{-# 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, SSE 2, 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(..)
    -- * Keyed hashing
  , BIO.Key
  , BIO.key
    -- * Key derivation
  , derive
    -- * Incremental hashing
  , BIO.Hasher
  , init
  , 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 Prelude hiding (init)
import System.IO.Unsafe (unsafeDupablePerformIO)

import qualified BLAKE3.IO as BIO

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

-- | BLAKE3 hashing.
--
-- For incremental hashing, see 'init', 'update' and 'finalize':
--
-- @
-- 'hash' yk = 'finalize' '.' 'update' ('init' yk)
-- @
hash
  :: forall len digest bin
  .  (BAS.ByteArrayN len digest, BA.ByteArrayAccess bin)
  => Maybe BIO.Key -- ^ Whether to use keyed hashing mode (for MAC, PRF).
  -> [bin]  -- ^ Data to hash.
  -> digest -- ^ The @digest@ type could be @'BIO.Digest' len@.
hash :: forall (len :: Nat) digest bin.
(ByteArrayN len digest, ByteArrayAccess bin) =>
Maybe Key -> [bin] -> digest
hash Maybe Key
yk = IO digest -> digest
forall a. IO a -> a
unsafeDupablePerformIO (IO digest -> digest) -> ([bin] -> IO digest) -> [bin] -> digest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Key -> [bin] -> IO digest
forall (len :: Nat) digest bin.
(ByteArrayN len digest, ByteArrayAccess bin) =>
Maybe Key -> [bin] -> IO digest
BIO.hash Maybe Key
yk
{-# NOINLINE hash #-}

-- | BLAKE3 key derivation.
--
-- This can be used for KDF (key derivation function) purposes.
--
-- The key derivation @context@ should be hardcoded, globally unique,
-- application-specific well-known string.
--
-- 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
-- @
derive
  :: forall len okm ikm context
  .  (BAS.ByteArrayN len okm,
      BA.ByteArrayAccess ikm,
      BA.ByteArrayAccess context)
  => context -- ^ Key derivation context.
  -> [ikm]   -- ^ Input key material.
  -> okm     -- ^ Output key material of the specified @len@ght.
derive :: forall (len :: Nat) okm ikm context.
(ByteArrayN len okm, ByteArrayAccess ikm,
 ByteArrayAccess context) =>
context -> [ikm] -> okm
derive context
ctx [ikm]
ikms = IO okm -> okm
forall a. IO a -> a
unsafeDupablePerformIO (IO okm -> okm) -> IO okm -> okm
forall a b. (a -> b) -> a -> b
$ do
  (dig, _ :: BIO.Hasher) <- Proxy HASHER_SIZE -> (Ptr Hasher -> IO okm) -> IO (okm, 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 okm) -> IO (okm, Hasher))
-> (Ptr Hasher -> IO okm) -> IO (okm, Hasher)
forall a b. (a -> b) -> a -> b
$ \Ptr Hasher
ph -> do
    Ptr Hasher -> context -> IO ()
forall context.
ByteArrayAccess context =>
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 okm
forall (len :: Nat) output.
ByteArrayN len output =>
Ptr Hasher -> IO output
BIO.finalize Ptr Hasher
ph
  pure dig
{-# NOINLINE derive #-}

-- | Initial 'BIO.Hasher' for incremental hashing.
init
  :: Maybe BIO.Key -- ^ Whether to use keyed hashing mode (for MAC, PRF).
  -> BIO.Hasher
init :: Maybe Key -> Hasher
init Maybe Key
yk =
  (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
$ \Ptr Hasher
ph ->
  Ptr Hasher -> Maybe Key -> IO ()
BIO.init Ptr Hasher
ph Maybe Key
yk

-- | Update 'BIO.Hasher' with new data.
update
  :: forall bin
  .  BA.ByteArrayAccess bin
  => BIO.Hasher
  -> [bin]  -- ^ New data to hash.
  -> BIO.Hasher
update :: forall bin. ByteArrayAccess bin => Hasher -> [bin] -> Hasher
update Hasher
h0 [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
$ \Ptr Hasher
ph1 ->
  Ptr Hasher -> [bin] -> IO ()
forall bin. ByteArrayAccess bin => Ptr Hasher -> [bin] -> IO ()
BIO.update Ptr Hasher
ph1 [bin]
bins

-- | Finalize incremental hashing and obtain a the BLAKE3 output of the
-- specified @len@gth.
finalize
  :: forall len output
  .  BAS.ByteArrayN len output
  => BIO.Hasher
  -> output -- ^ The @output@ type could be @'BIO.Digest' len@.
finalize :: forall (len :: Nat) output.
ByteArrayN len output =>
Hasher -> output
finalize Hasher
h0 = IO output -> output
forall a. IO a -> a
unsafeDupablePerformIO (IO output -> output) -> IO output -> output
forall a b. (a -> b) -> a -> b
$ do
  (dig, _ :: BIO.Hasher) <- Hasher -> (Ptr Hasher -> IO output) -> IO (output, 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 output
forall (len :: Nat) output.
ByteArrayN len output =>
Ptr Hasher -> IO output
BIO.finalize
  pure dig
{-# NOINLINE finalize #-}

-- | 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
  => BIO.Hasher
  -> Word64     -- ^ BLAKE3 output offset.
  -> output     -- ^ The @output@ type could be @'BIO.Digest' len@.
finalizeSeek :: forall (len :: Nat) output.
ByteArrayN len output =>
Hasher -> Word64 -> output
finalizeSeek Hasher
h0 Word64
pos = IO output -> output
forall a. IO a -> a
unsafeDupablePerformIO (IO output -> output) -> IO output -> output
forall a b. (a -> b) -> a -> b
$ do
  (dig, _ :: BIO.Hasher) <- Hasher -> (Ptr Hasher -> IO output) -> IO (output, 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 output) -> IO (output, Hasher))
-> (Ptr Hasher -> IO output) -> IO (output, Hasher)
forall a b. (a -> b) -> a -> b
$ \Ptr Hasher
ph -> Ptr Hasher -> Word64 -> IO output
forall (len :: Nat) output.
ByteArrayN len output =>
Ptr Hasher -> Word64 -> IO output
BIO.finalizeSeek Ptr Hasher
ph Word64
pos
  pure dig
{-# NOINLINE finalizeSeek #-}