on master help sign in
Disable chunking for HTTP 1.0 connections
689ddc9Michael Snoyman
Network/Wai/Handler/Warp.hs+8−3
@@ -32,7 +32,7 @@ import Control.Exception (bracket, finally, Exception, throwIO)
32import System.IO (Handle, hClose, hFlush)
32import System.IO (Handle, hClose, hFlush)
33import System.IO.Error (isEOFError, ioeGetHandle)
33import System.IO.Error (isEOFError, ioeGetHandle)
34import Control.Concurrent (forkIO)
34import Control.Concurrent (forkIO)
35−import Control.Monad (unless)
35+import Control.Monad (unless, when)
36import Data.Maybe (fromMaybe)
36import Data.Maybe (fromMaybe)
37
37
38import Data.Typeable (Typeable)
38import Data.Typeable (Typeable)
@@ -79,7 +79,7 @@ serveConnection port app conn remoteHost' = do
79 sendResponse (httpVersion env) conn res
79 sendResponse (httpVersion env) conn res
80 -- FIXME drain request body
80 -- FIXME drain request body
81 hFlush conn
81 hFlush conn
82− serveConnection'
82+ when (isChunked $ httpVersion env) serveConnection'
83
83
84 catchEOFError :: IOError -> IO ()
84 catchEOFError :: IOError -> IO ()
85 catchEOFError e | isEOFError e = case ioeGetHandle e of
85 catchEOFError e | isEOFError e = case ioeGetHandle e of
@@ -175,7 +175,9 @@ headers httpversion status responseHeaders = mconcat
175 , fromByteString $ statusMessage status
175 , fromByteString $ statusMessage status
176 , fromByteString "\r\n"
176 , fromByteString "\r\n"
177 , mconcat $ map go responseHeaders
177 , mconcat $ map go responseHeaders
178+ , if isChunked httpversion
178− , fromByteString "Transfer-Encoding: chunked\r\n\r\n" -- FIXME perhaps put in non-chunked for HTTP 1.0 clients?
179+ then fromByteString "Transfer-Encoding: chunked\r\n\r\n"
180+ else fromByteString "\r\n"
179 ]
181 ]
180 where
182 where
181 go (x, y) = mconcat
183 go (x, y) = mconcat
@@ -185,6 +187,9 @@ headers httpversion status responseHeaders = mconcat
185 , fromByteString "\r\n"
187 , fromByteString "\r\n"
186 ]
188 ]
187
189
190+isChunked :: HttpVersion -> Bool
191+isChunked = (==) http11
192+
188sendResponse :: HttpVersion -> Handle -> Response -> IO ()
193sendResponse :: HttpVersion -> Handle -> Response -> IO ()
189sendResponse hv handle res = do
194sendResponse hv handle res = do
190 responseEnumerator res $ \s hs ->
195 responseEnumerator res $ \s hs ->