commit e00be26007b707b01dd510c38ff61a256980a620
parent 15b1005aa8924d19a6b40474e3bf185b97f562d5
Author: Jared Tobin <jared@jtobin.io>
Date: Mon, 11 Nov 2024 18:45:23 +0400
lib: ripemd160 skeleton
Diffstat:
3 files changed, 484 insertions(+), 0 deletions(-)
diff --git a/.ghci b/.ghci
@@ -0,0 +1 @@
+:set -XOverloadedStrings
diff --git a/lib/Crypto/Hash/RIPEMD160.hs b/lib/Crypto/Hash/RIPEMD160.hs
@@ -1,3 +1,485 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-- see
+--
+-- https://homes.esat.kuleuven.be/~bosselae/ripemd160/pdf/AB-9601/AB-9601.pdf
+
module Crypto.Hash.RIPEMD160 where
+import qualified Data.Bits as B
+import Data.Bits ((.|.), (.&.))
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BSB
+import qualified Data.ByteString.Builder.Extra as BE
+import qualified Data.ByteString.Internal as BI
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Internal as BLI
+import qualified Data.ByteString.Unsafe as BU
+import Data.Word (Word32, Word64)
+import Foreign.ForeignPtr (plusForeignPtr)
+
+import Debug.Trace
+
+-- preliminary utils
+
+-- keystroke saver
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+{-# INLINE fi #-}
+
+-- parse strict ByteString in BE order to Word32 (verbatim from
+-- Data.Binary)
+--
+-- invariant:
+-- the input bytestring is at least 32 bits in length
+unsafe_word32be :: BS.ByteString -> Word32
+unsafe_word32be s =
+ (fi (s `BU.unsafeIndex` 0) `B.unsafeShiftL` 24) .|.
+ (fi (s `BU.unsafeIndex` 1) `B.unsafeShiftL` 16) .|.
+ (fi (s `BU.unsafeIndex` 2) `B.unsafeShiftL` 8) .|.
+ (fi (s `BU.unsafeIndex` 3))
+{-# INLINE unsafe_word32be #-}
+
+-- utility types for more efficient ByteString management
+
+data SSPair = SSPair
+ {-# UNPACK #-} !BS.ByteString
+ {-# UNPACK #-} !BS.ByteString
+
+data SLPair = SLPair {-# UNPACK #-} !BS.ByteString !BL.ByteString
+
+data WSPair = WSPair {-# UNPACK #-} !Word32 {-# UNPACK #-} !BS.ByteString
+
+-- unsafe version of splitAt that does no bounds checking
+--
+-- invariant:
+-- 0 <= n <= l
+unsafe_splitAt :: Int -> BS.ByteString -> SSPair
+unsafe_splitAt n (BI.BS x l) =
+ SSPair (BI.BS x n) (BI.BS (plusForeignPtr x n) (l - n))
+
+-- variant of Data.ByteString.Lazy.splitAt that returns the initial
+-- component as a strict, unboxed ByteString
+splitAt64 :: BL.ByteString -> SLPair
+splitAt64 = splitAt' (64 :: Int) where
+ splitAt' _ BLI.Empty = SLPair mempty BLI.Empty
+ splitAt' n (BLI.Chunk c cs) =
+ if n < BS.length c
+ then
+ -- n < BS.length c, so unsafe_splitAt is safe
+ let !(SSPair c0 c1) = unsafe_splitAt n c
+ in SLPair c0 (BLI.Chunk c1 cs)
+ else
+ let SLPair cs' cs'' = splitAt' (n - BS.length c) cs
+ in SLPair (c <> cs') cs''
+
+-- variant of Data.ByteString.splitAt that behaves like an incremental
+-- Word32 parser
+--
+-- invariant:
+-- the input bytestring is at least 32 bits in length
+unsafe_parseWsPair :: BS.ByteString -> WSPair
+unsafe_parseWsPair (BI.BS x l) =
+ WSPair (unsafe_word32be (BI.BS x 4)) (BI.BS (plusForeignPtr x 4) (l - 4))
+{-# INLINE unsafe_parseWsPair #-}
+
+-- message padding and parsing
+
+-- this is the standard padding for merkle-damgård constructions; see e.g.
+--
+-- https://datatracker.ietf.org/doc/html/rfc1320
+-- https://datatracker.ietf.org/doc/html/rfc6234
+--
+-- for equivalent padding specifications for MD4 and SHA2, but note that
+-- RIPEMD (and MD4) use little-endian word encodings
+
+-- k such that (l + 1 + k) mod 64 = 56
+sol :: Word64 -> Word64
+sol l =
+ let r = 56 - fi l `mod` 64 - 1 :: Integer -- fi prevents underflow
+ in fi (if r < 0 then r + 64 else r)
+
+pad :: BS.ByteString -> BS.ByteString
+pad m = BL.toStrict . BSB.toLazyByteString $ padded where
+ l = fi (BS.length m)
+ padded = BSB.byteString m <> fill (sol l) (BSB.word8 0x80)
+
+ fill j !acc
+ | j == 0 = acc <> BSB.word64LE (l * 8)
+ | otherwise = fill (pred j) (acc <> BSB.word8 0x00)
+
+pad_lazy :: BL.ByteString -> BL.ByteString
+pad_lazy (BL.toChunks -> m) = BL.fromChunks (walk 0 m) where
+ walk !l bs = case bs of
+ (c:cs) -> c : walk (l + fi (BS.length c)) cs
+ [] -> padding l (sol l) (BSB.word8 0x80)
+
+ padding l k bs
+ | k == 0 =
+ pure
+ . BL.toStrict
+ -- more efficient for small builder
+ . BE.toLazyByteStringWith
+ (BE.safeStrategy 128 BE.smallChunkSize) mempty
+ $ bs <> BSB.word64LE (l * 8)
+ | otherwise =
+ let nacc = bs <> BSB.word8 0x00
+ in padding l (pred k) nacc
+
+-- initialization
+
+data Registers = Registers {
+ h0 :: !Word32
+ , h1 :: !Word32
+ , h2 :: !Word32
+ , h3 :: !Word32
+ , h4 :: !Word32
+ } deriving Show
+
+iv :: Registers
+iv = Registers 0x67452301 0xEFCDAB89 0x98BADCFE 0x10325476 0xC3D2E1F0
+
+-- processing
+
+data Block = Block {
+ m00 :: !Word32, m01 :: !Word32, m02 :: !Word32, m03 :: !Word32
+ , m04 :: !Word32, m05 :: !Word32, m06 :: !Word32, m07 :: !Word32
+ , m08 :: !Word32, m09 :: !Word32, m10 :: !Word32, m11 :: !Word32
+ , m12 :: !Word32, m13 :: !Word32, m14 :: !Word32, m15 :: !Word32
+ } deriving Show
+
+-- parse strict bytestring to block
+--
+-- invariant:
+-- the input bytestring is exactly 512 bits long
+unsafe_parse :: BS.ByteString -> Block
+unsafe_parse bs =
+ let !(WSPair m00 t00) = unsafe_parseWsPair bs
+ !(WSPair m01 t01) = unsafe_parseWsPair t00
+ !(WSPair m02 t02) = unsafe_parseWsPair t01
+ !(WSPair m03 t03) = unsafe_parseWsPair t02
+ !(WSPair m04 t04) = unsafe_parseWsPair t03
+ !(WSPair m05 t05) = unsafe_parseWsPair t04
+ !(WSPair m06 t06) = unsafe_parseWsPair t05
+ !(WSPair m07 t07) = unsafe_parseWsPair t06
+ !(WSPair m08 t08) = unsafe_parseWsPair t07
+ !(WSPair m09 t09) = unsafe_parseWsPair t08
+ !(WSPair m10 t10) = unsafe_parseWsPair t09
+ !(WSPair m11 t11) = unsafe_parseWsPair t10
+ !(WSPair m12 t12) = unsafe_parseWsPair t11
+ !(WSPair m13 t13) = unsafe_parseWsPair t12
+ !(WSPair m14 t14) = unsafe_parseWsPair t13
+ !(WSPair m15 t15) = unsafe_parseWsPair t14
+ in if BS.null t15
+ then Block {..}
+ else error "ppad-ripemd160: internal error (bytes remaining)"
+
+-- nonlinear functions at bit level
+f0, f1, f2, f3, f4 :: Word32 -> Word32 -> Word32 -> Word32
+f0 x y z = x `B.xor` y `B.xor` z
+f1 x y z = (x .&. y) .|. ((B.complement x) .&. z)
+f2 x y z = (x .|. B.complement y) `B.xor` z
+f3 x y z = (x .&. z) .|. (y .&. B.complement z)
+f4 x y z = x `B.xor` (y .|. B.complement z)
+
+-- constants
+k0, k1, k2, k3, k4 :: Word32
+k0 = 0x00000000 -- 00 <= j <= 15
+k1 = 0x5A827999 -- 16 <= j <= 31
+k2 = 0x6ED9EBA1 -- 32 <= j <= 47
+k3 = 0x8F1BBCDC -- 48 <= j <= 63
+k4 = 0xA953FD4E -- 64 <= j <= 79
+
+k0', k1', k2', k3', k4' :: Word32
+k0' = 0x50A28BE6 -- 00 <= j <= 15
+k1' = 0x5C4DD124 -- 16 <= j <= 31
+k2' = 0x6D703EF3 -- 32 <= j <= 47
+k3' = 0x7A6D76E9 -- 48 <= j <= 63
+k4' = 0x00000000 -- 64 <= j <= 79
+
+-- strict registers pair
+data Pair = Pair !Registers !Registers
+ deriving Show
+
+round1, round2, round3, round4, round5 ::
+ Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
+
+round1 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' =
+ let t = (B.rotateL (a + f0 b c d + x + k0) s) + e
+ r0 = Registers e t b (B.rotateL c 10) d
+ t' = (B.rotateL (a' + f4 b' c' d' + x' + k0') s') + e'
+ r1 = Registers e' t' b' (B.rotateL c' 10) d'
+ in Pair r0 r1
+
+round2 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' =
+ let t = (B.rotateL (a + f1 b c d + x + k1) s) + e
+ r0 = Registers e t b (B.rotateL c 10) d
+ t' = (B.rotateL (a' + f3 b' c' d' + x' + k1') s') + e'
+ r1 = Registers e' t' b' (B.rotateL c' 10) d'
+ in Pair r0 r1
+
+round3 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' =
+ let t = (B.rotateL (a + f2 b c d + x + k2) s) + e
+ r0 = Registers e t b (B.rotateL c 10) d
+ t' = (B.rotateL (a' + f2 b' c' d' + x' + k2') s') + e'
+ r1 = Registers e' t' b' (B.rotateL c' 10) d'
+ in Pair r0 r1
+
+round4 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' =
+ let t = (B.rotateL (a + f3 b c d + x + k3) s) + e
+ r0 = Registers e t b (B.rotateL c 10) d
+ t' = (B.rotateL (a' + f1 b' c' d' + x' + k3') s') + e'
+ r1 = Registers e' t' b' (B.rotateL c' 10) d'
+ in Pair r0 r1
+
+round5 x x' (Registers a b c d e) (Registers a' b' c' d' e') s s' =
+ let t = (B.rotateL (a + f4 b c d + x + k4) s) + e
+ r0 = Registers e t b (B.rotateL c 10) d
+ t' = (B.rotateL (a' + f0 b' c' d' + x' + k4') s') + e'
+ r1 = Registers e' t' b' (B.rotateL c' 10) d'
+ in Pair r0 r1
+
+block_hash :: Registers -> Block -> Registers
+block_hash reg@Registers {..} Block {..} =
+ -- round 1
+ --
+ -- r(j) = j (0 ≤ j ≤ 15)
+ -- r'(0..15) = 5, 14, 7, 0, 9, 2, 11, 4, 13, 6, 15, 8, 1, 10, 3, 12
+ -- s(0..15) = 11, 14, 15, 12, 5, 8, 7, 9, 11, 13, 14, 15, 6, 7, 9, 8
+ -- s'(0..15) = 8, 9, 9, 11, 13, 15, 15, 5, 7, 7, 8, 11, 14, 14, 12, 6
+ let !(Pair l00 r00) = round1 m00 m05 reg reg 11 08
+ !(Pair l01 r01) = round1 m01 m14 l00 r00 14 09
+ !(Pair l02 r02) = round1 m02 m07 l01 r01 15 09
+ !(Pair l03 r03) = round1 m03 m00 l02 r02 12 11
+ !(Pair l04 r04) = round1 m04 m09 l03 r03 05 13
+ !(Pair l05 r05) = round1 m05 m02 l04 r04 08 15
+ !(Pair l06 r06) = round1 m06 m11 l05 r05 07 15
+ !(Pair l07 r07) = round1 m07 m04 l06 r06 09 05
+ !(Pair l08 r08) = round1 m08 m13 l07 r07 11 07
+ !(Pair l09 r09) = round1 m09 m06 l08 r08 13 07
+ !(Pair l10 r10) = round1 m10 m15 l09 r09 14 08
+ !(Pair l11 r11) = round1 m11 m08 l10 r10 15 11
+ !(Pair l12 r12) = round1 m12 m01 l11 r11 06 14
+ !(Pair l13 r13) = round1 m13 m10 l12 r12 07 14
+ !(Pair l14 r14) = round1 m14 m03 l13 r13 09 12
+ !(Pair l15 r15) = round1 m15 m12 l14 r14 08 06
+
+ -- round 2
+ --
+ -- r(16..31) = 7, 4, 13, 1, 10, 6, 15, 3, 12, 0, 9, 5, 2, 14, 11, 8
+ -- r'(16..31) = 6, 11, 3, 7, 0, 13, 5, 10, 14, 15, 8, 12, 4, 9, 1, 2
+ -- s(16..31) = 7, 6, 8, 13, 11, 9, 7, 15, 7, 12, 15, 9, 11, 7, 13, 12
+ -- s'(16..31) = 9, 13, 15, 7, 12, 8, 9, 11, 7, 7, 12, 7, 6, 15, 13, 11
+ !(Pair l16 r16) = round2 m07 m06 l15 r15 07 09
+ !(Pair l17 r17) = round2 m04 m11 l16 r16 06 13
+ !(Pair l18 r18) = round2 m13 m03 l17 r17 08 15
+ !(Pair l19 r19) = round2 m01 m07 l18 r18 13 07
+ !(Pair l20 r20) = round2 m10 m00 l19 r19 11 12
+ !(Pair l21 r21) = round2 m06 m13 l20 r20 09 08
+ !(Pair l22 r22) = round2 m15 m05 l21 r21 07 09
+ !(Pair l23 r23) = round2 m03 m10 l22 r22 15 11
+ !(Pair l24 r24) = round2 m12 m14 l23 r23 07 07
+ !(Pair l25 r25) = round2 m00 m15 l24 r24 12 07
+ !(Pair l26 r26) = round2 m09 m08 l25 r25 15 12
+ !(Pair l27 r27) = round2 m05 m12 l26 r26 09 07
+ !(Pair l28 r28) = round2 m02 m04 l27 r27 11 06
+ !(Pair l29 r29) = round2 m14 m09 l28 r28 07 15
+ !(Pair l30 r30) = round2 m11 m01 l29 r29 13 13
+ !(Pair l31 r31) = round2 m08 m02 l30 r30 12 11
+
+ -- round 3
+ --
+ -- r(32..47) = 3, 10, 14, 4, 9, 15, 8, 1, 2, 7, 0, 6, 13, 11, 5, 12
+ -- r'(32..47) = 15, 5, 1, 3, 7, 14, 6, 9, 11, 8, 12, 2, 10, 0, 4, 13
+ -- s(32..47) = 11, 13, 6, 7, 14, 9, 13, 15, 14, 8, 13, 6, 5, 12, 7, 5
+ -- s'(32..47) = 9, 7, 15, 11, 8, 6, 6, 14, 12, 13, 5, 14, 13, 13, 7, 5
+ !(Pair l32 r32) = round3 m03 m15 l31 r31 11 09
+ !(Pair l33 r33) = round3 m10 m05 l32 r32 13 07
+ !(Pair l34 r34) = round3 m14 m01 l33 r33 06 15
+ !(Pair l35 r35) = round3 m04 m03 l34 r34 07 11
+ !(Pair l36 r36) = round3 m09 m07 l35 r35 14 08
+ !(Pair l37 r37) = round3 m15 m14 l36 r36 09 06
+ !(Pair l38 r38) = round3 m08 m06 l37 r37 13 06
+ !(Pair l39 r39) = round3 m01 m09 l38 r38 15 14
+ !(Pair l40 r40) = round3 m02 m11 l39 r39 14 12
+ !(Pair l41 r41) = round3 m07 m08 l40 r40 08 13
+ !(Pair l42 r42) = round3 m00 m12 l41 r41 13 05
+ !(Pair l43 r43) = round3 m06 m02 l42 r42 06 14
+ !(Pair l44 r44) = round3 m13 m10 l43 r43 05 13
+ !(Pair l45 r45) = round3 m11 m00 l44 r44 12 13
+ !(Pair l46 r46) = round3 m05 m04 l45 r45 07 07
+ !(Pair l47 r47) = round3 m12 m13 l46 r46 05 05
+
+ -- round 4
+ --
+ -- r(48..63) = 1, 9, 11, 10, 0, 8, 12, 4, 13, 3, 7, 15, 14, 5, 6, 2
+ -- r'(48..63) = 8, 6, 4, 1, 3, 11, 15, 0, 5, 12, 2, 13, 9, 7, 10, 14
+ -- s(48..63) = 11, 12, 14, 15, 14, 15, 9, 8, 9, 14, 5, 6, 8, 6, 5, 12
+ -- s'(48..63) = 15, 5, 8, 11, 14, 14, 6, 14, 6, 9, 12, 9, 12, 5, 15, 8
+ !(Pair l48 r48) = round4 m01 m08 l47 r47 11 15
+ !(Pair l49 r49) = round4 m09 m06 l48 r48 12 05
+ !(Pair l50 r50) = round4 m11 m04 l49 r49 14 08
+ !(Pair l51 r51) = round4 m10 m01 l50 r50 15 11
+ !(Pair l52 r52) = round4 m00 m03 l51 r51 14 14
+ !(Pair l53 r53) = round4 m08 m11 l52 r52 15 14
+ !(Pair l54 r54) = round4 m12 m15 l53 r53 09 06
+ !(Pair l55 r55) = round4 m04 m00 l54 r54 08 14
+ !(Pair l56 r56) = round4 m13 m05 l55 r55 09 06
+ !(Pair l57 r57) = round4 m03 m12 l56 r56 14 09
+ !(Pair l58 r58) = round4 m07 m02 l57 r57 05 12
+ !(Pair l59 r59) = round4 m15 m13 l58 r58 06 09
+ !(Pair l60 r60) = round4 m14 m09 l59 r59 08 12
+ !(Pair l61 r61) = round4 m05 m07 l60 r60 06 05
+ !(Pair l62 r62) = round4 m06 m10 l61 r61 05 15
+ !(Pair l63 r63) = round4 m02 m14 l62 r62 12 08
+
+ -- round 5
+ --
+ -- r(64..79) = 4, 0, 5, 9, 7, 12, 2, 10, 14, 1, 3, 8, 11, 6, 15, 13
+ -- r'(64..79) = 12, 15, 10, 4, 1, 5, 8, 7, 6, 2, 13, 14, 0, 3, 9, 11
+ -- s(64..79) = 9, 15, 5, 11, 6, 8, 13, 12, 5, 12, 13, 14, 11, 8, 5, 6
+ -- s'(64..79) = 8, 5, 12, 9, 12, 5, 14, 6, 8, 13, 6, 5, 15, 13, 11, 11
+ !(Pair l64 r64) = round5 m04 m12 l63 r63 09 08
+ !(Pair l65 r65) = round5 m00 m15 l64 r64 15 05
+ !(Pair l66 r66) = round5 m05 m10 l65 r65 05 12
+ !(Pair l67 r67) = round5 m09 m04 l66 r66 11 09
+ !(Pair l68 r68) = round5 m07 m01 l67 r67 06 12
+ !(Pair l69 r69) = round5 m12 m05 l68 r68 08 05
+ !(Pair l70 r70) = round5 m02 m08 l69 r69 13 14
+ !(Pair l71 r71) = round5 m10 m07 l70 r70 12 06
+ !(Pair l72 r72) = round5 m14 m06 l71 r71 05 08
+ !(Pair l73 r73) = round5 m01 m02 l72 r72 12 13
+ !(Pair l74 r74) = round5 m03 m13 l73 r73 13 06
+ !(Pair l75 r75) = round5 m08 m14 l74 r74 14 05
+ !(Pair l76 r76) = round5 m11 m00 l75 r75 11 15
+ !(Pair l77 r77) = round5 m06 m03 l76 r76 08 13
+ !(Pair l78 r78) = round5 m15 m09 l77 r77 05 11
+ !(Pair l79 r79) = round5 m13 m11 l78 r78 06 11
+
+ !(Registers a b c d e) = l79
+ !(Registers a' b' c' d' e') = r79
+
+ in Registers
+ (h1 + c + d') (h2 + d + e') (h3 + e + a') (h4 + a + b') (h0 + b + c')
+
+-- block pipeline
+--
+-- invariant:
+-- the input bytestring is exactly 512 bits in length
+unsafe_hash_alg :: Registers -> BS.ByteString -> Registers
+unsafe_hash_alg rs bs = block_hash rs (unsafe_parse bs)
+
+-- register concatenation
+cat :: Registers -> BS.ByteString
+cat Registers {..} =
+ BL.toStrict
+ -- more efficient for small builder
+ . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty
+ $ mconcat [
+ BSB.word32LE h0
+ , BSB.word32LE h1
+ , BSB.word32LE h2
+ , BSB.word32LE h3
+ , BSB.word32LE h4
+ ]
+
+-- | Compute a condensed representation of a strict bytestring via
+-- RIPEMD-160.
+--
+-- The 160-bit output digest is returned as a strict bytestring.
+--
+-- >>> hash "strict bytestring input"
+-- "<strict 160-bit message digest>"
+hash :: BS.ByteString -> BS.ByteString
+hash bs = cat (go iv (pad bs)) where
+ go :: Registers -> BS.ByteString -> Registers
+ go !acc b
+ | BS.null b = acc
+ | otherwise = case unsafe_splitAt 64 b of
+ SSPair c r -> go (unsafe_hash_alg acc c) r
+
+-- | Compute a condensed representation of a lazy bytestring via
+-- RIPEMD-160.
+--
+-- The 160-bit output digest is returned as a strict bytestring.
+--
+-- >>> hash_lazy "lazy bytestring input"
+-- "<strict 160-bit message digest>"
+hash_lazy :: BL.ByteString -> BS.ByteString
+hash_lazy bl = cat (go iv (pad_lazy bl)) where
+ go :: Registers -> BL.ByteString -> Registers
+ go !acc bs
+ | BL.null bs = acc
+ | otherwise = case splitAt64 bs of
+ SLPair c r -> go (unsafe_hash_alg acc c) r
+
+-- -- HMAC -----------------------------------------------------------------------
+-- -- https://datatracker.ietf.org/doc/html/rfc2104#section-2
+--
+-- data KeyAndLen = KeyAndLen
+-- {-# UNPACK #-} !BS.ByteString
+-- {-# UNPACK #-} !Int
+--
+-- -- | Produce a message authentication code for a strict bytestring,
+-- -- based on the provided (strict, bytestring) key, via RIPEMD-160.
+-- --
+-- -- The 160-bit MAC is returned as a strict bytestring.
+-- --
+-- -- Per RFC 2104, the key /should/ be a minimum of 32 bytes long. Keys
+-- -- exceeding 64 bytes in length will first be hashed (via RIPEMD-160).
+-- --
+-- -- >>> hmac "strict bytestring key" "strict bytestring input"
+-- -- "<strict 160-bit MAC>"
+-- hmac
+-- :: BS.ByteString -- ^ key
+-- -> BS.ByteString -- ^ text
+-- -> BS.ByteString
+-- hmac mk text =
+-- let step1 = k <> BS.replicate (64 - lk) 0x00
+-- step2 = BS.map (B.xor 0x36) step1
+-- step3 = step2 <> text
+-- step4 = hash step3
+-- step5 = BS.map (B.xor 0x5C) step1
+-- step6 = step5 <> step4
+-- in hash step6
+-- where
+-- !(KeyAndLen k lk) =
+-- let l = BS.length mk
+-- in if l > 64
+-- then KeyAndLen (hash mk) 32
+-- else KeyAndLen mk l
+--
+-- -- | Produce a message authentication code for a lazy bytestring, based
+-- -- on the provided (strict, bytestring) key, via RIPEMD-160.
+-- --
+-- -- The 160-bit MAC is returned as a strict bytestring.
+-- --
+-- -- Per RFC 2104, the key /should/ be a minimum of 32 bytes long. Keys
+-- -- exceeding 64 bytes in length will first be hashed (via RIPEMD-160).
+-- --
+-- -- >>> hmac_lazy "strict bytestring key" "lazy bytestring input"
+-- -- "<strict 160-bit MAC>"
+-- hmac_lazy
+-- :: BS.ByteString -- ^ key
+-- -> BL.ByteString -- ^ text
+-- -> BS.ByteString
+-- hmac_lazy mk text =
+-- let step1 = k <> BS.replicate (64 - lk) 0x00
+-- step2 = BS.map (B.xor 0x36) step1
+-- step3 = BL.fromStrict step2 <> text
+-- step4 = hash_lazy step3
+-- step5 = BS.map (B.xor 0x5C) step1
+-- step6 = step5 <> step4
+-- in hash step6
+-- where
+-- !(KeyAndLen k lk) =
+-- let l = BS.length mk
+-- in if l > 64
+-- then KeyAndLen (hash mk) 32
+-- else KeyAndLen mk l
+--
+--
+--
diff --git a/ppad-ripemd160.cabal b/ppad-ripemd160.cabal
@@ -28,6 +28,7 @@ library
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
+ , base16-bytestring
test-suite ripemd160-tests
type: exitcode-stdio-1.0
