1-- | 2-- Module : Crypto.MAC.HMAC 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- Provide the HMAC (Hash based Message Authentification Code) base algorithm. 9-- <http://en.wikipedia.org/wiki/HMAC> 10-- 11{-# LANGUAGE BangPatterns #-} 12{-# LANGUAGE GeneralizedNewtypeDeriving #-} 13module Crypto.MAC.HMAC 14 ( hmac 15 , HMAC(..) 16 -- * Incremental 17 , Context(..) 18 , initialize 19 , update 20 , updates 21 , finalize 22 ) where 23 24import Crypto.Hash hiding (Context) 25import qualified Crypto.Hash as Hash (Context) 26import Crypto.Hash.IO 27import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArrayAccess) 28import qualified Crypto.Internal.ByteArray as B 29import Data.Memory.PtrMethods 30import Crypto.Internal.Compat 31 32-- | Represent an HMAC that is a phantom type with the hash used to produce the mac. 33-- 34-- The Eq instance is constant time. No Show instance is provided, to avoid 35-- printing by mistake. 36newtype HMAC a = HMAC { hmacGetDigest :: Digest a } 37 deriving (ByteArrayAccess) 38 39instance Eq (HMAC a) where 40 (HMAC b1) == (HMAC b2) = B.constEq b1 b2 41 42-- | compute a MAC using the supplied hashing function 43hmac :: (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) 44 => key -- ^ Secret key 45 -> message -- ^ Message to MAC 46 -> HMAC a 47hmac secret msg = finalize $ updates (initialize secret) [msg] 48 49-- | Represent an ongoing HMAC state, that can be appended with 'update' 50-- and finalize to an HMAC with 'hmacFinalize' 51data Context hashalg = Context !(Hash.Context hashalg) !(Hash.Context hashalg) 52 53-- | Initialize a new incremental HMAC context 54initialize :: (ByteArrayAccess key, HashAlgorithm a) 55 => key -- ^ Secret key 56 -> Context a 57initialize secret = unsafeDoIO (doHashAlg undefined) 58 where 59 doHashAlg :: HashAlgorithm a => a -> IO (Context a) 60 doHashAlg alg = do 61 !withKey <- case B.length secret `compare` blockSize of 62 EQ -> return $ B.withByteArray secret 63 LT -> do key <- B.alloc blockSize $ \k -> do 64 memSet k 0 blockSize 65 B.withByteArray secret $ \s -> memCopy k s (B.length secret) 66 return $ B.withByteArray (key :: ScrubbedBytes) 67 GT -> do 68 -- hash the secret key 69 ctx <- hashMutableInitWith alg 70 hashMutableUpdate ctx secret 71 digest <- hashMutableFinalize ctx 72 hashMutableReset ctx 73 -- pad it if necessary 74 if digestSize < blockSize 75 then do 76 key <- B.alloc blockSize $ \k -> do 77 memSet k 0 blockSize 78 B.withByteArray digest $ \s -> memCopy k s (B.length digest) 79 return $ B.withByteArray (key :: ScrubbedBytes) 80 else 81 return $ B.withByteArray digest 82 (inner, outer) <- withKey $ \keyPtr -> 83 (,) <$> B.alloc blockSize (\p -> memXorWith p 0x36 keyPtr blockSize) 84 <*> B.alloc blockSize (\p -> memXorWith p 0x5c keyPtr blockSize) 85 return $ Context (hashUpdates initCtx [outer :: ScrubbedBytes]) 86 (hashUpdates initCtx [inner :: ScrubbedBytes]) 87 where 88 blockSize = hashBlockSize alg 89 digestSize = hashDigestSize alg 90 initCtx = hashInitWith alg 91{-# NOINLINE initialize #-} 92 93-- | Incrementally update a HMAC context 94update :: (ByteArrayAccess message, HashAlgorithm a) 95 => Context a -- ^ Current HMAC context 96 -> message -- ^ Message to append to the MAC 97 -> Context a -- ^ Updated HMAC context 98update (Context octx ictx) msg = 99 Context octx (hashUpdate ictx msg) 100 101-- | Increamentally update a HMAC context with multiple inputs 102updates :: (ByteArrayAccess message, HashAlgorithm a) 103 => Context a -- ^ Current HMAC context 104 -> [message] -- ^ Messages to append to the MAC 105 -> Context a -- ^ Updated HMAC context 106updates (Context octx ictx) msgs = 107 Context octx (hashUpdates ictx msgs) 108 109-- | Finalize a HMAC context and return the HMAC. 110finalize :: HashAlgorithm a 111 => Context a 112 -> HMAC a 113finalize (Context octx ictx) = 114 HMAC $ hashFinalize $ hashUpdates octx [hashFinalize ictx] 115