@@ -119,8 +119,8 @@ frameSender ctx@Context{outputQ,connectionWindow}
119119 lim <- getWindowSize connectionWindow (streamWindow strm)
120120 -- Data frame payload
121121 Next datPayloadLen mnext <- curr lim
122− fillDataHeaderSend strm 0 datPayloadLen mnext
123− maybeEnqueueNext strm mnext
122+ fillDataHeaderSend strm 0 datPayloadLen
123+ dispatchNext strm mnext
124124 loop
125125 switch (OPush oldStrm push mvar strm s h aux) = do
126126 pushed <- unlessClosed conn oldStrm $ do
@@ -134,23 +134,26 @@ frameSender ctx@Context{outputQ,connectionWindow}
134134 sendResponse strm s h aux lim
135135 putMVar mvar pushed
136136 loop
137− switch (OTrailers strm []) = do
138− _ <- unlessClosed conn strm $ do
139− -- An empty data frame should be used to end the stream instead
140− -- when there are no trailers.
141− let flag = setEndStream defaultFlags
142− fillFrameHeader FrameData 0 (streamNumber strm) flag connWriteBuffer
143− closed strm Finished
144− flushN frameHeaderLength
145− loop
146137 switch (OTrailers strm trailers) = do
147138 _ <- unlessClosed conn strm $ do
148139 -- Trailers always indicate the end of a stream; send them in
149− -- consecutive header+continuation frames and end the stream.
150− builder <- hpackEncodeCIHeaders ctx trailers
151− off <- headerContinue (streamNumber strm) builder True
140+ -- consecutive header+continuation frames and end the stream. Some
141+ -- clients dislike empty headers frames, so end the stream with an
142+ -- empty data frame instead, as recommended by the spec.
143+ toFlush <- case trailers of
144+ [] -> frameHeaderLength <$ fillFrameHeader FrameData 0
145+ (streamNumber strm)
146+ (setEndStream defaultFlags)
147+ connWriteBuffer
148+ _ -> do
149+ builder <- hpackEncodeCIHeaders ctx trailers
150+ off <- headerContinue (streamNumber strm) builder True
151+ return (off + frameHeaderLength)
152+ -- 'closed' must be before 'flushN'. If not, the context would be
153+ -- switched to the receiver, resulting in the inconsistency of
154+ -- concurrency.
152155 closed strm Finished
153− flushN $ off + frameHeaderLength
156+ flushN toFlush
154157 loop
155158
156159 -- Send the response headers and as much of the response as is immediately
@@ -169,10 +172,10 @@ frameSender ctx@Context{outputQ,connectionWindow}
169172 -- If no data was immediately available, avoid sending an
170173 -- empty data frame.
171174 if datPayloadLen > 0 then
172− fillDataHeaderSend strm total datPayloadLen mnext
175+ fillDataHeaderSend strm total datPayloadLen
173176 else
174177 when needSend $ flushN off
175− maybeEnqueueNext strm mnext
178+ dispatchNext strm mnext
176179
177180
178181 -- Flush the connection buffer to the socket, where the first 'n' bytes of
@@ -223,16 +226,25 @@ frameSender ctx@Context{outputQ,connectionWindow}
223226 -- True if the connection buffer has room for a 1-byte data frame.
224227 canFitDataFrame total = total + frameHeaderLength < connBufferSize
225228
226− -- Re-enqueue the stream in the output queue if more output is immediately
227− -- available; do nothing otherwise.
228− maybeEnqueueNext :: Stream -> Control DynaNext -> IO ()
229− maybeEnqueueNext strm (CNext next) = do
229+ -- Take the appropriate action based on the given 'Control':
230+ -- - If more output is immediately available, re-enqueue the stream in the
231+ -- output queue.
232+ -- - If the output is over and trailers are available, send them now and
233+ -- end the stream.
234+ -- - If we've drained the queue and handed the stream back to its waiter,
235+ -- do nothing.
236+ --
237+ -- This is done after sending any part of the stream body, so it's shared
238+ -- by 'sendResponse' and @switch (ONext ...)@.
239+ dispatchNext :: Stream -> Control DynaNext -> IO ()
240+ dispatchNext strm (CNext next) = do
230241 let out = ONext strm next
231242 enqueueOrSpawnTemporaryWaiter strm outputQ out
232− -- If the streaming is not finished, it must already have been
233− -- written to the 'TVar' owned by 'waiter', which will
234− -- put it back into the queue when more output becomes available.
235− maybeEnqueueNext _ _ = return ()
243+ dispatchNext strm (CFinish trailers) = do
244+ let out = OTrailers strm trailers
245+ pri <- readIORef $ streamPriority strm
246+ enqueue outputQ out pri
247+ dispatchNext _ _ = return ()
236248
237249
238250 -- Send headers if there is not room for a 1-byte data frame, and return
@@ -244,18 +256,12 @@ frameSender ctx@Context{outputQ,connectionWindow}
244256 flushN total
245257 return (0, False)
246258
247− fillDataHeaderSend strm otherLen datPayloadLen mnext = do
259+ fillDataHeaderSend strm otherLen datPayloadLen = do
248260 -- Data frame header
249261 let sid = streamNumber strm
250262 buf = connWriteBuffer `plusPtr` otherLen
251263 total = otherLen + frameHeaderLength + datPayloadLen
252264 fillFrameHeader FrameData datPayloadLen sid defaultFlags buf
253− -- "closed" must be before "connSendAll". If not,
254− -- the context would be switched to the receiver,
255− -- resulting the inconsistency of concurrency.
256− case mnext of
257− CFinish -> closed strm Finished
258− _ -> return ()
259265 flushN total
260266 atomically $ do
261267 modifyTVar' connectionWindow (subtract datPayloadLen)
@@ -406,8 +412,8 @@ nextForStream :: InternalInfo -> Buffer -> BufSize -> TBQueue Sequence
406412 -> TVar Sync -> Stream -> Leftover -> Maybe Trailers
407413 -> BytesFilled -> IO Next
408414nextForStream _ _ _ _ tvar _ _ (Just trailers) len = do
409− atomically $ writeTVar tvar $ SyncFinish trailers
410− return $ Next len CNone
415+ atomically $ writeTVar tvar $ SyncFinish
416+ return $ Next len $ CFinish trailers
411417nextForStream ii buf siz sq tvar strm LZero Nothing len = do
412418 let out = ONext strm (fillBufStream ii buf siz LZero sq tvar strm)
413419 atomically $ writeTVar tvar $ SyncNext out