diff --git a/agora-specs/Property/Governor.hs b/agora-specs/Property/Governor.hs index a75cf55..1da91d8 100644 --- a/agora-specs/Property/Governor.hs +++ b/agora-specs/Property/Governor.hs @@ -7,7 +7,7 @@ Property model and tests for 'Governor' related functions -} module Property.Governor (props) where -import Agora.Governor (GovernorDatum (..), pisGovernorDatumValid) +import Agora.Governor (Governor (gstOutRef), GovernorDatum (..), pisGovernorDatumValid) import Agora.Governor.Scripts (governorPolicy) import Agora.Proposal ( ProposalId (ProposalId), @@ -201,7 +201,7 @@ governorMintingProperty = opaqueToUnit = plam $ \_ -> pconstant () actual :: Term s (PScriptContext :--> PUnit) - actual = plam $ \sc -> opaqueToUnit #$ governorPolicy governor # pforgetData (pconstantData ()) # sc + actual = plam $ \sc -> opaqueToUnit #$ governorPolicy governor.gstOutRef # pforgetData (pconstantData ()) # sc classifier :: ScriptContext -> GovernorPolicyCases classifier sc diff --git a/agora-specs/Sample/Effect/GovernorMutation.hs b/agora-specs/Sample/Effect/GovernorMutation.hs index 3564091..75a7a56 100644 --- a/agora-specs/Sample/Effect/GovernorMutation.hs +++ b/agora-specs/Sample/Effect/GovernorMutation.hs @@ -17,6 +17,7 @@ import Agora.Effect.GovernorMutation ( ) import Agora.Governor (GovernorDatum (..)) import Agora.Proposal (ProposalId (..), ProposalThresholds (..)) +import Agora.Utils (validatorHashToTokenName) import Data.Default.Class (Default (def)) import Data.Tagged (Tagged (..)) import Plutarch.Api.V1 (mkValidator, validatorHash) @@ -24,7 +25,6 @@ import PlutusLedgerApi.V1 ( Address, Datum (..), ToData (..), - TokenName (..), TxInInfo (..), TxInfo (..), TxOut (..), @@ -40,10 +40,11 @@ import PlutusLedgerApi.V1.Value qualified as Value ( singleton, ) import Sample.Shared ( + agoraScripts, authorityTokenSymbol, + deterministicTracingConfing, govAssetClass, govValidatorAddress, - governor, minAda, signer, ) @@ -51,7 +52,7 @@ import Test.Util (datumPair, toDatumHash) -- | The effect validator instance. effectValidator :: Validator -effectValidator = mkValidator def $ mutateGovernorValidator governor +effectValidator = mkValidator deterministicTracingConfing $ mutateGovernorValidator agoraScripts -- | The hash of the validator instance. effectValidatorHash :: ValidatorHash @@ -65,17 +66,15 @@ effectValidatorAddress = scriptHashAddress effectValidatorHash atAssetClass :: AssetClass atAssetClass = assetClass authorityTokenSymbol tokenName where - -- TODO: use 'validatorHashToTokenName' - ValidatorHash bs = effectValidatorHash - tokenName = TokenName bs + tokenName = validatorHashToTokenName effectValidatorHash -- | The mock reference of the governor state UTXO. govRef :: TxOutRef -govRef = TxOutRef "614481d2159bfb72350222d61fce17e548e0fc00e5a1f841ff1837c431346ce7" 1 +govRef = TxOutRef "1475e1ee22330dfc55430980e5a6b100ec9d9249bb4b462256a79559" 1 -- | The mock reference of the effect UTXO. effectRef :: TxOutRef -effectRef = TxOutRef "c31164dc11835de7eb6187f67d0e1a19c1dfc0786a456923eef5043189cdb578" 1 +effectRef = TxOutRef "a302d327d8e5553d50b9d017475369753f723d7e999ac1b68da8ad52" 1 -- | The input effect datum in 'mkEffectTransaction'. mkEffectDatum :: GovernorDatum -> MutateGovernorDatum @@ -159,7 +158,7 @@ mkEffectTxInfo newGovDatum = , txInfoValidRange = Interval.always , txInfoSignatories = [signer] , txInfoData = datumPair <$> [governorInputDatum, governorOutputDatum, effectInputDatum] - , txInfoId = "4dae3806cc69615b721d52ed09b758f43f25a8f39b7934d6b28514caf71f5f7b" + , txInfoId = "74c75505691e7baa981fa80e50b9b7e88dbe1eda67d4f062d89d203b" } validNewGovernorDatum :: GovernorDatum diff --git a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs index 5cb2db2..3070e79 100644 --- a/agora-specs/Sample/Effect/TreasuryWithdrawal.hs +++ b/agora-specs/Sample/Effect/TreasuryWithdrawal.hs @@ -28,7 +28,7 @@ import Plutarch.Api.V1 (mkValidator, validatorHash) import PlutusLedgerApi.V1 ( Address (Address), Credential (..), - CurrencySymbol (CurrencySymbol), + CurrencySymbol, DatumHash (DatumHash), PubKeyHash, ScriptContext (..), @@ -60,7 +60,7 @@ import Test.Util (scriptCredentials, userCredentials) -- | A sample Currency Symbol. currSymbol :: CurrencySymbol -currSymbol = CurrencySymbol "12312099" +currSymbol = "9c04a69c7133e26061fe5a15adaf4f79cd51e47ef22a2e3c91a36f04" -- | A sample 'PubKeyHash'. signer :: PubKeyHash diff --git a/agora-specs/Sample/Governor/Initialize.hs b/agora-specs/Sample/Governor/Initialize.hs index 3828373..167cb5a 100644 --- a/agora-specs/Sample/Governor/Initialize.hs +++ b/agora-specs/Sample/Governor/Initialize.hs @@ -19,16 +19,20 @@ module Sample.Governor.Initialize ( mkTestCase, ) where +import Agora.Bootstrap (agoraScripts) import Agora.Governor (Governor (..), GovernorDatum (..)) -import Agora.Governor.Scripts ( - governorPolicy, - governorSTAssetClassFromGovernor, +import Agora.Proposal (ProposalId (..), ProposalThresholds (..)) +import Agora.Proposal.Time ( + MaxTimeRangeWidth (MaxTimeRangeWidth), + ProposalTimingConfig (ProposalTimingConfig), + ) +import Agora.Scripts ( + AgoraScripts (compiledGovernorPolicy), + governorSTAssetClass, + governorSTSymbol, governorValidatorHash, ) -import Agora.Proposal (ProposalId (..), ProposalThresholds (..)) -import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalTimingConfig (ProposalTimingConfig)) import Data.Default (Default (..)) -import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy) import Plutarch.Context ( input, mint, @@ -43,7 +47,6 @@ import Plutarch.Context ( ) import PlutusLedgerApi.V1 ( CurrencySymbol, - MintingPolicy, TxOutRef (TxOutRef), ValidatorHash, ) @@ -107,17 +110,17 @@ governor = { gstOutRef = witnessRef } +scripts :: AgoraScripts +scripts = agoraScripts Shared.deterministicTracingConfing governor + govAssetClass :: AssetClass -govAssetClass = governorSTAssetClassFromGovernor governor +govAssetClass = governorSTAssetClass scripts govValidatorHash :: ValidatorHash -govValidatorHash = governorValidatorHash governor - -govPolicy :: MintingPolicy -govPolicy = mkMintingPolicy def (governorPolicy governor) +govValidatorHash = governorValidatorHash scripts govSymbol :: CurrencySymbol -govSymbol = mintingPolicySymbol govPolicy +govSymbol = governorSTSymbol scripts -------------------------------------------------------------------------------- @@ -271,6 +274,6 @@ mkTestCase name ps valid = testPolicy valid name - (governorPolicy governor) + scripts.compiledGovernorPolicy () (mkMinting mintGST ps govSymbol) diff --git a/agora-specs/Sample/Governor/Mutate.hs b/agora-specs/Sample/Governor/Mutate.hs index c5026b3..df8a70c 100644 --- a/agora-specs/Sample/Governor/Mutate.hs +++ b/agora-specs/Sample/Governor/Mutate.hs @@ -18,8 +18,8 @@ module Sample.Governor.Mutate ( import Agora.Effect.NoOp (noOpValidator) import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor)) -import Agora.Governor.Scripts (governorValidator) import Agora.Proposal (ProposalId (ProposalId), ProposalThresholds (..)) +import Agora.Scripts (AgoraScripts (..)) import Agora.Utils (validatorHashToTokenName) import Data.Default (def) import Plutarch.Api.V1 (PValidator, mkValidator, validatorHash) @@ -42,10 +42,10 @@ import PlutusLedgerApi.V1 ( ) import PlutusLedgerApi.V1.Value qualified as Value import Sample.Shared ( + agoraScripts, authorityTokenSymbol, govAssetClass, govValidatorHash, - governor, minAda, ) import Test.Specification (SpecificationTree, testValidator) @@ -219,7 +219,7 @@ mkTestCase name pb (Validity forGov) = testValidator forGov name - (governorValidator governor) + agoraScripts.compiledGovernorValidator governorInputDatum governorRedeemer (mkSpending mutate pb governorRef) diff --git a/agora-specs/Sample/Proposal/Advance.hs b/agora-specs/Sample/Proposal/Advance.hs index 2ef3ff7..6e7a3f1 100644 --- a/agora-specs/Sample/Proposal/Advance.hs +++ b/agora-specs/Sample/Proposal/Advance.hs @@ -37,15 +37,11 @@ module Sample.Proposal.Advance ( mkBadGovernorOutputDatumBundle, ) where -import Agora.AuthorityToken ( - AuthorityToken (AuthorityToken), - authorityTokenPolicy, - ) import Agora.Governor ( + Governor (..), GovernorDatum (..), GovernorRedeemer (MintGATs), ) -import Agora.Governor.Scripts (governorValidator) import Agora.Proposal ( ProposalDatum (..), ProposalId (ProposalId), @@ -56,7 +52,6 @@ import Agora.Proposal ( ResultTag (ResultTag), emptyVotesFor, ) -import Agora.Proposal.Scripts (proposalValidator) import Agora.Proposal.Time ( ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig ( @@ -66,12 +61,11 @@ import Agora.Proposal.Time ( votingTime ), ) +import Agora.Scripts (AgoraScripts (..)) import Agora.Stake ( - Stake (gtClassRef), StakeDatum (..), StakeRedeemer (WitnessStake), ) -import Agora.Stake.Scripts (stakeValidator) import Agora.Utils (validatorHashToTokenName) import Control.Monad.State (execState, modify, when) import Data.Default (def) @@ -107,18 +101,18 @@ import Sample.Proposal.Shared ( stakeTxRef, ) import Sample.Shared ( + agoraScripts, authorityTokenSymbol, govAssetClass, govValidatorHash, + governor, minAda, proposalPolicySymbol, proposalValidatorHash, signer, - stake, stakeAssetClass, stakeValidatorHash, ) -import Sample.Shared qualified as Shared import Test.Specification ( SpecificationTree, group, @@ -394,7 +388,7 @@ mkStakeBuilder ps = minAda <> Value.assetClassValue stakeAssetClass 1 <> Value.assetClassValue - (untag stake.gtClassRef) + (untag governor.gtClassRef) ps.perStakeGTs perStake idx i o = let withSig = @@ -565,7 +559,7 @@ mkTestTree name pb val = testValidator val.forProposalValidator "proposal" - (proposalValidator Shared.proposal) + agoraScripts.compiledProposalValidator proposalInputDatum proposalRedeemer (spend proposalRef) @@ -576,7 +570,7 @@ mkTestTree name pb val = testValidator val.forStakeValidator "stake" - (stakeValidator Shared.stake) + agoraScripts.compiledStakeValidator (getStakeInputDatumAt pb.stakeParameters idx) stakeRedeemer ( spend (mkStakeRef idx) @@ -586,7 +580,7 @@ mkTestTree name pb val = testValidator (fromJust val.forGovernorValidator) "governor" - (governorValidator Shared.governor) + agoraScripts.compiledGovernorValidator governorInputDatum governorRedeemer (spend governorRef) @@ -596,7 +590,7 @@ mkTestTree name pb val = testPolicy (fromJust val.forAuthorityTokenPolicy) "authority" - (authorityTokenPolicy $ AuthorityToken Shared.govAssetClass) + agoraScripts.compiledAuthorityTokenPolicy authorityTokenRedeemer (mint authorityTokenSymbol) <$ (pb.authorityTokenParameters) diff --git a/agora-specs/Sample/Proposal/Cosign.hs b/agora-specs/Sample/Proposal/Cosign.hs index 6970497..09f0b67 100644 --- a/agora-specs/Sample/Proposal/Cosign.hs +++ b/agora-specs/Sample/Proposal/Cosign.hs @@ -14,6 +14,7 @@ module Sample.Proposal.Cosign ( mkTestTree, ) where +import Agora.Governor (Governor (..)) import Agora.Proposal ( ProposalDatum (..), ProposalId (ProposalId), @@ -22,19 +23,17 @@ import Agora.Proposal ( ResultTag (ResultTag), emptyVotesFor, ) -import Agora.Proposal.Scripts (proposalValidator) import Agora.Proposal.Time ( ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (draftTime), ) import Agora.SafeMoney (GTTag) +import Agora.Scripts (AgoraScripts (..)) import Agora.Stake ( - Stake (gtClassRef), StakeDatum (StakeDatum, owner), StakeRedeemer (WitnessStake), stakedAmount, ) -import Agora.Stake.Scripts (stakeValidator) import Data.Coerce (coerce) import Data.Default (def) import Data.List (sort) @@ -61,15 +60,15 @@ import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Shared ( + agoraScripts, + governor, minAda, proposalPolicySymbol, proposalValidatorHash, signer, - stake, stakeAssetClass, stakeValidatorHash, ) -import Sample.Shared qualified as Shared import Test.Specification ( SpecificationTree, group, @@ -149,7 +148,7 @@ cosign ps = builder sortValue $ minAda <> Value.assetClassValue - (untag stake.gtClassRef) + (untag governor.gtClassRef) (untag perStakedGTs) <> sst @@ -322,7 +321,7 @@ mkTestTree name ps isValid = group name [proposal, stake] in testValidator isValid "proposal" - (proposalValidator Shared.proposal) + agoraScripts.compiledProposalValidator proposalInputDatum (mkProposalRedeemer ps) (spend proposalRef) @@ -334,7 +333,7 @@ mkTestTree name ps isValid = group name [proposal, stake] in testValidator isValid "stake" - (stakeValidator Shared.stake) + agoraScripts.compiledStakeValidator stakeInputDatum stakeRedeemer (spend $ mkStakeRef idx) diff --git a/agora-specs/Sample/Proposal/Create.hs b/agora-specs/Sample/Proposal/Create.hs index e962f00..af356fb 100644 --- a/agora-specs/Sample/Proposal/Create.hs +++ b/agora-specs/Sample/Proposal/Create.hs @@ -20,27 +20,24 @@ module Sample.Proposal.Create ( ) where import Agora.Governor ( + Governor (..), GovernorDatum (..), GovernorRedeemer (CreateProposal), ) -import Agora.Governor.Scripts (governorValidator) import Agora.Proposal ( - Proposal (governorSTAssetClass), ProposalDatum (..), ProposalId (ProposalId), ProposalStatus (..), ResultTag (ResultTag), emptyVotesFor, ) -import Agora.Proposal.Scripts (proposalPolicy) import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalStartingTime (..)) +import Agora.Scripts (AgoraScripts (..)) import Agora.Stake ( ProposalLock (..), - Stake (gtClassRef), StakeDatum (..), StakeRedeemer (PermitVote), ) -import Agora.Stake.Scripts (stakeValidator) import Data.Coerce (coerce) import Data.Default (Default (def)) import Data.Tagged (Tagged, untag) @@ -69,19 +66,19 @@ import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap import Sample.Proposal.Shared (stakeTxRef) import Sample.Shared ( + agoraScripts, + govAssetClass, govValidatorHash, + governor, minAda, - proposal, proposalPolicySymbol, proposalStartingTimeFromTimeRange, proposalValidatorHash, signer, signer2, - stake, stakeAssetClass, stakeValidatorHash, ) -import Sample.Shared qualified as Shared import Test.Specification (SpecificationTree, group, testPolicy, testValidator) import Test.Util (CombinableBuilder, closedBoundedInterval, mkMinting, mkSpending, sortValue) @@ -270,7 +267,7 @@ createProposal ps = builder where pst = Value.singleton proposalPolicySymbol "" 1 sst = Value.assetClassValue stakeAssetClass 1 - gst = Value.assetClassValue proposal.governorSTAssetClass 1 + gst = Value.assetClassValue govAssetClass 1 --- @@ -279,7 +276,7 @@ createProposal ps = builder sortValue $ sortValue $ sst - <> Value.assetClassValue (untag stake.gtClassRef) (untag stakedGTs) + <> Value.assetClassValue (untag governor.gtClassRef) (untag stakedGTs) <> minAda proposalValue = sortValue $ pst <> minAda @@ -438,7 +435,7 @@ mkTestTree testPolicy validForProposalPolicy "proposal" - (proposalPolicy Shared.proposal.governorSTAssetClass) + agoraScripts.compiledProposalPolicy proposalPolicyRedeemer (mint proposalPolicySymbol) @@ -446,15 +443,16 @@ mkTestTree testValidator validForGovernorValidator "governor" - (governorValidator Shared.governor) + agoraScripts.compiledGovernorValidator governorInputDatum governorRedeemer (spend governorRef) + stakeTest = testValidator validForStakeValidator "stake" - (stakeValidator Shared.stake) + agoraScripts.compiledStakeValidator (mkStakeInputDatum ps) stakeRedeemer (spend stakeRef) diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs index 09c1db0..5e72125 100644 --- a/agora-specs/Sample/Proposal/UnlockStake.hs +++ b/agora-specs/Sample/Proposal/UnlockStake.hs @@ -25,6 +25,7 @@ module Sample.Proposal.UnlockStake ( -------------------------------------------------------------------------------- +import Agora.Governor (Governor (..)) import Agora.Proposal ( ProposalDatum (..), ProposalId (..), @@ -33,10 +34,9 @@ import Agora.Proposal ( ProposalVotes (..), ResultTag (..), ) -import Agora.Proposal.Scripts (proposalValidator) import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime)) -import Agora.Stake (ProposalLock (..), Stake (..), StakeDatum (..), StakeRedeemer (RetractVotes)) -import Agora.Stake.Scripts (stakeValidator) +import Agora.Scripts (AgoraScripts (..)) +import Agora.Stake (ProposalLock (..), StakeDatum (..), StakeRedeemer (RetractVotes)) import Data.Default.Class (Default (def)) import Data.Tagged (Tagged (..), untag) import Plutarch.Context ( @@ -59,15 +59,15 @@ import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap import Sample.Proposal.Shared (stakeTxRef) import Sample.Shared ( + agoraScripts, + governor, minAda, proposalPolicySymbol, proposalValidatorHash, signer, - stake, stakeAssetClass, stakeValidatorHash, ) -import Sample.Shared qualified as Shared import Test.Specification (SpecificationTree, group, testValidator) import Test.Util (CombinableBuilder, mkSpending, sortValue, updateMap) @@ -277,7 +277,7 @@ unlockStake ps = sortValue $ mconcat [ Value.assetClassValue - (untag stake.gtClassRef) + (untag governor.gtClassRef) (untag defStakedGTs) , sst , minAda @@ -532,7 +532,7 @@ mkTestTree name ps isValid = group name [stake, proposal] testValidator (not ps.alterOutputStake) "stake" - (stakeValidator Shared.stake) + agoraScripts.compiledStakeValidator (mkStakeInputDatum ps) stakeRedeemer (spend stakeRef) @@ -544,7 +544,7 @@ mkTestTree name ps isValid = group name [stake, proposal] in testValidator isValid "proposal" - (proposalValidator Shared.proposal) + agoraScripts.compiledProposalValidator (mkProposalInputDatum ps pid) proposalRedeemer (spend ref) diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs index b1b1835..937a152 100644 --- a/agora-specs/Sample/Proposal/Vote.hs +++ b/agora-specs/Sample/Proposal/Vote.hs @@ -11,6 +11,7 @@ module Sample.Proposal.Vote ( validVoteAsDelegateParameters, ) where +import Agora.Governor (Governor (..)) import Agora.Proposal ( ProposalDatum (..), ProposalId (ProposalId), @@ -19,18 +20,16 @@ import Agora.Proposal ( ProposalVotes (ProposalVotes), ResultTag (ResultTag), ) -import Agora.Proposal.Scripts (proposalValidator) import Agora.Proposal.Time ( ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (draftTime, votingTime), ) +import Agora.Scripts (AgoraScripts (..)) import Agora.Stake ( ProposalLock (..), - Stake (gtClassRef), StakeDatum (..), StakeRedeemer (PermitVote), ) -import Agora.Stake.Scripts (stakeValidator) import Data.Default (Default (def)) import Data.Tagged (Tagged (Tagged), untag) import Plutarch.Context ( @@ -52,15 +51,15 @@ import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Shared ( + agoraScripts, + governor, minAda, proposalPolicySymbol, proposalValidatorHash, signer, - stake, stakeAssetClass, stakeValidatorHash, ) -import Sample.Shared qualified as Shared import Test.Specification ( SpecificationTree, group, @@ -205,7 +204,7 @@ vote params = stakeValue = sortValue $ sst - <> Value.assetClassValue (untag stake.gtClassRef) params.voteCount + <> Value.assetClassValue (untag governor.gtClassRef) params.voteCount <> minAda signer = @@ -278,7 +277,7 @@ mkTestTree name ps isValid = group name [proposal, stake] testValidator isValid "proposal" - (proposalValidator Shared.proposal) + agoraScripts.compiledProposalValidator proposalInputDatum (mkProposalRedeemer ps) (spend proposalRef) @@ -287,7 +286,7 @@ mkTestTree name ps isValid = group name [proposal, stake] let stakeInputDatum = mkStakeInputDatum ps in validatorSucceedsWith "stake" - (stakeValidator Shared.stake) + agoraScripts.compiledStakeValidator stakeInputDatum stakeRedeemer (spend stakeRef) diff --git a/agora-specs/Sample/Shared.hs b/agora-specs/Sample/Shared.hs index a08891a..01039db 100644 --- a/agora-specs/Sample/Shared.hs +++ b/agora-specs/Sample/Shared.hs @@ -12,11 +12,15 @@ module Sample.Shared ( signer, signer2, minAda, + deterministicTracingConfing, + mkEffect, + + -- * Agora Scripts + agoraScripts, -- * Components -- ** Stake - stake, stakeAssetClass, stakeValidatorHash, stakeAddress, @@ -33,14 +37,12 @@ module Sample.Shared ( gstUTXORef, -- ** Proposal - proposal, proposalPolicySymbol, proposalValidatorHash, proposalValidatorAddress, proposalStartingTimeFromTimeRange, -- ** Authority - authorityToken, authorityTokenSymbol, -- ** Treasury @@ -53,38 +55,29 @@ module Sample.Shared ( wrongEffHash, ) where -import Agora.AuthorityToken (AuthorityToken) +import Agora.Bootstrap qualified as Bootstrap import Agora.Effect.NoOp (noOpValidator) import Agora.Governor (Governor (Governor)) -import Agora.Governor.Scripts ( - authorityTokenFromGovernor, - authorityTokenSymbolFromGovernor, - governorPolicy, - governorSTAssetClassFromGovernor, - governorValidator, - governorValidatorHash, - proposalFromGovernor, - proposalSTSymbolFromGovernor, - proposalValidatorHashFromGovernor, - stakeFromGovernor, - stakeSTAssetClassFromGovernor, - stakeSTSymbolFromGovernor, - stakeValidatorHashFromGovernor, - ) -import Agora.Proposal (Proposal (..), ProposalThresholds (..)) +import Agora.Proposal (ProposalThresholds (..)) import Agora.Proposal.Time ( MaxTimeRangeWidth (..), ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..), ) -import Agora.Stake (Stake (..)) +import Agora.Scripts qualified as Scripts import Agora.Treasury (treasuryValidator) -import Agora.Utils (validatorHashToTokenName) +import Agora.Utils ( + CompiledEffect (CompiledEffect), + CompiledMintingPolicy (getCompiledMintingPolicy), + CompiledValidator (getCompiledValidator), + validatorHashToTokenName, + ) import Data.Default.Class (Default (..)) import Data.Tagged (Tagged (..)) +import Plutarch (Config (..), TracingMode (DetTracing)) import Plutarch.Api.V1 ( + PValidator, mintingPolicySymbol, - mkMintingPolicy, mkValidator, validatorHash, ) @@ -110,24 +103,13 @@ import PlutusLedgerApi.V1.Value qualified as Value ( assetClass, singleton, ) +import PlutusTx qualified -stake :: Stake -stake = stakeFromGovernor governor - -stakeSymbol :: CurrencySymbol -stakeSymbol = stakeSTSymbolFromGovernor governor - -stakeAssetClass :: AssetClass -stakeAssetClass = stakeSTAssetClassFromGovernor governor - -stakeValidatorHash :: ValidatorHash -stakeValidatorHash = stakeValidatorHashFromGovernor governor - -stakeAddress :: Address -stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing - -gstUTXORef :: TxOutRef -gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 +-- Plutarch compiler configauration. +-- TODO: add the ability to change this value. Maybe wrap everything in a +-- Reader monad? +deterministicTracingConfing :: Config +deterministicTracingConfing = Config DetTracing governor :: Governor governor = Governor oref gt mc @@ -140,29 +122,44 @@ governor = Governor oref gt mc "LQ" mc = 20 +agoraScripts :: Scripts.AgoraScripts +agoraScripts = Bootstrap.agoraScripts deterministicTracingConfing governor + +stakeSymbol :: CurrencySymbol +stakeSymbol = Scripts.stakeSTSymbol agoraScripts + +stakeAssetClass :: AssetClass +stakeAssetClass = Scripts.stakeSTAssetClass agoraScripts + +stakeValidatorHash :: ValidatorHash +stakeValidatorHash = Scripts.stakeValidatorHash agoraScripts + +stakeAddress :: Address +stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing + +gstUTXORef :: TxOutRef +gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 + govPolicy :: MintingPolicy -govPolicy = mkMintingPolicy def (governorPolicy governor) +govPolicy = getCompiledMintingPolicy $ agoraScripts.compiledGovernorPolicy govValidator :: Validator -govValidator = mkValidator def (governorValidator governor) +govValidator = getCompiledValidator $ agoraScripts.compiledGovernorValidator govSymbol :: CurrencySymbol govSymbol = mintingPolicySymbol govPolicy govAssetClass :: AssetClass -govAssetClass = governorSTAssetClassFromGovernor governor +govAssetClass = Scripts.governorSTAssetClass agoraScripts govValidatorHash :: ValidatorHash -govValidatorHash = governorValidatorHash governor +govValidatorHash = Scripts.governorValidatorHash agoraScripts govValidatorAddress :: Address govValidatorAddress = scriptHashAddress govValidatorHash -proposal :: Proposal -proposal = proposalFromGovernor governor - proposalPolicySymbol :: CurrencySymbol -proposalPolicySymbol = proposalSTSymbolFromGovernor governor +proposalPolicySymbol = Scripts.proposalSTSymbol agoraScripts -- | A sample 'PubKeyHash'. signer :: PubKeyHash @@ -173,7 +170,7 @@ signer2 :: PubKeyHash signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192" proposalValidatorHash :: ValidatorHash -proposalValidatorHash = proposalValidatorHashFromGovernor governor +proposalValidatorHash = Scripts.proposalValidatoHash agoraScripts proposalValidatorAddress :: Address proposalValidatorAddress = scriptHashAddress proposalValidatorHash @@ -189,11 +186,8 @@ instance Default ProposalThresholds where , vote = Tagged 100 } -authorityToken :: AuthorityToken -authorityToken = authorityTokenFromGovernor governor - authorityTokenSymbol :: CurrencySymbol -authorityTokenSymbol = authorityTokenSymbolFromGovernor governor +authorityTokenSymbol = Scripts.authorityTokenSymbol agoraScripts {- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'. For testing purpose only. @@ -222,6 +216,9 @@ proposalStartingTimeFromTimeRange ProposalStartingTime $ (l + u) `div` 2 proposalStartingTimeFromTimeRange _ = error "Given time range should be finite and closed" +mkEffect :: (PlutusTx.ToData datum) => ClosedTerm PValidator -> CompiledEffect datum +mkEffect v = CompiledEffect $ mkValidator deterministicTracingConfing v + ------------------------------------------------------------------ treasuryOut :: TxOut diff --git a/agora-specs/Sample/Stake.hs b/agora-specs/Sample/Stake.hs index 9348260..1d0f2c1 100644 --- a/agora-specs/Sample/Stake.hs +++ b/agora-specs/Sample/Stake.hs @@ -6,10 +6,8 @@ Description: Sample based testing for Stake utxos This module tests primarily the happy path for Stake creation -} module Sample.Stake ( - stake, stakeAssetClass, stakeSymbol, - validatorHashTN, signer, -- * Script contexts @@ -20,15 +18,12 @@ module Sample.Stake ( DepositWithdrawExample (..), ) where +import Agora.Governor (Governor (gtClassRef)) import Agora.SafeMoney (GTTag) import Agora.Stake ( - Stake (gtClassRef), StakeDatum (StakeDatum, stakedAmount), ) -import Agora.Stake.Scripts (stakeValidator) -import Data.Default (def) import Data.Tagged (Tagged, untag) -import Plutarch.Api.V1 (mkValidator, validatorHash) import Plutarch.Context ( MintingBuilder, SpendingBuilder, @@ -51,9 +46,7 @@ import PlutusLedgerApi.V1 ( ScriptContext (..), ScriptPurpose (Minting), ToData (toBuiltinData), - TokenName (TokenName), TxInfo (txInfoData, txInfoSignatories), - ValidatorHash (ValidatorHash), ) import PlutusLedgerApi.V1.Contexts (TxOutRef (..)) import PlutusLedgerApi.V1.Value qualified as Value ( @@ -61,19 +54,13 @@ import PlutusLedgerApi.V1.Value qualified as Value ( singleton, ) import Sample.Shared ( + governor, signer, - stake, stakeAssetClass, stakeSymbol, stakeValidatorHash, ) - --- | 'TokenName' that represents the hash of the 'Stake' validator. -validatorHashTN :: TokenName -validatorHashTN = - let validator = mkValidator def $ stakeValidator stake - ValidatorHash vh = validatorHash validator - in TokenName vh +import Test.Util (sortValue) -- | This script context should be a valid transaction. stakeCreation :: ScriptContext @@ -151,14 +138,22 @@ stakeDepositWithdraw config = , input $ mconcat [ script stakeValidatorHash - , withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeBefore.stakedAmount)) + , withValue + ( sortValue $ + st + <> Value.assetClassValue (untag governor.gtClassRef) (untag stakeBefore.stakedAmount) + ) , withDatum stakeAfter , withOutRef stakeRef ] , output $ mconcat [ script stakeValidatorHash - , withValue (st <> Value.assetClassValue (untag stake.gtClassRef) (untag stakeAfter.stakedAmount)) + , withValue + ( sortValue $ + st + <> Value.assetClassValue (untag governor.gtClassRef) (untag stakeAfter.stakedAmount) + ) , withDatum stakeAfter ] , withSpendingOutRef stakeRef diff --git a/agora-specs/Sample/Stake/SetDelegate.hs b/agora-specs/Sample/Stake/SetDelegate.hs index 4549600..9f9f25e 100644 --- a/agora-specs/Sample/Stake/SetDelegate.hs +++ b/agora-specs/Sample/Stake/SetDelegate.hs @@ -19,12 +19,12 @@ module Sample.Stake.SetDelegate ( delegateToOwnerParameters, ) where +import Agora.Governor (Governor (gtClassRef)) +import Agora.Scripts (AgoraScripts (..)) import Agora.Stake ( - Stake (gtClassRef), StakeDatum (..), StakeRedeemer (ClearDelegate, DelegateTo), ) -import Agora.Stake.Scripts (stakeValidator) import Data.Tagged (untag) import Plutarch.Context ( SpendingBuilder, @@ -46,10 +46,11 @@ import PlutusLedgerApi.V1 ( ) import PlutusLedgerApi.V1.Value qualified as Value import Sample.Shared ( + agoraScripts, + governor, minAda, signer, signer2, - stake, stakeAssetClass, stakeValidatorHash, ) @@ -118,7 +119,7 @@ setDelegate ps = buildSpendingUnsafe builder mconcat [ st , Value.assetClassValue - (untag stake.gtClassRef) + (untag governor.gtClassRef) (untag stakeInput.stakedAmount) , minAda ] @@ -154,7 +155,7 @@ mkTestCase name ps valid = testValidator valid name - (stakeValidator stake) + agoraScripts.compiledStakeValidator (mkStakeInputDatum ps) (mkStakeRedeemer ps) (setDelegate ps) diff --git a/agora-specs/Spec/Effect/GovernorMutation.hs b/agora-specs/Spec/Effect/GovernorMutation.hs index ebcf120..72a17e6 100644 --- a/agora-specs/Spec/Effect/GovernorMutation.hs +++ b/agora-specs/Spec/Effect/GovernorMutation.hs @@ -2,8 +2,8 @@ module Spec.Effect.GovernorMutation (specs) where import Agora.Effect.GovernorMutation (mutateGovernorValidator) import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor)) -import Agora.Governor.Scripts (governorValidator) import Agora.Proposal (ProposalId (..)) +import Agora.Scripts (AgoraScripts (..)) import Data.Default.Class (Default (def)) import PlutusLedgerApi.V1 (ScriptContext (ScriptContext), ScriptPurpose (Spending)) import Sample.Effect.GovernorMutation ( @@ -14,7 +14,7 @@ import Sample.Effect.GovernorMutation ( mkEffectTxInfo, validNewGovernorDatum, ) -import Sample.Shared qualified as Shared +import Sample.Shared (agoraScripts, mkEffect) import Test.Specification ( SpecificationTree, effectFailsWith, @@ -32,7 +32,7 @@ specs = "valid new governor datum" [ validatorSucceedsWith "governor validator should pass" - (governorValidator Shared.governor) + agoraScripts.compiledGovernorValidator ( GovernorDatum def (ProposalId 0) @@ -47,7 +47,7 @@ specs = ) , effectSucceedsWith "effect validator should pass" - (mutateGovernorValidator Shared.governor) + (mkEffect $ mutateGovernorValidator agoraScripts) (mkEffectDatum validNewGovernorDatum) (ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef)) ] @@ -55,7 +55,7 @@ specs = "invalid new governor datum" [ validatorFailsWith "governor validator should fail" - (governorValidator Shared.governor) + agoraScripts.compiledGovernorValidator ( GovernorDatum def (ProposalId 0) @@ -70,7 +70,7 @@ specs = ) , effectFailsWith "effect validator should fail" - (mutateGovernorValidator Shared.governor) + (mkEffect $ mutateGovernorValidator agoraScripts) (mkEffectDatum validNewGovernorDatum) (ScriptContext (mkEffectTxInfo invalidNewGovernorDatum) (Spending effectRef)) ] diff --git a/agora-specs/Spec/Effect/TreasuryWithdrawal.hs b/agora-specs/Spec/Effect/TreasuryWithdrawal.hs index ea0f67a..984a49c 100644 --- a/agora-specs/Spec/Effect/TreasuryWithdrawal.hs +++ b/agora-specs/Spec/Effect/TreasuryWithdrawal.hs @@ -25,12 +25,14 @@ import Sample.Effect.TreasuryWithdrawal ( treasuries, users, ) +import Sample.Shared (mkEffect) import Test.Specification ( SpecificationTree, effectFailsWith, effectSucceedsWith, group, ) +import Test.Util (sortValue) specs :: [SpecificationTree] specs = @@ -38,7 +40,7 @@ specs = "effect" [ effectSucceedsWith "Simple" - (treasuryWithdrawalValidator currSymbol) + (mkEffect $ treasuryWithdrawalValidator currSymbol) datum1 ( buildScriptContext [ inputGAT @@ -50,7 +52,7 @@ specs = ) , effectSucceedsWith "Simple with multiple treasuries " - (treasuryWithdrawalValidator currSymbol) + (mkEffect $ treasuryWithdrawalValidator currSymbol) datum1 ( buildScriptContext [ inputGAT @@ -67,7 +69,7 @@ specs = ) , effectSucceedsWith "Mixed Assets" - (treasuryWithdrawalValidator currSymbol) + (mkEffect $ treasuryWithdrawalValidator currSymbol) datum2 ( buildScriptContext [ inputGAT @@ -82,7 +84,7 @@ specs = ) , effectFailsWith "Pay to uknown 3rd party" - (treasuryWithdrawalValidator currSymbol) + (mkEffect $ treasuryWithdrawalValidator currSymbol) datum2 ( buildScriptContext [ inputGAT @@ -98,7 +100,7 @@ specs = ) , effectFailsWith "Missing receiver" - (treasuryWithdrawalValidator currSymbol) + (mkEffect $ treasuryWithdrawalValidator currSymbol) datum2 ( buildScriptContext [ inputGAT @@ -113,7 +115,7 @@ specs = ) , effectFailsWith "Unauthorized treasury" - (treasuryWithdrawalValidator currSymbol) + (mkEffect $ treasuryWithdrawalValidator currSymbol) datum3 ( buildScriptContext [ inputGAT @@ -125,7 +127,7 @@ specs = ) , effectFailsWith "Prevent transactions besides the withdrawal" - (treasuryWithdrawalValidator currSymbol) + (mkEffect $ treasuryWithdrawalValidator currSymbol) datum3 ( buildScriptContext [ inputGAT @@ -141,8 +143,14 @@ specs = ] ] where - asset1 = Value.singleton "abbc12" "OrangeBottle" - asset2 = Value.singleton "abbc12" "19721121" + asset1 = + Value.singleton + "0d586e057e76238f8c56c0752507bfa45ae13b04f8497a311d4aaa48" + "OrangeBottle" + asset2 = + Value.singleton + "7e6aa764bceeba1f7acf47d20f1a2a85440afa2928f8ae96376f4d85" + "19721121" datum1 = TreasuryWithdrawalDatum [ (head users, asset1 1) @@ -155,8 +163,8 @@ specs = ] datum2 = TreasuryWithdrawalDatum - [ (head users, asset2 5 <> asset1 4) - , (users !! 1, asset2 1 <> asset1 2) + [ (head users, sortValue $ asset2 5 <> asset1 4) + , (users !! 1, sortValue $ asset2 1 <> asset1 2) , (users !! 2, asset1 1) ] [ head treasuries diff --git a/agora-specs/Spec/Stake.hs b/agora-specs/Spec/Stake.hs index 686e441..b9e781f 100644 --- a/agora-specs/Spec/Stake.hs +++ b/agora-specs/Spec/Stake.hs @@ -9,14 +9,14 @@ Tests for Stake policy and validator -} module Spec.Stake (specs) where +import Agora.Scripts (AgoraScripts (..)) import Agora.Stake ( - Stake (..), StakeDatum (StakeDatum), StakeRedeemer (DepositWithdraw), ) -import Agora.Stake.Scripts (stakePolicy, stakeValidator) import Data.Bool (Bool (..)) import Data.Maybe (Maybe (..)) +import Sample.Shared (agoraScripts) import Sample.Stake ( DepositWithdrawExample ( DepositWithdrawExample, @@ -26,7 +26,6 @@ import Sample.Stake ( signer, ) import Sample.Stake qualified as Stake ( - stake, stakeCreation, stakeCreationUnsigned, stakeCreationWrongDatum, @@ -41,7 +40,6 @@ import Test.Specification ( validatorFailsWith, validatorSucceedsWith, ) -import Test.Util (toDatum) import Prelude (Num (negate), ($)) -- | The SpecificationTree exported by this module. @@ -51,17 +49,17 @@ specs = "policy" [ policySucceedsWith "stakeCreation" - (stakePolicy Stake.stake.gtClassRef) + agoraScripts.compiledStakePolicy () Stake.stakeCreation , policyFailsWith "stakeCreationWrongDatum" - (stakePolicy Stake.stake.gtClassRef) + agoraScripts.compiledStakePolicy () Stake.stakeCreationWrongDatum , policyFailsWith "stakeCreationUnsigned" - (stakePolicy Stake.stake.gtClassRef) + agoraScripts.compiledStakePolicy () Stake.stakeCreationUnsigned ] @@ -69,21 +67,21 @@ specs = "validator" [ validatorSucceedsWith "stakeDepositWithdraw deposit" - (stakeValidator Stake.stake) - (toDatum $ StakeDatum 100_000 signer Nothing []) - (toDatum $ DepositWithdraw 100_000) + agoraScripts.compiledStakeValidator + (StakeDatum 100_000 signer Nothing []) + (DepositWithdraw 100_000) (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = 100_000}) , validatorSucceedsWith "stakeDepositWithdraw withdraw" - (stakeValidator Stake.stake) - (toDatum $ StakeDatum 100_000 signer Nothing []) - (toDatum $ DepositWithdraw $ negate 100_000) + agoraScripts.compiledStakeValidator + (StakeDatum 100_000 signer Nothing []) + (DepositWithdraw $ negate 100_000) (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 100_000}) , validatorFailsWith "stakeDepositWithdraw negative GT" - (stakeValidator Stake.stake) - (toDatum $ StakeDatum 100_000 signer Nothing []) - (toDatum $ DepositWithdraw 1_000_000) + agoraScripts.compiledStakeValidator + (StakeDatum 100_000 signer Nothing []) + (DepositWithdraw 1_000_000) (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 1_000_000}) , group "set delegate" diff --git a/agora-specs/Spec/Treasury.hs b/agora-specs/Spec/Treasury.hs index 6d29bc6..03d60fb 100644 --- a/agora-specs/Spec/Treasury.hs +++ b/agora-specs/Spec/Treasury.hs @@ -25,6 +25,8 @@ import Agora.Treasury ( TreasuryRedeemer (SpendTreasuryGAT), treasuryValidator, ) +import Agora.Utils (CompiledValidator (CompiledValidator)) +import Plutarch.Api.V1 (mkValidator) import PlutusLedgerApi.V1 (DCert (DCertDelegRegKey)) import PlutusLedgerApi.V1.Contexts ( ScriptContext (scriptContextPurpose, scriptContextTxInfo), @@ -35,7 +37,7 @@ import PlutusLedgerApi.V1.Credential ( StakingCredential (StakingHash), ) import PlutusLedgerApi.V1.Value qualified as Value (singleton) -import Sample.Shared (trCredential) +import Sample.Shared (deterministicTracingConfing, trCredential) import Sample.Treasury ( gatCs, gatTn, @@ -51,6 +53,12 @@ import Test.Specification ( validatorSucceedsWith, ) +compiledTreasuryValidator :: CompiledValidator () TreasuryRedeemer +compiledTreasuryValidator = + CompiledValidator $ + mkValidator deterministicTracingConfing $ + treasuryValidator gatCs + specs :: [SpecificationTree] specs = [ group @@ -59,7 +67,7 @@ specs = "Positive" [ validatorSucceedsWith "Allows for effect changes" - (treasuryValidator gatCs) + compiledTreasuryValidator () SpendTreasuryGAT validCtx @@ -70,7 +78,7 @@ specs = "Fails with ScriptPurpose not Minting" [ validatorFailsWith "Spending" - (treasuryValidator gatCs) + compiledTreasuryValidator () SpendTreasuryGAT validCtx @@ -78,7 +86,7 @@ specs = } , validatorFailsWith "Rewarding" - (treasuryValidator gatCs) + compiledTreasuryValidator () SpendTreasuryGAT validCtx @@ -88,7 +96,7 @@ specs = } , validatorFailsWith "Certifying" - (treasuryValidator gatCs) + compiledTreasuryValidator () SpendTreasuryGAT validCtx @@ -100,7 +108,7 @@ specs = ] , validatorFailsWith -- TODO: Use QuickCheck. "Fails when multiple GATs burned" - (treasuryValidator gatCs) + compiledTreasuryValidator () SpendTreasuryGAT validCtx @@ -115,13 +123,13 @@ specs = } , validatorFailsWith "Fails when GAT token name is not script address" - (treasuryValidator gatCs) + compiledTreasuryValidator () SpendTreasuryGAT trCtxGATNameNotAddress , validatorFailsWith "Fails with wallet as input" - (treasuryValidator gatCs) + compiledTreasuryValidator () SpendTreasuryGAT ( let txInfo = validCtx.scriptContextTxInfo diff --git a/agora-testlib/Test/Specification.hs b/agora-testlib/Test/Specification.hs index 34a0335..2280af9 100644 --- a/agora-testlib/Test/Specification.hs +++ b/agora-testlib/Test/Specification.hs @@ -49,12 +49,18 @@ module Test.Specification ( toTestTree, ) where -import Plutarch.Api.V1 (PMintingPolicy, PValidator) -import Plutarch.Builtin (pforgetData) +import Agora.Utils (CompiledEffect (..), CompiledMintingPolicy (..), CompiledValidator (..)) +import Control.Composition ((.**), (.***)) +import Data.Coerce (coerce) import Plutarch.Evaluate (evalScript) -import Plutarch.Extra.Compile (mustCompile) -import Plutarch.Lift (PUnsafeLiftDecl (PLifted)) -import PlutusLedgerApi.V1 (Script, ScriptContext) +import PlutusLedgerApi.V1 ( + Datum (..), + Redeemer (Redeemer), + Script, + ScriptContext, + ToData (toBuiltinData), + ) +import PlutusLedgerApi.V1.Scripts (Context (..), applyMintingPolicyScript, applyValidator) import PlutusTx.IsData qualified as PlutusTx (ToData) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase) @@ -153,122 +159,133 @@ scriptSucceeds name script = Terminal $ Specification name Success script scriptFails :: String -> Script -> SpecificationTree scriptFails name script = Terminal $ Specification name Failure script +mkContext :: ScriptContext -> Context +mkContext = Context . toBuiltinData + +mkRedeemer :: + forall redeemer. + (PlutusTx.ToData redeemer) => + redeemer -> + Redeemer +mkRedeemer = Redeemer . toBuiltinData + +mkDatum :: + forall datum. + (PlutusTx.ToData datum) => + datum -> + Datum +mkDatum = Datum . toBuiltinData + +applyMintingPolicy' :: + (PlutusTx.ToData redeemer) => + CompiledMintingPolicy redeemer -> + redeemer -> + ScriptContext -> + Script +applyMintingPolicy' policy redeemer scriptContext = + applyMintingPolicyScript + (mkContext scriptContext) + (getCompiledMintingPolicy policy) + (mkRedeemer redeemer) + +applyValidator' :: + ( PlutusTx.ToData datum + , PlutusTx.ToData redeemer + ) => + CompiledValidator datum redeemer -> + datum -> + redeemer -> + ScriptContext -> + Script +applyValidator' validator datum redeemer scriptContext = + applyValidator + (mkContext scriptContext) + (getCompiledValidator validator) + (mkDatum datum) + (mkRedeemer redeemer) + -- | Check that a policy script succeeds, given a name and arguments. policySucceedsWith :: - ( PLift redeemer - , PlutusTx.ToData (PLifted redeemer) - ) => + (PlutusTx.ToData redeemer) => String -> - ClosedTerm PMintingPolicy -> - PLifted redeemer -> + CompiledMintingPolicy redeemer -> + redeemer -> ScriptContext -> SpecificationTree -policySucceedsWith tag policy redeemer scriptContext = - scriptSucceeds tag $ - mustCompile - ( policy - # pforgetData (pconstantData redeemer) - # pconstant scriptContext - ) +policySucceedsWith tag = + scriptSucceeds tag .** applyMintingPolicy' -- | Check that a policy script fails, given a name and arguments. policyFailsWith :: - ( PLift redeemer - , PlutusTx.ToData (PLifted redeemer) - ) => + (PlutusTx.ToData redeemer) => String -> - ClosedTerm PMintingPolicy -> - PLifted redeemer -> + CompiledMintingPolicy redeemer -> + redeemer -> ScriptContext -> SpecificationTree -policyFailsWith tag policy redeemer scriptContext = - scriptFails tag $ - mustCompile - ( policy - # pforgetData (pconstantData redeemer) - # pconstant scriptContext - ) +policyFailsWith tag = + scriptFails tag .** applyMintingPolicy' -- | Check that a validator script succeeds, given a name and arguments. validatorSucceedsWith :: - ( PLift datum - , PlutusTx.ToData (PLifted datum) - , PLift redeemer - , PlutusTx.ToData (PLifted redeemer) + ( PlutusTx.ToData datum + , PlutusTx.ToData redeemer ) => String -> - ClosedTerm PValidator -> - PLifted datum -> - PLifted redeemer -> + CompiledValidator datum redeemer -> + datum -> + redeemer -> ScriptContext -> SpecificationTree -validatorSucceedsWith tag validator datum redeemer scriptContext = - scriptSucceeds tag $ - mustCompile - ( validator - # pforgetData (pconstantData datum) - # pforgetData (pconstantData redeemer) - # pconstant scriptContext - ) +validatorSucceedsWith tag = + scriptSucceeds tag .*** applyValidator' -- | Check that a validator script fails, given a name and arguments. validatorFailsWith :: - ( PLift datum - , PlutusTx.ToData (PLifted datum) - , PLift redeemer - , PlutusTx.ToData (PLifted redeemer) + ( PlutusTx.ToData datum + , PlutusTx.ToData redeemer ) => String -> - ClosedTerm PValidator -> - PLifted datum -> - PLifted redeemer -> + CompiledValidator datum redeemer -> + datum -> + redeemer -> ScriptContext -> SpecificationTree -validatorFailsWith tag validator datum redeemer scriptContext = - scriptFails tag $ - mustCompile - ( validator - # pforgetData (pconstantData datum) - # pforgetData (pconstantData redeemer) - # pconstant scriptContext - ) +validatorFailsWith tag = + scriptFails tag .*** applyValidator' -- | Check that an effect succeeds, given a name and argument. effectSucceedsWith :: - ( PLift datum - , PlutusTx.ToData (PLifted datum) + ( PlutusTx.ToData datum ) => String -> - ClosedTerm PValidator -> - PLifted datum -> + CompiledEffect datum -> + datum -> ScriptContext -> SpecificationTree -effectSucceedsWith tag eff datum = validatorSucceedsWith tag eff datum () +effectSucceedsWith tag eff datum = validatorSucceedsWith tag (coerce eff) datum () -- | Check that an effect fails, given a name and argument. effectFailsWith :: - ( PLift datum - , PlutusTx.ToData (PLifted datum) + ( PlutusTx.ToData datum ) => String -> - ClosedTerm PValidator -> - PLifted datum -> + CompiledEffect datum -> + datum -> ScriptContext -> SpecificationTree -effectFailsWith tag eff datum = validatorFailsWith tag eff datum () +effectFailsWith tag eff datum = validatorFailsWith tag (coerce eff) datum () +-- | Test a validator, given the expectation as a boolean value. testValidator :: - ( PLift datum - , PlutusTx.ToData (PLifted datum) - , PLift redeemer - , PlutusTx.ToData (PLifted redeemer) - ) => - -- | Should the validator pass? + forall datum redeemer. + (PlutusTx.ToData datum, PlutusTx.ToData redeemer) => + -- | Is this test case expected to succeed? Bool -> String -> - ClosedTerm PValidator -> - PLifted datum -> - PLifted redeemer -> + CompiledValidator datum redeemer -> + datum -> + redeemer -> ScriptContext -> SpecificationTree testValidator isValid = @@ -276,14 +293,15 @@ testValidator isValid = then validatorSucceedsWith else validatorFailsWith +-- | Test a policy, given the expectation as a boolean value. testPolicy :: - ( PLift redeemer - , PlutusTx.ToData (PLifted redeemer) - ) => + forall redeemer. + (PlutusTx.ToData redeemer) => + -- | Is this test case expected to succeed? Bool -> String -> - ClosedTerm PMintingPolicy -> - PLifted redeemer -> + CompiledMintingPolicy redeemer -> + redeemer -> ScriptContext -> SpecificationTree testPolicy isValid =