@@ -9,23 +9,22 @@ import Control.Applicative
99#endif
1010import Control.Concurrent.STM
1111import qualified Control.Exception as E
12−import Control.Monad (unless, void, when)
12+import Control.Monad (void, when)
1313import qualified Data.ByteString as BS
1414import qualified Data.ByteString.Builder.Extra as B
15+import Data.Maybe (isNothing)
1516import Foreign.Ptr
1617import Network.HPACK (setLimitForEncoding)
1718import Network.HTTP2
18−import Network.HTTP2.Priority
19+import Network.HTTP2.Priority (isEmptySTM, dequeueSTM, Precedence)
1920import Network.Wai
2021import Network.Wai.Handler.Warp.Buffer
2122import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
2223import Network.Wai.Handler.Warp.HTTP2.HPACK
24+import Network.Wai.Handler.Warp.HTTP2.Manager (Manager)
2325import Network.Wai.Handler.Warp.HTTP2.Types
2426import Network.Wai.Handler.Warp.IORef
2527import qualified Network.Wai.Handler.Warp.Settings as S
26−#ifndef WINDOWS
27−import qualified Network.Wai.Handler.Warp.Timeout as T
28−#endif
2928import Network.Wai.Handler.Warp.Types
3029import Network.Wai.Internal (Response(..))
3130
@@ -34,6 +33,7 @@ import qualified System.IO as IO
3433#else
3534import Network.Wai.Handler.Warp.FdCache
3635import Network.Wai.Handler.Warp.SendFile (positionRead)
36+import qualified Network.Wai.Handler.Warp.Timeout as T
3737import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)
3838import System.Posix.Types
3939#endif
@@ -46,25 +46,6 @@ data Leftover = LZero
4646
4747----------------------------------------------------------------
4848
49−unlessClosed :: Context -> Connection -> Stream -> IO () -> IO ()
50−unlessClosed ctx
51− Connection{connSendAll}
52− strm@Stream{streamState,streamNumber}
53− body = E.handle resetStream $ do
54− state <- readIORef streamState
55− unless (isClosed state) body
56− where
57− resetStream e = do
58− closed ctx strm (ResetByMe e)
59− let rst = resetFrame InternalError streamNumber
60− connSendAll rst
61−
62−getConnectionWindowSizeWhenReady :: Context -> IO WindowSize
63−getConnectionWindowSizeWhenReady Context{connectionWindow} = atomically $ do
64− w <- readTVar connectionWindow
65− check (w > 0)
66− return w
67−
6849getStreamWindowSize :: Stream -> IO WindowSize
6950getStreamWindowSize Stream{streamWindow} = atomically $ readTVar streamWindow
7051
@@ -78,187 +59,208 @@ waitStreaming tbq = do
7859 isEmpty <- isEmptyTBQueue tbq
7960 check (isEmpty == False)
8061
81−frameSender :: Context -> Connection -> InternalInfo -> S.Settings -> IO ()
82−frameSender ctx@Context{outputQ,connectionWindow,encodeDynamicTable}
62+data Switch = C Control
63+ | O (StreamId,Precedence,Output)
64+ | Flush
65+
66+frameSender :: Context -> Connection -> InternalInfo -> S.Settings -> Manager -> IO ()
67+frameSender ctx@Context{outputQ,controlQ,connectionWindow,encodeDynamicTable}
8368 conn@Connection{connWriteBuffer,connBufferSize,connSendAll}
84− ii settings = go `E.catch` ignore
69+ ii settings mgr = loop 0 `E.catch` ignore
8570 where
86− initialSettings = [(SettingsMaxConcurrentStreams,recommendedConcurrency)]
87− initialFrame = settingsFrame id initialSettings
88− bufHeaderPayload = connWriteBuffer `plusPtr` frameHeaderLength
89− headerPayloadLim = connBufferSize - frameHeaderLength
90−
91− go = do
92− connSendAll initialFrame
93− loop
94−
95− -- ignoring the old priority because the value might be changed.
96− loop = dequeue outputQ >>= \(_sid,pre,out) -> switch out pre
97−
98− ignore :: E.SomeException -> IO ()
99− ignore _ = return ()
100−
101− switch OFinish _ = return ()
102− switch (OGoaway frame) _ = connSendAll frame
103− switch (OFrame frame) _ = do
104− connSendAll frame
105− loop
106− switch (OSettings frame alist) _ = do
71+ dequeue off = do
72+ isEmpty <- isEmptyTQueue controlQ
73+ if isEmpty then do
74+ w <- readTVar connectionWindow
75+ check (w > 0)
76+ emp <- isEmptySTM outputQ
77+ if emp then
78+ if off /= 0 then return Flush else retry
79+ else
80+ O <$> dequeueSTM outputQ
81+ else
82+ C <$> readTQueue controlQ
83+
84+ loop off = do
85+ x <- atomically $ dequeue off
86+ case x of
87+ C ctl -> do
88+ when (off /= 0) $ flushN off
89+ cont <- control ctl
90+ when cont $ loop 0
91+ O (_,pre,out) -> do
92+ let strm = outputStream out
93+ writeIORef (streamPrecedence strm) pre
94+ off' <- whenReadyOrEnqueueAgain out off $ output out off
95+ case off' of
96+ 0 -> loop 0
97+ _ | off' > 12288 -> flushN off' >> loop 0 -- fixme: hard-coding
98+ | otherwise -> loop off'
99+ Flush -> flushN off >> loop 0
100+
101+ control CFinish = return False
102+ control (CGoaway frame) = connSendAll frame >> return False
103+ control (CFrame frame) = connSendAll frame >> return True
104+ control (CSettings frame alist) = do
107105 connSendAll frame
108106 case lookup SettingsHeaderTableSize alist of
109107 Nothing -> return ()
110108 Just siz -> do
111109 dyntbl <- readIORef encodeDynamicTable
112110 setLimitForEncoding siz dyntbl
113− loop
114− switch out@(ONext strm curr binfo) pre = do
115− writeIORef (streamPrecedence strm) pre
116− whenReadyOrEnqueueAgain strm binfo out $ \sws -> do
117− cws <- getConnectionWindowSizeWhenReady ctx
118− let !lim = min cws sws
119− -- Data frame payload
120− Next datPayloadLen mnext <- curr lim
121− fillDataHeaderSend strm 0 datPayloadLen mnext
122− maybeEnqueueNext strm mnext binfo
123− loop
124− switch out@(OResponse strm rsp binfo) pre = do
125− writeIORef (streamPrecedence strm) pre
126− whenReadyOrEnqueueAgain strm binfo out $ \sws -> do
127− cws <- getConnectionWindowSizeWhenReady ctx
128− let !lim = min cws sws
129− -- Header frame and Continuation frame
130− let sid = streamNumber strm
131− endOfStream = case binfo of
132− Persist{} -> False
133− OneshotWithBody -> False
134− OneshotWithoutBody -> True
135− len <- headerContinue sid rsp endOfStream
136− let total = len + frameHeaderLength
137− case binfo of
138− OneshotWithBody -> do
139− -- Data frame payload
140− (off, _) <- sendHeadersIfNecessary total
141− let payloadOff = off + frameHeaderLength
142− Next datPayloadLen mnext <-
143− fillResponseBodyGetNext conn ii payloadOff lim rsp
144− fillDataHeaderSend strm total datPayloadLen mnext
145− maybeEnqueueNext strm mnext binfo
146− OneshotWithoutBody -> do
147− -- "closed" must be before "connSendAll". If not,
148− -- the context would be switched to the receiver,
149− -- resulting the inconsistency of concurrency.
150− closed ctx strm Finished
151− flushN total
152− Persist sq -> do
153− (off, needSend) <- sendHeadersIfNecessary total
154− let payloadOff = off + frameHeaderLength
155− Next datPayloadLen mnext <-
156− fillStreamBodyGetNext conn payloadOff lim sq strm
157− -- If no data was immediately available, avoid sending an
158− -- empty data frame.
159− if datPayloadLen > 0 then
160− fillDataHeaderSend strm total datPayloadLen mnext
161− else
162− when needSend $ flushN off
163− maybeEnqueueNext strm mnext binfo
164− loop
165−
166− whenReadyOrEnqueueAgain strm binfo out body =
167− unlessClosed ctx conn strm $ case binfo of
111+ return True
112+
113+ output (ONext strm binfo curr) off0 lim = do
114+ -- Data frame payload
115+ let !buf = connWriteBuffer `plusPtr` off0
116+ !siz = connBufferSize - off0
117+ Next datPayloadLen mnext <- curr buf siz lim
118+ off <- fillDataHeader strm off0 datPayloadLen mnext
119+ maybeEnqueueNext strm binfo mnext
120+ return off
121+
122+ output (OResponse strm binfo rsp) off0 lim = do
123+ -- Header frame and Continuation frame
124+ 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
130+ off <- sendHeadersIfNecessary $ off0 + frameHeaderLength + kvlen
131+ case binfo of
132+ OneshotWithoutBody -> do
133+ closed ctx strm Finished
134+ return off
135+ OneshotWithBody -> do
136+ -- Data frame payload
137+ let payloadOff = off + frameHeaderLength
138+ Next datPayloadLen mnext <-
139+ fillResponseBodyGetNext conn ii payloadOff lim rsp
140+ off' <- fillDataHeader strm off datPayloadLen mnext
141+ maybeEnqueueNext strm binfo mnext
142+ return off'
143+ Persist sq -> do
144+ let payloadOff = off + frameHeaderLength
145+ Next datPayloadLen mnext <-
146+ fillStreamBodyGetNext conn payloadOff lim sq strm
147+ off' <- fillDataHeader strm off datPayloadLen mnext
148+ maybeEnqueueNext strm binfo mnext
149+ return off'
150+
151+ whenReadyOrEnqueueAgain out off body = E.handle resetStream $ do
152+ state <- readIORef $ streamState strm
153+ if isClosed state then
154+ return off
155+ else case binfo of
168156 Persist tbq -> checkStreaming tbq
169157 _ -> checkStreamWindowSize
170158 where
159+ strm = outputStream out
160+ binfo = outputBodyInfo out
171161 checkStreaming tbq = do
172162 isEmpty <- atomically $ isEmptyTBQueue tbq
173− if isEmpty then
174− enqueueWhenReady (waitStreaming tbq) outputQ out
163+ if isEmpty then do
164+ forkAndEnqueueWhenReady (waitStreaming tbq) outputQ out mgr
165+ return off
175166 else
176167 checkStreamWindowSize
177168 checkStreamWindowSize = do
178169 sws <- getStreamWindowSize strm
179170 if sws == 0 then do
180− enqueueWhenReady (waitStreamWindowSize strm) outputQ out
181− else
182− body sws
171+ forkAndEnqueueWhenReady (waitStreamWindowSize strm) outputQ out mgr
172+ return off
173+ else do
174+ cws <- atomically $ readTVar connectionWindow -- not 0
175+ let !lim = min cws sws
176+ body lim
177+ resetStream e = do
178+ closed ctx strm (ResetByMe e)
179+ let !rst = resetFrame InternalError $ streamNumber strm
180+ enqueueControl controlQ $ CFrame rst
181+ return off
183182
184183 -- Flush the connection buffer to the socket, where the first 'n' bytes of
185184 -- the buffer are filled.
186185 flushN :: Int -> IO ()
187186 flushN n = bufferIO connWriteBuffer n connSendAll
188187
189− headerContinue sid rsp endOfStream = do
188+ headerContinue sid rsp endOfStream off = do
190189 builder <- hpackEncodeHeader ctx ii settings rsp
191− (len, signal) <- B.runBuilder builder bufHeaderPayload headerPayloadLim
190+ let !offkv = off + frameHeaderLength
191+ let !bufkv = connWriteBuffer `plusPtr` offkv
192+ !limkv = connBufferSize - offkv
193+ (kvlen, signal) <- B.runBuilder builder bufkv limkv
192194 let flag0 = case signal of
193195 B.Done -> setEndHeader defaultFlags
194196 _ -> defaultFlags
195197 flag = if endOfStream then setEndStream flag0 else flag0
196− fillFrameHeader FrameHeaders len sid flag connWriteBuffer
197− continue sid len signal
198+ let buf = connWriteBuffer `plusPtr` off
199+ fillFrameHeader FrameHeaders kvlen sid flag buf
200+ continue sid kvlen signal
201+
202+ bufHeaderPayload = connWriteBuffer `plusPtr` frameHeaderLength
203+ headerPayloadLim = connBufferSize - frameHeaderLength
198204
199− continue _ len B.Done = return len
200− continue sid len (B.More _ writer) = do
201− flushN $ len + frameHeaderLength
202− (len', signal') <- writer bufHeaderPayload headerPayloadLim
205+ continue _ kvlen B.Done = return kvlen
206+ continue sid kvlen (B.More _ writer) = do
207+ flushN $ kvlen + frameHeaderLength
208+ -- Now off is 0
209+ (kvlen', signal') <- writer bufHeaderPayload headerPayloadLim
203210 let flag = case signal' of
204211 B.Done -> setEndHeader defaultFlags
205212 _ -> defaultFlags
206− fillFrameHeader FrameContinuation len' sid flag connWriteBuffer
207− continue sid len' signal'
208− continue sid len (B.Chunk bs writer) = do
209− flushN $ len + frameHeaderLength
213+ fillFrameHeader FrameContinuation kvlen' sid flag connWriteBuffer
214+ continue sid kvlen' signal'
215+ continue sid kvlen (B.Chunk bs writer) = do
216+ flushN $ kvlen + frameHeaderLength
217+ -- Now off is 0
210218 let (bs1,bs2) = BS.splitAt headerPayloadLim bs
211− len' = BS.length bs1
219+ kvlen' = BS.length bs1
212220 void $ copy bufHeaderPayload bs1
213− fillFrameHeader FrameContinuation len' sid defaultFlags connWriteBuffer
221+ fillFrameHeader FrameContinuation kvlen' sid defaultFlags connWriteBuffer
214222 if bs2 == "" then
215− continue sid len' (B.More 0 writer)
223+ continue sid kvlen' (B.More 0 writer)
216224 else
217− continue sid len' (B.Chunk bs2 writer)
218−
219− -- True if the connection buffer has room for a 1-byte data frame.
220− canFitDataFrame total = total + frameHeaderLength < connBufferSize
225+ continue sid kvlen' (B.Chunk bs2 writer)
221226
222227 -- Re-enqueue the stream in the output queue.
223− maybeEnqueueNext :: Stream -> Maybe DynaNext -> BodyInfo -> IO ()
224− maybeEnqueueNext strm (Just next) binfo = do
225− let !out = ONext strm next binfo
226− enqueueOutput outputQ out
227− maybeEnqueueNext _ _ _ = return ()
228−
228+ maybeEnqueueNext :: Stream -> BodyInfo -> Maybe DynaNext -> IO ()
229+ maybeEnqueueNext _ _ Nothing = return ()
230+ maybeEnqueueNext strm binfo (Just next) = enqueueOutput outputQ out
231+ where
232+ !out = ONext strm binfo next
229233
230234 -- Send headers if there is not room for a 1-byte data frame, and return
231− -- the offset of the next frame's first header byte and whether the headers
232− -- still need to be sent.
233− sendHeadersIfNecessary total
234− | canFitDataFrame total = return (total, True)
235− | otherwise = do
236− flushN total
237− return (0, False)
238−
239− fillDataHeaderSend strm otherLen datPayloadLen mnext = do
235+ -- the offset of the next frame's first header byte.
236+ sendHeadersIfNecessary off
237+ -- True if the connection buffer has room for a 1-byte data frame.
238+ | off + frameHeaderLength < connBufferSize = return off
239+ | otherwise = do
240+ flushN off
241+ return 0
242+
243+ fillDataHeader strm off datPayloadLen mnext = do
240244 -- Data frame header
241− let sid = streamNumber strm
242− buf = connWriteBuffer `plusPtr` otherLen
243− total = otherLen + frameHeaderLength + datPayloadLen
245+ let !sid = streamNumber strm
246+ !buf = connWriteBuffer `plusPtr` off
247+ !off' = off + frameHeaderLength + datPayloadLen
244248 flag = case mnext of
245249 Nothing -> setEndStream defaultFlags
246250 _ -> defaultFlags
247251 fillFrameHeader FrameData datPayloadLen sid flag buf
248− -- "closed" must be before "connSendAll". If not,
249− -- the context would be switched to the receiver,
250− -- resulting the inconsistency of concurrency.
251− case mnext of
252− Nothing -> closed ctx strm Finished
253− _ -> return ()
254− flushN total
252+ when (isNothing mnext) $ closed ctx strm Finished
255253 atomically $ modifyTVar' connectionWindow (subtract datPayloadLen)
256254 atomically $ modifyTVar' (streamWindow strm) (subtract datPayloadLen)
255+ return off'
257256
258257 fillFrameHeader ftyp len sid flag buf = encodeFrameHeaderBuf ftyp hinfo buf
259258 where
260259 hinfo = FrameHeader len flag sid
261260
261+ ignore :: E.SomeException -> IO ()
262+ ignore _ = return ()
263+
262264----------------------------------------------------------------
263265
264266{-
@@ -274,7 +276,7 @@ fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
274276 let datBuf = connWriteBuffer `plusPtr` off
275277 room = min (connBufferSize - off) lim
276278 (len, signal) <- B.runBuilder bb datBuf room
277− return $ nextForBuilder connWriteBuffer connBufferSize len signal
279+ return $ nextForBuilder len signal
278280
279281#ifdef WINDOWS
280282fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
@@ -287,7 +289,8 @@ fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
287289 IO.hSeek h IO.AbsoluteSeek start
288290 len <- IO.hGetBufSome h datBuf (mini room bytes)
289291 let bytes' = bytes - fromIntegral len
290− return $ nextForFile len connWriteBuffer connBufferSize h bytes' (return ())
292+ -- fixme: connWriteBuffer connBufferSize
293+ return $ nextForFile len h bytes' (return ())
291294#else
292295fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
293296 ii off lim (ResponseFile _ _ path mpart) = do
@@ -303,7 +306,7 @@ fillResponseBodyGetNext Connection{connWriteBuffer,connBufferSize}
303306 len <- positionRead fd datBuf (mini room bytes) start
304307 refresh
305308 let len' = fromIntegral len
306− return $ nextForFile len connWriteBuffer connBufferSize fd (start + len') (bytes - len') refresh
309+ return $ nextForFile len fd (start + len') (bytes - len') refresh
307310#endif
308311
309312fillResponseBodyGetNext _ _ _ _ _ = error "fillResponseBodyGetNext"
@@ -321,12 +324,12 @@ fillStreamBodyGetNext Connection{connWriteBuffer,connBufferSize}
321324 let datBuf = connWriteBuffer `plusPtr` off
322325 room = min (connBufferSize - off) lim
323326 (leftover, cont, len) <- runStreamBuilder datBuf room sq
324− return $ nextForStream connWriteBuffer connBufferSize sq strm leftover cont len
327+ return $ nextForStream sq strm leftover cont len
325328
326329----------------------------------------------------------------
327330
328−fillBufBuilder :: Buffer -> BufSize -> Leftover -> DynaNext
329−fillBufBuilder buf0 siz0 leftover lim = do
331+fillBufBuilder :: Leftover -> DynaNext
332+fillBufBuilder leftover buf0 siz0 lim = do
330333 let payloadBuf = buf0 `plusPtr` frameHeaderLength
331334 room = min (siz0 - frameHeaderLength) lim
332335 case leftover of
@@ -345,15 +348,15 @@ fillBufBuilder buf0 siz0 leftover lim = do
345348 void $ copy payloadBuf bs1
346349 getNext room (B.Chunk bs2 writer)
347350 where
348− getNext l s = return $ nextForBuilder buf0 siz0 l s
351+ getNext l s = return $ nextForBuilder l s
349352
350−nextForBuilder :: Buffer -> BufSize -> BytesFilled -> B.Next -> Next
351−nextForBuilder _ _ len B.Done
353+nextForBuilder :: BytesFilled -> B.Next -> Next
354+nextForBuilder len B.Done
352355 = Next len Nothing
353−nextForBuilder buf siz len (B.More _ writer)
354− = Next len $ Just (fillBufBuilder buf siz (LOne writer))
355−nextForBuilder buf siz len (B.Chunk bs writer)
356− = Next len $ Just (fillBufBuilder buf siz (LTwo bs writer))
356+nextForBuilder len (B.More _ writer)
357+ = Next len $ Just (fillBufBuilder (LOne writer))
358+nextForBuilder len (B.Chunk bs writer)
359+ = Next len $ Just (fillBufBuilder (LTwo bs writer))
357360
358361----------------------------------------------------------------
359362
@@ -375,8 +378,8 @@ runStreamBuilder buf0 room0 sq = loop buf0 room0 0
375378 Just SFlush -> return (LZero, True, total)
376379 Just SFinish -> return (LZero, False, total)
377380
378−fillBufStream :: Buffer -> BufSize -> Leftover -> TBQueue Sequence -> Stream -> DynaNext
379−fillBufStream buf0 siz0 leftover0 sq strm lim0 = do
381+fillBufStream :: Leftover -> TBQueue Sequence -> Stream -> DynaNext
382+fillBufStream leftover0 sq strm buf0 siz0 lim0 = do
380383 let payloadBuf = buf0 `plusPtr` frameHeaderLength
381384 room0 = min (siz0 - frameHeaderLength) lim0
382385 case leftover0 of
@@ -394,7 +397,7 @@ fillBufStream buf0 siz0 leftover0 sq strm lim0 = do
394397 void $ copy payloadBuf bs1
395398 getNext (LTwo bs2 writer) True room0
396399 where
397− getNext l b r = return $ nextForStream buf0 siz0 sq strm l b r
400+ getNext l b r = return $ nextForStream sq strm l b r
398401 write writer1 buf room sofar = do
399402 (len, signal) <- writer1 buf room
400403 case signal of
@@ -409,45 +412,45 @@ fillBufStream buf0 siz0 leftover0 sq strm lim0 = do
409412 let !total = sofar + len
410413 getNext (LTwo bs writer) True total
411414
412−nextForStream :: Buffer -> BufSize -> TBQueue Sequence -> Stream
415+nextForStream :: TBQueue Sequence -> Stream
413416 -> Leftover -> Bool -> BytesFilled
414417 -> Next
415−nextForStream _ _ _ _ _ False len = Next len Nothing
416−nextForStream buf siz sq strm leftOrZero True len =
417− Next len $ Just (fillBufStream buf siz leftOrZero sq strm)
418+nextForStream _ _ _ False len = Next len Nothing
419+nextForStream sq strm leftOrZero True len =
420+ Next len $ Just (fillBufStream leftOrZero sq strm)
418421
419422----------------------------------------------------------------
420423
421424#ifdef WINDOWS
422−fillBufFile :: Buffer -> BufSize -> IO.Handle -> Integer -> IO () -> DynaNext
423−fillBufFile buf siz h bytes refresh lim = do
425+fillBufFile :: IO.Handle -> Integer -> IO () -> DynaNext
426+fillBufFile h bytes refresh buf siz lim = do
424427 let payloadBuf = buf `plusPtr` frameHeaderLength
425428 room = min (siz - frameHeaderLength) lim
426429 len <- IO.hGetBufSome h payloadBuf room
427430 refresh
428431 let bytes' = bytes - fromIntegral len
429− return $ nextForFile len buf siz h bytes' refresh
432+ return $ nextForFile len h bytes' refresh
430433
431−nextForFile :: BytesFilled -> Buffer -> BufSize -> IO.Handle -> Integer -> IO () -> Next
432−nextForFile 0 _ _ _ _ _ = Next 0 Nothing
433−nextForFile len _ _ _ 0 _ = Next len Nothing
434−nextForFile len buf siz h bytes refresh =
435− Next len $ Just (fillBufFile buf siz h bytes refresh)
434+nextForFile :: BytesFilled -> IO.Handle -> Integer -> IO () -> Next
435+nextForFile 0 _ _ _ = Next 0 Nothing
436+nextForFile len _ 0 _ = Next len Nothing
437+nextForFile len h bytes refresh =
438+ Next len $ Just (fillBufFile h bytes refresh)
436439#else
437−fillBufFile :: Buffer -> BufSize -> Fd -> Integer -> Integer -> IO () -> DynaNext
438−fillBufFile buf siz fd start bytes refresh lim = do
440+fillBufFile :: Fd -> Integer -> Integer -> IO () -> DynaNext
441+fillBufFile fd start bytes refresh buf siz lim = do
439442 let payloadBuf = buf `plusPtr` frameHeaderLength
440443 room = min (siz - frameHeaderLength) lim
441444 len <- positionRead fd payloadBuf (mini room bytes) start
442445 let len' = fromIntegral len
443446 refresh
444− return $ nextForFile len buf siz fd (start + len') (bytes - len') refresh
447+ return $ nextForFile len fd (start + len') (bytes - len') refresh
445448
446−nextForFile :: BytesFilled -> Buffer -> BufSize -> Fd -> Integer -> Integer -> IO () -> Next
447−nextForFile 0 _ _ _ _ _ _ = Next 0 Nothing
448−nextForFile len _ _ _ _ 0 _ = Next len Nothing
449−nextForFile len buf siz fd start bytes refresh =
450− Next len $ Just (fillBufFile buf siz fd start bytes refresh)
449+nextForFile :: BytesFilled -> Fd -> Integer -> Integer -> IO () -> Next
450+nextForFile 0 _ _ _ _ = Next 0 Nothing
451+nextForFile len _ _ 0 _ = Next len Nothing
452+nextForFile len fd start bytes refresh =
453+ Next len $ Just (fillBufFile fd start bytes refresh)
451454#endif
452455
453456mini :: Int -> Integer -> Int