@@ -2,6 +2,7 @@
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE OverloadedStrings #-}
44{-# LANGUAGE CPP #-}
5+{-# LANGUAGE BangPatterns #-}
56---------------------------------------------------------
67-- |
78-- Module : Network.Wai.Handler.Warp
@@ -27,6 +28,7 @@ import qualified System.IO
2728
2829import Data.ByteString (ByteString)
2930import qualified Data.ByteString as S
31+import qualified Data.ByteString.Unsafe as SU
3032import qualified Data.ByteString.Char8 as B
3133import qualified Data.ByteString.Lazy as L
3234import Network
@@ -57,6 +59,7 @@ import Network.Socket.SendFile (sendFile)
5759
5860import Control.Monad.IO.Class (liftIO)
5961import System.Timeout (timeout)
62+import Data.Word (Word8)
6063
6164run :: Port -> Application -> IO ()
6265run port = withSocketsDo .
@@ -149,28 +152,29 @@ parseRequest' :: Port
149152 -> [ByteString]
150153 -> SockAddr
151154 -> E.Iteratee S.ByteString IO (E.Enumeratee S.ByteString S.ByteString IO a, Request)
152−parseRequest' port lines' remoteHost' = do
153− (firstLine, otherLines) <-
154− case lines' of
155− x:xs -> return (x, xs)
156− [] -> E.throwError $ NotEnoughLines $ map B.unpack lines'
155+parseRequest' _ [] _ = E.throwError $ NotEnoughLines []
156+parseRequest' port (firstLine:otherLines) remoteHost' = do
157157 (method, rpath', gets, httpversion) <- parseFirst firstLine
158− let rpath = '/' : case B.unpack rpath' of
159− ('/':x) -> x
160− _ -> B.unpack rpath'
158+ let rpath =
159+ if S.null rpath'
160+ then "/"
161+ else if '/' == B.head rpath'
162+ then "/"
163+ else B.cons '/' rpath'
161164 let heads = map (first mkCIByteString . parseHeaderNoAttr) otherLines
162165 let host = fromMaybe "" $ lookup "host" heads
163− let len = fromMaybe 0 $ do
164− bs <- lookup "Content-Length" heads
165− let str = B.unpack bs
166− case reads str of
167− (x, _):_ -> Just x
168− _ -> Nothing
169− let (serverName', _) = B.break (== ':') host
166+ let len =
167+ case lookup "content-length" heads of
168+ Nothing -> 0
169+ Just bs ->
170+ case reads $ B.unpack bs of -- FIXME could probably be optimized
171+ (x, _):_ -> x
172+ [] -> 0
173+ let serverName' = takeUntil 58 host -- ':'
170174 return (requestBodyHandle len, Request
171175 { requestMethod = method
172176 , httpVersion = httpversion
173− , pathInfo = B.pack rpath
177+ , pathInfo = rpath
174178 , queryString = gets
175179 , serverName = serverName'
176180 , serverPort = port
@@ -180,6 +184,14 @@ parseRequest' port lines' remoteHost' = do
180184 , remoteHost = remoteHost'
181185 })
182186
187+
188+takeUntil :: Word8 -> ByteString -> ByteString
189+takeUntil c bs =
190+ case S.elemIndex c bs of
191+ Just !idx -> SU.unsafeTake idx bs
192+ Nothing -> bs
193+{-# INLINE takeUntil #-}
194+
183195parseFirst :: ByteString
184196 -> E.Iteratee S.ByteString IO (ByteString, ByteString, ByteString, HttpVersion)
185197parseFirst s = do