diff --git a/Network/Wai/Handler/Warp/Conduit.hs b/Network/Wai/Handler/Warp/Conduit.hs --- a/Network/Wai/Handler/Warp/Conduit.hs +++ b/Network/Wai/Handler/Warp/Conduit.hs @@ -7,14 +7,12 @@ import Control.Monad.Trans.Class (lift) import Data.ByteString (ByteString) import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as B -import Data.Char (isHexDigit) import Data.Conduit import qualified Data.Conduit.Binary as CB import Data.Conduit.Internal (ResumableSource (..)) import qualified Data.Conduit.List as CL import qualified Data.IORef as I -import Data.Word (Word) +import Data.Word (Word, Word8) import Network.Wai.Handler.Warp.Types ---------------------------------------------------------------- @@ -133,13 +131,18 @@ | otherwise -> return (x, y) let w = S.foldl' (\i c -> i * 16 + fromIntegral (hexToWord c)) 0 - $ B.takeWhile isHexDigit x + $ S.takeWhile isHexDigit x return (w, S.drop 1 y) hexToWord w | w < 58 = w - 48 | w < 71 = w - 55 | otherwise = w - 87 + +isHexDigit :: Word8 -> Bool +isHexDigit w = w >= 48 && w <= 57 + || w >= 65 && w <= 70 + || w >= 97 && w <= 102 ---------------------------------------------------------------- diff --git a/Network/Wai/Handler/Warp/ReadInt.hs b/Network/Wai/Handler/Warp/ReadInt.hs --- a/Network/Wai/Handler/Warp/ReadInt.hs +++ b/Network/Wai/Handler/Warp/ReadInt.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE BangPatterns #-} -- Copyright : Erik de Castro Lopo -- License : BSD3 @@ -12,11 +14,11 @@ -- poorly with the CPP pragma. import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as B -import qualified Data.Char as C +import qualified Data.ByteString as S import Data.Int (Int64) import GHC.Prim import GHC.Types +import GHC.Word {-# INLINE readInt #-} readInt :: Integral a => ByteString -> a @@ -32,15 +34,14 @@ {- NOINLINE readInt64MH #-} readInt64 :: ByteString -> Int64 -readInt64 bs = - B.foldl' (\i c -> i * 10 + fromIntegral (mhDigitToInt c)) 0 - $ B.takeWhile C.isDigit bs +readInt64 bs = S.foldl' (\ !i !c -> i * 10 + fromIntegral (mhDigitToInt c)) 0 + $ S.takeWhile isDigit bs data Table = Table !Addr# {- NOINLINE mhDigitToInt #-} -mhDigitToInt :: Char -> Int -mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i))) +mhDigitToInt :: Word8 -> Int +mhDigitToInt (W8# i) = I# (word2Int# (indexWord8OffAddr# addr (word2Int# i))) where !(Table addr) = table table :: Table @@ -62,3 +63,5 @@ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# +isDigit :: Word8 -> Bool +isDigit w = w >= 48 && w <= 57 diff --git a/Network/Wai/Handler/Warp/Request.hs b/Network/Wai/Handler/Warp/Request.hs --- a/Network/Wai/Handler/Warp/Request.hs +++ b/Network/Wai/Handler/Warp/Request.hs @@ -8,7 +8,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Data.ByteString (ByteString) import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Char8 as B (unpack) import qualified Data.ByteString.Unsafe as SU import qualified Data.CaseInsensitive as CI import Data.Conduit @@ -30,7 +30,7 @@ maxTotalHeaderLength = 50 * 1024 parseRequest :: Connection -> Port -> SockAddr - -> Source (ResourceT IO) S.ByteString + -> Source (ResourceT IO) ByteString -> ResourceT IO (Request, IO (ResumableSource (ResourceT IO) ByteString)) parseRequest conn port remoteHost' src1 = do (src2, headers') <- src1 $$+ takeHeaders @@ -55,7 +55,7 @@ -> Port -> [ByteString] -> SockAddr - -> ResumableSource (ResourceT IO) S.ByteString -- FIXME was buffered + -> ResumableSource (ResourceT IO) ByteString -- FIXME was buffered -> ResourceT IO (Request, IO (ResumableSource (ResourceT IO) ByteString)) parseRequest' _ _ [] _ _ = throwIO $ NotEnoughLines [] parseRequest' conn port (firstLine:otherLines) remoteHost' src = do @@ -114,7 +114,7 @@ case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of -- ' ' (method:query:http'') -> do let http' = S.concat http'' - (hfirst, hsecond) = B.splitAt 5 http' + (hfirst, hsecond) = S.splitAt 5 http' if hfirst == "HTTP/" then let (rpath, qstring) = S.breakByte 63 query -- '?' hv = @@ -209,6 +209,6 @@ {-# INLINE checkCR #-} checkCR :: ByteString -> Int -> Int -checkCR bs pos = if '\r' == B.index bs p then p else pos +checkCR bs pos = if 13 == S.index bs p then p else pos -- 13 is CR where !p = pos - 1 diff --git a/Network/Wai/Handler/Warp/Response.hs b/Network/Wai/Handler/Warp/Response.hs --- a/Network/Wai/Handler/Warp/Response.hs +++ b/Network/Wai/Handler/Warp/Response.hs @@ -11,7 +11,8 @@ import Control.Applicative import Control.Exception import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.ByteString.Char8 as B +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B (pack) import qualified Data.CaseInsensitive as CI import Data.Conduit import Data.Conduit.Blaze (builderToByteString) @@ -119,7 +120,7 @@ ---------------------------------------------------------------- -- | Use 'connSendAll' to send this data while respecting timeout rules. -connSink :: Connection -> T.Handle -> Sink B.ByteString (ResourceT IO) () +connSink :: Connection -> T.Handle -> Sink ByteString (ResourceT IO) () connSink Connection { connSendAll = send } th = sink where @@ -166,16 +167,19 @@ isKeepAlive = isPersist && (isChunked || hasLength) hasLength = isJust $ checkLength hs -checkLength :: H.ResponseHeaders -> Maybe B.ByteString +checkLength :: H.ResponseHeaders -> Maybe ByteString checkLength = lookup H.hContentLength ---------------------------------------------------------------- hasBody :: H.Status -> Request -> Bool -hasBody s req = s /= H.Status 204 "" - && s /= H.status304 - && H.statusCode s >= 200 - && requestMethod req /= H.methodHead +hasBody s req = sc /= 204 + && sc /= 304 + && sc >= 200 + && method /= H.methodHead + where + sc = H.statusCode s + method = requestMethod req ---------------------------------------------------------------- @@ -197,7 +201,7 @@ ---------------------------------------------------------------- -composeHeader :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> B.ByteString +composeHeader :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> ByteString composeHeader version s hs = RH.composeHeader version s (addServerHeader hs) composeHeaderBuilder :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> Builder diff --git a/Network/Wai/Handler/Warp/Run.hs b/Network/Wai/Handler/Warp/Run.hs --- a/Network/Wai/Handler/Warp/Run.hs +++ b/Network/Wai/Handler/Warp/Run.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} module Network.Wai.Handler.Warp.Run where @@ -25,6 +26,17 @@ import Network.Wai.Handler.Warp.Types import Prelude hiding (catch) +-- Sock.recv first tries to call recvfrom() optimistically. +-- If EAGAIN returns, it polls incoming data with epoll/kqueue. +-- This code first polls incoming data with epoll/kqueue. +#define PESSIMISTIC_RECV 1 + +#ifdef PESSIMISTIC_RECV +import System.Posix.Types (Fd(..)) +import Control.Concurrent (threadWaitRead) +import Network.Socket (Socket(..)) +#endif + #if WINDOWS import qualified Control.Concurrent.MVar as MV import Network.Socket (withSocketsDo) @@ -36,12 +48,20 @@ -- | Default action value for 'Connection' socketConnection :: Socket -> Connection +#ifdef PESSIMISTIC_RECV +socketConnection s@(MkSocket fd _ _ _ _) = Connection +#else socketConnection s = Connection +#endif { connSendMany = Sock.sendMany s , connSendAll = Sock.sendAll s , connSendFile = \fp off len act hdr -> sendfileWithHeader s fp (PartOfFile off len) act hdr , connClose = sClose s +#ifdef PESSIMISTIC_RECV + , connRecv = threadWaitRead (Fd fd) >> Sock.recv s bytesPerRead +#else , connRecv = Sock.recv s bytesPerRead +#endif } #if __GLASGOW_HASKELL__ < 702 diff --git a/Network/Wai/Handler/Warp/Types.hs b/Network/Wai/Handler/Warp/Types.hs --- a/Network/Wai/Handler/Warp/Types.hs +++ b/Network/Wai/Handler/Warp/Types.hs @@ -5,7 +5,6 @@ import Control.Exception import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as B import Data.Typeable (Typeable) import Data.Version (showVersion) import Network.HTTP.Types.Header @@ -65,9 +64,9 @@ -- -- * Every time data is successfully sent to the client, the timeout is tickled. data Connection = Connection - { connSendMany :: [B.ByteString] -> IO () - , connSendAll :: B.ByteString -> IO () + { connSendMany :: [ByteString] -> IO () + , connSendAll :: ByteString -> IO () , connSendFile :: FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO () -- ^ offset, length , connClose :: IO () - , connRecv :: IO B.ByteString + , connRecv :: IO ByteString } diff --git a/warp.cabal b/warp.cabal --- a/warp.cabal +++ b/warp.cabal @@ -1,5 +1,5 @@ Name: warp -Version: 1.3.1 +Version: 1.3.1.1 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE @@ -35,7 +35,7 @@ Build-Depends: network >= 2.2.1.5 && < 2.2.3 , network-bytestring >= 0.1.3 && < 0.1.4 else - Build-Depends: network >= 2.3 && < 2.4 + Build-Depends: network >= 2.3 Exposed-modules: Network.Wai.Handler.Warp Other-modules: Network.Wai.Handler.Warp.Conduit Network.Wai.Handler.Warp.ReadInt @@ -75,7 +75,7 @@ , network , HUnit , QuickCheck - , hspec + , hspec == 1.3.* Source-Repository head Type: git