warp 1.3.1 → 1.3.1.1
raw patch · 7 files changed
+61/−32 lines, 7 filesdep −HUnitdep −QuickCheckdep −hspecdep ~basedep ~network
Dependencies removed: HUnit, QuickCheck, hspec
Dependency ranges changed: base, network
Files
- Network/Wai/Handler/Warp/Conduit.hs +7/−4
- Network/Wai/Handler/Warp/ReadInt.hs +11/−8
- Network/Wai/Handler/Warp/Request.hs +5/−5
- Network/Wai/Handler/Warp/Response.hs +12/−8
- Network/Wai/Handler/Warp/Run.hs +20/−0
- Network/Wai/Handler/Warp/Types.hs +3/−4
- warp.cabal +3/−3
Network/Wai/Handler/Warp/Conduit.hs view
@@ -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 ----------------------------------------------------------------
Network/Wai/Handler/Warp/ReadInt.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE BangPatterns #-} -- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com> -- 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
Network/Wai/Handler/Warp/Request.hs view
@@ -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
Network/Wai/Handler/Warp/Response.hs view
@@ -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
Network/Wai/Handler/Warp/Run.hs view
@@ -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
Network/Wai/Handler/Warp/Types.hs view
@@ -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 }
warp.cabal view
@@ -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