on master help sign in
Defining getWindowSize (#423)
commit1a2bcf33ab31e620d4a2b4e1b827ab2a4dfe3ea1 authorKazu Yamamoto <kazu@iij.ad.jp> dateThu 13 Aug 2015, 09:36 (11 years ago) parentbe0d848
1 file changed+44−43
warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+44−43
warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+44−43
@@ -58,15 +58,16 @@ unlessClosed ctx
5858 let rst = resetFrame InternalError streamNumber
5959 connSendAll rst
6060
61−checkWindowSize :: TVar WindowSize -> TVar WindowSize -> (WindowSize -> IO ()) -> IO ()
62−checkWindowSize connWindow strmWindow body = do
61+getWindowSize :: TVar WindowSize -> TVar WindowSize -> IO WindowSize
62+getWindowSize connWindow strmWindow = do
63+ -- Waiting that the connection window gets open.
6364 cw <- atomically $ do
6465 w <- readTVar connWindow
6566 check (w > 0)
6667 return w
67− -- sw is greater than 0
68+ -- This stream window is greater than 0 thanks to the invariant.
6869 sw <- atomically $ readTVar strmWindow
69− body (min cw sw)
70+ return $ min cw sw
7071
7172frameSender :: Context -> Connection -> InternalInfo -> S.Settings -> IO ()
7273frameSender ctx@Context{outputQ,connectionWindow}
@@ -94,48 +95,48 @@ frameSender ctx@Context{outputQ,connectionWindow}
9495 connSendAll frame
9596 loop
9697 switch (OResponse strm rsp aux) = unlessClosed ctx conn strm $ do
97− checkWindowSize connectionWindow (streamWindow strm) $ \lim -> do
98− -- Header frame and Continuation frame
99− let sid = streamNumber strm
100− endOfStream = case aux of
101− Persist{} -> False
102− Oneshot hb -> not hb
103− len <- headerContinue sid rsp endOfStream
104− let total = len + frameHeaderLength
105− case aux of
106− Oneshot True -> do -- hasBody
107− -- Data frame payload
108− (off, _) <- sendHeadersIfNecessary total
109− let payloadOff = off + frameHeaderLength
110− Next datPayloadLen mnext <-
111− fillResponseBodyGetNext conn ii payloadOff lim rsp
98+ lim <- getWindowSize connectionWindow (streamWindow strm)
99+ -- Header frame and Continuation frame
100+ let sid = streamNumber strm
101+ endOfStream = case aux of
102+ Persist{} -> False
103+ Oneshot hb -> not hb
104+ len <- headerContinue sid rsp endOfStream
105+ let total = len + frameHeaderLength
106+ case aux of
107+ Oneshot True -> do -- hasBody
108+ -- Data frame payload
109+ (off, _) <- sendHeadersIfNecessary total
110+ let payloadOff = off + frameHeaderLength
111+ Next datPayloadLen mnext <-
112+ fillResponseBodyGetNext conn ii payloadOff lim rsp
113+ fillDataHeaderSend strm total datPayloadLen mnext
114+ maybeEnqueueNext strm mnext
115+ Oneshot False -> do
116+ -- "closed" must be before "connSendAll". If not,
117+ -- the context would be switched to the receiver,
118+ -- resulting the inconsistency of concurrency.
119+ closed ctx strm Finished
120+ flushN total
121+ Persist sq tvar -> do
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
112129 fillDataHeaderSend strm total datPayloadLen mnext
113− maybeEnqueueNext strm mnext
114− Oneshot False -> do
115− -- "closed" must be before "connSendAll". If not,
116− -- the context would be switched to the receiver,
117− -- resulting the inconsistency of concurrency.
118− closed ctx strm Finished
119− flushN total
120− Persist sq tvar -> do
121− (off, needSend) <- sendHeadersIfNecessary total
122− let payloadOff = off + frameHeaderLength
123− Next datPayloadLen mnext <-
124− fillStreamBodyGetNext conn payloadOff lim sq tvar strm
125− -- If no data was immediately available, avoid sending an
126− -- empty data frame.
127− if datPayloadLen > 0 then
128− fillDataHeaderSend strm total datPayloadLen mnext
129− else
130− when needSend $ flushN off
131− maybeEnqueueNext strm mnext
130+ else
131+ when needSend $ flushN off
132+ maybeEnqueueNext strm mnext
132133 loop
133134 switch (ONext strm curr) = unlessClosed ctx conn strm $ do
134− checkWindowSize connectionWindow (streamWindow strm) $ \lim -> do
135− -- Data frame payload
136− Next datPayloadLen mnext <- curr lim
137− fillDataHeaderSend strm 0 datPayloadLen mnext
138− maybeEnqueueNext strm mnext
135+ lim <- getWindowSize connectionWindow (streamWindow strm)
136+ -- Data frame payload
137+ Next datPayloadLen mnext <- curr lim
138+ fillDataHeaderSend strm 0 datPayloadLen mnext
139+ maybeEnqueueNext strm mnext
139140 loop
140141
141142 -- Flush the connection buffer to the socket, where the first 'n' bytes of