Deterministic Nonce Generation for ECDSA

Crypto/Number/Generate.hs

@@ -7,6 +7,7 @@
 module Crypto.Number.Generate (
     GenTopPolicy (..),
     generateParams,
+    generatePrefix,
     generateMax,
     generateBetween,
 ) where
@@ -18,7 +19,7 @@ import Crypto.Internal.Imports
 import Crypto.Number.Basic
 import Crypto.Number.Serialize
 import Crypto.Random.Types
-import Data.Bits (complement, shiftL, testBit, (.&.), (.|.))
+import Data.Bits (complement, unsafeShiftR, shiftL, testBit, (.&.), (.|.))
 import Foreign.Ptr
 import Foreign.Storable
 
@@ -79,6 +80,18 @@ generateParams bits genTopPolicy generateOdd
     bit = (bits - 1) `mod` 8
     mask = 0xff `shiftL` (bit + 1)
 
+-- | Generate a number for a specific size of bits.
+--
+-- * @'generateParams' n Nothing False@ generates bytes and uses the suffix of @n@ bits
+-- * @'generatePrefix' n@ generates bytes and uses the prefix of @n@ bits
+generatePrefix :: MonadRandom m => Int -> m Integer
+generatePrefix bits
+    | bits <= 0 = return 0
+    | otherwise = do
+        let (count, offset) = (bits + 7) `divMod` 8
+        bytes <- getRandomBytes count
+        return $ os2ip (bytes :: ScrubbedBytes) `unsafeShiftR` (7 - offset)
+
 -- | Generate a positive integer x, s.t. 0 <= x < range
 generateMax
     :: MonadRandom m

Crypto/PubKey/ECC/ECDSA.hs

@@ -22,20 +22,25 @@ module Crypto.PubKey.ECC.ECDSA (
     verifyDigest,
     recover,
     recoverDigest,
+    deterministicNonce,
 ) where
 
 import Control.Monad
 import Data.Data
 import Data.Bits
+import Data.ByteString (ByteString)
 
 import Crypto.Hash
 import Crypto.Internal.ByteArray (ByteArrayAccess)
+import Crypto.Number.Basic
 import Crypto.Number.Generate
+import Crypto.Number.Serialize
 import Crypto.Number.ModArithmetic (inverse)
 import Crypto.PubKey.ECC.Prim
 import Crypto.PubKey.ECC.Types
 import Crypto.PubKey.Internal (dsaTruncHashDigest)
 import Crypto.Random.Types
+import Crypto.Random.HmacDRG
 
 -- | Represent a ECDSA signature namely R and S.
 data Signature = Signature
@@ -208,3 +213,19 @@ recover
     :: (ByteArrayAccess msg, HashAlgorithm hash)
     => hash -> Curve -> ExtendedSignature -> msg -> Maybe PublicKey
 recover hashAlg curve sig msg = recoverDigest curve sig $ hashWith hashAlg msg
+
+-- | Deterministic nonce generation according to RFC 6979.
+-- Allows using different hash algorithms for the HMAC-based DRG and the message digest.
+deterministicNonce
+    :: (HashAlgorithm hashDRG, HashAlgorithm hashDigest)
+    => hashDRG -> PrivateKey -> Digest hashDigest -> (Integer -> Maybe a) -> a
+deterministicNonce alg (PrivateKey curve key) digest go = fst $ withDRG state run where
+    state = update seed $ initial alg where
+        seed = i2ospOf_ bytes key <> i2ospOf_ bytes message :: ByteString
+        message = dsaTruncHashDigest digest n `mod` n
+    run = do
+        k <- generatePrefix bits
+        if 0 < k && k < n then maybe run pure $ go k else run
+    bytes = (bits + 7) `div` 8
+    bits = numBits n
+    n = ecc_n $ common_curve curve

Crypto/Random/HmacDRG.hs

@@ -0,0 +1,38 @@
+module Crypto.Random.HmacDRG (HmacDRG, initial, update) where
+
+import Data.Maybe
+import qualified Data.ByteString as B
+import Data.ByteArray (ByteArrayAccess)
+import qualified Data.ByteArray as M
+import Crypto.Hash
+import Crypto.MAC.HMAC (HMAC (..), hmac)
+import Crypto.Random.Types
+
+-- | HMAC-based Deterministic Random Generator
+--
+-- Adapted from NIST Special Publication 800-90A Revision 1, Section 10.1.2
+data HmacDRG hash = HmacDRG (Digest hash) (Digest hash)
+
+-- | The initial DRG state. It should be seeded via 'update' before use.
+initial :: HashAlgorithm hash => hash -> HmacDRG hash
+initial algorithm = HmacDRG (constant 0x00) (constant 0x01) where
+    constant = fromJust . digestFromByteString . B.replicate (hashDigestSize algorithm)
+
+-- | Update the DRG state with optional provided data.
+update :: ByteArrayAccess input => HashAlgorithm hash => input -> HmacDRG hash -> HmacDRG hash
+update input state0 = if M.null input then state1 else state2 where
+    state1 = step 0x00 state0
+    state2 = step 0x01 state1
+    step byte (HmacDRG key value) = HmacDRG keyNew valueNew where
+        keyNew = hmacGetDigest $ hmac key $ M.convert value <> B.singleton byte <> M.convert input
+        valueNew = hmacGetDigest $ hmac keyNew value
+
+instance HashAlgorithm hash => DRG (HmacDRG hash) where
+    randomBytesGenerate count (HmacDRG key value) = (output, state) where
+        output = M.take count result
+        state = update B.empty $ HmacDRG key new
+        (result, new) = go M.empty value
+        go buffer current
+            | M.length buffer >= count = (buffer, current)
+            | otherwise = go (buffer <> M.convert next) next
+            where next = hmacGetDigest $ hmac key current

crypton.cabal

@@ -276,6 +276,7 @@ library
         Crypto.Random.Entropy.Source
         Crypto.Random.Entropy.Backend
         Crypto.Random.ChaChaDRG
+        Crypto.Random.HmacDRG
         Crypto.Random.SystemDRG
         Crypto.Random.Probabilistic
         Crypto.PubKey.Internal

tests/KAT_PubKey/ECDSA.hs

@@ -11,7 +11,7 @@ import Test.Tasty.HUnit
 import Crypto.Number.Serialize
 import Crypto.Hash
 import Crypto.PubKey.ECC.Types
-import Crypto.PubKey.ECC.ECDSA (Signature (..), PrivateKey (..), PublicKey (..), signWith, verify)
+import Crypto.PubKey.ECC.ECDSA (Signature (..), PrivateKey (..), PublicKey (..), signWith, verify, deterministicNonce)
 import Crypto.PubKey.ECC.Generate
 
 -- existential type allows storing different hash algorithms in the same value
@@ -859,6 +859,10 @@ testPublic :: PrivateKey -> PublicPoint -> TestTree
 testPublic (PrivateKey curve key) pub = testCase "public" $
     pub @=? generateQ curve key
 
+testNonce :: PrivateKey -> HashAlg -> ByteString -> Integer -> TestTree
+testNonce key (HashAlg alg) msg nonc = testCase "nonce" $
+    nonc @=? deterministicNonce alg key (hashWith alg msg) Just
+
 testSignature :: PrivateKey -> HashAlg -> ByteString -> Integer -> Signature -> TestTree
 testSignature key (HashAlg alg) msg nonc sig = testCase "signature" $
     case signWith nonc key alg msg of
@@ -879,7 +883,18 @@ testEntry entry = testGroup (show entry) tests where
     key = PrivateKey curve $ privateNumber entry
     curve = getCurveByName $ curveName entry
 
+testEntryNonce :: Entry -> TestTree
+testEntryNonce entry = testGroup (show entry) tests where
+    tests = [
+        testPublic key $ publicPoint entry,
+        testNonce key (hashAlgorithm entry) (message entry) (nonce entry),
+        testSignature key (hashAlgorithm entry) (message entry) (nonce entry) (signature entry),
+        testVerify pub (hashAlgorithm entry) (message entry) (signature entry)]
+    pub = PublicKey curve $ publicPoint entry
+    key = PrivateKey curve $ privateNumber entry
+    curve = getCurveByName $ curveName entry
+
 ecdsaTests :: TestTree
 ecdsaTests = testGroup "ECDSA" [
     testGroup "GEC 2" $ testEntry . normalize <$> gec2Entries,
-    testGroup "RFC 6979" $ testEntry . normalize <$> flatten rfc6979Entries]
+    testGroup "RFC 6979" $ testEntryNonce . normalize <$> flatten rfc6979Entries]