7dc82b9 · typeable/wai

git.iko.soy/typeable/wai

Turn Response into a type alias

commit7dc82b9bbe08de510914e9b13131a019a94beb31 authorAndrew Pritchard <awpr@google.com> dateThu 30 Jul 2015, 19:41 (11 years ago) parent664d4e3

6 files changed+48−48

compare with master

unifiedsplit

wai/Network/Wai/HTTP2.hs+8−4 warp/Network/Wai/Handler/Warp/HTTP2.hs+1−2 warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+7−8 warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+2−2 warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+5−5 warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+25−27

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

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

11module Network.Wai.HTTP2

22 ( Http2Application

3− , Response(..)

3+ , Response

44 , Trailers

55 , responseStatus

6+ , responseStream

67 , responseHeaders

78 ) where

@@ -20,10 +21,13 @@ type Http2Application = Request -> (Response -> IO ()) -> IO Trailers

2021

2122type StreamingBody = (Builder -> IO ()) -> IO () -> IO ()

2223

23−data Response = ResponseStream H.Status H.ResponseHeaders StreamingBody

24+type Response = (H.Status, H.ResponseHeaders, StreamingBody)

2425

2526responseStatus :: Response -> H.Status

26−responseStatus (ResponseStream s _ _) = s

27+responseStatus (s, _, _) = s

2728

2829responseHeaders :: Response -> H.ResponseHeaders

29−responseHeaders (ResponseStream _ h _) = h

30+responseHeaders (_, h, _) = h

31+

32+responseStream :: H.Status -> H.ResponseHeaders -> StreamingBody -> Response

33+responseStream = (,,)

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

@@ -17,7 +17,6 @@ import Network.HTTP2

1717import Network.Socket (SockAddr)

1818

1919import Network.Wai (Application, responseToStream)

20−import Network.Wai.HTTP2 (Response(..))

2120import Network.Wai.HTTP2 (Http2Application)

2221import Network.Wai.Internal (ResponseReceived(..))

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

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

8079promoteApplication :: Application -> Http2Application

8180promoteApplication app req respond = [] <$ app req respond'

8281 where

83− respond' r = ResponseReceived <$ (withBody $ respond . ResponseStream s h)

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

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

warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+7−8

@@ -13,24 +13,23 @@ import Data.IORef (readIORef, writeIORef)

1313import Network.HPACK

1414import qualified Network.HTTP.Types as H

1515import Network.HTTP2

16−import Network.Wai.HTTP2 (Trailers, Response, responseStatus, responseHeaders)

16+import Network.Wai.HTTP2 (Trailers)

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

1818import Network.Wai.Handler.Warp.Header

1919import Network.Wai.Handler.Warp.Response

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

2121import Network.Wai.Handler.Warp.Types

2222

23−hpackEncodeHeader :: Context -> InternalInfo -> S.Settings -> Response

24− -> IO Builder

25−hpackEncodeHeader ctx ii settings rsp = do

26− hdr1 <- addServerAndDate hdr0

23+hpackEncodeHeader :: Context -> InternalInfo -> S.Settings -> H.Status

24+ -> H.ResponseHeaders -> IO Builder

25+hpackEncodeHeader ctx ii settings s h = do

26+ hdr1 <- addServerAndDate h

2727 let hdr2 = (":status", status) : map (first foldedCase) hdr1

2828 hpackEncodeRawHeaders ctx hdr2

2929 where

30− hdr0 = responseHeaders rsp

31− status = B8.pack $ show $ H.statusCode $ responseStatus rsp

30+ status = B8.pack $ show $ H.statusCode $ s

3231 dc = dateCacher ii

33− rspidxhdr = indexResponseHeader hdr0

32+ rspidxhdr = indexResponseHeader h

3433 defServer = S.settingsServerName settings

3534 addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr

3635

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

@@ -81,12 +81,12 @@ frameSender ctx@Context{outputQ,connectionWindow}

8181 switch (OFrame frame) = do

8282 connSendAll frame

8383 loop

84− switch (OResponse strm rsp aux) = do

84+ switch (OResponse strm s h aux) = do

8585 unlessClosed ctx conn strm $ do

8686 lim <- getWindowSize connectionWindow (streamWindow strm)

8787 -- Header frame and Continuation frame

8888 let sid = streamNumber strm

89− builder <- hpackEncodeHeader ctx ii settings rsp

89+ builder <- hpackEncodeHeader ctx ii settings s h

9090 len <- headerContinue sid builder False

9191 let total = len + frameHeaderLength

9292 case aux of

warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+5−5

@@ -18,7 +18,7 @@ import Data.IntMap.Strict (IntMap, IntMap)

1818import qualified Data.IntMap.Strict as M

1919import qualified Network.HTTP.Types as H

2020import Network.Wai (Request)

21−import Network.Wai.HTTP2 (Trailers, Response)

21+import Network.Wai.HTTP2 (Trailers)

2222import Network.Wai.Handler.Warp.IORef

2323import Network.Wai.Handler.Warp.Types

2424

@@ -66,7 +66,7 @@ data Output = OFinish

6666 -- ^ Send a goaway frame and terminate the connection.

6767 | OFrame ByteString

6868 -- ^ Send an entire pre-encoded frame.

69− | OResponse Stream Response Aux

69+ | OResponse Stream H.Status H.ResponseHeaders Aux

7070 -- ^ Send the headers and as much of the response as is immediately

7171 -- available.

7272 | ONext Stream DynaNext

@@ -75,9 +75,9 @@ data Output = OFinish

7575 -- ^ Send a series of trailers in header and continuation frames.

7676

7777outputStream :: Output -> Stream

78−outputStream (OResponse strm _ _) = strm

79−outputStream (ONext strm _) = strm

80−outputStream _ = error "outputStream"

78+outputStream (OResponse strm _ _ _) = strm

79+outputStream (ONext strm _) = strm

80+outputStream _ = error "outputStream"

8181

8282----------------------------------------------------------------

8383

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

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

2020import Data.Typeable

2121import Network.HTTP2

2222import Network.HTTP2.Priority

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

23+import Network.Wai.HTTP2 (Http2Application, Response)

2424import Network.Wai hiding (Response, responseStatus)

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

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

@@ -41,32 +41,30 @@ type Responder = ThreadContinue -> T.Handle -> Stream ->

4141-- They also pass 'Response's from 'Http2Application's to this function.

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

4343response :: Context -> Manager -> Responder

44−response Context{outputQ} mgr tconf th strm sq rsp = do

45− case rsp of

46− ResponseStream _ _ strmbdy -> do

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

48− --

49− -- We must not exit this WAI application.

50− -- If the application exits, streaming would be also closed.

51− -- So, this work occupies this thread.

52− --

53− -- We need to increase the number of workers.

54− myThreadId >>= replaceWithAction mgr

55− -- After this work, this thread stops to decease

56− -- the number of workers.

57− setThreadContinue tconf False

58− tvar <- newTVarIO SyncNone

59− let out = OResponse strm rsp (Persist sq tvar)

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

61− -- queue, we spawn a thread to ensure that the designated

62− -- queue is not empty.

63− void $ forkIO $ waiter tvar sq strm outputQ

64− atomically $ writeTVar tvar (SyncNext out)

65− let push b = do

66− atomically $ writeTBQueue sq (SBuilder b)

67− T.tickle th

68− flush = atomically $ writeTBQueue sq SFlush

69− strmbdy push flush

44+response Context{outputQ} mgr tconf th strm sq (s, h, strmbdy) = do

45+ -- TODO(awpr)r HEAD requests will still stream.

46+ --

47+ -- We must not exit this WAI application.

48+ -- If the application exits, streaming would be also closed.

49+ -- So, this work occupies this thread.

50+ --

51+ -- We need to increase the number of workers.

52+ myThreadId >>= replaceWithAction mgr

53+ -- After this work, this thread stops to decease

54+ -- the number of workers.

55+ setThreadContinue tconf False

56+ tvar <- newTVarIO SyncNone

57+ let out = OResponse strm s h (Persist sq tvar)

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

59+ -- queue, we spawn a thread to ensure that the designated

60+ -- queue is not empty.

61+ void $ forkIO $ waiter tvar sq strm outputQ

62+ atomically $ writeTVar tvar (SyncNext out)

63+ let push b = do

64+ atomically $ writeTBQueue sq (SBuilder b)

65+ T.tickle th

66+ flush = atomically $ writeTBQueue sq SFlush

67+ strmbdy push flush

7068

7169data Break = Break deriving (Show, Typeable)

7270