@@ -11,6 +11,7 @@ import Control.Concurrent.STM
1111import qualified Control.Exception as E
1212import Control.Monad (void, when)
1313import qualified Data.ByteString as BS
14+import Data.ByteString.Builder (Builder)
1415import qualified Data.ByteString.Builder.Extra as B
1516import Data.Maybe (isNothing)
1617import Foreign.Ptr
@@ -26,7 +27,6 @@ import Network.Wai.Handler.Warp.HTTP2.Types
2627import Network.Wai.Handler.Warp.IORef
2728import qualified Network.Wai.Handler.Warp.Settings as S
2829import Network.Wai.Handler.Warp.Types
29−import Network.Wai.Internal (Response(..))
3030
3131#ifdef WINDOWS
3232import qualified System.IO as IO
@@ -110,54 +110,61 @@ frameSender ctx@Context{outputQ,controlQ,connectionWindow,encodeDynamicTable}
110110 setLimitForEncoding siz dyntbl
111111 return True
112112
113− output (ONext strm binfo curr) off0 lim = do
113+ output (ONext strm curr mtbq) off0 lim = do
114114 -- Data frame payload
115115 let !buf = connWriteBuffer `plusPtr` off0
116116 !siz = connBufferSize - off0
117117 Next datPayloadLen mnext <- curr buf siz lim
118118 off <- fillDataHeader strm off0 datPayloadLen mnext
119− maybeEnqueueNext strm binfo mnext
119+ maybeEnqueueNext strm mtbq mnext
120120 return off
121121
122− output (OResponse strm binfo rsp) off0 lim = do
122+ output (ORspn strm rspn) off0 lim = do
123123 -- Header frame and Continuation frame
124124 let sid = streamNumber strm
125− endOfStream = case binfo of
126− Persist{} -> False
127− OneshotWithBody -> False
128− OneshotWithoutBody -> True
129− kvlen <- headerContinue sid rsp endOfStream off0
125+ endOfStream = case rspn of
126+ RspnNobody _ _ -> True
127+ _ -> False
128+ kvlen <- headerContinue sid rspn endOfStream off0
130129 off <- sendHeadersIfNecessary $ off0 + frameHeaderLength + kvlen
131− case binfo of
132− OneshotWithoutBody -> do
130+ case rspn of
131+ RspnNobody _ _ -> do
133132 closed ctx strm Finished
134133 return off
135− OneshotWithBody -> do
134+ RspnFile _ _ h path mpart -> do
136135 -- Data frame payload
137136 let payloadOff = off + frameHeaderLength
138137 Next datPayloadLen mnext <-
139− fillResponseBodyGetNext conn ii payloadOff lim rsp
138+ fillFileBodyGetNext conn ii payloadOff lim h path mpart
140139 off' <- fillDataHeader strm off datPayloadLen mnext
141− maybeEnqueueNext strm binfo mnext
140+ maybeEnqueueNext strm Nothing mnext
142141 return off'
143− Persist sq -> do
142+ RspnBuilder _ _ builder -> do
143+ -- Data frame payload
144+ let payloadOff = off + frameHeaderLength
145+ Next datPayloadLen mnext <-
146+ fillBuilderBodyGetNext conn ii payloadOff lim builder
147+ off' <- fillDataHeader strm off datPayloadLen mnext
148+ maybeEnqueueNext strm Nothing mnext
149+ return off'
150+ RspnStreaming _ _ tbq -> do
144151 let payloadOff = off + frameHeaderLength
145152 Next datPayloadLen mnext <-
146− fillStreamBodyGetNext conn payloadOff lim sq strm
153+ fillStreamBodyGetNext conn payloadOff lim tbq strm
147154 off' <- fillDataHeader strm off datPayloadLen mnext
148− maybeEnqueueNext strm binfo mnext
155+ maybeEnqueueNext strm (Just tbq) mnext
149156 return off'
150157
151158 whenReadyOrEnqueueAgain out off body = E.handle resetStream $ do
152159 state <- readIORef $ streamState strm
153160 if isClosed state then
154161 return off
155− else case binfo of
156− Persist tbq -> checkStreaming tbq
157− _ -> checkStreamWindowSize
162+ else case mtbq of
163+ Just tbq -> checkStreaming tbq
164+ _ -> checkStreamWindowSize
158165 where
159166 strm = outputStream out
160− binfo = outputBodyInfo out
167+ mtbq = outputMaybeTBQueue out
161168 checkStreaming tbq = do
162169 isEmpty <- atomically $ isEmptyTBQueue tbq
163170 if isEmpty then do
@@ -185,8 +192,10 @@ frameSender ctx@Context{outputQ,controlQ,connectionWindow,encodeDynamicTable}
185192 flushN :: Int -> IO ()
186193 flushN n = bufferIO connWriteBuffer n connSendAll
187194
188− headerContinue sid rsp endOfStream off = do
189− builder <- hpackEncodeHeader ctx ii settings rsp
195+ headerContinue sid rspn endOfStream off = do
196+ let !s = rspnStatus rspn
197+ !h = rspnHeaders rspn
198+ builder <- hpackEncodeHeader ctx ii settings s h
190199 let !offkv = off + frameHeaderLength
191200 let !bufkv = connWriteBuffer `plusPtr` offkv
192201 !limkv = connBufferSize - offkv
@@ -225,11 +234,11 @@ frameSender ctx@Context{outputQ,controlQ,connectionWindow,encodeDynamicTable}
225234 continue sid kvlen' (B.Chunk bs2 writer)
226235
227236 -- Re-enqueue the stream in the output queue.
228− maybeEnqueueNext :: Stream -> BodyInfo -> Maybe DynaNext -> IO ()
229− maybeEnqueueNext _ _ Nothing = return ()
230− maybeEnqueueNext strm binfo (Just next) = enqueueOutput outputQ out
237+ maybeEnqueueNext :: Stream -> Maybe (TBQueue Sequence) -> Maybe DynaNext -> IO ()
238+ maybeEnqueueNext _ _ Nothing = return ()
239+ maybeEnqueueNext strm mtbq (Just next) = enqueueOutput outputQ out
231240 where
232− !out = ONext strm binfo next
241+ !out = ONext strm next mtbq
233242
234243 -- Send headers if there is not room for a 1-byte data frame, and return
235244 -- the offset of the next frame's first header byte.
@@ -270,32 +279,33 @@ ResponseStream Status ResponseHeaders StreamingBody
270279ResponseRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) Response
271280-}
272281
273−fillResponseBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> Response -> IO Next
274−fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
275− _ off lim (ResponseBuilder _ _ bb) = do
282+fillBuilderBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> Builder -> IO Next
283+fillBuilderBodyGetNext Connection{connWriteBuffer,connBufferSize}
284+ _ off lim bb = do
276285 let datBuf = connWriteBuffer `plusPtr` off
277286 room = min (connBufferSize - off) lim
278287 (len, signal) <- B.runBuilder bb datBuf room
279288 return $ nextForBuilder len signal
280289
290+fillFileBodyGetNext :: Connection -> InternalInfo -> Int -> WindowSize -> Int -> FilePath -> Maybe FilePart -> IO Next
281291#ifdef WINDOWS
282−fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
283− _ off lim (ResponseFile _ _ path mpart) = do
292+fillFileBodyGetNext Connection{connWriteBuffer,connBufferSize}
293+ _ off lim _ path mpart = do
284294 let datBuf = connWriteBuffer `plusPtr` off
285295 room = min (connBufferSize - off) lim
286296 (start, bytes) <- fileStartEnd path mpart
287297 -- fixme: how to close Handle? GC does it at this moment.
288− h <- IO.openBinaryFile path IO.ReadMode
298+ hdl <- IO.openBinaryFile path IO.ReadMode
289299 IO.hSeek h IO.AbsoluteSeek start
290− len <- IO.hGetBufSome h datBuf (mini room bytes)
300+ len <- IO.hGetBufSome hdl datBuf (mini room bytes)
291301 let bytes' = bytes - fromIntegral len
292302 -- fixme: connWriteBuffer connBufferSize
293− return $ nextForFile len h bytes' (return ())
303+ return $ nextForFile len hdl bytes' (return ())
294304#else
295−fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
296− ii off lim (ResponseFile _ _ path mpart) = do
305+fillFileBodyGetNext Connection{connWriteBuffer,connBufferSize}
306+ ii off lim h path mpart = do
297307 (fd, refresh) <- case fdCacher ii of
298− Just fdcache -> getFd fdcache path
308+ Just fdcache -> getFd' fdcache h path
299309 Nothing -> do
300310 fd' <- openFd path ReadOnly Nothing defaultFileFlags{nonBlock=True}
301311 th <- T.register (timeoutManager ii) (closeFd fd')
@@ -309,8 +319,6 @@ fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
309319 return $ nextForFile len fd (start + len') (bytes - len') refresh
310320#endif
311321
312−fillResponseBodyGetNext _ _ _ _ _ = error "fillResponseBodyGetNext"
313−
314322fileStartEnd :: FilePath -> Maybe FilePart -> IO (Integer, Integer)
315323fileStartEnd _ (Just part) =
316324 return (filePartOffset part, filePartByteCount part)