{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      : Network.TLS.Handshake.State
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.Handshake.State
    ( HandshakeState(..)
    , HandshakeDigest(..)
    , HandshakeMode13(..)
    , RTT0Status(..)
    , CertReqCBdata
    , HandshakeM
    , newEmptyHandshake
    , runHandshake
    -- * key accessors
    , setPublicKey
    , setPublicPrivateKeys
    , getLocalPublicPrivateKeys
    , getRemotePublicKey
    , setServerDHParams
    , getServerDHParams
    , setServerECDHParams
    , getServerECDHParams
    , setDHPrivate
    , getDHPrivate
    , setGroupPrivate
    , getGroupPrivate
    -- * cert accessors
    , setClientCertSent
    , getClientCertSent
    , setCertReqSent
    , getCertReqSent
    , setClientCertChain
    , getClientCertChain
    , setCertReqToken
    , getCertReqToken
    , setCertReqCBdata
    , getCertReqCBdata
    , setCertReqSigAlgsCert
    , getCertReqSigAlgsCert
    -- * digest accessors
    , addHandshakeMessage
    , updateHandshakeDigest
    , getHandshakeMessages
    , getHandshakeMessagesRev
    , getHandshakeDigest
    , foldHandshakeDigest
    -- * master secret
    , setMasterSecret
    , setMasterSecretFromPre
    -- * misc accessor
    , getPendingCipher
    , setServerHelloParameters
    , setExtendedMasterSec
    , getExtendedMasterSec
    , setNegotiatedGroup
    , getNegotiatedGroup
    , setTLS13HandshakeMode
    , getTLS13HandshakeMode
    , setTLS13RTT0Status
    , getTLS13RTT0Status
    , setTLS13EarlySecret
    , getTLS13EarlySecret
    , setTLS13ResumptionSecret
    , getTLS13ResumptionSecret
    , setCCS13Sent
    , getCCS13Sent
    ) where

import Network.TLS.Util
import Network.TLS.Struct
import Network.TLS.Record.State
import Network.TLS.Packet
import Network.TLS.Crypto
import Network.TLS.Cipher
import Network.TLS.Compression
import Network.TLS.Types
import Network.TLS.Imports
import Control.Monad.State.Strict
import Data.X509 (CertificateChain)
import Data.ByteArray (ByteArrayAccess)

data HandshakeKeyState = HandshakeKeyState
    { HandshakeKeyState -> Maybe PubKey
hksRemotePublicKey :: !(Maybe PubKey)
    , HandshakeKeyState -> Maybe (PubKey, PrivKey)
hksLocalPublicPrivateKeys :: !(Maybe (PubKey, PrivKey))
    } deriving (Int -> HandshakeKeyState -> ShowS
[HandshakeKeyState] -> ShowS
HandshakeKeyState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandshakeKeyState] -> ShowS
$cshowList :: [HandshakeKeyState] -> ShowS
show :: HandshakeKeyState -> String
$cshow :: HandshakeKeyState -> String
showsPrec :: Int -> HandshakeKeyState -> ShowS
$cshowsPrec :: Int -> HandshakeKeyState -> ShowS
Show)

data HandshakeDigest = HandshakeMessages [ByteString]
                     | HandshakeDigestContext HashCtx
                     deriving (Int -> HandshakeDigest -> ShowS
[HandshakeDigest] -> ShowS
HandshakeDigest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandshakeDigest] -> ShowS
$cshowList :: [HandshakeDigest] -> ShowS
show :: HandshakeDigest -> String
$cshow :: HandshakeDigest -> String
showsPrec :: Int -> HandshakeDigest -> ShowS
$cshowsPrec :: Int -> HandshakeDigest -> ShowS
Show)

data HandshakeState = HandshakeState
    { HandshakeState -> Version
hstClientVersion       :: !Version
    , HandshakeState -> ClientRandom
hstClientRandom        :: !ClientRandom
    , HandshakeState -> Maybe ServerRandom
hstServerRandom        :: !(Maybe ServerRandom)
    , HandshakeState -> Maybe ByteString
hstMasterSecret        :: !(Maybe ByteString)
    , HandshakeState -> HandshakeKeyState
hstKeyState            :: !HandshakeKeyState
    , HandshakeState -> Maybe ServerDHParams
hstServerDHParams      :: !(Maybe ServerDHParams)
    , HandshakeState -> Maybe DHPrivate
hstDHPrivate           :: !(Maybe DHPrivate)
    , HandshakeState -> Maybe ServerECDHParams
hstServerECDHParams    :: !(Maybe ServerECDHParams)
    , HandshakeState -> Maybe GroupPrivate
hstGroupPrivate        :: !(Maybe GroupPrivate)
    , HandshakeState -> HandshakeDigest
hstHandshakeDigest     :: !HandshakeDigest
    , HandshakeState -> [ByteString]
hstHandshakeMessages   :: [ByteString]
    , HandshakeState -> Maybe ByteString
hstCertReqToken        :: !(Maybe ByteString)
        -- ^ Set to Just-value when a TLS13 certificate request is received
    , HandshakeState -> Maybe CertReqCBdata
hstCertReqCBdata       :: !(Maybe CertReqCBdata)
        -- ^ Set to Just-value when a certificate request is received
    , HandshakeState -> Maybe [HashAndSignatureAlgorithm]
hstCertReqSigAlgsCert  :: !(Maybe [HashAndSignatureAlgorithm])
        -- ^ In TLS 1.3, these are separate from the certificate
        -- issuer signature algorithm hints in the callback data.
        -- In TLS 1.2 the same list is overloaded for both purposes.
        -- Not present in TLS 1.1 and earlier
    , HandshakeState -> Bool
hstClientCertSent      :: !Bool
        -- ^ Set to true when a client certificate chain was sent
    , HandshakeState -> Bool
hstCertReqSent         :: !Bool
        -- ^ Set to true when a certificate request was sent.  This applies
        -- only to requests sent during handshake (not post-handshake).
    , HandshakeState -> Maybe CertificateChain
hstClientCertChain     :: !(Maybe CertificateChain)
    , HandshakeState -> Maybe RecordState
hstPendingTxState      :: Maybe RecordState
    , HandshakeState -> Maybe RecordState
hstPendingRxState      :: Maybe RecordState
    , HandshakeState -> Maybe Cipher
hstPendingCipher       :: Maybe Cipher
    , HandshakeState -> Compression
hstPendingCompression  :: Compression
    , HandshakeState -> Bool
hstExtendedMasterSec   :: Bool
    , HandshakeState -> Maybe Group
hstNegotiatedGroup     :: Maybe Group
    , HandshakeState -> HandshakeMode13
hstTLS13HandshakeMode  :: HandshakeMode13
    , HandshakeState -> RTT0Status
hstTLS13RTT0Status     :: !RTT0Status
    , HandshakeState -> Maybe (BaseSecret EarlySecret)
hstTLS13EarlySecret    :: Maybe (BaseSecret EarlySecret)
    , HandshakeState -> Maybe (BaseSecret ResumptionSecret)
hstTLS13ResumptionSecret :: Maybe (BaseSecret ResumptionSecret)
    , HandshakeState -> Bool
hstCCS13Sent           :: !Bool
    } deriving (Int -> HandshakeState -> ShowS
[HandshakeState] -> ShowS
HandshakeState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandshakeState] -> ShowS
$cshowList :: [HandshakeState] -> ShowS
show :: HandshakeState -> String
$cshow :: HandshakeState -> String
showsPrec :: Int -> HandshakeState -> ShowS
$cshowsPrec :: Int -> HandshakeState -> ShowS
Show)

{- | When we receive a CertificateRequest from a server, a just-in-time
   callback is issued to the application to obtain a suitable certificate.
   Somewhat unfortunately, the callback parameters don't abstract away the
   details of the TLS 1.2 Certificate Request message, which combines the
   legacy @certificate_types@ and new @supported_signature_algorithms@
   parameters is a rather subtle way.

   TLS 1.2 also (again unfortunately, in the opinion of the author of this
   comment) overloads the signature algorithms parameter to constrain not only
   the algorithms used in TLS, but also the algorithms used by issuing CAs in
   the X.509 chain.  Best practice is to NOT treat such that restriction as a
   MUST, but rather take it as merely a preference, when a choice exists.  If
   the best chain available does not match the provided signature algorithm
   list, go ahead and use it anyway, it will probably work, and the server may
   not even care about the issuer CAs at all, it may be doing DANE or have
   explicit mappings for the client's public key, ...

   The TLS 1.3 @CertificateRequest@ message, drops @certificate_types@ and no
   longer overloads @supported_signature_algorithms@ to cover X.509.  It also
   includes a new opaque context token that the client must echo back, which
   makes certain client authentication replay attacks more difficult.  We will
   store that context separately, it does not need to be presented in the user
   callback.  The certificate signature algorithms preferred by the peer are
   now in the separate @signature_algorithms_cert@ extension, but we cannot
   report these to the application callback without an API change.  The good
   news is that filtering the X.509 signature types is generally unnecessary,
   unwise and difficult.  So we just ignore this extension.

   As a result, the information we provide to the callback is no longer a
   verbatim copy of the certificate request payload.  In the case of TLS 1.3
   The 'CertificateType' list is synthetically generated from the server's
   @signature_algorithms@ extension, and the @signature_algorithms_certs@
   extension is ignored.

   Since the original TLS 1.2 'CertificateType' has no provision for the newer
   certificate types that have appeared in TLS 1.3 we're adding some synthetic
   values that have no equivalent values in the TLS 1.2 'CertificateType' as
   defined in the IANA
   <https://www.iana.org/assignments/tls-parameters/tls-parameters.xhtml#tls-parameters-2
   TLS ClientCertificateType Identifiers> registry.  These values are inferred
   from the TLS 1.3 @signature_algorithms@ extension, and will allow clients to
   present Ed25519 and Ed448 certificates when these become supported.
-}
type CertReqCBdata =
     ( [CertificateType]
     , Maybe [HashAndSignatureAlgorithm]
     , [DistinguishedName] )

newtype HandshakeM a = HandshakeM { forall a. HandshakeM a -> State HandshakeState a
runHandshakeM :: State HandshakeState a }
    deriving (forall a b. a -> HandshakeM b -> HandshakeM a
forall a b. (a -> b) -> HandshakeM a -> HandshakeM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HandshakeM b -> HandshakeM a
$c<$ :: forall a b. a -> HandshakeM b -> HandshakeM a
fmap :: forall a b. (a -> b) -> HandshakeM a -> HandshakeM b
$cfmap :: forall a b. (a -> b) -> HandshakeM a -> HandshakeM b
Functor, Functor HandshakeM
forall a. a -> HandshakeM a
forall a b. HandshakeM a -> HandshakeM b -> HandshakeM a
forall a b. HandshakeM a -> HandshakeM b -> HandshakeM b
forall a b. HandshakeM (a -> b) -> HandshakeM a -> HandshakeM b
forall a b c.
(a -> b -> c) -> HandshakeM a -> HandshakeM b -> HandshakeM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. HandshakeM a -> HandshakeM b -> HandshakeM a
$c<* :: forall a b. HandshakeM a -> HandshakeM b -> HandshakeM a
*> :: forall a b. HandshakeM a -> HandshakeM b -> HandshakeM b
$c*> :: forall a b. HandshakeM a -> HandshakeM b -> HandshakeM b
liftA2 :: forall a b c.
(a -> b -> c) -> HandshakeM a -> HandshakeM b -> HandshakeM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> HandshakeM a -> HandshakeM b -> HandshakeM c
<*> :: forall a b. HandshakeM (a -> b) -> HandshakeM a -> HandshakeM b
$c<*> :: forall a b. HandshakeM (a -> b) -> HandshakeM a -> HandshakeM b
pure :: forall a. a -> HandshakeM a
$cpure :: forall a. a -> HandshakeM a
Applicative, Applicative HandshakeM
forall a. a -> HandshakeM a
forall a b. HandshakeM a -> HandshakeM b -> HandshakeM b
forall a b. HandshakeM a -> (a -> HandshakeM b) -> HandshakeM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> HandshakeM a
$creturn :: forall a. a -> HandshakeM a
>> :: forall a b. HandshakeM a -> HandshakeM b -> HandshakeM b
$c>> :: forall a b. HandshakeM a -> HandshakeM b -> HandshakeM b
>>= :: forall a b. HandshakeM a -> (a -> HandshakeM b) -> HandshakeM b
$c>>= :: forall a b. HandshakeM a -> (a -> HandshakeM b) -> HandshakeM b
Monad)

instance MonadState HandshakeState HandshakeM where
    put :: HandshakeState -> HandshakeM ()
put HandshakeState
x = forall a. State HandshakeState a -> HandshakeM a
HandshakeM (forall s (m :: * -> *). MonadState s m => s -> m ()
put HandshakeState
x)
    get :: HandshakeM HandshakeState
get   = forall a. State HandshakeState a -> HandshakeM a
HandshakeM forall s (m :: * -> *). MonadState s m => m s
get
    state :: forall a. (HandshakeState -> (a, HandshakeState)) -> HandshakeM a
state HandshakeState -> (a, HandshakeState)
f = forall a. State HandshakeState a -> HandshakeM a
HandshakeM (forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state HandshakeState -> (a, HandshakeState)
f)

-- create a new empty handshake state
newEmptyHandshake :: Version -> ClientRandom -> HandshakeState
newEmptyHandshake :: Version -> ClientRandom -> HandshakeState
newEmptyHandshake Version
ver ClientRandom
crand = HandshakeState
    { hstClientVersion :: Version
hstClientVersion       = Version
ver
    , hstClientRandom :: ClientRandom
hstClientRandom        = ClientRandom
crand
    , hstServerRandom :: Maybe ServerRandom
hstServerRandom        = forall a. Maybe a
Nothing
    , hstMasterSecret :: Maybe ByteString
hstMasterSecret        = forall a. Maybe a
Nothing
    , hstKeyState :: HandshakeKeyState
hstKeyState            = Maybe PubKey -> Maybe (PubKey, PrivKey) -> HandshakeKeyState
HandshakeKeyState forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    , hstServerDHParams :: Maybe ServerDHParams
hstServerDHParams      = forall a. Maybe a
Nothing
    , hstDHPrivate :: Maybe DHPrivate
hstDHPrivate           = forall a. Maybe a
Nothing
    , hstServerECDHParams :: Maybe ServerECDHParams
hstServerECDHParams    = forall a. Maybe a
Nothing
    , hstGroupPrivate :: Maybe GroupPrivate
hstGroupPrivate        = forall a. Maybe a
Nothing
    , hstHandshakeDigest :: HandshakeDigest
hstHandshakeDigest     = [ByteString] -> HandshakeDigest
HandshakeMessages []
    , hstHandshakeMessages :: [ByteString]
hstHandshakeMessages   = []
    , hstCertReqToken :: Maybe ByteString
hstCertReqToken        = forall a. Maybe a
Nothing
    , hstCertReqCBdata :: Maybe CertReqCBdata
hstCertReqCBdata       = forall a. Maybe a
Nothing
    , hstCertReqSigAlgsCert :: Maybe [HashAndSignatureAlgorithm]
hstCertReqSigAlgsCert  = forall a. Maybe a
Nothing
    , hstClientCertSent :: Bool
hstClientCertSent      = Bool
False
    , hstCertReqSent :: Bool
hstCertReqSent         = Bool
False
    , hstClientCertChain :: Maybe CertificateChain
hstClientCertChain     = forall a. Maybe a
Nothing
    , hstPendingTxState :: Maybe RecordState
hstPendingTxState      = forall a. Maybe a
Nothing
    , hstPendingRxState :: Maybe RecordState
hstPendingRxState      = forall a. Maybe a
Nothing
    , hstPendingCipher :: Maybe Cipher
hstPendingCipher       = forall a. Maybe a
Nothing
    , hstPendingCompression :: Compression
hstPendingCompression  = Compression
nullCompression
    , hstExtendedMasterSec :: Bool
hstExtendedMasterSec   = Bool
False
    , hstNegotiatedGroup :: Maybe Group
hstNegotiatedGroup     = forall a. Maybe a
Nothing
    , hstTLS13HandshakeMode :: HandshakeMode13
hstTLS13HandshakeMode  = HandshakeMode13
FullHandshake
    , hstTLS13RTT0Status :: RTT0Status
hstTLS13RTT0Status     = RTT0Status
RTT0None
    , hstTLS13EarlySecret :: Maybe (BaseSecret EarlySecret)
hstTLS13EarlySecret    = forall a. Maybe a
Nothing
    , hstTLS13ResumptionSecret :: Maybe (BaseSecret ResumptionSecret)
hstTLS13ResumptionSecret = forall a. Maybe a
Nothing
    , hstCCS13Sent :: Bool
hstCCS13Sent           = Bool
False
    }

runHandshake :: HandshakeState -> HandshakeM a -> (a, HandshakeState)
runHandshake :: forall a. HandshakeState -> HandshakeM a -> (a, HandshakeState)
runHandshake HandshakeState
hst HandshakeM a
f = forall s a. State s a -> s -> (a, s)
runState (forall a. HandshakeM a -> State HandshakeState a
runHandshakeM HandshakeM a
f) HandshakeState
hst

setPublicKey :: PubKey -> HandshakeM ()
setPublicKey :: PubKey -> HandshakeM ()
setPublicKey PubKey
pk = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstKeyState :: HandshakeKeyState
hstKeyState = HandshakeKeyState -> HandshakeKeyState
setPK (HandshakeState -> HandshakeKeyState
hstKeyState HandshakeState
hst) })
  where setPK :: HandshakeKeyState -> HandshakeKeyState
setPK HandshakeKeyState
hks = HandshakeKeyState
hks { hksRemotePublicKey :: Maybe PubKey
hksRemotePublicKey = forall a. a -> Maybe a
Just PubKey
pk }

setPublicPrivateKeys :: (PubKey, PrivKey) -> HandshakeM ()
setPublicPrivateKeys :: (PubKey, PrivKey) -> HandshakeM ()
setPublicPrivateKeys (PubKey, PrivKey)
keys = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstKeyState :: HandshakeKeyState
hstKeyState = HandshakeKeyState -> HandshakeKeyState
setKeys (HandshakeState -> HandshakeKeyState
hstKeyState HandshakeState
hst) })
  where setKeys :: HandshakeKeyState -> HandshakeKeyState
setKeys HandshakeKeyState
hks = HandshakeKeyState
hks { hksLocalPublicPrivateKeys :: Maybe (PubKey, PrivKey)
hksLocalPublicPrivateKeys = forall a. a -> Maybe a
Just (PubKey, PrivKey)
keys }

getRemotePublicKey :: HandshakeM PubKey
getRemotePublicKey :: HandshakeM PubKey
getRemotePublicKey = forall a. String -> Maybe a -> a
fromJust String
"remote public key" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (HandshakeKeyState -> Maybe PubKey
hksRemotePublicKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandshakeState -> HandshakeKeyState
hstKeyState)

getLocalPublicPrivateKeys :: HandshakeM (PubKey, PrivKey)
getLocalPublicPrivateKeys :: HandshakeM (PubKey, PrivKey)
getLocalPublicPrivateKeys = forall a. String -> Maybe a -> a
fromJust String
"local public/private key" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (HandshakeKeyState -> Maybe (PubKey, PrivKey)
hksLocalPublicPrivateKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandshakeState -> HandshakeKeyState
hstKeyState)

setServerDHParams :: ServerDHParams -> HandshakeM ()
setServerDHParams :: ServerDHParams -> HandshakeM ()
setServerDHParams ServerDHParams
shp = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstServerDHParams :: Maybe ServerDHParams
hstServerDHParams = forall a. a -> Maybe a
Just ServerDHParams
shp })

getServerDHParams :: HandshakeM ServerDHParams
getServerDHParams :: HandshakeM ServerDHParams
getServerDHParams = forall a. String -> Maybe a -> a
fromJust String
"server DH params" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe ServerDHParams
hstServerDHParams

setServerECDHParams :: ServerECDHParams -> HandshakeM ()
setServerECDHParams :: ServerECDHParams -> HandshakeM ()
setServerECDHParams ServerECDHParams
shp = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstServerECDHParams :: Maybe ServerECDHParams
hstServerECDHParams = forall a. a -> Maybe a
Just ServerECDHParams
shp })

getServerECDHParams :: HandshakeM ServerECDHParams
getServerECDHParams :: HandshakeM ServerECDHParams
getServerECDHParams = forall a. String -> Maybe a -> a
fromJust String
"server ECDH params" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe ServerECDHParams
hstServerECDHParams

setDHPrivate :: DHPrivate -> HandshakeM ()
setDHPrivate :: DHPrivate -> HandshakeM ()
setDHPrivate DHPrivate
shp = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstDHPrivate :: Maybe DHPrivate
hstDHPrivate = forall a. a -> Maybe a
Just DHPrivate
shp })

getDHPrivate :: HandshakeM DHPrivate
getDHPrivate :: HandshakeM DHPrivate
getDHPrivate = forall a. String -> Maybe a -> a
fromJust String
"server DH private" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe DHPrivate
hstDHPrivate

getGroupPrivate :: HandshakeM GroupPrivate
getGroupPrivate :: HandshakeM GroupPrivate
getGroupPrivate = forall a. String -> Maybe a -> a
fromJust String
"server ECDH private" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe GroupPrivate
hstGroupPrivate

setGroupPrivate :: GroupPrivate -> HandshakeM ()
setGroupPrivate :: GroupPrivate -> HandshakeM ()
setGroupPrivate GroupPrivate
shp = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstGroupPrivate :: Maybe GroupPrivate
hstGroupPrivate = forall a. a -> Maybe a
Just GroupPrivate
shp })

setExtendedMasterSec :: Bool -> HandshakeM ()
setExtendedMasterSec :: Bool -> HandshakeM ()
setExtendedMasterSec Bool
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstExtendedMasterSec :: Bool
hstExtendedMasterSec = Bool
b })

getExtendedMasterSec :: HandshakeM Bool
getExtendedMasterSec :: HandshakeM Bool
getExtendedMasterSec = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Bool
hstExtendedMasterSec

setNegotiatedGroup :: Group -> HandshakeM ()
setNegotiatedGroup :: Group -> HandshakeM ()
setNegotiatedGroup Group
g = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstNegotiatedGroup :: Maybe Group
hstNegotiatedGroup = forall a. a -> Maybe a
Just Group
g })

getNegotiatedGroup :: HandshakeM (Maybe Group)
getNegotiatedGroup :: HandshakeM (Maybe Group)
getNegotiatedGroup = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe Group
hstNegotiatedGroup

-- | Type to show which handshake mode is used in TLS 1.3.
data HandshakeMode13 =
      -- | Full handshake is used.
      FullHandshake
      -- | Full handshake is used with hello retry request.
    | HelloRetryRequest
      -- | Server authentication is skipped.
    | PreSharedKey
      -- | Server authentication is skipped and early data is sent.
    | RTT0
    deriving (Int -> HandshakeMode13 -> ShowS
[HandshakeMode13] -> ShowS
HandshakeMode13 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandshakeMode13] -> ShowS
$cshowList :: [HandshakeMode13] -> ShowS
show :: HandshakeMode13 -> String
$cshow :: HandshakeMode13 -> String
showsPrec :: Int -> HandshakeMode13 -> ShowS
$cshowsPrec :: Int -> HandshakeMode13 -> ShowS
Show,HandshakeMode13 -> HandshakeMode13 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandshakeMode13 -> HandshakeMode13 -> Bool
$c/= :: HandshakeMode13 -> HandshakeMode13 -> Bool
== :: HandshakeMode13 -> HandshakeMode13 -> Bool
$c== :: HandshakeMode13 -> HandshakeMode13 -> Bool
Eq)

setTLS13HandshakeMode :: HandshakeMode13 -> HandshakeM ()
setTLS13HandshakeMode :: HandshakeMode13 -> HandshakeM ()
setTLS13HandshakeMode HandshakeMode13
s = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstTLS13HandshakeMode :: HandshakeMode13
hstTLS13HandshakeMode = HandshakeMode13
s })

getTLS13HandshakeMode :: HandshakeM HandshakeMode13
getTLS13HandshakeMode :: HandshakeM HandshakeMode13
getTLS13HandshakeMode = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> HandshakeMode13
hstTLS13HandshakeMode

data RTT0Status = RTT0None
                | RTT0Sent
                | RTT0Accepted
                | RTT0Rejected
                deriving (Int -> RTT0Status -> ShowS
[RTT0Status] -> ShowS
RTT0Status -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RTT0Status] -> ShowS
$cshowList :: [RTT0Status] -> ShowS
show :: RTT0Status -> String
$cshow :: RTT0Status -> String
showsPrec :: Int -> RTT0Status -> ShowS
$cshowsPrec :: Int -> RTT0Status -> ShowS
Show,RTT0Status -> RTT0Status -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RTT0Status -> RTT0Status -> Bool
$c/= :: RTT0Status -> RTT0Status -> Bool
== :: RTT0Status -> RTT0Status -> Bool
$c== :: RTT0Status -> RTT0Status -> Bool
Eq)

setTLS13RTT0Status :: RTT0Status -> HandshakeM ()
setTLS13RTT0Status :: RTT0Status -> HandshakeM ()
setTLS13RTT0Status RTT0Status
s = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstTLS13RTT0Status :: RTT0Status
hstTLS13RTT0Status = RTT0Status
s })

getTLS13RTT0Status :: HandshakeM RTT0Status
getTLS13RTT0Status :: HandshakeM RTT0Status
getTLS13RTT0Status = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> RTT0Status
hstTLS13RTT0Status

setTLS13EarlySecret :: BaseSecret EarlySecret -> HandshakeM ()
setTLS13EarlySecret :: BaseSecret EarlySecret -> HandshakeM ()
setTLS13EarlySecret BaseSecret EarlySecret
secret = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstTLS13EarlySecret :: Maybe (BaseSecret EarlySecret)
hstTLS13EarlySecret = forall a. a -> Maybe a
Just BaseSecret EarlySecret
secret })

getTLS13EarlySecret :: HandshakeM (Maybe (BaseSecret EarlySecret))
getTLS13EarlySecret :: HandshakeM (Maybe (BaseSecret EarlySecret))
getTLS13EarlySecret = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe (BaseSecret EarlySecret)
hstTLS13EarlySecret

setTLS13ResumptionSecret :: BaseSecret ResumptionSecret -> HandshakeM ()
setTLS13ResumptionSecret :: BaseSecret ResumptionSecret -> HandshakeM ()
setTLS13ResumptionSecret BaseSecret ResumptionSecret
secret = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstTLS13ResumptionSecret :: Maybe (BaseSecret ResumptionSecret)
hstTLS13ResumptionSecret = forall a. a -> Maybe a
Just BaseSecret ResumptionSecret
secret })

getTLS13ResumptionSecret :: HandshakeM (Maybe (BaseSecret ResumptionSecret))
getTLS13ResumptionSecret :: HandshakeM (Maybe (BaseSecret ResumptionSecret))
getTLS13ResumptionSecret = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe (BaseSecret ResumptionSecret)
hstTLS13ResumptionSecret

setCCS13Sent :: Bool -> HandshakeM ()
setCCS13Sent :: Bool -> HandshakeM ()
setCCS13Sent Bool
sent = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstCCS13Sent :: Bool
hstCCS13Sent = Bool
sent })

getCCS13Sent :: HandshakeM Bool
getCCS13Sent :: HandshakeM Bool
getCCS13Sent = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Bool
hstCCS13Sent

setCertReqSent :: Bool -> HandshakeM ()
setCertReqSent :: Bool -> HandshakeM ()
setCertReqSent Bool
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstCertReqSent :: Bool
hstCertReqSent = Bool
b })

getCertReqSent :: HandshakeM Bool
getCertReqSent :: HandshakeM Bool
getCertReqSent = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Bool
hstCertReqSent

setClientCertSent :: Bool -> HandshakeM ()
setClientCertSent :: Bool -> HandshakeM ()
setClientCertSent Bool
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstClientCertSent :: Bool
hstClientCertSent = Bool
b })

getClientCertSent :: HandshakeM Bool
getClientCertSent :: HandshakeM Bool
getClientCertSent = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Bool
hstClientCertSent

setClientCertChain :: CertificateChain -> HandshakeM ()
setClientCertChain :: CertificateChain -> HandshakeM ()
setClientCertChain CertificateChain
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstClientCertChain :: Maybe CertificateChain
hstClientCertChain = forall a. a -> Maybe a
Just CertificateChain
b })

getClientCertChain :: HandshakeM (Maybe CertificateChain)
getClientCertChain :: HandshakeM (Maybe CertificateChain)
getClientCertChain = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe CertificateChain
hstClientCertChain

--
setCertReqToken :: Maybe ByteString -> HandshakeM ()
setCertReqToken :: Maybe ByteString -> HandshakeM ()
setCertReqToken Maybe ByteString
token = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \HandshakeState
hst -> HandshakeState
hst { hstCertReqToken :: Maybe ByteString
hstCertReqToken = Maybe ByteString
token }

getCertReqToken :: HandshakeM (Maybe ByteString)
getCertReqToken :: HandshakeM (Maybe ByteString)
getCertReqToken = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe ByteString
hstCertReqToken

--
setCertReqCBdata :: Maybe CertReqCBdata -> HandshakeM ()
setCertReqCBdata :: Maybe CertReqCBdata -> HandshakeM ()
setCertReqCBdata Maybe CertReqCBdata
d = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\HandshakeState
hst -> HandshakeState
hst { hstCertReqCBdata :: Maybe CertReqCBdata
hstCertReqCBdata = Maybe CertReqCBdata
d })

getCertReqCBdata :: HandshakeM (Maybe CertReqCBdata)
getCertReqCBdata :: HandshakeM (Maybe CertReqCBdata)
getCertReqCBdata = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe CertReqCBdata
hstCertReqCBdata

-- Dead code, until we find some use for the extension
setCertReqSigAlgsCert :: Maybe [HashAndSignatureAlgorithm] -> HandshakeM ()
setCertReqSigAlgsCert :: Maybe [HashAndSignatureAlgorithm] -> HandshakeM ()
setCertReqSigAlgsCert Maybe [HashAndSignatureAlgorithm]
as = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \HandshakeState
hst -> HandshakeState
hst { hstCertReqSigAlgsCert :: Maybe [HashAndSignatureAlgorithm]
hstCertReqSigAlgsCert = Maybe [HashAndSignatureAlgorithm]
as }

getCertReqSigAlgsCert :: HandshakeM (Maybe [HashAndSignatureAlgorithm])
getCertReqSigAlgsCert :: HandshakeM (Maybe [HashAndSignatureAlgorithm])
getCertReqSigAlgsCert = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe [HashAndSignatureAlgorithm]
hstCertReqSigAlgsCert

--
getPendingCipher :: HandshakeM Cipher
getPendingCipher :: HandshakeM Cipher
getPendingCipher = forall a. String -> Maybe a -> a
fromJust String
"pending cipher" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> Maybe Cipher
hstPendingCipher

addHandshakeMessage :: ByteString -> HandshakeM ()
addHandshakeMessage :: ByteString -> HandshakeM ()
addHandshakeMessage ByteString
content = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \HandshakeState
hs -> HandshakeState
hs { hstHandshakeMessages :: [ByteString]
hstHandshakeMessages = ByteString
content forall a. a -> [a] -> [a]
: HandshakeState -> [ByteString]
hstHandshakeMessages HandshakeState
hs}

getHandshakeMessages :: HandshakeM [ByteString]
getHandshakeMessages :: HandshakeM [ByteString]
getHandshakeMessages = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandshakeState -> [ByteString]
hstHandshakeMessages)

getHandshakeMessagesRev :: HandshakeM [ByteString]
getHandshakeMessagesRev :: HandshakeM [ByteString]
getHandshakeMessagesRev = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> [ByteString]
hstHandshakeMessages

updateHandshakeDigest :: ByteString -> HandshakeM ()
updateHandshakeDigest :: ByteString -> HandshakeM ()
updateHandshakeDigest ByteString
content = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \HandshakeState
hs -> HandshakeState
hs
    { hstHandshakeDigest :: HandshakeDigest
hstHandshakeDigest = case HandshakeState -> HandshakeDigest
hstHandshakeDigest HandshakeState
hs of
        HandshakeMessages [ByteString]
bytes        -> [ByteString] -> HandshakeDigest
HandshakeMessages (ByteString
contentforall a. a -> [a] -> [a]
:[ByteString]
bytes)
        HandshakeDigestContext HashCtx
hashCtx -> HashCtx -> HandshakeDigest
HandshakeDigestContext forall a b. (a -> b) -> a -> b
$ HashCtx -> ByteString -> HashCtx
hashUpdate HashCtx
hashCtx ByteString
content }

-- | Compress the whole transcript with the specified function.  Function @f@
-- takes the handshake digest as input and returns an encoded handshake message
-- to replace the transcript with.
foldHandshakeDigest :: Hash -> (ByteString -> ByteString) -> HandshakeM ()
foldHandshakeDigest :: Hash -> (ByteString -> ByteString) -> HandshakeM ()
foldHandshakeDigest Hash
hashAlg ByteString -> ByteString
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \HandshakeState
hs ->
    case HandshakeState -> HandshakeDigest
hstHandshakeDigest HandshakeState
hs of
        HandshakeMessages [ByteString]
bytes ->
            let hashCtx :: HashCtx
hashCtx  = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HashCtx -> ByteString -> HashCtx
hashUpdate (Hash -> HashCtx
hashInit Hash
hashAlg) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [ByteString]
bytes
                !folded :: ByteString
folded  = ByteString -> ByteString
f (HashCtx -> ByteString
hashFinal HashCtx
hashCtx)
             in HandshakeState
hs { hstHandshakeDigest :: HandshakeDigest
hstHandshakeDigest   = [ByteString] -> HandshakeDigest
HandshakeMessages [ByteString
folded]
                   , hstHandshakeMessages :: [ByteString]
hstHandshakeMessages = [ByteString
folded]
                   }
        HandshakeDigestContext HashCtx
hashCtx ->
            let !folded :: ByteString
folded  = ByteString -> ByteString
f (HashCtx -> ByteString
hashFinal HashCtx
hashCtx)
                hashCtx' :: HashCtx
hashCtx' = HashCtx -> ByteString -> HashCtx
hashUpdate (Hash -> HashCtx
hashInit Hash
hashAlg) ByteString
folded
             in HandshakeState
hs { hstHandshakeDigest :: HandshakeDigest
hstHandshakeDigest   = HashCtx -> HandshakeDigest
HandshakeDigestContext HashCtx
hashCtx'
                   , hstHandshakeMessages :: [ByteString]
hstHandshakeMessages = [ByteString
folded]
                   }

getSessionHash :: HandshakeM ByteString
getSessionHash :: HandshakeM ByteString
getSessionHash = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ \HandshakeState
hst ->
    case HandshakeState -> HandshakeDigest
hstHandshakeDigest HandshakeState
hst of
        HandshakeDigestContext HashCtx
hashCtx -> HashCtx -> ByteString
hashFinal HashCtx
hashCtx
        HandshakeMessages [ByteString]
_ -> forall a. HasCallStack => String -> a
error String
"un-initialized session hash"

getHandshakeDigest :: Version -> Role -> HandshakeM ByteString
getHandshakeDigest :: Version -> Role -> HandshakeM ByteString
getHandshakeDigest Version
ver Role
role = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HandshakeState -> ByteString
gen
  where gen :: HandshakeState -> ByteString
gen HandshakeState
hst = case HandshakeState -> HandshakeDigest
hstHandshakeDigest HandshakeState
hst of
                      HandshakeDigestContext HashCtx
hashCtx ->
                         let msecret :: ByteString
msecret = forall a. String -> Maybe a -> a
fromJust String
"master secret" forall a b. (a -> b) -> a -> b
$ HandshakeState -> Maybe ByteString
hstMasterSecret HandshakeState
hst
                             cipher :: Cipher
cipher  = forall a. String -> Maybe a -> a
fromJust String
"cipher" forall a b. (a -> b) -> a -> b
$ HandshakeState -> Maybe Cipher
hstPendingCipher HandshakeState
hst
                          in Version -> Cipher -> ByteString -> HashCtx -> ByteString
generateFinish Version
ver Cipher
cipher ByteString
msecret HashCtx
hashCtx
                      HandshakeMessages [ByteString]
_        ->
                         forall a. HasCallStack => String -> a
error String
"un-initialized handshake digest"
        generateFinish :: Version -> Cipher -> ByteString -> HashCtx -> ByteString
generateFinish | Role
role forall a. Eq a => a -> a -> Bool
== Role
ClientRole = Version -> Cipher -> ByteString -> HashCtx -> ByteString
generateClientFinished
                       | Bool
otherwise          = Version -> Cipher -> ByteString -> HashCtx -> ByteString
generateServerFinished

-- | Generate the master secret from the pre master secret.
setMasterSecretFromPre :: ByteArrayAccess preMaster
                       => Version   -- ^ chosen transmission version
                       -> Role      -- ^ the role (Client or Server) of the generating side
                       -> preMaster -- ^ the pre master secret
                       -> HandshakeM ByteString
setMasterSecretFromPre :: forall preMaster.
ByteArrayAccess preMaster =>
Version -> Role -> preMaster -> HandshakeM ByteString
setMasterSecretFromPre Version
ver Role
role preMaster
premasterSecret = do
    Bool
ems <- HandshakeM Bool
getExtendedMasterSec
    ByteString
secret <- if Bool
ems then forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HandshakeState -> HandshakeM ByteString
genExtendedSecret else HandshakeState -> ByteString
genSecret forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
    Version -> Role -> ByteString -> HandshakeM ()
setMasterSecret Version
ver Role
role ByteString
secret
    forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
secret
  where genSecret :: HandshakeState -> ByteString
genSecret HandshakeState
hst =
            forall preMaster.
ByteArrayAccess preMaster =>
Version
-> Cipher
-> preMaster
-> ClientRandom
-> ServerRandom
-> ByteString
generateMasterSecret Version
ver (forall a. String -> Maybe a -> a
fromJust String
"cipher" forall a b. (a -> b) -> a -> b
$ HandshakeState -> Maybe Cipher
hstPendingCipher HandshakeState
hst)
                                 preMaster
premasterSecret
                                 (HandshakeState -> ClientRandom
hstClientRandom HandshakeState
hst)
                                 (forall a. String -> Maybe a -> a
fromJust String
"server random" forall a b. (a -> b) -> a -> b
$ HandshakeState -> Maybe ServerRandom
hstServerRandom HandshakeState
hst)
        genExtendedSecret :: HandshakeState -> HandshakeM ByteString
genExtendedSecret HandshakeState
hst =
            forall preMaster.
ByteArrayAccess preMaster =>
Version -> Cipher -> preMaster -> ByteString -> ByteString
generateExtendedMasterSec Version
ver (forall a. String -> Maybe a -> a
fromJust String
"cipher" forall a b. (a -> b) -> a -> b
$ HandshakeState -> Maybe Cipher
hstPendingCipher HandshakeState
hst)
                                      preMaster
premasterSecret
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HandshakeM ByteString
getSessionHash

-- | Set master secret and as a side effect generate the key block
-- with all the right parameters, and setup the pending tx/rx state.
setMasterSecret :: Version -> Role -> ByteString -> HandshakeM ()
setMasterSecret :: Version -> Role -> ByteString -> HandshakeM ()
setMasterSecret Version
ver Role
role ByteString
masterSecret = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \HandshakeState
hst ->
    let (RecordState
pendingTx, RecordState
pendingRx) = HandshakeState
-> ByteString -> Version -> Role -> (RecordState, RecordState)
computeKeyBlock HandshakeState
hst ByteString
masterSecret Version
ver Role
role
     in HandshakeState
hst { hstMasterSecret :: Maybe ByteString
hstMasterSecret   = forall a. a -> Maybe a
Just ByteString
masterSecret
            , hstPendingTxState :: Maybe RecordState
hstPendingTxState = forall a. a -> Maybe a
Just RecordState
pendingTx
            , hstPendingRxState :: Maybe RecordState
hstPendingRxState = forall a. a -> Maybe a
Just RecordState
pendingRx }

computeKeyBlock :: HandshakeState -> ByteString -> Version -> Role -> (RecordState, RecordState)
computeKeyBlock :: HandshakeState
-> ByteString -> Version -> Role -> (RecordState, RecordState)
computeKeyBlock HandshakeState
hst ByteString
masterSecret Version
ver Role
cc = (RecordState
pendingTx, RecordState
pendingRx)
  where cipher :: Cipher
cipher       = forall a. String -> Maybe a -> a
fromJust String
"cipher" forall a b. (a -> b) -> a -> b
$ HandshakeState -> Maybe Cipher
hstPendingCipher HandshakeState
hst
        keyblockSize :: Int
keyblockSize = Cipher -> Int
cipherKeyBlockSize Cipher
cipher

        bulk :: Bulk
bulk         = Cipher -> Bulk
cipherBulk Cipher
cipher
        digestSize :: Int
digestSize   = if BulkFunctions -> Bool
hasMAC (Bulk -> BulkFunctions
bulkF Bulk
bulk) then Hash -> Int
hashDigestSize (Cipher -> Hash
cipherHash Cipher
cipher)
                                              else Int
0
        keySize :: Int
keySize      = Bulk -> Int
bulkKeySize Bulk
bulk
        ivSize :: Int
ivSize       = Bulk -> Int
bulkIVSize Bulk
bulk
        kb :: ByteString
kb           = Version
-> Cipher
-> ClientRandom
-> ServerRandom
-> ByteString
-> Int
-> ByteString
generateKeyBlock Version
ver Cipher
cipher (HandshakeState -> ClientRandom
hstClientRandom HandshakeState
hst)
                                        (forall a. String -> Maybe a -> a
fromJust String
"server random" forall a b. (a -> b) -> a -> b
$ HandshakeState -> Maybe ServerRandom
hstServerRandom HandshakeState
hst)
                                        ByteString
masterSecret Int
keyblockSize

        (ByteString
cMACSecret, ByteString
sMACSecret, ByteString
cWriteKey, ByteString
sWriteKey, ByteString
cWriteIV, ByteString
sWriteIV) =
                    forall a. String -> Maybe a -> a
fromJust String
"p6" forall a b. (a -> b) -> a -> b
$ ByteString
-> (Int, Int, Int, Int, Int, Int)
-> Maybe
     (ByteString, ByteString, ByteString, ByteString, ByteString,
      ByteString)
partition6 ByteString
kb (Int
digestSize, Int
digestSize, Int
keySize, Int
keySize, Int
ivSize, Int
ivSize)

        cstClient :: CryptState
cstClient = CryptState { cstKey :: BulkState
cstKey        = Bulk -> BulkDirection -> ByteString -> BulkState
bulkInit Bulk
bulk (BulkDirection
BulkEncrypt forall {p}. p -> p -> p
`orOnServer` BulkDirection
BulkDecrypt) ByteString
cWriteKey
                               , cstIV :: ByteString
cstIV         = ByteString
cWriteIV
                               , cstMacSecret :: ByteString
cstMacSecret  = ByteString
cMACSecret }
        cstServer :: CryptState
cstServer = CryptState { cstKey :: BulkState
cstKey        = Bulk -> BulkDirection -> ByteString -> BulkState
bulkInit Bulk
bulk (BulkDirection
BulkDecrypt forall {p}. p -> p -> p
`orOnServer` BulkDirection
BulkEncrypt) ByteString
sWriteKey
                               , cstIV :: ByteString
cstIV         = ByteString
sWriteIV
                               , cstMacSecret :: ByteString
cstMacSecret  = ByteString
sMACSecret }
        msClient :: MacState
msClient = MacState { msSequence :: Word64
msSequence = Word64
0 }
        msServer :: MacState
msServer = MacState { msSequence :: Word64
msSequence = Word64
0 }

        pendingTx :: RecordState
pendingTx = RecordState
                  { stCryptState :: CryptState
stCryptState  = if Role
cc forall a. Eq a => a -> a -> Bool
== Role
ClientRole then CryptState
cstClient else CryptState
cstServer
                  , stMacState :: MacState
stMacState    = if Role
cc forall a. Eq a => a -> a -> Bool
== Role
ClientRole then MacState
msClient else MacState
msServer
                  , stCryptLevel :: CryptLevel
stCryptLevel  = CryptLevel
CryptMasterSecret
                  , stCipher :: Maybe Cipher
stCipher      = forall a. a -> Maybe a
Just Cipher
cipher
                  , stCompression :: Compression
stCompression = HandshakeState -> Compression
hstPendingCompression HandshakeState
hst
                  }
        pendingRx :: RecordState
pendingRx = RecordState
                  { stCryptState :: CryptState
stCryptState  = if Role
cc forall a. Eq a => a -> a -> Bool
== Role
ClientRole then CryptState
cstServer else CryptState
cstClient
                  , stMacState :: MacState
stMacState    = if Role
cc forall a. Eq a => a -> a -> Bool
== Role
ClientRole then MacState
msServer else MacState
msClient
                  , stCryptLevel :: CryptLevel
stCryptLevel  = CryptLevel
CryptMasterSecret
                  , stCipher :: Maybe Cipher
stCipher      = forall a. a -> Maybe a
Just Cipher
cipher
                  , stCompression :: Compression
stCompression = HandshakeState -> Compression
hstPendingCompression HandshakeState
hst
                  }

        orOnServer :: p -> p -> p
orOnServer p
f p
g = if Role
cc forall a. Eq a => a -> a -> Bool
== Role
ClientRole then p
f else p
g


setServerHelloParameters :: Version      -- ^ chosen version
                         -> ServerRandom
                         -> Cipher
                         -> Compression
                         -> HandshakeM ()
setServerHelloParameters :: Version -> ServerRandom -> Cipher -> Compression -> HandshakeM ()
setServerHelloParameters Version
ver ServerRandom
sran Cipher
cipher Compression
compression = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \HandshakeState
hst -> HandshakeState
hst
                { hstServerRandom :: Maybe ServerRandom
hstServerRandom       = forall a. a -> Maybe a
Just ServerRandom
sran
                , hstPendingCipher :: Maybe Cipher
hstPendingCipher      = forall a. a -> Maybe a
Just Cipher
cipher
                , hstPendingCompression :: Compression
hstPendingCompression = Compression
compression
                , hstHandshakeDigest :: HandshakeDigest
hstHandshakeDigest    = HandshakeDigest -> HandshakeDigest
updateDigest forall a b. (a -> b) -> a -> b
$ HandshakeState -> HandshakeDigest
hstHandshakeDigest HandshakeState
hst
                }
  where hashAlg :: Hash
hashAlg = Version -> Cipher -> Hash
getHash Version
ver Cipher
cipher
        updateDigest :: HandshakeDigest -> HandshakeDigest
updateDigest (HandshakeMessages [ByteString]
bytes)  = HashCtx -> HandshakeDigest
HandshakeDigestContext forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HashCtx -> ByteString -> HashCtx
hashUpdate (Hash -> HashCtx
hashInit Hash
hashAlg) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [ByteString]
bytes
        updateDigest (HandshakeDigestContext HashCtx
_) = forall a. HasCallStack => String -> a
error String
"cannot initialize digest with another digest"

-- The TLS12 Hash is cipher specific, and some TLS12 algorithms use SHA384
-- instead of the default SHA256.
getHash :: Version -> Cipher -> Hash
getHash :: Version -> Cipher -> Hash
getHash Version
ver Cipher
ciph
    | Version
ver forall a. Ord a => a -> a -> Bool
< Version
TLS12                              = Hash
SHA1_MD5
    | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> a -> Bool
< Version
TLS12) (Cipher -> Maybe Version
cipherMinVer Cipher
ciph) = Hash
SHA256
    | Bool
otherwise                                = Cipher -> Hash
cipherHash Cipher
ciph