92 lines
3.2 KiB
Haskell
92 lines
3.2 KiB
Haskell
-- |
|
|
-- 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 #-}
|
|
module Crypto.MAC.HMAC
|
|
( hmac
|
|
, HMAC(..)
|
|
-- * incremental
|
|
, Context(..)
|
|
, initialize
|
|
, update
|
|
, finalize
|
|
) where
|
|
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.ByteString as B
|
|
import Data.Bits (xor)
|
|
import Data.Byteable
|
|
import Crypto.Hash hiding (Context)
|
|
import qualified Crypto.Hash as Hash (Context)
|
|
|
|
-- | 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 }
|
|
|
|
instance Byteable (HMAC a) where
|
|
toBytes (HMAC b) = toBytes b
|
|
|
|
instance Eq (HMAC a) where
|
|
(HMAC b1) == (HMAC b2) = constEqBytes (toBytes b1) (toBytes b2)
|
|
|
|
-- | compute a MAC using the supplied hashing function
|
|
hmac :: (Byteable key, HashAlgorithm a)
|
|
=> key -- ^ Secret key
|
|
-> ByteString -- ^ Message to MAC
|
|
-> HMAC a
|
|
hmac secret msg = doHMAC hashInit
|
|
where doHMAC :: HashAlgorithm a => Hash.Context a -> HMAC a
|
|
doHMAC !ctxInit = HMAC $ hashF $ B.append opad (toBytes $ hashF $ B.append ipad msg)
|
|
where opad = B.map (xor 0x5c) k'
|
|
ipad = B.map (xor 0x36) k'
|
|
|
|
k' = B.append kt pad
|
|
kt = if byteableLength secret > fromIntegral blockSize then toBytes (hashF (toBytes secret)) else toBytes secret
|
|
pad = B.replicate (fromIntegral blockSize - B.length kt) 0
|
|
hashF = hashFinalize . hashUpdate ctxInit
|
|
blockSize = hashBlockSize ctxInit
|
|
|
|
-- | Represent an ongoing HMAC state, that can be appended with 'hmacUpdate'
|
|
-- and finalize to an HMAC with 'hmacFinalize'
|
|
data Context hashalg = Context !(Hash.Context hashalg) !(Hash.Context hashalg)
|
|
|
|
-- | Initialize a new incremental HMAC context
|
|
initialize :: (Byteable key, HashAlgorithm a)
|
|
=> key -- ^ Secret key
|
|
-> Context a
|
|
initialize secret = Context octx ictx
|
|
where ictx = hashUpdates ctxInit [ipad]
|
|
octx = hashUpdates ctxInit [opad]
|
|
ipad = B.map (xor 0x36) k'
|
|
opad = B.map (xor 0x5c) k'
|
|
|
|
k' = B.append kt pad
|
|
kt = if byteableLength secret > fromIntegral blockSize then toBytes (hashF (toBytes secret)) else toBytes secret
|
|
pad = B.replicate (fromIntegral blockSize - B.length kt) 0
|
|
hashF = hashFinalize . hashUpdate ctxInit
|
|
blockSize = hashBlockSize ctxInit
|
|
!ctxInit = hashInit
|
|
|
|
-- | Incrementally update a HMAC context
|
|
update :: HashAlgorithm a
|
|
=> Context a -- ^ Current HMAC context
|
|
-> ByteString -- ^ Message to Mac
|
|
-> Context a -- ^ Updated HMAC context
|
|
update (Context octx ictx) msg =
|
|
Context octx (hashUpdate ictx msg)
|
|
|
|
-- | Finalize a HMAC context and return the HMAC.
|
|
finalize :: HashAlgorithm a
|
|
=> Context a
|
|
-> HMAC a
|
|
finalize (Context octx ictx) =
|
|
HMAC $ hashFinalize $ hashUpdates octx [toBytes $ hashFinalize ictx]
|