timeout-snooze (empty) → 0.1.0.0

raw patch · 7 files changed

+265/−0 lines, 7 filesdep +basedep +hspecdep +stmsetup-changed

Dependencies added: base, hspec, stm, stm-delay, timeout-snooze, unliftio

Files

• CHANGELOG.md +11/−0
• LICENSE +26/−0
• README.md +98/−0
• Setup.hs +3/−0
• src/System/Timeout/Snooze.hs +42/−0
• test/Spec.hs +23/−0
• timeout-snooze.cabal +62/−0

@@ -0,0 +1,11 @@+# Changelog for `timeout-snooze`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD

@@ -0,0 +1,26 @@+Copyright 2025 Author name here++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1.  Redistributions of source code must retain the above copyright notice, this+    list of conditions and the following disclaimer.++2.  Redistributions in binary form must reproduce the above copyright notice,+    this list of conditions and the following disclaimer in the documentation+    and/or other materials provided with the distribution.++3.  Neither the name of the copyright holder nor the names of its contributors+    may be used to endorse or promote products derived from this software+    without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,98 @@+# timeout-snooze++This package provides a `Timeout` that can be snoozed, allowing you to give extra time to the action.++The primary purpose of this package is to support a timeout for `hspec` tests that can be reset during flaky test detection (where we rerun a test case, and if it succeeds the second time, we call it a flake).+When we initially implemented flaky test detection, we simply doubled our timeout, but this is unnecessarily lax, and makes true problems take twice as long to be detected.++The system is based on the `stm-delay` package, which leverages the GHC event manager API.+This package incurs a single thread overhead for `race` for the timeout.++## Comparison with Existing Implementations++### `System.Timeout`++This module lives in `base` and gives you an efficient function:++```haskell+timeout :: Int -> IO a -> IO (Maybe a)+```++However, it is not possible to extend the timeout.++### [`time-manager`](https://www.stackage.org/haddock/lts-24.12/time-manager-0.2.3/System-TimeManager.html) `System.TimeManager`++This implementation is used in warp to provide slow loris protection.+This is a bit heavier duty.+Instead of forking a thread for each action, a `Manager` is used to store a list of timeout actions.+The `Manager` thread wakes every `N` microseconds, looks through the list of actions, and toggles them to `Inactive` if they are `Active`.+The next `N` microseconds, if an action is still `Inactive`, then it is canceled.++The `Handle` can be `tickle`d to reset the state to `Active`, or `pause` can be used to pause the time.+However, the actual time delay of the action is set to the `Manager`, which means that different tests cannot have different timeouts.+We have some known long running tests, and so we need configurable timeouts in our implementation.+For this reason, `time-manager` is not suitable.++### [`timer-wheel`](https://hackage.haskell.org/package/timer-wheel)++`TimerWheel` allows us to create timers and is efficiently designed.+Timers can be set arbitrarily far in the future, so we do get customizable timeouts.+However, there doesn't appear to be a way to reset the timer, so this does not satisfy our needs.++Additionally, it relies on a `ki` library which has an opinionated notion of how concurrency is done.+The assumptions made in `ki` are invalid in `hspec`, which renders it useless to me.++### [`async-timer`](https://hackage.haskell.org/package/async-timer)++The package `async-timer` allows for customizable `TimeoutConf`, and the given `Timer` can be reset.+The actual timer loop is implemented using `Control.Concurrent.Async.race`.++I believe this could be used for my purpose.+We would write:++```haskell+timeoutKillThread :: Int -> (IO () -> IO a) -> IO (Maybe a)+timeoutKillThread micros action = do+    let conf = setInterval micros defaultConf+    withAsyncTimer conf \timer -> do+        ea <- race (wait timer) (action (reset timer))+        case ea of+            Left e -> pure Nothing+            Right a -> pure (Just a)+```++Now, this is a bit unsatisfying to me.+I don't think I am so performance sensitive here that I want to go the `time-manager` approach with a global registered reaper thread instead of `N` reaper threads - the complexity there is challenging, particularly since extending that design with custom timeouts would be tricky.+But this implementation here requires us to fork *many* threads:++1. `withAsyncTimer` forks a thread for `timerLoop` in a `withAsync`+2. We fork a thread with `race` for `wait timer`+3. `timerLoop` does `race`, forking an additional thread for the sleep.++That's `3N` extra threads.+That's quite a lot of overhead.++### [`stm-delay`](https://hackage.haskell.org/package/stm-delay)++This package uses the GHC event manager, which makes it the most efficient option: no threads are forked for the timer, just a registered action.++My primary reservation with the library is age.+It was initially written in 2012, updated in 2014, but it did receive a patch in 2024.++This allows us to write:++```haskell+timeoutKillThread :: Int -> (IO () -> IO a) -> IO (Maybe a)+timeoutKillThread micros action = do+    delay <- newDelay micros +    let bump = updateDelay delay micros+    ea <- race (atomically (waitDelay delay)) (action bump)+    case ea of+        Left () -> pure Nothing+        Right a -> pure (Just a)+```++We incur an extra thread for `race`.+We could avoid that, but it would essentially require us re-implementing the `stm-delay` but instead of `writeTVar` we'd be doing `killThread` - which the docs for [`TimeoutCallback`](https://www.stackage.org/haddock/lts-24.12/base-4.20.2.0/GHC-Event.html#t:TimeoutCallback) explicitly warn against.++I'm pretty pleased with a single thread overhead.

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,42 @@+-- | This module provides a 'Timeout' that can be remotely reset, allowing+-- the timeout to be extended.+module System.Timeout.Snooze+    ( timeoutWithSnooze+    , SnoozeHandle+    , snooze+    ) where++import Control.Concurrent.STM.Delay+import UnliftIO++-- | A 'SnoozeHandle' is a handle that allows you to reset the timeout for+-- the given action.+--+-- @since 0.1.0.0+newtype SnoozeHandle = SnoozeHandle (IO ())++-- | Reset the timeout to the original delay given in 'timeoutWithSnooze'.+--+-- @since 0.1.0.0+snooze :: (MonadIO m) => SnoozeHandle -> m ()+snooze (SnoozeHandle action) = liftIO action++-- | Like "System.Timeout".'System.Timeout.timeout', but also passes+-- a 'SnoozeHandle' into the callback. This 'SnoozeHandle' can be 'snooze'd to reset+-- the timeout to the original delay.+--+-- @since 0.1.0.0+timeoutWithSnooze+    :: (MonadUnliftIO m) => Int -> (SnoozeHandle -> m a) -> m (Maybe a)+timeoutWithSnooze microseconds action = do+    delay <- liftIO $ newDelay microseconds+    let+        bump = updateDelay delay microseconds+        sleep = liftIO $ atomically $ waitDelay delay+        work = do+            liftIO bump+            action (SnoozeHandle bump)+    ea <- race sleep work+    case ea of+        Left () -> pure Nothing+        Right a -> pure (Just a)

@@ -0,0 +1,23 @@+import Control.Concurrent+import System.Timeout.Snooze+import Test.Hspec++main :: IO ()+main = hspec $ do+    describe "System.Timeout.Snooze" $ do+        it "times out a long running action" $ do+            munit <- timeoutWithSnooze 1000 $ \_ -> do+                threadDelay 2000+            munit `shouldBe` Nothing++        it "passes if you're fast enough" $ do+            munit <- timeoutWithSnooze 10000 $ \_ -> do+                threadDelay 1000+            munit `shouldBe` Just ()++        it "allows you to snooze" $ do+            munit <- timeoutWithSnooze 10000 $ \sn -> do+                threadDelay 9000+                snooze sn+                threadDelay 9000+            munit `shouldBe` Just ()

@@ -0,0 +1,62 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.38.0.+--+-- see: https://github.com/sol/hpack++name:           timeout-snooze+version:        0.1.0.0+synopsis:       Efficient timeout with reset+description:    Please see the README on GitHub at <https://github.com/parsonsmatt/timeout-snooze#readme>+category:       Concurrent+homepage:       https://github.com/parsonsmatt/timeout-snooze#readme+bug-reports:    https://github.com/parsonsmatt/timeout-snooze/issues+author:         Matt Parsons+maintainer:     parsonsmatt@gmail.com+copyright:      2025 Matt Parsons+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/parsonsmatt/timeout-snooze++library+  exposed-modules:+      System.Timeout.Snooze+  other-modules:+      Paths_timeout_snooze+  autogen-modules:+      Paths_timeout_snooze+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , stm+    , stm-delay+    , unliftio+  default-language: Haskell2010++test-suite timeout-snooze-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_timeout_snooze+  autogen-modules:+      Paths_timeout_snooze+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , hspec+    , stm+    , stm-delay+    , timeout-snooze+    , unliftio+  default-language: Haskell2010