Merge PR #986

time-manager/ChangeLog.md

@@ -0,0 +1,8 @@
+# ChangeLog for time-manager
+
+## 0.1.0
+
+* [#986](https://github.com/yesodweb/wai/pull/986)
+    * Change behavior of `cancel` to immediately remove the `Handle` from the
+    reaper's workload, rather than waiting for timeout.
+    * Using auto-update v0.2.0.

time-manager/System/TimeManager.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE BangPatterns #-}
 
 module System.TimeManager (
     -- ** Types
@@ -43,13 +44,12 @@ type Manager = Reaper [Handle] Handle
 type TimeoutAction = IO ()
 
 -- | A handle used by 'Manager'
-data Handle = Handle !(IORef TimeoutAction) !(IORef State)
+data Handle = Handle Manager !(IORef TimeoutAction) !(IORef State)
 
 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.
 
 ----------------------------------------------------------------
 
@@ -63,14 +63,13 @@ initialize timeout =
             , reaperDelay = timeout
             }
   where
-    prune m@(Handle actionRef stateRef) = do
+    prune m@(Handle _ actionRef stateRef) = do
         state <- I.atomicModifyIORef' stateRef (\x -> (inactivate x, x))
         case state of
             Inactive -> do
                 onTimeout <- I.readIORef actionRef
                 onTimeout `E.catch` ignoreAll
                 return Nothing
-            Canceled -> return Nothing
             _ -> return $ Just m
 
     inactivate Active = Inactive
@@ -82,7 +81,7 @@ initialize timeout =
 stopManager :: Manager -> IO ()
 stopManager mgr = E.mask_ (reaperStop mgr >>= mapM_ fire)
   where
-    fire (Handle actionRef _) = do
+    fire (Handle _ actionRef _) = do
         onTimeout <- I.readIORef actionRef
         onTimeout `E.catch` ignoreAll
 
@@ -97,10 +96,10 @@ killManager = reaperKill
 
 -- | Registering a timeout action.
 register :: Manager -> TimeoutAction -> IO Handle
-register mgr onTimeout = do
+register mgr !onTimeout = do
     actionRef <- I.newIORef onTimeout
     stateRef <- I.newIORef Active
-    let h = Handle actionRef stateRef
+    let h = Handle mgr actionRef stateRef
     reaperAdd mgr h
     return h
 
@@ -129,19 +128,28 @@ instance Show TimeoutThread where
 -- | Setting the state to active.
 --   'Manager' turns active to inactive repeatedly.
 tickle :: Handle -> IO ()
-tickle (Handle _ stateRef) = I.writeIORef stateRef Active
+tickle (Handle _ _ stateRef) = I.writeIORef stateRef Active
 
--- | Setting the state to canceled.
---   'Manager' eventually removes this without timeout action.
+-- | Removing the 'Handle' from the 'Manager' immediately.
 cancel :: Handle -> IO ()
-cancel (Handle actionRef stateRef) = do
-    I.writeIORef actionRef (return ()) -- ensuring to release ThreadId
-    I.writeIORef stateRef Canceled
+cancel (Handle mgr _ stateRef) = do
+    _ <- reaperModify mgr filt
+    return ()
+  where
+    -- It's very important that this function forces the whole workload so we
+    -- don't retain old handles, otherwise disasterous leaks occur.
+    filt [] = []
+    filt (h@(Handle _ _ stateRef') : hs)
+        | stateRef == stateRef' =
+            hs
+        | otherwise =
+            let !hs'= filt hs
+             in h : hs'
 
 -- | Setting the state to paused.
 --   'Manager' does not change the value.
 pause :: Handle -> IO ()
-pause (Handle _ stateRef) = I.writeIORef stateRef Paused
+pause (Handle _ _ stateRef) = I.writeIORef stateRef Paused
 
 -- | Setting the paused state to active.
 --   This is an alias to 'tickle'.

time-manager/time-manager.cabal

@@ -1,5 +1,5 @@
 Name:                time-manager
-Version:             0.0.1
+Version:             0.1.0
 Synopsis:            Scalable timer
 License:             MIT
 License-file:        LICENSE
@@ -11,10 +11,11 @@ Build-Type:          Simple
 Cabal-Version:       >=1.10
 Stability:           Stable
 Description:         Scalable timer functions provided by a timer manager.
+Extra-Source-Files:  ChangeLog.md
 
 Library
   Build-Depends:     base                      >= 4.12       && < 5
-                   , auto-update
+                   , auto-update               >= 0.2        && < 0.3
                    , unliftio
   Default-Language:  Haskell2010
   Exposed-modules:   System.TimeManager

warp/ChangeLog.md

@@ -1,5 +1,10 @@
 # ChangeLog for warp
 
+## 3.4.1
+
+* Using time-manager v0.1.0, and auto-update v0.2.0.
+  [#986](https://github.com/yesodweb/wai/pull/986)
+
 ## 3.4.0
 
 * Reworked request lines (`CRLF`) parsing: [#968](https://github.com/yesodweb/wai/pulls)

warp/warp.cabal

@@ -1,5 +1,5 @@
 Name:                warp
-Version:             3.4.0
+Version:             3.4.1
 Synopsis:            A fast, light-weight web server for WAI applications.
 License:             MIT
 License-file:        LICENSE
@@ -55,7 +55,7 @@ Library
                    , stm                       >= 2.3
                    , streaming-commons         >= 0.1.10
                    , text
-                   , time-manager
+                   , time-manager              >= 0.1      && < 0.2
                    , vault                     >= 0.3
                    , wai                       >= 3.2.4    && < 3.3
                    , word8