{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module: Data.Hash.Class.Mutable.Salted
-- Copyright: Copyright © 2021-2024 Lars Kuhtz <lakuhtz@gmail.com>
-- License: MIT
-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>
-- Stability: experimental
--
-- Class of Salted Mutable Hashes
--
module Data.Hash.Class.Mutable.Salted
( Hash(..)

, hashPtr
, hashStorable
, hashByteString
, hashByteStringLazy
, hashShortByteString
, hashByteArray

-- ** Pure variants of hash functions
--
-- The following pure variants of the hash functions are implemented with
-- 'unsafePerformIO'. This is generally less efficient than running them
-- directly in 'IO'. Often the performance difference does not matter. However,
-- when many hashes are computed one should prefer the variants that run in
-- 'IO'. When a 'ResetableHash' instance is available it provides the most
-- efficient way to compute many hashes in a tight loop.

, hashPtr_
, hashStorable_
, hashByteString_
, hashByteStringLazy_
, hashShortByteString_
, hashByteArray_

-- * Incremental Hashing
, updateByteString
, updateByteStringLazy
, updateShortByteString
, updateStorable
, updateByteArray
) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Short as BS
import Data.Kind
import Data.Word

import Foreign.Ptr
import Foreign.Storable

import GHC.Exts
import GHC.IO

-- internal modules

import Data.Hash.Class.Mutable.Internal

-- -------------------------------------------------------------------------- --
-- Class of Salted Mutable Hashes

class IncrementalHash a => Hash a where
    type Salt a :: Type
    initialize :: Salt a -> IO (Context a)

-- -------------------------------------------------------------------------- --
-- Hash Functions

hashPtr :: forall a . Hash a => Salt a -> Ptr Word8 -> Int -> IO a
hashPtr :: forall a. Hash a => Salt a -> Ptr Word8 -> Int -> IO a
hashPtr Salt a
k Ptr Word8
p Int
n = do
    Context a
ctx <- forall a. Hash a => Salt a -> IO (Context a)
initialize @a Salt a
k
    forall a.
IncrementalHash a =>
Context a -> Ptr Word8 -> Int -> IO ()
update @a Context a
ctx Ptr Word8
p Int
n
    Context a -> IO a
forall a. IncrementalHash a => Context a -> IO a
finalize Context a
ctx
{-# INLINE hashPtr #-}

hashByteString :: forall a . Hash a => Salt a -> B.ByteString -> IO a
hashByteString :: forall a. Hash a => Salt a -> ByteString -> IO a
hashByteString Salt a
k ByteString
b = do
        Context a
ctx <- forall a. Hash a => Salt a -> IO (Context a)
initialize @a Salt a
k
        forall a. IncrementalHash a => Context a -> ByteString -> IO ()
updateByteString @a Context a
ctx ByteString
b
        Context a -> IO a
forall a. IncrementalHash a => Context a -> IO a
finalize Context a
ctx
{-# INLINE hashByteString #-}

hashByteStringLazy :: forall a . Hash a => Salt a -> BL.ByteString -> IO a
hashByteStringLazy :: forall a. Hash a => Salt a -> ByteString -> IO a
hashByteStringLazy Salt a
k ByteString
b = do
        Context a
ctx <- forall a. Hash a => Salt a -> IO (Context a)
initialize @a Salt a
k
        forall a. IncrementalHash a => Context a -> ByteString -> IO ()
updateByteStringLazy @a Context a
ctx ByteString
b
        Context a -> IO a
forall a. IncrementalHash a => Context a -> IO a
finalize Context a
ctx
{-# INLINE hashByteStringLazy #-}

hashShortByteString :: forall a . Hash a => Salt a -> BS.ShortByteString -> IO a
hashShortByteString :: forall a. Hash a => Salt a -> ShortByteString -> IO a
hashShortByteString Salt a
k ShortByteString
b = do
        Context a
ctx <- forall a. Hash a => Salt a -> IO (Context a)
initialize @a Salt a
k
        forall a.
IncrementalHash a =>
Context a -> ShortByteString -> IO ()
updateShortByteString @a Context a
ctx ShortByteString
b
        Context a -> IO a
forall a. IncrementalHash a => Context a -> IO a
finalize Context a
ctx
{-# INLINE hashShortByteString #-}

hashStorable :: forall a b . Hash a => Storable b => Salt a -> b -> IO a
hashStorable :: forall a b. (Hash a, Storable b) => Salt a -> b -> IO a
hashStorable Salt a
k b
b = do
        Context a
ctx <- forall a. Hash a => Salt a -> IO (Context a)
initialize @a Salt a
k
        forall a b.
(IncrementalHash a, Storable b) =>
Context a -> b -> IO ()
updateStorable @a Context a
ctx b
b
        Context a -> IO a
forall a. IncrementalHash a => Context a -> IO a
finalize Context a
ctx
{-# INLINE hashStorable #-}

hashByteArray :: forall a . Hash a => Salt a -> ByteArray# -> IO a
hashByteArray :: forall a. Hash a => Salt a -> ByteArray# -> IO a
hashByteArray Salt a
k ByteArray#
b = do
        Context a
ctx <- forall a. Hash a => Salt a -> IO (Context a)
initialize @a Salt a
k
        forall a. IncrementalHash a => Context a -> ByteArray# -> IO ()
updateByteArray @a Context a
ctx ByteArray#
b
        Context a -> IO a
forall a. IncrementalHash a => Context a -> IO a
finalize Context a
ctx
{-# INLINE hashByteArray #-}

-- -------------------------------------------------------------------------- --
-- Pure variants

hashPtr_ :: forall a . Hash a => Salt a -> Ptr Word8 -> Int -> a
hashPtr_ :: forall a. Hash a => Salt a -> Ptr Word8 -> Int -> a
hashPtr_ Salt a
s Ptr Word8
ptr = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> (Int -> IO a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt a -> Ptr Word8 -> Int -> IO a
forall a. Hash a => Salt a -> Ptr Word8 -> Int -> IO a
hashPtr Salt a
s Ptr Word8
ptr
{-# INLINE hashPtr_ #-}

hashByteString_ :: forall a . Hash a => Salt a -> B.ByteString -> a
hashByteString_ :: forall a. Hash a => Salt a -> ByteString -> a
hashByteString_ Salt a
s = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> (ByteString -> IO a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt a -> ByteString -> IO a
forall a. Hash a => Salt a -> ByteString -> IO a
hashByteString Salt a
s
{-# INLINE hashByteString_ #-}

hashByteStringLazy_ :: forall a . Hash a => Salt a -> BL.ByteString -> a
hashByteStringLazy_ :: forall a. Hash a => Salt a -> ByteString -> a
hashByteStringLazy_ Salt a
s = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> (ByteString -> IO a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt a -> ByteString -> IO a
forall a. Hash a => Salt a -> ByteString -> IO a
hashByteStringLazy Salt a
s
{-# INLINE hashByteStringLazy_ #-}

hashShortByteString_ :: forall a . Hash a => Salt a -> BS.ShortByteString -> a
hashShortByteString_ :: forall a. Hash a => Salt a -> ShortByteString -> a
hashShortByteString_ Salt a
s = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> (ShortByteString -> IO a) -> ShortByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt a -> ShortByteString -> IO a
forall a. Hash a => Salt a -> ShortByteString -> IO a
hashShortByteString Salt a
s
{-# INLINE hashShortByteString_ #-}

hashStorable_ :: forall a b . Hash a => Storable b => Salt a -> b -> a
hashStorable_ :: forall a b. (Hash a, Storable b) => Salt a -> b -> a
hashStorable_ Salt a
s = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> (b -> IO a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Salt a -> b -> IO a
forall a b. (Hash a, Storable b) => Salt a -> b -> IO a
hashStorable Salt a
s
{-# INLINE hashStorable_ #-}

hashByteArray_ :: forall a . Hash a => Salt a -> ByteArray# -> a
hashByteArray_ :: forall a. Hash a => Salt a -> ByteArray# -> a
hashByteArray_ Salt a
s ByteArray#
a = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Salt a -> ByteArray# -> IO a
forall a. Hash a => Salt a -> ByteArray# -> IO a
hashByteArray Salt a
s ByteArray#
a
{-# INLINE hashByteArray_ #-}