@@ -6,6 +6,7 @@
7module Network.Wai.Handler.Warp.HTTP2 (http2) where
7module Network.Wai.Handler.Warp.HTTP2 (http2) where
9+import qualified Data.IORef as I
9import qualified Control.Exception as E
10import qualified Control.Exception as E
10import qualified Network.HTTP2.Server as H2
11import qualified Network.HTTP2.Server as H2
11import Network.Socket (SockAddr)
12import Network.Socket (SockAddr)
@@ -37,21 +38,29 @@ http2 conn ii addr settings readN app =
38 http2server h2req aux response = do
39 http2server h2req aux response = do
39 req <- toWAIRequest h2req aux
40 req <- toWAIRequest h2req aux
40− ResponseReceived <- app req $ \rsp -> do
41+ ref <- I.newIORef Nothing
42+ eResponseReceived <- E.try $ app req $ \rsp -> do
41 h2rsp <- fromResponse settings ii req rsp
43 h2rsp <- fromResponse settings ii req rsp
42 pps <- fromPushPromises ii req
44 pps <- fromPushPromises ii req
45+ I.writeIORef ref $ Just (h2rsp, pps)
43− ex <- E.try $ response h2rsp pps
46+ _ <- response h2rsp pps
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
54 return ResponseReceived
47 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 ()
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
57 toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th
66 toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th