{-|
Module      : Z.Crypto.Hash
Description : Hash Functions and Checksums
Copyright   : Dong Han, 2021
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

Hash functions are one-way functions, which map data of arbitrary size to a fixed output length. Most of the hash functions in Botan are designed to be cryptographically secure, which means that it is computationally infeasible to create a collision (finding two inputs with the same hash) or preimages (given a hash output, generating an arbitrary input with the same hash). But note that not all such hash functions meet their goals, in particular MD4 and MD5 are trivially broken. However they are still included due to their wide adoption in various protocols.

Using a hash function is typically split into three stages: initialization, update, and finalization (often referred to as a IUF interface). The initialization stage is implicit: after creating a 'Hash' function object, it is ready to process data. Then update is called one or more times. Calling update several times is equivalent to calling it once with all of the arguments concatenated. After completing a hash computation (eg using final), the internal state is reset to begin hashing a new message.

-}
module Z.Crypto.Hash(
    -- * Hash type
    HashType(..)
  , Hash, hashName, hashSize
    -- * IUF interface
  , newHash
  , updateHash
  , finalHash
  , copyHash
  , clearHash
  -- * function interface
  , hash, hashChunks
  -- * BIO interface
  , sinkToHash
  -- * Internal helper
  , hashTypeToCBytes
  , withHash
    -- * re-export
  , module Z.Crypto.SafeMem
  ) where

import           GHC.Generics      (Generic)
import           System.IO.Unsafe  (unsafePerformIO)
import           Z.Botan.Exception (HasCallStack, throwBotanIfMinus_)
import           Z.Botan.FFI
import           Z.Crypto.SafeMem
import           Z.Data.CBytes     as CB
import           Z.Data.JSON       (JSON)
import qualified Z.Data.Text       as T
import qualified Z.Data.Vector     as V
import           Z.Foreign
import           Z.IO.BIO          (pattern EOF, Sink)

-- | Available Hashs
data HashType
      -- | A recently designed hash function. Very fast on 64-bit processors.
      -- Can output a hash of any length between 1 and 64 bytes,
      -- this is specified by passing desired byte length.
    = BLAKE2b Int
      -- | Alias for @Blake2b 32@
    | BLAKE2b256
      -- | Alias for @Blake2b 64@
    | BLAKE2b512
      -- | An older (and incompatible) variant of SHA-3, but sometimes used. Prefer SHA-3 in new code.
    | Keccak1600_224
    | Keccak1600_256
    | Keccak1600_384
    | Keccak1600_512
      -- | An old hash function that is now known to be trivially breakable.
      -- It is very fast, and may still be suitable as a (non-cryptographic) checksum.
    | MD4
      -- | Widely used, now known to be broken.
    | MD5
      -- | A 160 bit hash function, quite old but still thought to be secure
      -- (up to the limit of 2**80 computation required for a collision which is possible
      -- with any 160 bit hash function). Somewhat deprecated these days.
    | RIPEMD160
      -- | Widely adopted NSA designed hash function.
      -- Starting to show significant signs of weakness, and collisions can now be generated. Avoid in new designs.
    | SHA160
      -- | Relatively fast 256 bit hash function, thought to be secure.
      -- Also includes the variant SHA-224. There is no real reason to use SHA-224.
    | SHA256
    | SHA224
      -- | SHA-512 is faster than SHA-256 on 64-bit processors.
      -- Also includes the truncated variants SHA-384 and SHA-512/256,
      -- which have the advantage of avoiding message extension attacks.
    | SHA512
    | SHA384
    | SHA512_256
      -- | The new NIST standard hash. Fairly slow.
      -- Supports 224, 256, 384 or 512 bit outputs.
      -- SHA-3 is faster with smaller outputs. Use as “SHA3_256” or “SHA3_512”.
      -- Plain “SHA-3” selects default 512 bit output.
    | SHA3_224
    | SHA3_256
    | SHA3_384
    | SHA3_512
      -- | These are actually XOFs (extensible output functions) based on SHA-3,
      -- which can output a value of any byte length. For example “SHAKE128 @128”
      -- will produce 1024 bits of output.
    | SHAKE128 Int
    | SHAKE256 Int
      -- | Chinese national hash function, 256 bit output. Widely used in industry there.
      -- Fast and seemingly secure, but no reason to prefer it over SHA-2 or SHA-3 unless required.
    | SM3
      -- | A contender for the NIST SHA-3 competition. Very fast on 64-bit systems. Can output a hash of any length between 1 and 64 bytes. It also accepts an optional “personalization string” which can create variants of the hash. This is useful for domain separation.
    | Skein512 Int CBytes
      -- | Newly designed Russian national hash function.
      -- Due to use of input-dependent table lookups, it is vulnerable to side channels.
      -- There is no reason to use it unless compatibility is needed.
      -- Warning: The Streebog Sbox has recently been revealed to have a hidden structure
      -- which interacts with its linear layer in a way which may provide a backdoor when used in certain ways.
      -- Avoid Streebog if at all possible.
    | Streebog256
    | Streebog512
      -- | A 512-bit hash function standardized by ISO and NESSIE.
      -- Relatively slow, and due to the table based implementation it is potentially vulnerable
      -- to cache based side channels.
    | Whirlpool
      -- | Parallel simply concatenates multiple hash functions.
      --   For example “Parallel SHA256 SHA512 outputs a 256+512 bit hash created by hashing the input
      --   with both SHA256 and SHA512 and concatenating the outputs.
    | Parallel HashType HashType
      -- | This combines two cryptographic hashes in such a way that preimage and collision attacks are
      --   provably at least as hard as a preimage or collision attack on the strongest hash.
    | Comb4P HashType HashType
      -- | Checksums, not suitable for cryptographic use, but can be used for error checking purposes.
    | Adler32
    | CRC24
    | CRC32
  deriving (Int -> HashType -> ShowS
[HashType] -> ShowS
HashType -> String
(Int -> HashType -> ShowS)
-> (HashType -> String) -> ([HashType] -> ShowS) -> Show HashType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashType] -> ShowS
$cshowList :: [HashType] -> ShowS
show :: HashType -> String
$cshow :: HashType -> String
showsPrec :: Int -> HashType -> ShowS
$cshowsPrec :: Int -> HashType -> ShowS
Show, ReadPrec [HashType]
ReadPrec HashType
Int -> ReadS HashType
ReadS [HashType]
(Int -> ReadS HashType)
-> ReadS [HashType]
-> ReadPrec HashType
-> ReadPrec [HashType]
-> Read HashType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HashType]
$creadListPrec :: ReadPrec [HashType]
readPrec :: ReadPrec HashType
$creadPrec :: ReadPrec HashType
readList :: ReadS [HashType]
$creadList :: ReadS [HashType]
readsPrec :: Int -> ReadS HashType
$creadsPrec :: Int -> ReadS HashType
Read, HashType -> HashType -> Bool
(HashType -> HashType -> Bool)
-> (HashType -> HashType -> Bool) -> Eq HashType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashType -> HashType -> Bool
$c/= :: HashType -> HashType -> Bool
== :: HashType -> HashType -> Bool
$c== :: HashType -> HashType -> Bool
Eq, Eq HashType
Eq HashType
-> (HashType -> HashType -> Ordering)
-> (HashType -> HashType -> Bool)
-> (HashType -> HashType -> Bool)
-> (HashType -> HashType -> Bool)
-> (HashType -> HashType -> Bool)
-> (HashType -> HashType -> HashType)
-> (HashType -> HashType -> HashType)
-> Ord HashType
HashType -> HashType -> Bool
HashType -> HashType -> Ordering
HashType -> HashType -> HashType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HashType -> HashType -> HashType
$cmin :: HashType -> HashType -> HashType
max :: HashType -> HashType -> HashType
$cmax :: HashType -> HashType -> HashType
>= :: HashType -> HashType -> Bool
$c>= :: HashType -> HashType -> Bool
> :: HashType -> HashType -> Bool
$c> :: HashType -> HashType -> Bool
<= :: HashType -> HashType -> Bool
$c<= :: HashType -> HashType -> Bool
< :: HashType -> HashType -> Bool
$c< :: HashType -> HashType -> Bool
compare :: HashType -> HashType -> Ordering
$ccompare :: HashType -> HashType -> Ordering
$cp1Ord :: Eq HashType
Ord, (forall x. HashType -> Rep HashType x)
-> (forall x. Rep HashType x -> HashType) -> Generic HashType
forall x. Rep HashType x -> HashType
forall x. HashType -> Rep HashType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HashType x -> HashType
$cfrom :: forall x. HashType -> Rep HashType x
Generic)
  deriving anyclass (Int -> HashType -> Builder ()
(Int -> HashType -> Builder ()) -> Print HashType
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> HashType -> Builder ()
$ctoUTF8BuilderP :: Int -> HashType -> Builder ()
T.Print, Value -> Converter HashType
HashType -> Value
HashType -> Builder ()
(Value -> Converter HashType)
-> (HashType -> Value) -> (HashType -> Builder ()) -> JSON HashType
forall a.
(Value -> Converter a)
-> (a -> Value) -> (a -> Builder ()) -> JSON a
encodeJSON :: HashType -> Builder ()
$cencodeJSON :: HashType -> Builder ()
toValue :: HashType -> Value
$ctoValue :: HashType -> Value
fromValue :: Value -> Converter HashType
$cfromValue :: Value -> Converter HashType
JSON)

hashTypeToCBytes :: HashType -> CBytes
hashTypeToCBytes :: HashType -> CBytes
hashTypeToCBytes HashType
h = case HashType
h of
    BLAKE2b Int
siz  -> [CBytes] -> CBytes
CB.concat [ CBytes
"Blake2b(" , Int -> CBytes
sizeCBytes Int
siz, CBytes
")"]
    HashType
BLAKE2b256   -> CBytes
"Blake2b(256)"
    HashType
BLAKE2b512   -> CBytes
"Blake2b(512)"
    HashType
Keccak1600_224 -> CBytes
"Keccak-1600(224)"
    HashType
Keccak1600_256 -> CBytes
"Keccak-1600(256)"
    HashType
Keccak1600_384 -> CBytes
"Keccak-1600(384)"
    HashType
Keccak1600_512 -> CBytes
"Keccak-1600(512)"
    HashType
MD4          -> CBytes
"MD4"
    HashType
MD5          -> CBytes
"MD5"
    HashType
RIPEMD160    -> CBytes
"RIPEMD-160"
    HashType
SHA160       -> CBytes
"SHA-160"
    HashType
SHA224       -> CBytes
"SHA-224"
    HashType
SHA256       -> CBytes
"SHA-256"
    HashType
SHA512       -> CBytes
"SHA-512"
    HashType
SHA384       -> CBytes
"SHA-384"
    HashType
SHA512_256   -> CBytes
"SHA-512-256"
    HashType
SHA3_224     -> CBytes
"SHA-3(224)"
    HashType
SHA3_256     -> CBytes
"SHA-3(256)"
    HashType
SHA3_384     -> CBytes
"SHA-3(384)"
    HashType
SHA3_512     -> CBytes
"SHA-3(512)"
    SHAKE128 Int
siz -> [CBytes] -> CBytes
CB.concat [ CBytes
"SHAKE-128(" , Int -> CBytes
sizeCBytes Int
siz , CBytes
")"]
    SHAKE256 Int
siz -> [CBytes] -> CBytes
CB.concat [ CBytes
"SHAKE-256(" , Int -> CBytes
sizeCBytes Int
siz , CBytes
")"]
    HashType
SM3          -> CBytes
"SM3"
    Skein512 Int
siz CBytes
b -> [CBytes] -> CBytes
CB.concat [ CBytes
"Skein-512(" , Int -> CBytes
sizeCBytes Int
siz, CBytes
"," , CBytes
b , CBytes
")"]
    HashType
Streebog256  -> CBytes
"Streebog-256"
    HashType
Streebog512  -> CBytes
"Streebog-512"
    HashType
Whirlpool    -> CBytes
"Whirlpool"
    Parallel HashType
h1 HashType
h2 -> [CBytes] -> CBytes
CB.concat [ CBytes
"Parallel("
                              , HashType -> CBytes
hashTypeToCBytes HashType
h1
                              , CBytes
","
                              , HashType -> CBytes
hashTypeToCBytes HashType
h2
                              , CBytes
")"]
    Comb4P HashType
h1 HashType
h2 -> [CBytes] -> CBytes
CB.concat [ CBytes
"Comb4P("
                              , HashType -> CBytes
hashTypeToCBytes HashType
h1
                              , CBytes
","
                              , HashType -> CBytes
hashTypeToCBytes HashType
h2
                              , CBytes
")"]
    HashType
Adler32      -> CBytes
"Adler32"
    HashType
CRC24        -> CBytes
"CRC24"
    HashType
CRC32        -> CBytes
"CRC32"
  where
    sizeCBytes :: Int -> CBytes
sizeCBytes = Text -> CBytes
CB.fromText (Text -> CBytes) -> (Int -> Text) -> Int -> CBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Print a => a -> Text
T.toText

-- | A Botan Hash Object.
data Hash = Hash
    { Hash -> BotanStruct
hashStruct :: {-# UNPACK #-} !BotanStruct
    , Hash -> CBytes
hashName   :: {-# UNPACK #-} !CBytes              -- ^ hash algo name
    , Hash -> Int
hashSize   :: {-# UNPACK #-} !Int                 -- ^ hash output size in bytes
    }
    deriving (Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
(Int -> Hash -> ShowS)
-> (Hash -> String) -> ([Hash] -> ShowS) -> Show Hash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hash] -> ShowS
$cshowList :: [Hash] -> ShowS
show :: Hash -> String
$cshow :: Hash -> String
showsPrec :: Int -> Hash -> ShowS
$cshowsPrec :: Int -> Hash -> ShowS
Show, (forall x. Hash -> Rep Hash x)
-> (forall x. Rep Hash x -> Hash) -> Generic Hash
forall x. Rep Hash x -> Hash
forall x. Hash -> Rep Hash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hash x -> Hash
$cfrom :: forall x. Hash -> Rep Hash x
Generic)
    deriving anyclass Int -> Hash -> Builder ()
(Int -> Hash -> Builder ()) -> Print Hash
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> Hash -> Builder ()
$ctoUTF8BuilderP :: Int -> Hash -> Builder ()
T.Print

-- | Pass Hash to FFI as @botan_hash_t@
withHash :: Hash -> (BotanStructT -> IO r) -> IO r
{-# INLINABLE withHash #-}
withHash :: Hash -> (BotanStructT -> IO r) -> IO r
withHash (Hash BotanStruct
h CBytes
_ Int
_) = BotanStruct -> (BotanStructT -> IO r) -> IO r
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
h

-- | Create a new 'Hash' object.
newHash :: HasCallStack => HashType -> IO Hash
{-# INLINABLE newHash #-}
newHash :: HashType -> IO Hash
newHash HashType
typ = do
    let name :: CBytes
name = HashType -> CBytes
hashTypeToCBytes HashType
typ
    BotanStruct
bs <- (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
        (\ MBA# BotanStructT
bts -> CBytes -> (BA# Word8 -> IO CInt) -> IO CInt
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
name ((BA# Word8 -> IO CInt) -> IO CInt)
-> (BA# Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pt ->
            (MBA# BotanStructT -> BA# Word8 -> Word32 -> IO CInt
botan_hash_init MBA# BotanStructT
bts BA# Word8
pt Word32
0))
        FunPtr (BotanStructT -> IO ())
botan_hash_destroy
    (CSize
osiz, CInt
_) <- BotanStruct
-> (BotanStructT -> IO (CSize, CInt)) -> IO (CSize, CInt)
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bs ((BotanStructT -> IO (CSize, CInt)) -> IO (CSize, CInt))
-> (BotanStructT -> IO (CSize, CInt)) -> IO (CSize, CInt)
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbs ->
        forall b.
Prim CSize =>
(MBA# BotanStructT -> IO b) -> IO (CSize, b)
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe @CSize ((MBA# BotanStructT -> IO CInt) -> IO (CSize, CInt))
-> (MBA# BotanStructT -> IO CInt) -> IO (CSize, CInt)
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pl ->
            BotanStructT -> MBA# BotanStructT -> IO CInt
botan_hash_output_length BotanStructT
pbs MBA# BotanStructT
pl
    Hash -> IO Hash
forall (m :: * -> *) a. Monad m => a -> m a
return (BotanStruct -> CBytes -> Int -> Hash
Hash BotanStruct
bs CBytes
name (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
osiz))

-- | Copies the state of the hash object to a new hash object.
copyHash :: HasCallStack => Hash -> IO Hash
{-# INLINABLE copyHash #-}
copyHash :: Hash -> IO Hash
copyHash (Hash BotanStruct
bts0 CBytes
name Int
siz) = do
    BotanStruct
s <- (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
        (\ MBA# BotanStructT
bts -> BotanStruct -> (BotanStructT -> IO CInt) -> IO CInt
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bts0 ((BotanStructT -> IO CInt) -> IO CInt)
-> (BotanStructT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbts0 ->
            MBA# BotanStructT -> BotanStructT -> IO CInt
botan_hash_copy_state MBA# BotanStructT
bts BotanStructT
pbts0)
        FunPtr (BotanStructT -> IO ())
botan_hash_destroy
    Hash -> IO Hash
forall (m :: * -> *) a. Monad m => a -> m a
return (BotanStruct -> CBytes -> Int -> Hash
Hash BotanStruct
s CBytes
name Int
siz)

-- | Reset the state of Hash object back to clean, as if no input has been supplied.
clearHash :: HasCallStack => Hash -> IO ()
{-# INLINABLE clearHash #-}
clearHash :: Hash -> IO ()
clearHash (Hash BotanStruct
bts CBytes
_ Int
_) =
    IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStruct -> (BotanStructT -> IO CInt) -> IO CInt
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bts BotanStructT -> IO CInt
botan_hash_clear)

-- | Feed a chunk of input into a hash object.
updateHash :: HasCallStack => Hash -> V.Bytes -> IO ()
{-# INLINABLE updateHash #-}
updateHash :: Hash -> Bytes -> IO ()
updateHash (Hash BotanStruct
bts CBytes
_ Int
_) Bytes
bs =
    BotanStruct -> (BotanStructT -> IO ()) -> IO ()
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bts ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbts ->
        Bytes -> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
bs ((BA# Word8 -> Int -> Int -> IO ()) -> IO ())
-> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pbs Int
off Int
len ->
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_hash_update BotanStructT
pbts BA# Word8
pbs Int
off Int
len)

-- | Compute hash value.
finalHash :: HasCallStack => Hash -> IO CEBytes
{-# INLINABLE finalHash #-}
finalHash :: Hash -> IO CEBytes
finalHash (Hash BotanStruct
bts CBytes
_ Int
siz) =
    BotanStruct -> (BotanStructT -> IO CEBytes) -> IO CEBytes
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bts ((BotanStructT -> IO CEBytes) -> IO CEBytes)
-> (BotanStructT -> IO CEBytes) -> IO CEBytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbts -> do
        Int -> (MBA# BotanStructT -> IO ()) -> IO CEBytes
forall r. Int -> (MBA# BotanStructT -> IO r) -> IO CEBytes
newCEBytesUnsafe Int
siz (\ MBA# BotanStructT
pout ->
            IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> MBA# BotanStructT -> IO CInt
botan_hash_final BotanStructT
pbts MBA# BotanStructT
pout))

{-| Trun 'Hash' to a 'V.Bytes' sink, update 'Hash' by write bytes to the sink.

@
import Z.Data.CBytes
import Z.Data.Vector.Hex
import Z.Botan.Hash
import Z.IO

-- | Calculate SHA256 and MD5 checksum for a file in one streaming pass.
sha256AndMd5File :: CBytes -> IO (HexBytes, HexBytes)
sha256AndMd5File f =
    withResource (sourceFromFile f) $ \ src -> do
        md5 <- newHash MD5
        sha256 <- newHash SHA256
        runBIO $ src . (joinSink (sinkToHash md5) (sinkToHash sha256))
        h1 <- finalHash md5
        h2 <- finalHash sha256
        return (HexBytes h1, HexBytes h2)
@
-}
sinkToHash :: HasCallStack => Hash -> Sink V.Bytes
{-# INLINABLE sinkToHash #-}
sinkToHash :: Hash -> Sink Bytes
sinkToHash Hash
h = \ Maybe Void -> IO ()
k Maybe Bytes
mbs -> case Maybe Bytes
mbs of
    Just Bytes
bs -> HasCallStack => Hash -> Bytes -> IO ()
Hash -> Bytes -> IO ()
updateHash Hash
h Bytes
bs
    Maybe Bytes
_       -> Maybe Void -> IO ()
k Maybe Void
forall a. Maybe a
EOF

-- | Directly compute a message's hash.
hash :: HasCallStack => HashType -> V.Bytes -> CEBytes
{-# INLINABLE hash #-}
hash :: HashType -> Bytes -> CEBytes
hash HashType
ht Bytes
inp = IO CEBytes -> CEBytes
forall a. IO a -> a
unsafePerformIO (IO CEBytes -> CEBytes) -> IO CEBytes -> CEBytes
forall a b. (a -> b) -> a -> b
$ do
    Hash
h <- HasCallStack => HashType -> IO Hash
HashType -> IO Hash
newHash HashType
ht
    HasCallStack => Hash -> Bytes -> IO ()
Hash -> Bytes -> IO ()
updateHash Hash
h Bytes
inp
    HasCallStack => Hash -> IO CEBytes
Hash -> IO CEBytes
finalHash Hash
h

-- | Directly compute a chunked message's hash.
hashChunks:: HasCallStack => HashType -> [V.Bytes] -> CEBytes
{-# INLINABLE hashChunks #-}
hashChunks :: HashType -> [Bytes] -> CEBytes
hashChunks HashType
ht [Bytes]
inp = IO CEBytes -> CEBytes
forall a. IO a -> a
unsafePerformIO (IO CEBytes -> CEBytes) -> IO CEBytes -> CEBytes
forall a b. (a -> b) -> a -> b
$ do
    Hash
h <- HasCallStack => HashType -> IO Hash
HashType -> IO Hash
newHash HashType
ht
    (Bytes -> IO ()) -> [Bytes] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HasCallStack => Hash -> Bytes -> IO ()
Hash -> Bytes -> IO ()
updateHash Hash
h) [Bytes]
inp
    HasCallStack => Hash -> IO CEBytes
Hash -> IO CEBytes
finalHash Hash
h