diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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. diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -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 ] ] diff --git a/lib/Crypto/DRBG/HMAC.hs b/lib/Crypto/DRBG/HMAC.hs --- a/lib/Crypto/DRBG/HMAC.hs +++ b/lib/Crypto/DRBG/HMAC.hs @@ -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 +-- "" 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 #-} diff --git a/ppad-hmac-drbg.cabal b/ppad-hmac-drbg.cabal --- a/ppad-hmac-drbg.cabal +++ b/ppad-hmac-drbg.cabal @@ -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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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