ECDSA with Public Key Recovery

Crypto/Number/F2m.hs

@@ -20,10 +20,11 @@ module Crypto.Number.F2m (
     sqrtF2m,
     invF2m,
     divF2m,
+    quadraticF2m,
 ) where
 
 import Crypto.Number.Basic
-import Data.Bits (setBit, shift, testBit, xor)
+import Data.Bits (setBit, shift, testBit, xor, unsafeShiftR)
 import Data.List
 
 -- | Binary Polynomial represented by an integer
@@ -209,3 +210,18 @@ divF2m
     -- ^ Quotient
 divF2m fx n1 n2 = mulF2m fx n1 <$> invF2m fx n2
 {-# INLINE divF2m #-}
+
+traceF2m :: BinaryPolynomial -> Integer -> Integer
+traceF2m fx = foldr addF2m 0 . take (log2 fx) . iterate (squareF2m fx)
+{-# INLINE traceF2m #-}
+
+halfTraceF2m :: BinaryPolynomial -> Integer -> Integer
+halfTraceF2m fx = foldr addF2m 0 . take (1 + log2 fx `unsafeShiftR` 1) . iterate (squareF2m fx . squareF2m fx)
+{-# INLINE halfTraceF2m #-}
+
+-- | Solve a quadratic equation of the form @x^2 + x = a@ in F₂m.
+quadraticF2m :: BinaryPolynomial -> Integer -> Maybe Integer
+quadraticF2m fx a
+    | traceF2m fx a == 0 = Just $ halfTraceF2m fx a
+    | otherwise = Nothing
+{-# INLINABLE quadraticF2m #-}

Crypto/PubKey/ECC/ECDSA.hs

@@ -4,6 +4,7 @@
 -- should be safe.
 module Crypto.PubKey.ECC.ECDSA (
     Signature (..),
+    ExtendedSignature (..),
     PublicPoint,
     PublicKey (..),
     PrivateNumber,
@@ -13,10 +14,14 @@ module Crypto.PubKey.ECC.ECDSA (
     toPrivateKey,
     signWith,
     signDigestWith,
+    signExtendedDigestWith,
     sign,
     signDigest,
+    signExtendedDigest,
     verify,
     verifyDigest,
+    recover,
+    recoverDigest,
 ) where
 
 import Control.Monad
@@ -40,6 +45,17 @@ data Signature = Signature
     }
     deriving (Show, Read, Eq, Data)
 
+-- | ECDSA signature with public key recovery information.
+data ExtendedSignature = ExtendedSignature
+    { index :: Integer
+    -- ^ Index of the X coordinate
+    , parity :: Bool
+    -- ^ Parity of the Y coordinate
+    , signature :: Signature
+    -- ^ Inner signature
+    }
+    deriving (Show, Read, Eq, Data)
+
 -- | ECDSA Private Key.
 data PrivateKey = PrivateKey
     { private_curve :: Curve
@@ -69,26 +85,37 @@ toPrivateKey (KeyPair curve _ priv) = PrivateKey curve priv
 -- | Sign digest using the private key and an explicit k number.
 --
 -- /WARNING:/ Vulnerable to timing attacks.
-signDigestWith
+signExtendedDigestWith
     :: HashAlgorithm hash
     => Integer
     -- ^ k random number
     -> PrivateKey
     -- ^ private key
     -> Digest hash
     -- ^ digest to sign
-    -> Maybe Signature
-signDigestWith k (PrivateKey curve d) digest = do
+    -> Maybe ExtendedSignature
+signExtendedDigestWith k (PrivateKey curve d) digest = do
     let z = dsaTruncHashDigest digest n
         CurveCommon _ _ g n _ = common_curve curve
-    let point = pointMul curve k g
-    r <- case point of
-        PointO -> Nothing
-        Point x _ -> return $ x `mod` n
+    (i, r, p) <- pointDecompose curve $ pointMul curve k g
     kInv <- inverse k n
     let s = kInv * (z + r * d) `mod` n
     when (r == 0 || s == 0) Nothing
-    return $ Signature r s
+    return $ ExtendedSignature i p $ Signature r s
+
+-- | Sign digest using the private key and an explicit k number.
+--
+-- /WARNING:/ Vulnerable to timing attacks.
+signDigestWith
+    :: HashAlgorithm hash
+    => Integer
+    -- ^ k random number
+    -> PrivateKey
+    -- ^ private key
+    -> Digest hash
+    -- ^ digest to sign
+    -> Maybe Signature
+signDigestWith k pk digest = signature <$> signExtendedDigestWith k pk digest
 
 -- | Sign message using the private key and an explicit k number.
 --
@@ -109,17 +136,25 @@ signWith k pk hashAlg msg = signDigestWith k pk (hashWith hashAlg msg)
 -- | Sign digest using the private key.
 --
 -- /WARNING:/ Vulnerable to timing attacks.
-signDigest
+signExtendedDigest
     :: (HashAlgorithm hash, MonadRandom m)
-    => PrivateKey -> Digest hash -> m Signature
-signDigest pk digest = do
+    => PrivateKey -> Digest hash -> m ExtendedSignature
+signExtendedDigest pk digest = do
     k <- generateBetween 1 (n - 1)
-    case signDigestWith k pk digest of
-        Nothing -> signDigest pk digest
+    case signExtendedDigestWith k pk digest of
+        Nothing -> signExtendedDigest pk digest
         Just sig -> return sig
   where
     n = ecc_n . common_curve $ private_curve pk
 
+-- | Sign digest using the private key.
+--
+-- /WARNING:/ Vulnerable to timing attacks.
+signDigest
+    :: (HashAlgorithm hash, MonadRandom m)
+    => PrivateKey -> Digest hash -> m Signature
+signDigest pk digest = signature <$> signExtendedDigest pk digest
+
 -- | Sign message using the private key.
 --
 -- /WARNING:/ Vulnerable to timing attacks.
@@ -153,3 +188,20 @@ verify
     :: (ByteArrayAccess msg, HashAlgorithm hash)
     => hash -> PublicKey -> Signature -> msg -> Bool
 verify hashAlg pk sig msg = verifyDigest pk sig (hashWith hashAlg msg)
+
+-- | Recover the public key from an extended signature and a digest.
+recoverDigest
+    :: HashAlgorithm hash
+    => Curve -> ExtendedSignature -> Digest hash -> Maybe PublicKey
+recoverDigest curve (ExtendedSignature i p (Signature r s)) digest = do
+    let CurveCommon _ _ g n _ = common_curve curve
+    let z = dsaTruncHashDigest digest n
+    w <- inverse r n
+    c <- pointCompose curve i r p
+    pure $ PublicKey curve $ pointAddTwoMuls curve (s * w) c (negate $ z * w) g
+
+-- | Recover the public key from an extended signature and a message.
+recover
+    :: (ByteArrayAccess msg, HashAlgorithm hash)
+    => hash -> Curve -> ExtendedSignature -> msg -> Maybe PublicKey
+recover hashAlg curve sig msg = recoverDigest curve sig $ hashWith hashAlg msg

Crypto/PubKey/ECC/Prim.hs

@@ -9,6 +9,8 @@ module Crypto.PubKey.ECC.Prim (
     pointBaseMul,
     pointMul,
     pointAddTwoMuls,
+    pointDecompose,
+    pointCompose,
     isPointAtInfinity,
     isPointValid,
 ) where
@@ -138,6 +140,38 @@ pointAddTwoMuls c n1 p1 n2 p2
                 (False, True) -> pointAdd c p2 q
                 (False, False) -> q
 
+-- | Decompose a point into index, residue, and parity.
+--
+-- Adapted from SEC 1: Elliptic Curve Cryptography, Version 2.0, section 2.3.3.
+pointDecompose :: Curve -> Point -> Maybe (Integer, Integer, Bool)
+pointDecompose _ PointO = Nothing
+pointDecompose curve (Point x y) = do
+    let CurveCommon _ _ _ n _ = common_curve curve
+    let (index, residue) = x `divMod` n
+    parity <- case curve of
+        CurveFP _ -> pure $ odd y
+        CurveF2m _ | x == 0 -> pure False
+        CurveF2m (CurveBinary fx _) -> odd <$> divF2m fx y x
+    pure (index, residue, parity)
+
+-- | Compose a point from index, residue, and parity.
+--
+-- Adapted from SEC 1: Elliptic Curve Cryptography, Version 2.0, section 2.3.4.
+pointCompose :: Curve -> Integer -> Integer -> Bool -> Maybe Point
+pointCompose curve index residue parity = do
+    let CurveCommon a b _ n _ = common_curve curve
+    let x = residue + index * n
+    y <- case curve of
+        CurveFP (CurvePrime p _) -> do
+            z <- squareRoot p $ x ^ (3 :: Int) + a * x + b
+            pure $ if odd z == parity then z else p - z
+        CurveF2m (CurveBinary fx _) | x == 0 -> pure $ sqrtF2m fx b
+        CurveF2m (CurveBinary fx _) -> do
+            c <- divF2m fx b $ squareF2m fx x
+            z <- quadraticF2m fx $ addF2m x $ addF2m a c
+            pure $ mulF2m fx x $ if odd z == parity then z else addF2m 1 z
+    pure $ Point x y
+
 -- | Check if a point is the point at infinity.
 isPointAtInfinity :: Point -> Bool
 isPointAtInfinity PointO = True

tests/ECDSA.hs

@@ -5,7 +5,8 @@ module ECDSA (tests) where
 
 import qualified Crypto.ECC as ECDSA
 import Crypto.Error
-import Crypto.Hash.Algorithms
+import Crypto.Hash
+import qualified Crypto.PubKey.ECC.Generate as ECC
 import qualified Crypto.PubKey.ECC.ECDSA as ECC
 import qualified Crypto.PubKey.ECC.Types as ECC
 import qualified Crypto.PubKey.ECDSA as ECDSA
@@ -43,16 +44,38 @@ sigECCToECDSA prx (ECC.Signature r s) =
         (throwCryptoError $ ECDSA.scalarFromInteger prx r)
         (throwCryptoError $ ECDSA.scalarFromInteger prx s)
 
-tests =
-    localOption (QuickCheckTests 5) $
+testRecover :: ECC.CurveName -> TestTree
+testRecover name = testProperty (show name) $ \ (ArbitraryBS0_2901 msg) -> do
+    let curve = ECC.getCurveByName name
+    let n = ECC.ecc_n $ ECC.common_curve curve
+    k <- choose (1, n - 1)
+    d <- choose (1, n - 1)
+    let key = ECC.PrivateKey curve d
+    let digest = hashWith SHA256 msg
+    let pub = ECC.signExtendedDigestWith k key digest >>= \ signature -> ECC.recoverDigest curve signature digest
+    pure $ propertyHold [eqTest "recovery" (Just $ ECC.generateQ curve d) (ECC.public_q <$> pub)]
+
+tests = testGroup "ECDSA"
+    [ localOption (QuickCheckTests 5) $
         testGroup
-            "ECDSA"
+            "verification"
             [ testProperty "SHA1" $ propertyECDSA SHA1
             , testProperty "SHA224" $ propertyECDSA SHA224
             , testProperty "SHA256" $ propertyECDSA SHA256
             , testProperty "SHA384" $ propertyECDSA SHA384
             , testProperty "SHA512" $ propertyECDSA SHA512
             ]
+    , testGroup "recovery"
+        [ localOption (QuickCheckTests 100) $ testRecover ECC.SEC_p128r1
+        , localOption (QuickCheckTests 100) $ testRecover ECC.SEC_p128r2
+        , localOption (QuickCheckTests 100) $ testRecover ECC.SEC_p256k1
+        , localOption (QuickCheckTests 100) $ testRecover ECC.SEC_p256r1
+        , localOption (QuickCheckTests 50) $ testRecover ECC.SEC_t131r1
+        , localOption (QuickCheckTests 50) $ testRecover ECC.SEC_t131r2
+        , localOption (QuickCheckTests 20) $ testRecover ECC.SEC_t233k1
+        , localOption (QuickCheckTests 20) $ testRecover ECC.SEC_t233r1
+        ]
+    ]
   where
     propertyECDSA hashAlg (Curve c curve _) (ArbitraryBS0_2901 msg) = do
         d <- arbitraryScalar curve