{-|
Module      : Botan.Low.Hash
Description : Hash Functions and Checksums
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX

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
hashFinal), the internal state is reset to begin hashing a new message.
-}

module Botan.Low.Hash
( 
    
-- * Hashing
-- $introduction

-- * Usage
-- $usage
 
  Hash(..)
, HashName(..)
, HashDigest(..)
, withHash
, hashInit
, hashDestroy
, hashName
, hashBlockSize
, hashOutputLength
, hashCopyState
, hashUpdate
, hashFinal
, hashUpdateFinalize
, hashUpdateFinalizeClear
, hashClear

-- * Hash algorithms

, pattern BLAKE2b
, blake2b
, pattern Keccak1600
, keccak1600
, pattern GOST_34_11
, pattern MD4
, pattern MD5
, pattern RIPEMD160
, pattern SHA1
, pattern SHA224
, pattern SHA256
, pattern SHA384
, pattern SHA512
, pattern SHA512_256
, pattern SHA3
, sha3
, pattern SHAKE128
, shake128
, pattern SHAKE256
, shake256
, pattern SM3
, pattern Skein512
, skein512
, pattern Streebog256
, pattern Streebog512
, pattern Whirlpool
, pattern Parallel
, pattern Comb4P
, pattern Adler32
, pattern CRC24
, pattern CRC32

-- * Convenience

, cryptohashes
, checksums
, allHashes

) where

import qualified Data.ByteString as ByteString

import System.IO.Unsafe

import Botan.Bindings.Hash

import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.Prelude
import Botan.Low.Remake

{- $introduction

A `hash` is deterministic, one-way function suitable for producing a
deterministic, fixed-size digest from an arbitrarily-sized message, which is
used to verify the integrity of the data.

-}

{- $usage

Unless you need a specific `hash`, it is strongly recommended that you use the `SHA3` algorithm.

> import Botan.Low.Hash
> hash <- hashInit SHA3
> message = "Fee fi fo fum!"
> hashUpdate hash message
> digest <- hashFinal hash

You can verify a digest by hashing the message a second time, and comparing the two:

> rehash <- hashInit SHA3
> hashUpdate rehash message
> redigest <- hashFinal rehash
> digest == redigest -- True

You can clear a hash's state, leaving it ready for reuse:

> hashClear hash
> -- Process another message
> hashUpdate hash anotherMessage
> anotherDigest <- hashFinal hash

-}

newtype Hash = MkHash { Hash -> ForeignPtr BotanHashStruct
getHashForeignPtr :: ForeignPtr BotanHashStruct }

newHash      :: BotanHash -> IO Hash
withHash     :: Hash -> (BotanHash -> IO a) -> IO a
hashDestroy  :: Hash -> IO ()
createHash   :: (Ptr BotanHash -> IO CInt) -> IO Hash
(BotanHash -> IO Hash
newHash, Hash -> (BotanHash -> IO a) -> IO a
withHash, Hash -> IO ()
hashDestroy, (Ptr BotanHash -> IO CInt) -> IO Hash
createHash, (Ptr BotanHash -> Ptr CSize -> IO CInt) -> IO [Hash]
_)
    = (Ptr BotanHashStruct -> BotanHash)
-> (BotanHash -> Ptr BotanHashStruct)
-> (ForeignPtr BotanHashStruct -> Hash)
-> (Hash -> ForeignPtr BotanHashStruct)
-> FinalizerPtr BotanHashStruct
-> (BotanHash -> IO Hash, Hash -> (BotanHash -> IO a) -> IO a,
    Hash -> IO (), (Ptr BotanHash -> IO CInt) -> IO Hash,
    (Ptr BotanHash -> Ptr CSize -> IO CInt) -> IO [Hash])
forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (botan -> IO object, object -> (botan -> IO a) -> IO a,
    object -> IO (), (Ptr botan -> IO CInt) -> IO object,
    (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
mkBindings
        Ptr BotanHashStruct -> BotanHash
MkBotanHash BotanHash -> Ptr BotanHashStruct
runBotanHash
        ForeignPtr BotanHashStruct -> Hash
MkHash Hash -> ForeignPtr BotanHashStruct
getHashForeignPtr
        FinalizerPtr BotanHashStruct
botan_hash_destroy

type HashName = ByteString

pattern BLAKE2b
    ,   Keccak1600
    ,   GOST_34_11
    ,   MD4
    ,   MD5
    ,   RIPEMD160
    ,   SHA1
    ,   SHA224
    ,   SHA256
    ,   SHA384
    ,   SHA512
    ,   SHA512_256
    ,   SHA3
    ,   SHAKE128
    ,   SHAKE256
    ,   SM3
    ,   Skein512
    ,   Streebog256
    ,   Streebog512
    ,   Whirlpool
    ,   Parallel
    ,   Comb4P
    ,   Adler32
    ,   CRC24
    ,   CRC32
    :: HashName

pattern $mBLAKE2b :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bBLAKE2b :: HashName
BLAKE2b         = BOTAN_HASH_BLAKE2B
-- TODO: function
-- sz is digest size in bits, must be 1-64 bytes, eg: 8-512 in multiples of 8
blake2b :: a -> HashName
blake2b a
sz | a
sz a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
512 = HashName
BLAKE2b HashName -> HashName -> HashName
forall a. (IsString a, Semigroup a) => a -> a -> a
/$ a -> HashName
forall a. Show a => a -> HashName
showBytes a
sz
blake2b a
_ = [Char] -> HashName
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid BLAKE2b variant"
pattern $mKeccak1600 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bKeccak1600 :: HashName
Keccak1600     = BOTAN_HASH_KECCAK_1600
-- TODO: function or pattern
keccak1600 :: a -> HashName
keccak1600 a
n | a
n a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
224, a
256, a
384, a
512] = HashName
Keccak1600 HashName -> HashName -> HashName
forall a. (IsString a, Semigroup a) => a -> a -> a
/$ a -> HashName
forall a. Show a => a -> HashName
showBytes a
n
keccak1600 a
_ = [Char] -> HashName
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid Keccak-1600 variant"
-- pattern Keccak1600_224 = "Keccak-1600(224)"
-- pattern Keccak1600_256 = "Keccak-1600(256)"
-- pattern Keccak1600_384 = "Keccak-1600(384)"
-- pattern Keccak1600_512 = "Keccak-1600(512)"
pattern $mGOST_34_11 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bGOST_34_11 :: HashName
GOST_34_11  = BOTAN_HASH_GOST_34_11
pattern $mMD4 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bMD4 :: HashName
MD4         = BOTAN_HASH_MD4
pattern $mMD5 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bMD5 :: HashName
MD5         = BOTAN_HASH_MD5
pattern $mRIPEMD160 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bRIPEMD160 :: HashName
RIPEMD160   = BOTAN_HASH_RIPEMD_160
pattern $mSHA1 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHA1 :: HashName
SHA1        = BOTAN_HASH_SHA1
pattern $mSHA224 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHA224 :: HashName
SHA224      = BOTAN_HASH_SHA_224
pattern $mSHA256 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHA256 :: HashName
SHA256      = BOTAN_HASH_SHA_256
pattern $mSHA384 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHA384 :: HashName
SHA384      = BOTAN_HASH_SHA_384
pattern $mSHA512 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHA512 :: HashName
SHA512      = BOTAN_HASH_SHA_512
pattern $mSHA512_256 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHA512_256 :: HashName
SHA512_256  = BOTAN_HASH_SHA_512_256
pattern $mSHA3 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHA3 :: HashName
SHA3        = BOTAN_HASH_SHA_3
-- TODO: function or pattern
sha3 :: a -> HashName
sha3 a
n | a
n a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
224, a
256, a
384, a
512] = HashName
SHA3 HashName -> HashName -> HashName
forall a. (IsString a, Semigroup a) => a -> a -> a
/$ a -> HashName
forall a. Show a => a -> HashName
showBytes a
n
sha3 a
_ = [Char] -> HashName
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid SHA-3 variant"
-- pattern SHA3_224 = "SHA-3(224)"
-- pattern SHA3_256 = "SHA-3(256)"
-- pattern SHA3_384 = "SHA-3(384)"
-- pattern SHA3_512 = "SHA-3(512)"
pattern $mSHAKE128 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHAKE128 :: HashName
SHAKE128       = BOTAN_HASH_SHAKE_128
-- TODO: function
shake128 :: a -> HashName
shake128 a
sz = HashName
SHAKE128 HashName -> HashName -> HashName
forall a. (IsString a, Semigroup a) => a -> a -> a
/$ a -> HashName
forall a. Show a => a -> HashName
showBytes a
sz
pattern $mSHAKE256 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHAKE256 :: HashName
SHAKE256       = BOTAN_HASH_SHAKE_256
-- TODO: function
shake256 :: a -> HashName
shake256 a
sz = HashName
SHAKE256 HashName -> HashName -> HashName
forall a. (IsString a, Semigroup a) => a -> a -> a
/$ a -> HashName
forall a. Show a => a -> HashName
showBytes a
sz
pattern $mSM3 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSM3 :: HashName
SM3             = BOTAN_HASH_SM3
pattern $mSkein512 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bSkein512 :: HashName
Skein512       = BOTAN_HASH_SKEIN_512
-- TODO: function
skein512 :: a -> HashName -> HashName
skein512 a
sz HashName
salt = HashName
Skein512 HashName -> HashName -> HashName
forall a. (IsString a, Semigroup a) => a -> a -> a
/$ a -> HashName
forall a. Show a => a -> HashName
showBytes a
sz HashName -> HashName -> HashName
forall a. Semigroup a => a -> a -> a
<> HashName
"," HashName -> HashName -> HashName
forall a. Semigroup a => a -> a -> a
<> HashName
salt
pattern $mStreebog256 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bStreebog256 :: HashName
Streebog256    = BOTAN_HASH_STREEBOG_256
pattern $mStreebog512 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bStreebog512 :: HashName
Streebog512    = BOTAN_HASH_STREEBOG_512
pattern $mWhirlpool :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bWhirlpool :: HashName
Whirlpool       = BOTAN_HASH_WHIRLPOOL
pattern $mParallel :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bParallel :: HashName
Parallel        = BOTAN_HASH_STRAT_PARALLEL
-- TODO: function
-- parallel a b =  Parallel /$ a <> "," <> b
-- TODO: function
-- comb4P a b =  Comb4P /$ a <> "," <> b
pattern $mComb4P :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bComb4P :: HashName
Comb4P          = BOTAN_HASH_STRAT_COMB4P
pattern $mAdler32 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bAdler32 :: HashName
Adler32         = BOTAN_CHECKSUM_ADLER32
pattern $mCRC24 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bCRC24 :: HashName
CRC24           = BOTAN_CHECKSUM_CRC24
pattern $mCRC32 :: forall {r}. HashName -> ((# #) -> r) -> ((# #) -> r) -> r
$bCRC32 :: HashName
CRC32           = BOTAN_CHECKSUM_CRC32

cryptohashes :: [HashName]
cryptohashes :: [HashName]
cryptohashes = 
    [ HashName
BLAKE2b
    -- , "BLAKE2b(128)"
    -- , "BLAKE2b(256)"
    -- , "BLAKE2b(512)"
    , HashName
GOST_34_11
    , HashName
Keccak1600
    -- , "Keccak-1600(224)"
    -- , "Keccak-1600(256)"
    -- , "Keccak-1600(384)"
    -- , "Keccak-1600(512)"
    , HashName
MD4
    , HashName
MD5
    , HashName
RIPEMD160
    , HashName
SHA1
    , HashName
SHA224
    , HashName
SHA256
    , HashName
SHA384
    , HashName
SHA512
    , HashName
SHA512_256
    , HashName
SHA3
    -- , "SHA-3(224)"
    -- , "SHA-3(256)"
    -- , "SHA-3(384)"
    -- , "SHA-3(512)"
    -- NOTE: SHAKE-128 has no default value, a parameter *MUST* be supplied
    , Integer -> HashName
forall a. Show a => a -> HashName
shake128 Integer
128
    -- , "SHAKE-128(128)"
    -- , "SHAKE-128(256)"
    -- , "SHAKE-128(512)"
    -- NOTE: SHAKE-256 has no default value, a parameter *MUST* be supplied
    , Integer -> HashName
forall a. Show a => a -> HashName
shake256 Integer
128
    -- , "SHAKE-256(128)"
    -- , "SHAKE-256(256)"
    -- , "SHAKE-256(512)"
    , HashName
SM3
    , HashName
Skein512
    -- , "Skein-512(128)"
    -- , "Skein-512(256)"
    -- , "Skein-512(512)"
    , HashName
Streebog256
    , HashName
Streebog512
    , HashName
Whirlpool
    ]

-- TODO:
-- hashStrategies :: [HashName]
-- hashStrategies = undefined

checksums :: [HashName]
checksums = 
    [ HashName
Adler32
    , HashName
CRC24
    , HashName
CRC32
    ]

allHashes :: [HashName]
allHashes = [HashName]
cryptohashes [HashName] -> [HashName] -> [HashName]
forall a. [a] -> [a] -> [a]
++ [HashName]
checksums

type HashDigest = ByteString

hashInit
    :: HashName -- ^ __hash_name__: name of the hash function, e.g., "SHA-384"
    -> IO Hash  -- ^ __hash__: hash object
hashInit :: HashName -> IO Hash
hashInit = ((Ptr BotanHash -> IO CInt) -> IO Hash)
-> (Ptr BotanHash -> ConstPtr CChar -> IO CInt)
-> HashName
-> IO Hash
forall botan object.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr CChar -> IO CInt)
-> HashName
-> IO object
mkCreateObjectCString (Ptr BotanHash -> IO CInt) -> IO Hash
createHash (\ Ptr BotanHash
out ConstPtr CChar
name -> Ptr BotanHash -> ConstPtr CChar -> Word32 -> IO CInt
botan_hash_init Ptr BotanHash
out ConstPtr CChar
name Word32
0)

-- WARNING: withFooInit-style limited lifetime functions moved to high-level botan
withHashInit :: HashName -> (Hash -> IO a) -> IO a
withHashInit :: forall a. HashName -> (Hash -> IO a) -> IO a
withHashInit = (HashName -> IO Hash)
-> (Hash -> IO ()) -> HashName -> (Hash -> IO a) -> IO a
forall x t a.
(x -> IO t) -> (t -> IO ()) -> x -> (t -> IO a) -> IO a
mkWithTemp1 HashName -> IO Hash
hashInit Hash -> IO ()
hashDestroy

hashName
    :: Hash             -- ^ __hash__: the object to read
    -> IO HashDigest    -- ^ __name__: output buffer
hashName :: Hash -> IO HashName
hashName = WithPtr Hash BotanHash
-> GetCString BotanHash CChar -> Hash -> IO HashName
forall typ ptr byte.
WithPtr typ ptr -> GetCString ptr byte -> typ -> IO HashName
mkGetCString Hash -> (BotanHash -> IO a) -> IO a
WithPtr Hash BotanHash
withHash GetCString BotanHash CChar
botan_hash_name

-- NOTE: This does the correct thing - see C++ docs:
--  Return a newly allocated HashFunction object of the same type as this one,
--  whose internal state matches the current state of this.

hashCopyState
    :: Hash     -- ^ __source__: source hash object
    -> IO Hash  -- ^ __dest__: destination hash object
hashCopyState :: Hash -> IO Hash
hashCopyState Hash
source = Hash -> (BotanHash -> IO Hash) -> IO Hash
WithPtr Hash BotanHash
withHash Hash
source ((BotanHash -> IO Hash) -> IO Hash)
-> (BotanHash -> IO Hash) -> IO Hash
forall a b. (a -> b) -> a -> b
$ \ BotanHash
sourcePtr -> do
    (Ptr BotanHash -> IO CInt) -> IO Hash
createHash ((Ptr BotanHash -> IO CInt) -> IO Hash)
-> (Ptr BotanHash -> IO CInt) -> IO Hash
forall a b. (a -> b) -> a -> b
$ \ Ptr BotanHash
dest -> Ptr BotanHash -> BotanHash -> IO CInt
botan_hash_copy_state Ptr BotanHash
dest BotanHash
sourcePtr

hashClear
    :: Hash -- ^ __hash__: hash object
    -> IO ()
hashClear :: Hash -> IO ()
hashClear =  WithPtr Hash BotanHash -> (BotanHash -> IO CInt) -> Hash -> IO ()
forall typ ptr. WithPtr typ ptr -> Action ptr -> typ -> IO ()
mkAction Hash -> (BotanHash -> IO a) -> IO a
WithPtr Hash BotanHash
withHash BotanHash -> IO CInt
botan_hash_clear

hashBlockSize
    :: Hash     -- ^ __hash__: hash object
    -> IO Int   -- ^ __block_size__: output buffer to hold the hash function block size
hashBlockSize :: Hash -> IO Int
hashBlockSize = WithPtr Hash BotanHash -> GetSize BotanHash -> Hash -> IO Int
forall typ ptr. WithPtr typ ptr -> GetSize ptr -> typ -> IO Int
mkGetSize Hash -> (BotanHash -> IO a) -> IO a
WithPtr Hash BotanHash
withHash GetSize BotanHash
botan_hash_block_size

hashOutputLength
    :: Hash     -- ^ __hash__: hash object
    -> IO Int   -- ^ __block_size__: output buffer to hold the hash function output length
hashOutputLength :: Hash -> IO Int
hashOutputLength = WithPtr Hash BotanHash -> GetSize BotanHash -> Hash -> IO Int
forall typ ptr. WithPtr typ ptr -> GetSize ptr -> typ -> IO Int
mkGetSize Hash -> (BotanHash -> IO a) -> IO a
WithPtr Hash BotanHash
withHash GetSize BotanHash
botan_hash_output_length

hashUpdate
    :: Hash         -- ^ __hash__: hash object
    -> ByteString   -- ^ __in__: input buffer
    -> IO ()
hashUpdate :: Hash -> HashName -> IO ()
hashUpdate = WithPtr Hash BotanHash
-> (BotanHash -> ConstPtr Word8 -> CSize -> IO CInt)
-> Hash
-> HashName
-> IO ()
forall object botan.
(forall a. object -> (botan -> IO a) -> IO a)
-> (botan -> ConstPtr Word8 -> CSize -> IO CInt)
-> object
-> HashName
-> IO ()
mkWithObjectSetterCBytesLen Hash -> (BotanHash -> IO a) -> IO a
WithPtr Hash BotanHash
withHash BotanHash -> ConstPtr Word8 -> CSize -> IO CInt
botan_hash_update

hashFinal
    :: Hash             -- ^ __hash__: hash object
    -> IO HashDigest    -- ^ __out[]__: output buffer
hashFinal :: Hash -> IO HashName
hashFinal Hash
hash = Hash -> (BotanHash -> IO HashName) -> IO HashName
WithPtr Hash BotanHash
withHash Hash
hash ((BotanHash -> IO HashName) -> IO HashName)
-> (BotanHash -> IO HashName) -> IO HashName
forall a b. (a -> b) -> a -> b
$ \ BotanHash
hashPtr -> do
    Int
sz <- Hash -> IO Int
hashOutputLength Hash
hash
    Int -> (Ptr Word8 -> IO ()) -> IO HashName
forall byte. Int -> (Ptr byte -> IO ()) -> IO HashName
allocBytes Int
sz ((Ptr Word8 -> IO ()) -> IO HashName)
-> (Ptr Word8 -> IO ()) -> IO HashName
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
digestPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanHash -> Ptr Word8 -> IO CInt
botan_hash_final BotanHash
hashPtr Ptr Word8
digestPtr

-- TODO:
-- pkcsHashId
--     :: ByteString       -- ^ __hash_name__
--     -> IO ByteString    -- ^ __pkcs_id[]__
-- pkcsHashId = undefined


-- Convenience

hashUpdateFinalize :: Hash -> ByteString -> IO HashDigest
hashUpdateFinalize :: Hash -> HashName -> IO HashName
hashUpdateFinalize Hash
ctx HashName
bytes = do
    Hash -> HashName -> IO ()
hashUpdate Hash
ctx HashName
bytes
    Hash -> IO HashName
hashFinal Hash
ctx

hashUpdateFinalizeClear :: Hash -> ByteString -> IO HashDigest
hashUpdateFinalizeClear :: Hash -> HashName -> IO HashName
hashUpdateFinalizeClear Hash
ctx HashName
bytes = do
    HashName
dg <- Hash -> HashName -> IO HashName
hashUpdateFinalize Hash
ctx HashName
bytes
    Hash -> IO ()
hashClear Hash
ctx
    HashName -> IO HashName
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HashName
dg
-- Or: hashUpdateFinalize ctx bytes <* hashClear ctx

hashWithHash :: Hash -> ByteString -> IO HashDigest
hashWithHash :: Hash -> HashName -> IO HashName
hashWithHash = Hash -> HashName -> IO HashName
hashUpdateFinalizeClear

hashWithName :: HashName -> ByteString -> IO HashDigest
hashWithName :: HashName -> HashName -> IO HashName
hashWithName HashName
name HashName
bytes = do
    Hash
ctx <- HashName -> IO Hash
hashInit HashName
name
    Hash -> HashName -> IO HashName
hashWithHash Hash
ctx HashName
bytes