0adedc1 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Curry Http2Application's responder function

0adedc1Andrew Pritchard11 years ago

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

compare with master

unifiedsplit

@@ -2,12 +2,9 @@

2module Network.Wai.HTTP2

3 ( Http2Application

4 , PushPromise(..)

5+ , RespondFunc

5 , Responder

6 , Responder

6− , Response

7 , Trailers

8− , responseStatus

9− , responseStream

10− , responseHeaders

11 , promiseHeaders

8 , promiseHeaders

12 ) where

9 ) where

@@ -41,18 +38,9 @@ type Http2Application = Request -> Responder

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

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

44−type Response a = (H.Status, H.ResponseHeaders, Body a)

41+type RespondFunc = forall a. H.Status -> H.ResponseHeaders -> Body a -> IO a

46−type Responder = (forall a. Response a -> IO a) -> IO Trailers

43+type Responder = RespondFunc -> 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 = (,,)

57promiseHeaders :: PushPromise -> H.RequestHeaders

45promiseHeaders :: PushPromise -> H.RequestHeaders

58promiseHeaders p =

46promiseHeaders p =

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

@@ -79,5 +79,5 @@ goaway Connection{..} etype debugmsg = connSendAll bytestream

79promoteApplication :: Application -> Http2Application

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

81 where

82− respond' r = ResponseReceived <$ (withBody $ \b -> respond (s, h, b))

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

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

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

@@ -13,7 +13,6 @@ import Data.IORef (readIORef, writeIORef)

13import Network.HPACK

14import qualified Network.HTTP.Types as H

15import Network.HTTP2

16−import Network.Wai.HTTP2 (Trailers)

17import Network.Wai.Handler.Warp.HTTP2.Types

16import Network.Wai.Handler.Warp.HTTP2.Types

18import Network.Wai.Handler.Warp.Header

17import Network.Wai.Handler.Warp.Header

19import Network.Wai.Handler.Warp.Response

18import Network.Wai.Handler.Warp.Response

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

@@ -22,29 +22,28 @@ import Data.Typeable

22import qualified Network.HTTP.Types as H

23import Network.HTTP2

24import Network.HTTP2.Priority

25−import Network.Wai.HTTP2 (Http2Application, PushPromise, Responder, Response)

25+import Network.Wai

26−import Network.Wai hiding (Response, responseStatus)

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

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

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

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

29import Network.Wai.Handler.Warp.HTTP2.Types

28import Network.Wai.Handler.Warp.HTTP2.Types

30import Network.Wai.Handler.Warp.IORef

29import Network.Wai.Handler.Warp.IORef

30+import Network.Wai.HTTP2 (Http2Application, PushPromise, Responder, RespondFunc)

31import qualified Network.Wai.Handler.Warp.Settings as S

32import qualified Network.Wai.Handler.Warp.Timeout as T

34----------------------------------------------------------------

36−-- | An 'Http2Application' takes a @forall a. Response a -> IO a@; this type

36+-- | An 'Http2Application' takes a 'RespondFunc'; this type implements that by

37−-- implements that by currying some internal arguments.

37+-- currying some internal arguments.

38--

39-- This is the argument to a 'Responder'.

40−type Respond = IO () -> Stream -> TBQueue Sequence ->

40+type Respond = IO () -> Stream -> TBQueue Sequence -> RespondFunc

41− (forall a. Response a -> IO a)

43-- | This function is passed to workers.

42-- | 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.

45-- This function enqueues commands for the HTTP/2 sender.

44-- This function enqueues commands for the HTTP/2 sender.

46response :: Context -> Manager -> ThreadContinue -> Respond

45response :: 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

48 -- TODO(awpr) HEAD requests will still stream.

47 -- TODO(awpr) HEAD requests will still stream.

50 -- We must not exit this WAI application.

49 -- We must not exit this WAI application.

@@ -56,12 +55,12 @@ response ctx mgr tconf tickle strm sq rsp = do

56 -- After this work, this thread stops to decrease the number of workers.

55 -- After this work, this thread stops to decrease the number of workers.

57 setThreadContinue tconf False

56 setThreadContinue tconf False

59− runStream ctx OResponse tickle strm sq rsp

58+ runStream ctx OResponse tickle strm sq s h strmbdy

61runStream :: Context

60runStream :: Context

62 -> (Stream -> H.Status -> H.ResponseHeaders -> Aux -> Output)

61 -> (Stream -> H.Status -> H.ResponseHeaders -> Aux -> Output)

63 -> Respond

62 -> 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

65 tvar <- newTVarIO SyncNone

64 tvar <- newTVarIO SyncNone

66 let out = mkOutput strm s h (Persist sq tvar)

65 let out = mkOutput strm s h (Persist sq tvar)

67 -- Since we must not enqueue an empty queue to the priority

66 -- Since we must not enqueue an empty queue to the priority