@@ -96,20 +96,20 @@ frameSender ctx@Context{outputQ,connectionWindow,wait}
9696 len <- headerContinue sid rsp endOfStream
9797 let total = len + frameHeaderLength
9898 case aux of
99− Oneshot hasBody -> if hasBody then do
99+ Oneshot True -> do -- hasBody
100100 -- Data frame payload
101− let datPayloadOff = total + frameHeaderLength
102− Next datPayloadLen mnext <- fillResponseBodyGetNext conn ii datPayloadOff lim rsp
101+ off <- sendHeadersIfNecessary total
102+ Next datPayloadLen mnext <- fillResponseBodyGetNext conn ii off lim rsp
103103 fillDataHeaderSend strm total datPayloadLen mnext pri
104− else do
104+ Oneshot False -> do
105105 -- "closed" must be before "connSendAll". If not,
106106 -- the context would be switched to the receiver,
107107 -- resulting the inconsistency of concurrency.
108108 closed ctx strm Finished
109109 bufferIO connWriteBuffer total connSendAll
110110 Persist sq tvar -> do
111− let datPayloadOff = total + frameHeaderLength
112− Next datPayloadLen mnext <- fillStreamBodyGetNext conn datPayloadOff lim sq tvar
111+ off <- sendHeadersIfNecessary total
112+ Next datPayloadLen mnext <- fillStreamBodyGetNext conn off lim sq tvar
113113 fillDataHeaderSend strm total datPayloadLen mnext pri
114114 loop
115115 switch out@(ONext strm curr) pri = unlessClosed ctx conn strm $ do
@@ -131,7 +131,8 @@ frameSender ctx@Context{outputQ,connectionWindow,wait}
131131
132132 continue _ len B.Done = return len
133133 continue sid len (B.More _ writer) = do
134− bufferIO connWriteBuffer (len + frameHeaderLength) connSendAll
134+ let total = len + frameHeaderLength
135+ bufferIO connWriteBuffer total connSendAll
135136 (len', signal') <- writer bufHeaderPayload headerPayloadLim
136137 let flag = case signal' of
137138 B.Done -> setEndHeader defaultFlags
@@ -139,7 +140,8 @@ frameSender ctx@Context{outputQ,connectionWindow,wait}
139140 fillFrameHeader FrameContinuation len' sid flag connWriteBuffer
140141 continue sid len' signal'
141142 continue sid len (B.Chunk bs writer) = do
142− bufferIO connWriteBuffer (len + frameHeaderLength) connSendAll
143+ let total = len + frameHeaderLength
144+ bufferIO connWriteBuffer total connSendAll
143145 let (bs1,bs2) = BS.splitAt headerPayloadLim bs
144146 len' = BS.length bs1
145147 void $ copy bufHeaderPayload bs1
@@ -149,6 +151,14 @@ frameSender ctx@Context{outputQ,connectionWindow,wait}
149151 else
150152 continue sid len' (B.Chunk bs2 writer)
151153
154+ sendHeadersIfNecessary total = do
155+ let datPayloadOff = total + frameHeaderLength
156+ if datPayloadOff < connBufferSize then
157+ return datPayloadOff
158+ else do
159+ bufferIO connWriteBuffer total connSendAll
160+ return frameHeaderLength
161+
152162 fillDataHeaderSend strm otherLen datPayloadLen mnext pri = do
153163 -- Data frame header
154164 let sid = streamNumber strm