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

@@ -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

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/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