FailoverSpec.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE OverloadedStrings  #-}

module Glue.FailoverSpec where

import           Control.Exception.Base   hiding (throw, throwIO)
import           Control.Exception.Lifted
import           Data.Typeable
import           Glue.Failover
import           Test.Hspec
import           Test.QuickCheck

data FailoverTestException = FailoverTestException deriving (Eq, Show, Typeable)
instance Exception FailoverTestException

spec :: Spec
spec = do
  describe "failover" $ do
    it "Failover handles potentially multiple errors" $ do
      property $ \(request, failureMax) ->
        let positiveFailureMax  = (abs failureMax) `mod` 10
            service req         = if req >= 10 then return (req + 100) else throwIO FailoverTestException
            options             = defaultFailoverOptions { transformFailoverRequest = (+1), maxFailovers = positiveFailureMax }
            failOverService     = failover options service
            successCase         = (failOverService request) `shouldReturn` ((if request <= 10 then 10 else request) + 100)
            failureCase         = (failOverService request) `shouldThrow` (== FailoverTestException)
        in if request + positiveFailureMax >= 10 then successCase else failureCase