commit d63ae899fe36f64586ea7d35884558a99653736b
parent f3f2ea5d9e1058547bdaac505420ab976f542039
Author: Jared Tobin <jared@jtobin.io>
Date: Mon, 30 Sep 2024 16:16:13 +0400
lib: misc heavy dev
Diffstat:
4 files changed, 138 insertions(+), 57 deletions(-)
diff --git a/.ghci b/.ghci
@@ -0,0 +1,2 @@
+:set prompt "> "
+:set -XOverloadedStrings
diff --git a/lib/Crypto/DRBG/HMAC.hs b/lib/Crypto/DRBG/HMAC.hs
@@ -2,108 +2,124 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
-module Crypto.DRBG.HMAC where
+module Crypto.DRBG.HMAC (
+ DRBG
+ , read_v
+ , read_key
+
+ , new
+ , gen
+ , reseed
+ ) where
-import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import Data.Word (Word64)
--- keystroke saver
+-- keystroke savers and utilities ---------------------------------------------
+
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
{-# INLINE fi #-}
-_RESEED_INTERVAL :: Word64
-_RESEED_INTERVAL = (2 :: Word64) ^ (48 :: Word64)
+toStrict :: BSB.Builder -> BS.ByteString
+toStrict = BS.toStrict . BSB.toLazyByteString
+{-# INLINE toStrict #-}
+
+-- dumb strict pair
+data Pair a b = Pair !a !b
+ deriving Show
+
+-- types ----------------------------------------------------------------------
+-- HMAC function and its associated outlength
data HMAC = HMAC
- !(BS.ByteString -> BS.ByteString -> BS.ByteString)
+ !(BS.ByteString -> BS.ByteString -> BS.ByteString)
{-# UNPACK #-} !Word64
+-- DRBG environment data and state
data DRBG = DRBG
- !HMAC -- hmac function & outlen
- {-# UNPACK #-} !BS.ByteString -- v
- {-# UNPACK #-} !BS.ByteString -- key
- {-# UNPACK #-} !Word64 -- reseed_counter
+ !HMAC -- hmac function & outlen
+ {-# UNPACK #-} !BS.ByteString -- v
+ {-# UNPACK #-} !BS.ByteString -- key
-instance Show DRBG where
- show (DRBG _ v k r) = "DRBG " <> show v <> " " <> show k <> " " <> show r
+-- | Read the 'V' value from the DRBG state.
+read_v :: DRBG -> BS.ByteString
+read_v (DRBG _ v _) = v
--- dumb strict pair
-data Pair a b = Pair !a !b
- deriving Show
+-- | Read the 'Key' value from the DRBG state.
+read_key :: DRBG -> BS.ByteString
+read_key (DRBG _ _ key) = key
+
+-- drbg interaction -----------------------------------------------------------
update
:: BS.ByteString
-> DRBG
-> DRBG
-update provided_data (DRBG h@(HMAC hmac _) v0 k0 r) =
- let !k1 = hmac k0 (suf 0x00 v0)
+update provided_data (DRBG h@(HMAC hmac _) v0 k0) =
+ let !k1 = hmac k0 (cat v0 0x00 provided_data)
!v1 = hmac k1 v0
in if BS.null provided_data
- then (DRBG h v1 k1 r)
- else let !k2 = hmac k1 (suf 0x01 v1)
+ then (DRBG h v1 k1)
+ else let !k2 = hmac k1 (cat v1 0x01 provided_data)
!v2 = hmac k2 v1
- in DRBG h v2 k2 r
+ in DRBG h v2 k2
where
- suf byte bs = BS.toStrict
- . BSB.toLazyByteString
- $ BSB.byteString bs <> BSB.word8 byte <> BSB.byteString provided_data
-
-instantiate
- :: (BS.ByteString -> BS.ByteString -> BS.ByteString)
- -> BS.ByteString
- -> BS.ByteString
- -> BS.ByteString
+ cat bs byte suf = toStrict $
+ BSB.byteString bs <> BSB.word8 byte <> BSB.byteString suf
+
+-- | Create a DRBG from the provided HMAC function, entropy, nonce, and
+-- personalization string.
+new
+ :: (BS.ByteString -> BS.ByteString -> BS.ByteString) -- HMAC function
+ -> BS.ByteString -- entropy
+ -> BS.ByteString -- nonce
+ -> BS.ByteString -- personalization string
-> DRBG
-instantiate hmac entropy nonce ps =
- let drbg = DRBG (HMAC hmac outlen) v0 k0 1
+new hmac entropy nonce ps =
+ let !drbg = DRBG (HMAC hmac outlen) v0 k0
in update seed_material drbg
where
seed_material = entropy <> nonce <> ps
- outlen = fi (BS.length (hmac mempty mempty)) -- UX hack, costs 1 hmac call
+ outlen = fi (BS.length (hmac mempty mempty))
k0 = BS.replicate (fi outlen) 0x00
v0 = BS.replicate (fi outlen) 0x01
-reseed :: DRBG -> BS.ByteString -> BS.ByteString -> DRBG
-reseed drbg entropy addl =
- let !(DRBG hmac v k _) = update seed_material drbg
- in DRBG hmac v k 1
- where
- seed_material = entropy <> addl
+-- | Inject entropy and additional bytes into a DRBG.
+--
+-- Note that we don't support "proper" reseeding (i.e., we don't track
+-- a reseed counter), but this can be used for injecting entropy per
+-- spec.
+reseed :: BS.ByteString -> BS.ByteString -> DRBG -> DRBG
+reseed entropy addl drbg = update (entropy <> addl) drbg
-generate
+gen
:: BS.ByteString
-> Word64
-> DRBG
-> (BS.ByteString, DRBG)
-generate addl bytes drbg0@(DRBG h@(HMAC hmac outlen) _ _ r)
- | r > _RESEED_INTERVAL = error "ppad-hmac-drbg: DRBG reseed required"
- | otherwise =
- let !(Pair temp drbg1) = go mempty 0 v1
-
- !returned_bits = BS.take (fi bytes) temp
- !drbg2 = update addl drbg1
-
- in (returned_bits, drbg2)
+gen addl bytes drbg0@(DRBG h@(HMAC hmac outlen) _ _) =
+ let !(Pair temp drbg1) = loop mempty 0 v1
+ !returned_bits = BS.take (fi bytes) temp
+ !drbg = update addl drbg1
+ in (returned_bits, drbg)
where
- !(DRBG _ v1 k1 _)
+ !(DRBG _ v1 k1)
| BS.null addl = drbg0
| otherwise = update addl drbg0
- go !acc !len !vl
+ loop !acc !len !vl
| len < bytes =
let nv = hmac k1 vl
nacc = acc <> BSB.byteString nv
nlen = len + outlen
- in go nacc nlen nv
+ in loop nacc nlen nv
- -- take opportunity to update reseed_counter here
| otherwise =
- let facc = BS.toStrict . BSB.toLazyByteString $ acc
- in Pair facc (DRBG h vl k1 (succ r))
+ let facc = toStrict acc
+ in Pair facc (DRBG h vl k1)
+
+-- XX maybe want some sort of primitive convenience here
--- XX test against
--- https://raw.githubusercontent.com/coruus/nist-testvectors/refs/heads/master/csrc.nist.gov/groups/STM/cavp/documents/drbg/drbgtestvectors/drbgvectors_pr_true/HMAC_DRBG.txt
diff --git a/ppad-hmac-drbg.cabal b/ppad-hmac-drbg.cabal
@@ -28,7 +28,6 @@ library
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
- , ppad-sha256 >= 0.1.0 && < 0.2.0
test-suite hmac-drbg-tests
type: exitcode-stdio-1.0
@@ -44,6 +43,7 @@ test-suite hmac-drbg-tests
, base16-bytestring
, bytestring
, ppad-hmac-drbg
+ , ppad-sha256 >= 0.1.0 && < 0.2.0
, tasty
, tasty-hunit
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,7 +1,70 @@
+{-# LANGUAGE OverloadedStrings #-}
module Main where
+import qualified Crypto.Hash.SHA256 as SHA256
import qualified Crypto.DRBG.HMAC as DRBG
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
+import Data.Word (Word64)
+
+-- XX test against
+-- https://raw.githubusercontent.com/coruus/nist-testvectors/refs/heads/master/csrc.nist.gov/groups/STM/cavp/documents/drbg/drbgtestvectors/drbgvectors_pr_true/HMAC_DRBG.txt
+
+fun0 = SHA256.hmac
+add0 :: BS.ByteString
+add0 = mempty
+byts :: Word64
+byts = 128
+
+ent0 :: BS.ByteString
+ent0 = "9969e54b4703ff31785b879a7e5c0eae0d3e309559e9fe96b0676d49d591ea4d"
+non0 :: BS.ByteString
+non0 = "07d20d46d064757d3023cac2376127ab"
+per0 :: BS.ByteString
+per0 = mempty
+ent1 :: BS.ByteString
+ent1 = "c60f2999100f738c10f74792676a3fc4a262d13721798046e29a295181569f54"
+ent2 :: BS.ByteString
+ent2 = "c11d4524c9071bd3096015fcf7bc24a607f22fa065c937658a2a77a8699089f4"
+
+test func addl bytes i_ent i_non i_per g_ent0 g_ent1 = do
+ let d_ent = B16.decodeLenient i_ent
+ d_non = B16.decodeLenient i_non
+ d_per = B16.decodeLenient i_per
+ drbg0 = DRBG.new func d_ent d_non d_per
+ v0 = DRBG.read_v drbg0
+ k0 = DRBG.read_key drbg0
+
+ putStrLn $ "upon instantiation:"
+ print $ " v: " <> B16.encode v0
+ print $ " k: " <> B16.encode k0
+
+ let d_ent0 = B16.decodeLenient g_ent0
+ drbg1 = DRBG.reseed mempty d_ent0 drbg0
+ (_, drbg2) = DRBG.gen addl bytes drbg1
+ v1 = DRBG.read_v drbg2
+ k1 = DRBG.read_key drbg2
+
+ putStrLn $ "after first gen:"
+ print $ " v: " <> B16.encode v1
+ print $ " k: " <> B16.encode k1
+
+ let d_ent1 = B16.decodeLenient g_ent1
+ drbg3 = DRBG.reseed mempty d_ent1 drbg2
+ (res, drbg4) = DRBG.gen addl bytes drbg3
+ v2 = DRBG.read_v drbg4
+ k2 = DRBG.read_key drbg4
+
+ putStrLn $ "after second gen:"
+ print $ " v: " <> B16.encode v2
+ print $ " k: " <> B16.encode k2
+
+ putStrLn mempty
+
+ putStrLn $ "returned bytes:"
+ print $ " " <> B16.encode res
+
+main :: IO ()
+main = test fun0 add0 byts ent0 non0 per0 ent1 ent2
