@@ -10,7 +10,7 @@ import Control.Applicative
1010import Control.Concurrent (forkIO)
1111import Control.Concurrent.STM
1212import qualified Control.Exception as E
13−import Control.Monad (void, unless)
13+import Control.Monad (unless, void, when)
1414import qualified Data.ByteString as BS
1515import qualified Data.ByteString.Builder.Extra as B
1616import Foreign.Ptr
@@ -111,8 +111,10 @@ frameSender ctx@Context{outputQ,connectionWindow}
111111 case aux of
112112 Oneshot True -> do -- hasBody
113113 -- Data frame payload
114− off <- sendHeadersIfNecessary total
115− Next datPayloadLen mnext <- fillResponseBodyGetNext conn ii off lim rsp
114+ (off, _) <- sendHeadersIfNecessary total
115+ let payloadOff = off + frameHeaderLength
116+ Next datPayloadLen mnext <-
117+ fillResponseBodyGetNext conn ii payloadOff lim rsp
116118 fillDataHeaderSend strm total datPayloadLen mnext pri
117119 Oneshot False -> do
118120 -- "closed" must be before "connSendAll". If not,
@@ -121,9 +123,19 @@ frameSender ctx@Context{outputQ,connectionWindow}
121123 closed ctx strm Finished
122124 bufferIO connWriteBuffer total connSendAll
123125 Persist sq tvar -> do
124− off <- sendHeadersIfNecessary total
125− Next datPayloadLen mnext <- fillStreamBodyGetNext conn off lim sq tvar
126− fillDataHeaderSend strm total datPayloadLen mnext pri
126+ (off, needSend) <- sendHeadersIfNecessary total
127+ let payloadOff = off + frameHeaderLength
128+ Next datPayloadLen mnext <-
129+ fillStreamBodyGetNext conn payloadOff lim sq tvar
130+ -- If no data was immediately available, avoid sending an
131+ -- empty data frame.
132+ 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 ()
127139 loop
128140 switch out@(ONext strm curr) pri = unlessClosed ctx conn strm $ do
129141 checkWindowSize connectionWindow (streamWindow strm) outputQ out pri $ \lim -> do
@@ -164,13 +176,16 @@ frameSender ctx@Context{outputQ,connectionWindow}
164176 else
165177 continue sid len' (B.Chunk bs2 writer)
166178
179+ -- True if the connection buffer has room for a 1-byte data frame.
180+ canFitDataFrame total = total + frameHeaderLength < connBufferSize
181+
182+ -- Send headers if there is not room for a 1-byte data frame, and return
183+ -- the offset of the next frame's first header byte and whether the headers
184+ -- still need to be sent.
167185 sendHeadersIfNecessary total = do
168− let datPayloadOff = total + frameHeaderLength
169− if datPayloadOff < connBufferSize then
170− return datPayloadOff
171− else do
172− bufferIO connWriteBuffer total connSendAll
173− return frameHeaderLength
186+ if canFitDataFrame total
187+ then return (total, True)
188+ else bufferIO connWriteBuffer total connSendAll >> return (0, False)
174189
175190 fillDataHeaderSend strm otherLen datPayloadLen mnext pri = do
176191 -- Data frame header
@@ -192,9 +207,8 @@ frameSender ctx@Context{outputQ,connectionWindow}
192207 modifyTVar' connectionWindow (subtract datPayloadLen)
193208 modifyTVar' (streamWindow strm) (subtract datPayloadLen)
194209 case mnext of
195− CFinish -> return ()
196210 CNext next -> enqueue outputQ (ONext strm next) pri
197− CNone -> return ()
211+ _ -> return ()
198212
199213 fillFrameHeader ftyp len sid flag buf = encodeFrameHeaderBuf ftyp hinfo buf
200214 where