{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
--
-- Module: Sel.Hashing
-- Description: Hashing with the BLAKE2b algorithm
-- Copyright: (C) Hécate Moonlight 2022
-- License: BSD-3-Clause
-- Maintainer: The Haskell Cryptography Group
-- Portability: GHC only
module Sel.Hashing
  ( -- ** Introduction
    -- $introduction

    -- ** Hashing a message
    HashKey
  , newHashKey
  , Hash
  , hashByteString

    -- ** Hashing a multi-part message
  , Multipart
  , withMultipart
  , updateMultipart

    -- ** Conversion
  , hashToHexText
  , hashToHexByteString
  , hashToBinary
  )
where

import Control.Monad (void)
import Data.ByteString (StrictByteString)
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Internal as BS
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import qualified Data.ByteString.Unsafe as BS
import Data.Text (Text)
import Data.Text.Display
import qualified Data.Text.Lazy.Builder as Builder
import Foreign (Ptr)
import qualified Foreign
import Foreign.C (CChar, CInt, CSize, CUChar, CULLong)
import Foreign.ForeignPtr
import Foreign.Storable
import System.IO.Unsafe (unsafeDupablePerformIO)

import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.Base16.Types as Base16
import Data.Kind (Type)
import LibSodium.Bindings.GenericHashing
  ( CryptoGenericHashState
  , cryptoGenericHash
  , cryptoGenericHashBytes
  , cryptoGenericHashFinal
  , cryptoGenericHashInit
  , cryptoGenericHashKeyBytes
  , cryptoGenericHashKeyGen
  , cryptoGenericHashStateBytes
  , cryptoGenericHashUpdate
  )
import Sel.Internal

-- $introduction
--
-- This API computes a fixed-length fingerprint for an arbitrarily long message.
-- It is backed by the [BLAKE2b](https://en.wikipedia.org/wiki/BLAKE_\(hash_function\)) algorithm.
--
-- Sample use cases:
--
--   * File integrity checking
--   * Creating unique identifiers to index arbitrarily long data
--
-- __⚠️ Do not use this module to hash passwords! ⚠️__ Please use the "Sel.Hashing.Password" module instead.
--
-- If you need to deviate from the defaults enforced by this module,
-- please use the underlying bindings at "LibSodium.Bindings.GenericHashing".

-- | The 'HashKey' is used to produce distinct fingerprints for the same message.
-- It is optional to use, and 'hashByteString' will always produce the same fingerprint
-- for the same message if a 'HashKey' is not given. This behaviour is similar to
-- MD5 and SHA-1 functions, for which 'hashByteString' is a faster and more secure alternative.
--
-- Create a new 'HashKey' with 'newHashKey'.
--
-- @since 0.0.1.0
newtype HashKey = HashKey (ForeignPtr CUChar)

instance Eq HashKey where
  (HashKey ForeignPtr CUChar
hk1) == :: HashKey -> HashKey -> Bool
== (HashKey ForeignPtr CUChar
hk2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoGenericHashKeyBytes

instance Ord HashKey where
  compare :: HashKey -> HashKey -> Ordering
compare (HashKey ForeignPtr CUChar
hk1) (HashKey ForeignPtr CUChar
hk2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
hk1 ForeignPtr CUChar
hk2 CSize
cryptoGenericHashKeyBytes

-- | Create a new 'HashKey' of size 'cryptoGenericHashKeyBytes'.
--
-- @since 0.0.1.0
newHashKey :: IO HashKey
newHashKey :: IO HashKey
newHashKey = do
  ForeignPtr CUChar
fPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoGenericHashKeyBytes)
  ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
fPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
ptr ->
    Ptr CUChar -> IO ()
cryptoGenericHashKeyGen Ptr CUChar
ptr
  HashKey -> IO HashKey
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashKey -> IO HashKey) -> HashKey -> IO HashKey
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> HashKey
HashKey ForeignPtr CUChar
fPtr

-- | The fingerprint computed by @hashByteString@.
-- It is produced by the BLAKE2b algorithm, and is
-- of size 'cryptoGenericHashBytes', as recommended.
--
-- You can produce a human-readable string representation
-- of a 'Hash' by using the @display@ function.
--
-- @since 0.0.1.0
newtype Hash = Hash (ForeignPtr CUChar)

-- |
--
-- @since 0.0.1.0
instance Eq Hash where
  (Hash ForeignPtr CUChar
h1) == :: Hash -> Hash -> Bool
== (Hash ForeignPtr CUChar
h2) =
    IO Bool -> Bool
forall a. IO a -> a
unsafeDupablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Bool
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Bool
foreignPtrEq ForeignPtr CUChar
h1 ForeignPtr CUChar
h2 CSize
cryptoGenericHashBytes

-- |
--
-- @since 0.0.1.0
instance Ord Hash where
  compare :: Hash -> Hash -> Ordering
compare (Hash ForeignPtr CUChar
h1) (Hash ForeignPtr CUChar
h2) =
    IO Ordering -> Ordering
forall a. IO a -> a
unsafeDupablePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
      ForeignPtr CUChar -> ForeignPtr CUChar -> CSize -> IO Ordering
forall a. ForeignPtr a -> ForeignPtr a -> CSize -> IO Ordering
foreignPtrOrd ForeignPtr CUChar
h1 ForeignPtr CUChar
h2 CSize
cryptoGenericHashBytes

-- |
--
-- @since 0.0.1.0
instance Storable Hash where
  sizeOf :: Hash -> Int
  sizeOf :: Hash -> Int
sizeOf Hash
_ = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoGenericHashBytes

  --  Aligned on the size of 'cryptoGenericHashBytes'
  alignment :: Hash -> Int
  alignment :: Hash -> Int
alignment Hash
_ = Int
32

  poke :: Ptr Hash -> Hash -> IO ()
  poke :: Ptr Hash -> Hash -> IO ()
poke Ptr Hash
ptr (Hash ForeignPtr CUChar
hashForeignPtr) =
    ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
hashForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
hashPtr ->
      Ptr CUChar -> Ptr CUChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray (Ptr Hash -> Ptr CUChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr Hash
ptr) Ptr CUChar
hashPtr (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoGenericHashKeyBytes)

  peek :: Ptr Hash -> IO Hash
  peek :: Ptr Hash -> IO Hash
peek Ptr Hash
ptr = do
    ForeignPtr CUChar
hashfPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoGenericHashKeyBytes)
    ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
hashfPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
hashPtr ->
      Ptr CUChar -> Ptr CUChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
Foreign.copyArray Ptr CUChar
hashPtr (Ptr Hash -> Ptr CUChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr Hash
ptr) (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoGenericHashKeyBytes)
    Hash -> IO Hash
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hash -> IO Hash) -> Hash -> IO Hash
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> Hash
Hash ForeignPtr CUChar
hashfPtr

-- |
--
-- @since 0.0.1.0
instance Display Hash where
  displayBuilder :: Hash -> Builder
displayBuilder = Text -> Builder
Builder.fromText (Text -> Builder) -> (Hash -> Text) -> Hash -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Text
hashToHexText

-- |
--
-- @since 0.0.1.0
instance Show Hash where
  show :: Hash -> String
show = ByteString -> String
BS.unpackChars (ByteString -> String) -> (Hash -> ByteString) -> Hash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> ByteString
hashToHexByteString

-- | Hash a 'StrictByteString' with the BLAKE2b algorithm, and an optional key.
--
-- Without a 'HashKey', hashing the same data twice will give the same result.
--
-- @since 0.0.1.0
hashByteString :: Maybe HashKey -> StrictByteString -> IO Hash
hashByteString :: Maybe HashKey -> ByteString -> IO Hash
hashByteString Maybe HashKey
mHashKey ByteString
bytestring =
  case Maybe HashKey
mHashKey of
    Just (HashKey ForeignPtr CUChar
fPtr) ->
      ForeignPtr CUChar -> (Ptr CUChar -> IO Hash) -> IO Hash
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
fPtr ((Ptr CUChar -> IO Hash) -> IO Hash)
-> (Ptr CUChar -> IO Hash) -> IO Hash
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
keyPtr ->
        Ptr CUChar -> CSize -> IO Hash
forall a. Ptr a -> CSize -> IO Hash
doHashByteString Ptr CUChar
keyPtr CSize
cryptoGenericHashKeyBytes
    Maybe HashKey
Nothing ->
      Ptr Any -> CSize -> IO Hash
forall a. Ptr a -> CSize -> IO Hash
doHashByteString Ptr Any
forall a. Ptr a
Foreign.nullPtr CSize
0
  where
    doHashByteString :: Ptr a -> CSize -> IO Hash
    doHashByteString :: forall a. Ptr a -> CSize -> IO Hash
doHashByteString Ptr a
keyPtr CSize
keyLength =
      ByteString -> (CStringLen -> IO Hash) -> IO Hash
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bytestring ((CStringLen -> IO Hash) -> IO Hash)
-> (CStringLen -> IO Hash) -> IO Hash
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
        ForeignPtr CUChar
hashForeignPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoGenericHashBytes)
        ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
hashForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
hashPtr -> do
          IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr CUChar
-> CSize -> Ptr CUChar -> CULLong -> Ptr CUChar -> CSize -> IO CInt
cryptoGenericHash
              Ptr CUChar
hashPtr
              CSize
cryptoGenericHashBytes
              (Ptr CChar -> Ptr CUChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr CChar
cString :: Ptr CUChar)
              (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cStringLen)
              (Ptr a -> Ptr CUChar
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr a
keyPtr :: Ptr CUChar)
              CSize
keyLength
        Hash -> IO Hash
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hash -> IO Hash) -> Hash -> IO Hash
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> Hash
Hash ForeignPtr CUChar
hashForeignPtr

-- | Convert a 'Hash' to a strict, hexadecimal-encoded 'Text'.
--
-- @since 0.0.1.0
hashToHexText :: Hash -> Text
hashToHexText :: Hash -> Text
hashToHexText = Base16 Text -> Text
forall a. Base16 a -> a
Base16.extractBase16 (Base16 Text -> Text) -> (Hash -> Base16 Text) -> Hash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base16 Text
Base16.encodeBase16 (ByteString -> Base16 Text)
-> (Hash -> ByteString) -> Hash -> Base16 Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> ByteString
hashToBinary

-- | Convert a 'Hash' to a strict, hexadecimal-encoded 'StrictByteString'.
--
-- @since 0.0.1.0
hashToHexByteString :: Hash -> StrictByteString
hashToHexByteString :: Hash -> ByteString
hashToHexByteString = Base16 ByteString -> ByteString
forall a. Base16 a -> a
Base16.extractBase16 (Base16 ByteString -> ByteString)
-> (Hash -> Base16 ByteString) -> Hash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base16 ByteString
Base16.encodeBase16' (ByteString -> Base16 ByteString)
-> (Hash -> ByteString) -> Hash -> Base16 ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> ByteString
hashToBinary

-- | Convert a 'Hash' to a strict binary 'StrictByteString'.
--
-- @since 0.0.1.0
hashToBinary :: Hash -> StrictByteString
hashToBinary :: Hash -> ByteString
hashToBinary (Hash ForeignPtr CUChar
fPtr) =
  ForeignPtr Word8 -> Int -> Int -> ByteString
BS.fromForeignPtr (ForeignPtr CUChar -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
Foreign.castForeignPtr ForeignPtr CUChar
fPtr) Int
0 Int
hashBytesSize
  where
    hashBytesSize :: Int
hashBytesSize = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoGenericHashBytes

-- ** Hashing a multi-part message

-- | 'Multipart' is a cryptographic context for streaming hashing.
-- This API can be used when a message is too big to fit
-- in memory or when the message is received in portions.
--
-- Use it like this:
--
-- >>> hashKey <- Hashing.newHashKey
-- >>> hash <- Hashing.withMultipart (Just hashKey) $ \multipartState -> do -- we are in MonadIO
-- ...   message1 <- getMessage
-- ...   Hashing.updateMultipart multipartState message1
-- ...   message2 <- getMessage
-- ...   Hashing.updateMultipart multipartState message2
--
-- @since 0.0.1.0
newtype Multipart s = Multipart (Ptr CryptoGenericHashState)

type role Multipart nominal

-- | Perform streaming hashing with a 'Multipart' cryptographic context.
-- If there is no 'HashKey', you will get the same output for the same input all the time.
--
-- Use 'Hashing.updateMultipart' within the continuation to add more message parts to be hashed.
--
-- The context is safely allocated first, then the continuation is run
-- and then it is deallocated after that.
--
-- @since 0.0.1.0
withMultipart
  :: forall (a :: Type) (m :: Type -> Type)
   . MonadIO m
  => Maybe HashKey
  -- ^ Optional cryptographic key
  -> (forall s. Multipart s -> m a)
  -- ^ Continuation that gives you access to a 'Multipart' cryptographic context
  -> m Hash
withMultipart :: forall a (m :: * -> *).
MonadIO m =>
Maybe HashKey -> (forall s. Multipart s -> m a) -> m Hash
withMultipart Maybe HashKey
mKey forall s. Multipart s -> m a
actions = do
  CSize -> (Ptr CryptoGenericHashState -> m Hash) -> m Hash
forall a b (m :: * -> *).
MonadIO m =>
CSize -> (Ptr a -> m b) -> m b
allocateWith CSize
cryptoGenericHashStateBytes ((Ptr CryptoGenericHashState -> m Hash) -> m Hash)
-> (Ptr CryptoGenericHashState -> m Hash) -> m Hash
forall a b. (a -> b) -> a -> b
$ \Ptr CryptoGenericHashState
statePtr -> do
    case Maybe HashKey
mKey of
      Just (HashKey ForeignPtr CUChar
hashKeyFPtr) ->
        IO CInt -> m CInt
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> m CInt) -> IO CInt -> m CInt
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
hashKeyFPtr ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(Ptr CUChar
hashKeyPtr :: Ptr CUChar) ->
          IO CInt -> IO CInt
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
            Ptr CryptoGenericHashState -> Ptr CUChar -> CSize -> IO CInt
initMultipart
              Ptr CryptoGenericHashState
statePtr
              Ptr CUChar
hashKeyPtr
              CSize
cryptoGenericHashKeyBytes
      Maybe HashKey
Nothing ->
        IO CInt -> m CInt
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> m CInt) -> IO CInt -> m CInt
forall a b. (a -> b) -> a -> b
$
          Ptr CryptoGenericHashState -> Ptr CUChar -> CSize -> IO CInt
initMultipart
            Ptr CryptoGenericHashState
statePtr
            Ptr CUChar
forall a. Ptr a
Foreign.nullPtr
            CSize
0
    let part :: Multipart s
part = Ptr CryptoGenericHashState -> Multipart s
forall s. Ptr CryptoGenericHashState -> Multipart s
Multipart Ptr CryptoGenericHashState
statePtr
    Multipart Any -> m a
forall s. Multipart s -> m a
actions Multipart Any
forall {s}. Multipart s
part
    Multipart Any -> m Hash
forall (m :: * -> *) s. MonadIO m => Multipart s -> m Hash
finaliseMultipart Multipart Any
forall {s}. Multipart s
part

-- Internal
initMultipart
  :: Ptr CryptoGenericHashState
  -> Ptr CUChar
  -> CSize
  -> IO CInt
initMultipart :: Ptr CryptoGenericHashState -> Ptr CUChar -> CSize -> IO CInt
initMultipart Ptr CryptoGenericHashState
statePtr Ptr CUChar
hashKeyPtr CSize
hashKeyLength =
  Ptr CryptoGenericHashState
-> Ptr CUChar -> CSize -> CSize -> IO CInt
cryptoGenericHashInit
    Ptr CryptoGenericHashState
statePtr
    Ptr CUChar
hashKeyPtr
    CSize
hashKeyLength
    CSize
cryptoGenericHashBytes

-- | Compute the 'Hash' of all the portions that were fed to the cryptographic context.
--
--  this function is only used within 'withMultipart'
--
--  @since 0.0.1.0
finaliseMultipart :: MonadIO m => Multipart s -> m Hash
finaliseMultipart :: forall (m :: * -> *) s. MonadIO m => Multipart s -> m Hash
finaliseMultipart (Multipart Ptr CryptoGenericHashState
statePtr) = IO Hash -> m Hash
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Hash -> m Hash) -> IO Hash -> m Hash
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr CUChar
hashForeignPtr <- Int -> IO (ForeignPtr CUChar)
forall a. Int -> IO (ForeignPtr a)
Foreign.mallocForeignPtrBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cryptoGenericHashBytes)
  ForeignPtr CUChar -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
Foreign.withForeignPtr ForeignPtr CUChar
hashForeignPtr ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CUChar
hashPtr :: Ptr CUChar) ->
    IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
      Ptr CryptoGenericHashState -> Ptr CUChar -> CSize -> IO CInt
cryptoGenericHashFinal
        Ptr CryptoGenericHashState
statePtr
        Ptr CUChar
hashPtr
        CSize
cryptoGenericHashBytes
  Hash -> IO Hash
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hash -> IO Hash) -> Hash -> IO Hash
forall a b. (a -> b) -> a -> b
$ ForeignPtr CUChar -> Hash
Hash ForeignPtr CUChar
hashForeignPtr

-- | Add a message portion to be hashed.
--
-- This function is to be used within 'withMultipart'.
--
-- @since 0.0.1.0
updateMultipart :: forall (m :: Type -> Type) (s :: Type). MonadIO m => Multipart s -> StrictByteString -> m ()
updateMultipart :: forall (m :: * -> *) s.
MonadIO m =>
Multipart s -> ByteString -> m ()
updateMultipart (Multipart Ptr CryptoGenericHashState
statePtr) ByteString
message = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen ByteString
message ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cString, Int
cStringLen) -> do
    let messagePtr :: Ptr CUChar
messagePtr = forall a b. Ptr a -> Ptr b
Foreign.castPtr @CChar @CUChar Ptr CChar
cString
    let messageLen :: CULLong
messageLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CULLong Int
cStringLen
    IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
      Ptr CryptoGenericHashState -> Ptr CUChar -> CULLong -> IO CInt
cryptoGenericHashUpdate
        Ptr CryptoGenericHashState
statePtr
        Ptr CUChar
messagePtr
        CULLong
messageLen