Merge branch 'master' into connor/governor
This commit is contained in:
fanghr
commit
cee0f4a67a
9 changed files with 421 additions and 24 deletions
|
|
@ -1,5 +1,3 @@
|
|||
--------------------------------------------------------------------------------
|
||||
|
||||
import Prelude
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -14,6 +12,7 @@ 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
|
||||
import Spec.Treasury qualified as Treasury
|
||||
|
||||
-- | The Agora test suite.
|
||||
main :: IO ()
|
||||
|
|
@ -33,6 +32,18 @@ main =
|
|||
, testGroup
|
||||
"Proposal tests"
|
||||
Proposal.tests
|
||||
, testGroup
|
||||
"AuthorityToken tests"
|
||||
AuthorityToken.tests
|
||||
, testGroup
|
||||
"Treasury tests"
|
||||
Treasury.tests
|
||||
, testGroup
|
||||
"AuthorityToken tests"
|
||||
AuthorityToken.tests
|
||||
, testGroup
|
||||
"Governor tests"
|
||||
Governor.tests
|
||||
, testGroup
|
||||
"Multisig tests"
|
||||
[ testGroup
|
||||
|
|
@ -41,10 +52,4 @@ main =
|
|||
, MultiSig.genTests
|
||||
]
|
||||
]
|
||||
, testGroup
|
||||
"AuthorityToken tests"
|
||||
AuthorityToken.tests
|
||||
, testGroup
|
||||
"Governor tests"
|
||||
Governor.tests
|
||||
]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
163
agora-test/Spec/Sample/Treasury.hs
Normal file
163
agora-test/Spec/Sample/Treasury.hs
Normal file
|
|
@ -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
|
||||
]
|
||||
}
|
||||
}
|
||||
142
agora-test/Spec/Treasury.hs
Normal file
142
agora-test/Spec/Treasury.hs
Normal file
|
|
@ -0,0 +1,142 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
{- |
|
||||
Module: Spec.Treasury
|
||||
Description: Tests for Agora treasury.
|
||||
Maintainer: jack@mlabs.city
|
||||
|
||||
This module exports `tests`, a list of `TestTree`s, which ensure
|
||||
that Agora's treasury component works as desired.
|
||||
|
||||
Tests need to fail when:
|
||||
|
||||
1. The reedeemer is of inproper form. TODO: Inquire.
|
||||
2. The script purpose is not minting.
|
||||
3. `singleAuthorityTokenBurned` returns false.
|
||||
a. @n /= -1@ GATs burned.
|
||||
b. An input returns 'False' for 'authorityTokensValidIn'
|
||||
i. A wallet input has a GAT.
|
||||
ii. A script has a GAT, the token name for which does /not/
|
||||
match the script's validator hash.
|
||||
-}
|
||||
module Spec.Treasury (tests) where
|
||||
|
||||
import Agora.Treasury (
|
||||
TreasuryRedeemer (SpendTreasuryGAT),
|
||||
treasuryValidator,
|
||||
)
|
||||
import Plutus.V1.Ledger.Api (
|
||||
DCert (DCertDelegRegKey),
|
||||
)
|
||||
import Plutus.V1.Ledger.Contexts (
|
||||
ScriptContext (scriptContextPurpose, scriptContextTxInfo),
|
||||
ScriptPurpose (Certifying, Rewarding, Spending),
|
||||
TxInfo (txInfoInputs, txInfoMint),
|
||||
)
|
||||
import Plutus.V1.Ledger.Credential (
|
||||
StakingCredential (StakingHash),
|
||||
)
|
||||
import Plutus.V1.Ledger.Value qualified as Value
|
||||
import Spec.Sample.Shared (
|
||||
trCredential,
|
||||
)
|
||||
import Spec.Sample.Treasury (
|
||||
gatCs,
|
||||
gatTn,
|
||||
trCtxGATNameNotAddress,
|
||||
treasuryRef,
|
||||
validCtx,
|
||||
walletIn,
|
||||
)
|
||||
import Spec.Util (validatorFailsWith, validatorSucceedsWith)
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
|
||||
tests :: [TestTree]
|
||||
tests =
|
||||
[ testGroup
|
||||
"Validator"
|
||||
[ testGroup
|
||||
"Positive"
|
||||
[ validatorSucceedsWith
|
||||
"Allows for effect changes"
|
||||
(treasuryValidator gatCs)
|
||||
()
|
||||
SpendTreasuryGAT
|
||||
validCtx
|
||||
]
|
||||
, testGroup
|
||||
"Negative"
|
||||
[ testGroup
|
||||
"Fails with ScriptPurpose not Minting"
|
||||
[ validatorFailsWith
|
||||
"Spending"
|
||||
(treasuryValidator gatCs)
|
||||
()
|
||||
SpendTreasuryGAT
|
||||
validCtx
|
||||
{ scriptContextPurpose = Spending treasuryRef
|
||||
}
|
||||
, validatorFailsWith
|
||||
"Rewarding"
|
||||
(treasuryValidator gatCs)
|
||||
()
|
||||
SpendTreasuryGAT
|
||||
validCtx
|
||||
{ scriptContextPurpose =
|
||||
Rewarding $
|
||||
StakingHash trCredential
|
||||
}
|
||||
, validatorFailsWith
|
||||
"Certifying"
|
||||
(treasuryValidator gatCs)
|
||||
()
|
||||
SpendTreasuryGAT
|
||||
validCtx
|
||||
{ scriptContextPurpose =
|
||||
Certifying $
|
||||
DCertDelegRegKey $
|
||||
StakingHash trCredential
|
||||
}
|
||||
]
|
||||
, validatorFailsWith -- TODO: Use QuickCheck.
|
||||
"Fails when multiple GATs burned"
|
||||
(treasuryValidator gatCs)
|
||||
()
|
||||
SpendTreasuryGAT
|
||||
validCtx
|
||||
{ scriptContextTxInfo =
|
||||
validCtx.scriptContextTxInfo
|
||||
{ txInfoMint =
|
||||
Value.singleton
|
||||
gatCs
|
||||
gatTn
|
||||
(-2)
|
||||
}
|
||||
}
|
||||
, validatorFailsWith
|
||||
"Fails when GAT token name is not script address"
|
||||
(treasuryValidator gatCs)
|
||||
()
|
||||
SpendTreasuryGAT
|
||||
trCtxGATNameNotAddress
|
||||
, validatorFailsWith
|
||||
"Fails with wallet as input"
|
||||
(treasuryValidator gatCs)
|
||||
()
|
||||
SpendTreasuryGAT
|
||||
( let txInfo = validCtx.scriptContextTxInfo
|
||||
inputs = txInfo.txInfoInputs
|
||||
newInputs =
|
||||
[ head inputs
|
||||
, walletIn
|
||||
]
|
||||
in validCtx
|
||||
{ scriptContextTxInfo =
|
||||
txInfo
|
||||
{ txInfoInputs = newInputs
|
||||
}
|
||||
}
|
||||
)
|
||||
]
|
||||
]
|
||||
]
|
||||
|
|
@ -3,7 +3,24 @@ Module : Spec.Util
|
|||
Maintainer : emi@haskell.fyi
|
||||
Description: Utility functions for testing Plutarch scripts with ScriptContext
|
||||
|
||||
Utility functions for testing Plutarch scripts with ScriptContext
|
||||
Utility functions for testing Plutarch scripts with ScriptContext:
|
||||
|
||||
- 'policySucceedsWith': checks that a minting policy succeeds.
|
||||
|
||||
- 'policyFailsWith': checks that a minting policy fails.
|
||||
|
||||
- 'validatorSucceedsWith': checks that validator succeeds.
|
||||
|
||||
- 'validatorFailsWith': checks that validator fails.
|
||||
|
||||
- 'effectSucceedsWith': checks that effect succeeds.
|
||||
|
||||
- 'effectFailsWith': checks that effect fails.
|
||||
|
||||
- 'scriptSucceeds': checks that an arbitrary script does not
|
||||
`perror`.
|
||||
|
||||
- 'scriptFails': checks that an arbitrary script `perror`s out.
|
||||
-}
|
||||
module Spec.Util (
|
||||
-- * Testing utils
|
||||
|
|
@ -131,7 +148,9 @@ validatorFailsWith tag validator datum redeemer scriptContext =
|
|||
# pconstant scriptContext
|
||||
)
|
||||
|
||||
-- | Check that a validator script succeeds, given a name and arguments.
|
||||
{- | Check that a validator script succeeds, given a name and arguments.
|
||||
TODO: Change docstring.
|
||||
-}
|
||||
effectSucceedsWith ::
|
||||
( PLift datum
|
||||
, PlutusTx.ToData (PLifted datum)
|
||||
|
|
@ -143,7 +162,11 @@ effectSucceedsWith ::
|
|||
TestTree
|
||||
effectSucceedsWith tag eff datum = validatorSucceedsWith tag eff datum ()
|
||||
|
||||
-- | Check that a validator script fails, given a name and arguments.
|
||||
-- TODO: Change docstring.
|
||||
|
||||
{- | Check that a validator script fails, given a name and arguments.
|
||||
TODO: Change docstring.
|
||||
-}
|
||||
effectFailsWith ::
|
||||
( PLift datum
|
||||
, PlutusTx.ToData (PLifted datum)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue