diff --git a/agora-test/Spec/Governor.hs b/agora-test/Spec/Governor.hs index 3d567f7..9999ba5 100644 --- a/agora-test/Spec/Governor.hs +++ b/agora-test/Spec/Governor.hs @@ -7,7 +7,7 @@ Tests for Governor policy and validator -} module Spec.Governor (tests) where -import Test.Tasty (TestTree, testGroup) +import Test.Tasty (TestTree) -------------------------------------------------------------------------------- diff --git a/agora-test/Spec/Sample/Governor.hs b/agora-test/Spec/Sample/Governor.hs index 28df5ad..1dbbfba 100644 --- a/agora-test/Spec/Sample/Governor.hs +++ b/agora-test/Spec/Sample/Governor.hs @@ -5,4 +5,450 @@ Description: Sample based testing for Governor utxos This module tests primarily the happy path for Governor interactions -} -module Spec.Sample.Governor () where +module Spec.Sample.Governor (proposalCreation, mutateState, mintGAT) where + +-------------------------------------------------------------------------------- + +import Plutarch.Api.V1 (mkValidator, validatorHash) +import Plutarch.SafeMoney.Tagged + +-------------------------------------------------------------------------------- + +import Plutus.V1.Ledger.Address (scriptHashAddress) +import Plutus.V1.Ledger.Api ( + Address, + Datum (..), + ScriptContext (..), + ScriptPurpose (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 +import Agora.Governor +import Agora.Proposal +import Agora.Proposal qualified as P +import Agora.Stake + +-------------------------------------------------------------------------------- + +import Spec.Sample.Shared +import Spec.Util (datumPair, toDatumHash) + +-------------------------------------------------------------------------------- + +-- | This script context should be a valid transaction. +proposalCreation :: ScriptContext +proposalCreation = + 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, []) + , (ResultTag 1, []) + ] + 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 = withMinAda pst + , 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 = withMinAda gst + } + + --- + + 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 = withMinAda sst <> Value.assetClassValue (untag stake.gtClassRef) stackedGTs + } + + --- + 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. +mintGAT :: ScriptContext +mintGAT = + 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, []) + , (ResultTag 1, [(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 + , -- TODO: Any need to check minimun amount of cosigners here? + 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 = withMinAda gst + } + + --- + + proposalOutputDatum' :: ProposalDatum + proposalOutputDatum' = proposalInputDatum' {status = Finished} + proposalOutputDatum :: Datum + proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum' + proposalOutput :: TxOut + proposalOutput = + proposalInput + { txOutDatumHash = Just $ toDatumHash proposalOutputDatum + , txOutValue = withMinAda pst + } + + -- + + mockEffectOutput :: TxOut + mockEffectOutput = + TxOut + { txOutAddress = mockEffectAddress + , txOutDatumHash = Just $ toDatumHash mockEffectOutputDatum + , txOutValue = withMinAda gat + } + + -- + + 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 + } + +-- | This script context should be a valid transaction. +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 = withMinAda gst + } + + -- + + 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, signer2] + , txInfoData = + datumPair + <$> [ governorInputDatum + , governorOutputDatum + , mockEffectInputDatum + , mockEffectOutputDatum + ] + , txInfoId = "9a12a605086a9f866731869a42d0558036fc739c74fea3849aa41562c015aaf9" + } + , scriptContextPurpose = Spending ownInputRef + } \ No newline at end of file diff --git a/agora-test/Spec/Sample/Shared.hs b/agora-test/Spec/Sample/Shared.hs index 923da45..771299f 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 @@ -24,6 +26,9 @@ module Spec.Sample.Shared ( govPolicy, govValidator, govSymbol, + govAssetClass, + govValidatorAddress, + govValidatorHash, -- ** Proposal defaultProposalThresholds, @@ -31,6 +36,10 @@ module Spec.Sample.Shared ( proposalPolicySymbol, proposalValidatorHash, proposalValidatorAddress, + + -- ** Authority + authorityToken , + authorityTokenSymbol, ) where import Agora.Governor ( @@ -38,14 +47,18 @@ import Agora.Governor ( ) import Agora.Governor.Scripts ( governorPolicy, + governorSTAssetClassFromGovernor, governorValidator, + governorValidatorHash, proposalFromGovernor, proposalSTSymbolFromGovernor, proposalValidatorHashFromGovernor, stakeFromGovernor, stakeSTAssetClassFromGovernor, stakeSTSymbolFromGovernor, - stakeValidatorHashFromGovernor, + stakeValidatorHashFromGovernor, + authorityTokenFromGovernor, + authorityTokenSymbolFromGovernor, ) import Agora.Proposal ( Proposal (..), @@ -66,10 +79,12 @@ import Plutus.V1.Ledger.Api ( MintingPolicy (..), PubKeyHash, TxOutRef (TxOutRef), + Value, ) import Plutus.V1.Ledger.Scripts (Validator, ValidatorHash) import Plutus.V1.Ledger.Value (AssetClass) import Plutus.V1.Ledger.Value qualified as Value +import Agora.AuthorityToken -------------------------------------------------------------------------------- @@ -109,6 +124,15 @@ 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 = proposalFromGovernor governor @@ -136,3 +160,15 @@ defaultProposalThresholds = , create = Tagged 1 , startVoting = Tagged 10 } + +minAda :: Value +minAda = Value.singleton "" "" 10_000_000 + +withMinAda :: Value -> Value +withMinAda v = v <> minAda + +authorityToken :: AuthorityToken +authorityToken = authorityTokenFromGovernor governor + +authorityTokenSymbol :: CurrencySymbol +authorityTokenSymbol = authorityTokenSymbolFromGovernor governor \ No newline at end of file diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 57e40f1..3beafe5 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -17,8 +17,9 @@ module Agora.Governor ( PGovernorDatum (..), PGovernorRedeemer (..), - -- * Plutus Utilities + -- * Utilities pgetNextProposalId, + getNextProposalId, ) where -------------------------------------------------------------------------------- @@ -32,7 +33,7 @@ import Generics.SOP (Generic, I (I)) import Agora.Proposal ( PProposalId (..), PProposalThresholds, - ProposalId, + ProposalId (ProposalId), ProposalThresholds, ) import Agora.SafeMoney (GTTag) @@ -153,6 +154,10 @@ deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom -------------------------------------------------------------------------------- --- | Get next proposal id. +-- | 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 diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index d1097df..0ed9a9e 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -25,6 +25,9 @@ module Agora.Governor.Scripts ( proposalValidatorHashFromGovernor, proposalSTSymbolFromGovernor, stakeSTAssetClassFromGovernor, + governorValidatorHash, + authorityTokenFromGovernor, + authorityTokenSymbolFromGovernor, ) where -------------------------------------------------------------------------------- @@ -745,3 +748,17 @@ proposalValidatorHashFromGovernor gov = validatorHash validator where params = proposalFromGovernor gov validator = mkValidator $ proposalValidator params + +governorValidatorHash :: Governor -> ValidatorHash +governorValidatorHash gov = validatorHash validator + where + validator = mkValidator $ governorValidator gov + +authorityTokenFromGovernor :: Governor -> AuthorityToken +authorityTokenFromGovernor gov = AuthorityToken $ governorSTAssetClassFromGovernor gov + +authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol +authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy + where + policy = mkMintingPolicy $ authorityTokenPolicy params + params = authorityTokenFromGovernor gov \ No newline at end of file