SCP-5125 Added property-based tests for multiple validators.

input-output-hk · Mar 15, 2023 · 435ac68 · 435ac68
1 parent 6f6331b
commit 435ac68
Showing 1 changed file with 18 additions and 53 deletions.
diff --git a/marlowe-test/src/Spec/Marlowe/Plutus/Specification.hs b/marlowe-test/src/Spec/Marlowe/Plutus/Specification.hs
@@ -22,7 +22,7 @@ module Spec.Marlowe.Plutus.Specification
     tests
   ) where
 
-import Control.Lens (use, uses, (%=), (.=), (<>=), (<~), (^.))
+import Control.Lens (use, uses, (%=), (<>=), (<~), (^.))
 import Control.Monad.State (lift)
 import Data.Bifunctor (bimap)
 import Data.List (nub)
@@ -104,7 +104,19 @@ import Spec.Marlowe.Reference (ReferencePath)
 import Spec.Marlowe.Semantics.Arbitrary (arbitraryPositiveInteger)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.QuickCheck
-  (Arbitrary(..), Gen, Property, chooseInteger, elements, forAll, listOf1, oneof, property, suchThat, testProperty, (===))
+  ( Arbitrary(..)
+  , Gen
+  , Property
+  , chooseInteger
+  , elements
+  , forAll
+  , listOf1
+  , oneof
+  , property
+  , suchThat
+  , testProperty
+  , (===)
+  )
 
 import qualified Language.Marlowe.Core.V1.Semantics as M (MarloweData(marloweParams))
 import qualified Language.Marlowe.Core.V1.Semantics.Types as M (Party(Address), State(..))
@@ -204,11 +216,6 @@ tests referencePaths =
             [
               testProperty "Invalid other validators during payment" $ checkOtherValidators referencePaths
             ]
-        , testGroup "Constraint 19. No duplicates"
-            [
-              testProperty "Invalid duplicate accounts in input state" checkInputDuplicates
-              -- TODO: This test on the output state requires instrumenting the Plutus script. For now, this constraint is enforced manually by code inspection.
-            ]
         , testProperty "Script hash matches reference hash"
             $ checkValidatorHash semanticsScriptHash
               -- DO NOT ALTER THE FOLLOWING VALUE UNLESS YOU ARE COMMITTING
@@ -297,8 +304,8 @@ checkSemanticsTransaction referencePaths modifyBefore modifyAfter condition vali
     . forAll (arbitrarySemanticsTransaction referencePaths modifyBefore modifyAfter noisy `suchThat` condition)
     $ \PlutusTransaction{..} ->
       case evaluateSemantics (toData _datum) (toData _redeemer) (toData _scriptContext) of
-        This  e   -> not valid || (error $ show e)
-        These e l -> not valid || (error $ show e <> ": " <> show l)
+        This  e   -> not valid || error (show e)
+        These e l -> not valid || error (show e <> ": " <> show l)
         That    _ -> valid
 
 
@@ -314,8 +321,8 @@ checkPayoutTransaction modifyBefore modifyAfter condition valid noisy =
     . forAll (arbitraryPayoutTransaction modifyBefore modifyAfter noisy `suchThat` condition)
     $ \PlutusTransaction{..} ->
       case evaluatePayout (toData _datum) (toData _redeemer) (toData _scriptContext) of
-        This  e   -> not valid || (error $ show e)
-        These e l -> not valid || (error $ show e <> ": " <> show l)
+        This  e   -> not valid || error (show e)
+        These e l -> not valid || error (show e <> ": " <> show l)
         That    _ -> valid
 
 
@@ -508,48 +515,6 @@ checkInputDuplicates referencePaths =
     checkSemanticsTransaction referencePaths modifyBefore noModify hasDuplicates False False
 
 
--- | Add a duplicate entry to an assocation list.
-addDuplicate :: Arbitrary v => AM.Map k v -> Gen (AM.Map k v)
-addDuplicate am =
-  do
-    let
-      am' = AM.toList am
-    key <- elements $ fst <$> am'
-    value <- arbitrary
-    AM.fromList <$> Q.shuffle ((key, value) : am')
-
-
--- | Check for the detection of duplicates in input state
-checkInputDuplicates :: Property
-checkInputDuplicates =
-  let
-    hasDuplicates tx =
-      let
-        hasDuplicate am = length (AM.keys am) /= length (nub $ AM.keys am)
-        M.State{..} = tx ^. inputState
-      in
-           hasDuplicate accounts
-        || hasDuplicate choices
-        || hasDuplicate boundValues
-    makeDuplicates am =
-      if AM.null am
-        then pure am
-        else oneof [pure am, addDuplicate am]
-    modifyBefore =
-      do
-        M.State{..} <- use inputState
-        state' <-
-          lift
-            $ M.State
-            <$> makeDuplicates accounts
-            <*> makeDuplicates choices
-            <*> makeDuplicates boundValues
-            <*> pure minTime
-        inputState .= state'
-  in
-    checkSemanticsTransaction modifyBefore noModify hasDuplicates False False
-
-
 -- | Check that output datum to a script matches its semantic output.
 checkDatumOutput :: [ReferencePath] -> (MarloweData -> Gen MarloweData) -> Property
 checkDatumOutput referencePaths perturb =