{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.TLS.Context.Internal (
    -- * Context configuration
    ClientParams (..),
    ServerParams (..),
    defaultParamsClient,
    SessionID,
    SessionData (..),
    MaxFragmentEnum (..),
    Measurement (..),

    -- * Context object and accessor
    Context (..),
    Hooks (..),
    Established (..),
    PendingRecvAction (..),
    RecordLayer (..),
    Locks (..),
    RoleParams (..),
    ctxEOF,
    ctxEstablished,
    withLog,
    ctxWithHooks,
    contextModifyHooks,
    setEOF,
    setEstablished,
    contextFlush,
    contextClose,
    contextSend,
    contextRecv,
    updateRecordLayer,
    updateMeasure,
    withMeasure,
    withReadLock,
    withWriteLock,
    withStateLock,
    withRWLock,

    -- * information
    Information (..),
    contextGetInformation,

    -- * Using context states
    throwCore,
    failOnEitherError,
    usingState,
    usingState_,
    runTxRecordState,
    runRxRecordState,
    usingHState,
    getHState,
    saveHState,
    restoreHState,
    getStateRNG,
    tls13orLater,
    addCertRequest13,
    getCertRequest13,
    decideRecordVersion,

    -- * Misc
    HandshakeSync (..),
    TLS13State (..),
    defaultTLS13State,
    getTLS13State,
    modifyTLS13State,
    CipherChoice (..),
    makeCipherChoice,
) where

import Control.Concurrent.MVar
import Control.Exception (throwIO)
import Control.Monad.State.Strict
import qualified Data.ByteString as B
import Data.IORef
import Data.Tuple

import Network.TLS.Backend
import Network.TLS.Cipher
import Network.TLS.Crypto
import Network.TLS.Extension
import Network.TLS.Handshake.Control
import Network.TLS.Handshake.State
import Network.TLS.Hooks
import Network.TLS.Imports
import Network.TLS.Measurement
import Network.TLS.Parameters
import Network.TLS.Record
import Network.TLS.Record.State
import Network.TLS.State
import Network.TLS.Struct
import Network.TLS.Struct13
import Network.TLS.Types
import Network.TLS.Util

-- | A TLS Context keep tls specific state, parameters and backend information.
data Context
    = forall a.
      Monoid a =>
    Context
    { Context -> Backend
ctxBackend :: Backend
    -- ^ return the backend object associated with this context
    , Context -> Supported
ctxSupported :: Supported
    , Context -> Shared
ctxShared :: Shared
    , Context -> MVar TLSState
ctxTLSState :: MVar TLSState
    , Context -> IORef Measurement
ctxMeasurement :: IORef Measurement
    , Context -> IORef Bool
ctxEOF_ :: IORef Bool
    -- ^ has the handle EOFed or not.
    , Context -> IORef Established
ctxEstablished_ :: IORef Established
    -- ^ has the handshake been done and been successful.
    , Context -> MVar RecordState
ctxTxRecordState :: MVar RecordState
    -- ^ current TX record state
    , Context -> MVar RecordState
ctxRxRecordState :: MVar RecordState
    -- ^ current RX record state
    , Context -> MVar (Maybe HandshakeState)
ctxHandshakeState :: MVar (Maybe HandshakeState)
    -- ^ optional handshake state
    , Context -> RoleParams
ctxRoleParams :: RoleParams
    -- ^ hooks for this context
    , Context -> Locks
ctxLocks :: Locks
    , Context -> String -> IO ()
ctxKeyLogger :: String -> IO ()
    , Context -> IORef Hooks
ctxHooks :: IORef Hooks
    , -- TLS 1.3
      Context -> IORef TLS13State
ctxTLS13State :: IORef TLS13State
    , Context -> IORef [PendingRecvAction]
ctxPendingRecvActions :: IORef [PendingRecvAction]
    , Context -> IORef (Maybe (Context -> IO ()))
ctxPendingSendAction :: IORef (Maybe (Context -> IO ()))
    , Context -> IORef [Handshake13]
ctxCertRequests :: IORef [Handshake13]
    -- ^ pending post handshake authentication requests
    , -- QUIC
      ()
ctxRecordLayer :: RecordLayer a
    , Context -> HandshakeSync
ctxHandshakeSync :: HandshakeSync
    , Context -> Bool
ctxQUICMode :: Bool
    , -- Misc
      Context -> IORef Bool
ctxNeedEmptyPacket :: IORef Bool
    -- ^ empty packet workaround for CBC guessability.
    , Context -> Maybe Int
ctxFragmentSize :: Maybe Int
    -- ^ maximum size of plaintext fragments
    }

data RoleParams = RoleParams
    { RoleParams -> Context -> IO ()
doHandshake_ :: Context -> IO ()
    , RoleParams -> Context -> Handshake -> IO ()
doHandshakeWith_ :: Context -> Handshake -> IO ()
    , RoleParams -> Context -> IO Bool
doRequestCertificate_ :: Context -> IO Bool
    , RoleParams -> Context -> Handshake13 -> IO ()
doPostHandshakeAuthWith_ :: Context -> Handshake13 -> IO ()
    }

data Locks = Locks
    { Locks -> MVar ()
lockWrite :: MVar ()
    -- ^ lock to use for writing data (including updating the state)
    , Locks -> MVar ()
lockRead :: MVar ()
    -- ^ lock to use for reading data (including updating the state)
    , Locks -> MVar ()
lockState :: MVar ()
    -- ^ lock used during read/write when receiving and sending packet.
    -- it is usually nested in a write or read lock.
    }

data CipherChoice = CipherChoice
    { CipherChoice -> Version
cVersion :: Version
    , CipherChoice -> Cipher
cCipher :: Cipher
    , CipherChoice -> Hash
cHash :: Hash
    , CipherChoice -> ByteString
cZero :: ByteString
    }
    deriving (Int -> CipherChoice -> ShowS
[CipherChoice] -> ShowS
CipherChoice -> String
(Int -> CipherChoice -> ShowS)
-> (CipherChoice -> String)
-> ([CipherChoice] -> ShowS)
-> Show CipherChoice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CipherChoice -> ShowS
showsPrec :: Int -> CipherChoice -> ShowS
$cshow :: CipherChoice -> String
show :: CipherChoice -> String
$cshowList :: [CipherChoice] -> ShowS
showList :: [CipherChoice] -> ShowS
Show)

makeCipherChoice :: Version -> Cipher -> CipherChoice
makeCipherChoice :: Version -> Cipher -> CipherChoice
makeCipherChoice Version
ver Cipher
cipher = Version -> Cipher -> Hash -> ByteString -> CipherChoice
CipherChoice Version
ver Cipher
cipher Hash
h ByteString
zero
  where
    h :: Hash
h = Cipher -> Hash
cipherHash Cipher
cipher
    zero :: ByteString
zero = Int -> Word8 -> ByteString
B.replicate (Hash -> Int
hashDigestSize Hash
h) Word8
0

data TLS13State = TLS13State
    { TLS13State -> Bool
tls13stRecvNST :: Bool -- client
    , TLS13State -> Bool
tls13stSentClientCert :: Bool -- client
    , TLS13State -> Bool
tls13stRecvSF :: Bool -- client
    , TLS13State -> Bool
tls13stSentCF :: Bool -- client
    , TLS13State -> Bool
tls13stRecvCF :: Bool -- server
    , TLS13State -> Maybe ByteString
tls13stPendingRecvData :: Maybe ByteString -- client
    , TLS13State -> [ByteString] -> [ByteString]
tls13stPendingSentData :: [ByteString] -> [ByteString] -- client
    , TLS13State -> Millisecond
tls13stRTT :: Millisecond
    , TLS13State -> Bool
tls13st0RTT :: Bool -- client
    , TLS13State -> Bool
tls13st0RTTAccepted :: Bool -- client
    , TLS13State -> [ExtensionRaw]
tls13stClientExtensions :: [ExtensionRaw] -- client
    , TLS13State -> CipherChoice
tls13stChoice :: ~CipherChoice -- client
    , TLS13State -> Maybe (SecretTriple HandshakeSecret)
tls13stHsKey :: Maybe (SecretTriple HandshakeSecret) -- client
    -- Actuall session id for TLS 1.2, random value for TLS 1.3
    , TLS13State -> Session
tls13stSession :: Session
    , TLS13State -> [ExtensionID]
tls13stSentExtensions :: [ExtensionID]
    }

defaultTLS13State :: TLS13State
defaultTLS13State :: TLS13State
defaultTLS13State =
    TLS13State
        { tls13stRecvNST :: Bool
tls13stRecvNST = Bool
False
        , tls13stSentClientCert :: Bool
tls13stSentClientCert = Bool
False
        , tls13stRecvSF :: Bool
tls13stRecvSF = Bool
False
        , tls13stSentCF :: Bool
tls13stSentCF = Bool
False
        , tls13stRecvCF :: Bool
tls13stRecvCF = Bool
False
        , tls13stPendingRecvData :: Maybe ByteString
tls13stPendingRecvData = Maybe ByteString
forall a. Maybe a
Nothing
        , tls13stPendingSentData :: [ByteString] -> [ByteString]
tls13stPendingSentData = [ByteString] -> [ByteString]
forall a. a -> a
id
        , tls13stRTT :: Millisecond
tls13stRTT = Millisecond
0
        , tls13st0RTT :: Bool
tls13st0RTT = Bool
False
        , tls13st0RTTAccepted :: Bool
tls13st0RTTAccepted = Bool
False
        , tls13stClientExtensions :: [ExtensionRaw]
tls13stClientExtensions = []
        , tls13stChoice :: CipherChoice
tls13stChoice = CipherChoice
forall a. HasCallStack => a
undefined
        , tls13stHsKey :: Maybe (SecretTriple HandshakeSecret)
tls13stHsKey = Maybe (SecretTriple HandshakeSecret)
forall a. Maybe a
Nothing
        , tls13stSession :: Session
tls13stSession = Maybe ByteString -> Session
Session Maybe ByteString
forall a. Maybe a
Nothing
        , tls13stSentExtensions :: [ExtensionID]
tls13stSentExtensions = []
        }

getTLS13State :: Context -> IO TLS13State
getTLS13State :: Context -> IO TLS13State
getTLS13State Context{Bool
Maybe Int
MVar (Maybe HandshakeState)
MVar RecordState
MVar TLSState
IORef Bool
IORef [Handshake13]
IORef [PendingRecvAction]
IORef (Maybe (Context -> IO ()))
IORef Measurement
IORef Hooks
IORef Established
IORef TLS13State
Backend
Shared
Supported
RecordLayer a
HandshakeSync
Locks
RoleParams
String -> IO ()
ctxBackend :: Context -> Backend
ctxSupported :: Context -> Supported
ctxShared :: Context -> Shared
ctxTLSState :: Context -> MVar TLSState
ctxMeasurement :: Context -> IORef Measurement
ctxEOF_ :: Context -> IORef Bool
ctxEstablished_ :: Context -> IORef Established
ctxTxRecordState :: Context -> MVar RecordState
ctxRxRecordState :: Context -> MVar RecordState
ctxHandshakeState :: Context -> MVar (Maybe HandshakeState)
ctxRoleParams :: Context -> RoleParams
ctxLocks :: Context -> Locks
ctxKeyLogger :: Context -> String -> IO ()
ctxHooks :: Context -> IORef Hooks
ctxTLS13State :: Context -> IORef TLS13State
ctxPendingRecvActions :: Context -> IORef [PendingRecvAction]
ctxPendingSendAction :: Context -> IORef (Maybe (Context -> IO ()))
ctxCertRequests :: Context -> IORef [Handshake13]
ctxRecordLayer :: ()
ctxHandshakeSync :: Context -> HandshakeSync
ctxQUICMode :: Context -> Bool
ctxNeedEmptyPacket :: Context -> IORef Bool
ctxFragmentSize :: Context -> Maybe Int
ctxBackend :: Backend
ctxSupported :: Supported
ctxShared :: Shared
ctxTLSState :: MVar TLSState
ctxMeasurement :: IORef Measurement
ctxEOF_ :: IORef Bool
ctxEstablished_ :: IORef Established
ctxTxRecordState :: MVar RecordState
ctxRxRecordState :: MVar RecordState
ctxHandshakeState :: MVar (Maybe HandshakeState)
ctxRoleParams :: RoleParams
ctxLocks :: Locks
ctxKeyLogger :: String -> IO ()
ctxHooks :: IORef Hooks
ctxTLS13State :: IORef TLS13State
ctxPendingRecvActions :: IORef [PendingRecvAction]
ctxPendingSendAction :: IORef (Maybe (Context -> IO ()))
ctxCertRequests :: IORef [Handshake13]
ctxRecordLayer :: RecordLayer a
ctxHandshakeSync :: HandshakeSync
ctxQUICMode :: Bool
ctxNeedEmptyPacket :: IORef Bool
ctxFragmentSize :: Maybe Int
..} = IORef TLS13State -> IO TLS13State
forall a. IORef a -> IO a
readIORef IORef TLS13State
ctxTLS13State

modifyTLS13State :: Context -> (TLS13State -> TLS13State) -> IO ()
modifyTLS13State :: Context -> (TLS13State -> TLS13State) -> IO ()
modifyTLS13State Context{Bool
Maybe Int
MVar (Maybe HandshakeState)
MVar RecordState
MVar TLSState
IORef Bool
IORef [Handshake13]
IORef [PendingRecvAction]
IORef (Maybe (Context -> IO ()))
IORef Measurement
IORef Hooks
IORef Established
IORef TLS13State
Backend
Shared
Supported
RecordLayer a
HandshakeSync
Locks
RoleParams
String -> IO ()
ctxBackend :: Context -> Backend
ctxSupported :: Context -> Supported
ctxShared :: Context -> Shared
ctxTLSState :: Context -> MVar TLSState
ctxMeasurement :: Context -> IORef Measurement
ctxEOF_ :: Context -> IORef Bool
ctxEstablished_ :: Context -> IORef Established
ctxTxRecordState :: Context -> MVar RecordState
ctxRxRecordState :: Context -> MVar RecordState
ctxHandshakeState :: Context -> MVar (Maybe HandshakeState)
ctxRoleParams :: Context -> RoleParams
ctxLocks :: Context -> Locks
ctxKeyLogger :: Context -> String -> IO ()
ctxHooks :: Context -> IORef Hooks
ctxTLS13State :: Context -> IORef TLS13State
ctxPendingRecvActions :: Context -> IORef [PendingRecvAction]
ctxPendingSendAction :: Context -> IORef (Maybe (Context -> IO ()))
ctxCertRequests :: Context -> IORef [Handshake13]
ctxRecordLayer :: ()
ctxHandshakeSync :: Context -> HandshakeSync
ctxQUICMode :: Context -> Bool
ctxNeedEmptyPacket :: Context -> IORef Bool
ctxFragmentSize :: Context -> Maybe Int
ctxBackend :: Backend
ctxSupported :: Supported
ctxShared :: Shared
ctxTLSState :: MVar TLSState
ctxMeasurement :: IORef Measurement
ctxEOF_ :: IORef Bool
ctxEstablished_ :: IORef Established
ctxTxRecordState :: MVar RecordState
ctxRxRecordState :: MVar RecordState
ctxHandshakeState :: MVar (Maybe HandshakeState)
ctxRoleParams :: RoleParams
ctxLocks :: Locks
ctxKeyLogger :: String -> IO ()
ctxHooks :: IORef Hooks
ctxTLS13State :: IORef TLS13State
ctxPendingRecvActions :: IORef [PendingRecvAction]
ctxPendingSendAction :: IORef (Maybe (Context -> IO ()))
ctxCertRequests :: IORef [Handshake13]
ctxRecordLayer :: RecordLayer a
ctxHandshakeSync :: HandshakeSync
ctxQUICMode :: Bool
ctxNeedEmptyPacket :: IORef Bool
ctxFragmentSize :: Maybe Int
..} TLS13State -> TLS13State
f = IORef TLS13State -> (TLS13State -> (TLS13State, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef TLS13State
ctxTLS13State ((TLS13State -> (TLS13State, ())) -> IO ())
-> (TLS13State -> (TLS13State, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TLS13State
st -> (TLS13State -> TLS13State
f TLS13State
st, ())

data HandshakeSync
    = HandshakeSync
        (Context -> ClientState -> IO ())
        (Context -> ServerState -> IO ())

{- FOURMOLU_DISABLE -}
data RecordLayer a = RecordLayer
    { -- Writing.hs
      forall a.
RecordLayer a
-> Context -> Record Plaintext -> IO (Either TLSError a)
recordEncode    :: Context -> Record Plaintext -> IO (Either TLSError a)
    , forall a.
RecordLayer a
-> Context -> Record Plaintext -> IO (Either TLSError a)
recordEncode13  :: Context -> Record Plaintext -> IO (Either TLSError a)
    , forall a. RecordLayer a -> Context -> a -> IO ()
recordSendBytes :: Context -> a -> IO ()
    , -- Reading.hs
      forall a.
RecordLayer a
-> Context -> Int -> IO (Either TLSError (Record Plaintext))
recordRecv      :: Context -> Int -> IO (Either TLSError (Record Plaintext))
    , forall a.
RecordLayer a -> Context -> IO (Either TLSError (Record Plaintext))
recordRecv13    :: Context -> IO (Either TLSError (Record Plaintext))
    }
{- FOURMOLU_ENABLE -}

updateRecordLayer :: Monoid a => RecordLayer a -> Context -> Context
updateRecordLayer :: forall a. Monoid a => RecordLayer a -> Context -> Context
updateRecordLayer RecordLayer a
recordLayer Context{Bool
Maybe Int
MVar (Maybe HandshakeState)
MVar RecordState
MVar TLSState
IORef Bool
IORef [Handshake13]
IORef [PendingRecvAction]
IORef (Maybe (Context -> IO ()))
IORef Measurement
IORef Hooks
IORef Established
IORef TLS13State
Backend
Shared
Supported
RecordLayer a
HandshakeSync
Locks
RoleParams
String -> IO ()
ctxBackend :: Context -> Backend
ctxSupported :: Context -> Supported
ctxShared :: Context -> Shared
ctxTLSState :: Context -> MVar TLSState
ctxMeasurement :: Context -> IORef Measurement
ctxEOF_ :: Context -> IORef Bool
ctxEstablished_ :: Context -> IORef Established
ctxTxRecordState :: Context -> MVar RecordState
ctxRxRecordState :: Context -> MVar RecordState
ctxHandshakeState :: Context -> MVar (Maybe HandshakeState)
ctxRoleParams :: Context -> RoleParams
ctxLocks :: Context -> Locks
ctxKeyLogger :: Context -> String -> IO ()
ctxHooks :: Context -> IORef Hooks
ctxTLS13State :: Context -> IORef TLS13State
ctxPendingRecvActions :: Context -> IORef [PendingRecvAction]
ctxPendingSendAction :: Context -> IORef (Maybe (Context -> IO ()))
ctxCertRequests :: Context -> IORef [Handshake13]
ctxRecordLayer :: ()
ctxHandshakeSync :: Context -> HandshakeSync
ctxQUICMode :: Context -> Bool
ctxNeedEmptyPacket :: Context -> IORef Bool
ctxFragmentSize :: Context -> Maybe Int
ctxBackend :: Backend
ctxSupported :: Supported
ctxShared :: Shared
ctxTLSState :: MVar TLSState
ctxMeasurement :: IORef Measurement
ctxEOF_ :: IORef Bool
ctxEstablished_ :: IORef Established
ctxTxRecordState :: MVar RecordState
ctxRxRecordState :: MVar RecordState
ctxHandshakeState :: MVar (Maybe HandshakeState)
ctxRoleParams :: RoleParams
ctxLocks :: Locks
ctxKeyLogger :: String -> IO ()
ctxHooks :: IORef Hooks
ctxTLS13State :: IORef TLS13State
ctxPendingRecvActions :: IORef [PendingRecvAction]
ctxPendingSendAction :: IORef (Maybe (Context -> IO ()))
ctxCertRequests :: IORef [Handshake13]
ctxRecordLayer :: RecordLayer a
ctxHandshakeSync :: HandshakeSync
ctxQUICMode :: Bool
ctxNeedEmptyPacket :: IORef Bool
ctxFragmentSize :: Maybe Int
..} =
    Context{ctxRecordLayer :: RecordLayer a
ctxRecordLayer = RecordLayer a
recordLayer, Bool
Maybe Int
MVar (Maybe HandshakeState)
MVar RecordState
MVar TLSState
IORef Bool
IORef [Handshake13]
IORef [PendingRecvAction]
IORef (Maybe (Context -> IO ()))
IORef Measurement
IORef Hooks
IORef Established
IORef TLS13State
Backend
Shared
Supported
HandshakeSync
Locks
RoleParams
String -> IO ()
ctxBackend :: Backend
ctxSupported :: Supported
ctxShared :: Shared
ctxTLSState :: MVar TLSState
ctxMeasurement :: IORef Measurement
ctxEOF_ :: IORef Bool
ctxEstablished_ :: IORef Established
ctxTxRecordState :: MVar RecordState
ctxRxRecordState :: MVar RecordState
ctxHandshakeState :: MVar (Maybe HandshakeState)
ctxRoleParams :: RoleParams
ctxLocks :: Locks
ctxKeyLogger :: String -> IO ()
ctxHooks :: IORef Hooks
ctxTLS13State :: IORef TLS13State
ctxPendingRecvActions :: IORef [PendingRecvAction]
ctxPendingSendAction :: IORef (Maybe (Context -> IO ()))
ctxCertRequests :: IORef [Handshake13]
ctxHandshakeSync :: HandshakeSync
ctxQUICMode :: Bool
ctxNeedEmptyPacket :: IORef Bool
ctxFragmentSize :: Maybe Int
ctxBackend :: Backend
ctxSupported :: Supported
ctxShared :: Shared
ctxTLSState :: MVar TLSState
ctxMeasurement :: IORef Measurement
ctxEOF_ :: IORef Bool
ctxEstablished_ :: IORef Established
ctxTxRecordState :: MVar RecordState
ctxRxRecordState :: MVar RecordState
ctxHandshakeState :: MVar (Maybe HandshakeState)
ctxRoleParams :: RoleParams
ctxLocks :: Locks
ctxKeyLogger :: String -> IO ()
ctxHooks :: IORef Hooks
ctxTLS13State :: IORef TLS13State
ctxPendingRecvActions :: IORef [PendingRecvAction]
ctxPendingSendAction :: IORef (Maybe (Context -> IO ()))
ctxCertRequests :: IORef [Handshake13]
ctxHandshakeSync :: HandshakeSync
ctxQUICMode :: Bool
ctxNeedEmptyPacket :: IORef Bool
ctxFragmentSize :: Maybe Int
..}

data Established
    = NotEstablished
    | EarlyDataAllowed Int -- server: remaining 0-RTT bytes allowed
    | EarlyDataNotAllowed Int -- sever: remaining 0-RTT packets allowed to skip
    | EarlyDataSending
    | Established
    deriving (Established -> Established -> Bool
(Established -> Established -> Bool)
-> (Established -> Established -> Bool) -> Eq Established
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Established -> Established -> Bool
== :: Established -> Established -> Bool
$c/= :: Established -> Established -> Bool
/= :: Established -> Established -> Bool
Eq, Int -> Established -> ShowS
[Established] -> ShowS
Established -> String
(Int -> Established -> ShowS)
-> (Established -> String)
-> ([Established] -> ShowS)
-> Show Established
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Established -> ShowS
showsPrec :: Int -> Established -> ShowS
$cshow :: Established -> String
show :: Established -> String
$cshowList :: [Established] -> ShowS
showList :: [Established] -> ShowS
Show)

data PendingRecvAction
    = -- | simple pending action. The first 'Bool' is necessity of alignment.
      PendingRecvAction Bool (Handshake13 -> IO ())
    | -- | pending action taking transcript hash up to preceding message
      --   The first 'Bool' is necessity of alignment.
      PendingRecvActionHash Bool (ByteString -> Handshake13 -> IO ())

updateMeasure :: Context -> (Measurement -> Measurement) -> IO ()
updateMeasure :: Context -> (Measurement -> Measurement) -> IO ()
updateMeasure Context
ctx = IORef Measurement -> (Measurement -> Measurement) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Context -> IORef Measurement
ctxMeasurement Context
ctx)

withMeasure :: Context -> (Measurement -> IO a) -> IO a
withMeasure :: forall a. Context -> (Measurement -> IO a) -> IO a
withMeasure Context
ctx Measurement -> IO a
f = IORef Measurement -> IO Measurement
forall a. IORef a -> IO a
readIORef (Context -> IORef Measurement
ctxMeasurement Context
ctx) IO Measurement -> (Measurement -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Measurement -> IO a
f

-- | A shortcut for 'backendFlush . ctxBackend'.
contextFlush :: Context -> IO ()
contextFlush :: Context -> IO ()
contextFlush = Backend -> IO ()
backendFlush (Backend -> IO ()) -> (Context -> Backend) -> Context -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Backend
ctxBackend

-- | A shortcut for 'backendClose . ctxBackend'.
contextClose :: Context -> IO ()
contextClose :: Context -> IO ()
contextClose = Backend -> IO ()
backendClose (Backend -> IO ()) -> (Context -> Backend) -> Context -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> Backend
ctxBackend

-- | Information about the current context
contextGetInformation :: Context -> IO (Maybe Information)
contextGetInformation :: Context -> IO (Maybe Information)
contextGetInformation Context
ctx = do
    Maybe Version
ver <- Context -> TLSSt (Maybe Version) -> IO (Maybe Version)
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt (Maybe Version) -> IO (Maybe Version))
-> TLSSt (Maybe Version) -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ (TLSState -> Maybe Version) -> TLSSt (Maybe Version)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TLSState -> Maybe Version
stVersion
    Maybe HandshakeState
hstate <- Context -> IO (Maybe HandshakeState)
forall (m :: * -> *).
MonadIO m =>
Context -> m (Maybe HandshakeState)
getHState Context
ctx
    let (Maybe ByteString
ms, Bool
ems, Maybe ClientRandom
cr, Maybe ServerRandom
sr, Maybe HandshakeMode13
hm13, Maybe Group
grp) =
            case Maybe HandshakeState
hstate of
                Just HandshakeState
st ->
                    ( HandshakeState -> Maybe ByteString
hstMainSecret HandshakeState
st
                    , HandshakeState -> Bool
hstExtendedMainSecret HandshakeState
st
                    , ClientRandom -> Maybe ClientRandom
forall a. a -> Maybe a
Just (HandshakeState -> ClientRandom
hstClientRandom HandshakeState
st)
                    , HandshakeState -> Maybe ServerRandom
hstServerRandom HandshakeState
st
                    , if Maybe Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
TLS13 then HandshakeMode13 -> Maybe HandshakeMode13
forall a. a -> Maybe a
Just (HandshakeState -> HandshakeMode13
hstTLS13HandshakeMode HandshakeState
st) else Maybe HandshakeMode13
forall a. Maybe a
Nothing
                    , HandshakeState -> Maybe Group
hstSupportedGroup HandshakeState
st
                    )
                Maybe HandshakeState
Nothing -> (Maybe ByteString
forall a. Maybe a
Nothing, Bool
False, Maybe ClientRandom
forall a. Maybe a
Nothing, Maybe ServerRandom
forall a. Maybe a
Nothing, Maybe HandshakeMode13
forall a. Maybe a
Nothing, Maybe Group
forall a. Maybe a
Nothing)
    (Maybe Cipher
cipher, Compression
comp) <-
        MVar RecordState -> IO RecordState
forall a. MVar a -> IO a
readMVar (Context -> MVar RecordState
ctxRxRecordState Context
ctx) IO RecordState
-> (RecordState -> (Maybe Cipher, Compression))
-> IO (Maybe Cipher, Compression)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \RecordState
st -> (RecordState -> Maybe Cipher
stCipher RecordState
st, RecordState -> Compression
stCompression RecordState
st)
    let accepted :: Bool
accepted = case Maybe HandshakeState
hstate of
            Just HandshakeState
st -> HandshakeState -> RTT0Status
hstTLS13RTT0Status HandshakeState
st RTT0Status -> RTT0Status -> Bool
forall a. Eq a => a -> a -> Bool
== RTT0Status
RTT0Accepted
            Maybe HandshakeState
Nothing -> Bool
False
    Bool
tls12resumption <- Context -> TLSSt Bool -> IO Bool
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt Bool
getTLS12SessionResuming
    case (Maybe Version
ver, Maybe Cipher
cipher) of
        (Just Version
v, Just Cipher
c) ->
            Maybe Information -> IO (Maybe Information)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Information -> IO (Maybe Information))
-> Maybe Information -> IO (Maybe Information)
forall a b. (a -> b) -> a -> b
$
                Information -> Maybe Information
forall a. a -> Maybe a
Just (Information -> Maybe Information)
-> Information -> Maybe Information
forall a b. (a -> b) -> a -> b
$
                    Information
                        { infoVersion :: Version
infoVersion = Version
v
                        , infoCipher :: Cipher
infoCipher = Cipher
c
                        , infoCompression :: Compression
infoCompression = Compression
comp
                        , infoMainSecret :: Maybe ByteString
infoMainSecret = Maybe ByteString
ms
                        , infoExtendedMainSecret :: Bool
infoExtendedMainSecret = Bool
ems
                        , infoClientRandom :: Maybe ClientRandom
infoClientRandom = Maybe ClientRandom
cr
                        , infoServerRandom :: Maybe ServerRandom
infoServerRandom = Maybe ServerRandom
sr
                        , infoSupportedGroup :: Maybe Group
infoSupportedGroup = Maybe Group
grp
                        , infoTLS12Resumption :: Bool
infoTLS12Resumption = Bool
tls12resumption
                        , infoTLS13HandshakeMode :: Maybe HandshakeMode13
infoTLS13HandshakeMode = Maybe HandshakeMode13
hm13
                        , infoIsEarlyDataAccepted :: Bool
infoIsEarlyDataAccepted = Bool
accepted
                        }
        (Maybe Version, Maybe Cipher)
_ -> Maybe Information -> IO (Maybe Information)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Information
forall a. Maybe a
Nothing

contextSend :: Context -> ByteString -> IO ()
contextSend :: Context -> ByteString -> IO ()
contextSend Context
c ByteString
b =
    Context -> (Measurement -> Measurement) -> IO ()
updateMeasure Context
c (Int -> Measurement -> Measurement
addBytesSent (Int -> Measurement -> Measurement)
-> Int -> Measurement -> Measurement
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
b) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Backend -> ByteString -> IO ()
backendSend (Backend -> ByteString -> IO ()) -> Backend -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> Backend
ctxBackend Context
c) ByteString
b

contextRecv :: Context -> Int -> IO ByteString
contextRecv :: Context -> Int -> IO ByteString
contextRecv Context
c Int
sz = Context -> (Measurement -> Measurement) -> IO ()
updateMeasure Context
c (Int -> Measurement -> Measurement
addBytesReceived Int
sz) IO () -> IO ByteString -> IO ByteString
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Backend -> Int -> IO ByteString
backendRecv (Backend -> Int -> IO ByteString)
-> Backend -> Int -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Context -> Backend
ctxBackend Context
c) Int
sz

ctxEOF :: Context -> IO Bool
ctxEOF :: Context -> IO Bool
ctxEOF Context
ctx = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool) -> IORef Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Context -> IORef Bool
ctxEOF_ Context
ctx

setEOF :: Context -> IO ()
setEOF :: Context -> IO ()
setEOF Context
ctx = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Context -> IORef Bool
ctxEOF_ Context
ctx) Bool
True

ctxEstablished :: Context -> IO Established
ctxEstablished :: Context -> IO Established
ctxEstablished Context
ctx = IORef Established -> IO Established
forall a. IORef a -> IO a
readIORef (IORef Established -> IO Established)
-> IORef Established -> IO Established
forall a b. (a -> b) -> a -> b
$ Context -> IORef Established
ctxEstablished_ Context
ctx

ctxWithHooks :: Context -> (Hooks -> IO a) -> IO a
ctxWithHooks :: forall a. Context -> (Hooks -> IO a) -> IO a
ctxWithHooks Context
ctx Hooks -> IO a
f = IORef Hooks -> IO Hooks
forall a. IORef a -> IO a
readIORef (Context -> IORef Hooks
ctxHooks Context
ctx) IO Hooks -> (Hooks -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Hooks -> IO a
f

contextModifyHooks :: Context -> (Hooks -> Hooks) -> IO ()
contextModifyHooks :: Context -> (Hooks -> Hooks) -> IO ()
contextModifyHooks Context
ctx = IORef Hooks -> (Hooks -> Hooks) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (Context -> IORef Hooks
ctxHooks Context
ctx)

setEstablished :: Context -> Established -> IO ()
setEstablished :: Context -> Established -> IO ()
setEstablished Context
ctx = IORef Established -> Established -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Context -> IORef Established
ctxEstablished_ Context
ctx)

withLog :: Context -> (Logging -> IO ()) -> IO ()
withLog :: Context -> (Logging -> IO ()) -> IO ()
withLog Context
ctx Logging -> IO ()
f = Context -> (Hooks -> IO ()) -> IO ()
forall a. Context -> (Hooks -> IO a) -> IO a
ctxWithHooks Context
ctx (Logging -> IO ()
f (Logging -> IO ()) -> (Hooks -> Logging) -> Hooks -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hooks -> Logging
hookLogging)

throwCore :: MonadIO m => TLSError -> m a
throwCore :: forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (TLSError -> IO a) -> TLSError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSException -> IO a
forall e a. Exception e => e -> IO a
throwIO (TLSException -> IO a)
-> (TLSError -> TLSException) -> TLSError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSError -> TLSException
Uncontextualized

failOnEitherError :: MonadIO m => m (Either TLSError a) -> m a
failOnEitherError :: forall (m :: * -> *) a. MonadIO m => m (Either TLSError a) -> m a
failOnEitherError m (Either TLSError a)
f = do
    Either TLSError a
ret <- m (Either TLSError a)
f
    case Either TLSError a
ret of
        Left TLSError
err -> TLSError -> m a
forall (m :: * -> *) a. MonadIO m => TLSError -> m a
throwCore TLSError
err
        Right a
r -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

usingState :: Context -> TLSSt a -> IO (Either TLSError a)
usingState :: forall a. Context -> TLSSt a -> IO (Either TLSError a)
usingState Context
ctx TLSSt a
f =
    MVar TLSState
-> (TLSState -> IO (TLSState, Either TLSError a))
-> IO (Either TLSError a)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Context -> MVar TLSState
ctxTLSState Context
ctx) ((TLSState -> IO (TLSState, Either TLSError a))
 -> IO (Either TLSError a))
-> (TLSState -> IO (TLSState, Either TLSError a))
-> IO (Either TLSError a)
forall a b. (a -> b) -> a -> b
$ \TLSState
st ->
        let (Either TLSError a
a, TLSState
newst) = TLSSt a -> TLSState -> (Either TLSError a, TLSState)
forall a. TLSSt a -> TLSState -> (Either TLSError a, TLSState)
runTLSState TLSSt a
f TLSState
st
         in TLSState
newst TLSState
-> IO (TLSState, Either TLSError a)
-> IO (TLSState, Either TLSError a)
forall a b. a -> b -> b
`seq` (TLSState, Either TLSError a) -> IO (TLSState, Either TLSError a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TLSState
newst, Either TLSError a
a)

usingState_ :: Context -> TLSSt a -> IO a
usingState_ :: forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx TLSSt a
f = IO (Either TLSError a) -> IO a
forall (m :: * -> *) a. MonadIO m => m (Either TLSError a) -> m a
failOnEitherError (IO (Either TLSError a) -> IO a) -> IO (Either TLSError a) -> IO a
forall a b. (a -> b) -> a -> b
$ Context -> TLSSt a -> IO (Either TLSError a)
forall a. Context -> TLSSt a -> IO (Either TLSError a)
usingState Context
ctx TLSSt a
f

usingHState :: MonadIO m => Context -> HandshakeM a -> m a
usingHState :: forall (m :: * -> *) a. MonadIO m => Context -> HandshakeM a -> m a
usingHState Context
ctx HandshakeM a
f = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ MVar (Maybe HandshakeState)
-> (Maybe HandshakeState -> IO (Maybe HandshakeState, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Context -> MVar (Maybe HandshakeState)
ctxHandshakeState Context
ctx) ((Maybe HandshakeState -> IO (Maybe HandshakeState, a)) -> IO a)
-> (Maybe HandshakeState -> IO (Maybe HandshakeState, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \case
    Maybe HandshakeState
Nothing -> IO (Maybe HandshakeState, a) -> IO (Maybe HandshakeState, a)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe HandshakeState, a) -> IO (Maybe HandshakeState, a))
-> IO (Maybe HandshakeState, a) -> IO (Maybe HandshakeState, a)
forall a b. (a -> b) -> a -> b
$ TLSException -> IO (Maybe HandshakeState, a)
forall e a. Exception e => e -> IO a
throwIO TLSException
MissingHandshake
    Just HandshakeState
st -> (Maybe HandshakeState, a) -> IO (Maybe HandshakeState, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe HandshakeState, a) -> IO (Maybe HandshakeState, a))
-> (Maybe HandshakeState, a) -> IO (Maybe HandshakeState, a)
forall a b. (a -> b) -> a -> b
$ (a, Maybe HandshakeState) -> (Maybe HandshakeState, a)
forall a b. (a, b) -> (b, a)
swap (HandshakeState -> Maybe HandshakeState
forall a. a -> Maybe a
Just (HandshakeState -> Maybe HandshakeState)
-> (a, HandshakeState) -> (a, Maybe HandshakeState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HandshakeState -> HandshakeM a -> (a, HandshakeState)
forall a. HandshakeState -> HandshakeM a -> (a, HandshakeState)
runHandshake HandshakeState
st HandshakeM a
f)

getHState :: MonadIO m => Context -> m (Maybe HandshakeState)
getHState :: forall (m :: * -> *).
MonadIO m =>
Context -> m (Maybe HandshakeState)
getHState Context
ctx = IO (Maybe HandshakeState) -> m (Maybe HandshakeState)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe HandshakeState) -> m (Maybe HandshakeState))
-> IO (Maybe HandshakeState) -> m (Maybe HandshakeState)
forall a b. (a -> b) -> a -> b
$ MVar (Maybe HandshakeState) -> IO (Maybe HandshakeState)
forall a. MVar a -> IO a
readMVar (Context -> MVar (Maybe HandshakeState)
ctxHandshakeState Context
ctx)

saveHState :: Context -> IO (Saved (Maybe HandshakeState))
saveHState :: Context -> IO (Saved (Maybe HandshakeState))
saveHState Context
ctx = MVar (Maybe HandshakeState) -> IO (Saved (Maybe HandshakeState))
forall a. MVar a -> IO (Saved a)
saveMVar (Context -> MVar (Maybe HandshakeState)
ctxHandshakeState Context
ctx)

restoreHState
    :: Context
    -> Saved (Maybe HandshakeState)
    -> IO (Saved (Maybe HandshakeState))
restoreHState :: Context
-> Saved (Maybe HandshakeState)
-> IO (Saved (Maybe HandshakeState))
restoreHState Context
ctx = MVar (Maybe HandshakeState)
-> Saved (Maybe HandshakeState)
-> IO (Saved (Maybe HandshakeState))
forall a. MVar a -> Saved a -> IO (Saved a)
restoreMVar (Context -> MVar (Maybe HandshakeState)
ctxHandshakeState Context
ctx)

decideRecordVersion :: Context -> IO (Version, Bool)
decideRecordVersion :: Context -> IO (Version, Bool)
decideRecordVersion Context
ctx = Context -> TLSSt (Version, Bool) -> IO (Version, Bool)
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt (Version, Bool) -> IO (Version, Bool))
-> TLSSt (Version, Bool) -> IO (Version, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Version
ver <- Version -> TLSSt Version
getVersionWithDefault ([Version] -> Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Version] -> Version) -> [Version] -> Version
forall a b. (a -> b) -> a -> b
$ Supported -> [Version]
supportedVersions (Supported -> [Version]) -> Supported -> [Version]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx)
    Bool
hrr <- TLSSt Bool
getTLS13HRR
    -- For TLS 1.3, ver' is only used in ClientHello.
    -- The record version of the first ClientHello SHOULD be TLS 1.0.
    -- The record version of the second ClientHello MUST be TLS 1.2.
    let ver' :: Version
ver'
            | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13 = if Bool
hrr then Version
TLS12 else Version
TLS10
            | Bool
otherwise = Version
ver
    (Version, Bool) -> TLSSt (Version, Bool)
forall a. a -> TLSSt a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
ver', Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13)

runTxRecordState :: Context -> RecordM a -> IO (Either TLSError a)
runTxRecordState :: forall a. Context -> RecordM a -> IO (Either TLSError a)
runTxRecordState Context
ctx RecordM a
f = do
    (Version
ver, Bool
tls13) <- Context -> IO (Version, Bool)
decideRecordVersion Context
ctx
    let opt :: RecordOptions
opt =
            RecordOptions
                { recordVersion :: Version
recordVersion = Version
ver
                , recordTLS13 :: Bool
recordTLS13 = Bool
tls13
                }
    MVar RecordState
-> (RecordState -> IO (RecordState, Either TLSError a))
-> IO (Either TLSError a)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Context -> MVar RecordState
ctxTxRecordState Context
ctx) ((RecordState -> IO (RecordState, Either TLSError a))
 -> IO (Either TLSError a))
-> (RecordState -> IO (RecordState, Either TLSError a))
-> IO (Either TLSError a)
forall a b. (a -> b) -> a -> b
$ \RecordState
st ->
        case RecordM a
-> RecordOptions -> RecordState -> Either TLSError (a, RecordState)
forall a.
RecordM a
-> RecordOptions -> RecordState -> Either TLSError (a, RecordState)
runRecordM RecordM a
f RecordOptions
opt RecordState
st of
            Left TLSError
err -> (RecordState, Either TLSError a)
-> IO (RecordState, Either TLSError a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecordState
st, TLSError -> Either TLSError a
forall a b. a -> Either a b
Left TLSError
err)
            Right (a
a, RecordState
newSt) -> (RecordState, Either TLSError a)
-> IO (RecordState, Either TLSError a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecordState
newSt, a -> Either TLSError a
forall a b. b -> Either a b
Right a
a)

runRxRecordState :: Context -> RecordM a -> IO (Either TLSError a)
runRxRecordState :: forall a. Context -> RecordM a -> IO (Either TLSError a)
runRxRecordState Context
ctx RecordM a
f = do
    Version
ver <-
        Context -> TLSSt Version -> IO Version
forall a. Context -> TLSSt a -> IO a
usingState_
            Context
ctx
            (Version -> TLSSt Version
getVersionWithDefault (Version -> TLSSt Version) -> Version -> TLSSt Version
forall a b. (a -> b) -> a -> b
$ [Version] -> Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Version] -> Version) -> [Version] -> Version
forall a b. (a -> b) -> a -> b
$ Supported -> [Version]
supportedVersions (Supported -> [Version]) -> Supported -> [Version]
forall a b. (a -> b) -> a -> b
$ Context -> Supported
ctxSupported Context
ctx)
    -- For 1.3, ver is just ignored. So, it is not necessary to convert ver.
    let opt :: RecordOptions
opt =
            RecordOptions
                { recordVersion :: Version
recordVersion = Version
ver
                , recordTLS13 :: Bool
recordTLS13 = Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13
                }
    MVar RecordState
-> (RecordState -> IO (RecordState, Either TLSError a))
-> IO (Either TLSError a)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Context -> MVar RecordState
ctxRxRecordState Context
ctx) ((RecordState -> IO (RecordState, Either TLSError a))
 -> IO (Either TLSError a))
-> (RecordState -> IO (RecordState, Either TLSError a))
-> IO (Either TLSError a)
forall a b. (a -> b) -> a -> b
$ \RecordState
st ->
        case RecordM a
-> RecordOptions -> RecordState -> Either TLSError (a, RecordState)
forall a.
RecordM a
-> RecordOptions -> RecordState -> Either TLSError (a, RecordState)
runRecordM RecordM a
f RecordOptions
opt RecordState
st of
            Left TLSError
err -> (RecordState, Either TLSError a)
-> IO (RecordState, Either TLSError a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecordState
st, TLSError -> Either TLSError a
forall a b. a -> Either a b
Left TLSError
err)
            Right (a
a, RecordState
newSt) -> (RecordState, Either TLSError a)
-> IO (RecordState, Either TLSError a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecordState
newSt, a -> Either TLSError a
forall a b. b -> Either a b
Right a
a)

getStateRNG :: Context -> Int -> IO ByteString
getStateRNG :: Context -> Int -> IO ByteString
getStateRNG Context
ctx Int
n = Context -> TLSSt ByteString -> IO ByteString
forall a. Context -> TLSSt a -> IO a
usingState_ Context
ctx (TLSSt ByteString -> IO ByteString)
-> TLSSt ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> TLSSt ByteString
genRandom Int
n

withReadLock :: Context -> IO a -> IO a
withReadLock :: forall a. Context -> IO a -> IO a
withReadLock Context
ctx IO a
f = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Locks -> MVar ()
lockRead (Locks -> MVar ()) -> Locks -> MVar ()
forall a b. (a -> b) -> a -> b
$ Context -> Locks
ctxLocks Context
ctx) (IO a -> () -> IO a
forall a b. a -> b -> a
const IO a
f)

withWriteLock :: Context -> IO a -> IO a
withWriteLock :: forall a. Context -> IO a -> IO a
withWriteLock Context
ctx IO a
f = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Locks -> MVar ()
lockWrite (Locks -> MVar ()) -> Locks -> MVar ()
forall a b. (a -> b) -> a -> b
$ Context -> Locks
ctxLocks Context
ctx) (IO a -> () -> IO a
forall a b. a -> b -> a
const IO a
f)

withRWLock :: Context -> IO a -> IO a
withRWLock :: forall a. Context -> IO a -> IO a
withRWLock Context
ctx IO a
f = Context -> IO a -> IO a
forall a. Context -> IO a -> IO a
withReadLock Context
ctx (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ Context -> IO a -> IO a
forall a. Context -> IO a -> IO a
withWriteLock Context
ctx IO a
f

withStateLock :: Context -> IO a -> IO a
withStateLock :: forall a. Context -> IO a -> IO a
withStateLock Context
ctx IO a
f = MVar () -> (() -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Locks -> MVar ()
lockState (Locks -> MVar ()) -> Locks -> MVar ()
forall a b. (a -> b) -> a -> b
$ Context -> Locks
ctxLocks Context
ctx) (IO a -> () -> IO a
forall a b. a -> b -> a
const IO a
f)

tls13orLater :: MonadIO m => Context -> m Bool
tls13orLater :: forall (m :: * -> *). MonadIO m => Context -> m Bool
tls13orLater Context
ctx = do
    Either TLSError Version
ev <- IO (Either TLSError Version) -> m (Either TLSError Version)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either TLSError Version) -> m (Either TLSError Version))
-> IO (Either TLSError Version) -> m (Either TLSError Version)
forall a b. (a -> b) -> a -> b
$ Context -> TLSSt Version -> IO (Either TLSError Version)
forall a. Context -> TLSSt a -> IO (Either TLSError a)
usingState Context
ctx (TLSSt Version -> IO (Either TLSError Version))
-> TLSSt Version -> IO (Either TLSError Version)
forall a b. (a -> b) -> a -> b
$ Version -> TLSSt Version
getVersionWithDefault Version
TLS12
    Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ case Either TLSError Version
ev of
        Left TLSError
_ -> Bool
False
        Right Version
v -> Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
TLS13

addCertRequest13 :: Context -> Handshake13 -> IO ()
addCertRequest13 :: Context -> Handshake13 -> IO ()
addCertRequest13 Context
ctx Handshake13
certReq = IORef [Handshake13] -> ([Handshake13] -> [Handshake13]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (Context -> IORef [Handshake13]
ctxCertRequests Context
ctx) (Handshake13
certReq Handshake13 -> [Handshake13] -> [Handshake13]
forall a. a -> [a] -> [a]
:)

getCertRequest13 :: Context -> CertReqContext -> IO (Maybe Handshake13)
getCertRequest13 :: Context -> ByteString -> IO (Maybe Handshake13)
getCertRequest13 Context
ctx ByteString
context = do
    let ref :: IORef [Handshake13]
ref = Context -> IORef [Handshake13]
ctxCertRequests Context
ctx
    [Handshake13]
l <- IORef [Handshake13] -> IO [Handshake13]
forall a. IORef a -> IO a
readIORef IORef [Handshake13]
ref
    let ([Handshake13]
matched, [Handshake13]
others) = (Handshake13 -> Bool)
-> [Handshake13] -> ([Handshake13], [Handshake13])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\Handshake13
cr -> ByteString
context ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Handshake13 -> ByteString
fromCertRequest13 Handshake13
cr) [Handshake13]
l
    case [Handshake13]
matched of
        [] -> Maybe Handshake13 -> IO (Maybe Handshake13)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handshake13
forall a. Maybe a
Nothing
        (Handshake13
certReq : [Handshake13]
_) -> IORef [Handshake13] -> [Handshake13] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Handshake13]
ref [Handshake13]
others IO () -> IO (Maybe Handshake13) -> IO (Maybe Handshake13)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Handshake13 -> IO (Maybe Handshake13)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handshake13 -> Maybe Handshake13
forall a. a -> Maybe a
Just Handshake13
certReq)
  where
    fromCertRequest13 :: Handshake13 -> ByteString
fromCertRequest13 (CertRequest13 ByteString
c [ExtensionRaw]
_) = ByteString
c
    fromCertRequest13 Handshake13
_ = String -> ByteString
forall a. HasCallStack => String -> a
error String
"fromCertRequest13"