diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 8391b5a..855ea60 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -8,6 +8,7 @@ -- Elliptic Curve Cryptography -- {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -21,6 +22,7 @@ module Crypto.ECC , EllipticCurve(..) , EllipticCurveDH(..) , EllipticCurveArith(..) + , EllipticCurveBasepointArith(..) , KeyPair(..) , SharedSecret(..) ) where @@ -34,7 +36,9 @@ import Crypto.Error import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) import qualified Crypto.Internal.ByteArray as B +import Crypto.Number.Basic (numBits) import Crypto.Number.Serialize (i2ospOf_, os2ip) +import qualified Crypto.Number.Serialize.LE as LE import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448 import Data.ByteArray (convert) @@ -98,7 +102,7 @@ class EllipticCurve curve => EllipticCurveDH curve where -- value or an exception. ecdh :: proxy curve -> Scalar curve -> Point curve -> CryptoFailable SharedSecret -class EllipticCurve curve => EllipticCurveArith curve where +class (EllipticCurve curve, Eq (Point curve)) => EllipticCurveArith curve where -- | Add points on a curve pointAdd :: proxy curve -> Point curve -> Point curve -> Point curve @@ -111,6 +115,35 @@ class EllipticCurve curve => EllipticCurveArith curve where -- -- | Scalar Inverse -- scalarInverse :: Scalar curve -> Scalar curve +class (EllipticCurveArith curve, Eq (Scalar curve)) => EllipticCurveBasepointArith curve where + -- | Get the curve order size in bits + curveOrderBits :: proxy curve -> Int + + -- | Multiply a scalar with the curve base point + pointBaseSmul :: proxy curve -> Scalar curve -> Point curve + + -- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@ + pointsSmulVarTime :: proxy curve -> Scalar curve -> Scalar curve -> Point curve -> Point curve + pointsSmulVarTime prx s1 s2 p = pointAdd prx (pointBaseSmul prx s1) (pointSmul prx s2 p) + + -- | Encode an elliptic curve scalar into big-endian form + encodeScalar :: ByteArray bs => proxy curve -> Scalar curve -> bs + + -- | Try to decode the big-endian form of an elliptic curve scalar + decodeScalar :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Scalar curve) + + -- | Convert an elliptic curve scalar to an integer + scalarToInteger :: proxy curve -> Scalar curve -> Integer + + -- | Try to create an elliptic curve scalar from an integer + scalarFromInteger :: proxy curve -> Integer -> CryptoFailable (Scalar curve) + + -- | Add two scalars and reduce modulo the curve order + scalarAdd :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve + + -- | Multiply two scalars and reduce modulo the curve order + scalarMul :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve + -- | P256 Curve -- -- also known as P256 @@ -133,11 +166,11 @@ instance EllipticCurve Curve_P256R1 where uncompressed = B.singleton 4 xy = P256.pointToBinary p decodePoint _ mxy = case B.uncons mxy of - Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid + Nothing -> CryptoFailed CryptoError_PointSizeInvalid Just (m,xy) -- uncompressed | m == 4 -> P256.pointFromBinary xy - | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid + | otherwise -> CryptoFailed CryptoError_PointFormatInvalid instance EllipticCurveArith Curve_P256R1 where pointAdd _ a b = P256.pointAdd a b @@ -148,6 +181,17 @@ instance EllipticCurveDH Curve_P256R1 where ecdhRaw _ s p = SharedSecret $ P256.pointDh s p ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) +instance EllipticCurveBasepointArith Curve_P256R1 where + curveOrderBits _ = 256 + pointBaseSmul _ = P256.toPoint + pointsSmulVarTime _ = P256.pointsMulVarTime + encodeScalar _ = P256.scalarToBinary + decodeScalar _ = P256.scalarFromBinary + scalarToInteger _ = P256.scalarToInteger + scalarFromInteger _ = P256.scalarFromInteger + scalarAdd _ = P256.scalarAdd + scalarMul _ = P256.scalarMul + data Curve_P384R1 = Curve_P384R1 deriving (Show,Data) @@ -171,6 +215,17 @@ instance EllipticCurveDH Curve_P384R1 where where prx = Proxy :: Proxy Simple.SEC_p384r1 +instance EllipticCurveBasepointArith Curve_P384R1 where + curveOrderBits _ = 384 + pointBaseSmul _ = Simple.pointBaseMul + pointsSmulVarTime _ = ecPointsMulVarTime + encodeScalar _ = ecScalarToBinary + decodeScalar _ = ecScalarFromBinary + scalarToInteger _ = ecScalarToInteger + scalarFromInteger _ = ecScalarFromInteger + scalarAdd _ = ecScalarAdd + scalarMul _ = ecScalarMul + data Curve_P521R1 = Curve_P521R1 deriving (Show,Data) @@ -194,6 +249,17 @@ instance EllipticCurveDH Curve_P521R1 where where prx = Proxy :: Proxy Simple.SEC_p521r1 +instance EllipticCurveBasepointArith Curve_P521R1 where + curveOrderBits _ = 521 + pointBaseSmul _ = Simple.pointBaseMul + pointsSmulVarTime _ = ecPointsMulVarTime + encodeScalar _ = ecScalarToBinary + decodeScalar _ = ecScalarFromBinary + scalarToInteger _ = ecScalarToInteger + scalarFromInteger _ = ecScalarFromInteger + scalarAdd _ = ecScalarAdd + scalarMul _ = ecScalarMul + data Curve_X25519 = Curve_X25519 deriving (Show,Data) @@ -250,6 +316,22 @@ instance EllipticCurveArith Curve_Edwards25519 where pointNegate _ p = Edwards25519.pointNegate p pointSmul _ s p = Edwards25519.pointMul s p +instance EllipticCurveBasepointArith Curve_Edwards25519 where + curveOrderBits _ = 253 + pointBaseSmul _ = Edwards25519.toPoint + pointsSmulVarTime _ = Edwards25519.pointsMulVarTime + encodeScalar _ = B.reverse . Edwards25519.scalarEncode + decodeScalar _ bs + | B.length bs == 32 = Edwards25519.scalarDecodeLong (B.reverse bs) + | otherwise = CryptoFailed CryptoError_SecretKeySizeInvalid + scalarToInteger _ s = LE.os2ip (Edwards25519.scalarEncode s :: B.Bytes) + scalarFromInteger _ i = + case LE.i2ospOf 32 i of + Nothing -> CryptoFailed CryptoError_SecretKeySizeInvalid + Just bs -> Edwards25519.scalarDecodeLong (bs :: B.Bytes) + scalarAdd _ = Edwards25519.scalarAdd + scalarMul _ = Edwards25519.scalarMul + checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret checkNonZeroDH s@(SharedSecret b) | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid @@ -271,7 +353,7 @@ encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb] decodeECPoint :: (Simple.Curve curve, ByteArray bs) => bs -> CryptoFailable (Simple.Point curve) decodeECPoint mxy = case B.uncons mxy of - Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid + Nothing -> CryptoFailed CryptoError_PointSizeInvalid Just (m,xy) -- uncompressed | m == 4 -> @@ -280,4 +362,47 @@ decodeECPoint mxy = case B.uncons mxy of x = os2ip xb y = os2ip yb in Simple.pointFromIntegers (x,y) - | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid + | otherwise -> CryptoFailed CryptoError_PointFormatInvalid + +ecPointsMulVarTime :: forall curve . Simple.Curve curve + => Simple.Scalar curve + -> Simple.Scalar curve -> Simple.Point curve + -> Simple.Point curve +ecPointsMulVarTime n1 = Simple.pointAddTwoMuls n1 g + where g = Simple.curveEccG $ Simple.curveParameters (Proxy :: Proxy curve) + +ecScalarFromBinary :: forall curve bs . (Simple.Curve curve, ByteArrayAccess bs) + => bs -> CryptoFailable (Simple.Scalar curve) +ecScalarFromBinary ba + | B.length ba /= size = CryptoFailed CryptoError_SecretKeySizeInvalid + | otherwise = CryptoPassed (Simple.Scalar $ os2ip ba) + where size = ecCurveOrderBytes (Proxy :: Proxy curve) + +ecScalarToBinary :: forall curve bs . (Simple.Curve curve, ByteArray bs) + => Simple.Scalar curve -> bs +ecScalarToBinary (Simple.Scalar s) = i2ospOf_ size s + where size = ecCurveOrderBytes (Proxy :: Proxy curve) + +ecScalarFromInteger :: forall curve . Simple.Curve curve + => Integer -> CryptoFailable (Simple.Scalar curve) +ecScalarFromInteger s + | numBits s > nb = CryptoFailed CryptoError_SecretKeySizeInvalid + | otherwise = CryptoPassed (Simple.Scalar s) + where nb = 8 * ecCurveOrderBytes (Proxy :: Proxy curve) + +ecScalarToInteger :: Simple.Scalar curve -> Integer +ecScalarToInteger (Simple.Scalar s) = s + +ecCurveOrderBytes :: Simple.Curve c => proxy c -> Int +ecCurveOrderBytes prx = (numBits n + 7) `div` 8 + where n = Simple.curveEccN $ Simple.curveParameters prx + +ecScalarAdd :: forall curve . Simple.Curve curve + => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve +ecScalarAdd (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a + b) `mod` n) + where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve) + +ecScalarMul :: forall curve . Simple.Curve curve + => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve +ecScalarMul (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a * b) `mod` n) + where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 3c350cd..6edd8dd 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -34,6 +34,7 @@ module Crypto.PubKey.ECC.P256 , scalarIsZero , scalarAdd , scalarSub + , scalarMul , scalarInv , scalarCmp , scalarFromBinary @@ -109,7 +110,7 @@ pointAdd a b = withNewPoint $ \dx dy -> -- | Negate a point pointNegate :: Point -> Point pointNegate a = withNewPoint $ \dx dy -> - withPoint a $ \ax ay -> do + withPoint a $ \ax ay -> ccryptonite_p256e_point_negate ax ay dx dy -- | Multiply a point by a scalar @@ -187,12 +188,12 @@ pointFromBinary ba = unsafePointFromBinary ba >>= validatePoint validatePoint :: Point -> CryptoFailable Point validatePoint p | pointIsValid p = CryptoPassed p - | otherwise = CryptoFailed $ CryptoError_PointCoordinatesInvalid + | otherwise = CryptoFailed CryptoError_PointCoordinatesInvalid -- | Convert from binary to a point, possibly invalid unsafePointFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Point unsafePointFromBinary ba - | B.length ba /= pointSize = CryptoFailed $ CryptoError_PublicKeySizeInvalid + | B.length ba /= pointSize = CryptoFailed CryptoError_PublicKeySizeInvalid | otherwise = CryptoPassed $ withNewPoint $ \px py -> B.withByteArray ba $ \src -> do ccryptonite_p256_from_bin src (castPtr px) @@ -237,6 +238,14 @@ scalarSub a b = withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> ccryptonite_p256e_modsub ccryptonite_SECP256r1_n pa pb d +-- | Perform multiplication between two scalars +-- +-- > a * b +scalarMul :: Scalar -> Scalar -> Scalar +scalarMul a b = + withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> + ccryptonite_p256_modmul ccryptonite_SECP256r1_n pa 0 pb d + -- | Give the inverse of the scalar -- -- > 1 / a @@ -257,7 +266,7 @@ scalarCmp a b = unsafeDoIO $ -- | convert a scalar from binary scalarFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Scalar scalarFromBinary ba - | B.length ba /= scalarSize = CryptoFailed $ CryptoError_SecretKeySizeInvalid + | B.length ba /= scalarSize = CryptoFailed CryptoError_SecretKeySizeInvalid | otherwise = CryptoPassed $ withNewScalarFreeze $ \p -> B.withByteArray ba $ \b -> ccryptonite_p256_from_bin b p diff --git a/tests/ECC.hs b/tests/ECC.hs index c00dedc..5faaf81 100644 --- a/tests/ECC.hs +++ b/tests/ECC.hs @@ -24,6 +24,19 @@ instance Arbitrary Curve where , Curve ECC.Curve_X448 ] +data CurveArith = forall curve. (ECC.EllipticCurveBasepointArith curve, Show curve) => CurveArith curve + +instance Show CurveArith where + showsPrec d (CurveArith curve) = showsPrec d curve + +instance Arbitrary CurveArith where + arbitrary = elements + [ CurveArith ECC.Curve_P256R1 + , CurveArith ECC.Curve_P384R1 + , CurveArith ECC.Curve_P521R1 + , CurveArith ECC.Curve_Edwards25519 + ] + data VectorPoint = VectorPoint { vpCurve :: Curve , vpHex :: ByteString @@ -280,7 +293,7 @@ tests = testGroup "ECC" [ testGroup "decodePoint" $ map doPointDecodeTest (zip [katZero..] vectorsPoint) , testGroup "ECDH weak points" $ map doWeakPointECDHTest (zip [katZero..] vectorsWeakPoint) , testGroup "property" - [ testProperty "decodePoint.encodePoint==id" $ \testDRG (Curve curve) -> do + [ testProperty "decodePoint.encodePoint==id" $ \testDRG (Curve curve) -> let prx = Just curve -- using Maybe as Proxy keyPair = withTestDRG testDRG $ ECC.curveGenerateKeyPair prx p1 = ECC.keypairGetPublic keyPair @@ -298,5 +311,33 @@ tests = testGroup "ECC" bobShared' = ECC.ecdhRaw prx (ECC.keypairGetPrivate bob) (ECC.keypairGetPublic alice) in aliceShared == bobShared && aliceShared == CryptoPassed aliceShared' && bobShared == CryptoPassed bobShared' + , testProperty "decodeScalar.encodeScalar==id" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + s1 = withTestDRG testDRG $ ECC.curveGenerateScalar prx + bs = ECC.encodeScalar prx s1 :: ByteString + s2 = ECC.decodeScalar prx bs + in CryptoPassed s1 == s2 + , testProperty "scalarFromInteger.scalarToInteger==id" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + s1 = withTestDRG testDRG $ ECC.curveGenerateScalar prx + bs = ECC.scalarToInteger prx s1 + s2 = ECC.scalarFromInteger prx bs + in CryptoPassed s1 == s2 + , localOption (QuickCheckTests 20) $ testProperty "(a + b).P = a.P + b.P" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + (s, a, b) = withTestDRG testDRG $ + (,,) <$> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + p = ECC.pointBaseSmul prx s + in ECC.pointSmul prx (ECC.scalarAdd prx a b) p == ECC.pointAdd prx (ECC.pointSmul prx a p) (ECC.pointSmul prx b p) + , localOption (QuickCheckTests 20) $ testProperty "(a * b).P = a.(b.P)" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + (s, a, b) = withTestDRG testDRG $ + (,,) <$> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + p = ECC.pointBaseSmul prx s + in ECC.pointSmul prx (ECC.scalarMul prx a b) p == ECC.pointSmul prx a (ECC.pointSmul prx b p) ] ] diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index c570548..7dd508e 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -54,6 +54,9 @@ unP256Scalar (P256Scalar r) = unP256 :: P256Scalar -> Integer unP256 (P256Scalar r) = r +modP256Scalar :: P256Scalar -> P256Scalar +modP256Scalar (P256Scalar r) = P256Scalar (r `mod` curveN) + p256ScalarToInteger :: P256.Scalar -> Integer p256ScalarToInteger s = os2ip (P256.scalarToBinary s :: Bytes) @@ -92,6 +95,10 @@ tests = testGroup "P256" let v = unP256 r `mod` curveN v' = P256.scalarSub (unP256Scalar r) P256.scalarZero in v `propertyEq` p256ScalarToInteger v' + , testProperty "mul" $ \r1 r2 -> + let r = (unP256 r1 * unP256 r2) `mod` curveN + r' = P256.scalarMul (unP256Scalar r1) (unP256Scalar r2) + in r `propertyEq` p256ScalarToInteger r' , testProperty "inv" $ \r' -> let inv = inverseCoprimes (unP256 r') curveN inv' = P256.scalarInv (unP256Scalar r') @@ -115,9 +122,10 @@ tests = testGroup "P256" t = P256.pointFromIntegers (xT, yT) r = P256.pointFromIntegers (xR, yR) in r @=? P256.pointAdd s t - , testProperty "lift-to-curve" $ propertyLiftToCurve - , testProperty "point-add" $ propertyPointAdd - , testProperty "point-negate" $ propertyPointNegate + , testProperty "lift-to-curve" propertyLiftToCurve + , testProperty "point-add" propertyPointAdd + , testProperty "point-negate" propertyPointNegate + , testProperty "point-mul" propertyPointMul ] ] where @@ -146,4 +154,15 @@ tests = testGroup "P256" let p = P256.toPoint (unP256Scalar r) pe = ECC.pointMul curve (unP256 r) curveGen pR = P256.pointNegate p - in ECC.pointNegate curve pe `propertyEq` (pointP256ToECC pR) + in ECC.pointNegate curve pe `propertyEq` pointP256ToECC pR + + propertyPointMul s' r' = + let s = modP256Scalar s' + r = modP256Scalar r' + p = P256.toPoint (unP256Scalar r) + pe = ECC.pointMul curve (unP256 r) curveGen + pR = P256.toPoint (P256.scalarMul (unP256Scalar s) (unP256Scalar r)) + peR = ECC.pointMul curve (unP256 s) pe + in propertyHold [ eqTest "p256" pR (P256.pointMul (unP256Scalar s) p) + , eqTest "ecc" peR (pointP256ToECC pR) + ]