@@ -268,7 +268,7 @@ serveConnection settings th onException port app conn remoteHost' =
268268 serveConnection'' fromClient
269269
270270 serveConnection'' fromClient = do
271− env <- parseRequest port remoteHost' fromClient
271+ (flushBody, env) <- parseRequest port remoteHost' fromClient
272272 case settingsIntercept settings env of
273273 Nothing -> do
274274 -- Let the application run for as long as it wants
@@ -276,7 +276,7 @@ serveConnection settings th onException port app conn remoteHost' =
276276 res <- app env
277277
278278 -- flush the rest of the request body
279− requestBody env C.$$ CL.sinkNull
279+ flushBody
280280
281281 liftIO $ T.resume th
282282 keepAlive <- sendResponse th env conn res
@@ -287,7 +287,7 @@ serveConnection settings th onException port app conn remoteHost' =
287287
288288parseRequest :: Port -> SockAddr
289289 -> C.BufferedSource IO S.ByteString
290− -> ResourceT IO Request
290+ -> ResourceT IO (ResourceT IO (), Request)
291291parseRequest port remoteHost' src = do
292292 headers' <- src C.$$ takeHeaders
293293 parseRequest' port headers' remoteHost' src
@@ -311,7 +311,7 @@ parseRequest' :: Port
311311 -> [ByteString]
312312 -> SockAddr
313313 -> C.BufferedSource IO S.ByteString
314− -> ResourceT IO Request
314+ -> ResourceT IO (ResourceT IO (), Request)
315315parseRequest' _ [] _ _ = throwIO $ NotEnoughLines []
316316parseRequest' port (firstLine:otherLines) remoteHost' src = do
317317 (method, rpath', gets, httpversion) <- parseFirst firstLine
@@ -326,11 +326,9 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do
326326 Nothing -> 0
327327 Just bs -> readInt bs
328328 let serverName' = takeUntil 58 host -- ':'
329− -- FIXME isolate takes an Integer instead of Int or Int64. If this is a
330− -- performance penalty, we may need our own version.
331− rbody <-
329+ (flush', rbody) <-
332330 if len0 == 0
333− then return mempty
331+ then return (return (), mempty)
334332 else do
335333 -- We can't use the standard isolate, as its counter is not
336334 -- kept in a mutable variable.
@@ -345,8 +343,23 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do
345343 then C.Finished (if S.null b then Nothing else Just b) (if S.null a then [] else [a])
346344 else C.Producing isolate [a]
347345 close = return []
348− return $ src C.$= isolate
349− return Request
346+
347+ binDrop i0 = C.sinkState i0 pushS closeS
348+ pushS i bs
349+ | S.length bs > i =
350+ return $ C.StateDone (Just $ S.drop i bs) ()
351+ | S.length bs == 0 =
352+ return $ C.StateDone Nothing ()
353+ | otherwise =
354+ return $ C.StateProcessing $ i - S.length bs
355+ closeS _ = return ()
356+ flush' = do
357+ len <- liftIO $ I.readIORef lenRef
358+ if len > 0
359+ then src C.$$ binDrop len
360+ else return ()
361+ return (flush', src C.$= isolate)
362+ return (flush', Request
350363 { requestMethod = method
351364 , httpVersion = httpversion
352365 , pathInfo = H.decodePathSegments rpath
@@ -360,7 +373,7 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do
360373 , remoteHost = remoteHost'
361374 , requestBody = rbody
362375 , vault = mempty
363− }
376+ })
364377
365378
366379takeUntil :: Word8 -> ByteString -> ByteString