ppad-hmac-drbg 0.1.1 → 0.1.2
raw patch · 5 files changed
+134/−72 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG +4/−0
- bench/Main.hs +14/−6
- lib/Crypto/DRBG/HMAC.hs +50/−31
- ppad-hmac-drbg.cabal +2/−1
- test/Main.hs +64/−34
CHANGELOG view
@@ -1,5 +1,9 @@ # Changelog +- 0.1.2 (2025-02-06)+ * Minor bytestring optimizations for shaving off microseconds in+ certain cases.+ - 0.1.1 (2024-10-07) * Add a basic placeholder 'Show' instance for the DRBG type.
bench/Main.hs view
@@ -7,21 +7,29 @@ import Criterion.Main import qualified Crypto.DRBG.HMAC as DRBG import qualified Crypto.Hash.SHA256 as SHA256+import qualified Crypto.Hash.SHA512 as SHA512 main :: IO () main = do- !drbg <- DRBG.new SHA256.hmac mempty mempty mempty -- no NFData+ !drbg256 <- DRBG.new SHA256.hmac mempty mempty mempty -- no NFData+ !drbg512 <- DRBG.new SHA512.hmac mempty mempty mempty -- no NFData defaultMain [- suite drbg+ suite drbg256 drbg512 ] -suite drbg =+suite drbg256 drbg512 = bgroup "ppad-hmac-drbg" [ bgroup "HMAC-SHA256" [ bench "new" $ whnfAppIO (DRBG.new SHA256.hmac mempty mempty) mempty- , bench "reseed" $ whnfAppIO (DRBG.reseed mempty mempty) drbg- , bench "gen (32B)" $ whnfAppIO (DRBG.gen mempty 32) drbg- , bench "gen (256B)" $ whnfAppIO (DRBG.gen mempty 256) drbg+ , bench "reseed" $ whnfAppIO (DRBG.reseed mempty mempty) drbg256+ , bench "gen (32B)" $ nfAppIO (DRBG.gen mempty 32) drbg256+ , bench "gen (256B)" $ nfAppIO (DRBG.gen mempty 256) drbg256+ ]+ , bgroup "HMAC-SHA512" [+ bench "new" $ whnfAppIO (DRBG.new SHA512.hmac mempty mempty) mempty+ , bench "reseed" $ whnfAppIO (DRBG.reseed mempty mempty) drbg512+ , bench "gen (32B)" $ nfAppIO (DRBG.gen mempty 32) drbg512+ , bench "gen (256B)" $ nfAppIO (DRBG.gen mempty 256) drbg512 ] ]
lib/Crypto/DRBG/HMAC.hs view
@@ -1,7 +1,6 @@ {-# OPTIONS_HADDOCK prune #-} {-# OPTIONS_GHC -funbox-small-strict-fields #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE LambdaCase #-} -- | -- Module: Crypto.DRBG.HMAC@@ -28,6 +27,8 @@ 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) @@ -37,10 +38,15 @@ fi = fromIntegral {-# INLINE fi #-} -toStrict :: BSB.Builder -> BS.ByteString-toStrict = BS.toStrict . BSB.toLazyByteString-{-# INLINE toStrict #-}+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@@ -55,6 +61,13 @@ -- -- Create a DRBG with 'new', and then use and reuse it to generate -- bytes as needed.+--+-- >>> import qualified Crypto.Hash.SHA256 as SHA256+-- >>> drbg <- new SHA256.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@@ -63,7 +76,7 @@ -- DRBG environment data and state data DRBGState = DRBGState !HMACEnv -- hmac function & outlen- !Word64 -- reseed counter+ {-# UNPACK #-} !Word64 -- reseed counter {-# UNPACK #-} !BS.ByteString -- v {-# UNPACK #-} !BS.ByteString -- key @@ -127,6 +140,29 @@ mut <- P.newMutVar drbg pure (DRBG mut) +-- | Generate bytes from a DRBG, optionally injecting additional bytes+-- per SP 800-90A.+--+-- >>> import qualified Data.ByteString.Base16 as B16+-- >>> drbg <- new SHA256.hmac entropy nonce personalization_string+-- >>> bytes0 <- gen addl_bytes 16 drbg+-- >>> 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 BS.ByteString+gen addl bytes (DRBG mut) = do+ drbg0 <- P.readMutVar mut+ let !(Pair bs drbg1) = gen_pure addl bytes drbg0+ P.writeMutVar mut drbg1+ pure bs+ -- | Reseed a DRBG. -- -- Each DRBG has an internal /reseed counter/ that tracks the number@@ -151,29 +187,6 @@ -> m () reseed ent add (DRBG drbg) = P.modifyMutVar' drbg (reseed_pure ent add) --- | Generate bytes from a DRBG, optionally injecting additional bytes--- per SP 800-90A.------ >>> import qualified Data.ByteString.Base16 as B16--- >>> drbg <- new SHA256.hmac entropy nonce personalization_string--- >>> bytes0 <- gen addl_bytes 16 drbg--- >>> 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 BS.ByteString-gen addl bytes (DRBG mut) = do- drbg0 <- P.readMutVar mut- let !(Pair bs drbg1) = gen_pure addl bytes drbg0- P.writeMutVar mut drbg1- pure bs- -- pure drbg interaction ------------------------------------------------------ -- SP 800-90A 10.1.2.2@@ -190,8 +203,12 @@ !v2 = hmac k2 v1 in DRBGState h r v2 k2 where- cat bs byte suf = toStrict $- BSB.byteString bs <> BSB.word8 byte <> BSB.byteString suf+ 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@@ -241,6 +258,8 @@ in loop nacc nlen nv | otherwise =- let facc = toStrict acc+ let facc | bytes < 128 = to_strict_small acc+ | otherwise = to_strict acc in Pair facc (DRBGState h (succ r) vl k1)+{-# INLINE gen_pure #-}
ppad-hmac-drbg.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-hmac-drbg-version: 0.1.1+version: 0.1.2 synopsis: HMAC-based deterministic random bit generator license: MIT license-file: LICENSE@@ -65,4 +65,5 @@ , criterion , ppad-hmac-drbg , ppad-sha256+ , ppad-sha512
test/Main.hs view
@@ -37,12 +37,25 @@ defaultMain (cavp_14_3 sha256_cases sha512_cases) -cavp_14_3 :: [Case] -> [Case] -> TestTree+cavp_14_3 :: [CaseBlock] -> [CaseBlock] -> TestTree cavp_14_3 cs ds = testGroup "CAVP 14.3" [- testGroup "SHA-256" (fmap (execute SHA256.hmac) cs)- , testGroup "SHA-512" (fmap (execute SHA512.hmac) ds)+ testGroup "HMAC-SHA256" (fmap (execute_caseblock SHA256.hmac) cs)+ , testGroup "HMAC-SHA512" (fmap (execute_caseblock SHA512.hmac) ds) ] +data CaseBlock = CaseBlock {+ cb_blockHeader :: !BlockHeader+ , cb_cases :: ![Case]+ } deriving Show++data BlockHeader = BlockHeader {+ bh_EntropyInputLen :: !Int+ , bh_NonceLen :: !Int+ , bh_PersonalizationStringLen :: !Int+ , bh_AdditionalInputLen :: !Int+ , bh_ReturnedBitsLen :: !Int+ } deriving Show+ -- test case spec data Case = Case { caseCount :: !Int@@ -63,9 +76,20 @@ , caseV2 :: !BS.ByteString , caseK2 :: !BS.ByteString , caseReturned :: !BS.ByteString- }- deriving Show+ } deriving Show +execute_caseblock :: DRBG.HMAC -> CaseBlock -> TestTree+execute_caseblock hmac CaseBlock {..} =+ testGroup msg (fmap (execute hmac) cb_cases)+ where+ BlockHeader {..} = cb_blockHeader+ msg = "bitlens: " <>+ "ent " <> show bh_EntropyInputLen <> " " <>+ "non " <> show bh_NonceLen <> " " <>+ "per " <> show bh_PersonalizationStringLen <> " " <>+ "add " <> show bh_AdditionalInputLen <> " " <>+ "ret " <> show bh_ReturnedBitsLen+ -- execute test case execute :: DRBG.HMAC -> Case -> TestTree execute hmac Case {..} = testCase ("count " <> show caseCount) $ do@@ -143,37 +167,43 @@ parse_cases :: A.Parser [Case] parse_cases = parse_case `A.sepBy` A.endOfLine -parse_sha256_header :: A.Parser ()-parse_sha256_header =- A.string "[SHA-256]" *> A.endOfLine- *> A.skipMany1 boring- *> A.endOfLine- where- boring = A.char '[' *> A.skipWhile (/= ']') *> A.char ']' *> A.endOfLine--parse_sha256_block :: A.Parser [Case]-parse_sha256_block =- parse_sha256_header- *> parse_cases- <* A.endOfLine+parse_header :: BS.ByteString -> A.Parser BlockHeader+parse_header sha = do+ A.string ("[" <> sha <> "]") *> A.endOfLine+ A.string "[PredictionResistance = True]" *> A.endOfLine+ bh_EntropyInputLen <-+ A.string "[EntropyInputLen = " *> A.decimal <* A.string "]" <* A.endOfLine+ bh_NonceLen <-+ A.string "[NonceLen = " *> A.decimal <* A.string "]" <* A.endOfLine+ bh_PersonalizationStringLen <-+ A.string "[PersonalizationStringLen = " *> A.decimal <* A.string "]"+ <* A.endOfLine+ bh_AdditionalInputLen <-+ A.string "[AdditionalInputLen = " *> A.decimal <* A.string "]"+ <* A.endOfLine+ bh_ReturnedBitsLen <-+ A.string "[ReturnedBitsLen = " *> A.decimal <* A.string "]"+ <* A.endOfLine+ A.endOfLine+ pure BlockHeader {..} -parse_sha256_blocks :: A.Parser [Case]-parse_sha256_blocks = concat <$> A.many1 parse_sha256_block+parse_sha256_block :: A.Parser CaseBlock+parse_sha256_block = do+ cb_blockHeader <- parse_header "SHA-256"+ cb_cases <- parse_cases+ A.endOfLine+ pure CaseBlock {..} -parse_sha512_header :: A.Parser ()-parse_sha512_header =- A.string "[SHA-512]" *> A.endOfLine- *> A.skipMany1 boring- *> A.endOfLine- where- boring = A.char '[' *> A.skipWhile (/= ']') *> A.char ']' *> A.endOfLine+parse_sha256_blocks :: A.Parser [CaseBlock]+parse_sha256_blocks = A.many1 parse_sha256_block -parse_sha512_block :: A.Parser [Case]-parse_sha512_block =- parse_sha512_header- *> parse_cases- <* A.endOfLine+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 [Case]-parse_sha512_blocks = concat <$> A.many1 parse_sha512_block+parse_sha512_blocks :: A.Parser [CaseBlock]+parse_sha512_blocks = A.many1 parse_sha512_block