on master help sign in
Allow stream bodies to have a result type

This allows trailers to be computed based on what happened during streaming, to allow e.g. checksums or signatures.

commit37fdcf869d83e5b37f129ef1de436aa68f2d8c0e authorAndrew Pritchard <awpr@google.com> dateThu 30 Jul 2015, 20:20 (11 years ago) parent7dc82b9
2 files changed+18−13
wai/Network/Wai/HTTP2.hs+7−6 warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+11−7
wai/Network/Wai/HTTP2.hs+7−6
@@ -1,3 +1,4 @@
1+{-# LANGUAGE RankNTypes #-}
12module Network.Wai.HTTP2
23 ( Http2Application
34 , Response
@@ -17,17 +18,17 @@ import Network.Wai.Internal (Request)
1718type Trailers = H.ResponseHeaders
1819
1920-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.
20−type Http2Application = Request -> (Response -> IO ()) -> IO Trailers
21+type Http2Application = Request -> (forall a. Response a -> IO a) -> IO Trailers
2122
22−type StreamingBody = (Builder -> IO ()) -> IO () -> IO ()
23+type StreamingBody a = (Builder -> IO ()) -> IO () -> IO a
2324
24−type Response = (H.Status, H.ResponseHeaders, StreamingBody)
25+type Response a = (H.Status, H.ResponseHeaders, StreamingBody a)
2526
26−responseStatus :: Response -> H.Status
27+responseStatus :: Response a -> H.Status
2728responseStatus (s, _, _) = s
2829
29−responseHeaders :: Response -> H.ResponseHeaders
30+responseHeaders :: Response a -> H.ResponseHeaders
3031responseHeaders (_, h, _) = h
3132
32−responseStream :: H.Status -> H.ResponseHeaders -> StreamingBody -> Response
33+responseStream :: H.Status -> H.ResponseHeaders -> StreamingBody a -> Response a
3334responseStream = (,,)
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+11−7
@@ -1,4 +1,5 @@
11{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE RankNTypes #-}
23{-# LANGUAGE NamedFieldPuns #-}
34{-# LANGUAGE PatternGuards #-}
45{-# LANGUAGE CPP #-}
@@ -31,11 +32,10 @@ import qualified Network.Wai.Handler.Warp.Timeout as T
3132
3233----------------------------------------------------------------
3334
34−-- | The wai definition is @type Http2Application = Request -> (Response -> IO ()) -> IO Trailers@.
35−-- This type implements the second argument @Response -> IO ()@
36−-- with extra arguments.
37−type Responder = ThreadContinue -> T.Handle -> Stream ->
38− TBQueue Sequence -> Response -> IO ()
35+-- | 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
3939
4040-- | This function is passed to workers.
4141-- They also pass 'Response's from 'Http2Application's to this function.
@@ -70,8 +70,12 @@ data Break = Break deriving (Show, Typeable)
7070
7171instance Exception Break
7272
73−worker ::
74− Context -> S.Settings -> T.Manager -> Http2Application -> Responder -> IO ()
73+worker :: Context
74+ -> S.Settings
75+ -> T.Manager
76+ -> Http2Application
77+ -> Responder
78+ -> IO ()
7579worker ctx@Context{inputQ,outputQ} set tm app responder = do
7680 tid <- myThreadId
7781 sinfo <- newStreamInfo