-- SPDX-FileCopyrightText: 2021 Serokell
--
-- SPDX-License-Identifier: MPL-2.0

{-# LANGUAGE ExplicitNamespaces, TypeOperators, TypeFamilies #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Internals of @crypto_generichash@.
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

-- | Hash returned by 'blake2b'.
--
-- This type is parametrised by hash size in bytes and the actual data type
-- that contains bytes. This can be, for example, a @ByteString@.
--
-- Length must be between 16 and 64 bytes.
type HashBlake2b len a = SizedByteArray len a

-- | Hash a message using BLAKE2b.
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 -- ^ Hash key
  -> pt  -- ^ Message to hash
  -> 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
  -- _ret can be only 0, so we don’t check it
  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)