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