RIPEMD160.hs (18234B)
1 {-# LANGUAGE BangPatterns #-} 2 {-# LANGUAGE RecordWildCards #-} 3 {-# LANGUAGE ViewPatterns #-} 4 5 -- | 6 -- Module: Crypto.Hash.RIPEMD160 7 -- Copyright: (c) 2024 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Pure RIPEMD-160 and HMAC-RIPEMD160 implementations for 12 -- strict and lazy ByteStrings. 13 14 -- for spec, see 15 -- 16 -- https://homes.esat.kuleuven.be/~bosselae/ripemd160/pdf/AB-9601/AB-9601.pdf 17 18 module Crypto.Hash.RIPEMD160 ( 19 -- * RIPEMD-160 message digest functions 20 hash 21 , hash_lazy 22 23 -- * RIPEMD160-based MAC functions 24 , hmac 25 , hmac_lazy 26 ) where 27 28 import qualified Data.Bits as B 29 import Data.Bits ((.|.), (.&.)) 30 import qualified Data.ByteString as BS 31 import qualified Data.ByteString.Builder as BSB 32 import qualified Data.ByteString.Builder.Extra as BE 33 import qualified Data.ByteString.Internal as BI 34 import qualified Data.ByteString.Lazy as BL 35 import qualified Data.ByteString.Lazy.Internal as BLI 36 import qualified Data.ByteString.Unsafe as BU 37 import Data.Word (Word32, Word64) 38 import Foreign.ForeignPtr (plusForeignPtr) 39 40 -- preliminary utils 41 42 -- keystroke saver 43 fi :: (Integral a, Num b) => a -> b 44 fi = fromIntegral 45 {-# INLINE fi #-} 46 47 -- parse strict ByteString in LE order to Word32 (verbatim from 48 -- Data.Binary) 49 -- 50 -- invariant: 51 -- the input bytestring is at least 32 bits in length 52 unsafe_word32le :: BS.ByteString -> Word32 53 unsafe_word32le s = 54 (fi (s `BU.unsafeIndex` 3) `B.unsafeShiftL` 24) .|. 55 (fi (s `BU.unsafeIndex` 2) `B.unsafeShiftL` 16) .|. 56 (fi (s `BU.unsafeIndex` 1) `B.unsafeShiftL` 8) .|. 57 (fi (s `BU.unsafeIndex` 0)) 58 {-# INLINE unsafe_word32le #-} 59 60 -- utility types for more efficient ByteString management 61 62 data SSPair = SSPair 63 {-# UNPACK #-} !BS.ByteString 64 {-# UNPACK #-} !BS.ByteString 65 66 data SLPair = SLPair {-# UNPACK #-} !BS.ByteString !BL.ByteString 67 68 data WSPair = WSPair {-# UNPACK #-} !Word32 {-# UNPACK #-} !BS.ByteString 69 70 -- unsafe version of splitAt that does no bounds checking 71 -- 72 -- invariant: 73 -- 0 <= n <= l 74 unsafe_splitAt :: Int -> BS.ByteString -> SSPair 75 unsafe_splitAt n (BI.BS x l) = 76 SSPair (BI.BS x n) (BI.BS (plusForeignPtr x n) (l - n)) 77 78 -- variant of Data.ByteString.Lazy.splitAt that returns the initial 79 -- component as a strict, unboxed ByteString 80 splitAt64 :: BL.ByteString -> SLPair 81 splitAt64 = splitAt' (64 :: Int) where 82 splitAt' _ BLI.Empty = SLPair mempty BLI.Empty 83 splitAt' n (BLI.Chunk c@(BI.PS _ _ l) cs) = 84 if n < l 85 then 86 -- n < BS.length c, so unsafe_splitAt is safe 87 let !(SSPair c0 c1) = unsafe_splitAt n c 88 in SLPair c0 (BLI.Chunk c1 cs) 89 else 90 let SLPair cs' cs'' = splitAt' (n - l) cs 91 in SLPair (c <> cs') cs'' 92 93 -- variant of Data.ByteString.splitAt that behaves like an incremental 94 -- Word32 parser 95 -- 96 -- invariant: 97 -- the input bytestring is at least 32 bits in length 98 unsafe_parseWsPair :: BS.ByteString -> WSPair 99 unsafe_parseWsPair (BI.BS x l) = 100 WSPair (unsafe_word32le (BI.BS x 4)) (BI.BS (plusForeignPtr x 4) (l - 4)) 101 {-# INLINE unsafe_parseWsPair #-} 102 103 -- message padding and parsing 104 105 -- this is the standard padding for merkle-damgård constructions; see e.g. 106 -- 107 -- https://datatracker.ietf.org/doc/html/rfc1320 108 -- https://datatracker.ietf.org/doc/html/rfc6234 109 -- 110 -- for equivalent padding specifications for MD4 and SHA2, but note that 111 -- RIPEMD (and MD4) use little-endian word encodings 112 113 -- k such that (l + 1 + k) mod 64 = 56 114 sol :: Word64 -> Word64 115 sol l = 116 let r = 56 - fi l `mod` 64 - 1 :: Integer -- fi prevents underflow 117 in fi (if r < 0 then r + 64 else r) 118 119 pad :: BS.ByteString -> BS.ByteString 120 pad m@(BI.PS _ _ (fi -> l)) = BL.toStrict . BSB.toLazyByteString $ padded where 121 padded = BSB.byteString m <> fill (sol l) (BSB.word8 0x80) 122 fill j !acc 123 | j == 0 = acc <> BSB.word64LE (l * 8) 124 | otherwise = fill (pred j) (acc <> BSB.word8 0x00) 125 126 pad_lazy :: BL.ByteString -> BL.ByteString 127 pad_lazy (BL.toChunks -> m) = BL.fromChunks (walk 0 m) where 128 walk !l bs = case bs of 129 (c:cs) -> c : walk (l + fi (BS.length c)) cs 130 [] -> padding l (sol l) (BSB.word8 0x80) 131 132 padding l k bs 133 | k == 0 = 134 pure 135 . BL.toStrict 136 -- more efficient for small builder 137 . BE.toLazyByteStringWith 138 (BE.safeStrategy 128 BE.smallChunkSize) mempty 139 $ bs <> BSB.word64LE (l * 8) 140 | otherwise = 141 let nacc = bs <> BSB.word8 0x00 142 in padding l (pred k) nacc 143 144 -- initialization 145 146 data Registers = Registers { 147 h0 :: !Word32 148 , h1 :: !Word32 149 , h2 :: !Word32 150 , h3 :: !Word32 151 , h4 :: !Word32 152 } deriving Show 153 154 iv :: Registers 155 iv = Registers 0x67452301 0xEFCDAB89 0x98BADCFE 0x10325476 0xC3D2E1F0 156 157 -- processing 158 159 data Block = Block { 160 m00 :: !Word32, m01 :: !Word32, m02 :: !Word32, m03 :: !Word32 161 , m04 :: !Word32, m05 :: !Word32, m06 :: !Word32, m07 :: !Word32 162 , m08 :: !Word32, m09 :: !Word32, m10 :: !Word32, m11 :: !Word32 163 , m12 :: !Word32, m13 :: !Word32, m14 :: !Word32, m15 :: !Word32 164 } deriving Show 165 166 -- parse strict bytestring to block 167 -- 168 -- invariant: 169 -- the input bytestring is exactly 512 bits long 170 unsafe_parse :: BS.ByteString -> Block 171 unsafe_parse bs = 172 let !(WSPair m00 t00) = unsafe_parseWsPair bs 173 !(WSPair m01 t01) = unsafe_parseWsPair t00 174 !(WSPair m02 t02) = unsafe_parseWsPair t01 175 !(WSPair m03 t03) = unsafe_parseWsPair t02 176 !(WSPair m04 t04) = unsafe_parseWsPair t03 177 !(WSPair m05 t05) = unsafe_parseWsPair t04 178 !(WSPair m06 t06) = unsafe_parseWsPair t05 179 !(WSPair m07 t07) = unsafe_parseWsPair t06 180 !(WSPair m08 t08) = unsafe_parseWsPair t07 181 !(WSPair m09 t09) = unsafe_parseWsPair t08 182 !(WSPair m10 t10) = unsafe_parseWsPair t09 183 !(WSPair m11 t11) = unsafe_parseWsPair t10 184 !(WSPair m12 t12) = unsafe_parseWsPair t11 185 !(WSPair m13 t13) = unsafe_parseWsPair t12 186 !(WSPair m14 t14) = unsafe_parseWsPair t13 187 !(WSPair m15 t15) = unsafe_parseWsPair t14 188 in if BS.null t15 189 then Block {..} 190 else error "ppad-ripemd160: internal error (bytes remaining)" 191 192 -- nonlinear functions at bit level 193 f0, f1, f2, f3, f4 :: Word32 -> Word32 -> Word32 -> Word32 194 f0 x y z = x `B.xor` y `B.xor` z 195 {-# INLINE f0 #-} 196 f1 x y z = (x .&. y) .|. (B.complement x .&. z) 197 {-# INLINE f1 #-} 198 f2 x y z = (x .|. B.complement y) `B.xor` z 199 {-# INLINE f2 #-} 200 f3 x y z = (x .&. z) .|. (y .&. B.complement z) 201 {-# INLINE f3 #-} 202 f4 x y z = x `B.xor` (y .|. B.complement z) 203 {-# INLINE f4 #-} 204 205 -- constants 206 k0, k1, k2, k3, k4 :: Word32 207 k0 = 0x00000000 -- 00 <= j <= 15 208 k1 = 0x5A827999 -- 16 <= j <= 31 209 k2 = 0x6ED9EBA1 -- 32 <= j <= 47 210 k3 = 0x8F1BBCDC -- 48 <= j <= 63 211 k4 = 0xA953FD4E -- 64 <= j <= 79 212 213 k0', k1', k2', k3', k4' :: Word32 214 k0' = 0x50A28BE6 -- 00 <= j <= 15 215 k1' = 0x5C4DD124 -- 16 <= j <= 31 216 k2' = 0x6D703EF3 -- 32 <= j <= 47 217 k3' = 0x7A6D76E9 -- 48 <= j <= 63 218 k4' = 0x00000000 -- 64 <= j <= 79 219 220 -- strict registers pair 221 data Pair = Pair !Registers !Registers 222 deriving Show 223 224 round1, round2, round3, round4, round5 :: 225 Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair 226 227 round1 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 228 let t = B.rotateL (a + f0 b c d + x + k0) s + e 229 r0 = Registers e t b (B.rotateL c 10) d 230 t' = B.rotateL (a' + f4 b' c' d' + x' + k0') s' + e' 231 r1 = Registers e' t' b' (B.rotateL c' 10) d' 232 in Pair r0 r1 233 234 round2 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 235 let t = B.rotateL (a + f1 b c d + x + k1) s + e 236 r0 = Registers e t b (B.rotateL c 10) d 237 t' = B.rotateL (a' + f3 b' c' d' + x' + k1') s' + e' 238 r1 = Registers e' t' b' (B.rotateL c' 10) d' 239 in Pair r0 r1 240 241 round3 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 242 let t = B.rotateL (a + f2 b c d + x + k2) s + e 243 r0 = Registers e t b (B.rotateL c 10) d 244 t' = B.rotateL (a' + f2 b' c' d' + x' + k2') s' + e' 245 r1 = Registers e' t' b' (B.rotateL c' 10) d' 246 in Pair r0 r1 247 248 round4 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 249 let t = B.rotateL (a + f3 b c d + x + k3) s + e 250 r0 = Registers e t b (B.rotateL c 10) d 251 t' = B.rotateL (a' + f1 b' c' d' + x' + k3') s' + e' 252 r1 = Registers e' t' b' (B.rotateL c' 10) d' 253 in Pair r0 r1 254 255 round5 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 256 let t = B.rotateL (a + f4 b c d + x + k4) s + e 257 r0 = Registers e t b (B.rotateL c 10) d 258 t' = B.rotateL (a' + f0 b' c' d' + x' + k4') s' + e' 259 r1 = Registers e' t' b' (B.rotateL c' 10) d' 260 in Pair r0 r1 261 262 block_hash :: Registers -> Block -> Registers 263 block_hash reg@Registers {..} Block {..} = 264 -- round 1 265 -- 266 -- r(j) = j (0 ≤ j ≤ 15) 267 -- r'(0..15) = 5, 14, 7, 0, 9, 2, 11, 4, 13, 6, 15, 8, 1, 10, 3, 12 268 -- s(0..15) = 11, 14, 15, 12, 5, 8, 7, 9, 11, 13, 14, 15, 6, 7, 9, 8 269 -- s'(0..15) = 8, 9, 9, 11, 13, 15, 15, 5, 7, 7, 8, 11, 14, 14, 12, 6 270 let !(Pair l00 r00) = round1 m00 m05 reg reg 11 08 271 !(Pair l01 r01) = round1 m01 m14 l00 r00 14 09 272 !(Pair l02 r02) = round1 m02 m07 l01 r01 15 09 273 !(Pair l03 r03) = round1 m03 m00 l02 r02 12 11 274 !(Pair l04 r04) = round1 m04 m09 l03 r03 05 13 275 !(Pair l05 r05) = round1 m05 m02 l04 r04 08 15 276 !(Pair l06 r06) = round1 m06 m11 l05 r05 07 15 277 !(Pair l07 r07) = round1 m07 m04 l06 r06 09 05 278 !(Pair l08 r08) = round1 m08 m13 l07 r07 11 07 279 !(Pair l09 r09) = round1 m09 m06 l08 r08 13 07 280 !(Pair l10 r10) = round1 m10 m15 l09 r09 14 08 281 !(Pair l11 r11) = round1 m11 m08 l10 r10 15 11 282 !(Pair l12 r12) = round1 m12 m01 l11 r11 06 14 283 !(Pair l13 r13) = round1 m13 m10 l12 r12 07 14 284 !(Pair l14 r14) = round1 m14 m03 l13 r13 09 12 285 !(Pair l15 r15) = round1 m15 m12 l14 r14 08 06 286 287 -- round 2 288 -- 289 -- r(16..31) = 7, 4, 13, 1, 10, 6, 15, 3, 12, 0, 9, 5, 2, 14, 11, 8 290 -- r'(16..31) = 6, 11, 3, 7, 0, 13, 5, 10, 14, 15, 8, 12, 4, 9, 1, 2 291 -- s(16..31) = 7, 6, 8, 13, 11, 9, 7, 15, 7, 12, 15, 9, 11, 7, 13, 12 292 -- s'(16..31) = 9, 13, 15, 7, 12, 8, 9, 11, 7, 7, 12, 7, 6, 15, 13, 11 293 !(Pair l16 r16) = round2 m07 m06 l15 r15 07 09 294 !(Pair l17 r17) = round2 m04 m11 l16 r16 06 13 295 !(Pair l18 r18) = round2 m13 m03 l17 r17 08 15 296 !(Pair l19 r19) = round2 m01 m07 l18 r18 13 07 297 !(Pair l20 r20) = round2 m10 m00 l19 r19 11 12 298 !(Pair l21 r21) = round2 m06 m13 l20 r20 09 08 299 !(Pair l22 r22) = round2 m15 m05 l21 r21 07 09 300 !(Pair l23 r23) = round2 m03 m10 l22 r22 15 11 301 !(Pair l24 r24) = round2 m12 m14 l23 r23 07 07 302 !(Pair l25 r25) = round2 m00 m15 l24 r24 12 07 303 !(Pair l26 r26) = round2 m09 m08 l25 r25 15 12 304 !(Pair l27 r27) = round2 m05 m12 l26 r26 09 07 305 !(Pair l28 r28) = round2 m02 m04 l27 r27 11 06 306 !(Pair l29 r29) = round2 m14 m09 l28 r28 07 15 307 !(Pair l30 r30) = round2 m11 m01 l29 r29 13 13 308 !(Pair l31 r31) = round2 m08 m02 l30 r30 12 11 309 310 -- round 3 311 -- 312 -- r(32..47) = 3, 10, 14, 4, 9, 15, 8, 1, 2, 7, 0, 6, 13, 11, 5, 12 313 -- r'(32..47) = 15, 5, 1, 3, 7, 14, 6, 9, 11, 8, 12, 2, 10, 0, 4, 13 314 -- s(32..47) = 11, 13, 6, 7, 14, 9, 13, 15, 14, 8, 13, 6, 5, 12, 7, 5 315 -- s'(32..47) = 9, 7, 15, 11, 8, 6, 6, 14, 12, 13, 5, 14, 13, 13, 7, 5 316 !(Pair l32 r32) = round3 m03 m15 l31 r31 11 09 317 !(Pair l33 r33) = round3 m10 m05 l32 r32 13 07 318 !(Pair l34 r34) = round3 m14 m01 l33 r33 06 15 319 !(Pair l35 r35) = round3 m04 m03 l34 r34 07 11 320 !(Pair l36 r36) = round3 m09 m07 l35 r35 14 08 321 !(Pair l37 r37) = round3 m15 m14 l36 r36 09 06 322 !(Pair l38 r38) = round3 m08 m06 l37 r37 13 06 323 !(Pair l39 r39) = round3 m01 m09 l38 r38 15 14 324 !(Pair l40 r40) = round3 m02 m11 l39 r39 14 12 325 !(Pair l41 r41) = round3 m07 m08 l40 r40 08 13 326 !(Pair l42 r42) = round3 m00 m12 l41 r41 13 05 327 !(Pair l43 r43) = round3 m06 m02 l42 r42 06 14 328 !(Pair l44 r44) = round3 m13 m10 l43 r43 05 13 329 !(Pair l45 r45) = round3 m11 m00 l44 r44 12 13 330 !(Pair l46 r46) = round3 m05 m04 l45 r45 07 07 331 !(Pair l47 r47) = round3 m12 m13 l46 r46 05 05 332 333 -- round 4 334 -- 335 -- r(48..63) = 1, 9, 11, 10, 0, 8, 12, 4, 13, 3, 7, 15, 14, 5, 6, 2 336 -- r'(48..63) = 8, 6, 4, 1, 3, 11, 15, 0, 5, 12, 2, 13, 9, 7, 10, 14 337 -- s(48..63) = 11, 12, 14, 15, 14, 15, 9, 8, 9, 14, 5, 6, 8, 6, 5, 12 338 -- s'(48..63) = 15, 5, 8, 11, 14, 14, 6, 14, 6, 9, 12, 9, 12, 5, 15, 8 339 !(Pair l48 r48) = round4 m01 m08 l47 r47 11 15 340 !(Pair l49 r49) = round4 m09 m06 l48 r48 12 05 341 !(Pair l50 r50) = round4 m11 m04 l49 r49 14 08 342 !(Pair l51 r51) = round4 m10 m01 l50 r50 15 11 343 !(Pair l52 r52) = round4 m00 m03 l51 r51 14 14 344 !(Pair l53 r53) = round4 m08 m11 l52 r52 15 14 345 !(Pair l54 r54) = round4 m12 m15 l53 r53 09 06 346 !(Pair l55 r55) = round4 m04 m00 l54 r54 08 14 347 !(Pair l56 r56) = round4 m13 m05 l55 r55 09 06 348 !(Pair l57 r57) = round4 m03 m12 l56 r56 14 09 349 !(Pair l58 r58) = round4 m07 m02 l57 r57 05 12 350 !(Pair l59 r59) = round4 m15 m13 l58 r58 06 09 351 !(Pair l60 r60) = round4 m14 m09 l59 r59 08 12 352 !(Pair l61 r61) = round4 m05 m07 l60 r60 06 05 353 !(Pair l62 r62) = round4 m06 m10 l61 r61 05 15 354 !(Pair l63 r63) = round4 m02 m14 l62 r62 12 08 355 356 -- round 5 357 -- 358 -- r(64..79) = 4, 0, 5, 9, 7, 12, 2, 10, 14, 1, 3, 8, 11, 6, 15, 13 359 -- r'(64..79) = 12, 15, 10, 4, 1, 5, 8, 7, 6, 2, 13, 14, 0, 3, 9, 11 360 -- s(64..79) = 9, 15, 5, 11, 6, 8, 13, 12, 5, 12, 13, 14, 11, 8, 5, 6 361 -- s'(64..79) = 8, 5, 12, 9, 12, 5, 14, 6, 8, 13, 6, 5, 15, 13, 11, 11 362 !(Pair l64 r64) = round5 m04 m12 l63 r63 09 08 363 !(Pair l65 r65) = round5 m00 m15 l64 r64 15 05 364 !(Pair l66 r66) = round5 m05 m10 l65 r65 05 12 365 !(Pair l67 r67) = round5 m09 m04 l66 r66 11 09 366 !(Pair l68 r68) = round5 m07 m01 l67 r67 06 12 367 !(Pair l69 r69) = round5 m12 m05 l68 r68 08 05 368 !(Pair l70 r70) = round5 m02 m08 l69 r69 13 14 369 !(Pair l71 r71) = round5 m10 m07 l70 r70 12 06 370 !(Pair l72 r72) = round5 m14 m06 l71 r71 05 08 371 !(Pair l73 r73) = round5 m01 m02 l72 r72 12 13 372 !(Pair l74 r74) = round5 m03 m13 l73 r73 13 06 373 !(Pair l75 r75) = round5 m08 m14 l74 r74 14 05 374 !(Pair l76 r76) = round5 m11 m00 l75 r75 11 15 375 !(Pair l77 r77) = round5 m06 m03 l76 r76 08 13 376 !(Pair l78 r78) = round5 m15 m09 l77 r77 05 11 377 !(Pair l79 r79) = round5 m13 m11 l78 r78 06 11 378 379 !(Registers a b c d e) = l79 380 !(Registers a' b' c' d' e') = r79 381 382 in Registers 383 (h1 + c + d') (h2 + d + e') (h3 + e + a') (h4 + a + b') (h0 + b + c') 384 385 -- block pipeline 386 -- 387 -- invariant: 388 -- the input bytestring is exactly 512 bits in length 389 unsafe_hash_alg :: Registers -> BS.ByteString -> Registers 390 unsafe_hash_alg rs bs = block_hash rs (unsafe_parse bs) 391 392 -- register concatenation 393 cat :: Registers -> BS.ByteString 394 cat Registers {..} = 395 BL.toStrict 396 -- more efficient for small builder 397 . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty 398 $ mconcat [ 399 BSB.word32LE h0 400 , BSB.word32LE h1 401 , BSB.word32LE h2 402 , BSB.word32LE h3 403 , BSB.word32LE h4 404 ] 405 406 -- | Compute a condensed representation of a strict bytestring via 407 -- RIPEMD-160. 408 -- 409 -- The 160-bit output digest is returned as a strict bytestring. 410 -- 411 -- >>> hash "strict bytestring input" 412 -- "<strict 160-bit message digest>" 413 hash :: BS.ByteString -> BS.ByteString 414 hash bs = cat (go iv (pad bs)) where 415 go :: Registers -> BS.ByteString -> Registers 416 go !acc b 417 | BS.null b = acc 418 | otherwise = case unsafe_splitAt 64 b of 419 SSPair c r -> go (unsafe_hash_alg acc c) r 420 421 -- | Compute a condensed representation of a lazy bytestring via 422 -- RIPEMD-160. 423 -- 424 -- The 160-bit output digest is returned as a strict bytestring. 425 -- 426 -- >>> hash_lazy "lazy bytestring input" 427 -- "<strict 160-bit message digest>" 428 hash_lazy :: BL.ByteString -> BS.ByteString 429 hash_lazy bl = cat (go iv (pad_lazy bl)) where 430 go :: Registers -> BL.ByteString -> Registers 431 go !acc bs 432 | BL.null bs = acc 433 | otherwise = case splitAt64 bs of 434 SLPair c r -> go (unsafe_hash_alg acc c) r 435 436 -- HMAC ----------------------------------------------------------------------- 437 -- https://datatracker.ietf.org/doc/html/rfc2104#section-2 438 439 data KeyAndLen = KeyAndLen 440 {-# UNPACK #-} !BS.ByteString 441 {-# UNPACK #-} !Int 442 443 -- | Produce a message authentication code for a strict bytestring, 444 -- based on the provided (strict, bytestring) key, via RIPEMD-160. 445 -- 446 -- The 160-bit MAC is returned as a strict bytestring. 447 -- 448 -- Per RFC 2104, the key /should/ be a minimum of 20 bytes long. Keys 449 -- exceeding 64 bytes in length will first be hashed (via RIPEMD-160). 450 -- 451 -- >>> hmac "strict bytestring key" "strict bytestring input" 452 -- "<strict 160-bit MAC>" 453 hmac 454 :: BS.ByteString -- ^ key 455 -> BS.ByteString -- ^ text 456 -> BS.ByteString 457 hmac mk@(BI.PS _ _ l) text = 458 let step1 = k <> BS.replicate (64 - lk) 0x00 459 step2 = BS.map (B.xor 0x36) step1 460 step3 = step2 <> text 461 step4 = hash step3 462 step5 = BS.map (B.xor 0x5C) step1 463 step6 = step5 <> step4 464 in hash step6 465 where 466 !(KeyAndLen k lk) 467 | l > 64 = KeyAndLen (hash mk) 20 468 | otherwise = KeyAndLen mk l 469 470 -- | Produce a message authentication code for a lazy bytestring, based 471 -- on the provided (strict, bytestring) key, via RIPEMD-160. 472 -- 473 -- The 160-bit MAC is returned as a strict bytestring. 474 -- 475 -- Per RFC 2104, the key /should/ be a minimum of 20 bytes long. Keys 476 -- exceeding 64 bytes in length will first be hashed (via RIPEMD-160). 477 -- 478 -- >>> hmac_lazy "strict bytestring key" "lazy bytestring input" 479 -- "<strict 160-bit MAC>" 480 hmac_lazy 481 :: BS.ByteString -- ^ key 482 -> BL.ByteString -- ^ text 483 -> BS.ByteString 484 hmac_lazy mk@(BI.PS _ _ l) text = 485 let step1 = k <> BS.replicate (64 - lk) 0x00 486 step2 = BS.map (B.xor 0x36) step1 487 step3 = BL.fromStrict step2 <> text 488 step4 = hash_lazy step3 489 step5 = BS.map (B.xor 0x5C) step1 490 step6 = step5 <> step4 491 in hash step6 492 where 493 !(KeyAndLen k lk) 494 | l > 64 = KeyAndLen (hash mk) 20 495 | otherwise = KeyAndLen mk l 496