From 3be54024df4d0c946643125be6e5ddffc79f0f69 Mon Sep 17 00:00:00 2001
From: Marcin Bugaj <marcin@mlabs.city>
Date: Tue, 12 Sep 2023 21:44:21 +0200
Subject: [PATCH] Tests added + documentation

---
 .../Simple/PlutusLedgerApi/V1/Scripts.hs      |  2 +-
 psm/plutus-simple-model.cabal                 |  1 +
 psm/test/Suites/Plutarch.hs                   | 78 +++++++++++++++----
 3 files changed, 65 insertions(+), 16 deletions(-)

diff --git a/cardano-simple/src/Cardano/Simple/PlutusLedgerApi/V1/Scripts.hs b/cardano-simple/src/Cardano/Simple/PlutusLedgerApi/V1/Scripts.hs
index cee1b9c..5894a83 100644
--- a/cardano-simple/src/Cardano/Simple/PlutusLedgerApi/V1/Scripts.hs
+++ b/cardano-simple/src/Cardano/Simple/PlutusLedgerApi/V1/Scripts.hs
@@ -106,7 +106,7 @@ applyPlutarchTypedScript
           UPLC.Program () v1 $
             UPLC.Apply () t1 t2
 
--- | 'PlutarchTypedScript' represents compiled a plutarch script while preserving type of the script
+-- | 'PlutarchTypedScript' represents a compiled plutarch script while preserving type of the script
 newtype PlutarchTypedScript s = PlutarchTypedScript {getPlutarchTypedScript :: Script}
 
 -- | 'Validator' is a wrapper around 'Script's which are used as validators in transaction outputs.
diff --git a/psm/plutus-simple-model.cabal b/psm/plutus-simple-model.cabal
index 0c8b40c..3d9e213 100644
--- a/psm/plutus-simple-model.cabal
+++ b/psm/plutus-simple-model.cabal
@@ -185,6 +185,7 @@ test-suite plutus-simple-model-test
     Suites.Plutus.Model.Util
 
   build-depends:
+    , cardano-simple
     , plutus-simple-model
     , plutus-tx-plugin
 
diff --git a/psm/test/Suites/Plutarch.hs b/psm/test/Suites/Plutarch.hs
index ddf05eb..d7d86cf 100644
--- a/psm/test/Suites/Plutarch.hs
+++ b/psm/test/Suites/Plutarch.hs
@@ -5,6 +5,7 @@ module Suites.Plutarch (tests) where
 import Plutarch.Prelude
 import Prelude
 
+import Cardano.Simple.PlutusLedgerApi.V1.Scripts (applyPlutarchTypedScript, mkPlutarchTypedScript)
 import Control.Monad (void)
 import Data.Default (def)
 import Data.Either (fromRight)
@@ -12,7 +13,7 @@ import Plutarch.Api.V2 (PValidator)
 import Plutarch.Monadic qualified as P
 import Plutus.Model (DatumMode (..), Run (..), TypedValidator (..), adaValue, defaultBabbageV2, mustFail, newUser, payToKey, payToScript, sendTx, signTx, spend, spendScript, userSpend, utxoAt)
 import Plutus.Model.Contract (testNoErrors)
-import Plutus.Model.V2 (mkTypedValidatorPlutarch)
+import Plutus.Model.V2 (mkTypedValidatorPlutarch, mkTypedValidatorPlutarchTypedScript)
 import PlutusLedgerApi.V1 (toBuiltin)
 import PlutusLedgerApi.V2 (BuiltinByteString)
 import Test.Tasty (TestTree, testGroup)
@@ -21,25 +22,32 @@ tests :: TestTree
 tests =
   testGroup
     "Plutarch"
-    [ good "Good guess" (testValidator "aa")
-    , bad "Bad guess" (testValidator "bb")
+    [ testGroup
+        "Game version with datums"
+        [ good "Good guess" (testValidatorWithDatum "aa")
+        , bad "Bad guess" (testValidatorWithDatum "bb")
+        ]
+    , testGroup
+        "Game version with parametrized validator"
+        [ good "Good guess" (testValidatorParametrized "aa")
+        , bad "Bad guess" (testValidatorParametrized "bb")
+        ]
     ]
   where
     bad msg = good msg . mustFail
     good = testNoErrors (adaValue 10_000_000) cfg
     cfg = defaultBabbageV2
 
-testValidator :: BuiltinByteString -> Run ()
-testValidator guess = do
+pHash :: Term s PByteString
+pHash = phexByteStr "961b6dd3ede3cb8ecbaacbd68de040cd78eb2ed5889130cceb4c49268ea4d506"
+
+testValidator :: GameValidator -> BuiltinByteString -> Run ()
+testValidator validator guess = do
   u1 <- newUser (adaValue 1_000_000)
   u2 <- newUser (adaValue 1_000_000)
   let amt = adaValue 100
       -- magic string is from 'echo -n aa | sha256sum'
-      datum =
-        toBuiltin $
-          plift $
-            phexByteStr
-              "961b6dd3ede3cb8ecbaacbd68de040cd78eb2ed5889130cceb4c49268ea4d506"
+      datum = toBuiltin $ plift pHash
   do
     -- initialize
     sp <- spend u1 amt
@@ -57,16 +65,56 @@ testValidator guess = do
           <> payToKey u2 amt
     void $ sendTx tx
 
-validator :: TypedValidator BuiltinByteString BuiltinByteString
-validator =
+testValidatorWithDatum :: BuiltinByteString -> Run ()
+testValidatorWithDatum = testValidator validatorWithDatum
+
+testValidatorParametrized :: BuiltinByteString -> Run ()
+testValidatorParametrized = testValidator validatorParametrized
+
+type GameValidator = TypedValidator BuiltinByteString BuiltinByteString
+
+validatorWithDatum :: GameValidator
+validatorWithDatum =
   fromRight (error "no validator") $
-    mkTypedValidatorPlutarch def gameContractPlutarch
+    mkTypedValidatorPlutarch def gameContractPlutarchWithDatum
+
+validatorParametrized :: GameValidator
+validatorParametrized =
+  fromRight (error "no validator") $ do
+    -- Execution time of `mkTypedValidatorPlutarch` and `mkPlutarchTypedScript`
+    -- can take up to 2 seconds for large validators.
+    -- One definitely should avoid calling these functions in every test.
+    -- It's recommended to compile a validator exactly once
+    -- to keep low psm tests execution time.
+    compiledParametrizedScript <-
+      mkPlutarchTypedScript def gameContractPlutarchParametrized
+
+    -- Once we have access to compiled (parametrized) validator script
+    -- we can apply it to some parameters which is usually very cheap.
+    -- This can be done in every test -
+    -- especially if validator's parameter varies across tests.
+    validator <-
+      applyPlutarchTypedScript def compiledParametrizedScript pHash
 
-gameContractPlutarch :: ClosedTerm PValidator
-gameContractPlutarch = plam $ \d' r' _ -> popaque $ P.do
+    pure $ mkTypedValidatorPlutarchTypedScript validator
+
+-- Datum is used to submit a hash of a puzzle
+gameContractPlutarchWithDatum :: ClosedTerm PValidator
+gameContractPlutarchWithDatum = plam $ \d' r' _ -> popaque $ P.do
   (r :: Term s (PAsData PByteString), _) <- ptryFrom r'
   (d :: Term s (PAsData PByteString), _) <- ptryFrom d'
   pif
     (psha2_256 # pfromData r #== pfromData d)
     (pconstant ())
     perror
+
+-- Script is parametrized by a hash of a puzzle; Datum does not matter
+-- The hash is set once and for all.
+-- For a new game the term below needs to be applied to a new hash.
+gameContractPlutarchParametrized :: ClosedTerm (PByteString :--> PValidator)
+gameContractPlutarchParametrized = plam $ \expectedHash _ r' _ -> popaque $ P.do
+  (r :: Term s (PAsData PByteString), _) <- ptryFrom r'
+  pif
+    (psha2_256 # pfromData r #== expectedHash)
+    (pconstant ())
+    perror