Merge pull request #179 from ocheron/ec-point-validation

Validate result of P256.pointFromBinary and EllipticCurveDH.ecdh

Crypto/ECC.hs

@@ -81,7 +81,21 @@ class EllipticCurve curve => EllipticCurveDH curve where
     -- is not hashed.
     --
     -- use `pointSmul` to keep the result in Point format.
-    ecdh :: proxy curve -> Scalar curve -> Point curve -> SharedSecret
+    --
+    -- /WARNING:/ Curve implementations may return a special value or an
+    -- exception when the public point lies in a subgroup of small order.
+    -- This function is adequate when the scalar is in expected range and
+    -- contributory behaviour is not needed.  Otherwise use 'ecdh'.
+    ecdhRaw :: proxy curve -> Scalar curve -> Point curve -> SharedSecret
+    ecdhRaw prx s = throwCryptoError . ecdh prx s
+
+    -- | Generate a Diffie hellman secret value and verify that the result
+    -- is not the point at infinity.
+    --
+    -- This additional test avoids risks existing with function 'ecdhRaw'.
+    -- Implementations always return a 'CryptoError' instead of a special
+    -- value or an exception.
+    ecdh :: proxy curve -> Scalar curve -> Point curve -> CryptoFailable SharedSecret
 
 class EllipticCurve curve => EllipticCurveArith curve where
     -- | Add points on a curve
@@ -118,7 +132,7 @@ instance EllipticCurve Curve_P256R1 where
         Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid
         Just (m,xy)
             -- uncompressed
-            | m == 4 -> P256.pointFromBinary xy >>= validateP256Point
+            | m == 4 -> P256.pointFromBinary xy
             | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid
 
 instance EllipticCurveArith Curve_P256R1 where
@@ -126,7 +140,8 @@ instance EllipticCurveArith Curve_P256R1 where
     pointSmul _ s p = P256.pointMul s p
 
 instance EllipticCurveDH Curve_P256R1 where
-    ecdh _ s p = SharedSecret $ P256.pointDh s p
+    ecdhRaw _ s p = SharedSecret $ P256.pointDh s p
+    ecdh  prx s p = checkNonZeroDH (ecdhRaw prx s p)
 
 data Curve_P384R1 = Curve_P384R1
     deriving (Show,Data,Typeable)
@@ -146,10 +161,9 @@ instance EllipticCurveArith Curve_P384R1 where
     pointSmul _ s p = Simple.pointMul s p
 
 instance EllipticCurveDH Curve_P384R1 where
-    ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x
+    ecdh _ s p = encodeECShared prx (Simple.pointMul s p)
       where
-        prx = Proxy :: Proxy Curve_P384R1
+        prx = Proxy :: Proxy Simple.SEC_p384r1
-        Simple.Point x _ = pointSmul prx s p
 
 data Curve_P521R1 = Curve_P521R1
     deriving (Show,Data,Typeable)
@@ -169,10 +183,9 @@ instance EllipticCurveArith Curve_P521R1 where
     pointSmul _ s p = Simple.pointMul s p
 
 instance EllipticCurveDH Curve_P521R1 where
-    ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x
+    ecdh _ s p = encodeECShared prx (Simple.pointMul s p)
       where
-        prx = Proxy :: Proxy Curve_P521R1
+        prx = Proxy :: Proxy Simple.SEC_p521r1
-        Simple.Point x _ = pointSmul prx s p
 
 data Curve_X25519 = Curve_X25519
     deriving (Show,Data,Typeable)
@@ -189,8 +202,9 @@ instance EllipticCurve Curve_X25519 where
     decodePoint _ bs = X25519.publicKey bs
 
 instance EllipticCurveDH Curve_X25519 where
-    ecdh _ s p = SharedSecret $ convert secret
+    ecdhRaw _ s p = SharedSecret $ convert secret
       where secret = X25519.dh p s
+    ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p)
 
 data Curve_X448 = Curve_X448
     deriving (Show,Data,Typeable)
@@ -207,13 +221,18 @@ instance EllipticCurve Curve_X448 where
     decodePoint _ bs = X448.publicKey bs
 
 instance EllipticCurveDH Curve_X448 where
-    ecdh _ s p = SharedSecret $ convert secret
+    ecdhRaw _ s p = SharedSecret $ convert secret
       where secret = X448.dh p s
+    ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p)
 
-validateP256Point :: P256.Point -> CryptoFailable P256.Point
+checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret
-validateP256Point p
+checkNonZeroDH s@(SharedSecret b)
-    | P256.pointIsValid p = CryptoPassed p
+    | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid
-    | otherwise           = CryptoFailed $ CryptoError_PointCoordinatesInvalid
+    | otherwise        = CryptoPassed s
+
+encodeECShared :: Simple.Curve curve => Proxy curve -> Simple.Point curve -> CryptoFailable SharedSecret
+encodeECShared _   Simple.PointO      = CryptoFailed CryptoError_ScalarMultiplicationInvalid
+encodeECShared prx (Simple.Point x _) = CryptoPassed . SharedSecret $ i2ospOf_ (Simple.curveSizeBytes prx) x
 
 encodeECPoint :: forall curve bs . (Simple.Curve curve, ByteArray bs) => Simple.Point curve -> bs
 encodeECPoint Simple.PointO      = error "encodeECPoint: cannot serialize point at infinity"
@@ -237,6 +256,3 @@ decodeECPoint mxy = case B.uncons mxy of
                 y = os2ip yb
              in Simple.pointFromIntegers (x,y)
         | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid
-
-curveSizeBytes :: EllipticCurve c => Proxy c -> Int
-curveSizeBytes proxy = (curveSizeBits proxy + 7) `div` 8

Crypto/Error/Types.hs

@@ -40,6 +40,7 @@ data CryptoError =
     | CryptoError_PointFormatInvalid
     | CryptoError_PointFormatUnsupported
     | CryptoError_PointCoordinatesInvalid
+    | CryptoError_ScalarMultiplicationInvalid
     -- Message authentification error
     | CryptoError_MacKeyInvalid
     | CryptoError_AuthenticationTagSizeInvalid

Crypto/Internal/ByteArray.hs

@@ -7,13 +7,33 @@
 --
 -- Simple and efficient byte array types
 --
+{-# LANGUAGE BangPatterns #-}
 {-# OPTIONS_HADDOCK hide #-}
 module Crypto.Internal.ByteArray
     ( module Data.ByteArray
     , module Data.ByteArray.Mapping
     , module Data.ByteArray.Encoding
+    , constAllZero
     ) where
 
 import Data.ByteArray
 import Data.ByteArray.Mapping
 import Data.ByteArray.Encoding
+
+import Data.Bits ((.|.))
+import Data.Word (Word8)
+import Foreign.Ptr (Ptr)
+import Foreign.Storable (peekByteOff)
+
+import Crypto.Internal.Compat (unsafeDoIO)
+
+constAllZero :: ByteArrayAccess ba => ba -> Bool
+constAllZero b = unsafeDoIO $ withByteArray b $ \p -> loop p 0 0
+  where
+    loop :: Ptr b -> Int -> Word8 -> IO Bool
+    loop p i !acc
+        | i == len  = return $! acc == 0
+        | otherwise = do
+            e <- peekByteOff p i
+            loop p (i+1) (acc .|. e)
+    len = Data.ByteArray.length b

Crypto/PubKey/ECC/P256.hs

@@ -26,6 +26,7 @@ module Crypto.PubKey.ECC.P256
     , pointFromIntegers
     , pointToBinary
     , pointFromBinary
+    , unsafePointFromBinary
     -- * scalar arithmetic
     , scalarGenerate
     , scalarZero
@@ -113,7 +114,8 @@ pointMul scalar p = withNewPoint $ \dx dy ->
     withScalar scalar $ \n -> withPoint p $ \px py -> withScalarZero $ \nzero ->
         ccryptonite_p256_points_mul_vartime nzero n px py dx dy
 
--- | Similar to 'pointMul', serializing the x coordinate as binary
+-- | Similar to 'pointMul', serializing the x coordinate as binary.
+-- When scalar is multiple of point order the result is all zero.
 pointDh :: ByteArray binary => Scalar -> Point -> binary
 pointDh scalar p =
     B.unsafeCreate scalarSize $ \dst -> withTempPoint $ \dx dy -> do
@@ -172,9 +174,18 @@ pointToBinary p = B.unsafeCreate pointSize $ \dst -> withPoint p $ \px py -> do
     ccryptonite_p256_to_bin (castPtr px) dst
     ccryptonite_p256_to_bin (castPtr py) (dst `plusPtr` 32)
 
--- | Convert from binary to a point
+-- | Convert from binary to a valid point
 pointFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Point
-pointFromBinary ba
+pointFromBinary ba = unsafePointFromBinary ba >>= validatePoint
+  where
+    validatePoint :: Point -> CryptoFailable Point
+    validatePoint p
+        | pointIsValid p = CryptoPassed p
+        | 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
     | otherwise                =
         CryptoPassed $ withNewPoint $ \px py -> B.withByteArray ba $ \src -> do

Crypto/PubKey/ECIES.hs

@@ -25,6 +25,7 @@ module Crypto.PubKey.ECIES
     ) where
 
 import           Crypto.ECC
+import           Crypto.Error
 import           Crypto.Random
 import           Crypto.Internal.Proxy
 
@@ -33,10 +34,10 @@ import           Crypto.Internal.Proxy
 deriveEncrypt :: (MonadRandom randomly, EllipticCurveDH curve)
               => proxy curve -- ^ representation of the curve
               -> Point curve -- ^ the public key of the receiver
-              -> randomly (Point curve, SharedSecret)
+              -> randomly (CryptoFailable (Point curve, SharedSecret))
 deriveEncrypt proxy pub = do
     (KeyPair rPoint rScalar) <- curveGenerateKeyPair proxy
-    return (rPoint, ecdh proxy rScalar pub)
+    return $ (\s -> (rPoint, s)) `fmap` ecdh proxy rScalar pub
 
 -- | Derive the shared secret with the receiver key
 -- and the R point of the scheme.
@@ -44,5 +45,5 @@ deriveDecrypt :: EllipticCurveDH curve
               => proxy curve  -- ^ representation of the curve
               -> Point curve  -- ^ The received R (supposedly, randomly generated on the encrypt side)
               -> Scalar curve -- ^ The secret key of the receiver
-              -> SharedSecret
+              -> CryptoFailable SharedSecret
 deriveDecrypt proxy point secret = ecdh proxy secret point

tests/ECC.hs

@@ -11,7 +11,7 @@ import           Data.ByteString (ByteString)
 
 import Imports
 
-data Curve = forall curve. (ECC.EllipticCurve curve, Show curve, Eq (ECC.Point curve)) => Curve curve
+data Curve = forall curve. (ECC.EllipticCurveDH curve, Show curve, Eq (ECC.Point curve)) => Curve curve
 
 instance Show Curve where
     showsPrec d (Curve curve) = showsPrec d curve
@@ -209,6 +209,54 @@ vectorsPoint =
         }
     ]
 
+vectorsWeakPoint =
+    [ VectorPoint
+        { vpCurve = Curve ECC.Curve_X25519
+        , vpHex   = "0000000000000000000000000000000000000000000000000000000000000000"
+        , vpError = Just CryptoError_ScalarMultiplicationInvalid
+        }
+    , VectorPoint
+        { vpCurve = Curve ECC.Curve_X25519
+        , vpHex   = "0100000000000000000000000000000000000000000000000000000000000000"
+        , vpError = Just CryptoError_ScalarMultiplicationInvalid
+        }
+    , VectorPoint
+        { vpCurve = Curve ECC.Curve_X25519
+        , vpHex   = "e0eb7a7c3b41b8ae1656e3faf19fc46ada098deb9c32b1fd866205165f49b800"
+        , vpError = Just CryptoError_ScalarMultiplicationInvalid
+        }
+    , VectorPoint
+        { vpCurve = Curve ECC.Curve_X25519
+        , vpHex   = "5f9c95bca3508c24b1d0b1559c83ef5b04445cc4581c8e86d8224eddd09f1157"
+        , vpError = Just CryptoError_ScalarMultiplicationInvalid
+        }
+    , VectorPoint
+        { vpCurve = Curve ECC.Curve_X25519
+        , vpHex   = "ecffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7f"
+        , vpError = Just CryptoError_ScalarMultiplicationInvalid
+        }
+    , VectorPoint
+        { vpCurve = Curve ECC.Curve_X25519
+        , vpHex   = "edffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7f"
+        , vpError = Just CryptoError_ScalarMultiplicationInvalid
+        }
+    , VectorPoint
+        { vpCurve = Curve ECC.Curve_X25519
+        , vpHex   = "eeffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7f"
+        , vpError = Just CryptoError_ScalarMultiplicationInvalid
+        }
+    , VectorPoint
+        { vpCurve = Curve ECC.Curve_X448
+        , vpHex   = "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+        , vpError = Just CryptoError_ScalarMultiplicationInvalid
+        }
+    , VectorPoint
+        { vpCurve = Curve ECC.Curve_X448
+        , vpHex   = "0100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
+        , vpError = Just CryptoError_ScalarMultiplicationInvalid
+        }
+    ]
+
 vpEncodedPoint :: VectorPoint -> ByteString
 vpEncodedPoint vector = let Right bs = convertFromBase Base16 (vpHex vector) in bs
 
@@ -221,8 +269,17 @@ doPointDecodeTest (i, vector) =
             let prx = Just curve -- using Maybe as Proxy
              in testCase (show i) (vpError vector @=? cryptoError (ECC.decodePoint prx $ vpEncodedPoint vector))
 
+doWeakPointECDHTest (i, vector) =
+    case vpCurve vector of
+        Curve curve -> testCase (show i) $ do
+            let prx = Just curve -- using Maybe as Proxy
+                CryptoPassed public = ECC.decodePoint prx $ vpEncodedPoint vector
+            keyPair <- ECC.curveGenerateKeyPair prx
+            vpError vector @=? cryptoError (ECC.ecdh prx (ECC.keypairGetPrivate keyPair) public)
+
 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
             let prx = Just curve -- using Maybe as Proxy
@@ -231,5 +288,16 @@ tests = testGroup "ECC"
                 bs = ECC.encodePoint prx p1 :: ByteString
                 p2 = ECC.decodePoint prx bs
              in CryptoPassed p1 == p2
+        , localOption (QuickCheckTests 20) $ testProperty "ECDH commutes" $ \testDRG (Curve curve) ->
+            let prx = Just curve -- using Maybe as Proxy
+                (alice, bob) = withTestDRG testDRG $
+                                   (,) <$> ECC.curveGenerateKeyPair prx
+                                       <*> ECC.curveGenerateKeyPair prx
+                aliceShared  = ECC.ecdh    prx (ECC.keypairGetPrivate alice) (ECC.keypairGetPublic bob)
+                bobShared    = ECC.ecdh    prx (ECC.keypairGetPrivate bob) (ECC.keypairGetPublic alice)
+                aliceShared' = ECC.ecdhRaw prx (ECC.keypairGetPrivate alice) (ECC.keypairGetPublic bob)
+                bobShared'   = ECC.ecdhRaw prx (ECC.keypairGetPrivate bob) (ECC.keypairGetPublic alice)
+             in aliceShared == bobShared && aliceShared == CryptoPassed aliceShared'
+                                         && bobShared   == CryptoPassed bobShared'
         ]
     ]

tests/KAT_PubKey/P256.hs

@@ -97,7 +97,7 @@ tests = testGroup "P256"
         [ testProperty "marshalling" $ \rx ry ->
             let p = P256.pointFromIntegers (unP256 rx, unP256 ry)
                 b = P256.pointToBinary p :: Bytes
-                p' = P256.pointFromBinary b
+                p' = P256.unsafePointFromBinary b
              in propertyHold [ eqTest "point" (CryptoPassed p) p' ]
         , testProperty "marshalling-integer" $ \rx ry ->
             let p = P256.pointFromIntegers (unP256 rx, unP256 ry)