-- |
-- 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
(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 -> [ByteString] -> 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 -> [ByteString]
L.toChunks ByteString
msg)