@@ -36,6 +36,7 @@ module Network.Wai.Handler.Warp
3636 , settingsTimeout
3737 , settingsIntercept
3838 , settingsManager
39+ , settingsRechunking
3940 -- * Datatypes
4041 , Port
4142 , InvalidRequest (..)
@@ -94,7 +95,7 @@ import Blaze.ByteString.Builder.Enumerator (builderToByteString)
9495import Blaze.ByteString.Builder.HTTP
9596 (chunkedTransferEncoding, chunkedTransferTerminator)
9697import Blaze.ByteString.Builder
97− (copyByteString, Builder, toLazyByteString, toByteStringIO)
98+ (copyByteString, Builder, toLazyByteString, toByteStringIO, toByteString)
9899import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)
99100import Data.Monoid (mappend, mconcat)
100101import Network.Sendfile
@@ -212,7 +213,7 @@ serveConnection settings th onException port app conn remoteHost' = do
212213 liftIO $ T.pause th
213214 res <- E.joinI $ EB.isolate len $$ app env
214215 liftIO $ T.resume th
215− keepAlive <- liftIO $ sendResponse th env conn res
216+ keepAlive <- liftIO $ sendResponse settings th env conn res
216217 if keepAlive then serveConnection' else return ()
217218 Just intercept -> do
218219 liftIO $ T.pause th
@@ -354,9 +355,10 @@ hasBody :: H.Status -> Request -> Bool
354355hasBody s req = s /= (H.Status 204 "") && s /= H.status304 &&
355356 H.statusCode s >= 200 && requestMethod req /= "HEAD"
356357
357−sendResponse :: T.Handle
358+sendResponse :: Settings
359+ -> T.Handle
358360 -> Request -> Socket -> Response -> IO Bool
359−sendResponse th req socket (ResponseFile s hs fp mpart) = do
361+sendResponse _ th req socket (ResponseFile s hs fp mpart) = do
360362 (hs', cl) <-
361363 case (readInt `fmap` lookup "content-length" hs, mpart) of
362364 (Just cl, _) -> return (hs, cl)
@@ -382,7 +384,7 @@ sendResponse th req socket (ResponseFile s hs fp mpart) = do
382384 T.tickle th
383385 return isPersist
384386 else return isPersist
385−sendResponse th req socket (ResponseBuilder s hs b)
387+sendResponse _ th req socket (ResponseBuilder s hs b)
386388 | hasBody s req = do
387389 toByteStringIO (\bs -> do
388390 Sock.sendAll socket bs
@@ -406,7 +408,7 @@ sendResponse th req socket (ResponseBuilder s hs b)
406408 isChunked' = isChunked (httpVersion req) && not hasLength
407409 isPersist = checkPersist req
408410 isKeepAlive = isPersist && (isChunked' || hasLength)
409−sendResponse th req socket (ResponseEnumerator res) =
411+sendResponse settings th req socket (ResponseEnumerator res) =
410412 res go
411413 where
412414 -- FIXME perhaps alloca a buffer per thread and reuse that in all functiosn below. Should lessen greatly the GC burden (I hope)
@@ -417,7 +419,9 @@ sendResponse th req socket (ResponseEnumerator res) =
417419 return (checkPersist req)
418420 go s hs = chunk'
419421 $ E.enumList 1 [headers (httpVersion req) s hs isChunked']
420− $$ E.joinI $ builderToByteString -- FIXME unsafeBuilderToByteString
422+ $$ E.joinI $ ( if settingsRechunking settings
423+ then builderToByteString -- FIXME unsafeBuilderToByteString
424+ else EL.map toByteString )
421425 $$ (iterSocket th socket >> return isKeepAlive)
422426 where
423427 hasLength = lookup "content-length" hs /= Nothing
@@ -489,6 +493,7 @@ data Settings = Settings
489493 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
490494 , settingsIntercept :: Request -> Maybe (Socket -> E.Iteratee S.ByteString IO ())
491495 , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'
496+ , settingsRechunking :: Bool -- ^ Should warp re-chunk response builder or not.
492497 }
493498
494499-- | The default settings for the Warp server. See the individual settings for
@@ -507,6 +512,7 @@ defaultSettings = Settings
507512 , settingsTimeout = 30
508513 , settingsIntercept = const Nothing
509514 , settingsManager = Nothing
515+ , settingsRechunking = True
510516 }
511517 where
512518 go :: InvalidRequest -> IO ()