From 04d6cbefe90931d7ffadefdbba8f37c8f2ebd257 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Thu, 1 Sep 2022 17:54:16 +0200 Subject: [PATCH] fix treasury implementation and tests --- agora-purescript-bridge/AgoraTypes.hs | 3 - agora-specs/Sample/Treasury.hs | 18 +++--- agora-specs/Spec/Treasury.hs | 26 ++++---- agora/Agora/Scripts.hs | 3 +- agora/Agora/Treasury.hs | 93 ++------------------------- bench.csv | 4 +- 6 files changed, 28 insertions(+), 119 deletions(-) diff --git a/agora-purescript-bridge/AgoraTypes.hs b/agora-purescript-bridge/AgoraTypes.hs index 21a41d9..a6dd27a 100644 --- a/agora-purescript-bridge/AgoraTypes.hs +++ b/agora-purescript-bridge/AgoraTypes.hs @@ -17,7 +17,6 @@ import Agora.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawalEffect import Agora.Governor qualified as Governor import Agora.Proposal qualified as Proposal import Agora.Stake qualified as Stake -import Agora.Treasury qualified as Treasury -------------------------------------------------------------------------------- @@ -39,8 +38,6 @@ agoraTypes = mkSumType (Proxy @Stake.ProposalLock) , mkSumType (Proxy @Stake.StakeRedeemer) , mkSumType (Proxy @Stake.StakeDatum) - , -- Treasury - mkSumType (Proxy @Treasury.TreasuryRedeemer) , -- AuthorityToken mkSumType (Proxy @AuthorityToken.AuthorityToken) , -- Effects diff --git a/agora-specs/Sample/Treasury.hs b/agora-specs/Sample/Treasury.hs index d206b0c..7928dc4 100644 --- a/agora-specs/Sample/Treasury.hs +++ b/agora-specs/Sample/Treasury.hs @@ -18,8 +18,8 @@ module Sample.Treasury ( ) where import Plutarch.Context ( - MintingBuilder, - buildMinting', + SpendingBuilder, + buildSpending', credential, input, mint, @@ -27,8 +27,8 @@ import Plutarch.Context ( script, signedWith, txId, - withMinting, withRefTxId, + withSpendingOutRefId, withValue, ) import PlutusLedgerApi.V1.Address (Address (..)) @@ -55,7 +55,7 @@ import Sample.Shared ( wrongEffHash, ) -baseCtxBuilder :: MintingBuilder +baseCtxBuilder :: SpendingBuilder baseCtxBuilder = let treasury = mconcat @@ -69,7 +69,7 @@ baseCtxBuilder = , mint (Value.singleton gatCs gatTn (-1)) , input treasury , output treasury - , withMinting gatCs + , withSpendingOutRefId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" ] {- | A `ScriptContext` that should be compatible with treasury @@ -77,7 +77,7 @@ baseCtxBuilder = -} validCtx :: ScriptContext validCtx = - let builder :: MintingBuilder + let builder :: SpendingBuilder builder = mconcat [ baseCtxBuilder @@ -88,7 +88,7 @@ validCtx = , withRefTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3" ] ] - in buildMinting' builder + in buildSpending' builder treasuryRef :: TxOutRef treasuryRef = @@ -121,7 +121,7 @@ walletIn = trCtxGATNameNotAddress :: ScriptContext trCtxGATNameNotAddress = - let builder :: MintingBuilder + let builder :: SpendingBuilder builder = mconcat [ baseCtxBuilder @@ -132,4 +132,4 @@ trCtxGATNameNotAddress = , withRefTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3" ] ] - in buildMinting' builder + in buildSpending' builder diff --git a/agora-specs/Spec/Treasury.hs b/agora-specs/Spec/Treasury.hs index 8fa4a8b..a76cd0b 100644 --- a/agora-specs/Spec/Treasury.hs +++ b/agora-specs/Spec/Treasury.hs @@ -22,7 +22,6 @@ Tests need to fail when: module Spec.Treasury (specs) where import Agora.Treasury ( - TreasuryRedeemer (SpendTreasuryGAT), treasuryValidator, ) import Agora.Utils (CompiledValidator (CompiledValidator)) @@ -34,7 +33,7 @@ import PlutusLedgerApi.V1.Value qualified as Value (singleton) import PlutusLedgerApi.V2 (DCert (DCertDelegRegKey)) import PlutusLedgerApi.V2.Contexts ( ScriptContext (scriptContextPurpose, scriptContextTxInfo), - ScriptPurpose (Certifying, Rewarding, Spending), + ScriptPurpose (Certifying, Minting, Rewarding), TxInfo (txInfoInputs, txInfoMint), ) import Sample.Shared (deterministicTracingConfing, trCredential) @@ -42,7 +41,6 @@ import Sample.Treasury ( gatCs, gatTn, trCtxGATNameNotAddress, - treasuryRef, validCtx, walletIn, ) @@ -53,7 +51,7 @@ import Test.Specification ( validatorSucceedsWith, ) -compiledTreasuryValidator :: CompiledValidator () TreasuryRedeemer +compiledTreasuryValidator :: CompiledValidator () () compiledTreasuryValidator = CompiledValidator $ mkValidator deterministicTracingConfing $ @@ -69,32 +67,32 @@ specs = "Allows for effect changes" compiledTreasuryValidator () - SpendTreasuryGAT + () validCtx , validatorSucceedsWith "Fails when GAT token name is not script address" compiledTreasuryValidator () - SpendTreasuryGAT + () trCtxGATNameNotAddress ] , group "Negative" [ group - "Fails with ScriptPurpose not Minting" + "Fails with ScriptPurpose not Spending" [ validatorFailsWith - "Spending" + "Minting" compiledTreasuryValidator () - SpendTreasuryGAT + () validCtx - { scriptContextPurpose = Spending treasuryRef + { scriptContextPurpose = Minting "" } , validatorFailsWith "Rewarding" compiledTreasuryValidator () - SpendTreasuryGAT + () validCtx { scriptContextPurpose = Rewarding $ @@ -104,7 +102,7 @@ specs = "Certifying" compiledTreasuryValidator () - SpendTreasuryGAT + () validCtx { scriptContextPurpose = Certifying $ @@ -116,7 +114,7 @@ specs = "Fails when multiple GATs burned" compiledTreasuryValidator () - SpendTreasuryGAT + () validCtx { scriptContextTxInfo = validCtx.scriptContextTxInfo @@ -131,7 +129,7 @@ specs = "Fails with wallet as input" compiledTreasuryValidator () - SpendTreasuryGAT + () ( let txInfo = validCtx.scriptContextTxInfo inputs = txInfo.txInfoInputs newInputs = diff --git a/agora/Agora/Scripts.hs b/agora/Agora/Scripts.hs index 60494eb..186ad18 100644 --- a/agora/Agora/Scripts.hs +++ b/agora/Agora/Scripts.hs @@ -22,7 +22,6 @@ module Agora.Scripts ( import Agora.Governor (GovernorDatum, GovernorRedeemer) import Agora.Proposal (ProposalDatum, ProposalRedeemer) import Agora.Stake (StakeDatum, StakeRedeemer) -import Agora.Treasury (TreasuryRedeemer) import Agora.Utils ( CompiledMintingPolicy (getCompiledMintingPolicy), CompiledValidator (getCompiledValidator), @@ -54,7 +53,7 @@ data AgoraScripts = AgoraScripts , compiledStakeValidator :: CompiledValidator StakeDatum StakeRedeemer , compiledProposalPolicy :: CompiledMintingPolicy () , compiledProposalValidator :: CompiledValidator ProposalDatum ProposalRedeemer - , compiledTreasuryValidator :: CompiledValidator () TreasuryRedeemer + , compiledTreasuryValidator :: CompiledValidator () () , compiledAuthorityTokenPolicy :: CompiledMintingPolicy () } diff --git a/agora/Agora/Treasury.hs b/agora/Agora/Treasury.hs index 44f4c03..410f3fc 100644 --- a/agora/Agora/Treasury.hs +++ b/agora/Agora/Treasury.hs @@ -9,96 +9,15 @@ Contains the datum, redeemer and validator for a template DAO treasury. -} module Agora.Treasury ( - TreasuryRedeemer (..), - PTreasuryRedeemer (..), treasuryValidator, ) where import Agora.AuthorityToken (singleAuthorityTokenBurned) -import Generics.SOP qualified as SOP import Plutarch.Api.V1.Value (PValue) -import Plutarch.Api.V2 (PScriptPurpose (PMinting), PValidator) -import Plutarch.Builtin (pforgetData) -import Plutarch.Extra.IsData ( - DerivePConstantViaEnum (DerivePConstantEnum), - EnumIsData (EnumIsData), - PlutusTypeEnumData, - ) +import Plutarch.Api.V2 (PScriptPurpose (PSpending), PValidator) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC) -import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl) import Plutarch.TryFrom () import PlutusLedgerApi.V1.Value (CurrencySymbol) -import PlutusTx qualified - -{- | Redeemer for Treasury actions. - - @since 0.1.0 --} -data TreasuryRedeemer - = -- | Allow transaction to pass by delegating to GAT burn. - SpendTreasuryGAT - deriving stock - ( -- | @since 0.1.0 - Eq - , -- | @since 0.1.0 - Show - , -- | @since 0.1.0 - Generic - , -- | @since 0.2.0 - Enum - , -- | @since 0.2.0 - Bounded - ) - deriving anyclass - ( -- | @since 0.2.0 - SOP.Generic - ) - deriving - ( -- | @since 0.1.0 - PlutusTx.ToData - , -- | @since 0.1.0 - PlutusTx.FromData - ) - via (EnumIsData TreasuryRedeemer) - --------------------------------------------------------------------------------- - -{- | Plutarch level type representing valid redeemers of the - treasury. - - @since 0.1.0 --} -data PTreasuryRedeemer (s :: S) - = PSpendTreasuryGAT - deriving stock - ( -- | @since 0.1.0 - Generic - , -- | @since 0.2.0 - Bounded - , -- | @since 0.2.0 - Enum - ) - deriving anyclass - ( -- | @since 0.1.0 - PlutusType - , -- | @since 0.1.0 - PIsData - ) - -instance DerivePlutusType PTreasuryRedeemer where - type DPTStrat _ = PlutusTypeEnumData - --- | @since 0.1.0 -instance PUnsafeLiftDecl PTreasuryRedeemer where - type PLifted PTreasuryRedeemer = TreasuryRedeemer - --- | @since 0.1.0 -deriving via - (DerivePConstantViaEnum TreasuryRedeemer PTreasuryRedeemer) - instance - (PConstantDecl TreasuryRedeemer) - --------------------------------------------------------------------------------- {- | Validator ensuring that transactions consuming the treasury do so in a valid manner. @@ -109,16 +28,12 @@ treasuryValidator :: -- | Governance Authority Token that can unlock this validator. CurrencySymbol -> ClosedTerm PValidator -treasuryValidator gatCs' = plam $ \_datum redeemer ctx' -> unTermCont $ do +treasuryValidator gatCs' = plam $ \_ _ ctx' -> unTermCont $ do -- plet required fields from script context. ctx <- pletFieldsC @["txInfo", "purpose"] ctx' - -- Ensure that script is for burning i.e. minting a negative amount. - PMinting _ <- pmatchC ctx.purpose - - -- Ensure redeemer type is valid. - pguardC "Redeemer should be SpendTreasuryGAT" $ - redeemer #== pforgetData (pconstantData SpendTreasuryGAT) + -- Ensure that script is for spending. + PSpending _ <- pmatchC ctx.purpose -- Get the minted value from txInfo. txInfo <- pletFieldsC @'["mint", "inputs"] ctx.txInfo diff --git a/bench.csv b/bench.csv index de96958..04df7a8 100644 --- a/bench.csv +++ b/bench.csv @@ -621,8 +621,8 @@ Agora/Proposal/validator/unlocking/illegal/with 42 proposals/creator: retract vo Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,24929970,68747,726 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,47662922,128817,826 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct even though scripts don't match,24929970,68747,725 -Agora/Treasury/Validator/Positive/Allows for effect changes,40927846,108662,1430 -Agora/Treasury/Validator/Positive/Fails when GAT token name is not script address,40927846,108662,1466 +Agora/Treasury/Validator/Positive/Allows for effect changes,39447993,107460,1386 +Agora/Treasury/Validator/Positive/Fails when GAT token name is not script address,39447993,107460,1422 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,24929970,68747,726 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,47662922,128817,826 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct even though scripts don't match,24929970,68747,725