    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE RankNTypes #-}
    -- |
    -- Module      : Network.TLS.IO
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    module Network.TLS.IO
        ( sendPacket
        , sendPacket13
        , recvPacket
        , recvPacket13
        --
        , isRecvComplete
        , checkValid
        -- * Grouping multiple packets in the same flight
        , PacketFlightM
        , runPacketFlight
        , loadPacket13
        ) where

    import Control.Exception (finally, throwIO)
    import Control.Monad.Reader
    import Control.Monad.State.Strict
    import qualified Data.ByteString as B
    import Data.IORef
    import System.IO.Error (mkIOError, eofErrorType)

    import Network.TLS.Context.Internal
    import Network.TLS.Hooks
    import Network.TLS.Imports
    import Network.TLS.Receiving
    import Network.TLS.Record
    import Network.TLS.Record.Layer
    import Network.TLS.Sending
    import Network.TLS.State
    import Network.TLS.Struct
    import Network.TLS.Struct13

    ----------------------------------------------------------------

    -- | Send one packet to the context
    sendPacket :: Context -> Packet -> IO ()
    sendPacket :: Context -> Packet -> IO ()
    sendPacket ctx :: Context
    ctx@Context{ctxRecordLayer :: ()
    ctxRecordLayer = RecordLayer bytes
    recordLayer} Packet
    pkt = do
        -- in ver <= TLS1.0, block ciphers using CBC are using CBC residue as IV, which can be guessed
        -- by an attacker. Hence, an empty packet is sent before a normal data packet, to
        -- prevent guessability.
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Packet -> Bool
    isNonNullAppData Packet
    pkt) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Bool
    withEmptyPacket <- 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
    ctxNeedEmptyPacket Context
    ctx
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    withEmptyPacket (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                Context -> RecordLayer bytes -> Packet -> IO bytes
    forall bytes.
    Monoid bytes =>
    Context -> RecordLayer bytes -> Packet -> IO bytes
    writePacketBytes Context
    ctx RecordLayer bytes
    recordLayer (ByteString -> Packet
    AppData ByteString
    B.empty) IO bytes -> (bytes -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                    RecordLayer bytes -> bytes -> IO ()
    forall bytes. RecordLayer bytes -> bytes -> IO ()
    recordSendBytes RecordLayer bytes
    recordLayer

        Context -> RecordLayer bytes -> Packet -> IO bytes
    forall bytes.
    Monoid bytes =>
    Context -> RecordLayer bytes -> Packet -> IO bytes
    writePacketBytes Context
    ctx RecordLayer bytes
    recordLayer Packet
    pkt IO bytes -> (bytes -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= RecordLayer bytes -> bytes -> IO ()
    forall bytes. RecordLayer bytes -> bytes -> IO ()
    recordSendBytes RecordLayer bytes
    recordLayer
      where isNonNullAppData :: Packet -> Bool
    isNonNullAppData (AppData ByteString
    b) = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Bool
    B.null ByteString
    b
            isNonNullAppData Packet
    _           = Bool
    False

    writePacketBytes :: Monoid bytes
                     => Context -> RecordLayer bytes -> Packet -> IO bytes
    writePacketBytes :: forall bytes.
    Monoid bytes =>
    Context -> RecordLayer bytes -> Packet -> IO bytes
    writePacketBytes Context
    ctx RecordLayer bytes
    recordLayer Packet
    pkt = do
        Context -> (Logging -> IO ()) -> IO ()
    withLog Context
    ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Logging
    logging -> Logging -> String -> IO ()
    loggingPacketSent Logging
    logging (Packet -> String
    forall a. Show a => a -> String
    show Packet
    pkt)
        Either TLSError bytes
    edataToSend <- Context
    -> RecordLayer bytes -> Packet -> IO (Either TLSError bytes)
    forall bytes.
    Monoid bytes =>
    Context
    -> RecordLayer bytes -> Packet -> IO (Either TLSError bytes)
    encodePacket Context
    ctx RecordLayer bytes
    recordLayer Packet
    pkt
        (TLSError -> IO bytes)
    -> (bytes -> IO bytes) -> Either TLSError bytes -> IO bytes
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either TLSError -> IO bytes
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore bytes -> IO bytes
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either TLSError bytes
    edataToSend

    ----------------------------------------------------------------

    sendPacket13 :: Context -> Packet13 -> IO ()
    sendPacket13 :: Context -> Packet13 -> IO ()
    sendPacket13 ctx :: Context
    ctx@Context{ctxRecordLayer :: ()
    ctxRecordLayer = RecordLayer bytes
    recordLayer} Packet13
    pkt =
        Context -> RecordLayer bytes -> Packet13 -> IO bytes
    forall bytes.
    Monoid bytes =>
    Context -> RecordLayer bytes -> Packet13 -> IO bytes
    writePacketBytes13 Context
    ctx RecordLayer bytes
    recordLayer Packet13
    pkt IO bytes -> (bytes -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= RecordLayer bytes -> bytes -> IO ()
    forall bytes. RecordLayer bytes -> bytes -> IO ()
    recordSendBytes RecordLayer bytes
    recordLayer

    writePacketBytes13 :: Monoid bytes
                       => Context -> RecordLayer bytes -> Packet13 -> IO bytes
    writePacketBytes13 :: forall bytes.
    Monoid bytes =>
    Context -> RecordLayer bytes -> Packet13 -> IO bytes
    writePacketBytes13 Context
    ctx RecordLayer bytes
    recordLayer Packet13
    pkt = do
        Context -> (Logging -> IO ()) -> IO ()
    withLog Context
    ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Logging
    logging -> Logging -> String -> IO ()
    loggingPacketSent Logging
    logging (Packet13 -> String
    forall a. Show a => a -> String
    show Packet13
    pkt)
        Either TLSError bytes
    edataToSend <- Context
    -> RecordLayer bytes -> Packet13 -> IO (Either TLSError bytes)
    forall bytes.
    Monoid bytes =>
    Context
    -> RecordLayer bytes -> Packet13 -> IO (Either TLSError bytes)
    encodePacket13 Context
    ctx RecordLayer bytes
    recordLayer Packet13
    pkt
        (TLSError -> IO bytes)
    -> (bytes -> IO bytes) -> Either TLSError bytes -> IO bytes
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either TLSError -> IO bytes
    forall (m :: * -> *) a. MonadIO m => TLSError -> m a
    throwCore bytes -> IO bytes
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either TLSError bytes
    edataToSend

    ----------------------------------------------------------------
    -- | receive one packet from the context that contains 1 or
    -- many messages (many only in case of handshake). if will returns a
    -- TLSError if the packet is unexpected or malformed
    recvPacket :: Context -> IO (Either TLSError Packet)
    recvPacket :: Context -> IO (Either TLSError Packet)
    recvPacket ctx :: Context
    ctx@Context{ctxRecordLayer :: ()
    ctxRecordLayer = RecordLayer bytes
    recordLayer} = do
        Bool
    compatSSLv2 <- Context -> IO Bool
    ctxHasSSLv2ClientHello Context
    ctx
        Bool
    hrr         <- Context -> TLSSt Bool -> IO Bool
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx TLSSt Bool
    getTLS13HRR
        -- When a client sends 0-RTT data to a server which rejects and sends a HRR,
        -- the server will not decrypt AppData segments.  The server needs to accept
        -- AppData with maximum size 2^14 + 256.  In all other scenarios and record
        -- types the maximum size is 2^14.
        let appDataOverhead :: Int
    appDataOverhead = if Bool
    hrr then Int
    256 else Int
    0
        Either TLSError (Record Plaintext)
    erecord <- RecordLayer bytes
    -> Bool -> Int -> IO (Either TLSError (Record Plaintext))
    forall bytes.
    RecordLayer bytes
    -> Bool -> Int -> IO (Either TLSError (Record Plaintext))
    recordRecv RecordLayer bytes
    recordLayer Bool
    compatSSLv2 Int
    appDataOverhead
        case Either TLSError (Record Plaintext)
    erecord of
            Left TLSError
    err     -> Either TLSError Packet -> IO (Either TLSError Packet)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either TLSError Packet -> IO (Either TLSError Packet))
    -> Either TLSError Packet -> IO (Either TLSError Packet)
    forall a b. (a -> b) -> a -> b
    $ TLSError -> Either TLSError Packet
    forall a b. a -> Either a b
    Left TLSError
    err
            Right Record Plaintext
    record ->
                if Bool
    hrr Bool -> Bool -> Bool
    && Record Plaintext -> Bool
    forall a. Record a -> Bool
    isCCS Record Plaintext
    record then
                    Context -> IO (Either TLSError Packet)
    recvPacket Context
    ctx
                  else do
                    Either TLSError Packet
    pktRecv <- Context -> Record Plaintext -> IO (Either TLSError Packet)
    processPacket Context
    ctx Record Plaintext
    record
                    if Either TLSError Packet -> Bool
    isEmptyHandshake Either TLSError Packet
    pktRecv then
                        -- When a handshake record is fragmented we continue
                        -- receiving in order to feed stHandshakeRecordCont
                        Context -> IO (Either TLSError Packet)
    recvPacket Context
    ctx
                      else do
                        Either TLSError Packet
    pkt <- case Either TLSError Packet
    pktRecv of
                                Right (Handshake [Handshake]
    hss) ->
                                    Context
    -> (Hooks -> IO (Either TLSError Packet))
    -> IO (Either TLSError Packet)
    forall a. Context -> (Hooks -> IO a) -> IO a
    ctxWithHooks Context
    ctx ((Hooks -> IO (Either TLSError Packet))
     -> IO (Either TLSError Packet))
    -> (Hooks -> IO (Either TLSError Packet))
    -> IO (Either TLSError Packet)
    forall a b. (a -> b) -> a -> b
    $ \Hooks
    hooks ->
                                        Packet -> Either TLSError Packet
    forall a b. b -> Either a b
    Right (Packet -> Either TLSError Packet)
    -> ([Handshake] -> Packet) -> [Handshake] -> Either TLSError Packet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Handshake] -> Packet
    Handshake ([Handshake] -> Either TLSError Packet)
    -> IO [Handshake] -> IO (Either TLSError Packet)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Handshake -> IO Handshake) -> [Handshake] -> IO [Handshake]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Hooks -> Handshake -> IO Handshake
    hookRecvHandshake Hooks
    hooks) [Handshake]
    hss
                                Either TLSError Packet
    _                     -> Either TLSError Packet -> IO (Either TLSError Packet)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either TLSError Packet
    pktRecv
                        case Either TLSError Packet
    pkt of
                            Right Packet
    p -> Context -> (Logging -> IO ()) -> IO ()
    withLog Context
    ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Logging
    logging -> Logging -> String -> IO ()
    loggingPacketRecv Logging
    logging (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Packet -> String
    forall a. Show a => a -> String
    show Packet
    p
                            Either TLSError Packet
    _       -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    compatSSLv2 (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Context -> IO ()
    ctxDisableSSLv2ClientHello Context
    ctx
                        Either TLSError Packet -> IO (Either TLSError Packet)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either TLSError Packet
    pkt

    isCCS :: Record a -> Bool
    isCCS :: forall a. Record a -> Bool
    isCCS (Record ProtocolType
    ProtocolType_ChangeCipherSpec Version
    _ Fragment a
    _) = Bool
    True
    isCCS Record a
    _                                          = Bool
    False

    isEmptyHandshake :: Either TLSError Packet -> Bool
    isEmptyHandshake :: Either TLSError Packet -> Bool
    isEmptyHandshake (Right (Handshake [])) = Bool
    True
    isEmptyHandshake Either TLSError Packet
    _                      = Bool
    False

    ----------------------------------------------------------------

    recvPacket13 :: Context -> IO (Either TLSError Packet13)
    recvPacket13 :: Context -> IO (Either TLSError Packet13)
    recvPacket13 ctx :: Context
    ctx@Context{ctxRecordLayer :: ()
    ctxRecordLayer = RecordLayer bytes
    recordLayer} = do
        Either TLSError (Record Plaintext)
    erecord <- RecordLayer bytes -> IO (Either TLSError (Record Plaintext))
    forall bytes.
    RecordLayer bytes -> IO (Either TLSError (Record Plaintext))
    recordRecv13 RecordLayer bytes
    recordLayer
        case Either TLSError (Record Plaintext)
    erecord of
            Left err :: TLSError
    err@(Error_Protocol (String
    _, Bool
    True, AlertDescription
    BadRecordMac)) -> do
                -- If the server decides to reject RTT0 data but accepts RTT1
                -- data, the server should skip all records for RTT0 data.
                Established
    established <- Context -> IO Established
    ctxEstablished Context
    ctx
                case Established
    established of
                    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 (Either TLSError Packet13)
    recvPacket13 Context
    ctx
                    Established
    _           -> Either TLSError Packet13 -> IO (Either TLSError Packet13)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either TLSError Packet13 -> IO (Either TLSError Packet13))
    -> Either TLSError Packet13 -> IO (Either TLSError Packet13)
    forall a b. (a -> b) -> a -> b
    $ TLSError -> Either TLSError Packet13
    forall a b. a -> Either a b
    Left TLSError
    err
            Left TLSError
    err      -> Either TLSError Packet13 -> IO (Either TLSError Packet13)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either TLSError Packet13 -> IO (Either TLSError Packet13))
    -> Either TLSError Packet13 -> IO (Either TLSError Packet13)
    forall a b. (a -> b) -> a -> b
    $ TLSError -> Either TLSError Packet13
    forall a b. a -> Either a b
    Left TLSError
    err
            Right Record Plaintext
    record -> do
                Either TLSError Packet13
    pktRecv <- Context -> Record Plaintext -> IO (Either TLSError Packet13)
    processPacket13 Context
    ctx Record Plaintext
    record
                if Either TLSError Packet13 -> Bool
    isEmptyHandshake13 Either TLSError Packet13
    pktRecv then
                    -- When a handshake record is fragmented we continue receiving
                    -- in order to feed stHandshakeRecordCont13
                    Context -> IO (Either TLSError Packet13)
    recvPacket13 Context
    ctx
                  else do
                    Either TLSError Packet13
    pkt <- case Either TLSError Packet13
    pktRecv of
                            Right (Handshake13 [Handshake13]
    hss) ->
                                Context
    -> (Hooks -> IO (Either TLSError Packet13))
    -> IO (Either TLSError Packet13)
    forall a. Context -> (Hooks -> IO a) -> IO a
    ctxWithHooks Context
    ctx ((Hooks -> IO (Either TLSError Packet13))
     -> IO (Either TLSError Packet13))
    -> (Hooks -> IO (Either TLSError Packet13))
    -> IO (Either TLSError Packet13)
    forall a b. (a -> b) -> a -> b
    $ \Hooks
    hooks ->
                                    Packet13 -> Either TLSError Packet13
    forall a b. b -> Either a b
    Right (Packet13 -> Either TLSError Packet13)
    -> ([Handshake13] -> Packet13)
    -> [Handshake13]
    -> Either TLSError Packet13
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Handshake13] -> Packet13
    Handshake13 ([Handshake13] -> Either TLSError Packet13)
    -> IO [Handshake13] -> IO (Either TLSError Packet13)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Handshake13 -> IO Handshake13)
    -> [Handshake13] -> IO [Handshake13]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Hooks -> Handshake13 -> IO Handshake13
    hookRecvHandshake13 Hooks
    hooks) [Handshake13]
    hss
                            Either TLSError Packet13
    _                       -> Either TLSError Packet13 -> IO (Either TLSError Packet13)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either TLSError Packet13
    pktRecv
                    case Either TLSError Packet13
    pkt of
                        Right Packet13
    p -> Context -> (Logging -> IO ()) -> IO ()
    withLog Context
    ctx ((Logging -> IO ()) -> IO ()) -> (Logging -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Logging
    logging -> Logging -> String -> IO ()
    loggingPacketRecv Logging
    logging (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Packet13 -> String
    forall a. Show a => a -> String
    show Packet13
    p
                        Either TLSError Packet13
    _       -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    Either TLSError Packet13 -> IO (Either TLSError Packet13)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either TLSError Packet13
    pkt

    isEmptyHandshake13 :: Either TLSError Packet13 -> Bool
    isEmptyHandshake13 :: Either TLSError Packet13 -> Bool
    isEmptyHandshake13 (Right (Handshake13 [])) = Bool
    True
    isEmptyHandshake13 Either TLSError Packet13
    _                        = Bool
    False

    ----------------------------------------------------------------

    isRecvComplete :: Context -> IO Bool
    isRecvComplete :: Context -> IO Bool
    isRecvComplete Context
    ctx = Context -> TLSSt Bool -> IO Bool
    forall a. Context -> TLSSt a -> IO a
    usingState_ Context
    ctx (TLSSt Bool -> IO Bool) -> TLSSt Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ do
        Maybe (GetContinuation (HandshakeType, ByteString))
    cont <- (TLSState -> Maybe (GetContinuation (HandshakeType, ByteString)))
    -> TLSSt (Maybe (GetContinuation (HandshakeType, ByteString)))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets TLSState -> Maybe (GetContinuation (HandshakeType, ByteString))
    stHandshakeRecordCont
        Maybe (GetContinuation (HandshakeType13, ByteString))
    cont13 <- (TLSState -> Maybe (GetContinuation (HandshakeType13, ByteString)))
    -> TLSSt (Maybe (GetContinuation (HandshakeType13, ByteString)))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets TLSState -> Maybe (GetContinuation (HandshakeType13, ByteString))
    stHandshakeRecordCont13
        Bool -> TLSSt Bool
    forall a. a -> TLSSt a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> TLSSt Bool) -> Bool -> TLSSt Bool
    forall a b. (a -> b) -> a -> b
    $! Maybe (GetContinuation (HandshakeType, ByteString)) -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe (GetContinuation (HandshakeType, ByteString))
    cont Bool -> Bool -> Bool
    && Maybe (GetContinuation (HandshakeType13, ByteString)) -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe (GetContinuation (HandshakeType13, ByteString))
    cont13

    checkValid :: Context -> IO ()
    checkValid :: Context -> IO ()
    checkValid Context
    ctx = do
        Established
    established <- Context -> IO Established
    ctxEstablished Context
    ctx
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Established
    established Established -> Established -> Bool
    forall a. Eq a => a -> a -> Bool
    == Established
    NotEstablished) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TLSException -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO TLSException
    ConnectionNotEstablished
        Bool
    eofed <- Context -> IO Bool
    ctxEOF Context
    ctx
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    eofed (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IOError -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO (IOError -> IO ()) -> IOError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
    mkIOError IOErrorType
    eofErrorType String
    "data" Maybe Handle
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing

    ----------------------------------------------------------------

    type Builder b = [b] -> [b]

    -- | State monad used to group several packets together and send them on wire as
    -- single flight.  When packets are loaded in the monad, they are logged
    -- immediately, update the context digest and transcript, but actual sending is
    -- deferred.  Packets are sent all at once when the monadic computation ends
    -- (normal termination but also if interrupted by an exception).
    newtype PacketFlightM b a = PacketFlightM (ReaderT (RecordLayer b, IORef (Builder b)) IO a)
        deriving ((forall a b. (a -> b) -> PacketFlightM b a -> PacketFlightM b b)
    -> (forall a b. a -> PacketFlightM b b -> PacketFlightM b a)
    -> Functor (PacketFlightM b)
    forall a b. a -> PacketFlightM b b -> PacketFlightM b a
    forall a b. (a -> b) -> PacketFlightM b a -> PacketFlightM b b
    forall b a b. a -> PacketFlightM b b -> PacketFlightM b a
    forall b a b. (a -> b) -> PacketFlightM b a -> PacketFlightM b b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall b a b. (a -> b) -> PacketFlightM b a -> PacketFlightM b b
    fmap :: forall a b. (a -> b) -> PacketFlightM b a -> PacketFlightM b b
    $c<$ :: forall b a b. a -> PacketFlightM b b -> PacketFlightM b a
    <$ :: forall a b. a -> PacketFlightM b b -> PacketFlightM b a
    Functor, Functor (PacketFlightM b)
    Functor (PacketFlightM b)
    -> (forall a. a -> PacketFlightM b a)
    -> (forall a b.
        PacketFlightM b (a -> b) -> PacketFlightM b a -> PacketFlightM b b)
    -> (forall a b c.
        (a -> b -> c)
        -> PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b c)
    -> (forall a b.
        PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b)
    -> (forall a b.
        PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b a)
    -> Applicative (PacketFlightM b)
    forall b. Functor (PacketFlightM b)
    forall a. a -> PacketFlightM b a
    forall b a. a -> PacketFlightM b a
    forall a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b a
    forall a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b
    forall a b.
    PacketFlightM b (a -> b) -> PacketFlightM b a -> PacketFlightM b b
    forall b a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b a
    forall b a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b
    forall b a b.
    PacketFlightM b (a -> b) -> PacketFlightM b a -> PacketFlightM b b
    forall a b c.
    (a -> b -> c)
    -> PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b c
    forall b a b c.
    (a -> b -> c)
    -> PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b c
    forall (f :: * -> *).
    Functor f
    -> (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall b a. a -> PacketFlightM b a
    pure :: forall a. a -> PacketFlightM b a
    $c<*> :: forall b a b.
    PacketFlightM b (a -> b) -> PacketFlightM b a -> PacketFlightM b b
    <*> :: forall a b.
    PacketFlightM b (a -> b) -> PacketFlightM b a -> PacketFlightM b b
    $cliftA2 :: forall b a b c.
    (a -> b -> c)
    -> PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b c
    liftA2 :: forall a b c.
    (a -> b -> c)
    -> PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b c
    $c*> :: forall b a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b
    *> :: forall a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b
    $c<* :: forall b a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b a
    <* :: forall a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b a
    Applicative, Applicative (PacketFlightM b)
    Applicative (PacketFlightM b)
    -> (forall a b.
        PacketFlightM b a -> (a -> PacketFlightM b b) -> PacketFlightM b b)
    -> (forall a b.
        PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b)
    -> (forall a. a -> PacketFlightM b a)
    -> Monad (PacketFlightM b)
    forall b. Applicative (PacketFlightM b)
    forall a. a -> PacketFlightM b a
    forall b a. a -> PacketFlightM b a
    forall a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b
    forall a b.
    PacketFlightM b a -> (a -> PacketFlightM b b) -> PacketFlightM b b
    forall b a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b
    forall b a b.
    PacketFlightM b a -> (a -> PacketFlightM b b) -> PacketFlightM b b
    forall (m :: * -> *).
    Applicative m
    -> (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall b a b.
    PacketFlightM b a -> (a -> PacketFlightM b b) -> PacketFlightM b b
    >>= :: forall a b.
    PacketFlightM b a -> (a -> PacketFlightM b b) -> PacketFlightM b b
    $c>> :: forall b a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b
    >> :: forall a b.
    PacketFlightM b a -> PacketFlightM b b -> PacketFlightM b b
    $creturn :: forall b a. a -> PacketFlightM b a
    return :: forall a. a -> PacketFlightM b a
    Monad, Monad (PacketFlightM b)
    Monad (PacketFlightM b)
    -> (forall a. String -> PacketFlightM b a)
    -> MonadFail (PacketFlightM b)
    forall b. Monad (PacketFlightM b)
    forall a. String -> PacketFlightM b a
    forall b a. String -> PacketFlightM b a
    forall (m :: * -> *).
    Monad m -> (forall a. String -> m a) -> MonadFail m
    $cfail :: forall b a. String -> PacketFlightM b a
    fail :: forall a. String -> PacketFlightM b a
    MonadFail, Monad (PacketFlightM b)
    Monad (PacketFlightM b)
    -> (forall a. IO a -> PacketFlightM b a)
    -> MonadIO (PacketFlightM b)
    forall b. Monad (PacketFlightM b)
    forall a. IO a -> PacketFlightM b a
    forall b a. IO a -> PacketFlightM b a
    forall (m :: * -> *).
    Monad m -> (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall b a. IO a -> PacketFlightM b a
    liftIO :: forall a. IO a -> PacketFlightM b a
    MonadIO)

    runPacketFlight :: Context -> (forall b . Monoid b => PacketFlightM b a) -> IO a
    runPacketFlight :: forall a.
    Context -> (forall b. Monoid b => PacketFlightM b a) -> IO a
    runPacketFlight Context{ctxRecordLayer :: ()
    ctxRecordLayer = RecordLayer bytes
    recordLayer} (PacketFlightM ReaderT (RecordLayer bytes, IORef (Builder bytes)) IO a
    f) = do
        IORef (Builder bytes)
    ref <- Builder bytes -> IO (IORef (Builder bytes))
    forall a. a -> IO (IORef a)
    newIORef Builder bytes
    forall a. a -> a
    id
        ReaderT (RecordLayer bytes, IORef (Builder bytes)) IO a
    -> (RecordLayer bytes, IORef (Builder bytes)) -> IO a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT (RecordLayer bytes, IORef (Builder bytes)) IO a
    f (RecordLayer bytes
    recordLayer, IORef (Builder bytes)
    ref) IO a -> IO () -> IO a
    forall a b. IO a -> IO b -> IO a
    `finally` RecordLayer bytes -> IORef (Builder bytes) -> IO ()
    forall b. Monoid b => RecordLayer b -> IORef (Builder b) -> IO ()
    sendPendingFlight RecordLayer bytes
    recordLayer IORef (Builder bytes)
    ref

    sendPendingFlight :: Monoid b => RecordLayer b -> IORef (Builder b) -> IO ()
    sendPendingFlight :: forall b. Monoid b => RecordLayer b -> IORef (Builder b) -> IO ()
    sendPendingFlight RecordLayer b
    recordLayer IORef (Builder b)
    ref = do
        Builder b
    build <- IORef (Builder b) -> IO (Builder b)
    forall a. IORef a -> IO a
    readIORef IORef (Builder b)
    ref
        let bss :: [b]
    bss = Builder b
    build []
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([b] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [b]
    bss) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ RecordLayer b -> b -> IO ()
    forall bytes. RecordLayer bytes -> bytes -> IO ()
    recordSendBytes RecordLayer b
    recordLayer (b -> IO ()) -> b -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [b] -> b
    forall a. Monoid a => [a] -> a
    mconcat [b]
    bss

    loadPacket13 :: Monoid b => Context -> Packet13 -> PacketFlightM b ()
    loadPacket13 :: forall b. Monoid b => Context -> Packet13 -> PacketFlightM b ()
    loadPacket13 Context
    ctx Packet13
    pkt = ReaderT (RecordLayer b, IORef (Builder b)) IO ()
    -> PacketFlightM b ()
    forall b a.
    ReaderT (RecordLayer b, IORef (Builder b)) IO a
    -> PacketFlightM b a
    PacketFlightM (ReaderT (RecordLayer b, IORef (Builder b)) IO ()
     -> PacketFlightM b ())
    -> ReaderT (RecordLayer b, IORef (Builder b)) IO ()
    -> PacketFlightM b ()
    forall a b. (a -> b) -> a -> b
    $ do
        (RecordLayer b
    recordLayer, IORef (Builder b)
    ref) <- ReaderT
      (RecordLayer b, IORef (Builder b))
      IO
      (RecordLayer b, IORef (Builder b))
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        IO () -> ReaderT (RecordLayer b, IORef (Builder b)) IO ()
    forall a. IO a -> ReaderT (RecordLayer b, IORef (Builder b)) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ReaderT (RecordLayer b, IORef (Builder b)) IO ())
    -> IO () -> ReaderT (RecordLayer b, IORef (Builder b)) IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            b
    bs <- Context -> RecordLayer b -> Packet13 -> IO b
    forall bytes.
    Monoid bytes =>
    Context -> RecordLayer bytes -> Packet13 -> IO bytes
    writePacketBytes13 Context
    ctx RecordLayer b
    recordLayer Packet13
    pkt
            IORef (Builder b) -> (Builder b -> Builder b) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef (Builder b)
    ref (Builder b -> Builder b -> Builder b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b
    bs b -> Builder b
    forall a. a -> [a] -> [a]
    :))