KeySchedule.hs

{-# LANGUAGE OverloadedStrings #-}

module Network.TLS.KeySchedule (
    hkdfExtract,
    hkdfExpandLabel,
    deriveSecret,
) where

import qualified Crypto.Hash as H
import Crypto.KDF.HKDF
import Data.ByteArray (ByteArray, ByteArrayAccess, convert)
import qualified Data.ByteString as BS

import Network.TLS.Crypto
import Network.TLS.Imports
import Network.TLS.Types
import Network.TLS.Wire

----------------------------------------------------------------

-- | @HKDF-Extract@ function.  Returns the pseudorandom key (PRK) from salt and
-- input keying material (IKM).
hkdfExtract
    :: (ByteArray ba, ByteArrayAccess ba) => Hash -> ba -> ba -> ba
hkdfExtract SHA1 salt ikm = convert (extract salt ikm :: PRK H.SHA1)
hkdfExtract SHA256 salt ikm = convert (extract salt ikm :: PRK H.SHA256)
hkdfExtract SHA384 salt ikm = convert (extract salt ikm :: PRK H.SHA384)
hkdfExtract SHA512 salt ikm = convert (extract salt ikm :: PRK H.SHA512)
hkdfExtract _ _ _ = error "hkdfExtract: unsupported hash"

----------------------------------------------------------------

deriveSecret :: Hash -> Secret -> ByteString -> TranscriptHash -> Secret
deriveSecret h secret label (TranscriptHash hashedMsgs) =
    hkdfExpandLabel h secret label hashedMsgs outlen
  where
    outlen = hashDigestSize h

----------------------------------------------------------------

-- | @HKDF-Expand-Label@ function.  Returns output keying material of the
-- specified length from the PRK, customized for a TLS label and context.
hkdfExpandLabel
    :: (ByteArray ba, ByteArrayAccess ba)
    => Hash
    -> Secret
    -> ByteString
    -> ByteString
    -> Int
    -> ba
hkdfExpandLabel h secret label ctx outlen = expand' h secret hkdfLabel outlen
  where
    hkdfLabel = runPut $ do
        putWord16 $ fromIntegral outlen
        putOpaque8 ("tls13 " `BS.append` label)
        putOpaque8 ctx

expand'
    :: (ByteArray ba, ByteArrayAccess ba) => Hash -> Secret -> ByteString -> Int -> ba
expand' SHA1 secret label len = expand (extractSkip secret :: PRK H.SHA1) label len
expand' SHA256 secret label len = expand (extractSkip secret :: PRK H.SHA256) label len
expand' SHA384 secret label len = expand (extractSkip secret :: PRK H.SHA384) label len
expand' SHA512 secret label len = expand (extractSkip secret :: PRK H.SHA512) label len
expand' _ _ _ _ = error "expand'"

----------------------------------------------------------------