From 6adb20af9f60a5d43139b6e84d3d0cbb07d8ee86 Mon Sep 17 00:00:00 2001 From: Julian Brunner Date: Fri, 7 Mar 2025 23:03:03 +0100 Subject: [PATCH 1/4] add HMAC-based deterministic random generator --- Crypto/Random/HmacDRG.hs | 38 ++++++++++++++++++++++++++++++++++++++ crypton.cabal | 1 + 2 files changed, 39 insertions(+) create mode 100644 Crypto/Random/HmacDRG.hs diff --git a/Crypto/Random/HmacDRG.hs b/Crypto/Random/HmacDRG.hs new file mode 100644 index 00000000..afcc6b28 --- /dev/null +++ b/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 diff --git a/crypton.cabal b/crypton.cabal index 408205f5..6fcd59dd 100644 --- a/crypton.cabal +++ b/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 From 0147f046279223104fc186abc324e3c63601556c Mon Sep 17 00:00:00 2001 From: Julian Brunner Date: Fri, 7 Mar 2025 23:03:33 +0100 Subject: [PATCH 2/4] add prefix random integer generation --- Crypto/Number/Generate.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/Crypto/Number/Generate.hs b/Crypto/Number/Generate.hs index a776046f..5c94c0ea 100644 --- a/Crypto/Number/Generate.hs +++ b/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 From 7a927ed34b2c64728a8df4cdf3cec4587f25f806 Mon Sep 17 00:00:00 2001 From: Julian Brunner Date: Fri, 7 Mar 2025 23:03:55 +0100 Subject: [PATCH 3/4] add deterministic nonce generation according to RFC 6979 --- Crypto/PubKey/ECC/ECDSA.hs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs index 52a79cbf..69eadb7e 100644 --- a/Crypto/PubKey/ECC/ECDSA.hs +++ b/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 From d1d9b235e8da635104c228ce3e24c6c30682af11 Mon Sep 17 00:00:00 2001 From: Julian Brunner Date: Fri, 7 Mar 2025 23:04:23 +0100 Subject: [PATCH 4/4] add deterministic nonce generation tests --- tests/KAT_PubKey/ECDSA.hs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/tests/KAT_PubKey/ECDSA.hs b/tests/KAT_PubKey/ECDSA.hs index 3835e651..79193043 100644 --- a/tests/KAT_PubKey/ECDSA.hs +++ b/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]