{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}

module Hash.Sha1
  ( boundedBuilder
  , byteArrayN
  ) where

import Control.Monad.ST (ST)
import Control.Monad.ST.Run (runByteArrayST)
import Data.Bytes.Builder.Bounded as BB
import Data.Bytes.Builder.Bounded.Unsafe as BBU
import Data.Bytes.Types (ByteArrayN (ByteArrayN), Bytes (Bytes))
import Data.Primitive (ByteArray (..), MutableByteArray (..))
import GHC.Exts (ByteArray#, Int (I#), Int#, MutableByteArray#)
import GHC.IO (unsafeIOToST)

import qualified Data.Primitive as PM

foreign import ccall unsafe "sha1.h hs_cryptohash_sha1_onepass"
  c_hash :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> IO ()

performHash :: MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
performHash :: forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
performHash (MutableByteArray MutableByteArray# s
x) (I# Int#
a) (ByteArray ByteArray#
y) (I# Int#
b) (I# Int#
c) =
  IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> IO ()
forall s.
MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> IO ()
c_hash MutableByteArray# s
x Int#
a ByteArray#
y Int#
b Int#
c)

-- | Hash the byte sequence, returning the result as a builder.
boundedBuilder :: Bytes -> BB.Builder 20
boundedBuilder :: Bytes -> Builder 20
boundedBuilder (Bytes ByteArray
arr Int
off Int
len) =
  (forall s. MutableByteArray s -> Int -> ST s Int) -> Builder 20
forall (n :: Nat).
(forall s. MutableByteArray s -> Int -> ST s Int) -> Builder n
BBU.construct
    ( \MutableByteArray s
buf Int
ix -> do
        MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
performHash MutableByteArray s
buf Int
ix ByteArray
arr Int
off Int
len
        Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
20)
    )

{- | Hash the byte sequence, returning the result as a byte array
known to have exactly 20 bytes.
-}
byteArrayN :: Bytes -> ByteArrayN 20
byteArrayN :: Bytes -> ByteArrayN 20
byteArrayN (Bytes ByteArray
arr Int
off Int
len) = ByteArray -> ByteArrayN 20
forall (n :: Nat). ByteArray -> ByteArrayN n
ByteArrayN (ByteArray -> ByteArrayN 20) -> ByteArray -> ByteArrayN 20
forall a b. (a -> b) -> a -> b
$ (forall s. ST s ByteArray) -> ByteArray
runByteArrayST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
20
  MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
forall s.
MutableByteArray s -> Int -> ByteArray -> Int -> Int -> ST s ()
performHash MutableByteArray s
dst Int
0 ByteArray
arr Int
off Int
len
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst