{-|
 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 (MacKey c d -> MacKey c d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c d. MacKey c d -> MacKey c d -> Bool
/= :: MacKey c d -> MacKey c d -> Bool
$c/= :: forall c d. MacKey c d -> MacKey c d -> Bool
== :: MacKey c d -> MacKey c d -> Bool
$c== :: forall c d. MacKey c d -> MacKey c d -> Bool
Eq, MacKey c d -> MacKey c d -> Bool
MacKey c d -> MacKey c d -> Ordering
MacKey c d -> MacKey c d -> MacKey c d
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c d. Eq (MacKey c d)
forall c d. MacKey c d -> MacKey c d -> Bool
forall c d. MacKey c d -> MacKey c d -> Ordering
forall c d. MacKey c d -> MacKey c d -> MacKey c d
min :: MacKey c d -> MacKey c d -> MacKey c d
$cmin :: forall c d. MacKey c d -> MacKey c d -> MacKey c d
max :: MacKey c d -> MacKey c d -> MacKey c d
$cmax :: forall c d. MacKey c d -> MacKey c d -> MacKey c d
>= :: MacKey c d -> MacKey c d -> Bool
$c>= :: forall c d. MacKey c d -> MacKey c d -> Bool
> :: MacKey c d -> MacKey c d -> Bool
$c> :: forall c d. MacKey c d -> MacKey c d -> Bool
<= :: MacKey c d -> MacKey c d -> Bool
$c<= :: forall c d. MacKey c d -> MacKey c d -> Bool
< :: MacKey c d -> MacKey c d -> Bool
$c< :: forall c d. MacKey c d -> MacKey c d -> Bool
compare :: MacKey c d -> MacKey c d -> Ordering
$ccompare :: forall c d. MacKey c d -> MacKey c d -> Ordering
Ord, Int -> MacKey c d -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c d. Int -> MacKey c d -> ShowS
forall c d. [MacKey c d] -> ShowS
forall c d. MacKey c d -> String
showList :: [MacKey c d] -> ShowS
$cshowList :: forall c d. [MacKey c d] -> ShowS
show :: MacKey c d -> String
$cshow :: forall c d. MacKey c d -> String
showsPrec :: Int -> MacKey c d -> ShowS
$cshowsPrec :: forall c d. Int -> MacKey c d -> ShowS
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 :: forall c d. Hash c d => MacKey c d -> ByteString -> d
hmac (MacKey ByteString
k) ByteString
msg = d
res
  where
  res :: d
res = forall ctx d. (Hash ctx d, Hash ctx d) => ByteString -> d
hash' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
B.append ByteString
ko forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => a -> ByteString
encode  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> d
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
L.append ByteString
ki forall a b. (a -> b) -> a -> b
$ ByteString
msg
  f :: ByteString -> d
f = forall c d. Hash c d => d -> ByteString -> d
hashFunc d
res
  keylen :: Int
keylen = ByteString -> Int
B.length ByteString
k
  blen :: Int
blen = forall ctx d. Hash ctx d => Tagged d Int
blockLength forall a b. Tagged a b -> a -> b
.::. d
res forall a. Integral a => a -> a -> a
`div` Int
8
  k' :: ByteString
k' = case forall a. Ord a => a -> a -> Ordering
compare Int
keylen Int
blen of
         Ordering
GT -> ByteString -> ByteString -> ByteString
B.append (forall a. Serialize a => a -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> d
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fc forall a b. (a -> b) -> a -> b
$ ByteString
k) (Int -> Word8 -> ByteString
B.replicate (Int
blen forall a. Num a => a -> a -> a
- (forall ctx d. Hash ctx d => Tagged d Int
outputLength forall a b. Tagged a b -> a -> b
.::. d
res forall a. Integral a => a -> a -> a
`div` Int
8) ) Word8
0x00)
         Ordering
EQ -> ByteString
k
         Ordering
LT -> ByteString -> ByteString -> ByteString
B.append ByteString
k (Int -> Word8 -> ByteString
B.replicate (Int
blen forall a. Num a => a -> a -> a
- Int
keylen) Word8
0x00)
  ko :: ByteString
ko = (Word8 -> Word8) -> ByteString -> ByteString
B.map (forall a. Bits a => a -> a -> a
`xor` Word8
0x5c) ByteString
k'
  ki :: ByteString
ki = ByteString -> ByteString
fc forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> ByteString -> ByteString
B.map (forall a. Bits a => a -> a -> a
`xor` Word8
0x36) ByteString
k'
  fc :: ByteString -> ByteString
fc = [ByteString] -> ByteString
L.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ByteString
x -> [ByteString
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' :: forall c d. Hash c d => MacKey c d -> ByteString -> d
hmac' MacKey c d
k = forall c d. Hash c d => MacKey c d -> ByteString -> d
hmac MacKey c d
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return