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