-- |The HMAC construction for a cryptographic hash

{-# LANGUAGE CPP                        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE ConstraintKinds            #-}
module Raaz.Hash.Internal.HMAC
       ( HMAC (..)
         -- * Combinators for computing HMACs
       , hmac, hmacFile, hmacSource
         -- ** Computing HMACs using non-standard implementations.
       , hmac', hmacFile', hmacSource'
       ) where

import           Control.Applicative
import           Control.Monad.IO.Class    (liftIO)
import           Data.Bits                 (xor)
import           Data.ByteString.Char8     (ByteString)
import qualified Data.ByteString           as B
import qualified Data.ByteString.Lazy      as L
import           Data.Monoid
import           Data.String
import           Data.Word
import           Foreign.Ptr               ( castPtr      )
import           Foreign.Storable          ( Storable(..) )
import           Prelude                   hiding (length, replicate)
import           System.IO
import           System.IO.Unsafe     (unsafePerformIO)

import           Raaz.Core          hiding (alignment)
import           Raaz.Core.Parse.Applicative
import           Raaz.Core.Transfer
import           Raaz.Random

import           Raaz.Hash.Internal

--------------------------- The HMAC Key -----------------------------

-- | The HMAC key type. The HMAC keys are usually of size at most the
-- block size of the associated hash, although the hmac construction
-- allows using keys arbitrary size. Using keys of small size, in
-- particular smaller than the size of the corresponding hash, can can
-- compromise security.
--
-- == A note on `Show` and `IsString` instances of keys.
--
-- As any other cryptographic type HMAC keys also have a `IsString`
-- and `Show` instance which is essentially the key expressed in
-- base16.  Keys larger than the block size of the underlying hashes
-- are shortened by applying the appropriate hash. As a result the
-- `show` and `fromString` need not be inverses of each other.
--
newtype HMACKey h = HMACKey { HMACKey h -> ByteString
unKey :: B.ByteString }
#if MIN_VERSION_base(4,11,0)
                 deriving (b -> HMACKey h -> HMACKey h
NonEmpty (HMACKey h) -> HMACKey h
HMACKey h -> HMACKey h -> HMACKey h
(HMACKey h -> HMACKey h -> HMACKey h)
-> (NonEmpty (HMACKey h) -> HMACKey h)
-> (forall b. Integral b => b -> HMACKey h -> HMACKey h)
-> Semigroup (HMACKey h)
forall b. Integral b => b -> HMACKey h -> HMACKey h
forall h. NonEmpty (HMACKey h) -> HMACKey h
forall h. HMACKey h -> HMACKey h -> HMACKey h
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall h b. Integral b => b -> HMACKey h -> HMACKey h
stimes :: b -> HMACKey h -> HMACKey h
$cstimes :: forall h b. Integral b => b -> HMACKey h -> HMACKey h
sconcat :: NonEmpty (HMACKey h) -> HMACKey h
$csconcat :: forall h. NonEmpty (HMACKey h) -> HMACKey h
<> :: HMACKey h -> HMACKey h -> HMACKey h
$c<> :: forall h. HMACKey h -> HMACKey h -> HMACKey h
Semigroup, Semigroup (HMACKey h)
HMACKey h
Semigroup (HMACKey h)
-> HMACKey h
-> (HMACKey h -> HMACKey h -> HMACKey h)
-> ([HMACKey h] -> HMACKey h)
-> Monoid (HMACKey h)
[HMACKey h] -> HMACKey h
HMACKey h -> HMACKey h -> HMACKey h
forall h. Semigroup (HMACKey h)
forall h. HMACKey h
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall h. [HMACKey h] -> HMACKey h
forall h. HMACKey h -> HMACKey h -> HMACKey h
mconcat :: [HMACKey h] -> HMACKey h
$cmconcat :: forall h. [HMACKey h] -> HMACKey h
mappend :: HMACKey h -> HMACKey h -> HMACKey h
$cmappend :: forall h. HMACKey h -> HMACKey h -> HMACKey h
mempty :: HMACKey h
$cmempty :: forall h. HMACKey h
$cp1Monoid :: forall h. Semigroup (HMACKey h)
Monoid)
#else
                 deriving Monoid
#endif

instance (Hash h, Recommendation h) => Storable (HMACKey h) where

  sizeOf :: HMACKey h -> Int
sizeOf    HMACKey h
_  = BYTES Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BYTES Int -> Int) -> BYTES Int -> Int
forall a b. (a -> b) -> a -> b
$ h -> BYTES Int
forall p. Primitive p => p -> BYTES Int
blockSize (h
forall a. HasCallStack => a
undefined :: h)

  alignment :: HMACKey h -> Int
alignment HMACKey h
_  = Word8 -> Int
forall a. Storable a => a -> Int
alignment (Word8
forall a. HasCallStack => a
undefined :: Word8)

  peek :: Ptr (HMACKey h) -> IO (HMACKey h)
peek         = Parser (HMACKey h) -> Pointer -> IO (HMACKey h)
forall a. Parser a -> Pointer -> IO a
unsafeRunParser (ByteString -> HMACKey h
forall h. ByteString -> HMACKey h
HMACKey (ByteString -> HMACKey h)
-> TwistRF ParseAction (BYTES Int) ByteString -> Parser (HMACKey h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BYTES Int -> TwistRF ParseAction (BYTES Int) ByteString
forall l.
LengthUnit l =>
l -> TwistRF ParseAction (BYTES Int) ByteString
parseByteString (h -> BYTES Int
forall p. Primitive p => p -> BYTES Int
blockSize (h
forall a. HasCallStack => a
undefined :: h))) (Pointer -> IO (HMACKey h))
-> (Ptr (HMACKey h) -> Pointer)
-> Ptr (HMACKey h)
-> IO (HMACKey h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (HMACKey h) -> Pointer
forall a b. Ptr a -> Ptr b
castPtr

  poke :: Ptr (HMACKey h) -> HMACKey h -> IO ()
poke Ptr (HMACKey h)
ptr HMACKey h
key = WriteM IO -> Pointer -> IO ()
forall (m :: * -> *). WriteM m -> Pointer -> m ()
unsafeWrite (ByteString -> WriteM IO
forall (m :: * -> *). MonadIO m => ByteString -> WriteM m
writeByteString (ByteString -> WriteM IO) -> ByteString -> WriteM IO
forall a b. (a -> b) -> a -> b
$ HMACKey h -> ByteString
forall h.
(Hash h, Recommendation h, Encodable h) =>
HMACKey h -> ByteString
hmacAdjustKey HMACKey h
key) (Pointer -> IO ()) -> Pointer -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (HMACKey h) -> Pointer
forall a b. Ptr a -> Ptr b
castPtr Ptr (HMACKey h)
ptr

hmacAdjustKey :: (Hash h, Recommendation h, Encodable h)
              => HMACKey h -- ^ the key.
              -> ByteString
hmacAdjustKey :: HMACKey h -> ByteString
hmacAdjustKey HMACKey h
key = ByteString -> ByteString
padIt ByteString
trimedKey
  where keyStr :: ByteString
keyStr      = HMACKey h -> ByteString
forall h. HMACKey h -> ByteString
unKey HMACKey h
key
        trimedKey :: ByteString
trimedKey   = if ByteString -> BYTES Int
length ByteString
keyStr BYTES Int -> BYTES Int -> Bool
forall a. Ord a => a -> a -> Bool
> BYTES Int
sz
                      then h -> ByteString
forall a. Encodable a => a -> ByteString
toByteString
                           (h -> ByteString) -> h -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> h
forall h src.
(Hash h, Recommendation h, PureByteSource src) =>
src -> h
hash ByteString
keyStr h -> h -> h
forall a. a -> a -> a
`asTypeOf` HMACKey h -> h
forall h. HMACKey h -> h
theHash HMACKey h
key
                      else ByteString
keyStr
        padIt :: ByteString -> ByteString
padIt ByteString
k     = ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> BYTES Int -> Word8 -> ByteString
forall l. LengthUnit l => l -> Word8 -> ByteString
replicate (BYTES Int
sz BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
- ByteString -> BYTES Int
length ByteString
k) Word8
0
        sz :: BYTES Int
sz          = h -> BYTES Int
forall p. Primitive p => p -> BYTES Int
blockSize (h -> BYTES Int) -> h -> BYTES Int
forall a b. (a -> b) -> a -> b
$ HMACKey h -> h
forall h. HMACKey h -> h
theHash HMACKey h
key
        theHash     :: HMACKey h -> h
        theHash :: HMACKey h -> h
theHash  HMACKey h
_  = h
forall a. HasCallStack => a
undefined

-- The HMACKey is just stored as a binary data.
instance (Hash h, Recommendation h) => EndianStore (HMACKey h) where
  store :: Ptr (HMACKey h) -> HMACKey h -> IO ()
store            = Ptr (HMACKey h) -> HMACKey h -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke
  load :: Ptr (HMACKey h) -> IO (HMACKey h)
load             = Ptr (HMACKey h) -> IO (HMACKey h)
forall a. Storable a => Ptr a -> IO a
peek
  adjustEndian :: Ptr (HMACKey h) -> Int -> IO ()
adjustEndian Ptr (HMACKey h)
_ Int
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance (Hash h, Recommendation h) => RandomStorable (HMACKey h) where
  fillRandomElements :: Int -> Ptr (HMACKey h) -> RT mem ()
fillRandomElements = Int -> Ptr (HMACKey h) -> RT mem ()
forall mem a. (Memory mem, Storable a) => Int -> Ptr a -> RT mem ()
unsafeFillRandomElements

instance (Hash h, Recommendation h) => Encodable (HMACKey h)

-- | Base16 representation of the string.
instance IsString (HMACKey h) where
  fromString :: String -> HMACKey h
fromString = ByteString -> HMACKey h
forall h. ByteString -> HMACKey h
HMACKey
               (ByteString -> HMACKey h)
-> (String -> ByteString) -> String -> HMACKey h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base16 -> ByteString
forall fmt. Format fmt => fmt -> ByteString
decodeFormat :: Base16 -> ByteString)
               (Base16 -> ByteString)
-> (String -> Base16) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Base16
forall a. IsString a => String -> a
fromString

instance Show (HMACKey h) where
  show :: HMACKey h -> String
show = Base16 -> String
forall a. Show a => a -> String
show (Base16 -> String) -> (HMACKey h -> Base16) -> HMACKey h -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Base16
forall fmt. Format fmt => ByteString -> fmt
encodeByteString :: ByteString -> Base16) (ByteString -> Base16)
-> (HMACKey h -> ByteString) -> HMACKey h -> Base16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HMACKey h -> ByteString
forall h. HMACKey h -> ByteString
unKey

----------------  The HMAC type -----------------------------------------

-- | The HMAC associated to a hash value. The HMAC type is essentially
-- the underlying hash type wrapped inside a newtype. Therefore, the
-- `Eq` instance for HMAC is essentially the `Eq` instance for the
-- underlying hash. It is safe against timing attack provided the
-- underlying hash comparison is safe under timing attack.
newtype HMAC h = HMAC {HMAC h -> h
unHMAC :: h} deriving ( HMAC h -> HMAC h -> Bool
(HMAC h -> HMAC h -> Bool)
-> (HMAC h -> HMAC h -> Bool) -> Eq (HMAC h)
forall h. Eq h => HMAC h -> HMAC h -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HMAC h -> HMAC h -> Bool
$c/= :: forall h. Eq h => HMAC h -> HMAC h -> Bool
== :: HMAC h -> HMAC h -> Bool
$c== :: forall h. Eq h => HMAC h -> HMAC h -> Bool
Eq, Ptr b -> Int -> IO (HMAC h)
Ptr b -> Int -> HMAC h -> IO ()
Ptr (HMAC h) -> IO (HMAC h)
Ptr (HMAC h) -> Int -> IO (HMAC h)
Ptr (HMAC h) -> Int -> HMAC h -> IO ()
Ptr (HMAC h) -> HMAC h -> IO ()
HMAC h -> Int
(HMAC h -> Int)
-> (HMAC h -> Int)
-> (Ptr (HMAC h) -> Int -> IO (HMAC h))
-> (Ptr (HMAC h) -> Int -> HMAC h -> IO ())
-> (forall b. Ptr b -> Int -> IO (HMAC h))
-> (forall b. Ptr b -> Int -> HMAC h -> IO ())
-> (Ptr (HMAC h) -> IO (HMAC h))
-> (Ptr (HMAC h) -> HMAC h -> IO ())
-> Storable (HMAC h)
forall b. Ptr b -> Int -> IO (HMAC h)
forall b. Ptr b -> Int -> HMAC h -> IO ()
forall h. Storable h => Ptr (HMAC h) -> IO (HMAC h)
forall h. Storable h => Ptr (HMAC h) -> Int -> IO (HMAC h)
forall h. Storable h => Ptr (HMAC h) -> Int -> HMAC h -> IO ()
forall h. Storable h => Ptr (HMAC h) -> HMAC h -> IO ()
forall h. Storable h => HMAC h -> Int
forall h b. Storable h => Ptr b -> Int -> IO (HMAC h)
forall h b. Storable h => Ptr b -> Int -> HMAC h -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (HMAC h) -> HMAC h -> IO ()
$cpoke :: forall h. Storable h => Ptr (HMAC h) -> HMAC h -> IO ()
peek :: Ptr (HMAC h) -> IO (HMAC h)
$cpeek :: forall h. Storable h => Ptr (HMAC h) -> IO (HMAC h)
pokeByteOff :: Ptr b -> Int -> HMAC h -> IO ()
$cpokeByteOff :: forall h b. Storable h => Ptr b -> Int -> HMAC h -> IO ()
peekByteOff :: Ptr b -> Int -> IO (HMAC h)
$cpeekByteOff :: forall h b. Storable h => Ptr b -> Int -> IO (HMAC h)
pokeElemOff :: Ptr (HMAC h) -> Int -> HMAC h -> IO ()
$cpokeElemOff :: forall h. Storable h => Ptr (HMAC h) -> Int -> HMAC h -> IO ()
peekElemOff :: Ptr (HMAC h) -> Int -> IO (HMAC h)
$cpeekElemOff :: forall h. Storable h => Ptr (HMAC h) -> Int -> IO (HMAC h)
alignment :: HMAC h -> Int
$calignment :: forall h. Storable h => HMAC h -> Int
sizeOf :: HMAC h -> Int
$csizeOf :: forall h. Storable h => HMAC h -> Int
Storable
                                             , Storable (HMAC h)
Ptr (HMAC h) -> IO (HMAC h)
Ptr (HMAC h) -> Int -> IO ()
Ptr (HMAC h) -> HMAC h -> IO ()
Storable (HMAC h)
-> (Ptr (HMAC h) -> HMAC h -> IO ())
-> (Ptr (HMAC h) -> IO (HMAC h))
-> (Ptr (HMAC h) -> Int -> IO ())
-> EndianStore (HMAC h)
forall w.
Storable w
-> (Ptr w -> w -> IO ())
-> (Ptr w -> IO w)
-> (Ptr w -> Int -> IO ())
-> EndianStore w
forall h. EndianStore h => Storable (HMAC h)
forall h. EndianStore h => Ptr (HMAC h) -> IO (HMAC h)
forall h. EndianStore h => Ptr (HMAC h) -> Int -> IO ()
forall h. EndianStore h => Ptr (HMAC h) -> HMAC h -> IO ()
adjustEndian :: Ptr (HMAC h) -> Int -> IO ()
$cadjustEndian :: forall h. EndianStore h => Ptr (HMAC h) -> Int -> IO ()
load :: Ptr (HMAC h) -> IO (HMAC h)
$cload :: forall h. EndianStore h => Ptr (HMAC h) -> IO (HMAC h)
store :: Ptr (HMAC h) -> HMAC h -> IO ()
$cstore :: forall h. EndianStore h => Ptr (HMAC h) -> HMAC h -> IO ()
$cp1EndianStore :: forall h. EndianStore h => Storable (HMAC h)
EndianStore
                                             , ByteString -> Maybe (HMAC h)
ByteString -> HMAC h
HMAC h -> ByteString
(HMAC h -> ByteString)
-> (ByteString -> Maybe (HMAC h))
-> (ByteString -> HMAC h)
-> Encodable (HMAC h)
forall h. Encodable h => ByteString -> Maybe (HMAC h)
forall h. Encodable h => ByteString -> HMAC h
forall h. Encodable h => HMAC h -> ByteString
forall a.
(a -> ByteString)
-> (ByteString -> Maybe a) -> (ByteString -> a) -> Encodable a
unsafeFromByteString :: ByteString -> HMAC h
$cunsafeFromByteString :: forall h. Encodable h => ByteString -> HMAC h
fromByteString :: ByteString -> Maybe (HMAC h)
$cfromByteString :: forall h. Encodable h => ByteString -> Maybe (HMAC h)
toByteString :: HMAC h -> ByteString
$ctoByteString :: forall h. Encodable h => HMAC h -> ByteString
Encodable
                                             , String -> HMAC h
(String -> HMAC h) -> IsString (HMAC h)
forall h. IsString h => String -> HMAC h
forall a. (String -> a) -> IsString a
fromString :: String -> HMAC h
$cfromString :: forall h. IsString h => String -> HMAC h
IsString
                                             )
instance Show h => Show (HMAC h) where
  show :: HMAC h -> String
show  = h -> String
forall a. Show a => a -> String
show (h -> String) -> (HMAC h -> h) -> HMAC h -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HMAC h -> h
forall h. HMAC h -> h
unHMAC


type instance  Key (HMAC h) = HMACKey h

-- | Compute the hash of a pure byte source like, `B.ByteString`.
hmac :: ( Hash h, Recommendation h, PureByteSource src )
     => Key (HMAC h)
     -> src  -- ^ Message
     -> HMAC h
hmac :: Key (HMAC h) -> src -> HMAC h
hmac Key (HMAC h)
key = IO (HMAC h) -> HMAC h
forall a. IO a -> a
unsafePerformIO (IO (HMAC h) -> HMAC h) -> (src -> IO (HMAC h)) -> src -> HMAC h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key (HMAC h) -> src -> IO (HMAC h)
forall h src.
(Hash h, Recommendation h, ByteSource src) =>
Key (HMAC h) -> src -> IO (HMAC h)
hmacSource Key (HMAC h)
key
{-# INLINEABLE hmac #-}
{-# SPECIALIZE hmac :: (Hash h, Recommendation h) => Key (HMAC h) -> B.ByteString -> HMAC h #-}
{-# SPECIALIZE hmac :: (Hash h, Recommendation h) => Key (HMAC h) -> L.ByteString -> HMAC h #-}

-- | Compute the hmac of file.
hmacFile :: (Hash h, Recommendation h)
         => Key (HMAC h) -- ^ Key to use for mac-ing
         -> FilePath     -- ^ File to be hashed
         -> IO (HMAC h)
hmacFile :: Key (HMAC h) -> String -> IO (HMAC h)
hmacFile Key (HMAC h)
key String
fileName = String -> IOMode -> (Handle -> IO (HMAC h)) -> IO (HMAC h)
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
fileName IOMode
ReadMode ((Handle -> IO (HMAC h)) -> IO (HMAC h))
-> (Handle -> IO (HMAC h)) -> IO (HMAC h)
forall a b. (a -> b) -> a -> b
$ Key (HMAC h) -> Handle -> IO (HMAC h)
forall h src.
(Hash h, Recommendation h, ByteSource src) =>
Key (HMAC h) -> src -> IO (HMAC h)
hmacSource Key (HMAC h)
key
{-# INLINEABLE hmacFile #-}

-- | Compute the hmac of a generic byte source.
hmacSource :: ( Hash h, Recommendation h, ByteSource src )
           => Key (HMAC h)  -- ^ key to use for mac-ing.
           -> src           -- ^ Message
           -> IO (HMAC h)
hmacSource :: Key (HMAC h) -> src -> IO (HMAC h)
hmacSource = h -> Key (HMAC h) -> src -> IO (HMAC h)
forall h src.
(Hash h, Recommendation h, ByteSource src) =>
h -> Key (HMAC h) -> src -> IO (HMAC h)
go h
forall a. HasCallStack => a
undefined
  where go :: (Hash h, Recommendation h, ByteSource src)
              => h -> Key (HMAC h) -> src -> IO (HMAC h)
        go :: h -> Key (HMAC h) -> src -> IO (HMAC h)
go h
h = Implementation h -> Key (HMAC h) -> src -> IO (HMAC h)
forall h src.
(Hash h, Recommendation h, ByteSource src) =>
Implementation h -> Key (HMAC h) -> src -> IO (HMAC h)
hmacSource' (h -> Implementation h
forall p. Recommendation p => p -> Implementation p
recommended h
h)

{-# INLINEABLE hmacSource #-}
{-# SPECIALIZE hmacSource :: (Hash h, Recommendation h) => Key (HMAC h) -> Handle -> IO (HMAC h) #-}


-- | Compute the hmac of a pure byte source like, `B.ByteString`.
hmac' :: ( Hash h, Recommendation h, PureByteSource src )
      => Implementation h
      -> Key (HMAC h)
      -> src  -- ^ Message
      -> HMAC h
hmac' :: Implementation h -> Key (HMAC h) -> src -> HMAC h
hmac' Implementation h
impl Key (HMAC h)
key = IO (HMAC h) -> HMAC h
forall a. IO a -> a
unsafePerformIO (IO (HMAC h) -> HMAC h) -> (src -> IO (HMAC h)) -> src -> HMAC h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Implementation h -> Key (HMAC h) -> src -> IO (HMAC h)
forall h src.
(Hash h, Recommendation h, ByteSource src) =>
Implementation h -> Key (HMAC h) -> src -> IO (HMAC h)
hmacSource' Implementation h
impl Key (HMAC h)
key
{-# INLINEABLE hmac' #-}
{-# SPECIALIZE hmac' :: (Hash h, Recommendation h)
                     => Implementation h
                     -> Key (HMAC h)
                     -> B.ByteString
                     -> HMAC h
  #-}
{-# SPECIALIZE hmac' :: (Hash h, Recommendation h)
                     => Implementation h
                     -> Key (HMAC h)
                     -> L.ByteString
                     -> HMAC h
  #-}


-- | Compute the hmac of file.
hmacFile' :: (Hash h, Recommendation h)
         => Implementation h
         -> Key (HMAC h)
         -> FilePath  -- ^ File to be hashed
         -> IO (HMAC h)
hmacFile' :: Implementation h -> Key (HMAC h) -> String -> IO (HMAC h)
hmacFile' Implementation h
impl Key (HMAC h)
key String
fileName = String -> IOMode -> (Handle -> IO (HMAC h)) -> IO (HMAC h)
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
fileName IOMode
ReadMode ((Handle -> IO (HMAC h)) -> IO (HMAC h))
-> (Handle -> IO (HMAC h)) -> IO (HMAC h)
forall a b. (a -> b) -> a -> b
$ Implementation h -> Key (HMAC h) -> Handle -> IO (HMAC h)
forall h src.
(Hash h, Recommendation h, ByteSource src) =>
Implementation h -> Key (HMAC h) -> src -> IO (HMAC h)
hmacSource' Implementation h
impl Key (HMAC h)
key
{-# INLINEABLE hmacFile' #-}

-- | Compute the hmac of a generic ByteSource using a given implementation.
hmacSource' :: (Hash h, Recommendation h, ByteSource src)
            => Implementation h
            -> Key (HMAC h)
            -> src
            -> IO (HMAC h)
hmacSource' :: Implementation h -> Key (HMAC h) -> src -> IO (HMAC h)
hmacSource' imp :: Implementation h
imp@(SomeHashI hI) Key (HMAC h)
key src
src =
  MT m (HMAC h) -> IO (HMAC h)
forall (mT :: * -> * -> *) mem a.
(MemoryThread mT, Memory mem) =>
mT mem a -> IO a
insecurely (MT m (HMAC h) -> IO (HMAC h)) -> MT m (HMAC h) -> IO (HMAC h)
forall a b. (a -> b) -> a -> b
$ do

    -- Hash the first block for the inner hash
    () -> MT m ()
forall m v. Initialisable m v => v -> MT m ()
initialise ()
    PointerAction (MT m) () ()
allocate PointerAction (MT m) () () -> PointerAction (MT m) () ()
forall a b. (a -> b) -> a -> b
$ \ Pointer
ptr -> do
      IO () -> MT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MT m ()) -> IO () -> MT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Pointer -> IO ()
unsafeCopyToPointer ByteString
innerFirstBlock Pointer
ptr
      HashI h m -> Pointer -> BLOCKS h -> MT m ()
forall h m. HashI h m -> Pointer -> BLOCKS h -> MT m ()
compress HashI h m
hI Pointer
ptr (BLOCKS h -> MT m ()) -> BLOCKS h -> MT m ()
forall a b. (a -> b) -> a -> b
$ Int -> BLOCKS h
forall a. Enum a => Int -> a
toEnum Int
1

    -- Finish it by hashing the source.
    h
innerHash <- HashI h m -> src -> MT m h
forall h src m.
(Hash h, ByteSource src, HashM h m) =>
HashI h m -> src -> MT m h
completeHashing HashI h m
hI src
src


    -- Hash the outer block.
    () -> MT m ()
forall m v. Initialisable m v => v -> MT m ()
initialise ()
    PointerAction (MT m) () ()
allocate PointerAction (MT m) () () -> PointerAction (MT m) () ()
forall a b. (a -> b) -> a -> b
$ \ Pointer
ptr -> do
      IO () -> MT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MT m ()) -> IO () -> MT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Pointer -> IO ()
unsafeCopyToPointer ByteString
outerFirstBlock Pointer
ptr
      HashI h m -> Pointer -> BLOCKS h -> MT m ()
forall h m. HashI h m -> Pointer -> BLOCKS h -> MT m ()
compress HashI h m
hI Pointer
ptr (BLOCKS h -> MT m ()) -> BLOCKS h -> MT m ()
forall a b. (a -> b) -> a -> b
$ Int -> BLOCKS h
forall a. Enum a => Int -> a
toEnum Int
1

    -- Finish it with hashing the  hash computed above
    h -> HMAC h
forall h. h -> HMAC h
HMAC (h -> HMAC h) -> MT m h -> MT m (HMAC h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashI h m -> ByteString -> MT m h
forall h src m.
(Hash h, ByteSource src, HashM h m) =>
HashI h m -> src -> MT m h
completeHashing HashI h m
hI (h -> ByteString
forall a. Encodable a => a -> ByteString
toByteString h
innerHash)

  where allocate :: PointerAction (MT m) () ()
allocate = PointerAction IO () () -> PointerAction (MT m) () ()
forall a b mem. PointerAction IO a b -> PointerAction (MT mem) a b
liftPointerAction (PointerAction IO () () -> PointerAction (MT m) () ())
-> PointerAction IO () () -> PointerAction (MT m) () ()
forall a b. (a -> b) -> a -> b
$ Implementation h -> BLOCKS h -> PointerAction IO () ()
forall prim b.
Primitive prim =>
Implementation prim -> BLOCKS prim -> (Pointer -> IO b) -> IO b
allocBufferFor Implementation h
imp (BLOCKS h -> PointerAction IO () ())
-> BLOCKS h -> PointerAction IO () ()
forall a b. (a -> b) -> a -> b
$ (Int -> BLOCKS h
forall a. Enum a => Int -> a
toEnum Int
1) BLOCKS h -> BLOCKS h -> BLOCKS h
forall a. a -> a -> a
`asTypeOf` (Key (HMAC h) -> BLOCKS h
forall h. Key (HMAC h) -> BLOCKS h
theBlock Key (HMAC h)
key)
        innerFirstBlock :: ByteString
innerFirstBlock = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0x36) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HMACKey h -> ByteString
forall h.
(Hash h, Recommendation h, Encodable h) =>
HMACKey h -> ByteString
hmacAdjustKey Key (HMAC h)
HMACKey h
key
        outerFirstBlock :: ByteString
outerFirstBlock = (Word8 -> Word8) -> ByteString -> ByteString
B.map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
0x5c) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HMACKey h -> ByteString
forall h.
(Hash h, Recommendation h, Encodable h) =>
HMACKey h -> ByteString
hmacAdjustKey Key (HMAC h)
HMACKey h
key
        theBlock :: Key (HMAC h) -> BLOCKS h
        theBlock :: Key (HMAC h) -> BLOCKS h
theBlock Key (HMAC h)
_ = Int -> BLOCKS h
forall a. Enum a => Int -> a
toEnum Int
1