@@ -13,6 +13,7 @@ import Control.Monad (unless, void, when)
1313import qualified Data.ByteString as BS
1414import qualified Data.ByteString.Builder.Extra as B
1515import Foreign.Ptr
16+import qualified Network.HTTP.Types as H
1617import Network.HTTP2
1718import Network.HTTP2.Priority
1819import Network.Wai.HTTP2 (Trailers)
@@ -81,27 +82,10 @@ frameSender ctx@Context{outputQ,connectionWindow}
8182 switch (OFrame frame) = do
8283 connSendAll frame
8384 loop
84− switch (OResponse strm s h aux) = do
85− unlessClosed ctx conn strm $ do
86− lim <- getWindowSize connectionWindow (streamWindow strm)
87− -- Header frame and Continuation frame
88− let sid = streamNumber strm
89− builder <- hpackEncodeHeader ctx ii settings s h
90− len <- headerContinue sid builder False
91− let total = len + frameHeaderLength
92− case aux of
93− Persist sq tvar -> do
94− (off, needSend) <- sendHeadersIfNecessary total
95− let payloadOff = off + frameHeaderLength
96− Next datPayloadLen mnext <-
97− fillStreamBodyGetNext conn payloadOff lim sq tvar strm
98− -- If no data was immediately available, avoid sending an
99− -- empty data frame.
100− if datPayloadLen > 0 then
101− fillDataHeaderSend strm total datPayloadLen mnext
102− else
103− when needSend $ flushN off
104− maybeEnqueueNext strm mnext
85+ switch out@(OResponse strm s h aux) = do
86+ unlessClosed ctx conn strm $
87+ getWindowSize connectionWindow (streamWindow strm) >>=
88+ sendResponse strm s h aux
10589 loop
10690 switch (ONext strm curr) = do
10791 unlessClosed ctx conn strm $ do
@@ -126,6 +110,28 @@ frameSender ctx@Context{outputQ,connectionWindow}
126110 flushN $ off + frameHeaderLength
127111 loop
128112
113+ -- Send the response headers and as much of the response as is immediately
114+ -- available; shared by normal responses and pushed streams.
115+ sendResponse :: Stream -> H.Status -> H.ResponseHeaders -> Aux -> WindowSize -> IO ()
116+ sendResponse strm s h (Persist sq tvar) lim = do
117+ -- Header frame and Continuation frame
118+ let sid = streamNumber strm
119+ builder <- hpackEncodeHeader ctx ii settings s h
120+ len <- headerContinue sid builder False
121+ let total = len + frameHeaderLength
122+ (off, needSend) <- sendHeadersIfNecessary total
123+ let payloadOff = off + frameHeaderLength
124+ Next datPayloadLen mnext <-
125+ fillStreamBodyGetNext conn payloadOff lim sq tvar strm
126+ -- If no data was immediately available, avoid sending an
127+ -- empty data frame.
128+ if datPayloadLen > 0 then
129+ fillDataHeaderSend strm total datPayloadLen mnext
130+ else
131+ when needSend $ flushN off
132+ maybeEnqueueNext strm mnext
133+
134+
129135 -- Flush the connection buffer to the socket, where the first 'n' bytes of
130136 -- the buffer are filled.
131137 flushN :: Int -> IO ()