Merge pull request #299 from ocheron/ecc-scalar-ext

Extended ECC type class

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)

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

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)
         ]
     ]

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 "lift-to-curve" propertyLiftToCurve
-        , testProperty "point-add" $ propertyPointAdd
+        , testProperty "point-add" propertyPointAdd
-        , testProperty "point-negate" $ propertyPointNegate
+        , 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)
+                         ]