commit 57d23beaa8c350af45ac44baf53466ecdc4ed30c
parent abe61aab2315f33f41c0c83e73436f6926a3d8a5
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 11 Jan 2026 23:41:19 +0400
lib: major refactoring
Diffstat:
8 files changed, 482 insertions(+), 127 deletions(-)
diff --git a/README.md b/README.md
@@ -76,28 +76,30 @@ Current benchmark figures on an M4 Silicon MacBook Air look like (use
```
benchmarking ppad-hmac-drbg/HMAC-SHA256/new
- time 655.0 ns (654.5 ns .. 655.5 ns)
- 1.000 R² (1.000 R² .. 1.000 R²)
- mean 655.3 ns (655.0 ns .. 655.7 ns)
- std dev 1.283 ns (1.052 ns .. 1.567 ns)
+ time 225.2 ns (224.3 ns .. 226.4 ns)
+ 0.999 R² (0.998 R² .. 1.000 R²)
+ mean 233.4 ns (227.9 ns .. 241.8 ns)
+ std dev 23.42 ns (12.58 ns .. 34.87 ns)
+ variance introduced by outliers: 90% (severely inflated)
benchmarking ppad-hmac-drbg/HMAC-SHA256/reseed
- time 428.6 ns (428.4 ns .. 429.0 ns)
+ time 211.3 ns (210.6 ns .. 211.9 ns)
1.000 R² (1.000 R² .. 1.000 R²)
- mean 429.7 ns (429.3 ns .. 431.0 ns)
- std dev 2.365 ns (1.310 ns .. 4.581 ns)
+ mean 210.7 ns (210.3 ns .. 211.1 ns)
+ std dev 1.381 ns (1.133 ns .. 1.766 ns)
benchmarking ppad-hmac-drbg/HMAC-SHA256/gen (32B)
- time 707.5 ns (707.2 ns .. 707.9 ns)
- 1.000 R² (1.000 R² .. 1.000 R²)
- mean 707.8 ns (707.5 ns .. 708.2 ns)
- std dev 1.043 ns (859.5 ps .. 1.334 ns)
+ time 367.3 ns (366.4 ns .. 368.3 ns)
+ 0.999 R² (0.999 R² .. 1.000 R²)
+ mean 375.9 ns (370.3 ns .. 388.7 ns)
+ std dev 28.42 ns (13.66 ns .. 55.18 ns)
+ variance introduced by outliers: 83% (severely inflated)
benchmarking ppad-hmac-drbg/HMAC-SHA256/gen (256B)
- time 2.106 μs (2.104 μs .. 2.110 μs)
+ time 1.472 μs (1.468 μs .. 1.476 μs)
1.000 R² (1.000 R² .. 1.000 R²)
- mean 2.111 μs (2.109 μs .. 2.113 μs)
- std dev 6.256 ns (5.144 ns .. 7.439 ns)
+ mean 1.470 μs (1.465 μs .. 1.474 μs)
+ std dev 15.77 ns (12.15 ns .. 21.36 ns)
```
You should compile with the 'llvm' flag (and ensure that
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -5,40 +5,29 @@
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 DRBG
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 <- DRBG.new mempty mempty mempty
+ -- !drbg512 <- DRBG.new mempty mempty mempty
defaultMain [
- suite drbg256 drbg512
+ suite drbg256
]
-suite drbg256 drbg512 =
+suite drbg256 =
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
- ]
- , 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 (DRBG.new mempty mempty) mempty
+ , bench "reseed" $ whnfAppIO (DRBG.reseed drbg256 mempty) mempty
+ , bench "gen (32B)" $ whnfAppIO (DRBG.gen drbg256 mempty) 32
+ , bench "gen (256B)" $ whnfAppIO (DRBG.gen drbg256 mempty) 256
]
+ -- , bgroup "HMAC-SHA512" [
+ -- bench "new" $ whnfAppIO (DRBG.new mempty mempty) mempty
+ -- , bench "reseed" $ whnfAppIO (DRBG.reseed drbg512 mempty) mempty
+ -- , bench "gen (32B)" $ whnfAppIO (DRBG.gen drbg512 mempty) 32
+ -- , bench "gen (256B)" $ whnfAppIO (DRBG.gen drbg512 mempty) 256
+ -- ]
]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -1,15 +1,15 @@
-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# 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 as DRBG
-import qualified Crypto.Hash.SHA256 as SHA256
-import qualified Crypto.Hash.SHA512 as SHA512
-import qualified Data.ByteString as BS
+import qualified Crypto.DRBG.HMAC.SHA256 as DRBG
import Weigh
instance NFData (DRBG.DRBG s) where
@@ -18,31 +18,12 @@ instance NFData (DRBG.DRBG s) where
instance NFData DRBG.Error where
rnf e = e `seq` ()
-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
-
--- note that 'weigh' doesn't work properly in a repl
main :: IO ()
main = do
- !drbg256 <- DRBG.new hmac_sha256 mempty mempty mempty
- !drbg512 <- DRBG.new hmac_sha512 mempty mempty mempty
+ !drbg <- DRBG.new mempty mempty mempty
mainWith $ do
- sha256 drbg256
- sha512 drbg512
-
-sha256 drbg = wgroup "HMAC-SHA256" $ do
- io "new" (DRBG.new hmac_sha256 mempty mempty) mempty
- io "reseed" (DRBG.reseed mempty mempty) drbg
- io "gen (32B)" (DRBG.gen mempty 32) drbg
- io "gen (256B)" (DRBG.gen mempty 256) drbg
-
-sha512 drbg = wgroup "HMAC-SHA512" $ do
- io "new" (DRBG.new hmac_sha512 mempty mempty) mempty
- io "reseed" (DRBG.reseed mempty mempty) drbg
- io "gen (32B)" (DRBG.gen mempty 32) drbg
- io "gen (256B)" (DRBG.gen mempty 256) drbg
+ wgroup "HMAC-SHA256" $ do
+ io "new" (DRBG.new mempty mempty) mempty
+ io "reseed" (DRBG.reseed drbg mempty) mempty
+ io "gen (32B)" (DRBG.gen drbg mempty) 32
+ io "gen (256B)" (DRBG.gen drbg mempty) 256
diff --git a/flake.lock b/flake.lock
@@ -105,18 +105,14 @@
]
},
"locked": {
- "lastModified": 1768121850,
- "narHash": "sha256-RxgAI88nZi4o4xYj1v+GC0X5E9adae12dDSmv/GFu2Y=",
- "ref": "master",
- "rev": "916595b21319ca270ce8beb9c742bf7e632cccc9",
- "revCount": 118,
- "type": "git",
- "url": "git://git.ppad.tech/sha256.git"
+ "lastModified": 1769922202,
+ "narHash": "sha256-c4kWgel9W3BBv9R+fwgUGgtfXfE9fJaw9a51zOIOSNY=",
+ "path": "/Users/jtobin/src/ppad/sha256",
+ "type": "path"
},
"original": {
- "ref": "master",
- "type": "git",
- "url": "git://git.ppad.tech/sha256.git"
+ "path": "/Users/jtobin/src/ppad/sha256",
+ "type": "path"
}
},
"ppad-sha512": {
diff --git a/flake.nix b/flake.nix
@@ -14,9 +14,11 @@
inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
};
ppad-sha256 = {
- type = "git";
- url = "git://git.ppad.tech/sha256.git";
- ref = "master";
+ # XX for development
+ url = "path:/Users/jtobin/src/ppad/sha256";
+ # type = "git";
+ # url = "git://git.ppad.tech/sha256.git";
+ # ref = "master";
inputs.ppad-base16.follows = "ppad-base16";
inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
};
diff --git a/lib/Crypto/DRBG/HMAC/SHA256.hs b/lib/Crypto/DRBG/HMAC/SHA256.hs
@@ -0,0 +1,398 @@
+{-# 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 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 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)
+{-# NOINLINE _RESEED_COUNTER #-}
+
+-- | 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 > 0x10000 = 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_unsafe 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_unsafe 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_unsafe 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_unsafe 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_unsafe 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
+ ]
+
diff --git a/ppad-hmac-drbg.cabal b/ppad-hmac-drbg.cabal
@@ -32,9 +32,12 @@ library
ghc-options: -fllvm -O2
exposed-modules:
Crypto.DRBG.HMAC
+ , Crypto.DRBG.HMAC.SHA256
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
+ , ppad-sha256 >= 0.3 && < 0.4
+ , ppad-sha512 >= 0.2 && < 0.4
, primitive >= 0.8 && < 0.10
test-suite hmac-drbg-tests
@@ -52,8 +55,6 @@ test-suite hmac-drbg-tests
, bytestring
, ppad-base16
, ppad-hmac-drbg
- , ppad-sha256 >= 0.3 && < 0.4
- , ppad-sha512 >= 0.2 && < 0.4
, tasty
, tasty-hunit
@@ -71,8 +72,6 @@ benchmark hmac-drbg-bench
, 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
@@ -88,7 +87,5 @@ benchmark hmac-drbg-weigh
, bytestring
, deepseq
, ppad-hmac-drbg
- , ppad-sha256 >= 0.3 && < 0.4
- , ppad-sha512 >= 0.2 && < 0.4
, weigh
diff --git a/test/Main.hs b/test/Main.hs
@@ -5,9 +5,7 @@
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 DRBG
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
@@ -26,29 +24,21 @@ import Test.Tasty.HUnit
main :: IO ()
main = do
sha256_vectors <- BS.readFile "etc/HMAC_DRBG_SHA256.txt"
- sha512_vectors <- BS.readFile "etc/HMAC_DRBG_SHA512.txt"
+ -- sha512_vectors <- BS.readFile "etc/HMAC_DRBG_SHA512.txt"
let sha256_cases = case A.parseOnly parse_sha256_blocks sha256_vectors of
Left _ -> error "ppad-hmac-drbg (test): parse error"
Right cs -> cs
- sha512_cases = case A.parseOnly parse_sha512_blocks sha512_vectors of
- Left _ -> error "ppad-hmac-drbg (test): parse error"
- Right cs -> cs
-
- 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
+ -- sha512_cases = case A.parseOnly parse_sha512_blocks sha512_vectors of
+ -- Left _ -> error "ppad-hmac-drbg (test): parse error"
+ -- Right cs -> cs
-hmac_sha512 :: BS.ByteString -> BS.ByteString -> BS.ByteString
-hmac_sha512 k b = case SHA512.hmac k b of
- SHA512.MAC m -> m
+ defaultMain (cavp_14_3 sha256_cases)
-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)
+cavp_14_3 :: [CaseBlock] -> TestTree
+cavp_14_3 cs = testGroup "CAVP 14.3" [
+ testGroup "HMAC-SHA256" (fmap execute_caseblock cs)
+ -- , testGroup "HMAC-SHA512" (fmap execute_caseblock ds)
]
data CaseBlock = CaseBlock {
@@ -86,9 +76,9 @@ data Case = Case {
, caseReturned :: !BS.ByteString
} deriving Show
-execute_caseblock :: DRBG.HMAC -> CaseBlock -> TestTree
-execute_caseblock hmac CaseBlock {..} =
- testGroup msg (fmap (execute hmac) cb_cases)
+execute_caseblock :: CaseBlock -> TestTree
+execute_caseblock CaseBlock {..} =
+ testGroup msg (fmap execute cb_cases)
where
BlockHeader {..} = cb_blockHeader
msg = "bitlens: " <>
@@ -99,27 +89,27 @@ execute_caseblock hmac CaseBlock {..} =
"ret " <> show bh_ReturnedBitsLen
-- execute test case
-execute :: DRBG.HMAC -> Case -> TestTree
-execute hmac Case {..} = testCase ("count " <> show caseCount) $ do
+execute :: Case -> TestTree
+execute Case {..} = testCase ("count " <> show caseCount) $ do
let bytes = fromIntegral (BS.length caseReturned)
- drbg <- DRBG.new hmac caseEntropy0 caseNonce casePs
+ drbg <- DRBG.new caseEntropy0 caseNonce casePs
v0 <- DRBG._read_v drbg
k0 <- DRBG._read_k drbg
assertEqual "v0" v0 caseV0
assertEqual "k0" k0 caseK0
- DRBG.reseed caseEntropy1 caseAddl1 drbg
- Right _ <- DRBG.gen mempty bytes drbg
+ DRBG.reseed drbg caseEntropy1 caseAddl1
+ Right _ <- DRBG.gen drbg mempty bytes
v1 <- DRBG._read_v drbg
k1 <- DRBG._read_k drbg
assertEqual "v1" v1 caseV1
assertEqual "k1" k1 caseK1
- DRBG.reseed caseEntropy2 caseAddl2 drbg
- Right returned <- DRBG.gen mempty bytes drbg
+ DRBG.reseed drbg caseEntropy2 caseAddl2
+ Right returned <- DRBG.gen drbg mempty bytes
v2 <- DRBG._read_v drbg
k2 <- DRBG._read_k drbg
@@ -208,13 +198,13 @@ parse_sha256_block = do
parse_sha256_blocks :: A.Parser [CaseBlock]
parse_sha256_blocks = A.many1 parse_sha256_block
-parse_sha512_block :: A.Parser CaseBlock
-parse_sha512_block = do
- cb_blockHeader <- parse_header "SHA-512"
- cb_cases <- parse_cases
- A.endOfLine
- pure CaseBlock {..}
+-- parse_sha512_block :: A.Parser CaseBlock
+-- parse_sha512_block = do
+-- cb_blockHeader <- parse_header "SHA-512"
+-- cb_cases <- parse_cases
+-- A.endOfLine
+-- pure CaseBlock {..}
-parse_sha512_blocks :: A.Parser [CaseBlock]
-parse_sha512_blocks = A.many1 parse_sha512_block
+-- parse_sha512_blocks :: A.Parser [CaseBlock]
+-- parse_sha512_blocks = A.many1 parse_sha512_block
