version 1.3.1.11.3.1.1

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