1-- |
2-- Module      : Crypto.KDF.HKDF
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Key Derivation Function based on HMAC
9--
10-- See RFC5869
11--
12{-# LANGUAGE BangPatterns #-}
13module Crypto.KDF.HKDF
14    ( PRK
15    , extract
16    , extractSkip
17    , expand
18    ) where
19
20import           Data.Word
21import           Crypto.Hash
22import           Crypto.MAC.HMAC
23import           Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)
24import qualified Crypto.Internal.ByteArray as B
25
26-- | Pseudo Random Key
27data PRK a = PRK (HMAC a) | PRK_NoExpand ScrubbedBytes
28    deriving (Eq)
29
30instance ByteArrayAccess (PRK a) where
31    length (PRK hm)          = B.length hm
32    length (PRK_NoExpand sb) = B.length sb
33    withByteArray (PRK hm)          = B.withByteArray hm
34    withByteArray (PRK_NoExpand sb) = B.withByteArray sb
35
36-- | Extract a Pseudo Random Key using the parameter and the underlaying hash mechanism
37extract :: (HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm)
38        => salt  -- ^ Salt
39        -> ikm   -- ^ Input Keying Material
40        -> PRK a -- ^ Pseudo random key
41extract salt ikm = PRK $ hmac salt ikm
42
43-- | Create a PRK directly from the input key material.
44--
45-- Only use when guaranteed to have a good quality and random data to use directly as key.
46-- This effectively skip a HMAC with key=salt and data=key.
47extractSkip :: ByteArrayAccess ikm
48            => ikm
49            -> PRK a
50extractSkip ikm = PRK_NoExpand $ B.convert ikm
51
52-- | Expand key material of specific length out of the parameters
53expand :: (HashAlgorithm a, ByteArrayAccess info, ByteArray out)
54       => PRK a      -- ^ Pseudo Random Key
55       -> info       -- ^ Optional context and application specific information
56       -> Int        -- ^ Output length in bytes
57       -> out        -- ^ Output data
58expand prkAt infoAt outputLength =
59    let hF = hFGet prkAt
60     in B.concat $ loop hF B.empty outputLength 1
61  where
62    hFGet :: (HashAlgorithm a, ByteArrayAccess b) => PRK a -> (b -> HMAC a)
63    hFGet prk = case prk of
64             PRK hmacKey      -> hmac hmacKey
65             PRK_NoExpand ikm -> hmac ikm
66
67    info :: ScrubbedBytes
68    info = B.convert infoAt
69
70    loop :: HashAlgorithm a
71         => (ScrubbedBytes -> HMAC a)
72         -> ScrubbedBytes
73         -> Int
74         -> Word8
75         -> [ScrubbedBytes]
76    loop hF tim1 n i
77        | n <= 0    = []
78        | otherwise =
79            let input   = B.concat [tim1,info,B.singleton i] :: ScrubbedBytes
80                ti      = B.convert $ hF input
81                hashLen = B.length ti
82                r       = n - hashLen
83             in (if n >= hashLen then ti else B.take n ti)
84              : loop hF ti r (i+1)
85