add property to sanity check model (#114)

checking that balances sometimes change

Author: UlfNorell

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.
 

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