Updated treasury docs to reflect current implementation

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.

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)