HMAC.hs (7710B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# OPTIONS_GHC -funbox-small-strict-fields #-} 3 {-# LANGUAGE BangPatterns #-} 4 {-# LANGUAGE LambdaCase #-} 5 6 -- | 7 -- Module: Crypto.DRBG.HMAC 8 -- Copyright: (c) 2024 Jared Tobin 9 -- License: MIT 10 -- Maintainer: Jared Tobin <jared@ppad.tech> 11 -- 12 -- A pure HMAC-DRBG implementation, as specified by 13 -- [NIST SP-800-90A](https://nvlpubs.nist.gov/nistpubs/SpecialPublications/NIST.SP.800-90Ar1.pdf). 14 15 module Crypto.DRBG.HMAC ( 16 -- * DRBG and HMAC function types 17 DRBG 18 , _read_v 19 , _read_k 20 , HMAC 21 22 -- * DRBG interaction 23 , new 24 , gen 25 , reseed 26 ) where 27 28 import Control.Monad.Primitive (PrimMonad, PrimState) 29 import qualified Data.ByteString as BS 30 import qualified Data.ByteString.Builder as BSB 31 import qualified Data.Primitive.MutVar as P 32 import Data.Word (Word64) 33 34 -- keystroke savers and utilities --------------------------------------------- 35 36 fi :: (Integral a, Num b) => a -> b 37 fi = fromIntegral 38 {-# INLINE fi #-} 39 40 toStrict :: BSB.Builder -> BS.ByteString 41 toStrict = BS.toStrict . BSB.toLazyByteString 42 {-# INLINE toStrict #-} 43 44 -- dumb strict pair 45 data Pair a b = Pair !a !b 46 deriving Show 47 48 -- types ---------------------------------------------------------------------- 49 50 -- see SP 800-90A table 2 51 _RESEED_COUNTER :: Word64 52 _RESEED_COUNTER = (2 :: Word64) ^ (48 :: Word64) 53 54 -- | A deterministic random bit generator (DRBG). 55 -- 56 -- Create a DRBG with 'new', and then use and reuse it to generate 57 -- bytes as needed. 58 -- 59 -- >>> import qualified Crypto.Hash.SHA256 as SHA256 60 -- >>> drbg <- new SHA256.hmac entropy nonce personalization_string 61 -- >>> bytes0 <- gen addl_bytes 16 drbg 62 -- >>> bytes1 <- gen addl_bytes 16 drbg 63 -- >>> drbg 64 -- "<drbg>" 65 newtype DRBG s = DRBG (P.MutVar s DRBGState) 66 67 instance Show (DRBG s) where 68 show _ = "<drbg>" 69 70 -- DRBG environment data and state 71 data DRBGState = DRBGState 72 !HMACEnv -- hmac function & outlen 73 {-# UNPACK #-} !Word64 -- reseed counter 74 {-# UNPACK #-} !BS.ByteString -- v 75 {-# UNPACK #-} !BS.ByteString -- key 76 77 -- NB following synonym really only exists to make haddocks more 78 -- readable 79 80 -- | A HMAC function, taking a key as the first argument and the input 81 -- value as the second, producing a MAC digest. 82 -- 83 -- >>> import qualified Crypto.Hash.SHA256 as SHA256 84 -- >>> :t SHA256.hmac 85 -- SHA256.hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString 86 type HMAC = BS.ByteString -> BS.ByteString -> BS.ByteString 87 88 -- HMAC function and its associated outlength 89 data HMACEnv = HMACEnv 90 !HMAC 91 {-# UNPACK #-} !Word64 92 93 -- the following convenience functions are useful for testing 94 95 _read_v 96 :: PrimMonad m 97 => DRBG (PrimState m) 98 -> m BS.ByteString 99 _read_v (DRBG mut) = do 100 DRBGState _ _ v _ <- P.readMutVar mut 101 pure v 102 103 _read_k 104 :: PrimMonad m 105 => DRBG (PrimState m) 106 -> m BS.ByteString 107 _read_k (DRBG mut) = do 108 DRBGState _ _ _ k <- P.readMutVar mut 109 pure k 110 111 -- drbg interaction ------------------------------------------------------ 112 113 -- | Create a DRBG from the supplied HMAC function, entropy, nonce, and 114 -- personalization string. 115 -- 116 -- You can instantiate the DRBG using any appropriate HMAC function; 117 -- it should merely take a key and value as input, as is standard, and 118 -- return a MAC digest, each being a strict 'ByteString'. 119 -- 120 -- The DRBG is returned in any 'PrimMonad', e.g. 'ST' or 'IO'. 121 -- 122 -- >>> import qualified Crypto.Hash.SHA256 as SHA256 123 -- >>> new SHA256.hmac entropy nonce personalization_string 124 -- "<drbg>" 125 new 126 :: PrimMonad m 127 => HMAC -- ^ HMAC function 128 -> BS.ByteString -- ^ entropy 129 -> BS.ByteString -- ^ nonce 130 -> BS.ByteString -- ^ personalization string 131 -> m (DRBG (PrimState m)) 132 new hmac entropy nonce ps = do 133 let !drbg = new_pure hmac entropy nonce ps 134 mut <- P.newMutVar drbg 135 pure (DRBG mut) 136 137 -- | Generate bytes from a DRBG, optionally injecting additional bytes 138 -- per SP 800-90A. 139 -- 140 -- >>> import qualified Data.ByteString.Base16 as B16 141 -- >>> drbg <- new SHA256.hmac entropy nonce personalization_string 142 -- >>> bytes0 <- gen addl_bytes 16 drbg 143 -- >>> bytes1 <- gen addl_bytes 16 drbg 144 -- >>> B16.encode bytes0 145 -- "938d6ca6d0b797f7b3c653349d6e3135" 146 -- >>> B16.encode bytes1 147 -- "5f379d16de6f2c6f8a35c56f13f9e5a5" 148 gen 149 :: PrimMonad m 150 => BS.ByteString -- ^ additional bytes to inject 151 -> Word64 -- ^ number of bytes to generate 152 -> DRBG (PrimState m) 153 -> m BS.ByteString 154 gen addl bytes (DRBG mut) = do 155 drbg0 <- P.readMutVar mut 156 let !(Pair bs drbg1) = gen_pure addl bytes drbg0 157 P.writeMutVar mut drbg1 158 pure bs 159 160 -- | Reseed a DRBG. 161 -- 162 -- Each DRBG has an internal /reseed counter/ that tracks the number 163 -- of requests made to the generator (note /requests made/, not bytes 164 -- generated). SP 800-90A specifies that a HMAC-DRBG should support 165 -- 2 ^ 48 requests before requiring a reseed, so in practice you're 166 -- unlikely to ever need to use this to actually reset the counter. 167 -- 168 -- Note however that 'reseed' can be used to implement "explicit" 169 -- prediction resistance, per SP 800-90A, by injecting entropy generated 170 -- elsewhere into the DRBG. 171 -- 172 -- >>> import qualified System.Entropy as E 173 -- >>> entropy <- E.getEntropy 32 174 -- >>> reseed entropy addl_bytes drbg 175 -- "<reseeded drbg>" 176 reseed 177 :: PrimMonad m 178 => BS.ByteString -- ^ entropy to inject 179 -> BS.ByteString -- ^ additional bytes to inject 180 -> DRBG (PrimState m) 181 -> m () 182 reseed ent add (DRBG drbg) = P.modifyMutVar' drbg (reseed_pure ent add) 183 184 -- pure drbg interaction ------------------------------------------------------ 185 186 -- SP 800-90A 10.1.2.2 187 update_pure 188 :: BS.ByteString 189 -> DRBGState 190 -> DRBGState 191 update_pure provided_data (DRBGState h@(HMACEnv hmac _) r v0 k0) = 192 let !k1 = hmac k0 (cat v0 0x00 provided_data) 193 !v1 = hmac k1 v0 194 in if BS.null provided_data 195 then DRBGState h r v1 k1 196 else let !k2 = hmac k1 (cat v1 0x01 provided_data) 197 !v2 = hmac k2 v1 198 in DRBGState h r v2 k2 199 where 200 cat bs byte suf = toStrict $ 201 BSB.byteString bs <> BSB.word8 byte <> BSB.byteString suf 202 203 -- SP 800-90A 10.1.2.3 204 new_pure 205 :: HMAC -- HMAC function 206 -> BS.ByteString -- entropy 207 -> BS.ByteString -- nonce 208 -> BS.ByteString -- personalization string 209 -> DRBGState 210 new_pure hmac entropy nonce ps = 211 let !drbg = DRBGState (HMACEnv hmac outlen) 1 v0 k0 212 in update_pure seed_material drbg 213 where 214 seed_material = entropy <> nonce <> ps 215 outlen = fi (BS.length (hmac mempty mempty)) 216 k0 = BS.replicate (fi outlen) 0x00 217 v0 = BS.replicate (fi outlen) 0x01 218 219 -- SP 800-90A 10.1.2.4 220 reseed_pure :: BS.ByteString -> BS.ByteString -> DRBGState -> DRBGState 221 reseed_pure entropy addl drbg = 222 let !(DRBGState h _ v k) = update_pure (entropy <> addl) drbg 223 in DRBGState h 1 v k 224 225 -- SP 800-90A 10.1.2.5 226 gen_pure 227 :: BS.ByteString 228 -> Word64 229 -> DRBGState 230 -> Pair BS.ByteString DRBGState 231 gen_pure addl bytes drbg0@(DRBGState h@(HMACEnv hmac outlen) _ _ _) 232 | r > _RESEED_COUNTER = error "ppad-hmac-drbg: reseed required" 233 | otherwise = 234 let !(Pair temp drbg1) = loop mempty 0 v1 235 returned_bits = BS.take (fi bytes) temp 236 drbg = update_pure addl drbg1 237 in Pair returned_bits drbg 238 where 239 !(DRBGState _ r v1 k1) 240 | BS.null addl = drbg0 241 | otherwise = update_pure addl drbg0 242 243 loop !acc !len !vl 244 | len < bytes = 245 let nv = hmac k1 vl 246 nacc = acc <> BSB.byteString nv 247 nlen = len + outlen 248 in loop nacc nlen nv 249 250 | otherwise = 251 let facc = toStrict acc 252 in Pair facc (DRBGState h (succ r) vl k1) 253