on master help sign in
Refactor 'cleanupStream' to handle exceptions in responders
19fda1fAndrew Pritchard
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+10−6
@@ -66,6 +66,15 @@ response Context{outputQ} mgr tconf th strm sq (s, h, strmbdy) = do
66 flush = atomically $ writeTBQueue sq SFlush
66 flush = atomically $ writeTBQueue sq SFlush
67 strmbdy push flush
67 strmbdy push flush
68
68
69+cleanupStream :: Context -> S.Settings -> Stream -> Maybe Request -> Maybe SomeException -> IO ()
70+cleanupStream ctx@Context{outputQ} set strm req me = do
71+ closed ctx strm Killed
72+ let frame = resetFrame InternalError (streamNumber strm)
73+ enqueue outputQ (OFrame frame) highestPriority
74+ case me of
75+ Nothing -> return ()
76+ Just e -> S.settingsOnException set req e
77+
69data Break = Break deriving (Show, Typeable)
78data Break = Break deriving (Show, Typeable)
70
79
71instance Exception Break
80instance Exception Break
@@ -117,12 +126,7 @@ worker ctx@Context{inputQ,outputQ} set tm app responder = do
117 case m of
126 case m of
118 Nothing -> return ()
127 Nothing -> return ()
119 Just (strm,req) -> do
128 Just (strm,req) -> do
120− closed ctx strm Killed
129+ cleanupStream ctx set strm (Just req) me
121− let frame = resetFrame InternalError (streamNumber strm)
122− enqueue outputQ (OFrame frame) highestPriority
123− case me of
124− Nothing -> return ()
125− Just e -> S.settingsOnException set (Just req) e
126 clearStreamInfo sinfo
130 clearStreamInfo sinfo
127
131
128waiter :: TVar Sync -> TBQueue Sequence -> Stream -> PriorityTree Output -> IO ()
132waiter :: TVar Sync -> TBQueue Sequence -> Stream -> PriorityTree Output -> IO ()