From 8e274f8e6096b144d5e0be9da72d4db9120abf65 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 25 Jun 2017 17:11:45 +0200 Subject: [PATCH 1/5] Validate output point when calling P256.pointFromBinary Function unsafePointFromBinary is added when validation is not needed. --- Crypto/ECC.hs | 7 +------ Crypto/PubKey/ECC/P256.hs | 14 ++++++++++++-- tests/KAT_PubKey/P256.hs | 2 +- 3 files changed, 14 insertions(+), 9 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index ea4d153..02e1777 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -118,7 +118,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 @@ -210,11 +210,6 @@ instance EllipticCurveDH Curve_X448 where ecdh _ s p = SharedSecret $ convert secret where secret = X448.dh p s -validateP256Point :: P256.Point -> CryptoFailable P256.Point -validateP256Point p - | P256.pointIsValid p = CryptoPassed p - | otherwise = CryptoFailed $ CryptoError_PointCoordinatesInvalid - encodeECPoint :: forall curve bs . (Simple.Curve curve, ByteArray bs) => Simple.Point curve -> bs encodeECPoint Simple.PointO = error "encodeECPoint: cannot serialize point at infinity" encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb] diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 4708985..ba9ac60 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -26,6 +26,7 @@ module Crypto.PubKey.ECC.P256 , pointFromIntegers , pointToBinary , pointFromBinary + , unsafePointFromBinary -- * scalar arithmetic , scalarGenerate , scalarZero @@ -172,9 +173,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 diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index 9549564..6b6d279 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/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) From adc192ac17777014d851c9b6fe390f534c104fe2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 25 Jun 2017 17:11:47 +0200 Subject: [PATCH 2/5] Add constAllZero --- Crypto/Internal/ByteArray.hs | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/Crypto/Internal/ByteArray.hs b/Crypto/Internal/ByteArray.hs index 3a23152..57ab57a 100644 --- a/Crypto/Internal/ByteArray.hs +++ b/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 From aec6af5de40f39acbac48b427fce28a9e25465fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Tue, 4 Jul 2017 21:39:01 +0200 Subject: [PATCH 3/5] Add note about P256 encoding of point-at-infinity --- Crypto/PubKey/ECC/P256.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index ba9ac60..1409c91 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -114,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 From 9b5668988531bc4998896b8225115fbedb6c5f45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 5 Jul 2017 22:08:54 +0200 Subject: [PATCH 4/5] Check that ECDH and ECIES result is not point-at-infinity This guards against invalid public keys when curves have a cofactor. Fixes #178 --- Crypto/ECC.hs | 47 ++++++++++++++++++++++++++++++------------ Crypto/Error/Types.hs | 1 + Crypto/PubKey/ECIES.hs | 7 ++++--- 3 files changed, 39 insertions(+), 16 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 02e1777..576247d 100644 --- a/Crypto/ECC.hs +++ b/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 @@ -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 - Simple.Point x _ = pointSmul prx s p + prx = Proxy :: Proxy Simple.SEC_p384r1 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 - Simple.Point x _ = pointSmul prx s p + prx = Proxy :: Proxy Simple.SEC_p521r1 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,8 +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) + +checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret +checkNonZeroDH s@(SharedSecret b) + | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid + | 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" @@ -232,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 diff --git a/Crypto/Error/Types.hs b/Crypto/Error/Types.hs index fd0e9c4..8cce985 100644 --- a/Crypto/Error/Types.hs +++ b/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 diff --git a/Crypto/PubKey/ECIES.hs b/Crypto/PubKey/ECIES.hs index cd3aac8..7c9c3aa 100644 --- a/Crypto/PubKey/ECIES.hs +++ b/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 From 5c4458d626c02fce1c6d74ed508c72aeef43720c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Wed, 5 Jul 2017 22:17:24 +0200 Subject: [PATCH 5/5] Test ECC functions ecdh and ecdhRaw --- tests/ECC.hs | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 69 insertions(+), 1 deletion(-) diff --git a/tests/ECC.hs b/tests/ECC.hs index 385ea53..e16e4de 100644 --- a/tests/ECC.hs +++ b/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' ] ]