{-# LANGUAGE ExplicitNamespaces, TypeOperators, TypeFamilies #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Crypto.Sodium.Hash.Internal
( HashBlake2b
, blake2b
) where
import Prelude hiding (length)
import Data.ByteArray (ByteArray, ByteArrayAccess, length, withByteArray)
import Data.ByteArray.Sized (SizedByteArray, allocRet)
import Data.Proxy (Proxy (Proxy))
import Foreign.Ptr (nullPtr)
import GHC.TypeNats (KnownNat, natVal, type (<=))
import qualified Libsodium as Na
type HashBlake2b len a = SizedByteArray len a
blake2b
:: forall len hashBytes pt key.
( ByteArrayAccess pt
, ByteArrayAccess key
, ByteArray hashBytes
, KnownNat len
, Na.CRYPTO_GENERICHASH_BYTES_MIN <= len
, len <= Na.CRYPTO_GENERICHASH_BYTES_MAX
)
=> Maybe key
-> pt
-> IO (HashBlake2b len hashBytes)
blake2b :: Maybe key -> pt -> IO (HashBlake2b len hashBytes)
blake2b Maybe key
key pt
msg = do
(CInt
_ret, HashBlake2b len hashBytes
hash) <-
Proxy len
-> (Ptr CUChar -> IO CInt) -> IO (CInt, HashBlake2b len hashBytes)
forall (n :: Nat) c p a.
ByteArrayN n c =>
Proxy n -> (Ptr p -> IO a) -> IO (a, c)
allocRet @len Proxy len
forall k (t :: k). Proxy t
Proxy ((Ptr CUChar -> IO CInt) -> IO (CInt, HashBlake2b len hashBytes))
-> (Ptr CUChar -> IO CInt) -> IO (CInt, HashBlake2b len hashBytes)
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
hashPtr ->
pt -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray pt
msg ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
msgPtr ->
(Ptr CUChar -> IO CInt) -> IO CInt
withKey ((Ptr CUChar -> IO CInt) -> IO CInt)
-> (Ptr CUChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
keyPtr ->
Ptr CUChar
-> (Any ::: CSize)
-> Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> (Any ::: CSize)
-> IO CInt
forall k1 k2 k3 k4 k5 k6 (out :: k1) (outlen :: k2) (in_ :: k3)
(inlen :: k4) (key :: k5) (keylen :: k6).
Ptr CUChar
-> (Any ::: CSize)
-> Ptr CUChar
-> (Any ::: CULLong)
-> Ptr CUChar
-> (Any ::: CSize)
-> IO CInt
Na.crypto_generichash_blake2b Ptr CUChar
hashPtr (Natural -> Any ::: CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Any ::: CSize) -> Natural -> Any ::: CSize
forall a b. (a -> b) -> a -> b
$ Proxy len -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal @len Proxy len
forall k (t :: k). Proxy t
Proxy)
Ptr CUChar
msgPtr (Int -> Any ::: CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Any ::: CULLong) -> Int -> Any ::: CULLong
forall a b. (a -> b) -> a -> b
$ pt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length pt
msg)
Ptr CUChar
keyPtr Any ::: CSize
keyLen
HashBlake2b len hashBytes -> IO (HashBlake2b len hashBytes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashBlake2b len hashBytes
hash
where
((Ptr CUChar -> IO CInt) -> IO CInt
withKey, Any ::: CSize
keyLen)
| Just key
key' <- Maybe key
key = (key -> (Ptr CUChar -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray key
key', Int -> Any ::: CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Any ::: CSize) -> Int -> Any ::: CSize
forall a b. (a -> b) -> a -> b
$ key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length key
key')
| Bool
otherwise = (((Ptr CUChar -> IO CInt) -> Ptr CUChar -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr CUChar
forall a. Ptr a
nullPtr), Any ::: CSize
0)