tasty-flaky-0.1.2.0: Handle flaky Tasty-based tests
Copyright(c) Powerweave Inc.
LicenseBSD-3-Clause
MaintainerLaurent René de Cotret
Portabilityportable
Safe HaskellSafe-Inferred
LanguageHaskell2010

Test.Tasty.Flaky

Description

This module defines a function, flakyTest, to declare a test which intermittently fails. Flaky tests can be retries using retry policies provided by the Control.Retry module (from the retry package).

To dynamically retry based on the result of a test, see flakyTestWithRetryAction instead.

For example, you can retry test cases from tasty-hunit like so:

import Test.Tasty.HUnit ( testCase ) -- from tasty-hunit

myFlakyTest :: TestTree
myFlakyTest = flakyTest (limitRetries 5 <> constantDelay 1000) $ testCase "some test case" $ do ... 

In the example above, the test will be retried up to 5 times, with a delay of 1000 microseconds between tries, if a failure occurs.

Synopsis

Test wrappers

flakyTest :: RetryPolicyM IO -> TestTree -> TestTree Source #

Mark any test as flaky.

If this test is not successful, it will be retried according to the supplied RetryPolicyM IO. See Control.Retry for documentation on how to specify a RetryPolicyM IO.

For example, you can retry test cases from tasty-hunit like so:

import Test.Tasty.HUnit ( testCase ) -- from tasty-hunit

myFlakyTest :: TestTree
myFlakyTest = flakyTest (limitRetries 5 <> constantDelay 1000) $ testCase "some test case" $ do ...

To dynamically retry based on the result of a test, see flakyTestWithRetryAction instead.

flakyTestWithRetryAction :: (RetryStatus -> Result -> IO RetryAction) -> RetryPolicyM IO -> TestTree -> TestTree Source #

Mark any test as flaky. Like flakyTest, but allows for overriding retry policies based on test results. Also see RetryAction.

For example, if you only want to retry a test if the error message contains "some error message":

import Test.Tasty.HUnit ( testCase ) -- from tasty-hunit
import Data.List ( isInfixOf )

myFlakyTest :: TestTree
myFlakyTest 
    = flakyTestWithRetryAction 
             retryAction 
             (constantDelay 1000)
                 $ testCase "some test case" $ do ...
    where
        retryAction :: RetryStatus -> Result -> IO RetryAction
        retryAction _ result
            | "some error message" `isInfixOf` show result = pure ConsultPolicy
            | otherwise = pure DontRetry

Since: 0.1.2.0

Re-exports

The following functions allow to construct 'RetryPolicyM IO' from the Control.Retry module.

constantDelay #

Arguments

:: forall (m :: Type -> Type). Monad m 
=> Int

Base delay in microseconds

-> RetryPolicyM m 

Implement a constant delay with unlimited retries.

exponentialBackoff #

Arguments

:: forall (m :: Type -> Type). Monad m 
=> Int

Base delay in microseconds

-> RetryPolicyM m 

Grow delay exponentially each iteration. Each delay will increase by a factor of two.

fullJitterBackoff #

Arguments

:: forall (m :: Type -> Type). MonadIO m 
=> Int

Base delay in microseconds

-> RetryPolicyM m 

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)

fibonacciBackoff #

Arguments

:: forall (m :: Type -> Type). Monad m 
=> Int

Base delay in microseconds

-> RetryPolicyM m 

Implement Fibonacci backoff.

limitRetries #

Arguments

:: Int

Maximum number of retries.

-> RetryPolicy 

Retry immediately, but only up to n times.

Policy Transformers

limitRetriesByDelay #

Arguments

:: forall (m :: Type -> Type). Monad m 
=> Int

Time-delay limit in microseconds.

-> RetryPolicyM m 
-> RetryPolicyM m 

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

limitRetriesByCumulativeDelay #

Arguments

:: forall (m :: Type -> Type). Monad m 
=> Int

Time-delay limit in microseconds.

-> RetryPolicyM m 
-> RetryPolicyM m 

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.

capDelay #

Arguments

:: forall (m :: Type -> Type). Monad m 
=> Int

A maximum delay in microseconds

-> RetryPolicyM m 
-> RetryPolicyM m 

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.