circuit-breaker-0.1.0.0: test/Spec.hs

module Main (main) where

import System.CircuitBreaker

import Control.Concurrent.MVar
import Data.Either
import Numeric.Natural
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck

main :: IO ()
main = defaultMain $ testGroup "System.CircuitBreaker" [
      decrementProperties
    , evaluationProperties
    , transitionProperties
    ]

transitionProperties :: TestTree
transitionProperties = testGroup "transition guard" [
    testCase "Waiting -> SkipClosed iff errors remain" $ do
        bs <- newMVar $ CircuitState {errorCount = 1, currentState = Waiting}
        action <- breakerTransitionGuard bs (ET 1)
        action @=? SkipClosed
    , testCase "Respects the error threshold" $ do
        bs <- newMVar $ CircuitState {errorCount = 9, currentState = Waiting}
        action <- breakerTransitionGuard bs (ET 10)
        bs' <- readMVar bs
        action @=? Run
        currentState bs' @=? Testing
    , testCase "Testing is a serialized state" $ do
        bs <- newMVar $ CircuitState {errorCount = 0, currentState = Testing}
        action <- breakerTransitionGuard bs (ET 1)
        action @=? SkipClosed
    , testCase "Active always -> Run" $ do
        bs <- newMVar $ CircuitState {errorCount = 5, currentState = Active}
        action <- breakerTransitionGuard bs (ET 1)
        action @=? Run
    ]

evaluationProperties :: TestTree
evaluationProperties = testGroup "evaluation" [
    testProperty "never evaluates if SkipClosed is provided" $ \(CircState rawBS, ca) ->
        cover 35 (ca == SkipClosed) "Skip Closed" .
        cover 35 (ca == Run) "Run" . ioProperty $ do
            bs <- newMVar rawBS
            cell <- newMVar False
            res <- breakerTryPerformAction "test" (swapMVar cell True) bs ca
            cellV <- readMVar cell
            pure $ if isLeft res
                   then not cellV
                   else cellV
    , testProperty "always sets status to active if it runs" $ \(CircState rawBS, ca) ->
        cover 35 (ca == SkipClosed) "Skip Closed" .
        cover 35 (ca == Run ) "Run" . ioProperty $ do
            bs <- newMVar rawBS
            cell <- newMVar False
            res <- breakerTryPerformAction "test" (swapMVar cell True) bs ca
            cellV <- readMVar cell
            ba' <- readMVar bs
            pure $ if cellV
                   then currentState ba' == Active
                   else isLeft res
    ]

decrementProperties :: TestTree
decrementProperties = testGroup "error decrement" [
    testProperty "decrements, but not through zero" $ \(CircState rawBS) ->
        cover 5 (errorCount rawBS < 2) "Minimum Boundary" . ioProperty $ do
            bs <- newMVar rawBS
            decrementErrorCount bs
            val <- readMVar bs
            pure $ if errorCount rawBS == 0
                   then errorCount rawBS == errorCount val
                   else errorCount val == errorCount rawBS - 1

    , testProperty "never changes state" $ \(CircState rawBS) -> ioProperty $ do
        bs <- newMVar rawBS
        decrementErrorCount bs
        val <- readMVar bs
        pure $ currentState val == currentState rawBS

    , testProperty "Always >= 0" $ \(CircState rawBS) ->
        cover 2 (errorCount rawBS == 0) "Minimum Boundary" . ioProperty $ do
        bs <- newMVar rawBS
        decrementErrorCount bs
        val <- readMVar bs
        pure $ errorCount val >= 0
    ]

newtype CircState = CircState CircuitState deriving Show
instance Arbitrary CircState where
    arbitrary = do
        st <- elements [Active, Testing, Waiting]
        ec <- arbitrary
        pure . CircState $ CircuitState {
              errorCount = ec
            , currentState = st
            }

instance Arbitrary CircuitAction where
    arbitrary = elements [Run, SkipClosed]


instance Arbitrary Natural where
    arbitrary = fromIntegral . abs <$> (arbitrary :: Gen Int)