4816758 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Optimize parseRequest (code from Matt)

4816758Michael Snoyman16 years ago

Network/Wai/Handler/Warp.hs+28−16

compare with master

unifiedsplit

@@ -2,6 +2,7 @@

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE CPP #-}

5+{-# LANGUAGE BangPatterns #-}

5---------------------------------------------------------

6---------------------------------------------------------

6-- |

7-- |

7-- Module : Network.Wai.Handler.Warp

8-- Module : Network.Wai.Handler.Warp

@@ -27,6 +28,7 @@ import qualified System.IO

28import Data.ByteString (ByteString)

29import Data.ByteString (ByteString)

29import qualified Data.ByteString as S

30import qualified Data.ByteString as S

31+import qualified Data.ByteString.Unsafe as SU

30import qualified Data.ByteString.Char8 as B

32import qualified Data.ByteString.Char8 as B

31import qualified Data.ByteString.Lazy as L

33import qualified Data.ByteString.Lazy as L

32import Network

34import Network

@@ -57,6 +59,7 @@ import Network.Socket.SendFile (sendFile)

58import Control.Monad.IO.Class (liftIO)

60import Control.Monad.IO.Class (liftIO)

59import System.Timeout (timeout)

61import System.Timeout (timeout)

62+import Data.Word (Word8)

61run :: Port -> Application -> IO ()

64run :: Port -> Application -> IO ()

62run port = withSocketsDo .

65run port = withSocketsDo .

@@ -149,28 +152,29 @@ parseRequest' :: Port

149 -> [ByteString]

152 -> [ByteString]

150 -> SockAddr

153 -> SockAddr

151 -> E.Iteratee S.ByteString IO (E.Enumeratee S.ByteString S.ByteString IO a, Request)

154 -> E.Iteratee S.ByteString IO (E.Enumeratee S.ByteString S.ByteString IO a, Request)

155+parseRequest' _ [] _ = E.throwError $ NotEnoughLines []

152−parseRequest' port lines' remoteHost' = do

156+parseRequest' port (firstLine:otherLines) remoteHost' = do

153− (firstLine, otherLines) <-

154− case lines' of

155− x:xs -> return (x, xs)

156− [] -> E.throwError $ NotEnoughLines $ map B.unpack lines'

157 (method, rpath', gets, httpversion) <- parseFirst firstLine

158− let rpath = '/' : case B.unpack rpath' of

158+ let rpath =

159− ('/':x) -> x

159+ if S.null rpath'

160+ then "/"

161+ else if '/' == B.head rpath'

162+ then "/"

160− _ -> B.unpack rpath'

163+ else B.cons '/' rpath'

161 let heads = map (first mkCIByteString . parseHeaderNoAttr) otherLines

164 let heads = map (first mkCIByteString . parseHeaderNoAttr) otherLines

162 let host = fromMaybe "" $ lookup "host" heads

165 let host = fromMaybe "" $ lookup "host" heads

163− let len = fromMaybe 0 $ do

166+ let len =

164− bs <- lookup "Content-Length" heads

167+ case lookup "content-length" heads of

165− let str = B.unpack bs

168+ Nothing -> 0

166− case reads str of

169+ Just bs ->

170+ case reads $ B.unpack bs of -- FIXME could probably be optimized

167− (x, _):_ -> Just x

171+ (x, _):_ -> x

168− _ -> Nothing

172+ [] -> 0

169− let (serverName', _) = B.break (== ':') host

173+ let serverName' = takeUntil 58 host -- ':'

170 return (requestBodyHandle len, Request

174 return (requestBodyHandle len, Request

171 { requestMethod = method

175 { requestMethod = method

172 , httpVersion = httpversion

176 , httpVersion = httpversion

173− , pathInfo = B.pack rpath

177+ , pathInfo = rpath

174 , queryString = gets

178 , queryString = gets

175 , serverName = serverName'

179 , serverName = serverName'

176 , serverPort = port

180 , serverPort = port

@@ -180,6 +184,14 @@ parseRequest' port lines' remoteHost' = do

180 , remoteHost = remoteHost'

184 , remoteHost = remoteHost'

181 })

185 })

182

186

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+

183parseFirst :: ByteString

195parseFirst :: ByteString

184 -> E.Iteratee S.ByteString IO (ByteString, ByteString, ByteString, HttpVersion)

196 -> E.Iteratee S.ByteString IO (ByteString, ByteString, ByteString, HttpVersion)

185parseFirst s = do

197parseFirst s = do