diff --git a/docs/tech-design/treasury.md b/docs/tech-design/treasury.md index 395f128..fe15702 100644 --- a/docs/tech-design/treasury.md +++ b/docs/tech-design/treasury.md @@ -2,7 +2,7 @@ | Specification | Implementation | Last revision | |:-----------:|:--------------:|:-------------:| -| Draft | WIP | v0.1 2022-03-01 | +| Draft | WIP | v0.1 2022-03-04 | --- @@ -20,8 +20,8 @@ **Current Status**: -- Conceptual draft agreed upon. -- Requires technical details and review from [Emily Martins]. +- Conceptual draft agreed upon. +- Implementation incomplete; documentation subject to change. --- @@ -48,19 +48,36 @@ The treasury will further be the initial holder of all a governance system's GT. are all, naturally, protocol-specific. A simple method for creating such a bespoke reward structure is **not** considered in-scope for Agora v1. Agora v1 will offer a simple, prescribed reward structure, that allows the treasury to determine the reward eligibility of a user and allow them to redeem said amount. -## Script +## Script -The script for an Agora treasury is described in this section. +The script for an Agora treasury is described in this section. For clarity, all data types and functions are written in _traditional Haskell_, rather than at the Plutarch level. -### Datum +### Datum -```hs -data TreasuryD = TreasuryD - { reserves :: Value - , stateThread :: CurrencySymbol +```hs +newtype TreasuryDtum = TreasuryDatum + { -- | Currency symbol of the treasury state thread. + stateThread :: CurrencySymbol } ``` -### Redeemers +### Redeemers + +```hs +newtype TreasuryRedeemer = AlterTrParams +``` + +At the current stage, it is sufficient to allow users to simply grant funds to the treasury, without an explicit redeemer. The only redeemer that is required is `AlterTrParams`, for when the treasury's parameters are subject to change by a proposal effect. ### Validators + +```hs +treasuryV :: + CurrencySymbol -> + TreasuryDatum -> + TreasuryRedeemer -> + ScriptContext -> + () +``` + +The only redeemer the validator handles at present is `AlterTrParams`. The validator ensures that a valid governance authority token is burned, when a proposal effect is attempting to alter the parameters of the treasury. diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs index 9066e1a..2e309bb 100644 --- a/src/Agora/Treasury.hs +++ b/src/Agora/Treasury.hs @@ -8,19 +8,25 @@ treasury. -} module Agora.Treasury (module Agora.Treasury) where +import Agora.Utils (passetClassValueOf) import GHC.Generics qualified as GHC import Generics.SOP -import Plutarch.Api.V1.Contexts (PScriptContext) -import Plutarch.Api.V1.Value (PCurrencySymbol) +import Plutarch.Api.V1.Contexts (PScriptContext, PScriptPurpose (PMinting)) +import Plutarch.Api.V1.Value (PCurrencySymbol, PValue) import Plutarch.DataRepr ( PDataFields, PIsDataReprInstances (PIsDataReprInstances), ) +import Plutarch.Monadic qualified as P +import Plutus.V1.Ledger.Value (CurrencySymbol, TokenName) {- | Validator ensuring that transactions consuming the treasury do so in a valid manner. -} treasuryV :: + forall {s :: S}. + CurrencySymbol -> + TokenName -> Term s ( PAsData PTreasuryDatum @@ -28,13 +34,28 @@ treasuryV :: :--> PAsData PScriptContext :--> PUnit ) -treasuryV = plam $ \_d r _ctx' -> P.do - pmatch (pfromData r) $ \case - -- Redeemer seeking to alter treasury parameters. Must ensure - -- a valid GAT is burned in the transaction. - PAlterTrParams _ -> - -- TODO: Implement. - ptraceError "Altering treasury parameters is not currently supported." +treasuryV cs tn = plam $ \_d r ctx' -> P.do + -- plet required fields from script context. + ctx <- pletFields @["txInfo", "purpose"] ctx' + + -- Ensure redeemer type is valid. + PAlterTrParams _ <- pmatch $ pfromData r + + -- Ensure that script is for burning i.e. minting a negative amount. + PMinting _ <- pmatch ctx.purpose + + -- Get the minted value from txInfo. + txInfo' <- plet ctx.txInfo + txInfo <- pletFields @'["mint"] txInfo' + let mint :: Term s PValue + mint = txInfo.mint + gatAmountMinted :: Term s PInteger + gatAmountMinted = passetClassValueOf # (pconstant cs) # (pconstant tn) # mint + + pif + (gatAmountMinted #== -1) -- If the amount of GATS burned is not one, ... + (ptraceError "GAT not burned.") -- ... then error. + (pconstant ()) -- ... else success. {- | Plutarch level type representing datum of the treasury. Contains: @@ -61,8 +82,8 @@ newtype PTreasuryDatum (s :: S) treasury. -} newtype PTreasuryRedeemer (s :: S) - = -- | Alters treasury parameters (subject to the burning of a - -- governance authority token). + = -- | Alters treasury parameters, subject to the burning of a + -- governance authority token. PAlterTrParams (Term s (PDataRecord '[])) deriving stock (GHC.Generic) deriving anyclass (Generic, PIsDataRepr)