From b71c2c6f3b50692a564bde6effbd0a62ac35ee7a Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Wed, 3 Jan 2024 15:09:53 +0100 Subject: [PATCH] Properly close streams --- Network/HTTP2/H2/Context.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/Network/HTTP2/H2/Context.hs b/Network/HTTP2/H2/Context.hs index f130cc8c..ea81d80b 100644 --- a/Network/HTTP2/H2/Context.hs +++ b/Network/HTTP2/H2/Context.hs @@ -175,7 +175,20 @@ setPeerStreamID ctx sid = writeIORef (peerStreamId ctx) sid {-# INLINE setStreamState #-} setStreamState :: Context -> Stream -> StreamState -> IO () -setStreamState _ Stream{streamState} val = writeIORef streamState val +setStreamState _ Stream{streamState} newState = do + oldState <- readIORef streamState + case (oldState, newState) of + (Open _ (Body q _ _ _), Open _ (Body q' _ _ _)) | q == q' -> + -- The stream stays open with the same body; nothing to do + return () + (Open _ (Body q _ _ _), _) -> + -- The stream is either closed, or is open with a /new/ body + -- We need to close the old queue so that any reads from it won't block + atomically $ writeTQueue q $ Left $ toException ConnectionIsClosed + _otherwise -> + -- The stream wasn't open to start with; nothing to do + return () + writeIORef streamState newState opened :: Context -> Stream -> IO () opened ctx strm = setStreamState ctx strm (Open Nothing JustOpened)