@@ -87,6 +87,8 @@ import qualified Timeout as T
8787import Data.Word (Word8)
8888import Data.List (foldl')
8989import Control.Monad (forever)
90+import qualified Network.HTTP.Types as H
91+import qualified Data.Ascii as A
9092
9193#if WINDOWS
9294import Control.Concurrent (threadDelay)
@@ -149,6 +151,7 @@ serveConnections' set app socket = do
149151 tm <- T.initialize $ settingsTimeout set * 1000000
150152 forever $ do
151153 (conn, sa) <- accept socket
154+ putStrLn "Accepted a connection"
152155 _ <- forkIO $ do
153156 th <- T.registerKillThread tm
154157 serveConnection th onE port app conn sa
@@ -214,19 +217,22 @@ parseRequest' port (firstLine:otherLines) remoteHost' = do
214217 then S.breakByte 47 $ S.drop 7 rpath' -- '/'
215218 else ("", rpath')
216219 let heads = map parseHeaderNoAttr otherLines
217− let host = fromMaybe host' $ lookup "host" heads
220+ let host = A.toByteString $ fromMaybe (A.unsafeFromByteString host')
221+ $ lookup "host" heads
218222 let len =
219223 case lookup "content-length" heads of
220224 Nothing -> 0
221− Just bs -> fromIntegral $ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0 $ B.takeWhile C.isDigit bs
225+ Just bs -> fromIntegral $ B.foldl' (\i c -> i * 10 + C.digitToInt c) 0 $ B.takeWhile C.isDigit $ A.toByteString bs
222226 let serverName' = takeUntil 58 host -- ':'
223227 -- FIXME isolate takes an Integer instead of Int or Int64. If this is a
224228 -- performance penalty, we may need our own version.
225229 return (EB.isolate len, Request
226− { requestMethod = method
230+ { requestMethod = A.unsafeFromByteString method
227231 , httpVersion = httpversion
228− , pathInfo = rpath
229− , queryString = gets
232+ , pathInfo = H.decodePathSegments rpath
233+ , rawPathInfo = rpath
234+ , rawQueryString = gets
235+ , queryString = H.parseQuery gets
230236 , serverName = serverName'
231237 , serverPort = port
232238 , requestHeaders = heads
@@ -244,14 +250,18 @@ takeUntil c bs =
244250{-# INLINE takeUntil #-}
245251
246252parseFirst :: ByteString
247− -> E.Iteratee S.ByteString IO (ByteString, ByteString, ByteString, HttpVersion)
253+ -> E.Iteratee S.ByteString IO (ByteString, ByteString, ByteString, H.HttpVersion)
248254parseFirst s =
249255 case S.split 32 s of -- ' '
250256 [method, query, http'] -> do
251257 let (hfirst, hsecond) = B.splitAt 5 http'
252258 if hfirst == "HTTP/"
253259 then let (rpath, qstring) = S.breakByte 63 query -- '?'
254− in return (method, rpath, qstring, hsecond)
260+ hv =
261+ case hsecond of
262+ "1.1" -> H.http11
263+ _ -> H.http10
264+ in return (method, rpath, qstring, hv)
255265 else E.throwError NonHttp
256266 _ -> E.throwError $ BadFirstLine $ B.unpack s
257267{-# INLINE parseFirst #-} -- FIXME is this inline necessary? the function is only called from one place and not exported
@@ -264,14 +274,17 @@ newlineBuilder = copyByteString "\r\n"
264274transferEncodingBuilder = copyByteString "Transfer-Encoding: chunked\r\n\r\n"
265275colonSpaceBuilder = copyByteString ": "
266276
267−headers :: HttpVersion -> Status -> ResponseHeaders -> Bool -> Builder
277+headers :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> Builder
268278headers !httpversion !status !responseHeaders !isChunked' = {-# SCC "headers" #-}
269279 let !start = httpBuilder
270− `mappend` copyByteString httpversion
280+ `mappend` (copyByteString $
281+ case httpversion of
282+ H.HttpVersion 1 1 -> "1.1"
283+ _ -> "1.0")
271284 `mappend` spaceBuilder
272− `mappend` fromShow (statusCode status)
285+ `mappend` fromShow (H.statusCode status)
273286 `mappend` spaceBuilder
274− `mappend` copyByteString (statusMessage status)
287+ `mappend` copyByteString (A.toByteString $ H.statusMessage status)
275288 `mappend` newlineBuilder
276289 !start' = foldl' responseHeaderToBuilder start responseHeaders
277290 !end = if isChunked'
@@ -279,21 +292,21 @@ headers !httpversion !status !responseHeaders !isChunked' = {-# SCC "headers" #-
279292 else newlineBuilder
280293 in start' `mappend` end
281294
282−responseHeaderToBuilder :: Builder -> (CIByteString, ByteString) -> Builder
295+responseHeaderToBuilder :: Builder -> (A.CIAscii, A.Ascii) -> Builder
283296responseHeaderToBuilder b (x, y) = b
284− `mappend` (copyByteString $ ciOriginal x)
297+ `mappend` (copyByteString $ A.ciToByteString x)
285298 `mappend` colonSpaceBuilder
286− `mappend` copyByteString y
299+ `mappend` copyByteString (A.toByteString y)
287300 `mappend` newlineBuilder
288301
289−isChunked :: HttpVersion -> Bool
290−isChunked = (==) http11
302+isChunked :: H.HttpVersion -> Bool
303+isChunked = (==) H.http11
291304
292−hasBody :: Status -> Request -> Bool
293−hasBody s req = s /= (Status 204 "") && requestMethod req /= "HEAD"
305+hasBody :: H.Status -> Request -> Bool
306+hasBody s req = s /= (H.Status 204 "") && requestMethod req /= "HEAD"
294307
295308sendResponse :: T.Handle
296− -> Request -> HttpVersion -> Socket -> Response -> IO Bool
309+ -> Request -> H.HttpVersion -> Socket -> Response -> IO Bool
297310sendResponse th req hv socket (ResponseFile s hs fp) = do
298311 Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False
299312 if hasBody s req
@@ -361,7 +374,7 @@ sendResponse th req hv socket (ResponseEnumerator res) =
361374 step k (E.Chunks [x]) = k (E.Chunks [chunkedTransferEncoding x]) >>== chunk
362375 step k (E.Chunks xs) = k (E.Chunks [chunkedTransferEncoding $ mconcat xs]) >>== chunk
363376
364−parseHeaderNoAttr :: ByteString -> (CIByteString, ByteString)
377+parseHeaderNoAttr :: ByteString -> H.Header
365378parseHeaderNoAttr s =
366379 let (k, rest) = S.breakByte 58 s -- ':'
367380 restLen = S.length rest
@@ -369,7 +382,7 @@ parseHeaderNoAttr s =
369382 rest' = if restLen > 1 && SU.unsafeTake 2 rest == ": "
370383 then SU.unsafeDrop 2 rest
371384 else rest
372− in (mkCIByteString k, rest')
385+ in (A.toCIAscii $ A.unsafeFromByteString k, A.unsafeFromByteString rest')
373386
374387enumSocket :: T.Handle -> Int -> Socket -> E.Enumerator ByteString IO a
375388enumSocket th len socket =