warp 3.0.2 → 3.0.2.1

raw patch · 3 files changed

+26/−25 lines, 3 filesdep +atomic-primops

Dependencies added: atomic-primops

Files

• Network/Wai/Handler/Warp/Counter.hs +6/−6
• Network/Wai/Handler/Warp/Timeout.hs +17/−18
• warp.cabal +3/−1

@@ -6,19 +6,19 @@   , decrease   ) where -import Network.Wai.Handler.Warp.IORef+import qualified Data.Atomics.Counter.Unboxed as C import Control.Applicative ((<$>)) -newtype Counter = Counter (IORef Int)+newtype Counter = Counter C.AtomicCounter  newCounter :: IO Counter-newCounter = Counter <$> newIORef 0+newCounter = Counter <$> C.newCounter 0  isZero :: Counter -> IO Bool-isZero (Counter ref) = (== 0) <$> readIORef ref+isZero (Counter ref) = (== 0) <$> C.readCounter ref  increase :: Counter -> IO ()-increase (Counter ref) = atomicModifyIORef' ref $ \x -> (x + 1, ())+increase (Counter ref) = C.incrCounter_ 1 ref  decrease :: Counter -> IO ()-decrease (Counter ref) = atomicModifyIORef' ref $ \x -> (x - 1, ())+decrease (Counter ref) = C.incrCounter_ (-1) ref

@@ -56,11 +56,10 @@ import Control.Concurrent (myThreadId) import qualified Control.Exception as E import GHC.Weak (Weak (..))-import Network.Wai.Handler.Warp.IORef (IORef)-import qualified Network.Wai.Handler.Warp.IORef as I import System.Mem.Weak (deRefWeak) import Data.Typeable (Typeable) import Control.Reaper+import qualified Data.Atomics.Counter.Unboxed as C  ---------------------------------------------------------------- @@ -71,12 +70,14 @@ type TimeoutAction = IO ()  -- | A handle used by 'Manager'-data Handle = Handle TimeoutAction (IORef State)+data Handle = Handle TimeoutAction {-# UNPACK #-} !C.AtomicCounter -data State = Active    -- Manager turns it to Inactive.-           | Inactive  -- Manager removes it with timeout action.-           | Paused    -- Manager does not change it.-           | Canceled  -- Manager removes it without timeout action.+-- Four states for the AtomicCounter:+--+-- 1: Active    -- Manager turns it to Inactive.+-- 2: Inactive  -- Manager removes it with timeout action.+-- 3: Paused    -- Manager does not change it.+-- 4: Canceled  -- Manager removes it without timeout action.  ---------------------------------------------------------------- @@ -89,17 +90,15 @@         }   where     prune m@(Handle onTimeout iactive) = do-        state <- I.atomicModifyIORef' iactive (\x -> (inactivate x, x))-        case state of-            Inactive -> do+        -- Try to change from active to inactive+        (wasActive, newState) <- C.casCounter iactive 1 2+        case newState of+            2 | not wasActive -> do -- inactive                 onTimeout `E.catch` ignoreAll                 return Nothing-            Canceled -> return Nothing+            4 -> return Nothing -- canceled             _        -> return $ Just m -    inactivate Active = Inactive-    inactivate x = x- ----------------------------------------------------------------  -- | Stopping timeout manager.@@ -116,7 +115,7 @@ -- | Registering a timeout action. register :: Manager -> TimeoutAction -> IO Handle register mgr onTimeout = do-    iactive <- I.newIORef Active+    iactive <- C.newCounter 1     let h = Handle onTimeout iactive     reaperAdd mgr h     return h@@ -153,17 +152,17 @@ -- | Setting the state to active. --   'Manager' turns active to inactive repeatedly. tickle :: Handle -> IO ()-tickle (Handle _ iactive) = I.writeIORef iactive Active+tickle (Handle _ iactive) = C.writeCounter iactive 1  -- | Setting the state to canceled. --   'Manager' eventually removes this without timeout action. cancel :: Handle -> IO ()-cancel (Handle _ iactive) = I.writeIORef iactive Canceled+cancel (Handle _ iactive) = C.writeCounter iactive 4  -- | Setting the state to paused. --   'Manager' does not change the value. pause :: Handle -> IO ()-pause (Handle _ iactive) = I.writeIORef iactive Paused+pause (Handle _ iactive) = C.writeCounter iactive 3  -- | Setting the paused state to active. --   This is an alias to 'tickle'.

@@ -1,5 +1,5 @@ Name:                warp-Version:             3.0.2+Version:             3.0.2.1 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE@@ -52,6 +52,7 @@                    , wai                       >= 3.0      && < 3.1                    , text                    , streaming-commons         >= 0.1.2+                   , atomic-primops            >= 0.6   if flag(network-bytestring)       Build-Depends: network                   >= 2.2.1.5  && < 2.2.3                    , network-bytestring        >= 0.1.3    && < 0.1.4@@ -143,6 +144,7 @@                    , text                    , streaming-commons >= 0.1.1                    , async+                   , atomic-primops    if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)     Cpp-Options:   -DSENDFILEFD