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