diff --git a/plutus-contract/src/Plutus/Contract/Test/ContractModel.hs b/plutus-contract/src/Plutus/Contract/Test/ContractModel.hs index c35301fa0e..9f4a6c5dbc 100644 --- a/plutus-contract/src/Plutus/Contract/Test/ContractModel.hs +++ b/plutus-contract/src/Plutus/Contract/Test/ContractModel.hs @@ -96,6 +96,8 @@ module Plutus.Contract.Test.ContractModel , SchemaConstraints , ContractInstanceSpec(..) , HandleFun + -- ** Model properties + , propSanityCheckModel -- ** Emulator properties , propRunActions_ , propRunActions @@ -1111,6 +1113,12 @@ checkNoCrashes = foldr (\ (ContractInstanceSpec k w c) -> (assertOutcome c (inst notError Done{} = True notError NotDone{} = True +-- | Sanity check a `ContractModel`. Ensures that wallet balances are not always unchanged. +propSanityCheckModel :: forall state. ContractModel state => Property +propSanityCheckModel = QC.expectFailure $ noBalanceChanges . stateAfter @state + where + noBalanceChanges s = all isZero (s ^. balanceChanges) + -- $noLockedFunds -- Showing that funds can not be locked in the contract forever. diff --git a/plutus-use-cases/test/Spec/GameStateMachine.hs b/plutus-use-cases/test/Spec/GameStateMachine.hs index da482428f4..bd03c65aca 100644 --- a/plutus-use-cases/test/Spec/GameStateMachine.hs +++ b/plutus-use-cases/test/Spec/GameStateMachine.hs @@ -19,6 +19,7 @@ module Spec.GameStateMachine , prop_Game, propGame', prop_GameWhitelist , prop_NoLockedFunds , prop_CheckNoLockedFundsProof + , prop_SanityCheckModel ) where import Control.Lens @@ -171,6 +172,9 @@ prop_Game = propRunActions_ handleSpec prop_GameWhitelist :: Actions GameModel -> Property prop_GameWhitelist = checkErrorWhitelist handleSpec defaultWhitelist +prop_SanityCheckModel :: Property +prop_SanityCheckModel = propSanityCheckModel @GameModel + propGame' :: LogLevel -> Actions GameModel -> Property propGame' l = propRunActionsWithOptions (set minLogLevel l defaultCheckOptions) @@ -293,6 +297,9 @@ tests = , testProperty "can always get the funds out" $ withMaxSuccess 10 prop_NoLockedFunds + + , testProperty "sanity check the contract model" $ + prop_SanityCheckModel ] initialVal :: Value