{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Haskell bindings to the fast [official BLAKE3 hashing
-- implementation in assembly and C](https://github.com/BLAKE3-team/BLAKE3).
-- With support for AVX-512, AVX2 and SSE 4.1.
--
-- The original assembly and C implementation is released into the public domain with CC0 1.0.
-- Alternatively, it is licensed under the Apache License 2.0, copyright of Jack
-- O'Connor and Samuel Neves. See its [LICENSE](https://github.com/BLAKE3-team/BLAKE3/blob/88dcee7005be962a81516f7863e70009d9caa2c9/LICENSE)
-- for details.
--
-- This Haskell library is the copyright of Renzo Carbonara,
-- licensed under the terms of
-- the [Apache License 2.0](https://github.com/k0001/hs-blake3/blob/master/blake3/LICENSE).
module BLAKE3
  ( -- * Hashing
    hash
  , BIO.Digest
  , BIO.digest
    -- * Keyed hashing
  , hashKeyed
  , BIO.Key
  , BIO.key
    -- * Key derivation
  , derive
  , BIO.Context
  , BIO.context
    -- * Incremental hashing
  , BIO.Hasher
  , hasher
  , hasherKeyed
  , update
  , finalize
  , finalizeSeek
    -- * Constants
  , BIO.KEY_LEN
  , BIO.BLOCK_SIZE
  , BIO.DEFAULT_DIGEST_LEN
  )
  where

import qualified Data.ByteArray as BA
import qualified Data.ByteArray.Sized as BAS
import Data.Proxy
import Data.Word
import GHC.TypeLits
import System.IO.Unsafe (unsafeDupablePerformIO)

import qualified BLAKE3.IO as BIO

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

-- | BLAKE3 hashing.
--
-- For incremental hashing, see 'hasher', 'update' and 'finalize':
--
-- @
-- 'hash' = 'finalize' '.' 'update' 'hasher'
-- @
hash
  :: forall len bin
  .  (KnownNat len, BA.ByteArrayAccess bin)
  => [bin]           -- ^ Data to hash.
  -> BIO.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] -> Digest len
hash = IO (Digest len) -> Digest len
forall a. IO a -> a
unsafeDupablePerformIO (IO (Digest len) -> Digest len)
-> ([bin] -> IO (Digest len)) -> [bin] -> Digest len
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [bin] -> IO (Digest len)
forall (len :: Nat) bin.
(KnownNat len, ByteArrayAccess bin) =>
[bin] -> IO (Digest len)
BIO.hash
{-# NOINLINE hash #-}

-- | BLAKE3 hashing with a 'BIO.Key'.
--
-- This can be used for MAC (message authentication code), PRF (pseudo random
-- function) and SHO (stateful hash object) purposes.
--
-- For incremental hashing, see 'hasherKeyed', 'update' and 'finalize':
--
-- @
-- 'hashKeyed' key = 'finalize' '.' 'update' ('hasherKeyed' key)
-- @
hashKeyed
  :: forall len bin
  .  (KnownNat len, BA.ByteArrayAccess bin)
  => BIO.Key
  -> [bin]           -- ^ Data to hash.
  -> BIO.Digest len
  -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'.
  -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused.
hashKeyed :: Key -> [bin] -> Digest len
hashKeyed key0 :: Key
key0 bins :: [bin]
bins = IO (Digest len) -> Digest len
forall a. IO a -> a
unsafeDupablePerformIO (IO (Digest len) -> Digest len) -> IO (Digest len) -> Digest len
forall a b. (a -> b) -> a -> b
$ do
  (dig :: Digest len
dig, Hasher
_ :: BIO.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 -> Key -> IO ()
BIO.initKeyed Ptr Hasher
ph Key
key0
    Ptr Hasher -> [bin] -> IO ()
forall bin. ByteArrayAccess bin => Ptr Hasher -> [bin] -> IO ()
BIO.update Ptr Hasher
ph [bin]
bins
    Ptr Hasher -> IO (Digest len)
forall (len :: Nat). KnownNat len => Ptr Hasher -> IO (Digest len)
BIO.finalize Ptr Hasher
ph
  Digest len -> IO (Digest len)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Digest len
dig
{-# NOINLINE hashKeyed #-}

-- | BLAKE3 key derivation.
--
-- This can be used for KDF (key derivation function) purposes.
derive
  :: forall len ikm
  .  (KnownNat len, BA.ByteArrayAccess ikm)
  => BIO.Context
  -> [ikm]  -- ^ Input key material.
  -> BIO.Digest len
  -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'.
  -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused.
derive :: Context -> [ikm] -> Digest len
derive ctx :: Context
ctx ikms :: [ikm]
ikms = IO (Digest len) -> Digest len
forall a. IO a -> a
unsafeDupablePerformIO (IO (Digest len) -> Digest len) -> IO (Digest len) -> Digest len
forall a b. (a -> b) -> a -> b
$ do
  (dig :: Digest len
dig, Hasher
_ :: BIO.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 -> Context -> IO ()
BIO.initDerive Ptr Hasher
ph Context
ctx
    Ptr Hasher -> [ikm] -> IO ()
forall bin. ByteArrayAccess bin => Ptr Hasher -> [bin] -> IO ()
BIO.update Ptr Hasher
ph [ikm]
ikms
    Ptr Hasher -> IO (Digest len)
forall (len :: Nat). KnownNat len => Ptr Hasher -> IO (Digest len)
BIO.finalize Ptr Hasher
ph
  Digest len -> IO (Digest len)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Digest len
dig
{-# NOINLINE derive #-}

-- | Initial 'BIO.Hasher' for incremental hashing.
hasher :: BIO.Hasher -- ^
hasher :: Hasher
hasher = (Ptr Hasher -> IO ()) -> Hasher
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> ba
BAS.allocAndFreeze Ptr Hasher -> IO ()
BIO.init

-- | Initial 'BIO.Hasher' for incremental /keyed/ hashing.
hasherKeyed :: BIO.Key -> BIO.Hasher -- ^
hasherKeyed :: Key -> Hasher
hasherKeyed key0 :: Key
key0 =
  (Ptr Hasher -> IO ()) -> Hasher
forall (n :: Nat) ba p.
(ByteArrayN n ba, KnownNat n) =>
(Ptr p -> IO ()) -> ba
BAS.allocAndFreeze ((Ptr Hasher -> IO ()) -> Hasher)
-> (Ptr Hasher -> IO ()) -> Hasher
forall a b. (a -> b) -> a -> b
$ \ph :: Ptr Hasher
ph ->
  Ptr Hasher -> Key -> IO ()
BIO.initKeyed Ptr Hasher
ph Key
key0

-- | Update 'BIO.Hasher' with new data.
update
  :: forall bin
  .  BA.ByteArrayAccess bin
  => BIO.Hasher
  -> [bin]  -- ^ New data to hash.
  -> BIO.Hasher
update :: Hasher -> [bin] -> Hasher
update h0 :: Hasher
h0 bins :: [bin]
bins =
  Hasher -> (Ptr Hasher -> IO ()) -> Hasher
forall (n :: Nat) bs1 bs2 p.
(ByteArrayN n bs1, ByteArrayN n bs2, ByteArrayAccess bs1,
 KnownNat n) =>
bs1 -> (Ptr p -> IO ()) -> bs2
BAS.copyAndFreeze Hasher
h0 ((Ptr Hasher -> IO ()) -> Hasher)
-> (Ptr Hasher -> IO ()) -> Hasher
forall a b. (a -> b) -> a -> b
$ \ph1 :: Ptr Hasher
ph1 ->
  Ptr Hasher -> [bin] -> IO ()
forall bin. ByteArrayAccess bin => Ptr Hasher -> [bin] -> IO ()
BIO.update Ptr Hasher
ph1 [bin]
bins

-- | Finish hashing and obtain a 'BIO.Digest' of the specified @len@gth.
finalize
  :: forall len
  .  KnownNat len
  => BIO.Hasher
  -> BIO.Digest len
  -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'.
  -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused.
finalize :: Hasher -> Digest len
finalize h0 :: Hasher
h0 = IO (Digest len) -> Digest len
forall a. IO a -> a
unsafeDupablePerformIO (IO (Digest len) -> Digest len) -> IO (Digest len) -> Digest len
forall a b. (a -> b) -> a -> b
$ do
  (dig :: Digest len
dig, Hasher
_ :: BIO.Hasher) <- Hasher
-> (Ptr Hasher -> IO (Digest len)) -> IO (Digest len, Hasher)
forall (n :: Nat) bs1 bs2 p a.
(ByteArrayN n bs1, ByteArrayN n bs2, ByteArrayAccess bs1,
 KnownNat n) =>
bs1 -> (Ptr p -> IO a) -> IO (a, bs2)
BAS.copyRet Hasher
h0 Ptr Hasher -> IO (Digest len)
forall (len :: Nat). KnownNat len => Ptr Hasher -> IO (Digest len)
BIO.finalize
  Digest len -> IO (Digest len)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Digest len
dig
{-# NOINLINE finalize #-}

-- | 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
  => BIO.Hasher
  -> Word64     -- ^ Number of bytes to skip before obtaning the digest output.
  -> BIO.Digest len
  -- ^ Default digest length is 'BIO.DEFAULT_DIGEST_LEN'.
  -- The 'Digest' is wiped from memory as soon as the 'Digest' becomes unused.
finalizeSeek :: Hasher -> Word64 -> Digest len
finalizeSeek h0 :: Hasher
h0 pos :: Word64
pos = IO (Digest len) -> Digest len
forall a. IO a -> a
unsafeDupablePerformIO (IO (Digest len) -> Digest len) -> IO (Digest len) -> Digest len
forall a b. (a -> b) -> a -> b
$ do
  (dig :: Digest len
dig, Hasher
_ :: BIO.Hasher) <- Hasher
-> (Ptr Hasher -> IO (Digest len)) -> IO (Digest len, Hasher)
forall (n :: Nat) bs1 bs2 p a.
(ByteArrayN n bs1, ByteArrayN n bs2, ByteArrayAccess bs1,
 KnownNat n) =>
bs1 -> (Ptr p -> IO a) -> IO (a, bs2)
BAS.copyRet Hasher
h0 ((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 -> Ptr Hasher -> Word64 -> IO (Digest len)
forall (len :: Nat).
KnownNat len =>
Ptr Hasher -> Word64 -> IO (Digest len)
BIO.finalizeSeek Ptr Hasher
ph Word64
pos
  Digest len -> IO (Digest len)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Digest len
dig
{-# NOINLINE finalizeSeek #-}

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