@@ -13,6 +13,7 @@ import Control.Monad (unless, void, when)
13import qualified Data.ByteString as BS
13import qualified Data.ByteString as BS
14import qualified Data.ByteString.Builder.Extra as B
14import qualified Data.ByteString.Builder.Extra as B
15import Foreign.Ptr
15import Foreign.Ptr
16+import qualified Network.HTTP.Types as H
16import Network.HTTP2
17import Network.HTTP2
17import Network.HTTP2.Priority
18import Network.HTTP2.Priority
18import Network.Wai.HTTP2 (Trailers)
19import Network.Wai.HTTP2 (Trailers)
@@ -81,27 +82,10 @@ frameSender ctx@Context{outputQ,connectionWindow}
81 switch (OFrame frame) = do
82 switch (OFrame frame) = do
82 connSendAll frame
83 connSendAll frame
84− switch (OResponse strm s h aux) = do
85+ switch out@(OResponse strm s h aux) = do
85− unlessClosed ctx conn strm $ do
86+ unlessClosed ctx conn strm $
86− lim <- getWindowSize connectionWindow (streamWindow strm)
87+ getWindowSize connectionWindow (streamWindow strm) >>=
87− -- Header frame and Continuation frame
88+ sendResponse strm s h aux
88− let sid = streamNumber strm
89− builder <- hpackEncodeHeader ctx ii settings s h
90− len <- headerContinue sid builder False
91− let total = len + frameHeaderLength
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
100− if datPayloadLen > 0 then
101− fillDataHeaderSend strm total datPayloadLen mnext
103− when needSend $ flushN off
104− maybeEnqueueNext strm mnext
106 switch (ONext strm curr) = do
90 switch (ONext strm curr) = do
107 unlessClosed ctx conn strm $ do
91 unlessClosed ctx conn strm $ do
@@ -126,6 +110,28 @@ frameSender ctx@Context{outputQ,connectionWindow}
126 flushN $ off + frameHeaderLength
110 flushN $ off + frameHeaderLength
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
131+ when needSend $ flushN off
132+ maybeEnqueueNext strm mnext
129 -- Flush the connection buffer to the socket, where the first 'n' bytes of
135 -- Flush the connection buffer to the socket, where the first 'n' bytes of
130 -- the buffer are filled.
136 -- the buffer are filled.
131 flushN :: Int -> IO ()
137 flushN :: Int -> IO ()