{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- Module      : Network.TLS.State
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- the State module contains calls related to state initialization/manipulation
-- which is use by the Receiving module and the Sending module.
--
module Network.TLS.State
    ( TLSState(..)
    , TLSSt
    , runTLSState
    , newTLSState
    , withTLSRNG
    , updateVerifiedData
    , finishHandshakeTypeMaterial
    , finishHandshakeMaterial
    , certVerifyHandshakeTypeMaterial
    , certVerifyHandshakeMaterial
    , setVersion
    , setVersionIfUnset
    , getVersion
    , getVersionWithDefault
    , setSecureRenegotiation
    , getSecureRenegotiation
    , setExtensionALPN
    , getExtensionALPN
    , setNegotiatedProtocol
    , getNegotiatedProtocol
    , setClientALPNSuggest
    , getClientALPNSuggest
    , setClientEcPointFormatSuggest
    , getClientEcPointFormatSuggest
    , getClientCertificateChain
    , setClientCertificateChain
    , setClientSNI
    , getClientSNI
    , getVerifiedData
    , setSession
    , getSession
    , isSessionResuming
    , isClientContext
    , setExporterMasterSecret
    , getExporterMasterSecret
    , setTLS13KeyShare
    , getTLS13KeyShare
    , setTLS13PreSharedKey
    , getTLS13PreSharedKey
    , setTLS13HRR
    , getTLS13HRR
    , setTLS13Cookie
    , getTLS13Cookie
    , setClientSupportsPHA
    , getClientSupportsPHA
    -- * random
    , genRandom
    , withRNG
    ) where

import Network.TLS.Imports
import Network.TLS.Struct
import Network.TLS.Struct13
import Network.TLS.RNG
import Network.TLS.Types (Role(..), HostName)
import Network.TLS.Wire (GetContinuation)
import Network.TLS.Extension
import qualified Data.ByteString as B
import Control.Monad.State.Strict
import Network.TLS.ErrT
import Crypto.Random
import Data.X509 (CertificateChain)

data TLSState = TLSState
    { TLSState -> Session
stSession             :: Session
    , TLSState -> Bool
stSessionResuming     :: Bool
    , TLSState -> Bool
stSecureRenegotiation :: Bool  -- RFC 5746
    , TLSState -> ByteString
stClientVerifiedData  :: ByteString -- RFC 5746
    , TLSState -> ByteString
stServerVerifiedData  :: ByteString -- RFC 5746
    , TLSState -> Bool
stExtensionALPN       :: Bool  -- RFC 7301
    , TLSState -> Maybe (GetContinuation (HandshakeType, ByteString))
stHandshakeRecordCont :: Maybe (GetContinuation (HandshakeType, ByteString))
    , TLSState -> Maybe ByteString
stNegotiatedProtocol  :: Maybe B.ByteString -- ALPN protocol
    , TLSState -> Maybe (GetContinuation (HandshakeType13, ByteString))
stHandshakeRecordCont13 :: Maybe (GetContinuation (HandshakeType13, ByteString))
    , TLSState -> Maybe [ByteString]
stClientALPNSuggest   :: Maybe [B.ByteString]
    , TLSState -> Maybe [Group]
stClientGroupSuggest  :: Maybe [Group]
    , TLSState -> Maybe [EcPointFormat]
stClientEcPointFormatSuggest :: Maybe [EcPointFormat]
    , TLSState -> Maybe CertificateChain
stClientCertificateChain :: Maybe CertificateChain
    , TLSState -> Maybe HostName
stClientSNI           :: Maybe HostName
    , TLSState -> StateRNG
stRandomGen           :: StateRNG
    , TLSState -> Maybe Version
stVersion             :: Maybe Version
    , TLSState -> Role
stClientContext       :: Role
    , TLSState -> Maybe KeyShare
stTLS13KeyShare       :: Maybe KeyShare
    , TLSState -> Maybe PreSharedKey
stTLS13PreSharedKey   :: Maybe PreSharedKey
    , TLSState -> Bool
stTLS13HRR            :: !Bool
    , TLSState -> Maybe Cookie
stTLS13Cookie         :: Maybe Cookie
    , TLSState -> Maybe ByteString
stExporterMasterSecret :: Maybe ByteString -- TLS 1.3
    , TLSState -> Bool
stClientSupportsPHA   :: !Bool -- Post-Handshake Authentication (TLS 1.3)
    }

newtype TLSSt a = TLSSt { TLSSt a -> ErrT TLSError (State TLSState) a
runTLSSt :: ErrT TLSError (State TLSState) a }
    deriving (Applicative TLSSt
a -> TLSSt a
Applicative TLSSt
-> (forall a b. TLSSt a -> (a -> TLSSt b) -> TLSSt b)
-> (forall a b. TLSSt a -> TLSSt b -> TLSSt b)
-> (forall a. a -> TLSSt a)
-> Monad TLSSt
TLSSt a -> (a -> TLSSt b) -> TLSSt b
TLSSt a -> TLSSt b -> TLSSt b
forall a. a -> TLSSt a
forall a b. TLSSt a -> TLSSt b -> TLSSt b
forall a b. TLSSt a -> (a -> TLSSt b) -> TLSSt 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 :: a -> TLSSt a
$creturn :: forall a. a -> TLSSt a
>> :: TLSSt a -> TLSSt b -> TLSSt b
$c>> :: forall a b. TLSSt a -> TLSSt b -> TLSSt b
>>= :: TLSSt a -> (a -> TLSSt b) -> TLSSt b
$c>>= :: forall a b. TLSSt a -> (a -> TLSSt b) -> TLSSt b
$cp1Monad :: Applicative TLSSt
Monad, MonadError TLSError, a -> TLSSt b -> TLSSt a
(a -> b) -> TLSSt a -> TLSSt b
(forall a b. (a -> b) -> TLSSt a -> TLSSt b)
-> (forall a b. a -> TLSSt b -> TLSSt a) -> Functor TLSSt
forall a b. a -> TLSSt b -> TLSSt a
forall a b. (a -> b) -> TLSSt a -> TLSSt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TLSSt b -> TLSSt a
$c<$ :: forall a b. a -> TLSSt b -> TLSSt a
fmap :: (a -> b) -> TLSSt a -> TLSSt b
$cfmap :: forall a b. (a -> b) -> TLSSt a -> TLSSt b
Functor, Functor TLSSt
a -> TLSSt a
Functor TLSSt
-> (forall a. a -> TLSSt a)
-> (forall a b. TLSSt (a -> b) -> TLSSt a -> TLSSt b)
-> (forall a b c. (a -> b -> c) -> TLSSt a -> TLSSt b -> TLSSt c)
-> (forall a b. TLSSt a -> TLSSt b -> TLSSt b)
-> (forall a b. TLSSt a -> TLSSt b -> TLSSt a)
-> Applicative TLSSt
TLSSt a -> TLSSt b -> TLSSt b
TLSSt a -> TLSSt b -> TLSSt a
TLSSt (a -> b) -> TLSSt a -> TLSSt b
(a -> b -> c) -> TLSSt a -> TLSSt b -> TLSSt c
forall a. a -> TLSSt a
forall a b. TLSSt a -> TLSSt b -> TLSSt a
forall a b. TLSSt a -> TLSSt b -> TLSSt b
forall a b. TLSSt (a -> b) -> TLSSt a -> TLSSt b
forall a b c. (a -> b -> c) -> TLSSt a -> TLSSt b -> TLSSt 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
<* :: TLSSt a -> TLSSt b -> TLSSt a
$c<* :: forall a b. TLSSt a -> TLSSt b -> TLSSt a
*> :: TLSSt a -> TLSSt b -> TLSSt b
$c*> :: forall a b. TLSSt a -> TLSSt b -> TLSSt b
liftA2 :: (a -> b -> c) -> TLSSt a -> TLSSt b -> TLSSt c
$cliftA2 :: forall a b c. (a -> b -> c) -> TLSSt a -> TLSSt b -> TLSSt c
<*> :: TLSSt (a -> b) -> TLSSt a -> TLSSt b
$c<*> :: forall a b. TLSSt (a -> b) -> TLSSt a -> TLSSt b
pure :: a -> TLSSt a
$cpure :: forall a. a -> TLSSt a
$cp1Applicative :: Functor TLSSt
Applicative)

instance MonadState TLSState TLSSt where
    put :: TLSState -> TLSSt ()
put TLSState
x = ErrT TLSError (State TLSState) () -> TLSSt ()
forall a. ErrT TLSError (State TLSState) a -> TLSSt a
TLSSt (State TLSState () -> ErrT TLSError (State TLSState) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State TLSState () -> ErrT TLSError (State TLSState) ())
-> State TLSState () -> ErrT TLSError (State TLSState) ()
forall a b. (a -> b) -> a -> b
$ TLSState -> State TLSState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put TLSState
x)
    get :: TLSSt TLSState
get   = ErrT TLSError (State TLSState) TLSState -> TLSSt TLSState
forall a. ErrT TLSError (State TLSState) a -> TLSSt a
TLSSt (State TLSState TLSState -> ErrT TLSError (State TLSState) TLSState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift State TLSState TLSState
forall s (m :: * -> *). MonadState s m => m s
get)
#if MIN_VERSION_mtl(2,1,0)
    state :: (TLSState -> (a, TLSState)) -> TLSSt a
state TLSState -> (a, TLSState)
f = ErrT TLSError (State TLSState) a -> TLSSt a
forall a. ErrT TLSError (State TLSState) a -> TLSSt a
TLSSt (State TLSState a -> ErrT TLSError (State TLSState) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State TLSState a -> ErrT TLSError (State TLSState) a)
-> State TLSState a -> ErrT TLSError (State TLSState) a
forall a b. (a -> b) -> a -> b
$ (TLSState -> (a, TLSState)) -> State TLSState a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state TLSState -> (a, TLSState)
f)
#endif

runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState)
runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState)
runTLSState TLSSt a
f TLSState
st = State TLSState (Either TLSError a)
-> TLSState -> (Either TLSError a, TLSState)
forall s a. State s a -> s -> (a, s)
runState (ExceptT TLSError (State TLSState) a
-> State TLSState (Either TLSError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runErrT (TLSSt a -> ExceptT TLSError (State TLSState) a
forall a. TLSSt a -> ErrT TLSError (State TLSState) a
runTLSSt TLSSt a
f)) TLSState
st

newTLSState :: StateRNG -> Role -> TLSState
newTLSState :: StateRNG -> Role -> TLSState
newTLSState StateRNG
rng Role
clientContext = TLSState :: Session
-> Bool
-> Bool
-> ByteString
-> ByteString
-> Bool
-> Maybe (GetContinuation (HandshakeType, ByteString))
-> Maybe ByteString
-> Maybe (GetContinuation (HandshakeType13, ByteString))
-> Maybe [ByteString]
-> Maybe [Group]
-> Maybe [EcPointFormat]
-> Maybe CertificateChain
-> Maybe HostName
-> StateRNG
-> Maybe Version
-> Role
-> Maybe KeyShare
-> Maybe PreSharedKey
-> Bool
-> Maybe Cookie
-> Maybe ByteString
-> Bool
-> TLSState
TLSState
    { stSession :: Session
stSession             = Maybe ByteString -> Session
Session Maybe ByteString
forall a. Maybe a
Nothing
    , stSessionResuming :: Bool
stSessionResuming     = Bool
False
    , stSecureRenegotiation :: Bool
stSecureRenegotiation = Bool
False
    , stClientVerifiedData :: ByteString
stClientVerifiedData  = ByteString
B.empty
    , stServerVerifiedData :: ByteString
stServerVerifiedData  = ByteString
B.empty
    , stExtensionALPN :: Bool
stExtensionALPN       = Bool
False
    , stHandshakeRecordCont :: Maybe (GetContinuation (HandshakeType, ByteString))
stHandshakeRecordCont = Maybe (GetContinuation (HandshakeType, ByteString))
forall a. Maybe a
Nothing
    , stHandshakeRecordCont13 :: Maybe (GetContinuation (HandshakeType13, ByteString))
stHandshakeRecordCont13 = Maybe (GetContinuation (HandshakeType13, ByteString))
forall a. Maybe a
Nothing
    , stNegotiatedProtocol :: Maybe ByteString
stNegotiatedProtocol  = Maybe ByteString
forall a. Maybe a
Nothing
    , stClientALPNSuggest :: Maybe [ByteString]
stClientALPNSuggest   = Maybe [ByteString]
forall a. Maybe a
Nothing
    , stClientGroupSuggest :: Maybe [Group]
stClientGroupSuggest  = Maybe [Group]
forall a. Maybe a
Nothing
    , stClientEcPointFormatSuggest :: Maybe [EcPointFormat]
stClientEcPointFormatSuggest = Maybe [EcPointFormat]
forall a. Maybe a
Nothing
    , stClientCertificateChain :: Maybe CertificateChain
stClientCertificateChain = Maybe CertificateChain
forall a. Maybe a
Nothing
    , stClientSNI :: Maybe HostName
stClientSNI           = Maybe HostName
forall a. Maybe a
Nothing
    , stRandomGen :: StateRNG
stRandomGen           = StateRNG
rng
    , stVersion :: Maybe Version
stVersion             = Maybe Version
forall a. Maybe a
Nothing
    , stClientContext :: Role
stClientContext       = Role
clientContext
    , stTLS13KeyShare :: Maybe KeyShare
stTLS13KeyShare       = Maybe KeyShare
forall a. Maybe a
Nothing
    , stTLS13PreSharedKey :: Maybe PreSharedKey
stTLS13PreSharedKey   = Maybe PreSharedKey
forall a. Maybe a
Nothing
    , stTLS13HRR :: Bool
stTLS13HRR            = Bool
False
    , stTLS13Cookie :: Maybe Cookie
stTLS13Cookie         = Maybe Cookie
forall a. Maybe a
Nothing
    , stExporterMasterSecret :: Maybe ByteString
stExporterMasterSecret = Maybe ByteString
forall a. Maybe a
Nothing
    , stClientSupportsPHA :: Bool
stClientSupportsPHA   = Bool
False
    }

updateVerifiedData :: Role -> ByteString -> TLSSt ()
updateVerifiedData :: Role -> ByteString -> TLSSt ()
updateVerifiedData Role
sending ByteString
bs = do
    Role
cc <- TLSSt Role
isClientContext
    if Role
cc Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
/= Role
sending
        then (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stServerVerifiedData :: ByteString
stServerVerifiedData = ByteString
bs })
        else (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stClientVerifiedData :: ByteString
stClientVerifiedData = ByteString
bs })

finishHandshakeTypeMaterial :: HandshakeType -> Bool
finishHandshakeTypeMaterial :: HandshakeType -> Bool
finishHandshakeTypeMaterial HandshakeType
HandshakeType_ClientHello     = Bool
True
finishHandshakeTypeMaterial HandshakeType
HandshakeType_ServerHello     = Bool
True
finishHandshakeTypeMaterial HandshakeType
HandshakeType_Certificate     = Bool
True
finishHandshakeTypeMaterial HandshakeType
HandshakeType_HelloRequest    = Bool
False
finishHandshakeTypeMaterial HandshakeType
HandshakeType_ServerHelloDone = Bool
True
finishHandshakeTypeMaterial HandshakeType
HandshakeType_ClientKeyXchg   = Bool
True
finishHandshakeTypeMaterial HandshakeType
HandshakeType_ServerKeyXchg   = Bool
True
finishHandshakeTypeMaterial HandshakeType
HandshakeType_CertRequest     = Bool
True
finishHandshakeTypeMaterial HandshakeType
HandshakeType_CertVerify      = Bool
True
finishHandshakeTypeMaterial HandshakeType
HandshakeType_Finished        = Bool
True

finishHandshakeMaterial :: Handshake -> Bool
finishHandshakeMaterial :: Handshake -> Bool
finishHandshakeMaterial = HandshakeType -> Bool
finishHandshakeTypeMaterial (HandshakeType -> Bool)
-> (Handshake -> HandshakeType) -> Handshake -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handshake -> HandshakeType
typeOfHandshake

certVerifyHandshakeTypeMaterial :: HandshakeType -> Bool
certVerifyHandshakeTypeMaterial :: HandshakeType -> Bool
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_ClientHello     = Bool
True
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_ServerHello     = Bool
True
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_Certificate     = Bool
True
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_HelloRequest    = Bool
False
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_ServerHelloDone = Bool
True
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_ClientKeyXchg   = Bool
True
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_ServerKeyXchg   = Bool
True
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_CertRequest     = Bool
True
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_CertVerify      = Bool
False
certVerifyHandshakeTypeMaterial HandshakeType
HandshakeType_Finished        = Bool
False

certVerifyHandshakeMaterial :: Handshake -> Bool
certVerifyHandshakeMaterial :: Handshake -> Bool
certVerifyHandshakeMaterial = HandshakeType -> Bool
certVerifyHandshakeTypeMaterial (HandshakeType -> Bool)
-> (Handshake -> HandshakeType) -> Handshake -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handshake -> HandshakeType
typeOfHandshake

setSession :: Session -> Bool -> TLSSt ()
setSession :: Session -> Bool -> TLSSt ()
setSession Session
session Bool
resuming = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stSession :: Session
stSession = Session
session, stSessionResuming :: Bool
stSessionResuming = Bool
resuming })

getSession :: TLSSt Session
getSession :: TLSSt Session
getSession = (TLSState -> Session) -> TLSSt Session
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Session
stSession

isSessionResuming :: TLSSt Bool
isSessionResuming :: TLSSt Bool
isSessionResuming = (TLSState -> Bool) -> TLSSt Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Bool
stSessionResuming

setVersion :: Version -> TLSSt ()
setVersion :: Version -> TLSSt ()
setVersion Version
ver = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stVersion :: Maybe Version
stVersion = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver })

setVersionIfUnset :: Version -> TLSSt ()
setVersionIfUnset :: Version -> TLSSt ()
setVersionIfUnset Version
ver = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify TLSState -> TLSState
maybeSet
  where maybeSet :: TLSState -> TLSState
maybeSet TLSState
st = case TLSState -> Maybe Version
stVersion TLSState
st of
                           Maybe Version
Nothing -> TLSState
st { stVersion :: Maybe Version
stVersion = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver }
                           Just Version
_  -> TLSState
st

getVersion :: TLSSt Version
getVersion :: TLSSt Version
getVersion = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe (HostName -> Version
forall a. HasCallStack => HostName -> a
error HostName
"internal error: version hasn't been set yet") (Maybe Version -> Version)
-> TLSSt (Maybe Version) -> TLSSt Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TLSState -> Maybe Version) -> TLSSt (Maybe Version)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe Version
stVersion

getVersionWithDefault :: Version -> TLSSt Version
getVersionWithDefault :: Version -> TLSSt Version
getVersionWithDefault Version
defaultVer = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe Version
defaultVer (Maybe Version -> Version)
-> TLSSt (Maybe Version) -> TLSSt Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TLSState -> Maybe Version) -> TLSSt (Maybe Version)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe Version
stVersion

setSecureRenegotiation :: Bool -> TLSSt ()
setSecureRenegotiation :: Bool -> TLSSt ()
setSecureRenegotiation Bool
b = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stSecureRenegotiation :: Bool
stSecureRenegotiation = Bool
b })

getSecureRenegotiation :: TLSSt Bool
getSecureRenegotiation :: TLSSt Bool
getSecureRenegotiation = (TLSState -> Bool) -> TLSSt Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Bool
stSecureRenegotiation

setExtensionALPN :: Bool -> TLSSt ()
setExtensionALPN :: Bool -> TLSSt ()
setExtensionALPN Bool
b = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stExtensionALPN :: Bool
stExtensionALPN = Bool
b })

getExtensionALPN :: TLSSt Bool
getExtensionALPN :: TLSSt Bool
getExtensionALPN = (TLSState -> Bool) -> TLSSt Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Bool
stExtensionALPN

setNegotiatedProtocol :: B.ByteString -> TLSSt ()
setNegotiatedProtocol :: ByteString -> TLSSt ()
setNegotiatedProtocol ByteString
s = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stNegotiatedProtocol :: Maybe ByteString
stNegotiatedProtocol = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s })

getNegotiatedProtocol :: TLSSt (Maybe B.ByteString)
getNegotiatedProtocol :: TLSSt (Maybe ByteString)
getNegotiatedProtocol = (TLSState -> Maybe ByteString) -> TLSSt (Maybe ByteString)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe ByteString
stNegotiatedProtocol

setClientALPNSuggest :: [B.ByteString] -> TLSSt ()
setClientALPNSuggest :: [ByteString] -> TLSSt ()
setClientALPNSuggest [ByteString]
ps = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stClientALPNSuggest :: Maybe [ByteString]
stClientALPNSuggest = [ByteString] -> Maybe [ByteString]
forall a. a -> Maybe a
Just [ByteString]
ps})

getClientALPNSuggest :: TLSSt (Maybe [B.ByteString])
getClientALPNSuggest :: TLSSt (Maybe [ByteString])
getClientALPNSuggest = (TLSState -> Maybe [ByteString]) -> TLSSt (Maybe [ByteString])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe [ByteString]
stClientALPNSuggest

setClientEcPointFormatSuggest :: [EcPointFormat] -> TLSSt ()
setClientEcPointFormatSuggest :: [EcPointFormat] -> TLSSt ()
setClientEcPointFormatSuggest [EcPointFormat]
epf = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stClientEcPointFormatSuggest :: Maybe [EcPointFormat]
stClientEcPointFormatSuggest = [EcPointFormat] -> Maybe [EcPointFormat]
forall a. a -> Maybe a
Just [EcPointFormat]
epf})

getClientEcPointFormatSuggest :: TLSSt (Maybe [EcPointFormat])
getClientEcPointFormatSuggest :: TLSSt (Maybe [EcPointFormat])
getClientEcPointFormatSuggest = (TLSState -> Maybe [EcPointFormat])
-> TLSSt (Maybe [EcPointFormat])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe [EcPointFormat]
stClientEcPointFormatSuggest

setClientCertificateChain :: CertificateChain -> TLSSt ()
setClientCertificateChain :: CertificateChain -> TLSSt ()
setClientCertificateChain CertificateChain
s = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stClientCertificateChain :: Maybe CertificateChain
stClientCertificateChain = CertificateChain -> Maybe CertificateChain
forall a. a -> Maybe a
Just CertificateChain
s })

getClientCertificateChain :: TLSSt (Maybe CertificateChain)
getClientCertificateChain :: TLSSt (Maybe CertificateChain)
getClientCertificateChain = (TLSState -> Maybe CertificateChain)
-> TLSSt (Maybe CertificateChain)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe CertificateChain
stClientCertificateChain

setClientSNI :: HostName -> TLSSt ()
setClientSNI :: HostName -> TLSSt ()
setClientSNI HostName
hn = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stClientSNI :: Maybe HostName
stClientSNI = HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
hn })

getClientSNI :: TLSSt (Maybe HostName)
getClientSNI :: TLSSt (Maybe HostName)
getClientSNI = (TLSState -> Maybe HostName) -> TLSSt (Maybe HostName)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe HostName
stClientSNI

getVerifiedData :: Role -> TLSSt ByteString
getVerifiedData :: Role -> TLSSt ByteString
getVerifiedData Role
client = (TLSState -> ByteString) -> TLSSt ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (if Role
client Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
ClientRole then TLSState -> ByteString
stClientVerifiedData else TLSState -> ByteString
stServerVerifiedData)

isClientContext :: TLSSt Role
isClientContext :: TLSSt Role
isClientContext = (TLSState -> Role) -> TLSSt Role
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Role
stClientContext

genRandom :: Int -> TLSSt ByteString
genRandom :: Int -> TLSSt ByteString
genRandom Int
n = do
    MonadPseudoRandom StateRNG ByteString -> TLSSt ByteString
forall a. MonadPseudoRandom StateRNG a -> TLSSt a
withRNG (Int -> MonadPseudoRandom StateRNG ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
n)

withRNG :: MonadPseudoRandom StateRNG a -> TLSSt a
withRNG :: MonadPseudoRandom StateRNG a -> TLSSt a
withRNG MonadPseudoRandom StateRNG a
f = do
    TLSState
st <- TLSSt TLSState
forall s (m :: * -> *). MonadState s m => m s
get
    let (a
a,StateRNG
rng') = StateRNG -> MonadPseudoRandom StateRNG a -> (a, StateRNG)
forall a. StateRNG -> MonadPseudoRandom StateRNG a -> (a, StateRNG)
withTLSRNG (TLSState -> StateRNG
stRandomGen TLSState
st) MonadPseudoRandom StateRNG a
f
    TLSState -> TLSSt ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (TLSState
st { stRandomGen :: StateRNG
stRandomGen = StateRNG
rng' })
    a -> TLSSt a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

setExporterMasterSecret :: ByteString -> TLSSt ()
setExporterMasterSecret :: ByteString -> TLSSt ()
setExporterMasterSecret ByteString
key = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stExporterMasterSecret :: Maybe ByteString
stExporterMasterSecret = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key })

getExporterMasterSecret :: TLSSt (Maybe ByteString)
getExporterMasterSecret :: TLSSt (Maybe ByteString)
getExporterMasterSecret = (TLSState -> Maybe ByteString) -> TLSSt (Maybe ByteString)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe ByteString
stExporterMasterSecret

setTLS13KeyShare :: Maybe KeyShare -> TLSSt ()
setTLS13KeyShare :: Maybe KeyShare -> TLSSt ()
setTLS13KeyShare Maybe KeyShare
mks = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stTLS13KeyShare :: Maybe KeyShare
stTLS13KeyShare = Maybe KeyShare
mks })

getTLS13KeyShare :: TLSSt (Maybe KeyShare)
getTLS13KeyShare :: TLSSt (Maybe KeyShare)
getTLS13KeyShare = (TLSState -> Maybe KeyShare) -> TLSSt (Maybe KeyShare)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe KeyShare
stTLS13KeyShare

setTLS13PreSharedKey :: Maybe PreSharedKey -> TLSSt ()
setTLS13PreSharedKey :: Maybe PreSharedKey -> TLSSt ()
setTLS13PreSharedKey Maybe PreSharedKey
mpsk = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stTLS13PreSharedKey :: Maybe PreSharedKey
stTLS13PreSharedKey = Maybe PreSharedKey
mpsk })

getTLS13PreSharedKey :: TLSSt (Maybe PreSharedKey)
getTLS13PreSharedKey :: TLSSt (Maybe PreSharedKey)
getTLS13PreSharedKey = (TLSState -> Maybe PreSharedKey) -> TLSSt (Maybe PreSharedKey)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe PreSharedKey
stTLS13PreSharedKey

setTLS13HRR :: Bool -> TLSSt ()
setTLS13HRR :: Bool -> TLSSt ()
setTLS13HRR Bool
b = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stTLS13HRR :: Bool
stTLS13HRR = Bool
b })

getTLS13HRR :: TLSSt Bool
getTLS13HRR :: TLSSt Bool
getTLS13HRR = (TLSState -> Bool) -> TLSSt Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Bool
stTLS13HRR

setTLS13Cookie :: Maybe Cookie -> TLSSt ()
setTLS13Cookie :: Maybe Cookie -> TLSSt ()
setTLS13Cookie Maybe Cookie
mcookie = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stTLS13Cookie :: Maybe Cookie
stTLS13Cookie = Maybe Cookie
mcookie })

getTLS13Cookie :: TLSSt (Maybe Cookie)
getTLS13Cookie :: TLSSt (Maybe Cookie)
getTLS13Cookie = (TLSState -> Maybe Cookie) -> TLSSt (Maybe Cookie)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe Cookie
stTLS13Cookie

setClientSupportsPHA :: Bool -> TLSSt ()
setClientSupportsPHA :: Bool -> TLSSt ()
setClientSupportsPHA Bool
b = (TLSState -> TLSState) -> TLSSt ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TLSState
st -> TLSState
st { stClientSupportsPHA :: Bool
stClientSupportsPHA = Bool
b })

getClientSupportsPHA :: TLSSt Bool
getClientSupportsPHA :: TLSSt Bool
getClientSupportsPHA = (TLSState -> Bool) -> TLSSt Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Bool
stClientSupportsPHA