summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2012-09-19 06:12:40 (GMT)
committerhdiff <hdiff@luite.com>2012-09-19 06:12:40 (GMT)
commitd8206e773ee9b8f6a881700907df3994bc57809a (patch)
treeb00a733f31a5cbd45862a33cecb34501ff7a7c46
parente4ea5572f1a4e126b462286222286660e135bf57 (diff)
version 1.3.1.11.3.1.1
-rw-r--r--Network/Wai/Handler/Warp/Conduit.hs11
-rw-r--r--Network/Wai/Handler/Warp/ReadInt.hs19
-rw-r--r--Network/Wai/Handler/Warp/Request.hs10
-rw-r--r--Network/Wai/Handler/Warp/Response.hs20
-rw-r--r--Network/Wai/Handler/Warp/Run.hs20
-rw-r--r--Network/Wai/Handler/Warp/Types.hs7
-rw-r--r--warp.cabal6
7 files changed, 61 insertions, 32 deletions
diff --git a/Network/Wai/Handler/Warp/Conduit.hs b/Network/Wai/Handler/Warp/Conduit.hs
index b5b739b..b77fda6 100644
--- a/Network/Wai/Handler/Warp/Conduit.hs
+++ b/Network/Wai/Handler/Warp/Conduit.hs
@@ -7,14 +7,12 @@ import Control.Monad.IO.Class (MonadIO, liftIO)
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,7 +131,7 @@ chunkedSource ipair = do
| 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
@@ -141,6 +139,11 @@ chunkedSource ipair = do
| w < 71 = w - 55
| otherwise = w - 87
+isHexDigit :: Word8 -> Bool
+isHexDigit w = w >= 48 && w <= 57
+ || w >= 65 && w <= 70
+ || w >= 97 && w <= 102
+
----------------------------------------------------------------
fmapResume :: (Source m o1 -> Source m o2) -> ResumableSource m o1 -> ResumableSource m o2
diff --git a/Network/Wai/Handler/Warp/ReadInt.hs b/Network/Wai/Handler/Warp/ReadInt.hs
index 235ff37..0a3876a 100644
--- 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 <erikd@mega-nerd.com>
-- License : BSD3
@@ -12,11 +14,11 @@ module Network.Wai.Handler.Warp.ReadInt (
-- 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 @@ readInt bs = fromIntegral $ readInt64 bs
{- 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 @@ mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i)))
\\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
index 4bd3137..e2ac090 100644
--- a/Network/Wai/Handler/Warp/Request.hs
+++ b/Network/Wai/Handler/Warp/Request.hs
@@ -8,7 +8,7 @@ import Control.Exception.Lifted (throwIO)
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 :: Int
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 @@ parseRequest' :: Connection
-> 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 @@ parseFirst s =
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 @@ push (THStatus len lines prepend) bs
{-# 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
index 0fc9c57..031b799 100644
--- a/Network/Wai/Handler/Warp/Response.hs
+++ b/Network/Wai/Handler/Warp/Response.hs
@@ -11,7 +11,8 @@ import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding, chunkedTransferTe
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 @@ sendResponse th req conn (ResponseSource s hs bodyFlush)
----------------------------------------------------------------
-- | 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 @@ infoFromResponse hs (isPersist,isChunked) = (isKeepAlive, needsChunked)
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 @@ warpVersionHeader = (hServer, ver)
----------------------------------------------------------------
-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
index 858ead6..568ec67 100644
--- 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 qualified Network.Wai.Handler.Warp.Timeout as T
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 @@ bytesPerRead = 4096
-- | 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
index 49ca55b..6df7a28 100644
--- a/Network/Wai/Handler/Warp/Types.hs
+++ b/Network/Wai/Handler/Warp/Types.hs
@@ -5,7 +5,6 @@ module Network.Wai.Handler.Warp.Types where
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 @@ instance Exception InvalidRequest
--
-- * 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
index d101b1d..98a8ea9 100644
--- 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 @@ Library
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 @@ Test-Suite spec
, network
, HUnit
, QuickCheck
- , hspec
+ , hspec == 1.3.*
Source-Repository head
Type: git