@@ -38,6 +38,7 @@ import Data.Typeable (Typeable)
39import Network.Socket.SendFile
39import Network.Socket.SendFile
40import Control.Arrow (first)
40import Control.Arrow (first)
41+import Numeric (showHex)
42run :: Port -> Application -> IO ()
43run :: Port -> Application -> IO ()
43run port = withSocketsDo .
44run port = withSocketsDo .
@@ -154,14 +155,23 @@ sendResponse httpversion h res = do
154 B.hPut h $ statusMessage $ status res
155 B.hPut h $ statusMessage $ status res
155 B.hPut h $ B.pack "\r\n"
156 B.hPut h $ B.pack "\r\n"
156 mapM_ putHeader $ responseHeaders res
157 mapM_ putHeader $ responseHeaders res
158+ case responseBody res of
159+ ResponseFile _ -> return ()
160+ _ -> B.hPut h $ B.pack "Transfer-Encoding: chunked\r\n"
157 B.hPut h $ B.pack "\r\n"
161 B.hPut h $ B.pack "\r\n"
158 case responseBody res of
162 case responseBody res of
159 ResponseFile fp -> unsafeSendFile h fp
163 ResponseFile fp -> unsafeSendFile h fp
160− ResponseEnumerator (Enumerator enum) -> enum myPut h >> return ()
164+ ResponseEnumerator (Enumerator enum) ->
165+ enum (const myPut) h >> return ()
161− ResponseLBS lbs -> L.hPut h lbs
166+ ResponseLBS lbs -> mapM_ myPut $ L.toChunks lbs
167+ case responseBody res of
168+ ResponseFile _ -> return ()
169+ _ -> B.hPut h $ B.pack "0\r\n"
163− myPut _ bs = do
171+ myPut bs = do
172+ B.hPut h $ B.pack $ showHex (B.length bs) "\r\n"
164 B.hPut h bs
173 B.hPut h bs
174+ B.hPut h $ B.pack "\r\n"
165 return (Right h)
175 return (Right h)
166 putHeader (x, y) = do
176 putHeader (x, y) = do
167 B.hPut h $ ciOriginal x
177 B.hPut h $ ciOriginal x