Merge branch 'main' into connor/#87

agora-sample/Sample/Effect/GovernorMutation.hs

@@ -0,0 +1,174 @@
+module Sample.Effect.GovernorMutation (
+  mkEffectTxInfo,
+  effectValidator,
+  effectValidatorAddress,
+  effectValidatorHash,
+  atAssetClass,
+  govRef,
+  effectRef,
+  invalidNewGovernorDatum,
+  validNewGovernorDatum,
+  mkEffectDatum,
+) where
+
+import Agora.Effect.GovernorMutation (
+  MutateGovernorDatum (..),
+  mutateGovernorValidator,
+ )
+import Agora.Governor (GovernorDatum (..))
+import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
+import Plutarch.Api.V1 (mkValidator, validatorHash)
+import Plutarch.SafeMoney (Tagged (Tagged))
+import Plutus.V1.Ledger.Address (scriptHashAddress)
+import Plutus.V1.Ledger.Api (
+  Address,
+  Datum (..),
+  ToData (..),
+  TokenName (..),
+  TxInInfo (..),
+  TxInfo (..),
+  TxOut (..),
+  TxOutRef (TxOutRef),
+  Validator,
+  ValidatorHash (..),
+ )
+import Plutus.V1.Ledger.Api qualified as Interval
+import Plutus.V1.Ledger.Value (AssetClass, assetClass)
+import Plutus.V1.Ledger.Value qualified as Value
+import Sample.Shared (
+  authorityTokenSymbol,
+  defaultProposalThresholds,
+  govAssetClass,
+  govValidatorAddress,
+  governor,
+  minAda,
+  signer,
+ )
+import Test.Util (datumPair, toDatumHash)
+
+-- | The effect validator instance.
+effectValidator :: Validator
+effectValidator = mkValidator $ mutateGovernorValidator governor
+
+-- | The hash of the validator instance.
+effectValidatorHash :: ValidatorHash
+effectValidatorHash = validatorHash effectValidator
+
+-- | The address of the validator.
+effectValidatorAddress :: Address
+effectValidatorAddress = scriptHashAddress effectValidatorHash
+
+-- | The assetclass of the authority token.
+atAssetClass :: AssetClass
+atAssetClass = assetClass authorityTokenSymbol tokenName
+  where
+    -- TODO: use 'validatorHashToTokenName'
+    ValidatorHash bs = effectValidatorHash
+    tokenName = TokenName bs
+
+-- | The mock reference of the governor state UTXO.
+govRef :: TxOutRef
+govRef = TxOutRef "614481d2159bfb72350222d61fce17e548e0fc00e5a1f841ff1837c431346ce7" 1
+
+-- | The mock reference of the effect UTXO.
+effectRef :: TxOutRef
+effectRef = TxOutRef "c31164dc11835de7eb6187f67d0e1a19c1dfc0786a456923eef5043189cdb578" 1
+
+-- | The input effect datum in 'mkEffectTransaction'.
+mkEffectDatum :: GovernorDatum -> MutateGovernorDatum
+mkEffectDatum newGovDatum =
+  MutateGovernorDatum
+    { governorRef = govRef
+    , newDatum = newGovDatum
+    }
+
+{- | Given the new governor state, create an effect to update the governor's state.
+
+    Note that the transaction is valid only if the given new datum is valid.
+-}
+mkEffectTxInfo :: GovernorDatum -> TxInfo
+mkEffectTxInfo newGovDatum =
+  let gst = Value.assetClassValue govAssetClass 1
+      at = Value.assetClassValue atAssetClass 1
+
+      -- One authority token is burnt in the process.
+      burnt = Value.assetClassValue atAssetClass (-1)
+
+      --
+
+      governorInputDatum' :: GovernorDatum
+      governorInputDatum' =
+        GovernorDatum
+          { proposalThresholds = defaultProposalThresholds
+          , nextProposalId = ProposalId 0
+          }
+      governorInputDatum :: Datum
+      governorInputDatum = Datum $ toBuiltinData governorInputDatum'
+      governorInput :: TxOut
+      governorInput =
+        TxOut
+          { txOutAddress = govValidatorAddress
+          , txOutValue = gst
+          , txOutDatumHash = Just $ toDatumHash governorInputDatum
+          }
+
+      --
+
+      -- The effect should update 'nextProposalId'
+      effectInputDatum' :: MutateGovernorDatum
+      effectInputDatum' = mkEffectDatum newGovDatum
+      effectInputDatum :: Datum
+      effectInputDatum = Datum $ toBuiltinData effectInputDatum'
+      effectInput :: TxOut
+      effectInput =
+        TxOut
+          { txOutAddress = effectValidatorAddress
+          , txOutValue = at -- The effect carry an authotity token.
+          , txOutDatumHash = Just $ toDatumHash effectInputDatum
+          }
+
+      --
+
+      governorOutputDatum' :: GovernorDatum
+      governorOutputDatum' = effectInputDatum'.newDatum
+      governorOutputDatum :: Datum
+      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
+      governorOutput :: TxOut
+      governorOutput =
+        TxOut
+          { txOutAddress = govValidatorAddress
+          , txOutValue = mconcat [gst, minAda]
+          , txOutDatumHash = Just $ toDatumHash governorOutputDatum
+          }
+   in TxInfo
+        { txInfoInputs =
+            [ TxInInfo effectRef effectInput
+            , TxInInfo govRef governorInput
+            ]
+        , txInfoOutputs = [governorOutput]
+        , txInfoFee = Value.singleton "" "" 2
+        , txInfoMint = burnt
+        , txInfoDCert = []
+        , txInfoWdrl = []
+        , txInfoValidRange = Interval.always
+        , txInfoSignatories = [signer]
+        , txInfoData = datumPair <$> [governorInputDatum, governorOutputDatum, effectInputDatum]
+        , txInfoId = "4dae3806cc69615b721d52ed09b758f43f25a8f39b7934d6b28514caf71f5f7b"
+        }
+
+validNewGovernorDatum :: GovernorDatum
+validNewGovernorDatum =
+  GovernorDatum
+    { proposalThresholds = defaultProposalThresholds
+    , nextProposalId = ProposalId 42
+    }
+
+invalidNewGovernorDatum :: GovernorDatum
+invalidNewGovernorDatum =
+  GovernorDatum
+    { proposalThresholds =
+        defaultProposalThresholds
+          { countVoting = Tagged (-1)
+          }
+    , nextProposalId = ProposalId 42
+    }

agora-sample/Sample/Governor.hs

@@ -508,7 +508,7 @@ mintGATs =
     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.
+    TODO: use 'Agora.Effect.GovernorMutation.mutateGovernorEffect' as the mock effect in the future.
 
     The governor will ensure the new governor state is valid.
 -}

agora-scripts/Options.hs

@@ -0,0 +1,45 @@
+{- |
+Module     : Options
+Maintainer : emi@haskell.fyi
+Description: Command line options for 'agora-scripts'.
+
+Command line options for 'agora-scripts'.
+-}
+module Options (Options (..), parseOptions) where
+
+import Options.Applicative ((<**>))
+import Options.Applicative qualified as Opt
+
+data Options = Options
+  { config :: FilePath
+  , output :: FilePath
+  }
+  deriving stock (Show, Eq)
+
+opt :: Opt.Parser Options
+opt =
+  Options
+    <$> Opt.strOption
+      ( Opt.long "config"
+          <> Opt.short 'c'
+          <> Opt.metavar "CONFIG_PATH"
+          <> Opt.value "./agora-scripts/agora-params.json"
+          <> Opt.help "The path where the script configuration is."
+      )
+    <*> Opt.strOption
+      ( Opt.long "output"
+          <> Opt.short 'o'
+          <> Opt.metavar "OUTPUT_PATH"
+          <> Opt.value "./agora-scripts/agora-scripts.json"
+          <> Opt.help "Output where generated scripts will be."
+      )
+
+parseOptions :: IO Options
+parseOptions = Opt.execParser p
+  where
+    p =
+      Opt.info
+        (opt <**> Opt.helper)
+        ( Opt.fullDesc
+            <> Opt.progDesc "Generate Agora scripts for off-chain use."
+        )

agora-scripts/Scripts.hs

@@ -0,0 +1,113 @@
+{- |
+Module     : Scripts
+Maintainer : emi@haskell.fyi
+Description: Export scripts given configuration.
+
+Export scripts given configuration.
+-}
+module Main (main) where
+
+import Agora.AuthorityToken (AuthorityToken, authorityTokenPolicy)
+import Agora.Governor (Governor (Governor))
+import Agora.Governor qualified as Governor
+import Agora.Governor.Scripts (
+  authorityTokenFromGovernor,
+  authorityTokenSymbolFromGovernor,
+  governorPolicy,
+  governorValidator,
+  proposalFromGovernor,
+  stakeFromGovernor,
+ )
+import Agora.Proposal (Proposal)
+import Agora.Proposal.Scripts (proposalPolicy, proposalValidator)
+import Agora.SafeMoney (GTTag)
+import Agora.ScriptInfo (PolicyInfo, ValidatorInfo, mkPolicyInfo, mkValidatorInfo)
+import Agora.Stake (Stake)
+import Agora.Stake.Scripts (stakePolicy, stakeValidator)
+import Agora.Treasury (treasuryValidator)
+import Control.Monad ((>=>))
+import Data.Aeson qualified as Aeson
+import GHC.Generics qualified as GHC
+import Options (Options (..), parseOptions)
+import Plutarch.Api.V1 (mintingPolicySymbol, mkMintingPolicy)
+import Plutarch.SafeMoney (Tagged)
+import Plutus.V1.Ledger.Api (TxOutRef)
+import Plutus.V1.Ledger.Value (AssetClass, CurrencySymbol)
+import Plutus.V1.Ledger.Value qualified as Value
+import System.Exit (exitFailure)
+import Text.Printf (printf)
+
+-- | Params required for creating script export.
+data ScriptParams = ScriptParams
+  { governorInitialSpend :: TxOutRef
+  , gtClassRef :: Tagged GTTag AssetClass
+  , maximumCosigners :: Integer
+  }
+  deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
+  deriving stock (Show, Eq, GHC.Generic)
+
+-- | Scripts that get exported.
+data AgoraScripts = AgoraScripts
+  { governorPolicyInfo :: PolicyInfo
+  , governorValidatorInfo :: ValidatorInfo
+  , stakePolicyInfo :: PolicyInfo
+  , stakeValidatorInfo :: ValidatorInfo
+  , proposalPolicyInfo :: PolicyInfo
+  , proposalValidatorInfo :: ValidatorInfo
+  , treasuryValidatorInfo :: ValidatorInfo
+  , authorityTokenPolicyInfo :: PolicyInfo
+  }
+  deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
+  deriving stock (Show, Eq, GHC.Generic)
+
+main :: IO ()
+main = do
+  options <- parseOptions
+
+  params <-
+    Aeson.eitherDecodeFileStrict @ScriptParams options.config
+      >>= either (putStrLn >=> const exitFailure) pure
+
+  let scripts = agoraScripts params
+
+  Aeson.encodeFile options.output scripts
+
+  printf "Done! Wrote to %s\n" options.output
+
+-- | Create scripts from params.
+agoraScripts :: ScriptParams -> AgoraScripts
+agoraScripts params =
+  AgoraScripts
+    { governorPolicyInfo = mkPolicyInfo (governorPolicy governor)
+    , governorValidatorInfo = mkValidatorInfo (governorValidator governor)
+    , stakePolicyInfo = mkPolicyInfo (stakePolicy params.gtClassRef)
+    , stakeValidatorInfo = mkValidatorInfo (stakeValidator stake)
+    , proposalPolicyInfo = mkPolicyInfo (proposalPolicy governorSTAssetClass)
+    , proposalValidatorInfo = mkValidatorInfo (proposalValidator proposal)
+    , treasuryValidatorInfo = mkValidatorInfo (treasuryValidator authorityTokenSymbol)
+    , authorityTokenPolicyInfo = mkPolicyInfo (authorityTokenPolicy authorityToken)
+    }
+  where
+    governor :: Governor
+    governor =
+      Governor
+        { Governor.gstOutRef = params.governorInitialSpend
+        , Governor.gtClassRef = params.gtClassRef
+        , Governor.maximumCosigners = params.maximumCosigners
+        }
+
+    authorityToken :: AuthorityToken
+    authorityToken = authorityTokenFromGovernor governor
+
+    authorityTokenSymbol :: CurrencySymbol
+    authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
+
+    governorSTAssetClass :: AssetClass
+    governorSTAssetClass =
+      Value.assetClass (mintingPolicySymbol $ mkMintingPolicy $ governorPolicy governor) ""
+
+    proposal :: Proposal
+    proposal = proposalFromGovernor governor
+
+    stake :: Stake
+    stake = stakeFromGovernor governor

agora-scripts/agora-params.json

@@ -0,0 +1,11 @@
+{
+  "governorInitialSpend": {
+    "txOutRefId": "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be",
+    "txOutRefIdx": 0
+  },
+  "gtClassRef": [
+    "",
+    ""
+  ],
+  "maximumCosigners": 5
+}

agora-test/Spec.hs

@@ -7,6 +7,7 @@ import Test.Tasty (defaultMain, testGroup)
 --------------------------------------------------------------------------------
 
 import Spec.AuthorityToken qualified as AuthorityToken
+import Spec.Effect.GovernorMutation qualified as GovernorMutation
 import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal
 import Spec.Governor qualified as Governor
 import Spec.Model.MultiSig qualified as MultiSig
@@ -26,6 +27,9 @@ main =
           [ testGroup
               "Treasury Withdrawal Effect"
               TreasuryWithdrawal.tests
+          , testGroup
+              "Governor Mutation Effect"
+              GovernorMutation.tests
           ]
       , testGroup
           "Stake tests"

agora-test/Spec/Effect/GovernorMutation.hs

@@ -0,0 +1,67 @@
+module Spec.Effect.GovernorMutation (tests) where
+
+import Agora.Effect.GovernorMutation (mutateGovernorValidator)
+import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
+import Agora.Governor.Scripts (governorValidator)
+import Agora.Proposal (ProposalId (..))
+import Plutus.V1.Ledger.Api (ScriptContext (ScriptContext), ScriptPurpose (Spending))
+import Sample.Effect.GovernorMutation (
+  effectRef,
+  govRef,
+  invalidNewGovernorDatum,
+  mkEffectDatum,
+  mkEffectTxInfo,
+  validNewGovernorDatum,
+ )
+import Sample.Shared qualified as Shared
+import Test.Tasty (TestTree, testGroup)
+import Test.Util (effectFailsWith, effectSucceedsWith, validatorFailsWith, validatorSucceedsWith)
+
+tests :: [TestTree]
+tests =
+  [ testGroup
+      "validator"
+      [ testGroup
+          "valid new governor datum"
+          [ validatorSucceedsWith
+              "governor validator should pass"
+              (governorValidator Shared.governor)
+              ( GovernorDatum
+                  { proposalThresholds = Shared.defaultProposalThresholds
+                  , nextProposalId = ProposalId 0
+                  }
+              )
+              MutateGovernor
+              ( ScriptContext
+                  (mkEffectTxInfo validNewGovernorDatum)
+                  (Spending govRef)
+              )
+          , effectSucceedsWith
+              "effect validator should pass"
+              (mutateGovernorValidator Shared.governor)
+              (mkEffectDatum validNewGovernorDatum)
+              (ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef))
+          ]
+      , testGroup
+          "invalid new governor datum"
+          [ validatorFailsWith
+              "governor validator should fail"
+              (governorValidator Shared.governor)
+              ( GovernorDatum
+                  { proposalThresholds = Shared.defaultProposalThresholds
+                  , nextProposalId = ProposalId 0
+                  }
+              )
+              MutateGovernor
+              ( ScriptContext
+                  (mkEffectTxInfo invalidNewGovernorDatum)
+                  (Spending govRef)
+              )
+          , effectFailsWith
+              "effect validator should fail"
+              (mutateGovernorValidator Shared.governor)
+              (mkEffectDatum validNewGovernorDatum)
+              (ScriptContext (mkEffectTxInfo invalidNewGovernorDatum) (Spending effectRef))
+          ]
+      ]
+  ]

agora.cabal

@@ -130,6 +130,7 @@ library
   exposed-modules:
     Agora.AuthorityToken
     Agora.Effect
+    Agora.Effect.GovernorMutation
     Agora.Effect.NoOp
     Agora.Effect.TreasuryWithdrawal
     Agora.Governor
@@ -145,19 +146,21 @@ library
     Agora.Treasury
     Agora.Utils
     Agora.Utils.Value
+    Agora.ScriptInfo
 
   other-modules:
+    Agora.Aeson.Orphans
   hs-source-dirs:  agora
 
 library pprelude
+  default-language: Haskell2010
+  exposed-modules:  PPrelude
+  hs-source-dirs:   agora
+
   build-depends:
     , base
     , plutarch
 
-  exposed-modules:  PPrelude
-  hs-source-dirs:   agora
-  default-language: Haskell2010
-
 library agora-testlib
   import:          lang, deps, test-deps
   exposed-modules: Test.Util
@@ -165,17 +168,18 @@ library agora-testlib
 
 library agora-sample
   import:          lang, deps, test-deps
-  build-depends:   agora-testlib
   exposed-modules:
+    Sample.Effect.GovernorMutation
     Sample.Effect.TreasuryWithdrawal
     Sample.Governor
     Sample.Proposal
     Sample.Shared
     Sample.Stake
     Sample.Treasury
-
   hs-source-dirs:  agora-sample
 
+  build-depends:   agora-testlib
+
 test-suite agora-test
   import:         lang, deps, test-deps
   type:           exitcode-stdio-1.0
@@ -183,6 +187,7 @@ test-suite agora-test
   hs-source-dirs: agora-test
   other-modules:
     Spec.AuthorityToken
+    Spec.Effect.GovernorMutation
     Spec.Effect.TreasuryWithdrawal
     Spec.Governor
     Spec.Model.MultiSig
@@ -205,16 +210,26 @@ benchmark agora-bench
     , agora
     , agora-sample
 
+executable agora-scripts
+  import:         lang, deps, exe-opts
+  main-is:        Scripts.hs
+  hs-source-dirs: agora-scripts
+  other-modules:
+    Options
+  build-depends:
+    , agora
+    , optparse-applicative
+
 executable agora-purescript-bridge
   import:         lang, deps, exe-opts
   main-is:        Bridge.hs
+  hs-source-dirs: agora-purescript-bridge
+  other-modules:
+    AgoraTypes
+    Options
+
   build-depends:
     , agora
     , optparse-applicative
     , path
     , purescript-bridge
-
-  hs-source-dirs: agora-purescript-bridge
-  other-modules:
-    AgoraTypes
-    Options

agora/Agora/Aeson/Orphans.hs

@@ -0,0 +1,146 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Agora.Aeson.Orphans (AsBase16Bytes (..)) where
+
+--------------------------------------------------------------------------------
+
+import Data.Coerce (Coercible, coerce)
+import Prelude
+
+--------------------------------------------------------------------------------
+
+import Codec.Serialise qualified as Codec
+import Data.Aeson qualified as Aeson
+import Data.Aeson.Types qualified as Aeson
+import Data.ByteString.Lazy qualified as Lazy
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
+
+--------------------------------------------------------------------------------
+
+import Plutus.V1.Ledger.Api qualified as Plutus
+import Plutus.V1.Ledger.Bytes qualified as Plutus
+import Plutus.V1.Ledger.Value qualified as Plutus
+
+--------------------------------------------------------------------------------
+
+newtype AsBase16Bytes a = AsBase16Bytes {unAsBase16Bytes :: a}
+newtype AsBase16Codec a = AsBase16Codec {unAsBase16Codec :: a}
+
+deriving via
+  (Plutus.CurrencySymbol, Plutus.TokenName)
+  instance
+    Aeson.ToJSON Plutus.AssetClass
+
+deriving via
+  (Plutus.CurrencySymbol, Plutus.TokenName)
+  instance
+    Aeson.FromJSON Plutus.AssetClass
+
+deriving via
+  AsBase16Bytes Plutus.TxId
+  instance
+    Aeson.FromJSON Plutus.TxId
+
+deriving via
+  AsBase16Bytes Plutus.TxId
+  instance
+    Aeson.ToJSON Plutus.TxId
+
+deriving anyclass instance Aeson.FromJSON Plutus.TxOutRef
+deriving anyclass instance Aeson.ToJSON Plutus.TxOutRef
+
+instance (Coercible a Plutus.LedgerBytes) => Aeson.ToJSON (AsBase16Bytes a) where
+  toJSON =
+    Aeson.String
+      . Plutus.encodeByteString
+      . Plutus.bytes
+      . coerce @(AsBase16Bytes a) @Plutus.LedgerBytes
+
+instance (Coercible Plutus.LedgerBytes a) => Aeson.FromJSON (AsBase16Bytes a) where
+  parseJSON v =
+    Aeson.parseJSON @T.Text v
+      >>= either (Aeson.parserThrowError []) (pure . coerce @_ @(AsBase16Bytes a))
+        . Plutus.fromHex
+        . T.encodeUtf8
+
+instance (Codec.Serialise a) => Aeson.ToJSON (AsBase16Codec a) where
+  toJSON =
+    Aeson.String
+      . Plutus.encodeByteString
+      . Lazy.toStrict
+      . Codec.serialise @a
+      . (.unAsBase16Codec)
+
+instance (Codec.Serialise a) => Aeson.FromJSON (AsBase16Codec a) where
+  parseJSON v =
+    Aeson.parseJSON @T.Text v
+      >>= either (Aeson.parserThrowError [] . show) (pure . AsBase16Codec)
+        . Codec.deserialiseOrFail
+        . Lazy.fromStrict
+        . T.encodeUtf8
+
+--------------------------------------------------------------------------------
+
+deriving via
+  (AsBase16Bytes Plutus.CurrencySymbol)
+  instance
+    (Aeson.ToJSON Plutus.CurrencySymbol)
+deriving via
+  (AsBase16Bytes Plutus.CurrencySymbol)
+  instance
+    (Aeson.FromJSON Plutus.CurrencySymbol)
+
+deriving via
+  (AsBase16Bytes Plutus.TokenName)
+  instance
+    (Aeson.ToJSON Plutus.TokenName)
+deriving via
+  (AsBase16Bytes Plutus.TokenName)
+  instance
+    (Aeson.FromJSON Plutus.TokenName)
+
+deriving via
+  (AsBase16Bytes Plutus.ValidatorHash)
+  instance
+    (Aeson.ToJSON Plutus.ValidatorHash)
+deriving via
+  (AsBase16Bytes Plutus.ValidatorHash)
+  instance
+    (Aeson.FromJSON Plutus.ValidatorHash)
+
+deriving via
+  (AsBase16Codec Plutus.Validator)
+  instance
+    (Aeson.ToJSON Plutus.Validator)
+deriving via
+  (AsBase16Codec Plutus.Validator)
+  instance
+    (Aeson.FromJSON Plutus.Validator)
+
+deriving via
+  (AsBase16Codec Plutus.MintingPolicy)
+  instance
+    (Aeson.ToJSON Plutus.MintingPolicy)
+deriving via
+  (AsBase16Codec Plutus.MintingPolicy)
+  instance
+    (Aeson.FromJSON Plutus.MintingPolicy)
+
+deriving via
+  (AsBase16Codec Plutus.Script)
+  instance
+    (Aeson.ToJSON Plutus.Script)
+deriving via
+  (AsBase16Codec Plutus.Script)
+  instance
+    (Aeson.FromJSON Plutus.Script)
+
+deriving via
+  Integer
+  instance
+    (Aeson.ToJSON Plutus.POSIXTime)
+deriving via
+  Integer
+  instance
+    (Aeson.FromJSON Plutus.POSIXTime)

agora/Agora/Effect.hs

@@ -23,7 +23,7 @@ import Plutus.V1.Ledger.Value (CurrencySymbol)
 -}
 makeEffect ::
   forall (datum :: PType).
-  (PIsData datum, PTryFrom PData datum) =>
+  (PIsData datum, PTryFrom PData (PAsData datum)) =>
   CurrencySymbol ->
   (forall (s :: S). Term s PCurrencySymbol -> Term s datum -> Term s PTxOutRef -> Term s (PAsData PTxInfo) -> Term s POpaque) ->
   ClosedTerm PValidator
@@ -35,7 +35,7 @@ makeEffect gatCs' f =
     -- convert input datum, PData, into desierable type
     -- the way this conversion is performed should be defined
     -- by PTryFrom for each datum in effect script.
-    (datum', _) <- tctryFrom @datum datum
+    (pfromData -> datum', _) <- tctryFrom datum
 
     -- ensure purpose is Spending.
     PSpending txOutRef <- tcmatch $ pfromData ctx.purpose

agora/Agora/Effect/GovernorMutation.hs

@@ -0,0 +1,214 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{- |
+Module     : Agora.Effect.GovernorMutation
+Maintainer : connor@mlabs.city
+Description: An effect that mutates governor settings.
+
+An effect for mutating governor settings.
+-}
+module Agora.Effect.GovernorMutation (
+  -- * Haskell-land
+  MutateGovernorDatum (..),
+
+  -- * Plutarch-land
+  PMutateGovernorDatum (..),
+
+  -- * Scripts
+  mutateGovernorValidator,
+) where
+
+--------------------------------------------------------------------------------
+
+import Control.Applicative (Const)
+import GHC.Generics qualified as GHC
+import Generics.SOP (Generic, I (I))
+
+--------------------------------------------------------------------------------
+
+import Plutarch.Api.V1 (
+  PTxOutRef,
+  PValidator,
+  PValue,
+ )
+import Plutarch.Api.V1.Extra (pvalueOf)
+import Plutarch.DataRepr (
+  DerivePConstantViaData (..),
+  PDataFields,
+  PIsDataReprInstances (PIsDataReprInstances),
+ )
+import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
+import Plutarch.TryFrom (PTryFrom (..))
+import Plutarch.Unsafe (punsafeCoerce)
+
+--------------------------------------------------------------------------------
+
+import Plutus.V1.Ledger.Api (TxOutRef)
+import Plutus.V1.Ledger.Value (AssetClass (..))
+import PlutusTx qualified
+
+--------------------------------------------------------------------------------
+
+import Agora.Effect (makeEffect)
+import Agora.Governor (
+  Governor,
+  GovernorDatum,
+  PGovernorDatum,
+  governorDatumValid,
+ )
+import Agora.Governor.Scripts (
+  authorityTokenSymbolFromGovernor,
+  governorSTAssetClassFromGovernor,
+ )
+import Agora.Utils (
+  isScriptAddress,
+  mustBePDJust,
+  mustBePJust,
+  ptryFindDatum,
+  tcassert,
+ )
+
+--------------------------------------------------------------------------------
+
+-- | Haskell-level datum for the governor mutation effect script.
+data MutateGovernorDatum = MutateGovernorDatum
+  { governorRef :: TxOutRef
+  -- ^ Referenced governor state UTXO should be updated by the effect.
+  , newDatum :: GovernorDatum
+  -- ^ The new settings for the governor.
+  }
+  deriving stock (Show, GHC.Generic)
+  deriving anyclass (Generic)
+
+PlutusTx.makeIsDataIndexed ''MutateGovernorDatum [('MutateGovernorDatum, 0)]
+
+--------------------------------------------------------------------------------
+
+-- | Plutarch-level version of 'MutateGovernorDatum'.
+newtype PMutateGovernorDatum (s :: S)
+  = PMutateGovernorDatum
+      ( Term
+          s
+          ( PDataRecord
+              '[ "governorRef" ':= PTxOutRef
+               , "newDatum" ':= PGovernorDatum
+               ]
+          )
+      )
+  deriving stock (GHC.Generic)
+  deriving anyclass (Generic)
+  deriving anyclass (PIsDataRepr)
+  deriving
+    (PlutusType, PIsData, PDataFields, PEq)
+    via (PIsDataReprInstances PMutateGovernorDatum)
+
+instance PUnsafeLiftDecl PMutateGovernorDatum where type PLifted PMutateGovernorDatum = MutateGovernorDatum
+deriving via (DerivePConstantViaData MutateGovernorDatum PMutateGovernorDatum) instance (PConstantDecl MutateGovernorDatum)
+
+-- TODO: Derive this.
+instance PTryFrom PData (PAsData PMutateGovernorDatum) where
+  type PTryFromExcess PData (PAsData PMutateGovernorDatum) = Const ()
+  ptryFrom' d k =
+    k (punsafeCoerce d, ())
+
+--------------------------------------------------------------------------------
+
+{- | Validator for the governor mutation effect.
+
+  This effect is implemented using the 'Agora.Effect.makeEffect' wrapper,
+   meaning that the burning of GAT is checked in said wrapper.
+
+  In order to locate the governor, the validator is parametrized with a 'Agora.Governor.Governor'.
+
+  All the information it needs to validate the effect is encoded in the 'MutateGovernorDatum',
+   so regardless what redeemer it's given, it will check:
+
+  - No token is minted/burnt other than GAT.
+  - Nothing is being paid to the the effect validator.
+  - The governor's state UTXO must be spent:
+
+      * It carries exactly one GST.
+      * It's referenced by 'governorRef' in the effect's datum.
+
+  - A new state UTXO is paid to the governor:
+
+      * It contains the GST.
+      * It has valid governor state datum.
+      * The datum is exactly the same as the 'newDatum'.
+-}
+mutateGovernorValidator :: Governor -> ClosedTerm PValidator
+mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $
+  \_gatCs (datum :: Term _ PMutateGovernorDatum) _ txInfo -> unTermCont $ do
+    datumF <- tcont $ pletFields @'["newDatum", "governorRef"] datum
+    txInfoF <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums"] txInfo
+
+    let mint :: Term _ (PBuiltinList _)
+        mint = pto $ pto $ pto $ pfromData txInfoF.mint
+
+    tcassert "Nothing should be minted/burnt other than GAT" $
+      plength # mint #== 1
+
+    -- Only two script inputs are alloed: one from the effect, one from the governor.
+    tcassert "Only self and governor script inputs are allowed" $
+      pfoldr
+        # phoistAcyclic
+          ( plam $ \inInfo count ->
+              let address = pfield @"address" #$ pfield @"resolved" # inInfo
+               in pif
+                    (isScriptAddress # address)
+                    (count + 1)
+                    count
+          )
+        # (0 :: Term _ PInteger)
+        # pfromData txInfoF.inputs
+        #== 2
+
+    -- Find the governor input by looking for GST.
+    let inputWithGST =
+          mustBePJust # "Governor input not found" #$ pfind
+            # phoistAcyclic
+              ( plam $ \inInfo ->
+                  let value = pfield @"value" #$ pfield @"resolved" # inInfo
+                   in gstValueOf # value #== 1
+              )
+            # pfromData txInfoF.inputs
+
+    govInInfo <- tcont $ pletFields @'["outRef", "resolved"] $ inputWithGST
+
+    -- The effect can only modify the governor UTXO referenced in the datum.
+    tcassert "Can only modify the pinned governor" $
+      govInInfo.outRef #== datumF.governorRef
+
+    -- The transaction can only have one output, which should be sent to the governor.
+    tcassert "Only governor output is allowed" $
+      plength # pfromData txInfoF.outputs #== 1
+
+    let govAddress = pfield @"address" #$ govInInfo.resolved
+        govOutput' = pfromData $ phead # pfromData txInfoF.outputs
+
+    govOutput <- tcont $ pletFields @'["address", "value", "datumHash"] govOutput'
+
+    tcassert "No output to the governor" $
+      govOutput.address #== govAddress
+
+    tcassert "Governor output doesn't carry the GST" $
+      gstValueOf # govOutput.value #== 1
+
+    let governorOutputDatumHash =
+          mustBePDJust # "Governor output doesn't have datum" # govOutput.datumHash
+        governorOutputDatum =
+          pfromData @PGovernorDatum $
+            mustBePJust # "Governor output datum not found"
+              #$ ptryFindDatum # governorOutputDatumHash # txInfoF.datums
+
+    -- Ensure the output governor datum is what we want.
+    tcassert "Unexpected governor datum" $ datumF.newDatum #== governorOutputDatum
+    tcassert "New governor datum should be valid" $ governorDatumValid # governorOutputDatum
+
+    return $ popaque $ pconstant ()
+  where
+    -- Get the amount of GST in the a given value.
+    gstValueOf :: Term s (PValue :--> PInteger)
+    gstValueOf = phoistAcyclic $ plam $ \v -> pvalueOf # v # pconstant cs # pconstant tn
+      where
+        AssetClass (cs, tn) = governorSTAssetClassFromGovernor gov

agora/Agora/Effect/NoOp.hs

@@ -18,13 +18,13 @@ import Plutus.V1.Ledger.Value (CurrencySymbol)
 newtype PNoOp (s :: S) = PNoOp (Term s PUnit)
   deriving (PlutusType, PIsData) via (DerivePNewtype PNoOp PUnit)
 
-instance PTryFrom PData PNoOp where
+instance PTryFrom PData (PAsData PNoOp) where
-  type PTryFromExcess PData PNoOp = Const ()
+  type PTryFromExcess PData (PAsData PNoOp) = Const ()
   ptryFrom' _ cont =
     -- JUSTIFICATION:
     -- We don't care anything about data.
     -- It should always be reduced to Unit.
-    cont (pcon $ PNoOp (pconstant ()), ())
+    cont (pdata $ pcon $ PNoOp (pconstant ()), ())
 
 -- | Dummy effect which can only burn its GAT.
 noOpValidator :: CurrencySymbol -> ClosedTerm PValidator

agora/Agora/Effect/TreasuryWithdrawal.hs

@@ -18,7 +18,7 @@ import GHC.Generics qualified as GHC
 import Generics.SOP (Generic, I (I))
 
 import Agora.Effect (makeEffect)
-import Agora.Utils (findTxOutByTxOutRef, paddValue, tcassert, tclet, tcmatch)
+import Agora.Utils (findTxOutByTxOutRef, isPubKey, paddValue, tcassert, tclet, tcmatch)
 import Plutarch.Api.V1 (
   PCredential (..),
   PTuple,
@@ -82,8 +82,8 @@ deriving via
   instance
     (PConstantDecl TreasuryWithdrawalDatum)
 
-instance PTryFrom PData PTreasuryWithdrawalDatum where
+instance PTryFrom PData (PAsData PTreasuryWithdrawalDatum) where
-  type PTryFromExcess PData PTreasuryWithdrawalDatum = Const ()
+  type PTryFromExcess PData (PAsData PTreasuryWithdrawalDatum) = Const ()
   ptryFrom' opq cont =
     -- TODO: This should not use 'punsafeCoerce'.
     -- Blocked by 'PCredential', and 'PTuple'.
@@ -140,12 +140,6 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
         treasuryInputValuesSum = sumValues #$ ofTreasury # inputValues
         treasuryOutputValuesSum = sumValues #$ ofTreasury # outputValues
         receiverValuesSum = sumValues # datum.receivers
-        isPubkey = plam $ \cred ->
-          pmatch cred $
-            \case
-              PPubKeyCredential _ -> pcon PTrue
-              PScriptCredential _ -> pcon PFalse
-
         -- Constraints
         outputContentMatchesRecivers =
           pall # plam (\out -> pelem # out # outputValues)
@@ -165,7 +159,7 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
               ( \((pfield @"_0" #) . pfromData -> cred) ->
                   cred #== pfield @"credential" # effInput.address
                     #|| pelem # cred # datum.treasuries
-                    #|| isPubkey # pfromData cred
+                    #|| isPubKey # pfromData cred
               )
             # inputValues
 

agora/Agora/SafeMoney.hs

@@ -8,6 +8,9 @@ Tags and extras for "Plutarch.SafeMoney".
 module Agora.SafeMoney (
   ADATag,
   GTTag,
+  GovernorSTTag,
+  StakeSTTag,
+  ProposalSTTag,
   adaRef,
 ) where
 
@@ -18,7 +21,7 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
 import Plutarch.SafeMoney
 
 --------------------------------------------------------------------------------
--- Example tags
+-- Tags
 
 -- | Governance token.
 data GTTag
@@ -26,6 +29,15 @@ data GTTag
 -- | ADA.
 data ADATag
 
+-- | Governor ST token.
+data GovernorSTTag
+
+-- | Stake ST token.
+data StakeSTTag
+
+-- | Proposal ST token.
+data ProposalSTTag
+
 --------------------------------------------------------------------------------
 
 -- | Resolves ada tags.

agora/Agora/ScriptInfo.hs

@@ -0,0 +1,63 @@
+{- |
+Module     : Agora.ScriptInfo
+Maintainer : emi@haskell.fyi
+Description: Exportable script bundles for off-chain consumption.
+
+Exportable script bundles for off-chain consumption.
+-}
+module Agora.ScriptInfo (
+  -- * Types
+  PolicyInfo (..),
+  ValidatorInfo (..),
+
+  -- * Introduction functions
+  mkValidatorInfo,
+  mkPolicyInfo,
+) where
+
+import Agora.Aeson.Orphans ()
+import Data.Aeson qualified as Aeson
+import GHC.Generics qualified as GHC
+import Plutarch.Api.V1 (PMintingPolicy, PValidator, mintingPolicySymbol, mkMintingPolicy, mkValidator, validatorHash)
+import Plutus.V1.Ledger.Api (MintingPolicy, Validator, ValidatorHash)
+import Plutus.V1.Ledger.Value (CurrencySymbol)
+
+-- | Bundle containing a 'Validator' and its hash.
+data ValidatorInfo = ValidatorInfo
+  { script :: Validator
+  -- ^ The validator script.
+  , hash :: ValidatorHash
+  -- ^ Hash of the validator.
+  }
+  deriving stock (Show, Eq, GHC.Generic)
+  deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
+
+-- | Create a 'ValidatorInfo' given a Plutarch term.
+mkValidatorInfo :: ClosedTerm PValidator -> ValidatorInfo
+mkValidatorInfo term =
+  ValidatorInfo
+    { script = validator
+    , hash = validatorHash validator
+    }
+  where
+    validator = mkValidator term
+
+-- | Bundle containing a 'MintingPolicy' and its symbol.
+data PolicyInfo = PolicyInfo
+  { policy :: MintingPolicy
+  -- ^ The minting policy.
+  , currencySymbol :: CurrencySymbol
+  -- ^ The symbol given by the minting policy.
+  }
+  deriving stock (Show, Eq, GHC.Generic)
+  deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
+
+-- | Create a 'PolicyInfo' given a Plutarch term.
+mkPolicyInfo :: ClosedTerm PMintingPolicy -> PolicyInfo
+mkPolicyInfo term =
+  PolicyInfo
+    { policy = policy
+    , currencySymbol = mintingPolicySymbol policy
+    }
+  where
+    policy = mkMintingPolicy term

agora/Agora/Treasury.hs

@@ -72,6 +72,7 @@ deriving via
      do so in a valid manner.
 -}
 treasuryValidator ::
+  -- | Governance Authority Token that can unlock this validator.
   CurrencySymbol ->
   ClosedTerm PValidator
 treasuryValidator gatCs' = plam $ \_datum redeemer ctx' -> unTermCont $ do

agora/Agora/Utils.hs

@@ -58,6 +58,8 @@ module Agora.Utils (
   validatorHashToAddress,
   pmergeBy,
   phalve,
+  isScriptAddress,
+  isPubKey,
 ) where
 
 --------------------------------------------------------------------------------
@@ -210,7 +212,7 @@ pfromMaybe = phoistAcyclic $
       PJust a' -> a'
       PNothing -> e
 
--- | Yield True if a given PMaybe is of form PJust _.
+-- | Yield True if a given PMaybe is of form @'PJust' _@.
 pisJust :: forall a s. Term s (PMaybe a :--> PBool)
 pisJust = phoistAcyclic $
   plam $ \v' ->
@@ -579,6 +581,19 @@ scriptHashFromAddress = phoistAcyclic $
       PScriptCredential ((pfield @"_0" #) -> h) -> pcon $ PJust h
       _ -> pcon PNothing
 
+-- | Return true if the given address is a script address.
+isScriptAddress :: Term s (PAddress :--> PBool)
+isScriptAddress = phoistAcyclic $
+  plam $ \addr -> pnot #$ isPubKey #$ pfromData $ pfield @"credential" # addr
+
+-- | Return true if the given credential is a pub-key-hash.
+isPubKey :: Term s (PCredential :--> PBool)
+isPubKey = phoistAcyclic $
+  plam $ \cred ->
+    pmatch cred $ \case
+      PScriptCredential _ -> pconstant False
+      _ -> pconstant True
+
 -- | Find all TxOuts sent to an Address
 findOutputsToAddress :: Term s (PBuiltinList (PAsData PTxOut) :--> PAddress :--> PBuiltinList (PAsData PTxOut))
 findOutputsToAddress = phoistAcyclic $