1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
-- |
-- 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
, hmacLazy
, 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, ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Data.Memory.PtrMethods
import Crypto.Internal.Compat
import qualified Data.ByteString.Lazy as L
-- | Represent an HMAC 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 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]
-- | Compute a MAC using the supplied hashing function, for a lazy input
hmacLazy :: (ByteArrayAccess key, HashAlgorithm a)
=> key -- ^ Secret key
-> L.ByteString -- ^ Message to MAC
-> HMAC a
hmacLazy secret msg = finalize $ updates (initialize secret) (L.toChunks 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]
|
