1-- |
2-- Module      : Crypto.PubKey.ECDSA
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Elliptic Curve Digital Signature Algorithm, with the parameterized
9-- curve implementations provided by module "Crypto.ECC".
10--
11-- Public/private key pairs can be generated using
12-- 'curveGenerateKeyPair' or decoded from binary.
13--
14-- /WARNING:/ Only curve P-256 has constant-time implementation.
15-- Signature operations with P-384 and P-521 may leak the private key.
16--
17-- Signature verification should be safe for all curves.
18{-# LANGUAGE BangPatterns #-}
19{-# LANGUAGE FlexibleContexts #-}
20{-# LANGUAGE ScopedTypeVariables #-}
21{-# LANGUAGE StandaloneDeriving #-}
22{-# LANGUAGE TypeFamilies #-}
23{-# LANGUAGE UndecidableInstances #-}
24module Crypto.PubKey.ECDSA
25    ( EllipticCurveECDSA (..)
26    -- * Public keys
27    , PublicKey
28    , encodePublic
29    , decodePublic
30    , toPublic
31    -- * Private keys
32    , PrivateKey
33    , encodePrivate
34    , decodePrivate
35    -- * Signatures
36    , Signature(..)
37    , signatureFromIntegers
38    , signatureToIntegers
39    -- * Generation and verification
40    , signWith
41    , signDigestWith
42    , sign
43    , signDigest
44    , verify
45    , verifyDigest
46    ) where
47
48import           Control.Monad
49
50import           Crypto.ECC
51import qualified Crypto.ECC.Simple.Types as Simple
52import           Crypto.Error
53import           Crypto.Hash
54import           Crypto.Hash.Types
55import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)
56import           Crypto.Internal.Imports
57import           Crypto.Number.ModArithmetic (inverseFermat)
58import qualified Crypto.PubKey.ECC.P256 as P256
59import           Crypto.Random.Types
60
61import           Data.Bits
62import qualified Data.ByteArray as B
63import           Data.Data
64
65import           Foreign.Ptr (Ptr)
66import           Foreign.Storable (peekByteOff, pokeByteOff)
67
68-- | Represent a ECDSA signature namely R and S.
69data Signature curve = Signature
70    { sign_r :: Scalar curve -- ^ ECDSA r
71    , sign_s :: Scalar curve -- ^ ECDSA s
72    }
73
74deriving instance Eq (Scalar curve) => Eq (Signature curve)
75deriving instance Show (Scalar curve) => Show (Signature curve)
76
77instance NFData (Scalar curve) => NFData (Signature curve) where
78    rnf (Signature r s) = rnf r `seq` rnf s `seq` ()
79
80-- | ECDSA Public Key.
81type PublicKey curve = Point curve
82
83-- | ECDSA Private Key.
84type PrivateKey curve = Scalar curve
85
86-- | Elliptic curves with ECDSA capabilities.
87class EllipticCurveBasepointArith curve => EllipticCurveECDSA curve where
88    -- | Is a scalar in the accepted range for ECDSA
89    scalarIsValid :: proxy curve -> Scalar curve -> Bool
90
91    -- | Test whether the scalar is zero
92    scalarIsZero :: proxy curve -> Scalar curve -> Bool
93    scalarIsZero prx s = s == throwCryptoError (scalarFromInteger prx 0)
94
95    -- | Scalar inversion modulo the curve order
96    scalarInv :: proxy curve -> Scalar curve -> Maybe (Scalar curve)
97
98    -- | Return the point X coordinate as a scalar
99    pointX :: proxy curve -> Point curve -> Maybe (Scalar curve)
100
101instance EllipticCurveECDSA Curve_P256R1 where
102    scalarIsValid _ s = not (P256.scalarIsZero s)
103                            && P256.scalarCmp s P256.scalarN == LT
104
105    scalarIsZero _ = P256.scalarIsZero
106
107    scalarInv _ s = let inv = P256.scalarInvSafe s
108                     in if P256.scalarIsZero inv then Nothing else Just inv
109
110    pointX _  = P256.pointX
111
112instance EllipticCurveECDSA Curve_P384R1 where
113    scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p384r1)
114
115    scalarIsZero _ = ecScalarIsZero
116
117    scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p384r1)
118
119    pointX _  = ecPointX (Proxy :: Proxy Simple.SEC_p384r1)
120
121instance EllipticCurveECDSA Curve_P521R1 where
122    scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p521r1)
123
124    scalarIsZero _ = ecScalarIsZero
125
126    scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p521r1)
127
128    pointX _  = ecPointX (Proxy :: Proxy Simple.SEC_p521r1)
129
130
131-- | Create a signature from integers (R, S).
132signatureFromIntegers :: EllipticCurveECDSA curve
133                      => proxy curve -> (Integer, Integer) -> CryptoFailable (Signature curve)
134signatureFromIntegers prx (r, s) =
135    liftA2 Signature (scalarFromInteger prx r) (scalarFromInteger prx s)
136
137-- | Get integers (R, S) from a signature.
138--
139-- The values can then be used to encode the signature to binary with
140-- ASN.1.
141signatureToIntegers :: EllipticCurveECDSA curve
142                    => proxy curve -> Signature curve -> (Integer, Integer)
143signatureToIntegers prx sig =
144    (scalarToInteger prx $ sign_r sig, scalarToInteger prx $ sign_s sig)
145
146-- | Encode a public key into binary form, i.e. the uncompressed encoding
147-- referenced from <https://tools.ietf.org/html/rfc5480 RFC 5480> section 2.2.
148encodePublic :: (EllipticCurve curve, ByteArray bs)
149             => proxy curve -> PublicKey curve -> bs
150encodePublic = encodePoint
151
152-- | Try to decode the binary form of a public key.
153decodePublic :: (EllipticCurve curve, ByteArray bs)
154             => proxy curve -> bs -> CryptoFailable (PublicKey curve)
155decodePublic = decodePoint
156
157-- | Encode a private key into binary form, i.e. the @privateKey@ field
158-- described in <https://tools.ietf.org/html/rfc5915 RFC 5915>.
159encodePrivate :: (EllipticCurveECDSA curve, ByteArray bs)
160              => proxy curve -> PrivateKey curve -> bs
161encodePrivate = encodeScalar
162
163-- | Try to decode the binary form of a private key.
164decodePrivate :: (EllipticCurveECDSA curve, ByteArray bs)
165              => proxy curve -> bs -> CryptoFailable (PrivateKey curve)
166decodePrivate = decodeScalar
167
168-- | Create a public key from a private key.
169toPublic :: EllipticCurveECDSA curve
170         => proxy curve -> PrivateKey curve -> PublicKey curve
171toPublic = pointBaseSmul
172
173-- | Sign digest using the private key and an explicit k scalar.
174signDigestWith :: (EllipticCurveECDSA curve, HashAlgorithm hash)
175               => proxy curve -> Scalar curve -> PrivateKey curve -> Digest hash -> Maybe (Signature curve)
176signDigestWith prx k d digest = do
177    let z = tHashDigest prx digest
178        point = pointBaseSmul prx k
179    r <- pointX prx point
180    kInv <- scalarInv prx k
181    let s = scalarMul prx kInv (scalarAdd prx z (scalarMul prx r d))
182    when (scalarIsZero prx r || scalarIsZero prx s) Nothing
183    return $ Signature r s
184
185-- | Sign message using the private key and an explicit k scalar.
186signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash)
187         => proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve)
188signWith prx k d hashAlg msg = signDigestWith prx k d (hashWith hashAlg msg)
189
190-- | Sign a digest using hash and private key.
191signDigest :: (EllipticCurveECDSA curve, MonadRandom m, HashAlgorithm hash)
192           => proxy curve -> PrivateKey curve -> Digest hash -> m (Signature curve)
193signDigest prx pk digest = do
194    k <- curveGenerateScalar prx
195    case signDigestWith prx k pk digest of
196        Nothing  -> signDigest prx pk digest
197        Just sig -> return sig
198
199-- | Sign a message using hash and private key.
200sign :: (EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg, HashAlgorithm hash)
201     => proxy curve -> PrivateKey curve -> hash -> msg -> m (Signature curve)
202sign prx pk hashAlg msg = signDigest prx pk (hashWith hashAlg msg)
203
204-- | Verify a digest using hash and public key.
205verifyDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash)
206       => proxy curve -> PublicKey curve -> Signature curve -> Digest hash -> Bool
207verifyDigest prx q (Signature r s) digest
208    | not (scalarIsValid prx r) = False
209    | not (scalarIsValid prx s) = False
210    | otherwise = maybe False (r ==) $ do
211        w <- scalarInv prx s
212        let z  = tHashDigest prx digest
213            u1 = scalarMul prx z w
214            u2 = scalarMul prx r w
215            x  = pointsSmulVarTime prx u1 u2 q
216        pointX prx x
217    -- Note: precondition q /= PointO is not tested because we assume
218    -- point decoding never decodes point at infinity.
219
220-- | Verify a signature using hash and public key.
221verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash)
222       => proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool
223verify prx hashAlg q sig msg = verifyDigest prx q sig (hashWith hashAlg msg)
224
225-- | Truncate a digest based on curve order size.
226tHashDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash)
227            => proxy curve -> Digest hash -> Scalar curve
228tHashDigest prx (Digest digest) = throwCryptoError $ decodeScalar prx encoded
229  where m      = curveOrderBits prx
230        d      = m - B.length digest * 8
231        (n, r) = m `divMod` 8
232        n'     = if r > 0 then succ n else n
233
234        encoded
235            | d >  0    = B.zero (n' - B.length digest) `B.append` digest
236            | d == 0    = digest
237            | r == 0    = B.take n digest
238            | otherwise = shiftBytes digest
239
240        shiftBytes bs = B.allocAndFreeze n' $ \dst ->
241            B.withByteArray bs $ \src -> go dst src 0 0
242
243        go :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ()
244        go dst src !a i
245            | i >= n'   = return ()
246            | otherwise = do
247                b <- peekByteOff src i
248                pokeByteOff dst i (unsafeShiftR b (8 - r) .|. unsafeShiftL a r)
249                go dst src b (succ i)
250
251
252ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool
253ecScalarIsValid prx (Simple.Scalar s) = s > 0 && s < n
254  where n = Simple.curveEccN $ Simple.curveParameters prx
255
256ecScalarIsZero :: forall curve . Simple.Curve curve
257               => Simple.Scalar curve -> Bool
258ecScalarIsZero (Simple.Scalar a) = a == 0
259
260ecScalarInv :: Simple.Curve c
261            => proxy c -> Simple.Scalar c -> Maybe (Simple.Scalar c)
262ecScalarInv prx (Simple.Scalar s)
263    | i == 0    = Nothing
264    | otherwise = Just $ Simple.Scalar i
265  where n = Simple.curveEccN $ Simple.curveParameters prx
266        i = inverseFermat s n
267
268ecPointX :: Simple.Curve c
269         => proxy c -> Simple.Point c -> Maybe (Simple.Scalar c)
270ecPointX _   Simple.PointO      = Nothing
271ecPointX prx (Simple.Point x _) = Just (Simple.Scalar $ x `mod` n)
272  where n = Simple.curveEccN $ Simple.curveParameters prx
273