@@ -107,6 +107,7 @@ import System.IO (hPrint, stderr)
107107import ReadInt (readInt64)
108108import qualified Data.IORef as I
109109import Data.Conduit.Network (bindPort, HostPreference (HostIPv4))
110+import Network.HTTP.Conduit.Chunk (chunkedConduit)
110111
111112#if WINDOWS
112113import Control.Concurrent (threadDelay)
@@ -269,6 +270,17 @@ ibsIsolate ibs@(IsolatedBSSource ref) =
269270ibsDone :: IsolatedBSSource -> IO (C.Source (ResourceT IO) ByteString)
270271ibsDone (IsolatedBSSource ref) = fmap snd $ I.readIORef ref
271272
273+refSource :: MonadIO m => I.IORef (C.Source m a) -> C.Source m a
274+refSource ref = C.PipeM pull (return ())
275+ where
276+ pull = do
277+ src <- liftIO $ I.readIORef ref
278+ (src', ma) <- src C.$$+ CL.head
279+ liftIO $ I.writeIORef ref src'
280+ case ma of
281+ Nothing -> return $ C.Done Nothing ()
282+ Just a -> return $ C.HaveOutput (refSource ref) (return ()) a
283+
272284serveConnection :: Settings
273285 -> T.Handle
274286 -> (SomeException -> IO ())
@@ -286,7 +298,7 @@ serveConnection settings th onException port app conn remoteHost' =
286298 serveConnection'' fromClient
287299
288300 serveConnection'' fromClient = do
289− (env, ibs) <- parseRequest conn port remoteHost' fromClient
301+ (env, getSource) <- parseRequest conn port remoteHost' fromClient
290302 case settingsIntercept settings env of
291303 Nothing -> do
292304 -- Let the application run for as long as it wants
@@ -294,20 +306,20 @@ serveConnection settings th onException port app conn remoteHost' =
294306 res <- app env
295307
296308 -- flush the rest of the request body
297− ibsIsolate ibs C.$$ CL.sinkNull
298− fromClient' <- liftIO $ ibsDone ibs
309+ requestBody env C.$$ CL.sinkNull
310+ fromClient' <- liftIO getSource
299311
300312 liftIO $ T.resume th
301313 keepAlive <- sendResponse th env conn res
302314 when keepAlive $ serveConnection'' fromClient'
303315 Just intercept -> do
304316 liftIO $ T.pause th
305− fromClient' <- liftIO $ ibsDone ibs
317+ fromClient' <- liftIO getSource
306318 intercept fromClient' conn
307319
308320parseRequest :: Connection -> Port -> SockAddr
309321 -> C.Source (ResourceT IO) S.ByteString
310− -> ResourceT IO (Request, IsolatedBSSource)
322+ -> ResourceT IO (Request, IO (C.Source (ResourceT IO) ByteString))
311323parseRequest conn port remoteHost' src1 = do
312324 (src2, headers') <- src1 C.$$+ takeHeaders
313325 parseRequest' conn port headers' remoteHost' src2
@@ -347,7 +359,7 @@ parseRequest' :: Connection
347359 -> [ByteString]
348360 -> SockAddr
349361 -> C.Source (ResourceT IO) S.ByteString -- FIXME was buffered
350− -> ResourceT IO (Request, IsolatedBSSource)
362+ -> ResourceT IO (Request, IO (C.Source (ResourceT IO) ByteString))
351363parseRequest' _ _ [] _ _ = throwIO $ NotEnoughLines []
352364parseRequest' conn port (firstLine:otherLines) remoteHost' src = do
353365 (method, rpath', gets, httpversion) <- parseFirst firstLine
@@ -364,9 +376,17 @@ parseRequest' conn port (firstLine:otherLines) remoteHost' src = do
364376 Nothing -> 0
365377 Just bs -> readInt bs
366378 let serverName' = takeUntil 58 host -- ':'
367− (rbody, ibs) <- liftIO $ do
368− ibs <- fmap IsolatedBSSource $ I.newIORef (len0, src)
369− return (ibsIsolate ibs, ibs)
379+ let chunked = maybe False (=="chunked")
380+ $ lookup "transfer-encoding" heads
381+ (rbody, getSource) <- liftIO $
382+ if chunked
383+ then do
384+ ref <- I.newIORef (src C.$= chunkedConduit False)
385+ return (refSource ref, I.readIORef ref)
386+ else do
387+ ibs <- fmap IsolatedBSSource $ I.newIORef (len0, src)
388+ return (ibsIsolate ibs, ibsDone ibs)
389+
370390 return (Request
371391 { requestMethod = method
372392 , httpVersion = httpversion
@@ -381,7 +401,7 @@ parseRequest' conn port (firstLine:otherLines) remoteHost' src = do
381401 , remoteHost = remoteHost'
382402 , requestBody = rbody
383403 , vault = mempty
384− }, ibs)
404+ }, getSource)
385405
386406
387407takeUntil :: Word8 -> ByteString -> ByteString