@@ -16,6 +16,8 @@
16---------------------------------------------------------
16---------------------------------------------------------
17module Network.Wai.Handler.SimpleServer
17module Network.Wai.Handler.SimpleServer
21import Network.Wai
23import Network.Wai
@@ -36,7 +38,6 @@ import Data.Maybe (isJust, fromJust, fromMaybe)
37import Data.Typeable (Typeable)
39import Data.Typeable (Typeable)
39−import Network.Socket.SendFile
40import Control.Arrow (first)
41import Control.Arrow (first)
41import Numeric (showHex)
42import Numeric (showHex)
@@ -61,14 +62,14 @@ serveConnection port app conn remoteHost' =
61 (hClose conn)
62 (hClose conn)
63 serveConnection' = do
64 serveConnection' = do
64− env <- hParseRequest port conn remoteHost'
65+ env <- parseRequest port conn remoteHost'
65 res <- app env
66 res <- app env
66 sendResponse (httpVersion env) conn res
67 sendResponse (httpVersion env) conn res
68−hParseRequest :: Port -> Handle -> String -> IO Request
69+parseRequest :: Port -> Handle -> String -> IO Request
69−hParseRequest port conn remoteHost' = do
70+parseRequest port conn remoteHost' = do
70 headers' <- takeUntilBlank conn id
71 headers' <- takeUntilBlank conn id
71− parseRequest port headers' conn remoteHost'
72+ parseRequest' port headers' conn remoteHost'
73takeUntilBlank :: Handle
74takeUntilBlank :: Handle
74 -> ([ByteString] -> [ByteString])
75 -> ([ByteString] -> [ByteString])
@@ -94,12 +95,12 @@ data InvalidRequest =
94instance Exception InvalidRequest
95instance Exception InvalidRequest
96-- | Parse a set of header lines and body into a 'Request'.
97-- | Parse a set of header lines and body into a 'Request'.
97−parseRequest :: Port
98+parseRequest' :: Port
98− -> [ByteString]
99+ -> [ByteString]
99− -> Handle
100+ -> Handle
100− -> String
101+ -> String
101− -> IO Request
102+ -> IO Request
102−parseRequest port lines' handle remoteHost' = do
103+parseRequest' port lines' handle remoteHost' = do
103 case lines' of
104 case lines' of
104 (_:_:_) -> return ()
105 (_:_:_) -> return ()
105 _ -> throwIO $ NotEnoughLines $ map B.unpack lines'
106 _ -> throwIO $ NotEnoughLines $ map B.unpack lines'
@@ -155,21 +156,19 @@ sendResponse httpversion h res = do
155 B.hPut h $ statusMessage $ status res
156 B.hPut h $ statusMessage $ status res
156 B.hPut h $ B.pack "\r\n"
157 B.hPut h $ B.pack "\r\n"
157 mapM_ putHeader $ responseHeaders res
158 mapM_ putHeader $ responseHeaders res
159+ B.hPut h $ B.pack "Transfer-Encoding: chunked\r\n\r\n"
158 case responseBody res of
160 case responseBody res of
159− ResponseFile _ -> return ()
161+ ResponseFile fp -> do
160− _ -> B.hPut h $ B.pack "Transfer-Encoding: chunked\r\n"
162+ -- FIXME this is lazy I/O
161− B.hPut h $ B.pack "\r\n"
163+ lbs <- L.readFile fp
162− case responseBody res of
164+ mapM_ myPut $ L.toChunks lbs
163− ResponseFile fp -> unsafeSendFile h fp
164 ResponseEnumerator (Enumerator enum) ->
165 ResponseEnumerator (Enumerator enum) ->
165 enum (const myPut) h >> return ()
166 enum (const myPut) h >> return ()
166 ResponseLBS lbs -> mapM_ myPut $ L.toChunks lbs
167 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"
171 myPut bs = do
170 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"
173 B.hPut h bs
172 B.hPut h bs
174 B.hPut h $ B.pack "\r\n"
173 B.hPut h $ B.pack "\r\n"
175 return (Right h)
174 return (Right h)