@@ -5,7 +5,7 @@
55{-# LANGUAGE CPP #-}
66
77module Network.Wai.Handler.Warp.HTTP2.Worker (
8− Responder
8+ Respond
99 , response
1010 , worker
1111 ) where
@@ -19,6 +19,7 @@ import Control.Exception (Exception, SomeException(..), AsyncException(..))
1919import qualified Control.Exception as E
2020import Control.Monad (void, when)
2121import Data.Typeable
22+import qualified Network.HTTP.Types as H
2223import Network.HTTP2
2324import Network.HTTP2.Priority
2425import Network.Wai.HTTP2 (Http2Application, Response, absurd)
@@ -33,28 +34,36 @@ import qualified Network.Wai.Handler.Warp.Timeout as T
3334----------------------------------------------------------------
3435
3536-- | An 'Http2Application' takes a @forall a. Response a -> IO a@; this type
36−-- implements that with extra arguments.
37−type Responder = forall a. ThreadContinue -> T.Handle -> Stream ->
38− TBQueue Sequence -> Response a -> IO a
37+-- implements that by currying some internal arguments.
38+--
39+-- This is the argument to a 'Responder'.
40+type Respond = IO () -> Stream -> TBQueue Sequence ->
41+ (forall a. Response a -> IO a)
3942
4043-- | This function is passed to workers.
4144-- They also pass 'Response's from 'Http2Application's to this function.
4245-- This function enqueues commands for the HTTP/2 sender.
43−response :: Context -> Manager -> Responder
44−response Context{outputQ} mgr tconf th strm sq (s, h, strmbdy) = do
45− -- TODO(awpr)r HEAD requests will still stream.
46− --
46+response :: Context -> Manager -> ThreadContinue -> Respond
47+response ctx mgr tconf tickle strm sq rsp = do
48+ -- TODO(awpr) HEAD requests will still stream.
49+
4750 -- We must not exit this WAI application.
4851 -- If the application exits, streaming would be also closed.
4952 -- So, this work occupies this thread.
5053 --
5154 -- We need to increase the number of workers.
5255 myThreadId >>= replaceWithAction mgr
53− -- After this work, this thread stops to decease
54− -- the number of workers.
56+ -- After this work, this thread stops to decrease the number of workers.
5557 setThreadContinue tconf False
58+
59+ runStream ctx OResponse tickle strm sq rsp
60+
61+runStream :: Context
62+ -> (Stream -> H.Status -> H.ResponseHeaders -> Aux -> Output)
63+ -> Respond
64+runStream Context{outputQ} mkOutput tickle strm sq (s, h, strmbdy) = do
5665 tvar <- newTVarIO SyncNone
57− let out = OResponse strm s h (Persist sq tvar)
66+ let out = mkOutput strm s h (Persist sq tvar)
5867 -- Since we must not enqueue an empty queue to the priority
5968 -- queue, we spawn a thread to ensure that the designated
6069 -- queue is not empty.
@@ -62,7 +71,7 @@ response Context{outputQ} mgr tconf th strm sq (s, h, strmbdy) = do
6271 atomically $ writeTVar tvar (SyncNext out)
6372 let push b = do
6473 atomically $ writeTBQueue sq (SBuilder b)
65− T.tickle th
74+ tickle
6675 flush = atomically $ writeTBQueue sq SFlush
6776 strmbdy push flush
6877
@@ -83,9 +92,9 @@ worker :: Context
8392 -> S.Settings
8493 -> T.Manager
8594 -> Http2Application
86− -> Responder
95+ -> (ThreadContinue -> Respond)
8796 -> IO ()
88−worker ctx@Context{inputQ,outputQ} set tm app responder = do
97+worker ctx@Context{inputQ} set tm app respond = do
8998 tid <- myThreadId
9099 sinfo <- newStreamInfo
91100 tcont <- newThreadContinue
@@ -103,7 +112,7 @@ worker ctx@Context{inputQ,outputQ} set tm app responder = do
103112 setStreamInfo sinfo strm req
104113 T.resume th
105114 T.tickle th
106− app (req, flip (const absurd)) $ responder tcont th strm sq
115+ app (req, flip (const absurd)) $ respond tcont (T.tickle th) strm sq
107116 cont1 <- case ex of
108117 Right trailers -> do
109118 atomically $ writeTBQueue sq $ SFinish trailers
@@ -156,7 +165,7 @@ waiter tvar sq strm outQ = do
156165-- | It would nice if responders could return values to workers.
157166-- Unfortunately, 'ResponseReceived' is already defined in WAI 2.0.
158167-- It is not wise to change this type.
159−-- So, a reference is shared by a responder and its worker.
168+-- So, a reference is shared by a 'Respond' and its worker.
160169-- The reference refers a value of this type as a return value.
161170-- If 'True', the worker continue to serve requests.
162171-- Otherwise, the worker get finished.