on master help sign in
using binfo.
commit585d41e2036aec6646035f41bc371db70b22f5e1 authorKazu Yamamoto <kazu@iij.ad.jp> dateThu 17 Dec 2015, 14:50 (11 years ago) parentb393adb
2 files changed+28−39
warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+25−29 warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+3−10
warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+25−29
@@ -107,11 +107,11 @@ frameSender ctx@Context{outputQ,connectionWindow,encodeDynamicTable}
107107 switch out@(OResponse strm rsp binfo) pre = do
108108 writeIORef (streamPrecedence strm) pre
109109 unlessClosed ctx conn strm $ do
110− cws <- getConnectionWindowSizeWhenReady ctx
111110 sws <- getStreamWindowSize strm
112111 if sws == 0 then do
113112 enqueueWhenReady (waitStreamWindowSize strm) outputQ out
114113 else do
114+ cws <- getConnectionWindowSizeWhenReady ctx
115115 let !lim = min cws sws
116116 -- Header frame and Continuation frame
117117 let sid = streamNumber strm
@@ -129,7 +129,7 @@ frameSender ctx@Context{outputQ,connectionWindow,encodeDynamicTable}
129129 Next datPayloadLen mnext <-
130130 fillResponseBodyGetNext conn ii payloadOff lim rsp
131131 fillDataHeaderSend strm total datPayloadLen mnext
132− maybeEnqueueNext strm mnext
132+ maybeEnqueueNext strm mnext binfo
133133 OneshotWithoutBody -> do
134134 -- "closed" must be before "connSendAll". If not,
135135 -- the context would be switched to the receiver,
@@ -147,21 +147,21 @@ frameSender ctx@Context{outputQ,connectionWindow,encodeDynamicTable}
147147 fillDataHeaderSend strm total datPayloadLen mnext
148148 else
149149 when needSend $ flushN off
150− maybeEnqueueNext strm mnext
150+ maybeEnqueueNext strm mnext binfo
151151 loop
152− switch out@(ONext strm curr) pre = do
152+ switch out@(ONext strm curr binfo) pre = do
153153 writeIORef (streamPrecedence strm) pre
154154 unlessClosed ctx conn strm $ do
155− cws <- getConnectionWindowSizeWhenReady ctx
156155 sws <- getStreamWindowSize strm
157156 if sws == 0 then do
158157 enqueueWhenReady (waitStreamWindowSize strm) outputQ out
159158 else do
159+ cws <- getConnectionWindowSizeWhenReady ctx
160160 let !lim = min cws sws
161161 -- Data frame payload
162162 Next datPayloadLen mnext <- curr lim
163163 fillDataHeaderSend strm 0 datPayloadLen mnext
164− maybeEnqueueNext strm mnext
164+ maybeEnqueueNext strm mnext binfo
165165 loop
166166
167167 -- Flush the connection buffer to the socket, where the first 'n' bytes of
@@ -202,16 +202,12 @@ frameSender ctx@Context{outputQ,connectionWindow,encodeDynamicTable}
202202 -- True if the connection buffer has room for a 1-byte data frame.
203203 canFitDataFrame total = total + frameHeaderLength < connBufferSize
204204
205− -- Re-enqueue the stream in the output queue if more output is immediately
206− -- available; do nothing otherwise.
207− maybeEnqueueNext :: Stream -> Control DynaNext -> IO ()
208− maybeEnqueueNext strm (CNext next) = do
209− let out = ONext strm next
205+ -- Re-enqueue the stream in the output queue.
206+ maybeEnqueueNext :: Stream -> Maybe DynaNext -> BodyInfo -> IO ()
207+ maybeEnqueueNext strm (Just next) binfo = do
208+ let !out = ONext strm next binfo
210209 enqueueOutput outputQ out
211− -- If the streaming is not finished, it must already have been
212− -- written to the 'TVar' owned by 'waiter', which will
213− -- put it back into the queue when more output becomes available.
214− maybeEnqueueNext _ _ = return ()
210+ maybeEnqueueNext _ _ _ = return ()
215211
216212
217213 -- Send headers if there is not room for a 1-byte data frame, and return
@@ -229,15 +225,15 @@ frameSender ctx@Context{outputQ,connectionWindow,encodeDynamicTable}
229225 buf = connWriteBuffer `plusPtr` otherLen
230226 total = otherLen + frameHeaderLength + datPayloadLen
231227 flag = case mnext of
232− CFinish -> setEndStream defaultFlags
228+ Nothing -> setEndStream defaultFlags
233229 _ -> defaultFlags
234230 fillFrameHeader FrameData datPayloadLen sid flag buf
235231 -- "closed" must be before "connSendAll". If not,
236232 -- the context would be switched to the receiver,
237233 -- resulting the inconsistency of concurrency.
238234 case mnext of
239− CFinish -> closed ctx strm Finished
240− _ -> return ()
235+ Nothing -> closed ctx strm Finished
236+ _ -> return ()
241237 flushN total
242238 atomically $ do
243239 modifyTVar' connectionWindow (subtract datPayloadLen)
@@ -337,11 +333,11 @@ fillBufBuilder buf0 siz0 leftover lim = do
337333
338334nextForBuilder :: Buffer -> BufSize -> BytesFilled -> B.Next -> Next
339335nextForBuilder _ _ len B.Done
340− = Next len CFinish
336+ = Next len Nothing
341337nextForBuilder buf siz len (B.More _ writer)
342− = Next len (CNext (fillBufBuilder buf siz (LOne writer)))
338+ = Next len $ Just (fillBufBuilder buf siz (LOne writer))
343339nextForBuilder buf siz len (B.Chunk bs writer)
344− = Next len (CNext (fillBufBuilder buf siz (LTwo bs writer)))
340+ = Next len $ Just (fillBufBuilder buf siz (LTwo bs writer))
345341
346342----------------------------------------------------------------
347343
@@ -400,9 +396,9 @@ fillBufStream buf0 siz0 leftover0 sq strm lim0 = do
400396nextForStream :: Buffer -> BufSize -> TBQueue Sequence -> Stream
401397 -> Leftover -> Bool -> BytesFilled
402398 -> Next
403−nextForStream _ _ _ _ _ False len = Next len CFinish
399+nextForStream _ _ _ _ _ False len = Next len Nothing
404400nextForStream buf siz sq strm leftOrZero True len =
405− Next len (CNext (fillBufStream buf siz leftOrZero sq strm))
401+ Next len $ Just (fillBufStream buf siz leftOrZero sq strm)
406402
407403----------------------------------------------------------------
408404
@@ -417,10 +413,10 @@ fillBufFile buf siz h bytes refresh lim = do
417413 return $ nextForFile len buf siz h bytes' refresh
418414
419415nextForFile :: BytesFilled -> Buffer -> BufSize -> IO.Handle -> Integer -> IO () -> Next
420−nextForFile 0 _ _ _ _ _ = Next 0 CFinish
421−nextForFile len _ _ _ 0 _ = Next len CFinish
416+nextForFile 0 _ _ _ _ _ = Next 0 Nothing
417+nextForFile len _ _ _ 0 _ = Next len Nothing
422418nextForFile len buf siz h bytes refresh =
423− Next len (CNext (fillBufFile buf siz h bytes refresh))
419+ Next len $ Just (fillBufFile buf siz h bytes refresh)
424420#else
425421fillBufFile :: Buffer -> BufSize -> Fd -> Integer -> Integer -> IO () -> DynaNext
426422fillBufFile buf siz fd start bytes refresh lim = do
@@ -432,10 +428,10 @@ fillBufFile buf siz fd start bytes refresh lim = do
432428 return $ nextForFile len buf siz fd (start + len') (bytes - len') refresh
433429
434430nextForFile :: BytesFilled -> Buffer -> BufSize -> Fd -> Integer -> Integer -> IO () -> Next
435−nextForFile 0 _ _ _ _ _ _ = Next 0 CFinish
436−nextForFile len _ _ _ _ 0 _ = Next len CFinish
431+nextForFile 0 _ _ _ _ _ _ = Next 0 Nothing
432+nextForFile len _ _ _ _ 0 _ = Next len Nothing
437433nextForFile len buf siz fd start bytes refresh =
438− Next len (CNext (fillBufFile buf siz fd start bytes refresh))
434+ Next len $ Just (fillBufFile buf siz fd start bytes refresh)
439435#endif
440436
441437mini :: Int -> Integer -> Int
warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+3−10
@@ -42,29 +42,22 @@ data Input = Input Stream Request
4242
4343----------------------------------------------------------------
4444
45−data Control a = CFinish
46− | CNext a
47−
48−instance Show (Control a) where
49− show CFinish = "CFinish"
50− show (CNext _) = "CNext"
51−
5245type DynaNext = WindowSize -> IO Next
5346
5447type BytesFilled = Int
5548
56−data Next = Next !BytesFilled (Control DynaNext)
49+data Next = Next !BytesFilled (Maybe DynaNext)
5750
5851data Output = OFinish
5952 | OGoaway !ByteString
6053 | OFrame !ByteString
6154 | OSettings !ByteString !SettingsList
6255 | OResponse !Stream !Response !BodyInfo
63− | ONext !Stream !DynaNext
56+ | ONext !Stream !DynaNext !BodyInfo
6457
6558outputStream :: Output -> Stream
6659outputStream (OResponse strm _ _) = strm
67−outputStream (ONext strm _) = strm
60+outputStream (ONext strm _ _) = strm
6861outputStream _ = error "outputStream"
6962
7063----------------------------------------------------------------