-- |
-- 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.
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Crypto.MAC.KeyedBlake2
    ( HashBlake2
    , KeyedBlake2(..)
    , keyedBlake2
    , keyedBlake2Lazy
    -- * Incremental
    , Context
    , initialize
    , update
    , updates
    , finalize
    ) where

import qualified Crypto.Hash as H
import qualified Crypto.Hash.Types as H
import           Crypto.Hash.Blake2
import           Crypto.Internal.DeepSeq (NFData)
import qualified Data.ByteArray as B
import           Data.ByteArray (ByteArrayAccess)
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
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
copyByteArrayToPtr :: forall p. KeyedBlake2 a -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall a p. KeyedBlake2 a -> Ptr p -> IO ()
withByteArray :: forall p a. KeyedBlake2 a -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall a p a. KeyedBlake2 a -> (Ptr p -> IO a) -> IO a
length :: KeyedBlake2 a -> Int
$clength :: forall a. KeyedBlake2 a -> Int
ByteArrayAccess,KeyedBlake2 a -> ()
forall a. KeyedBlake2 a -> ()
forall a. (a -> ()) -> NFData a
rnf :: KeyedBlake2 a -> ()
$crnf :: forall a. KeyedBlake2 a -> ()
NFData)

instance Eq (KeyedBlake2 a) where
    KeyedBlake2 Digest a
x == :: KeyedBlake2 a -> KeyedBlake2 a -> Bool
== KeyedBlake2 Digest a
y = 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 = forall a. Context a -> Context a
Context forall a b. (a -> b) -> a -> b
$ forall a. Bytes -> Context a
H.Context forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
ctxSz Ptr (Context a) -> IO ()
performInit
    where ctxSz :: Int
ctxSz = forall a. HashAlgorithm a => a -> Int
H.hashInternalContextSize (forall a. HasCallStack => a
undefined :: a)
          digestSz :: Int
digestSz = forall a. HashAlgorithm a => a -> Int
H.hashDigestSize (forall a. HasCallStack => a
undefined :: a)
          -- cap the number of key bytes at digestSz,
          -- since that's the maximal key size
          keyByteLen :: Int
keyByteLen = forall a. Ord a => a -> a -> a
min (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 = forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray key
k
            forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyPtr -> forall a.
HashBlake2 a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
blake2InternalKeyedInit Ptr (Context a)
ptr Ptr Word8
keyPtr (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) = forall a. Context a -> Context a
Context forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall a. Context a -> Context a
Context forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall a. Digest a -> KeyedBlake2 a
KeyedBlake2 forall a b. (a -> b) -> a -> b
$ 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 = forall a. HashBlake2 a => Context a -> KeyedBlake2 a
finalize forall a b. (a -> b) -> a -> b
$ forall a ba.
(HashBlake2 a, ByteArrayAccess ba) =>
Context a -> ba -> Context a
update (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 = forall a. HashBlake2 a => Context a -> KeyedBlake2 a
finalize forall a b. (a -> b) -> a -> b
$ forall a ba.
(HashBlake2 a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
updates (forall a key.
(HashBlake2 a, ByteArrayAccess key) =>
key -> Context a
initialize key
key) (ByteString -> [ByteString]
L.toChunks ByteString
msg)