-- |
-- Module : Crypto.MAC.HMAC
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- provide the HMAC (Hash based Message Authentification Code) base algorithm.
-- <http://en.wikipedia.org/wiki/HMAC>
--
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.MAC.HMAC
( hmac
, HMAC(..)
-- * incremental
, Context(..)
, initialize
, update
, updates
, finalize
) where
import Crypto.Hash hiding (Context)
import qualified Crypto.Hash as Hash (Context)
import Crypto.Hash.IO
import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Data.Memory.PtrMethods
import Crypto.Internal.Compat
import Crypto.Internal.Imports
-- | Represent an HMAC that is a phantom type with the hash used to produce the mac.
--
-- The Eq instance is constant time.
newtype HMAC a = HMAC { hmacGetDigest :: Digest a }
deriving (ByteArrayAccess)
instance Eq (HMAC a) where
(HMAC b1) == (HMAC b2) = B.constEq b1 b2
-- | compute a MAC using the supplied hashing function
hmac :: (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a)
=> key -- ^ Secret key
-> message -- ^ Message to MAC
-> HMAC a
hmac secret msg = finalize $ updates (initialize secret) [msg]
-- | Represent an ongoing HMAC state, that can be appended with 'update'
-- and finalize to an HMAC with 'hmacFinalize'
data Context hashalg = Context !(Hash.Context hashalg) !(Hash.Context hashalg)
-- | Initialize a new incremental HMAC context
initialize :: (ByteArrayAccess key, HashAlgorithm a)
=> key -- ^ Secret key
-> Context a
initialize secret = unsafeDoIO (doHashAlg undefined)
where
doHashAlg :: HashAlgorithm a => a -> IO (Context a)
doHashAlg alg = do
!withKey <- case B.length secret `compare` blockSize of
EQ -> return $ B.withByteArray secret
LT -> do key <- B.alloc blockSize $ \k -> do
memSet k 0 blockSize
B.withByteArray secret $ \s -> memCopy k s (B.length secret)
return $ B.withByteArray (key :: ScrubbedBytes)
GT -> do
-- hash the secret key
ctx <- hashMutableInitWith alg
hashMutableUpdate ctx secret
digest <- hashMutableFinalize ctx
hashMutableReset ctx
-- pad it if necessary
if digestSize < blockSize
then do
key <- B.alloc blockSize $ \k -> do
memSet k 0 blockSize
B.withByteArray digest $ \s -> memCopy k s (B.length digest)
return $ B.withByteArray (key :: ScrubbedBytes)
else
return $ B.withByteArray digest
(inner, outer) <- withKey $ \keyPtr ->
(,) <$> B.alloc blockSize (\p -> memXorWith p 0x36 keyPtr blockSize)
<*> B.alloc blockSize (\p -> memXorWith p 0x5c keyPtr blockSize)
return $ Context (hashUpdates initCtx [outer :: ScrubbedBytes])
(hashUpdates initCtx [inner :: ScrubbedBytes])
where
blockSize = hashBlockSize alg
digestSize = hashDigestSize alg
initCtx = hashInitWith alg
{-# NOINLINE initialize #-}
-- | Incrementally update a HMAC context
update :: (ByteArrayAccess message, HashAlgorithm a)
=> Context a -- ^ Current HMAC context
-> message -- ^ Message to append to the MAC
-> Context a -- ^ Updated HMAC context
update (Context octx ictx) msg =
Context octx (hashUpdate ictx msg)
-- | Increamentally update a HMAC context with multiple inputs
updates :: (ByteArrayAccess message, HashAlgorithm a)
=> Context a -- ^ Current HMAC context
-> [message] -- ^ Messages to append to the MAC
-> Context a -- ^ Updated HMAC context
updates (Context octx ictx) msgs =
Context octx (hashUpdates ictx msgs)
-- | Finalize a HMAC context and return the HMAC.
finalize :: HashAlgorithm a
=> Context a
-> HMAC a
finalize (Context octx ictx) =
HMAC $ hashFinalize $ hashUpdates octx [hashFinalize ictx]