From 19b7ab375a80a0690deb7b149dcb4a602ea6ecfb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 8 Oct 2017 09:21:45 +0200 Subject: [PATCH 1/6] Time-constant modular inverse --- Crypto/Number/ModArithmetic.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Crypto/Number/ModArithmetic.hs b/Crypto/Number/ModArithmetic.hs index dcd8663..3d46aaa 100644 --- a/Crypto/Number/ModArithmetic.hs +++ b/Crypto/Number/ModArithmetic.hs @@ -16,6 +16,7 @@ module Crypto.Number.ModArithmetic , inverse , inverseCoprimes , jacobi + , inverseFermat ) where import Control.Exception (throw, Exception) @@ -120,3 +121,8 @@ jacobi a n n1 = n `mod` a1 in if a1 == 1 then Just s else fmap (*s) (jacobi n1 a1) + +-- | Modular inverse using Fermat's little theorem. This works only when +-- the modulus is prime but avoids side channels like in 'expSafe'. +inverseFermat :: Integer -> Integer -> Integer +inverseFermat g p = expSafe g (p - 2) p From 977e75f47814566ee2b3150ce0a7e00c39830d61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 8 Oct 2017 15:28:14 +0200 Subject: [PATCH 2/6] Add P256 functions to implement ECDSA --- Crypto/PubKey/ECC/P256.hs | 24 +++++++++++++++++++++++- tests/KAT_PubKey/P256.hs | 6 ++++++ 2 files changed, 29 insertions(+), 1 deletion(-) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 6edd8dd..aa5b18e 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -8,7 +8,6 @@ -- P256 support -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE EmptyDataDecls #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} module Crypto.PubKey.ECC.P256 @@ -22,7 +21,9 @@ module Crypto.PubKey.ECC.P256 , pointDh , pointsMulVarTime , pointIsValid + , pointIsAtInfinity , toPoint + , pointX , pointToIntegers , pointFromIntegers , pointToBinary @@ -31,6 +32,7 @@ module Crypto.PubKey.ECC.P256 -- * Scalar arithmetic , scalarGenerate , scalarZero + , scalarN , scalarIsZero , scalarAdd , scalarSub @@ -77,6 +79,9 @@ data P256Scalar data P256Y data P256X +order :: Integer +order = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551 + ------------------------------------------------------------------------ -- Point methods ------------------------------------------------------------------------ @@ -146,6 +151,19 @@ pointIsValid p = unsafeDoIO $ withPoint p $ \px py -> do r <- ccryptonite_p256_is_valid_point px py return (r /= 0) +-- | Check if a 'Point' is the point at infinity +pointIsAtInfinity :: Point -> Bool +pointIsAtInfinity (Point b) = constAllZero b + +-- | Return the x coordinate as a 'Scalar' if the point is not at infinity +pointX :: Point -> Maybe Scalar +pointX p + | pointIsAtInfinity p = Nothing + | otherwise = Just $ + withNewScalarFreeze $ \d -> + withPoint p $ \px _ -> + ccryptonite_p256_mod ccryptonite_SECP256r1_n (castPtr px) (castPtr d) + -- | Convert a point to (x,y) Integers pointToIntegers :: Point -> (Integer, Integer) pointToIntegers p = unsafeDoIO $ withPoint p $ \px py -> @@ -216,6 +234,10 @@ scalarGenerate = unwrap . scalarFromBinary . witness <$> getRandomBytes 32 scalarZero :: Scalar scalarZero = withNewScalarFreeze $ \d -> ccryptonite_p256_init d +-- | The scalar representing the curve order +scalarN :: Scalar +scalarN = throwCryptoError (scalarFromInteger order) + -- | Check if the scalar is 0 scalarIsZero :: Scalar -> Bool scalarIsZero s = unsafeDoIO $ withScalar s $ \d -> do diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index 7dd508e..f04603f 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -126,6 +126,12 @@ tests = testGroup "P256" , testProperty "point-add" propertyPointAdd , testProperty "point-negate" propertyPointNegate , testProperty "point-mul" propertyPointMul + , testProperty "infinity" $ + let gN = P256.toPoint P256.scalarN + g1 = P256.pointBase + in propertyHold [ eqTest "zero" True (P256.pointIsAtInfinity gN) + , eqTest "base" False (P256.pointIsAtInfinity g1) + ] ] ] where From 8f75165f8b3cfa98846030026b66a253fdcaa299 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 26 Nov 2017 10:06:04 +0100 Subject: [PATCH 3/6] Time-constant P256 scalar inversion --- Crypto/PubKey/ECC/P256.hs | 11 ++++ cbits/p256/p256.c | 111 ++++++++++++++++++++++++++++++++++++++ tests/KAT_PubKey/P256.hs | 16 +++++- 3 files changed, 137 insertions(+), 1 deletion(-) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index aa5b18e..77a5ff0 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -38,6 +38,7 @@ module Crypto.PubKey.ECC.P256 , scalarSub , scalarMul , scalarInv + , scalarInvSafe , scalarCmp , scalarFromBinary , scalarToBinary @@ -278,6 +279,14 @@ scalarInv a = withNewScalarFreeze $ \b -> withScalar a $ \pa -> ccryptonite_p256_modinv_vartime ccryptonite_SECP256r1_n pa b +-- | Give the inverse of the scalar using safe exponentiation +-- +-- > 1 / a +scalarInvSafe :: Scalar -> Scalar +scalarInvSafe a = + withNewScalarFreeze $ \b -> withScalar a $ \pa -> + ccryptonite_p256e_scalar_invert pa b + -- | Compare 2 Scalar scalarCmp :: Scalar -> Scalar -> Ordering scalarCmp a b = unsafeDoIO $ @@ -381,6 +390,8 @@ foreign import ccall "cryptonite_p256_mod" ccryptonite_p256_mod :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO () foreign import ccall "cryptonite_p256_modmul" ccryptonite_p256_modmul :: Ptr P256Scalar -> Ptr P256Scalar -> P256Digit -> Ptr P256Scalar -> Ptr P256Scalar -> IO () +foreign import ccall "cryptonite_p256e_scalar_invert" + ccryptonite_p256e_scalar_invert :: Ptr P256Scalar -> Ptr P256Scalar -> IO () --foreign import ccall "cryptonite_p256_modinv" -- ccryptonite_p256_modinv :: Ptr P256Scalar -> Ptr P256Scalar -> Ptr P256Scalar -> IO () foreign import ccall "cryptonite_p256_modinv_vartime" diff --git a/cbits/p256/p256.c b/cbits/p256/p256.c index bd94f6a..8dad6ef 100644 --- a/cbits/p256/p256.c +++ b/cbits/p256/p256.c @@ -408,3 +408,114 @@ void cryptonite_p256e_modsub(const cryptonite_p256_int* MOD, const cryptonite_p2 top = subM(MOD, top, P256_DIGITS(c), MSB_COMPLEMENT(top)); addM(MOD, 0, P256_DIGITS(c), top); } + +// n' such as n * n' = -1 mod (2^32) +#define MONTGOMERY_FACTOR 0xEE00BC4F + +#define NTH_DOUBLE_THEN_ADD(i, a, nth, b, out) \ + cryptonite_p256e_montmul(a, a, out); \ + for (i = 1; i < nth; i++) \ + cryptonite_p256e_montmul(out, out, out); \ + cryptonite_p256e_montmul(out, b, out); + +const cryptonite_p256_int cryptonite_SECP256r1_r2 = // r^2 mod n + {{0xBE79EEA2, 0x83244C95, 0x49BD6FA6, 0x4699799C, + 0x2B6BEC59, 0x2845B239, 0xF3D95620, 0x66E12D94}}; + +const cryptonite_p256_int cryptonite_SECP256r1_one = {{1}}; + +// Montgomery multiplication, i.e. c = ab/r mod n with r = 2^256. +// Implementation is adapted from 'sc_montmul' in libdecaf. +static void cryptonite_p256e_montmul(const cryptonite_p256_int* a, const cryptonite_p256_int* b, cryptonite_p256_int* c) { + int i, j, borrow; + cryptonite_p256_digit accum[P256_NDIGITS+1] = {0}; + cryptonite_p256_digit hi_carry = 0; + + for (i=0; i>= P256_BITSPERDIGIT; + } + accum[j] = chain; + + mand = accum[0] * MONTGOMERY_FACTOR; + chain = 0; + mier = P256_DIGITS(&cryptonite_SECP256r1_n); + for (j=0; j>= P256_BITSPERDIGIT; + } + chain += accum[j]; + chain += hi_carry; + accum[j-1] = chain; + hi_carry = chain >> P256_BITSPERDIGIT; + } + + memcpy(P256_DIGITS(c), accum, sizeof(*c)); + borrow = cryptonite_p256_sub(c, &cryptonite_SECP256r1_n, c); + addM(&cryptonite_SECP256r1_n, 0, P256_DIGITS(c), borrow + hi_carry); +} + +// b = 1/a mod n, using Fermat's little theorem. +void cryptonite_p256e_scalar_invert(const cryptonite_p256_int* a, cryptonite_p256_int* b) { + cryptonite_p256_int _1, _10, _11, _101, _111, _1010, _1111; + cryptonite_p256_int _10101, _101010, _101111, x6, x8, x16, x32; + int i; + + // Montgomerize + cryptonite_p256e_montmul(a, &cryptonite_SECP256r1_r2, &_1); + + // P-256 (secp256r1) Scalar Inversion + // + cryptonite_p256e_montmul(&_1 , &_1 , &_10); + cryptonite_p256e_montmul(&_10 , &_1 , &_11); + cryptonite_p256e_montmul(&_10 , &_11 , &_101); + cryptonite_p256e_montmul(&_10 , &_101 , &_111); + cryptonite_p256e_montmul(&_101 , &_101 , &_1010); + cryptonite_p256e_montmul(&_101 , &_1010 , &_1111); + NTH_DOUBLE_THEN_ADD(i, &_1010, 1 , &_1 , &_10101); + cryptonite_p256e_montmul(&_10101 , &_10101 , &_101010); + cryptonite_p256e_montmul(&_101 , &_101010, &_101111); + cryptonite_p256e_montmul(&_10101 , &_101010, &x6); + NTH_DOUBLE_THEN_ADD(i, &x6 , 2 , &_11 , &x8); + NTH_DOUBLE_THEN_ADD(i, &x8 , 8 , &x8 , &x16); + NTH_DOUBLE_THEN_ADD(i, &x16 , 16 , &x16 , &x32); + + NTH_DOUBLE_THEN_ADD(i, &x32 , 32+32, &x32 , b); + NTH_DOUBLE_THEN_ADD(i, b , 32, &x32 , b); + NTH_DOUBLE_THEN_ADD(i, b , 6, &_101111, b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 4, &_1111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 5, &_10101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 3, &_101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3, &_101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3, &_101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3 + 6, &_101111, b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 4, &_1111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 1, &_1 , b); + NTH_DOUBLE_THEN_ADD(i, b , 4 + 1, &_1 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 4, &_1111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_111 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 3, &_101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 1 + 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 4 + 6, &_101111, b); + NTH_DOUBLE_THEN_ADD(i, b , 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3 + 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 3 + 2, &_11 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 1, &_1 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 5, &_10101 , b); + NTH_DOUBLE_THEN_ADD(i, b , 2 + 4, &_1111 , b); + + // Demontgomerize + cryptonite_p256e_montmul(b, &cryptonite_SECP256r1_one, b); +} diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index f04603f..63831ce 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -102,7 +102,21 @@ tests = testGroup "P256" , testProperty "inv" $ \r' -> let inv = inverseCoprimes (unP256 r') curveN inv' = P256.scalarInv (unP256Scalar r') - in if unP256 r' == 0 then True else inv `propertyEq` p256ScalarToInteger inv' + in unP256 r' /= 0 ==> inv `propertyEq` p256ScalarToInteger inv' + , testProperty "inv-safe" $ \r' -> + let inv = P256.scalarInv (unP256Scalar r') + inv' = P256.scalarInvSafe (unP256Scalar r') + in unP256 r' /= 0 ==> inv `propertyEq` inv' + , testProperty "inv-safe-mul" $ \r' -> + let inv = P256.scalarInvSafe (unP256Scalar r') + res = P256.scalarMul (unP256Scalar r') inv + in unP256 r' /= 0 ==> 1 `propertyEq` p256ScalarToInteger res + , testProperty "inv-safe-zero" $ + let inv0 = P256.scalarInvSafe P256.scalarZero + invN = P256.scalarInvSafe P256.scalarN + in propertyHold [ eqTest "scalarZero" P256.scalarZero inv0 + , eqTest "scalarN" P256.scalarZero invN + ] ] , testGroup "point" [ testProperty "marshalling" $ \rx ry -> From 15327ecd4ffffa94dfe698e8544f787ec71c8136 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 5 May 2019 09:13:57 +0200 Subject: [PATCH 4/6] ECDSA with a type class --- Crypto/PubKey/ECDSA.hs | 231 +++++++++++++++++++++++++++++++++++++++++ QA.hs | 1 + benchs/Bench.hs | 40 +++++++ cryptonite.cabal | 2 + tests/ECDSA.hs | 61 +++++++++++ tests/Tests.hs | 2 + 6 files changed, 337 insertions(+) create mode 100644 Crypto/PubKey/ECDSA.hs create mode 100644 tests/ECDSA.hs diff --git a/Crypto/PubKey/ECDSA.hs b/Crypto/PubKey/ECDSA.hs new file mode 100644 index 0000000..c1416a0 --- /dev/null +++ b/Crypto/PubKey/ECDSA.hs @@ -0,0 +1,231 @@ +-- | +-- Module : Crypto.PubKey.ECDSA +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- Elliptic Curve Digital Signature Algorithm, with the parameterized +-- curve implementations provided by module "Crypto.ECC". +-- +-- Public/private key pairs can be generated using +-- 'curveGenerateKeyPair' or decoded from binary. +-- +-- /WARNING:/ Only curve P-256 has constant-time implementation. +-- Signature operations with P-384 and P-521 may leak the private key. +-- +-- Signature verification should be safe for all curves. +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module Crypto.PubKey.ECDSA + ( EllipticCurveECDSA (..) + -- * Public keys + , PublicKey + , encodePublic + , decodePublic + , toPublic + -- * Private keys + , PrivateKey + , encodePrivate + , decodePrivate + -- * Signatures + , Signature(..) + , signatureFromIntegers + , signatureToIntegers + -- * Generation and verification + , signWith + , sign + , verify + ) where + +import Control.Monad + +import Crypto.ECC +import qualified Crypto.ECC.Simple.Types as Simple +import Crypto.Error +import Crypto.Hash +import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) +import Crypto.Internal.Imports +import Crypto.Number.ModArithmetic (inverseFermat) +import Crypto.Number.Serialize +import qualified Crypto.PubKey.ECC.P256 as P256 +import Crypto.Random.Types + +import Data.Bits (shiftR) +import Data.Data + +-- | Represent a ECDSA signature namely R and S. +data Signature curve = Signature + { sign_r :: Scalar curve -- ^ ECDSA r + , sign_s :: Scalar curve -- ^ ECDSA s + } + +deriving instance Eq (Scalar curve) => Eq (Signature curve) +deriving instance Show (Scalar curve) => Show (Signature curve) + +instance NFData (Scalar curve) => NFData (Signature curve) where + rnf (Signature r s) = rnf r `seq` rnf s `seq` () + +-- | ECDSA Public Key. +type PublicKey curve = Point curve + +-- | ECDSA Private Key. +type PrivateKey curve = Scalar curve + +-- | Elliptic curves with ECDSA capabilities. +class EllipticCurveBasepointArith curve => EllipticCurveECDSA curve where + -- | Is a scalar in the accepted range for ECDSA + scalarIsValid :: proxy curve -> Scalar curve -> Bool + + -- | Test whether the scalar is zero + scalarIsZero :: proxy curve -> Scalar curve -> Bool + scalarIsZero prx s = s == throwCryptoError (scalarFromInteger prx 0) + + -- | Scalar inversion modulo the curve order + scalarInv :: proxy curve -> Scalar curve -> Maybe (Scalar curve) + + -- | Return the point X coordinate as a scalar + pointX :: proxy curve -> Point curve -> Maybe (Scalar curve) + +instance EllipticCurveECDSA Curve_P256R1 where + scalarIsValid _ s = not (P256.scalarIsZero s) + && P256.scalarCmp s P256.scalarN == LT + + scalarIsZero _ = P256.scalarIsZero + + scalarInv _ s = let inv = P256.scalarInvSafe s + in if P256.scalarIsZero inv then Nothing else Just inv + + pointX _ = P256.pointX + +instance EllipticCurveECDSA Curve_P384R1 where + scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p384r1) + + scalarIsZero _ = ecScalarIsZero + + scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p384r1) + + pointX _ = ecPointX (Proxy :: Proxy Simple.SEC_p384r1) + +instance EllipticCurveECDSA Curve_P521R1 where + scalarIsValid _ = ecScalarIsValid (Proxy :: Proxy Simple.SEC_p521r1) + + scalarIsZero _ = ecScalarIsZero + + scalarInv _ = ecScalarInv (Proxy :: Proxy Simple.SEC_p521r1) + + pointX _ = ecPointX (Proxy :: Proxy Simple.SEC_p521r1) + + +-- | Create a signature from integers (R, S). +signatureFromIntegers :: EllipticCurveECDSA curve + => proxy curve -> (Integer, Integer) -> CryptoFailable (Signature curve) +signatureFromIntegers prx (r, s) = + liftA2 Signature (scalarFromInteger prx r) (scalarFromInteger prx s) + +-- | Get integers (R, S) from a signature. +-- +-- The values can then be used to encode the signature to binary with +-- ASN.1. +signatureToIntegers :: EllipticCurveECDSA curve + => proxy curve -> Signature curve -> (Integer, Integer) +signatureToIntegers prx sig = + (scalarToInteger prx $ sign_r sig, scalarToInteger prx $ sign_s sig) + +-- | Encode a public key into binary form, i.e. the uncompressed encoding +-- referenced from section 2.2. +encodePublic :: (EllipticCurve curve, ByteArray bs) + => proxy curve -> PublicKey curve -> bs +encodePublic = encodePoint + +-- | Try to decode the binary form of a public key. +decodePublic :: (EllipticCurve curve, ByteArray bs) + => proxy curve -> bs -> CryptoFailable (PublicKey curve) +decodePublic = decodePoint + +-- | Encode a private key into binary form, i.e. the @privateKey@ field +-- described in . +encodePrivate :: (EllipticCurveECDSA curve, ByteArray bs) + => proxy curve -> PrivateKey curve -> bs +encodePrivate = encodeScalar + +-- | Try to decode the binary form of a private key. +decodePrivate :: (EllipticCurveECDSA curve, ByteArray bs) + => proxy curve -> bs -> CryptoFailable (PrivateKey curve) +decodePrivate = decodeScalar + +-- | Create a public key from a private key. +toPublic :: EllipticCurveECDSA curve + => proxy curve -> PrivateKey curve -> PublicKey curve +toPublic = pointBaseSmul + +-- | Sign message using the private key and an explicit k scalar. +signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve) +signWith prx k d hashAlg msg = do + let z = tHash prx hashAlg msg + point = pointBaseSmul prx k + r <- pointX prx point + kInv <- scalarInv prx k + let s = scalarMul prx kInv (scalarAdd prx z (scalarMul prx r d)) + when (scalarIsZero prx r || scalarIsZero prx s) Nothing + return $ Signature r s + +-- | Sign a message using hash and private key. +sign :: (EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> PrivateKey curve -> hash -> msg -> m (Signature curve) +sign prx pk hashAlg msg = do + k <- curveGenerateScalar prx + case signWith prx k pk hashAlg msg of + Nothing -> sign prx pk hashAlg msg + Just sig -> return sig + +-- | Verify a signature using hash and public key. +verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool +verify prx hashAlg q (Signature r s) msg + | not (scalarIsValid prx r) = False + | not (scalarIsValid prx s) = False + | otherwise = maybe False (r ==) $ do + w <- scalarInv prx s + let z = tHash prx hashAlg msg + u1 = scalarMul prx z w + u2 = scalarMul prx r w + x = pointsSmulVarTime prx u1 u2 q + pointX prx x + -- Note: precondition q /= PointO is not tested because we assume + -- point decoding never decodes point at infinity. + +-- | Truncate and hash. +tHash :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> hash -> msg -> Scalar curve +tHash prx hashAlg m = + throwCryptoError $ scalarFromInteger prx (if d > 0 then shiftR e d else e) + where e = os2ip $ hashWith hashAlg m + d = hashDigestSize hashAlg * 8 - curveOrderBits prx + + +ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool +ecScalarIsValid prx (Simple.Scalar s) = s > 0 && s < n + where n = Simple.curveEccN $ Simple.curveParameters prx + +ecScalarIsZero :: forall curve . Simple.Curve curve + => Simple.Scalar curve -> Bool +ecScalarIsZero (Simple.Scalar a) = a == 0 + +ecScalarInv :: Simple.Curve c + => proxy c -> Simple.Scalar c -> Maybe (Simple.Scalar c) +ecScalarInv prx (Simple.Scalar s) + | i == 0 = Nothing + | otherwise = Just $ Simple.Scalar i + where n = Simple.curveEccN $ Simple.curveParameters prx + i = inverseFermat s n + +ecPointX :: Simple.Curve c + => proxy c -> Simple.Point c -> Maybe (Simple.Scalar c) +ecPointX _ Simple.PointO = Nothing +ecPointX prx (Simple.Point x _) = Just (Simple.Scalar $ x `mod` n) + where n = Simple.curveEccN $ Simple.curveParameters prx diff --git a/QA.hs b/QA.hs index bf6b2e2..f3090bb 100644 --- a/QA.hs +++ b/QA.hs @@ -47,6 +47,7 @@ perModuleAllowedExtensions = , ("Crypto/Cipher/DES/Primitive.hs", [FlexibleInstances]) , ("Crypto/Cipher/Twofish/Primitive.hs", [MagicHash]) , ("Crypto/PubKey/Curve25519.hs", [MagicHash]) + , ("Crypto/PubKey/ECDSA.hs", [FlexibleContexts,StandaloneDeriving,UndecidableInstances]) , ("Crypto/Number/Compat.hs", [UnboxedTuples,MagicHash,CPP]) , ("Crypto/System/CPU.hs", [CPP]) ] diff --git a/benchs/Bench.hs b/benchs/Bench.hs index bc1d668..e111a0d 100644 --- a/benchs/Bench.hs +++ b/benchs/Bench.hs @@ -23,6 +23,7 @@ import Crypto.Number.Generate import qualified Crypto.PubKey.DH as DH import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.ECC.Prim as ECC +import qualified Crypto.PubKey.ECDSA as ECDSA import Crypto.Random import Control.DeepSeq (NFData) @@ -286,6 +287,44 @@ benchECDH = map doECDHBench curves , ("X448", CurveDH Curve_X448) ] +data CurveHashECDSA = + forall curve hashAlg . (ECDSA.EllipticCurveECDSA curve, + NFData (Scalar curve), + NFData (Point curve), + HashAlgorithm hashAlg) => CurveHashECDSA curve hashAlg + +benchECDSA = map doECDSABench curveHashes + where + doECDSABench (name, CurveHashECDSA c hashAlg) = + let proxy = Just c -- using Maybe as Proxy + in bgroup name + [ env (signGenerate proxy) $ bench "sign" . nfIO . signRun proxy hashAlg + , env (verifyGenerate proxy hashAlg) $ bench "verify" . nf (verifyRun proxy hashAlg) + ] + + signGenerate proxy = do + m <- tenKB + s <- curveGenerateScalar proxy + return (s, m) + + signRun proxy hashAlg (priv, msg) = ECDSA.sign proxy priv hashAlg msg + + verifyGenerate proxy hashAlg = do + m <- tenKB + KeyPair p s <- curveGenerateKeyPair proxy + sig <- ECDSA.sign proxy s hashAlg m + return (p, sig, m) + + verifyRun proxy hashAlg (pub, sig, msg) = ECDSA.verify proxy hashAlg pub sig msg + + tenKB :: IO Bytes + tenKB = getRandomBytes 10240 + + curveHashes = [ ("secp256r1_sha256", CurveHashECDSA Curve_P256R1 SHA256) + , ("secp384r1_sha384", CurveHashECDSA Curve_P384R1 SHA384) + , ("secp521r1_sha512", CurveHashECDSA Curve_P521R1 SHA512) + ] + main = defaultMain [ bgroup "hash" benchHash , bgroup "block-cipher" benchBlockCipher @@ -298,5 +337,6 @@ main = defaultMain [ bgroup "FFDH" benchFFDH , bgroup "ECDH" benchECDH ] + , bgroup "ECDSA" benchECDSA , bgroup "F2m" benchF2m ] diff --git a/cryptonite.cabal b/cryptonite.cabal index f7372c9..637521a 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -159,6 +159,7 @@ Library Crypto.PubKey.ECC.ECDSA Crypto.PubKey.ECC.P256 Crypto.PubKey.ECC.Types + Crypto.PubKey.ECDSA Crypto.PubKey.ECIES Crypto.PubKey.Ed25519 Crypto.PubKey.Ed448 @@ -387,6 +388,7 @@ Test-Suite test-cryptonite BCryptPBKDF ECC ECC.Edwards25519 + ECDSA Hash Imports KAT_AES.KATCBC diff --git a/tests/ECDSA.hs b/tests/ECDSA.hs new file mode 100644 index 0000000..7d8f2a6 --- /dev/null +++ b/tests/ECDSA.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +module ECDSA (tests) where + +import qualified Crypto.ECC as ECDSA +import qualified Crypto.PubKey.ECC.ECDSA as ECC +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Crypto.PubKey.ECDSA as ECDSA +import Crypto.Hash.Algorithms +import Crypto.Error +import qualified Data.ByteString as B + +import Imports + +data Curve = forall curve. (ECDSA.EllipticCurveECDSA curve, Show (ECDSA.Scalar curve)) => Curve curve ECC.Curve ECC.CurveName + +instance Show Curve where + showsPrec d (Curve _ _ name) = showsPrec d name + +instance Arbitrary Curve where + arbitrary = elements + [ makeCurve ECDSA.Curve_P256R1 ECC.SEC_p256r1 + , makeCurve ECDSA.Curve_P384R1 ECC.SEC_p384r1 + , makeCurve ECDSA.Curve_P521R1 ECC.SEC_p521r1 + ] + where + makeCurve c name = Curve c (ECC.getCurveByName name) name + +arbitraryScalar curve = choose (1, n - 1) + where n = ECC.ecc_n (ECC.common_curve curve) + +sigECCToECDSA :: ECDSA.EllipticCurveECDSA curve + => proxy curve -> ECC.Signature -> ECDSA.Signature curve +sigECCToECDSA prx (ECC.Signature r s) = + ECDSA.Signature (throwCryptoError $ ECDSA.scalarFromInteger prx r) + (throwCryptoError $ ECDSA.scalarFromInteger prx s) + +tests = localOption (QuickCheckTests 5) $ testGroup "ECDSA" + [ testProperty "SHA1" $ propertyECDSA SHA1 + , testProperty "SHA224" $ propertyECDSA SHA224 + , testProperty "SHA256" $ propertyECDSA SHA256 + , testProperty "SHA384" $ propertyECDSA SHA384 + , testProperty "SHA512" $ propertyECDSA SHA512 + ] + where + propertyECDSA hashAlg (Curve c curve _) (ArbitraryBS0_2901 msg) = do + d <- arbitraryScalar curve + kECC <- arbitraryScalar curve + let privECC = ECC.PrivateKey curve d + prx = Just c -- using Maybe as Proxy + kECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx kECC + privECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx d + pubECDSA = ECDSA.toPublic prx privECDSA + Just sigECC = ECC.signWith kECC privECC hashAlg msg + Just sigECDSA = ECDSA.signWith prx kECDSA privECDSA hashAlg msg + sigECDSA' = sigECCToECDSA prx sigECC + msg' = msg `B.append` B.singleton 42 + return $ propertyHold [ eqTest "signature" sigECDSA sigECDSA' + , eqTest "verification" True (ECDSA.verify prx hashAlg pubECDSA sigECDSA' msg) + , eqTest "alteration" False (ECDSA.verify prx hashAlg pubECDSA sigECDSA msg') + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index 4e2a863..f379fc8 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -11,6 +11,7 @@ import qualified BCrypt import qualified BCryptPBKDF import qualified ECC import qualified ECC.Edwards25519 +import qualified ECDSA import qualified Hash import qualified Poly1305 import qualified Salsa @@ -96,6 +97,7 @@ tests = testGroup "cryptonite" , KAT_AFIS.tests , ECC.tests , ECC.Edwards25519.tests + , ECDSA.tests ] main = defaultMain tests From b9a8a6b83dc8d375e4abd1dfaf745088aed0c367 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 8 May 2019 08:18:07 +0200 Subject: [PATCH 5/6] ECDSA with digest --- Crypto/PubKey/ECDSA.hs | 63 ++++++++++++++++++++++++++++-------------- 1 file changed, 42 insertions(+), 21 deletions(-) diff --git a/Crypto/PubKey/ECDSA.hs b/Crypto/PubKey/ECDSA.hs index c1416a0..941f909 100644 --- a/Crypto/PubKey/ECDSA.hs +++ b/Crypto/PubKey/ECDSA.hs @@ -37,8 +37,11 @@ module Crypto.PubKey.ECDSA , signatureToIntegers -- * Generation and verification , signWith + , signDigestWith , sign + , signDigest , verify + , verifyDigest ) where import Control.Monad @@ -162,11 +165,11 @@ toPublic :: EllipticCurveECDSA curve => proxy curve -> PrivateKey curve -> PublicKey curve toPublic = pointBaseSmul --- | Sign message using the private key and an explicit k scalar. -signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) - => proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve) -signWith prx k d hashAlg msg = do - let z = tHash prx hashAlg msg +-- | Sign digest using the private key and an explicit k scalar. +signDigestWith :: (EllipticCurveECDSA curve, HashAlgorithm hash) + => proxy curve -> Scalar curve -> PrivateKey curve -> Digest hash -> Maybe (Signature curve) +signDigestWith prx k d digest = do + let z = tHashDigest prx digest point = pointBaseSmul prx k r <- pointX prx point kInv <- scalarInv prx k @@ -174,24 +177,34 @@ signWith prx k d hashAlg msg = do when (scalarIsZero prx r || scalarIsZero prx s) Nothing return $ Signature r s +-- | Sign message using the private key and an explicit k scalar. +signWith :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> Scalar curve -> PrivateKey curve -> hash -> msg -> Maybe (Signature curve) +signWith prx k d hashAlg msg = signDigestWith prx k d (hashWith hashAlg msg) + +-- | Sign a digest using hash and private key. +signDigest :: (EllipticCurveECDSA curve, MonadRandom m, HashAlgorithm hash) + => proxy curve -> PrivateKey curve -> Digest hash -> m (Signature curve) +signDigest prx pk digest = do + k <- curveGenerateScalar prx + case signDigestWith prx k pk digest of + Nothing -> signDigest prx pk digest + Just sig -> return sig + -- | Sign a message using hash and private key. sign :: (EllipticCurveECDSA curve, MonadRandom m, ByteArrayAccess msg, HashAlgorithm hash) => proxy curve -> PrivateKey curve -> hash -> msg -> m (Signature curve) -sign prx pk hashAlg msg = do - k <- curveGenerateScalar prx - case signWith prx k pk hashAlg msg of - Nothing -> sign prx pk hashAlg msg - Just sig -> return sig +sign prx pk hashAlg msg = signDigest prx pk (hashWith hashAlg msg) --- | Verify a signature using hash and public key. -verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) - => proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool -verify prx hashAlg q (Signature r s) msg +-- | Verify a digest using hash and public key. +verifyDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash) + => proxy curve -> PublicKey curve -> Signature curve -> Digest hash -> Bool +verifyDigest prx q (Signature r s) digest | not (scalarIsValid prx r) = False | not (scalarIsValid prx s) = False | otherwise = maybe False (r ==) $ do w <- scalarInv prx s - let z = tHash prx hashAlg msg + let z = tHashDigest prx digest u1 = scalarMul prx z w u2 = scalarMul prx r w x = pointsSmulVarTime prx u1 u2 q @@ -199,13 +212,21 @@ verify prx hashAlg q (Signature r s) msg -- Note: precondition q /= PointO is not tested because we assume -- point decoding never decodes point at infinity. --- | Truncate and hash. -tHash :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) - => proxy curve -> hash -> msg -> Scalar curve -tHash prx hashAlg m = +-- | Verify a signature using hash and public key. +verify :: (EllipticCurveECDSA curve, ByteArrayAccess msg, HashAlgorithm hash) + => proxy curve -> hash -> PublicKey curve -> Signature curve -> msg -> Bool +verify prx hashAlg q sig msg = verifyDigest prx q sig (hashWith hashAlg msg) + +-- | Truncate a digest based on curve order size. +tHashDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash) + => proxy curve -> Digest hash -> Scalar curve +tHashDigest prx digest = throwCryptoError $ scalarFromInteger prx (if d > 0 then shiftR e d else e) - where e = os2ip $ hashWith hashAlg m - d = hashDigestSize hashAlg * 8 - curveOrderBits prx + where e = os2ip digest + d = hashDigestSize (getHashAlg digest) * 8 - curveOrderBits prx + +getHashAlg :: Digest hash -> hash +getHashAlg _ = undefined ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool From 99820c742dec2b0fb808a1114a9cb09eda73e667 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 12 May 2019 08:10:11 +0200 Subject: [PATCH 6/6] Truncate the digest without Integer conversion --- Crypto/PubKey/ECDSA.hs | 36 ++++++++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/Crypto/PubKey/ECDSA.hs b/Crypto/PubKey/ECDSA.hs index 941f909..3014216 100644 --- a/Crypto/PubKey/ECDSA.hs +++ b/Crypto/PubKey/ECDSA.hs @@ -15,6 +15,7 @@ -- Signature operations with P-384 and P-521 may leak the private key. -- -- Signature verification should be safe for all curves. +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -50,16 +51,20 @@ import Crypto.ECC import qualified Crypto.ECC.Simple.Types as Simple import Crypto.Error import Crypto.Hash +import Crypto.Hash.Types import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess) import Crypto.Internal.Imports import Crypto.Number.ModArithmetic (inverseFermat) -import Crypto.Number.Serialize import qualified Crypto.PubKey.ECC.P256 as P256 import Crypto.Random.Types -import Data.Bits (shiftR) +import Data.Bits +import qualified Data.ByteArray as B import Data.Data +import Foreign.Ptr (Ptr) +import Foreign.Storable (peekByteOff, pokeByteOff) + -- | Represent a ECDSA signature namely R and S. data Signature curve = Signature { sign_r :: Scalar curve -- ^ ECDSA r @@ -220,13 +225,28 @@ verify prx hashAlg q sig msg = verifyDigest prx q sig (hashWith hashAlg msg) -- | Truncate a digest based on curve order size. tHashDigest :: (EllipticCurveECDSA curve, HashAlgorithm hash) => proxy curve -> Digest hash -> Scalar curve -tHashDigest prx digest = - throwCryptoError $ scalarFromInteger prx (if d > 0 then shiftR e d else e) - where e = os2ip digest - d = hashDigestSize (getHashAlg digest) * 8 - curveOrderBits prx +tHashDigest prx (Digest digest) = throwCryptoError $ decodeScalar prx encoded + where m = curveOrderBits prx + d = m - B.length digest * 8 + (n, r) = m `divMod` 8 + n' = if r > 0 then succ n else n -getHashAlg :: Digest hash -> hash -getHashAlg _ = undefined + encoded + | d > 0 = B.zero (n' - B.length digest) `B.append` digest + | d == 0 = digest + | r == 0 = B.take n digest + | otherwise = shiftBytes digest + + shiftBytes bs = B.allocAndFreeze n' $ \dst -> + B.withByteArray bs $ \src -> go dst src 0 0 + + go :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO () + go dst src !a i + | i >= n' = return () + | otherwise = do + b <- peekByteOff src i + pokeByteOff dst i (unsafeShiftR b (8 - r) .|. unsafeShiftL a r) + go dst src b (succ i) ecScalarIsValid :: Simple.Curve c => proxy c -> Simple.Scalar c -> Bool