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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- 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>
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 (ByteArrayAccess, ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat
import qualified Data.ByteString.Lazy as L
import Data.Memory.PtrMethods
-- | 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]
|
