Merge branch 'master' into connor/governor

agora-test/Spec/Sample/Shared.hs

@@ -40,8 +40,17 @@ module Spec.Sample.Shared (
   -- ** Authority
   authorityToken,
   authorityTokenSymbol,
+
+  -- ** Treasury
+  treasuryOut,
+  gatTn,
+  gatCs,
+  mockTrEffect,
+  trCredential,
+  wrongEffHash,
 ) where
 
+import Agora.Effect.NoOp (noOpValidator)
 import Agora.AuthorityToken
 import Agora.Governor (
   Governor (Governor),
@@ -66,10 +75,13 @@ import Agora.Proposal (
   ProposalThresholds (..),
  )
 import Agora.Stake (Stake (..))
+import Agora.Treasury (treasuryValidator)
+import Agora.Utils (validatorHashToTokenName)
 import Plutarch.Api.V1 (
   mintingPolicySymbol,
   mkMintingPolicy,
   mkValidator,
+  validatorHash
  )
 import Plutarch.SafeMoney
 import Plutus.V1.Ledger.Address (scriptHashAddress)
@@ -82,8 +94,11 @@ import Plutus.V1.Ledger.Api (
   TxOutRef (TxOutRef),
   Value,
  )
-import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash)
-import Plutus.V1.Ledger.Value (AssetClass)
+import Plutus.V1.Ledger.Contexts (
+  TxOut (..),
+ )
+import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash (..))
+import Plutus.V1.Ledger.Value (TokenName, AssetClass)
 import Plutus.V1.Ledger.Value qualified as Value
 
 --------------------------------------------------------------------------------
@@ -163,11 +178,52 @@ defaultProposalThresholds =
     , startVoting = Tagged 10
     }
 
-minAda :: Value
-minAda = Value.singleton "" "" 10_000_000
-
 authorityToken :: AuthorityToken
 authorityToken = authorityTokenFromGovernor governor
 
 authorityTokenSymbol :: CurrencySymbol
 authorityTokenSymbol = authorityTokenSymbolFromGovernor governor
+
+------------------------------------------------------------------
+
+treasuryOut :: TxOut
+treasuryOut =
+  TxOut
+    { txOutAddress = Address trCredential Nothing
+    , txOutValue = minAda
+    , txOutDatumHash = Nothing
+    }
+
+{- | Arbitrary 'CurrencySymbol', representing the 'CurrencySymbol'
+     of a valid governance authority token (GAT).
+-}
+gatCs :: CurrencySymbol
+gatCs = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+
+trValidator :: Validator
+trValidator = mkValidator (treasuryValidator gatCs)
+
+-- | `ScriptCredential` used for the dummy treasury validator.
+trCredential :: Credential
+trCredential = ScriptCredential $ validatorHash trValidator
+
+-- | `TokenName` for GAT generated from address of `mockTrEffect`.
+gatTn :: TokenName
+gatTn = validatorHashToTokenName $ validatorHash mockTrEffect
+
+-- | Mock treasury effect script, used for testing.
+mockTrEffect :: Validator
+mockTrEffect = mkValidator $ noOpValidator gatCs
+
+{- | A SHA-256 hash which (in all certainty) should not match the
+     hash of the dummy effect script.
+-}
+wrongEffHash :: ValidatorHash
+wrongEffHash =
+  ValidatorHash
+    "a21bc4a1d95600f9fa0a00b97ed0fa49a152a72de76253cb706f90b4b40f837b"
+
+------------------------------------------------------------------
+
+minAda :: Value
+minAda = Value.singleton "" "" 10_000_000

agora-test/Spec/Sample/Treasury.hs

@@ -0,0 +1,163 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{- |
+Module: Spec.Sample.Treasury
+Description: Sample data for `Spec.Treasury`.
+Maintainer: jack@mlabs.city
+
+This module contains sample data, used in the tests written in
+`Spec.Treasury`.
+-}
+module Spec.Sample.Treasury (
+  gatCs,
+  validCtx,
+  treasuryRef,
+  gatTn,
+  walletIn,
+  trCtxGATNameNotAddress,
+) where
+
+import Plutarch.Api.V1 (validatorHash)
+import Plutus.V1.Ledger.Address (Address (..))
+import Plutus.V1.Ledger.Api (
+  BuiltinByteString,
+  Credential (PubKeyCredential),
+  PubKeyHash (PubKeyHash),
+ )
+import Plutus.V1.Ledger.Contexts (
+  ScriptContext (..),
+  ScriptPurpose (Minting),
+  TxInInfo (..),
+  TxInfo (..),
+  TxOut (..),
+  TxOutRef (..),
+ )
+import Plutus.V1.Ledger.Credential (Credential (ScriptCredential))
+import Plutus.V1.Ledger.Interval qualified as Interval
+import Plutus.V1.Ledger.Scripts (
+  ValidatorHash (ValidatorHash),
+ )
+import Plutus.V1.Ledger.Value qualified as Value
+import Spec.Sample.Shared (
+  gatCs,
+  gatTn,
+  minAda,
+  mockTrEffect,
+  signer,
+  treasuryOut,
+  wrongEffHash,
+ )
+import Spec.Util (datumPair)
+
+{- | A `ScriptContext` that should be compatible with treasury
+     transactions.
+-}
+validCtx :: ScriptContext
+validCtx =
+  ScriptContext
+    { scriptContextPurpose = Minting gatCs
+    , scriptContextTxInfo =
+        TxInfo
+          { txInfoInputs =
+              [ treasuryIn
+              , effectIn
+              ]
+          , txInfoOutputs =
+              [ treasuryOut
+              ]
+          , -- Ensure sufficient ADA for transaction costs.
+            txInfoFee = Value.singleton "" "" 2 -- 2 ADA.
+          , -- Burn the GAT.
+            txInfoMint = Value.singleton gatCs gatTn (-1)
+          , txInfoDCert = []
+          , txInfoWdrl = []
+          , txInfoValidRange = Interval.always
+          , txInfoSignatories = [signer]
+          , txInfoData =
+              [ datumPair treasuryIn
+              , datumPair treasuryOut
+              , datumPair effectIn
+              ]
+          , txInfoId =
+              "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+          }
+    }
+  where
+    treasuryIn =
+      TxInInfo
+        { txInInfoOutRef = treasuryRef
+        , txInInfoResolved = treasuryOut
+        }
+    effectIn =
+      TxInInfo
+        { txInInfoOutRef = effectRef
+        , txInInfoResolved =
+            TxOut
+              { txOutAddress =
+                  Address (ScriptCredential $ validatorHash mockTrEffect) Nothing
+              , txOutValue =
+                  mconcat
+                    [ Value.singleton gatCs gatTn 1
+                    , minAda
+                    ]
+              , txOutDatumHash = Nothing
+              }
+        }
+
+-- | Reference to treasury output.
+treasuryRef :: TxOutRef
+treasuryRef =
+  TxOutRef
+    "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+    1
+
+-- | Reference to dummy effect output.
+effectRef :: TxOutRef
+effectRef =
+  TxOutRef
+    "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+    0
+
+-- | Input representing a user wallet with a valid GAT.
+walletIn :: TxInInfo
+walletIn =
+  TxInInfo
+    { txInInfoOutRef =
+        TxOutRef
+          "cf4a8b33dd8e4493187e3339ecc3802d0cc000c947fb5559b7614153947d4e83"
+          0
+    , txInInfoResolved =
+        TxOut
+          { txOutDatumHash = Nothing
+          , txOutValue = Value.singleton gatCs gatTn 1
+          , txOutAddress =
+              Address
+                (PubKeyCredential $ PubKeyHash addressBs)
+                Nothing
+          }
+    }
+
+addressBs :: BuiltinByteString
+(ValidatorHash addressBs) = validatorHash mockTrEffect
+
+trCtxGATNameNotAddress :: ScriptContext
+trCtxGATNameNotAddress =
+  let txInfo = validCtx.scriptContextTxInfo
+      inputs = txInfo.txInfoInputs
+      effectIn = inputs !! 1
+      invalidEff =
+        effectIn
+          { txInInfoResolved =
+              effectIn.txInInfoResolved
+                { txOutAddress = Address (ScriptCredential wrongEffHash) Nothing
+                }
+          }
+   in validCtx
+        { scriptContextTxInfo =
+            txInfo
+              { txInfoInputs =
+                  [ head inputs
+                  , invalidEff
+                  ]
+              }
+        }