    -- |
    -- Module      : Crypto.MAC.HMAC
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- Provide the HMAC (Hash based Message Authentification Code) base algorithm.
    -- <http://en.wikipedia.org/wiki/HMAC>
    --
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    module Crypto.MAC.HMAC
        ( hmac
        , hmacLazy
        , HMAC(..)
        -- * Incremental
        , Context(..)
        , initialize
        , update
        , updates
        , finalize
        ) where

    import           Crypto.Hash hiding (Context)
    import qualified Crypto.Hash as Hash (Context)
    import           Crypto.Hash.IO
    import           Crypto.Internal.ByteArray (ScrubbedBytes, ByteArrayAccess)
    import qualified Crypto.Internal.ByteArray as B
    import           Data.Memory.PtrMethods
    import           Crypto.Internal.Compat
    import qualified Data.ByteString.Lazy as L

    -- | Represent an HMAC that is a phantom type with the hash used to produce the mac.
    --
    -- The Eq instance is constant time.  No Show instance is provided, to avoid
    -- printing by mistake.
    newtype HMAC a = HMAC { forall a. HMAC a -> Digest a
    hmacGetDigest :: Digest a }
        deriving (HMAC a -> Int
    (HMAC a -> Int)
    -> (forall p a. HMAC a -> (Ptr p -> IO a) -> IO a)
    -> (forall p. HMAC a -> Ptr p -> IO ())
    -> ByteArrayAccess (HMAC a)
    forall a. HMAC a -> Int
    forall p. HMAC a -> Ptr p -> IO ()
    forall ba.
    (ba -> Int)
    -> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
    -> (forall p. ba -> Ptr p -> IO ())
    -> ByteArrayAccess ba
    forall a p. HMAC a -> Ptr p -> IO ()
    forall p a. HMAC a -> (Ptr p -> IO a) -> IO a
    forall a p a. HMAC a -> (Ptr p -> IO a) -> IO a
    $clength :: forall a. HMAC a -> Int
    length :: HMAC a -> Int
    $cwithByteArray :: forall a p a. HMAC a -> (Ptr p -> IO a) -> IO a
    withByteArray :: forall p a. HMAC a -> (Ptr p -> IO a) -> IO a
    $ccopyByteArrayToPtr :: forall a p. HMAC a -> Ptr p -> IO ()
    copyByteArrayToPtr :: forall p. HMAC a -> Ptr p -> IO ()
    ByteArrayAccess)

    instance Eq (HMAC a) where
        (HMAC Digest a
    b1) == :: HMAC a -> HMAC a -> Bool
    == (HMAC Digest a
    b2) = Digest a -> Digest a -> Bool
    forall bs1 bs2.
    (ByteArrayAccess bs1, ByteArrayAccess bs2) =>
    bs1 -> bs2 -> Bool
    B.constEq Digest a
    b1 Digest a
    b2

    -- | Compute a MAC using the supplied hashing function
    hmac :: (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a)
         => key     -- ^ Secret key
         -> message -- ^ Message to MAC
         -> HMAC a
    hmac :: forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    hmac key
    secret message
    msg = Context a -> HMAC a
    forall a. HashAlgorithm a => Context a -> HMAC a
    finalize (Context a -> HMAC a) -> Context a -> HMAC a
    forall a b. (a -> b) -> a -> b
    $ Context a -> [message] -> Context a
    forall message a.
    (ByteArrayAccess message, HashAlgorithm a) =>
    Context a -> [message] -> Context a
    updates (key -> Context a
    forall key a.
    (ByteArrayAccess key, HashAlgorithm a) =>
    key -> Context a
    initialize key
    secret) [message
    msg]

    -- | Compute a MAC using the supplied hashing function, for a lazy input
    hmacLazy :: (ByteArrayAccess key, HashAlgorithm a)
         => key     -- ^ Secret key
         -> L.ByteString -- ^ Message to MAC
         -> HMAC a
    hmacLazy :: forall key a.
    (ByteArrayAccess key, HashAlgorithm a) =>
    key -> ByteString -> HMAC a
    hmacLazy key
    secret ByteString
    msg = Context a -> HMAC a
    forall a. HashAlgorithm a => Context a -> HMAC a
    finalize (Context a -> HMAC a) -> Context a -> HMAC a
    forall a b. (a -> b) -> a -> b
    $ Context a -> [StrictByteString] -> Context a
    forall message a.
    (ByteArrayAccess message, HashAlgorithm a) =>
    Context a -> [message] -> Context a
    updates (key -> Context a
    forall key a.
    (ByteArrayAccess key, HashAlgorithm a) =>
    key -> Context a
    initialize key
    secret) (ByteString -> [StrictByteString]
    L.toChunks ByteString
    msg)

    -- | Represent an ongoing HMAC state, that can be appended with 'update'
    -- and finalize to an HMAC with 'hmacFinalize'
    data Context hashalg = Context !(Hash.Context hashalg) !(Hash.Context hashalg)

    -- | Initialize a new incremental HMAC context
    initialize :: (ByteArrayAccess key, HashAlgorithm a)
               => key       -- ^ Secret key
               -> Context a
    initialize :: forall key a.
    (ByteArrayAccess key, HashAlgorithm a) =>
    key -> Context a
    initialize key
    secret = IO (Context a) -> Context a
    forall a. IO a -> a
    unsafeDoIO (a -> IO (Context a)
    forall a. HashAlgorithm a => a -> IO (Context a)
    doHashAlg a
    forall a. HasCallStack => a
    undefined)
      where
            doHashAlg :: HashAlgorithm a => a -> IO (Context a)
            doHashAlg :: forall a. HashAlgorithm a => a -> IO (Context a)
    doHashAlg a
    alg = do
                !withKey <- case key -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length key
    secret Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` Int
    blockSize of
                                Ordering
    EQ -> ((Ptr Word8 -> IO (ScrubbedBytes, ScrubbedBytes))
     -> IO (ScrubbedBytes, ScrubbedBytes))
    -> IO
         ((Ptr Word8 -> IO (ScrubbedBytes, ScrubbedBytes))
          -> IO (ScrubbedBytes, ScrubbedBytes))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (((Ptr Word8 -> IO (ScrubbedBytes, ScrubbedBytes))
      -> IO (ScrubbedBytes, ScrubbedBytes))
     -> IO
          ((Ptr Word8 -> IO (ScrubbedBytes, ScrubbedBytes))
           -> IO (ScrubbedBytes, ScrubbedBytes)))
    -> ((Ptr Word8 -> IO (ScrubbedBytes, ScrubbedBytes))
        -> IO (ScrubbedBytes, ScrubbedBytes))
    -> IO
         ((Ptr Word8 -> IO (ScrubbedBytes, ScrubbedBytes))
          -> IO (ScrubbedBytes, ScrubbedBytes))
    forall a b. (a -> b) -> a -> b
    $ key
    -> (Ptr Word8 -> IO (ScrubbedBytes, ScrubbedBytes))
    -> IO (ScrubbedBytes, ScrubbedBytes)
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. key -> (Ptr p -> IO a) -> IO a
    B.withByteArray key
    secret
                                Ordering
    LT -> do key <- Int -> (Ptr Word8 -> IO ()) -> IO ScrubbedBytes
    forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
    B.alloc Int
    blockSize ((Ptr Word8 -> IO ()) -> IO ScrubbedBytes)
    -> (Ptr Word8 -> IO ()) -> IO ScrubbedBytes
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    k -> do
                                            Ptr Word8 -> Word8 -> Int -> IO ()
    memSet Ptr Word8
    k Word8
    0 Int
    blockSize
                                            key -> (Ptr Word8 -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. key -> (Ptr p -> IO a) -> IO a
    B.withByteArray key
    secret ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    s -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    memCopy Ptr Word8
    k Ptr Word8
    s (key -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length key
    secret)
                                         return $ B.withByteArray (key :: ScrubbedBytes)
                                Ordering
    GT -> do
                                    -- hash the secret key
                                    ctx <- a -> IO (MutableContext a)
    forall alg. HashAlgorithm alg => alg -> IO (MutableContext alg)
    hashMutableInitWith a
    alg
                                    hashMutableUpdate ctx secret
                                    digest <- hashMutableFinalize ctx
                                    hashMutableReset ctx
                                    -- pad it if necessary
                                    if digestSize < blockSize
                                        then do
                                            key <- B.alloc blockSize $ \Ptr Word8
    k -> do
                                                Ptr Word8 -> Word8 -> Int -> IO ()
    memSet Ptr Word8
    k Word8
    0 Int
    blockSize
                                                Digest a -> (Ptr Word8 -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. Digest a -> (Ptr p -> IO a) -> IO a
    B.withByteArray Digest a
    digest ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    s -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    memCopy Ptr Word8
    k Ptr Word8
    s (Digest a -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length Digest a
    digest)
                                            return $ B.withByteArray (key :: ScrubbedBytes)
                                        else
                                           return $ B.withByteArray digest
                (inner, outer) <- withKey $ \Ptr Word8
    keyPtr ->
                    (,) (ScrubbedBytes -> ScrubbedBytes -> (ScrubbedBytes, ScrubbedBytes))
    -> IO ScrubbedBytes
    -> IO (ScrubbedBytes -> (ScrubbedBytes, ScrubbedBytes))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> (Ptr Word8 -> IO ()) -> IO ScrubbedBytes
    forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
    B.alloc Int
    blockSize (\Ptr Word8
    p -> Ptr Word8 -> Word8 -> Ptr Word8 -> Int -> IO ()
    memXorWith Ptr Word8
    p Word8
    0x36 Ptr Word8
    keyPtr Int
    blockSize)
                        IO (ScrubbedBytes -> (ScrubbedBytes, ScrubbedBytes))
    -> IO ScrubbedBytes -> IO (ScrubbedBytes, ScrubbedBytes)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Int -> (Ptr Word8 -> IO ()) -> IO ScrubbedBytes
    forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
    B.alloc Int
    blockSize (\Ptr Word8
    p -> Ptr Word8 -> Word8 -> Ptr Word8 -> Int -> IO ()
    memXorWith Ptr Word8
    p Word8
    0x5c Ptr Word8
    keyPtr Int
    blockSize)
                return $ Context (hashUpdates initCtx [outer :: ScrubbedBytes])
                                 (hashUpdates initCtx [inner :: ScrubbedBytes])
              where
                    blockSize :: Int
    blockSize  = a -> Int
    forall a. HashAlgorithm a => a -> Int
    hashBlockSize a
    alg
                    digestSize :: Int
    digestSize = a -> Int
    forall a. HashAlgorithm a => a -> Int
    hashDigestSize a
    alg
                    initCtx :: Context a
    initCtx    = a -> Context a
    forall alg. HashAlgorithm alg => alg -> Context alg
    hashInitWith a
    alg
    {-# NOINLINE initialize #-}

    -- | Incrementally update a HMAC context
    update :: (ByteArrayAccess message, HashAlgorithm a)
           => Context a  -- ^ Current HMAC context
           -> message    -- ^ Message to append to the MAC
           -> Context a  -- ^ Updated HMAC context
    update :: forall message a.
    (ByteArrayAccess message, HashAlgorithm a) =>
    Context a -> message -> Context a
    update (Context Context a
    octx Context a
    ictx) message
    msg =
        Context a -> Context a -> Context a
    forall hashalg.
    Context hashalg -> Context hashalg -> Context hashalg
    Context Context a
    octx (Context a -> message -> Context a
    forall ba a.
    (ByteArrayAccess ba, HashAlgorithm a) =>
    Context a -> ba -> Context a
    hashUpdate Context a
    ictx message
    msg)

    -- | Increamentally update a HMAC context with multiple inputs
    updates :: (ByteArrayAccess message, HashAlgorithm a)
            => Context a -- ^ Current HMAC context
            -> [message] -- ^ Messages to append to the MAC
            -> Context a -- ^ Updated HMAC context
    updates :: forall message a.
    (ByteArrayAccess message, HashAlgorithm a) =>
    Context a -> [message] -> Context a
    updates (Context Context a
    octx Context a
    ictx) [message]
    msgs =
        Context a -> Context a -> Context a
    forall hashalg.
    Context hashalg -> Context hashalg -> Context hashalg
    Context Context a
    octx (Context a -> [message] -> Context a
    forall a ba.
    (HashAlgorithm a, ByteArrayAccess ba) =>
    Context a -> [ba] -> Context a
    hashUpdates Context a
    ictx [message]
    msgs)

    -- | Finalize a HMAC context and return the HMAC.
    finalize :: HashAlgorithm a
             => Context a
             -> HMAC a
    finalize :: forall a. HashAlgorithm a => Context a -> HMAC a
    finalize (Context Context a
    octx Context a
    ictx) =
        Digest a -> HMAC a
    forall a. Digest a -> HMAC a
    HMAC (Digest a -> HMAC a) -> Digest a -> HMAC a
    forall a b. (a -> b) -> a -> b
    $ Context a -> Digest a
    forall a. HashAlgorithm a => Context a -> Digest a
    hashFinalize (Context a -> Digest a) -> Context a -> Digest a
    forall a b. (a -> b) -> a -> b
    $ Context a -> [Digest a] -> Context a
    forall a ba.
    (HashAlgorithm a, ByteArrayAccess ba) =>
    Context a -> [ba] -> Context a
    hashUpdates Context a
    octx [Context a -> Digest a
    forall a. HashAlgorithm a => Context a -> Digest a
    hashFinalize Context a
    ictx]