@@ -6,6 +6,7 @@
66
77module Network.Wai.Handler.Warp.HTTP2 (http2) where
88
9+import qualified Data.IORef as I
910import qualified Control.Exception as E
1011import qualified Network.HTTP2.Server as H2
1112import Network.Socket (SockAddr)
@@ -37,21 +38,29 @@ http2 conn ii addr settings readN app =
3738
3839 http2server h2req aux response = do
3940 req <- toWAIRequest h2req aux
40− ResponseReceived <- app req $ \rsp -> do
41+ ref <- I.newIORef Nothing
42+ eResponseReceived <- E.try $ app req $ \rsp -> do
4143 h2rsp <- fromResponse settings ii req rsp
4244 pps <- fromPushPromises ii req
43− ex <- E.try $ response h2rsp pps
44− case ex of
45− Right () -> do
46− logResponse h2rsp req
47− mapM_ (logPushPromise req) pps
48− Left e@(E.SomeException _)
49− -- killed by the local worker manager
50− | Just E.ThreadKilled <- E.fromException e -> return ()
51− -- killed by the local timeout manager
52− | Just T.TimeoutThread <- E.fromException e -> return ()
53− | otherwise -> S.settingsOnException settings (Just req) e
45+ I.writeIORef ref $ Just (h2rsp, pps)
46+ _ <- response h2rsp pps
5447 return ResponseReceived
48+ case eResponseReceived of
49+ Right ResponseReceived -> do
50+ Just (h2rsp, pps) <- I.readIORef ref
51+ logResponse h2rsp req
52+ mapM_ (logPushPromise req) pps
53+ Left e@(E.SomeException _)
54+ -- killed by the local worker manager
55+ | Just E.ThreadKilled <- E.fromException e -> return ()
56+ -- killed by the local timeout manager
57+ | Just T.TimeoutThread <- E.fromException e -> return ()
58+ | otherwise -> do
59+ S.settingsOnException settings (Just req) e
60+ let ersp = S.settingsOnExceptionResponse settings e
61+ h2rsp' <- fromResponse settings ii req ersp
62+ _ <- response h2rsp' []
63+ logResponse h2rsp' req
5564 return ()
5665
5766 toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th