    -- |
    -- Module      : Crypto.KDF.HKDF
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- Key Derivation Function based on HMAC
    --
    -- See RFC5869
    --
    {-# LANGUAGE BangPatterns #-}
    module Crypto.KDF.HKDF
        ( PRK
        , extract
        , extractSkip
        , expand
        ) where

    import           Data.Word
    import           Crypto.Hash
    import           Crypto.MAC.HMAC
    import           Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)
    import qualified Crypto.Internal.ByteArray as B

    -- | Pseudo Random Key
    data PRK a = PRK (HMAC a) | PRK_NoExpand ScrubbedBytes
        deriving (PRK a -> PRK a -> Bool
    (PRK a -> PRK a -> Bool) -> (PRK a -> PRK a -> Bool) -> Eq (PRK a)
    forall a. PRK a -> PRK a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. PRK a -> PRK a -> Bool
    == :: PRK a -> PRK a -> Bool
    $c/= :: forall a. PRK a -> PRK a -> Bool
    /= :: PRK a -> PRK a -> Bool
    Eq)

    instance ByteArrayAccess (PRK a) where
        length :: PRK a -> Int
    length (PRK HMAC a
    hm)          = HMAC a -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length HMAC a
    hm
        length (PRK_NoExpand ScrubbedBytes
    sb) = ScrubbedBytes -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ScrubbedBytes
    sb
        withByteArray :: forall p a. PRK a -> (Ptr p -> IO a) -> IO a
    withByteArray (PRK HMAC a
    hm)          = HMAC a -> (Ptr p -> IO a) -> IO a
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. HMAC a -> (Ptr p -> IO a) -> IO a
    B.withByteArray HMAC a
    hm
        withByteArray (PRK_NoExpand ScrubbedBytes
    sb) = ScrubbedBytes -> (Ptr p -> IO a) -> IO a
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
    B.withByteArray ScrubbedBytes
    sb

    -- | Extract a Pseudo Random Key using the parameter and the underlaying hash mechanism
    extract :: (HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm)
            => salt  -- ^ Salt
            -> ikm   -- ^ Input Keying Material
            -> PRK a -- ^ Pseudo random key
    extract :: forall a salt ikm.
    (HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) =>
    salt -> ikm -> PRK a
    extract salt
    salt ikm
    ikm = HMAC a -> PRK a
    forall a. HMAC a -> PRK a
    PRK (HMAC a -> PRK a) -> HMAC a -> PRK a
    forall a b. (a -> b) -> a -> b
    $ salt -> ikm -> HMAC a
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    hmac salt
    salt ikm
    ikm

    -- | Create a PRK directly from the input key material.
    --
    -- Only use when guaranteed to have a good quality and random data to use directly as key.
    -- This effectively skip a HMAC with key=salt and data=key.
    extractSkip :: ByteArrayAccess ikm
                => ikm
                -> PRK a
    extractSkip :: forall ikm a. ByteArrayAccess ikm => ikm -> PRK a
    extractSkip ikm
    ikm = ScrubbedBytes -> PRK a
    forall a. ScrubbedBytes -> PRK a
    PRK_NoExpand (ScrubbedBytes -> PRK a) -> ScrubbedBytes -> PRK a
    forall a b. (a -> b) -> a -> b
    $ ikm -> ScrubbedBytes
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    B.convert ikm
    ikm

    -- | Expand key material of specific length out of the parameters
    expand :: (HashAlgorithm a, ByteArrayAccess info, ByteArray out)
           => PRK a      -- ^ Pseudo Random Key
           -> info       -- ^ Optional context and application specific information
           -> Int        -- ^ Output length in bytes
           -> out        -- ^ Output data
    expand :: forall a info out.
    (HashAlgorithm a, ByteArrayAccess info, ByteArray out) =>
    PRK a -> info -> Int -> out
    expand PRK a
    prkAt info
    infoAt Int
    outputLength =
        let hF :: ScrubbedBytes -> HMAC a
    hF = PRK a -> ScrubbedBytes -> HMAC a
    forall a b.
    (HashAlgorithm a, ByteArrayAccess b) =>
    PRK a -> b -> HMAC a
    hFGet PRK a
    prkAt
         in [ScrubbedBytes] -> out
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    [bin] -> bout
    B.concat ([ScrubbedBytes] -> out) -> [ScrubbedBytes] -> out
    forall a b. (a -> b) -> a -> b
    $ (ScrubbedBytes -> HMAC a)
    -> ScrubbedBytes -> Int -> Word8 -> [ScrubbedBytes]
    forall a.
    HashAlgorithm a =>
    (ScrubbedBytes -> HMAC a)
    -> ScrubbedBytes -> Int -> Word8 -> [ScrubbedBytes]
    loop ScrubbedBytes -> HMAC a
    hF ScrubbedBytes
    forall a. ByteArray a => a
    B.empty Int
    outputLength Word8
    1
      where
        hFGet :: (HashAlgorithm a, ByteArrayAccess b) => PRK a -> (b -> HMAC a)
        hFGet :: forall a b.
    (HashAlgorithm a, ByteArrayAccess b) =>
    PRK a -> b -> HMAC a
    hFGet PRK a
    prk = case PRK a
    prk of
                 PRK HMAC a
    hmacKey      -> HMAC a -> b -> HMAC a
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    hmac HMAC a
    hmacKey
                 PRK_NoExpand ScrubbedBytes
    ikm -> ScrubbedBytes -> b -> HMAC a
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    hmac ScrubbedBytes
    ikm

        info :: ScrubbedBytes
        info :: ScrubbedBytes
    info = info -> ScrubbedBytes
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    B.convert info
    infoAt

        loop :: HashAlgorithm a
             => (ScrubbedBytes -> HMAC a)
             -> ScrubbedBytes
             -> Int
             -> Word8
             -> [ScrubbedBytes]
        loop :: forall a.
    HashAlgorithm a =>
    (ScrubbedBytes -> HMAC a)
    -> ScrubbedBytes -> Int -> Word8 -> [ScrubbedBytes]
    loop ScrubbedBytes -> HMAC a
    hF ScrubbedBytes
    tim1 Int
    n Word8
    i
            | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0    = []
            | Bool
    otherwise =
                let input :: ScrubbedBytes
    input   = [ScrubbedBytes] -> ScrubbedBytes
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    [bin] -> bout
    B.concat [ScrubbedBytes
    tim1,ScrubbedBytes
    info,Word8 -> ScrubbedBytes
    forall a. ByteArray a => Word8 -> a
    B.singleton Word8
    i] :: ScrubbedBytes
                    ti :: ScrubbedBytes
    ti      = HMAC a -> ScrubbedBytes
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    B.convert (HMAC a -> ScrubbedBytes) -> HMAC a -> ScrubbedBytes
    forall a b. (a -> b) -> a -> b
    $ ScrubbedBytes -> HMAC a
    hF ScrubbedBytes
    input
                    hashLen :: Int
    hashLen = ScrubbedBytes -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ScrubbedBytes
    ti
                    r :: Int
    r       = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    hashLen
                 in (if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    hashLen then ScrubbedBytes
    ti else Int -> ScrubbedBytes -> ScrubbedBytes
    forall bs. ByteArray bs => Int -> bs -> bs
    B.take Int
    n ScrubbedBytes
    ti)
                  ScrubbedBytes -> [ScrubbedBytes] -> [ScrubbedBytes]
    forall a. a -> [a] -> [a]
    : (ScrubbedBytes -> HMAC a)
    -> ScrubbedBytes -> Int -> Word8 -> [ScrubbedBytes]
    forall a.
    HashAlgorithm a =>
    (ScrubbedBytes -> HMAC a)
    -> ScrubbedBytes -> Int -> Word8 -> [ScrubbedBytes]
    loop ScrubbedBytes -> HMAC a
    hF ScrubbedBytes
    ti Int
    r (Word8
    iWord8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    +Word8
    1)