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
|
{-|
Maintainer: Thomas.DuBuisson@gmail.com
Stability: beta
Portability: portable
-}
module Crypto.HMAC
( hmac
, hmac'
, MacKey(..)
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Crypto.Classes
import Data.Serialize (encode)
import Data.Bits (xor)
-- | A key carrying phantom types @c@ and @d@, forcing the key data to only be used
-- by particular hash algorithms.
newtype MacKey c d = MacKey B.ByteString deriving (Eq, Ord, Show)
-- |Message authentication code calculation for lazy bytestrings.
-- @hmac k msg@ will compute an authentication code for @msg@ using key @k@
hmac :: (Hash c d) => MacKey c d -> L.ByteString -> d
hmac (MacKey k) msg = res
where
res = hash' . B.append ko . encode . f . L.append ki $ msg
f = hashFunc res
keylen = B.length k
blen = blockLength .::. res `div` 8
k' = case compare keylen blen of
GT -> B.append (encode . f . fc $ k) (B.replicate (blen - (outputLength .::. res `div` 8) ) 0x00)
EQ -> k
LT -> B.append k (B.replicate (blen - keylen) 0x00)
ko = B.map (`xor` 0x5c) k'
ki = fc $ B.map (`xor` 0x36) k'
fc = L.fromChunks . (\x -> [x])
-- | @hmac k msg@ will compute an authentication code for @msg@ using key @k@
hmac' :: (Hash c d) => MacKey c d -> B.ByteString -> d
hmac' k = hmac k . L.fromChunks . return
|
