git.iko.soy/typeable/wai
on master help sign in
Curry Http2Application's responder function

Since Response was not a multi-constructor datatype under HTTP/2, it could be turned into curried arguments to a respond function.

commit0adedc10f3120854882e75148e39098bd46ae8fd authorAndrew Pritchard <awpr@google.com> dateWed 5 Aug 2015, 22:26 (11 years ago) parentf043d8c
4 files changed+13−27
compare with master
unifiedsplit
wai/Network/Wai/HTTP2.hs+3−15 warp/Network/Wai/Handler/Warp/HTTP2.hs+1−1 warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs−1 warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+9−10
wai/Network/Wai/HTTP2.hs+3−15
@@ -2,12 +2,9 @@
22module Network.Wai.HTTP2
33 ( Http2Application
44 , PushPromise(..)
5+ , RespondFunc
56 , Responder
6− , Response
77 , Trailers
8− , responseStatus
9− , responseStream
10− , responseHeaders
118 , promiseHeaders
129 ) where
1310
@@ -41,18 +38,9 @@ type Http2Application = Request -> Responder
4138
4239type Body a = (Builder -> IO ()) -> IO () -> IO a
4340
44−type Response a = (H.Status, H.ResponseHeaders, Body a)
41+type RespondFunc = forall a. H.Status -> H.ResponseHeaders -> Body a -> IO a
4542
46−type Responder = (forall a. Response a -> IO a) -> IO Trailers
47−
48−responseStatus :: Response a -> H.Status
49−responseStatus (s, _, _) = s
50−
51−responseHeaders :: Response a -> H.ResponseHeaders
52−responseHeaders (_, h, _) = h
53−
54−responseStream :: H.Status -> H.ResponseHeaders -> Body a -> Response a
55−responseStream = (,,)
43+type Responder = RespondFunc -> IO Trailers
5644
5745promiseHeaders :: PushPromise -> H.RequestHeaders
5846promiseHeaders p =
warp/Network/Wai/Handler/Warp/HTTP2.hs+1−1
@@ -79,5 +79,5 @@ goaway Connection{..} etype debugmsg = connSendAll bytestream
7979promoteApplication :: Application -> Http2Application
8080promoteApplication app (req, _) respond = [] <$ app req respond'
8181 where
82− respond' r = ResponseReceived <$ (withBody $ \b -> respond (s, h, b))
82+ respond' r = ResponseReceived <$ (withBody $ respond s h)
8383 where (s, h, withBody) = responseToStream r
warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs−1
@@ -13,7 +13,6 @@ import Data.IORef (readIORef, writeIORef)
1313import Network.HPACK
1414import qualified Network.HTTP.Types as H
1515import Network.HTTP2
16−import Network.Wai.HTTP2 (Trailers)
1716import Network.Wai.Handler.Warp.HTTP2.Types
1817import Network.Wai.Handler.Warp.Header
1918import Network.Wai.Handler.Warp.Response
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+9−10
@@ -22,29 +22,28 @@ import Data.Typeable
2222import qualified Network.HTTP.Types as H
2323import Network.HTTP2
2424import Network.HTTP2.Priority
25−import Network.Wai.HTTP2 (Http2Application, PushPromise, Responder, Response)
26−import Network.Wai hiding (Response, responseStatus)
25+import Network.Wai
2726import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
2827import Network.Wai.Handler.Warp.HTTP2.Manager
2928import Network.Wai.Handler.Warp.HTTP2.Types
3029import Network.Wai.Handler.Warp.IORef
30+import Network.Wai.HTTP2 (Http2Application, PushPromise, Responder, RespondFunc)
3131import qualified Network.Wai.Handler.Warp.Settings as S
3232import qualified Network.Wai.Handler.Warp.Timeout as T
3333
3434----------------------------------------------------------------
3535
36−-- | An 'Http2Application' takes a @forall a. Response a -> IO a@; this type
37−-- implements that by currying some internal arguments.
36+-- | An 'Http2Application' takes a 'RespondFunc'; this type implements that by
37+-- currying some internal arguments.
3838--
3939-- This is the argument to a 'Responder'.
40−type Respond = IO () -> Stream -> TBQueue Sequence ->
41− (forall a. Response a -> IO a)
40+type Respond = IO () -> Stream -> TBQueue Sequence -> RespondFunc
4241
4342-- | This function is passed to workers.
44−-- They also pass 'Response's from 'Http2Application's to this function.
43+-- They also pass responses from 'Http2Application's to this function.
4544-- This function enqueues commands for the HTTP/2 sender.
4645response :: Context -> Manager -> ThreadContinue -> Respond
47−response ctx mgr tconf tickle strm sq rsp = do
46+response ctx mgr tconf tickle strm sq s h strmbdy = do
4847 -- TODO(awpr) HEAD requests will still stream.
4948
5049 -- We must not exit this WAI application.
@@ -56,12 +55,12 @@ response ctx mgr tconf tickle strm sq rsp = do
5655 -- After this work, this thread stops to decrease the number of workers.
5756 setThreadContinue tconf False
5857
59− runStream ctx OResponse tickle strm sq rsp
58+ runStream ctx OResponse tickle strm sq s h strmbdy
6059
6160runStream :: Context
6261 -> (Stream -> H.Status -> H.ResponseHeaders -> Aux -> Output)
6362 -> Respond
64−runStream Context{outputQ} mkOutput tickle strm sq (s, h, strmbdy) = do
63+runStream Context{outputQ} mkOutput tickle strm sq s h strmbdy = do
6564 tvar <- newTVarIO SyncNone
6665 let out = mkOutput strm s h (Persist sq tvar)
6766 -- Since we must not enqueue an empty queue to the priority