diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index 709be31..5df4023 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -1,14 +1,3 @@ -{- | -Module: Main -Description: Agora test suite. -Maintainer: emi@haskell.fyi - -This module is the root of Agora's test suite. --} -module Main (main) where - --------------------------------------------------------------------------------- - import Prelude -------------------------------------------------------------------------------- @@ -42,6 +31,12 @@ main = , testGroup "Proposal tests" Proposal.tests + , testGroup + "AuthorityToken tests" + AuthorityToken.tests + , testGroup + "Treasury tests" + Treasury.tests , testGroup "Multisig tests" [ testGroup @@ -50,10 +45,4 @@ main = , MultiSig.genTests ] ] - , testGroup - "AuthorityToken tests" - AuthorityToken.tests - , testGroup - "Treasury tests" - Treasury.tests ] diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index bd4957f..bec7174 100644 --- a/agora-test/Spec/Sample/Shared.hs +++ b/agora-test/Spec/Sample/Shared.hs @@ -9,6 +9,8 @@ module Spec.Sample.Shared ( -- * Misc signer, signer2, + minAda, + withMinAda, -- * Components @@ -30,8 +32,16 @@ module Spec.Sample.Shared ( proposalPolicySymbol, proposalValidatorHash, proposalValidatorAddress, + + -- ** Treasury + treasuryOut, + gatTn, + gatCs, + mockTrEffect, + trCredential, ) where +import Agora.Effect.NoOp (noOpValidator) import Agora.Governor ( Governor (Governor), governorPolicy, @@ -47,6 +57,8 @@ import Agora.Proposal.Scripts ( ) import Agora.Stake (Stake (..)) import Agora.Stake.Scripts (stakePolicy, stakeValidator) +import Agora.Treasury (treasuryValidator) +import Agora.Utils (validatorHashToTokenName) import Plutarch.Api.V1 ( mintingPolicySymbol, mkMintingPolicy, @@ -62,7 +74,11 @@ import Plutus.V1.Ledger.Api ( MintingPolicy (..), PubKeyHash, ) +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 qualified as Value -------------------------------------------------------------------------------- @@ -131,3 +147,42 @@ defaultProposalThresholds = , create = Tagged 1 , startVoting = Tagged 10 } + +------------------------------------------------------------------ + +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 + +------------------------------------------------------------------ + +minAda :: Value +minAda = Value.singleton "" "" 10_000_000 + +withMinAda :: Value -> Value +withMinAda v = v <> minAda diff --git a/agora-test/Spec/Sample/Treasury.hs b/agora-test/Spec/Sample/Treasury.hs index 9255275..c4836d6 100644 --- a/agora-test/Spec/Sample/Treasury.hs +++ b/agora-test/Spec/Sample/Treasury.hs @@ -9,27 +9,14 @@ This module contains sample data, used in the tests written in `Spec.Treasury`. -} module Spec.Sample.Treasury ( - BadTreasuryRedeemer (NukeTheSystem), gatCs, validCtx, treasuryRef, gatTn, walletIn, - trCredential, ) where -import Agora.Effect.NoOp (noOpValidator) -import Agora.Treasury ( - treasuryValidator, - ) -import GHC.Generics qualified as GHC -import Generics.SOP (Generic, I (I)) -import Plutarch.Api.V1 (mkValidator, validatorHash) -import Plutarch.DataRepr ( - DerivePConstantViaData (..), - PIsDataReprInstances (..), - ) -import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) +import Plutarch.Api.V1 (validatorHash) import Plutus.V1.Ledger.Address (Address (..)) import Plutus.V1.Ledger.Api ( BuiltinByteString, @@ -47,26 +34,18 @@ import Plutus.V1.Ledger.Contexts ( import Plutus.V1.Ledger.Credential (Credential (ScriptCredential)) import Plutus.V1.Ledger.Interval qualified as Interval import Plutus.V1.Ledger.Scripts ( - Validator, ValidatorHash (ValidatorHash), ) -import Plutus.V1.Ledger.Value ( - CurrencySymbol, - TokenName (TokenName), - ) import Plutus.V1.Ledger.Value qualified as Value -import PlutusTx qualified -import Spec.Sample.Shared (signer) -import Spec.Util (datumPair, toDatumHash) - -{- | Arbitrary 'CurrencySymbol', representing the 'CurrencySymbol' - of a valid governance authority token (GAT). --} -gatCs :: CurrencySymbol -gatCs = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" - -trValidator :: Validator -trValidator = mkValidator (treasuryValidator gatCs) +import Spec.Sample.Shared ( + gatCs, + gatTn, + mockTrEffect, + signer, + treasuryOut, + withMinAda, + ) +import Spec.Util (datumPair) {- | A `ScriptContext` that should be compatible with treasury transactions. @@ -113,17 +92,11 @@ validCtx = , txInInfoResolved = TxOut { txOutAddress = - Address (ScriptCredential $ validatorHash mockEffect) Nothing - , txOutValue = Value.singleton gatCs gatTn 1 - , txOutDatumHash = Just (toDatumHash ()) + Address (ScriptCredential $ validatorHash mockTrEffect) Nothing + , txOutValue = withMinAda $ Value.singleton gatCs gatTn 1 + , txOutDatumHash = Nothing } } - treasuryOut :: TxOut = - TxOut - { txOutAddress = Address trCredential Nothing - , txOutValue = Value.singleton "" "" 0 - , txOutDatumHash = Just (toDatumHash ()) - } -- | Reference to treasury output. treasuryRef :: TxOutRef @@ -139,22 +112,6 @@ effectRef = "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3" 0 --- | `ScriptCredential` used for the dummy treasury validator. -trCredential :: Credential -trCredential = ScriptCredential $ validatorHash trValidator - --- | Mock effect script, used for testing. -mockEffect :: Validator -mockEffect = mkValidator $ noOpValidator gatCs - --- | The hash of the mock effect script. -addressBs :: BuiltinByteString -(ValidatorHash addressBs) = validatorHash mockEffect - --- | `TokenName` for GAT generated from address of `mockEffect`. -gatTn :: TokenName -gatTn = TokenName addressBs - -- | Input representing a user wallet with a valid GAT. walletIn :: TxInInfo walletIn = @@ -174,33 +131,5 @@ walletIn = } } --- | Unsupported treasury redeemer. -newtype BadTreasuryRedeemer - = -- | Unsupported treasury redeemer. - NukeTheSystem Integer - deriving stock (Eq, Show, GHC.Generic) - -PlutusTx.makeIsDataIndexed - ''BadTreasuryRedeemer - [ ('NukeTheSystem, 0) - ] - --- | Plutarch implementation of `BadTreasuryRedeemer`. -newtype PBadTreasuryRedeemer (s :: S) - = PNukeTheSystem (Term s (PDataRecord '["_0" ':= PInteger])) - deriving stock (GHC.Generic) - deriving anyclass (Generic) - deriving anyclass (PIsDataRepr) - deriving - (PlutusType, PIsData) - via PIsDataReprInstances PBadTreasuryRedeemer - -instance PUnsafeLiftDecl PBadTreasuryRedeemer where - type PLifted PBadTreasuryRedeemer = BadTreasuryRedeemer -deriving via - ( DerivePConstantViaData - BadTreasuryRedeemer - PBadTreasuryRedeemer - ) - instance - (PConstantDecl BadTreasuryRedeemer) +addressBs :: BuiltinByteString +(ValidatorHash addressBs) = validatorHash mockTrEffect diff --git a/agora-test/Spec/Treasury.hs b/agora-test/Spec/Treasury.hs index dd319d0..fc191c4 100644 --- a/agora-test/Spec/Treasury.hs +++ b/agora-test/Spec/Treasury.hs @@ -45,11 +45,15 @@ import Plutus.V1.Ledger.Scripts ( ValidatorHash (ValidatorHash), ) import Plutus.V1.Ledger.Value qualified as Value + +-- BadTreasuryRedeemer (NukeTheSystem), + +import Spec.Sample.Shared ( + trCredential, + ) import Spec.Sample.Treasury ( - -- BadTreasuryRedeemer (NukeTheSystem), gatCs, gatTn, - trCredential, treasuryRef, validCtx, walletIn, @@ -104,14 +108,7 @@ tests = StakingHash trCredential } ] - , -- , validatorFailsWith -- TODO: Check. - -- "Fails with invalid redeemer" - -- (treasuryValidator gatCs) - -- () - -- (NukeTheSystem 72) - -- validCtx - - validatorFailsWith -- TODO: Use QuickCheck. + , validatorFailsWith -- TODO: Use QuickCheck. "Fails when multiple GATs burned" (treasuryValidator gatCs) () diff --git a/agora.cabal b/agora.cabal index 2cbc0a8..0f5f221 100644 --- a/agora.cabal +++ b/agora.cabal @@ -111,6 +111,7 @@ common deps common test-deps build-depends: + , agora , apropos , apropos-tx , lens @@ -137,11 +138,10 @@ library Agora.Stake Agora.Stake.Scripts Agora.Treasury - - other-modules: Agora.Utils Agora.Utils.Value + other-modules: hs-source-dirs: agora library pprelude