{-# 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
  , digest
    -- * Keyed hashing
  , Key
  , key
  , initKeyed
    -- * Key derivation
  , Context
  , context
  , 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
  , c_update
  , c_finalize
  , c_finalize_seek
  )
  where

import Control.Monad (guard)
import Data.Foldable
import Data.Proxy
import Data.String
import Data.Word
import Foreign.C.String
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
import qualified Data.Memory.PtrMethods as BA

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

-- | Output from BLAKE3 algorithm, of @len@ bytes.
--
-- The default digest length for BLAKE3 is 'DEFAULT_DIGEST_LEN'.
data Digest (len :: Nat) where
  -- | We store things this way to avoid unnecessary conversions between
  -- different 'BA.ByteArrayAccess' when using 'digest' for reading a 'Digest'
  -- from a third party source.
  --
  -- Digest produced by this library are always allocated with 'BAS.allocRet'.
  Digest :: BA.ByteArrayAccess x => x -> Digest len

-- | Obtain a digest containing bytes from a third-party source.
--
-- This is useful if you want to use the 'Digest' datatype in your programs, but
-- you are loading the pre-calculated digests from a database or similar.
digest
  :: forall len bin
  .  (KnownNat len, BA.ByteArrayAccess bin)
  => bin  -- ^ Raw digest bytes. Must have length @len@.
  -> Maybe (Digest len)  -- ^
digest :: bin -> Maybe (Digest len)
digest bin :: bin
bin
  | bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length bin
bin Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 (Proxy len
forall k (t :: k). Proxy t
Proxy @len)) = Maybe (Digest len)
forall a. Maybe a
Nothing
  | Bool
otherwise = Digest len -> Maybe (Digest len)
forall a. a -> Maybe a
Just (bin -> Digest len
forall x (len :: Nat). ByteArrayAccess x => x -> Digest len
Digest bin
bin)

-- | Constant time.
instance Eq (Digest len) where
  Digest a :: x
a == :: Digest len -> Digest len -> Bool
== Digest b :: x
b = x -> x -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq x
a x
b

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

instance BA.ByteArrayAccess (Digest len) where
  length :: Digest len -> Int
length (Digest x :: x
x) = x -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length x
x
  withByteArray :: Digest len -> (Ptr p -> IO a) -> IO a
withByteArray (Digest x :: x
x) = x -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
BA.withByteArray x
x

-- | Allocate a 'Digest'.
-- The memory is wiped and freed as soon the 'Digest' becomes unused.
instance KnownNat len => BAS.ByteArrayN len (Digest len) where
  allocRet :: Proxy len -> (Ptr p -> IO a) -> IO (a, Digest len)
allocRet prx :: Proxy len
prx g :: Ptr p -> IO a
g = do
    let size :: Int
size = 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 Proxy len
prx)
    (a :: a
a, ScrubbedBytes
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)
BA.allocRet Int
size Ptr p -> IO a
g
    (a, Digest len) -> IO (a, Digest len)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, ScrubbedBytes -> Digest len
forall x (len :: Nat). ByteArrayAccess x => x -> Digest len
Digest ScrubbedBytes
bs)

-- | 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 _ = 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 (Proxy len
forall k (t :: k). Proxy t
Proxy @len))
  alignment :: Digest len -> Int
alignment _ = 8 -- Not sure.
  peek :: Ptr (Digest len) -> IO (Digest len)
peek ps :: 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
$ \pd :: 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 1
  poke :: Ptr (Digest len) -> Digest len -> IO ()
poke pd :: Ptr (Digest len)
pd src :: Digest len
src = Digest len -> (Ptr (Digest len) -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (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
$ \ps :: 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 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 a :: x
a == :: Key -> Key -> Bool
== Key b :: x
b = x -> x -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq x
a x
b

-- | Base 16 (hexadecimal).
instance Show Key where
  show :: Key -> String
show (Key x :: 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) = x -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length x
x
  withByteArray :: Key -> (Ptr p -> IO a) -> IO a
withByteArray (Key x :: x
x) = x -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (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 :: Proxy KEY_LEN -> (Ptr p -> IO a) -> IO (a, Key)
allocRet _ g :: Ptr p -> IO a
g = do
    (a :: a
a, ScrubbedBytes
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)
BA.allocRet Int
keyLen Ptr p -> IO a
g
    (a, Key) -> IO (a, Key)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, ScrubbedBytes -> Key
forall x. ByteArrayAccess x => x -> Key
Key ScrubbedBytes
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 _ = Int
keyLen
  alignment :: Key -> Int
alignment _ = 8 -- Not sure.
  peek :: Ptr Key -> IO Key
peek ps :: 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
$ \pd :: 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 1
  poke :: Ptr Key -> Key -> IO ()
poke pd :: Ptr Key
pd src :: Key
src = Key -> (Ptr Key -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (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
$ \ps :: 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 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 :: bin -> Maybe Key
key bin :: 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)

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

-- | Context for BLAKE3 key derivation. Obtain with 'context'.
newtype Context
  = Context BA.Bytes
  -- ^ NUL-terminated 'CString'. We store things this way so as to avoid
  -- re-creating the 'CString' each time we need to use this 'Context' in
  -- 'c_init_derive_key'. We never expose the NUL-terminating byte to users
  -- of this library.
  deriving newtype (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq)

-- We exclude the NUL-terminating byte. That's internal.
instance BA.ByteArrayAccess Context where
  length :: Context -> Int
length (Context x :: Bytes
x) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length Bytes
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
  withByteArray :: Context -> (Ptr p -> IO a) -> IO a
withByteArray c :: Context
c@(Context x :: Bytes
x) = View Bytes -> (Ptr p -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
BA.withByteArray (Bytes -> Int -> View Bytes
forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
BA.takeView Bytes
x (Context -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length Context
c))

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

-- | 'fromString' is a /partial/ function that fails if the given 'String'
-- contains 'Char's outside the range @['toEnum' 1 .. 'toEnum' 255]@.
-- See 'context' for more details.
instance IsString Context where
  fromString :: String -> Context
fromString s :: String
s = case (Char -> Maybe Word8) -> String -> Maybe [Word8]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> Maybe Word8
charToWord8 String
s of
      Nothing -> String -> Context
forall a. HasCallStack => String -> a
error "Not a valid String for Context"
      Just w8s :: [Word8]
w8s -> Bytes -> Context
Context (Bytes -> Context) -> Bytes -> Context
forall a b. (a -> b) -> a -> b
$! [Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
BA.pack ([Word8]
w8s [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> [0])
    where
      charToWord8 :: Char -> Maybe Word8
      charToWord8 :: Char -> Maybe Word8
charToWord8 c :: Char
c = do
        let i :: Int
i = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 256)
        Word8 -> Maybe Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

-- | Obtain a 'Context' for BLAKE3 key derivation.
--
-- The context should be hardcoded, globally unique, and
-- application-specific.
--
-- A good format for the context string is:
--
-- @
-- [application] [commit timestamp] [purpose]
-- @
--
-- For example:
--
-- @
-- example.com 2019-12-25 16:18:03 session tokens v1
-- @
context
  :: BA.ByteArrayAccess bin
  => bin -- ^ If @bin@ contains null bytes, this function returns 'Nothing'.
  -> Maybe Context
context :: bin -> Maybe Context
context src :: bin
src
  | (Word8 -> Bool) -> bin -> Bool
forall ba. ByteArrayAccess ba => (Word8 -> Bool) -> ba -> Bool
BA.any (0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==) bin
src = Maybe Context
forall a. Maybe a
Nothing
  | Bool
otherwise = Context -> Maybe Context
forall a. a -> Maybe a
Just (Context -> Maybe Context) -> Context -> Maybe Context
forall a b. (a -> b) -> a -> b
$ Bytes -> Context
Context (Bytes -> Context) -> Bytes -> Context
forall a b. (a -> b) -> a -> b
$
      let srcLen :: Int
srcLen = bin -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length bin
src
          dstLen :: Int
dstLen = Int
srcLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
      in Int -> (Ptr Word8 -> IO ()) -> Bytes
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
BA.allocAndFreeze Int
dstLen ((Ptr Word8 -> IO ()) -> Bytes) -> (Ptr Word8 -> IO ()) -> Bytes
forall a b. (a -> b) -> a -> b
$ \pdst :: Ptr Word8
pdst ->
         bin -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
BA.withByteArray bin
src ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \psrc :: Ptr Word8
psrc -> do
           Ptr Word8 -> Ptr Word8 -> Int -> IO ()
BA.memCopy Ptr Word8
pdst Ptr Word8
psrc Int
srcLen
           Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
pdst Int
srcLen (0 :: Word8)

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

showBase16 :: BA.ByteArrayAccess x => x -> String
showBase16 :: x -> String
showBase16 = (Word8 -> Char) -> [Word8] -> String
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
. ByteArrayAccess ScrubbedBytes => ScrubbedBytes -> [Word8]
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 bin
  .  (KnownNat len, BA.ByteArrayAccess bin)
  => [bin]
  -- ^ Data to hash.
  -> IO (Digest len)
  -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'.
  -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused.
hash :: [bin] -> IO (Digest len)
hash bins :: [bin]
bins = do
  (dig :: Digest len
dig, Hasher
_ :: Hasher) <- Proxy HASHER_SIZE
-> (Ptr Hasher -> IO (Digest len)) -> IO (Digest len, Hasher)
forall (n :: Nat) c p a.
ByteArrayN n c =>
Proxy n -> (Ptr p -> IO a) -> IO (a, c)
BAS.allocRet Proxy HASHER_SIZE
forall k (t :: k). Proxy t
Proxy ((Ptr Hasher -> IO (Digest len)) -> IO (Digest len, Hasher))
-> (Ptr Hasher -> IO (Digest len)) -> IO (Digest len, Hasher)
forall a b. (a -> b) -> a -> b
$ \ph :: Ptr Hasher
ph -> do
    Ptr Hasher -> IO ()
init Ptr Hasher
ph
    Ptr Hasher -> [bin] -> IO ()
forall bin. ByteArrayAccess bin => Ptr Hasher -> [bin] -> IO ()
update Ptr Hasher
ph [bin]
bins
    Ptr Hasher -> IO (Digest len)
forall (len :: Nat). KnownNat len => Ptr Hasher -> IO (Digest len)
finalize Ptr Hasher
ph
  Digest len -> IO (Digest len)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Digest len
dig

-- | Initialize a 'Hasher'.
init
  :: Ptr Hasher  -- ^ Obtain with 'BAS.alloc' or similar. It will be mutated.
  -> IO ()
init :: Ptr Hasher -> IO ()
init = Ptr Hasher -> IO ()
c_init

-- | Initialize a 'Hasher' in keyed mode.
initKeyed
  :: Ptr Hasher  -- ^ Obtain with 'BAS.alloc' or similar. It will be mutated.
  -> Key
  -> IO ()
initKeyed :: Ptr Hasher -> Key -> IO ()
initKeyed ph :: Ptr Hasher
ph key0 :: Key
key0 =
  Key -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (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
$ \pkey :: 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
  :: Ptr Hasher  -- ^ Obtain with 'BAS.alloc' or similar. It will be mutated.
  -> Context
  -> IO ()
initDerive :: Ptr Hasher -> Context -> IO ()
initDerive ph :: Ptr Hasher
ph (Context ctx :: Bytes
ctx) =
  Bytes -> (Ptr CChar -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
BA.withByteArray Bytes
ctx ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \pc :: Ptr CChar
pc ->
  Ptr Hasher -> Ptr CChar -> IO ()
c_init_derive_key Ptr Hasher
ph Ptr CChar
pc

-- | Update 'Hasher' state with new data.
update
  :: forall bin
  .  BA.ByteArrayAccess bin
  => Ptr Hasher -- ^ Obtain with 'modifyHasher'. It will be mutated.
  -> [bin]
  -> IO ()
update :: Ptr Hasher -> [bin] -> IO ()
update ph :: Ptr Hasher
ph bins :: [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 ->
  bin -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (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
$ \pbin :: 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 hashin and obtain a 'Digest'.
finalize
  :: forall len
  .  KnownNat len
  => Ptr Hasher -- ^ Obtain with 'modifyHasher'. It will be mutated.
  -> IO (Digest len)
  -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'.
  -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused.
finalize :: Ptr Hasher -> IO (Digest len)
finalize ph :: Ptr Hasher
ph =
  (Ptr Word8 -> IO ()) -> IO (Digest len)
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> IO ba
BAS.alloc ((Ptr Word8 -> IO ()) -> IO (Digest len))
-> (Ptr Word8 -> IO ()) -> IO (Digest len)
forall a b. (a -> b) -> a -> b
$ \pd :: 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 (Proxy len
forall k (t :: k). Proxy t
Proxy @len)))

-- | Finalize incremental hashing and obtain a 'Digest' of length @len@ /after/
-- the specified number of bytes of BLAKE3 output.
--
-- @
-- 'finalize' h = 'finalizeSeek' h 0
-- @
finalizeSeek
  :: forall len
  .  KnownNat len
  => Ptr Hasher -- ^ Obtain with 'modifyHasher'. It will be mutated.
  -> Word64     -- ^ Number of bytes to skip before obtaning the digest output.
  -> IO (Digest len)
  -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'.
  -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused.
finalizeSeek :: Ptr Hasher -> Word64 -> IO (Digest len)
finalizeSeek ph :: Ptr Hasher
ph pos :: Word64
pos =
  (Ptr Word8 -> IO ()) -> IO (Digest len)
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> IO ba
BAS.alloc ((Ptr Word8 -> IO ()) -> IO (Digest len))
-> (Ptr Word8 -> IO ()) -> IO (Digest len)
forall a b. (a -> b) -> a -> b
$ \pd :: 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 (Proxy len
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 (Proxy HASHER_SIZE
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 (Proxy KEY_LEN
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
    ( 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.
    )

instance Eq Hasher where
  == :: Hasher -> Hasher -> Bool
(==) = Hasher -> Hasher -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.eq

-- | 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 :: 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
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 _ = Int
hasherSize
  alignment :: Hasher -> Int
alignment _ = 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 (Proxy HASHER_ALIGNMENT
forall k (t :: k). Proxy t
Proxy @HASHER_ALIGNMENT))
  peek :: Ptr Hasher -> IO Hasher
peek ps :: 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
$ \pd :: 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 1
  poke :: Ptr Hasher -> Hasher -> IO ()
poke pd :: Ptr Hasher
pd src :: Hasher
src = Hasher -> (Ptr Hasher -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (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
$ \ps :: 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 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(blake3_hasher *self, const char *context)@
foreign import ccall unsafe
  "blake3.h blake3_hasher_init_derive_key"
  c_init_derive_key
    :: Ptr Hasher  -- ^ You can obtain with 'BAS.alloc'.
                   -- Otherwise, any chunk of 'HASHER_SIZE' bytes aligned to
                   -- 'HASHER_ALIGNMENT' will do.
    -> CString  -- ^ Context.
    -> IO ()

-- | @void blake3_hasher_update(blake3_hasher *self, const void *input, size_t input_len)@
foreign import ccall unsafe
  "blake3.h blake3_hasher_update"
  c_update
    :: 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 ()