39a3fba · typeable/wai

git.iko.soy/typeable/wai

Merge pull request #107 from kazu-yamamoto/refactoring2

Refactoring2

commit39a3fba58efc4a01772274d869452c17345484a7 authorMichael Snoyman <michael@snoyman.com> dateTue 18 Sep 2012, 22:59 (14 years ago) parent6d2bcab 41f01b1

6 files changed+58−29

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/Conduit.hs+7−4 warp/Network/Wai/Handler/Warp/ReadInt.hs+11−8 warp/Network/Wai/Handler/Warp/Request.hs+5−5 warp/Network/Wai/Handler/Warp/Response.hs+12−8 warp/Network/Wai/Handler/Warp/Run.hs+20 warp/Network/Wai/Handler/Warp/Types.hs+3−4

warp/Network/Wai/Handler/Warp/Conduit.hs+7−4

@@ -7,14 +7,12 @@ import Control.Monad.IO.Class (MonadIO, liftIO)

77import Control.Monad.Trans.Class (lift)

88import Data.ByteString (ByteString)

99import qualified Data.ByteString as S

10−import qualified Data.ByteString.Char8 as B

11−import Data.Char (isHexDigit)

1210import Data.Conduit

1311import qualified Data.Conduit.Binary as CB

1412import Data.Conduit.Internal (ResumableSource (..))

1513import qualified Data.Conduit.List as CL

1614import qualified Data.IORef as I

17−import Data.Word (Word)

15+import Data.Word (Word, Word8)

1816import Network.Wai.Handler.Warp.Types

1917

2018----------------------------------------------------------------

@@ -133,7 +131,7 @@ chunkedSource ipair = do

133131 | otherwise -> return (x, y)

134132 let w =

135133 S.foldl' (\i c -> i * 16 + fromIntegral (hexToWord c)) 0

136− $ B.takeWhile isHexDigit x

134+ $ S.takeWhile isHexDigit x

137135 return (w, S.drop 1 y)

138136

139137 hexToWord w

@@ -141,6 +139,11 @@ chunkedSource ipair = do

141139 | w < 71 = w - 55

142140 | otherwise = w - 87

143141

142+isHexDigit :: Word8 -> Bool

143+isHexDigit w = w >= 48 && w <= 57

144+ || w >= 65 && w <= 70

145+ || w >= 97 && w <= 102

146+

144147----------------------------------------------------------------

145148

146149fmapResume :: (Source m o1 -> Source m o2) -> ResumableSource m o1 -> ResumableSource m o2

warp/Network/Wai/Handler/Warp/ReadInt.hs+11−8

@@ -1,4 +1,6 @@

1−{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-}

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE MagicHash #-}

3+{-# LANGUAGE BangPatterns #-}

35-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>

46-- License : BSD3

@@ -12,11 +14,11 @@ module Network.Wai.Handler.Warp.ReadInt (

1214-- poorly with the CPP pragma.

1315

1416import Data.ByteString (ByteString)

15−import qualified Data.ByteString.Char8 as B

16−import qualified Data.Char as C

17+import qualified Data.ByteString as S

1718import Data.Int (Int64)

1819import GHC.Prim

1920import GHC.Types

21+import GHC.Word

2022

2123{-# INLINE readInt #-}

2224readInt :: Integral a => ByteString -> a

@@ -32,15 +34,14 @@ readInt bs = fromIntegral $ readInt64 bs

3234

3335{- NOINLINE readInt64MH #-}

3436readInt64 :: ByteString -> Int64

35−readInt64 bs =

36− B.foldl' (\i c -> i * 10 + fromIntegral (mhDigitToInt c)) 0

37− $ B.takeWhile C.isDigit bs

37+readInt64 bs = S.foldl' (\ !i !c -> i * 10 + fromIntegral (mhDigitToInt c)) 0

38+ $ S.takeWhile isDigit bs

3839

3940data Table = Table !Addr#

4041

4142{- NOINLINE mhDigitToInt #-}

42−mhDigitToInt :: Char -> Int

43−mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i)))

43+mhDigitToInt :: Word8 -> Int

44+mhDigitToInt (W8# i) = I# (word2Int# (indexWord8OffAddr# addr (word2Int# i)))

4445 where

4546 !(Table addr) = table

4647 table :: Table

@@ -62,3 +63,5 @@ mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i)))

6263 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

6364 \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#

6465

66+isDigit :: Word8 -> Bool

67+isDigit w = w >= 48 && w <= 57

warp/Network/Wai/Handler/Warp/Request.hs+5−5

@@ -8,7 +8,7 @@ import Control.Exception.Lifted (throwIO)

88import Control.Monad.IO.Class (MonadIO, liftIO)

99import Data.ByteString (ByteString)

1010import qualified Data.ByteString as S

11−import qualified Data.ByteString.Char8 as B

11+import qualified Data.ByteString.Char8 as B (unpack)

1212import qualified Data.ByteString.Unsafe as SU

1313import qualified Data.CaseInsensitive as CI

1414import Data.Conduit

@@ -30,7 +30,7 @@ maxTotalHeaderLength :: Int

3030maxTotalHeaderLength = 50 * 1024

3131

3232parseRequest :: Connection -> Port -> SockAddr

33− -> Source (ResourceT IO) S.ByteString

33+ -> Source (ResourceT IO) ByteString

3434 -> ResourceT IO (Request, IO (ResumableSource (ResourceT IO) ByteString))

3535parseRequest conn port remoteHost' src1 = do

3636 (src2, headers') <- src1 $$+ takeHeaders

@@ -55,7 +55,7 @@ parseRequest' :: Connection

5555 -> Port

5656 -> [ByteString]

5757 -> SockAddr

58− -> ResumableSource (ResourceT IO) S.ByteString -- FIXME was buffered

58+ -> ResumableSource (ResourceT IO) ByteString -- FIXME was buffered

5959 -> ResourceT IO (Request, IO (ResumableSource (ResourceT IO) ByteString))

6060parseRequest' _ _ [] _ _ = throwIO $ NotEnoughLines []

6161parseRequest' conn port (firstLine:otherLines) remoteHost' src = do

@@ -114,7 +114,7 @@ parseFirst s =

114114 case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of -- ' '

115115 (method:query:http'') -> do

116116 let http' = S.concat http''

117− (hfirst, hsecond) = B.splitAt 5 http'

117+ (hfirst, hsecond) = S.splitAt 5 http'

118118 if hfirst == "HTTP/"

119119 then let (rpath, qstring) = S.breakByte 63 query -- '?'

120120 hv =

@@ -209,6 +209,6 @@ push (THStatus len lines prepend) bs

209209

210210{-# INLINE checkCR #-}

211211checkCR :: ByteString -> Int -> Int

212−checkCR bs pos = if '\r' == B.index bs p then p else pos

212+checkCR bs pos = if 13 == S.index bs p then p else pos -- 13 is CR

213213 where

214214 !p = pos - 1

warp/Network/Wai/Handler/Warp/Response.hs+12−8

@@ -11,7 +11,8 @@ import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding, chunkedTransferTe

1111import Control.Applicative

1212import Control.Exception

1313import Control.Monad.IO.Class (MonadIO, liftIO)

14−import qualified Data.ByteString.Char8 as B

14+import Data.ByteString (ByteString)

15+import qualified Data.ByteString.Char8 as B (pack)

1516import qualified Data.CaseInsensitive as CI

1617import Data.Conduit

1718import Data.Conduit.Blaze (builderToByteString)

@@ -119,7 +120,7 @@ sendResponse th req conn (ResponseSource s hs bodyFlush)

119120----------------------------------------------------------------

120121

121122-- | Use 'connSendAll' to send this data while respecting timeout rules.

122−connSink :: Connection -> T.Handle -> Sink B.ByteString (ResourceT IO) ()

123+connSink :: Connection -> T.Handle -> Sink ByteString (ResourceT IO) ()

123124connSink Connection { connSendAll = send } th =

124125 sink

125126 where

@@ -166,16 +167,19 @@ infoFromResponse hs (isPersist,isChunked) = (isKeepAlive, needsChunked)

166167 isKeepAlive = isPersist && (isChunked || hasLength)

167168 hasLength = isJust $ checkLength hs

168169

169−checkLength :: H.ResponseHeaders -> Maybe B.ByteString

170+checkLength :: H.ResponseHeaders -> Maybe ByteString

170171checkLength = lookup H.hContentLength

171172

172173----------------------------------------------------------------

173174

174175hasBody :: H.Status -> Request -> Bool

175−hasBody s req = s /= H.Status 204 ""

176− && s /= H.status304

177− && H.statusCode s >= 200

178− && requestMethod req /= H.methodHead

176+hasBody s req = sc /= 204

177+ && sc /= 304

178+ && sc >= 200

179+ && method /= H.methodHead

180+ where

181+ sc = H.statusCode s

182+ method = requestMethod req

179183

180184----------------------------------------------------------------

181185

@@ -197,7 +201,7 @@ warpVersionHeader = (hServer, ver)

197201

198202----------------------------------------------------------------

199203

200−composeHeader :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> B.ByteString

204+composeHeader :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> ByteString

201205composeHeader version s hs = RH.composeHeader version s (addServerHeader hs)

202206

203207composeHeaderBuilder :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> Builder

warp/Network/Wai/Handler/Warp/Run.hs+20

@@ -1,5 +1,6 @@

11{-# LANGUAGE CPP #-}

22{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE CPP #-}

45module Network.Wai.Handler.Warp.Run where

@@ -25,6 +26,17 @@ import qualified Network.Wai.Handler.Warp.Timeout as T

2526import Network.Wai.Handler.Warp.Types

2627import Prelude hiding (catch)

2728

29+-- Sock.recv first tries to call recvfrom() optimistically.

30+-- If EAGAIN returns, it polls incoming data with epoll/kqueue.

31+-- This code first polls incoming data with epoll/kqueue.

32+#define PESSIMISTIC_RECV 1

33+

34+#ifdef PESSIMISTIC_RECV

35+import System.Posix.Types (Fd(..))

36+import Control.Concurrent (threadWaitRead)

37+import Network.Socket (Socket(..))

38+#endif

39+

2840#if WINDOWS

2941import qualified Control.Concurrent.MVar as MV

3042import Network.Socket (withSocketsDo)

@@ -36,12 +48,20 @@ bytesPerRead = 4096

3648

3749-- | Default action value for 'Connection'

3850socketConnection :: Socket -> Connection

51+#ifdef PESSIMISTIC_RECV

52+socketConnection s@(MkSocket fd _ _ _ _) = Connection

53+#else

3954socketConnection s = Connection

55+#endif

4056 { connSendMany = Sock.sendMany s

4157 , connSendAll = Sock.sendAll s

4258 , connSendFile = \fp off len act hdr -> sendfileWithHeader s fp (PartOfFile off len) act hdr

4359 , connClose = sClose s

60+#ifdef PESSIMISTIC_RECV

61+ , connRecv = threadWaitRead (Fd fd) >> Sock.recv s bytesPerRead

62+#else

4463 , connRecv = Sock.recv s bytesPerRead

64+#endif

4565 }

4666

4767#if __GLASGOW_HASKELL__ < 702

warp/Network/Wai/Handler/Warp/Types.hs+3−4

@@ -5,7 +5,6 @@ module Network.Wai.Handler.Warp.Types where

66import Control.Exception

77import Data.ByteString (ByteString)

8−import qualified Data.ByteString.Char8 as B

98import Data.Typeable (Typeable)

109import Data.Version (showVersion)

1110import Network.HTTP.Types.Header

@@ -65,9 +64,9 @@ instance Exception InvalidRequest

6564--

6665-- * Every time data is successfully sent to the client, the timeout is tickled.

6766data Connection = Connection

68− { connSendMany :: [B.ByteString] -> IO ()

69− , connSendAll :: B.ByteString -> IO ()

67+ { connSendMany :: [ByteString] -> IO ()

68+ , connSendAll :: ByteString -> IO ()

7069 , connSendFile :: FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO () -- ^ offset, length

7170 , connClose :: IO ()

72− , connRecv :: IO B.ByteString

71+ , connRecv :: IO ByteString

7372 }