-- | This modules provides primitives to run tests over mockchain executions and
-- to give expectation on the result of these runs.
module Cooked.MockChain.Testing where

import Control.Exception qualified as E
import Control.Monad
import Cooked.InitialDistribution
import Cooked.MockChain.BlockChain
import Cooked.MockChain.Direct
import Cooked.MockChain.Staged
import Cooked.MockChain.UtxoState
import Cooked.Pretty
import Data.Default
import Data.Text qualified as T
import Ledger qualified
import Test.QuickCheck qualified as QC
import Test.Tasty.HUnit qualified as HU

-- * Common interface between HUnit and QuickCheck

-- | 'IsProp' is a common interface for HUnit and QuickCheck tests. It abstracts
-- uses of 'HU.Assertion' and 'QC.Property' for @(IsProp prop) => prop@, then
-- provide instances for both @HU.Asserton@ and @QC.Property@.
class IsProp prop where
  -- | Displays the string to the user in case of failure
  testCounterexample :: String -> prop -> prop

  -- | Conjunction of a number of results
  testConjoin :: [prop] -> prop

  -- | Disjunction of a number of results
  testDisjoin :: [prop] -> prop

  -- | Flags a failure
  testFailure :: prop
  testFailure = [prop] -> prop
forall prop. IsProp prop => [prop] -> prop
testDisjoin []

  -- | Flags a success
  testSuccess :: prop
  testSuccess = [prop] -> prop
forall prop. IsProp prop => [prop] -> prop
testConjoin []

  -- | Flags a failure with a message
  testFailureMsg :: String -> prop
  testFailureMsg String
msg = String -> prop -> prop
forall prop. IsProp prop => String -> prop -> prop
testCounterexample String
msg prop
forall prop. IsProp prop => prop
testFailure

-- | Turns a boolean into a @prop@
testBool :: (IsProp prop) => Bool -> prop
testBool :: forall prop. IsProp prop => Bool -> prop
testBool Bool
True = prop
forall prop. IsProp prop => prop
testSuccess
testBool Bool
False = prop
forall prop. IsProp prop => prop
testFailure

-- | Ensures all elements of a list satisfy a given @prop@
testAll :: (IsProp prop) => (a -> prop) -> [a] -> prop
testAll :: forall prop a. IsProp prop => (a -> prop) -> [a] -> prop
testAll a -> prop
f = [prop] -> prop
forall prop. IsProp prop => [prop] -> prop
testConjoin ([prop] -> prop) -> ([a] -> [prop]) -> [a] -> prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> prop) -> [a] -> [prop]
forall a b. (a -> b) -> [a] -> [b]
map a -> prop
f

infix 4 .==.

-- | Lifts an equality test to a @prop@
(.==.) :: (IsProp prop, Eq a) => a -> a -> prop
a
a .==. :: forall prop a. (IsProp prop, Eq a) => a -> a -> prop
.==. a
b = Bool -> prop
forall prop. IsProp prop => Bool -> prop
testBool (Bool -> prop) -> Bool -> prop
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b

infixr 3 .&&.

-- | Conjunction of two @prop@s
(.&&.) :: (IsProp prop) => prop -> prop -> prop
prop
a .&&. :: forall prop. IsProp prop => prop -> prop -> prop
.&&. prop
b = [prop] -> prop
forall prop. IsProp prop => [prop] -> prop
testConjoin [prop
a, prop
b]

infixr 2 .||.

-- | Disjunction of two @prop@s
(.||.) :: (IsProp prop) => prop -> prop -> prop
prop
a .||. :: forall prop. IsProp prop => prop -> prop -> prop
.||. prop
b = [prop] -> prop
forall prop. IsProp prop => [prop] -> prop
testDisjoin [prop
a, prop
b]

-- | Catches a HUnit test failure, if the test fails.
assertionToMaybe :: HU.Assertion -> IO (Maybe HU.HUnitFailure)
assertionToMaybe :: Assertion -> IO (Maybe HUnitFailure)
assertionToMaybe = (IO (Maybe HUnitFailure)
 -> [Handler (Maybe HUnitFailure)] -> IO (Maybe HUnitFailure))
-> [Handler (Maybe HUnitFailure)]
-> IO (Maybe HUnitFailure)
-> IO (Maybe HUnitFailure)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO (Maybe HUnitFailure)
-> [Handler (Maybe HUnitFailure)] -> IO (Maybe HUnitFailure)
forall a. IO a -> [Handler a] -> IO a
E.catches [(HUnitFailure -> IO (Maybe HUnitFailure))
-> Handler (Maybe HUnitFailure)
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler ((HUnitFailure -> IO (Maybe HUnitFailure))
 -> Handler (Maybe HUnitFailure))
-> (HUnitFailure -> IO (Maybe HUnitFailure))
-> Handler (Maybe HUnitFailure)
forall a b. (a -> b) -> a -> b
$ Maybe HUnitFailure -> IO (Maybe HUnitFailure)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe HUnitFailure -> IO (Maybe HUnitFailure))
-> (HUnitFailure -> Maybe HUnitFailure)
-> HUnitFailure
-> IO (Maybe HUnitFailure)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HUnitFailure -> Maybe HUnitFailure
forall a. a -> Maybe a
Just] (IO (Maybe HUnitFailure) -> IO (Maybe HUnitFailure))
-> (Assertion -> IO (Maybe HUnitFailure))
-> Assertion
-> IO (Maybe HUnitFailure)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Assertion -> IO (Maybe HUnitFailure) -> IO (Maybe HUnitFailure)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe HUnitFailure -> IO (Maybe HUnitFailure)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe HUnitFailure
forall a. Maybe a
Nothing)

-- | HUnit instance of 'IsProp'
instance IsProp HU.Assertion where
  testCounterexample :: String -> Assertion -> Assertion
testCounterexample String
msg = Assertion
-> (HUnitFailure -> Assertion) -> Maybe HUnitFailure -> Assertion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Assertion
forall prop. IsProp prop => prop
testSuccess (HUnitFailure -> Assertion
forall a e. Exception e => e -> a
E.throw (HUnitFailure -> Assertion)
-> (HUnitFailure -> HUnitFailure) -> HUnitFailure -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HUnitFailure -> HUnitFailure
adjustMsg) (Maybe HUnitFailure -> Assertion)
-> (Assertion -> IO (Maybe HUnitFailure)) -> Assertion -> Assertion
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Assertion -> IO (Maybe HUnitFailure)
assertionToMaybe
    where
      joinMsg :: String -> String
      joinMsg :: String -> String
joinMsg String
rest = String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rest

      adjustMsg :: HU.HUnitFailure -> HU.HUnitFailure
      adjustMsg :: HUnitFailure -> HUnitFailure
adjustMsg (HU.HUnitFailure Maybe SrcLoc
loc String
txt) =
        Maybe SrcLoc -> String -> HUnitFailure
HU.HUnitFailure Maybe SrcLoc
loc (String -> String
joinMsg String
txt)

  testFailure :: Assertion
testFailure = String -> Assertion
forall a. HasCallStack => String -> IO a
HU.assertFailure String
""
  testFailureMsg :: String -> Assertion
testFailureMsg = String -> Assertion
forall a. HasCallStack => String -> IO a
HU.assertFailure

  testConjoin :: [Assertion] -> Assertion
testConjoin = [Assertion] -> Assertion
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_

  testDisjoin :: [Assertion] -> Assertion
testDisjoin [] = Assertion
forall prop. IsProp prop => prop
testFailure
  testDisjoin (Assertion
x : [Assertion]
xs) = Assertion -> IO (Maybe HUnitFailure)
assertionToMaybe Assertion
x IO (Maybe HUnitFailure)
-> (Maybe HUnitFailure -> Assertion) -> Assertion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Assertion
-> (HUnitFailure -> Assertion) -> Maybe HUnitFailure -> Assertion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Assertion] -> Assertion
forall prop. IsProp prop => [prop] -> prop
testDisjoin [Assertion]
xs) HUnitFailure -> Assertion
forall a e. Exception e => e -> a
E.throw

  testSuccess :: Assertion
testSuccess = () -> Assertion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | QuickCheck instance of 'IsProp'
instance IsProp QC.Property where
  testCounterexample :: String -> Property -> Property
testCounterexample = String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
QC.counterexample
  testFailure :: Property
testFailure = Bool -> Property
forall prop. Testable prop => prop -> Property
QC.property Bool
False
  testSuccess :: Property
testSuccess = Bool -> Property
forall prop. Testable prop => prop -> Property
QC.property Bool
True
  testConjoin :: [Property] -> Property
testConjoin = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
QC.conjoin
  testDisjoin :: [Property] -> Property
testDisjoin = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
QC.disjoin

-- | Here we provide our own universsal quantifier instead of 'QC.forAll', so we
--  can monomorphize it to returning a 'QC.Property'
forAll :: (Show a) => QC.Gen a -> (a -> QC.Property) -> QC.Property
forAll :: forall a. Show a => Gen a -> (a -> Property) -> Property
forAll = Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll

-- * Extra HUnit assertions

-- | Asserts whether a set is a subset of another one, both given as lists.
assertSubset :: (Show a, Eq a) => [a] -> [a] -> HU.Assertion
assertSubset :: forall a. (Show a, Eq a) => [a] -> [a] -> Assertion
assertSubset [a]
l [a]
r =
  [Assertion] -> Assertion
forall prop. IsProp prop => [prop] -> prop
testConjoin
    ( (a -> Assertion) -> [a] -> [Assertion]
forall a b. (a -> b) -> [a] -> [b]
map
        ( \a
x ->
            HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
HU.assertBool
              ( String
"not a subset:\n\n"
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nis not an element of\n\n"
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
r
              )
              (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
r
        )
        [a]
l
    )

-- | Asserts whether 2 sets are equal, both given as lists.
assertSameSets :: (Show a, Eq a) => [a] -> [a] -> HU.Assertion
assertSameSets :: forall a. (Show a, Eq a) => [a] -> [a] -> Assertion
assertSameSets [a]
l [a]
r =
  HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
HU.assertBool
    (String
"expected lists of the same length, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
r))
    ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
r)
    Assertion -> Assertion -> Assertion
forall prop. IsProp prop => prop -> prop -> prop
.&&. [a] -> [a] -> Assertion
forall a. (Show a, Eq a) => [a] -> [a] -> Assertion
assertSubset [a]
l [a]
r
    Assertion -> Assertion -> Assertion
forall prop. IsProp prop => prop -> prop -> prop
.&&. [a] -> [a] -> Assertion
forall a. (Show a, Eq a) => [a] -> [a] -> Assertion
assertSubset [a]
r [a]
l

-- * Testing mockchain traces

-- | Data structure to test a mockchain trace
data Test a prop = Test
  { -- | The mockchain trace to test
    forall a prop. Test a prop -> StagedMockChain a
testTrace :: StagedMockChain a,
    -- | The initial distribution from which the trace should be run
    forall a prop. Test a prop -> InitialDistribution
testInitDist :: InitialDistribution,
    -- | The requirement on the number of results
    forall a prop. Test a prop -> Integer -> prop
testSizeProp :: Integer -> prop,
    -- | The property should hold in case of failure
    forall a prop.
Test a prop
-> PrettyCookedOpts
-> MockChainError
-> [MockChainLogEntry]
-> prop
testErrorProp :: PrettyCookedOpts -> MockChainError -> [MockChainLogEntry] -> prop,
    -- | The property that should hold in case of success
    forall a prop.
Test a prop
-> PrettyCookedOpts
-> a
-> UtxoState
-> [MockChainLogEntry]
-> prop
testResultProp :: PrettyCookedOpts -> a -> UtxoState -> [MockChainLogEntry] -> prop,
    -- | The printing option that should be use to render test results
    forall a prop. Test a prop -> PrettyCookedOpts
testPrettyOpts :: PrettyCookedOpts
  }

-- | A test template which expects a success from a trace
mustSucceedTest :: (IsProp prop) => StagedMockChain a -> Test a prop
mustSucceedTest :: forall prop a. IsProp prop => StagedMockChain a -> Test a prop
mustSucceedTest StagedMockChain a
trace =
  Test
    { testTrace :: StagedMockChain a
testTrace = StagedMockChain a
trace,
      testInitDist :: InitialDistribution
testInitDist = InitialDistribution
forall a. Default a => a
def,
      testSizeProp :: Integer -> prop
testSizeProp = prop -> Integer -> prop
forall a b. a -> b -> a
const prop
forall prop. IsProp prop => prop
testSuccess,
      testErrorProp :: PrettyCookedOpts -> MockChainError -> [MockChainLogEntry] -> prop
testErrorProp = \PrettyCookedOpts
opts MockChainError
res [MockChainLogEntry]
_ -> String -> prop
forall prop. IsProp prop => String -> prop
testFailureMsg (String -> prop) -> String -> prop
forall a b. (a -> b) -> a -> b
$ (MockChainError -> DocCooked) -> MockChainError -> String
forall a. (a -> DocCooked) -> a -> String
renderString (PrettyCookedOpts -> MockChainError -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts) MockChainError
res,
      testResultProp :: PrettyCookedOpts -> a -> UtxoState -> [MockChainLogEntry] -> prop
testResultProp = \PrettyCookedOpts
_ a
_ UtxoState
_ [MockChainLogEntry]
_ -> prop
forall prop. IsProp prop => prop
testSuccess,
      testPrettyOpts :: PrettyCookedOpts
testPrettyOpts = PrettyCookedOpts
forall a. Default a => a
def
    }

-- | A test template which expects a failure from a trace
mustFailTest :: (IsProp prop, Show a) => StagedMockChain a -> Test a prop
mustFailTest :: forall prop a.
(IsProp prop, Show a) =>
StagedMockChain a -> Test a prop
mustFailTest StagedMockChain a
trace =
  Test
    { testTrace :: StagedMockChain a
testTrace = StagedMockChain a
trace,
      testInitDist :: InitialDistribution
testInitDist = InitialDistribution
forall a. Default a => a
def,
      testSizeProp :: Integer -> prop
testSizeProp = prop -> Integer -> prop
forall a b. a -> b -> a
const prop
forall prop. IsProp prop => prop
testSuccess,
      testErrorProp :: PrettyCookedOpts -> MockChainError -> [MockChainLogEntry] -> prop
testErrorProp = \PrettyCookedOpts
_ MockChainError
_ [MockChainLogEntry]
_ -> prop
forall prop. IsProp prop => prop
testSuccess,
      testResultProp :: PrettyCookedOpts -> a -> UtxoState -> [MockChainLogEntry] -> prop
testResultProp = \PrettyCookedOpts
opts a
a UtxoState
res [MockChainLogEntry]
_ -> String -> prop
forall prop. IsProp prop => String -> prop
testFailureMsg (String -> prop) -> String -> prop
forall a b. (a -> b) -> a -> b
$ ((a, UtxoState) -> DocCooked) -> (a, UtxoState) -> String
forall a. (a -> DocCooked) -> a -> String
renderString (PrettyCookedOpts -> (a, UtxoState) -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts) (a
a, UtxoState
res),
      testPrettyOpts :: PrettyCookedOpts
testPrettyOpts = PrettyCookedOpts
forall a. Default a => a
def
    }

-- | A test template with no particular requirement on the trace
emptyTest :: (IsProp prop) => StagedMockChain a -> Test a prop
emptyTest :: forall prop a. IsProp prop => StagedMockChain a -> Test a prop
emptyTest StagedMockChain a
trace =
  Test
    { testTrace :: StagedMockChain a
testTrace = StagedMockChain a
trace,
      testInitDist :: InitialDistribution
testInitDist = InitialDistribution
forall a. Default a => a
def,
      testSizeProp :: Integer -> prop
testSizeProp = prop -> Integer -> prop
forall a b. a -> b -> a
const prop
forall prop. IsProp prop => prop
testSuccess,
      testErrorProp :: PrettyCookedOpts -> MockChainError -> [MockChainLogEntry] -> prop
testErrorProp = \PrettyCookedOpts
_ MockChainError
_ [MockChainLogEntry]
_ -> prop
forall prop. IsProp prop => prop
testSuccess,
      testResultProp :: PrettyCookedOpts -> a -> UtxoState -> [MockChainLogEntry] -> prop
testResultProp = \PrettyCookedOpts
_ a
_ UtxoState
_ [MockChainLogEntry]
_ -> prop
forall prop. IsProp prop => prop
testSuccess,
      testPrettyOpts :: PrettyCookedOpts
testPrettyOpts = PrettyCookedOpts
forall a. Default a => a
def
    }

-- | Appending an initial distribution to a test
withInitDist :: Test a prop -> InitialDistribution -> Test a prop
withInitDist :: forall a prop. Test a prop -> InitialDistribution -> Test a prop
withInitDist Test a prop
test InitialDistribution
initDist = Test a prop
test {testInitDist = initDist}

-- | Appending printing options to a test
withPrettyOpts :: Test a prop -> PrettyCookedOpts -> Test a prop
withPrettyOpts :: forall a prop. Test a prop -> PrettyCookedOpts -> Test a prop
withPrettyOpts Test a prop
test PrettyCookedOpts
opts = Test a prop
test {testPrettyOpts = opts}

-- | Appending a predicate over the log to a test. This will be used both in
-- case of success or failure of the trace.
withJournalPred :: (IsProp prop) => Test a prop -> ([MockChainLogEntry] -> prop) -> Test a prop
withJournalPred :: forall prop a.
IsProp prop =>
Test a prop -> ([MockChainLogEntry] -> prop) -> Test a prop
withJournalPred Test a prop
test [MockChainLogEntry] -> prop
journalPred =
  Test a prop
test
    { testErrorProp = \PrettyCookedOpts
opts MockChainError
err [MockChainLogEntry]
journal -> Test a prop
-> PrettyCookedOpts
-> MockChainError
-> [MockChainLogEntry]
-> prop
forall a prop.
Test a prop
-> PrettyCookedOpts
-> MockChainError
-> [MockChainLogEntry]
-> prop
testErrorProp Test a prop
test PrettyCookedOpts
opts MockChainError
err [MockChainLogEntry]
journal prop -> prop -> prop
forall prop. IsProp prop => prop -> prop -> prop
.&&. [MockChainLogEntry] -> prop
journalPred [MockChainLogEntry]
journal,
      testResultProp = \PrettyCookedOpts
opts a
val UtxoState
state [MockChainLogEntry]
journal -> Test a prop
-> PrettyCookedOpts
-> a
-> UtxoState
-> [MockChainLogEntry]
-> prop
forall a prop.
Test a prop
-> PrettyCookedOpts
-> a
-> UtxoState
-> [MockChainLogEntry]
-> prop
testResultProp Test a prop
test PrettyCookedOpts
opts a
val UtxoState
state [MockChainLogEntry]
journal prop -> prop -> prop
forall prop. IsProp prop => prop -> prop -> prop
.&&. [MockChainLogEntry] -> prop
journalPred [MockChainLogEntry]
journal
    }

-- | Appending a predicate over the return value and state, which will be used
-- in case of success of the trace.
withValueAndStatePred :: (IsProp prop) => Test a prop -> (a -> UtxoState -> prop) -> Test a prop
withValueAndStatePred :: forall prop a.
IsProp prop =>
Test a prop -> (a -> UtxoState -> prop) -> Test a prop
withValueAndStatePred Test a prop
test a -> UtxoState -> prop
resultPred =
  Test a prop
test
    { testResultProp = \PrettyCookedOpts
opts a
val UtxoState
state [MockChainLogEntry]
journal -> Test a prop
-> PrettyCookedOpts
-> a
-> UtxoState
-> [MockChainLogEntry]
-> prop
forall a prop.
Test a prop
-> PrettyCookedOpts
-> a
-> UtxoState
-> [MockChainLogEntry]
-> prop
testResultProp Test a prop
test PrettyCookedOpts
opts a
val UtxoState
state [MockChainLogEntry]
journal prop -> prop -> prop
forall prop. IsProp prop => prop -> prop -> prop
.&&. a -> UtxoState -> prop
resultPred a
val UtxoState
state
    }

-- | Ensuring the number of results of a test is exactly as expected
withExactSize :: (IsProp prop) => Test a prop -> Integer -> Test a prop
withExactSize :: forall prop a. IsProp prop => Test a prop -> Integer -> Test a prop
withExactSize Test a prop
test Integer
reqSize =
  Test a prop
test
    { testSizeProp = \Integer
n ->
        if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
reqSize
          then prop
forall prop. IsProp prop => prop
testSuccess
          else String -> prop
forall prop. IsProp prop => String -> prop
testFailureMsg (String -> prop) -> String -> prop
forall a b. (a -> b) -> a -> b
$ String
"Incorrect number of results (expected: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
reqSize String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" but got: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
    }

-- | Appending a predicate over the return value, which will be used in case of
-- success of the trace.
withValuePred :: (IsProp prop) => Test a prop -> (a -> prop) -> Test a prop
withValuePred :: forall prop a.
IsProp prop =>
Test a prop -> (a -> prop) -> Test a prop
withValuePred Test a prop
test a -> prop
valuePred = Test a prop -> (a -> UtxoState -> prop) -> Test a prop
forall prop a.
IsProp prop =>
Test a prop -> (a -> UtxoState -> prop) -> Test a prop
withValueAndStatePred Test a prop
test ((a -> UtxoState -> prop) -> Test a prop)
-> (a -> UtxoState -> prop) -> Test a prop
forall a b. (a -> b) -> a -> b
$ \a
val UtxoState
_ -> a -> prop
valuePred a
val

-- | Appending a predicate over the return state, which will be used in case of
-- success of the trace.
withStatePred :: (IsProp prop) => Test a prop -> (UtxoState -> prop) -> Test a prop
withStatePred :: forall prop a.
IsProp prop =>
Test a prop -> (UtxoState -> prop) -> Test a prop
withStatePred Test a prop
test UtxoState -> prop
statePred = Test a prop -> (a -> UtxoState -> prop) -> Test a prop
forall prop a.
IsProp prop =>
Test a prop -> (a -> UtxoState -> prop) -> Test a prop
withValueAndStatePred Test a prop
test ((a -> UtxoState -> prop) -> Test a prop)
-> (a -> UtxoState -> prop) -> Test a prop
forall a b. (a -> b) -> a -> b
$ \a
_ UtxoState
st -> UtxoState -> prop
statePred UtxoState
st

-- | Appending a predicate over an error which uses the printing options, which
-- will be used in case of failure of the trace.
withPrettyAndErrorPred :: (IsProp prop) => Test a prop -> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
withPrettyAndErrorPred :: forall prop a.
IsProp prop =>
Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
withPrettyAndErrorPred Test a prop
test PrettyCookedOpts -> MockChainError -> prop
errorPred = Test a prop
test {testErrorProp = \PrettyCookedOpts
opts MockChainError
err [MockChainLogEntry]
journal -> Test a prop
-> PrettyCookedOpts
-> MockChainError
-> [MockChainLogEntry]
-> prop
forall a prop.
Test a prop
-> PrettyCookedOpts
-> MockChainError
-> [MockChainLogEntry]
-> prop
testErrorProp Test a prop
test PrettyCookedOpts
opts MockChainError
err [MockChainLogEntry]
journal prop -> prop -> prop
forall prop. IsProp prop => prop -> prop -> prop
.&&. PrettyCookedOpts -> MockChainError -> prop
errorPred PrettyCookedOpts
opts MockChainError
err}

-- | Appends a predicate over an error to a 'Test'
withErrorPred :: (IsProp prop) => Test a prop -> (MockChainError -> prop) -> Test a prop
withErrorPred :: forall prop a.
IsProp prop =>
Test a prop -> (MockChainError -> prop) -> Test a prop
withErrorPred Test a prop
test MockChainError -> prop
errorPred = Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
forall prop a.
IsProp prop =>
Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
withPrettyAndErrorPred Test a prop
test ((PrettyCookedOpts -> MockChainError -> prop) -> Test a prop)
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
forall a b. (a -> b) -> a -> b
$ \PrettyCookedOpts
_ MockChainError
err -> MockChainError -> prop
errorPred MockChainError
err

-- | This takes a test and transforms it into an actual test case in prop.
testToProp :: (IsProp prop) => Test a prop -> prop
testToProp :: forall prop a. IsProp prop => Test a prop -> prop
testToProp Test {StagedMockChain a
PrettyCookedOpts
InitialDistribution
Integer -> prop
PrettyCookedOpts -> a -> UtxoState -> [MockChainLogEntry] -> prop
PrettyCookedOpts -> MockChainError -> [MockChainLogEntry] -> prop
testTrace :: forall a prop. Test a prop -> StagedMockChain a
testInitDist :: forall a prop. Test a prop -> InitialDistribution
testSizeProp :: forall a prop. Test a prop -> Integer -> prop
testErrorProp :: forall a prop.
Test a prop
-> PrettyCookedOpts
-> MockChainError
-> [MockChainLogEntry]
-> prop
testResultProp :: forall a prop.
Test a prop
-> PrettyCookedOpts
-> a
-> UtxoState
-> [MockChainLogEntry]
-> prop
testPrettyOpts :: forall a prop. Test a prop -> PrettyCookedOpts
testTrace :: StagedMockChain a
testInitDist :: InitialDistribution
testSizeProp :: Integer -> prop
testErrorProp :: PrettyCookedOpts -> MockChainError -> [MockChainLogEntry] -> prop
testResultProp :: PrettyCookedOpts -> a -> UtxoState -> [MockChainLogEntry] -> prop
testPrettyOpts :: PrettyCookedOpts
..} =
  let innerProp :: (Either MockChainError (a, UtxoState), MockChainBook) -> prop
innerProp (Either MockChainError (a, UtxoState)
res, MockChainBook [MockChainLogEntry]
mcLog Map BuiltinByteString String
names) =
        case Either MockChainError (a, UtxoState)
res of
          Left MockChainError
err -> PrettyCookedOpts -> MockChainError -> [MockChainLogEntry] -> prop
testErrorProp (Map BuiltinByteString String
-> PrettyCookedOpts -> PrettyCookedOpts
addHashNames Map BuiltinByteString String
names PrettyCookedOpts
testPrettyOpts) MockChainError
err [MockChainLogEntry]
mcLog
          Right (a
result, UtxoState
state) -> PrettyCookedOpts -> a -> UtxoState -> [MockChainLogEntry] -> prop
testResultProp (Map BuiltinByteString String
-> PrettyCookedOpts -> PrettyCookedOpts
addHashNames Map BuiltinByteString String
names PrettyCookedOpts
testPrettyOpts) a
result UtxoState
state [MockChainLogEntry]
mcLog
      results :: [(Either MockChainError (a, UtxoState), MockChainBook)]
results = (forall (m :: * -> *).
 Monad m =>
 MockChainT m a
 -> m (Either MockChainError (a, UtxoState), MockChainBook))
-> StagedMockChain a
-> [(Either MockChainError (a, UtxoState), MockChainBook)]
forall a res.
(forall (m :: * -> *). Monad m => MockChainT m a -> m res)
-> StagedMockChain a -> [res]
interpretAndRunWith (InitialDistribution
-> MockChainT m a
-> m (Either MockChainError (a, UtxoState), MockChainBook)
forall (m :: * -> *) a.
Monad m =>
InitialDistribution
-> MockChainT m a -> m (MockChainReturn a UtxoState)
runMockChainTFrom InitialDistribution
testInitDist) StagedMockChain a
testTrace
   in Integer -> prop
testSizeProp (Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([(Either MockChainError (a, UtxoState), MockChainBook)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Either MockChainError (a, UtxoState), MockChainBook)]
results))
        prop -> prop -> prop
forall prop. IsProp prop => prop -> prop -> prop
.&&. ((Either MockChainError (a, UtxoState), MockChainBook) -> prop)
-> [(Either MockChainError (a, UtxoState), MockChainBook)] -> prop
forall prop a. IsProp prop => (a -> prop) -> [a] -> prop
testAll
          ( \res :: (Either MockChainError (a, UtxoState), MockChainBook)
res@(Either MockChainError (a, UtxoState)
_, MockChainBook [MockChainLogEntry]
mcLog Map BuiltinByteString String
names) ->
              String -> prop -> prop
forall prop. IsProp prop => String -> prop -> prop
testCounterexample
                (([MockChainLogEntry] -> DocCooked) -> [MockChainLogEntry] -> String
forall a. (a -> DocCooked) -> a -> String
renderString (PrettyCookedOpts -> [MockChainLogEntry] -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt (Map BuiltinByteString String
-> PrettyCookedOpts -> PrettyCookedOpts
addHashNames Map BuiltinByteString String
names PrettyCookedOpts
testPrettyOpts)) [MockChainLogEntry]
mcLog)
                ((Either MockChainError (a, UtxoState), MockChainBook) -> prop
innerProp (Either MockChainError (a, UtxoState), MockChainBook)
res)
          )
          [(Either MockChainError (a, UtxoState), MockChainBook)]
results

-- | Ensure that all results produced by the staged mockchain /succeed/,
-- starting from the default initial distribution
testSucceeds :: (IsProp prop) => StagedMockChain a -> prop
testSucceeds :: forall prop a. IsProp prop => StagedMockChain a -> prop
testSucceeds = Test a prop -> prop
forall prop a. IsProp prop => Test a prop -> prop
testToProp (Test a prop -> prop)
-> (StagedMockChain a -> Test a prop) -> StagedMockChain a -> prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StagedMockChain a -> Test a prop
forall prop a. IsProp prop => StagedMockChain a -> Test a prop
mustSucceedTest

-- | Ensure that all results produced by the staged mockchain /fail/
testFails :: (IsProp prop, Show a) => StagedMockChain a -> prop
testFails :: forall prop a. (IsProp prop, Show a) => StagedMockChain a -> prop
testFails = Test a prop -> prop
forall prop a. IsProp prop => Test a prop -> prop
testToProp (Test a prop -> prop)
-> (StagedMockChain a -> Test a prop) -> StagedMockChain a -> prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StagedMockChain a -> Test a prop
forall prop a.
(IsProp prop, Show a) =>
StagedMockChain a -> Test a prop
mustFailTest

-- | A property to ensure a phase 1 failure
isPhase1Failure :: (IsProp prop) => PrettyCookedOpts -> MockChainError -> prop
isPhase1Failure :: forall prop.
IsProp prop =>
PrettyCookedOpts -> MockChainError -> prop
isPhase1Failure PrettyCookedOpts
_ (MCEValidationError ValidationPhase
Ledger.Phase1 ValidationError
_) = prop
forall prop. IsProp prop => prop
testSuccess
isPhase1Failure PrettyCookedOpts
pcOpts MockChainError
e = String -> prop
forall prop. IsProp prop => String -> prop
testFailureMsg (String -> prop) -> String -> prop
forall a b. (a -> b) -> a -> b
$ String
"Expected phase 1 evaluation failure, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (MockChainError -> DocCooked) -> MockChainError -> String
forall a. (a -> DocCooked) -> a -> String
renderString (PrettyCookedOpts -> MockChainError -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
pcOpts) MockChainError
e

-- | A test that succeeds when the trace results in a phase 1 failure
testFailsInPhase1 :: (IsProp prop, Show a) => StagedMockChain a -> prop
testFailsInPhase1 :: forall prop a. (IsProp prop, Show a) => StagedMockChain a -> prop
testFailsInPhase1 = Test a prop -> prop
forall prop a. IsProp prop => Test a prop -> prop
testToProp (Test a prop -> prop)
-> (StagedMockChain a -> Test a prop) -> StagedMockChain a -> prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
forall prop a.
IsProp prop =>
Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
`withPrettyAndErrorPred` PrettyCookedOpts -> MockChainError -> prop
forall prop.
IsProp prop =>
PrettyCookedOpts -> MockChainError -> prop
isPhase1Failure) (Test a prop -> Test a prop)
-> (StagedMockChain a -> Test a prop)
-> StagedMockChain a
-> Test a prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StagedMockChain a -> Test a prop
forall prop a.
(IsProp prop, Show a) =>
StagedMockChain a -> Test a prop
mustFailTest

-- | A property to ensure a phase 2 failure
isPhase2Failure :: (IsProp prop) => PrettyCookedOpts -> MockChainError -> prop
isPhase2Failure :: forall prop.
IsProp prop =>
PrettyCookedOpts -> MockChainError -> prop
isPhase2Failure PrettyCookedOpts
_ (MCEValidationError ValidationPhase
Ledger.Phase2 ValidationError
_) = prop
forall prop. IsProp prop => prop
testSuccess
isPhase2Failure PrettyCookedOpts
pcOpts MockChainError
e = String -> prop
forall prop. IsProp prop => String -> prop
testFailureMsg (String -> prop) -> String -> prop
forall a b. (a -> b) -> a -> b
$ String
"Expected phase 2 evaluation failure, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (MockChainError -> DocCooked) -> MockChainError -> String
forall a. (a -> DocCooked) -> a -> String
renderString (PrettyCookedOpts -> MockChainError -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
pcOpts) MockChainError
e

-- | A test that succeeds when the trace results in a phase 2 failure
testFailsInPhase2 :: (IsProp prop, Show a) => StagedMockChain a -> prop
testFailsInPhase2 :: forall prop a. (IsProp prop, Show a) => StagedMockChain a -> prop
testFailsInPhase2 = Test a prop -> prop
forall prop a. IsProp prop => Test a prop -> prop
testToProp (Test a prop -> prop)
-> (StagedMockChain a -> Test a prop) -> StagedMockChain a -> prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
forall prop a.
IsProp prop =>
Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
`withPrettyAndErrorPred` PrettyCookedOpts -> MockChainError -> prop
forall prop.
IsProp prop =>
PrettyCookedOpts -> MockChainError -> prop
isPhase2Failure) (Test a prop -> Test a prop)
-> (StagedMockChain a -> Test a prop)
-> StagedMockChain a
-> Test a prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StagedMockChain a -> Test a prop
forall prop a.
(IsProp prop, Show a) =>
StagedMockChain a -> Test a prop
mustFailTest

-- | Same as 'isPhase1Failure' with an added predicate on the text error
isPhase1FailureWithMsg :: (IsProp prop) => (String -> Bool) -> PrettyCookedOpts -> MockChainError -> prop
isPhase1FailureWithMsg :: forall prop.
IsProp prop =>
(String -> Bool) -> PrettyCookedOpts -> MockChainError -> prop
isPhase1FailureWithMsg String -> Bool
f PrettyCookedOpts
_ (MCEValidationError ValidationPhase
Ledger.Phase1 (Ledger.CardanoLedgerValidationError Text
text)) | String -> Bool
f (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
text = prop
forall prop. IsProp prop => prop
testSuccess
isPhase1FailureWithMsg String -> Bool
_ PrettyCookedOpts
pcOpts MockChainError
e = String -> prop
forall prop. IsProp prop => String -> prop
testFailureMsg (String -> prop) -> String -> prop
forall a b. (a -> b) -> a -> b
$ String
"Expected phase 1 evaluation failure with constrained messages, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (MockChainError -> DocCooked) -> MockChainError -> String
forall a. (a -> DocCooked) -> a -> String
renderString (PrettyCookedOpts -> MockChainError -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
pcOpts) MockChainError
e

-- | Same as 'testFailsInPhase1' with an added predicate on the text error
testFailsInPhase1WithMsg :: (IsProp prop, Show a) => (String -> Bool) -> StagedMockChain a -> prop
testFailsInPhase1WithMsg :: forall prop a.
(IsProp prop, Show a) =>
(String -> Bool) -> StagedMockChain a -> prop
testFailsInPhase1WithMsg String -> Bool
f = Test a prop -> prop
forall prop a. IsProp prop => Test a prop -> prop
testToProp (Test a prop -> prop)
-> (StagedMockChain a -> Test a prop) -> StagedMockChain a -> prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
forall prop a.
IsProp prop =>
Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
`withPrettyAndErrorPred` (String -> Bool) -> PrettyCookedOpts -> MockChainError -> prop
forall prop.
IsProp prop =>
(String -> Bool) -> PrettyCookedOpts -> MockChainError -> prop
isPhase1FailureWithMsg String -> Bool
f) (Test a prop -> Test a prop)
-> (StagedMockChain a -> Test a prop)
-> StagedMockChain a
-> Test a prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StagedMockChain a -> Test a prop
forall prop a.
(IsProp prop, Show a) =>
StagedMockChain a -> Test a prop
mustFailTest

-- | Same as 'isPhase2Failure' with an added predicate over the text error
isPhase2FailureWithMsg :: (IsProp prop) => (String -> Bool) -> PrettyCookedOpts -> MockChainError -> prop
isPhase2FailureWithMsg :: forall prop.
IsProp prop =>
(String -> Bool) -> PrettyCookedOpts -> MockChainError -> prop
isPhase2FailureWithMsg String -> Bool
f PrettyCookedOpts
_ (MCEValidationError ValidationPhase
Ledger.Phase2 (Ledger.ScriptFailure (Ledger.EvaluationError [Text]
texts String
_))) | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
f (String -> Bool) -> (Text -> String) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
texts = prop
forall prop. IsProp prop => prop
testSuccess
isPhase2FailureWithMsg String -> Bool
_ PrettyCookedOpts
pcOpts MockChainError
e = String -> prop
forall prop. IsProp prop => String -> prop
testFailureMsg (String -> prop) -> String -> prop
forall a b. (a -> b) -> a -> b
$ String
"Expected phase 2 evaluation failure with constrained messages, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (MockChainError -> DocCooked) -> MockChainError -> String
forall a. (a -> DocCooked) -> a -> String
renderString (PrettyCookedOpts -> MockChainError -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
pcOpts) MockChainError
e

-- | Same as 'testFailsInPhase2' with an added predicate over the text error
testFailsInPhase2WithMsg :: (IsProp prop, Show a) => (String -> Bool) -> StagedMockChain a -> prop
testFailsInPhase2WithMsg :: forall prop a.
(IsProp prop, Show a) =>
(String -> Bool) -> StagedMockChain a -> prop
testFailsInPhase2WithMsg String -> Bool
f = Test a prop -> prop
forall prop a. IsProp prop => Test a prop -> prop
testToProp (Test a prop -> prop)
-> (StagedMockChain a -> Test a prop) -> StagedMockChain a -> prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
forall prop a.
IsProp prop =>
Test a prop
-> (PrettyCookedOpts -> MockChainError -> prop) -> Test a prop
`withPrettyAndErrorPred` (String -> Bool) -> PrettyCookedOpts -> MockChainError -> prop
forall prop.
IsProp prop =>
(String -> Bool) -> PrettyCookedOpts -> MockChainError -> prop
isPhase2FailureWithMsg String -> Bool
f) (Test a prop -> Test a prop)
-> (StagedMockChain a -> Test a prop)
-> StagedMockChain a
-> Test a prop
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StagedMockChain a -> Test a prop
forall prop a.
(IsProp prop, Show a) =>
StagedMockChain a -> Test a prop
mustFailTest