packages feed

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 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