git.iko.soy/typeable/wai
on master help sign in
Change Http2Application to return trailers
df285cfAndrew Pritchard
wai/Network/Wai/HTTP2.hs+2−2
compare with master
unifiedsplit
@@ -5,11 +5,11 @@ module Network.Wai.HTTP2
5
5
6import qualified Network.HTTP.Types as H
6import qualified Network.HTTP.Types as H
7
7
8−import Network.Wai.Internal (Request, Response, ResponseReceived)
8+import Network.Wai.Internal (Request, Response)
9
9
10-- | Headers sent after the end of a data stream, as defined by section 4.1.2 of
10-- | Headers sent after the end of a data stream, as defined by section 4.1.2 of
11-- the HTTP\/1.1 spec (RFC 7230), and section 8.1 of the HTTP\/2 spec.
11-- the HTTP\/1.1 spec (RFC 7230), and section 8.1 of the HTTP\/2 spec.
12type Trailers = H.ResponseHeaders
12type Trailers = H.ResponseHeaders
13
13
14-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.
14-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.
15−type Http2Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
15+type Http2Application = Request -> (Response -> IO ()) -> IO Trailers
warp/Network/Wai/Handler/Warp/HTTP2.hs+4−1
@@ -7,6 +7,7 @@ module Network.Wai.Handler.Warp.HTTP2
7 , promoteApplication
7 , promoteApplication
8 ) where
8 ) where
9
9
10+import Control.Applicative ((<$))
10import Control.Concurrent (forkIO, killThread)
11import Control.Concurrent (forkIO, killThread)
11import qualified Control.Exception as E
12import qualified Control.Exception as E
12import Control.Monad (when, unless, replicateM_)
13import Control.Monad (when, unless, replicateM_)
@@ -17,6 +18,7 @@ import Network.Socket (SockAddr)
17
18
18import Network.Wai (Application)
19import Network.Wai (Application)
19import Network.Wai.HTTP2 (Http2Application)
20import Network.Wai.HTTP2 (Http2Application)
21+import Network.Wai.Internal (ResponseReceived(..))
20import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
22import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
21import Network.Wai.Handler.Warp.HTTP2.Manager
23import Network.Wai.Handler.Warp.HTTP2.Manager
22import Network.Wai.Handler.Warp.HTTP2.Receiver
24import Network.Wai.Handler.Warp.HTTP2.Receiver
@@ -75,4 +77,5 @@ goaway Connection{..} etype debugmsg = connSendAll bytestream
75-- | Promote a normal WAI 'Application' to an 'Http2Application' by ignoring
77-- | Promote a normal WAI 'Application' to an 'Http2Application' by ignoring
76-- the HTTP/2-specific features.
78-- the HTTP/2-specific features.
77promoteApplication :: Application -> Http2Application
79promoteApplication :: Application -> Http2Application
78−promoteApplication app = app
80+promoteApplication app req respond = [] <$ app req respond'
81+ where respond' x = ResponseReceived <$ respond x
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+6−7
@@ -30,15 +30,15 @@ import Network.Wai.Handler.Warp.IORef
30import qualified Network.Wai.Handler.Warp.Response as R
30import qualified Network.Wai.Handler.Warp.Response as R
31import qualified Network.Wai.Handler.Warp.Settings as S
31import qualified Network.Wai.Handler.Warp.Settings as S
32import qualified Network.Wai.Handler.Warp.Timeout as T
32import qualified Network.Wai.Handler.Warp.Timeout as T
33−import Network.Wai.Internal (Response(..), ResponseReceived(..), ResponseReceived(..))
33+import Network.Wai.Internal (Response(..))
34
34
35----------------------------------------------------------------
35----------------------------------------------------------------
36
36
37−-- | The wai definition is @type Http2Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived@.
37+-- | The wai definition is @type Http2Application = Request -> (Response -> IO ()) -> IO Trailers@.
38−-- This type implements the second argument @Response -> IO ResponseReceived@
38+-- This type implements the second argument @Response -> IO ()@
39-- with extra arguments.
39-- with extra arguments.
40type Responder = ThreadContinue -> T.Handle -> Stream -> Request ->
40type Responder = ThreadContinue -> T.Handle -> Stream -> Request ->
41− TBQueue Sequence -> Response -> IO ResponseReceived
41+ TBQueue Sequence -> Response -> IO ()
42
42
43-- | This function is passed to workers.
43-- | This function is passed to workers.
44-- They also pass 'Response's from 'Http2Application's to this function.
44-- They also pass 'Response's from 'Http2Application's to this function.
@@ -74,7 +74,6 @@ response Context{outputQ} mgr tconf th strm req sq rsp = do
74 && R.hasBody (responseStatus rsp)
74 && R.hasBody (responseStatus rsp)
75 out = OResponse strm rsp (Oneshot hasBody)
75 out = OResponse strm rsp (Oneshot hasBody)
76 enqueueOrSpawnTemporaryWaiter strm outputQ out
76 enqueueOrSpawnTemporaryWaiter strm outputQ out
77− return ResponseReceived
78
77
79data Break = Break deriving (Show, Typeable)
78data Break = Break deriving (Show, Typeable)
80
79
@@ -102,8 +101,8 @@ worker ctx@Context{inputQ,outputQ} set tm app responder = do
102 T.tickle th
101 T.tickle th
103 app req $ responder tcont th strm req sq
102 app req $ responder tcont th strm req sq
104 cont1 <- case ex of
103 cont1 <- case ex of
105− Right ResponseReceived -> do
104+ Right trailers -> do
106− atomically $ writeTBQueue sq $ SFinish []
105+ atomically $ writeTBQueue sq $ SFinish trailers
107 return True
106 return True
108 Left e@(SomeException _)
107 Left e@(SomeException _)
109 | Just Break <- E.fromException e -> do
108 | Just Break <- E.fromException e -> do