    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    -- |
    -- Module      : Crypto.MAC.KeyedBlake2
    -- License     : BSD-style
    -- Maintainer  : Matthias Valvekens <dev@mvalvekens.be>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- Expose a MAC interface to the keyed Blake2 algorithms
    -- defined in RFC 7693.
    module Crypto.MAC.KeyedBlake2 (
        HashBlake2,
        KeyedBlake2 (..),
        keyedBlake2,
        keyedBlake2Lazy,

        -- * Incremental
        Context,
        initialize,
        update,
        updates,
        finalize,
    ) where

    import qualified Crypto.Hash as H
    import Crypto.Hash.Blake2
    import qualified Crypto.Hash.Types as H
    import Crypto.Internal.DeepSeq (NFData)
    import Data.ByteArray (ByteArrayAccess)
    import qualified Data.ByteArray as B
    import qualified Data.ByteString.Lazy as L

    import Foreign.Ptr (Ptr)

    -- Keyed Blake2b

    -- | Represent a Blake2b MAC that is a phantom type with the hash used to produce the
    -- MAC.
    --
    -- The Eq instance is constant time.  No Show instance is provided, to avoid
    -- printing by mistake.
    newtype KeyedBlake2 a = KeyedBlake2 {forall a. KeyedBlake2 a -> Digest a
    keyedBlake2GetDigest :: H.Digest a}
        deriving (KeyedBlake2 a -> Int
    (KeyedBlake2 a -> Int)
    -> (forall p a. KeyedBlake2 a -> (Ptr p -> IO a) -> IO a)
    -> (forall p. KeyedBlake2 a -> Ptr p -> IO ())
    -> ByteArrayAccess (KeyedBlake2 a)
    forall a. KeyedBlake2 a -> Int
    forall p. KeyedBlake2 a -> 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 a p. KeyedBlake2 a -> Ptr p -> IO ()
    forall p a. KeyedBlake2 a -> (Ptr p -> IO a) -> IO a
    forall a p a. KeyedBlake2 a -> (Ptr p -> IO a) -> IO a
    $clength :: forall a. KeyedBlake2 a -> Int
    length :: KeyedBlake2 a -> Int
    $cwithByteArray :: forall a p a. KeyedBlake2 a -> (Ptr p -> IO a) -> IO a
    withByteArray :: forall p a. KeyedBlake2 a -> (Ptr p -> IO a) -> IO a
    $ccopyByteArrayToPtr :: forall a p. KeyedBlake2 a -> Ptr p -> IO ()
    copyByteArrayToPtr :: forall p. KeyedBlake2 a -> Ptr p -> IO ()
    ByteArrayAccess, KeyedBlake2 a -> ()
    (KeyedBlake2 a -> ()) -> NFData (KeyedBlake2 a)
    forall a. KeyedBlake2 a -> ()
    forall a. (a -> ()) -> NFData a
    $crnf :: forall a. KeyedBlake2 a -> ()
    rnf :: KeyedBlake2 a -> ()
    NFData)

    instance Eq (KeyedBlake2 a) where
        KeyedBlake2 Digest a
    x == :: KeyedBlake2 a -> KeyedBlake2 a -> Bool
    == KeyedBlake2 Digest a
    y = Digest a -> Digest a -> Bool
    forall bs1 bs2.
    (ByteArrayAccess bs1, ByteArrayAccess bs2) =>
    bs1 -> bs2 -> Bool
    B.constEq Digest a
    x Digest a
    y

    -- | Represent an ongoing Blake2 state, that can be appended with 'update' and
    -- finalized to a 'KeyedBlake2' with 'finalize'.
    newtype Context a = Context (H.Context a)

    -- | Initialize a new incremental keyed Blake2 context with the supplied key.
    initialize
        :: forall a key
         . (HashBlake2 a, ByteArrayAccess key)
        => key -> Context a
    initialize :: forall a key.
    (HashBlake2 a, ByteArrayAccess key) =>
    key -> Context a
    initialize key
    k = Context a -> Context a
    forall a. Context a -> Context a
    Context (Context a -> Context a) -> Context a -> Context a
    forall a b. (a -> b) -> a -> b
    $ Bytes -> Context a
    forall a. Bytes -> Context a
    H.Context (Bytes -> Context a) -> Bytes -> Context a
    forall a b. (a -> b) -> a -> b
    $ Int -> (Ptr (Context a) -> IO ()) -> Bytes
    forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
    B.allocAndFreeze Int
    ctxSz Ptr (Context a) -> IO ()
    performInit
      where
        ctxSz :: Int
    ctxSz = a -> Int
    forall a. HashAlgorithm a => a -> Int
    H.hashInternalContextSize (a
    forall a. HasCallStack => a
    undefined :: a)
        digestSz :: Int
    digestSz = a -> Int
    forall a. HashAlgorithm a => a -> Int
    H.hashDigestSize (a
    forall a. HasCallStack => a
    undefined :: a)
        -- cap the number of key bytes at digestSz,
        -- since that's the maximal key size
        keyByteLen :: Int
    keyByteLen = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (key -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length key
    k) Int
    digestSz
        performInit :: Ptr (H.Context a) -> IO ()
        performInit :: Ptr (Context a) -> IO ()
    performInit Ptr (Context a)
    ptr = 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
    B.withByteArray key
    k ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            \Ptr Word8
    keyPtr -> Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
    forall a.
    HashBlake2 a =>
    Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
    blake2InternalKeyedInit Ptr (Context a)
    ptr Ptr Word8
    keyPtr (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    keyByteLen)

    -- | Incrementally update a keyed Blake2 context.
    update :: (HashBlake2 a, ByteArrayAccess ba) => Context a -> ba -> Context a
    update :: forall a ba.
    (HashBlake2 a, ByteArrayAccess ba) =>
    Context a -> ba -> Context a
    update (Context Context a
    ctx) = Context a -> Context a
    forall a. Context a -> Context a
    Context (Context a -> Context a) -> (ba -> Context a) -> ba -> Context a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Context a -> ba -> Context a
    forall ba a.
    (ByteArrayAccess ba, HashAlgorithm a) =>
    Context a -> ba -> Context a
    H.hashUpdate Context a
    ctx

    -- | Incrementally update a keyed Blake2 context with multiple inputs.
    updates :: (HashBlake2 a, ByteArrayAccess ba) => Context a -> [ba] -> Context a
    updates :: forall a ba.
    (HashBlake2 a, ByteArrayAccess ba) =>
    Context a -> [ba] -> Context a
    updates (Context Context a
    ctx) = Context a -> Context a
    forall a. Context a -> Context a
    Context (Context a -> Context a)
    -> ([ba] -> Context a) -> [ba] -> Context a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Context a -> [ba] -> Context a
    forall a ba.
    (HashAlgorithm a, ByteArrayAccess ba) =>
    Context a -> [ba] -> Context a
    H.hashUpdates Context a
    ctx

    -- | Finalize a keyed Blake2 context and return the computed MAC.
    finalize :: HashBlake2 a => Context a -> KeyedBlake2 a
    finalize :: forall a. HashBlake2 a => Context a -> KeyedBlake2 a
    finalize (Context Context a
    ctx) = Digest a -> KeyedBlake2 a
    forall a. Digest a -> KeyedBlake2 a
    KeyedBlake2 (Digest a -> KeyedBlake2 a) -> Digest a -> KeyedBlake2 a
    forall a b. (a -> b) -> a -> b
    $ Context a -> Digest a
    forall a. HashAlgorithm a => Context a -> Digest a
    H.hashFinalize Context a
    ctx

    -- | Compute a Blake2 MAC using the supplied key.
    keyedBlake2
        :: (HashBlake2 a, ByteArrayAccess key, ByteArrayAccess ba)
        => key -> ba -> KeyedBlake2 a
    keyedBlake2 :: forall a key ba.
    (HashBlake2 a, ByteArrayAccess key, ByteArrayAccess ba) =>
    key -> ba -> KeyedBlake2 a
    keyedBlake2 key
    key ba
    msg = Context a -> KeyedBlake2 a
    forall a. HashBlake2 a => Context a -> KeyedBlake2 a
    finalize (Context a -> KeyedBlake2 a) -> Context a -> KeyedBlake2 a
    forall a b. (a -> b) -> a -> b
    $ Context a -> ba -> Context a
    forall a ba.
    (HashBlake2 a, ByteArrayAccess ba) =>
    Context a -> ba -> Context a
    update (key -> Context a
    forall a key.
    (HashBlake2 a, ByteArrayAccess key) =>
    key -> Context a
    initialize key
    key) ba
    msg

    -- | Compute a Blake2 MAC using the supplied key, for a lazy input.
    keyedBlake2Lazy
        :: (HashBlake2 a, ByteArrayAccess key)
        => key -> L.ByteString -> KeyedBlake2 a
    keyedBlake2Lazy :: forall a key.
    (HashBlake2 a, ByteArrayAccess key) =>
    key -> ByteString -> KeyedBlake2 a
    keyedBlake2Lazy key
    key ByteString
    msg = Context a -> KeyedBlake2 a
    forall a. HashBlake2 a => Context a -> KeyedBlake2 a
    finalize (Context a -> KeyedBlake2 a) -> Context a -> KeyedBlake2 a
    forall a b. (a -> b) -> a -> b
    $ Context a -> [StrictByteString] -> Context a
    forall a ba.
    (HashBlake2 a, ByteArrayAccess ba) =>
    Context a -> [ba] -> Context a
    updates (key -> Context a
    forall a key.
    (HashBlake2 a, ByteArrayAccess key) =>
    key -> Context a
    initialize key
    key) (ByteString -> [StrictByteString]
    L.toChunks ByteString
    msg)