-----------------------------------------------------------------------------
-- |
-- 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))