{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | IO and low level tools.
module BLAKE3.IO
  ( -- * Hashing
    hash
  , init
  , update
  , finalize
  , finalizeSeek
    -- * Digest
  , Digest(..)
    -- * Keyed hashing
  , Key
  , key
    -- * Key derivation
  , initDerive
    -- * Hasher
  , Hasher
  , modifyHasher
    -- * Constants
  , HASHER_ALIGNMENT
  , HASHER_SIZE
  , KEY_LEN
  , BLOCK_SIZE
  , DEFAULT_DIGEST_LEN
  , CHUNK_LEN
  , MAX_DEPTH
  , MAX_SIMD_DEGREE
    -- * Low-level C bindings
  , c_init
  , c_init_keyed
  , c_init_derive_key_raw
  , c_update
  , c_update__safe
  , c_update__unsafe
  , c_finalize
  , c_finalize_seek
  )
  where

import Data.Foldable
import Data.Proxy
import Data.String
import Data.Word
import Foreign.C.Types
import Foreign.Marshal.Array (copyArray)
import Foreign.Ptr
import Foreign.Storable
import GHC.TypeLits
import Prelude hiding (init)
import qualified Data.ByteArray as BA
import qualified Data.ByteArray.Sized as BAS
import qualified Data.ByteArray.Encoding as BA

--------------------------------------------------------------------------------

-- | Output from BLAKE3 algorithm, of @len@ bytes.
--
-- The default digest length for BLAKE3 is 'DEFAULT_DIGEST_LEN'.
newtype Digest (len :: Nat)
  = Digest (BAS.SizedByteArray len BA.ScrubbedBytes)
  deriving newtype ( Digest len -> Digest len -> Bool
(Digest len -> Digest len -> Bool)
-> (Digest len -> Digest len -> Bool) -> Eq (Digest len)
forall (len :: Nat). Digest len -> Digest len -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (len :: Nat). Digest len -> Digest len -> Bool
== :: Digest len -> Digest len -> Bool
$c/= :: forall (len :: Nat). Digest len -> Digest len -> Bool
/= :: Digest len -> Digest len -> Bool
Eq -- ^ Constant time.
                   , Eq (Digest len)
Eq (Digest len) =>
(Digest len -> Digest len -> Ordering)
-> (Digest len -> Digest len -> Bool)
-> (Digest len -> Digest len -> Bool)
-> (Digest len -> Digest len -> Bool)
-> (Digest len -> Digest len -> Bool)
-> (Digest len -> Digest len -> Digest len)
-> (Digest len -> Digest len -> Digest len)
-> Ord (Digest len)
Digest len -> Digest len -> Bool
Digest len -> Digest len -> Ordering
Digest len -> Digest len -> Digest len
forall (len :: Nat). Eq (Digest len)
forall (len :: Nat). Digest len -> Digest len -> Bool
forall (len :: Nat). Digest len -> Digest len -> Ordering
forall (len :: Nat). Digest len -> Digest len -> Digest len
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: forall (len :: Nat). Digest len -> Digest len -> Ordering
compare :: Digest len -> Digest len -> Ordering
$c< :: forall (len :: Nat). Digest len -> Digest len -> Bool
< :: Digest len -> Digest len -> Bool
$c<= :: forall (len :: Nat). Digest len -> Digest len -> Bool
<= :: Digest len -> Digest len -> Bool
$c> :: forall (len :: Nat). Digest len -> Digest len -> Bool
> :: Digest len -> Digest len -> Bool
$c>= :: forall (len :: Nat). Digest len -> Digest len -> Bool
>= :: Digest len -> Digest len -> Bool
$cmax :: forall (len :: Nat). Digest len -> Digest len -> Digest len
max :: Digest len -> Digest len -> Digest len
$cmin :: forall (len :: Nat). Digest len -> Digest len -> Digest len
min :: Digest len -> Digest len -> Digest len
Ord
                   , Digest len -> Int
(Digest len -> Int)
-> (forall p a. Digest len -> (Ptr p -> IO a) -> IO a)
-> (forall p. Digest len -> Ptr p -> IO ())
-> ByteArrayAccess (Digest len)
forall (len :: Nat). KnownNat len => Digest len -> Int
forall (len :: Nat) p. KnownNat len => Digest len -> Ptr p -> IO ()
forall (len :: Nat) p a.
KnownNat len =>
Digest len -> (Ptr p -> IO a) -> IO a
forall p. Digest len -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. Digest len -> (Ptr p -> IO a) -> IO a
$clength :: forall (len :: Nat). KnownNat len => Digest len -> Int
length :: Digest len -> Int
$cwithByteArray :: forall (len :: Nat) p a.
KnownNat len =>
Digest len -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. Digest len -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall (len :: Nat) p. KnownNat len => Digest len -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. Digest len -> Ptr p -> IO ()
BA.ByteArrayAccess
                   , BAS.ByteArrayN len )

-- | Base 16 (hexadecimal).
instance Show (Digest len) where
  show :: Digest len -> String
show (Digest SizedByteArray len ScrubbedBytes
x) = ScrubbedBytes -> String
forall x. ByteArrayAccess x => x -> String
showBase16 (SizedByteArray len ScrubbedBytes -> ScrubbedBytes
forall (n :: Nat) ba. SizedByteArray n ba -> ba
BAS.unSizedByteArray SizedByteArray len ScrubbedBytes
x)

-- | When allocating a 'Digest', prefer to use 'BAS.alloc', which
-- wipes and releases the memory as soon it becomes unused.
instance forall len. KnownNat len => Storable (Digest len) where
  sizeOf :: Digest len -> Int
sizeOf Digest len
_ = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy len -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @len))
  alignment :: Digest len -> Int
alignment Digest len
_ = Int
8 -- Not sure.
  peek :: Ptr (Digest len) -> IO (Digest len)
peek Ptr (Digest len)
ps = (Ptr (Digest len) -> IO ()) -> IO (Digest len)
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> IO ba
BAS.alloc ((Ptr (Digest len) -> IO ()) -> IO (Digest len))
-> (Ptr (Digest len) -> IO ()) -> IO (Digest len)
forall a b. (a -> b) -> a -> b
$ \Ptr (Digest len)
pd -> Ptr (Digest len) -> Ptr (Digest len) -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr (Digest len)
pd Ptr (Digest len)
ps Int
1
  poke :: Ptr (Digest len) -> Digest len -> IO ()
poke Ptr (Digest len)
pd Digest len
src = Digest len -> (Ptr (Digest len) -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Digest len -> (Ptr p -> IO a) -> IO a
BA.withByteArray Digest len
src ((Ptr (Digest len) -> IO ()) -> IO ())
-> (Ptr (Digest len) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Digest len)
ps -> Ptr (Digest len) -> Ptr (Digest len) -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr (Digest len)
pd Ptr (Digest len)
ps Int
1

--------------------------------------------------------------------------------

-- | Key used for keyed hashing mode.
--
-- Obtain with 'BLAKE3.key'.
--
-- See 'BLAKE3.hashKeyed'.
data Key where
  -- | We store things this way to avoid unnecessary conversions between
  -- different 'BA.ByteArrayAccess' when using 'key' for reading a 'Key'
  -- from a third party source.
  Key :: BA.ByteArrayAccess x => x -> Key

-- | Constant time.
instance Eq Key where
  == :: Key -> Key -> Bool
(==) = Key -> Key -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq
  {-# INLINE (==) #-}

-- | Base 16 (hexadecimal).
instance Show Key where
  show :: Key -> String
show (Key x
x) = x -> String
forall x. ByteArrayAccess x => x -> String
showBase16 x
x

-- | Length is 'KEY_LEN'.
instance BA.ByteArrayAccess Key where
  length :: Key -> Int
length (Key x
x) = x -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length x
x
  withByteArray :: forall p a. Key -> (Ptr p -> IO a) -> IO a
withByteArray (Key x
x) = x -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. x -> (Ptr p -> IO a) -> IO a
BA.withByteArray x
x

-- | Allocate a 'Key'.
--
-- The memory is wiped and freed as soon as the 'Key' becomes unused.
instance BAS.ByteArrayN KEY_LEN Key where
  allocRet :: forall p a. Proxy KEY_LEN -> (Ptr p -> IO a) -> IO (a, Key)
allocRet Proxy KEY_LEN
_ Ptr p -> IO a
g = do
    (a, bs :: BA.ScrubbedBytes) <- Int -> (Ptr p -> IO a) -> IO (a, ScrubbedBytes)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, ScrubbedBytes)
BA.allocRet Int
keyLen Ptr p -> IO a
g
    pure (a, Key bs)

-- | When allocating a 'Key', prefer to use 'BAS.alloc', which
-- wipes and releases the memory as soon it becomes unused.
instance Storable Key where
  sizeOf :: Key -> Int
sizeOf Key
_ = Int
keyLen
  alignment :: Key -> Int
alignment Key
_ = Int
8 -- Not sure.
  peek :: Ptr Key -> IO Key
peek Ptr Key
ps = (Ptr Key -> IO ()) -> IO Key
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> IO ba
BAS.alloc ((Ptr Key -> IO ()) -> IO Key) -> (Ptr Key -> IO ()) -> IO Key
forall a b. (a -> b) -> a -> b
$ \Ptr Key
pd -> Ptr Key -> Ptr Key -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr Key
pd Ptr Key
ps Int
1
  poke :: Ptr Key -> Key -> IO ()
poke Ptr Key
pd Key
src = Key -> (Ptr Key -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Key -> (Ptr p -> IO a) -> IO a
BA.withByteArray Key
src ((Ptr Key -> IO ()) -> IO ()) -> (Ptr Key -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Key
ps -> Ptr Key -> Ptr Key -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr Key
pd Ptr Key
ps Int
1

-- | Obtain a 'Key' for use in BLAKE3 keyed hashing.
--
-- See 'BLAKE3.hashKeyed'.
key
  :: BA.ByteArrayAccess bin
  => bin -- ^ Key bytes. Must have length 'KEY_LEN'.
  -> Maybe Key -- ^
key :: forall bin. ByteArrayAccess bin => bin -> Maybe Key
key bin
bin | bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length bin
bin Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
keyLen = Maybe Key
forall a. Maybe a
Nothing
        | Bool
otherwise = Key -> Maybe Key
forall a. a -> Maybe a
Just (bin -> Key
forall x. ByteArrayAccess x => x -> Key
Key bin
bin)

--------------------------------------------------------------------------------

showBase16 :: BA.ByteArrayAccess x => x -> String
showBase16 :: forall x. ByteArrayAccess x => x -> String
showBase16 = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
           ([Word8] -> String) -> (x -> [Word8]) -> x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack @BA.ScrubbedBytes
           (ScrubbedBytes -> [Word8]) -> (x -> ScrubbedBytes) -> x -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> x -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
BA.convertToBase Base
BA.Base16

--------------------------------------------------------------------------------

-- | BLAKE3 hashing.
hash
  :: forall len digest bin
  .  (BAS.ByteArrayN len digest, BA.ByteArrayAccess bin)
  => Maybe Key  -- ^ Whether to use keyed hashing mode (for MAC, PRF).
  -> [bin]      -- ^ Data to hash.
  -> IO digest  -- ^ The @digest@ type could be @'Digest' len@.
hash :: forall (len :: Nat) digest bin.
(ByteArrayN len digest, ByteArrayAccess bin) =>
Maybe Key -> [bin] -> IO digest
hash Maybe Key
yk [bin]
bins = do
  (dig, _ :: Hasher) <- Proxy HASHER_SIZE
-> (Ptr Hasher -> IO digest) -> IO (digest, Hasher)
forall (n :: Nat) c p a.
ByteArrayN n c =>
Proxy n -> (Ptr p -> IO a) -> IO (a, c)
forall p a. Proxy HASHER_SIZE -> (Ptr p -> IO a) -> IO (a, Hasher)
BAS.allocRet Proxy HASHER_SIZE
forall {k} (t :: k). Proxy t
Proxy ((Ptr Hasher -> IO digest) -> IO (digest, Hasher))
-> (Ptr Hasher -> IO digest) -> IO (digest, Hasher)
forall a b. (a -> b) -> a -> b
$ \Ptr Hasher
ph -> do
    Ptr Hasher -> Maybe Key -> IO ()
init Ptr Hasher
ph Maybe Key
yk
    Ptr Hasher -> [bin] -> IO ()
forall bin. ByteArrayAccess bin => Ptr Hasher -> [bin] -> IO ()
update Ptr Hasher
ph [bin]
bins
    Ptr Hasher -> IO digest
forall (len :: Nat) output.
ByteArrayN len output =>
Ptr Hasher -> IO output
finalize Ptr Hasher
ph
  pure dig

-- | Initialize a 'Hasher'.
init
  :: Ptr Hasher  -- ^ Obtain with 'BAS.alloc' or similar. It will be mutated.
  -> Maybe Key   -- ^ Whether to use keyed hashing mode (for MAC, PRF).
  -> IO ()
init :: Ptr Hasher -> Maybe Key -> IO ()
init Ptr Hasher
ph Maybe Key
Nothing     = Ptr Hasher -> IO ()
c_init Ptr Hasher
ph
init Ptr Hasher
ph (Just Key
key0) = Key -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Key -> (Ptr p -> IO a) -> IO a
BA.withByteArray Key
key0 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pkey ->
                      Ptr Hasher -> Ptr Word8 -> IO ()
c_init_keyed Ptr Hasher
ph Ptr Word8
pkey

-- | Initialize a 'Hasher' in derivation mode.
--
-- The input key material must be provided afterwards, using 'update'.
initDerive
  :: forall context
  .  BA.ByteArrayAccess context
  => Ptr Hasher  -- ^ Obtain with 'BAS.alloc' or similar. It will be mutated.
  -> context
  -> IO ()
initDerive :: forall context.
ByteArrayAccess context =>
Ptr Hasher -> context -> IO ()
initDerive Ptr Hasher
ph context
ctx =
  context -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. context -> (Ptr p -> IO a) -> IO a
BA.withByteArray context
ctx ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pc ->
  Ptr Hasher -> Ptr Word8 -> CSize -> IO ()
c_init_derive_key_raw Ptr Hasher
ph Ptr Word8
pc (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (context -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length context
ctx))

-- | Update 'Hasher' state with new data.
update
  :: forall bin
  .  BA.ByteArrayAccess bin
  => Ptr Hasher -- ^ Obtain with 'modifyHasher'. It will be mutated.
  -> [bin]
  -> IO ()
update :: forall bin. ByteArrayAccess bin => Ptr Hasher -> [bin] -> IO ()
update Ptr Hasher
ph [bin]
bins =
  [bin] -> (bin -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [bin]
bins ((bin -> IO ()) -> IO ()) -> (bin -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \bin
bin ->
  bin -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. bin -> (Ptr p -> IO a) -> IO a
BA.withByteArray bin
bin ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pbin ->
  Ptr Hasher -> Ptr Word8 -> CSize -> IO ()
c_update Ptr Hasher
ph Ptr Word8
pbin (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length bin
bin))

-- | Finalize incremental hashing and obtain a the BLAKE3 output of the
-- specified @len@gth.
finalize
  :: forall len output
  .  BAS.ByteArrayN len output
  => Ptr Hasher -- ^ Obtain with 'modifyHasher'. It will be mutated.
  -> IO output  -- ^ The @output@ type could be @'Digest' len@.
finalize :: forall (len :: Nat) output.
ByteArrayN len output =>
Ptr Hasher -> IO output
finalize Ptr Hasher
ph =
  (Ptr Word8 -> IO ()) -> IO output
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> IO ba
BAS.alloc ((Ptr Word8 -> IO ()) -> IO output)
-> (Ptr Word8 -> IO ()) -> IO output
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pd ->
  Ptr Hasher -> Ptr Word8 -> CSize -> IO ()
c_finalize Ptr Hasher
ph Ptr Word8
pd (Integer -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy len -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @len)))

-- | Finalize incremental hashing and obtain the specified @len@gth of BLAKE3
-- output starting at the specified offset.
--
-- @
-- 'finalize' h = 'finalizeSeek' h 0
-- @
finalizeSeek
  :: forall len output
  .  BAS.ByteArrayN len output
  => Ptr Hasher -- ^ Obtain with 'modifyHasher'. It will be mutated.
  -> Word64     -- ^ BLAKE3 output offset.
  -> IO output
finalizeSeek :: forall (len :: Nat) output.
ByteArrayN len output =>
Ptr Hasher -> Word64 -> IO output
finalizeSeek Ptr Hasher
ph Word64
pos =
  (Ptr Word8 -> IO ()) -> IO output
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> IO ba
BAS.alloc ((Ptr Word8 -> IO ()) -> IO output)
-> (Ptr Word8 -> IO ()) -> IO output
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pd ->
  Ptr Hasher -> Word64 -> Ptr Word8 -> CSize -> IO ()
c_finalize_seek Ptr Hasher
ph Word64
pos Ptr Word8
pd (Integer -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy len -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @len)))

--------------------------------------------------------------------------------

type HASHER_ALIGNMENT = 8

-- | In bytes.
type HASHER_SIZE = 1912

hasherSize :: Int
hasherSize :: Int
hasherSize = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy HASHER_SIZE -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @HASHER_SIZE))

-- | In bytes.
type KEY_LEN = 32

keyLen :: Int
keyLen :: Int
keyLen = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy KEY_LEN -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @KEY_LEN))

-- | In bytes.
type DEFAULT_DIGEST_LEN = 32

-- | In bytes.
type BLOCK_SIZE = 64

type CHUNK_LEN = 1024
type MAX_DEPTH = 54
type MAX_SIMD_DEGREE = 16

--------------------------------------------------------------------------------

-- | BLAKE3 internal state.
--
-- Obtain with 'BLAKE3.hasher', 'BLAKE3.hasherKeyed'.
newtype Hasher = Hasher (BAS.SizedByteArray HASHER_SIZE BA.ScrubbedBytes)
  deriving newtype
    ( Hasher -> Hasher -> Bool
(Hasher -> Hasher -> Bool)
-> (Hasher -> Hasher -> Bool) -> Eq Hasher
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hasher -> Hasher -> Bool
== :: Hasher -> Hasher -> Bool
$c/= :: Hasher -> Hasher -> Bool
/= :: Hasher -> Hasher -> Bool
Eq -- ^ Constant time.
    , Hasher -> Int
(Hasher -> Int)
-> (forall p a. Hasher -> (Ptr p -> IO a) -> IO a)
-> (forall p. Hasher -> Ptr p -> IO ())
-> ByteArrayAccess Hasher
forall p. Hasher -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. Hasher -> (Ptr p -> IO a) -> IO a
$clength :: Hasher -> Int
length :: Hasher -> Int
$cwithByteArray :: forall p a. Hasher -> (Ptr p -> IO a) -> IO a
withByteArray :: forall p a. Hasher -> (Ptr p -> IO a) -> IO a
$ccopyByteArrayToPtr :: forall p. Hasher -> Ptr p -> IO ()
copyByteArrayToPtr :: forall p. Hasher -> Ptr p -> IO ()
BA.ByteArrayAccess -- ^ Length is 'HASHER_SIZE'.
    , BAS.ByteArrayN HASHER_SIZE
      -- ^ Allocate a 'Hasher'.
      -- The memory is wiped and freed as soon as the 'Hasher' becomes unused.
    )

-- | Base 16 (hexadecimal).
instance Show Hasher where
  show :: Hasher -> String
show = Hasher -> String
forall x. ByteArrayAccess x => x -> String
showBase16

-- | Obtain a @'Ptr' 'Hasher'@ to use with functions like 'initDerive', etc.
modifyHasher
  :: Hasher
  -> (Ptr Hasher -> IO a) -- ^ 'HASHER_SIZE' bytes.
  -> IO a
modifyHasher :: forall a. Hasher -> (Ptr Hasher -> IO a) -> IO a
modifyHasher = Hasher -> (Ptr Hasher -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Hasher -> (Ptr p -> IO a) -> IO a
BA.withByteArray

-- | When allocating a 'Hasher', prefer to use 'BAS.alloc', which
-- wipes and releases the memory as soon it becomes unused.
instance Storable Hasher where
  sizeOf :: Hasher -> Int
sizeOf Hasher
_ = Int
hasherSize
  alignment :: Hasher -> Int
alignment Hasher
_ = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy HASHER_ALIGNMENT -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @HASHER_ALIGNMENT))
  peek :: Ptr Hasher -> IO Hasher
peek Ptr Hasher
ps = (Ptr Hasher -> IO ()) -> IO Hasher
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> IO ba
BAS.alloc ((Ptr Hasher -> IO ()) -> IO Hasher)
-> (Ptr Hasher -> IO ()) -> IO Hasher
forall a b. (a -> b) -> a -> b
$ \Ptr Hasher
pd -> Ptr Hasher -> Ptr Hasher -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr Hasher
pd Ptr Hasher
ps Int
1
  poke :: Ptr Hasher -> Hasher -> IO ()
poke Ptr Hasher
pd Hasher
src = Hasher -> (Ptr Hasher -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. Hasher -> (Ptr p -> IO a) -> IO a
BA.withByteArray Hasher
src ((Ptr Hasher -> IO ()) -> IO ()) -> (Ptr Hasher -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Hasher
ps -> Ptr Hasher -> Ptr Hasher -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr Hasher
pd Ptr Hasher
ps Int
1

--------------------------------------------------------------------------------

-- | @void blake3_hasher_init(blake3_hasher *self)@
foreign import ccall unsafe
  "blake3.h blake3_hasher_init"
  c_init
    :: Ptr Hasher  -- ^ You can obtain with 'BAS.alloc'.
                   -- Otherwise, any chunk of 'HASHER_SIZE' bytes aligned to
                   -- 'HASHER_ALIGNMENT' will do.
    -> IO ()

-- | @void blake3_hasher_init_keyed(blake3_hasher *self, const uint8_t key['KEY_LEN'])@
foreign import ccall unsafe
  "blake3.h blake3_hasher_init_keyed"
  c_init_keyed
    :: Ptr Hasher  -- ^ You can obtain with 'BAS.alloc'.
                   -- Otherwise, any chunk of 'HASHER_SIZE' bytes aligned to
                   -- 'HASHER_ALIGNMENT' will do.
    -> Ptr Word8   -- ^ You can obtain with 'BAS.alloc'.
                   -- Otherwise, any chunk of length 'KEY_LEN' will do.
    -> IO ()


-- | @void blake3_hasher_init_derive_key_raw(blake3_hasher *self, const void *context, size_t context_len)@
foreign import ccall unsafe
  "blake3.h blake3_hasher_init_derive_key_raw"
  c_init_derive_key_raw
    :: Ptr Hasher  -- ^ You can obtain with 'BAS.alloc'.
                   -- Otherwise, any chunk of 'HASHER_SIZE' bytes aligned to
                   -- 'HASHER_ALIGNMENT' will do.
    -> Ptr Word8   -- ^ Context.
    -> CSize       -- ^ Context length.
    -> IO ()

-- | @void blake3_hasher_update(blake3_hasher *self, const void *input, size_t input_len)@
--
-- Uses 'c_update__unsafe' FFI call for @input_len@ of up to 16 KiB, and
-- 'c_update__safe' otherwise.
c_update
    :: Ptr Hasher -- ^ Must have been previously initialized. See 'c_init',
                  -- 'c_init_keyed', 'c_init_derive_key'.
    -> Ptr Word8  -- ^ Data.
    -> CSize      -- ^ Data length.
    -> IO ()
c_update :: Ptr Hasher -> Ptr Word8 -> CSize -> IO ()
c_update Ptr Hasher
ph Ptr Word8
pd CSize
dl =
  let f :: Ptr Hasher -> Ptr Word8 -> CSize -> IO ()
f = if CSize
dl CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
<= CSize
16384 then Ptr Hasher -> Ptr Word8 -> CSize -> IO ()
c_update__unsafe else Ptr Hasher -> Ptr Word8 -> CSize -> IO ()
c_update__safe
  in  Ptr Hasher -> Ptr Word8 -> CSize -> IO ()
f Ptr Hasher
ph Ptr Word8
pd CSize
dl
{-# INLINE c_update #-}

-- | @void blake3_hasher_update(blake3_hasher *self, const void *input, size_t input_len)@
--
-- Like 'c_update__safe', but marked @unsafe@ for FFI purposes.
-- Suitable when @input_len@ is big. See 'c_update'.
foreign import ccall unsafe
  "blake3.h blake3_hasher_update"
  c_update__unsafe
    :: Ptr Hasher -- ^ Must have been previously initializedi. See 'c_init',
                  -- 'c_init_keyed', 'c_init_derive_key'.
    -> Ptr Word8  -- ^ Data.
    -> CSize      -- ^ Data length.
    -> IO ()

-- | @void blake3_hasher_update(blake3_hasher *self, const void *input, size_t input_len)@
--
-- Like 'c_update_safe', but marked @safe@ for FFI purposes.
-- Suitable when @input_len@ is small. See 'c_update'.
foreign import ccall safe
  "blake3.h blake3_hasher_update"
  c_update__safe
    :: Ptr Hasher -- ^ Must have been previously initializedi. See 'c_init',
                  -- 'c_init_keyed', 'c_init_derive_key'.
    -> Ptr Word8  -- ^ Data.
    -> CSize      -- ^ Data length.
    -> IO ()

-- | @void blake3_hasher_finalize(const blake3_hasher *self, uint8_t *out, size_t out_len)@
foreign import ccall unsafe
  "blake3.h blake3_hasher_finalize"
  c_finalize
    :: Ptr Hasher -- ^ Must have been previously initializedi. See 'c_init',
                  -- 'c_init_keyed', 'c_init_derive_key'.
    -> Ptr Word8  -- ^ Out.
    -> CSize      -- ^ Out length.
    -> IO ()

-- | @void blake3_hasher_finalize_seek(const blake3_hasher *self, uint64_t seek, uint8_t *out, size_t out_len)@
foreign import ccall unsafe
  "blake3.h blake3_hasher_finalize_seek"
  c_finalize_seek
    :: Ptr Hasher  -- ^ Must have been previously initializedi. See 'c_init',
                   -- 'c_init_keyed', 'c_init_derive_key'.
    -> Word64      -- ^ Seek position.
    -> Ptr Word8   -- ^ Out.
    -> CSize       -- ^ Out length.
    -> IO ()