feat: update merkelized validator sample

plutarch-design-pattern.cabal

@@ -159,5 +159,6 @@ test-suite plutarch-design-pattern-test
     Spec.MerkelizedValidatorSpec
     Spec.StakeValidatorSpec
     Spec.TxLevelMinterSpec
+    Spec.Utils
 
   build-depends:  plutarch-design-pattern

test/Spec.hs

@@ -8,5 +8,6 @@ main = do
   defaultMain $
     testGroup
       "Unit Test Group"
-      [ Spec.MerkelizedValidatorSpec.unitTest
+      [ Spec.MerkelizedValidatorSpec.spendUnitTest
+      , Spec.MerkelizedValidatorSpec.withdrawUnitTest
       ]

test/Spec/MerkelizedValidatorSpec.hs

@@ -1,16 +1,19 @@
 module Spec.MerkelizedValidatorSpec (
   psumOfSquares,
-  unitTest,
+  spendUnitTest,
+  withdrawUnitTest,
+  withdraw,
 ) where
 
 import Plutarch.Api.V1.Address (PCredential (..))
 import Plutarch.Api.V2 (
   PScriptHash (..),
+  PStakeValidator,
   PStakingCredential (..),
   PValidator,
  )
-import Plutarch.Builtin (pasInt)
-import Plutarch.MerkelizedValidator (spend)
+import Plutarch.Builtin (pasInt, pdataImpl)
+import Plutarch.MerkelizedValidator qualified as MerkelizedValidator
 import Plutarch.Num ((#*), (#+))
 import Plutarch.Prelude
 import Plutarch.Test.Precompiled (Expectation (Failure), testEvalCase, tryFromPTerm)
@@ -22,25 +25,28 @@ import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (
   pletFieldsC,
  )
 
-psumOfSquares :: (PIsListLike list PInteger) => Term s (list PInteger :--> list PInteger)
+psumOfSquares :: (PIsListLike list PData, PIsListLike list PInteger) => Term s (list PData :--> list PData)
 psumOfSquares =
   plam $ \xs ->
-    let result = pfoldl # plam (\x y -> (x #* x) #+ y) # 0 # xs
-     in psingleton # result
+    let result = pfoldl # plam (\x y -> (x #* x) #+ y) # 0 # (pmap # pasInt # xs)
+     in psingleton # pdataImpl result
 
 validator :: Term s PStakingCredential -> Term s PValidator
 validator stakeCred =
   plam $ \x y ctx -> unTermCont $ do
     ctxF <- pletFieldsC @'["txInfo"] ctx
     txInfoF <- pletFieldsC @'["redeemers"] ctxF.txInfo
-    sum' <- pletC $ pheadSingleton #$ spend stakeCred (pcons # x # (pcons # y # pnil)) txInfoF.redeemers
+    sum' <- pletC $ pheadSingleton #$ MerkelizedValidator.spend stakeCred (pcons # x # (pcons # y # pnil)) txInfoF.redeemers
     sum <- pletC $ pasInt # sum'
     return $
       pif
         (sum #< 42)
         (popaque $ pconstant ())
         perror
 
+withdraw :: Term s PStakeValidator
+withdraw = MerkelizedValidator.withdraw psumOfSquares
+
 scByteString :: Term s PByteString
 scByteString = pconstant "b055a795895b15d9af25acb752ac89c78524acfa387acb626c7e1bc8"
 
@@ -49,12 +55,21 @@ stakeCred =
   pcon $ PStakingHash $ pdcons @"_0" # (pdata $ pcon $ PScriptCredential $ pdcons @"_0" # (pdata . pcon . PScriptHash) scByteString # pdnil) # pdnil
 
 -- TODO(hadelive)
-unitTest :: TestTree
-unitTest = tryFromPTerm "Merkelized Validator Unit Test" (validator stakeCred) $ do
+spendUnitTest :: TestTree
+spendUnitTest = tryFromPTerm "Merkelized Validator Spend Unit Test" (validator stakeCred) $ do
   testEvalCase
     "Fail"
     Failure
     [ PlutusTx.toData ()
     , PlutusTx.toData ()
     , PlutusTx.toData ()
     ]
+
+withdrawUnitTest :: TestTree
+withdrawUnitTest = tryFromPTerm "Merkelized Validator Withdraw Unit Test" withdraw $ do
+  testEvalCase
+    "Fail"
+    Failure
+    [ PlutusTx.toData ()
+    , PlutusTx.toData ()
+    ]

test/Spec/Utils.hs

@@ -0,0 +1,23 @@
+module Spec.Utils (
+  inputValidator,
+  inputOutputValidator,
+  collectiveOutputValidator,
+) where
+
+import Plutarch.Api.V2 (PTxInInfo, PTxOut)
+import Plutarch.Prelude
+
+inputValidator :: Term s (PTxInInfo :--> PBool)
+inputValidator = phoistAcyclic $
+  plam $
+    \_ -> pcon PTrue
+
+inputOutputValidator :: Term s (PTxOut :--> PTxOut :--> PBool)
+inputOutputValidator = phoistAcyclic $
+  plam $
+    \_ _ -> pcon PTrue
+
+collectiveOutputValidator :: Term s (PBuiltinList PTxOut :--> PInteger :--> PBool)
+collectiveOutputValidator = phoistAcyclic $
+  plam $
+    \_ _ -> pcon PTrue