    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# OPTIONS_HADDOCK hide #-}

    module Network.TLS.Core (
        -- * Internal packet sending and receiving
        sendPacket12,
        recvPacket12,

        -- * Initialisation and Termination of context
        bye,
        handshake,

        -- * Application Layer Protocol Negotiation
        getNegotiatedProtocol,

        -- * Server Name Indication
        getClientSNI,

        -- * High level API
        sendData,
        recvData,
        recvData',
        updateKey,
        KeyUpdateRequest (..),
        requestCertificate,
    ) where

    import qualified Control.Exception as E
    import Control.Monad.State.Strict
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as C8
    import qualified Data.ByteString.Lazy as L
    import Data.IORef
    import System.Timeout

    import Network.TLS.Cipher
    import Network.TLS.Context
    import Network.TLS.Crypto
    import Network.TLS.Extension
    import Network.TLS.Handshake
    import Network.TLS.Handshake.Common
    import Network.TLS.Handshake.Common13
    import Network.TLS.Handshake.Process
    import Network.TLS.Handshake.State
    import Network.TLS.Handshake.State13
    import Network.TLS.IO
    import Network.TLS.Imports
    import Network.TLS.KeySchedule
    import Network.TLS.Parameters
    import Network.TLS.PostHandshake
    import Network.TLS.Session
    import Network.TLS.State (getRole, getSession)
    import qualified Network.TLS.State as S
    import Network.TLS.Struct
    import Network.TLS.Struct13
    import Network.TLS.Types (
        AnyTrafficSecret (..),
        ApplicationSecret,
        HostName,
        Role (..),
     )
    import Network.TLS.Util (catchException, mapChunks_)

    -- | Handshake for a new TLS connection
    -- This is to be called at the beginning of a connection, and during renegotiation.
    -- Don't use this function as the acquire resource of 'bracket'.
    handshake :: MonadIO m => Context -> m ()
    handshake :: forall (m :: * -> *). MonadIO m => Context -> m ()
    handshake Context
    ctx = do
        Context -> m ()
    forall (m :: * -> *). MonadIO m => Context -> m ()
    handshake_ Context
    ctx
        -- Trying to receive an alert of client authentication failure
        IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
            role <- Context -> TLSSt Role -> IO Role
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Role
    getRole
            tls13 <- tls13orLater ctx
            sentClientCert <- tls13stSentClientCert <$> getTLS13State ctx
            when (role == ClientRole && tls13 && sentClientCert) $ do
                rtt <- getRTT ctx
                -- This 'timeout' should work.
                mdat <- timeout rtt $ recvData13 ctx
                case mdat of
                    Maybe ByteString
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    Just ByteString
    dat -> Context -> (TLS13State -> TLS13State) -> IO ()
    modifyTLS13State Context
    ctx ((TLS13State -> TLS13State) -> IO ())
    -> (TLS13State -> TLS13State) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \TLS13State
    st -> TLS13State
    st{tls13stPendingRecvData = Just dat}

    rttFactor :: Int
    rttFactor :: Int
    rttFactor = Int
    3

    getRTT :: Context -> IO Int
    getRTT :: Context -> IO Int
    getRTT Context
    ctx = do
        rtt <- TLS13State -> Millisecond
    tls13stRTT (TLS13State -> Millisecond) -> IO TLS13State -> IO Millisecond
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> IO TLS13State
    getTLS13State Context
    ctx
        let rtt' = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max (Millisecond -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Millisecond
    rtt) Int
    10
        return (rtt' * rttFactor * 1000) -- ms to us

    -- | Notify the context that this side wants to close connection.
    -- This is important that it is called before closing the handle, otherwise
    -- the session might not be resumable (for version < TLS1.2).
    -- This doesn't actually close the handle.
    --
    -- Proper usage is as follows:
    --
    -- > ctx <- contextNew <backend> <params>
    -- > handshake ctx
    -- > ...
    -- > bye
    --
    -- The following code ensures nothing but is no harm.
    --
    -- > bracket (contextNew <backend> <params>) bye $ \ctx -> do
    -- >   handshake ctx
    -- >   ...
    bye :: MonadIO m => Context -> m ()
    bye :: forall (m :: * -> *). MonadIO m => Context -> m ()
    bye Context
    ctx = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        eof <- Context -> IO Bool
    ctxEOF Context
    ctx
        tls13 <- tls13orLater ctx
        when (tls13 && not eof) $ do
            role <- usingState_ ctx getRole
            if role == ClientRole
                then do
                    withWriteLock ctx $ sendCFifNecessary ctx
                    -- receiving NewSessionTicket
                    let chk = TLS13State -> Bool
    tls13stRecvNST (TLS13State -> Bool) -> IO TLS13State -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> IO TLS13State
    getTLS13State Context
    ctx
                    recvNST <- chk
                    unless recvNST $ do
                        rtt <- getRTT ctx
                        void $ timeout rtt $ recvHS13 ctx chk
                else do
                    -- receiving Client Finished
                    let chk = TLS13State -> Bool
    tls13stRecvCF (TLS13State -> Bool) -> IO TLS13State -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> IO TLS13State
    getTLS13State Context
    ctx
                    recvCF <- chk
                    unless recvCF $ do
                        -- no chance to measure RTT before receiving CF
                        -- fixme: 1sec is good enough?
                        let rtt = Int
    1000000
                        void $ timeout rtt $ recvHS13 ctx chk
        bye_ ctx

    bye_ :: MonadIO m => Context -> m ()
    bye_ :: forall (m :: * -> *). MonadIO m => Context -> m ()
    bye_ Context
    ctx = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        -- Although setEOF is always protected by the read lock, here we don't try
        -- to wrap ctxEOF with it, so that function bye can still be called
        -- concurrently to a blocked recvData.
        eof <- Context -> IO Bool
    ctxEOF Context
    ctx
        tls13 <- tls13orLater ctx
        unless eof $
            withWriteLock ctx $
                if tls13
                    then sendPacket13 ctx $ Alert13 [(AlertLevel_Warning, CloseNotify)]
                    else sendPacket12 ctx $ Alert [(AlertLevel_Warning, CloseNotify)]

    -- | If the ALPN extensions have been used, this will
    -- return get the protocol agreed upon.
    getNegotiatedProtocol :: MonadIO m => Context -> m (Maybe B.ByteString)
    getNegotiatedProtocol :: forall (m :: * -> *). MonadIO m => Context -> m (Maybe ByteString)
    getNegotiatedProtocol Context
    ctx = IO (Maybe ByteString) -> m (Maybe ByteString)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
    -> IO (Maybe ByteString) -> m (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ Context -> TLSSt (Maybe ByteString) -> IO (Maybe ByteString)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe ByteString)
    S.getNegotiatedProtocol

    -- | If the Server Name Indication extension has been used, return the
    -- hostname specified by the client.
    getClientSNI :: MonadIO m => Context -> m (Maybe HostName)
    getClientSNI :: forall (m :: * -> *). MonadIO m => Context -> m (Maybe HostName)
    getClientSNI Context
    ctx = IO (Maybe HostName) -> m (Maybe HostName)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe HostName) -> m (Maybe HostName))
    -> IO (Maybe HostName) -> m (Maybe HostName)
    forall a b. (a -> b) -> a -> b
    $ Context -> TLSSt (Maybe HostName) -> IO (Maybe HostName)
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt (Maybe HostName)
    S.getClientSNI

    sendCFifNecessary :: Context -> IO ()
    sendCFifNecessary :: Context -> IO ()
    sendCFifNecessary Context
    ctx = do
        st <- Context -> IO TLS13State
    getTLS13State Context
    ctx
        let recvSF = TLS13State -> Bool
    tls13stRecvSF TLS13State
    st
            sentCF = TLS13State -> Bool
    tls13stSentCF TLS13State
    st
        when (recvSF && not sentCF) $ do
            msend <- readIORef (ctxPendingSendAction ctx)
            case msend of
                Maybe (Context -> IO ())
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Just Context -> IO ()
    sendAction -> do
                    Context -> IO ()
    sendAction Context
    ctx
                    IORef (Maybe (Context -> IO ()))
    -> Maybe (Context -> IO ()) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (Context -> IORef (Maybe (Context -> IO ()))
    ctxPendingSendAction Context
    ctx) Maybe (Context -> IO ())
    forall a. Maybe a
    Nothing

    -- | sendData sends a bunch of data.
    -- It will automatically chunk data to acceptable packet size
    sendData :: MonadIO m => Context -> L.ByteString -> m ()
    sendData :: forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
    sendData Context
    _ ByteString
    "" = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    sendData Context
    ctx ByteString
    dataToSend = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
        tls13 <- Context -> IO Bool
    forall (m :: * -> *). MonadIO m => Context -> m Bool
    tls13orLater Context
    ctx
        let sendP ByteString
    bs
                | Bool
    tls13 = do
                    Context -> Packet13 -> IO ()
    sendPacket13 Context
    ctx (Packet13 -> IO ()) -> Packet13 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Packet13
    AppData13 ByteString
    bs
                    role <- Context -> TLSSt Role -> IO Role
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Role
    getRole
                    sentCF <- tls13stSentCF <$> getTLS13State ctx
                    rtt0 <- tls13st0RTT <$> getTLS13State ctx
                    when (role == ClientRole && rtt0 && not sentCF) $
                        modifyTLS13State ctx $
                            \TLS13State
    st -> TLS13State
    st{tls13stPendingSentData = tls13stPendingSentData st . (bs :)}
                | Bool
    otherwise = Context -> Packet -> IO ()
    sendPacket12 Context
    ctx (Packet -> IO ()) -> Packet -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Packet
    AppData ByteString
    bs
        when tls13 $ withWriteLock ctx $ sendCFifNecessary ctx
        withWriteLock ctx $ do
            checkValid ctx
            -- All chunks are protected with the same write lock because we don't
            -- want to interleave writes from other threads in the middle of our
            -- possibly large write.
            mlen <- getPeerRecordLimit ctx -- plaintext, dont' adjust for TLS 1.3
            mapM_ (mapChunks_ mlen sendP) (L.toChunks dataToSend)

    -- | Get data out of Data packet, and automatically renegotiate if a Handshake
    -- ClientHello is received.  An empty result means EOF.
    recvData :: MonadIO m => Context -> m B.ByteString
    recvData :: forall (m :: * -> *). MonadIO m => Context -> m ByteString
    recvData Context
    ctx = IO ByteString -> m ByteString
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $ do
        tls13 <- Context -> IO Bool
    forall (m :: * -> *). MonadIO m => Context -> m Bool
    tls13orLater Context
    ctx
        withReadLock ctx $ do
            checkValid ctx
            -- We protect with a read lock both reception and processing of the
            -- packet, because don't want another thread to receive a new packet
            -- before this one has been fully processed.
            --
            -- Even when recvData12/recvData13 loops, we only need to call function
            -- checkValid once.  Since we hold the read lock, no concurrent call
            -- will impact the validity of the context.
            if tls13 then recvData13 ctx else recvData12 ctx

    recvData12 :: Context -> IO B.ByteString
    recvData12 :: Context -> IO ByteString
    recvData12 Context
    ctx = do
        pkt <- Context -> IO (Either TLSError Packet)
    recvPacket12 Context
    ctx
        either (onError terminate12) process pkt
      where
        process :: Packet -> IO ByteString
    process (Handshake [ch :: Handshake
    ch@ClientHello{}]) =
            Context -> Handshake -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Handshake -> m ()
    handshakeWith Context
    ctx Handshake
    ch 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
    >> Context -> IO ByteString
    recvData12 Context
    ctx
        process (Handshake [hr :: Handshake
    hr@Handshake
    HelloRequest]) =
            Context -> Handshake -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> Handshake -> m ()
    handshakeWith Context
    ctx Handshake
    hr 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
    >> Context -> IO ByteString
    recvData12 Context
    ctx
        -- UserCanceled should be followed by a close_notify.
        -- fixme: is it safe to call recvData12?
        process (Alert [(AlertLevel
    AlertLevel_Warning, AlertDescription
    UserCanceled)]) = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    B.empty
        process (Alert [(AlertLevel
    AlertLevel_Warning, AlertDescription
    CloseNotify)]) = Context -> IO ()
    tryBye Context
    ctx IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Context -> IO ()
    setEOF Context
    ctx 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
    >> ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    B.empty
        process (Alert [(AlertLevel
    AlertLevel_Fatal, AlertDescription
    desc)]) = do
            Context -> IO ()
    setEOF Context
    ctx
            TLSException -> IO ByteString
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO
                ( Bool -> HostName -> TLSError -> TLSException
    Terminated
                    Bool
    True
                    (HostName
    "received fatal error: " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ AlertDescription -> HostName
    forall a. Show a => a -> HostName
    show AlertDescription
    desc)
                    (HostName -> AlertDescription -> TLSError
    Error_Protocol HostName
    "remote side fatal error" AlertDescription
    desc)
                )

        -- when receiving empty appdata, we just retry to get some data.
        process (AppData ByteString
    "") = Context -> IO ByteString
    recvData12 Context
    ctx
        process (AppData ByteString
    x) = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    x
        process Packet
    p =
            let reason :: HostName
    reason = HostName
    "unexpected message " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ Packet -> HostName
    forall a. Show a => a -> HostName
    show Packet
    p
             in TLSError
    -> AlertLevel -> AlertDescription -> HostName -> IO ByteString
    forall {a}.
    TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate12 (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason

        terminate12 :: TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate12 = Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    forall a.
    Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    terminateWithWriteLock Context
    ctx (Context -> Packet -> IO ()
    sendPacket12 Context
    ctx (Packet -> IO ())
    -> ([(AlertLevel, AlertDescription)] -> Packet)
    -> [(AlertLevel, AlertDescription)]
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(AlertLevel, AlertDescription)] -> Packet
    Alert)

    recvData13 :: Context -> IO B.ByteString
    recvData13 :: Context -> IO ByteString
    recvData13 Context
    ctx = do
        mdat <- TLS13State -> Maybe ByteString
    tls13stPendingRecvData (TLS13State -> Maybe ByteString)
    -> IO TLS13State -> IO (Maybe ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> IO TLS13State
    getTLS13State Context
    ctx
        case mdat of
            Maybe ByteString
    Nothing -> do
                pkt <- Context -> IO (Either TLSError Packet13)
    recvPacket13 Context
    ctx
                either (onError (terminate13 ctx)) process pkt
            Just ByteString
    dat -> do
                Context -> (TLS13State -> TLS13State) -> IO ()
    modifyTLS13State Context
    ctx ((TLS13State -> TLS13State) -> IO ())
    -> (TLS13State -> TLS13State) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \TLS13State
    st -> TLS13State
    st{tls13stPendingRecvData = Nothing}
                ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    dat
      where
        -- UserCanceled MUST be followed by a CloseNotify.
        process :: Packet13 -> IO ByteString
    process (Alert13 [(AlertLevel
    AlertLevel_Warning, AlertDescription
    UserCanceled)]) = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    B.empty
        process (Alert13 [(AlertLevel
    AlertLevel_Warning, AlertDescription
    CloseNotify)]) = Context -> IO ()
    tryBye Context
    ctx IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Context -> IO ()
    setEOF Context
    ctx 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
    >> ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    B.empty
        process (Alert13 [(AlertLevel
    AlertLevel_Fatal, AlertDescription
    desc)]) = do
            Context -> IO ()
    setEOF Context
    ctx
            TLSException -> IO ByteString
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO
                ( Bool -> HostName -> TLSError -> TLSException
    Terminated
                    Bool
    True
                    (HostName
    "received fatal error: " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ AlertDescription -> HostName
    forall a. Show a => a -> HostName
    show AlertDescription
    desc)
                    (HostName -> AlertDescription -> TLSError
    Error_Protocol HostName
    "remote side fatal error" AlertDescription
    desc)
                )
        process (Handshake13 [Handshake13]
    hs) = do
            [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs
            Context -> IO ByteString
    recvData13 Context
    ctx
        -- when receiving empty appdata, we just retry to get some data.
        process (AppData13 ByteString
    "") = Context -> IO ByteString
    recvData13 Context
    ctx
        process (AppData13 ByteString
    x) = do
            let chunkLen :: Int
    chunkLen = ByteString -> Int
    C8.length ByteString
    x
            established <- Context -> IO Established
    ctxEstablished Context
    ctx
            case established of
                EarlyDataAllowed Int
    maxSize
                    | Int
    chunkLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maxSize -> do
                        Context -> Established -> IO ()
    setEstablished Context
    ctx (Established -> IO ()) -> Established -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Established
    EarlyDataAllowed (Int
    maxSize Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    chunkLen)
                        ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    x
                    | Bool
    otherwise ->
                        let reason :: HostName
    reason = HostName
    "early data overflow"
                         in Context
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO ByteString
    forall a.
    Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate13 Context
    ctx (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
                EarlyDataNotAllowed Int
    n
                    | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 -> do
                        Context -> Established -> IO ()
    setEstablished Context
    ctx (Established -> IO ()) -> Established -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Established
    EarlyDataNotAllowed (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
                        Context -> IO ByteString
    recvData13 Context
    ctx -- ignore "x"
                    | Bool
    otherwise ->
                        let reason :: HostName
    reason = HostName
    "early data deprotect overflow"
                         in Context
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO ByteString
    forall a.
    Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate13 Context
    ctx (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
                Established
    Established -> ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    x
                Established
    _ -> TLSError -> IO ByteString
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore (TLSError -> IO ByteString) -> TLSError -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ HostName -> AlertDescription -> TLSError
    Error_Protocol HostName
    "data at not-established" AlertDescription
    UnexpectedMessage
        process Packet13
    ChangeCipherSpec13 = do
            established <- Context -> IO Established
    ctxEstablished Context
    ctx
            if established /= Established
                then recvData13 ctx
                else do
                    let reason = HostName
    "CSS after Finished"
                    terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
        process Packet13
    p =
            let reason :: HostName
    reason = HostName
    "unexpected message " HostName -> HostName -> HostName
    forall a. [a] -> [a] -> [a]
    ++ Packet13 -> HostName
    forall a. Show a => a -> HostName
    show Packet13
    p
             in Context
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO ByteString
    forall a.
    Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate13 Context
    ctx (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason

        loopHandshake13 :: [Handshake13] -> IO ()
    loopHandshake13 [] = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        -- fixme: some implementations send multiple NST at the same time.
        -- Only the first one is used at this moment.
        loopHandshake13 (NewSessionTicket13 Second
    life Second
    add ByteString
    nonce ByteString
    ticket [ExtensionRaw]
    exts : [Handshake13]
    hs) = do
            role <- Context -> TLSSt Role -> IO Role
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Role
    S.getRole
            unless (role == ClientRole) $
                let reason = HostName
    "Session ticket is allowed for client only"
                 in terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
            -- This part is similar to handshake code, so protected with
            -- read+write locks (which is also what we use for all calls to the
            -- session manager).
            withWriteLock ctx $ do
                Just resumptionSecret <- usingHState ctx getTLS13ResumptionSecret
                (_, usedCipher, _, _) <- getTxRecordState ctx
                -- mMaxSize is always Just, but anyway
                let extract (EarlyDataIndication Maybe Second
    mMaxSize) =
                        b -> (Second -> b) -> Maybe Second -> b
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe b
    0 (Second -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Second -> b) -> (Second -> Second) -> Second -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Second -> Second
    forall a. (Num a, Ord a, FiniteBits a) => a -> a
    safeNonNegative32) Maybe Second
    mMaxSize
                let choice = Version -> Cipher -> CipherChoice
    makeCipherChoice Version
    TLS13 Cipher
    usedCipher
                    psk = CipherChoice
    -> BaseSecret ResumptionSecret -> ByteString -> ByteString
    derivePSK CipherChoice
    choice BaseSecret ResumptionSecret
    resumptionSecret ByteString
    nonce
                    maxSize =
                        ExtensionID
    -> MessageType
    -> [ExtensionRaw]
    -> Int
    -> (EarlyDataIndication -> Int)
    -> Int
    forall e a.
    Extension e =>
    ExtensionID -> MessageType -> [ExtensionRaw] -> a -> (e -> a) -> a
    lookupAndDecode
                            ExtensionID
    EID_EarlyData
                            MessageType
    MsgTNewSessionTicket
                            [ExtensionRaw]
    exts
                            Int
    0
                            EarlyDataIndication -> Int
    forall {b}. Num b => EarlyDataIndication -> b
    extract
                    life7d = Second -> Second -> Second
    forall a. Ord a => a -> a -> a
    min Second
    life Second
    604800 -- 7 days max
                tinfo <- createTLS13TicketInfo life7d (Right add) Nothing
                sdata <- getSessionData13 ctx usedCipher tinfo maxSize psk
                let ticket' = ByteString -> ByteString
    B.copy ByteString
    ticket
                void $ sessionEstablish (sharedSessionManager $ ctxShared ctx) ticket' sdata
                modifyTLS13State ctx $ \TLS13State
    st -> TLS13State
    st{tls13stRecvNST = True}
            loopHandshake13 hs
        loopHandshake13 (KeyUpdate13 KeyUpdate
    mode : [Handshake13]
    hs) = do
            let multipleKeyUpdate :: Bool
    multipleKeyUpdate = (Handshake13 -> Bool) -> [Handshake13] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Handshake13 -> Bool
    isKeyUpdate13 [Handshake13]
    hs
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    multipleKeyUpdate (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                let reason :: HostName
    reason = HostName
    "Multiple KeyUpdate is not allowed in one record"
                Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO ()
    forall a.
    Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate13 Context
    ctx (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Context -> Bool
    ctxQUICMode Context
    ctx) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                let reason :: HostName
    reason = HostName
    "KeyUpdate is not allowed for QUIC"
                Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO ()
    forall a.
    Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate13 Context
    ctx (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
            Context -> [Handshake13] -> IO ()
    checkAlignment Context
    ctx [Handshake13]
    hs
            established <- Context -> IO Established
    ctxEstablished Context
    ctx
            -- Though RFC 8446 Sec 4.6.3 does not clearly says,
            -- unidirectional key update is legal.
            -- So, we don't have to check if this key update is corresponding
            -- to key update (update_requested) which we sent.
            if established == Established
                then do
                    keyUpdate ctx getRxRecordState setRxRecordState
                    -- Write lock wraps both actions because we don't want another
                    -- packet to be sent by another thread before the Tx state is
                    -- updated.
                    when (mode == UpdateRequested) $ withWriteLock ctx $ do
                        sendPacket13 ctx $ Handshake13 [KeyUpdate13 UpdateNotRequested]
                        keyUpdate ctx getTxRecordState setTxRecordState
                    loopHandshake13 hs
                else do
                    let reason = HostName
    "received key update before established"
                    terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
        loopHandshake13 (h :: Handshake13
    h@CertRequest13{} : [Handshake13]
    hs) =
            Context -> Handshake13 -> IO ()
    postHandshakeAuthWith Context
    ctx Handshake13
    h IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs
        loopHandshake13 (h :: Handshake13
    h@Certificate13{} : [Handshake13]
    hs) =
            Context -> Handshake13 -> IO ()
    postHandshakeAuthWith Context
    ctx Handshake13
    h IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs
        loopHandshake13 (Handshake13
    h : [Handshake13]
    hs) = do
            rtt0 <- TLS13State -> Bool
    tls13st0RTT (TLS13State -> Bool) -> IO TLS13State -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> IO TLS13State
    getTLS13State Context
    ctx
            when rtt0 $ case h of
                ServerHello13 ServerRandom
    srand Session
    _ CipherId
    _ [ExtensionRaw]
    _ ->
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ServerRandom -> Bool
    isHelloRetryRequest ServerRandom
    srand) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                        Context -> IO ()
    clearTxRecordState Context
    ctx
                        let reason :: HostName
    reason = HostName
    "HRR is not allowed for 0-RTT"
                         in Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO ()
    forall a.
    Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate13 Context
    ctx (HostName -> TLSError
    Error_Misc HostName
    reason) AlertLevel
    AlertLevel_Fatal AlertDescription
    UnexpectedMessage HostName
    reason
                Handshake13
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            cont <- popAction ctx h hs
            when cont $ loopHandshake13 hs

    recvHS13 :: Context -> IO Bool -> IO ()
    recvHS13 :: Context -> IO Bool -> IO ()
    recvHS13 Context
    ctx IO Bool
    breakLoop = do
        pkt <- Context -> IO (Either TLSError Packet13)
    recvPacket13 Context
    ctx
        -- fixme: Left
        either (\TLSError
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) process pkt
      where
        -- UserCanceled MUST be followed by a CloseNotify.
        process :: Packet13 -> IO ()
    process (Alert13 [(AlertLevel
    AlertLevel_Warning, AlertDescription
    CloseNotify)]) = Context -> IO ()
    tryBye Context
    ctx IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Context -> IO ()
    setEOF Context
    ctx
        process (Alert13 [(AlertLevel
    AlertLevel_Fatal, AlertDescription
    _desc)]) = Context -> IO ()
    setEOF Context
    ctx
        process (Handshake13 [Handshake13]
    hs) = do
            [Handshake13] -> IO ()
    loopHandshake13 [Handshake13]
    hs
            stop <- IO Bool
    breakLoop
            unless stop $ recvHS13 ctx breakLoop
        process Packet13
    _ = Context -> IO Bool -> IO ()
    recvHS13 Context
    ctx IO Bool
    breakLoop

        loopHandshake13 :: [Handshake13] -> IO ()
    loopHandshake13 [] = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        -- fixme: some implementations send multiple NST at the same time.
        -- Only the first one is used at this moment.
        loopHandshake13 (NewSessionTicket13 Second
    life Second
    add ByteString
    nonce ByteString
    ticket [ExtensionRaw]
    exts : [Handshake13]
    hs) = do
            role <- Context -> TLSSt Role -> IO Role
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Role
    S.getRole
            unless (role == ClientRole) $
                let reason = HostName
    "Session ticket is allowed for client only"
                 in terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason
            -- This part is similar to handshake code, so protected with
            -- read+write locks (which is also what we use for all calls to the
            -- session manager).
            withWriteLock ctx $ do
                Just resumptionSecret <- usingHState ctx getTLS13ResumptionSecret
                (_, usedCipher, _, _) <- getTxRecordState ctx
                let choice = Version -> Cipher -> CipherChoice
    makeCipherChoice Version
    TLS13 Cipher
    usedCipher
                    psk = CipherChoice
    -> BaseSecret ResumptionSecret -> ByteString -> ByteString
    derivePSK CipherChoice
    choice BaseSecret ResumptionSecret
    resumptionSecret ByteString
    nonce
                    maxSize =
                        ExtensionID
    -> MessageType
    -> [ExtensionRaw]
    -> Int
    -> (EarlyDataIndication -> Int)
    -> Int
    forall e a.
    Extension e =>
    ExtensionID -> MessageType -> [ExtensionRaw] -> a -> (e -> a) -> a
    lookupAndDecode
                            ExtensionID
    EID_EarlyData
                            MessageType
    MsgTNewSessionTicket
                            [ExtensionRaw]
    exts
                            Int
    0
                            (\(EarlyDataIndication Maybe Second
    mms) -> Second -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Second -> Int) -> Second -> Int
    forall a b. (a -> b) -> a -> b
    $ Second -> Second
    forall a. (Num a, Ord a, FiniteBits a) => a -> a
    safeNonNegative32 (Second -> Second) -> Second -> Second
    forall a b. (a -> b) -> a -> b
    $ Maybe Second -> Second
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe Second
    mms)
                    life7d = Second -> Second -> Second
    forall a. Ord a => a -> a -> a
    min Second
    life Second
    604800 -- 7 days max
                tinfo <- createTLS13TicketInfo life7d (Right add) Nothing
                sdata <- getSessionData13 ctx usedCipher tinfo maxSize psk
                let ticket' = ByteString -> ByteString
    B.copy ByteString
    ticket
                void $ sessionEstablish (sharedSessionManager $ ctxShared ctx) ticket' sdata
                modifyTLS13State ctx $ \TLS13State
    st -> TLS13State
    st{tls13stRecvNST = True}
            loopHandshake13 hs
        loopHandshake13 (Handshake13
    h : [Handshake13]
    hs) = do
            cont <- Context -> Handshake13 -> [Handshake13] -> IO Bool
    popAction Context
    ctx Handshake13
    h [Handshake13]
    hs
            when cont $ loopHandshake13 hs

    terminate13
        :: Context -> TLSError -> AlertLevel -> AlertDescription -> String -> IO a
    terminate13 :: forall a.
    Context
    -> TLSError -> AlertLevel -> AlertDescription -> HostName -> IO a
    terminate13 Context
    ctx = Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    forall a.
    Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    terminateWithWriteLock Context
    ctx (Context -> Packet13 -> IO ()
    sendPacket13 Context
    ctx (Packet13 -> IO ())
    -> ([(AlertLevel, AlertDescription)] -> Packet13)
    -> [(AlertLevel, AlertDescription)]
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(AlertLevel, AlertDescription)] -> Packet13
    Alert13)

    popAction :: Context -> Handshake13 -> [Handshake13] -> IO Bool
    popAction :: Context -> Handshake13 -> [Handshake13] -> IO Bool
    popAction Context
    ctx Handshake13
    h [Handshake13]
    hs = do
        mPendingRecvAction <- Context -> IO (Maybe PendingRecvAction)
    popPendingRecvAction Context
    ctx
        case mPendingRecvAction of
            Maybe PendingRecvAction
    Nothing -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            Just PendingRecvAction
    action -> do
                -- Pending actions are executed with read+write locks, just
                -- like regular handshake code.
                Context -> IO () -> IO ()
    forall a. Context -> IO a -> IO a
    withWriteLock Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    Context -> IO () -> IO ()
    handleException Context
    ctx (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                        case PendingRecvAction
    action of
                            PendingRecvAction Bool
    needAligned Handshake13 -> IO ()
    pa -> do
                                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    needAligned (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Context -> [Handshake13] -> IO ()
    checkAlignment Context
    ctx [Handshake13]
    hs
                                Context -> Handshake13 -> IO ()
    processHandshake13 Context
    ctx Handshake13
    h
                                Handshake13 -> IO ()
    pa Handshake13
    h
                            PendingRecvActionHash Bool
    needAligned ByteString -> Handshake13 -> IO ()
    pa -> do
                                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    needAligned (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Context -> [Handshake13] -> IO ()
    checkAlignment Context
    ctx [Handshake13]
    hs
                                d <- Context -> IO ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    transcriptHash Context
    ctx
                                processHandshake13 ctx h
                                pa d h
                        -- Client: after receiving SH, app data is coming.
                        -- this loop tries to receive it.
                        -- App key must be installed before receiving
                        -- the app data.
                        Context -> IO ()
    sendCFifNecessary Context
    ctx
                Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    checkAlignment :: Context -> [Handshake13] -> IO ()
    checkAlignment :: Context -> [Handshake13] -> IO ()
    checkAlignment Context
    ctx [Handshake13]
    _hs = do
        complete <- Context -> IO Bool
    isRecvComplete Context
    ctx
        unless complete $ do
            let reason = HostName
    "received message not aligned with record boundary"
            terminate13 ctx (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason

    -- the other side could have close the connection already, so wrap
    -- this in a try and ignore all exceptions
    tryBye :: Context -> IO ()
    tryBye :: Context -> IO ()
    tryBye Context
    ctx = IO () -> (SomeException -> IO ()) -> IO ()
    forall a. IO a -> (SomeException -> IO a) -> IO a
    catchException (Context -> IO ()
    forall (m :: * -> *). MonadIO m => Context -> m ()
    bye_ Context
    ctx) (\SomeException
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    onError
        :: Monad m
        => (TLSError -> AlertLevel -> AlertDescription -> String -> m B.ByteString)
        -> TLSError
        -> m B.ByteString
    onError :: forall (m :: * -> *).
    Monad m =>
    (TLSError
     -> AlertLevel -> AlertDescription -> HostName -> m ByteString)
    -> TLSError -> m ByteString
    onError TLSError
    -> AlertLevel -> AlertDescription -> HostName -> m ByteString
    _ TLSError
    Error_EOF =
        -- Not really an error.
        ByteString -> m ByteString
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    B.empty
    onError TLSError
    -> AlertLevel -> AlertDescription -> HostName -> m ByteString
    terminate TLSError
    err =
        let (AlertLevel
    lvl, AlertDescription
    ad) = TLSError -> (AlertLevel, AlertDescription)
    errorToAlert TLSError
    err
         in TLSError
    -> AlertLevel -> AlertDescription -> HostName -> m ByteString
    terminate TLSError
    err AlertLevel
    lvl AlertDescription
    ad (TLSError -> HostName
    errorToAlertMessage TLSError
    err)

    terminateWithWriteLock
        :: Context
        -> ([(AlertLevel, AlertDescription)] -> IO ())
        -> TLSError
        -> AlertLevel
        -> AlertDescription
        -> String
        -> IO a
    terminateWithWriteLock :: forall a.
    Context
    -> ([(AlertLevel, AlertDescription)] -> IO ())
    -> TLSError
    -> AlertLevel
    -> AlertDescription
    -> HostName
    -> IO a
    terminateWithWriteLock Context
    ctx [(AlertLevel, AlertDescription)] -> IO ()
    send TLSError
    err AlertLevel
    level AlertDescription
    desc HostName
    reason = Context -> IO a -> IO a
    forall a. Context -> IO a -> IO a
    withWriteLock Context
    ctx (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ do
        tls13 <- Context -> IO Bool
    forall (m :: * -> *). MonadIO m => Context -> m Bool
    tls13orLater Context
    ctx
        unless tls13 $ do
            -- TLS 1.2 uses the same session ID and session data
            -- for all resumed sessions.
            --
            -- TLS 1.3 changes session data for every resumed session.
            session <- usingState_ ctx getSession
            case session of
                Session Maybe ByteString
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Session (Just ByteString
    sid) ->
                    -- calling even session ticket manager anyway
                    SessionManager -> ByteString -> IO ()
    sessionInvalidate (Shared -> SessionManager
    sharedSessionManager (Shared -> SessionManager) -> Shared -> SessionManager
    forall a b. (a -> b) -> a -> b
    $ Context -> Shared
    ctxShared Context
    ctx) ByteString
    sid
        catchException (send [(level, desc)]) (\SomeException
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
        setEOF ctx
        E.throwIO (Terminated False reason err)

    {-# DEPRECATED recvData' "use recvData that returns strict bytestring" #-}

    -- | same as recvData but returns a lazy bytestring.
    recvData' :: MonadIO m => Context -> m L.ByteString
    recvData' :: forall (m :: * -> *). MonadIO m => Context -> m ByteString
    recvData' Context
    ctx = [ByteString] -> ByteString
    L.fromChunks ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : []) (ByteString -> ByteString) -> m ByteString -> m ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Context -> m ByteString
    forall (m :: * -> *). MonadIO m => Context -> m ByteString
    recvData Context
    ctx

    keyUpdate
        :: Context
        -> (Context -> IO (Hash, Cipher, CryptLevel, C8.ByteString))
        -> (Context -> Hash -> Cipher -> AnyTrafficSecret ApplicationSecret -> IO ())
        -> IO ()
    keyUpdate :: Context
    -> (Context -> IO (Hash, Cipher, CryptLevel, ByteString))
    -> (Context
        -> Hash -> Cipher -> AnyTrafficSecret ApplicationSecret -> IO ())
    -> IO ()
    keyUpdate Context
    ctx Context -> IO (Hash, Cipher, CryptLevel, ByteString)
    getState Context
    -> Hash -> Cipher -> AnyTrafficSecret ApplicationSecret -> IO ()
    setState = do
        (usedHash, usedCipher, level, applicationSecretN) <- Context -> IO (Hash, Cipher, CryptLevel, ByteString)
    getState Context
    ctx
        unless (level == CryptApplicationSecret) $
            throwCore $
                Error_Protocol
                    "tried key update without application traffic secret"
                    InternalError
        let applicationSecretN1 =
                Hash -> ByteString -> ByteString -> ByteString -> Int -> ByteString
    hkdfExpandLabel Hash
    usedHash ByteString
    applicationSecretN ByteString
    "traffic upd" ByteString
    "" (Int -> ByteString) -> Int -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                    Hash -> Int
    hashDigestSize Hash
    usedHash
        setState ctx usedHash usedCipher (AnyTrafficSecret applicationSecretN1)

    -- | How to update keys in TLS 1.3
    data KeyUpdateRequest
        = -- | Unidirectional key update
          OneWay
        | -- | Bidirectional key update (normal case)
          TwoWay
        deriving (KeyUpdateRequest -> KeyUpdateRequest -> Bool
    (KeyUpdateRequest -> KeyUpdateRequest -> Bool)
    -> (KeyUpdateRequest -> KeyUpdateRequest -> Bool)
    -> Eq KeyUpdateRequest
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: KeyUpdateRequest -> KeyUpdateRequest -> Bool
    == :: KeyUpdateRequest -> KeyUpdateRequest -> Bool
    $c/= :: KeyUpdateRequest -> KeyUpdateRequest -> Bool
    /= :: KeyUpdateRequest -> KeyUpdateRequest -> Bool
    Eq, Int -> KeyUpdateRequest -> HostName -> HostName
    [KeyUpdateRequest] -> HostName -> HostName
    KeyUpdateRequest -> HostName
    (Int -> KeyUpdateRequest -> HostName -> HostName)
    -> (KeyUpdateRequest -> HostName)
    -> ([KeyUpdateRequest] -> HostName -> HostName)
    -> Show KeyUpdateRequest
    forall a.
    (Int -> a -> HostName -> HostName)
    -> (a -> HostName) -> ([a] -> HostName -> HostName) -> Show a
    $cshowsPrec :: Int -> KeyUpdateRequest -> HostName -> HostName
    showsPrec :: Int -> KeyUpdateRequest -> HostName -> HostName
    $cshow :: KeyUpdateRequest -> HostName
    show :: KeyUpdateRequest -> HostName
    $cshowList :: [KeyUpdateRequest] -> HostName -> HostName
    showList :: [KeyUpdateRequest] -> HostName -> HostName
    Show)

    -- | Updating appication traffic secrets for TLS 1.3.
    --   If this API is called for TLS 1.3, 'True' is returned.
    --   Otherwise, 'False' is returned.
    updateKey :: MonadIO m => Context -> KeyUpdateRequest -> m Bool
    updateKey :: forall (m :: * -> *).
    MonadIO m =>
    Context -> KeyUpdateRequest -> m Bool
    updateKey Context
    ctx KeyUpdateRequest
    way = IO Bool -> m Bool
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
    forall a b. (a -> b) -> a -> b
    $ do
        tls13 <- Context -> IO Bool
    forall (m :: * -> *). MonadIO m => Context -> m Bool
    tls13orLater Context
    ctx
        when tls13 $ do
            let req = case KeyUpdateRequest
    way of
                    KeyUpdateRequest
    OneWay -> KeyUpdate
    UpdateNotRequested
                    KeyUpdateRequest
    TwoWay -> KeyUpdate
    UpdateRequested
            -- Write lock wraps both actions because we don't want another packet to
            -- be sent by another thread before the Tx state is updated.
            withWriteLock ctx $ do
                sendPacket13 ctx $ Handshake13 [KeyUpdate13 req]
                keyUpdate ctx getTxRecordState setTxRecordState
        return tls13