From 07e7cb43c9272184962b280c8c2f8a5ad39c02f2 Mon Sep 17 00:00:00 2001 From: Finley McIlwaine Date: Thu, 25 Apr 2024 17:01:39 -0700 Subject: [PATCH] Eagerly remove handles from the manager on `cancel` `cancel` used to mark the given `Handle` as `Canceled`, which relied on the reaper to run and clean up the `Canceled` handles. This is not good for long timeouts when many streams are opened, as a lot of `Canceled` handles build up in the reaper's workload. This commit uses the reaper's new `reaperModify` API to immediately remove the given `Handle` in `cancel`. This obsoletes the `Canceled` constructor of `State`, so we remove that as well. We update the time-manager dependency of warp to include the new changes as well. The related auto-update changes are in PR #985. --- time-manager/ChangeLog.md | 8 +++++++ time-manager/System/TimeManager.hs | 36 ++++++++++++++++++------------ time-manager/time-manager.cabal | 5 +++-- warp/ChangeLog.md | 5 +++++ warp/warp.cabal | 4 ++-- 5 files changed, 40 insertions(+), 18 deletions(-) create mode 100644 time-manager/ChangeLog.md diff --git a/time-manager/ChangeLog.md b/time-manager/ChangeLog.md new file mode 100644 index 000000000..7656f0e72 --- /dev/null +++ b/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. diff --git a/time-manager/System/TimeManager.hs b/time-manager/System/TimeManager.hs index dba938f7b..f9e267af2 100644 --- a/time-manager/System/TimeManager.hs +++ b/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'. diff --git a/time-manager/time-manager.cabal b/time-manager/time-manager.cabal index d90a16ba9..616f95604 100644 --- a/time-manager/time-manager.cabal +++ b/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 diff --git a/warp/ChangeLog.md b/warp/ChangeLog.md index ea9b3bb61..89e9d41f4 100644 --- a/warp/ChangeLog.md +++ b/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) diff --git a/warp/warp.cabal b/warp/warp.cabal index 9d0e12a1f..99b266f83 100644 --- a/warp/warp.cabal +++ b/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