Merge pull request #61 from Liqwid-Labs/connor/governor

Implementation of the governor components

Makefile

@@ -1,7 +1,7 @@
 # This really ought to be `/usr/bin/env bash`, but nix flakes don't like that.
 SHELL := /bin/sh
 
-.PHONY: hoogle format haddock usage tag lint ps_bridge
+.PHONY: hoogle format haddock usage tag format_nix format_haskell format_check lint ps_bridge
 
 usage:
 	@echo "usage: make <command> [OPTIONS]"
@@ -11,6 +11,9 @@ usage:
 	@echo "  format -- Format the project"
 	@echo "  haddock -- Generate Haddock docs for project"
 	@echo "  tag -- Generate CTAGS and ETAGS files for project"
+	@echo "  format_haskell -- Format haskell stuff, including source code and cabal files"
+	@echo "  format_nix -- Format *.nix files only"
+	@echo "  format_check -- Check if all haskell stuff have been formatted correctly"
 	@echo "  lint -- Get hlint suggestions for project"
 	@echo "  ps_bridge -- Generate purescript bridge files"
 

agora-purescript-bridge/src/Agora/Governor.purs

@@ -4,6 +4,7 @@ module Agora.Governor where
 import Prelude
 
 import Agora.Proposal (ProposalId, ProposalThresholds)
+import Agora.SafeMoney (GTTag)
 import Data.Bounded.Generic (genericBottom, genericTop)
 import Data.Enum (class Enum)
 import Data.Enum.Generic (genericPred, genericSucc)
@@ -13,6 +14,10 @@ import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Record (prop)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
+import Data.Tagged (Tagged)
+import GHC.Num.Integer (Integer)
+import Plutus.V1.Ledger.Tx (TxOutRef)
+import Plutus.V1.Ledger.Value (AssetClass)
 import Type.Proxy (Proxy(Proxy))
 
 newtype GovernorDatum = GovernorDatum
@@ -34,6 +39,7 @@ _GovernorDatum = _Newtype
 data GovernorRedeemer
   = CreateProposal
   | MintGATs
+  | MutateGovernor
 
 derive instance Generic GovernorRedeemer _
 
@@ -57,21 +63,24 @@ _MintGATs = prism' (const MintGATs) case _ of
   MintGATs -> Just unit
   _ -> Nothing
 
+_MutateGovernor :: Prism' GovernorRedeemer Unit
+_MutateGovernor = prism' (const MutateGovernor) case _ of
+  MutateGovernor -> Just unit
+  _ -> Nothing
+
 --------------------------------------------------------------------------------
 
-data Governor = Governor
+newtype Governor = Governor
+  { gstOutRef :: TxOutRef
+  , gtClassRef :: Tagged GTTag AssetClass
+  , maximumCosigners :: Integer
+  }
 
 derive instance Generic Governor _
 
-instance Enum Governor where
+derive instance Newtype Governor _
-  succ = genericSucc
-  pred = genericPred
-
-instance Bounded Governor where
-  bottom = genericBottom
-  top = genericTop
 
 --------------------------------------------------------------------------------
 
-_Governor :: Iso' Governor Unit
+_Governor :: Iso' Governor {gstOutRef :: TxOutRef, gtClassRef :: Tagged GTTag AssetClass, maximumCosigners :: Integer}
-_Governor = iso (const unit) (const Governor)
+_Governor = _Newtype

agora-purescript-bridge/src/Agora/Proposal.purs

@@ -14,7 +14,6 @@ import Data.Lens.Record (prop)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
 import Data.Tagged (Tagged)
-import Data.Tuple (Tuple)
 import GHC.Num.Integer (Integer)
 import Plutus.V1.Ledger.Crypto (PubKeyHash)
 import Plutus.V1.Ledger.Scripts (DatumHash, ValidatorHash)
@@ -120,7 +119,7 @@ _ProposalVotes = _Newtype
 
 newtype ProposalDatum = ProposalDatum
   { proposalId :: ProposalId
-  , effects :: Map ResultTag (Array (Tuple ValidatorHash DatumHash))
+  , effects :: Map ResultTag (Map ValidatorHash DatumHash)
   , status :: ProposalStatus
   , cosigners :: Array PubKeyHash
   , thresholds :: ProposalThresholds
@@ -133,7 +132,7 @@ derive instance Newtype ProposalDatum _
 
 --------------------------------------------------------------------------------
 
-_ProposalDatum :: Iso' ProposalDatum {proposalId :: ProposalId, effects :: Map ResultTag (Array (Tuple ValidatorHash DatumHash)), status :: ProposalStatus, cosigners :: Array PubKeyHash, thresholds :: ProposalThresholds, votes :: ProposalVotes}
+_ProposalDatum :: Iso' ProposalDatum {proposalId :: ProposalId, effects :: Map ResultTag (Map ValidatorHash DatumHash), status :: ProposalStatus, cosigners :: Array PubKeyHash, thresholds :: ProposalThresholds, votes :: ProposalVotes}
 _ProposalDatum = _Newtype
 
 --------------------------------------------------------------------------------

agora-sample/Sample/Governor.hs

@@ -0,0 +1,619 @@
+{- |
+Module     : Spec.Sample.Governor
+Maintainer : connor@mlabs.city
+Description: Sample based testing for Governor utxos
+
+This module tests primarily the happy path for Governor interactions
+-}
+module Sample.Governor (
+  createProposal,
+  mutateState,
+  mintGATs,
+  mintGST,
+) where
+
+--------------------------------------------------------------------------------
+
+import Plutarch.Api.V1 (mkValidator, validatorHash)
+import Plutarch.SafeMoney.Tagged
+
+--------------------------------------------------------------------------------
+
+import Plutus.V1.Ledger.Address (scriptHashAddress)
+import Plutus.V1.Ledger.Api (
+  Address (..),
+  Credential (ScriptCredential),
+  Datum (..),
+  ScriptContext (..),
+  ScriptPurpose (Minting, Spending),
+  ToData (toBuiltinData),
+  TokenName (..),
+  TxInInfo (TxInInfo),
+  TxInfo (..),
+  TxOut (..),
+  TxOutRef (..),
+  Validator,
+  ValidatorHash (..),
+ )
+import Plutus.V1.Ledger.Interval qualified as Interval
+import Plutus.V1.Ledger.Scripts (unitDatum)
+import Plutus.V1.Ledger.Value (
+  AssetClass (..),
+ )
+import Plutus.V1.Ledger.Value qualified as Value
+import PlutusTx.AssocMap qualified as AssocMap
+
+--------------------------------------------------------------------------------
+
+import Agora.Effect.NoOp (noOpValidator)
+import Agora.Governor (GovernorDatum (..), getNextProposalId)
+import Agora.Proposal (
+  ProposalDatum (..),
+  ProposalId (..),
+  ProposalStatus (..),
+  ProposalVotes (..),
+  ResultTag (..),
+  emptyVotesFor,
+ )
+import Agora.Proposal qualified as P
+import Agora.Stake (
+  ProposalLock (..),
+  Stake (..),
+  StakeDatum (..),
+ )
+
+--------------------------------------------------------------------------------
+
+import Sample.Shared (
+  authorityTokenSymbol,
+  defaultProposalThresholds,
+  govAssetClass,
+  govSymbol,
+  govValidatorAddress,
+  gstUTXORef,
+  minAda,
+  proposalPolicySymbol,
+  proposalValidatorAddress,
+  signer,
+  signer2,
+  stake,
+  stakeAddress,
+  stakeAssetClass,
+ )
+import Test.Util (datumPair, toDatumHash)
+
+--------------------------------------------------------------------------------
+
+{- | A valid 'ScriptContext' for minting GST.
+
+    - Only the minting policy will be ran in the transaction.
+    - An arbitrary UTXO is spent to create the token.
+
+        - We call this the "witness" UTXO.
+        - This UTXO is referenced in the 'Agora.Governor.Governor' parameter
+        - The minting policy should only be ran once its life time,
+          cause the GST cannot be minted twice or burnt.
+
+    - The output UTXO must carry a valid 'GovernorDatum'.
+    - It's worth noticing that the transaction should send the GST to the governor validator,
+        but unfortunately we can't check it in the policy. The GST will stay at the address of
+        the governor validator forever once the token is under control of the said validator.
+
+    TODO: tag the output UTXO with the target address.
+-}
+mintGST :: ScriptContext
+mintGST =
+  let gst = Value.assetClassValue govAssetClass 1
+
+      ---
+
+      governorOutputDatum' :: GovernorDatum
+      governorOutputDatum' =
+        GovernorDatum
+          { proposalThresholds = defaultProposalThresholds
+          , nextProposalId = ProposalId 0
+          }
+      governorOutputDatum :: Datum
+      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
+      governorOutput :: TxOut
+      governorOutput =
+        TxOut
+          { txOutAddress = govValidatorAddress
+          , txOutValue = gst <> minAda
+          , txOutDatumHash = Just $ toDatumHash governorOutputDatum
+          }
+
+      ---
+
+      witness :: ValidatorHash
+      witness = "a926a9a72a0963f428e3252caa8354e655603996fb8892d6b8323fd072345924"
+      witnessAddress :: Address
+      witnessAddress = Address (ScriptCredential witness) Nothing
+
+      ---
+
+      -- The witness UTXO must be consumed.
+      witnessInput :: TxOut
+      witnessInput =
+        TxOut
+          { txOutAddress = witnessAddress
+          , txOutValue = mempty
+          , txOutDatumHash = Nothing
+          }
+      initialSpend :: TxInInfo
+      initialSpend = TxInInfo gstUTXORef witnessInput
+   in ScriptContext
+        { scriptContextTxInfo =
+            TxInfo
+              { txInfoInputs =
+                  [ initialSpend
+                  ]
+              , txInfoOutputs = [governorOutput]
+              , -- Some ada to cover the transaction fee
+                txInfoFee = Value.singleton "" "" 2
+              , -- Exactly one GST is minted
+                txInfoMint = gst
+              , txInfoDCert = []
+              , txInfoWdrl = []
+              , txInfoValidRange = Interval.always
+              , txInfoSignatories = [signer]
+              , txInfoData = [datumPair governorOutputDatum]
+              , txInfoId = "90906d3e6b4d6dec2e747dcdd9617940ea8358164c7244694cfa39dec18bd9d4"
+              }
+        , scriptContextPurpose = Minting govSymbol
+        }
+
+{- | A valid script context to create a proposal.
+
+    Three component will run in the transaction:
+    TODO: mention redeemers
+
+    - Governor validator
+    - Stake validator
+    - Proposal policy
+
+    The components will ensure:
+
+    - The governor state UTXO is spent
+
+        - A new UTXO is paid back to governor validator, which carries the GST.
+        - The proposal id in the state datum is advanced.
+
+    - A new UTXO is sent to the proposal validator
+
+        - The UTXO contains a newly minted proposal state token.
+        - It also carries a legal proposal state datum, whose status is set to 'Agora.Proposal.Draft'.
+
+    - A stake is spent to create a proposal
+
+        - The stake owner must sign the transaction.
+        - The output stake must paid back to the stake validator.
+        - The output stake is locked by the newly created proposal.
+-}
+createProposal :: ScriptContext
+createProposal =
+  let pst = Value.singleton proposalPolicySymbol "" 1
+      gst = Value.assetClassValue govAssetClass 1
+      sst = Value.assetClassValue stakeAssetClass 1
+      stackedGTs = 424242424242
+      thisProposalId = ProposalId 0
+
+      ---
+
+      governorInputDatum' :: GovernorDatum
+      governorInputDatum' =
+        GovernorDatum
+          { proposalThresholds = defaultProposalThresholds
+          , nextProposalId = thisProposalId
+          }
+      governorInputDatum :: Datum
+      governorInputDatum = Datum $ toBuiltinData governorInputDatum'
+      governorInput :: TxOut
+      governorInput =
+        TxOut
+          { txOutAddress = govValidatorAddress
+          , txOutValue = gst
+          , txOutDatumHash = Just $ toDatumHash governorInputDatum
+          }
+
+      ---
+
+      effects =
+        AssocMap.fromList
+          [ (ResultTag 0, AssocMap.empty)
+          , (ResultTag 1, AssocMap.empty)
+          ]
+      proposalDatum :: Datum
+      proposalDatum =
+        Datum
+          ( toBuiltinData $
+              ProposalDatum
+                { P.proposalId = ProposalId 0
+                , effects = effects
+                , status = Draft
+                , cosigners = [signer]
+                , thresholds = defaultProposalThresholds
+                , votes = emptyVotesFor effects
+                }
+          )
+      proposalOutput :: TxOut
+      proposalOutput =
+        TxOut
+          { txOutAddress = proposalValidatorAddress
+          , txOutValue = pst <> minAda
+          , txOutDatumHash = Just (toDatumHash proposalDatum)
+          }
+
+      ---
+
+      stakeInputDatum' :: StakeDatum
+      stakeInputDatum' =
+        StakeDatum
+          { stakedAmount = Tagged stackedGTs
+          , owner = signer
+          , lockedBy = []
+          }
+      stakeInputDatum :: Datum
+      stakeInputDatum = Datum $ toBuiltinData stakeInputDatum'
+      stakeInput :: TxOut
+      stakeInput =
+        TxOut
+          { txOutAddress = stakeAddress
+          , txOutValue = sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs
+          , txOutDatumHash = Just (toDatumHash stakeInputDatum)
+          }
+
+      ---
+      governorOutputDatum' :: GovernorDatum
+      governorOutputDatum' = governorInputDatum' {nextProposalId = getNextProposalId thisProposalId}
+      governorOutputDatum :: Datum
+      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
+      governorOutput :: TxOut
+      governorOutput =
+        governorInput
+          { txOutDatumHash = Just $ toDatumHash governorOutputDatum
+          , txOutValue = gst <> minAda
+          }
+
+      ---
+
+      proposalLocks :: [ProposalLock]
+      proposalLocks =
+        [ ProposalLock (ResultTag 0) thisProposalId
+        , ProposalLock (ResultTag 1) thisProposalId
+        ]
+      stakeOutputDatum' :: StakeDatum
+      stakeOutputDatum' = stakeInputDatum' {lockedBy = proposalLocks}
+      stakeOutputDatum :: Datum
+      stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum'
+      stakeOutput :: TxOut
+      stakeOutput =
+        stakeInput
+          { txOutDatumHash = Just $ toDatumHash stakeOutputDatum
+          , txOutValue = sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs <> minAda
+          }
+
+      ---
+      ownInputRef :: TxOutRef
+      ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
+   in ScriptContext
+        { scriptContextTxInfo =
+            TxInfo
+              { txInfoInputs =
+                  [ TxInInfo
+                      ownInputRef
+                      governorInput
+                  , TxInInfo
+                      (TxOutRef "4262bbd0b3fc926b74eaa8abab5def6ce5e6b94f19cf221c02a16e7da8cd470f" 1)
+                      stakeInput
+                  ]
+              , txInfoOutputs = [proposalOutput, governorOutput, stakeOutput]
+              , txInfoFee = Value.singleton "" "" 2
+              , txInfoMint = pst
+              , txInfoDCert = []
+              , txInfoWdrl = []
+              , txInfoValidRange = Interval.always
+              , txInfoSignatories = [signer]
+              , txInfoData =
+                  datumPair
+                    <$> [ governorInputDatum
+                        , governorOutputDatum
+                        , proposalDatum
+                        , stakeInputDatum
+                        , stakeOutputDatum
+                        ]
+              , txInfoId = "1ffb9669335c908d9a4774a4bf7aa7bfafec91d015249b4138bc83fde4a3330a"
+              }
+        , scriptContextPurpose = Spending ownInputRef
+        }
+
+{- This script context should be a valid transaction for minting authority for the effect scrips.
+
+    The following components will run:
+
+    - Governor validator
+    - Authority policy
+    - Proposal validator
+
+    There should be only one proposal the transaction.
+    The validity of the proposal will be checked:
+
+    - It's in 'Agora.Proposal.Locked' state.
+    - It has a 'winner' effect group, meaning that the votes meet the requirements.
+
+    The system will ensure that for every effect scrips in said effect group,
+    a newly minted GAT is sent to the corresponding effect, and properly tagged.
+-}
+mintGATs :: ScriptContext
+mintGATs =
+  let pst = Value.singleton proposalPolicySymbol "" 1
+      gst = Value.assetClassValue govAssetClass 1
+      gat = Value.assetClassValue atAssetClass 1
+
+      ---
+
+      mockEffect :: Validator
+      mockEffect = mkValidator $ noOpValidator ""
+      mockEffectHash :: ValidatorHash
+      mockEffectHash = validatorHash mockEffect
+      mockEffectAddress :: Address
+      mockEffectAddress = scriptHashAddress mockEffectHash
+      mockEffectOutputDatum :: Datum
+      mockEffectOutputDatum = unitDatum
+      atTokenName :: TokenName
+      atTokenName = TokenName hash
+        where
+          ValidatorHash hash = mockEffectHash
+      atAssetClass :: AssetClass
+      atAssetClass = AssetClass (authorityTokenSymbol, atTokenName)
+
+      ---
+
+      governorInputDatum' :: GovernorDatum
+      governorInputDatum' =
+        GovernorDatum
+          { proposalThresholds = defaultProposalThresholds
+          , nextProposalId = ProposalId 5
+          }
+      governorInputDatum :: Datum
+      governorInputDatum = Datum $ toBuiltinData governorInputDatum'
+      governorInput :: TxOut
+      governorInput =
+        TxOut
+          { txOutAddress = govValidatorAddress
+          , txOutValue = gst
+          , txOutDatumHash = Just $ toDatumHash governorInputDatum
+          }
+
+      ---
+
+      effects =
+        AssocMap.fromList
+          [ (ResultTag 0, AssocMap.empty)
+          , (ResultTag 1, AssocMap.singleton mockEffectHash $ toDatumHash mockEffectOutputDatum)
+          ]
+      proposalVotes :: ProposalVotes
+      proposalVotes =
+        ProposalVotes $
+          AssocMap.fromList
+            [ (ResultTag 0, 100)
+            , (ResultTag 1, 2000) -- The winner
+            ]
+      proposalInputDatum' :: ProposalDatum
+      proposalInputDatum' =
+        ProposalDatum
+          { P.proposalId = ProposalId 0
+          , effects = effects
+          , status = Locked
+          , cosigners = [signer, signer2]
+          , thresholds = defaultProposalThresholds
+          , votes = proposalVotes
+          }
+      proposalInputDatum :: Datum
+      proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
+      proposalInput :: TxOut
+      proposalInput =
+        TxOut
+          { txOutAddress = proposalValidatorAddress
+          , txOutValue = pst
+          , txOutDatumHash = Just (toDatumHash proposalInputDatum)
+          }
+
+      ---
+
+      governorOutputDatum' :: GovernorDatum
+      governorOutputDatum' = governorInputDatum'
+      governorOutputDatum :: Datum
+      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
+      governorOutput :: TxOut
+      governorOutput =
+        governorInput
+          { txOutDatumHash = Just $ toDatumHash governorOutputDatum
+          , txOutValue = gst <> minAda
+          }
+
+      ---
+
+      proposalOutputDatum' :: ProposalDatum
+      proposalOutputDatum' = proposalInputDatum' {status = Finished}
+      proposalOutputDatum :: Datum
+      proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
+      proposalOutput :: TxOut
+      proposalOutput =
+        proposalInput
+          { txOutDatumHash = Just $ toDatumHash proposalOutputDatum
+          , txOutValue = pst <> minAda
+          }
+
+      --
+
+      mockEffectOutput :: TxOut
+      mockEffectOutput =
+        TxOut
+          { txOutAddress = mockEffectAddress
+          , txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum
+          , txOutValue = gat <> minAda
+          }
+
+      --
+
+      ownInputRef :: TxOutRef
+      ownInputRef = TxOutRef "4355a46b19d348dc2f57c046f8ef63d4538ebb936000f3c9ee954a27460dd865" 1
+   in ScriptContext
+        { scriptContextTxInfo =
+            TxInfo
+              { txInfoInputs =
+                  [ TxInInfo ownInputRef governorInput
+                  , TxInInfo
+                      (TxOutRef "11b2162f267614b803761032b6333040fc61478ae788c088614ee9487ab0c1b7" 1)
+                      proposalInput
+                  ]
+              , txInfoOutputs =
+                  [ governorOutput
+                  , proposalOutput
+                  , mockEffectOutput
+                  ]
+              , txInfoFee = Value.singleton "" "" 2
+              , txInfoMint = gat
+              , txInfoDCert = []
+              , txInfoWdrl = []
+              , txInfoValidRange = Interval.always
+              , txInfoSignatories = [signer, signer2]
+              , txInfoData =
+                  datumPair
+                    <$> [ governorInputDatum
+                        , governorOutputDatum
+                        , proposalInputDatum
+                        , proposalOutputDatum
+                        , mockEffectOutputDatum
+                        ]
+              , txInfoId = "ff755f613c1f7487dfbf231325c67f481f7a97e9faf4d8b09ad41176fd65cbe7"
+              }
+        , scriptContextPurpose = Spending ownInputRef
+        }
+
+{- | A valid script context for changing the state datum of the governor.
+
+    In this case, the following components will run:
+
+    * Governor validator
+    * Effect script
+
+    The effect script should carry an valid tagged authority token,
+      and said token will be burnt in the transaction. We use 'noOpValidator'
+      here as a mock effect, so no actual change is done to the governor state.
+    TODO: use 'mutateGovernorEffect' as the mock effect in the future.
+
+    The governor will ensure the new governor state is valid.
+-}
+mutateState :: ScriptContext
+mutateState =
+  let gst = Value.assetClassValue govAssetClass 1
+      gat = Value.assetClassValue atAssetClass 1
+      burntGAT = Value.assetClassValue atAssetClass (-1)
+
+      ---
+
+      -- TODO: Use the *real* effect, see https://github.com/Liqwid-Labs/agora/pull/62
+
+      mockEffect :: Validator
+      mockEffect = mkValidator $ noOpValidator ""
+      mockEffectHash :: ValidatorHash
+      mockEffectHash = validatorHash mockEffect
+      mockEffectAddress :: Address
+      mockEffectAddress = scriptHashAddress mockEffectHash
+      atTokenName :: TokenName
+      atTokenName = TokenName hash
+        where
+          ValidatorHash hash = mockEffectHash
+      atAssetClass :: AssetClass
+      atAssetClass = AssetClass (authorityTokenSymbol, atTokenName)
+
+      --
+
+      mockEffectInputDatum :: Datum
+      mockEffectInputDatum = unitDatum
+      mockEffectInput :: TxOut
+      mockEffectInput =
+        TxOut
+          { txOutAddress = mockEffectAddress
+          , txOutValue = gat -- Will be burnt
+          , txOutDatumHash = Just $ toDatumHash mockEffectInputDatum
+          }
+
+      --
+
+      mockEffectOutputDatum :: Datum
+      mockEffectOutputDatum = mockEffectInputDatum
+      mockEffectOutput :: TxOut
+      mockEffectOutput =
+        mockEffectInput
+          { txOutValue = minAda
+          , txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum
+          }
+
+      --
+
+      governorInputDatum' :: GovernorDatum
+      governorInputDatum' =
+        GovernorDatum
+          { proposalThresholds = defaultProposalThresholds
+          , nextProposalId = ProposalId 5
+          }
+      governorInputDatum :: Datum
+      governorInputDatum = Datum $ toBuiltinData governorInputDatum'
+      governorInput :: TxOut
+      governorInput =
+        TxOut
+          { txOutAddress = govValidatorAddress
+          , txOutValue = gst
+          , txOutDatumHash = Just $ toDatumHash governorInputDatum
+          }
+
+      --
+
+      governorOutputDatum' :: GovernorDatum
+      governorOutputDatum' = governorInputDatum'
+      governorOutputDatum :: Datum
+      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
+      governorOutput :: TxOut
+      governorOutput =
+        governorInput
+          { txOutDatumHash = Just $ toDatumHash governorOutputDatum
+          , txOutValue = gst <> minAda
+          }
+
+      --
+
+      ownInputRef :: TxOutRef
+      ownInputRef = TxOutRef "f867238a04597c99a0b9858746557d305025cca3b9f78ea14d5c88c4cfcf58ff" 1
+   in ScriptContext
+        { scriptContextTxInfo =
+            TxInfo
+              { txInfoInputs =
+                  [ TxInInfo ownInputRef governorInput
+                  , TxInInfo
+                      (TxOutRef "ecff06d7cf99089294569cc8b92609e44927278f9901730715d14634fbc10089" 1)
+                      mockEffectInput
+                  ]
+              , txInfoOutputs =
+                  [ governorOutput
+                  , mockEffectOutput
+                  ]
+              , txInfoFee = Value.singleton "" "" 2
+              , txInfoMint = burntGAT
+              , txInfoDCert = []
+              , txInfoWdrl = []
+              , txInfoValidRange = Interval.always
+              , txInfoSignatories = [signer]
+              , txInfoData =
+                  datumPair
+                    <$> [ governorInputDatum
+                        , governorOutputDatum
+                        , mockEffectInputDatum
+                        , mockEffectOutputDatum
+                        ]
+              , txInfoId = "9a12a605086a9f866731869a42d0558036fc739c74fea3849aa41562c015aaf9"
+              }
+        , scriptContextPurpose = Spending ownInputRef
+        }

agora-sample/Sample/Proposal.hs

@@ -60,8 +60,8 @@ proposalCreation =
   let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
       effects =
         AssocMap.fromList
-          [ (ResultTag 0, [])
+          [ (ResultTag 0, AssocMap.empty)
-          , (ResultTag 1, [])
+          , (ResultTag 1, AssocMap.empty)
           ]
       proposalDatum :: Datum
       proposalDatum =
@@ -155,8 +155,8 @@ cosignProposal newSigners =
   let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
       effects =
         AssocMap.fromList
-          [ (ResultTag 0, [])
+          [ (ResultTag 0, AssocMap.empty)
-          , (ResultTag 1, [])
+          , (ResultTag 1, AssocMap.empty)
           ]
       proposalBefore :: ProposalDatum
       proposalBefore =
@@ -193,7 +193,7 @@ cosignProposal newSigners =
                       mconcat
                         [ Value.singleton "" "" 10_000_000
                         , Value.assetClassValue (untag stake.gtClassRef) 50_000_000
-                        , Value.singleton stakeSymbol "" 1
+                        , Value.assetClassValue stakeAssetClass 1
                         ]
                   , txOutDatumHash = Just (toDatumHash stakeDatum)
                   }
@@ -214,7 +214,7 @@ cosignProposal newSigners =
                     mconcat
                       [ Value.singleton "" "" 10_000_000
                       , Value.assetClassValue (untag stake.gtClassRef) 50_000_000
-                      , Value.singleton stakeSymbol "" 1
+                      , Value.assetClassValue stakeAssetClass 1
                       ]
                 , txOutDatumHash = Just (toDatumHash stakeDatum)
                 }

agora-sample/Sample/Shared.hs

@@ -15,15 +15,20 @@ module Sample.Shared (
 
   -- ** Stake
   stake,
-  stakeSymbol,
+  stakeAssetClass,
   stakeValidatorHash,
   stakeAddress,
+  stakeSymbol,
 
   -- ** Governor
   governor,
   govPolicy,
   govValidator,
   govSymbol,
+  govAssetClass,
+  govValidatorAddress,
+  govValidatorHash,
+  gstUTXORef,
 
   -- ** Proposal
   defaultProposalThresholds,
@@ -32,6 +37,10 @@ module Sample.Shared (
   proposalValidatorHash,
   proposalValidatorAddress,
 
+  -- ** Authority
+  authorityToken,
+  authorityTokenSymbol,
+
   -- ** Treasury
   treasuryOut,
   gatTn,
@@ -41,22 +50,31 @@ module Sample.Shared (
   wrongEffHash,
 ) where
 
+import Agora.AuthorityToken
 import Agora.Effect.NoOp (noOpValidator)
 import Agora.Governor (
   Governor (Governor),
+ )
+import Agora.Governor.Scripts (
+  authorityTokenFromGovernor,
+  authorityTokenSymbolFromGovernor,
   governorPolicy,
+  governorSTAssetClassFromGovernor,
   governorValidator,
+  governorValidatorHash,
+  proposalFromGovernor,
+  proposalSTSymbolFromGovernor,
+  proposalValidatorHashFromGovernor,
+  stakeFromGovernor,
+  stakeSTAssetClassFromGovernor,
+  stakeSTSymbolFromGovernor,
+  stakeValidatorHashFromGovernor,
  )
 import Agora.Proposal (
   Proposal (..),
   ProposalThresholds (..),
  )
-import Agora.Proposal.Scripts (
-  proposalPolicy,
-  proposalValidator,
- )
 import Agora.Stake (Stake (..))
-import Agora.Stake.Scripts (stakePolicy, stakeValidator)
 import Agora.Treasury (treasuryValidator)
 import Agora.Utils (validatorHashToTokenName)
 import Plutarch.Api.V1 (
@@ -73,38 +91,46 @@ import Plutus.V1.Ledger.Api (
   CurrencySymbol,
   MintingPolicy (..),
   PubKeyHash,
+  TxOutRef (TxOutRef),
+  Value,
  )
 import Plutus.V1.Ledger.Contexts (
   TxOut (..),
  )
 import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash (..))
-import Plutus.V1.Ledger.Value (TokenName, Value)
+import Plutus.V1.Ledger.Value (AssetClass, TokenName)
 import Plutus.V1.Ledger.Value qualified as Value
 
 --------------------------------------------------------------------------------
 
 stake :: Stake
-stake =
+stake = stakeFromGovernor governor
-  Stake
-    { gtClassRef =
-        Tagged $
-          Value.assetClass
-            "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24"
-            "LQ"
-    , proposalSTClass = Value.assetClass proposalPolicySymbol ""
-    }
 
 stakeSymbol :: CurrencySymbol
-stakeSymbol = mintingPolicySymbol $ mkMintingPolicy $ stakePolicy stake.gtClassRef
+stakeSymbol = stakeSTSymbolFromGovernor governor
+
+stakeAssetClass :: AssetClass
+stakeAssetClass = stakeSTAssetClassFromGovernor governor
 
 stakeValidatorHash :: ValidatorHash
-stakeValidatorHash = validatorHash $ mkValidator (stakeValidator stake)
+stakeValidatorHash = stakeValidatorHashFromGovernor governor
 
 stakeAddress :: Address
 stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing
 
+gstUTXORef :: TxOutRef
+gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0
+
 governor :: Governor
-governor = Governor
+governor = Governor oref gt mc
+  where
+    oref = gstUTXORef
+    gt =
+      Tagged $
+        Value.assetClass
+          "da8c30857834c6ae7203935b89278c532b3995245295456f993e1d24"
+          "LQ"
+    mc = 6
 
 govPolicy :: MintingPolicy
 govPolicy = mkMintingPolicy (governorPolicy governor)
@@ -115,16 +141,20 @@ govValidator = mkValidator (governorValidator governor)
 govSymbol :: CurrencySymbol
 govSymbol = mintingPolicySymbol govPolicy
 
+govAssetClass :: AssetClass
+govAssetClass = governorSTAssetClassFromGovernor governor
+
+govValidatorHash :: ValidatorHash
+govValidatorHash = governorValidatorHash governor
+
+govValidatorAddress :: Address
+govValidatorAddress = scriptHashAddress govValidatorHash
+
 proposal :: Proposal
-proposal =
+proposal = proposalFromGovernor governor
-  Proposal
-    { governorSTAssetClass = Value.assetClass govSymbol ""
-    , stakeSTAssetClass = Value.assetClass stakeSymbol ""
-    , maximumCosigners = 6
-    }
 
 proposalPolicySymbol :: CurrencySymbol
-proposalPolicySymbol = mintingPolicySymbol $ mkMintingPolicy (proposalPolicy proposal)
+proposalPolicySymbol = proposalSTSymbolFromGovernor governor
 
 -- | A sample 'PubKeyHash'.
 signer :: PubKeyHash
@@ -135,7 +165,7 @@ signer2 :: PubKeyHash
 signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192"
 
 proposalValidatorHash :: ValidatorHash
-proposalValidatorHash = validatorHash (mkValidator $ proposalValidator proposal)
+proposalValidatorHash = proposalValidatorHashFromGovernor governor
 
 proposalValidatorAddress :: Address
 proposalValidatorAddress = scriptHashAddress proposalValidatorHash
@@ -148,6 +178,12 @@ defaultProposalThresholds =
     , startVoting = Tagged 10
     }
 
+authorityToken :: AuthorityToken
+authorityToken = authorityTokenFromGovernor governor
+
+authorityTokenSymbol :: CurrencySymbol
+authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
+
 ------------------------------------------------------------------
 
 treasuryOut :: TxOut

agora-sample/Sample/Stake.hs

@@ -7,6 +7,7 @@ This module tests primarily the happy path for Stake creation
 -}
 module Sample.Stake (
   stake,
+  stakeAssetClass,
   stakeSymbol,
   validatorHashTN,
   signer,
@@ -60,7 +61,7 @@ validatorHashTN = let ValidatorHash vh = validatorHash (mkValidator $ stakeValid
 -- | This script context should be a valid transaction.
 stakeCreation :: ScriptContext
 stakeCreation =
-  let st = Value.singleton stakeSymbol validatorHashTN 1 -- Stake ST
+  let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
       datum :: Datum
       datum = Datum (toBuiltinData $ StakeDatum 424242424242 signer [])
    in ScriptContext
@@ -120,7 +121,7 @@ data DepositWithdrawExample = DepositWithdrawExample
 -- | Create a ScriptContext that deposits or withdraws, given the config for it.
 stakeDepositWithdraw :: DepositWithdrawExample -> ScriptContext
 stakeDepositWithdraw config =
-  let st = Value.singleton stakeSymbol validatorHashTN 1 -- Stake ST
+  let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
       stakeBefore :: StakeDatum
       stakeBefore = StakeDatum config.startAmount signer []
 

agora-test/Spec.hs

@@ -8,6 +8,7 @@ import Test.Tasty (defaultMain, testGroup)
 
 import Spec.AuthorityToken qualified as AuthorityToken
 import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal
+import Spec.Governor qualified as Governor
 import Spec.Model.MultiSig qualified as MultiSig
 import Spec.Proposal qualified as Proposal
 import Spec.Stake qualified as Stake
@@ -42,7 +43,10 @@ main =
           "AuthorityToken tests"
           AuthorityToken.tests
       , testGroup
-          "Utility functions tests"
+          "Governor tests"
+          Governor.tests
+      , testGroup
+          "Utility tests"
           Utils.tests
       , testGroup
           "Multisig tests"

agora-test/Spec/Governor.hs

@@ -0,0 +1,57 @@
+{- |
+Module     : Spec.Governor
+Maintainer : connor@mlabs.city
+Description: Tests for Agora governor.
+
+Thie module exports `tests`, a list of `TestTree`s, which ensure
+that Agora's governor component workds as intended.
+
+Tests should pass when the validator or policy is given one of the
+valid script contexts, which are defined in 'Agora.Sample.Governor'.
+
+TODO: Add negative test cases, see [#76](https://github.com/Liqwid-Labs/agora/issues/76).
+-}
+module Spec.Governor (tests) where
+
+import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..))
+import Agora.Governor.Scripts (governorPolicy, governorValidator)
+import Agora.Proposal (ProposalId (..))
+import Sample.Governor (createProposal, mintGATs, mintGST, mutateState)
+import Sample.Shared qualified as Shared
+import Test.Tasty (TestTree, testGroup)
+import Test.Util (policySucceedsWith, validatorSucceedsWith)
+
+--------------------------------------------------------------------------------
+
+tests :: [TestTree]
+tests =
+  [ testGroup
+      "policy"
+      [ policySucceedsWith
+          "GST minting"
+          (governorPolicy Shared.governor)
+          ()
+          mintGST
+      ]
+  , testGroup
+      "validator"
+      [ validatorSucceedsWith
+          "proposal creation"
+          (governorValidator Shared.governor)
+          (GovernorDatum Shared.defaultProposalThresholds (ProposalId 0))
+          CreateProposal
+          createProposal
+      , validatorSucceedsWith
+          "GATs minting"
+          (governorValidator Shared.governor)
+          (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5))
+          MintGATs
+          mintGATs
+      , validatorSucceedsWith
+          "mutate governor state"
+          (governorValidator Shared.governor)
+          (GovernorDatum Shared.defaultProposalThresholds (ProposalId 5))
+          MutateGovernor
+          mutateState
+      ]
+  ]

agora-test/Spec/Proposal.hs

@@ -12,6 +12,7 @@ module Spec.Proposal (tests) where
 --------------------------------------------------------------------------------
 
 import Agora.Proposal (
+  Proposal (..),
   ProposalDatum (ProposalDatum),
   ProposalId (ProposalId),
   ProposalRedeemer (Cosign),
@@ -49,7 +50,7 @@ tests =
       "policy"
       [ policySucceedsWith
           "proposalCreation"
-          (proposalPolicy Shared.proposal)
+          (proposalPolicy Shared.proposal.governorSTAssetClass)
           ()
           Proposal.proposalCreation
       ]
@@ -64,8 +65,8 @@ tests =
                   { proposalId = ProposalId 0
                   , effects =
                       AssocMap.fromList
-                        [ (ResultTag 0, [])
+                        [ (ResultTag 0, AssocMap.empty)
-                        , (ResultTag 1, [])
+                        , (ResultTag 1, AssocMap.empty)
                         ]
                   , status = Draft
                   , cosigners = [signer]
@@ -73,8 +74,8 @@ tests =
                   , votes =
                       emptyVotesFor $
                         AssocMap.fromList
-                          [ (ResultTag 0, [])
+                          [ (ResultTag 0, AssocMap.empty)
-                          , (ResultTag 1, [])
+                          , (ResultTag 1, AssocMap.empty)
                           ]
                   }
               )

agora-test/Spec/Utils.hs

@@ -7,7 +7,138 @@ Tests for utility functions in 'Agora.Utils'.
 -}
 module Spec.Utils (tests) where
 
+--------------------------------------------------------------------------------
+
+import Agora.Utils (phalve, pisUniq, pmergeBy, pmsort, pnubSort)
+
+--------------------------------------------------------------------------------
+
+import Data.List (nub, sort)
+import Data.Set as S
+
+--------------------------------------------------------------------------------
+
 import Test.Tasty (TestTree)
+import Test.Tasty.QuickCheck (testProperty)
+
+--------------------------------------------------------------------------------
 
 tests :: [TestTree]
-tests = []
+tests =
+  [ testProperty "'pmsort' sorts a list properly" prop_msortCorrect
+  , testProperty "'pmerge' merges two sorted lists into one sorted list" prop_mergeCorrect
+  , testProperty "'phalve' splits a list in half as expected" prop_halveCorrect
+  , testProperty "'pnubSort' sorts a list and remove duplicate elements" prop_nubSortProperly
+  , testProperty "'pisUniq' can tell whether all elements in a list are unique" prop_uniqueList
+  ]
+
+--------------------------------------------------------------------------------
+
+-- | Yield true if 'Agora.Utils.pmsort' sorts a given list correctly.
+prop_msortCorrect :: [Integer] -> Bool
+prop_msortCorrect l = sorted == expected
+  where
+    -- Expected sorted list, using 'Data.List.sort'.
+    expected :: [Integer]
+    expected = sort l
+
+    --
+
+    psorted :: Term _ (PBuiltinList PInteger)
+    psorted = pmsort # pconstant l
+
+    sorted :: [Integer]
+    sorted = plift psorted
+
+-- | Yield true if 'Agora.Utils.pmerge' merges two list into a ordered list correctly.
+prop_mergeCorrect :: [Integer] -> [Integer] -> Bool
+prop_mergeCorrect a b = merged == expected
+  where
+    -- Sorted list a and b
+    sa = sort a
+    sb = sort b
+
+    -- Merge two lists which are assumed to be ordered.
+    merge :: [Integer] -> [Integer] -> [Integer]
+    merge xs [] = xs
+    merge [] ys = ys
+    merge sx@(x : xs) sy@(y : ys)
+      | x <= y = x : merge xs sy
+      | otherwise = y : merge sx ys
+
+    expected :: [Integer]
+    expected = merge sa sb
+
+    --
+
+    pmerged :: Term _ (PBuiltinList PInteger)
+    pmerged = pmergeBy # plam (#<) # pconstant sa # pconstant sb
+
+    merged :: [Integer]
+    merged = plift pmerged
+
+{- | Yield true if Plutarch level 'Agora.Utils.phalve' splits a given list
+   as its Haskell level counterpart does.
+-}
+prop_halveCorrect :: [Integer] -> Bool
+prop_halveCorrect l = halved == expected
+  where
+    -- Halve a list.
+    halve :: [Integer] -> ([Integer], [Integer])
+    halve xs = go xs xs
+      where
+        go xs [] = ([], xs)
+        go (x : xs) [_] = ([x], xs)
+        go (x : xs) (_ : _ : ys) =
+          let (first, last) =
+                go xs ys
+           in (x : first, last)
+        go [] _ = ([], [])
+
+    expected :: ([Integer], [Integer])
+    expected = halve l
+
+    --
+
+    phalved :: Term _ (PPair (PBuiltinList PInteger) (PBuiltinList PInteger))
+    phalved = phalve # pconstant l
+
+    halved :: ([Integer], [Integer])
+    halved =
+      let f = plift $ pmatch phalved $ \(PPair x _) -> x
+          s = plift $ pmatch phalved $ \(PPair _ x) -> x
+       in (f, s)
+
+{- | Yield true if 'Agora.Utils.pnubSort' sorts and removes
+   duplicate elements from a given list.
+-}
+prop_nubSortProperly :: [Integer] -> Bool
+prop_nubSortProperly l = nubbed == expected
+  where
+    -- Sort and list and then nub it.
+    expected :: [Integer]
+    expected = nub $ sort l
+
+    --
+
+    pnubbed :: Term _ (PBuiltinList PInteger)
+    pnubbed = pnubSort # pconstant l
+
+    nubbed :: [Integer]
+    nubbed = plift pnubbed
+
+{- | Yield true if 'Agora.Utils.isUnique' can correctly determine
+   whether a given list only contains unique elements or not.
+-}
+prop_uniqueList :: [Integer] -> Bool
+prop_uniqueList l = isUnique == expected
+  where
+    -- Convert input list to a set.
+    -- If the set's size equals to list's size,
+    --   the list only contains unique elements.
+    expected :: Bool
+    expected = S.size (S.fromList l) == length l
+
+    --
+
+    isUnique = plift $ pisUniq # pconstant l

agora.cabal

@@ -119,6 +119,7 @@ common test-deps
     , tasty
     , tasty-hedgehog
     , tasty-hunit
+    , tasty-quickcheck
 
 common exe-opts
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -O0
@@ -131,6 +132,7 @@ library
     Agora.Effect.NoOp
     Agora.Effect.TreasuryWithdrawal
     Agora.Governor
+    Agora.Governor.Scripts
     Agora.MultiSig
     Agora.Proposal
     Agora.Proposal.Scripts
@@ -162,12 +164,10 @@ library agora-testlib
 
 library agora-sample
   import:          lang, deps, test-deps
-  build-depends:
+  build-depends:   agora-testlib
-    , agora
-    , agora-testlib
-
   exposed-modules:
     Sample.Effect.TreasuryWithdrawal
+    Sample.Governor
     Sample.Proposal
     Sample.Shared
     Sample.Stake
@@ -183,6 +183,7 @@ test-suite agora-test
   other-modules:
     Spec.AuthorityToken
     Spec.Effect.TreasuryWithdrawal
+    Spec.Governor
     Spec.Model.MultiSig
     Spec.Proposal
     Spec.Stake
@@ -190,7 +191,6 @@ test-suite agora-test
     Spec.Utils
 
   build-depends:
-    , agora
     , agora-sample
     , agora-testlib
 

agora/Agora/AuthorityToken.hs

@@ -17,6 +17,7 @@ import Plutarch.Api.V1 (
   PAddress (..),
   PCredential (..),
   PCurrencySymbol (..),
+  PMintingPolicy,
   PScriptContext (..),
   PScriptPurpose (..),
   PTxInInfo (PTxInInfo),
@@ -127,9 +128,7 @@ singleAuthorityTokenBurned gatCs txInfo mint = unTermCont $ do
       ]
 
 -- | Policy given 'AuthorityToken' params.
-authorityTokenPolicy ::
+authorityTokenPolicy :: AuthorityToken -> ClosedTerm PMintingPolicy
-  AuthorityToken ->
-  Term s (PData :--> PScriptContext :--> PUnit)
 authorityTokenPolicy params =
   plam $ \_redeemer ctx' ->
     pmatch ctx' $ \(PScriptContext ctx') -> unTermCont $ do
@@ -156,7 +155,6 @@ authorityTokenPolicy params =
                   authorityTokensValidIn
                     # ownSymbol
                     # txOut
-
+              pure $ popaque $ pconstant ()
-              pure $ pconstant ()
           )
-          (pconstant ())
+          (popaque $ pconstant ())

agora/Agora/Governor.hs

@@ -2,7 +2,7 @@
 
 {- |
 Module     : Agora.Governor
-Maintainer : emi@haskell.fyi
+Maintainer : connor@mlabs.city
 Description: Governor entity scripts acting as authority of entire system.
 
 Governor entity scripts acting as authority of entire system.
@@ -14,17 +14,52 @@ module Agora.Governor (
   Governor (..),
 
   -- * Plutarch-land
+  PGovernorDatum (..),
+  PGovernorRedeemer (..),
 
-  -- * Scripts
+  -- * Utilities
-  governorPolicy,
+  pgetNextProposalId,
-  governorValidator,
+  getNextProposalId,
+  governorDatumValid,
 ) where
 
-import Agora.Proposal (ProposalId, ProposalThresholds)
+--------------------------------------------------------------------------------
+
+import Control.Applicative (Const)
 import GHC.Generics qualified as GHC
-import Plutarch.Api.V1 (PMintingPolicy, PValidator)
+import Generics.SOP (Generic, I (I))
+
+--------------------------------------------------------------------------------
+
+import Agora.Proposal (
+  PProposalId (..),
+  PProposalThresholds (..),
+  ProposalId (ProposalId),
+  ProposalThresholds,
+ )
+import Agora.SafeMoney (GTTag)
+import Agora.Utils (tclet)
+
+--------------------------------------------------------------------------------
+
+import Plutarch.DataRepr (
+  DerivePConstantViaData (..),
+  PDataFields,
+  PIsDataReprInstances (PIsDataReprInstances),
+ )
+import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
+import Plutarch.SafeMoney (Tagged (..), puntag)
+import Plutarch.TryFrom (PTryFrom (..))
+import Plutarch.Unsafe (punsafeCoerce)
+
+--------------------------------------------------------------------------------
+
+import Plutus.V1.Ledger.Api (TxOutRef)
+import Plutus.V1.Ledger.Value (AssetClass (..))
 import PlutusTx qualified
 
+--------------------------------------------------------------------------------
+
 -- | Datum for the Governor script.
 data GovernorDatum = GovernorDatum
   { proposalThresholds :: ProposalThresholds
@@ -32,7 +67,7 @@ data GovernorDatum = GovernorDatum
   , nextProposalId :: ProposalId
   -- ^ What tag the next proposal will get upon creating.
   }
-  deriving stock (GHC.Generic)
+  deriving stock (Show, GHC.Generic)
 
 PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)]
 
@@ -41,6 +76,8 @@ PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)]
 
      1. The gating of Proposal creation.
      2. The gating of minting authority tokens.
+
+     Parameters of the governor can also be mutated by an effect.
 -}
 data GovernorRedeemer
   = -- | Checks that a proposal was created lawfully, and allows it.
@@ -48,23 +85,106 @@ data GovernorRedeemer
   | -- | Checks that a SINGLE proposal finished correctly,
     --   and allows minting GATs for each effect script.
     MintGATs
-  deriving stock (GHC.Generic)
+  | -- | Allows effects to mutate the parameters.
+    MutateGovernor
+  deriving stock (Show, GHC.Generic)
 
-PlutusTx.makeIsDataIndexed ''GovernorRedeemer [('CreateProposal, 0), ('MintGATs, 1)]
+PlutusTx.makeIsDataIndexed
+  ''GovernorRedeemer
+  [ ('CreateProposal, 0)
+  , ('MintGATs, 1)
+  , ('MutateGovernor, 2)
+  ]
 
 -- | Parameters for creating Governor scripts.
-data Governor
+data Governor = Governor
-  = Governor
+  { gstOutRef :: TxOutRef
+  -- ^ Referenced utxo will be spent to mint the GST.
+  , gtClassRef :: Tagged GTTag AssetClass
+  -- ^ Governance token of the system.
+  , maximumCosigners :: Integer
+  -- ^ Arbitrary limit for maximum amount of cosigners on a proposal.
+  -- See `Agora.Proposal.proposalDatumValid`.
+  }
   deriving stock (GHC.Generic)
 
 --------------------------------------------------------------------------------
 
--- | Policy for Governors.
+-- | Plutarch-level datum for the Governor script.
-governorPolicy :: Governor -> ClosedTerm PMintingPolicy
+newtype PGovernorDatum (s :: S) = PGovernorDatum
-governorPolicy _ =
+  { getGovernorDatum ::
-  plam $ \_redeemer _ctx' -> popaque (pconstant ())
+    Term
+      s
+      ( PDataRecord
+          '[ "proposalThresholds" ':= PProposalThresholds
+           , "nextProposalId" ':= PProposalId
+           ]
+      )
+  }
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic)
+  deriving anyclass (PIsDataRepr)
+  deriving
+    (PlutusType, PIsData, PDataFields, PEq)
+    via PIsDataReprInstances PGovernorDatum
 
--- | Validator for Governors.
+instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum
-governorValidator :: Governor -> ClosedTerm PValidator
+deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstantDecl GovernorDatum)
-governorValidator _ =
+
-  plam $ \_datum _redeemer _ctx' -> popaque (pconstant ())
+-- FIXME: derive this via 'PIsDataReprInstances'
+-- Blocked by: PProposalThresholds
+instance PTryFrom PData (PAsData PGovernorDatum) where
+  type PTryFromExcess PData (PAsData PGovernorDatum) = Const ()
+
+  ptryFrom' d k = k (punsafeCoerce d, ())
+
+-- | Plutarch-level version of 'GovernorRedeemer'.
+data PGovernorRedeemer (s :: S)
+  = PCreateProposal (Term s (PDataRecord '[]))
+  | PMintGATs (Term s (PDataRecord '[]))
+  | PMutateGovernor (Term s (PDataRecord '[]))
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic)
+  deriving anyclass (PIsDataRepr)
+  deriving
+    (PlutusType, PIsData)
+    via PIsDataReprInstances PGovernorRedeemer
+
+instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer
+deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstantDecl GovernorRedeemer)
+
+deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom PData (PAsData PGovernorRedeemer)
+
+--------------------------------------------------------------------------------
+
+-- | Plutrach version of 'getNextProposalId'.
+pgetNextProposalId :: Term s (PProposalId :--> PProposalId)
+pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1
+
+-- | Get next proposal id.
+getNextProposalId :: ProposalId -> ProposalId
+getNextProposalId (ProposalId pid) = ProposalId $ pid + 1
+
+--------------------------------------------------------------------------------
+
+governorDatumValid :: Term s (PGovernorDatum :--> PBool)
+governorDatumValid = phoistAcyclic $
+  plam $ \datum -> unTermCont $ do
+    thresholds <-
+      tcont $
+        pletFields @'["execute", "draft", "vote"] $
+          pfield @"proposalThresholds" # datum
+
+    execute <- tclet $ puntag thresholds.execute
+    draft <- tclet $ puntag thresholds.draft
+    vote <- tclet $ puntag thresholds.vote
+
+    pure $
+      foldr1
+        (#&&)
+        [ ptraceIfFalse "Execute threshold is less than or equal to" $ 0 #<= execute
+        , ptraceIfFalse "Draft threshold is less than or equal to " $ 0 #<= draft
+        , ptraceIfFalse "Vote threshold is less than or equal to " $ 0 #<= vote
+        , ptraceIfFalse "Draft threshold is less than vote threshold" $ draft #<= vote
+        , ptraceIfFalse "Execute threshold is less than vote threshold" $ vote #< execute
+        ]

agora/Agora/Governor/Scripts.hs

@@ -0,0 +1,822 @@
+{- |
+Module     : Agora.Governor.Scripts
+Maintainer : connor@mlabs.city
+Description: Plutus scripts for Governors.
+
+Plutus scripts for Governors.
+-}
+module Agora.Governor.Scripts (
+  -- * GST
+  -- $gst
+
+  -- * Scripts
+  governorPolicy,
+  governorValidator,
+
+  -- * Bridges
+  governorSTSymbolFromGovernor,
+  governorSTAssetClassFromGovernor,
+  proposalSTAssetClassFromGovernor,
+  stakeSTSymbolFromGovernor,
+  stakeFromGovernor,
+  stakeValidatorHashFromGovernor,
+  proposalFromGovernor,
+  proposalValidatorHashFromGovernor,
+  proposalSTSymbolFromGovernor,
+  stakeSTAssetClassFromGovernor,
+  governorValidatorHash,
+  authorityTokenFromGovernor,
+  authorityTokenSymbolFromGovernor,
+) where
+
+--------------------------------------------------------------------------------
+
+import Agora.AuthorityToken (
+  AuthorityToken (..),
+  authorityTokenPolicy,
+  authorityTokensValidIn,
+  singleAuthorityTokenBurned,
+ )
+import Agora.Governor (
+  Governor (gstOutRef, gtClassRef, maximumCosigners),
+  PGovernorDatum (PGovernorDatum),
+  PGovernorRedeemer (PCreateProposal, PMintGATs, PMutateGovernor),
+  governorDatumValid,
+  pgetNextProposalId,
+ )
+import Agora.Proposal (
+  PProposalDatum (..),
+  PProposalId (..),
+  PProposalStatus (PFinished),
+  PResultTag,
+  Proposal (..),
+  ProposalStatus (Draft, Locked),
+  proposalDatumValid,
+ )
+import Agora.Proposal.Scripts (
+  proposalPolicy,
+  proposalValidator,
+ )
+import Agora.Record
+import Agora.SafeMoney (GTTag)
+import Agora.Stake (
+  PProposalLock (..),
+  PStakeDatum (..),
+  Stake (..),
+ )
+import Agora.Stake.Scripts (
+  stakePolicy,
+  stakeValidator,
+ )
+import Agora.Utils (
+  findOutputsToAddress,
+  hasOnlyOneTokenOfCurrencySymbol,
+  mustBePDJust,
+  mustBePJust,
+  mustFindDatum',
+  pfindTxInByTxOutRef,
+  pisDJust,
+  pisJust,
+  pisUTXOSpent,
+  psymbolValueOf,
+  ptryFindDatum,
+  ptxSignedBy,
+  pvalueSpent,
+  scriptHashFromAddress,
+  tcassert,
+  tclet,
+  tcmatch,
+  validatorHashToAddress,
+  validatorHashToTokenName,
+ )
+
+--------------------------------------------------------------------------------
+
+import Plutarch.Api.V1 (
+  PAddress,
+  PCurrencySymbol,
+  PDatumHash,
+  PMap,
+  PMintingPolicy,
+  PScriptPurpose (PMinting, PSpending),
+  PTxOut,
+  PValidator,
+  PValidatorHash,
+  PValue,
+  mintingPolicySymbol,
+  mkMintingPolicy,
+  mkValidator,
+  validatorHash,
+ )
+import Plutarch.Api.V1.Extra (
+  passetClass,
+  passetClassValueOf,
+ )
+import Plutarch.Map.Extra (
+  pkeys,
+  plookup,
+  plookup',
+ )
+import Plutarch.SafeMoney (
+  PDiscrete,
+  puntag,
+  pvalueDiscrete',
+ )
+import Plutarch.TryFrom (ptryFrom)
+
+--------------------------------------------------------------------------------
+
+import Plutus.V1.Ledger.Api (
+  CurrencySymbol (..),
+  MintingPolicy,
+ )
+import Plutus.V1.Ledger.Scripts (ValidatorHash (..))
+import Plutus.V1.Ledger.Value (
+  AssetClass (..),
+ )
+
+--------------------------------------------------------------------------------
+
+{- $gst
+   Governance state token, aka. GST, is an NFT that identifies a UTXO that
+    carries the state datum of the Governance script.
+
+   This token is minted by a one-shot monetary policy 'governorPolicy',
+    meaning that the token has guaranteed uniqueness.
+
+   The 'governorValidator' ensures that exactly one GST stays
+    at the address of itself forever.
+-}
+
+--------------------------------------------------------------------------------
+
+{- | Policy for minting GSTs.
+
+   This policy perform the following checks:
+
+    - The UTXO referenced in the parameter is spent in the transaction.
+    - Exactly one GST is minted.
+    - Ensure the token name is empty.
+    - Said UTXO should carry a valid 'Agora.Governor.GovernorDatum'.
+
+  NOTE: It's user's responsibility to make sure the token is sent to the corresponding governor validator.
+        We /can't/ really check this in the policy, otherwise we create a cyclic reference issue.
+-}
+governorPolicy :: Governor -> ClosedTerm PMintingPolicy
+governorPolicy gov =
+  plam $ \_ ctx' -> unTermCont $ do
+    let oref = pconstant gov.gstOutRef
+
+    PMinting ((pfield @"_0" #) -> ownSymbol) <- tcmatch (pfromData $ pfield @"purpose" # ctx')
+    let ownAssetClass = passetClass # ownSymbol # pconstant ""
+        txInfo = pfromData $ pfield @"txInfo" # ctx'
+
+    txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums"] txInfo
+
+    tcassert "Referenced utxo should be spent" $
+      pisUTXOSpent # oref # txInfoF.inputs
+
+    tcassert "Exactly one token should be minted" $
+      psymbolValueOf # ownSymbol # txInfoF.mint #== 1
+        #&& passetClassValueOf # txInfoF.mint # ownAssetClass #== 1
+
+    govOutput <-
+      tclet $
+        mustBePJust
+          # "Governor output not found"
+            #$ pfind
+          # plam
+            ( \((pfield @"value" #) . pfromData -> value) ->
+                psymbolValueOf # ownSymbol # value #== 1
+            )
+          # pfromData txInfoF.outputs
+
+    let datumHash = pfield @"datumHash" # pfromData govOutput
+        datum = mustFindDatum' @PGovernorDatum # datumHash # txInfoF.datums
+
+    pure $ popaque $ governorDatumValid # datum
+
+{- | Validator for Governors.
+
+  == Common checks
+
+  The validator always ensures:
+
+    - The UTXO which holds the GST must be spent.
+    - The GST always stays at the validator's address.
+    - The new state UTXO has a valid datum of type 'GovernorDatum'.
+
+  == Creating a Proposal
+
+  When the redeemer is 'CreateProposal', the script will check:
+
+  - For governor's state datum:
+
+      * 'nextProposalId' is advanced.
+      * Nothing is changed other that that.
+
+  - Exactly one stake (the "input stake") must be provided in the input:
+      * At least 'Agora.Stake.stackedAmount' of GT must be spent in the transaction.
+      * The transaction must be signed by the stake owner.
+
+  - Exactly one new proposal state token is minted.
+  - An UTXO which holds the newly minted proposal state token is sent to the proposal validator.
+    This UTXO must have a valid datum of type 'Agora.Proposal.ProposalDatum', the datum must:
+
+      * Copy its id and thresholds from the governor's state.
+      * Have status set to 'Proposal.Draft'.
+      * Have zero votes.
+      * Have exactly one cosigner - the stake owner
+
+  - An UTXO which holds the stake state token is sent back to the stake validator.
+    This UTXO must have a valid datum of type 'Agora.Stake.StakeDatum':
+
+      * The 'Agora.Stake.stakedAmount' and 'Agora.Stake.owner' should not be changed,
+         comparing to the input stake.
+      * The new proposal locks must be appended to the 'Agora.Stake.lockedBy'.
+
+  == Minting GATs
+
+  When the redeemer is 'MintGATs', the script will check:
+
+  - Governor's state is not changed.
+  - Exactly only one proposal is in the inputs. Let's call this the /input proposal/.
+  - The proposal is in the 'Proposal.Executable' state.
+
+  NOTE: The input proposal is found by looking for the UTXO with a proposal state token in the inputs.
+
+  === Effect Group Selection
+
+  Currently a proposal can have two or more than two options to vote on,
+    meaning that it can contains two or more effect groups,
+    according to [#39](https://github.com/Liqwid-Labs/agora/issues/39).
+
+  Either way, the shapes of 'Proposal.votes' and 'Proposal.effects' should be the same.
+    This is checked by 'Proposal.proposalDatumValid'.
+
+  The script will look at the the 'Proposal.votes' to determine which group has the highest votes,
+    said group shoud be executed.
+
+  During the process, minimum votes requirement will also be enforced.
+
+  Next, the script will:
+
+  - Ensure that for every effect in the said effect group,
+    exactly one valid GAT is minted and sent to the effect.
+  - The amount of GAT minted in the transaction should be equal to the number of effects.
+  - A new UTXO is sent to the proposal validator, this UTXO should:
+
+      * Include the one proposal state token.
+      * Have a valid datum of type 'Proposal.ProposalDatum'.
+        This datum should be as same as the one of the input proposal,
+        except its status should be 'Proposal.Finished'.
+
+  == Changing the State
+
+  Redeemer 'MutateGovernor' allows the state datum to be changed by an external effect.
+
+  In this case, the script will check
+
+  - Exactly one GAT is burnt in the transaction.
+  - Said GAT is tagged by the effect.
+-}
+governorValidator :: Governor -> ClosedTerm PValidator
+governorValidator gov =
+  plam $ \datum' redeemer' ctx' -> unTermCont $ do
+    (pfromData -> redeemer, _) <- tcont $ ptryFrom redeemer'
+    ctxF <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
+
+    txInfo' <- tclet $ pfromData $ ctxF.txInfo
+    txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo'
+
+    PSpending (pfromData . (pfield @"_0" #) -> ownInputRef) <- tcmatch $ pfromData ctxF.purpose
+
+    ((pfield @"resolved" #) -> ownInput) <-
+      tclet $
+        mustBePJust # "Own input not found"
+          #$ pfindTxInByTxOutRef # ownInputRef # txInfoF.inputs
+    ownInputF <- tcont $ pletFields @'["address", "value"] ownInput
+    let ownAddress = pfromData $ ownInputF.address
+
+    (pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- tcont $ ptryFrom datum'
+    oldGovernorDatumF <- tcont $ pletFields @'["proposalThresholds", "nextProposalId"] oldGovernorDatum
+
+    -- Check that GST will be returned to the governor.
+    let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value
+    tcassert "Own input should have exactly one state token" $
+      ownInputGSTAmount #== 1
+
+    ownOutputs <- tclet $ findOutputsToAddress # txInfoF.outputs # ownAddress
+    tcassert "Exactly one utxo should be sent to the governor" $
+      plength # ownOutputs #== 1
+
+    ownOutput <- tcont $ pletFields @'["value", "datumHash"] $ phead # ownOutputs
+    let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # ownOutput.value
+    tcassert "State token should stay at governor's address" $
+      ownOuputGSTAmount #== 1
+
+    -- Check that own output have datum of type 'GovernorDatum'.
+    let outputGovernorStateDatumHash =
+          mustBePDJust # "Governor output doesn't have datum" # ownOutput.datumHash
+    newGovernorDatum <-
+      tclet $
+        pfromData $
+          mustBePJust # "Ouput governor state datum not found"
+            #$ ptryFindDatum # outputGovernorStateDatumHash # txInfoF.datums
+    tcassert "New datum is not valid" $ governorDatumValid # newGovernorDatum
+
+    pure $
+      pmatch redeemer $ \case
+        PCreateProposal _ -> unTermCont $ do
+          -- Check that the transaction advances proposal id.
+
+          let expectedNextProposalId = pgetNextProposalId # oldGovernorDatumF.nextProposalId
+              expectedNewDatum =
+                mkRecordConstr
+                  PGovernorDatum
+                  ( #proposalThresholds .= oldGovernorDatumF.proposalThresholds
+                      .& #nextProposalId .= pdata expectedNextProposalId
+                  )
+          tcassert "Unexpected governor state datum" $
+            newGovernorDatum #== expectedNewDatum
+
+          -- Check that exactly one proposal token is being minted.
+
+          tcassert "Exactly one proposal token must be minted" $
+            hasOnlyOneTokenOfCurrencySymbol # ppstSymbol # txInfoF.mint
+
+          -- Check that a stake is spent to create the propsal,
+          --   and the value it contains meets the requirement.
+
+          stakeInput <-
+            tclet $
+              mustBePJust # "Stake input not found" #$ pfind
+                # phoistAcyclic
+                  ( plam $
+                      \((pfield @"resolved" #) -> txOut') -> unTermCont $ do
+                        txOut <- tcont $ pletFields @'["address", "value"] txOut'
+
+                        pure $
+                          txOut.address #== pdata pstakeValidatorAddress
+                            #&& psymbolValueOf # psstSymbol # txOut.value #== 1
+                  )
+                # pfromData txInfoF.inputs
+
+          stakeInputF <- tcont $ pletFields @'["datumHash", "value"] $ pfield @"resolved" # stakeInput
+
+          tcassert "Stake input doesn't have datum" $
+            pisDJust # stakeInputF.datumHash
+
+          let stakeInputDatum = mustFindDatum' @PStakeDatum # stakeInputF.datumHash # txInfoF.datums
+
+          stakeInputDatumF <-
+            tcont $ pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum
+
+          tcassert "Required amount of stake GTs should be presented" $
+            stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeInputF.value)
+
+          -- TODO: Is this required?
+          tcassert "Tx should be signed by the stake owner" $
+            ptxSignedBy # txInfoF.signatories # stakeInputDatumF.owner
+
+          -- Check that the newly minted PST is sent to the proposal validator,
+          --   and the datum it carries is legal.
+
+          outputsToProposalValidatorWithStateToken <-
+            tclet $
+              pfilter
+                # phoistAcyclic
+                  ( plam $
+                      \txOut' -> unTermCont $ do
+                        txOut <- tcont $ pletFields @'["address", "value"] txOut'
+
+                        pure $
+                          txOut.address #== pdata pproposalValidatorAddress
+                            #&& psymbolValueOf # ppstSymbol # txOut.value #== 1
+                  )
+                # pfromData txInfoF.outputs
+
+          tcassert "Exactly one UTXO with proposal state token should be sent to the proposal validator" $
+            plength # outputsToProposalValidatorWithStateToken #== 1
+
+          outputDatumHash <- tclet $ pfield @"datumHash" #$ phead # outputsToProposalValidatorWithStateToken
+
+          tcassert "The utxo paid to the proposal validator must have datum" $
+            pisDJust # outputDatumHash
+
+          proposalOutputDatum' <-
+            tclet $
+              mustFindDatum' @PProposalDatum
+                # outputDatumHash
+                # txInfoF.datums
+
+          tcassert "Proposal datum must be valid" $
+            proposalDatumValid' # proposalOutputDatum'
+
+          proposalOutputDatum <-
+            tcont $
+              pletFields
+                @'["proposalId", "status", "cosigners", "thresholds", "votes"]
+                proposalOutputDatum'
+
+          -- Id and thresholds should be copied from the old governor state datum.
+          tcassert "Invalid proposal id in proposal datum" $
+            proposalOutputDatum.proposalId #== oldGovernorDatumF.nextProposalId
+
+          tcassert "Invalid thresholds in proposal datum" $
+            proposalOutputDatum.thresholds #== oldGovernorDatumF.proposalThresholds
+
+          -- The proposal at this point should be in draft state.
+          tcassert "Proposal state should be draft" $
+            proposalOutputDatum.status #== pconstantData Draft
+
+          tcassert "Proposal should have only one cosigner" $
+            plength # pfromData proposalOutputDatum.cosigners #== 1
+
+          let cosigner = phead # pfromData proposalOutputDatum.cosigners
+
+          tcassert "Cosigner should be the stake owner" $
+            pdata stakeInputDatumF.owner #== cosigner
+
+          -- Check the output stake has been proposly updated.
+
+          stakeOutput <-
+            tclet $
+              mustBePJust
+                # "Stake output not found"
+                  #$ pfind
+                # phoistAcyclic
+                  ( plam $
+                      \txOut' -> unTermCont $ do
+                        txOut <- tcont $ pletFields @'["address", "value"] txOut'
+
+                        pure $
+                          txOut.address #== pdata pstakeValidatorAddress
+                            #&& psymbolValueOf # psstSymbol # txOut.value #== 1
+                  )
+                # pfromData txInfoF.outputs
+
+          stakeOutputF <- tcont $ pletFields @'["datumHash", "value"] $ stakeOutput
+
+          tcassert "Staked GTs should be sent back to stake validator" $
+            stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeOutputF.value)
+
+          let stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutputF.datumHash
+
+              stakeOutputDatum =
+                mustBePJust # "Stake output not found" #$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums
+
+          -- The stake should be locked by the newly created proposal.
+
+          let possibleVoteResults = pkeys #$ pto $ pfromData proposalOutputDatum.votes
+
+              mkProposalLock :: Term _ (PProposalId :--> PAsData PResultTag :--> PAsData PProposalLock)
+              mkProposalLock =
+                phoistAcyclic $
+                  plam
+                    ( \pid rt' ->
+                        pdata $
+                          mkRecordConstr
+                            PProposalLock
+                            ( #vote .= rt' .& #proposalTag .= pdata pid
+                            )
+                    )
+
+              -- Append new locks to existing locks
+              expectedProposalLocks =
+                pconcat # stakeInputDatumF.lockedBy
+                  #$ pmap # (mkProposalLock # proposalOutputDatum.proposalId) # possibleVoteResults
+
+              expectedStakeOutputDatum =
+                pdata $
+                  mkRecordConstr
+                    PStakeDatum
+                    ( #stakedAmount .= stakeInputDatumF.stakedAmount
+                        .& #owner .= stakeInputDatumF.owner
+                        .& #lockedBy .= pdata expectedProposalLocks
+                    )
+
+          tcassert "Unexpected stake output datum" $ expectedStakeOutputDatum #== stakeOutputDatum
+
+          pure $ popaque $ pconstant ()
+
+        --------------------------------------------------------------------------
+
+        PMintGATs _ -> unTermCont $ do
+          tcassert "Governor state should not be changed" $ newGovernorDatum #== oldGovernorDatum
+
+          -- Filter out proposal inputs and ouputs using PST and the address of proposal validator.
+
+          tcassert "The governor can only process one proposal at a time" $
+            (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1
+
+          proposalInputF <-
+            tcont $
+              pletFields @'["datumHash"] $
+                pfield @"resolved"
+                  #$ pfromData
+                  $ mustBePJust
+                    # "Proposal input not found"
+                      #$ pfind
+                    # plam
+                      ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
+                          txOutF <- tcont $ pletFields @'["address", "value"] txOut
+
+                          pure $
+                            psymbolValueOf # ppstSymbol # txOutF.value #== 1
+                              #&& txOutF.address #== pdata pproposalValidatorAddress
+                      )
+                    # pfromData txInfoF.inputs
+
+          proposalOutputF <-
+            tcont $
+              pletFields @'["datumHash"] $
+                mustBePJust # "Proposal output not found"
+                  #$ pfind
+                    # plam
+                      ( \txOut -> unTermCont $ do
+                          txOutF <- tcont $ pletFields @'["address", "value"] txOut
+                          pure $
+                            psymbolValueOf # ppstSymbol # txOutF.value #== 1
+                              #&& txOutF.address #== pdata pproposalValidatorAddress
+                      )
+                    # pfromData txInfoF.outputs
+
+          proposalInputDatum <-
+            tclet $
+              mustFindDatum' @PProposalDatum
+                # proposalInputF.datumHash
+                # txInfoF.datums
+          proposalOutputDatum <-
+            tclet $
+              mustFindDatum' @PProposalDatum
+                # proposalOutputF.datumHash
+                # txInfoF.datums
+
+          tcassert "Proposal datum must be valid" $
+            proposalDatumValid' # proposalInputDatum
+              #&& proposalDatumValid' # proposalOutputDatum
+
+          proposalInputDatumF <-
+            tcont $
+              pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes"]
+                proposalInputDatum
+
+          -- Check that the proposal state is advanced so that a proposal cannot be executed twice.
+
+          tcassert "Proposal must be in locked(executable) state in order to execute effects" $
+            proposalInputDatumF.status #== pconstantData Locked
+
+          let expectedOutputProposalDatum =
+                mkRecordConstr
+                  PProposalDatum
+                  ( #proposalId .= proposalInputDatumF.proposalId
+                      .& #effects .= proposalInputDatumF.effects
+                      .& #status .= pdata (pcon $ PFinished pdnil)
+                      .& #cosigners .= proposalInputDatumF.cosigners
+                      .& #thresholds .= proposalInputDatumF.thresholds
+                      .& #votes .= proposalInputDatumF.votes
+                  )
+
+          tcassert "Unexpected output proposal datum" $
+            pdata proposalOutputDatum #== pdata expectedOutputProposalDatum
+
+          -- TODO: anything else to check here?
+
+          -- Find the highest votes and the corresponding tag.
+          let highestVoteFolder =
+                phoistAcyclic $
+                  plam
+                    ( \pair last' ->
+                        pif
+                          (pisJust # last')
+                          ( unTermCont $ do
+                              PJust last <- tcmatch last'
+                              let lastHighestVote = pfromData $ psndBuiltin # last
+                                  thisVote = pfromData $ psndBuiltin # pair
+                              pure $ pif (lastHighestVote #< thisVote) (pcon $ PJust pair) last'
+                          )
+                          (pcon $ PJust pair)
+                    )
+
+              votesList = pto $ pto $ pfromData proposalInputDatumF.votes
+
+              maybeWinner =
+                pfoldr # highestVoteFolder # pcon PNothing # votesList
+
+          winner <- tclet $ mustBePJust # "No winning outcome" # maybeWinner
+
+          let highestVote = pfromData $ psndBuiltin # winner
+              minimumVotes = puntag $ pfromData $ pfield @"execute" # proposalInputDatumF.thresholds
+
+          tcassert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote
+
+          let finalResultTag = pfromData $ pfstBuiltin # winner
+
+          -- The effects of the winner outcome.
+          effectGroup <- tclet $ plookup' # finalResultTag #$ proposalInputDatumF.effects
+
+          gatCount <- tclet $ plength #$ pto $ pto effectGroup
+
+          tcassert "Required amount of GATs should be minted" $
+            psymbolValueOf # patSymbol # txInfoF.mint #== gatCount
+
+          -- Ensure that every GAT goes to one of the effects in the winner effect group.
+          outputsWithGAT <-
+            tclet $
+              pfilter
+                # phoistAcyclic
+                  ( plam
+                      ( \((pfield @"value" #) -> value) ->
+                          0 #< psymbolValueOf # patSymbol # value
+                      )
+                  )
+                # pfromData txInfoF.outputs
+
+          tcassert "Output GATs is more than minted GATs" $
+            plength # outputsWithGAT #== gatCount
+
+          let gatOutputValidator' :: Term s (PMap PValidatorHash PDatumHash :--> PAsData PTxOut :--> PBool)
+              gatOutputValidator' =
+                phoistAcyclic $
+                  plam
+                    ( \effects (pfromData -> output') -> unTermCont $ do
+                        output <- tcont $ pletFields @'["address", "datumHash"] $ output'
+
+                        let scriptHash =
+                              mustBePJust # "GAT receiver is not a script"
+                                #$ scriptHashFromAddress # output.address
+                            datumHash =
+                              mustBePDJust # "Output to effect should have datum"
+                                #$ output.datumHash
+
+                            expectedDatumHash =
+                              mustBePJust # "Receiver is not in the effect list"
+                                #$ plookup # scriptHash # effects
+
+                        pure $
+                          foldr1
+                            (#&&)
+                            [ ptraceIfFalse "GAT must be tagged by the effect hash" $ authorityTokensValidIn # patSymbol # output'
+                            , ptraceIfFalse "Unexpected datum" $ datumHash #== expectedDatumHash
+                            ]
+                    )
+
+              gatOutputValidator = gatOutputValidator' # effectGroup
+
+          pure $
+            popaque $
+              pfoldr
+                # plam
+                  ( \txOut r ->
+                      let value = pfield @"value" # txOut
+                          atValue = psymbolValueOf # patSymbol # value
+                       in pif (atValue #== 0) r $
+                            pif (atValue #== 1) (r #&& gatOutputValidator # txOut) $ pconstant False
+                  )
+                # pconstant True
+                # pfromData txInfoF.outputs
+
+        --------------------------------------------------------------------------
+
+        PMutateGovernor _ -> unTermCont $ do
+          -- Check that a GAT is burnt.
+          pure $ popaque $ singleAuthorityTokenBurned patSymbol ctxF.txInfo txInfoF.mint
+  where
+    -- Get th amount of governance tokens in a value.
+    pgtValueOf :: Term s (PValue :--> PDiscrete GTTag)
+    pgtValueOf = phoistAcyclic $ pvalueDiscrete' gov.gtClassRef
+
+    -- The currency symbol of authority token.
+    patSymbol :: Term s PCurrencySymbol
+    patSymbol = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor gov
+
+    -- The currency symbol of the proposal state token.
+    ppstSymbol :: Term s PCurrencySymbol
+    ppstSymbol =
+      let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov
+       in phoistAcyclic $ pconstant sym
+
+    -- Is a proposal state datum valid?
+    proposalDatumValid' :: Term s (PProposalDatum :--> PBool)
+    proposalDatumValid' =
+      let params = proposalFromGovernor gov
+       in phoistAcyclic $ proposalDatumValid params
+
+    -- The address of the proposal validator.
+    pproposalValidatorAddress :: Term s PAddress
+    pproposalValidatorAddress =
+      let vh = proposalValidatorHashFromGovernor gov
+       in phoistAcyclic $ pconstant $ validatorHashToAddress vh
+
+    -- The address of the stake validator.
+    pstakeValidatorAddress :: Term s PAddress
+    pstakeValidatorAddress =
+      let vh = stakeValidatorHashFromGovernor gov
+       in phoistAcyclic $ pconstant $ validatorHashToAddress vh
+
+    -- The currency symbol of the stake state token.
+    psstSymbol :: Term s PCurrencySymbol
+    psstSymbol =
+      let sym = stakeSTSymbolFromGovernor gov
+       in phoistAcyclic $ pconstant sym
+
+    -- The currency symbol of the governor state token.
+    pgstSymbol :: Term s PCurrencySymbol
+    pgstSymbol =
+      let sym = governorSTSymbolFromGovernor gov
+       in phoistAcyclic $ pconstant sym
+
+--------------------------------------------------------------------------------
+
+-- | Get the 'CurrencySymbol' of GST.
+governorSTSymbolFromGovernor :: Governor -> CurrencySymbol
+governorSTSymbolFromGovernor gov = mintingPolicySymbol policy
+  where
+    policy :: MintingPolicy
+    policy = mkMintingPolicy $ governorPolicy gov
+
+-- | Get the 'AssetClass' of GST.
+governorSTAssetClassFromGovernor :: Governor -> AssetClass
+governorSTAssetClassFromGovernor gov = AssetClass (symbol, "")
+  where
+    symbol :: CurrencySymbol
+    symbol = governorSTSymbolFromGovernor gov
+
+-- | Get the 'CurrencySymbol' of the proposal state token.
+proposalSTSymbolFromGovernor :: Governor -> CurrencySymbol
+proposalSTSymbolFromGovernor gov = symbol
+  where
+    gstAC = governorSTAssetClassFromGovernor gov
+    policy = mkMintingPolicy $ proposalPolicy gstAC
+    symbol = mintingPolicySymbol policy
+
+-- | Get the 'AssetClass' of the proposal state token.
+proposalSTAssetClassFromGovernor :: Governor -> AssetClass
+proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "")
+  where
+    symbol = proposalSTSymbolFromGovernor gov
+
+-- | Get the 'CurrencySymbol' of the stake token/
+stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol
+stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy
+  where
+    policy = mkMintingPolicy $ stakePolicy gov.gtClassRef
+
+{- | Get the 'AssetClass' of the stake token.
+
+   Note that the token is tagged with the hash of the stake validator.
+   See 'Agora.Stake.Script.stakePolicy'.
+-}
+stakeSTAssetClassFromGovernor :: Governor -> AssetClass
+stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName)
+  where
+    symbol = stakeSTSymbolFromGovernor gov
+
+    -- Tag with the address where the token is being sent to.
+    tokenName = validatorHashToTokenName $ stakeValidatorHashFromGovernor gov
+
+-- | Get the 'Stake' parameter, given the 'Governor' parameter.
+stakeFromGovernor :: Governor -> Stake
+stakeFromGovernor gov =
+  Stake gov.gtClassRef $
+    proposalSTAssetClassFromGovernor gov
+
+-- | Get the hash of 'Agora.Stake.Script.stakePolicy'.
+stakeValidatorHashFromGovernor :: Governor -> ValidatorHash
+stakeValidatorHashFromGovernor gov = validatorHash validator
+  where
+    params = stakeFromGovernor gov
+    validator = mkValidator $ stakeValidator params
+
+-- | Get the 'Proposal' parameter, given the 'Governor' parameter.
+proposalFromGovernor :: Governor -> Proposal
+proposalFromGovernor gov = Proposal gstAC sstAC mc
+  where
+    gstAC = governorSTAssetClassFromGovernor gov
+    mc = gov.maximumCosigners
+    sstAC = stakeSTAssetClassFromGovernor gov
+
+-- | Get the hash of 'Agora.Proposal.proposalPolicy'.
+proposalValidatorHashFromGovernor :: Governor -> ValidatorHash
+proposalValidatorHashFromGovernor gov = validatorHash validator
+  where
+    params = proposalFromGovernor gov
+    validator = mkValidator $ proposalValidator params
+
+-- | Get the hash of 'Agora.Proposal.proposalValidator'.
+governorValidatorHash :: Governor -> ValidatorHash
+governorValidatorHash gov = validatorHash validator
+  where
+    validator = mkValidator $ governorValidator gov
+
+-- | Get the 'AuthorityToken' parameter given the 'Governor' parameter.
+authorityTokenFromGovernor :: Governor -> AuthorityToken
+authorityTokenFromGovernor gov = AuthorityToken $ governorSTAssetClassFromGovernor gov
+
+-- | Get the 'CurrencySymbol' of the authority token.
+authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol
+authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy
+  where
+    policy = mkMintingPolicy $ authorityTokenPolicy params
+    params = authorityTokenFromGovernor gov

agora/Agora/Proposal.hs

@@ -48,7 +48,6 @@ import Agora.SafeMoney (GTTag)
 import Agora.Utils (pkeysEqual, pnotNull)
 import Control.Applicative (Const)
 import Control.Arrow (first)
-import Plutarch.Builtin (PBuiltinMap)
 import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..))
 import Plutarch.Lift (
   DerivePConstantViaNewtype (..),
@@ -174,10 +173,10 @@ emptyVotesFor = ProposalVotes . AssocMap.mapWithKey (const . const 0)
 data ProposalDatum = ProposalDatum
   { proposalId :: ProposalId
   -- ^ Identification of the proposal.
-  , -- TODO: could we encode this more efficiently?
+  -- TODO: could we encode this more efficiently?
   -- This is shaped this way for future proofing.
   -- See https://github.com/Liqwid-Labs/agora/issues/39
-  effects :: AssocMap.Map ResultTag [(ValidatorHash, DatumHash)]
+  , effects :: AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
   -- ^ Effect lookup table. First by result, then by effect hash.
   , status :: ProposalStatus
   -- ^ The status the proposal is in.
@@ -414,17 +413,12 @@ proposalDatumValid proposal =
     plam $ \datum' -> unTermCont $ do
       datum <- tcont $ pletFields @'["effects", "cosigners", "votes"] $ datum'
 
-      let effects :: Term _ (PBuiltinMap Agora.Proposal.PResultTag (PBuiltinMap Plutarch.Api.V1.PValidatorHash Plutarch.Api.V1.PDatumHash))
+      let atLeastOneNegativeResult =
-          effects =
+            pany
-            -- JUSTIFICATION:
+              # phoistAcyclic
-            -- @datum.effects : PMap PResultTag (PMap PValidatorHash PDatumHash)@
+                (plam $ \m -> pnull #$ pto $ pfromData $ psndBuiltin # m)
-            -- @PMap PResultTag (PMap PValidatorHash PDatumHash)@ is equivalent to
+              #$ pto
-            -- @PBuiltinMap PResultTag (PBuiltinMap Plutarch.Api.V1.PValidatorHash Plutarch.Api.V1.PDatumHash)@
+              $ pfromData datum.effects
-            punsafeCoerce datum.effects
-
-          atLeastOneNegativeResult :: Term _ PBool
-          atLeastOneNegativeResult =
-            pany # plam (\pair -> pnull #$ pfromData $ psndBuiltin # pair) # effects
 
       pure $
         foldr1

agora/Agora/Proposal/Scripts.hs

@@ -21,7 +21,7 @@ import Agora.Utils (
   anyOutput,
   findTxOutByTxOutRef,
   getMintingPolicySymbol,
-  pisUniq,
+  pisUniqBy,
   psymbolValueOf,
   ptokenSpent,
   ptxSignedBy,
@@ -59,8 +59,11 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
 
    - This policy cannot be burned.
 -}
-proposalPolicy :: Proposal -> ClosedTerm PMintingPolicy
+proposalPolicy ::
-proposalPolicy proposal =
+  -- | The assetclass of GST, see 'Agora.Governor.Scripts.governorPolicy'.
+  AssetClass ->
+  ClosedTerm PMintingPolicy
+proposalPolicy (AssetClass (govCs, govTn)) =
   plam $ \_redeemer ctx' -> unTermCont $ do
     PScriptContext ctx' <- tcmatch ctx'
     ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
@@ -70,7 +73,6 @@ proposalPolicy proposal =
 
     let inputs = txInfo.inputs
         mintedValue = pfromData txInfo.mint
-        AssetClass (govCs, govTn) = proposal.governorSTAssetClass
 
     PMinting ownSymbol' <- tcmatch $ pfromData ctx.purpose
     let mintedProposalST =
@@ -147,9 +149,10 @@ proposalValidator proposal =
     ownAddress <- tclet $ txOutF.address
 
     let stCurrencySymbol =
-          pconstant $ getMintingPolicySymbol (proposalPolicy proposal)
+          pconstant $ getMintingPolicySymbol (proposalPolicy proposal.governorSTAssetClass)
     valueSpent <- tclet $ pvalueSpent # txInfoF.inputs
     spentST <- tclet $ psymbolValueOf # stCurrencySymbol #$ valueSpent
+
     let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass
     stakeSTAssetClass <-
       tclet $ passetClass # pconstant stakeSym # pconstant stakeTn
@@ -168,7 +171,10 @@ proposalValidator proposal =
           newSigs <- tclet $ pfield @"newCosigners" # r
 
           tcassert "Cosigners are unique" $
-            pisUniq # newSigs
+            pisUniqBy
+              # phoistAcyclic (plam (#==))
+              # phoistAcyclic (plam $ \(pfromData -> x) (pfromData -> y) -> x #< y)
+              # newSigs
 
           tcassert "Signed by all new cosigners" $
             pall # signedBy # newSigs

agora/Agora/Utils.hs

@@ -32,8 +32,14 @@ module Agora.Utils (
   pisJust,
   ptokenSpent,
   pkeysEqual,
-  pnub,
+  pnubSortBy,
   pisUniq,
+  pisUniqBy,
+  pisDJust,
+  pisUTXOSpent,
+  pmsortBy,
+  pmsort,
+  pnubSort,
 
   -- * Functions which should (probably) not be upstreamed
   anyOutput,
@@ -46,11 +52,20 @@ module Agora.Utils (
   validatorHashToTokenName,
   pvalidatorHashToTokenName,
   getMintingPolicySymbol,
+  hasOnlyOneTokenOfCurrencySymbol,
+  mustFindDatum',
+  mustBePJust,
+  mustBePDJust,
+  validatorHashToAddress,
+  pmergeBy,
+  phalve,
 ) where
 
 --------------------------------------------------------------------------------
 
 import Plutus.V1.Ledger.Api (
+  Address (..),
+  Credential (..),
   CurrencySymbol,
   TokenName (..),
   ValidatorHash (..),
@@ -83,7 +98,7 @@ import Plutarch.Api.V1 (
 import Plutarch.Api.V1.AssocMap (PMap (PMap))
 import Plutarch.Api.V1.Extra (PAssetClass, passetClassValueOf, pvalueOf)
 import Plutarch.Api.V1.Value (PValue (PValue))
-import Plutarch.Builtin (ppairDataBuiltin)
+import Plutarch.Builtin (pforgetData, ppairDataBuiltin)
 import Plutarch.Map.Extra (pkeys)
 import Plutarch.Reducible (Reducible (Reduce))
 import Plutarch.TryFrom (PTryFrom (PTryFromExcess), ptryFrom)
@@ -346,38 +361,159 @@ ptokenSpent =
 {- | True if both maps have exactly the same keys.
      Using @'#=='@ is not sufficient, because keys returned are not ordered.
 -}
-pkeysEqual :: forall (s :: S) k a b. Term s (PMap k a :--> PMap k b :--> PBool)
+pkeysEqual :: (POrd k, PIsData k) => forall (s :: S) a b. Term s (PMap k a :--> PMap k b :--> PBool)
 pkeysEqual = phoistAcyclic $
   plam $ \p q -> unTermCont $ do
     pks <- tclet $ pkeys # p
     qks <- tclet $ pkeys # q
+
     pure $
-      pall # plam (\pk -> pelem # pk # qks) # pks
-        #&& pall # plam (\qk -> pelem # qk # pks) # qks
-
--- | / O(n^2) /. Clear out duplicates in a list. The order is not preserved.
-pnub :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s (list a :--> list a)
-pnub =
-  phoistAcyclic $
-    precList
-      ( \self x xs ->
       pif
-            (pnot #$ pelem # x # xs)
+        (plength # pks #== plength # qks)
-            (pcons # x # (self # xs))
+        ( unTermCont $ do
-            (self # xs)
+            let comp = phoistAcyclic $ plam $ \(pfromData -> x) (pfromData -> y) -> x #< y
-      )
+                spks = pmsortBy # comp # pks
-      (const pnil)
+                sqks = pmsortBy # comp # qks
 
--- | / O(n^2) /. Check if a list contains no duplicates.
+            pure $ plistEquals # spks # sqks
-pisUniq :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s (list a :--> PBool)
+        )
-pisUniq =
+        (pcon PFalse)
-  phoistAcyclic $
+
-    precList
+-- | / O(nlogn) /. Sort and remove dupicate elements in a list.
-      ( \self x xs ->
+pnubSortBy ::
-          (pnot #$ pelem # x # xs)
+  forall list a (s :: S).
-            #&& (self # xs)
+  (PIsListLike list a) =>
+  Term s ((a :--> a :--> PBool) :--> (a :--> a :--> PBool) :--> list a :--> list a)
+pnubSortBy = phoistAcyclic $
+  plam $ \eq comp l -> pif (pnull # l) l $
+    unTermCont $ do
+      sl <- tclet $ pmsortBy # comp # l
+
+      let x = phead # sl
+          xs = ptail # sl
+
+      return $ pgo # eq # x # xs
+  where
+    pgo = phoistAcyclic pfix #$ plam pgo'
+    pgo' self eq seen l =
+      pif (pnull # l) (psingleton # seen) $
+        unTermCont $ do
+          x <- tclet $ phead # l
+          xs <- tclet $ ptail # l
+
+          return $
+            pif
+              (eq # x # seen)
+              (self # eq # seen # xs)
+              (pcons # seen #$ self # eq # x # xs)
+
+-- | Special version of 'pnubSortBy', which requires elements have 'POrd'.
+pnubSort ::
+  forall list a (s :: S).
+  (PIsListLike list a, POrd a) =>
+  Term s (list a :--> list a)
+pnubSort = phoistAcyclic $ pnubSortBy # eq # comp
+  where
+    eq = phoistAcyclic $ plam (#==)
+    comp = phoistAcyclic $ plam (#<)
+
+-- | / O(nlogn) /. Check if a list contains no duplicates.
+pisUniqBy ::
+  forall list a (s :: S).
+  (PIsListLike list a) =>
+  Term s ((a :--> a :--> PBool) :--> (a :--> a :--> PBool) :--> list a :--> PBool)
+pisUniqBy = phoistAcyclic $
+  plam $ \eq comp xs ->
+    let nubbed = pnubSortBy # eq # comp # xs
+     in plength # xs #== plength # nubbed
+
+-- | A special case of 'pisUniqBy' which requires elements have 'POrd' instance.
+pisUniq :: forall list a (s :: S). (POrd a, PIsListLike list a) => Term s (list a :--> PBool)
+pisUniq = phoistAcyclic $ pisUniqBy # eq # comp
+  where
+    eq = phoistAcyclic $ plam (#==)
+    comp = phoistAcyclic $ plam (#<)
+
+-- | Yield True if a given PMaybeData is of form @'PDJust' _@.
+pisDJust :: Term s (PMaybeData a :--> PBool)
+pisDJust = phoistAcyclic $
+  plam $ \x ->
+    pmatch
+      x
+      ( \case
+          PDJust _ -> pconstant True
+          _ -> pconstant False
+      )
+
+-- | Determines if a given UTXO is spent.
+pisUTXOSpent :: Term s (PTxOutRef :--> PBuiltinList (PAsData PTxInInfo) :--> PBool)
+pisUTXOSpent = phoistAcyclic $
+  plam $ \oref inputs -> P.do
+    pisJust #$ pfindTxInByTxOutRef # oref # inputs
+
+-- | / O(n) /. Merge two lists which are assumed to be ordered, given a custom comparator.
+pmergeBy :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a :--> l a)
+pmergeBy = phoistAcyclic $ pfix #$ plam pmergeBy'
+  where
+    pmergeBy' self comp a b =
+      pif (pnull # a) b $
+        pif (pnull # b) a $
+          unTermCont $ do
+            ah <- tclet $ phead # a
+            at <- tclet $ ptail # a
+            bh <- tclet $ phead # b
+            bt <- tclet $ ptail # b
+
+            pure $
+              pif
+                (comp # ah # bh)
+                (pcons # ah #$ self # comp # at # b)
+                (pcons # bh #$ self # comp # a # bt)
+
+{- | / O(nlogn) /. Merge sort, bottom-up version, given a custom comparator.
+
+   Elements are arranged from lowest to highest,
+   keeping duplicates in the order they appeared in the input.
+-}
+pmsortBy :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a)
+pmsortBy = phoistAcyclic $ pfix #$ plam pmsortBy'
+  where
+    pmsortBy' self comp xs = pif (pnull # xs) pnil $
+      pif (pnull #$ ptail # xs) xs $
+        pmatch (phalve # xs) $ \(PPair fh sh) ->
+          let sfh = self # comp # fh
+              ssh = self # comp # sh
+           in pmergeBy # comp # sfh # ssh
+
+-- | A special case of 'pmsortBy' which requires elements have 'POrd' instance.
+pmsort :: (POrd a, PIsListLike l a) => Term s (l a :--> l a)
+pmsort = phoistAcyclic $ pmsortBy # comp
+  where
+    comp = phoistAcyclic $ plam (#<)
+
+-- | Split a list in half.
+phalve :: (PIsListLike l a) => Term s (l a :--> PPair (l a) (l a))
+phalve = phoistAcyclic $ plam $ \l -> go # l # l
+  where
+    go = phoistAcyclic $ pfix #$ plam go'
+    go' self xs ys =
+      pif
+        (pnull # ys)
+        (pcon $ PPair pnil xs)
+        ( unTermCont $ do
+            yt <- tclet $ ptail # ys
+
+            xh <- tclet $ phead # xs
+            xt <- tclet $ ptail # xs
+
+            pure $
+              pif (pnull # yt) (pcon $ PPair (psingleton # xh) xt) $
+                unTermCont $ do
+                  yt' <- tclet $ ptail # yt
+                  pure $
+                    pmatch (self # xt # yt') $ \(PPair first last) ->
+                      pcon $ PPair (pcons # xh # first) last
         )
-      (const $ pcon PTrue)
 
 --------------------------------------------------------------------------------
 {- Functions which should (probably) not be upstreamed
@@ -514,3 +650,49 @@ pvalidatorHashToTokenName vh = pcon (PTokenName (pto vh))
 -- | Get the CurrencySymbol of a PMintingPolicy.
 getMintingPolicySymbol :: ClosedTerm PMintingPolicy -> CurrencySymbol
 getMintingPolicySymbol v = mintingPolicySymbol $ mkMintingPolicy v
+
+-- | The entire value only contains one token of the given currency symbol.
+hasOnlyOneTokenOfCurrencySymbol :: Term s (PCurrencySymbol :--> PValue :--> PBool)
+hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $
+  plam $ \cs vs -> P.do
+    psymbolValueOf # cs # vs #== 1
+      #&& (plength #$ pto $ pto $ pto vs) #== 1
+
+-- | Find datum given a maybe datum hash
+mustFindDatum' ::
+  forall (datum :: PType).
+  (PIsData datum, PTryFrom PData (PAsData datum)) =>
+  forall s.
+  Term
+    s
+    ( PMaybeData PDatumHash
+        :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum))
+        :--> datum
+    )
+mustFindDatum' = phoistAcyclic $
+  plam $ \mdh datums -> unTermCont $ do
+    let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh
+        dt = mustBePJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums
+    (d, _) <- tcont $ ptryFrom $ pforgetData $ pdata dt
+    pure $ pfromData d
+
+{- | Extract the value stored in a PMaybe container.
+     If there's no value, throw an error with the given message.
+-}
+mustBePJust :: forall a s. Term s (PString :--> PMaybe a :--> a)
+mustBePJust = phoistAcyclic $
+  plam $ \emsg mv' -> pmatch mv' $ \case
+    PJust v -> v
+    _ -> ptraceError emsg
+
+{- | Extract the value stored in a PMaybeData container.
+     If there's no value, throw an error with the given message.
+-}
+mustBePDJust :: forall a s. (PIsData a) => Term s (PString :--> PMaybeData a :--> a)
+mustBePDJust = phoistAcyclic $
+  plam $ \emsg mv' -> pmatch mv' $ \case
+    PDJust ((pfield @"_0" #) -> v) -> v
+    _ -> ptraceError emsg
+
+validatorHashToAddress :: ValidatorHash -> Address
+validatorHashToAddress vh = Address (ScriptCredential vh) Nothing