{-# LANGUAGE ViewPatterns, LambdaCase, BangPatterns #-}

-------------------------------------------------------------------------------
-- |
-- Module:      Crypto.Sha256.Hmac
-- Copyright:   (c) 2024 Auth Global
-- License:     Apache2
--
-- An implementation of HMAC-SHA256 that supports precomputed keys, streaming,
-- backtracking, bitstring inputs, and (de)serialization of intermediate states.
--
-------------------------------------------------------------------------------

module Crypto.Sha256.Hmac
  ( hmac
  , hmac'
  , HmacKeyPlain
  -- , hmacKeyPlain_eq
  , HmacKey()
  , hmacKey
  , hmacKey_hashed
  , hmacKey_toPlain
  , hmacKey_toHashed
  , hmacKey_forgetPlain
  , hmacKey_run
  , HmacKeyLike()
  , hmacKeyLike
  , hmacKeyLike_init
  , hmacKeyLike_initHashed
  , hmacKeyLike_initPrefixed
  , hmacKeyLike_toKey
  , hmacKeyLike_toPlain
  , hmacKeyLike_toHashed
  , hmacKeyLike_toPrefixed
  , hmacKeyLike_run
  , hmacKeyLike_byteCount
  , hmacKeyLike_blockCount
  , hmacKeyLike_bufferLength
  -- , hmacKeyLike_feeds
  -- , hmacKeyLike_feedsWith
  , HmacKeyHashed()
  , hmacKeyHashed
  , hmacKeyHashed_toKey
  , hmacKeyHashed_run
  , hmacKeyHashed_runWith
  , HmacKeyPrefixed()
  , hmacKeyPrefixed
  , hmacKeyPrefixed_init
  , hmacKeyPrefixed_initHashed
  , hmacKeyPrefixed_initLike
  , hmacKeyPrefixed_toHashed
  -- , hmacKeyPrefixed_eqHashed
  , hmacKeyPrefixed_feed
  , hmacKeyPrefixed_feeds
  , hmacKeyPrefixed_feedsWith
  , hmacKeyPrefixed_run
  , hmacKeyPrefixed_byteCount
  , hmacKeyPrefixed_blockCount
  , hmacKeyPrefixed_bufferLength
  , HmacCtx()
  , hmacCtx
  , hmacCtx_init
  , hmacCtx_initWith
  , hmacCtx_update,  hmacCtx_feed
  , hmacCtx_updates, hmacCtx_feeds
  , hmacCtx_finalize     , hmacCtx_finalize_toByteString
  , hmacCtx_finalizeBits , hmacCtx_finalizeBits_toByteString
  , hmacCtx_finalizeBytes, hmacCtx_finalizeBytes_toByteString
  , hmacCtx_byteCount
  , hmacCtx_blockCount
  , hmacCtx_bufferLength
--  , hmacCtx_toHmacKeyPrefixed
  ) where

import           Data.Bits(xor)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import           Data.List(scanl')
import           Data.Function((&))
import           Data.Foldable(Foldable, toList)
import           Data.Int
import           Data.Word

import           Crypto.HashString
import           Crypto.Sha256 as Sha256
import           Crypto.Sha256.Subtle
import           Crypto.Sha256.Hmac.Implementation

-- Should these be made publicly available?  Are these available anywhere else?
dropBs :: Int64 -> [ ByteString ] -> [ ByteString ]
dropBs :: Int64 -> [ByteString] -> [ByteString]
dropBs = Int64 -> [ByteString] -> [ByteString]
go
  where
    len :: ByteString -> Int64
len = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> (ByteString -> Int) -> ByteString -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length
    go :: Int64 -> [ByteString] -> [ByteString]
go Int64
_ [] = []
    go Int64
0 [ByteString]
bs = [ByteString]
bs
    go Int64
n (ByteString
b:[ByteString]
bs)
      | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int64
len ByteString
b = Int64 -> [ByteString] -> [ByteString]
go (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
len ByteString
b) [ByteString]
bs
      | Bool
otherwise = Int -> ByteString -> ByteString
B.drop (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ByteString
b ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
bs

takeBs :: Int64 -> [ ByteString ] -> [ ByteString ]
takeBs :: Int64 -> [ByteString] -> [ByteString]
takeBs = Int64 -> [ByteString] -> [ByteString]
go
  where
    len :: ByteString -> Int64
len = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> (ByteString -> Int) -> ByteString -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length
    go :: Int64 -> [ByteString] -> [ByteString]
go Int64
_ [] = []
    go Int64
n (ByteString
b:[ByteString]
bs)
      | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 = []
      | ByteString -> Int64
len ByteString
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
n = ByteString
b ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int64 -> [ByteString] -> [ByteString]
go (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
len ByteString
b) [ByteString]
bs
      | Bool
otherwise = [Int -> ByteString -> ByteString
B.take (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ByteString
b]

takeBs' :: Int64 -> [ ByteString ] -> [ ByteString ]
takeBs' :: Int64 -> [ByteString] -> [ByteString]
takeBs' Int64
n [ByteString]
bs = if Bool
haveEnough then Int64 -> [ByteString] -> [ByteString]
takeBs Int64
n [ByteString]
bs else []
  where
    len :: ByteString -> Int64
len = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> (ByteString -> Int) -> ByteString -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length
    haveEnough :: Bool
haveEnough = (Int64 -> Bool) -> [Int64] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
n) ((Int64 -> Int64 -> Int64) -> Int64 -> [Int64] -> [Int64]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
(+) Int64
0 ((ByteString -> Int64) -> [ByteString] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int64
len [ByteString]
bs))


-- Initialize a precomputed hmac key from a plaintext bytestring, which
-- can then be turned into an hmac context using 'hmacKey_run'
--
-- Note this structure retains the plaintext key, which isn't strictly necessary
-- for actually computing the resulting hmac function.  The plaintext key can
-- be forgotten using 'hmacKey_forgetPlain'.
hmacKey :: HmacKeyPlain -> HmacKey
hmacKey :: ByteString -> HmacKey
hmacKey ByteString
key = ByteString -> HmacKeyHashed -> HmacKey
HmacKey_Plain ByteString
key (ByteString -> HmacKeyHashed
hmacKeyHashed ByteString
key)

-- | If the plaintext hmac key has been remembered by the precomputed key, return it.
--   Otherwise return 'Nothing'.  Keys precomputed by 'hmacKey' retain the plaintext,
--   which can subsequently be forgotten by 'hmacKey_forgetPlain'.  Alternatively,
--   keys precomputed by 'hmacKey_hashed' never retains the plaintext key in the
--   first place.
hmacKey_toPlain :: HmacKey -> Maybe HmacKeyPlain
hmacKey_toPlain :: HmacKey -> Maybe ByteString
hmacKey_toPlain = \case
  HmacKey_Plain ByteString
a HmacKeyHashed
_ -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
a
  HmacKey_Hashed HmacKeyHashed
_  -> Maybe ByteString
forall a. Maybe a
Nothing

-- | Forget any plaintext hmac keys being retained by a given precomputed key, meaning
--   that for all x, @hmacKey_toPlain (hmacKey_forgetPlain x) == Nothing@.
--
--   This is potentially useful when implementing PBKDF2, as the plaintext password can
--   immediately be replaced with a precomputed hmac key, even before key-stretching
--   is complete. Note that the precomputed hmac key does provide a fast brute-force
--   attack on the plaintext key, typically as little as 1 SHA256 block, so this cannot be
--   relied upon for secrecy if the hmac key is potentially guessable, such as a weak
--   password or a non-secret salt.

hmacKey_forgetPlain :: HmacKey -> HmacKey
hmacKey_forgetPlain :: HmacKey -> HmacKey
hmacKey_forgetPlain = \case
  HmacKey_Plain ByteString
_ HmacKeyHashed
b -> HmacKeyHashed -> HmacKey
HmacKey_Hashed HmacKeyHashed
b
  x :: HmacKey
x@(HmacKey_Hashed HmacKeyHashed
_) -> HmacKey
x

hmacKeyLike :: HmacKeyPlain -> HmacKeyLike
hmacKeyLike :: ByteString -> HmacKeyLike
hmacKeyLike ByteString
key = ByteString -> HmacKeyHashed -> HmacKeyLike
HmacKeyLike_Plain ByteString
key (ByteString -> HmacKeyHashed
hmacKeyHashed ByteString
key)

hmacKeyLike_init :: HmacKey -> HmacKeyLike
hmacKeyLike_init :: HmacKey -> HmacKeyLike
hmacKeyLike_init = \case
  HmacKey_Plain ByteString
a HmacKeyHashed
b -> ByteString -> HmacKeyHashed -> HmacKeyLike
HmacKeyLike_Plain ByteString
a HmacKeyHashed
b
  HmacKey_Hashed HmacKeyHashed
b -> HmacKeyHashed -> HmacKeyLike
HmacKeyLike_Hashed HmacKeyHashed
b

hmacKeyLike_initHashed :: HmacKeyHashed -> HmacKeyLike
hmacKeyLike_initHashed :: HmacKeyHashed -> HmacKeyLike
hmacKeyLike_initHashed = HmacKeyHashed -> HmacKeyLike
HmacKeyLike_Hashed

hmacKeyLike_initPrefixed :: HmacKeyPrefixed -> HmacKeyLike
hmacKeyLike_initPrefixed :: HmacKeyPrefixed -> HmacKeyLike
hmacKeyLike_initPrefixed = HmacKeyPrefixed -> HmacKeyLike
HmacKeyLike_Prefixed

hmacKeyLike_toPlain :: HmacKeyLike -> Maybe HmacKeyPlain
hmacKeyLike_toPlain :: HmacKeyLike -> Maybe ByteString
hmacKeyLike_toPlain = \case
  HmacKeyLike_Plain ByteString
a HmacKeyHashed
_ -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
a
  HmacKeyLike_Hashed HmacKeyHashed
_ -> Maybe ByteString
forall a. Maybe a
Nothing
  HmacKeyLike_Prefixed HmacKeyPrefixed
_ -> Maybe ByteString
forall a. Maybe a
Nothing

hmacKeyLike_toHashed :: HmacKeyLike -> Maybe HmacKeyHashed
hmacKeyLike_toHashed :: HmacKeyLike -> Maybe HmacKeyHashed
hmacKeyLike_toHashed = \case
  HmacKeyLike_Plain ByteString
_ HmacKeyHashed
a -> HmacKeyHashed -> Maybe HmacKeyHashed
forall a. a -> Maybe a
Just HmacKeyHashed
a
  HmacKeyLike_Hashed HmacKeyHashed
a -> HmacKeyHashed -> Maybe HmacKeyHashed
forall a. a -> Maybe a
Just HmacKeyHashed
a
  HmacKeyLike_Prefixed HmacKeyPrefixed
a -> HmacKeyPrefixed -> Maybe HmacKeyHashed
hmacKeyPrefixed_toHashed HmacKeyPrefixed
a

hmacKeyLike_toKey :: HmacKeyLike -> Maybe HmacKey
hmacKeyLike_toKey :: HmacKeyLike -> Maybe HmacKey
hmacKeyLike_toKey = \case
  HmacKeyLike_Plain ByteString
a HmacKeyHashed
b -> HmacKey -> Maybe HmacKey
forall a. a -> Maybe a
Just (HmacKey -> Maybe HmacKey) -> HmacKey -> Maybe HmacKey
forall a b. (a -> b) -> a -> b
$ ByteString -> HmacKeyHashed -> HmacKey
HmacKey_Plain ByteString
a HmacKeyHashed
b
  HmacKeyLike_Hashed HmacKeyHashed
b -> HmacKey -> Maybe HmacKey
forall a. a -> Maybe a
Just (HmacKey -> Maybe HmacKey) -> HmacKey -> Maybe HmacKey
forall a b. (a -> b) -> a -> b
$ HmacKeyHashed -> HmacKey
HmacKey_Hashed HmacKeyHashed
b
  HmacKeyLike_Prefixed HmacKeyPrefixed
c -> HmacKeyHashed -> HmacKey
HmacKey_Hashed (HmacKeyHashed -> HmacKey) -> Maybe HmacKeyHashed -> Maybe HmacKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HmacKeyPrefixed -> Maybe HmacKeyHashed
hmacKeyPrefixed_toHashed HmacKeyPrefixed
c

hmacKeyLike_run :: HmacKeyLike -> HmacCtx
hmacKeyLike_run :: HmacKeyLike -> HmacCtx
hmacKeyLike_run = \case
  HmacKeyLike_Plain ByteString
_ HmacKeyHashed
a -> HmacKeyHashed -> HmacCtx
hmacKeyHashed_run HmacKeyHashed
a
  HmacKeyLike_Hashed HmacKeyHashed
a -> HmacKeyHashed -> HmacCtx
hmacKeyHashed_run HmacKeyHashed
a
  HmacKeyLike_Prefixed HmacKeyPrefixed
a -> HmacKeyPrefixed -> HmacCtx
hmacKeyPrefixed_run HmacKeyPrefixed
a

-- | how many bytes have been fed into the SHA256 state machine?  This is always 64
--   more bytes than hmac's "message" input.
--   If @hmacKeyLike_toKey x == Just ...@, then @hmacKeyLike_byteCount x == 64@.
--   If @hmacKeyLike_toKey x == Nothing@, then this returns a multiple of 64 that is
--   greater or equal to 128.
--   

hmacKeyLike_byteCount :: HmacKeyLike -> Word64
hmacKeyLike_byteCount :: HmacKeyLike -> Word64
hmacKeyLike_byteCount = \case
  HmacKeyLike_Plain ByteString
_ HmacKeyHashed
_ -> Word64
64
  HmacKeyLike_Hashed HmacKeyHashed
_ -> Word64
64
  HmacKeyLike_Prefixed HmacKeyPrefixed
b -> HmacKeyPrefixed -> Word64
hmacKeyPrefixed_byteCount HmacKeyPrefixed
b

hmacKeyLike_blockCount :: HmacKeyLike -> Word64
hmacKeyLike_blockCount :: HmacKeyLike -> Word64
hmacKeyLike_blockCount = \case
  HmacKeyLike_Plain ByteString
_ HmacKeyHashed
_ -> Word64
1
  HmacKeyLike_Hashed HmacKeyHashed
_ -> Word64
1
  HmacKeyLike_Prefixed HmacKeyPrefixed
b -> HmacKeyPrefixed -> Word64
hmacKeyPrefixed_blockCount HmacKeyPrefixed
b

hmacKeyLike_bufferLength :: HmacKeyLike -> Word8
hmacKeyLike_bufferLength :: HmacKeyLike -> Word8
hmacKeyLike_bufferLength = Word8 -> HmacKeyLike -> Word8
forall a b. a -> b -> a
const Word8
0

-- | Precompute an HmacKey without retaining the plaintext input, equivalent to
--   'hmacKey_forgetInput . hmacKey'
hmacKey_hashed :: HmacKeyPlain -> HmacKey
hmacKey_hashed :: ByteString -> HmacKey
hmacKey_hashed = HmacKeyHashed -> HmacKey
HmacKey_Hashed (HmacKeyHashed -> HmacKey)
-> (ByteString -> HmacKeyHashed) -> ByteString -> HmacKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HmacKeyHashed
hmacKeyHashed

hmacKey_run :: HmacKey -> HmacCtx
hmacKey_run :: HmacKey -> HmacCtx
hmacKey_run = HmacKey -> HmacCtx
hmacCtx_init

hmacKeyHashed :: HmacKeyPlain -> HmacKeyHashed
hmacKeyHashed :: ByteString -> HmacKeyHashed
hmacKeyHashed ByteString
key = Sha256State -> Sha256State -> HmacKeyHashed
HmacKeyHashed Sha256State
opad Sha256State
ipad
  where
    ipad :: Sha256State
ipad = Word8 -> Sha256State
tweak Word8
0x36
    opad :: Sha256State
opad = Word8 -> Sha256State
tweak Word8
0x5c
    k1 :: ByteString
k1 = if ByteString -> Int
B.length ByteString
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 then ByteString -> ByteString
Sha256.hash ByteString
key else ByteString
key
    k2 :: ByteString
k2 = ByteString -> ByteString -> ByteString
B.append ByteString
k1 (Int -> Word8 -> ByteString
B.replicate (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
k1) Word8
0)
    tweak :: Word8 -> Sha256State
tweak Word8
c = Sha256State
sha256state_init Sha256State -> (Sha256State -> Sha256State) -> Sha256State
forall a b. a -> (a -> b) -> b
& ByteString -> Sha256State -> Sha256State
sha256state_feed ((Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
c) ByteString
k2)

hmacKeyHashed_toKey :: HmacKeyHashed -> HmacKey
hmacKeyHashed_toKey :: HmacKeyHashed -> HmacKey
hmacKeyHashed_toKey = HmacKeyHashed -> HmacKey
HmacKey_Hashed

hmacKeyHashed_run :: HmacKeyHashed -> HmacCtx
hmacKeyHashed_run :: HmacKeyHashed -> HmacCtx
hmacKeyHashed_run HmacKeyHashed
key = HmacCtx
    { hmacCtx_ipadCtx :: Sha256Ctx
hmacCtx_ipadCtx = HmacKeyHashed -> Sha256Ctx
hmacKeyHashed_ipadCtx HmacKeyHashed
key
    , hmacCtx_opad :: Sha256State
hmacCtx_opad = HmacKeyHashed -> Sha256State
hmacKeyHashed_opad HmacKeyHashed
key
    }

hmacKeyHashed_runWith :: HmacKeyHashed -> ByteString -> HmacCtx
hmacKeyHashed_runWith :: HmacKeyHashed -> ByteString -> HmacCtx
hmacKeyHashed_runWith HmacKeyHashed
key ByteString
str = HmacCtx
    { hmacCtx_ipadCtx :: Sha256Ctx
hmacCtx_ipadCtx = HmacKeyHashed -> ByteString -> Sha256Ctx
hmacKeyHashed_runIpadCtx HmacKeyHashed
key ByteString
str
    , hmacCtx_opad :: Sha256State
hmacCtx_opad = HmacKeyHashed -> Sha256State
hmacKeyHashed_opad HmacKeyHashed
key
    }

hmacKeyPrefixed :: HmacKeyPlain -> HmacKeyPrefixed
hmacKeyPrefixed :: ByteString -> HmacKeyPrefixed
hmacKeyPrefixed = HmacKeyHashed -> HmacKeyPrefixed
hmacKeyPrefixed_initHashed (HmacKeyHashed -> HmacKeyPrefixed)
-> (ByteString -> HmacKeyHashed) -> ByteString -> HmacKeyPrefixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HmacKeyHashed
hmacKeyHashed

hmacKeyPrefixed_init :: HmacKey -> HmacKeyPrefixed
hmacKeyPrefixed_init :: HmacKey -> HmacKeyPrefixed
hmacKeyPrefixed_init = HmacKeyHashed -> HmacKeyPrefixed
hmacKeyPrefixed_initHashed (HmacKeyHashed -> HmacKeyPrefixed)
-> (HmacKey -> HmacKeyHashed) -> HmacKey -> HmacKeyPrefixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HmacKey -> HmacKeyHashed
hmacKey_toHashed

hmacKeyPrefixed_initLike :: HmacKeyLike -> HmacKeyPrefixed
hmacKeyPrefixed_initLike :: HmacKeyLike -> HmacKeyPrefixed
hmacKeyPrefixed_initLike = HmacKeyLike -> HmacKeyPrefixed
hmacKeyLike_toPrefixed

hmacKeyPrefixed_toHashed :: HmacKeyPrefixed -> Maybe HmacKeyHashed
hmacKeyPrefixed_toHashed :: HmacKeyPrefixed -> Maybe HmacKeyHashed
hmacKeyPrefixed_toHashed HmacKeyPrefixed
x =
  if HmacKeyPrefixed -> Word64
hmacKeyPrefixed_blockCount HmacKeyPrefixed
x Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
1
  then HmacKeyHashed -> Maybe HmacKeyHashed
forall a. a -> Maybe a
Just (HmacKeyHashed -> Maybe HmacKeyHashed)
-> HmacKeyHashed -> Maybe HmacKeyHashed
forall a b. (a -> b) -> a -> b
$ HmacKeyHashed
    { hmacKeyHashed_ipad :: Sha256State
hmacKeyHashed_ipad = Sha256Ctx -> Sha256State
sha256state_fromCtxInplace (HmacKeyPrefixed -> Sha256Ctx
hmacKeyPrefixed_ipadCtx HmacKeyPrefixed
x)
    , hmacKeyHashed_opad :: Sha256State
hmacKeyHashed_opad = HmacKeyPrefixed -> Sha256State
hmacKeyPrefixed_opad HmacKeyPrefixed
x
    }
  else Maybe HmacKeyHashed
forall a. Maybe a
Nothing

hmacKeyPrefixed_feed :: ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feed :: ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feed ByteString
x = [ByteString] -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
forall (f :: * -> *).
Foldable f =>
f ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feeds [ByteString
x]

hmacKeyPrefixed_feeds :: Foldable f => f ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feeds :: forall (f :: * -> *).
Foldable f =>
f ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feeds = (ByteString -> ByteString)
-> f ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
forall (f :: * -> *) a.
Foldable f =>
(a -> ByteString)
-> f a -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feedsWith ByteString -> ByteString
forall a. a -> a
id

hmacKeyPrefixed_feedsWith :: Foldable f => (a -> ByteString) -> f a -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feedsWith :: forall (f :: * -> *) a.
Foldable f =>
(a -> ByteString)
-> f a -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feedsWith a -> ByteString
f = [ByteString] -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
go ([ByteString] -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed))
-> (f a -> [ByteString])
-> f a
-> HmacKeyPrefixed
-> (ByteString, HmacKeyPrefixed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
f ([a] -> [ByteString]) -> (f a -> [a]) -> f a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  where
    go :: [ByteString] -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
go [ByteString]
bss !HmacKeyPrefixed
st =
      case Int64 -> [ByteString] -> [ByteString]
takeBs' Int64
64 [ByteString]
bss of
        [] -> ([ByteString] -> ByteString
B.concat [ByteString]
bss, HmacKeyPrefixed
st)
        [ByteString]
x  -> [ByteString] -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
go (Int64 -> [ByteString] -> [ByteString]
dropBs Int64
64 [ByteString]
bss) HmacKeyPrefixed
st'
                where
                  st' :: HmacKeyPrefixed
st' = HmacKeyPrefixed
                    { hmacKeyPrefixed_ipadCtx :: Sha256Ctx
hmacKeyPrefixed_ipadCtx = Sha256Ctx -> [ByteString] -> Sha256Ctx
forall (f :: * -> *).
Foldable f =>
Sha256Ctx -> f ByteString -> Sha256Ctx
sha256_updates (HmacKeyPrefixed -> Sha256Ctx
hmacKeyPrefixed_ipadCtx HmacKeyPrefixed
st) [ByteString]
x
                    , hmacKeyPrefixed_opad :: Sha256State
hmacKeyPrefixed_opad = HmacKeyPrefixed -> Sha256State
hmacKeyPrefixed_opad HmacKeyPrefixed
st
                    }

hmacKeyPrefixed_run :: HmacKeyPrefixed -> HmacCtx
hmacKeyPrefixed_run :: HmacKeyPrefixed -> HmacCtx
hmacKeyPrefixed_run HmacKeyPrefixed
key = HmacCtx
    { hmacCtx_ipadCtx :: Sha256Ctx
hmacCtx_ipadCtx = HmacKeyPrefixed -> Sha256Ctx
hmacKeyPrefixed_ipadCtx HmacKeyPrefixed
key
    , hmacCtx_opad :: Sha256State
hmacCtx_opad    = HmacKeyPrefixed -> Sha256State
hmacKeyPrefixed_opad HmacKeyPrefixed
key
    }

hmacKeyPrefixed_byteCount :: HmacKeyPrefixed -> Word64
hmacKeyPrefixed_byteCount :: HmacKeyPrefixed -> Word64
hmacKeyPrefixed_byteCount = Sha256Ctx -> Word64
sha256_byteCount (Sha256Ctx -> Word64)
-> (HmacKeyPrefixed -> Sha256Ctx) -> HmacKeyPrefixed -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HmacKeyPrefixed -> Sha256Ctx
hmacKeyPrefixed_ipadCtx

hmacKeyPrefixed_bufferLength :: HmacKeyPrefixed -> Word8
hmacKeyPrefixed_bufferLength :: HmacKeyPrefixed -> Word8
hmacKeyPrefixed_bufferLength = Word8 -> HmacKeyPrefixed -> Word8
forall a b. a -> b -> a
const Word8
0

-- | A simple interface to HMAC-SHA256. Note that this function was written
--   to make partial application an efficient way to compute the hmac of
--   multiple messages with exactly the same key:
--
--   @
--     let myHash = hmac "my-key"
--      in (myHash "message 1", myHash "message 2", myHash "message 3")
--   @
--
--   This typically saves two SHA-256 blocks per reused function application.
--   Thus this example saves four block computations from the two reused
--   calls to @myHash@ in this example.
--
--   Initializing the @myHash@ closure requires computing two SHA-256 blocks.
--   Applying the closure requires two further SHA-256 blocks per message,
--   as every message is less than 56 bytes long. Thus the total computation
--   requires 8 SHA-256 blocks with reuse, or 12 SHA-256 blocks without reuse.
--
--   Key reuse can save four or more block computations per application if
--   the reused key is longer than 64 bytes. I don't recommend using HMAC
--   keys that are longer than 64 bytes, as all such keys can be trivially
--   replaced with the SHA256 hash of the key, which is only 32 bytes long.
--
--   This high-level interface is implemented using 'hmacCtx_finalize',
--   'hmacKeyHashed_run', and 'hmacKeyHashed' composed in a point-free style
--   in order to help ensure key reuse works as expected.

hmac :: HmacKeyPlain -> ByteString -> ByteString
hmac :: ByteString -> ByteString -> ByteString
hmac = (HmacCtx -> ByteString)
-> (ByteString -> HmacCtx) -> ByteString -> ByteString
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HmacCtx -> ByteString
hmacCtx_finalize_toByteString ((ByteString -> HmacCtx) -> ByteString -> ByteString)
-> (ByteString -> ByteString -> HmacCtx)
-> ByteString
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HmacKey -> ByteString -> HmacCtx
hmacCtx_initWith (HmacKey -> ByteString -> HmacCtx)
-> (ByteString -> HmacKey) -> ByteString -> ByteString -> HmacCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HmacKey
hmacKey_hashed

hmac' :: HmacKeyPlain -> ByteString -> HashString
hmac' :: ByteString -> ByteString -> HashString
hmac' = (HmacCtx -> HashString)
-> (ByteString -> HmacCtx) -> ByteString -> HashString
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HmacCtx -> HashString
hmacCtx_finalize ((ByteString -> HmacCtx) -> ByteString -> HashString)
-> (ByteString -> ByteString -> HmacCtx)
-> ByteString
-> ByteString
-> HashString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HmacKey -> ByteString -> HmacCtx
hmacCtx_initWith (HmacKey -> ByteString -> HmacCtx)
-> (ByteString -> HmacKey) -> ByteString -> ByteString -> HmacCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HmacKey
hmacKey_hashed

hmacCtx :: HmacKeyPlain -> HmacCtx
hmacCtx :: ByteString -> HmacCtx
hmacCtx = HmacKey -> HmacCtx
hmacCtx_init (HmacKey -> HmacCtx)
-> (ByteString -> HmacKey) -> ByteString -> HmacCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HmacKey
hmacKey_hashed

-- | Initialize a new empty HMAC context from a precomputed HMAC key.

hmacCtx_init :: HmacKey -> HmacCtx
hmacCtx_init :: HmacKey -> HmacCtx
hmacCtx_init = HmacKeyHashed -> HmacCtx
hmacKeyHashed_run (HmacKeyHashed -> HmacCtx)
-> (HmacKey -> HmacKeyHashed) -> HmacKey -> HmacCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HmacKey -> HmacKeyHashed
hmacKey_toHashed

hmacCtx_initWith :: HmacKey -> ByteString -> HmacCtx
hmacCtx_initWith :: HmacKey -> ByteString -> HmacCtx
hmacCtx_initWith = HmacKeyHashed -> ByteString -> HmacCtx
hmacKeyHashed_runWith (HmacKeyHashed -> ByteString -> HmacCtx)
-> (HmacKey -> HmacKeyHashed) -> HmacKey -> ByteString -> HmacCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HmacKey -> HmacKeyHashed
hmacKey_toHashed

-- | Append a bytestring onto the end of the message argument to HMAC.

hmacCtx_update ::  HmacCtx -> ByteString -> HmacCtx
hmacCtx_update :: HmacCtx -> ByteString -> HmacCtx
hmacCtx_update = (ByteString -> HmacCtx -> HmacCtx)
-> HmacCtx -> ByteString -> HmacCtx
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> HmacCtx -> HmacCtx
hmacCtx_feed

hmacCtx_feed :: ByteString -> HmacCtx -> HmacCtx
hmacCtx_feed :: ByteString -> HmacCtx -> HmacCtx
hmacCtx_feed ByteString
b (HmacCtx Sha256State
oc Sha256Ctx
ic) = Sha256State -> Sha256Ctx -> HmacCtx
HmacCtx Sha256State
oc (Sha256Ctx -> ByteString -> Sha256Ctx
sha256_update Sha256Ctx
ic ByteString
b)

-- | Append zero or more bytestrings onto the end of the message argument to
--   HMAC.

hmacCtx_updates :: Foldable f => HmacCtx -> f ByteString -> HmacCtx
hmacCtx_updates :: forall (f :: * -> *).
Foldable f =>
HmacCtx -> f ByteString -> HmacCtx
hmacCtx_updates = (f ByteString -> HmacCtx -> HmacCtx)
-> HmacCtx -> f ByteString -> HmacCtx
forall a b c. (a -> b -> c) -> b -> a -> c
flip f ByteString -> HmacCtx -> HmacCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> HmacCtx -> HmacCtx
hmacCtx_feeds

hmacCtx_feeds :: Foldable f => f ByteString -> HmacCtx -> HmacCtx
hmacCtx_feeds :: forall (f :: * -> *).
Foldable f =>
f ByteString -> HmacCtx -> HmacCtx
hmacCtx_feeds f ByteString
bs (HmacCtx Sha256State
oc Sha256Ctx
ic) = Sha256State -> Sha256Ctx -> HmacCtx
HmacCtx Sha256State
oc (Sha256Ctx -> [ByteString] -> Sha256Ctx
forall (f :: * -> *).
Foldable f =>
Sha256Ctx -> f ByteString -> Sha256Ctx
sha256_updates Sha256Ctx
ic (f ByteString -> [ByteString]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f ByteString
bs))

-- | Finish computing the final 32-byte hash for an HMAC context.

hmacCtx_finalize :: HmacCtx -> HashString
hmacCtx_finalize :: HmacCtx -> HashString
hmacCtx_finalize = ByteString -> Word64 -> HmacCtx -> HashString
hmacCtx_finalizeBits ByteString
B.empty Word64
0

-- | Append any arbitrary bitstring onto the end of an HMAC context, and
--   finish computing the final 32-byte hash.

hmacCtx_finalizeBits :: ByteString -> Word64 -> HmacCtx -> HashString
hmacCtx_finalizeBits :: ByteString -> Word64 -> HmacCtx -> HashString
hmacCtx_finalizeBits ByteString
bits Word64
bitlen (HmacCtx Sha256State
oc Sha256Ctx
ic) = HashString
outer
  where
    inner :: ByteString
inner = ByteString -> Word64 -> Sha256Ctx -> ByteString
sha256_finalizeBits_toByteString ByteString
bits Word64
bitlen Sha256Ctx
ic
    outer :: HashString
outer = Sha256Ctx -> HashString
sha256_finalize (Word64 -> ByteString -> Sha256State -> Sha256Ctx
sha256state_runWith Word64
1 ByteString
inner Sha256State
oc)

hmacCtx_finalize_toByteString :: HmacCtx -> ByteString
hmacCtx_finalize_toByteString :: HmacCtx -> ByteString
hmacCtx_finalize_toByteString = ByteString -> Word64 -> HmacCtx -> ByteString
hmacCtx_finalizeBits_toByteString ByteString
B.empty Word64
0

-- | Append any arbitrary bitstring onto the end of an HMAC context, and
--   finish computing the final 32-byte hash.

hmacCtx_finalizeBits_toByteString :: ByteString -> Word64 -> HmacCtx -> ByteString
hmacCtx_finalizeBits_toByteString :: ByteString -> Word64 -> HmacCtx -> ByteString
hmacCtx_finalizeBits_toByteString ByteString
bits Word64
bitlen (HmacCtx Sha256State
oc Sha256Ctx
ic) = ByteString
outer
  where
    inner :: ByteString
inner = ByteString -> Word64 -> Sha256Ctx -> ByteString
sha256_finalizeBits_toByteString ByteString
bits Word64
bitlen Sha256Ctx
ic
    outer :: ByteString
outer = Sha256Ctx -> ByteString
sha256_finalize_toByteString (Word64 -> ByteString -> Sha256State -> Sha256Ctx
sha256state_runWith Word64
1 ByteString
inner Sha256State
oc)

hmacCtx_finalizeBytes :: ByteString -> HmacCtx -> HashString
hmacCtx_finalizeBytes :: ByteString -> HmacCtx -> HashString
hmacCtx_finalizeBytes = (ByteString -> Word64 -> HmacCtx -> HashString)
-> Word64 -> ByteString -> HmacCtx -> HashString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Word64 -> HmacCtx -> HashString
hmacCtx_finalizeBits Word64
forall a. Bounded a => a
maxBound

hmacCtx_finalizeBytes_toByteString :: ByteString -> HmacCtx -> ByteString
hmacCtx_finalizeBytes_toByteString :: ByteString -> HmacCtx -> ByteString
hmacCtx_finalizeBytes_toByteString = (ByteString -> Word64 -> HmacCtx -> ByteString)
-> Word64 -> ByteString -> HmacCtx -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Word64 -> HmacCtx -> ByteString
hmacCtx_finalizeBits_toByteString Word64
forall a. Bounded a => a
maxBound

hmacCtx_byteCount :: HmacCtx -> Word64
hmacCtx_byteCount :: HmacCtx -> Word64
hmacCtx_byteCount = Sha256Ctx -> Word64
sha256_byteCount (Sha256Ctx -> Word64)
-> (HmacCtx -> Sha256Ctx) -> HmacCtx -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HmacCtx -> Sha256Ctx
hmacCtx_ipadCtx

hmacCtx_blockCount :: HmacCtx -> Word64
hmacCtx_blockCount :: HmacCtx -> Word64
hmacCtx_blockCount = Sha256Ctx -> Word64
sha256_blockCount (Sha256Ctx -> Word64)
-> (HmacCtx -> Sha256Ctx) -> HmacCtx -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HmacCtx -> Sha256Ctx
hmacCtx_ipadCtx

hmacCtx_bufferLength :: HmacCtx -> Word8
hmacCtx_bufferLength :: HmacCtx -> Word8
hmacCtx_bufferLength = Sha256Ctx -> Word8
sha256_bufferLength (Sha256Ctx -> Word8) -> (HmacCtx -> Sha256Ctx) -> HmacCtx -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HmacCtx -> Sha256Ctx
hmacCtx_ipadCtx

-- Ugh, I don't have convenient access to cryptohash's internal counter. I
-- should fix that. I also need to fix the fact that cryptohash-sha256 exposes
-- endianess issues in a publicly-facing bytestrings, thus potentially creating
-- less-than-immediately-obvious problems when serializing/deserializing SHA256
-- states. Thus part of the reason why I started on newer SHA256 bindings for
-- GHC 9.4.

-- hmacCtx_toHmacKeyPrefixed :: HmacCtx -> (ByteString, HmacKeyPrefixed)