From b55a93dfdc13b758cbd00770b70c4684fdd486e7 Mon Sep 17 00:00:00 2001
From: Baojun Wang <wangbj@gmail.com>
Date: Mon, 4 Jun 2018 18:13:29 -0700
Subject: [PATCH] add ECDSA sign/verify digest APIs

(rebased from commit 045793427e8d46594b0b2afedb314d027ec707ab)
---
 Crypto/PubKey/ECC/ECDSA.hs | 65 ++++++++++++++++++++++++++------------
 Crypto/PubKey/Internal.hs  |  9 ++++--
 2 files changed, 52 insertions(+), 22 deletions(-)

diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs
index 4cfc4b8..24c6e15 100644
--- a/Crypto/PubKey/ECC/ECDSA.hs
+++ b/Crypto/PubKey/ECC/ECDSA.hs
@@ -10,9 +10,12 @@ module Crypto.PubKey.ECC.ECDSA
     , KeyPair(..)
     , toPublicKey
     , toPrivateKey
+    , signWithDigest
     , signWith
+    , signDigest
     , sign
     , verify
+    , verifyDigest
     ) where
 
 import Control.Monad
@@ -24,7 +27,7 @@ import Crypto.Number.ModArithmetic (inverse)
 import Crypto.Number.Generate
 import Crypto.PubKey.ECC.Types
 import Crypto.PubKey.ECC.Prim
-import Crypto.PubKey.Internal (dsaTruncHash)
+import Crypto.PubKey.Internal (dsaTruncHashDigest)
 import Crypto.Random.Types
 
 -- | Represent a ECDSA signature namely R and S.
@@ -57,17 +60,17 @@ toPublicKey (KeyPair curve pub _) = PublicKey curve pub
 toPrivateKey :: KeyPair -> PrivateKey
 toPrivateKey (KeyPair curve _ priv) = PrivateKey curve priv
 
--- | Sign message using the private key and an explicit k number.
+-- | Sign digest using the private key and an explicit k number.
 --
 -- /WARNING:/ Vulnerable to timing attacks.
-signWith :: (ByteArrayAccess msg, HashAlgorithm hash)
-         => Integer    -- ^ k random number
-         -> PrivateKey -- ^ private key
-         -> hash       -- ^ hash function
-         -> msg        -- ^ message to sign
+signWithDigest :: HashAlgorithm hash
+         => Integer     -- ^ k random number
+         -> PrivateKey  -- ^ private key
+         -> hash        -- ^ hash function
+         -> Digest hash -- ^ digest to sign
          -> Maybe Signature
-signWith k (PrivateKey curve d) hashAlg msg = do
-    let z = dsaTruncHash hashAlg msg n
+signWithDigest k (PrivateKey curve d) hashAlg digest = do
+    let z = dsaTruncHashDigest hashAlg digest n
         CurveCommon _ _ g n _ = common_curve curve
     let point = pointMul curve k g
     r <- case point of
@@ -78,26 +81,44 @@ signWith k (PrivateKey curve d) hashAlg msg = do
     when (r == 0 || s == 0) Nothing
     return $ Signature r s
 
+-- | Sign message using the private key and an explicit k number.
+--
+-- /WARNING:/ Vulnerable to timing attacks.
+signWith :: (ByteArrayAccess msg, HashAlgorithm hash)
+         => Integer    -- ^ k random number
+         -> PrivateKey -- ^ private key
+         -> hash       -- ^ hash function
+         -> msg        -- ^ message to sign
+         -> Maybe Signature
+signWith k pk hashAlg msg = signWithDigest k pk hashAlg (hashWith hashAlg msg)
+
+-- | Sign digst using the private key.
+--
+-- /WARNING:/ Vulnerable to timing attacks.
+signDigest :: (HashAlgorithm hash, MonadRandom m)
+     => PrivateKey -> hash -> Digest hash -> m Signature
+signDigest pk hashAlg digest = do
+    k <- generateBetween 1 (n - 1)
+    case signWithDigest k pk hashAlg digest of
+         Nothing  -> signDigest pk hashAlg digest
+         Just sig -> return sig
+  where n = ecc_n . common_curve $ private_curve pk
+
 -- | Sign message using the private key.
 --
 -- /WARNING:/ Vulnerable to timing attacks.
 sign :: (ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m)
      => PrivateKey -> hash -> msg -> m Signature
-sign pk hashAlg msg = do
-    k <- generateBetween 1 (n - 1)
-    case signWith k pk hashAlg msg of
-         Nothing  -> sign pk hashAlg msg
-         Just sig -> return sig
-  where n = ecc_n . common_curve $ private_curve pk
+sign pk hashAlg msg = signDigest pk hashAlg (hashWith hashAlg msg)
 
--- | Verify a bytestring using the public key.
-verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool
-verify _       (PublicKey _ PointO) _ _ = False
-verify hashAlg pk@(PublicKey curve q) (Signature r s) msg
+-- | Verify a digest using the public key.
+verifyDigest :: HashAlgorithm hash => hash -> PublicKey -> Signature -> Digest hash -> Bool
+verifyDigest _       (PublicKey _ PointO) _ _ = False
+verifyDigest hashAlg pk@(PublicKey curve q) (Signature r s) digest
     | r < 1 || r >= n || s < 1 || s >= n = False
     | otherwise = maybe False (r ==) $ do
         w <- inverse s n
-        let z  = dsaTruncHash hashAlg msg n
+        let z  = dsaTruncHashDigest hashAlg digest n
             u1 = z * w `mod` n
             u2 = r * w `mod` n
             x  = pointAddTwoMuls curve u1 g u2 q
@@ -107,3 +128,7 @@ verify hashAlg pk@(PublicKey curve q) (Signature r s) msg
   where n = ecc_n cc
         g = ecc_g cc
         cc = common_curve $ public_curve pk
+
+-- | Verify a bytestring using the public key.
+verify :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> PublicKey -> Signature -> msg -> Bool
+verify hashAlg pk sig msg = verifyDigest hashAlg pk sig (hashWith hashAlg msg)
diff --git a/Crypto/PubKey/Internal.hs b/Crypto/PubKey/Internal.hs
index b1631cc..5e0629f 100644
--- a/Crypto/PubKey/Internal.hs
+++ b/Crypto/PubKey/Internal.hs
@@ -9,6 +9,7 @@ module Crypto.PubKey.Internal
     ( and'
     , (&&!)
     , dsaTruncHash
+    , dsaTruncHashDigest
     ) where
 
 import Data.Bits (shiftR)
@@ -32,8 +33,12 @@ False &&! False = False
 
 -- | Truncate and hash for DSA and ECDSA.
 dsaTruncHash :: (ByteArrayAccess msg, HashAlgorithm hash) => hash -> msg -> Integer -> Integer
-dsaTruncHash hashAlg m n
+dsaTruncHash hashAlg = dsaTruncHashDigest hashAlg . hashWith hashAlg
+
+-- | Truncate a digest for DSA and ECDSA.
+dsaTruncHashDigest :: HashAlgorithm hash => hash -> Digest hash -> Integer -> Integer
+dsaTruncHashDigest hashAlg digest n
     | d > 0 = shiftR e d
     | otherwise = e
-  where e = os2ip $ hashWith hashAlg m
+  where e = os2ip digest
         d = hashDigestSize hashAlg * 8 - numBits n