feat: add tx-level-minter sample

Anastasia-Labs · Apr 27, 2024 · 9698cad · 9698cad
1 parent ed765ac
commit 9698cad
Show file tree

Hide file tree

Showing 4 changed files with 34 additions and 8 deletions.
diff --git a/plutarch-design-pattern.cabal b/plutarch-design-pattern.cabal
@@ -158,5 +158,6 @@ test-suite plutarch-design-pattern-test
   other-modules:
     Spec.MerkelizedValidatorSpec
     Spec.StakeValidatorSpec
+    Spec.TxLevelMinterSpec
 
   build-depends:  plutarch-design-pattern
diff --git a/src/Plutarch/TxLevelMinter.hs b/src/Plutarch/TxLevelMinter.hs
@@ -5,7 +5,7 @@ module Plutarch.TxLevelMinter (
 
 import Plutarch.Api.V1.Address (PCredential (..))
 import Plutarch.Api.V1.Value (pnormalize)
-import Plutarch.Api.V2 (PCurrencySymbol (..), PScriptContext, PScriptPurpose (..), PStakeValidator, PTokenName)
+import Plutarch.Api.V2 (PCurrencySymbol (..), PMintingPolicy, PScriptContext, PScriptPurpose (..), PTokenName)
 import Plutarch.Api.V2.Contexts (PTxInfo)
 import Plutarch.Builtin (pasInt)
 import Plutarch.Monadic qualified as P
@@ -42,7 +42,7 @@ spend = phoistAcyclic $ plam $ \mintTN red ctx -> P.do
     (pconstant ())
     perror
 
-mint :: Term s (PData :--> PCurrencySymbol :--> PTxInfo :--> PUnit) -> Term s PStakeValidator
+mint :: Term s (PData :--> PCurrencySymbol :--> PTxInfo :--> PUnit) -> Term s PMintingPolicy
 mint mintLogic =
   plam $ \redeemer ctx -> unTermCont $ do
     ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx

diff --git a/test/Spec/StakeValidatorSpec.hs b/test/Spec/StakeValidatorSpec.hs
@@ -2,22 +2,22 @@ module Spec.StakeValidatorSpec (
   validator,
 ) where
 
-import Plutarch.Api.V2 (PScriptContext, PStakeValidator, PStakingCredential, PValidator)
+import Plutarch.Api.V2 (PStakeValidator, PStakingCredential, PValidator)
+import Plutarch.Api.V2.Contexts (PTxInfo)
 import Plutarch.Multivalidator qualified as Multivalidator
+import Plutarch.Prelude
 import Plutarch.StakeValidator qualified as StakeValidator
 
 spend :: Term s PValidator
 spend = StakeValidator.spend
 
 withdrawLogic :: Term s (PData :--> PStakingCredential :--> PTxInfo :--> PUnit)
 withdrawLogic =
-  plam $ \redData ownValidator txInfo -> unTermCont $ do
+  plam $ \_ _ _ -> unTermCont $ do
     pure $ pconstant ()
 
 withdraw :: Term s PStakeValidator
-withdraw = phoistAcyclic $
-  plam $ \redeemer ctx -> unTermCont $ do
-    return $ StakeValidator.withdraw withdrawLogic redeemer ctx
+withdraw = StakeValidator.withdraw withdrawLogic
 
-validator :: Term s PStakeValidator
+validator :: Term s PValidator
 validator = Multivalidator.multivalidator withdraw spend
diff --git a/test/Spec/TxLevelMinterSpec.hs b/test/Spec/TxLevelMinterSpec.hs
@@ -0,0 +1,25 @@
+module Spec.TxLevelMinterSpec (
+  validator,
+) where
+
+import Plutarch.Api.V2 (PCurrencySymbol, PMintingPolicy, PValidator)
+import Plutarch.Api.V2.Contexts (PTxInfo)
+import Plutarch.Multivalidator qualified as Multivalidator
+import Plutarch.Prelude
+import Plutarch.TxLevelMinter qualified as TxLevelMinter
+
+spend :: Term s PValidator
+spend = phoistAcyclic $
+  plam $ \_ redeemer ctx -> unTermCont $ do
+    return (popaque $ TxLevelMinter.spend # pconstant "BEACON" # redeemer # ctx)
+
+mintLogic :: Term s (PData :--> PCurrencySymbol :--> PTxInfo :--> PUnit)
+mintLogic =
+  plam $ \_ _ _ -> unTermCont $ do
+    pure $ pconstant ()
+
+mint :: Term s PMintingPolicy
+mint = TxLevelMinter.mint mintLogic
+
+validator :: Term s PValidator
+validator = Multivalidator.multivalidator mint spend