2bceea0 · typeable/wai

wai/Network/Wai/HTTP2.hs+4−6

compare with master

unifiedsplit

@@ -14,7 +14,7 @@ import qualified Data.ByteString.Lazy as L

14import Data.ByteString.Builder (Builder)

15import qualified Network.HTTP.Types as H

16

17−import qualified Network.Wai.Internal as H1 (Request)

17+import Network.Wai.Internal (Request)

18

19-- | Headers sent after the end of a data stream, as defined by section 4.1.2 of

20-- the HTTP\/1.1 spec (RFC 7230), and section 8.1 of the HTTP\/2 spec.

@@ -29,12 +29,8 @@ data PushPromise = PushPromise

29 , promisedHeader :: H.RequestHeaders

30 }

31

32−-- | The type of an HTTP\/2 request: a normal HTTP request and an action to

33−-- push streams associated with this request.

34−type Request = (H1.Request, PushPromise -> Responder -> IO Bool)

35−

36-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.

32-- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'.

37−type Http2Application = Request -> Responder

33+type Http2Application = Request -> PushFunc -> Responder

38

34

39type Body a = (Builder -> IO ()) -> IO () -> IO a

35type Body a = (Builder -> IO ()) -> IO () -> IO a

40

36

@@ -42,6 +38,8 @@ type RespondFunc = forall a. H.Status -> H.ResponseHeaders -> Body a -> IO a

42

38

43type Responder = RespondFunc -> IO Trailers

39type Responder = RespondFunc -> IO Trailers

44

40

41+type PushFunc = PushPromise -> Responder -> IO Bool

42+

45promiseHeaders :: PushPromise -> H.RequestHeaders

43promiseHeaders :: PushPromise -> H.RequestHeaders

46promiseHeaders p =

44promiseHeaders p =

47 [ (":method", promisedMethod p)

45 [ (":method", promisedMethod p)

warp/Network/Wai/Handler/Warp/HTTP2.hs+1−1

@@ -77,7 +77,7 @@ goaway Connection{..} etype debugmsg = connSendAll bytestream

77-- | Promote a normal WAI 'Application' to an 'Http2Application' by ignoring

78-- the HTTP/2-specific features.

79promoteApplication :: Application -> Http2Application

80−promoteApplication app (req, _) respond = [] <$ app req respond'

80+promoteApplication app req _ respond = [] <$ app req respond'

81 where

82 respond' r = ResponseReceived <$ (withBody $ respond s h)

83 where (s, h, withBody) = responseToStream r

warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+1−1

@@ -144,7 +144,7 @@ worker ctx@Context{inputQ} set tm app respond = do

144 setStreamInfo sinfo strm req

145 T.resume th

146 T.tickle th

147− let responder = app (req, pushResponder ctx set strm)

147+ let responder = app req $ pushResponder ctx set strm

148 runResponder responder (respond tcont) (T.tickle th) strm

149 cont1 <- case ex of

150 Right () -> return True