fix treasury implementation and tests

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

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

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 =

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 ()
   }
 

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

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