on master help sign in
Refactor 'runResponder' to set up a queue and run the stream
commit6fa930b49d5e5ecd73698b467e573112fad00947 authorAndrew Pritchard <awpr@google.com> dateMon 3 Aug 2015, 13:56 (11 years ago) parent3dbf9e9
2 files changed+14−8
wai/Network/Wai/HTTP2.hs+1 warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+13−8
wai/Network/Wai/HTTP2.hs+1
@@ -2,6 +2,7 @@
22module Network.Wai.HTTP2
33 ( Http2Application
44 , PushPromise
5+ , Responder
56 , Response
67 , Trailers
78 , absurd
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+13−8
@@ -22,7 +22,7 @@ import Data.Typeable
2222import qualified Network.HTTP.Types as H
2323import Network.HTTP2
2424import Network.HTTP2.Priority
25−import Network.Wai.HTTP2 (Http2Application, Response, absurd)
25+import Network.Wai.HTTP2 (Http2Application, Responder, Response, absurd)
2626import Network.Wai hiding (Response, responseStatus)
2727import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
2828import Network.Wai.Handler.Warp.HTTP2.Manager
@@ -75,6 +75,14 @@ runStream Context{outputQ} mkOutput tickle strm sq (s, h, strmbdy) = do
7575 flush = atomically $ writeTBQueue sq SFlush
7676 strmbdy push flush
7777
78+runResponder :: Responder -> Respond -> IO () -> Stream -> IO ()
79+runResponder responder respond tickle strm = do
80+ -- Since 'Body' is loop, we cannot control it.
81+ -- So, let's serialize 'Builder' with a designated queue.
82+ sq <- newTBQueueIO 10 -- fixme: hard coding: 10
83+ trailers <- responder $ respond tickle strm sq
84+ atomically $ writeTBQueue sq $ SFinish trailers
85+
7886cleanupStream :: Context -> S.Settings -> Stream -> Maybe Request -> Maybe SomeException -> IO ()
7987cleanupStream ctx@Context{outputQ} set strm req me = do
8088 closed ctx strm Killed
@@ -103,20 +111,17 @@ worker ctx@Context{inputQ} set tm app respond = do
103111 where
104112 go sinfo tcont th = do
105113 setThreadContinue tcont True
106− -- Since 'Body' is loop, we cannot control it.
107− -- So, let's serialize 'Builder' with a designated queue.
108− sq <- newTBQueueIO 10 -- fixme: hard coding: 10
114+
109115 ex <- E.try $ do
110116 T.pause th
111117 Input strm req <- atomically $ readTQueue inputQ
112118 setStreamInfo sinfo strm req
113119 T.resume th
114120 T.tickle th
115− app (req, flip (const absurd)) $ respond tcont (T.tickle th) strm sq
121+ let responder = app (req, flip (const absurd))
122+ runResponder responder (respond tcont) (T.tickle th) strm
116123 cont1 <- case ex of
117− Right trailers -> do
118− atomically $ writeTBQueue sq $ SFinish trailers
119− return True
124+ Right () -> return True
120125 Left e@(SomeException _)
121126 | Just Break <- E.fromException e -> do
122127 cleanup sinfo Nothing