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

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

, 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.Word

import Foreign.Ptr
import Foreign.Storable

import GHC.Exts
import GHC.IO

-- internal modules

import Data.Hash.Class.Mutable.Internal

-- -------------------------------------------------------------------------- --
-- Class of Salted Pure Hashes

class IncrementalHash a => Hash a where
    initialize :: IO (Context a)

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

hashPtr :: forall a . Hash a => Ptr Word8 -> Int -> IO a
hashPtr :: Ptr Word8 -> Int -> IO a
hashPtr Ptr Word8
p Int
n = do
    Context a
ctx <- Hash a => IO (Context a)
forall a. Hash a => IO (Context a)
initialize @a
    Context a -> Ptr Word8 -> Int -> IO ()
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 => B.ByteString -> a
hashByteString :: ByteString -> a
hashByteString ByteString
b = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
    Context a
ctx <- Hash a => IO (Context a)
forall a. Hash a => IO (Context a)
initialize @a
    Context a -> ByteString -> IO ()
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 => BL.ByteString -> a
hashByteStringLazy :: ByteString -> a
hashByteStringLazy ByteString
b = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
    Context a
ctx <- Hash a => IO (Context a)
forall a. Hash a => IO (Context a)
initialize @a
    Context a -> ByteString -> IO ()
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 => BS.ShortByteString -> IO a
hashShortByteString :: ShortByteString -> IO a
hashShortByteString ShortByteString
b = do
    Context a
ctx <- Hash a => IO (Context a)
forall a. Hash a => IO (Context a)
initialize @a
    Context a -> ShortByteString -> IO ()
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 => b -> IO a
hashStorable :: b -> IO a
hashStorable b
b = do
    Context a
ctx <- Hash a => IO (Context a)
forall a. Hash a => IO (Context a)
initialize @a
    Context a -> b -> IO ()
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 => ByteArray# -> IO a
hashByteArray :: ByteArray# -> IO a
hashByteArray ByteArray#
b = do
    Context a
ctx <- Hash a => IO (Context a)
forall a. Hash a => IO (Context a)
initialize @a
    Context a -> ByteArray# -> IO ()
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 #-}