@@ -75,6 +75,7 @@ serveConnection port app conn remoteHost' = do
7575 env <- parseRequest port conn remoteHost'
7676 res <- app env
7777 sendResponse (httpVersion env) conn res
78+ -- FIXME drain request body
7879 hFlush conn
7980 serveConnection'
8081
@@ -106,7 +107,6 @@ stripCR bs
106107
107108data InvalidRequest =
108109 NotEnoughLines [String]
109− | HostNotIncluded
110110 | BadFirstLine String
111111 | NonHttp
112112 deriving (Show, Typeable)
@@ -119,15 +119,16 @@ parseRequest' :: Port
119119 -> String
120120 -> IO Request
121121parseRequest' port lines' handle remoteHost' = do
122− case lines' of
123− (_:_) -> return ()
124− _ -> throwIO $ NotEnoughLines $ map B.unpack lines'
125− (method, rpath', gets, httpversion) <- parseFirst $ head lines'
122+ (firstLine, otherLines) <-
123+ case lines' of
124+ x:xs -> return (x, xs)
125+ [] -> throwIO $ NotEnoughLines $ map B.unpack lines'
126+ (method, rpath', gets, httpversion) <- parseFirst firstLine
126127 let rpath = '/' : case B.unpack rpath' of
127128 ('/':x) -> x
128129 _ -> B.unpack rpath'
129− let heads = map (first mkCIByteString . parseHeaderNoAttr) $ tail lines'
130− host <- maybe (throwIO HostNotIncluded) return $ lookup "host" heads
130+ let heads = map (first mkCIByteString . parseHeaderNoAttr) otherLines
131+ let host = fromMaybe "" $ lookup "host" heads
131132 let len = fromMaybe 0 $ do
132133 bs <- lookup "Content-Length" heads
133134 let str = B.unpack bs
@@ -172,7 +173,7 @@ headers httpversion status responseHeaders = mconcat
172173 , fromByteString $ statusMessage status
173174 , fromByteString "\r\n"
174175 , mconcat $ map go responseHeaders
175− , fromByteString "Transfer-Encoding: chunked\r\n\r\n"
176+ , fromByteString "Transfer-Encoding: chunked\r\n\r\n" -- FIXME perhaps put in non-chunked for HTTP 1.0 clients?
176177 ]
177178 where
178179 go (x, y) = mconcat