From 4a256020c3ea859d9c0fbac5c2842e3626d69f37 Mon Sep 17 00:00:00 2001 From: Ilias Tsitsimpis Date: Sat, 29 Sep 2018 18:51:10 +0100 Subject: [PATCH] Import haskell-retry_0.7.7.0.orig.tar.gz [dgit import orig haskell-retry_0.7.7.0.orig.tar.gz] --- LICENSE | 30 ++ README.md | 37 ++ Setup.hs | 2 + changelog.md | 99 +++++ retry.cabal | 85 +++++ src/Control/Retry.hs | 732 ++++++++++++++++++++++++++++++++++++ test/Main.hs | 22 ++ test/Tests/Control/Retry.hs | 376 ++++++++++++++++++ 8 files changed, 1383 insertions(+) create mode 100644 LICENSE create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 changelog.md create mode 100644 retry.cabal create mode 100644 src/Control/Retry.hs create mode 100644 test/Main.hs create mode 100644 test/Tests/Control/Retry.hs diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..f42500f --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Ozgun Ataman + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of Ozgun Ataman nor the names of other + 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 +OWNER 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. diff --git a/README.md b/README.md new file mode 100644 index 0000000..fb0dc18 --- /dev/null +++ b/README.md @@ -0,0 +1,37 @@ +# README [![Build Status](https://travis-ci.org/Soostone/retry.svg?branch=master)](https://travis-ci.org/Soostone/retry) [![Coverage Status](https://coveralls.io/repos/Soostone/retry/badge.png?branch=master)](https://coveralls.io/r/Soostone/retry?branch=master) + +retry - combinators for monadic actions that may fail + +## About + +Monadic action combinators that add delayed-retry functionality, +potentially with exponential-backoff, to arbitrary actions. + +The main purpose of this package is to make it easy to work reliably +with IO and similar actions that often fail. Common examples are +database queries and large file uploads. + + +## Documentation + +Please see haddocks for documentation. + +## Changes + +See [https://github.com/Soostone/retry/blob/master/changelog.md](changelog.md). + +## Author + +Ozgun Ataman, Soostone Inc + + +## Contributors + +Contributors, please list yourself here. + +- Mitsutoshi Aoe (@maoe) +- John Wiegley +- Michael Snoyman +- Michael Xavier +- Marco Zocca (@ocramz) + diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/changelog.md b/changelog.md new file mode 100644 index 0000000..92c3f68 --- /dev/null +++ b/changelog.md @@ -0,0 +1,99 @@ +0.7.7.0 +* Add `natTransformRetryPolicy` + +0.7.6.3 +* Documentation fix on `recoverAll` + +0.7.6.2 +* Loosen bounds on exceptions again. + +0.7.6.1 +* Loosen bounds on exceptions. + +0.7.6.0 +* Clarify the semantics of `limitRetriesByDelay`. +* Add `limitRetriesByCumulativeDelay` + +0.7.5.1 +* Improve haddocks for fullJitterBackoff. + +0.7.5.0 +* Add Semigroup instance when the Semigroup class is available through base. + +0.7.4.3 +* Loosen dependency upper bounds. + +0.7.5 +* Add skipAsyncExceptions helper function + +0.7.4.2 +* Loosen HUnit dependency for tests. + +0.7.4.1 +* Loosen QuickCheck dependency for tests. + +0.7.4 +* Widen transformers dependency + +0.7.3 +* Widen ghc-prim dependency for GHC 8 + +0.7.2 +* Fix premature integer overflow error thanks to Mitsutoshi Aoe + +0.7.1 +* Various documentation updates. +* Add stepping combinator for manual retries. +* Add applyPolicy and applyAndDelay +* Add Read instance for RetryStatus +* Fix logic bug in rsPreviousDelay in first retry + +0.7.0.1 +* Officially drop support for GHC < 7.6 due to usage of Generics. + +0.7 +* RetryPolicy has become RetryPolicyM, allowing for policy logic to + consult the monad context. +* RetryPolicyM now takes a RetryStatus value. Use the function + rsIterNum to preserve existing behavior of RetryPolicy only + receiving the number. +* The monadic action now gets the RetryStatus on each try. Use const + if you don't need it. +* recoverAll explicitly does not handle the standard async + exceptions. Users are encouraged to do the same when using + recovering, as catching async exceptions can be hazardous. +* We no longer re-export (<>) from Monoid. +* Utility functions simulatePolicy and simulatePolicyPP have been + added which help predict how a policy will behave on each iteration. + +0.6 + +* Actions are now retried in the original masking state, while + handlers continue to run in `MaskedInterruptible` (@maoe) +* Added several tests confirming exception hierarchy semantics under + `recovering` (@ozataman) + +0.5 + +* Mitsutoshi's backoff work inspired a complete redo of the + RetryPolicy interface, replacing it with a monoidal RetryPolicy. The + result is a much thinner API that actually provides much more power + to the end user. +* Now using microseconds in all premade policies. PLEASE TAKE CARE + WHEN UPGRADING. It was a bad idea to use miliseconds and deviate + from norms in the first place. + +0.4 + +* Transitioned to using Edward Kmett's exceptions package instead of + monad-control. Use 0.3 series if you still need monad-control + support. + +0.3 + +Thanks to John Wiegley and Michael Snoyman for their contributions: + +* Now using monad-control instead of MonadCatchIO, which is widely + agreed to be broken. +* Now using transformers instead of mtl, which was a broader than + needed dependency. diff --git a/retry.cabal b/retry.cabal new file mode 100644 index 0000000..4764f24 --- /dev/null +++ b/retry.cabal @@ -0,0 +1,85 @@ +name: retry + +description: + + This package exposes combinators that can wrap arbitrary + monadic actions. They run the action and potentially retry + running it with some configurable delay for a configurable + number of times. + + The purpose is to make it easier to work with IO and + especially network IO actions that often experience temporary + failure and warrant retrying of the original action. For + example, a database query may time out for a while, in which + case we should hang back for a bit and retry the query instead + of simply raising an exception. + +version: 0.7.7.0 +synopsis: Retry combinators for monadic actions that may fail +license: BSD3 +license-file: LICENSE +author: Ozgun Ataman +maintainer: ozgun.ataman@soostone.com +copyright: Ozgun Ataman, Soostone Inc +category: Control +build-type: Simple +cabal-version: >=1.10 +homepage: http://github.com/Soostone/retry +extra-source-files: + README.md + changelog.md + +flag lib-Werror + default: False + manual: True + +library + exposed-modules: Control.Retry + build-depends: + base >= 4.6 && < 5 + , data-default-class + , exceptions >= 0.5 && < 0.11 + , ghc-prim < 0.6 + , random >= 1 && < 1.2 + , transformers < 0.7 + hs-source-dirs: src + default-language: Haskell2010 + + if flag(lib-Werror) + ghc-options: -Werror + + ghc-options: -Wall + + +test-suite test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test,src + ghc-options: -threaded + other-modules: Control.Retry + Tests.Control.Retry + build-depends: + base ==4.* + , exceptions + , transformers + , data-default-class + , random + , time + , HUnit >= 1.2.5.2 + , tasty + , tasty-hunit + , tasty-hedgehog + , hedgehog + , stm + , ghc-prim + , mtl + default-language: Haskell2010 + + if flag(lib-Werror) + ghc-options: -Werror + + ghc-options: -Wall + +source-repository head + type: git + location: git://github.com/Soostone/retry.git diff --git a/src/Control/Retry.hs b/src/Control/Retry.hs new file mode 100644 index 0000000..d658790 --- /dev/null +++ b/src/Control/Retry.hs @@ -0,0 +1,732 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE ViewPatterns #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Control.Retry +-- Copyright : Ozgun Ataman +-- License : BSD3 +-- +-- Maintainer : Ozgun Ataman +-- Stability : provisional +-- +-- This module exposes combinators that can wrap arbitrary monadic +-- actions. They run the action and potentially retry running it with +-- some configurable delay for a configurable number of times. +-- +-- The express purpose of this library is to make it easier to work +-- with IO and especially network IO actions that often experience +-- temporary failure that warrant retrying of the original action. For +-- example, a database query may time out for a while, in which case +-- we should delay a bit and retry the query. +---------------------------------------------------------------------------- + + +module Control.Retry + ( + -- * Types and Operations + RetryPolicyM (..) + , RetryPolicy + , retryPolicy + , natTransformRetryPolicy + , RetryStatus (..) + , defaultRetryStatus + , applyPolicy + , applyAndDelay + + + -- ** Lenses for 'RetryStatus' + , rsIterNumberL + , rsCumulativeDelayL + , rsPreviousDelayL + + -- * Applying Retry Policies + , retrying + , recovering + , stepping + , recoverAll + , skipAsyncExceptions + , logRetries + , defaultLogMsg + + -- * Retry Policies + , constantDelay + , exponentialBackoff + , fullJitterBackoff + , fibonacciBackoff + , limitRetries + + -- * Policy Transformers + , limitRetriesByDelay + , limitRetriesByCumulativeDelay + , capDelay + + -- * Development Helpers + , simulatePolicy + , simulatePolicyPP + ) where + +------------------------------------------------------------------------------- +import Control.Applicative +import Control.Concurrent +#if MIN_VERSION_base(4, 7, 0) +import Control.Exception (AsyncException, SomeAsyncException) +#else +import Control.Exception (AsyncException) +#endif +import Control.Monad +import Control.Monad.Catch +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Control.Monad.Trans.Maybe +import Control.Monad.Trans.State +import Data.Default.Class +import Data.List (foldl') +import Data.Maybe +import GHC.Generics +import GHC.Prim +import GHC.Types (Int(I#)) +import System.Random +# if MIN_VERSION_base(4, 9, 0) +import Data.Semigroup +# else +import Data.Monoid +# endif +import Prelude +------------------------------------------------------------------------------- + + +------------------------------------------------------------------------------- +-- | A 'RetryPolicyM' is a function that takes an 'RetryStatus' and +-- possibly returns a delay in microseconds. Iteration numbers start +-- at zero and increase by one on each retry. A *Nothing* return value from +-- the function implies we have reached the retry limit. +-- +-- Please note that 'RetryPolicyM' is a 'Monoid'. You can collapse +-- multiple strategies into one using 'mappend' or '<>'. The semantics +-- of this combination are as follows: +-- +-- 1. If either policy returns 'Nothing', the combined policy returns +-- 'Nothing'. This can be used to @inhibit@ after a number of retries, +-- for example. +-- +-- 2. If both policies return a delay, the larger delay will be used. +-- This is quite natural when combining multiple policies to achieve a +-- certain effect. +-- +-- Example: +-- +-- One can easily define an exponential backoff policy with a limited +-- number of retries: +-- +-- >> limitedBackoff = exponentialBackoff 50 <> limitRetries 5 +-- +-- Naturally, 'mempty' will retry immediately (delay 0) for an +-- unlimited number of retries, forming the identity for the 'Monoid'. +-- +-- The default under 'def' implements a constant 50ms delay, up to 5 times: +-- +-- >> def = constantDelay 50000 <> limitRetries 5 +-- +-- For anything more complex, just define your own 'RetryPolicyM': +-- +-- >> myPolicy = retryPolicy $ \ rs -> if rsIterNumber n > 10 then Just 1000 else Just 10000 +-- +-- Since 0.7. +newtype RetryPolicyM m = RetryPolicyM { getRetryPolicyM :: RetryStatus -> m (Maybe Int) } + + +-- | Simplified 'RetryPolicyM' without any use of the monadic context in +-- determining policy. Mostly maintains backwards compatitibility with +-- type signatures pre-0.7. +type RetryPolicy = forall m . Monad m => RetryPolicyM m + + +instance Monad m => Default (RetryPolicyM m) where + def = constantDelay 50000 <> limitRetries 5 + + +-- Base 4.9.0 adds a Data.Semigroup module. This has fewer +-- dependencies than the semigroups package, so we're using base's +-- only if its available. +# if MIN_VERSION_base(4, 9, 0) +instance Monad m => Semigroup (RetryPolicyM m) where + (RetryPolicyM a) <> (RetryPolicyM b) = RetryPolicyM $ \ n -> runMaybeT $ do + a' <- MaybeT $ a n + b' <- MaybeT $ b n + return $! max a' b' + + +instance Monad m => Monoid (RetryPolicyM m) where + mempty = retryPolicy $ const (Just 0) + mappend = (<>) +# else +instance Monad m => Monoid (RetryPolicyM m) where + mempty = retryPolicy $ const (Just 0) + (RetryPolicyM a) `mappend` (RetryPolicyM b) = RetryPolicyM $ \ n -> runMaybeT $ do + a' <- MaybeT $ a n + b' <- MaybeT $ b n + return $! max a' b' +#endif + + +------------------------------------------------------------------------------- +-- | Applies a natural transformation to a policy to run a RetryPolicy +-- meant for the monad @m@ in the monad @n@ provided a transformation +-- from @m@ to @n@ is available. A common case is if you have a pure +-- policy, @RetryPolicyM Identity@ and want to use it to govern an +-- @IO@ computation you could write: +-- +-- @ +-- purePolicyInIO :: RetryPolicyM Identity -> RetryPolicyM IO +-- purePolicyInIO = natTransformRetryPolicy (pure . runIdentity) +-- @ +natTransformRetryPolicy :: (forall a. m a -> n a) -> RetryPolicyM m -> RetryPolicyM n +natTransformRetryPolicy f (RetryPolicyM p) = RetryPolicyM $ \stat -> f (p stat) + + +------------------------------------------------------------------------------- +-- | Datatype with stats about retries made thus far. The constructor +-- is deliberately not exported to make additional fields easier to +-- add in a backward-compatible manner. To read or modify fields in +-- RetryStatus, use the accessors or lenses below. Note that if you +-- don't want to use lenses, the exported field names can be used for +-- updates: +-- +-- >> retryStatus { rsIterNumber = newIterNumber } +-- >> retryStatus & rsIterNumberL .~ newIterNumber +data RetryStatus = RetryStatus + { rsIterNumber :: !Int -- ^ Iteration number, where 0 is the first try + , rsCumulativeDelay :: !Int -- ^ Delay incurred so far from retries in microseconds + , rsPreviousDelay :: !(Maybe Int) -- ^ Latest attempt's delay. Will always be Nothing on first run. + } deriving (Read, Show, Eq, Generic) + + +------------------------------------------------------------------------------- +-- | Initial, default retry status. Exported mostly to allow user code +-- to test their handlers and retry policies. Use fields or lenses to update. +defaultRetryStatus :: RetryStatus +defaultRetryStatus = RetryStatus 0 0 Nothing + +------------------------------------------------------------------------------- +rsIterNumberL :: Lens' RetryStatus Int +rsIterNumberL = lens rsIterNumber (\rs x -> rs { rsIterNumber = x }) +{-# INLINE rsIterNumberL #-} + + +------------------------------------------------------------------------------- +rsCumulativeDelayL :: Lens' RetryStatus Int +rsCumulativeDelayL = lens rsCumulativeDelay (\rs x -> rs { rsCumulativeDelay = x }) +{-# INLINE rsCumulativeDelayL #-} + + +------------------------------------------------------------------------------- +rsPreviousDelayL :: Lens' RetryStatus (Maybe Int) +rsPreviousDelayL = lens rsPreviousDelay (\rs x -> rs { rsPreviousDelay = x }) +{-# INLINE rsPreviousDelayL #-} + + + +------------------------------------------------------------------------------- +-- | Apply policy on status to see what the decision would be. +-- 'Nothing' implies no retry, 'Just' returns updated status. +applyPolicy + :: Monad m + => RetryPolicyM m + -> RetryStatus + -> m (Maybe RetryStatus) +applyPolicy (RetryPolicyM policy) s = do + res <- policy s + case res of + Just delay -> return $! Just $! RetryStatus + { rsIterNumber = rsIterNumber s + 1 + , rsCumulativeDelay = rsCumulativeDelay s `boundedPlus` delay + , rsPreviousDelay = Just delay } + Nothing -> return Nothing + + +------------------------------------------------------------------------------- +-- | Apply policy and delay by its amount if it results in a retry. +-- Return updated status. +applyAndDelay + :: MonadIO m + => RetryPolicyM m + -> RetryStatus + -> m (Maybe RetryStatus) +applyAndDelay policy s = do + chk <- applyPolicy policy s + case chk of + Just rs -> do + case (rsPreviousDelay rs) of + Nothing -> return () + Just delay -> liftIO $ threadDelay delay + return (Just rs) + Nothing -> return Nothing + + + +------------------------------------------------------------------------------- +-- | Helper for making simplified policies that don't use the monadic +-- context. +retryPolicy :: (RetryStatus -> Maybe Int) -> RetryPolicy +retryPolicy f = RetryPolicyM $ \ s -> return (f s) + + +------------------------------------------------------------------------------- +-- | Retry immediately, but only up to @n@ times. +limitRetries + :: Int + -- ^ Maximum number of retries. + -> RetryPolicy +limitRetries i = retryPolicy $ \ RetryStatus { rsIterNumber = n} -> if n >= i then Nothing else (Just 0) + + +------------------------------------------------------------------------------- +-- | Add an upperbound to a policy such that once the given time-delay +-- amount *per try* has been reached or exceeded, the policy will stop +-- retrying and fail. If you need to stop retrying once *cumulative* +-- delay reaches a time-delay amount, use +-- 'limitRetriesByCumulativeDelay' +limitRetriesByDelay + :: Monad m + => Int + -- ^ Time-delay limit in microseconds. + -> RetryPolicyM m + -> RetryPolicyM m +limitRetriesByDelay i p = RetryPolicyM $ \ n -> + (>>= limit) `liftM` getRetryPolicyM p n + where + limit delay = if delay >= i then Nothing else Just delay + + +------------------------------------------------------------------------------- +-- | Add an upperbound to a policy such that once the cumulative delay +-- over all retries has reached or exceeded the given limit, the +-- policy will stop retrying and fail. +limitRetriesByCumulativeDelay + :: Monad m + => Int + -- ^ Time-delay limit in microseconds. + -> RetryPolicyM m + -> RetryPolicyM m +limitRetriesByCumulativeDelay cumulativeLimit p = RetryPolicyM $ \ stat -> + (>>= limit stat) `liftM` getRetryPolicyM p stat + where + limit status curDelay + | rsCumulativeDelay status `boundedPlus` curDelay > cumulativeLimit = Nothing + | otherwise = Just curDelay + + +------------------------------------------------------------------------------- +-- | Implement a constant delay with unlimited retries. +constantDelay + :: Int + -- ^ Base delay in microseconds + -> RetryPolicy +constantDelay delay = retryPolicy (const (Just delay)) + + +------------------------------------------------------------------------------- +-- | Grow delay exponentially each iteration. Each delay will +-- increase by a factor of two. +exponentialBackoff + :: Int + -- ^ Base delay in microseconds + -> RetryPolicy +exponentialBackoff base = retryPolicy $ \ RetryStatus { rsIterNumber = n } -> + Just $! base `boundedMult` boundedPow 2 n + +------------------------------------------------------------------------------- +-- | FullJitter exponential backoff as explained in AWS Architecture +-- Blog article. +-- +-- @http:\/\/www.awsarchitectureblog.com\/2015\/03\/backoff.html@ +-- +-- temp = min(cap, base * 2 ** attempt) +-- +-- sleep = temp \/ 2 + random_between(0, temp \/ 2) +fullJitterBackoff + :: MonadIO m + => Int + -- ^ Base delay in microseconds + -> RetryPolicyM m +fullJitterBackoff base = RetryPolicyM $ \ RetryStatus { rsIterNumber = n } -> do + let d = (base `boundedMult` boundedPow 2 n) `div` 2 + rand <- liftIO $ randomRIO (0, d) + return $! Just $! d `boundedPlus` rand + + +------------------------------------------------------------------------------- +-- | Implement Fibonacci backoff. +fibonacciBackoff + :: Int + -- ^ Base delay in microseconds + -> RetryPolicy +fibonacciBackoff base = retryPolicy $ \RetryStatus { rsIterNumber = n } -> + Just $ fib (n + 1) (0, base) + where + fib 0 (a, _) = a + fib !m (!a, !b) = fib (m-1) (b, a `boundedPlus` b) + + +------------------------------------------------------------------------------- +-- | Set a time-upperbound for any delays that may be directed by the +-- given policy. This function does not terminate the retrying. The policy +-- `capDelay maxDelay (exponentialBackoff n)` will never stop retrying. It +-- will reach a state where it retries forever with a delay of `maxDelay` +-- between each one. To get termination you need to use one of the +-- 'limitRetries' function variants. +capDelay + :: Monad m + => Int + -- ^ A maximum delay in microseconds + -> RetryPolicyM m + -> RetryPolicyM m +capDelay limit p = RetryPolicyM $ \ n -> + (fmap (min limit)) `liftM` (getRetryPolicyM p) n + + +------------------------------------------------------------------------------- +-- | Retry combinator for actions that don't raise exceptions, but +-- signal in their type the outcome has failed. Examples are the +-- 'Maybe', 'Either' and 'EitherT' monads. +-- +-- Let's write a function that always fails and watch this combinator +-- retry it 5 additional times following the initial run: +-- +-- >>> import Data.Maybe +-- >>> let f _ = putStrLn "Running action" >> return Nothing +-- >>> retrying def (const $ return . isNothing) f +-- Running action +-- Running action +-- Running action +-- Running action +-- Running action +-- Running action +-- Nothing +-- +-- Note how the latest failing result is returned after all retries +-- have been exhausted. +retrying :: MonadIO m + => RetryPolicyM m + -> (RetryStatus -> b -> m Bool) + -- ^ An action to check whether the result should be retried. + -- If True, we delay and retry the operation. + -> (RetryStatus -> m b) + -- ^ Action to run + -> m b +retrying policy chk f = go defaultRetryStatus + where + go s = do + res <- f s + chk' <- chk s res + case chk' of + True -> do + rs <- applyAndDelay policy s + case rs of + Nothing -> return res + Just rs' -> go $! rs' + False -> return res + + +------------------------------------------------------------------------------- +-- | Retry ALL exceptions that may be raised. To be used with caution; +-- this matches the exception on 'SomeException'. Note that this +-- handler explicitly does not handle 'AsyncException' nor +-- 'SomeAsyncException' (for versions of base >= 4.7). It is not a +-- good idea to catch async exceptions as it can result in hanging +-- threads and programs. Note that if you just throw an exception to +-- this thread that does not descend from SomeException, recoverAll +-- will not catch it. +-- +-- See how the action below is run once and retried 5 more times +-- before finally failing for good: +-- +-- >>> let f _ = putStrLn "Running action" >> error "this is an error" +-- >>> recoverAll def f +-- Running action +-- Running action +-- Running action +-- Running action +-- Running action +-- Running action +-- *** Exception: this is an error +recoverAll +#if MIN_VERSION_exceptions(0, 6, 0) + :: (MonadIO m, MonadMask m) +#else + :: (MonadIO m, MonadCatch m) +#endif + => RetryPolicyM m + -> (RetryStatus -> m a) + -> m a +recoverAll set f = recovering set handlers f + where + handlers = skipAsyncExceptions ++ [h] + h _ = Handler $ \ (_ :: SomeException) -> return True + + +------------------------------------------------------------------------------- +-- | List of pre-made handlers that will skip retries on +-- 'AsyncException' and 'SomeAsyncException'. Append your handlers to +-- this list as a convenient way to make sure you're not catching +-- async exceptions like user interrupt. +skipAsyncExceptions + :: ( MonadIO m + ) + => [RetryStatus -> Handler m Bool] +skipAsyncExceptions = handlers + where + asyncH _ = Handler $ \ (_ :: AsyncException) -> return False +#if MIN_VERSION_base(4, 7, 0) + someAsyncH _ = Handler $ \(_ :: SomeAsyncException) -> return False + handlers = [asyncH, someAsyncH] +#else + handlers = [asyncH] +#endif + + +------------------------------------------------------------------------------- +-- | Run an action and recover from a raised exception by potentially +-- retrying the action a number of times. Note that if you're going to +-- use a handler for 'SomeException', you should add explicit cases +-- *earlier* in the list of handlers to reject 'AsyncException' and +-- 'SomeAsyncException', as catching these can cause thread and +-- program hangs. 'recoverAll' already does this for you so if you +-- just plan on catching 'SomeException', you may as well ues +-- 'recoverAll' +recovering +#if MIN_VERSION_exceptions(0, 6, 0) + :: (MonadIO m, MonadMask m) +#else + :: (MonadIO m, MonadCatch m) +#endif + => RetryPolicyM m + -- ^ Just use 'def' for default settings + -> [(RetryStatus -> Handler m Bool)] + -- ^ Should a given exception be retried? Action will be + -- retried if this returns True *and* the policy allows it. + -- This action will be consulted first even if the policy + -- later blocks it. + -> (RetryStatus -> m a) + -- ^ Action to perform + -> m a +recovering policy hs f = mask $ \restore -> go restore defaultRetryStatus + where + go restore = loop + where + loop s = do + r <- try $ restore (f s) + case r of + Right x -> return x + Left e -> recover (e :: SomeException) hs + where + recover e [] = throwM e + recover e ((($ s) -> Handler h) : hs') + | Just e' <- fromException e = do + chk <- h e' + case chk of + True -> do + rs <- applyAndDelay policy s + case rs of + Just rs' -> loop $! rs' + Nothing -> throwM e' + False -> throwM e' + | otherwise = recover e hs' + + + +------------------------------------------------------------------------------- +-- | A version of 'recovering' that tries to run the action only a +-- single time. The control will return immediately upon both success +-- and failure. Useful for implementing retry logic in distributed +-- queues and similar external-interfacing systems. +stepping +#if MIN_VERSION_exceptions(0, 6, 0) + :: (MonadIO m, MonadMask m) +#else + :: (MonadIO m, MonadCatch m) +#endif + => RetryPolicyM m + -- ^ Just use 'def' for default settings + -> [(RetryStatus -> Handler m Bool)] + -- ^ Should a given exception be retried? Action will be + -- retried if this returns True *and* the policy allows it. + -- This action will be consulted first even if the policy + -- later blocks it. + -> (RetryStatus -> m ()) + -- ^ Action to run with updated status upon failure. + -> (RetryStatus -> m a) + -- ^ Main action to perform with current status. + -> RetryStatus + -- ^ Current status of this step + -> m (Maybe a) +stepping policy hs schedule f s = do + r <- try $ f s + case r of + Right x -> return $ Just x + Left e -> recover (e :: SomeException) hs + where + recover e [] = throwM e + recover e ((($ s) -> Handler h) : hs') + | Just e' <- fromException e = do + chk <- h e' + case chk of + True -> do + res <- applyPolicy policy s + case res of + Just rs -> do + schedule $! rs + return Nothing + Nothing -> throwM e' + False -> throwM e' + | otherwise = recover e hs' + + +------------------------------------------------------------------------------- +-- | Helper function for constructing handler functions of the form required +-- by 'recovering'. +logRetries + :: ( Monad m + , Exception e) + => (e -> m Bool) + -- ^ Test for whether action is to be retried + -> (Bool -> e -> RetryStatus -> m ()) + -- ^ How to report the generated warning message. Boolean is + -- whether it's being retried or crashed. + -> RetryStatus + -- ^ Retry number + -> Handler m Bool +logRetries test reporter status = Handler $ \ err -> do + result <- test err + reporter result err status + return result + +-- | For use with 'logRetries'. +defaultLogMsg :: (Exception e) => Bool -> e -> RetryStatus -> String +defaultLogMsg shouldRetry err status = + "[retry:" <> iter <> "] Encountered " <> show err <> ". " <> nextMsg + where + iter = show $ rsIterNumber status + nextMsg = if shouldRetry then "Retrying." else "Crashing." + + +------------------------------------------------------------------------------- +-- | Run given policy up to N iterations and gather results. In the +-- pair, the @Int@ is the iteration number and the @Maybe Int@ is the +-- delay in microseconds. +simulatePolicy :: Monad m => Int -> RetryPolicyM m -> m [(Int, Maybe Int)] +simulatePolicy n (RetryPolicyM f) = flip evalStateT defaultRetryStatus $ forM [0..n] $ \i -> do + stat <- get + delay <- lift (f stat) + put $! stat + { rsIterNumber = i + 1 + , rsCumulativeDelay = rsCumulativeDelay stat `boundedPlus` fromMaybe 0 delay + , rsPreviousDelay = delay + } + return (i, delay) + + +------------------------------------------------------------------------------- +-- | Run given policy up to N iterations and pretty print results on +-- the console. +simulatePolicyPP :: Int -> RetryPolicyM IO -> IO () +simulatePolicyPP n p = do + ps <- simulatePolicy n p + forM_ ps $ \ (iterNo, res) -> putStrLn $ + show iterNo <> ": " <> maybe "Inhibit" ppTime res + putStrLn $ "Total cumulative delay would be: " <> + (ppTime $ boundedSum $ (mapMaybe snd) ps) + + +------------------------------------------------------------------------------- +ppTime :: (Integral a, Show a) => a -> String +ppTime n | n < 1000 = show n <> "us" + | n < 1000000 = show ((fromIntegral n / 1000) :: Double) <> "ms" + | otherwise = show ((fromIntegral n / 1000) :: Double) <> "ms" + +------------------------------------------------------------------------------- +-- Bounded arithmetic +------------------------------------------------------------------------------- + +-- | Same as '+' on 'Int' but it maxes out at @'maxBound' :: 'Int'@ or +-- @'minBound' :: 'Int'@ rather than rolling over +boundedPlus :: Int -> Int -> Int +boundedPlus i@(I# i#) j@(I# j#) = case addIntC# i# j# of + (# k#, 0# #) -> I# k# + (# _, _ #) + | maxBy abs i j < 0 -> minBound + | otherwise -> maxBound + where + maxBy f a b = if f a >= f b then a else b + +-- | Same as '*' on 'Int' but it maxes out at @'maxBound' :: 'Int'@ or +-- @'minBound' :: 'Int'@ rather than rolling over +boundedMult :: Int -> Int -> Int +boundedMult i@(I# i#) j@(I# j#) = case mulIntMayOflo# i# j# of + 0# -> I# (i# *# j#) + _ | signum i * signum j < 0 -> minBound + | otherwise -> maxBound + +-- | Same as 'sum' on 'Int' but it maxes out at @'maxBound' :: 'Int'@ or +-- @'minBound' :: 'Int'@ rather than rolling over +boundedSum :: [Int] -> Int +boundedSum = foldl' boundedPlus 0 + +-- | Same as '^' on 'Int' but it maxes out at @'maxBound' :: 'Int'@ or +-- @'MinBound' :: 'Int'@ rather than rolling over +boundedPow :: Int -> Int -> Int +boundedPow x0 y0 + | y0 < 0 = error "Negative exponent" + | y0 == 0 = 1 + | otherwise = f x0 y0 + where + f x y + | even y = f (x `boundedMult` x) (y `quot` 2) + | y == 1 = x + | otherwise = g (x `boundedMult` x) ((y - 1) `quot` 2) x + g x y z + | even y = g (x `boundedMult` x) (y `quot` 2) z + | y == 1 = x `boundedMult` z + | otherwise = g (x `boundedMult` x) ((y - 1) `quot` 2) (x `boundedMult` z) + +------------------------------------------------------------------------------- +-- Lens machinery +------------------------------------------------------------------------------- +-- Unexported type aliases to clean up the documentation +type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t + +type Lens' s a = Lens s s a a + + +------------------------------------------------------------------------------- +lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b +lens sa sbt afb s = sbt s <$> afb (sa s) +{-# INLINE lens #-} + + + ------------------ + -- Simple Tests -- + ------------------ + + + +-- data TestException = TestException deriving (Show, Typeable) +-- data AnotherException = AnotherException deriving (Show, Typeable) + +-- instance Exception TestException +-- instance Exception AnotherException + + +-- test = retrying def [h1,h2] f +-- where +-- f = putStrLn "Running action" >> throwM AnotherException +-- h1 = Handler $ \ (e :: TestException) -> return False +-- h2 = Handler $ \ (e :: AnotherException) -> return True diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..e489715 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,22 @@ +module Main + ( main + ) where + + +------------------------------------------------------------------------------- +import Test.Tasty +------------------------------------------------------------------------------- +import qualified Tests.Control.Retry +------------------------------------------------------------------------------- + + + +main :: IO () +main = defaultMain tests + + +------------------------------------------------------------------------------- +tests :: TestTree +tests = testGroup "retry" + [ Tests.Control.Retry.tests + ] diff --git a/test/Tests/Control/Retry.hs b/test/Tests/Control/Retry.hs new file mode 100644 index 0000000..dcc5d20 --- /dev/null +++ b/test/Tests/Control/Retry.hs @@ -0,0 +1,376 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Tests.Control.Retry + ( tests + ) where + +------------------------------------------------------------------------------- +import Control.Applicative +import Control.Concurrent +import Control.Concurrent.STM as STM +import Control.Exception (AsyncException (..), IOException, + MaskingState (..), + getMaskingState, throwTo) +import Control.Monad.Catch +import Control.Monad.Identity +import Control.Monad.IO.Class +import Control.Monad.Writer.Strict +import Data.Default.Class (def) +import Data.Either +import Data.IORef +import Data.List +import Data.Maybe +import Data.Time.Clock +import Data.Time.LocalTime () +import Data.Typeable +import Hedgehog as HH +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import System.IO.Error +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.HUnit (assertBool, testCase, (@?=)) +------------------------------------------------------------------------------- +import Control.Retry +------------------------------------------------------------------------------- + + +tests :: TestTree +tests = testGroup "Control.Retry" + [ recoveringTests + , monoidTests + , retryStatusTests + , quadraticDelayTests + , policyTransformersTests + , maskingStateTests + , capDelayTests + , limitRetriesByCumulativeDelayTests + ] + + +------------------------------------------------------------------------------- +recoveringTests :: TestTree +recoveringTests = testGroup "recovering" + [ testProperty "recovering test without quadratic retry delay" $ property $ do + startTime <- liftIO getCurrentTime + timeout <- forAll (Gen.int (Range.linear 0 15)) + retries <- forAll (Gen.int (Range.linear 0 50)) + res <- liftIO $ try $ recovering + (constantDelay timeout <> limitRetries retries) + testHandlers + (const $ throwM (userError "booo")) + endTime <- liftIO getCurrentTime + HH.assert (isLeftAnd isUserError res) + let ms' = (fromInteger . toInteger $ (timeout * retries)) / 1000000.0 + HH.assert (diffUTCTime endTime startTime >= ms') + , testGroup "exception hierarchy semantics" + [ testCase "does not catch async exceptions" $ do + counter <- newTVarIO (0 :: Int) + done <- newEmptyMVar + let work = atomically (modifyTVar' counter succ) >> threadDelay 1000000 + + tid <- forkIO $ + recoverAll (limitRetries 2) (const work) `finally` putMVar done () + + atomically (STM.check . (== 1) =<< readTVar counter) + throwTo tid UserInterrupt + + takeMVar done + + count <- atomically (readTVar counter) + count @?= 1 + + , testCase "recovers from custom exceptions" $ do + f <- mkFailN Custom1 2 + res <- try $ recovering + (constantDelay 5000 <> limitRetries 3) + [const $ Handler $ \ Custom1 -> return shouldRetry] + f + (res :: Either Custom1 ()) @?= Right () + + , testCase "fails beyond policy using custom exceptions" $ do + f <- mkFailN Custom1 3 + res <- try $ recovering + (constantDelay 5000 <> limitRetries 2) + [const $ Handler $ \ Custom1 -> return shouldRetry] + f + (res :: Either Custom1 ()) @?= Left Custom1 + + , testCase "recoverAll won't catch exceptions which are not decendants of SomeException" $ do + f <- mkFailN Custom1 4 + res <- try $ recoverAll + (constantDelay 5000 <> limitRetries 3) + f + (res :: Either Custom1 ()) @?= Left Custom1 + + , testCase "does not recover from unhandled exceptions" $ do + f <- mkFailN Custom2 2 + res <- try $ recovering + (constantDelay 5000 <> limitRetries 5) + [const $ Handler $ \ Custom1 -> return shouldRetry] + f + (res :: Either Custom2 ()) @?= Left Custom2 + + + , testCase "recovers in presence of multiple handlers" $ do + f <- mkFailN Custom2 2 + res <- try $ recovering + (constantDelay 5000 <> limitRetries 5) + [ const $ Handler $ \ Custom1 -> return shouldRetry + , const $ Handler $ \ Custom2 -> return shouldRetry ] + f + (res :: Either Custom2 ()) @?= Right () + + + , testCase "general exceptions catch specific ones" $ do + f <- mkFailN Custom2 2 + res <- try $ recovering + (constantDelay 5000 <> limitRetries 5) + [ const $ Handler $ \ (_::SomeException) -> return shouldRetry ] + f + (res :: Either Custom2 ()) @?= Right () + + + , testCase "(redundant) even general catchers don't go beyond policy" $ do + f <- mkFailN Custom2 3 + res <- try $ recovering + (constantDelay 5000 <> limitRetries 2) + [ const $ Handler $ \ (_::SomeException) -> return shouldRetry ] + f + (res :: Either Custom2 ()) @?= Left Custom2 + + + , testCase "rethrows in presence of failed exception casts" $ do + f <- mkFailN Custom2 3 + final <- try $ do + res <- try $ recovering + (constantDelay 5000 <> limitRetries 2) + [ const $ Handler $ \ (_::SomeException) -> return shouldRetry ] + f + (res :: Either Custom1 ()) @?= Left Custom1 + final @?= Left Custom2 + ] + ] + + +------------------------------------------------------------------------------- +monoidTests :: TestTree +monoidTests = testGroup "Policy is a monoid" + [ testProperty "left identity" $ property $ + propIdentity (\p -> mempty <> p) id + , testProperty "right identity" $ property $ + propIdentity (\p -> p <> mempty) id + , testProperty "associativity" $ property $ + propAssociativity (\x y z -> x <> (y <> z)) (\x y z -> (x <> y) <> z) + ] + where + propIdentity left right = do + retryStatus <- forAll genRetryStatus + fixedDelay <- forAll (Gen.maybe (Gen.int (Range.linear 0 maxBound))) + let calculateDelay _rs = fixedDelay + let applyPolicy' f = getRetryPolicyM (f $ retryPolicy calculateDelay) retryStatus + validRes = maybe True (>= 0) + l <- liftIO $ applyPolicy' left + r <- liftIO $ applyPolicy' right + if validRes r && validRes l + then l === r + else return () + propAssociativity left right = do + retryStatus <- forAll genRetryStatus + let genDelay = Gen.maybe (Gen.int (Range.linear 0 maxBound)) + delayA <- forAll genDelay + delayB <- forAll genDelay + delayC <- forAll genDelay + let applyPolicy' f = liftIO $ getRetryPolicyM (f (retryPolicy (const delayA)) (retryPolicy (const delayB)) (retryPolicy (const delayC))) retryStatus + res <- liftIO (liftA2 (==) (applyPolicy' left) (applyPolicy' right)) + assert res + + +------------------------------------------------------------------------------- +retryStatusTests :: TestTree +retryStatusTests = testGroup "retry status" + [ testCase "passes the correct retry status each time" $ do + let policy = limitRetries 2 <> constantDelay 100 + rses <- gatherStatuses policy + rsIterNumber <$> rses @?= [0, 1, 2] + rsCumulativeDelay <$> rses @?= [0, 100, 200] + rsPreviousDelay <$> rses @?= [Nothing, Just 100, Just 100] + ] + + +------------------------------------------------------------------------------- +policyTransformersTests :: TestTree +policyTransformersTests = testGroup "policy transformers" + [ testProperty "always produces positive delay with positive constants (no rollover)" $ property $ do + delay <- forAll (Gen.int (Range.linear 0 maxBound)) + let res = runIdentity (simulatePolicy 1000 (exponentialBackoff delay)) + delays = catMaybes (snd <$> res) + mnDelay = if null delays + then Nothing + else Just (minimum delays) + case mnDelay of + Nothing -> return () + Just n -> do + footnote (show n ++ " is not >= 0") + HH.assert (n >= 0) + , testProperty "positive, nonzero exponential backoff is always incrementing" $ property $ do + delay <- forAll (Gen.int (Range.linear 1 maxBound)) + let res = runIdentity (simulatePolicy 1000 (limitRetriesByDelay maxBound (exponentialBackoff delay))) + delays = catMaybes (snd <$> res) + sort delays === delays + length (group delays) === length delays + ] + + +------------------------------------------------------------------------------- +maskingStateTests :: TestTree +maskingStateTests = testGroup "masking state" + [ testCase "shouldn't change masking state in a recovered action" $ do + maskingState <- getMaskingState + final <- try $ recovering def testHandlers $ const $ do + maskingState' <- getMaskingState + maskingState' @?= maskingState + fail "Retrying..." + assertBool + ("Expected IOException but didn't get one") + (isLeft (final :: Either IOException ())) + + , testCase "should mask asynchronous exceptions in exception handlers" $ do + let checkMaskingStateHandlers = + [ const $ Handler $ \(_ :: SomeException) -> do + maskingState <- getMaskingState + maskingState @?= MaskedInterruptible + return shouldRetry + ] + final <- try $ recovering def checkMaskingStateHandlers $ const $ fail "Retrying..." + assertBool + ("Expected IOException but didn't get one") + (isLeft (final :: Either IOException ())) + ] + + +------------------------------------------------------------------------------- +capDelayTests :: TestTree +capDelayTests = testGroup "capDelay" + [ testProperty "respects limitRetries" $ property $ do + retries <- forAll (Gen.int (Range.linear 1 100)) + cap <- forAll (Gen.int (Range.linear 1 maxBound)) + let policy = capDelay cap (limitRetries retries) + let delays = runIdentity (simulatePolicy (retries + 1) policy) + let Just lastDelay = lookup (retries - 1) delays + let Just gaveUp = lookup retries delays + let noDelay = 0 + lastDelay === Just noDelay + gaveUp === Nothing + , testProperty "does not allow any delays higher than the given delay" $ property $ do + cap <- forAll (Gen.int (Range.linear 1 maxBound)) + baseDelay <- forAll (Gen.int (Range.linear 1 100)) + basePolicy <- forAllWith (const "RetryPolicy") (genScalingPolicy baseDelay) + let policy = capDelay cap basePolicy + let delays = catMaybes (snd <$> runIdentity (simulatePolicy 100 policy)) + let baddies = filter (> cap) delays + baddies === [] + ] + + +------------------------------------------------------------------------------- +-- | Generates policies that increase on each iteration +genScalingPolicy :: (Alternative m) => Int -> m (RetryPolicyM Identity) +genScalingPolicy baseDelay = + (pure (exponentialBackoff baseDelay) <|> pure (fibonacciBackoff baseDelay)) + + +------------------------------------------------------------------------------- +limitRetriesByCumulativeDelayTests :: TestTree +limitRetriesByCumulativeDelayTests = testGroup "limitRetriesByCumulativeDelay" + [ testProperty "never exceeds the given cumulative delay" $ property $ do + baseDelay <- forAll (Gen.int (Range.linear 1 100)) + basePolicy <- forAllWith (const "RetryPolicy") (genScalingPolicy baseDelay) + cumulativeDelayMax <- forAll (Gen.int (Range.linear 1 10000)) + let policy = limitRetriesByCumulativeDelay cumulativeDelayMax basePolicy + let delays = catMaybes (snd <$> runIdentity (simulatePolicy 100 policy)) + footnoteShow delays + let actualCumulativeDelay = sum delays + footnote (show actualCumulativeDelay <> " <= " <> show cumulativeDelayMax) + HH.assert (actualCumulativeDelay <= cumulativeDelayMax) + + ] + +------------------------------------------------------------------------------- +quadraticDelayTests :: TestTree +quadraticDelayTests = testGroup "quadratic delay" + [ testProperty "recovering test with quadratic retry delay" $ property $ do + startTime <- liftIO getCurrentTime + timeout <- forAll (Gen.int (Range.linear 0 15)) + retries <- forAll (Gen.int (Range.linear 0 8)) + res <- liftIO $ try $ recovering + (exponentialBackoff timeout <> limitRetries retries) + [const $ Handler (\(_::SomeException) -> return True)] + (const $ throwM (userError "booo")) + endTime <- liftIO getCurrentTime + HH.assert (isLeftAnd isUserError res) + let tmo = if retries > 0 then timeout * 2 ^ (retries - 1) else 0 + let ms' = ((fromInteger . toInteger $ tmo) / 1000000.0) + HH.assert (diffUTCTime endTime startTime >= ms') + ] + +------------------------------------------------------------------------------- +isLeftAnd :: (a -> Bool) -> Either a b -> Bool +isLeftAnd f ei = case ei of + Left v -> f v + _ -> False + +testHandlers :: [a -> Handler IO Bool] +testHandlers = [const $ Handler (\(_::SomeException) -> return shouldRetry)] + + +data Custom1 = Custom1 deriving (Eq,Show,Read,Ord,Typeable) +data Custom2 = Custom2 deriving (Eq,Show,Read,Ord,Typeable) + + +instance Exception Custom1 +instance Exception Custom2 + + +------------------------------------------------------------------------------- +genRetryStatus :: MonadGen m => m RetryStatus +genRetryStatus = do + n <- Gen.int (Range.linear 0 maxBound) + d <- Gen.int (Range.linear 0 maxBound) + l <- Gen.maybe (Gen.int (Range.linear 0 d)) + return $ defaultRetryStatus { rsIterNumber = n + , rsCumulativeDelay = d + , rsPreviousDelay = l} + + +------------------------------------------------------------------------------- + + +------------------------------------------------------------------------------- +-- | Create an action that will fail exactly N times with the given +-- exception and will then return () in any subsequent calls. +mkFailN :: (Exception e) => e -> Int -> IO (s -> IO ()) +mkFailN e n = do + r <- newIORef 0 + return $ const $ do + old <- atomicModifyIORef' r $ \ old -> (old+1, old) + case old >= n of + True -> return () + False -> throwM e + + +------------------------------------------------------------------------------- +gatherStatuses + :: MonadIO m + => RetryPolicyM (WriterT [RetryStatus] m) + -> m [RetryStatus] +gatherStatuses policy = execWriterT $ + retrying policy (\_ _ -> return shouldRetry) + (\rs -> tell [rs]) + + +------------------------------------------------------------------------------- +-- | Just makes things a bit easier to follow instead of a magic value +-- of @return True@ +shouldRetry :: Bool +shouldRetry = True -- 2.30.2