http2-5.3.11: Network/HTTP2/H2/Receiver.hs
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Network.HTTP2.H2.Receiver (
frameReceiver,
closureClient,
closureServer,
sendPing,
) 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 qualified System.ThreadManager as T
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{..} =
(switch `E.catch` handler)
`E.finally` atomically
(writeTVar (receiverDone ctx) True)
where
handler ConnectionIsClosed = return ()
handler e = E.throwIO e
switch = do
labelMe "H2 receiver"
tid <- myThreadId
if confReadNTimeout
then
loop1
else
void $
T.withHandle (threadManager ctx) (E.throwTo tid ConnectionIsTimeout) loop2
loop1 = do
hd <- confReadN frameHeaderLength -- throwing an exception on timeout
when (BS.null hd) $ E.throwIO ConnectionIsClosed
processFrame ctx conf $ decodeFrameHeader hd
loop1
loop2 th = do
-- If 'confReadN' is timeouted, 'ConnectionIsTimeout' is thrown
-- to destroy the thread trees.
hd <- confReadN frameHeaderLength
T.tickle th
when (BS.null hd) $ E.throwIO ConnectionIsClosed
processFrame ctx conf $ decodeFrameHeader hd
loop2 th
----------------------------------------------------------------
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 ctx@Context{mySettings, pingRate} =
unless (testAck flags) $ do
rate <- getRate pingRate
if rate > pingRateLimit mySettings
then E.throwIO $ ConnectionErrorIsSent EnhanceYourCalm streamId "too many ping"
else sendPing ctx True bs
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 -> Context -> Either E.SomeException a -> IO a
closureClient conf ctx (Right x) = do
frame <- goaway ctx NoError "no error"
sendGoaway conf frame
return x
closureClient conf ctx (Left se) = closureServer conf ctx se
closureServer :: Config -> Context -> E.SomeException -> IO a
closureServer conf ctx se
| isAsyncException se = do
frame <- goaway ctx NoError "maybe timeout by manager"
sendGoaway conf frame
E.throwIO se
| Just ConnectionIsClosed <- E.fromException se = do
frame <- goaway ctx NoError "no error"
sendGoaway conf frame
E.throwIO ConnectionIsClosed
| Just ConnectionIsTimeout <- E.fromException se = do
frame <- goaway ctx NoError "timeout"
sendGoaway conf frame
E.throwIO ConnectionIsTimeout
| Just e@(ConnectionErrorIsReceived _err _sid msg) <- E.fromException se = do
frame <- goaway ctx NoError $ Short.fromShort msg
sendGoaway conf frame
E.throwIO e
| Just e@(ConnectionErrorIsSent err _sid msg) <- E.fromException se = do
frame <- goaway ctx err $ Short.fromShort msg
sendGoaway conf frame
E.throwIO e
| Just e@(StreamErrorIsSent err _sid msg) <- E.fromException se = do
let frame = resetFrame err _sid
frame' <- goaway ctx err $ Short.fromShort msg
sendGoaway conf (frame <> frame')
E.throwIO e
| Just e@(StreamErrorIsReceived err _sid) <- E.fromException se = do
frame <- goaway ctx err "treat a stream error as a connection error"
sendGoaway conf frame
E.throwIO e
| Just (_ :: HTTP2Error) <- E.fromException se = E.throwIO se
| otherwise = E.throwIO $ BadThingHappen se
goaway :: Context -> ErrorCode -> ByteString -> IO ByteString
goaway ctx err msg = do
sid <- getPeerLastStreamId ctx
return $ goawayFrame sid err msg
sendGoaway :: Config -> ByteString -> IO ()
sendGoaway Config{..} frame = confSendAll frame `E.catch` ignore
ignore :: E.SomeException -> IO ()
ignore (E.SomeException e)
| isAsyncException e = E.throwIO e
| otherwise = return ()
----------------------------------------------------------------
sendPing :: Context -> Bool -> ByteString -> IO ()
sendPing Context{..} ack bs = enqueueControl controlQ $ CFrames Nothing [frame]
where
frame = pingFrame ack bs