From 840624af0e7f69c7f9d819ab158f9991e0e0fcc3 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Mon, 28 Feb 2022 14:25:20 +0000
Subject: [PATCH 01/18] Minorly updated docs

---
 docs/tech-design/treasury.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/docs/tech-design/treasury.md b/docs/tech-design/treasury.md
index abd977a..be532dd 100644
--- a/docs/tech-design/treasury.md
+++ b/docs/tech-design/treasury.md
@@ -12,7 +12,7 @@
 
 -   [Jack Hodgkinson]
 
-**Implementation ownership:** _unassigned_
+**Implementation ownership:** [Jack Hodgkinson]
 
 [Jack Hodgkinson]: https://github.com/jhodgdev
 

From 9ab736c24df0cdf138db5ac2a629ea8d15c11050 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Tue, 1 Mar 2022 12:53:39 +0000
Subject: [PATCH 02/18] Initialised skeleton for treasury

---
 .gitignore                   |  4 ++
 Makefile                     | 11 +++--
 agora.cabal                  |  9 ++++-
 docs/tech-design/treasury.md | 22 +++++++++-
 src/Agora/Treasury.hs        | 78 ++++++++++++++++++++++++++++++++++++
 5 files changed, 117 insertions(+), 7 deletions(-)
 create mode 100644 src/Agora/Treasury.hs

diff --git a/.gitignore b/.gitignore
index 5ae1889..a2329d2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -21,3 +21,7 @@ TAGS
 # direnv files
 .envrc
 .direnv/
+
+# Haddock files and Hoogle databases 
+haddock 
+hoo
diff --git a/Makefile b/Makefile
index 35cd401..38026f3 100644
--- a/Makefile
+++ b/Makefile
@@ -8,13 +8,18 @@ usage:
 	@echo "Available commands:"
 	@echo "  hoogle -- Start local hoogle"
 	@echo "  format -- Format the project"
+	@echo "  haddock -- Generate Haddock docs for project"
 
-HOOGLE_PORT=8081
-hoogle:
-	hoogle server --local --port $(HOOGLE_PORT) > /dev/null &
+hoogle: 
+	hoogle generate --local=haddock --database=hoo/local.hoo
+	hoogle server --local -p 8081 >> /dev/null &
+	hoogle server --local --database=hoo/local.hoo -p 8082 >> /dev/null &
 
 FORMAT_EXTENSIONS := -o -XQuasiQuotes -o -XTemplateHaskell -o -XTypeApplications -o -XImportQualifiedPost -o -XPatternSynonyms -o -XOverloadedRecordDot
 format:
 	find -name '*.hs' -not -path './dist-*/*' | xargs fourmolu $(FORMAT_EXTENSIONS) -m inplace
 	git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.nix' | xargs nixfmt
 	git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.cabal' | xargs cabal-fmt -i
+
+haddock:
+	cabal haddock --haddock-html --haddock-hoogle --builddir=haddock
diff --git a/agora.cabal b/agora.cabal
index c26f23b..ab38454 100644
--- a/agora.cabal
+++ b/agora.cabal
@@ -23,6 +23,7 @@ common lang
     pprelude (PPrelude as Prelude)
 
   default-extensions:
+    UndecidableInstances
     NoStarIsType
     BangPatterns
     BinaryLiterals
@@ -92,6 +93,7 @@ common deps
     , containers
     , data-default
     , data-default-class
+    , generics-sop
     , plutarch
     , plutus-core
     , plutus-ledger-api
@@ -112,7 +114,10 @@ common test-deps
 
 library
   import:          lang, deps
-  exposed-modules: Agora.AuthorityToken
+  exposed-modules:
+    Agora.AuthorityToken
+    Agora.Treasury
+
   other-modules:
   hs-source-dirs:  src
 
@@ -137,5 +142,5 @@ benchmark agora-bench
   main-is:        Main.hs
   type:           exitcode-stdio-1.0
   build-depends:
+    , agora
     , plutarch-benchmark
-    , agora
\ No newline at end of file
diff --git a/docs/tech-design/treasury.md b/docs/tech-design/treasury.md
index be532dd..395f128 100644
--- a/docs/tech-design/treasury.md
+++ b/docs/tech-design/treasury.md
@@ -2,7 +2,7 @@
 
 | Specification | Implementation    | Last revision |
 |:-----------:|:--------------:|:-------------:|
-| WIP         |  WIP           | v0.1 2022-02-07 |
+| Draft         |  WIP           | v0.1 2022-03-01 |
 
 ---
 
@@ -20,7 +20,8 @@
 
 **Current Status**:
 
-Initial conceptual draft. Requires review from [Emily Martins].
+- Conceptual draft agreed upon. 
+- Requires technical details and review from [Emily Martins].
 
 ---
 
@@ -46,3 +47,20 @@ The treasury will further be the initial holder of all a governance system's GT.
 3.  How much do they receive in their reward?
 
 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 
+
+The script for an Agora treasury is described in this section.
+
+### Datum 
+
+```hs 
+data TreasuryD = TreasuryD
+  { reserves :: Value
+  , stateThread :: CurrencySymbol
+  }
+```
+
+### Redeemers 
+
+### Validators
diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
new file mode 100644
index 0000000..02ca842
--- /dev/null
+++ b/src/Agora/Treasury.hs
@@ -0,0 +1,78 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
+{- |
+Module: Agora.Treasury
+Maintainer: jack@mlabs.city
+Description: Treasury scripts.
+
+Contains the datum, redeemer and validator for a template DAO
+treasury.
+-}
+module Agora.Treasury where
+
+import GHC.Generics qualified as GHC
+import Generics.SOP
+import Plutarch.Api.V1.Contexts (PScriptContext)
+import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
+import Plutarch.DataRepr (
+  PDataFields,
+  PIsDataReprInstances (PIsDataReprInstances),
+ )
+import Plutarch.Monadic qualified as P
+
+{- | Validator ensuring that transactions consuming the treasury
+     do so in a valid manner.
+-}
+treasuryV ::
+  Term
+    s
+    ( PAsData PTreasuryDatum
+        :--> PAsData PTreasuryRedeemer
+        :--> PAsData PScriptContext
+        :--> PUnit
+    )
+treasuryV = plam $ \_d r ctx' -> P.do
+  ctx <- pletFields @["txInfo", "purpose"] ctx'
+  pmatch (pfromData r) $ \case
+    -- Validation for receiving funds.
+    PReceiveFunds _ -> pconstant ()
+    -- Validation for witnessing transaction.
+    PWitnessTreasury _ -> pconstant ()
+
+{- | Plutarch level type representing datum of the treasury.
+     Contains:
+
+       - @reserves@ representing the current value kept in the
+         treasury.
+       - @stateThread@ representing the asset class of the
+         treasury's state thread token.
+-}
+newtype PTreasuryDatum (s :: S)
+  = PTreasuryDatum
+      ( Term
+          s
+          ( PDataRecord
+              '[ "reserves" ':= PValue
+               , "stateThread" ':= PCurrencySymbol
+               ]
+          )
+      )
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PIsDataRepr)
+  deriving
+    (PlutusType, PIsData, PDataFields)
+    via PIsDataReprInstances PTreasuryDatum
+
+{- | Plutarch level type representing valid redeemers of the
+     treasury.
+-}
+data PTreasuryRedeemer (s :: S)
+  = -- | Receive funds and place them in the treasury.
+    PReceiveFunds (Term s (PDataRecord '["_0" ':= PValue]))
+  | -- | Serve as a witness for any transaction. Must remain unaltered.
+    PWitnessTreasury (Term s (PDataRecord '[]))
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PIsDataRepr)
+  deriving
+    (PlutusType, PIsData)
+    via PIsDataReprInstances PTreasuryRedeemer

From 4bc3c958d0ed7d82ccdb4484bce5971df7f38fda Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Tue, 1 Mar 2022 14:13:47 +0000
Subject: [PATCH 03/18] hlint fix

---
 .github/workflows/integrate.yaml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/integrate.yaml b/.github/workflows/integrate.yaml
index 10b425d..662e290 100644
--- a/.github/workflows/integrate.yaml
+++ b/.github/workflows/integrate.yaml
@@ -56,7 +56,7 @@ jobs:
           name: mlabs
           authToken: ${{ secrets.CACHIX_KEY }}
 
-      - run: nix run nixpkgs#hlint -- $(git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.hs')
+      - run: nix run nixpkgs#haskell.packages.ghc921.hlint -- $(git ls-tree -r HEAD --full-tree --name-only | grep -E '.*\.hs')
         name: Run hlint
 
   check-build:

From 1a03b0bb75c08ca5229b9f7b4d19e65f8e0d4d44 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Wed, 2 Mar 2022 11:57:34 +0000
Subject: [PATCH 04/18] added helper functions to treasury

---
 src/Agora/Treasury.hs | 76 ++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 71 insertions(+), 5 deletions(-)

diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 02ca842..9f69c9c 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -12,8 +12,19 @@ module Agora.Treasury where
 
 import GHC.Generics qualified as GHC
 import Generics.SOP
-import Plutarch.Api.V1.Contexts (PScriptContext)
+import Plutarch.Api.V1.Contexts (
+  PScriptContext,
+  PTuple,
+  PTxInfo (PTxInfo),
+ )
+import Plutarch.Api.V1.Maybe (PMaybeData (PDJust))
+import Plutarch.Api.V1.Scripts (PDatum, PDatumHash)
+import Plutarch.Api.V1.Tx (
+  PTxInInfo (PTxInInfo),
+  PTxOut (PTxOut),
+ )
 import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
+import Plutarch.Builtin (pforgetData)
 import Plutarch.DataRepr (
   PDataFields,
   PIsDataReprInstances (PIsDataReprInstances),
@@ -31,13 +42,68 @@ treasuryV ::
         :--> PAsData PScriptContext
         :--> PUnit
     )
-treasuryV = plam $ \_d r ctx' -> P.do
+treasuryV = plam $ \d r ctx' -> P.do
   ctx <- pletFields @["txInfo", "purpose"] ctx'
+  PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo
   pmatch (pfromData r) $ \case
+    PWitnessTreasury _ -> P.do
+      txInfo <- pletFields @'["inputs", "outputs", "data"] txInfo'
+
+      -- inputs :: Term s ( PAsData PBuiltinList )
+      let inputs = txInfo.inputs
+
+      -- dat :: Term s (PAsData PBuiltinList)
+      let dat = pfield @"data" # txInfo'
+
+      -- dh :: Term s PDatumHash
+      let dH = getTrDatumHash # d # dat
+
+      pconstant ()
+
     -- Validation for receiving funds.
-    PReceiveFunds _ -> pconstant ()
-    -- Validation for witnessing transaction.
-    PWitnessTreasury _ -> pconstant ()
+    PReceiveFunds _ -> P.do
+      pconstant ()
+
+{- | Plutarch level function that, given a treasury datum and a
+    list of the transaction's data, will find its hash.
+-}
+getTrDatumHash ::
+  Term
+    s
+    ( PAsData PTreasuryDatum
+        :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum))
+        :--> PDatumHash
+    )
+getTrDatumHash = plam $ \d l -> P.do
+  let t = phead #$ pfilter # (matchDatums # d) # l
+  pfield @"_0" # t
+  where
+    matchDatums ::
+      Term
+        s
+        ( PAsData PTreasuryDatum
+            :--> PAsData (PTuple PDatumHash PDatum)
+            :--> PBool
+        )
+    matchDatums = plam $ \d t' ->
+      let t = pfield @"_1" # t'
+       in (pforgetData d) #== (pforgetData t)
+
+getValAtDHash ::
+  Term
+    s
+    ( PDatumHash
+        :--> PBuiltinList (PAsData PTxOut)
+        :--> PValue
+    )
+getValAtDHash = plam $ \dh outs -> P.do
+  let matchingOut = phead #$ pfilter # (matchHashes # dh) # outs
+  pfield @"value" # matchingOut
+  where
+    matchHashes :: Term s (PDatumHash :--> PAsData PTxOut :--> PBool)
+    matchHashes = plam $ \dh out' -> P.do
+      PDJust dh' <- pmatch $ pfield @"datumHash" # pfromData out'
+      dh #== pfield @"_0" # dh'
 
 {- | Plutarch level type representing datum of the treasury.
      Contains:

From fce9f007d43d85efac37649db9fc52b2a7d94215 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Wed, 2 Mar 2022 12:50:00 +0000
Subject: [PATCH 05/18] expanded treasury

---
 src/Agora/Treasury.hs | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 9f69c9c..0984cf0 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -49,16 +49,22 @@ treasuryV = plam $ \d r ctx' -> P.do
     PWitnessTreasury _ -> P.do
       txInfo <- pletFields @'["inputs", "outputs", "data"] txInfo'
 
-      -- inputs :: Term s ( PAsData PBuiltinList )
       let inputs = txInfo.inputs
 
-      -- dat :: Term s (PAsData PBuiltinList)
       let dat = pfield @"data" # txInfo'
 
-      -- dh :: Term s PDatumHash
       let dH = getTrDatumHash # d # dat
 
-      pconstant ()
+      let rs = pmap # toResolved # inputs
+      let outputs = txInfo.outputs
+
+      let valueIn = getValAtDHash # dH # rs
+      let valueOut = getValAtDHash # dH # outputs
+
+      pif
+        (valueIn #== valueOut)
+        (pconstant ())
+        $ ptraceError "Treasury is altered when witnessing transaction"
 
     -- Validation for receiving funds.
     PReceiveFunds _ -> P.do
@@ -89,12 +95,15 @@ getTrDatumHash = plam $ \d l -> P.do
       let t = pfield @"_1" # t'
        in (pforgetData d) #== (pforgetData t)
 
+toResolved :: Term s (PAsData PTxInInfo :--> PAsData PTxOut)
+toResolved = plam $ \txIn -> pfield @"resolved" # txIn
+
 getValAtDHash ::
   Term
     s
     ( PDatumHash
         :--> PBuiltinList (PAsData PTxOut)
-        :--> PValue
+        :--> PAsData PValue
     )
 getValAtDHash = plam $ \dh outs -> P.do
   let matchingOut = phead #$ pfilter # (matchHashes # dh) # outs

From f46cafca39ede6592922244e8bf159bc38ca6821 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Wed, 2 Mar 2022 13:01:45 +0000
Subject: [PATCH 06/18] Documented solution for treasury witnessing

---
 src/Agora/Treasury.hs | 32 ++++++++++++++++++++++++--------
 1 file changed, 24 insertions(+), 8 deletions(-)

diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 0984cf0..bff49c5 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -43,30 +43,44 @@ treasuryV ::
         :--> PUnit
     )
 treasuryV = plam $ \d r ctx' -> P.do
+  -- Load txInfo and purpose fields from script context.
   ctx <- pletFields @["txInfo", "purpose"] ctx'
+
+  -- Extract txInfo.
   PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo
+
+  -- Pattern match on type of treasury redeemer.
   pmatch (pfromData r) $ \case
+    -- Treasury is merely being witnessed. It's datum and value
+    -- must be unchanged.
     PWitnessTreasury _ -> P.do
       txInfo <- pletFields @'["inputs", "outputs", "data"] txInfo'
 
-      let inputs = txInfo.inputs
-
+      -- Get datum hash of datum supplied to validator.
       let dat = pfield @"data" # txInfo'
+          dH = getTrDatumHash # d # dat
 
-      let dH = getTrDatumHash # d # dat
-
-      let rs = pmap # toResolved # inputs
-      let outputs = txInfo.outputs
+      -- Get inputs in TxOut form.
+      let inputs = txInfo.inputs
+          rs = pmap # toResolved # inputs
 
+      -- Find the value the treasury had before being spent.
       let valueIn = getValAtDHash # dH # rs
-      let valueOut = getValAtDHash # dH # outputs
 
+      -- Find the value the treasury has after being spent.
+      let outputs = txInfo.outputs
+          valueOut = getValAtDHash # dH # outputs
+
+      -- If the value in equals the value out, validate the
+      -- transaction. Otherwise, fail.
       pif
         (valueIn #== valueOut)
         (pconstant ())
         $ ptraceError "Treasury is altered when witnessing transaction"
 
-    -- Validation for receiving funds.
+    -- Treasury is receiving amount of funds specified in the
+    -- redeemer. It's datum must be unchanged but it's value
+    -- must be increased by the specified amount.
     PReceiveFunds _ -> P.do
       pconstant ()
 
@@ -95,9 +109,11 @@ getTrDatumHash = plam $ \d l -> P.do
       let t = pfield @"_1" # t'
        in (pforgetData d) #== (pforgetData t)
 
+-- | Get the "resolved" field of a TxInInfo.
 toResolved :: Term s (PAsData PTxInInfo :--> PAsData PTxOut)
 toResolved = plam $ \txIn -> pfield @"resolved" # txIn
 
+-- | Gets the value kept at a given datum hash.
 getValAtDHash ::
   Term
     s

From d143ec87b54338fbf7567b6348e096395e942bb1 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Wed, 2 Mar 2022 16:46:09 +0000
Subject: [PATCH 07/18] Began applying Emily's suggestions

---
 Makefile              |  2 +-
 agora.cabal           |  1 -
 src/Agora/Treasury.hs | 15 +++++----------
 3 files changed, 6 insertions(+), 12 deletions(-)

diff --git a/Makefile b/Makefile
index 38026f3..feb2a3d 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
 SHELL := /usr/bin/env bash
 
-.PHONY: hoogle format usage
+.PHONY: hoogle format haddock usage
 
 usage:
 	@echo "usage: make <command> [OPTIONS]"
diff --git a/agora.cabal b/agora.cabal
index 53d3ed8..103c47a 100644
--- a/agora.cabal
+++ b/agora.cabal
@@ -76,7 +76,6 @@ common lang
     TypeOperators
     TypeSynonymInstances
     UndecidableInstances
-    UndecidableInstances
     ViewPatterns
     OverloadedRecordDot
     QualifiedDo
diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index bff49c5..729d0b4 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wwarn #-}
-
 {- |
 Module: Agora.Treasury
 Maintainer: jack@mlabs.city
@@ -8,7 +6,7 @@ Description: Treasury scripts.
 Contains the datum, redeemer and validator for a template DAO
 treasury.
 -}
-module Agora.Treasury where
+module Agora.Treasury (treasuryV) where
 
 import GHC.Generics qualified as GHC
 import Generics.SOP
@@ -20,8 +18,8 @@ import Plutarch.Api.V1.Contexts (
 import Plutarch.Api.V1.Maybe (PMaybeData (PDJust))
 import Plutarch.Api.V1.Scripts (PDatum, PDatumHash)
 import Plutarch.Api.V1.Tx (
-  PTxInInfo (PTxInInfo),
-  PTxOut (PTxOut),
+  PTxInInfo,
+  PTxOut,
  )
 import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
 import Plutarch.Builtin (pforgetData)
@@ -107,7 +105,7 @@ getTrDatumHash = plam $ \d l -> P.do
         )
     matchDatums = plam $ \d t' ->
       let t = pfield @"_1" # t'
-       in (pforgetData d) #== (pforgetData t)
+       in pforgetData d #== pforgetData t
 
 -- | Get the "resolved" field of a TxInInfo.
 toResolved :: Term s (PAsData PTxInInfo :--> PAsData PTxOut)
@@ -133,8 +131,6 @@ getValAtDHash = plam $ \dh outs -> P.do
 {- | Plutarch level type representing datum of the treasury.
      Contains:
 
-       - @reserves@ representing the current value kept in the
-         treasury.
        - @stateThread@ representing the asset class of the
          treasury's state thread token.
 -}
@@ -143,8 +139,7 @@ newtype PTreasuryDatum (s :: S)
       ( Term
           s
           ( PDataRecord
-              '[ "reserves" ':= PValue
-               , "stateThread" ':= PCurrencySymbol
+              '[ "stateThread" ':= PCurrencySymbol
                ]
           )
       )

From 0a0c9ee2c68a502b5da9961f93b964aa2b2874da Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Thu, 3 Mar 2022 11:59:23 +0000
Subject: [PATCH 08/18] began reworking treasury

---
 src/Agora/Treasury.hs | 106 +++++++++---------------------------------
 src/Agora/Utils.hs    |  58 +++++++++++++++++++++++
 2 files changed, 80 insertions(+), 84 deletions(-)

diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 729d0b4..2948008 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
 {- |
 Module: Agora.Treasury
 Maintainer: jack@mlabs.city
@@ -28,6 +30,7 @@ import Plutarch.DataRepr (
   PIsDataReprInstances (PIsDataReprInstances),
  )
 import Plutarch.Monadic qualified as P
+import Agora.Utils (pisValueSubset)
 
 {- | Validator ensuring that transactions consuming the treasury
      do so in a valid manner.
@@ -41,92 +44,27 @@ treasuryV ::
         :--> PUnit
     )
 treasuryV = plam $ \d r ctx' -> P.do
-  -- Load txInfo and purpose fields from script context.
-  ctx <- pletFields @["txInfo", "purpose"] ctx'
-
-  -- Extract txInfo.
-  PTxInfo txInfo' <- pmatch $ pfromData ctx.txInfo
-
-  -- Pattern match on type of treasury redeemer.
   pmatch (pfromData r) $ \case
-    -- Treasury is merely being witnessed. It's datum and value
-    -- must be unchanged.
-    PWitnessTreasury _ -> P.do
-      txInfo <- pletFields @'["inputs", "outputs", "data"] txInfo'
+    -- Redeemer seeking to alter treasury parameters. Must ensure
+    -- a valid GAT is burned in the transaction.
+    PAlterTrParams _ ->
+      ptraceError "Altering treasury parameters is not currently supported."
+    -- Redeemer for all other treasury actions. Must ensure datum
+    -- is unchanged and no value has been removed from the
+    -- treasury.
+    PRedeemTreasury _ -> P.do
+      -- Amount of value treasury has before transaction.
+      let valueTrIn = undefined
 
-      -- Get datum hash of datum supplied to validator.
-      let dat = pfield @"data" # txInfo'
-          dH = getTrDatumHash # d # dat
+      -- Amount of value treasury has after transaction.
+      let valueTrOut = undefined
 
-      -- Get inputs in TxOut form.
-      let inputs = txInfo.inputs
-          rs = pmap # toResolved # inputs
+      let vOutExceedsVIn = pisValueSubset # valueTrIn # valueTrOut
 
-      -- Find the value the treasury had before being spent.
-      let valueIn = getValAtDHash # dH # rs
-
-      -- Find the value the treasury has after being spent.
-      let outputs = txInfo.outputs
-          valueOut = getValAtDHash # dH # outputs
-
-      -- If the value in equals the value out, validate the
-      -- transaction. Otherwise, fail.
       pif
-        (valueIn #== valueOut)
+        (vOutExceedsVIn)
         (pconstant ())
-        $ ptraceError "Treasury is altered when witnessing transaction"
-
-    -- Treasury is receiving amount of funds specified in the
-    -- redeemer. It's datum must be unchanged but it's value
-    -- must be increased by the specified amount.
-    PReceiveFunds _ -> P.do
-      pconstant ()
-
-{- | Plutarch level function that, given a treasury datum and a
-    list of the transaction's data, will find its hash.
--}
-getTrDatumHash ::
-  Term
-    s
-    ( PAsData PTreasuryDatum
-        :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum))
-        :--> PDatumHash
-    )
-getTrDatumHash = plam $ \d l -> P.do
-  let t = phead #$ pfilter # (matchDatums # d) # l
-  pfield @"_0" # t
-  where
-    matchDatums ::
-      Term
-        s
-        ( PAsData PTreasuryDatum
-            :--> PAsData (PTuple PDatumHash PDatum)
-            :--> PBool
-        )
-    matchDatums = plam $ \d t' ->
-      let t = pfield @"_1" # t'
-       in pforgetData d #== pforgetData t
-
--- | Get the "resolved" field of a TxInInfo.
-toResolved :: Term s (PAsData PTxInInfo :--> PAsData PTxOut)
-toResolved = plam $ \txIn -> pfield @"resolved" # txIn
-
--- | Gets the value kept at a given datum hash.
-getValAtDHash ::
-  Term
-    s
-    ( PDatumHash
-        :--> PBuiltinList (PAsData PTxOut)
-        :--> PAsData PValue
-    )
-getValAtDHash = plam $ \dh outs -> P.do
-  let matchingOut = phead #$ pfilter # (matchHashes # dh) # outs
-  pfield @"value" # matchingOut
-  where
-    matchHashes :: Term s (PDatumHash :--> PAsData PTxOut :--> PBool)
-    matchHashes = plam $ \dh out' -> P.do
-      PDJust dh' <- pmatch $ pfield @"datumHash" # pfromData out'
-      dh #== pfield @"_0" # dh'
+        (ptraceError "Value has been illegally deducted from treasury.")
 
 {- | Plutarch level type representing datum of the treasury.
      Contains:
@@ -153,10 +91,10 @@ newtype PTreasuryDatum (s :: S)
      treasury.
 -}
 data PTreasuryRedeemer (s :: S)
-  = -- | Receive funds and place them in the treasury.
-    PReceiveFunds (Term s (PDataRecord '["_0" ':= PValue]))
-  | -- | Serve as a witness for any transaction. Must remain unaltered.
-    PWitnessTreasury (Term s (PDataRecord '[]))
+  = -- | TODO: will allow the burning of GATs to alter Treasury params.
+    PAlterTrParams (Term s (PDataRecord '[]))
+  | -- | All other treasury actions. Value must not decrease.
+    PRedeemTreasury (Term s (PDataRecord '[]))
   deriving stock (GHC.Generic)
   deriving anyclass (Generic, PIsDataRepr)
   deriving
diff --git a/src/Agora/Utils.hs b/src/Agora/Utils.hs
index 124c57b..e3de254 100644
--- a/src/Agora/Utils.hs
+++ b/src/Agora/Utils.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
 {- |
 Module     : Agora.Utils
 Maintainer : emi@haskell.fyi
@@ -22,6 +24,7 @@ module Agora.Utils (
   pfindTxInByTxOutRef,
   psingletonValue,
   pfindMap,
+  pisValueSubset,
 
   -- * Functions which should (probably) not be upstreamed
   anyOutput,
@@ -50,6 +53,8 @@ import Plutarch.Api.V1 (
   PTxOutRef,
   PValue (PValue),
  )
+import Plutarch.Api.V1.Tuple (ptupleFromBuiltin)
+import Plutarch.Bool (pand)
 import Plutarch.Builtin (ppairDataBuiltin)
 import Plutarch.Internal (punsafeCoerce)
 import Plutarch.Monadic qualified as P
@@ -255,6 +260,59 @@ pfindTxInByTxOutRef = phoistAcyclic $
           )
         #$ (pfield @"inputs" # txInfo)
 
+-- | Determines if a value is a subset of another.
+pisValueSubset :: Term s (PValue :--> PValue :--> PBool)
+pisValueSubset = plam $ \v0 _v1 -> P.do
+  -- v0Map :: Term s (PMap PCurrencySymbol (PMap PTokenName PInteger))
+  PValue v0Map <- pmatch v0
+
+  -- v0BuiltinMap :: Term s (PBuiltinMap k v)
+  PMap v0BuiltinMap <- pmatch v0Map
+
+  -- ks0 :: Term s (PBuiltinList PCurrencySymbol)
+  let ks0 = pmap # pfstBuiltin # v0BuiltinMap
+  pconstant True
+
+-- | Determines if a PTokenName/PInteger pmap is a subset of another.
+pisTnISubset ::
+  Term
+    s
+    ( PMap PTokenName PInteger
+        :--> PMap PTokenName PInteger
+        :--> PBool
+    )
+pisTnISubset = plam $ \m0 m1 -> P.do
+  -- m0BuiltinMap :: Term s (PBuiltinMap PTokenName PInteger)
+  PMap m0BuiltinMap <- pmatch m0
+
+  -- ks0 :: Term s (PBuiltinList PTokenName)
+  let ks0 = pmap # pfstBuiltin # m0BuiltinMap
+  pconstant True
+
+pcompareKeysForEq ::
+  Term
+    s
+    ( PBuiltinList k
+        :--> PMap k v
+        :--> PMap k v
+        :--> PBool
+    )
+pcompareKeysForEq = plam $ \ks m0' m1' -> P.do
+  PMap m0 <- m0'
+  PMap m1 <- m1'
+  bs <- pmatch $ pmap # f # ks
+  pcon PTrue
+
+f :: Term s (k :--> PMap k v :--> PMap k v)
+f = plam $ \k m0' m1' -> P.do
+  PMap m0 <- m0'
+  PMap m1 <- m1'
+  pmatch (plookup # k # m1) $ \case
+    PNothing -> pconstant False
+    PJust n1 -> P.do
+      PJust n0 <- pmatch $ plookup # k # m0
+      n0 #<= n1
+
 --------------------------------------------------------------------------------
 -- Functions which should (probably) not be upstreamed
 

From 346c08afc98c00c96ed5a818abe27ce0e38b9692 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Thu, 3 Mar 2022 17:00:14 +0000
Subject: [PATCH 09/18] Added Utils.Value

---
 agora.cabal               |   6 ++-
 src/Agora/Treasury.hs     |   3 +-
 src/Agora/Utils.hs        |  93 ++++++++++++++++-----------------
 src/Agora/Utils/Value.hs  | 107 ++++++++++++++++++++++++++++++++++++++
 src/Plutarch/Extra/Map.hs |   2 +
 5 files changed, 161 insertions(+), 50 deletions(-)
 create mode 100644 src/Agora/Utils/Value.hs
 create mode 100644 src/Plutarch/Extra/Map.hs

diff --git a/agora.cabal b/agora.cabal
index 103c47a..a7b4703 100644
--- a/agora.cabal
+++ b/agora.cabal
@@ -122,7 +122,11 @@ library
     Agora.Treasury
     Agora.Voting
 
-  other-modules:   Agora.Utils
+  other-modules:   
+    Agora.Utils
+    Agora.Utils.Value
+    Plutarch.Extra.Map
+
   hs-source-dirs:  src
 
 library pprelude
diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 2948008..61ae19d 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -30,7 +30,6 @@ import Plutarch.DataRepr (
   PIsDataReprInstances (PIsDataReprInstances),
  )
 import Plutarch.Monadic qualified as P
-import Agora.Utils (pisValueSubset)
 
 {- | Validator ensuring that transactions consuming the treasury
      do so in a valid manner.
@@ -59,7 +58,7 @@ treasuryV = plam $ \d r ctx' -> P.do
       -- Amount of value treasury has after transaction.
       let valueTrOut = undefined
 
-      let vOutExceedsVIn = pisValueSubset # valueTrIn # valueTrOut
+      let vOutExceedsVIn = undefined
 
       pif
         (vOutExceedsVIn)
diff --git a/src/Agora/Utils.hs b/src/Agora/Utils.hs
index e3de254..d70e9f1 100644
--- a/src/Agora/Utils.hs
+++ b/src/Agora/Utils.hs
@@ -24,7 +24,6 @@ module Agora.Utils (
   pfindTxInByTxOutRef,
   psingletonValue,
   pfindMap,
-  pisValueSubset,
 
   -- * Functions which should (probably) not be upstreamed
   anyOutput,
@@ -260,58 +259,58 @@ pfindTxInByTxOutRef = phoistAcyclic $
           )
         #$ (pfield @"inputs" # txInfo)
 
--- | Determines if a value is a subset of another.
-pisValueSubset :: Term s (PValue :--> PValue :--> PBool)
-pisValueSubset = plam $ \v0 _v1 -> P.do
-  -- v0Map :: Term s (PMap PCurrencySymbol (PMap PTokenName PInteger))
-  PValue v0Map <- pmatch v0
+-- -- | Determines if a value is a subset of another.
+-- pisValueSubset :: Term s (PValue :--> PValue :--> PBool)
+-- pisValueSubset = plam $ \v0 _v1 -> P.do
+--   -- v0Map :: Term s (PMap PCurrencySymbol (PMap PTokenName PInteger))
+--   PValue v0Map <- pmatch v0
 
-  -- v0BuiltinMap :: Term s (PBuiltinMap k v)
-  PMap v0BuiltinMap <- pmatch v0Map
+--   -- v0BuiltinMap :: Term s (PBuiltinMap k v)
+--   PMap v0BuiltinMap <- pmatch v0Map
 
-  -- ks0 :: Term s (PBuiltinList PCurrencySymbol)
-  let ks0 = pmap # pfstBuiltin # v0BuiltinMap
-  pconstant True
+--   -- ks0 :: Term s (PBuiltinList PCurrencySymbol)
+--   let ks0 = pmap # pfstBuiltin # v0BuiltinMap
+--   pconstant True
 
--- | Determines if a PTokenName/PInteger pmap is a subset of another.
-pisTnISubset ::
-  Term
-    s
-    ( PMap PTokenName PInteger
-        :--> PMap PTokenName PInteger
-        :--> PBool
-    )
-pisTnISubset = plam $ \m0 m1 -> P.do
-  -- m0BuiltinMap :: Term s (PBuiltinMap PTokenName PInteger)
-  PMap m0BuiltinMap <- pmatch m0
+-- -- | Determines if a PTokenName/PInteger pmap is a subset of another.
+-- pisTnISubset ::
+--   Term
+--     s
+--     ( PMap PTokenName PInteger
+--         :--> PMap PTokenName PInteger
+--         :--> PBool
+--     )
+-- pisTnISubset = plam $ \m0 m1 -> P.do
+--   -- m0BuiltinMap :: Term s (PBuiltinMap PTokenName PInteger)
+--   PMap m0BuiltinMap <- pmatch m0
 
-  -- ks0 :: Term s (PBuiltinList PTokenName)
-  let ks0 = pmap # pfstBuiltin # m0BuiltinMap
-  pconstant True
+--   -- ks0 :: Term s (PBuiltinList PTokenName)
+--   let ks0 = pmap # pfstBuiltin # m0BuiltinMap
+--   pconstant True
 
-pcompareKeysForEq ::
-  Term
-    s
-    ( PBuiltinList k
-        :--> PMap k v
-        :--> PMap k v
-        :--> PBool
-    )
-pcompareKeysForEq = plam $ \ks m0' m1' -> P.do
-  PMap m0 <- m0'
-  PMap m1 <- m1'
-  bs <- pmatch $ pmap # f # ks
-  pcon PTrue
+-- pcompareKeys ::
+--   Term
+--     s
+--     ( PBuiltinList k
+--         :--> PMap k v
+--         :--> PMap k v
+--         :--> PBool
+--     )
+-- pcompareKeys = plam $ \ks m0' m1' -> P.do
+--   PMap m0 <- m0'
+--   PMap m1 <- m1'
+--   bs <- pmatch $ pmap # f # ks
+--   pconstant True
 
-f :: Term s (k :--> PMap k v :--> PMap k v)
-f = plam $ \k m0' m1' -> P.do
-  PMap m0 <- m0'
-  PMap m1 <- m1'
-  pmatch (plookup # k # m1) $ \case
-    PNothing -> pconstant False
-    PJust n1 -> P.do
-      PJust n0 <- pmatch $ plookup # k # m0
-      n0 #<= n1
+-- f :: Term s (k :--> PMap k v :--> PMap k v :--> PBool)
+-- f = plam $ \k m0' m1' -> P.do
+--   PMap m0 <- m0'
+--   PMap m1 <- m1'
+--   pmatch (plookup # k # m1) $ \case
+--     PNothing -> pconstant False
+--     PJust n1 -> P.do
+--       PJust n0 <- pmatch $ plookup # k # m0
+--       n0 #<= n1
 
 --------------------------------------------------------------------------------
 -- Functions which should (probably) not be upstreamed
diff --git a/src/Agora/Utils/Value.hs b/src/Agora/Utils/Value.hs
new file mode 100644
index 0000000..b27d569
--- /dev/null
+++ b/src/Agora/Utils/Value.hs
@@ -0,0 +1,107 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
+module Agora.Utils.Value where
+
+import GHC.Generics qualified as GHC
+import Generics.SOP
+import Plutarch.Api.V1.AssocMap (PMap (PMap))
+import Plutarch.Api.V1.Tuple (PTuple, ptupleFromBuiltin)
+import Plutarch.Api.V1.Value (PCurrencySymbol, PTokenName, PValue)
+import Plutarch.DataRepr (PIsDataReprInstances (PIsDataReprInstances))
+import Plutarch.Lift (PLifted, PUnsafeLiftDecl)
+import Plutarch.Monadic qualified as P
+import Plutus.V1.Ledger.Api qualified as Plutus
+import PlutusTx.These qualified as PlutusThese
+
+-- data PThese (a :: PType) (b :: PType) (s :: S)
+--   = PThis (Term s a)
+--   | PThat (Term s b)
+--   | PThese (Term s a) (Term s b)
+--   deriving stock (GHC.Generic)
+--   deriving anyclass (Generic, PlutusType)
+
+data PTheseData (a :: PType) (b :: PType) (s :: S)
+  = PDThis (Term s (PDataRecord '["_0" ':= a]))
+  | PDThat (Term s (PDataRecord '["_0" ':= b]))
+  | PDThese (Term s (PDataRecord '["_0" ':= a, "_1" ':= b]))
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PIsDataRepr)
+  deriving
+    (PlutusType, PIsData)
+    via PIsDataReprInstances (PTheseData a b)
+
+instance
+  ( Plutus.ToData (PLifted a)
+  , Plutus.ToData (PLifted b)
+  , Plutus.FromData (PLifted a)
+  , Plutus.FromData (PLifted b)
+  , PLift a
+  , PLift b
+  ) =>
+  PUnsafeLiftDecl (PTheseData a b)
+  where
+  type PLifted (PTheseData a b) = PlutusThese.These (PLifted a) (PLifted b)
+
+punionVal ::
+  Term
+    s
+    ( PValue
+        :--> PValue
+        :--> PMap
+              PCurrencySymbol
+              (PMap PTokenName (PTheseData PInteger PInteger))
+    )
+punionVal = undefined
+
+-- | Determines if a condition is true for all values in a map.
+pmapAll ::
+  (PUnsafeLiftDecl v, PIsData v) =>
+  Term s ((v :--> PBool) :--> PMap k v :--> PBool)
+pmapAll = plam $ \f m -> P.do
+  PMap builtinMap <- pmatch $ m
+
+  let getV :: PIsData v => Term s (PBuiltinPair (PAsData k) (PAsData v) :--> v)
+      getV = plam $ \bip -> P.do
+        let tuple = pfromData $ ptupleFromBuiltin (pdata bip)
+        pfield @"_1" # tuple
+
+  let vs = pmap # getV # builtinMap
+  pall # f # vs
+
+pcheckPred ::
+  forall {s :: S}.
+  Term
+    s
+    ( (PTheseData PInteger PInteger :--> PBool)
+        :--> PValue
+        :--> PValue
+        :--> PBool
+    )
+pcheckPred = plam $ \f l r -> P.do
+  let inner :: Term s (PMap PTokenName (PTheseData PInteger PInteger) :--> PBool)
+      inner = pmapAll # f
+  pmapAll # inner # (punionVal # l # r)
+
+pcheckBinRel ::
+  forall {s :: S}.
+  Term
+    s
+    ( (PInteger :--> PInteger :--> PBool)
+        :--> PValue
+        :--> PValue
+        :--> PBool
+    )
+pcheckBinRel = plam $ \f l r -> P.do
+  let unThese :: Term s (PTheseData PInteger PInteger :--> PBool)
+      unThese = plam $ \k' ->
+        pmatch k' $ \case
+          PDThis r -> f # (pfield @"_0" # r) # 0
+          PDThat r -> f # 0 # (pfield @"_0" # r)
+          PDThese r -> f # (pfield @"_0" # r) # (pfield @"_1" # r)
+  pcheckPred # unThese # l # r
+
+pleq :: Term s (PValue :--> PValue :--> PBool)
+pleq = plam $ \v0 v1 -> (pcheckBinRel # pleq') # v0 # v1
+
+pleq' :: Term s (PInteger :--> PInteger :--> PBool)
+pleq' = plam $ \m n -> m #<= n
diff --git a/src/Plutarch/Extra/Map.hs b/src/Plutarch/Extra/Map.hs
new file mode 100644
index 0000000..ba05359
--- /dev/null
+++ b/src/Plutarch/Extra/Map.hs
@@ -0,0 +1,2 @@
+module Plutarch.Extra.Map () where
+

From 86182ced25bd7424cfba99a4745a8f547c10350c Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Fri, 4 Mar 2022 06:26:53 +0000
Subject: [PATCH 10/18] Removed redundant Plutarch Extra files

---
 agora.cabal               | 3 +--
 src/Plutarch/Extra/Map.hs | 2 --
 2 files changed, 1 insertion(+), 4 deletions(-)
 delete mode 100644 src/Plutarch/Extra/Map.hs

diff --git a/agora.cabal b/agora.cabal
index a7b4703..00e342c 100644
--- a/agora.cabal
+++ b/agora.cabal
@@ -122,10 +122,9 @@ library
     Agora.Treasury
     Agora.Voting
 
-  other-modules:   
+  other-modules:
     Agora.Utils
     Agora.Utils.Value
-    Plutarch.Extra.Map
 
   hs-source-dirs:  src
 
diff --git a/src/Plutarch/Extra/Map.hs b/src/Plutarch/Extra/Map.hs
deleted file mode 100644
index ba05359..0000000
--- a/src/Plutarch/Extra/Map.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-module Plutarch.Extra.Map () where
-

From 43cd0c450760f08038e7ae37a5b9f472edcefbf7 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Fri, 4 Mar 2022 09:27:41 +0000
Subject: [PATCH 11/18] Added These data types

---
 agora.cabal                  |  2 +
 src/Agora/Treasury.hs        | 44 ++++-----------------
 src/Agora/Utils.hs           | 57 ---------------------------
 src/Agora/Utils/Value.hs     | 76 +++++++++++++++---------------------
 src/Plutarch/Api/V1/These.hs | 62 +++++++++++++++++++++++++++++
 src/Plutarch/These.hs        | 12 ++++++
 6 files changed, 114 insertions(+), 139 deletions(-)
 create mode 100644 src/Plutarch/Api/V1/These.hs
 create mode 100644 src/Plutarch/These.hs

diff --git a/agora.cabal b/agora.cabal
index 00e342c..3d8cdf0 100644
--- a/agora.cabal
+++ b/agora.cabal
@@ -125,6 +125,8 @@ library
   other-modules:
     Agora.Utils
     Agora.Utils.Value
+    Plutarch.Api.V1.These
+    Plutarch.These
 
   hs-source-dirs:  src
 
diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 61ae19d..d487f5a 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wwarn #-}
-
 {- |
 Module: Agora.Treasury
 Maintainer: jack@mlabs.city
@@ -8,28 +6,16 @@ Description: Treasury scripts.
 Contains the datum, redeemer and validator for a template DAO
 treasury.
 -}
-module Agora.Treasury (treasuryV) where
+module Agora.Treasury (module Agora.Treasury) where
 
 import GHC.Generics qualified as GHC
 import Generics.SOP
-import Plutarch.Api.V1.Contexts (
-  PScriptContext,
-  PTuple,
-  PTxInfo (PTxInfo),
- )
-import Plutarch.Api.V1.Maybe (PMaybeData (PDJust))
-import Plutarch.Api.V1.Scripts (PDatum, PDatumHash)
-import Plutarch.Api.V1.Tx (
-  PTxInInfo,
-  PTxOut,
- )
-import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
-import Plutarch.Builtin (pforgetData)
+import Plutarch.Api.V1.Contexts (PScriptContext)
+import Plutarch.Api.V1.Value (PCurrencySymbol)
 import Plutarch.DataRepr (
   PDataFields,
   PIsDataReprInstances (PIsDataReprInstances),
  )
-import Plutarch.Monadic qualified as P
 
 {- | Validator ensuring that transactions consuming the treasury
      do so in a valid manner.
@@ -42,28 +28,13 @@ treasuryV ::
         :--> PAsData PScriptContext
         :--> PUnit
     )
-treasuryV = plam $ \d r ctx' -> P.do
+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."
-    -- Redeemer for all other treasury actions. Must ensure datum
-    -- is unchanged and no value has been removed from the
-    -- treasury.
-    PRedeemTreasury _ -> P.do
-      -- Amount of value treasury has before transaction.
-      let valueTrIn = undefined
-
-      -- Amount of value treasury has after transaction.
-      let valueTrOut = undefined
-
-      let vOutExceedsVIn = undefined
-
-      pif
-        (vOutExceedsVIn)
-        (pconstant ())
-        (ptraceError "Value has been illegally deducted from treasury.")
 
 {- | Plutarch level type representing datum of the treasury.
      Contains:
@@ -90,10 +61,9 @@ newtype PTreasuryDatum (s :: S)
      treasury.
 -}
 data PTreasuryRedeemer (s :: S)
-  = -- | TODO: will allow the burning of GATs to alter Treasury params.
+  = -- | Alters treasury parameters (subject to the burning of a
+    --   governance authority token).
     PAlterTrParams (Term s (PDataRecord '[]))
-  | -- | All other treasury actions. Value must not decrease.
-    PRedeemTreasury (Term s (PDataRecord '[]))
   deriving stock (GHC.Generic)
   deriving anyclass (Generic, PIsDataRepr)
   deriving
diff --git a/src/Agora/Utils.hs b/src/Agora/Utils.hs
index d70e9f1..124c57b 100644
--- a/src/Agora/Utils.hs
+++ b/src/Agora/Utils.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wwarn #-}
-
 {- |
 Module     : Agora.Utils
 Maintainer : emi@haskell.fyi
@@ -52,8 +50,6 @@ import Plutarch.Api.V1 (
   PTxOutRef,
   PValue (PValue),
  )
-import Plutarch.Api.V1.Tuple (ptupleFromBuiltin)
-import Plutarch.Bool (pand)
 import Plutarch.Builtin (ppairDataBuiltin)
 import Plutarch.Internal (punsafeCoerce)
 import Plutarch.Monadic qualified as P
@@ -259,59 +255,6 @@ pfindTxInByTxOutRef = phoistAcyclic $
           )
         #$ (pfield @"inputs" # txInfo)
 
--- -- | Determines if a value is a subset of another.
--- pisValueSubset :: Term s (PValue :--> PValue :--> PBool)
--- pisValueSubset = plam $ \v0 _v1 -> P.do
---   -- v0Map :: Term s (PMap PCurrencySymbol (PMap PTokenName PInteger))
---   PValue v0Map <- pmatch v0
-
---   -- v0BuiltinMap :: Term s (PBuiltinMap k v)
---   PMap v0BuiltinMap <- pmatch v0Map
-
---   -- ks0 :: Term s (PBuiltinList PCurrencySymbol)
---   let ks0 = pmap # pfstBuiltin # v0BuiltinMap
---   pconstant True
-
--- -- | Determines if a PTokenName/PInteger pmap is a subset of another.
--- pisTnISubset ::
---   Term
---     s
---     ( PMap PTokenName PInteger
---         :--> PMap PTokenName PInteger
---         :--> PBool
---     )
--- pisTnISubset = plam $ \m0 m1 -> P.do
---   -- m0BuiltinMap :: Term s (PBuiltinMap PTokenName PInteger)
---   PMap m0BuiltinMap <- pmatch m0
-
---   -- ks0 :: Term s (PBuiltinList PTokenName)
---   let ks0 = pmap # pfstBuiltin # m0BuiltinMap
---   pconstant True
-
--- pcompareKeys ::
---   Term
---     s
---     ( PBuiltinList k
---         :--> PMap k v
---         :--> PMap k v
---         :--> PBool
---     )
--- pcompareKeys = plam $ \ks m0' m1' -> P.do
---   PMap m0 <- m0'
---   PMap m1 <- m1'
---   bs <- pmatch $ pmap # f # ks
---   pconstant True
-
--- f :: Term s (k :--> PMap k v :--> PMap k v :--> PBool)
--- f = plam $ \k m0' m1' -> P.do
---   PMap m0 <- m0'
---   PMap m1 <- m1'
---   pmatch (plookup # k # m1) $ \case
---     PNothing -> pconstant False
---     PJust n1 -> P.do
---       PJust n0 <- pmatch $ plookup # k # m0
---       n0 #<= n1
-
 --------------------------------------------------------------------------------
 -- Functions which should (probably) not be upstreamed
 
diff --git a/src/Agora/Utils/Value.hs b/src/Agora/Utils/Value.hs
index b27d569..90efdaa 100644
--- a/src/Agora/Utils/Value.hs
+++ b/src/Agora/Utils/Value.hs
@@ -1,46 +1,15 @@
-{-# OPTIONS_GHC -Wwarn #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
-module Agora.Utils.Value where
+module Agora.Utils.Value (pgeq, pleq, pgt, plt) where
 
-import GHC.Generics qualified as GHC
-import Generics.SOP
 import Plutarch.Api.V1.AssocMap (PMap (PMap))
-import Plutarch.Api.V1.Tuple (PTuple, ptupleFromBuiltin)
+import Plutarch.Api.V1.These (PTheseData (..))
+import Plutarch.Api.V1.Tuple (ptupleFromBuiltin)
 import Plutarch.Api.V1.Value (PCurrencySymbol, PTokenName, PValue)
-import Plutarch.DataRepr (PIsDataReprInstances (PIsDataReprInstances))
-import Plutarch.Lift (PLifted, PUnsafeLiftDecl)
+import Plutarch.Lift (PUnsafeLiftDecl)
+import Plutarch.List (pconvertLists)
 import Plutarch.Monadic qualified as P
-import Plutus.V1.Ledger.Api qualified as Plutus
-import PlutusTx.These qualified as PlutusThese
-
--- data PThese (a :: PType) (b :: PType) (s :: S)
---   = PThis (Term s a)
---   | PThat (Term s b)
---   | PThese (Term s a) (Term s b)
---   deriving stock (GHC.Generic)
---   deriving anyclass (Generic, PlutusType)
-
-data PTheseData (a :: PType) (b :: PType) (s :: S)
-  = PDThis (Term s (PDataRecord '["_0" ':= a]))
-  | PDThat (Term s (PDataRecord '["_0" ':= b]))
-  | PDThese (Term s (PDataRecord '["_0" ':= a, "_1" ':= b]))
-  deriving stock (GHC.Generic)
-  deriving anyclass (Generic, PIsDataRepr)
-  deriving
-    (PlutusType, PIsData)
-    via PIsDataReprInstances (PTheseData a b)
-
-instance
-  ( Plutus.ToData (PLifted a)
-  , Plutus.ToData (PLifted b)
-  , Plutus.FromData (PLifted a)
-  , Plutus.FromData (PLifted b)
-  , PLift a
-  , PLift b
-  ) =>
-  PUnsafeLiftDecl (PTheseData a b)
-  where
-  type PLifted (PTheseData a b) = PlutusThese.These (PLifted a) (PLifted b)
 
 punionVal ::
   Term
@@ -60,10 +29,9 @@ pmapAll ::
 pmapAll = plam $ \f m -> P.do
   PMap builtinMap <- pmatch $ m
 
-  let getV :: PIsData v => Term s (PBuiltinPair (PAsData k) (PAsData v) :--> v)
-      getV = plam $ \bip -> P.do
+  let getV = plam $ \bip -> P.do
         let tuple = pfromData $ ptupleFromBuiltin (pdata bip)
-        pfield @"_1" # tuple
+        pfromData $ pfield @"_1" # tuple
 
   let vs = pmap # getV # builtinMap
   pall # f # vs
@@ -77,10 +45,12 @@ pcheckPred ::
         :--> PValue
         :--> PBool
     )
-pcheckPred = plam $ \f l r -> P.do
-  let inner :: Term s (PMap PTokenName (PTheseData PInteger PInteger) :--> PBool)
-      inner = pmapAll # f
-  pmapAll # inner # (punionVal # l # r)
+pcheckPred = plam $ \_f _l _r -> P.do
+  undefined
+
+--  let inner :: Term s (PMap PTokenName (PTheseData PInteger PInteger) :--> PBool)
+--      inner = pmapAll # f
+--  pmapAll # inner # (punionVal # l # r)
 
 pcheckBinRel ::
   forall {s :: S}.
@@ -100,8 +70,24 @@ pcheckBinRel = plam $ \f l r -> P.do
           PDThese r -> f # (pfield @"_0" # r) # (pfield @"_1" # r)
   pcheckPred # unThese # l # r
 
+-- | Establishes if a value is less than or equal to another.
 pleq :: Term s (PValue :--> PValue :--> PBool)
 pleq = plam $ \v0 v1 -> (pcheckBinRel # pleq') # v0 # v1
 
 pleq' :: Term s (PInteger :--> PInteger :--> PBool)
 pleq' = plam $ \m n -> m #<= n
+
+-- | Establishes if a value is strictly less than another.
+plt :: Term s (PValue :--> PValue :--> PBool)
+plt = plam $ \v0 v1 -> (pcheckBinRel # plt') # v0 # v1
+
+plt' :: Term s (PInteger :--> PInteger :--> PBool)
+plt' = plam $ \m n -> m #< n
+
+-- | Establishes if a value is greater than or equal to another.
+pgeq :: Term s (PValue :--> PValue :--> PBool)
+pgeq = plam $ \v0 v1 -> pnot #$ plt # v0 # v1
+
+-- | Establishes if a value is strictly greater than another.
+pgt :: Term s (PValue :--> PValue :--> PBool)
+pgt = plam $ \v0 v1 -> pnot #$ pleq # v0 # v1
diff --git a/src/Plutarch/Api/V1/These.hs b/src/Plutarch/Api/V1/These.hs
new file mode 100644
index 0000000..e1ae1ed
--- /dev/null
+++ b/src/Plutarch/Api/V1/These.hs
@@ -0,0 +1,62 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Plutarch.Api.V1.These (PTheseData (..)) where
+
+import GHC.Generics qualified as GHC
+import Generics.SOP
+import Plutarch.DataRepr (PIsDataReprInstances (PIsDataReprInstances))
+import Plutarch.Lift (
+  PConstantRepr,
+  PConstanted,
+  PLifted,
+  PUnsafeLiftDecl,
+  pconstantFromRepr,
+  pconstantToRepr,
+ )
+import Plutus.V1.Ledger.Api qualified as Plutus
+import PlutusTx.These qualified as PlutusThese
+
+data PTheseData (a :: PType) (b :: PType) (s :: S)
+  = PDThis (Term s (PDataRecord '["_0" ':= a]))
+  | PDThat (Term s (PDataRecord '["_0" ':= b]))
+  | PDThese (Term s (PDataRecord '["_0" ':= a, "_1" ':= b]))
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PIsDataRepr)
+  deriving
+    (PlutusType, PIsData)
+    via PIsDataReprInstances (PTheseData a b)
+
+instance
+  ( Plutus.ToData (PLifted a)
+  , Plutus.ToData (PLifted b)
+  , Plutus.FromData (PLifted a)
+  , Plutus.FromData (PLifted b)
+  , PLift a
+  , PLift b
+  ) =>
+  PUnsafeLiftDecl (PTheseData a b)
+  where
+  type PLifted (PTheseData a b) = PlutusThese.These (PLifted a) (PLifted b)
+
+{- TODO: Make PTheseData an instance of PConstant:
+         https://github.com/Plutonomicon/plutarch/pull/355
+-}
+
+instance
+  ( PLifted (PConstanted a) ~ a
+  , Plutus.ToData b
+  , Plutus.FromData b
+  , Plutus.ToData a
+  , Plutus.FromData a
+  , PConstant a
+  , PLifted (PConstanted b) ~ b
+  , Plutus.FromData b
+  , Plutus.ToData b
+  , PConstant b
+  ) =>
+  PConstant (PlutusThese.These a b)
+  where
+  type PConstantRepr (PlutusThese.These a b) = [(Plutus.Data, Plutus.Data)]
+  type PConstanted (PlutusThese.These a b) = PTheseData (PConstanted a) (PConstanted b)
+  pconstantToRepr _t = undefined
+  pconstantFromRepr _t = undefined
diff --git a/src/Plutarch/These.hs b/src/Plutarch/These.hs
new file mode 100644
index 0000000..f9b225a
--- /dev/null
+++ b/src/Plutarch/These.hs
@@ -0,0 +1,12 @@
+module Plutarch.These (PThese (..)) where
+
+import GHC.Generics qualified as GHC
+import Generics.SOP
+
+-- | Plutus These type with Scott-encoded representation.
+data PThese (a :: PType) (b :: PType) (s :: S)
+  = PThis (Term s a)
+  | PThat (Term s b)
+  | PThese (Term s a) (Term s b)
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic, PlutusType)

From 1bfa0f5b6d57b8220eb2fc89b64f598e664c7be3 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Fri, 4 Mar 2022 09:30:53 +0000
Subject: [PATCH 12/18] Added linting suggestions

---
 src/Agora/Treasury.hs    | 2 +-
 src/Agora/Utils/Value.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index d487f5a..9066e1a 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -60,7 +60,7 @@ newtype PTreasuryDatum (s :: S)
 {- | Plutarch level type representing valid redeemers of the
      treasury.
 -}
-data PTreasuryRedeemer (s :: S)
+newtype PTreasuryRedeemer (s :: S)
   = -- | Alters treasury parameters (subject to the burning of a
     --   governance authority token).
     PAlterTrParams (Term s (PDataRecord '[]))
diff --git a/src/Agora/Utils/Value.hs b/src/Agora/Utils/Value.hs
index 90efdaa..e20bb5b 100644
--- a/src/Agora/Utils/Value.hs
+++ b/src/Agora/Utils/Value.hs
@@ -27,7 +27,7 @@ pmapAll ::
   (PUnsafeLiftDecl v, PIsData v) =>
   Term s ((v :--> PBool) :--> PMap k v :--> PBool)
 pmapAll = plam $ \f m -> P.do
-  PMap builtinMap <- pmatch $ m
+  PMap builtinMap <- pmatch m
 
   let getV = plam $ \bip -> P.do
         let tuple = pfromData $ ptupleFromBuiltin (pdata bip)

From 5216987dac4cce7bfaec2e33b056bdb7a8bd0773 Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Fri, 4 Mar 2022 13:04:16 +0000
Subject: [PATCH 13/18] Updated treasury docs to reflect current implementation

---
 docs/tech-design/treasury.md | 39 +++++++++++++++++++++++---------
 src/Agora/Treasury.hs        | 43 +++++++++++++++++++++++++++---------
 2 files changed, 60 insertions(+), 22 deletions(-)

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)

From 657031508ec53b28023a74ad3b807e833b62b30f Mon Sep 17 00:00:00 2001
From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com>
Date: Fri, 4 Mar 2022 13:09:05 +0000
Subject: [PATCH 14/18] Applied linting suggestions

---
 src/Agora/Treasury.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 2e309bb..9bf407f 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -50,7 +50,7 @@ treasuryV cs tn = plam $ \_d r ctx' -> P.do
   let mint :: Term s PValue
       mint = txInfo.mint
       gatAmountMinted :: Term s PInteger
-      gatAmountMinted = passetClassValueOf # (pconstant cs) # (pconstant tn) # mint
+      gatAmountMinted = passetClassValueOf # pconstant cs # pconstant tn # mint
 
   pif
     (gatAmountMinted #== -1) -- If the amount of GATS burned is not one, ...

From 16211998f63ce8beb9aa16b97d2ea55630f8e50b Mon Sep 17 00:00:00 2001
From: Emily Martins <emi@haskell.fyi>
Date: Fri, 4 Mar 2022 17:16:16 +0100
Subject: [PATCH 15/18] rename `AlterTrParams` to `AlterTreasuryParams`

---
 docs/tech-design/treasury.md | 10 +++++-----
 flake.lock                   |  2 ++
 src/Agora/Treasury.hs        |  8 ++++----
 3 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/docs/tech-design/treasury.md b/docs/tech-design/treasury.md
index fe15702..8d3993b 100644
--- a/docs/tech-design/treasury.md
+++ b/docs/tech-design/treasury.md
@@ -55,8 +55,8 @@ The script for an Agora treasury is described in this section. For clarity, all
 ### Datum
 
 ```hs
-newtype TreasuryDtum = TreasuryDatum
-  { -- | Currency symbol of the treasury state thread. 
+newtype TreasuryDatum = TreasuryDatum
+  { -- | Currency symbol of the treasury state thread.
     stateThread :: CurrencySymbol
   }
 ```
@@ -64,16 +64,16 @@ newtype TreasuryDtum = TreasuryDatum
 ### Redeemers
 
 ```hs
-newtype TreasuryRedeemer = AlterTrParams
+newtype TreasuryRedeemer = AlterTreasuryParams
 ```
 
-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.
+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 `AlterTreasuryParams`, for when the treasury's parameters are subject to change by a proposal effect.
 
 ### Validators
 
 ```hs
 treasuryV ::
-  CurrencySymbol -> 
+  CurrencySymbol ->
   TreasuryDatum ->
   TreasuryRedeemer ->
   ScriptContext ->
diff --git a/flake.lock b/flake.lock
index 6247424..f5ab6be 100644
--- a/flake.lock
+++ b/flake.lock
@@ -440,6 +440,8 @@
         "hpc-coveralls": "hpc-coveralls",
         "nix-tools": "nix-tools",
         "nixpkgs": [
+          "plutarch",
+          "haskell-nix",
           "nixpkgs-2111"
         ],
         "nixpkgs-2003": "nixpkgs-2003",
diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 9bf407f..3fb0b33 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -38,12 +38,12 @@ 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
 
+  -- Ensure redeemer type is valid.
+  PAlterTreasuryParams _ <- pmatch $ pfromData r
+
   -- Get the minted value from txInfo.
   txInfo' <- plet ctx.txInfo
   txInfo <- pletFields @'["mint"] txInfo'
@@ -84,7 +84,7 @@ newtype PTreasuryDatum (s :: S)
 newtype PTreasuryRedeemer (s :: S)
   = -- | Alters treasury parameters, subject to the burning of a
     --   governance authority token.
-    PAlterTrParams (Term s (PDataRecord '[]))
+    PAlterTreasuryParams (Term s (PDataRecord '[]))
   deriving stock (GHC.Generic)
   deriving anyclass (Generic, PIsDataRepr)
   deriving

From 98833e10740f44e26acb698c4917178c2194889b Mon Sep 17 00:00:00 2001
From: Emily Martins <emi@haskell.fyi>
Date: Fri, 4 Mar 2022 22:04:59 +0100
Subject: [PATCH 16/18] add `authorityTokensValidIn` function

---
 src/Agora/AuthorityToken.hs | 44 ++++++++++++++++++++++++++++++++++++-
 src/Agora/Treasury.hs       |  9 ++++----
 2 files changed, 47 insertions(+), 6 deletions(-)

diff --git a/src/Agora/AuthorityToken.hs b/src/Agora/AuthorityToken.hs
index 64dcfc7..fbdd438 100644
--- a/src/Agora/AuthorityToken.hs
+++ b/src/Agora/AuthorityToken.hs
@@ -7,16 +7,23 @@ Tokens acting as redeemable proofs of DAO authority.
 -}
 module Agora.AuthorityToken (
   authorityTokenPolicy,
+  authorityTokensValidIn,
   AuthorityToken (..),
 ) where
 
 import Plutarch.Api.V1 (
+  PAddress (..),
+  PCredential (..),
+  PCurrencySymbol (..),
+  PMap (..),
   PScriptContext (..),
   PScriptPurpose (..),
   PTxInInfo (..),
   PTxInfo (..),
   PTxOut (..),
+  PValue (..),
  )
+import Plutarch.Builtin (pforgetData)
 import Plutarch.List (pfoldr')
 import Plutarch.Monadic qualified as P
 import Plutus.V1.Ledger.Value (AssetClass)
@@ -25,7 +32,7 @@ import Prelude
 
 --------------------------------------------------------------------------------
 
-import Agora.Utils (passert, passetClassValueOf, passetClassValueOf')
+import Agora.Utils (passert, passetClassValueOf, passetClassValueOf', plookup)
 
 --------------------------------------------------------------------------------
 
@@ -42,6 +49,41 @@ newtype AuthorityToken = AuthorityToken
 
 --------------------------------------------------------------------------------
 
+{- | Check that all GATs are valid in a particular TxOut.
+     How this is checked: an AuthorityToken should never leave
+     the Effect it was initially sent to, so we simply check that
+     the script address the token resides in matches the TokenName.
+     Since the TokenName was tagged upon mint with the Effect script
+     it was sent to, this is enough to prove validity.
+
+     In other words, check that all assets of a particular currency symbol
+     are tagged with a TokenName that matches where they live.
+-}
+authorityTokensValidIn :: Term s (PCurrencySymbol :--> PTxOut :--> PBool)
+authorityTokensValidIn = phoistAcyclic $
+  plam $ \authorityTokenSym txOut'' -> P.do
+    PTxOut txOut' <- pmatch txOut''
+    txOut <- pletFields @'["address", "value"] $ txOut'
+    PAddress address <- pmatch txOut.address
+    PValue value' <- pmatch txOut.value
+    PMap value <- pmatch value'
+    pmatch (plookup # pdata authorityTokenSym # value) $ \case
+      PJust (pfromData -> tokenMap') ->
+        pmatch (pfield @"credential" # address) $ \case
+          PPubKeyCredential _ ->
+            -- GATs should only be sent to Effect validators
+            pconstant False
+          PScriptCredential ((pfromData . (pfield @"_0" #)) -> cred) -> P.do
+            PMap tokenMap <- pmatch tokenMap'
+            pall
+              # ( plam $ \pair ->
+                    pforgetData (pfstBuiltin # pair) #== pforgetData (pdata cred)
+                )
+              # tokenMap
+      PNothing ->
+        -- No GATs exist at this output!
+        pconstant True
+
 -- | Policy given 'AuthorityToken' params.
 authorityTokenPolicy ::
   AuthorityToken ->
diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 3fb0b33..279da4a 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -8,7 +8,7 @@ treasury.
 -}
 module Agora.Treasury (module Agora.Treasury) where
 
-import Agora.Utils (passetClassValueOf)
+import Agora.Utils (passert, passetClassValueOf)
 import GHC.Generics qualified as GHC
 import Generics.SOP
 import Plutarch.Api.V1.Contexts (PScriptContext, PScriptPurpose (PMinting))
@@ -52,10 +52,9 @@ treasuryV cs tn = plam $ \_d r ctx' -> P.do
       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.
+  passert "GAT not burned." $ gatAmountMinted #== -1
+
+  pconstant ()
 
 {- | Plutarch level type representing datum of the treasury.
      Contains:

From 770ce12337443493444d06cd6c2aaf7e4be2a036 Mon Sep 17 00:00:00 2001
From: Emily Martins <emi@haskell.fyi>
Date: Tue, 8 Mar 2022 13:17:29 +0100
Subject: [PATCH 17/18] check that all GATs burned in treasury validator are
 valid

---
 src/Agora/AuthorityToken.hs | 12 +++++++--
 src/Agora/Treasury.hs       | 19 ++++++++++----
 src/Agora/Utils.hs          | 52 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 75 insertions(+), 8 deletions(-)

diff --git a/src/Agora/AuthorityToken.hs b/src/Agora/AuthorityToken.hs
index fbdd438..a862ef2 100644
--- a/src/Agora/AuthorityToken.hs
+++ b/src/Agora/AuthorityToken.hs
@@ -32,7 +32,7 @@ import Prelude
 
 --------------------------------------------------------------------------------
 
-import Agora.Utils (passert, passetClassValueOf, passetClassValueOf', plookup)
+import Agora.Utils (allOutputs, passert, passetClassValueOf, passetClassValueOf', plookup)
 
 --------------------------------------------------------------------------------
 
@@ -113,5 +113,13 @@ authorityTokenPolicy params =
       let mintedATs = passetClassValueOf # ownSymbol # pconstant "" # mintedValue
       pif
         (0 #< mintedATs)
-        (passert "Authority token did not move in minting GATs" tokenMoved (pconstant ()))
+        ( P.do
+            passert "Parent token did not move in minting GATs" tokenMoved
+            passert "All outputs only emit valid GATs" $
+              allOutputs @PUnit # pfromData ctx.txInfo #$ plam $ \txOut _value _address _datum ->
+                authorityTokensValidIn
+                  # ownSymbol
+                  # txOut
+            pconstant ()
+        )
         (pconstant ())
diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs
index 279da4a..ff4ab36 100644
--- a/src/Agora/Treasury.hs
+++ b/src/Agora/Treasury.hs
@@ -8,7 +8,6 @@ treasury.
 -}
 module Agora.Treasury (module Agora.Treasury) where
 
-import Agora.Utils (passert, passetClassValueOf)
 import GHC.Generics qualified as GHC
 import Generics.SOP
 import Plutarch.Api.V1.Contexts (PScriptContext, PScriptPurpose (PMinting))
@@ -18,7 +17,12 @@ import Plutarch.DataRepr (
   PIsDataReprInstances (PIsDataReprInstances),
  )
 import Plutarch.Monadic qualified as P
-import Plutus.V1.Ledger.Value (CurrencySymbol, TokenName)
+import Plutus.V1.Ledger.Value (CurrencySymbol)
+
+--------------------------------------------------------------------------------
+
+import Agora.AuthorityToken (authorityTokensValidIn)
+import Agora.Utils (allInputs, passert, psymbolValueOf)
 
 {- | Validator ensuring that transactions consuming the treasury
      do so in a valid manner.
@@ -26,7 +30,6 @@ import Plutus.V1.Ledger.Value (CurrencySymbol, TokenName)
 treasuryV ::
   forall {s :: S}.
   CurrencySymbol ->
-  TokenName ->
   Term
     s
     ( PAsData PTreasuryDatum
@@ -34,7 +37,7 @@ treasuryV ::
         :--> PAsData PScriptContext
         :--> PUnit
     )
-treasuryV cs tn = plam $ \_d r ctx' -> P.do
+treasuryV cs = plam $ \_d r ctx' -> P.do
   -- plet required fields from script context.
   ctx <- pletFields @["txInfo", "purpose"] ctx'
 
@@ -50,10 +53,16 @@ treasuryV cs tn = plam $ \_d r ctx' -> P.do
   let mint :: Term s PValue
       mint = txInfo.mint
       gatAmountMinted :: Term s PInteger
-      gatAmountMinted = passetClassValueOf # pconstant cs # pconstant tn # mint
+      gatAmountMinted = psymbolValueOf # pconstant cs # mint
 
   passert "GAT not burned." $ gatAmountMinted #== -1
 
+  passert "All inputs only have valid GATs" $
+    allInputs @PUnit # pfromData ctx.txInfo #$ plam $ \txOut _value _address _datum ->
+      authorityTokensValidIn
+        # pconstant cs
+        # txOut
+
   pconstant ()
 
 {- | Plutarch level type representing datum of the treasury.
diff --git a/src/Agora/Utils.hs b/src/Agora/Utils.hs
index 124c57b..01f50cb 100644
--- a/src/Agora/Utils.hs
+++ b/src/Agora/Utils.hs
@@ -25,7 +25,9 @@ module Agora.Utils (
 
   -- * Functions which should (probably) not be upstreamed
   anyOutput,
+  allOutputs,
   anyInput,
+  allInputs,
 ) where
 
 --------------------------------------------------------------------------------
@@ -256,7 +258,9 @@ pfindTxInByTxOutRef = phoistAcyclic $
         #$ (pfield @"inputs" # txInfo)
 
 --------------------------------------------------------------------------------
--- Functions which should (probably) not be upstreamed
+{- Functions which should (probably) not be upstreamed
+   All of these functions are quite inefficient.
+-}
 
 -- | Check if any output matches the predicate.
 anyOutput ::
@@ -280,6 +284,28 @@ anyOutput = phoistAcyclic $
         )
       # pfromData txInfo.outputs
 
+-- | Check if all outputs match the predicate.
+allOutputs ::
+  forall (datum :: PType) s.
+  ( PIsData datum
+  ) =>
+  Term s (PTxInfo :--> (PTxOut :--> PValue :--> PAddress :--> datum :--> PBool) :--> PBool)
+allOutputs = phoistAcyclic $
+  plam $ \txInfo' predicate -> P.do
+    txInfo <- pletFields @'["outputs"] txInfo'
+    pall
+      # plam
+        ( \txOut'' -> P.do
+            PTxOut txOut' <- pmatch (pfromData txOut'')
+            txOut <- pletFields @'["value", "datumHash", "address"] txOut'
+            PDJust dh <- pmatch txOut.datumHash
+            pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo') $ \case
+              PJust datum -> P.do
+                predicate # (pfromData txOut'') # txOut.value # txOut.address # pfromData datum
+              PNothing -> pcon PFalse
+        )
+      # pfromData txInfo.outputs
+
 -- | Check if any (resolved) input matches the predicate.
 anyInput ::
   forall (datum :: PType) s.
@@ -304,6 +330,30 @@ anyInput = phoistAcyclic $
         )
       # pfromData txInfo.inputs
 
+-- | Check if all (resolved) inputs match the predicate.
+allInputs ::
+  forall (datum :: PType) s.
+  ( PIsData datum
+  ) =>
+  Term s (PTxInfo :--> (PTxOut :--> PValue :--> PAddress :--> datum :--> PBool) :--> PBool)
+allInputs = phoistAcyclic $
+  plam $ \txInfo' predicate -> P.do
+    txInfo <- pletFields @'["inputs"] txInfo'
+    pall
+      # plam
+        ( \txInInfo'' -> P.do
+            PTxInInfo txInInfo' <- pmatch (pfromData txInInfo'')
+            let txOut'' = pfield @"resolved" # txInInfo'
+            PTxOut txOut' <- pmatch (pfromData txOut'')
+            txOut <- pletFields @'["value", "datumHash", "address"] txOut'
+            PDJust dh <- pmatch txOut.datumHash
+            pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo') $ \case
+              PJust datum -> P.do
+                predicate # pfromData txOut'' # txOut.value # txOut.address # pfromData datum
+              PNothing -> pcon PFalse
+        )
+      # pfromData txInfo.inputs
+
 -- | Create a value with a single asset class.
 psingletonValue :: forall s. Term s (PCurrencySymbol :--> PTokenName :--> PInteger :--> PValue)
 psingletonValue = phoistAcyclic $

From 85e304d781e2e8328aa00eca838008dd4e46cecf Mon Sep 17 00:00:00 2001
From: Emily Martins <emi@haskell.fyi>
Date: Tue, 8 Mar 2022 13:22:37 +0100
Subject: [PATCH 18/18] make hlint happy

---
 bench.csv                   | 2 +-
 src/Agora/AuthorityToken.hs | 3 ++-
 src/Agora/Utils.hs          | 2 +-
 3 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/bench.csv b/bench.csv
index a467473..ef76a58 100644
--- a/bench.csv
+++ b/bench.csv
@@ -1,4 +1,4 @@
 name,cpu,mem,size
-full_scripts:authorityTokenPolicy,1399431,4800,421
+full_scripts:authorityTokenPolicy,1756707,6000,841
 full_scripts:stakePolicy,3751498,12700,1610
 full_scripts:stakeValidator,3126265,10600,1500
diff --git a/src/Agora/AuthorityToken.hs b/src/Agora/AuthorityToken.hs
index a862ef2..3a00148 100644
--- a/src/Agora/AuthorityToken.hs
+++ b/src/Agora/AuthorityToken.hs
@@ -76,7 +76,8 @@ authorityTokensValidIn = phoistAcyclic $
           PScriptCredential ((pfromData . (pfield @"_0" #)) -> cred) -> P.do
             PMap tokenMap <- pmatch tokenMap'
             pall
-              # ( plam $ \pair ->
+              # plam
+                ( \pair ->
                     pforgetData (pfstBuiltin # pair) #== pforgetData (pdata cred)
                 )
               # tokenMap
diff --git a/src/Agora/Utils.hs b/src/Agora/Utils.hs
index 01f50cb..2afa33a 100644
--- a/src/Agora/Utils.hs
+++ b/src/Agora/Utils.hs
@@ -301,7 +301,7 @@ allOutputs = phoistAcyclic $
             PDJust dh <- pmatch txOut.datumHash
             pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo') $ \case
               PJust datum -> P.do
-                predicate # (pfromData txOut'') # txOut.value # txOut.address # pfromData datum
+                predicate # pfromData txOut'' # txOut.value # txOut.address # pfromData datum
               PNothing -> pcon PFalse
         )
       # pfromData txInfo.outputs