Skip to content

Commit 15327ec

Browse files
ocheronocheron
committedNov 11, 2019
ECDSA with a type class
1 parent 8f75165 commit 15327ec

File tree

6 files changed

+337
-0
lines changed

6 files changed

+337
-0
lines changed
 

‎Crypto/PubKey/ECDSA.hs

+231
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,231 @@
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 FlexibleContexts #-}
19+
{-# LANGUAGE ScopedTypeVariables #-}
20+
{-# LANGUAGE StandaloneDeriving #-}
21+
{-# LANGUAGE TypeFamilies #-}
22+
{-# LANGUAGE UndecidableInstances #-}
23+
module Crypto.PubKey.ECDSA
24+
( EllipticCurveECDSA (..)
25+
-- * Public keys
26+
, PublicKey
27+
, encodePublic
28+
, decodePublic
29+
, toPublic
30+
-- * Private keys
31+
, PrivateKey
32+
, encodePrivate
33+
, decodePrivate
34+
-- * Signatures
35+
, Signature(..)
36+
, signatureFromIntegers
37+
, signatureToIntegers
38+
-- * Generation and verification
39+
, signWith
40+
, sign
41+
, verify
42+
) where
43+
44+
import Control.Monad
45+
46+
import Crypto.ECC
47+
import qualified Crypto.ECC.Simple.Types as Simple
48+
import Crypto.Error
49+
import Crypto.Hash
50+
import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)
51+
import Crypto.Internal.Imports
52+
import Crypto.Number.ModArithmetic (inverseFermat)
53+
import Crypto.Number.Serialize
54+
import qualified Crypto.PubKey.ECC.P256 as P256
55+
import Crypto.Random.Types
56+
57+
import Data.Bits (shiftR)
58+
import Data.Data
59+
60+
-- | Represent a ECDSA signature namely R and S.
61+
data Signature curve = Signature
62+
{ sign_r :: Scalar curve -- ^ ECDSA r
63+
, sign_s :: Scalar curve -- ^ ECDSA s
64+
}
65+
66+
deriving instance Eq (Scalar curve) => Eq (Signature curve)
67+
deriving instance Show (Scalar curve) => Show (Signature curve)
68+
69+
instance NFData (Scalar curve) => NFData (Signature curve) where
70+
rnf (Signature r s) = rnf r `seq` rnf s `seq` ()
71+
72+
-- | ECDSA Public Key.
73+
type PublicKey curve = Point curve
74+
75+
-- | ECDSA Private Key.
76+
type PrivateKey curve = Scalar curve
77+
78+
-- | Elliptic curves with ECDSA capabilities.
79+
class EllipticCurveBasepointArith curve => EllipticCurveECDSA curve where
80+
-- | Is a scalar in the accepted range for ECDSA
81+
scalarIsValid :: proxy curve -> Scalar curve -> Bool
82+
83+
-- | Test whether the scalar is zero
84+
scalarIsZero :: proxy curve -> Scalar curve -> Bool
85+
scalarIsZero prx s = s == throwCryptoError (scalarFromInteger prx 0)
86+
87+
-- | Scalar inversion modulo the curve order
88+
scalarInv :: proxy curve -> Scalar curve -> Maybe (Scalar curve)
89+
90+
-- | Return the point X coordinate as a scalar
91+
pointX :: proxy curve -> Point curve -> Maybe (Scalar curve)
92+
93+
instance EllipticCurveECDSA Curve_P256R1 where
94+
scalarIsValid _ s = not (P256.scalarIsZero s)
95+
&& P256.scalarCmp s P256.scalarN == LT
96+
97+
scalarIsZero _ = P256.scalarIsZero
98+
99+
scalarInv _ s = let inv = P256.scalarInvSafe s
100+
in if P256.scalarIsZero inv then Nothing else Just inv
101+
102+
pointX _ = P256.pointX
103+
104+
instance EllipticCurveECDSA Curve_P384R1 where
105+
scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p384r1)
106+
107+
scalarIsZero _ = ecScalarIsZero
108+
109+
scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p384r1)
110+
111+
pointX _ = ecPointX (Proxy :: Proxy Simple.SEC_p384r1)
112+
113+
instance EllipticCurveECDSA Curve_P521R1 where
114+
scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p521r1)
115+
116+
scalarIsZero _ = ecScalarIsZero
117+
118+
scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p521r1)
119+
120+
pointX _ = ecPointX (Proxy :: Proxy Simple.SEC_p521r1)
121+
122+
123+
-- | Create a signature from integers (R, S).
124+
signatureFromIntegers :: EllipticCurveECDSA curve
125+
=> proxy curve -> (Integer, Integer) -> CryptoFailable (Signature curve)
126+
signatureFromIntegers prx (r, s) =
127+
liftA2 Signature (scalarFromInteger prx r) (scalarFromInteger prx s)
128+
129+
-- | Get integers (R, S) from a signature.
130+
--
131+
-- The values can then be used to encode the signature to binary with
132+
-- ASN.1.
133+
signatureToIntegers :: EllipticCurveECDSA curve
134+
=> proxy curve -> Signature curve -> (Integer, Integer)
135+
signatureToIntegers prx sig =
136+
(scalarToInteger prx $ sign_r sig, scalarToInteger prx $ sign_s sig)
137+
138+
-- | Encode a public key into binary form, i.e. the uncompressed encoding
139+
-- referenced from <https://tools.ietf.org/html/rfc5480 RFC 5480> section 2.2.
140+
encodePublic :: (EllipticCurve curve, ByteArray bs)
141+
=> proxy curve -> PublicKey curve -> bs
142+
encodePublic = encodePoint
143+
144+
-- | Try to decode the binary form of a public key.
145+
decodePublic :: (EllipticCurve curve, ByteArray bs)
146+
=> proxy curve -> bs -> CryptoFailable (PublicKey curve)
147+
decodePublic = decodePoint
148+
149+
-- | Encode a private key into binary form, i.e. the @privateKey@ field
150+
-- described in <https://tools.ietf.org/html/rfc5915 RFC 5915>.
151+
encodePrivate :: (EllipticCurveECDSA curve, ByteArray bs)
152+
=> proxy curve -> PrivateKey curve -> bs
153+
encodePrivate = encodeScalar
154+
155+
-- | Try to decode the binary form of a private key.
156+
decodePrivate :: (EllipticCurveECDSA curve, ByteArray bs)
157+
=> proxy curve -> bs -> CryptoFailable (PrivateKey curve)
158+
decodePrivate = decodeScalar
159+
160+
-- | Create a public key from a private key.
161+
toPublic :: EllipticCurveECDSA curve
162+
=> proxy curve -> PrivateKey curve -> PublicKey curve
163+
toPublic = pointBaseSmul
164+
165+
-- | Sign message using the private key and an explicit k scalar.
166+
signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash)
167+
=> proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve)
168+
signWith prx k d hashAlg msg = do
169+
let z = tHash prx hashAlg msg
170+
point = pointBaseSmul prx k
171+
r <- pointX prx point
172+
kInv <- scalarInv prx k
173+
let s = scalarMul prx kInv (scalarAdd prx z (scalarMul prx r d))
174+
when (scalarIsZero prx r || scalarIsZero prx s) Nothing
175+
return $ Signature r s
176+
177+
-- | Sign a message using hash and private key.
178+
sign :: (EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg, HashAlgorithm hash)
179+
=> proxy curve -> PrivateKey curve -> hash -> msg -> m (Signature curve)
180+
sign prx pk hashAlg msg = do
181+
k <- curveGenerateScalar prx
182+
case signWith prx k pk hashAlg msg of
183+
Nothing -> sign prx pk hashAlg msg
184+
Just sig -> return sig
185+
186+
-- | Verify a signature using hash and public key.
187+
verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash)
188+
=> proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool
189+
verify prx hashAlg q (Signature r s) msg
190+
| not (scalarIsValid prx r) = False
191+
| not (scalarIsValid prx s) = False
192+
| otherwise = maybe False (r ==) $ do
193+
w <- scalarInv prx s
194+
let z = tHash prx hashAlg msg
195+
u1 = scalarMul prx z w
196+
u2 = scalarMul prx r w
197+
x = pointsSmulVarTime prx u1 u2 q
198+
pointX prx x
199+
-- Note: precondition q /= PointO is not tested because we assume
200+
-- point decoding never decodes point at infinity.
201+
202+
-- | Truncate and hash.
203+
tHash :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash)
204+
=> proxy curve -> hash -> msg -> Scalar curve
205+
tHash prx hashAlg m =
206+
throwCryptoError $ scalarFromInteger prx (if d > 0 then shiftR e d else e)
207+
where e = os2ip $ hashWith hashAlg m
208+
d = hashDigestSize hashAlg * 8 - curveOrderBits prx
209+
210+
211+
ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool
212+
ecScalarIsValid prx (Simple.Scalar s) = s > 0 && s < n
213+
where n = Simple.curveEccN $ Simple.curveParameters prx
214+
215+
ecScalarIsZero :: forall curve . Simple.Curve curve
216+
=> Simple.Scalar curve -> Bool
217+
ecScalarIsZero (Simple.Scalar a) = a == 0
218+
219+
ecScalarInv :: Simple.Curve c
220+
=> proxy c -> Simple.Scalar c -> Maybe (Simple.Scalar c)
221+
ecScalarInv prx (Simple.Scalar s)
222+
| i == 0 = Nothing
223+
| otherwise = Just $ Simple.Scalar i
224+
where n = Simple.curveEccN $ Simple.curveParameters prx
225+
i = inverseFermat s n
226+
227+
ecPointX :: Simple.Curve c
228+
=> proxy c -> Simple.Point c -> Maybe (Simple.Scalar c)
229+
ecPointX _ Simple.PointO = Nothing
230+
ecPointX prx (Simple.Point x _) = Just (Simple.Scalar $ x `mod` n)
231+
where n = Simple.curveEccN $ Simple.curveParameters prx

‎QA.hs

+1
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ perModuleAllowedExtensions =
4747
, ("Crypto/Cipher/DES/Primitive.hs", [FlexibleInstances])
4848
, ("Crypto/Cipher/Twofish/Primitive.hs", [MagicHash])
4949
, ("Crypto/PubKey/Curve25519.hs", [MagicHash])
50+
, ("Crypto/PubKey/ECDSA.hs", [FlexibleContexts,StandaloneDeriving,UndecidableInstances])
5051
, ("Crypto/Number/Compat.hs", [UnboxedTuples,MagicHash,CPP])
5152
, ("Crypto/System/CPU.hs", [CPP])
5253
]

‎benchs/Bench.hs

+40
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ import Crypto.Number.Generate
2323
import qualified Crypto.PubKey.DH as DH
2424
import qualified Crypto.PubKey.ECC.Types as ECC
2525
import qualified Crypto.PubKey.ECC.Prim as ECC
26+
import qualified Crypto.PubKey.ECDSA as ECDSA
2627
import Crypto.Random
2728

2829
import Control.DeepSeq (NFData)
@@ -286,6 +287,44 @@ benchECDH = map doECDHBench curves
286287
, ("X448", CurveDH Curve_X448)
287288
]
288289

290+
data CurveHashECDSA =
291+
forall curve hashAlg . (ECDSA.EllipticCurveECDSA curve,
292+
NFData (Scalar curve),
293+
NFData (Point curve),
294+
HashAlgorithm hashAlg) => CurveHashECDSA curve hashAlg
295+
296+
benchECDSA = map doECDSABench curveHashes
297+
where
298+
doECDSABench (name, CurveHashECDSA c hashAlg) =
299+
let proxy = Just c -- using Maybe as Proxy
300+
in bgroup name
301+
[ env (signGenerate proxy) $ bench "sign" . nfIO . signRun proxy hashAlg
302+
, env (verifyGenerate proxy hashAlg) $ bench "verify" . nf (verifyRun proxy hashAlg)
303+
]
304+
305+
signGenerate proxy = do
306+
m <- tenKB
307+
s <- curveGenerateScalar proxy
308+
return (s, m)
309+
310+
signRun proxy hashAlg (priv, msg) = ECDSA.sign proxy priv hashAlg msg
311+
312+
verifyGenerate proxy hashAlg = do
313+
m <- tenKB
314+
KeyPair p s <- curveGenerateKeyPair proxy
315+
sig <- ECDSA.sign proxy s hashAlg m
316+
return (p, sig, m)
317+
318+
verifyRun proxy hashAlg (pub, sig, msg) = ECDSA.verify proxy hashAlg pub sig msg
319+
320+
tenKB :: IO Bytes
321+
tenKB = getRandomBytes 10240
322+
323+
curveHashes = [ ("secp256r1_sha256", CurveHashECDSA Curve_P256R1 SHA256)
324+
, ("secp384r1_sha384", CurveHashECDSA Curve_P384R1 SHA384)
325+
, ("secp521r1_sha512", CurveHashECDSA Curve_P521R1 SHA512)
326+
]
327+
289328
main = defaultMain
290329
[ bgroup "hash" benchHash
291330
, bgroup "block-cipher" benchBlockCipher
@@ -298,5 +337,6 @@ main = defaultMain
298337
[ bgroup "FFDH" benchFFDH
299338
, bgroup "ECDH" benchECDH
300339
]
340+
, bgroup "ECDSA" benchECDSA
301341
, bgroup "F2m" benchF2m
302342
]

‎cryptonite.cabal

+2
Original file line numberDiff line numberDiff line change
@@ -159,6 +159,7 @@ Library
159159
Crypto.PubKey.ECC.ECDSA
160160
Crypto.PubKey.ECC.P256
161161
Crypto.PubKey.ECC.Types
162+
Crypto.PubKey.ECDSA
162163
Crypto.PubKey.ECIES
163164
Crypto.PubKey.Ed25519
164165
Crypto.PubKey.Ed448
@@ -387,6 +388,7 @@ Test-Suite test-cryptonite
387388
BCryptPBKDF
388389
ECC
389390
ECC.Edwards25519
391+
ECDSA
390392
Hash
391393
Imports
392394
KAT_AES.KATCBC

‎tests/ECDSA.hs

+61
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
{-# LANGUAGE ExistentialQuantification #-}
2+
{-# LANGUAGE FlexibleContexts #-}
3+
module ECDSA (tests) where
4+
5+
import qualified Crypto.ECC as ECDSA
6+
import qualified Crypto.PubKey.ECC.ECDSA as ECC
7+
import qualified Crypto.PubKey.ECC.Types as ECC
8+
import qualified Crypto.PubKey.ECDSA as ECDSA
9+
import Crypto.Hash.Algorithms
10+
import Crypto.Error
11+
import qualified Data.ByteString as B
12+
13+
import Imports
14+
15+
data Curve = forall curve. (ECDSA.EllipticCurveECDSA curve, Show (ECDSA.Scalar curve)) => Curve curve ECC.Curve ECC.CurveName
16+
17+
instance Show Curve where
18+
showsPrec d (Curve _ _ name) = showsPrec d name
19+
20+
instance Arbitrary Curve where
21+
arbitrary = elements
22+
[ makeCurve ECDSA.Curve_P256R1 ECC.SEC_p256r1
23+
, makeCurve ECDSA.Curve_P384R1 ECC.SEC_p384r1
24+
, makeCurve ECDSA.Curve_P521R1 ECC.SEC_p521r1
25+
]
26+
where
27+
makeCurve c name = Curve c (ECC.getCurveByName name) name
28+
29+
arbitraryScalar curve = choose (1, n - 1)
30+
where n = ECC.ecc_n (ECC.common_curve curve)
31+
32+
sigECCToECDSA :: ECDSA.EllipticCurveECDSA curve
33+
=> proxy curve -> ECC.Signature -> ECDSA.Signature curve
34+
sigECCToECDSA prx (ECC.Signature r s) =
35+
ECDSA.Signature (throwCryptoError $ ECDSA.scalarFromInteger prx r)
36+
(throwCryptoError $ ECDSA.scalarFromInteger prx s)
37+
38+
tests = localOption (QuickCheckTests 5) $ testGroup "ECDSA"
39+
[ testProperty "SHA1" $ propertyECDSA SHA1
40+
, testProperty "SHA224" $ propertyECDSA SHA224
41+
, testProperty "SHA256" $ propertyECDSA SHA256
42+
, testProperty "SHA384" $ propertyECDSA SHA384
43+
, testProperty "SHA512" $ propertyECDSA SHA512
44+
]
45+
where
46+
propertyECDSA hashAlg (Curve c curve _) (ArbitraryBS0_2901 msg) = do
47+
d <- arbitraryScalar curve
48+
kECC <- arbitraryScalar curve
49+
let privECC = ECC.PrivateKey curve d
50+
prx = Just c -- using Maybe as Proxy
51+
kECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx kECC
52+
privECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx d
53+
pubECDSA = ECDSA.toPublic prx privECDSA
54+
Just sigECC = ECC.signWith kECC privECC hashAlg msg
55+
Just sigECDSA = ECDSA.signWith prx kECDSA privECDSA hashAlg msg
56+
sigECDSA' = sigECCToECDSA prx sigECC
57+
msg' = msg `B.append` B.singleton 42
58+
return $ propertyHold [ eqTest "signature" sigECDSA sigECDSA'
59+
, eqTest "verification" True (ECDSA.verify prx hashAlg pubECDSA sigECDSA' msg)
60+
, eqTest "alteration" False (ECDSA.verify prx hashAlg pubECDSA sigECDSA msg')
61+
]

‎tests/Tests.hs

+2
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ import qualified BCrypt
1111
import qualified BCryptPBKDF
1212
import qualified ECC
1313
import qualified ECC.Edwards25519
14+
import qualified ECDSA
1415
import qualified Hash
1516
import qualified Poly1305
1617
import qualified Salsa
@@ -96,6 +97,7 @@ tests = testGroup "cryptonite"
9697
, KAT_AFIS.tests
9798
, ECC.tests
9899
, ECC.Edwards25519.tests
100+
, ECDSA.tests
99101
]
100102

101103
main = defaultMain tests

0 commit comments

Comments
 (0)
Please sign in to comment.