ppad-hmac-drbg 0.2.1 → 0.3.0

raw patch · 9 files changed

+924/−337 lines, 9 filesdep +deepseqdep +weighdep ~basedep ~bytestringdep ~ppad-sha256PVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, weigh

Dependency ranges changed: base, bytestring, ppad-sha256, ppad-sha512

API changes (from Hackage documentation)

Files

• CHANGELOG +18/−0
• bench/Main.hs +12/−22
• bench/Weight.hs +42/−0
• lib/Crypto/DRBG/HMAC.hs +0/−280
• lib/Crypto/DRBG/HMAC/Internal.hs +33/−0
• lib/Crypto/DRBG/HMAC/SHA256.hs +388/−0
• lib/Crypto/DRBG/HMAC/SHA512.hs +373/−0
• ppad-hmac-drbg.cabal +22/−6
• test/Main.hs +36/−29

@@ -1,5 +1,23 @@ # Changelog +- 0.3.0 (2026-02-01)+  * This backwards-incompatible version changes the "bring your own HMAC+    function" design and simply provides specialized DRBGs for+    HMAC-SHA256 and HMAC-SHA512, respectively. These HMAC functions are+    provided by ppad-sha256 and ppad-sha512.++  * The rationale here is to provide better security guarantees around+    the DRBG state. Now, the DRBG state is restricted to a single, pinned,+    heap-allocated mutable buffer; components of it are /never/+    allocated anywhere else on the heap during DRBG operation (not even+    in temporary, to-be-GC'd bytestrings). A new 'wipe' function is also+    exposed for explicitly zeroing out state when one is finished+    generating bytes from the DRBG.++  * Aside from the increased security guarantees, DRBG performance is+    dramatically improved, and other heap allocation dramatically+    limited, compared to previous versions.+ - 0.2.1 (2026-01-10)   * Simply adds bounds to the ppad-sha{256,512} dependencies in the test and     benchmark suites.

@@ -5,23 +5,13 @@ module Main where  import Criterion.Main-import qualified Crypto.DRBG.HMAC as DRBG-import qualified Crypto.Hash.SHA256 as SHA256-import qualified Crypto.Hash.SHA512 as SHA512-import qualified Data.ByteString as BS--hmac_sha256 :: BS.ByteString -> BS.ByteString -> BS.ByteString-hmac_sha256 k b = case SHA256.hmac k b of-  SHA256.MAC m -> m--hmac_sha512 :: BS.ByteString -> BS.ByteString -> BS.ByteString-hmac_sha512 k b = case SHA512.hmac k b of-  SHA512.MAC m -> m+import qualified Crypto.DRBG.HMAC.SHA256 as DRBG256+import qualified Crypto.DRBG.HMAC.SHA512 as DRBG512  main :: IO () main = do-  !drbg256 <- DRBG.new hmac_sha256 mempty mempty mempty -- no NFData-  !drbg512 <- DRBG.new hmac_sha512 mempty mempty mempty -- no NFData+  !drbg256 <- DRBG256.new mempty mempty mempty+  !drbg512 <- DRBG512.new mempty mempty mempty   defaultMain [       suite drbg256 drbg512     ]@@ -29,16 +19,16 @@ suite drbg256 drbg512 =   bgroup "ppad-hmac-drbg" [     bgroup "HMAC-SHA256" [-      bench "new" $ whnfAppIO (DRBG.new hmac_sha256 mempty mempty) mempty-    , bench "reseed" $ whnfAppIO (DRBG.reseed mempty mempty) drbg256-    , bench "gen (32B)"  $ whnfAppIO (DRBG.gen mempty 32) drbg256-    , bench "gen (256B)" $ whnfAppIO (DRBG.gen mempty 256) drbg256+      bench "new" $ whnfAppIO (DRBG256.new mempty mempty) mempty+    , bench "reseed" $ whnfAppIO (DRBG256.reseed drbg256 mempty) mempty+    , bench "gen (32B)"  $ whnfAppIO (DRBG256.gen drbg256 mempty) 32+    , bench "gen (256B)" $ whnfAppIO (DRBG256.gen drbg256 mempty) 256     ]   , bgroup "HMAC-SHA512" [-      bench "new" $ whnfAppIO (DRBG.new hmac_sha512 mempty mempty) mempty-    , bench "reseed" $ whnfAppIO (DRBG.reseed mempty mempty) drbg512-    , bench "gen (32B)"  $ whnfAppIO (DRBG.gen mempty 32) drbg512-    , bench "gen (256B)" $ whnfAppIO (DRBG.gen mempty 256) drbg512+      bench "new" $ whnfAppIO (DRBG512.new mempty mempty) mempty+    , bench "reseed" $ whnfAppIO (DRBG512.reseed drbg512 mempty) mempty+    , bench "gen (32B)"  $ whnfAppIO (DRBG512.gen drbg512 mempty) 32+    , bench "gen (256B)" $ whnfAppIO (DRBG512.gen drbg512 mempty) 256     ]   ] 

@@ -0,0 +1,42 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++-- NOTE: weigh forks a subprocess per test, so each test pays ~32KB of+-- process initialization overhead. Direct measurement via GHC.Stats+-- shows actual per-call allocation is ~1.1KB for DRBG.new.++module Main where++import Control.DeepSeq+import qualified Crypto.DRBG.HMAC.SHA256 as DRBG256+import qualified Crypto.DRBG.HMAC.SHA512 as DRBG512+import Weigh++instance NFData (DRBG256.DRBG s) where+  rnf d = d `seq` ()++instance NFData DRBG256.Error where+  rnf e = e `seq` ()++instance NFData (DRBG512.DRBG s) where+  rnf d = d `seq` ()++instance NFData DRBG512.Error where+  rnf e = e `seq` ()++main :: IO ()+main = do+  !drbg256 <- DRBG256.new mempty mempty mempty+  !drbg512 <- DRBG512.new mempty mempty mempty+  mainWith $ do+    wgroup "HMAC-SHA256" $ do+      io "new" (DRBG256.new mempty mempty) mempty+      io "reseed" (DRBG256.reseed drbg256 mempty) mempty+      io "gen (32B)" (DRBG256.gen drbg256 mempty) 32+      io "gen (256B)" (DRBG256.gen drbg256 mempty) 256+    wgroup "HMAC-SHA512" $ do+      io "new" (DRBG512.new mempty mempty) mempty+      io "reseed" (DRBG512.reseed drbg512 mempty) mempty+      io "gen (32B)" (DRBG512.gen drbg512 mempty) 32+      io "gen (256B)" (DRBG512.gen drbg512 mempty) 256

@@ -1,280 +0,0 @@-{-# OPTIONS_HADDOCK prune #-}-{-# OPTIONS_GHC -funbox-small-strict-fields #-}-{-# LANGUAGE BangPatterns #-}---- |--- Module: Crypto.DRBG.HMAC--- Copyright: (c) 2024 Jared Tobin--- License: MIT--- Maintainer: Jared Tobin <jared@ppad.tech>------ A pure HMAC-DRBG implementation, as specified by--- [NIST SP-800-90A](https://nvlpubs.nist.gov/nistpubs/SpecialPublications/NIST.SP.800-90Ar1.pdf).--module Crypto.DRBG.HMAC (-  -- * DRBG and HMAC function types-    DRBG-  , HMAC-  , Error(..)-  , _read_v-  , _read_k--  -- * DRBG interaction-  , new-  , gen-  , reseed-  ) where--import Control.Monad.Primitive (PrimMonad, PrimState)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Builder as BSB-import qualified Data.ByteString.Builder.Extra as BE-import qualified Data.ByteString.Internal as BI-import qualified Data.Primitive.MutVar as P-import Data.Word (Word64)---- keystroke savers and utilities -----------------------------------------------fi :: (Integral a, Num b) => a -> b-fi = fromIntegral-{-# INLINE fi #-}--to_strict :: BSB.Builder -> BS.ByteString-to_strict = BS.toStrict . BSB.toLazyByteString-{-# INLINE to_strict #-}--to_strict_small :: BSB.Builder -> BS.ByteString-to_strict_small = BS.toStrict . BE.toLazyByteStringWith-  (BE.safeStrategy 128 BE.smallChunkSize) mempty-{-# INLINE to_strict_small #-}---- dumb strict pair-data Pair a b = Pair !a !b-  deriving Show---- types -------------------------------------------------------------------------- | A DRBG error.-data Error =-    MaxBytesExceeded -- ^ More than 65536 bytes have been requested.-  | ReseedRequired   -- ^ The DRBG must be reseeded (via 'reseed').-  deriving (Eq, Show)---- see SP 800-90A table 2-_RESEED_COUNTER :: Word64-_RESEED_COUNTER = (2 :: Word64) ^ (48 :: Word64)---- | A deterministic random bit generator (DRBG).------   Create a DRBG with 'new', and then use and reuse it to generate---   bytes as needed.------   >>> drbg <- new hmac entropy nonce personalization_string---   >>> bytes0 <- gen addl_bytes 16 drbg---   >>> bytes1 <- gen addl_bytes 16 drbg---   >>> drbg---   "<drbg>"-newtype DRBG s = DRBG (P.MutVar s DRBGState)--instance Show (DRBG s) where-  show _ = "<drbg>"---- DRBG environment data and state-data DRBGState = DRBGState-                 !HMACEnv       -- hmac function & outlen-  {-# UNPACK #-} !Word64        -- reseed counter-  {-# UNPACK #-} !BS.ByteString -- v-  {-# UNPACK #-} !BS.ByteString -- key---- NB following synonym really only exists to make haddocks more---    readable---- | A HMAC function, taking a key as the first argument and the input---   value as the second, producing a MAC digest.------   >>> import qualified Crypto.Hash.SHA256 as SHA256---   >>> let hmac k b = let SHA256.MAC m = SHA256.hmac k b in m---   >>> :t hmac---   hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString-type HMAC = BS.ByteString -> BS.ByteString -> BS.ByteString---- HMAC function and its associated outlength-data HMACEnv = HMACEnv-                 !HMAC-  {-# UNPACK #-} !Word64---- the following convenience functions are useful for testing--_read_v-  :: PrimMonad m-  => DRBG (PrimState m)-  -> m BS.ByteString-_read_v (DRBG mut) = do-  DRBGState _ _ v _ <- P.readMutVar mut-  pure v--_read_k-  :: PrimMonad m-  => DRBG (PrimState m)-  -> m BS.ByteString-_read_k (DRBG mut) = do-  DRBGState _ _ _ k <- P.readMutVar mut-  pure k---- drbg interaction ---------------------------------------------------------- | Create a DRBG from the supplied HMAC function, entropy, nonce, and---   personalization string.------   You can instantiate the DRBG using any appropriate HMAC function;---   it should merely take a key and value as input, as is standard, and---   return a MAC digest, each being a strict 'ByteString'.------   The DRBG is returned in any 'PrimMonad', e.g. 'ST' or 'IO'.------   >>> import qualified Crypto.Hash.SHA256 as SHA256---   >>> let hmac k b = let SHA256.MAC m = SHA256.hmac k b in m---   >>> new hmac entropy nonce personalization_string---   "<drbg>"-new-  :: PrimMonad m-  => HMAC           -- ^ HMAC function-  -> BS.ByteString  -- ^ entropy-  -> BS.ByteString  -- ^ nonce-  -> BS.ByteString  -- ^ personalization string-  -> m (DRBG (PrimState m))-new hmac entropy nonce ps = do-  let !drbg = new_pure hmac entropy nonce ps-  mut <- P.newMutVar drbg-  pure (DRBG mut)---- | Generate bytes from a DRBG, optionally injecting additional bytes---   per SP 800-90A.------   Per SP 800-90A, the maximum number of bytes that can be requested---   on any invocation is 65536. Larger requests will return---   'MaxBytesExceeded'.------   >>> import qualified Data.ByteString.Base16 as B16---   >>> drbg <- new hmac entropy nonce personalization_string---   >>> Right bytes0 <- gen addl_bytes 16 drbg---   >>> Right bytes1 <- gen addl_bytes 16 drbg---   >>> B16.encode bytes0---   "938d6ca6d0b797f7b3c653349d6e3135"---   >>> B16.encode bytes1---   "5f379d16de6f2c6f8a35c56f13f9e5a5"-gen-  :: PrimMonad m-  => BS.ByteString       -- ^ additional bytes to inject-  -> Word64              -- ^ number of bytes to generate-  -> DRBG (PrimState m)-  -> m (Either Error BS.ByteString)-gen addl bytes (DRBG mut) = do-  drbg0 <- P.readMutVar mut-  case gen_pure addl bytes drbg0 of-    Left e -> pure (Left e)-    Right !(Pair bs drbg1) -> do-      P.writeMutVar mut drbg1-      pure (Right bs)---- | Reseed a DRBG.------   Each DRBG has an internal /reseed counter/ that tracks the number---   of requests made to the generator (note /requests made/, not bytes---   generated). SP 800-90A specifies that a HMAC-DRBG should support---   2 ^ 48 requests before requiring a reseed, so in practice you're---   unlikely to ever need to use this to actually reset the counter.------   Note however that 'reseed' can be used to implement "explicit"---   prediction resistance, per SP 800-90A, by injecting entropy generated---   elsewhere into the DRBG.------   >>> import qualified System.Entropy as E---   >>> entropy <- E.getEntropy 32---   >>> reseed entropy addl_bytes drbg---   "<reseeded drbg>"-reseed-  :: PrimMonad m-  => BS.ByteString        -- ^ entropy to inject-  -> BS.ByteString        -- ^ additional bytes to inject-  -> DRBG (PrimState m)-  -> m ()-reseed ent add (DRBG drbg) = P.modifyMutVar' drbg (reseed_pure ent add)---- pure drbg interaction ---------------------------------------------------------- SP 800-90A 10.1.2.2-update_pure-  :: BS.ByteString-  -> DRBGState-  -> DRBGState-update_pure provided_data (DRBGState h@(HMACEnv hmac _) r v0 k0) =-    let !k1 = hmac k0 (cat v0 0x00 provided_data)-        !v1 = hmac k1 v0-    in  if   BS.null provided_data-        then DRBGState h r v1 k1-        else let !k2 = hmac k1 (cat v1 0x01 provided_data)-                 !v2 = hmac k2 v1-             in  DRBGState h r v2 k2-  where-    cat bs byte suf@(BI.PS _ _ l) =-      let bil = BSB.byteString bs <> BSB.word8 byte <> BSB.byteString suf-      in  if   l < 64-          then to_strict_small bil-          else to_strict bil-    {-# INLINE cat #-}---- SP 800-90A 10.1.2.3-new_pure-  :: HMAC           -- HMAC function-  -> BS.ByteString  -- entropy-  -> BS.ByteString  -- nonce-  -> BS.ByteString  -- personalization string-  -> DRBGState-new_pure hmac entropy nonce ps =-    let !drbg = DRBGState (HMACEnv hmac outlen) 1 v0 k0-    in  update_pure seed_material drbg-  where-    seed_material = entropy <> nonce <> ps-    outlen = fi (BS.length (hmac mempty mempty))-    k0 = BS.replicate (fi outlen) 0x00-    v0 = BS.replicate (fi outlen) 0x01---- SP 800-90A 10.1.2.4-reseed_pure :: BS.ByteString -> BS.ByteString -> DRBGState -> DRBGState-reseed_pure entropy addl drbg =-  let !(DRBGState h _ v k) = update_pure (entropy <> addl) drbg-  in  DRBGState h 1 v k---- SP 800-90A 10.1.2.5-gen_pure-  :: BS.ByteString-  -> Word64-  -> DRBGState-  -> Either Error (Pair BS.ByteString DRBGState)-gen_pure addl bytes drbg0@(DRBGState h@(HMACEnv hmac outlen) _ _ _)-    | bytes > 0x10000     = Left MaxBytesExceeded-    | r > _RESEED_COUNTER = Left ReseedRequired-    | otherwise =-        let !(Pair temp drbg1) = loop mempty 0 v1-            returned_bits = BS.take (fi bytes) temp-            drbg = update_pure addl drbg1-        in  Right (Pair returned_bits drbg)-  where-    !(DRBGState _ r v1 k1)-      | BS.null addl = drbg0-      | otherwise = update_pure addl drbg0--    loop !acc !len !vl-      | len < bytes =-          let nv   = hmac k1 vl-              nacc = acc <> BSB.byteString nv-              nlen = len + outlen-          in  loop nacc nlen nv--      | otherwise =-          let facc | bytes < 128 = to_strict_small acc-                   | otherwise   = to_strict acc-          in  Pair facc (DRBGState h (succ r) vl k1)-{-# INLINE gen_pure #-}-

@@ -0,0 +1,33 @@+{-# OPTIONS_HADDOCK hide #-}++-- |+-- Module: Crypto.DRBG.HMAC.Internal+-- Copyright: (c) 2024 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Internal HMAC-DRBG definitions.++module Crypto.DRBG.HMAC.Internal (+    Error(..)+  , _RESEED_COUNTER+  , _MAX_BYTES+  ) where++import Data.Word (Word64)++-- | A DRBG error.+data Error =+    MaxBytesExceeded -- ^ More than 65536 bytes have been requested.+  | ReseedRequired   -- ^ The DRBG must be reseeded (via 'reseed').+  deriving (Eq, Show)++-- see SP 800-90A table 2+_RESEED_COUNTER :: Word64+_RESEED_COUNTER = (2 :: Word64) ^ (48 :: Word64)+{-# INLINE _RESEED_COUNTER #-}++-- see SP 800-90A table 2+_MAX_BYTES :: Word64+_MAX_BYTES = 0x10000+{-# INLINE _MAX_BYTES #-}

@@ -0,0 +1,388 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module: Crypto.DRBG.HMAC+-- Copyright: (c) 2024 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- A pure HMAC-DRBG implementation, as specified by+-- [NIST SP-800-90A](https://nvlpubs.nist.gov/nistpubs/SpecialPublications/NIST.SP.800-90Ar1.pdf).++module Crypto.DRBG.HMAC.SHA256 (+  -- * DRBG and HMAC function types+    DRBG+  , Error(..)++  -- * DRBG interaction+  , new+  , gen+  , reseed+  , wipe++  -- for testing+  , _read_v+  , _read_k+  ) where++import Crypto.DRBG.HMAC.Internal (Error(..), _RESEED_COUNTER, _MAX_BYTES)+import qualified Crypto.Hash.SHA256 as SHA256+import Crypto.Hash.SHA256.Internal (Registers(..))+import qualified Crypto.Hash.SHA256.Internal as SHA256 (cat)+import Control.Monad.Primitive (PrimMonad, PrimState)+import qualified Control.Monad.Primitive as Prim (unsafeIOToPrim)+import Data.Bits ((.<<.), (.>>.), (.|.))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Internal as BI+import qualified Data.Primitive.PrimArray as PA+import Data.Word (Word32, Word64)+import qualified GHC.Word+import qualified Foreign.Ptr as FP++-- api ------------------------------------------------------------------------++-- | A deterministic random bit generator (DRBG).+--+--   Create a DRBG with 'new', and then use and reuse it to generate+--   bytes as needed.+--+--   >>> drbg <- new entropy nonce personalization_string+--   >>> bytes0 <- gen drbg mempty 10+--   >>> bytes1 <- gen drbg mempty 10+--   >>> drbg+--   "<drbg>"++-- first two elements are hi/lo bits of word64 counter+-- next eight elements are k+-- next eight elements are v+-- next sixteen elements are scratch space+newtype DRBG s = DRBG (PA.MutablePrimArray s Word32)++instance Show (DRBG s) where+  show _ = "<drbg>"++-- | Create a HMAC-SHA256 DRBG from the supplied entropy, nonce, and+--   personalization string.+--+--   The DRBG is returned in any 'PrimMonad', e.g. 'ST s' or 'IO'.+--+--   >>> new entropy nonce personalization_string+--   "<drbg>"+new+  :: PrimMonad m+  => BS.ByteString    -- ^ entropy+  -> BS.ByteString    -- ^ nonce+  -> BS.ByteString    -- ^ personalization string+  -> m (DRBG (PrimState m))+new entropy nonce ps = do+  drbg <- PA.newPinnedPrimArray 34 -- 2 (ctr) + 16 (k, v) + 16 (scratch)+  init_counter drbg+  PA.setPrimArray drbg 02 08 (0x00000000 :: Word32) -- init k+  PA.setPrimArray drbg 10 08 (0x01010101 :: Word32) -- init v+  PA.setPrimArray drbg 18 16 (0x00000000 :: Word32) -- scratch+  update drbg (entropy <> nonce <> ps)+  pure $! DRBG drbg+{-# INLINABLE new #-}++-- | Reseed a DRBG.+--+--   Each DRBG has an internal /reseed counter/ that tracks the number+--   of requests made to the generator (note /requests made/, not bytes+--   generated). SP 800-90A specifies that a HMAC-DRBG should support+--   2 ^ 48 requests before requiring a reseed, so in practice you're+--   unlikely to ever need to use this to actually reset the counter.+--+--   Note however that 'reseed' can be used to implement "explicit"+--   prediction resistance, per SP 800-90A, by injecting entropy generated+--   elsewhere into the DRBG.+--+--   >>> import qualified System.Entropy as E+--   >>> entropy <- E.getEntropy 32+--   >>> reseed entropy addl_bytes drbg+--   "<reseeded drbg>"+reseed+  :: PrimMonad m+  => DRBG (PrimState m)+  -> BS.ByteString+  -> BS.ByteString+  -> m ()+reseed (DRBG drbg) entr addl = do+  update drbg (entr <> addl)+  init_counter drbg+{-# INLINE reseed #-}++-- | Generate bytes from a DRBG, optionally injecting additional bytes+--   per SP 800-90A.+--+--   Per SP 800-90A, the maximum number of bytes that can be requested+--   on any invocation is 65536. Larger requests will return+--   'MaxBytesExceeded'.+--+--   >>> import qualified Data.ByteString.Base16 as B16+--   >>> drbg <- new entropy nonce personalization_string+--   >>> Right bytes0 <- gen drbg addl_bytes 16+--   >>> Right bytes1 <- gen drbg addl_bytes 16+--   >>> B16.encode bytes0+--   "938d6ca6d0b797f7b3c653349d6e3135"+--   >>> B16.encode bytes1+--   "5f379d16de6f2c6f8a35c56f13f9e5a5"+gen+  :: PrimMonad m+  => DRBG (PrimState m)+  -> BS.ByteString+  -> Word64+  -> m (Either Error BS.ByteString)+gen (DRBG drbg) addl@(BI.PS _ _ l) bytes+  | bytes > _MAX_BYTES = pure $! Left MaxBytesExceeded+  | otherwise = do+      ctr <- read_counter drbg+      if   ctr > _RESEED_COUNTER+      then pure $! Left ReseedRequired+      else do+        if l == 0 then pure () else update drbg addl+        !(GHC.Word.W32# k00) <- PA.readPrimArray drbg 02+        !(GHC.Word.W32# k01) <- PA.readPrimArray drbg 03+        !(GHC.Word.W32# k02) <- PA.readPrimArray drbg 04+        !(GHC.Word.W32# k03) <- PA.readPrimArray drbg 05+        !(GHC.Word.W32# k04) <- PA.readPrimArray drbg 06+        !(GHC.Word.W32# k05) <- PA.readPrimArray drbg 07+        !(GHC.Word.W32# k06) <- PA.readPrimArray drbg 08+        !(GHC.Word.W32# k07) <- PA.readPrimArray drbg 09+        !(GHC.Word.W32# v00) <- PA.readPrimArray drbg 10+        !(GHC.Word.W32# v01) <- PA.readPrimArray drbg 11+        !(GHC.Word.W32# v02) <- PA.readPrimArray drbg 12+        !(GHC.Word.W32# v03) <- PA.readPrimArray drbg 13+        !(GHC.Word.W32# v04) <- PA.readPrimArray drbg 14+        !(GHC.Word.W32# v05) <- PA.readPrimArray drbg 15+        !(GHC.Word.W32# v06) <- PA.readPrimArray drbg 16+        !(GHC.Word.W32# v07) <- PA.readPrimArray drbg 17+        let !k0  = Registers (# k00, k01, k02, k03, k04, k05, k06, k07 #)+            !v0  = Registers (# v00, v01, v02, v03, v04, v05, v06, v07 #)+        !res <- gen_loop drbg k0 v0 bytes+        update drbg addl+        write_counter drbg (ctr + 1)+        pure $! Right res+{-# INLINABLE gen #-}++-- | Wipe the state of a DRBG.+--+--   You should call this when you're finished with a DRBG to ensure that its+--   state is wiped from memory.+--+--   >>> drbg <- new mempty mempty mempty+--   >>> Right bytes <- gen drbg addl_bytes 16+--   >>> wipe drbg+--   >>> -- do something with bytes+wipe+  :: PrimMonad m+  => DRBG (PrimState m)+  -> m ()+wipe (DRBG drbg) = do+  init_counter drbg+  PA.setPrimArray drbg 02 08 (0x00000000 :: Word32) -- init k+  PA.setPrimArray drbg 10 08 (0x01010101 :: Word32) -- init v+  PA.setPrimArray drbg 18 16 (0x00000000 :: Word32) -- init scratch+{-# INLINE wipe #-}+-- utilities ------------------------------------------------------------------++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}++-- drbg utilities -------------------------------------------------------------++gen_loop+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word32+  -> Registers+  -> Registers+  -> Word64+  -> m BS.ByteString+gen_loop drbg k0 v0 bytes = loop mempty v0 0 where+  !vp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 40 -- 10 * 4+  !sp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 72 -- 18 * 4+  loop !acc v l+    | l >= bytes = do+        write_v drbg v+        pure acc+    | otherwise = do+        Prim.unsafeIOToPrim $ SHA256._hmac_rr vp sp k0 v+        !(GHC.Word.W32# nv0) <- PA.readPrimArray drbg 10+        !(GHC.Word.W32# nv1) <- PA.readPrimArray drbg 11+        !(GHC.Word.W32# nv2) <- PA.readPrimArray drbg 12+        !(GHC.Word.W32# nv3) <- PA.readPrimArray drbg 13+        !(GHC.Word.W32# nv4) <- PA.readPrimArray drbg 14+        !(GHC.Word.W32# nv5) <- PA.readPrimArray drbg 15+        !(GHC.Word.W32# nv6) <- PA.readPrimArray drbg 16+        !(GHC.Word.W32# nv7) <- PA.readPrimArray drbg 17+        let !nv = Registers (# nv0, nv1, nv2, nv3, nv4, nv5, nv6, nv7 #)+            !na = acc <> SHA256.cat nv+            !nl = l + 32+        loop na nv nl+{-# INLINE gen_loop #-}++update+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word32+  -> BS.ByteString+  -> m ()+update drbg provided_data@(BI.PS _ _ l) = do+  !(GHC.Word.W32# k00) <- PA.readPrimArray drbg 02+  !(GHC.Word.W32# k01) <- PA.readPrimArray drbg 03+  !(GHC.Word.W32# k02) <- PA.readPrimArray drbg 04+  !(GHC.Word.W32# k03) <- PA.readPrimArray drbg 05+  !(GHC.Word.W32# k04) <- PA.readPrimArray drbg 06+  !(GHC.Word.W32# k05) <- PA.readPrimArray drbg 07+  !(GHC.Word.W32# k06) <- PA.readPrimArray drbg 08+  !(GHC.Word.W32# k07) <- PA.readPrimArray drbg 09+  !(GHC.Word.W32# v00) <- PA.readPrimArray drbg 10+  !(GHC.Word.W32# v01) <- PA.readPrimArray drbg 11+  !(GHC.Word.W32# v02) <- PA.readPrimArray drbg 12+  !(GHC.Word.W32# v03) <- PA.readPrimArray drbg 13+  !(GHC.Word.W32# v04) <- PA.readPrimArray drbg 14+  !(GHC.Word.W32# v05) <- PA.readPrimArray drbg 15+  !(GHC.Word.W32# v06) <- PA.readPrimArray drbg 16+  !(GHC.Word.W32# v07) <- PA.readPrimArray drbg 17+  let !k0 = Registers (# k00, k01, k02, k03, k04, k05, k06, k07 #)+      !v0 = Registers (# v00, v01, v02, v03, v04, v05, v06, v07 #)+      !kp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 08 --  2 * 4+      !vp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 40 -- 10 * 4+      !sp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 72 -- 18 * 4+  Prim.unsafeIOToPrim $ SHA256._hmac_rsb kp sp k0 v0 0x00 provided_data+  !(GHC.Word.W32# k10) <- PA.readPrimArray drbg 02+  !(GHC.Word.W32# k11) <- PA.readPrimArray drbg 03+  !(GHC.Word.W32# k12) <- PA.readPrimArray drbg 04+  !(GHC.Word.W32# k13) <- PA.readPrimArray drbg 05+  !(GHC.Word.W32# k14) <- PA.readPrimArray drbg 06+  !(GHC.Word.W32# k15) <- PA.readPrimArray drbg 07+  !(GHC.Word.W32# k16) <- PA.readPrimArray drbg 08+  !(GHC.Word.W32# k17) <- PA.readPrimArray drbg 09+  let !k1 = Registers (# k10, k11, k12, k13, k14, k15, k16, k17 #)+  Prim.unsafeIOToPrim $ SHA256._hmac_rr vp sp k1 v0+  if   l == 0+  then pure ()+  else do+    !(GHC.Word.W32# v10) <- PA.readPrimArray drbg 10+    !(GHC.Word.W32# v11) <- PA.readPrimArray drbg 11+    !(GHC.Word.W32# v12) <- PA.readPrimArray drbg 12+    !(GHC.Word.W32# v13) <- PA.readPrimArray drbg 13+    !(GHC.Word.W32# v14) <- PA.readPrimArray drbg 14+    !(GHC.Word.W32# v15) <- PA.readPrimArray drbg 15+    !(GHC.Word.W32# v16) <- PA.readPrimArray drbg 16+    !(GHC.Word.W32# v17) <- PA.readPrimArray drbg 17+    let !v1 = Registers (# v10, v11, v12, v13, v14, v15, v16, v17 #)+    Prim.unsafeIOToPrim $ SHA256._hmac_rsb kp sp k1 v1 0x01 provided_data+    !(GHC.Word.W32# k20) <- PA.readPrimArray drbg 02+    !(GHC.Word.W32# k21) <- PA.readPrimArray drbg 03+    !(GHC.Word.W32# k22) <- PA.readPrimArray drbg 04+    !(GHC.Word.W32# k23) <- PA.readPrimArray drbg 05+    !(GHC.Word.W32# k24) <- PA.readPrimArray drbg 06+    !(GHC.Word.W32# k25) <- PA.readPrimArray drbg 07+    !(GHC.Word.W32# k26) <- PA.readPrimArray drbg 08+    !(GHC.Word.W32# k27) <- PA.readPrimArray drbg 09+    let !k2 = Registers (# k20, k21, k22, k23, k24, k25, k26, k27 #)+    Prim.unsafeIOToPrim $ SHA256._hmac_rr vp sp k2 v1+{-# INLINABLE update #-}++init_counter+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word32+  -> m ()+init_counter drbg = do+  PA.writePrimArray drbg 0 (0x00 :: Word32) -- init high word, counter+  PA.writePrimArray drbg 1 (0x01 :: Word32) -- init low word, counter+{-# INLINE init_counter #-}++read_counter+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word32+  -> m Word64+read_counter drbg = do+  !hi <- PA.readPrimArray drbg 0+  !lo <- PA.readPrimArray drbg 1+  let !ctr = fi hi .<<. 32 .|. fi lo+  pure $! ctr+{-# INLINE read_counter #-}++write_counter+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word32+  -> Word64+  -> m ()+write_counter drbg ctr = do+  let !hi = fi (ctr .>>. 32)+      !lo = fi ctr+  PA.writePrimArray drbg 0 hi+  PA.writePrimArray drbg 1 lo+{-# INLINE write_counter #-}++write_v+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word32+  -> Registers+  -> m ()+write_v drbg (R v0 v1 v2 v3 v4 v5 v6 v7) = do+  PA.writePrimArray drbg 10 (GHC.Word.W32# v0)+  PA.writePrimArray drbg 11 (GHC.Word.W32# v1)+  PA.writePrimArray drbg 12 (GHC.Word.W32# v2)+  PA.writePrimArray drbg 13 (GHC.Word.W32# v3)+  PA.writePrimArray drbg 14 (GHC.Word.W32# v4)+  PA.writePrimArray drbg 15 (GHC.Word.W32# v5)+  PA.writePrimArray drbg 16 (GHC.Word.W32# v6)+  PA.writePrimArray drbg 17 (GHC.Word.W32# v7)+{-# INLINE write_v #-}++-- read secret drbg state (for testing)+_read_v+  :: PrimMonad m+  => DRBG (PrimState m)+  -> m BS.ByteString+_read_v (DRBG drbg) = do+  !v00 <- PA.readPrimArray drbg 10+  !v01 <- PA.readPrimArray drbg 11+  !v02 <- PA.readPrimArray drbg 12+  !v03 <- PA.readPrimArray drbg 13+  !v04 <- PA.readPrimArray drbg 14+  !v05 <- PA.readPrimArray drbg 15+  !v06 <- PA.readPrimArray drbg 16+  !v07 <- PA.readPrimArray drbg 17+  pure . BS.toStrict . BSB.toLazyByteString $ mconcat [+      BSB.word32BE v00+    , BSB.word32BE v01+    , BSB.word32BE v02+    , BSB.word32BE v03+    , BSB.word32BE v04+    , BSB.word32BE v05+    , BSB.word32BE v06+    , BSB.word32BE v07+    ]++-- read secret drbg state (for testing)+_read_k+  :: PrimMonad m+  => DRBG (PrimState m)+  -> m BS.ByteString+_read_k (DRBG drbg) = do+  !k00 <- PA.readPrimArray drbg 02+  !k01 <- PA.readPrimArray drbg 03+  !k02 <- PA.readPrimArray drbg 04+  !k03 <- PA.readPrimArray drbg 05+  !k04 <- PA.readPrimArray drbg 06+  !k05 <- PA.readPrimArray drbg 07+  !k06 <- PA.readPrimArray drbg 08+  !k07 <- PA.readPrimArray drbg 09+  pure . BS.toStrict . BSB.toLazyByteString $ mconcat [+      BSB.word32BE k00+    , BSB.word32BE k01+    , BSB.word32BE k02+    , BSB.word32BE k03+    , BSB.word32BE k04+    , BSB.word32BE k05+    , BSB.word32BE k06+    , BSB.word32BE k07+    ]+

@@ -0,0 +1,373 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module: Crypto.DRBG.HMAC.SHA512+-- Copyright: (c) 2024 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- A pure HMAC-DRBG implementation, as specified by+-- [NIST SP-800-90A](https://nvlpubs.nist.gov/nistpubs/SpecialPublications/NIST.SP.800-90Ar1.pdf).++module Crypto.DRBG.HMAC.SHA512 (+  -- * DRBG and HMAC function types+    DRBG+  , Error(..)++  -- * DRBG interaction+  , new+  , gen+  , reseed+  , wipe++  -- for testing+  , _read_v+  , _read_k+  ) where++import Crypto.DRBG.HMAC.Internal (Error(..), _RESEED_COUNTER, _MAX_BYTES)+import qualified Crypto.Hash.SHA512 as SHA512+import Crypto.Hash.SHA512.Internal (Registers(..))+import qualified Crypto.Hash.SHA512.Internal as SHA512 (cat)+import Control.Monad.Primitive (PrimMonad, PrimState)+import qualified Control.Monad.Primitive as Prim (unsafeIOToPrim)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Internal as BI+import qualified Data.Primitive.PrimArray as PA+import Data.Word (Word64)+import qualified GHC.Word+import qualified Foreign.Ptr as FP++-- api ------------------------------------------------------------------------++-- | A deterministic random bit generator (DRBG).+--+--   Create a DRBG with 'new', and then use and reuse it to generate+--   bytes as needed.+--+--   >>> drbg <- new entropy nonce personalization_string+--   >>> bytes0 <- gen drbg mempty 10+--   >>> bytes1 <- gen drbg mempty 10+--   >>> drbg+--   "<drbg>"++-- layout (Word64 array):+-- index 0: counter+-- indices 1-8: k (8 Word64s = 64 bytes)+-- indices 9-16: v (8 Word64s = 64 bytes)+-- indices 17-32: scratch space (16 Word64s = 128 bytes)+newtype DRBG s = DRBG (PA.MutablePrimArray s Word64)++instance Show (DRBG s) where+  show _ = "<drbg>"++-- | Create a HMAC-SHA512 DRBG from the supplied entropy, nonce, and+--   personalization string.+--+--   The DRBG is returned in any 'PrimMonad', e.g. 'ST s' or 'IO'.+--+--   >>> new entropy nonce personalization_string+--   "<drbg>"+new+  :: PrimMonad m+  => BS.ByteString    -- ^ entropy+  -> BS.ByteString    -- ^ nonce+  -> BS.ByteString    -- ^ personalization string+  -> m (DRBG (PrimState m))+new entropy nonce ps = do+  drbg <- PA.newPinnedPrimArray 33 -- 1 (ctr) + 16 (k, v) + 16 (scratch)+  init_counter drbg+  PA.setPrimArray drbg 01 08 (0x0000000000000000 :: Word64) -- init k+  PA.setPrimArray drbg 09 08 (0x0101010101010101 :: Word64) -- init v+  PA.setPrimArray drbg 17 16 (0x0000000000000000 :: Word64) -- scratch+  update drbg (entropy <> nonce <> ps)+  pure $! DRBG drbg+{-# INLINABLE new #-}++-- | Reseed a DRBG.+--+--   Each DRBG has an internal /reseed counter/ that tracks the number+--   of requests made to the generator (note /requests made/, not bytes+--   generated). SP 800-90A specifies that a HMAC-DRBG should support+--   2 ^ 48 requests before requiring a reseed, so in practice you're+--   unlikely to ever need to use this to actually reset the counter.+--+--   Note however that 'reseed' can be used to implement "explicit"+--   prediction resistance, per SP 800-90A, by injecting entropy generated+--   elsewhere into the DRBG.+--+--   >>> import qualified System.Entropy as E+--   >>> entropy <- E.getEntropy 32+--   >>> reseed entropy addl_bytes drbg+--   "<reseeded drbg>"+reseed+  :: PrimMonad m+  => DRBG (PrimState m)+  -> BS.ByteString+  -> BS.ByteString+  -> m ()+reseed (DRBG drbg) entr addl = do+  update drbg (entr <> addl)+  init_counter drbg+{-# INLINE reseed #-}++-- | Generate bytes from a DRBG, optionally injecting additional bytes+--   per SP 800-90A.+--+--   Per SP 800-90A, the maximum number of bytes that can be requested+--   on any invocation is 65536. Larger requests will return+--   'MaxBytesExceeded'.+--+--   >>> import qualified Data.ByteString.Base16 as B16+--   >>> drbg <- new entropy nonce personalization_string+--   >>> Right bytes0 <- gen drbg addl_bytes 16+--   >>> Right bytes1 <- gen drbg addl_bytes 16+--   >>> B16.encode bytes0+--   "938d6ca6d0b797f7b3c653349d6e3135"+--   >>> B16.encode bytes1+--   "5f379d16de6f2c6f8a35c56f13f9e5a5"+gen+  :: PrimMonad m+  => DRBG (PrimState m)+  -> BS.ByteString+  -> Word64+  -> m (Either Error BS.ByteString)+gen (DRBG drbg) addl@(BI.PS _ _ l) bytes+  | bytes > _MAX_BYTES = pure $! Left MaxBytesExceeded+  | otherwise = do+      ctr <- read_counter drbg+      if   ctr > _RESEED_COUNTER+      then pure $! Left ReseedRequired+      else do+        if l == 0 then pure () else update drbg addl+        !(GHC.Word.W64# k00) <- PA.readPrimArray drbg 01+        !(GHC.Word.W64# k01) <- PA.readPrimArray drbg 02+        !(GHC.Word.W64# k02) <- PA.readPrimArray drbg 03+        !(GHC.Word.W64# k03) <- PA.readPrimArray drbg 04+        !(GHC.Word.W64# k04) <- PA.readPrimArray drbg 05+        !(GHC.Word.W64# k05) <- PA.readPrimArray drbg 06+        !(GHC.Word.W64# k06) <- PA.readPrimArray drbg 07+        !(GHC.Word.W64# k07) <- PA.readPrimArray drbg 08+        !(GHC.Word.W64# v00) <- PA.readPrimArray drbg 09+        !(GHC.Word.W64# v01) <- PA.readPrimArray drbg 10+        !(GHC.Word.W64# v02) <- PA.readPrimArray drbg 11+        !(GHC.Word.W64# v03) <- PA.readPrimArray drbg 12+        !(GHC.Word.W64# v04) <- PA.readPrimArray drbg 13+        !(GHC.Word.W64# v05) <- PA.readPrimArray drbg 14+        !(GHC.Word.W64# v06) <- PA.readPrimArray drbg 15+        !(GHC.Word.W64# v07) <- PA.readPrimArray drbg 16+        let !k0  = Registers (# k00, k01, k02, k03, k04, k05, k06, k07 #)+            !v0  = Registers (# v00, v01, v02, v03, v04, v05, v06, v07 #)+        !res <- gen_loop drbg k0 v0 bytes+        update drbg addl+        write_counter drbg (ctr + 1)+        pure $! Right res+{-# INLINABLE gen #-}++-- | Wipe the state of a DRBG.+--+--   You should call this when you're finished with a DRBG to ensure that its+--   state is wiped from memory.+--+--   >>> drbg <- new mempty mempty mempty+--   >>> Right bytes <- gen drbg addl_bytes 16+--   >>> wipe drbg+--   >>> -- do something with bytes+wipe+  :: PrimMonad m+  => DRBG (PrimState m)+  -> m ()+wipe (DRBG drbg) = do+  init_counter drbg+  PA.setPrimArray drbg 01 08 (0x0000000000000000 :: Word64) -- init k+  PA.setPrimArray drbg 09 08 (0x0101010101010101 :: Word64) -- init v+  PA.setPrimArray drbg 17 16 (0x0000000000000000 :: Word64) -- init scratch+{-# INLINE wipe #-}++-- drbg utilities -------------------------------------------------------------++gen_loop+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word64+  -> Registers+  -> Registers+  -> Word64+  -> m BS.ByteString+gen_loop drbg k0 v0 bytes = loop mempty v0 0 where+  !vp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 72  -- 9 * 8+  !sp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 136 -- 17 * 8+  loop !acc v l+    | l >= bytes = do+        write_v drbg v+        pure acc+    | otherwise = do+        Prim.unsafeIOToPrim $ SHA512._hmac_rr vp sp k0 v+        !(GHC.Word.W64# nv0) <- PA.readPrimArray drbg 09+        !(GHC.Word.W64# nv1) <- PA.readPrimArray drbg 10+        !(GHC.Word.W64# nv2) <- PA.readPrimArray drbg 11+        !(GHC.Word.W64# nv3) <- PA.readPrimArray drbg 12+        !(GHC.Word.W64# nv4) <- PA.readPrimArray drbg 13+        !(GHC.Word.W64# nv5) <- PA.readPrimArray drbg 14+        !(GHC.Word.W64# nv6) <- PA.readPrimArray drbg 15+        !(GHC.Word.W64# nv7) <- PA.readPrimArray drbg 16+        let !nv = Registers (# nv0, nv1, nv2, nv3, nv4, nv5, nv6, nv7 #)+            !na = acc <> SHA512.cat nv+            !nl = l + 64+        loop na nv nl+{-# INLINE gen_loop #-}++update+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word64+  -> BS.ByteString+  -> m ()+update drbg provided_data@(BI.PS _ _ l) = do+  !(GHC.Word.W64# k00) <- PA.readPrimArray drbg 01+  !(GHC.Word.W64# k01) <- PA.readPrimArray drbg 02+  !(GHC.Word.W64# k02) <- PA.readPrimArray drbg 03+  !(GHC.Word.W64# k03) <- PA.readPrimArray drbg 04+  !(GHC.Word.W64# k04) <- PA.readPrimArray drbg 05+  !(GHC.Word.W64# k05) <- PA.readPrimArray drbg 06+  !(GHC.Word.W64# k06) <- PA.readPrimArray drbg 07+  !(GHC.Word.W64# k07) <- PA.readPrimArray drbg 08+  !(GHC.Word.W64# v00) <- PA.readPrimArray drbg 09+  !(GHC.Word.W64# v01) <- PA.readPrimArray drbg 10+  !(GHC.Word.W64# v02) <- PA.readPrimArray drbg 11+  !(GHC.Word.W64# v03) <- PA.readPrimArray drbg 12+  !(GHC.Word.W64# v04) <- PA.readPrimArray drbg 13+  !(GHC.Word.W64# v05) <- PA.readPrimArray drbg 14+  !(GHC.Word.W64# v06) <- PA.readPrimArray drbg 15+  !(GHC.Word.W64# v07) <- PA.readPrimArray drbg 16+  let !k0 = Registers (# k00, k01, k02, k03, k04, k05, k06, k07 #)+      !v0 = Registers (# v00, v01, v02, v03, v04, v05, v06, v07 #)+      !kp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 08  -- 1 * 8+      !vp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 72  -- 9 * 8+      !sp = PA.mutablePrimArrayContents drbg `FP.plusPtr` 136 -- 17 * 8+  Prim.unsafeIOToPrim $ SHA512._hmac_rsb kp sp k0 v0 0x00 provided_data+  !(GHC.Word.W64# k10) <- PA.readPrimArray drbg 01+  !(GHC.Word.W64# k11) <- PA.readPrimArray drbg 02+  !(GHC.Word.W64# k12) <- PA.readPrimArray drbg 03+  !(GHC.Word.W64# k13) <- PA.readPrimArray drbg 04+  !(GHC.Word.W64# k14) <- PA.readPrimArray drbg 05+  !(GHC.Word.W64# k15) <- PA.readPrimArray drbg 06+  !(GHC.Word.W64# k16) <- PA.readPrimArray drbg 07+  !(GHC.Word.W64# k17) <- PA.readPrimArray drbg 08+  let !k1 = Registers (# k10, k11, k12, k13, k14, k15, k16, k17 #)+  Prim.unsafeIOToPrim $ SHA512._hmac_rr vp sp k1 v0+  if   l == 0+  then pure ()+  else do+    !(GHC.Word.W64# v10) <- PA.readPrimArray drbg 09+    !(GHC.Word.W64# v11) <- PA.readPrimArray drbg 10+    !(GHC.Word.W64# v12) <- PA.readPrimArray drbg 11+    !(GHC.Word.W64# v13) <- PA.readPrimArray drbg 12+    !(GHC.Word.W64# v14) <- PA.readPrimArray drbg 13+    !(GHC.Word.W64# v15) <- PA.readPrimArray drbg 14+    !(GHC.Word.W64# v16) <- PA.readPrimArray drbg 15+    !(GHC.Word.W64# v17) <- PA.readPrimArray drbg 16+    let !v1 = Registers (# v10, v11, v12, v13, v14, v15, v16, v17 #)+    Prim.unsafeIOToPrim $ SHA512._hmac_rsb kp sp k1 v1 0x01 provided_data+    !(GHC.Word.W64# k20) <- PA.readPrimArray drbg 01+    !(GHC.Word.W64# k21) <- PA.readPrimArray drbg 02+    !(GHC.Word.W64# k22) <- PA.readPrimArray drbg 03+    !(GHC.Word.W64# k23) <- PA.readPrimArray drbg 04+    !(GHC.Word.W64# k24) <- PA.readPrimArray drbg 05+    !(GHC.Word.W64# k25) <- PA.readPrimArray drbg 06+    !(GHC.Word.W64# k26) <- PA.readPrimArray drbg 07+    !(GHC.Word.W64# k27) <- PA.readPrimArray drbg 08+    let !k2 = Registers (# k20, k21, k22, k23, k24, k25, k26, k27 #)+    Prim.unsafeIOToPrim $ SHA512._hmac_rr vp sp k2 v1+{-# INLINABLE update #-}++init_counter+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word64+  -> m ()+init_counter drbg =+  PA.writePrimArray drbg 0 (0x01 :: Word64)+{-# INLINE init_counter #-}++read_counter+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word64+  -> m Word64+read_counter drbg = PA.readPrimArray drbg 0+{-# INLINE read_counter #-}++write_counter+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word64+  -> Word64+  -> m ()+write_counter drbg = PA.writePrimArray drbg 0+{-# INLINE write_counter #-}++write_v+  :: PrimMonad m+  => PA.MutablePrimArray (PrimState m) Word64+  -> Registers+  -> m ()+write_v drbg (R v0 v1 v2 v3 v4 v5 v6 v7) = do+  PA.writePrimArray drbg 09 (GHC.Word.W64# v0)+  PA.writePrimArray drbg 10 (GHC.Word.W64# v1)+  PA.writePrimArray drbg 11 (GHC.Word.W64# v2)+  PA.writePrimArray drbg 12 (GHC.Word.W64# v3)+  PA.writePrimArray drbg 13 (GHC.Word.W64# v4)+  PA.writePrimArray drbg 14 (GHC.Word.W64# v5)+  PA.writePrimArray drbg 15 (GHC.Word.W64# v6)+  PA.writePrimArray drbg 16 (GHC.Word.W64# v7)+{-# INLINE write_v #-}++-- read secret drbg state (for testing)+_read_v+  :: PrimMonad m+  => DRBG (PrimState m)+  -> m BS.ByteString+_read_v (DRBG drbg) = do+  !v00 <- PA.readPrimArray drbg 09+  !v01 <- PA.readPrimArray drbg 10+  !v02 <- PA.readPrimArray drbg 11+  !v03 <- PA.readPrimArray drbg 12+  !v04 <- PA.readPrimArray drbg 13+  !v05 <- PA.readPrimArray drbg 14+  !v06 <- PA.readPrimArray drbg 15+  !v07 <- PA.readPrimArray drbg 16+  pure . BS.toStrict . BSB.toLazyByteString $ mconcat [+      BSB.word64BE v00+    , BSB.word64BE v01+    , BSB.word64BE v02+    , BSB.word64BE v03+    , BSB.word64BE v04+    , BSB.word64BE v05+    , BSB.word64BE v06+    , BSB.word64BE v07+    ]++-- read secret drbg state (for testing)+_read_k+  :: PrimMonad m+  => DRBG (PrimState m)+  -> m BS.ByteString+_read_k (DRBG drbg) = do+  !k00 <- PA.readPrimArray drbg 01+  !k01 <- PA.readPrimArray drbg 02+  !k02 <- PA.readPrimArray drbg 03+  !k03 <- PA.readPrimArray drbg 04+  !k04 <- PA.readPrimArray drbg 05+  !k05 <- PA.readPrimArray drbg 06+  !k06 <- PA.readPrimArray drbg 07+  !k07 <- PA.readPrimArray drbg 08+  pure . BS.toStrict . BSB.toLazyByteString $ mconcat [+      BSB.word64BE k00+    , BSB.word64BE k01+    , BSB.word64BE k02+    , BSB.word64BE k03+    , BSB.word64BE k04+    , BSB.word64BE k05+    , BSB.word64BE k06+    , BSB.word64BE k07+    ]

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-hmac-drbg-version:            0.2.1+version:            0.3.0 synopsis:           HMAC-based deterministic random bit generator license:            MIT license-file:       LICENSE@@ -31,10 +31,14 @@   if flag(llvm)     ghc-options: -fllvm -O2   exposed-modules:-      Crypto.DRBG.HMAC+      Crypto.DRBG.HMAC.Internal+    , Crypto.DRBG.HMAC.SHA256+    , Crypto.DRBG.HMAC.SHA512   build-depends:       base >= 4.9 && < 5     , bytestring >= 0.9 && < 0.13+    , ppad-sha256 >= 0.3.2 && < 0.4+    , ppad-sha512 >= 0.2.2 && < 0.4     , primitive >= 0.8 && < 0.10  test-suite hmac-drbg-tests@@ -52,8 +56,6 @@     , bytestring     , ppad-base16     , ppad-hmac-drbg-    , ppad-sha256 >= 0.3 && < 0.4-    , ppad-sha512 >= 0.2 && < 0.4     , tasty     , tasty-hunit @@ -71,6 +73,20 @@     , bytestring     , criterion     , ppad-hmac-drbg-    , ppad-sha256 >= 0.3 && < 0.4-    , ppad-sha512 >= 0.2 && < 0.4++benchmark hmac-drbg-weigh+  type:                exitcode-stdio-1.0+  default-language:    Haskell2010+  hs-source-dirs:      bench+  main-is:             Weight.hs++  ghc-options:+    -rtsopts -O2 -Wall++  build-depends:+      base+    , bytestring+    , deepseq+    , ppad-hmac-drbg+    , weigh 

@@ -5,11 +5,11 @@ module Main where  import Control.Applicative ((<|>))-import qualified Crypto.Hash.SHA256 as SHA256-import qualified Crypto.Hash.SHA512 as SHA512-import qualified Crypto.DRBG.HMAC as DRBG+import qualified Crypto.DRBG.HMAC.SHA256 as DRBG256+import qualified Crypto.DRBG.HMAC.SHA512 as DRBG512 import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.ByteString as BS+import Data.Word (Word64) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Base16 as B16 import Test.Tasty@@ -37,18 +37,10 @@    defaultMain (cavp_14_3 sha256_cases sha512_cases) -hmac_sha256 :: BS.ByteString -> BS.ByteString -> BS.ByteString-hmac_sha256 k b = case SHA256.hmac k b of-  SHA256.MAC m -> m--hmac_sha512 :: BS.ByteString -> BS.ByteString -> BS.ByteString-hmac_sha512 k b = case SHA512.hmac k b of-  SHA512.MAC m -> m- cavp_14_3 :: [CaseBlock] -> [CaseBlock] -> TestTree cavp_14_3 cs ds = testGroup "CAVP 14.3" [-    testGroup "HMAC-SHA256" (fmap (execute_caseblock hmac_sha256) cs)-  , testGroup "HMAC-SHA512" (fmap (execute_caseblock hmac_sha512) ds)+    testGroup "HMAC-SHA256" (fmap (execute_caseblock DRBG256.new DRBG256.reseed DRBG256.gen DRBG256._read_v DRBG256._read_k) cs)+  , testGroup "HMAC-SHA512" (fmap (execute_caseblock DRBG512.new DRBG512.reseed DRBG512.gen DRBG512._read_v DRBG512._read_k) ds)   ]  data CaseBlock = CaseBlock {@@ -86,9 +78,16 @@   , caseReturned :: !BS.ByteString   } deriving Show -execute_caseblock :: DRBG.HMAC -> CaseBlock -> TestTree-execute_caseblock hmac CaseBlock {..} =-    testGroup msg (fmap (execute hmac) cb_cases)+execute_caseblock+  :: (BS.ByteString -> BS.ByteString -> BS.ByteString -> IO drbg)+  -> (drbg -> BS.ByteString -> BS.ByteString -> IO ())+  -> (drbg -> BS.ByteString -> Word64 -> IO (Either e BS.ByteString))+  -> (drbg -> IO BS.ByteString)+  -> (drbg -> IO BS.ByteString)+  -> CaseBlock+  -> TestTree+execute_caseblock drbg_new drbg_reseed drbg_gen read_v read_k CaseBlock {..} =+    testGroup msg (fmap (execute drbg_new drbg_reseed drbg_gen read_v read_k) cb_cases)   where     BlockHeader {..} = cb_blockHeader     msg = "bitlens: " <>@@ -99,29 +98,37 @@           "ret " <> show bh_ReturnedBitsLen  -- execute test case-execute :: DRBG.HMAC -> Case -> TestTree-execute hmac Case {..} = testCase ("count " <> show caseCount) $ do+execute+  :: (BS.ByteString -> BS.ByteString -> BS.ByteString -> IO drbg)+  -> (drbg -> BS.ByteString -> BS.ByteString -> IO ())+  -> (drbg -> BS.ByteString -> Word64 -> IO (Either e BS.ByteString))+  -> (drbg -> IO BS.ByteString)+  -> (drbg -> IO BS.ByteString)+  -> Case+  -> TestTree+execute drbg_new drbg_reseed drbg_gen read_v read_k Case {..} =+    testCase ("count " <> show caseCount) $ do   let bytes = fromIntegral (BS.length caseReturned) -  drbg <- DRBG.new hmac caseEntropy0 caseNonce casePs-  v0 <- DRBG._read_v drbg-  k0 <- DRBG._read_k drbg+  drbg <- drbg_new caseEntropy0 caseNonce casePs+  v0 <- read_v drbg+  k0 <- read_k drbg    assertEqual "v0" v0 caseV0   assertEqual "k0" k0 caseK0 -  DRBG.reseed caseEntropy1 caseAddl1 drbg-  Right _ <- DRBG.gen mempty bytes drbg-  v1 <- DRBG._read_v drbg-  k1 <- DRBG._read_k drbg+  drbg_reseed drbg caseEntropy1 caseAddl1+  Right _ <- drbg_gen drbg mempty bytes+  v1 <- read_v drbg+  k1 <- read_k drbg    assertEqual "v1" v1 caseV1   assertEqual "k1" k1 caseK1 -  DRBG.reseed caseEntropy2 caseAddl2 drbg-  Right returned <- DRBG.gen mempty bytes drbg-  v2 <- DRBG._read_v drbg-  k2 <- DRBG._read_k drbg+  drbg_reseed drbg caseEntropy2 caseAddl2+  Right returned <- drbg_gen drbg mempty bytes+  v2 <- read_v drbg+  k2 <- read_k drbg    assertEqual "returned_bytes" returned caseReturned   assertEqual "v2" v2 caseV2