@@ -16,6 +16,8 @@
1616---------------------------------------------------------
1717module Network.Wai.Handler.SimpleServer
1818 ( run
19+ , sendResponse
20+ , parseRequest
1921 ) where
2022
2123import Network.Wai
@@ -36,7 +38,6 @@ import Data.Maybe (isJust, fromJust, fromMaybe)
3638
3739import Data.Typeable (Typeable)
3840
39−import Network.Socket.SendFile
4041import Control.Arrow (first)
4142import Numeric (showHex)
4243
@@ -61,14 +62,14 @@ serveConnection port app conn remoteHost' =
6162 (hClose conn)
6263 where
6364 serveConnection' = do
64− env <- hParseRequest port conn remoteHost'
65+ env <- parseRequest port conn remoteHost'
6566 res <- app env
6667 sendResponse (httpVersion env) conn res
6768
68−hParseRequest :: Port -> Handle -> String -> IO Request
69−hParseRequest port conn remoteHost' = do
69+parseRequest :: Port -> Handle -> String -> IO Request
70+parseRequest port conn remoteHost' = do
7071 headers' <- takeUntilBlank conn id
71− parseRequest port headers' conn remoteHost'
72+ parseRequest' port headers' conn remoteHost'
7273
7374takeUntilBlank :: Handle
7475 -> ([ByteString] -> [ByteString])
@@ -94,12 +95,12 @@ data InvalidRequest =
9495instance Exception InvalidRequest
9596
9697-- | Parse a set of header lines and body into a 'Request'.
97−parseRequest :: Port
98− -> [ByteString]
99− -> Handle
100− -> String
101− -> IO Request
102−parseRequest port lines' handle remoteHost' = do
98+parseRequest' :: Port
99+ -> [ByteString]
100+ -> Handle
101+ -> String
102+ -> IO Request
103+parseRequest' port lines' handle remoteHost' = do
103104 case lines' of
104105 (_:_:_) -> return ()
105106 _ -> throwIO $ NotEnoughLines $ map B.unpack lines'
@@ -155,21 +156,19 @@ sendResponse httpversion h res = do
155156 B.hPut h $ statusMessage $ status res
156157 B.hPut h $ B.pack "\r\n"
157158 mapM_ putHeader $ responseHeaders res
159+ B.hPut h $ B.pack "Transfer-Encoding: chunked\r\n\r\n"
158160 case responseBody res of
159− ResponseFile _ -> return ()
160− _ -> B.hPut h $ B.pack "Transfer-Encoding: chunked\r\n"
161− B.hPut h $ B.pack "\r\n"
162− case responseBody res of
163− ResponseFile fp -> unsafeSendFile h fp
161+ ResponseFile fp -> do
162+ -- FIXME this is lazy I/O
163+ lbs <- L.readFile fp
164+ mapM_ myPut $ L.toChunks lbs
164165 ResponseEnumerator (Enumerator enum) ->
165166 enum (const myPut) h >> return ()
166167 ResponseLBS lbs -> mapM_ myPut $ L.toChunks lbs
167− case responseBody res of
168− ResponseFile _ -> return ()
169− _ -> B.hPut h $ B.pack "0\r\n"
168+ B.hPut h $ B.pack "0\r\n\r\n"
170169 where
171170 myPut bs = do
172− B.hPut h $ B.pack $ showHex (B.length bs) "\r\n"
171+ B.hPut h $ B.pack $ showHex (B.length bs) " \r\n"
173172 B.hPut h bs
174173 B.hPut h $ B.pack "\r\n"
175174 return (Right h)