ppad-hmac-drbg (empty) → 0.1.1
raw patch · 6 files changed
+548/−0 lines, 6 filesdep +attoparsecdep +basedep +base16-bytestring
Dependencies added: attoparsec, base, base16-bytestring, bytestring, criterion, ppad-hmac-drbg, ppad-sha256, ppad-sha512, primitive, tasty, tasty-hunit
Files
- CHANGELOG +8/−0
- LICENSE +20/−0
- bench/Main.hs +27/−0
- lib/Crypto/DRBG/HMAC.hs +246/−0
- ppad-hmac-drbg.cabal +68/−0
- test/Main.hs +179/−0
+ CHANGELOG view
@@ -0,0 +1,8 @@+# Changelog++- 0.1.1 (2024-10-07)+ * Add a basic placeholder 'Show' instance for the DRBG type.++- 0.1.0 (2024-10-05)+ * Initial release.+
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2024 Jared Tobin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Main.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Criterion.Main+import qualified Crypto.DRBG.HMAC as DRBG+import qualified Crypto.Hash.SHA256 as SHA256++main :: IO ()+main = do+ !drbg <- DRBG.new SHA256.hmac mempty mempty mempty -- no NFData+ defaultMain [+ suite drbg+ ]++suite drbg =+ 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+ ]+ ]+
+ lib/Crypto/DRBG/HMAC.hs view
@@ -0,0 +1,246 @@+{-# OPTIONS_HADDOCK prune #-}+{-# OPTIONS_GHC -funbox-small-strict-fields #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}++-- |+-- 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+ , _read_v+ , _read_k+ , HMAC++ -- * 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.Primitive.MutVar as P+import Data.Word (Word64)++-- keystroke savers and utilities ---------------------------------------------++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}++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 ----------------------------------------------------------------------++-- 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.+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+ !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+-- >>> :t SHA256.hmac+-- SHA256.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+-- >>> new SHA256.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)++-- | 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)++-- | 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+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 = toStrict $+ BSB.byteString bs <> BSB.word8 byte <> BSB.byteString suf++-- 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+ -> Pair BS.ByteString DRBGState+gen_pure addl bytes drbg0@(DRBGState h@(HMACEnv hmac outlen) _ _ _)+ | r > _RESEED_COUNTER = error "ppad-hmac-drbg: reseed required"+ | otherwise =+ let !(Pair temp drbg1) = loop mempty 0 v1+ returned_bits = BS.take (fi bytes) temp+ drbg = update_pure addl drbg1+ in 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 = toStrict acc+ in Pair facc (DRBGState h (succ r) vl k1)+
+ ppad-hmac-drbg.cabal view
@@ -0,0 +1,68 @@+cabal-version: 3.0+name: ppad-hmac-drbg+version: 0.1.1+synopsis: HMAC-based deterministic random bit generator+license: MIT+license-file: LICENSE+author: Jared Tobin+maintainer: jared@ppad.tech+category: Cryptography+build-type: Simple+tested-with: GHC == { 9.8.1 }+extra-doc-files: CHANGELOG+description:+ A pure implementation of the HMAC-DRBG CSPRNG, as specified by NIST-SP+ 800-90A.++source-repository head+ type: git+ location: git.ppad.tech/hmac-drbg.git++library+ default-language: Haskell2010+ hs-source-dirs: lib+ ghc-options:+ -Wall+ exposed-modules:+ Crypto.DRBG.HMAC+ build-depends:+ base >= 4.9 && < 5+ , bytestring >= 0.9 && < 0.13+ , primitive >= 0.8 && < 0.10++test-suite hmac-drbg-tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs++ ghc-options:+ -rtsopts -Wall -O2++ build-depends:+ attoparsec+ , base+ , base16-bytestring+ , bytestring+ , ppad-hmac-drbg+ , ppad-sha256+ , ppad-sha512+ , tasty+ , tasty-hunit++benchmark hmac-drbg-bench+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++ ghc-options:+ -rtsopts -O2 -Wall++ build-depends:+ base+ , bytestring+ , criterion+ , ppad-hmac-drbg+ , ppad-sha256+
+ test/Main.hs view
@@ -0,0 +1,179 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++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 Data.Attoparsec.ByteString.Char8 as A+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Base16 as B16+import Test.Tasty+import Test.Tasty.HUnit++-- CAVP source:+--+-- 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+--+-- spec:+--+-- https://csrc.nist.gov/CSRC/media/Projects/Cryptographic-Algorithm-Validation-Program/documents/drbg/DRBGVS.pdf++main :: IO ()+main = do+ sha256_vectors <- BS.readFile "etc/HMAC_DRBG_SHA256.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)++cavp_14_3 :: [Case] -> [Case] -> 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)+ ]++-- test case spec+data Case = Case {+ caseCount :: !Int+ -- instantiate+ , caseEntropy0 :: !BS.ByteString+ , caseNonce :: !BS.ByteString+ , casePs :: !BS.ByteString+ , caseV0 :: !BS.ByteString+ , caseK0 :: !BS.ByteString+ -- first generate+ , caseAddl1 :: !BS.ByteString+ , caseEntropy1 :: !BS.ByteString+ , caseV1 :: !BS.ByteString+ , caseK1 :: !BS.ByteString+ -- second generate+ , caseAddl2 :: !BS.ByteString+ , caseEntropy2 :: !BS.ByteString+ , caseV2 :: !BS.ByteString+ , caseK2 :: !BS.ByteString+ , caseReturned :: !BS.ByteString+ }+ deriving Show++-- execute test case+execute :: DRBG.HMAC -> Case -> TestTree+execute hmac 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++ assertEqual "v0" v0 caseV0+ assertEqual "k0" k0 caseK0++ DRBG.reseed caseEntropy1 caseAddl1 drbg+ _ <- DRBG.gen mempty bytes drbg+ v1 <- DRBG._read_v drbg+ k1 <- DRBG._read_k drbg++ assertEqual "v1" v1 caseV1+ assertEqual "k1" k1 caseK1++ DRBG.reseed caseEntropy2 caseAddl2 drbg+ returned <- DRBG.gen mempty bytes drbg+ v2 <- DRBG._read_v drbg+ k2 <- DRBG._read_k drbg++ assertEqual "returned_bytes" returned caseReturned+ assertEqual "v2" v2 caseV2+ assertEqual "k2" k2 caseK2++-- CAVP vector parsers++hex_digit :: A.Parser Char+hex_digit = A.satisfy hd where+ hd c =+ (c >= '0' && c <= '9')+ || (c >= 'a' && c <= 'f')+ || (c >= 'A' && c <= 'F')++parse_hex :: A.Parser BS.ByteString+parse_hex = (B16.decodeLenient . B8.pack) <$> A.many1 hex_digit++parse_kv :: BS.ByteString -> A.Parser BS.ByteString+parse_kv k =+ A.string k+ *> A.skipSpace+ *> A.char '='+ *> parse_v+ where+ parse_v =+ (A.endOfLine *> pure mempty)+ <|> (A.skipSpace *> parse_hex <* A.endOfLine)++parse_case :: A.Parser Case+parse_case = do+ caseCount <- A.string "COUNT = " *> A.decimal <* A.endOfLine+ caseEntropy0 <- parse_kv "EntropyInput"+ caseNonce <- parse_kv "Nonce"+ casePs <- parse_kv "PersonalizationString"+ A.string "** INSTANTIATE:" *> A.endOfLine+ caseV0 <- parse_kv "\tV"+ caseK0 <- parse_kv "\tKey"+ caseAddl1 <- parse_kv "AdditionalInput"+ caseEntropy1 <- parse_kv "EntropyInputPR"+ A.string "** GENERATE (FIRST CALL):" *> A.endOfLine+ caseV1 <- parse_kv "\tV"+ caseK1 <- parse_kv "\tKey"+ caseAddl2 <- parse_kv "AdditionalInput"+ caseEntropy2 <- parse_kv "EntropyInputPR"+ caseReturned <- parse_kv "ReturnedBits"+ A.string "** GENERATE (SECOND CALL):" *> A.endOfLine+ caseV2 <- parse_kv "\tV"+ caseK2 <- parse_kv "\tKey"+ return Case {..}++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_sha256_blocks :: A.Parser [Case]+parse_sha256_blocks = concat <$> A.many1 parse_sha256_block++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_sha512_block :: A.Parser [Case]+parse_sha512_block =+ parse_sha512_header+ *> parse_cases+ <* A.endOfLine++parse_sha512_blocks :: A.Parser [Case]+parse_sha512_blocks = concat <$> A.many1 parse_sha512_block+