@@ -108,6 +108,7 @@ import System.IO (hPrint, stderr)
108108import ReadInt (readInt64)
109109import qualified Data.IORef as I
110110import Data.Conduit.Network (bindPort, HostPreference (HostIPv4))
111+import Network.HTTP.Conduit.Chunk (chunkedConduit)
111112
112113#if WINDOWS
113114import Control.Concurrent (threadDelay)
@@ -271,6 +272,17 @@ ibsIsolate ibs@(IsolatedBSSource ref) =
271272ibsDone :: IsolatedBSSource -> IO (C.Source (ResourceT IO) ByteString)
272273ibsDone (IsolatedBSSource ref) = fmap snd $ I.readIORef ref
273274
275+refSource :: MonadIO m => I.IORef (C.Source m a) -> C.Source m a
276+refSource ref = C.PipeM pull (return ())
277+ where
278+ pull = do
279+ src <- liftIO $ I.readIORef ref
280+ (src', ma) <- src C.$$+ CL.head
281+ liftIO $ I.writeIORef ref src'
282+ case ma of
283+ Nothing -> return $ C.Done Nothing ()
284+ Just a -> return $ C.HaveOutput (refSource ref) (return ()) a
285+
274286serveConnection :: Settings
275287 -> T.Handle
276288 -> Port -> Application -> Connection -> SockAddr-> IO ()
@@ -283,7 +295,7 @@ serveConnection settings th port app conn remoteHost' =
283295 serveConnection'' fromClient
284296
285297 serveConnection'' fromClient = do
286− (env, ibs) <- parseRequest conn port remoteHost' fromClient
298+ (env, getSource) <- parseRequest conn port remoteHost' fromClient
287299 case settingsIntercept settings env of
288300 Nothing -> do
289301 -- Let the application run for as long as it wants
@@ -291,20 +303,20 @@ serveConnection settings th port app conn remoteHost' =
291303 res <- app env
292304
293305 -- flush the rest of the request body
294− ibsIsolate ibs C.$$ CL.sinkNull
295− fromClient' <- liftIO $ ibsDone ibs
306+ requestBody env C.$$ CL.sinkNull
307+ fromClient' <- liftIO getSource
296308
297309 liftIO $ T.resume th
298310 keepAlive <- sendResponse th env conn res
299311 when keepAlive $ serveConnection'' fromClient'
300312 Just intercept -> do
301313 liftIO $ T.pause th
302− fromClient' <- liftIO $ ibsDone ibs
314+ fromClient' <- liftIO getSource
303315 intercept fromClient' conn
304316
305317parseRequest :: Connection -> Port -> SockAddr
306318 -> C.Source (ResourceT IO) S.ByteString
307− -> ResourceT IO (Request, IsolatedBSSource)
319+ -> ResourceT IO (Request, IO (C.Source (ResourceT IO) ByteString))
308320parseRequest conn port remoteHost' src1 = do
309321 (src2, headers') <- src1 C.$$+ takeHeaders
310322 parseRequest' conn port headers' remoteHost' src2
@@ -344,7 +356,7 @@ parseRequest' :: Connection
344356 -> [ByteString]
345357 -> SockAddr
346358 -> C.Source (ResourceT IO) S.ByteString -- FIXME was buffered
347− -> ResourceT IO (Request, IsolatedBSSource)
359+ -> ResourceT IO (Request, IO (C.Source (ResourceT IO) ByteString))
348360parseRequest' _ _ [] _ _ = throwIO $ NotEnoughLines []
349361parseRequest' conn port (firstLine:otherLines) remoteHost' src = do
350362 (method, rpath', gets, httpversion) <- parseFirst firstLine
@@ -361,9 +373,17 @@ parseRequest' conn port (firstLine:otherLines) remoteHost' src = do
361373 Nothing -> 0
362374 Just bs -> readInt bs
363375 let serverName' = takeUntil 58 host -- ':'
364− (rbody, ibs) <- liftIO $ do
365− ibs <- fmap IsolatedBSSource $ I.newIORef (len0, src)
366− return (ibsIsolate ibs, ibs)
376+ let chunked = maybe False (=="chunked")
377+ $ lookup "transfer-encoding" heads
378+ (rbody, getSource) <- liftIO $
379+ if chunked
380+ then do
381+ ref <- I.newIORef (src C.$= chunkedConduit False)
382+ return (refSource ref, I.readIORef ref)
383+ else do
384+ ibs <- fmap IsolatedBSSource $ I.newIORef (len0, src)
385+ return (ibsIsolate ibs, ibsDone ibs)
386+
367387 return (Request
368388 { requestMethod = method
369389 , httpVersion = httpversion
@@ -378,7 +398,7 @@ parseRequest' conn port (firstLine:otherLines) remoteHost' src = do
378398 , remoteHost = remoteHost'
379399 , requestBody = rbody
380400 , vault = mempty
381− }, ibs)
401+ }, getSource)
382402
383403
384404takeUntil :: Word8 -> ByteString -> ByteString