RIPEMD160.hs (18296B)
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 cs) = 84 if n < BS.length c 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 - BS.length c) 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 = BL.toStrict . BSB.toLazyByteString $ padded where 121 l = fi (BS.length m) 122 padded = BSB.byteString m <> fill (sol l) (BSB.word8 0x80) 123 124 fill j !acc 125 | j == 0 = acc <> BSB.word64LE (l * 8) 126 | otherwise = fill (pred j) (acc <> BSB.word8 0x00) 127 128 pad_lazy :: BL.ByteString -> BL.ByteString 129 pad_lazy (BL.toChunks -> m) = BL.fromChunks (walk 0 m) where 130 walk !l bs = case bs of 131 (c:cs) -> c : walk (l + fi (BS.length c)) cs 132 [] -> padding l (sol l) (BSB.word8 0x80) 133 134 padding l k bs 135 | k == 0 = 136 pure 137 . BL.toStrict 138 -- more efficient for small builder 139 . BE.toLazyByteStringWith 140 (BE.safeStrategy 128 BE.smallChunkSize) mempty 141 $ bs <> BSB.word64LE (l * 8) 142 | otherwise = 143 let nacc = bs <> BSB.word8 0x00 144 in padding l (pred k) nacc 145 146 -- initialization 147 148 data Registers = Registers { 149 h0 :: !Word32 150 , h1 :: !Word32 151 , h2 :: !Word32 152 , h3 :: !Word32 153 , h4 :: !Word32 154 } deriving Show 155 156 iv :: Registers 157 iv = Registers 0x67452301 0xEFCDAB89 0x98BADCFE 0x10325476 0xC3D2E1F0 158 159 -- processing 160 161 data Block = Block { 162 m00 :: !Word32, m01 :: !Word32, m02 :: !Word32, m03 :: !Word32 163 , m04 :: !Word32, m05 :: !Word32, m06 :: !Word32, m07 :: !Word32 164 , m08 :: !Word32, m09 :: !Word32, m10 :: !Word32, m11 :: !Word32 165 , m12 :: !Word32, m13 :: !Word32, m14 :: !Word32, m15 :: !Word32 166 } deriving Show 167 168 -- parse strict bytestring to block 169 -- 170 -- invariant: 171 -- the input bytestring is exactly 512 bits long 172 unsafe_parse :: BS.ByteString -> Block 173 unsafe_parse bs = 174 let !(WSPair m00 t00) = unsafe_parseWsPair bs 175 !(WSPair m01 t01) = unsafe_parseWsPair t00 176 !(WSPair m02 t02) = unsafe_parseWsPair t01 177 !(WSPair m03 t03) = unsafe_parseWsPair t02 178 !(WSPair m04 t04) = unsafe_parseWsPair t03 179 !(WSPair m05 t05) = unsafe_parseWsPair t04 180 !(WSPair m06 t06) = unsafe_parseWsPair t05 181 !(WSPair m07 t07) = unsafe_parseWsPair t06 182 !(WSPair m08 t08) = unsafe_parseWsPair t07 183 !(WSPair m09 t09) = unsafe_parseWsPair t08 184 !(WSPair m10 t10) = unsafe_parseWsPair t09 185 !(WSPair m11 t11) = unsafe_parseWsPair t10 186 !(WSPair m12 t12) = unsafe_parseWsPair t11 187 !(WSPair m13 t13) = unsafe_parseWsPair t12 188 !(WSPair m14 t14) = unsafe_parseWsPair t13 189 !(WSPair m15 t15) = unsafe_parseWsPair t14 190 in if BS.null t15 191 then Block {..} 192 else error "ppad-ripemd160: internal error (bytes remaining)" 193 194 -- nonlinear functions at bit level 195 f0, f1, f2, f3, f4 :: Word32 -> Word32 -> Word32 -> Word32 196 f0 x y z = x `B.xor` y `B.xor` z 197 {-# INLINE f0 #-} 198 f1 x y z = (x .&. y) .|. (B.complement x .&. z) 199 {-# INLINE f1 #-} 200 f2 x y z = (x .|. B.complement y) `B.xor` z 201 {-# INLINE f2 #-} 202 f3 x y z = (x .&. z) .|. (y .&. B.complement z) 203 {-# INLINE f3 #-} 204 f4 x y z = x `B.xor` (y .|. B.complement z) 205 {-# INLINE f4 #-} 206 207 -- constants 208 k0, k1, k2, k3, k4 :: Word32 209 k0 = 0x00000000 -- 00 <= j <= 15 210 k1 = 0x5A827999 -- 16 <= j <= 31 211 k2 = 0x6ED9EBA1 -- 32 <= j <= 47 212 k3 = 0x8F1BBCDC -- 48 <= j <= 63 213 k4 = 0xA953FD4E -- 64 <= j <= 79 214 215 k0', k1', k2', k3', k4' :: Word32 216 k0' = 0x50A28BE6 -- 00 <= j <= 15 217 k1' = 0x5C4DD124 -- 16 <= j <= 31 218 k2' = 0x6D703EF3 -- 32 <= j <= 47 219 k3' = 0x7A6D76E9 -- 48 <= j <= 63 220 k4' = 0x00000000 -- 64 <= j <= 79 221 222 -- strict registers pair 223 data Pair = Pair !Registers !Registers 224 deriving Show 225 226 round1, round2, round3, round4, round5 :: 227 Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair 228 229 round1 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 230 let t = B.rotateL (a + f0 b c d + x + k0) s + e 231 r0 = Registers e t b (B.rotateL c 10) d 232 t' = B.rotateL (a' + f4 b' c' d' + x' + k0') s' + e' 233 r1 = Registers e' t' b' (B.rotateL c' 10) d' 234 in Pair r0 r1 235 236 round2 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 237 let t = B.rotateL (a + f1 b c d + x + k1) s + e 238 r0 = Registers e t b (B.rotateL c 10) d 239 t' = B.rotateL (a' + f3 b' c' d' + x' + k1') s' + e' 240 r1 = Registers e' t' b' (B.rotateL c' 10) d' 241 in Pair r0 r1 242 243 round3 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 244 let t = B.rotateL (a + f2 b c d + x + k2) s + e 245 r0 = Registers e t b (B.rotateL c 10) d 246 t' = B.rotateL (a' + f2 b' c' d' + x' + k2') s' + e' 247 r1 = Registers e' t' b' (B.rotateL c' 10) d' 248 in Pair r0 r1 249 250 round4 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 251 let t = B.rotateL (a + f3 b c d + x + k3) s + e 252 r0 = Registers e t b (B.rotateL c 10) d 253 t' = B.rotateL (a' + f1 b' c' d' + x' + k3') s' + e' 254 r1 = Registers e' t' b' (B.rotateL c' 10) d' 255 in Pair r0 r1 256 257 round5 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' = 258 let t = B.rotateL (a + f4 b c d + x + k4) s + e 259 r0 = Registers e t b (B.rotateL c 10) d 260 t' = B.rotateL (a' + f0 b' c' d' + x' + k4') s' + e' 261 r1 = Registers e' t' b' (B.rotateL c' 10) d' 262 in Pair r0 r1 263 264 block_hash :: Registers -> Block -> Registers 265 block_hash reg@Registers {..} Block {..} = 266 -- round 1 267 -- 268 -- r(j) = j (0 ≤ j ≤ 15) 269 -- r'(0..15) = 5, 14, 7, 0, 9, 2, 11, 4, 13, 6, 15, 8, 1, 10, 3, 12 270 -- s(0..15) = 11, 14, 15, 12, 5, 8, 7, 9, 11, 13, 14, 15, 6, 7, 9, 8 271 -- s'(0..15) = 8, 9, 9, 11, 13, 15, 15, 5, 7, 7, 8, 11, 14, 14, 12, 6 272 let !(Pair l00 r00) = round1 m00 m05 reg reg 11 08 273 !(Pair l01 r01) = round1 m01 m14 l00 r00 14 09 274 !(Pair l02 r02) = round1 m02 m07 l01 r01 15 09 275 !(Pair l03 r03) = round1 m03 m00 l02 r02 12 11 276 !(Pair l04 r04) = round1 m04 m09 l03 r03 05 13 277 !(Pair l05 r05) = round1 m05 m02 l04 r04 08 15 278 !(Pair l06 r06) = round1 m06 m11 l05 r05 07 15 279 !(Pair l07 r07) = round1 m07 m04 l06 r06 09 05 280 !(Pair l08 r08) = round1 m08 m13 l07 r07 11 07 281 !(Pair l09 r09) = round1 m09 m06 l08 r08 13 07 282 !(Pair l10 r10) = round1 m10 m15 l09 r09 14 08 283 !(Pair l11 r11) = round1 m11 m08 l10 r10 15 11 284 !(Pair l12 r12) = round1 m12 m01 l11 r11 06 14 285 !(Pair l13 r13) = round1 m13 m10 l12 r12 07 14 286 !(Pair l14 r14) = round1 m14 m03 l13 r13 09 12 287 !(Pair l15 r15) = round1 m15 m12 l14 r14 08 06 288 289 -- round 2 290 -- 291 -- r(16..31) = 7, 4, 13, 1, 10, 6, 15, 3, 12, 0, 9, 5, 2, 14, 11, 8 292 -- r'(16..31) = 6, 11, 3, 7, 0, 13, 5, 10, 14, 15, 8, 12, 4, 9, 1, 2 293 -- s(16..31) = 7, 6, 8, 13, 11, 9, 7, 15, 7, 12, 15, 9, 11, 7, 13, 12 294 -- s'(16..31) = 9, 13, 15, 7, 12, 8, 9, 11, 7, 7, 12, 7, 6, 15, 13, 11 295 !(Pair l16 r16) = round2 m07 m06 l15 r15 07 09 296 !(Pair l17 r17) = round2 m04 m11 l16 r16 06 13 297 !(Pair l18 r18) = round2 m13 m03 l17 r17 08 15 298 !(Pair l19 r19) = round2 m01 m07 l18 r18 13 07 299 !(Pair l20 r20) = round2 m10 m00 l19 r19 11 12 300 !(Pair l21 r21) = round2 m06 m13 l20 r20 09 08 301 !(Pair l22 r22) = round2 m15 m05 l21 r21 07 09 302 !(Pair l23 r23) = round2 m03 m10 l22 r22 15 11 303 !(Pair l24 r24) = round2 m12 m14 l23 r23 07 07 304 !(Pair l25 r25) = round2 m00 m15 l24 r24 12 07 305 !(Pair l26 r26) = round2 m09 m08 l25 r25 15 12 306 !(Pair l27 r27) = round2 m05 m12 l26 r26 09 07 307 !(Pair l28 r28) = round2 m02 m04 l27 r27 11 06 308 !(Pair l29 r29) = round2 m14 m09 l28 r28 07 15 309 !(Pair l30 r30) = round2 m11 m01 l29 r29 13 13 310 !(Pair l31 r31) = round2 m08 m02 l30 r30 12 11 311 312 -- round 3 313 -- 314 -- r(32..47) = 3, 10, 14, 4, 9, 15, 8, 1, 2, 7, 0, 6, 13, 11, 5, 12 315 -- r'(32..47) = 15, 5, 1, 3, 7, 14, 6, 9, 11, 8, 12, 2, 10, 0, 4, 13 316 -- s(32..47) = 11, 13, 6, 7, 14, 9, 13, 15, 14, 8, 13, 6, 5, 12, 7, 5 317 -- s'(32..47) = 9, 7, 15, 11, 8, 6, 6, 14, 12, 13, 5, 14, 13, 13, 7, 5 318 !(Pair l32 r32) = round3 m03 m15 l31 r31 11 09 319 !(Pair l33 r33) = round3 m10 m05 l32 r32 13 07 320 !(Pair l34 r34) = round3 m14 m01 l33 r33 06 15 321 !(Pair l35 r35) = round3 m04 m03 l34 r34 07 11 322 !(Pair l36 r36) = round3 m09 m07 l35 r35 14 08 323 !(Pair l37 r37) = round3 m15 m14 l36 r36 09 06 324 !(Pair l38 r38) = round3 m08 m06 l37 r37 13 06 325 !(Pair l39 r39) = round3 m01 m09 l38 r38 15 14 326 !(Pair l40 r40) = round3 m02 m11 l39 r39 14 12 327 !(Pair l41 r41) = round3 m07 m08 l40 r40 08 13 328 !(Pair l42 r42) = round3 m00 m12 l41 r41 13 05 329 !(Pair l43 r43) = round3 m06 m02 l42 r42 06 14 330 !(Pair l44 r44) = round3 m13 m10 l43 r43 05 13 331 !(Pair l45 r45) = round3 m11 m00 l44 r44 12 13 332 !(Pair l46 r46) = round3 m05 m04 l45 r45 07 07 333 !(Pair l47 r47) = round3 m12 m13 l46 r46 05 05 334 335 -- round 4 336 -- 337 -- r(48..63) = 1, 9, 11, 10, 0, 8, 12, 4, 13, 3, 7, 15, 14, 5, 6, 2 338 -- r'(48..63) = 8, 6, 4, 1, 3, 11, 15, 0, 5, 12, 2, 13, 9, 7, 10, 14 339 -- s(48..63) = 11, 12, 14, 15, 14, 15, 9, 8, 9, 14, 5, 6, 8, 6, 5, 12 340 -- s'(48..63) = 15, 5, 8, 11, 14, 14, 6, 14, 6, 9, 12, 9, 12, 5, 15, 8 341 !(Pair l48 r48) = round4 m01 m08 l47 r47 11 15 342 !(Pair l49 r49) = round4 m09 m06 l48 r48 12 05 343 !(Pair l50 r50) = round4 m11 m04 l49 r49 14 08 344 !(Pair l51 r51) = round4 m10 m01 l50 r50 15 11 345 !(Pair l52 r52) = round4 m00 m03 l51 r51 14 14 346 !(Pair l53 r53) = round4 m08 m11 l52 r52 15 14 347 !(Pair l54 r54) = round4 m12 m15 l53 r53 09 06 348 !(Pair l55 r55) = round4 m04 m00 l54 r54 08 14 349 !(Pair l56 r56) = round4 m13 m05 l55 r55 09 06 350 !(Pair l57 r57) = round4 m03 m12 l56 r56 14 09 351 !(Pair l58 r58) = round4 m07 m02 l57 r57 05 12 352 !(Pair l59 r59) = round4 m15 m13 l58 r58 06 09 353 !(Pair l60 r60) = round4 m14 m09 l59 r59 08 12 354 !(Pair l61 r61) = round4 m05 m07 l60 r60 06 05 355 !(Pair l62 r62) = round4 m06 m10 l61 r61 05 15 356 !(Pair l63 r63) = round4 m02 m14 l62 r62 12 08 357 358 -- round 5 359 -- 360 -- r(64..79) = 4, 0, 5, 9, 7, 12, 2, 10, 14, 1, 3, 8, 11, 6, 15, 13 361 -- r'(64..79) = 12, 15, 10, 4, 1, 5, 8, 7, 6, 2, 13, 14, 0, 3, 9, 11 362 -- s(64..79) = 9, 15, 5, 11, 6, 8, 13, 12, 5, 12, 13, 14, 11, 8, 5, 6 363 -- s'(64..79) = 8, 5, 12, 9, 12, 5, 14, 6, 8, 13, 6, 5, 15, 13, 11, 11 364 !(Pair l64 r64) = round5 m04 m12 l63 r63 09 08 365 !(Pair l65 r65) = round5 m00 m15 l64 r64 15 05 366 !(Pair l66 r66) = round5 m05 m10 l65 r65 05 12 367 !(Pair l67 r67) = round5 m09 m04 l66 r66 11 09 368 !(Pair l68 r68) = round5 m07 m01 l67 r67 06 12 369 !(Pair l69 r69) = round5 m12 m05 l68 r68 08 05 370 !(Pair l70 r70) = round5 m02 m08 l69 r69 13 14 371 !(Pair l71 r71) = round5 m10 m07 l70 r70 12 06 372 !(Pair l72 r72) = round5 m14 m06 l71 r71 05 08 373 !(Pair l73 r73) = round5 m01 m02 l72 r72 12 13 374 !(Pair l74 r74) = round5 m03 m13 l73 r73 13 06 375 !(Pair l75 r75) = round5 m08 m14 l74 r74 14 05 376 !(Pair l76 r76) = round5 m11 m00 l75 r75 11 15 377 !(Pair l77 r77) = round5 m06 m03 l76 r76 08 13 378 !(Pair l78 r78) = round5 m15 m09 l77 r77 05 11 379 !(Pair l79 r79) = round5 m13 m11 l78 r78 06 11 380 381 !(Registers a b c d e) = l79 382 !(Registers a' b' c' d' e') = r79 383 384 in Registers 385 (h1 + c + d') (h2 + d + e') (h3 + e + a') (h4 + a + b') (h0 + b + c') 386 387 -- block pipeline 388 -- 389 -- invariant: 390 -- the input bytestring is exactly 512 bits in length 391 unsafe_hash_alg :: Registers -> BS.ByteString -> Registers 392 unsafe_hash_alg rs bs = block_hash rs (unsafe_parse bs) 393 394 -- register concatenation 395 cat :: Registers -> BS.ByteString 396 cat Registers {..} = 397 BL.toStrict 398 -- more efficient for small builder 399 . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty 400 $ mconcat [ 401 BSB.word32LE h0 402 , BSB.word32LE h1 403 , BSB.word32LE h2 404 , BSB.word32LE h3 405 , BSB.word32LE h4 406 ] 407 408 -- | Compute a condensed representation of a strict bytestring via 409 -- RIPEMD-160. 410 -- 411 -- The 160-bit output digest is returned as a strict bytestring. 412 -- 413 -- >>> hash "strict bytestring input" 414 -- "<strict 160-bit message digest>" 415 hash :: BS.ByteString -> BS.ByteString 416 hash bs = cat (go iv (pad bs)) where 417 go :: Registers -> BS.ByteString -> Registers 418 go !acc b 419 | BS.null b = acc 420 | otherwise = case unsafe_splitAt 64 b of 421 SSPair c r -> go (unsafe_hash_alg acc c) r 422 423 -- | Compute a condensed representation of a lazy bytestring via 424 -- RIPEMD-160. 425 -- 426 -- The 160-bit output digest is returned as a strict bytestring. 427 -- 428 -- >>> hash_lazy "lazy bytestring input" 429 -- "<strict 160-bit message digest>" 430 hash_lazy :: BL.ByteString -> BS.ByteString 431 hash_lazy bl = cat (go iv (pad_lazy bl)) where 432 go :: Registers -> BL.ByteString -> Registers 433 go !acc bs 434 | BL.null bs = acc 435 | otherwise = case splitAt64 bs of 436 SLPair c r -> go (unsafe_hash_alg acc c) r 437 438 -- HMAC ----------------------------------------------------------------------- 439 -- https://datatracker.ietf.org/doc/html/rfc2104#section-2 440 441 data KeyAndLen = KeyAndLen 442 {-# UNPACK #-} !BS.ByteString 443 {-# UNPACK #-} !Int 444 445 -- | Produce a message authentication code for a strict bytestring, 446 -- based on the provided (strict, bytestring) key, via RIPEMD-160. 447 -- 448 -- The 160-bit MAC is returned as a strict bytestring. 449 -- 450 -- Per RFC 2104, the key /should/ be a minimum of 20 bytes long. Keys 451 -- exceeding 64 bytes in length will first be hashed (via RIPEMD-160). 452 -- 453 -- >>> hmac "strict bytestring key" "strict bytestring input" 454 -- "<strict 160-bit MAC>" 455 hmac 456 :: BS.ByteString -- ^ key 457 -> BS.ByteString -- ^ text 458 -> BS.ByteString 459 hmac mk text = 460 let step1 = k <> BS.replicate (64 - lk) 0x00 461 step2 = BS.map (B.xor 0x36) step1 462 step3 = step2 <> text 463 step4 = hash step3 464 step5 = BS.map (B.xor 0x5C) step1 465 step6 = step5 <> step4 466 in hash step6 467 where 468 !(KeyAndLen k lk) = 469 let l = BS.length mk 470 in if l > 64 471 then KeyAndLen (hash mk) 20 472 else KeyAndLen mk l 473 474 -- | Produce a message authentication code for a lazy bytestring, based 475 -- on the provided (strict, bytestring) key, via RIPEMD-160. 476 -- 477 -- The 160-bit MAC is returned as a strict bytestring. 478 -- 479 -- Per RFC 2104, the key /should/ be a minimum of 20 bytes long. Keys 480 -- exceeding 64 bytes in length will first be hashed (via RIPEMD-160). 481 -- 482 -- >>> hmac_lazy "strict bytestring key" "lazy bytestring input" 483 -- "<strict 160-bit MAC>" 484 hmac_lazy 485 :: BS.ByteString -- ^ key 486 -> BL.ByteString -- ^ text 487 -> BS.ByteString 488 hmac_lazy mk text = 489 let step1 = k <> BS.replicate (64 - lk) 0x00 490 step2 = BS.map (B.xor 0x36) step1 491 step3 = BL.fromStrict step2 <> text 492 step4 = hash_lazy step3 493 step5 = BS.map (B.xor 0x5C) step1 494 step6 = step5 <> step4 495 in hash step6 496 where 497 !(KeyAndLen k lk) = 498 let l = BS.length mk 499 in if l > 64 500 then KeyAndLen (hash mk) 20 501 else KeyAndLen mk l 502