{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Network.HTTP2.H2.Receiver (
    frameReceiver,
    closureClient,
    closureServer,
) where

import Control.Concurrent
import Control.Concurrent.STM
import qualified Control.Exception as E
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Short as Short
import qualified Data.ByteString.UTF8 as UTF8
import Data.IORef
import Network.Control
import Network.HTTP.Semantics

import Imports hiding (delete, insert)
import Network.HTTP2.Frame
import Network.HTTP2.H2.Context
import Network.HTTP2.H2.EncodeFrame
import Network.HTTP2.H2.HPACK
import Network.HTTP2.H2.Queue
import Network.HTTP2.H2.Settings
import Network.HTTP2.H2.Stream
import Network.HTTP2.H2.StreamTable
import Network.HTTP2.H2.Types
import Network.HTTP2.H2.Window

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

continuationLimit :: Int
continuationLimit = 10

headerFragmentLimit :: Int
headerFragmentLimit = 51200 -- 50K

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

frameReceiver :: Context -> Config -> IO ()
frameReceiver ctx conf@Config{..} = do
    labelMe "H2 receiver"
    loop
  where
    loop = do
        -- If 'confReadN' is timeouted, an exception is thrown
        -- to destroy the thread trees.
        hd <- confReadN frameHeaderLength
        when (BS.null hd) $ E.throwIO ConnectionIsTimeout
        processFrame ctx conf $ decodeFrameHeader hd
        loop

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

processFrame :: Context -> Config -> (FrameType, FrameHeader) -> IO ()
processFrame ctx _conf (fid, FrameHeader{streamId})
    | isServer ctx
        && isServerInitiated streamId
        && (fid `notElem` [FramePriority, FrameRSTStream, FrameWindowUpdate]) =
        E.throwIO $
            ConnectionErrorIsSent ProtocolError streamId "stream id should be odd"
processFrame ctx _conf (FramePushPromise, FrameHeader{streamId})
    | isServer ctx =
        E.throwIO $
            ConnectionErrorIsSent ProtocolError streamId "push promise is not allowed"
processFrame Context{..} Config{..} (ftyp, FrameHeader{payloadLength, streamId})
    | ftyp > maxFrameType = do
        mx <- readIORef continued
        case mx of
            Nothing -> do
                -- ignoring unknown frame
                void $ confReadN payloadLength
            Just _ -> E.throwIO $ ConnectionErrorIsSent ProtocolError streamId "unknown frame"
processFrame ctx@Context{..} conf typhdr@(ftyp, header) = do
    -- My SETTINGS_MAX_FRAME_SIZE
    -- My SETTINGS_ENABLE_PUSH
    case checkFrameHeader typhdr of
        Left (FrameDecodeError ec sid msg) -> E.throwIO $ ConnectionErrorIsSent ec sid msg
        Right _ -> do
            let Settings{maxFrameSize, enablePush} = mySettings
                sid = streamId header
            when (payloadLength header > maxFrameSize) $
                E.throwIO $
                    ConnectionErrorIsSent FrameSizeError sid "exceeds maximum frame size"
            when (not enablePush && ftyp == FramePushPromise) $
                E.throwIO $
                    ConnectionErrorIsSent ProtocolError sid "push not enabled"
            controlOrStream ctx conf ftyp header

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

controlOrStream :: Context -> Config -> FrameType -> FrameHeader -> IO ()
controlOrStream ctx@Context{..} Config{..} ftyp header@FrameHeader{streamId, payloadLength}
    | isControl streamId = do
        bs <- confReadN payloadLength
        control ftyp header bs ctx
    | ftyp == FramePushPromise = do
        bs <- confReadN payloadLength
        push header bs ctx
    | otherwise = do
        checkContinued
        mstrm <- getStream ctx ftyp streamId
        bs <- confReadN payloadLength
        case mstrm of
            Just strm -> do
                state0 <- readStreamState strm
                state <- stream ftyp header bs ctx state0 strm
                resetContinued
                set <- processState state ctx strm streamId
                when set setContinued
            Nothing
                | ftyp == FramePriority -> do
                    -- for h2spec only
                    PriorityFrame newpri <- guardIt $ decodePriorityFrame header bs
                    checkPriority newpri streamId
                | otherwise -> return ()
  where
    setContinued = writeIORef continued $ Just streamId
    resetContinued = writeIORef continued Nothing
    checkContinued = do
        mx <- readIORef continued
        case mx of
            Nothing -> return ()
            Just sid
                | sid == streamId && ftyp == FrameContinuation -> return ()
                | otherwise ->
                    E.throwIO $
                        ConnectionErrorIsSent ProtocolError streamId "continuation frame must follow"

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

processState :: StreamState -> Context -> Stream -> StreamId -> IO Bool
-- Transition (process1)
processState (Open _ (NoBody tbl@(_, reqvt))) ctx@Context{..} strm@Stream{streamInput} streamId = do
    let mcl = fst <$> (getFieldValue tokenContentLength reqvt >>= C8.readInt)
    when (just mcl (/= (0 :: Int))) $
        E.throwIO $
            StreamErrorIsSent
                ProtocolError
                streamId
                "no body but content-length is not zero"
    tlr <- newIORef Nothing
    let inpObj = InpObj tbl (Just 0) (return (mempty, True)) tlr
    if isServer ctx
        then do
            let ServerInfo{..} = toServerInfo roleInfo
            launch ctx strm inpObj
        else putMVar streamInput $ Right inpObj
    halfClosedRemote ctx strm
    return False

-- Transition (process2)
processState (Open hcl (HasBody tbl@(_, reqvt))) ctx@Context{..} strm@Stream{streamInput, streamRxQ} _streamId = do
    let mcl = fst <$> (getFieldValue tokenContentLength reqvt >>= C8.readInt)
    bodyLength <- newIORef 0
    tlr <- newIORef Nothing
    q <- newTQueueIO
    writeIORef streamRxQ $ Just q
    setStreamState ctx strm $ Open hcl (Body q mcl bodyLength tlr)
    -- FLOW CONTROL: WINDOW_UPDATE 0: recv: announcing my limit properly
    -- FLOW CONTROL: WINDOW_UPDATE: recv: announcing my limit properly
    bodySource <- mkSource q $ informWindowUpdate ctx strm
    let inpObj = InpObj tbl mcl (readSource bodySource) tlr
    if isServer ctx
        then do
            let ServerInfo{..} = toServerInfo roleInfo
            launch ctx strm inpObj
        else putMVar streamInput $ Right inpObj
    return False

-- Transition (process3)
processState s@(Open _ Continued{}) ctx strm _streamId = do
    setStreamState ctx strm s
    return True

-- Transition (process4)
processState HalfClosedRemote ctx strm _streamId = do
    halfClosedRemote ctx strm
    return False

-- Transition (process5)
processState (Closed cc) ctx strm _streamId = do
    closed ctx strm cc
    return False

-- Transition (process6)
processState s ctx strm _streamId = do
    -- Idle, Open Body, Closed
    setStreamState ctx strm s
    return False

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

{- FOURMOLU_DISABLE -}
getStream :: Context -> FrameType -> StreamId -> IO (Maybe Stream)
getStream ctx@Context{..} ftyp streamId
  | isEven    = lookupEven evenStreamTable streamId >>= getEvenStream ctx ftyp
  | otherwise = lookupOdd oddStreamTable  streamId >>= getOddStream  ctx ftyp streamId
  where
    isEven = isServerInitiated streamId
{- FOURMOLU_ENABLE -}

getEvenStream :: Context -> FrameType -> Maybe Stream -> IO (Maybe Stream)
getEvenStream ctx ftyp js@(Just strm) = do
    when (ftyp == FrameHeaders) $ do
        st <- readStreamState strm
        when (isReserved st) $ halfClosedLocal ctx strm Finished
    return js
getEvenStream _ _ Nothing = return Nothing

getOddStream
    :: Context -> FrameType -> StreamId -> Maybe Stream -> IO (Maybe Stream)
getOddStream ctx ftyp streamId js@(Just strm0) = do
    when (ftyp == FrameHeaders) $ do
        st <- readStreamState strm0
        when (isHalfClosedRemote st) $
            E.throwIO $
                ConnectionErrorIsSent
                    StreamClosed
                    streamId
                    "header must not be sent to half or fully closed stream"
        -- Priority made an idle stream
        when (isIdle st) $ opened ctx strm0
    return js
getOddStream ctx ftyp streamId Nothing
    | isServer ctx = do
        csid <- getPeerStreamID ctx
        if streamId <= csid -- consider the stream closed
            then
                if ftyp `elem` [FrameWindowUpdate, FrameRSTStream, FramePriority]
                    then return Nothing -- will be ignored
                    else
                        E.throwIO $
                            ConnectionErrorIsSent
                                ProtocolError
                                streamId
                                "stream identifier must not decrease"
            else do
                -- consider the stream idle
                when (ftyp `notElem` [FrameHeaders, FramePriority]) $ do
                    let errmsg =
                            Short.toShort
                                ( "this frame is not allowed in an idle stream: "
                                    `BS.append` C8.pack (show ftyp)
                                )
                    E.throwIO $ ConnectionErrorIsSent ProtocolError streamId errmsg
                when (ftyp == FrameHeaders) $ setPeerStreamID ctx streamId
                -- FLOW CONTROL: SETTINGS_MAX_CONCURRENT_STREAMS: recv: rejecting if over my limit
                Just <$> openOddStreamCheck ctx streamId ftyp
    | otherwise =
        -- We received a frame from the server on an unknown stream
        -- (likely a previously created and then subsequently reset stream).
        -- We just drop it.
        return Nothing

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

type Payload = ByteString

control :: FrameType -> FrameHeader -> Payload -> Context -> IO ()
control FrameSettings header@FrameHeader{flags, streamId} bs Context{myFirstSettings, controlQ, settingsRate, mySettings, rxFlow} = do
    SettingsFrame peerAlist <- guardIt $ decodeSettingsFrame header bs
    traverse_ E.throwIO $ checkSettingsList peerAlist
    if testAck flags
        then do
            when (peerAlist /= []) $
                E.throwIO $
                    ConnectionErrorIsSent FrameSizeError streamId "ack settings has a body"
        else do
            -- Settings Flood - CVE-2019-9515
            rate <- getRate settingsRate
            when (rate > settingsRateLimit mySettings) $
                E.throwIO $
                    ConnectionErrorIsSent EnhanceYourCalm streamId "too many settings"
            let ack = settingsFrame setAck []
            sent <- readIORef myFirstSettings
            if sent
                then do
                    let setframe = CFrames (Just peerAlist) [ack]
                    enqueueControl controlQ setframe
                else do
                    -- Server side only
                    connRxWS <- rxfBufSize <$> readIORef rxFlow
                    let frames = makeNegotiationFrames mySettings connRxWS
                        setframe = CFrames (Just peerAlist) (frames ++ [ack])
                    writeIORef myFirstSettings True
                    enqueueControl controlQ setframe
control FramePing FrameHeader{flags, streamId} bs Context{mySettings, controlQ, pingRate} =
    unless (testAck flags) $ do
        rate <- getRate pingRate
        if rate > pingRateLimit mySettings
            then E.throwIO $ ConnectionErrorIsSent EnhanceYourCalm streamId "too many ping"
            else do
                let frame = pingFrame bs
                enqueueControl controlQ $ CFrames Nothing [frame]
control FrameGoAway header bs _ = do
    GoAwayFrame sid err msg <- guardIt $ decodeGoAwayFrame header bs
    if err == NoError
        then E.throwIO ConnectionIsClosed
        else E.throwIO $ ConnectionErrorIsReceived err sid $ Short.toShort msg
control FrameWindowUpdate header bs ctx = do
    WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs
    increaseConnectionWindowSize ctx n
control _ _ _ _ =
    -- must not reach here
    return ()

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

-- Called in client only
push :: FrameHeader -> ByteString -> Context -> IO ()
push header@FrameHeader{streamId} bs ctx = do
    PushPromiseFrame sid frag <- guardIt $ decodePushPromiseFrame header bs
    unless (isServerInitiated sid) $
        E.throwIO $
            ConnectionErrorIsSent
                ProtocolError
                streamId
                "push promise must specify an even stream identifier"
    when (frag == "") $
        E.throwIO $
            ConnectionErrorIsSent
                ProtocolError
                streamId
                "wrong header fragment for push promise"
    (_, vt) <- hpackDecodeHeader frag streamId ctx
    let ClientInfo{..} = toClientInfo $ roleInfo ctx
    when
        ( getFieldValue tokenAuthority vt == Just (UTF8.fromString authority)
            && getFieldValue tokenScheme vt == Just scheme
        )
        $ do
            let mmethod = getFieldValue tokenMethod vt
                mpath = getFieldValue tokenPath vt
            case (mmethod, mpath) of
                (Just method, Just path) ->
                    -- FLOW CONTROL: SETTINGS_MAX_CONCURRENT_STREAMS: recv: rejecting if over my limit
                    openEvenStreamCacheCheck ctx sid method path
                _ -> return ()

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

{-# INLINE guardIt #-}
guardIt :: Either FrameDecodeError a -> IO a
guardIt x = case x of
    Left (FrameDecodeError ec sid msg) -> E.throwIO $ ConnectionErrorIsSent ec sid msg
    Right frame -> return frame

{-# INLINE checkPriority #-}
checkPriority :: Priority -> StreamId -> IO ()
checkPriority p me
    | dep == me =
        E.throwIO $ StreamErrorIsSent ProtocolError me "priority depends on itself"
    | otherwise = return ()
  where
    dep = streamDependency p

stream
    :: FrameType
    -> FrameHeader
    -> ByteString
    -> Context
    -> StreamState
    -> Stream
    -> IO StreamState
-- Transition (stream1)
stream FrameHeaders header@FrameHeader{flags, streamId} bs ctx s@(Open hcl JustOpened) Stream{streamNumber} = do
    HeadersFrame mp frag <- guardIt $ decodeHeadersFrame header bs
    let endOfStream = testEndStream flags
        endOfHeader = testEndHeader flags
    if frag == "" && not endOfStream && not endOfHeader
        then do
            -- Empty Frame Flooding - CVE-2019-9518
            rate <- getRate $ emptyFrameRate ctx
            if rate > emptyFrameRateLimit (mySettings ctx)
                then
                    E.throwIO $
                        ConnectionErrorIsSent EnhanceYourCalm streamId "too many empty headers"
                else return s
        else do
            case mp of
                Nothing -> return ()
                Just p -> checkPriority p streamNumber
            if endOfHeader
                then do
                    tbl <- hpackDecodeHeader frag streamId ctx
                    return $
                        if endOfStream
                            then -- turned into HalfClosedRemote in processState
                                Open hcl (NoBody tbl)
                            else Open hcl (HasBody tbl)
                else do
                    let siz = BS.length frag
                    return $ Open hcl $ Continued [frag] siz 1 endOfStream

-- Transition (stream2)
stream FrameHeaders header@FrameHeader{flags, streamId} bs ctx (Open _ (Body q _ _ tlr)) _ = do
    HeadersFrame _ frag <- guardIt $ decodeHeadersFrame header bs
    let endOfStream = testEndStream flags
    -- checking frag == "" is not necessary
    if endOfStream
        then do
            tbl <- hpackDecodeTrailer frag streamId ctx
            writeIORef tlr (Just tbl)
            atomically $ writeTQueue q $ Right (mempty, True)
            return HalfClosedRemote
        else -- we don't support continuation here.
            E.throwIO $
                ConnectionErrorIsSent
                    ProtocolError
                    streamId
                    "continuation in trailer is not supported"

-- Transition (stream4)
stream
    FrameData
    header@FrameHeader{flags, payloadLength, streamId}
    bs
    Context{emptyFrameRate, rxFlow, mySettings}
    s@(Open _ (Body q mcl bodyLength _))
    Stream{..} = do
        DataFrame body <- guardIt $ decodeDataFrame header bs
        -- FLOW CONTROL: WINDOW_UPDATE 0: recv: rejecting if over my limit
        okc <- atomicModifyIORef' rxFlow $ checkRxLimit payloadLength
        unless okc $
            E.throwIO $
                ConnectionErrorIsSent
                    EnhanceYourCalm
                    streamId
                    "exceeds connection flow-control limit"
        -- FLOW CONTROL: WINDOW_UPDATE: recv: rejecting if over my limit
        oks <- atomicModifyIORef' streamRxFlow $ checkRxLimit payloadLength
        unless oks $
            E.throwIO $
                ConnectionErrorIsSent
                    EnhanceYourCalm
                    streamId
                    "exceeds stream flow-control limit"
        len0 <- readIORef bodyLength
        let len = len0 + payloadLength
            endOfStream = testEndStream flags
        -- Empty Frame Flooding - CVE-2019-9518
        if body == ""
            then unless endOfStream $ do
                rate <- getRate emptyFrameRate
                when (rate > emptyFrameRateLimit mySettings) $ do
                    E.throwIO $ ConnectionErrorIsSent EnhanceYourCalm streamId "too many empty data"
            else do
                writeIORef bodyLength len
                atomically $ writeTQueue q $ Right (body, endOfStream)
        if endOfStream
            then do
                case mcl of
                    Nothing -> return ()
                    Just cl ->
                        when (cl /= len) $
                            E.throwIO $
                                StreamErrorIsSent
                                    ProtocolError
                                    streamId
                                    "actual body length is not the same as content-length"
                -- no trailers
                atomically $ writeTQueue q $ Right (mempty, True)
                return HalfClosedRemote
            else return s

-- Transition (stream5)
stream FrameContinuation FrameHeader{flags, streamId} frag ctx s@(Open hcl (Continued rfrags siz n endOfStream)) _ = do
    let endOfHeader = testEndHeader flags
    if frag == "" && not endOfHeader
        then do
            -- Empty Frame Flooding - CVE-2019-9518
            rate <- getRate $ emptyFrameRate ctx
            if rate > emptyFrameRateLimit (mySettings ctx)
                then
                    E.throwIO $
                        ConnectionErrorIsSent EnhanceYourCalm streamId "too many empty continuation"
                else return s
        else do
            let rfrags' = frag : rfrags
                siz' = siz + BS.length frag
                n' = n + 1
            when (siz' > headerFragmentLimit) $
                E.throwIO $
                    ConnectionErrorIsSent EnhanceYourCalm streamId "Header is too big"
            when (n' > continuationLimit) $
                E.throwIO $
                    ConnectionErrorIsSent EnhanceYourCalm streamId "Header is too fragmented"
            if endOfHeader
                then do
                    let hdrblk = BS.concat $ reverse rfrags'
                    tbl <- hpackDecodeHeader hdrblk streamId ctx
                    return $
                        if endOfStream
                            then -- turned into HalfClosedRemote in processState
                                Open hcl (NoBody tbl)
                            else Open hcl (HasBody tbl)
                else return $ Open hcl $ Continued rfrags' siz' n' endOfStream

-- (No state transition)
stream FrameWindowUpdate header bs _ s strm = do
    WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs
    increaseStreamWindowSize strm n
    return s

-- Transition (stream6)
stream FrameRSTStream header@FrameHeader{streamId} bs ctx s strm = do
    -- Rapid Rest: CVE-2023-44487
    rate <- getRate $ rstRate ctx
    when (rate > rstRateLimit (mySettings ctx)) $
        E.throwIO $
            ConnectionErrorIsSent EnhanceYourCalm streamId "too many rst_stream"
    RSTStreamFrame err <- guardIt $ decodeRSTStreamFrame header bs
    let cc = Reset err
    closed ctx strm cc

    -- HTTP2 spec, section 5.1, "Stream States":
    --
    -- > A stream in the "open" state may be used by both peers to send frames
    -- > of any type. (..) From this state, either endpoint can send a frame
    -- > with an END_STREAM flag set, which causes the stream to transition into
    -- > one of the "half-closed" states.  An endpoint sending an END_STREAM
    -- > flag causes the stream state to become "half-closed (local)"; an
    -- > endpoint receiving an END_STREAM flag causes the stream state to become
    -- > "half-closed (remote)".
    --
    -- Crucially (for the specific case we're dealing with here), it continues:
    --
    -- > /Either endpoint/ can send a RST_STREAM frame from this state, causing
    -- > it to transition immediately to "closed".
    --
    -- (emphasis not in original).
    --
    -- In addition, the spec states (about the open state):
    --
    -- > Either endpoint can send a RST_STREAM frame from this state, causing it
    -- > to transition immediately to "closed".
    --
    -- This justifies the two non-error cases, below. (Section 8.1 of the spec
    -- is also relevant, but it is less explicit about the /either endpoint/
    -- part.)
    case s of
        Open _ _
            | isNonCritical err ->
                -- Open /or/ half-closed (local)
                return (Closed cc)
        HalfClosedRemote
            | isNonCritical err ->
                return (Closed cc)
        _otherwise -> do
            E.throwIO $ StreamErrorIsReceived err streamId
-- (No state transition)
stream FramePriority header bs _ s Stream{streamNumber} = do
    -- ignore
    -- Resource Loop - CVE-2019-9513
    PriorityFrame newpri <- guardIt $ decodePriorityFrame header bs
    checkPriority newpri streamNumber
    return s

-- this ordering is important
stream FrameContinuation FrameHeader{streamId} _ _ _ _ =
    E.throwIO $
        ConnectionErrorIsSent ProtocolError streamId "continue frame cannot come here"
stream _ FrameHeader{streamId} _ _ (Open _ Continued{}) _ =
    E.throwIO $
        ConnectionErrorIsSent
            ProtocolError
            streamId
            "an illegal frame follows header/continuation frames"
-- Ignore frames to streams we have just reset, per section 5.1.
stream _ _ _ _ st@(Closed (ResetByMe _)) _ = return st
stream FrameData FrameHeader{streamId} _ _ _ _ =
    E.throwIO $
        StreamErrorIsSent StreamClosed streamId $
            fromString ("illegal data frame for " ++ show streamId)
stream x FrameHeader{streamId} _ _ _ _ =
    E.throwIO $
        StreamErrorIsSent ProtocolError streamId $
            fromString ("illegal frame " ++ show x ++ " for " ++ show streamId)

{- FOURMOLU_DISABLE -}
-- Although some stream errors indicate misbehaving peers, such as
-- FLOW_CONTROL_ERROR, not all errors do. We will close the connection only
-- for critical errors.
isNonCritical :: ErrorCode -> Bool
isNonCritical NoError       = True
isNonCritical Cancel        = True
isNonCritical InternalError = True
isNonCritical _             = False
{- FOURMOLU_ENABLE -}

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

-- | Type for input streaming.
data Source = Source RxQ (Int -> IO ()) (IORef Bool)

mkSource :: RxQ -> (Int -> IO ()) -> IO Source
mkSource q inform = Source q inform <$> newIORef False

readSource :: Source -> IO (ByteString, Bool)
readSource (Source q inform refEOF) = do
    eof <- readIORef refEOF
    if eof
        then return (mempty, True)
        else do
            mBS <- atomically $ readTQueue q
            case mBS of
                Left err -> do
                    writeIORef refEOF True
                    E.throwIO err
                Right (bs, isEOF) -> do
                    writeIORef refEOF isEOF
                    let len = BS.length bs
                    inform len
                    return (bs, isEOF)

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

closureClient :: Config -> Either E.SomeException a -> IO a
closureClient Config{..} (Right x) = do
    let frame = goawayFrame 0 NoError ""
    confSendAll frame `E.catch` ignore
    return x
  where
    ignore (E.SomeException e)
        | isAsyncException e = E.throwIO e
        | otherwise = return ()
closureClient conf (Left se) = closureServer conf se

closureServer :: Config -> E.SomeException -> IO a
closureServer Config{..} se
    | isAsyncException se = E.throwIO se
    | Just ConnectionIsClosed <- E.fromException se = do
        E.throwIO ConnectionIsClosed
    | Just e@(ConnectionErrorIsReceived{}) <- E.fromException se =
        E.throwIO e
    | Just e@(ConnectionErrorIsSent err sid msg) <- E.fromException se = do
        let frame = goawayFrame sid err $ Short.fromShort msg
        confSendAll frame
        E.throwIO e
    | Just e@(StreamErrorIsSent err sid msg) <- E.fromException se = do
        let frame = resetFrame err sid
        let frame' = goawayFrame sid err $ Short.fromShort msg
        confSendAll $ frame <> frame'
        E.throwIO e
    | Just e@(StreamErrorIsReceived err sid) <- E.fromException se = do
        let frame = goawayFrame sid err "treat a stream error as a connection error"
        confSendAll frame
        E.throwIO e
    | Just (_ :: HTTP2Error) <- E.fromException se = E.throwIO se
    | otherwise = E.throwIO $ BadThingHappen se