diff --git a/plutarch-design-pattern.cabal b/plutarch-design-pattern.cabal index 8cfbcdd..dbeda1d 100644 --- 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 index 78a93b6..be33447 100644 --- 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 index f7df52d..13bdcee 100644 --- a/test/Spec/StakeValidatorSpec.hs +++ b/test/Spec/StakeValidatorSpec.hs @@ -2,8 +2,10 @@ 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 @@ -11,13 +13,11 @@ 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 new file mode 100644 index 0000000..b658180 --- /dev/null +++ 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