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
|
-----------------------------------------------------------------------------
-- |
-- Module : Data.HMAC
-- Copyright : (c) Greg Heartsfield 2007
-- License : BSD-style (see the file ReadMe.tex)
--
-- Implements HMAC (hashed message authentication code) as defined in FIPS 198
-- <http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf>.
--
-----------------------------------------------------------------------------
module Data.HMAC(
-- * Function Types
hmac, hmac_sha1, hmac_md5,
-- * Data Types
HashMethod(HashMethod, digest, input_blocksize),
) where
import Data.Digest.SHA1 as SHA1
import Data.Digest.MD5 as MD5
import Data.Word (Word32)
import Data.Bits (shiftR, xor, bitSize, Bits)
import Codec.Utils (Octet)
-- | HMAC works over any hash function, which is represented by
-- HashMethod. A hash function and input block size must
-- be specified.
data HashMethod =
HashMethod { -- | An arbitrary hash function
digest :: [Octet] -> [Octet],
-- | Bit size of an input block to the hash function
input_blocksize :: Int}
-- Some useful digest functions for use with HMAC.
sha1_hm = HashMethod (w160_to_w8s . SHA1.hash) 512
md5_hm = HashMethod MD5.hash 512
-- | Compute an HMAC using SHA-1 as the underlying hash function.
hmac_sha1 :: [Octet] -- ^ Secret key
-> [Octet] -- ^ Message text
-> [Octet] -- ^ Resulting HMAC-SHA1 value
hmac_sha1 = hmac sha1_hm
-- | Compute an HMAC using MD5 as the underlying hash function.
hmac_md5 :: [Octet] -- ^ Secret key
-> [Octet] -- ^ Message text
-> [Octet] -- ^ Resulting HMAC-MD5 value
hmac_md5 = hmac md5_hm
w160_to_w8s :: Word160 -> [Octet]
w160_to_w8s w = concat $ map w32_to_w8s (w160_to_w32s w)
w160_to_w32s :: Word160 -> [Word32]
w160_to_w32s (Word160 a b c d e) = a : b : c : d : e : []
w32_to_w8s :: Word32 -> [Octet]
w32_to_w8s a = (fromIntegral (shiftR a 24)) :
(fromIntegral (shiftR a 16)) :
(fromIntegral (shiftR a 8)) :
(fromIntegral a) : []
-- | Generalized function for creating HMACs on a specified
-- hash function.
hmac :: HashMethod -- ^ Hash function and associated block size
-> [Octet] -- ^ Secret key
-> [Octet] -- ^ Message text
-> [Octet] -- ^ Resulting HMAC value
hmac h uk m = hash (opad ++ (hash (ipad ++ m)))
where hash = digest h
(opad, ipad) = process_pads key
(make_start_pad bs opad_pattern)
(make_start_pad bs ipad_pattern)
bs = input_blocksize h
key = key_from_user h uk
-- Create a key of the proper size from the user-supplied key.
-- Keys greater than blocksize get hashed and padded with zeroes.
-- Keys same as blocksize are used as is.
-- Keys shorter than blocksize are padding with zeroes.
key_from_user :: HashMethod -> [Octet] -> [Octet]
key_from_user h uk =
case (compare (bitcount uk) (input_blocksize h)) of
GT -> fill_key ((digest h) uk)
LT -> fill_key uk
EQ -> uk
where fill_key kd =
kd ++ (take (((input_blocksize h) - (bitcount kd)) `div` 8)
(repeat 0x0))
-- Create the inner/outer pad values by XOR'ing with the key.
process_pads :: [Octet] -- Key
-> [Octet] -- opad
-> [Octet] -- ipad
-> ([Octet], [Octet]) -- new opad, new ipad
process_pads ks os is =
unzip $ zipWith3 (\k o i -> (k `xor` o, k `xor` i)) ks os is
-- Create padding values for a hash of a given bit size.
make_start_pad :: Int -> Octet -> [Octet]
make_start_pad size pad = take (size `div` (bitSize pad)) $ repeat pad
-- Padding constants, per the spec.
opad_pattern = 0x5c :: Octet
ipad_pattern = 0x36 :: Octet
-- Bit count of byte array.
bitcount :: [Octet] -> Int
bitcount k = (length k) * (bitSize (head k))
|
