-----------------------------------------------------------------------------
-- |
-- 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
                 HashMethod -> [Octet] -> [Octet]
digest :: [Octet] -> [Octet],
                -- | Bit size of an input block to the hash function
                 HashMethod -> Int
input_blocksize :: Int}

-- Some useful digest functions for use with HMAC.

sha1_hm :: HashMethod
sha1_hm = ([Octet] -> [Octet]) -> Int -> HashMethod
HashMethod (Word160 -> [Octet]
w160_to_w8s forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Octet] -> Word160
SHA1.hash) Int
512
md5_hm :: HashMethod
md5_hm = ([Octet] -> [Octet]) -> Int -> HashMethod
HashMethod [Octet] -> [Octet]
MD5.hash Int
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 :: [Octet] -> [Octet] -> [Octet]
hmac_sha1 = HashMethod -> [Octet] -> [Octet] -> [Octet]
hmac HashMethod
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 :: [Octet] -> [Octet] -> [Octet]
hmac_md5 = HashMethod -> [Octet] -> [Octet] -> [Octet]
hmac HashMethod
md5_hm

w160_to_w8s :: Word160 -> [Octet]
w160_to_w8s :: Word160 -> [Octet]
w160_to_w8s Word160
w = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Word32 -> [Octet]
w32_to_w8s (Word160 -> [Word32]
w160_to_w32s Word160
w)

w160_to_w32s :: Word160 -> [Word32]
w160_to_w32s :: Word160 -> [Word32]
w160_to_w32s (Word160 Word32
a Word32
b Word32
c Word32
d Word32
e) = Word32
a forall a. a -> [a] -> [a]
: Word32
b forall a. a -> [a] -> [a]
: Word32
c forall a. a -> [a] -> [a]
: Word32
d forall a. a -> [a] -> [a]
: Word32
e forall a. a -> [a] -> [a]
: []

w32_to_w8s :: Word32 -> [Octet]
w32_to_w8s :: Word32 -> [Octet]
w32_to_w8s Word32
a = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
a Int
24)) forall a. a -> [a] -> [a]
:
               (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
a Int
16)) forall a. a -> [a] -> [a]
:
               (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
a Int
8)) forall a. a -> [a] -> [a]
:
               (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a) forall a. a -> [a] -> [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 :: HashMethod -> [Octet] -> [Octet] -> [Octet]
hmac HashMethod
h [Octet]
uk [Octet]
m = [Octet] -> [Octet]
hash ([Octet]
opad forall a. [a] -> [a] -> [a]
++ ([Octet] -> [Octet]
hash ([Octet]
ipad forall a. [a] -> [a] -> [a]
++ [Octet]
m)))
    where hash :: [Octet] -> [Octet]
hash = HashMethod -> [Octet] -> [Octet]
digest HashMethod
h
          ([Octet]
opad, [Octet]
ipad) = [Octet] -> [Octet] -> [Octet] -> ([Octet], [Octet])
process_pads [Octet]
key
                           (Int -> Octet -> [Octet]
make_start_pad Int
bs Octet
opad_pattern)
                           (Int -> Octet -> [Octet]
make_start_pad Int
bs Octet
ipad_pattern)
          bs :: Int
bs = HashMethod -> Int
input_blocksize HashMethod
h
          key :: [Octet]
key = HashMethod -> [Octet] -> [Octet]
key_from_user HashMethod
h [Octet]
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 :: HashMethod -> [Octet] -> [Octet]
key_from_user HashMethod
h [Octet]
uk =
    case (forall a. Ord a => a -> a -> Ordering
compare ([Octet] -> Int
bitcount [Octet]
uk) (HashMethod -> Int
input_blocksize HashMethod
h)) of
      Ordering
GT -> [Octet] -> [Octet]
fill_key ((HashMethod -> [Octet] -> [Octet]
digest HashMethod
h) [Octet]
uk)
      Ordering
LT -> [Octet] -> [Octet]
fill_key [Octet]
uk
      Ordering
EQ -> [Octet]
uk
    where fill_key :: [Octet] -> [Octet]
fill_key [Octet]
kd =
              [Octet]
kd forall a. [a] -> [a] -> [a]
++ (forall a. Int -> [a] -> [a]
take (((HashMethod -> Int
input_blocksize HashMethod
h) forall a. Num a => a -> a -> a
- ([Octet] -> Int
bitcount [Octet]
kd)) forall a. Integral a => a -> a -> a
`div` Int
8)
                     (forall a. a -> [a]
repeat Octet
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 :: [Octet] -> [Octet] -> [Octet] -> ([Octet], [Octet])
process_pads [Octet]
ks [Octet]
os [Octet]
is =
    forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Octet
k Octet
o Octet
i -> (Octet
k forall a. Bits a => a -> a -> a
`xor` Octet
o, Octet
k forall a. Bits a => a -> a -> a
`xor` Octet
i)) [Octet]
ks [Octet]
os [Octet]
is

-- Create padding values for a hash of a given bit size.

make_start_pad :: Int -> Octet -> [Octet]
make_start_pad :: Int -> Octet -> [Octet]
make_start_pad Int
size Octet
pad = forall a. Int -> [a] -> [a]
take (Int
size forall a. Integral a => a -> a -> a
`div` (forall a. Bits a => a -> Int
bitSize Octet
pad)) forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat Octet
pad

-- Padding constants, per the spec.

opad_pattern :: Octet
opad_pattern = Octet
0x5c :: Octet
ipad_pattern :: Octet
ipad_pattern = Octet
0x36 :: Octet

-- Bit count of byte array.

bitcount :: [Octet] -> Int
bitcount :: [Octet] -> Int
bitcount [Octet]
k = (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Octet]
k) forall a. Num a => a -> a -> a
* (forall a. Bits a => a -> Int
bitSize (forall a. [a] -> a
head [Octet]
k))