{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module: Crypto.Hash.RIPEMD160
-- Copyright: (c) 2024 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Pure RIPEMD-160 and HMAC-RIPEMD160 implementations for
-- strict and lazy ByteStrings.

-- for spec, see
--
-- https://homes.esat.kuleuven.be/~bosselae/ripemd160/pdf/AB-9601/AB-9601.pdf

module Crypto.Hash.RIPEMD160 (
  -- * RIPEMD-160 message digest functions
    hash
  , hash_lazy

  -- * RIPEMD160-based MAC functions
  , hmac
  , hmac_lazy
  ) 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)

-- preliminary utils

-- keystroke saver
fi :: (Integral a, Num b) => a -> b
fi :: forall a b. (Integral a, Num b) => a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE fi #-}

-- parse strict ByteString in LE order to Word32 (verbatim from
-- Data.Binary)
--
-- invariant:
--   the input bytestring is at least 32 bits in length
unsafe_word32le :: BS.ByteString -> Word32
unsafe_word32le :: ByteString -> Word32
unsafe_word32le ByteString
s =
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi (ByteString
s ByteString -> Int -> Word8
`BU.unsafeIndex` Int
3) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi (ByteString
s ByteString -> Int -> Word8
`BU.unsafeIndex` Int
2) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi (ByteString
s ByteString -> Int -> Word8
`BU.unsafeIndex` Int
1) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL`  Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fi (ByteString
s ByteString -> Int -> Word8
`BU.unsafeIndex` Int
0))
{-# INLINE unsafe_word32le #-}

-- 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 :: Int -> ByteString -> SSPair
unsafe_splitAt Int
n (BI.BS ForeignPtr Word8
x Int
l) =
  ByteString -> ByteString -> SSPair
SSPair (ForeignPtr Word8 -> Int -> ByteString
BI.BS ForeignPtr Word8
x Int
n) (ForeignPtr Word8 -> Int -> ByteString
BI.BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
n) (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n))

-- variant of Data.ByteString.Lazy.splitAt that returns the initial
-- component as a strict, unboxed ByteString
splitAt64 :: BL.ByteString -> SLPair
splitAt64 :: ByteString -> SLPair
splitAt64 = Int -> ByteString -> SLPair
splitAt' (Int
64 :: Int) where
  splitAt' :: Int -> ByteString -> SLPair
splitAt' Int
_ ByteString
BLI.Empty        = ByteString -> ByteString -> SLPair
SLPair ByteString
forall a. Monoid a => a
mempty ByteString
BLI.Empty
  splitAt' Int
n (BLI.Chunk c :: ByteString
c@(BI.PS ForeignPtr Word8
_ Int
_ Int
l) ByteString
cs) =
    if    Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l
    then
      -- n < BS.length c, so unsafe_splitAt is safe
      let !(SSPair ByteString
c0 ByteString
c1) = Int -> ByteString -> SSPair
unsafe_splitAt Int
n ByteString
c
      in  ByteString -> ByteString -> SLPair
SLPair ByteString
c0 (ByteString -> ByteString -> ByteString
BLI.Chunk ByteString
c1 ByteString
cs)
    else
      let SLPair ByteString
cs' ByteString
cs'' = Int -> ByteString -> SLPair
splitAt' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) ByteString
cs
      in  ByteString -> ByteString -> SLPair
SLPair (ByteString
c ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cs') ByteString
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 :: ByteString -> WSPair
unsafe_parseWsPair (BI.BS ForeignPtr Word8
x Int
l) =
  Word32 -> ByteString -> WSPair
WSPair (ByteString -> Word32
unsafe_word32le (ForeignPtr Word8 -> Int -> ByteString
BI.BS ForeignPtr Word8
x Int
4)) (ForeignPtr Word8 -> Int -> ByteString
BI.BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
4) (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4))
{-# INLINE unsafe_parseWsPair #-}

-- builder realization strategies

to_strict :: BSB.Builder -> BS.ByteString
to_strict :: Builder -> ByteString
to_strict = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString

to_strict_small :: BSB.Builder -> BS.ByteString
to_strict_small :: Builder -> ByteString
to_strict_small = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllocationStrategy -> ByteString -> Builder -> ByteString
BE.toLazyByteStringWith
  (Int -> Int -> AllocationStrategy
BE.safeStrategy Int
128 Int
BE.smallChunkSize) ByteString
forall a. Monoid a => a
mempty

-- 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 :: Word64 -> Word64
sol Word64
l =
  let r :: Integer
r = Integer
56 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Word64
l Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
64 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 :: Integer -- fi prevents underflow
  in  Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fi (if Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
64 else Integer
r)

pad :: BS.ByteString -> BS.ByteString
pad :: ByteString -> ByteString
pad m :: ByteString
m@(BI.PS ForeignPtr Word8
_ Int
_ (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fi -> Word64
l))
    | Word64
l Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
128   = Builder -> ByteString
to_strict_small Builder
padded
    | Bool
otherwise = Builder -> ByteString
to_strict Builder
padded
  where
    padded :: Builder
padded = ByteString -> Builder
BSB.byteString ByteString
m
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder -> Builder
forall {t}. Integral t => t -> Builder -> Builder
fill (Word64 -> Word64
sol Word64
l) (Word8 -> Builder
BSB.word8 Word8
0x80)
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BSB.word64LE (Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
8)

    fill :: t -> Builder -> Builder
fill t
j !Builder
acc
      | t
j t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
8 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop64 t
j Builder
acc
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
7) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
8 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop64 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
7) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BSB.word32LE Word32
0x00
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BSB.word16LE Word16
0x00
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
6) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
8 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop64 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
6) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BSB.word32LE Word32
0x00
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BSB.word16LE Word16
0x00
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
5) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
8 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop64 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
5) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BSB.word32LE Word32
0x00
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
4) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
8 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop64 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
4) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BSB.word32LE Word32
0x00
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
3) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
8 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop64 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
3) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BSB.word16LE Word16
0x00
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
2) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
8 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop64 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
2) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BSB.word16LE Word16
0x00
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
1) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
8 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop64 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00

      | t
j t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
4 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop32 t
j Builder
acc
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
3) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
4 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop32 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
3) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BSB.word16LE Word16
0x00
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
2) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
4 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop32 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
2) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BSB.word16LE Word16
0x00
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
1) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
4 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop32 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00

      | t
j t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
2 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop16 t
j Builder
acc
      | (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
1) t -> t -> t
forall a. Integral a => a -> a -> a
`rem` t
2 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
             t -> Builder -> Builder
forall {t}. (Eq t, Num t) => t -> Builder -> Builder
loop16 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Builder
acc
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00

      | Bool
otherwise =
            t -> Builder -> Builder
forall {t}. (Eq t, Num t, Enum t) => t -> Builder -> Builder
loop8 t
j Builder
acc

    loop64 :: t -> Builder -> Builder
loop64 t
j !Builder
acc
      | t
j t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = Builder
acc
      | Bool
otherwise = t -> Builder -> Builder
loop64 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
8) (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BSB.word64LE Word64
0x00)

    loop32 :: t -> Builder -> Builder
loop32 t
j !Builder
acc
      | t
j t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = Builder
acc
      | Bool
otherwise = t -> Builder -> Builder
loop32 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
4) (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BSB.word32LE Word32
0x00)

    loop16 :: t -> Builder -> Builder
loop16 t
j !Builder
acc
      | t
j t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = Builder
acc
      | Bool
otherwise = t -> Builder -> Builder
loop16 (t
j t -> t -> t
forall a. Num a => a -> a -> a
- t
2) (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BSB.word16LE Word16
0x00)

    loop8 :: t -> Builder -> Builder
loop8 t
j !Builder
acc
      | t
j t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = Builder
acc
      | Bool
otherwise = t -> Builder -> Builder
loop8 (t -> t
forall a. Enum a => a -> a
pred t
j) (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00)

pad_lazy :: BL.ByteString -> BL.ByteString
pad_lazy :: ByteString -> ByteString
pad_lazy (ByteString -> [ByteString]
BL.toChunks -> [ByteString]
m) = [ByteString] -> ByteString
BL.fromChunks (Word64 -> [ByteString] -> [ByteString]
walk Word64
0 [ByteString]
m) where
  walk :: Word64 -> [ByteString] -> [ByteString]
walk !Word64
l [ByteString]
bs = case [ByteString]
bs of
    (ByteString
c:[ByteString]
cs) -> ByteString
c ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Word64 -> [ByteString] -> [ByteString]
walk (Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fi (ByteString -> Int
BS.length ByteString
c)) [ByteString]
cs
    [] -> Word64 -> Word64 -> Builder -> [ByteString]
forall {t} {f :: * -> *}.
(Eq t, Num t, Applicative f, Enum t) =>
Word64 -> t -> Builder -> f ByteString
padding Word64
l (Word64 -> Word64
sol Word64
l) (Word8 -> Builder
BSB.word8 Word8
0x80)

  padding :: Word64 -> t -> Builder -> f ByteString
padding Word64
l t
k Builder
bs
    | t
k t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 =
          ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (ByteString -> f ByteString)
-> (Builder -> ByteString) -> Builder -> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
to_strict
        (Builder -> f ByteString) -> Builder -> f ByteString
forall a b. (a -> b) -> a -> b
$ Builder
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BSB.word64LE (Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
8)
    | Bool
otherwise =
        let nacc :: Builder
nacc = Builder
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00
        in  Word64 -> t -> Builder -> f ByteString
padding Word64
l (t -> t
forall a. Enum a => a -> a
pred t
k) Builder
nacc

-- initialization

data Registers = Registers {
    Registers -> Word32
h0 :: !Word32
  , Registers -> Word32
h1 :: !Word32
  , Registers -> Word32
h2 :: !Word32
  , Registers -> Word32
h3 :: !Word32
  , Registers -> Word32
h4 :: !Word32
  } deriving Int -> Registers -> ShowS
[Registers] -> ShowS
Registers -> String
(Int -> Registers -> ShowS)
-> (Registers -> String)
-> ([Registers] -> ShowS)
-> Show Registers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Registers -> ShowS
showsPrec :: Int -> Registers -> ShowS
$cshow :: Registers -> String
show :: Registers -> String
$cshowList :: [Registers] -> ShowS
showList :: [Registers] -> ShowS
Show

iv :: Registers
iv :: Registers
iv = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
0x67452301 Word32
0xEFCDAB89 Word32
0x98BADCFE Word32
0x10325476 Word32
0xC3D2E1F0

-- processing

data Block = Block {
    Block -> Word32
m00 :: !Word32, Block -> Word32
m01 :: !Word32, Block -> Word32
m02 :: !Word32, Block -> Word32
m03 :: !Word32
  , Block -> Word32
m04 :: !Word32, Block -> Word32
m05 :: !Word32, Block -> Word32
m06 :: !Word32, Block -> Word32
m07 :: !Word32
  , Block -> Word32
m08 :: !Word32, Block -> Word32
m09 :: !Word32, Block -> Word32
m10 :: !Word32, Block -> Word32
m11 :: !Word32
  , Block -> Word32
m12 :: !Word32, Block -> Word32
m13 :: !Word32, Block -> Word32
m14 :: !Word32, Block -> Word32
m15 :: !Word32
  } deriving Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show

-- parse strict bytestring to block
--
-- invariant:
--   the input bytestring is exactly 512 bits long
unsafe_parse :: BS.ByteString -> Block
unsafe_parse :: ByteString -> Block
unsafe_parse ByteString
bs =
  let !(WSPair Word32
m00 ByteString
t00) = ByteString -> WSPair
unsafe_parseWsPair ByteString
bs
      !(WSPair Word32
m01 ByteString
t01) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t00
      !(WSPair Word32
m02 ByteString
t02) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t01
      !(WSPair Word32
m03 ByteString
t03) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t02
      !(WSPair Word32
m04 ByteString
t04) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t03
      !(WSPair Word32
m05 ByteString
t05) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t04
      !(WSPair Word32
m06 ByteString
t06) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t05
      !(WSPair Word32
m07 ByteString
t07) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t06
      !(WSPair Word32
m08 ByteString
t08) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t07
      !(WSPair Word32
m09 ByteString
t09) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t08
      !(WSPair Word32
m10 ByteString
t10) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t09
      !(WSPair Word32
m11 ByteString
t11) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t10
      !(WSPair Word32
m12 ByteString
t12) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t11
      !(WSPair Word32
m13 ByteString
t13) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t12
      !(WSPair Word32
m14 ByteString
t14) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t13
      !(WSPair Word32
m15 ByteString
t15) = ByteString -> WSPair
unsafe_parseWsPair ByteString
t14
  in  if   ByteString -> Bool
BS.null ByteString
t15
      then Block {Word32
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
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
..}
      else String -> Block
forall a. HasCallStack => String -> a
error String
"ppad-ripemd160: internal error (bytes remaining)"

-- nonlinear functions at bit level
f0, f1, f2, f3, f4 :: Word32 -> Word32 -> Word32 -> Word32
f0 :: Word32 -> Word32 -> Word32 -> Word32
f0 Word32
x Word32
y Word32
z = Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` Word32
y Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` Word32
z
{-# INLINE f0 #-}
f1 :: Word32 -> Word32 -> Word32 -> Word32
f1 Word32
x Word32
y Word32
z = (Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
y) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32 -> Word32
forall a. Bits a => a -> a
B.complement Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
z)
{-# INLINE f1 #-}
f2 :: Word32 -> Word32 -> Word32 -> Word32
f2 Word32
x Word32
y Word32
z = (Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Word32
forall a. Bits a => a -> a
B.complement Word32
y) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` Word32
z
{-# INLINE f2 #-}
f3 :: Word32 -> Word32 -> Word32 -> Word32
f3 Word32
x Word32
y Word32
z = (Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
z) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
y Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32
forall a. Bits a => a -> a
B.complement Word32
z)
{-# INLINE f3 #-}
f4 :: Word32 -> Word32 -> Word32 -> Word32
f4 Word32
x Word32
y Word32
z = Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`B.xor` (Word32
y Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Word32
forall a. Bits a => a -> a
B.complement Word32
z)
{-# INLINE f4 #-}

-- constants
k0, k1, k2, k3, k4 :: Word32
k0 :: Word32
k0 = Word32
0x00000000 -- 00 <= j <= 15
k1 :: Word32
k1 = Word32
0x5A827999 -- 16 <= j <= 31
k2 :: Word32
k2 = Word32
0x6ED9EBA1 -- 32 <= j <= 47
k3 :: Word32
k3 = Word32
0x8F1BBCDC -- 48 <= j <= 63
k4 :: Word32
k4 = Word32
0xA953FD4E -- 64 <= j <= 79

k0', k1', k2', k3', k4' :: Word32
k0' :: Word32
k0' = Word32
0x50A28BE6 -- 00 <= j <= 15
k1' :: Word32
k1' = Word32
0x5C4DD124 -- 16 <= j <= 31
k2' :: Word32
k2' = Word32
0x6D703EF3 -- 32 <= j <= 47
k3' :: Word32
k3' = Word32
0x7A6D76E9 -- 48 <= j <= 63
k4' :: Word32
k4' = Word32
0x00000000 -- 64 <= j <= 79

-- strict registers pair
data Pair = Pair !Registers !Registers
  deriving Int -> Pair -> ShowS
[Pair] -> ShowS
Pair -> String
(Int -> Pair -> ShowS)
-> (Pair -> String) -> ([Pair] -> ShowS) -> Show Pair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pair -> ShowS
showsPrec :: Int -> Pair -> ShowS
$cshow :: Pair -> String
show :: Pair -> String
$cshowList :: [Pair] -> ShowS
showList :: [Pair] -> ShowS
Show

round1, round2, round3, round4, round5 ::
  Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair

round1 :: Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
x Word32
x' (Registers Word32
a Word32
b Word32
c Word32
d Word32
e) (Registers Word32
a' Word32
b' Word32
c' Word32
d' Word32
e') Int
s Int
s' =
  let t :: Word32
t  = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f0 Word32
b Word32
c Word32
d Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k0) Int
s Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e
      r0 :: Registers
r0 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e Word32
t Word32
b (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c Int
10) Word32
d
      t' :: Word32
t' = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f4 Word32
b' Word32
c' Word32
d' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k0') Int
s' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e'
      r1 :: Registers
r1 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e' Word32
t' Word32
b' (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c' Int
10) Word32
d'
  in  Registers -> Registers -> Pair
Pair Registers
r0 Registers
r1

round2 :: Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
x Word32
x' (Registers Word32
a Word32
b Word32
c Word32
d Word32
e) (Registers Word32
a' Word32
b' Word32
c' Word32
d' Word32
e') Int
s Int
s' =
  let t :: Word32
t  = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f1 Word32
b Word32
c Word32
d Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k1) Int
s Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e
      r0 :: Registers
r0 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e Word32
t Word32
b (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c Int
10) Word32
d
      t' :: Word32
t' = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f3 Word32
b' Word32
c' Word32
d' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k1') Int
s' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e'
      r1 :: Registers
r1 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e' Word32
t' Word32
b' (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c' Int
10) Word32
d'
  in  Registers -> Registers -> Pair
Pair Registers
r0 Registers
r1

round3 :: Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
x Word32
x' (Registers Word32
a Word32
b Word32
c Word32
d Word32
e) (Registers Word32
a' Word32
b' Word32
c' Word32
d' Word32
e') Int
s Int
s' =
  let t :: Word32
t  = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f2 Word32
b Word32
c Word32
d Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k2) Int
s Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e
      r0 :: Registers
r0 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e Word32
t Word32
b (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c Int
10) Word32
d
      t' :: Word32
t' = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f2 Word32
b' Word32
c' Word32
d' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k2') Int
s' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e'
      r1 :: Registers
r1 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e' Word32
t' Word32
b' (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c' Int
10) Word32
d'
  in  Registers -> Registers -> Pair
Pair Registers
r0 Registers
r1

round4 :: Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
x Word32
x' (Registers Word32
a Word32
b Word32
c Word32
d Word32
e) (Registers Word32
a' Word32
b' Word32
c' Word32
d' Word32
e') Int
s Int
s' =
  let t :: Word32
t  = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f3 Word32
b Word32
c Word32
d Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k3) Int
s Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e
      r0 :: Registers
r0 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e Word32
t Word32
b (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c Int
10) Word32
d
      t' :: Word32
t' = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f1 Word32
b' Word32
c' Word32
d' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k3') Int
s' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e'
      r1 :: Registers
r1 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e' Word32
t' Word32
b' (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c' Int
10) Word32
d'
  in  Registers -> Registers -> Pair
Pair Registers
r0 Registers
r1

round5 :: Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
x Word32
x' (Registers Word32
a Word32
b Word32
c Word32
d Word32
e) (Registers Word32
a' Word32
b' Word32
c' Word32
d' Word32
e') Int
s Int
s' =
  let t :: Word32
t  = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f4 Word32
b Word32
c Word32
d Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k4) Int
s Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e
      r0 :: Registers
r0 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e Word32
t Word32
b (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c Int
10) Word32
d
      t' :: Word32
t' = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL (Word32
a' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Word32 -> Word32 -> Word32
f0 Word32
b' Word32
c' Word32
d' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
x' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
k4') Int
s' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e'
      r1 :: Registers
r1 = Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers Word32
e' Word32
t' Word32
b' (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
B.rotateL Word32
c' Int
10) Word32
d'
  in  Registers -> Registers -> Pair
Pair Registers
r0 Registers
r1

block_hash :: Registers -> Block -> Registers
block_hash :: Registers -> Block -> Registers
block_hash reg :: Registers
reg@Registers {Word32
h0 :: Registers -> Word32
h1 :: Registers -> Word32
h2 :: Registers -> Word32
h3 :: Registers -> Word32
h4 :: Registers -> Word32
h0 :: Word32
h1 :: Word32
h2 :: Word32
h3 :: Word32
h4 :: Word32
..} Block {Word32
m00 :: Block -> Word32
m01 :: Block -> Word32
m02 :: Block -> Word32
m03 :: Block -> Word32
m04 :: Block -> Word32
m05 :: Block -> Word32
m06 :: Block -> Word32
m07 :: Block -> Word32
m08 :: Block -> Word32
m09 :: Block -> Word32
m10 :: Block -> Word32
m11 :: Block -> Word32
m12 :: Block -> Word32
m13 :: Block -> Word32
m14 :: Block -> Word32
m15 :: Block -> Word32
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
..} =
      -- 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 Registers
l00 Registers
r00) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m00 Word32
m05 Registers
reg Registers
reg Int
11 Int
08
      !(Pair Registers
l01 Registers
r01) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m01 Word32
m14 Registers
l00 Registers
r00 Int
14 Int
09
      !(Pair Registers
l02 Registers
r02) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m02 Word32
m07 Registers
l01 Registers
r01 Int
15 Int
09
      !(Pair Registers
l03 Registers
r03) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m03 Word32
m00 Registers
l02 Registers
r02 Int
12 Int
11
      !(Pair Registers
l04 Registers
r04) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m04 Word32
m09 Registers
l03 Registers
r03 Int
05 Int
13
      !(Pair Registers
l05 Registers
r05) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m05 Word32
m02 Registers
l04 Registers
r04 Int
08 Int
15
      !(Pair Registers
l06 Registers
r06) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m06 Word32
m11 Registers
l05 Registers
r05 Int
07 Int
15
      !(Pair Registers
l07 Registers
r07) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m07 Word32
m04 Registers
l06 Registers
r06 Int
09 Int
05
      !(Pair Registers
l08 Registers
r08) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m08 Word32
m13 Registers
l07 Registers
r07 Int
11 Int
07
      !(Pair Registers
l09 Registers
r09) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m09 Word32
m06 Registers
l08 Registers
r08 Int
13 Int
07
      !(Pair Registers
l10 Registers
r10) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m10 Word32
m15 Registers
l09 Registers
r09 Int
14 Int
08
      !(Pair Registers
l11 Registers
r11) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m11 Word32
m08 Registers
l10 Registers
r10 Int
15 Int
11
      !(Pair Registers
l12 Registers
r12) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m12 Word32
m01 Registers
l11 Registers
r11 Int
06 Int
14
      !(Pair Registers
l13 Registers
r13) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m13 Word32
m10 Registers
l12 Registers
r12 Int
07 Int
14
      !(Pair Registers
l14 Registers
r14) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m14 Word32
m03 Registers
l13 Registers
r13 Int
09 Int
12
      !(Pair Registers
l15 Registers
r15) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round1 Word32
m15 Word32
m12 Registers
l14 Registers
r14 Int
08 Int
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 Registers
l16 Registers
r16) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m07 Word32
m06 Registers
l15 Registers
r15 Int
07 Int
09
      !(Pair Registers
l17 Registers
r17) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m04 Word32
m11 Registers
l16 Registers
r16 Int
06 Int
13
      !(Pair Registers
l18 Registers
r18) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m13 Word32
m03 Registers
l17 Registers
r17 Int
08 Int
15
      !(Pair Registers
l19 Registers
r19) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m01 Word32
m07 Registers
l18 Registers
r18 Int
13 Int
07
      !(Pair Registers
l20 Registers
r20) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m10 Word32
m00 Registers
l19 Registers
r19 Int
11 Int
12
      !(Pair Registers
l21 Registers
r21) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m06 Word32
m13 Registers
l20 Registers
r20 Int
09 Int
08
      !(Pair Registers
l22 Registers
r22) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m15 Word32
m05 Registers
l21 Registers
r21 Int
07 Int
09
      !(Pair Registers
l23 Registers
r23) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m03 Word32
m10 Registers
l22 Registers
r22 Int
15 Int
11
      !(Pair Registers
l24 Registers
r24) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m12 Word32
m14 Registers
l23 Registers
r23 Int
07 Int
07
      !(Pair Registers
l25 Registers
r25) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m00 Word32
m15 Registers
l24 Registers
r24 Int
12 Int
07
      !(Pair Registers
l26 Registers
r26) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m09 Word32
m08 Registers
l25 Registers
r25 Int
15 Int
12
      !(Pair Registers
l27 Registers
r27) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m05 Word32
m12 Registers
l26 Registers
r26 Int
09 Int
07
      !(Pair Registers
l28 Registers
r28) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m02 Word32
m04 Registers
l27 Registers
r27 Int
11 Int
06
      !(Pair Registers
l29 Registers
r29) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m14 Word32
m09 Registers
l28 Registers
r28 Int
07 Int
15
      !(Pair Registers
l30 Registers
r30) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m11 Word32
m01 Registers
l29 Registers
r29 Int
13 Int
13
      !(Pair Registers
l31 Registers
r31) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round2 Word32
m08 Word32
m02 Registers
l30 Registers
r30 Int
12 Int
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 Registers
l32 Registers
r32) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m03 Word32
m15 Registers
l31 Registers
r31 Int
11 Int
09
      !(Pair Registers
l33 Registers
r33) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m10 Word32
m05 Registers
l32 Registers
r32 Int
13 Int
07
      !(Pair Registers
l34 Registers
r34) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m14 Word32
m01 Registers
l33 Registers
r33 Int
06 Int
15
      !(Pair Registers
l35 Registers
r35) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m04 Word32
m03 Registers
l34 Registers
r34 Int
07 Int
11
      !(Pair Registers
l36 Registers
r36) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m09 Word32
m07 Registers
l35 Registers
r35 Int
14 Int
08
      !(Pair Registers
l37 Registers
r37) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m15 Word32
m14 Registers
l36 Registers
r36 Int
09 Int
06
      !(Pair Registers
l38 Registers
r38) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m08 Word32
m06 Registers
l37 Registers
r37 Int
13 Int
06
      !(Pair Registers
l39 Registers
r39) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m01 Word32
m09 Registers
l38 Registers
r38 Int
15 Int
14
      !(Pair Registers
l40 Registers
r40) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m02 Word32
m11 Registers
l39 Registers
r39 Int
14 Int
12
      !(Pair Registers
l41 Registers
r41) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m07 Word32
m08 Registers
l40 Registers
r40 Int
08 Int
13
      !(Pair Registers
l42 Registers
r42) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m00 Word32
m12 Registers
l41 Registers
r41 Int
13 Int
05
      !(Pair Registers
l43 Registers
r43) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m06 Word32
m02 Registers
l42 Registers
r42 Int
06 Int
14
      !(Pair Registers
l44 Registers
r44) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m13 Word32
m10 Registers
l43 Registers
r43 Int
05 Int
13
      !(Pair Registers
l45 Registers
r45) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m11 Word32
m00 Registers
l44 Registers
r44 Int
12 Int
13
      !(Pair Registers
l46 Registers
r46) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m05 Word32
m04 Registers
l45 Registers
r45 Int
07 Int
07
      !(Pair Registers
l47 Registers
r47) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round3 Word32
m12 Word32
m13 Registers
l46 Registers
r46 Int
05 Int
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 Registers
l48 Registers
r48) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m01 Word32
m08 Registers
l47 Registers
r47 Int
11 Int
15
      !(Pair Registers
l49 Registers
r49) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m09 Word32
m06 Registers
l48 Registers
r48 Int
12 Int
05
      !(Pair Registers
l50 Registers
r50) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m11 Word32
m04 Registers
l49 Registers
r49 Int
14 Int
08
      !(Pair Registers
l51 Registers
r51) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m10 Word32
m01 Registers
l50 Registers
r50 Int
15 Int
11
      !(Pair Registers
l52 Registers
r52) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m00 Word32
m03 Registers
l51 Registers
r51 Int
14 Int
14
      !(Pair Registers
l53 Registers
r53) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m08 Word32
m11 Registers
l52 Registers
r52 Int
15 Int
14
      !(Pair Registers
l54 Registers
r54) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m12 Word32
m15 Registers
l53 Registers
r53 Int
09 Int
06
      !(Pair Registers
l55 Registers
r55) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m04 Word32
m00 Registers
l54 Registers
r54 Int
08 Int
14
      !(Pair Registers
l56 Registers
r56) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m13 Word32
m05 Registers
l55 Registers
r55 Int
09 Int
06
      !(Pair Registers
l57 Registers
r57) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m03 Word32
m12 Registers
l56 Registers
r56 Int
14 Int
09
      !(Pair Registers
l58 Registers
r58) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m07 Word32
m02 Registers
l57 Registers
r57 Int
05 Int
12
      !(Pair Registers
l59 Registers
r59) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m15 Word32
m13 Registers
l58 Registers
r58 Int
06 Int
09
      !(Pair Registers
l60 Registers
r60) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m14 Word32
m09 Registers
l59 Registers
r59 Int
08 Int
12
      !(Pair Registers
l61 Registers
r61) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m05 Word32
m07 Registers
l60 Registers
r60 Int
06 Int
05
      !(Pair Registers
l62 Registers
r62) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m06 Word32
m10 Registers
l61 Registers
r61 Int
05 Int
15
      !(Pair Registers
l63 Registers
r63) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round4 Word32
m02 Word32
m14 Registers
l62 Registers
r62 Int
12 Int
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 Registers
l64 Registers
r64) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m04 Word32
m12 Registers
l63 Registers
r63 Int
09 Int
08
      !(Pair Registers
l65 Registers
r65) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m00 Word32
m15 Registers
l64 Registers
r64 Int
15 Int
05
      !(Pair Registers
l66 Registers
r66) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m05 Word32
m10 Registers
l65 Registers
r65 Int
05 Int
12
      !(Pair Registers
l67 Registers
r67) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m09 Word32
m04 Registers
l66 Registers
r66 Int
11 Int
09
      !(Pair Registers
l68 Registers
r68) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m07 Word32
m01 Registers
l67 Registers
r67 Int
06 Int
12
      !(Pair Registers
l69 Registers
r69) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m12 Word32
m05 Registers
l68 Registers
r68 Int
08 Int
05
      !(Pair Registers
l70 Registers
r70) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m02 Word32
m08 Registers
l69 Registers
r69 Int
13 Int
14
      !(Pair Registers
l71 Registers
r71) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m10 Word32
m07 Registers
l70 Registers
r70 Int
12 Int
06
      !(Pair Registers
l72 Registers
r72) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m14 Word32
m06 Registers
l71 Registers
r71 Int
05 Int
08
      !(Pair Registers
l73 Registers
r73) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m01 Word32
m02 Registers
l72 Registers
r72 Int
12 Int
13
      !(Pair Registers
l74 Registers
r74) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m03 Word32
m13 Registers
l73 Registers
r73 Int
13 Int
06
      !(Pair Registers
l75 Registers
r75) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m08 Word32
m14 Registers
l74 Registers
r74 Int
14 Int
05
      !(Pair Registers
l76 Registers
r76) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m11 Word32
m00 Registers
l75 Registers
r75 Int
11 Int
15
      !(Pair Registers
l77 Registers
r77) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m06 Word32
m03 Registers
l76 Registers
r76 Int
08 Int
13
      !(Pair Registers
l78 Registers
r78) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m15 Word32
m09 Registers
l77 Registers
r77 Int
05 Int
11
      !(Pair Registers
l79 Registers
r79) = Word32 -> Word32 -> Registers -> Registers -> Int -> Int -> Pair
round5 Word32
m13 Word32
m11 Registers
l78 Registers
r78 Int
06 Int
11

      !(Registers Word32
a Word32
b Word32
c Word32
d Word32
e)      = Registers
l79
      !(Registers Word32
a' Word32
b' Word32
c' Word32
d' Word32
e') = Registers
r79

   in Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> Registers
Registers
        (Word32
h1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
c Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
d') (Word32
h2 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
d Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e') (Word32
h3 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
e Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
a') (Word32
h4 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
b') (Word32
h0 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
b Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
c')

-- block pipeline
--
-- invariant:
--   the input bytestring is exactly 512 bits in length
unsafe_hash_alg :: Registers -> BS.ByteString -> Registers
unsafe_hash_alg :: Registers -> ByteString -> Registers
unsafe_hash_alg Registers
rs ByteString
bs = Registers -> Block -> Registers
block_hash Registers
rs (ByteString -> Block
unsafe_parse ByteString
bs)

-- register concatenation
cat :: Registers -> BS.ByteString
cat :: Registers -> ByteString
cat Registers {Word32
h0 :: Registers -> Word32
h1 :: Registers -> Word32
h2 :: Registers -> Word32
h3 :: Registers -> Word32
h4 :: Registers -> Word32
h0 :: Word32
h1 :: Word32
h2 :: Word32
h3 :: Word32
h4 :: Word32
..} =
  let w64_0 :: Word64
w64_0 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fi Word32
h1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fi Word32
h0
      w64_1 :: Word64
w64_1 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fi Word32
h3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`B.shiftL` Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fi Word32
h2
  in  Builder -> ByteString
to_strict_small (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
           Word64 -> Builder
BSB.word64LE Word64
w64_0
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BSB.word64LE Word64
w64_1
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BSB.word32LE Word32
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 :: ByteString -> ByteString
hash ByteString
bs = Registers -> ByteString
cat (Registers -> ByteString -> Registers
go Registers
iv (ByteString -> ByteString
pad ByteString
bs)) where
  go :: Registers -> BS.ByteString -> Registers
  go :: Registers -> ByteString -> Registers
go !Registers
acc ByteString
b
    | ByteString -> Bool
BS.null ByteString
b = Registers
acc
    | Bool
otherwise = case Int -> ByteString -> SSPair
unsafe_splitAt Int
64 ByteString
b of
        SSPair ByteString
c ByteString
r -> Registers -> ByteString -> Registers
go (Registers -> ByteString -> Registers
unsafe_hash_alg Registers
acc ByteString
c) ByteString
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 :: ByteString -> ByteString
hash_lazy ByteString
bl = Registers -> ByteString
cat (Registers -> ByteString -> Registers
go Registers
iv (ByteString -> ByteString
pad_lazy ByteString
bl)) where
  go :: Registers -> BL.ByteString -> Registers
  go :: Registers -> ByteString -> Registers
go !Registers
acc ByteString
bs
    | ByteString -> Bool
BL.null ByteString
bs = Registers
acc
    | Bool
otherwise = case ByteString -> SLPair
splitAt64 ByteString
bs of
        SLPair ByteString
c ByteString
r -> Registers -> ByteString -> Registers
go (Registers -> ByteString -> Registers
unsafe_hash_alg Registers
acc ByteString
c) ByteString
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 20 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 :: ByteString -> ByteString -> ByteString
hmac mk :: ByteString
mk@(BI.PS ForeignPtr Word8
_ Int
_ Int
l) ByteString
text =
    let step1 :: ByteString
step1 = ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lk) Word8
0x00
        step2 :: ByteString
step2 = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
B.xor Word8
0x36) ByteString
step1
        step3 :: ByteString
step3 = ByteString
step2 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
text
        step4 :: ByteString
step4 = ByteString -> ByteString
hash ByteString
step3
        step5 :: ByteString
step5 = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
B.xor Word8
0x5C) ByteString
step1
        step6 :: ByteString
step6 = ByteString
step5 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
step4
    in  ByteString -> ByteString
hash ByteString
step6
  where
    !(KeyAndLen ByteString
k Int
lk)
      | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64    = ByteString -> Int -> KeyAndLen
KeyAndLen (ByteString -> ByteString
hash ByteString
mk) Int
20
      | Bool
otherwise = ByteString -> Int -> KeyAndLen
KeyAndLen ByteString
mk Int
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 20 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 :: ByteString -> ByteString -> ByteString
hmac_lazy mk :: ByteString
mk@(BI.PS ForeignPtr Word8
_ Int
_ Int
l) ByteString
text =
    let step1 :: ByteString
step1 = ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lk) Word8
0x00
        step2 :: ByteString
step2 = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
B.xor Word8
0x36) ByteString
step1
        step3 :: ByteString
step3 = ByteString -> ByteString
BL.fromStrict ByteString
step2 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
text
        step4 :: ByteString
step4 = ByteString -> ByteString
hash_lazy ByteString
step3
        step5 :: ByteString
step5 = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
B.xor Word8
0x5C) ByteString
step1
        step6 :: ByteString
step6 = ByteString
step5 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
step4
    in  ByteString -> ByteString
hash ByteString
step6
  where
    !(KeyAndLen ByteString
k Int
lk)
      | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64    = ByteString -> Int -> KeyAndLen
KeyAndLen (ByteString -> ByteString
hash ByteString
mk) Int
20
      | Bool
otherwise = ByteString -> Int -> KeyAndLen
KeyAndLen ByteString
mk Int
l