47fc3fe · typeable/wai

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

compare with master

unifiedsplit

@@ -1,8 +1,9 @@

1−{-# LANGUAGE RankNTypes #-}

1+{-# LANGUAGE EmptyCase, EmptyDataDecls, RankNTypes #-}

2module Network.Wai.HTTP2

3 ( Http2Application

4 , Response

5 , Trailers

6+ , absurd

6 , responseStatus

7 , responseStatus

7 , responseStream

8 , responseStream

8 , responseHeaders

9 , responseHeaders

@@ -17,9 +18,19 @@ import qualified Network.Wai.Internal as H1 (Request)

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

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

18type Trailers = H.ResponseHeaders

19type Trailers = H.ResponseHeaders

19

20

20−-- | The type of an HTTP\/2 request.

21+-- | The synthesized request and headers of a pushed stream.

21−-- TODO(awpr): specialize this for HTTP\/2.

22+-- TODO(awpr): implement for real.

23+data PushPromise

24+

25+-- 'PushPromise' is currently uninhabited, which proves the caller cannot use

26+-- 'pushPromise'. This discharges the obligation to implement any function

27+-- taking a 'PushPromise'.

28+absurd :: PushPromise -> a

29+absurd p = case p of {}

30+

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

32+-- push streams associated with this request.

22−type Request = H1.Request

33+type Request = (H1.Request, PushPromise -> Responder -> IO ())

23

34

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

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

25type Http2Application = Request -> Responder

36type Http2Application = Request -> Responder

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 $ \b -> respond (s, h, b))

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

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

@@ -21,7 +21,7 @@ import Control.Monad (void, when)

21import Data.Typeable

22import Network.HTTP2

23import Network.HTTP2.Priority

24−import Network.Wai.HTTP2 (Http2Application, Response)

24+import Network.Wai.HTTP2 (Http2Application, Response, absurd)

25import Network.Wai hiding (Response, responseStatus)

26import Network.Wai.Handler.Warp.HTTP2.EncodeFrame

27import Network.Wai.Handler.Warp.HTTP2.Manager

@@ -94,7 +94,7 @@ worker ctx@Context{inputQ,outputQ} set tm app responder = do

94 setStreamInfo sinfo strm req

95 T.resume th

96 T.tickle th

97− app req $ responder tcont th strm sq

97+ app (req, flip (const absurd)) $ responder tcont th strm sq

98 cont1 <- case ex of

99 Right trailers -> do

100 atomically $ writeTBQueue sq $ SFinish trailers