on master help sign in
Forward trailers from SyncFinish to the output queue
cabea22Andrew Pritchard
warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+3−3
@@ -140,13 +140,13 @@ frameSender ctx@Context{outputQ,connectionWindow}
140 fillDataHeaderSend strm 0 datPayloadLen mnext
140 fillDataHeaderSend strm 0 datPayloadLen mnext
141 maybeEnqueueNext strm mnext
141 maybeEnqueueNext strm mnext
142 loop
142 loop
143− switch (OTrailers strm []) _ = do
143+ switch (OTrailers strm []) = do
144 let flag = setEndStream defaultFlags
144 let flag = setEndStream defaultFlags
145 fillFrameHeader FrameData 0 (streamNumber strm) flag connWriteBuffer
145 fillFrameHeader FrameData 0 (streamNumber strm) flag connWriteBuffer
146 closed ctx strm Finished
146 closed ctx strm Finished
147 flushN frameHeaderLength
147 flushN frameHeaderLength
148 loop
148 loop
149− switch (OTrailers strm trailers) _ = do
149+ switch (OTrailers strm trailers) = do
150 -- Trailers always indicate the end of a stream; send them in
150 -- Trailers always indicate the end of a stream; send them in
151 -- consecutive header+continuation frames and end the stream.
151 -- consecutive header+continuation frames and end the stream.
152 builder <- hpackEncodeTrailers ctx trailers
152 builder <- hpackEncodeTrailers ctx trailers
@@ -395,7 +395,7 @@ nextForStream :: Buffer -> BufSize -> TBQueue Sequence -> TVar Sync -> Stream
395 -> Leftover -> Bool -> BytesFilled
395 -> Leftover -> Bool -> BytesFilled
396 -> IO Next
396 -> IO Next
397nextForStream _ _ _ tvar _ _ False len = do
397nextForStream _ _ _ tvar _ _ False len = do
398− atomically $ writeTVar tvar SyncFinish
398+ atomically $ writeTVar tvar $ SyncFinish []
399 return $ Next len CFinish
399 return $ Next len CFinish
400nextForStream buf siz sq tvar strm LZero True len = do
400nextForStream buf siz sq tvar strm LZero True len = do
401 let out = ONext strm (fillBufStream buf siz LZero sq tvar strm)
401 let out = ONext strm (fillBufStream buf siz LZero sq tvar strm)
warp/Network/Wai/Handler/Warp/HTTP2/Types.hs+1−1
@@ -86,7 +86,7 @@ data Sequence = SFinish
86 | SBuilder Builder
86 | SBuilder Builder
87
87
88data Sync = SyncNone
88data Sync = SyncNone
89− | SyncFinish
89+ | SyncFinish Trailers
90 | SyncNext Output
90 | SyncNext Output
91
91
92data Aux = Oneshot Bool
92data Aux = Oneshot Bool
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+10−10
@@ -64,7 +64,7 @@ response Context{outputQ} mgr tconf th strm req rsp = do
64 -- Since we must not enqueue an empty queue to the priority
64 -- Since we must not enqueue an empty queue to the priority
65 -- queue, we spawn a thread to ensure that the designated
65 -- queue, we spawn a thread to ensure that the designated
66 -- queue is not empty.
66 -- queue is not empty.
67− void $ forkIO $ waiter tvar sq outputQ
67+ void $ forkIO $ waiter tvar sq strm outputQ
68 atomically $ writeTVar tvar (SyncNext out)
68 atomically $ writeTVar tvar (SyncNext out)
69 let push b = do
69 let push b = do
70 atomically $ writeTBQueue sq (SBuilder b)
70 atomically $ writeTBQueue sq (SBuilder b)
@@ -130,27 +130,27 @@ worker ctx@Context{inputQ,outputQ} set tm app responder = do
130 Just e -> S.settingsOnException set (Just req) e
130 Just e -> S.settingsOnException set (Just req) e
131 clearStreamInfo sinfo
131 clearStreamInfo sinfo
132
132
133−waiter :: TVar Sync -> TBQueue Sequence -> PriorityTree Output -> IO ()
133+waiter :: TVar Sync -> TBQueue Sequence -> Stream -> PriorityTree Output -> IO ()
134−waiter tvar sq outQ = do
134+waiter tvar sq strm outQ = do
135 -- waiting for actions other than SyncNone
135 -- waiting for actions other than SyncNone
136 mx <- atomically $ do
136 mx <- atomically $ do
137 mout <- readTVar tvar
137 mout <- readTVar tvar
138 case mout of
138 case mout of
139− SyncNone -> retry
139+ SyncNone -> retry
140− SyncNext out -> do
140+ SyncNext out -> do
141 writeTVar tvar SyncNone
141 writeTVar tvar SyncNone
142− return $ Just out
142+ return $ Right out
143− SyncFinish -> return Nothing
143+ SyncFinish trailers -> return $ Left trailers
144 case mx of
144 case mx of
145− Nothing -> return ()
145+ Left trailers -> enqueueWhenWindowIsOpen outQ (OTrailers strm trailers)
146− Just out -> do
146+ Right out -> do
147 -- ensuring that the streaming queue is not empty.
147 -- ensuring that the streaming queue is not empty.
148 atomically $ do
148 atomically $ do
149 isEmpty <- isEmptyTBQueue sq
149 isEmpty <- isEmptyTBQueue sq
150 when isEmpty retry
150 when isEmpty retry
151 -- ensuring that stream window is greater than 0.
151 -- ensuring that stream window is greater than 0.
152 enqueueWhenWindowIsOpen outQ out
152 enqueueWhenWindowIsOpen outQ out
153− waiter tvar sq outQ
153+ waiter tvar sq strm outQ
154
154
155----------------------------------------------------------------
155----------------------------------------------------------------
156
156