@@ -115,13 +115,14 @@ frameSender ctx@Context{outputQ,connectionWindow}
115115 let payloadOff = off + frameHeaderLength
116116 Next datPayloadLen mnext <-
117117 fillResponseBodyGetNext conn ii payloadOff lim rsp
118− fillDataHeaderSend strm total datPayloadLen mnext pri
118+ fillDataHeaderSend strm total datPayloadLen mnext
119+ maybeEnqueueNext strm mnext pri
119120 Oneshot False -> do
120121 -- "closed" must be before "connSendAll". If not,
121122 -- the context would be switched to the receiver,
122123 -- resulting the inconsistency of concurrency.
123124 closed ctx strm Finished
124− bufferIO connWriteBuffer total connSendAll
125+ flushN total
125126 Persist sq tvar -> do
126127 (off, needSend) <- sendHeadersIfNecessary total
127128 let payloadOff = off + frameHeaderLength
@@ -130,20 +131,23 @@ frameSender ctx@Context{outputQ,connectionWindow}
130131 -- If no data was immediately available, avoid sending an
131132 -- empty data frame.
132133 if datPayloadLen > 0
133− then fillDataHeaderSend strm total datPayloadLen mnext pri
134− else when needSend $ do
135− bufferIO connWriteBuffer off connSendAll
136− case mnext of
137− CNext next -> enqueue outputQ (ONext strm next) pri
138− _ -> return ()
134+ then fillDataHeaderSend strm total datPayloadLen mnext
135+ else when needSend $ flushN off
136+ maybeEnqueueNext strm mnext pri
139137 loop
140138 switch out@(ONext strm curr) pri = unlessClosed ctx conn strm $ do
141139 checkWindowSize connectionWindow (streamWindow strm) outputQ out pri $ \lim -> do
142140 -- Data frame payload
143141 Next datPayloadLen mnext <- curr lim
144− fillDataHeaderSend strm 0 datPayloadLen mnext pri
142+ fillDataHeaderSend strm 0 datPayloadLen mnext
143+ maybeEnqueueNext strm mnext pri
145144 loop
146145
146+ -- Flush the connection buffer to the socket, where the first 'n' bytes of
147+ -- the buffer are filled.
148+ flushN :: Int -> IO ()
149+ flushN n = bufferIO connWriteBuffer n connSendAll
150+
147151 headerContinue sid rsp endOfStream = do
148152 builder <- hpackEncodeHeader ctx ii settings rsp
149153 (len, signal) <- B.runBuilder builder bufHeaderPayload headerPayloadLim
@@ -156,8 +160,7 @@ frameSender ctx@Context{outputQ,connectionWindow}
156160
157161 continue _ len B.Done = return len
158162 continue sid len (B.More _ writer) = do
159− let total = len + frameHeaderLength
160− bufferIO connWriteBuffer total connSendAll
163+ flushN $ len + frameHeaderLength
161164 (len', signal') <- writer bufHeaderPayload headerPayloadLim
162165 let flag = case signal' of
163166 B.Done -> setEndHeader defaultFlags
@@ -165,8 +168,7 @@ frameSender ctx@Context{outputQ,connectionWindow}
165168 fillFrameHeader FrameContinuation len' sid flag connWriteBuffer
166169 continue sid len' signal'
167170 continue sid len (B.Chunk bs writer) = do
168− let total = len + frameHeaderLength
169− bufferIO connWriteBuffer total connSendAll
171+ flushN $ len + frameHeaderLength
170172 let (bs1,bs2) = BS.splitAt headerPayloadLim bs
171173 len' = BS.length bs1
172174 void $ copy bufHeaderPayload bs1
@@ -179,6 +181,15 @@ frameSender ctx@Context{outputQ,connectionWindow}
179181 -- True if the connection buffer has room for a 1-byte data frame.
180182 canFitDataFrame total = total + frameHeaderLength < connBufferSize
181183
184+ -- Re-enqueue the stream in the output queue if more output is immediately
185+ -- available; do nothing otherwise. If the stream is not finished, it must
186+ -- already have been written to the 'TVar' owned by 'waiter', which will
187+ -- put it back into the queue when more output becomes available.
188+ maybeEnqueueNext :: Stream -> Control DynaNext -> Priority -> IO ()
189+ maybeEnqueueNext strm (CNext next) = enqueue outputQ (ONext strm next)
190+ maybeEnqueueNext _ _ = const $ return ()
191+
192+
182193 -- Send headers if there is not room for a 1-byte data frame, and return
183194 -- the offset of the next frame's first header byte and whether the headers
184195 -- still need to be sent.
@@ -187,7 +198,7 @@ frameSender ctx@Context{outputQ,connectionWindow}
187198 then return (total, True)
188199 else bufferIO connWriteBuffer total connSendAll >> return (0, False)
189200
190− fillDataHeaderSend strm otherLen datPayloadLen mnext pri = do
201+ fillDataHeaderSend strm otherLen datPayloadLen mnext = do
191202 -- Data frame header
192203 let sid = streamNumber strm
193204 buf = connWriteBuffer `plusPtr` otherLen
@@ -202,13 +213,10 @@ frameSender ctx@Context{outputQ,connectionWindow}
202213 case mnext of
203214 CFinish -> closed ctx strm Finished
204215 _ -> return ()
205− bufferIO connWriteBuffer total connSendAll
216+ flushN total
206217 atomically $ do
207218 modifyTVar' connectionWindow (subtract datPayloadLen)
208219 modifyTVar' (streamWindow strm) (subtract datPayloadLen)
209− case mnext of
210− CNext next -> enqueue outputQ (ONext strm next) pri
211− _ -> return ()
212220
213221 fillFrameHeader ftyp len sid flag buf = encodeFrameHeaderBuf ftyp hinfo buf
214222 where