    {-# LANGUAGE OverloadedStrings #-}

    module Network.TLS.Context (
        -- * Context configuration
        TLSParams,

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

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

        -- * New contexts
        contextNew,

        -- * Context hooks
        contextHookSetHandshakeRecv,
        contextHookSetHandshake13Recv,
        contextHookSetCertificateRecv,
        contextHookSetLogging,

        -- * Using context states
        throwCore,
        usingState,
        usingState_,
        runTxRecordState,
        runRxRecordState,
        usingHState,
        getHState,
        getStateRNG,
        tls13orLater,
        getTLSUnique,
        getTLSExporter,
        getTLSServerEndPoint,
        getFinished,
        getPeerFinished,
        TLS13State (..),
        getTLS13State,
        modifyTLS13State,
        setMyRecordLimit,
        enableMyRecordLimit,
        getMyRecordLimit,
        checkMyRecordLimit,
        setPeerRecordLimit,
        enablePeerRecordLimit,
        getPeerRecordLimit,
        checkPeerRecordLimit,
        newRecordLimitRef,
    ) where

    import Control.Concurrent.MVar
    import Control.Monad.State.Strict
    import Data.IORef

    import Network.TLS.Backend
    import Network.TLS.Cipher
    import Network.TLS.Context.Internal
    import Network.TLS.Crypto
    import Network.TLS.Handshake (
        handshakeClient,
        handshakeClientWith,
        handshakeServer,
        handshakeServerWith,
     )
    import Network.TLS.Handshake.State13
    import Network.TLS.Hooks
    import Network.TLS.Imports
    import Network.TLS.KeySchedule
    import Network.TLS.Measurement
    import Network.TLS.Packet
    import Network.TLS.Parameters
    import Network.TLS.PostHandshake (
        postHandshakeAuthClientWith,
        postHandshakeAuthServerWith,
        requestCertificateServer,
     )
    import Network.TLS.RNG
    import Network.TLS.Record.Recv
    import Network.TLS.Record.Send
    import Network.TLS.Record.State
    import Network.TLS.State
    import Network.TLS.Struct
    import Network.TLS.Struct13
    import Network.TLS.Types (Role (..), defaultRecordSizeLimit)
    import Network.TLS.X509

    class TLSParams a where
        getTLSCommonParams :: a -> CommonParams
        getTLSRole :: a -> Role
        doHandshake :: a -> Context -> IO ()
        doHandshakeWith :: a -> Context -> Handshake -> IO ()
        doRequestCertificate :: a -> Context -> IO Bool
        doPostHandshakeAuthWith :: a -> Context -> Handshake13 -> IO ()

    instance TLSParams ClientParams where
        getTLSCommonParams :: ClientParams -> CommonParams
    getTLSCommonParams ClientParams
    cparams =
            ( ClientParams -> Supported
    clientSupported ClientParams
    cparams
            , ClientParams -> Shared
    clientShared ClientParams
    cparams
            , ClientParams -> DebugParams
    clientDebug ClientParams
    cparams
            )
        getTLSRole :: ClientParams -> Role
    getTLSRole ClientParams
    _ = Role
    ClientRole
        doHandshake :: ClientParams -> Context -> IO ()
    doHandshake = ClientParams -> Context -> IO ()
    handshakeClient
        doHandshakeWith :: ClientParams -> Context -> Handshake -> IO ()
    doHandshakeWith = ClientParams -> Context -> Handshake -> IO ()
    handshakeClientWith
        doRequestCertificate :: ClientParams -> Context -> IO Bool
    doRequestCertificate ClientParams
    _ Context
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        doPostHandshakeAuthWith :: ClientParams -> Context -> Handshake13 -> IO ()
    doPostHandshakeAuthWith = ClientParams -> Context -> Handshake13 -> IO ()
    postHandshakeAuthClientWith

    instance TLSParams ServerParams where
        getTLSCommonParams :: ServerParams -> CommonParams
    getTLSCommonParams ServerParams
    sparams =
            ( ServerParams -> Supported
    serverSupported ServerParams
    sparams
            , ServerParams -> Shared
    serverShared ServerParams
    sparams
            , ServerParams -> DebugParams
    serverDebug ServerParams
    sparams
            )
        getTLSRole :: ServerParams -> Role
    getTLSRole ServerParams
    _ = Role
    ServerRole
        doHandshake :: ServerParams -> Context -> IO ()
    doHandshake = ServerParams -> Context -> IO ()
    handshakeServer
        doHandshakeWith :: ServerParams -> Context -> Handshake -> IO ()
    doHandshakeWith = ServerParams -> Context -> Handshake -> IO ()
    handshakeServerWith
        doRequestCertificate :: ServerParams -> Context -> IO Bool
    doRequestCertificate = ServerParams -> Context -> IO Bool
    requestCertificateServer
        doPostHandshakeAuthWith :: ServerParams -> Context -> Handshake13 -> IO ()
    doPostHandshakeAuthWith = ServerParams -> Context -> Handshake13 -> IO ()
    postHandshakeAuthServerWith

    -- | create a new context using the backend and parameters specified.
    contextNew
        :: (MonadIO m, HasBackend backend, TLSParams params)
        => backend
        -- ^ Backend abstraction with specific method to interact with the connection type.
        -> params
        -- ^ Parameters of the context.
        -> m Context
    contextNew :: forall (m :: * -> *) backend params.
    (MonadIO m, HasBackend backend, TLSParams params) =>
    backend -> params -> m Context
    contextNew backend
    backend params
    params = IO Context -> m Context
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Context -> m Context) -> IO Context -> m Context
    forall a b. (a -> b) -> a -> b
    $ do
        backend -> IO ()
    forall a. HasBackend a => a -> IO ()
    initializeBackend backend
    backend

        let (Supported
    supported, Shared
    shared, DebugParams
    debug) = params -> CommonParams
    forall a. TLSParams a => a -> CommonParams
    getTLSCommonParams params
    params

        seed <- case DebugParams -> Maybe Seed
    debugSeed DebugParams
    debug of
            Maybe Seed
    Nothing -> do
                seed <- IO Seed
    forall (randomly :: * -> *). MonadRandom randomly => randomly Seed
    seedNew
                debugPrintSeed debug seed
                return seed
            Just Seed
    determ -> Seed -> IO Seed
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Seed
    determ
        let rng = Seed -> StateRNG
    newStateRNG Seed
    seed

        let role = params -> Role
    forall a. TLSParams a => a -> Role
    getTLSRole params
    params
            st = StateRNG -> Role -> TLSState
    newTLSState StateRNG
    rng Role
    role

        tlsstate <- newMVar st
        eof <- newIORef False
        established <- newIORef NotEstablished
        stats <- newIORef newMeasurement
        needEmptyPacket <- newIORef False
        hooks <- newIORef defaultHooks
        tx <- newMVar newRecordState
        rx <- newMVar newRecordState
        hs <- newMVar Nothing
        recvActionsRef <- newIORef []
        sendActionRef <- newIORef Nothing
        crs <- newIORef []
        locks <- Locks <$> newMVar () <*> newMVar () <*> newMVar ()
        st13ref <- newIORef defaultTLS13State
        mylimref <- newRecordLimitRef $ Just defaultRecordSizeLimit
        peerlimref <- newRecordLimitRef $ Just defaultRecordSizeLimit
        let roleParams =
                RoleParams
                    { doHandshake_ :: Context -> IO ()
    doHandshake_ = params -> Context -> IO ()
    forall a. TLSParams a => a -> Context -> IO ()
    doHandshake params
    params
                    , doHandshakeWith_ :: Context -> Handshake -> IO ()
    doHandshakeWith_ = params -> Context -> Handshake -> IO ()
    forall a. TLSParams a => a -> Context -> Handshake -> IO ()
    doHandshakeWith params
    params
                    , doRequestCertificate_ :: Context -> IO Bool
    doRequestCertificate_ = params -> Context -> IO Bool
    forall a. TLSParams a => a -> Context -> IO Bool
    doRequestCertificate params
    params
                    , doPostHandshakeAuthWith_ :: Context -> Handshake13 -> IO ()
    doPostHandshakeAuthWith_ = params -> Context -> Handshake13 -> IO ()
    forall a. TLSParams a => a -> Context -> Handshake13 -> IO ()
    doPostHandshakeAuthWith params
    params
                    }

        let ctx =
                Context
                    { ctxBackend :: Backend
    ctxBackend = backend -> Backend
    forall a. HasBackend a => a -> Backend
    getBackend backend
    backend
                    , ctxShared :: Shared
    ctxShared = Shared
    shared
                    , ctxSupported :: Supported
    ctxSupported = Supported
    supported
                    , ctxTLSState :: MVar TLSState
    ctxTLSState = MVar TLSState
    tlsstate
                    , ctxMyRecordLimit :: IORef RecordLimit
    ctxMyRecordLimit = IORef RecordLimit
    mylimref
                    , ctxPeerRecordLimit :: IORef RecordLimit
    ctxPeerRecordLimit = IORef RecordLimit
    peerlimref
                    , ctxTxRecordState :: MVar RecordState
    ctxTxRecordState = MVar RecordState
    tx
                    , ctxRxRecordState :: MVar RecordState
    ctxRxRecordState = MVar RecordState
    rx
                    , ctxHandshakeState :: MVar (Maybe HandshakeState)
    ctxHandshakeState = MVar (Maybe HandshakeState)
    hs
                    , ctxRoleParams :: RoleParams
    ctxRoleParams = RoleParams
    roleParams
                    , ctxMeasurement :: IORef Measurement
    ctxMeasurement = IORef Measurement
    stats
                    , ctxEOF_ :: IORef Bool
    ctxEOF_ = IORef Bool
    eof
                    , ctxEstablished_ :: IORef Established
    ctxEstablished_ = IORef Established
    established
                    , ctxNeedEmptyPacket :: IORef Bool
    ctxNeedEmptyPacket = IORef Bool
    needEmptyPacket
                    , ctxHooks :: IORef Hooks
    ctxHooks = IORef Hooks
    hooks
                    , ctxLocks :: Locks
    ctxLocks = Locks
    locks
                    , ctxPendingRecvActions :: IORef [PendingRecvAction]
    ctxPendingRecvActions = IORef [PendingRecvAction]
    recvActionsRef
                    , ctxPendingSendAction :: IORef (Maybe (Context -> IO ()))
    ctxPendingSendAction = IORef (Maybe (Context -> IO ()))
    sendActionRef
                    , ctxCertRequests :: IORef [Handshake13]
    ctxCertRequests = IORef [Handshake13]
    crs
                    , ctxKeyLogger :: String -> IO ()
    ctxKeyLogger = DebugParams -> String -> IO ()
    debugKeyLogger DebugParams
    debug
                    , ctxRecordLayer :: RecordLayer ByteString
    ctxRecordLayer = RecordLayer ByteString
    recordLayer
                    , ctxHandshakeSync :: HandshakeSync
    ctxHandshakeSync = (Context -> ClientState -> IO ())
    -> (Context -> ServerState -> IO ()) -> HandshakeSync
    HandshakeSync Context -> ClientState -> IO ()
    forall {m :: * -> *} {p} {p}. Monad m => p -> p -> m ()
    syncNoOp Context -> ServerState -> IO ()
    forall {m :: * -> *} {p} {p}. Monad m => p -> p -> m ()
    syncNoOp
                    , ctxQUICMode :: Bool
    ctxQUICMode = Bool
    False
                    , ctxTLS13State :: IORef TLS13State
    ctxTLS13State = IORef TLS13State
    st13ref
                    }

            syncNoOp p
    _ p
    _ = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

            recordLayer =
                RecordLayer
                    { recordEncode12 :: Context -> Record Plaintext -> IO (Either TLSError ByteString)
    recordEncode12 = Context -> Record Plaintext -> IO (Either TLSError ByteString)
    encodeRecord12
                    , recordEncode13 :: Context -> Record Plaintext -> IO (Either TLSError ByteString)
    recordEncode13 = Context -> Record Plaintext -> IO (Either TLSError ByteString)
    encodeRecord13
                    , recordSendBytes :: Context -> ByteString -> IO ()
    recordSendBytes = Context -> ByteString -> IO ()
    sendBytes
                    , recordRecv12 :: Context -> IO (Either TLSError (Record Plaintext))
    recordRecv12 = Context -> IO (Either TLSError (Record Plaintext))
    recvRecord12
                    , recordRecv13 :: Context -> IO (Either TLSError (Record Plaintext))
    recordRecv13 = Context -> IO (Either TLSError (Record Plaintext))
    recvRecord13
                    }

        return ctx

    contextHookSetHandshakeRecv :: Context -> (Handshake -> IO Handshake) -> IO ()
    contextHookSetHandshakeRecv :: Context -> (Handshake -> IO Handshake) -> IO ()
    contextHookSetHandshakeRecv Context
    context Handshake -> IO Handshake
    f =
        Context -> (Hooks -> Hooks) -> IO ()
    contextModifyHooks Context
    context (\Hooks
    hooks -> Hooks
    hooks{hookRecvHandshake = f})

    contextHookSetHandshake13Recv
        :: Context -> (Handshake13 -> IO Handshake13) -> IO ()
    contextHookSetHandshake13Recv :: Context -> (Handshake13 -> IO Handshake13) -> IO ()
    contextHookSetHandshake13Recv Context
    context Handshake13 -> IO Handshake13
    f =
        Context -> (Hooks -> Hooks) -> IO ()
    contextModifyHooks Context
    context (\Hooks
    hooks -> Hooks
    hooks{hookRecvHandshake13 = f})

    contextHookSetCertificateRecv :: Context -> (CertificateChain -> IO ()) -> IO ()
    contextHookSetCertificateRecv :: Context -> (CertificateChain -> IO ()) -> IO ()
    contextHookSetCertificateRecv Context
    context CertificateChain -> IO ()
    f =
        Context -> (Hooks -> Hooks) -> IO ()
    contextModifyHooks Context
    context (\Hooks
    hooks -> Hooks
    hooks{hookRecvCertificates = f})

    contextHookSetLogging :: Context -> Logging -> IO ()
    contextHookSetLogging :: Context -> Logging -> IO ()
    contextHookSetLogging Context
    context Logging
    loggingCallbacks =
        Context -> (Hooks -> Hooks) -> IO ()
    contextModifyHooks Context
    context (\Hooks
    hooks -> Hooks
    hooks{hookLogging = loggingCallbacks})

    {-# DEPRECATED getFinished "Use getTLSUnique instead" #-}

    -- | Getting TLS Finished sent to peer.
    getFinished :: Context -> IO (Maybe VerifyData)
    getFinished :: Context -> IO (Maybe VerifyData)
    getFinished Context
    ctx = Context -> TLSSt (Maybe VerifyData) -> IO (Maybe VerifyData)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe VerifyData)
    getMyVerifyData

    {-# DEPRECATED getPeerFinished "Use getTLSUnique instead" #-}

    -- | Getting TLS Finished received from peer.
    getPeerFinished :: Context -> IO (Maybe VerifyData)
    getPeerFinished :: Context -> IO (Maybe VerifyData)
    getPeerFinished Context
    ctx = Context -> TLSSt (Maybe VerifyData) -> IO (Maybe VerifyData)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe VerifyData)
    getPeerVerifyData

    -- | Getting the "tls-unique" channel binding for TLS 1.2 (RFC5929).
    --   For TLS 1.3, 'Nothing' is returned.
    --   'supportedExtendedMainSecret' must be 'RequireEMS'
    --   But in general, it is highly recommended to upgrade to TLS 1.3
    --   and use the "tls-exporter" channel binding via 'getTLSExporter'.
    getTLSUnique :: Context -> IO (Maybe ByteString)
    getTLSUnique :: Context -> IO (Maybe ByteString)
    getTLSUnique Context
    ctx = do
        ver <- IO Version -> IO Version
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Version -> IO Version) -> IO Version -> IO Version
    forall a b. (a -> b) -> a -> b
    $ Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
        if ver == TLS12
            then do
                mx <- usingState_ ctx getFirstVerifyData
                case mx of
                    Maybe VerifyData
    Nothing -> Maybe ByteString -> IO (Maybe ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing
                    Just (VerifyData ByteString
    verifyData) -> Maybe ByteString -> IO (Maybe ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> IO (Maybe ByteString))
    -> Maybe ByteString -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    verifyData
            else return Nothing

    -- | Getting the "tls-exporter" channel binding for TLS 1.3 (RFC9266).
    --   For TLS 1.2, 'Nothing' is returned.
    getTLSExporter :: Context -> IO (Maybe ByteString)
    getTLSExporter :: Context -> IO (Maybe ByteString)
    getTLSExporter Context
    ctx = do
        ver <- IO Version -> IO Version
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Version -> IO Version) -> IO Version -> IO Version
    forall a b. (a -> b) -> a -> b
    $ Context -> TLSSt Version -> IO Version
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Version
    getVersion
        if ver == TLS13
            then exporter ctx "EXPORTER-Channel-Binding" "" 32
            else return Nothing

    exporter :: Context -> ByteString -> ByteString -> Int -> IO (Maybe ByteString)
    exporter :: Context -> ByteString -> ByteString -> Int -> IO (Maybe ByteString)
    exporter Context
    ctx ByteString
    label ByteString
    context Int
    outlen = do
        msecret <- Context -> TLSSt (Maybe ByteString) -> IO (Maybe ByteString)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe ByteString)
    getTLS13ExporterSecret
        mcipher <- failOnEitherError $ runRxRecordState ctx $ gets stCipher
        return $ case (msecret, mcipher) of
            (Just ByteString
    secret, Just Cipher
    cipher) ->
                let h :: Hash
    h = Cipher -> Hash
    cipherHash Cipher
    cipher
                    secret' :: ByteString
    secret' = Hash -> ByteString -> ByteString -> ByteString -> ByteString
    deriveSecret Hash
    h ByteString
    secret ByteString
    label ByteString
    ""
                    label' :: ByteString
    label' = ByteString
    "exporter"
                    value' :: ByteString
    value' = Hash -> ByteString -> ByteString
    hash Hash
    h ByteString
    context
                    key :: ByteString
    key = Hash -> ByteString -> ByteString -> ByteString -> Int -> ByteString
    hkdfExpandLabel Hash
    h ByteString
    secret' ByteString
    label' ByteString
    value' Int
    outlen
                 in ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    key
            (Maybe ByteString, Maybe Cipher)
    _ -> Maybe ByteString
    forall a. Maybe a
    Nothing

    -- | Getting the "tls-server-end-point" channel binding for TLS 1.2
    --   (RFC5929).  For 1.3, there is no specifications for how to create
    --   it.  In this implementation, a certificate chain without
    --   extensions is hashed like TLS 1.2.
    getTLSServerEndPoint :: Context -> IO (Maybe ByteString)
    getTLSServerEndPoint :: Context -> IO (Maybe ByteString)
    getTLSServerEndPoint Context
    ctx = do
        mcc <- Context
    -> TLSSt (Maybe CertificateChain) -> IO (Maybe CertificateChain)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe CertificateChain)
    getServerCertificateChain
        case mcc of
            Maybe CertificateChain
    Nothing -> Maybe ByteString -> IO (Maybe ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing
            Just CertificateChain
    cc -> do
                (usedHash, _, _, _) <- Context -> IO (Hash, Cipher, CryptLevel, ByteString)
    getRxRecordState Context
    ctx
                return $ Just $ hash usedHash $ encodeCertificate cc