Expose keyed Blake2 interface

This fixes haskell-crypto#196.

 - FFI: expose keyed init functions for all Blake2 variants
 - Add HashBlake2 typeclass in Crypto.Hash.Blake2 to support keyed init
 - Add KeyedBlake2 module to Crypto.MAC

Uses KAT vectors from BLAKE2/BLAKE2 repository, plus quickcheck tests
analogous to those in the KAT_KMAC test module.

Crypto/Hash/Blake2.hs

@@ -33,7 +33,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 module Crypto.Hash.Blake2
-    ( Blake2s(..)
+    ( HashBlake2(..)
+    , Blake2s(..)
     , Blake2sp(..)
     , Blake2b(..)
     , Blake2bp(..)
@@ -46,6 +47,13 @@ import           Data.Word (Word8, Word32)
 import           GHC.TypeLits (Nat, KnownNat)
 import           Crypto.Internal.Nat
 
+-- | Typeclass for the Blake2 family of digest functions.
+class HashAlgorithm a => HashBlake2 a where
+
+    -- | Init Blake2 algorithm with the specified key of the specified length.
+    -- The key length is specified in bytes.
+    blake2InternalKeyedInit :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
+
 -- | Fast and secure alternative to SHA1 and HMAC-SHA1
 --
 -- It is espacially known to target 32bits architectures.
@@ -72,8 +80,16 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost b
     hashInternalUpdate        = c_blake2s_update
     hashInternalFinalize p    = c_blake2s_finalize p (integralNatVal (Proxy :: Proxy bitlen))
 
+instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256)
+      => HashBlake2 (Blake2s bitlen)
+      where
+    blake2InternalKeyedInit p = c_blake2s_init_key p outLen
+        where outLen = integralNatVal (Proxy :: Proxy bitlen)
+
 foreign import ccall unsafe "crypton_blake2s_init"
     c_blake2s_init :: Ptr (Context a) -> Word32 -> IO ()
+foreign import ccall unsafe "crypton_blake2s_init_key"
+    c_blake2s_init_key :: Ptr (Context a) -> Word32 -> Ptr Word8 -> Word32 -> IO ()
 foreign import ccall "crypton_blake2s_update"
     c_blake2s_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
 foreign import ccall unsafe "crypton_blake2s_finalize"
@@ -107,8 +123,16 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost b
     hashInternalUpdate        = c_blake2b_update
     hashInternalFinalize p    = c_blake2b_finalize p (integralNatVal (Proxy :: Proxy bitlen))
 
+instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512)
+      => HashBlake2 (Blake2b bitlen)
+      where
+    blake2InternalKeyedInit p = c_blake2b_init_key p outLen
+        where outLen = integralNatVal (Proxy :: Proxy bitlen)
+
 foreign import ccall unsafe "crypton_blake2b_init"
     c_blake2b_init :: Ptr (Context a) -> Word32 -> IO ()
+foreign import ccall unsafe "crypton_blake2b_init_key"
+    c_blake2b_init_key :: Ptr (Context a) -> Word32 -> Ptr Word8 -> Word32 -> IO ()
 foreign import ccall "crypton_blake2b_update"
     c_blake2b_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
 foreign import ccall unsafe "crypton_blake2b_finalize"
@@ -130,8 +154,16 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost b
     hashInternalUpdate        = c_blake2sp_update
     hashInternalFinalize p    = c_blake2sp_finalize p (integralNatVal (Proxy :: Proxy bitlen))
 
+instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 256)
+      => HashBlake2 (Blake2sp bitlen)
+      where
+    blake2InternalKeyedInit p = c_blake2sp_init_key p outLen
+        where outLen = integralNatVal (Proxy :: Proxy bitlen)
+
 foreign import ccall unsafe "crypton_blake2sp_init"
     c_blake2sp_init :: Ptr (Context a) -> Word32 -> IO ()
+foreign import ccall unsafe "crypton_blake2sp_init_key"
+    c_blake2sp_init_key :: Ptr (Context a) -> Word32 -> Ptr Word8 -> Word32 -> IO ()
 foreign import ccall "crypton_blake2sp_update"
     c_blake2sp_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
 foreign import ccall unsafe "crypton_blake2sp_finalize"
@@ -153,9 +185,16 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost b
     hashInternalUpdate        = c_blake2bp_update
     hashInternalFinalize p    = c_blake2bp_finalize p (integralNatVal (Proxy :: Proxy bitlen))
 
+instance (IsDivisibleBy8 bitlen, KnownNat bitlen, IsAtLeast bitlen 8, IsAtMost bitlen 512)
+      => HashBlake2 (Blake2bp bitlen)
+      where
+    blake2InternalKeyedInit p = c_blake2bp_init_key p outLen
+        where outLen = integralNatVal (Proxy :: Proxy bitlen)
 
 foreign import ccall unsafe "crypton_blake2bp_init"
     c_blake2bp_init :: Ptr (Context a) -> Word32 -> IO ()
+foreign import ccall unsafe "crypton_blake2bp_init_key"
+    c_blake2bp_init_key :: Ptr (Context a) -> Word32 -> Ptr Word8 -> Word32 -> IO ()
 foreign import ccall "crypton_blake2bp_update"
     c_blake2bp_update :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
 foreign import ccall unsafe "crypton_blake2bp_finalize"

Crypto/MAC/KeyedBlake2.hs

@@ -0,0 +1,88 @@
+-- |
+-- Module      : Crypto.MAC.KeyedBlake2
+-- License     : BSD-style
+-- Maintainer  : Matthias Valvekens <[email protected]>
+-- 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 { keyedBlake2GetDigest :: H.Digest a }
+    deriving (ByteArrayAccess,NFData)
+
+instance Eq (KeyedBlake2 a) where
+    KeyedBlake2 x == KeyedBlake2 y = B.constEq x 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 k = Context $ H.Context $ B.allocAndFreeze ctxSz performInit
+    where ctxSz = H.hashInternalContextSize (undefined :: a)
+          digestSz = H.hashDigestSize (undefined :: a)
+          -- cap the number of key bytes at digestSz,
+          -- since that's the maximal key size
+          keyByteLen = min (B.length k) digestSz
+          performInit :: Ptr (H.Context a) -> IO ()
+          performInit ptr = B.withByteArray k
+            $ \keyPtr -> blake2InternalKeyedInit ptr keyPtr (fromIntegral keyByteLen)
+
+-- | Incrementally update a keyed Blake2 context.
+update :: (HashBlake2 a, ByteArrayAccess ba) => Context a -> ba -> Context a
+update (Context ctx) = Context . H.hashUpdate ctx
+
+-- | Incrementally update a keyed Blake2 context with multiple inputs.
+updates :: (HashBlake2 a, ByteArrayAccess ba) => Context a -> [ba] -> Context a
+updates (Context ctx) = Context . H.hashUpdates ctx
+
+-- | Finalize a keyed Blake2 context and return the computed MAC.
+finalize :: HashBlake2 a => Context a -> KeyedBlake2 a
+finalize (Context ctx) = KeyedBlake2 $ H.hashFinalize ctx
+
+-- | Compute a Blake2 MAC using the supplied key.
+keyedBlake2 :: (HashBlake2 a, ByteArrayAccess key, ByteArrayAccess ba)
+            => key -> ba -> KeyedBlake2 a
+keyedBlake2 key msg = finalize $ update (initialize key) msg
+
+-- | Compute a Blake2 MAC using the supplied key, for a lazy input.
+keyedBlake2Lazy :: (HashBlake2 a, ByteArrayAccess key)
+            => key -> L.ByteString -> KeyedBlake2 a
+keyedBlake2Lazy key msg = finalize $ updates (initialize key) (L.toChunks msg)

cbits/crypton_blake2b.c

@@ -5,6 +5,11 @@ void crypton_blake2b_init(blake2b_ctx *ctx, uint32_t hashlen)
 	_crypton_blake2b_init(ctx, hashlen / 8);
 }
 
+void crypton_blake2b_init_key(blake2b_ctx *ctx, uint32_t hashlen, const uint8_t *key, size_t keylen)
+{
+	_crypton_blake2b_init_key(ctx, hashlen / 8, (const void *) key, keylen);
+}
+
 void crypton_blake2b_update(blake2b_ctx *ctx, const uint8_t *data, uint32_t len)
 {
 	_crypton_blake2b_update(ctx, data, len);

cbits/crypton_blake2b.h

@@ -6,6 +6,7 @@
 typedef blake2b_state blake2b_ctx;
 
 void crypton_blake2b_init(blake2b_ctx *ctx, uint32_t hashlen);
+void crypton_blake2b_init_key(blake2b_ctx *ctx, uint32_t hashlen, const uint8_t *key, size_t keylen);
 void crypton_blake2b_update(blake2b_ctx *ctx, const uint8_t *data, uint32_t len);
 void crypton_blake2b_finalize(blake2b_ctx *ctx, uint32_t hashlen, uint8_t *out);
 

cbits/crypton_blake2bp.c

@@ -5,6 +5,11 @@ void crypton_blake2bp_init(blake2bp_ctx *ctx, uint32_t hashlen)
 	_crypton_blake2bp_init(ctx, hashlen / 8);
 }
 
+void crypton_blake2bp_init_key(blake2bp_ctx *ctx, uint32_t hashlen, const uint8_t *key, size_t keylen)
+{
+	_crypton_blake2bp_init_key(ctx, hashlen / 8, (const void *) key, keylen);
+}
+
 void crypton_blake2bp_update(blake2bp_ctx *ctx, const uint8_t *data, uint32_t len)
 {
 	_crypton_blake2bp_update(ctx, data, len);

cbits/crypton_blake2bp.h

@@ -6,6 +6,7 @@
 typedef blake2bp_state blake2bp_ctx;
 
 void crypton_blake2bp_init(blake2bp_ctx *ctx, uint32_t hashlen);
+void crypton_blake2bp_init_key(blake2bp_ctx *ctx, uint32_t hashlen, const uint8_t *key, size_t keylen);
 void crypton_blake2bp_update(blake2bp_ctx *ctx, const uint8_t *data, uint32_t len);
 void crypton_blake2bp_finalize(blake2bp_ctx *ctx, uint32_t hashlen, uint8_t *out);
 

cbits/crypton_blake2s.c

@@ -5,6 +5,11 @@ void crypton_blake2s_init(blake2s_ctx *ctx, uint32_t hashlen)
 	_crypton_blake2s_init(ctx, hashlen / 8);
 }
 
+void crypton_blake2s_init_key(blake2s_ctx *ctx, uint32_t hashlen, const uint8_t *key, size_t keylen)
+{
+	_crypton_blake2s_init_key(ctx, hashlen / 8, (const void *) key, keylen);
+}
+
 void crypton_blake2s_update(blake2s_ctx *ctx, const uint8_t *data, uint32_t len)
 {
 	_crypton_blake2s_update(ctx, data, len);

cbits/crypton_blake2s.h

@@ -6,6 +6,7 @@
 typedef blake2s_state blake2s_ctx;
 
 void crypton_blake2s_init(blake2s_ctx *ctx, uint32_t hashlen);
+void crypton_blake2s_init_key(blake2s_ctx *ctx, uint32_t hashlen, const uint8_t *key, size_t keylen);
 void crypton_blake2s_update(blake2s_ctx *ctx, const uint8_t *data, uint32_t len);
 void crypton_blake2s_finalize(blake2s_ctx *ctx, uint32_t hashlen, uint8_t *out);
 

cbits/crypton_blake2sp.c

@@ -5,6 +5,11 @@ void crypton_blake2sp_init(blake2sp_ctx *ctx, uint32_t hashlen)
 	_crypton_blake2sp_init(ctx, hashlen / 8);
 }
 
+void crypton_blake2sp_init_key(blake2sp_ctx *ctx, uint32_t hashlen, const uint8_t *key, size_t keylen)
+{
+	_crypton_blake2sp_init_key(ctx, hashlen / 8, (const void *) key, keylen);
+}
+
 void crypton_blake2sp_update(blake2sp_ctx *ctx, const uint8_t *data, uint32_t len)
 {
 	_crypton_blake2sp_update(ctx, data, len);

cbits/crypton_blake2sp.h

@@ -6,6 +6,7 @@
 typedef blake2sp_state blake2sp_ctx;
 
 void crypton_blake2sp_init(blake2sp_ctx *ctx, uint32_t hashlen);
+void crypton_blake2sp_init_key(blake2sp_ctx *ctx, uint32_t hashlen, const uint8_t *key, size_t keylen);
 void crypton_blake2sp_update(blake2sp_ctx *ctx, const uint8_t *data, uint32_t len);
 void crypton_blake2sp_finalize(blake2sp_ctx *ctx, uint32_t hashlen, uint8_t *out);
 

crypton.cabal

@@ -134,6 +134,7 @@ Library
                      Crypto.MAC.CMAC
                      Crypto.MAC.Poly1305
                      Crypto.MAC.HMAC
+                     Crypto.MAC.KeyedBlake2
                      Crypto.MAC.KMAC
                      Crypto.Number.Basic
                      Crypto.Number.F2m
@@ -432,6 +433,7 @@ Test-Suite test-crypton
                      KAT_Ed25519
                      KAT_Ed448
                      KAT_EdDSA
+                     KAT_Blake2
                      KAT_CMAC
                      KAT_HKDF
                      KAT_HMAC