diff --git a/agora-test/Spec.hs b/agora-test/Spec.hs index 40a7b7f..22c5b49 100644 --- a/agora-test/Spec.hs +++ b/agora-test/Spec.hs @@ -11,6 +11,7 @@ import Test.Tasty (defaultMain, testGroup) import Spec.AuthorityToken qualified as AuthorityToken import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal import Spec.Model.MultiSig qualified as MultiSig +import Spec.Proposal qualified as Proposal import Spec.Stake qualified as Stake -- | The Agora test suite. @@ -28,6 +29,9 @@ main = , testGroup "Stake tests" Stake.tests + , testGroup + "Proposal tests" + Proposal.tests , testGroup "Multisig tests" [ testGroup diff --git a/agora-test/Spec/Proposal.hs b/agora-test/Spec/Proposal.hs new file mode 100644 index 0000000..4d3c4e3 --- /dev/null +++ b/agora-test/Spec/Proposal.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE QuasiQuotes #-} + +{- | +Module : Spec.Proposal +Maintainer : emi@haskell.fyi +Description: Tests for Proposal policy and validator + +Tests for Proposal policy and validator +-} +module Spec.Proposal (tests) where + +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- + +import Agora.Proposal (proposalPolicy) +import Spec.Sample.Proposal qualified as Proposal +import Spec.Util (policySucceedsWith) +import Test.Tasty (TestTree, testGroup) + +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- + +-- | Stake tests. +tests :: [TestTree] +tests = + [ testGroup + "policy" + [ policySucceedsWith + "stakeCreation" + (proposalPolicy Proposal.proposal) + () + Proposal.proposalCreation + ] + ] diff --git a/agora-test/Spec/Sample/Proposal.hs b/agora-test/Spec/Sample/Proposal.hs new file mode 100644 index 0000000..ba4a3bb --- /dev/null +++ b/agora-test/Spec/Sample/Proposal.hs @@ -0,0 +1,198 @@ +{- | +Module : Spec.Sample.Proposal +Maintainer : emi@haskell.fyi +Description: Sample based testing for Proposal utxos + +This module tests primarily the happy path for Proposal interactions +-} +module Spec.Sample.Proposal ( + proposal, + policy, + policySymbol, + validatorHashTN, + signer, + + -- * Script contexts + proposalCreation, +) where + +-------------------------------------------------------------------------------- +import Plutarch.Api.V1 ( + mintingPolicySymbol, + mkMintingPolicy, + mkValidator, + validatorHash, + ) +import Plutus.V1.Ledger.Api ( + Address (Address), + Credential (ScriptCredential), + CurrencySymbol, + Datum (Datum), + MintingPolicy (..), + PubKeyHash, + ScriptContext (..), + ScriptPurpose (..), + ToData (toBuiltinData), + TxInInfo (TxInInfo), + TxInfo (..), + TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue), + TxOutRef (TxOutRef), + ValidatorHash (ValidatorHash), + ) +import Plutus.V1.Ledger.Interval qualified as Interval +import Plutus.V1.Ledger.Scripts (Validator) +import Plutus.V1.Ledger.Value (AssetClass (AssetClass), TokenName (TokenName)) +import Plutus.V1.Ledger.Value qualified as Value + +-------------------------------------------------------------------------------- + +import Agora.Governor ( + Governor (Governor), + GovernorDatum (GovernorDatum, nextProposalId, proposalThresholds), + governorPolicy, + governorValidator, + ) +import Agora.Proposal +import Plutarch.SafeMoney +import PlutusTx.AssocMap qualified as AssocMap +import Spec.Util (datumPair, toDatumHash) + +-------------------------------------------------------------------------------- + +governor :: Governor +governor = Governor + +govPolicy :: MintingPolicy +govPolicy = mkMintingPolicy (governorPolicy governor) + +govValidator :: Validator +govValidator = mkValidator (governorValidator governor) + +govSymbol :: CurrencySymbol +govSymbol = mintingPolicySymbol govPolicy + +proposal :: Proposal +proposal = + Proposal + { governorSTAssetClass = + -- TODO: if we had a governor here + AssetClass + ( govSymbol + , "" + ) + } + +-- | 'Proposal' policy instance. +policy :: MintingPolicy +policy = mkMintingPolicy (proposalPolicy proposal) + +policySymbol :: CurrencySymbol +policySymbol = mintingPolicySymbol policy + +-- | A sample 'PubKeyHash'. +signer :: PubKeyHash +signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c" + +-- | 'Proposal' validator instance. +validator :: Validator +validator = mkValidator (proposalValidator proposal) + +-- | 'TokenName' that represents the hash of the 'Proposal' validator. +validatorHashTN :: TokenName +validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh + +propThresholds :: ProposalThresholds +propThresholds = + ProposalThresholds + { countVoting = Tagged 1000 + , create = Tagged 1 + , vote = Tagged 10 + } + +-- | This script context should be a valid transaction. +proposalCreation :: ScriptContext +proposalCreation = + let st = Value.singleton policySymbol "" 1 -- Proposal ST + proposalDatum :: Datum + proposalDatum = + Datum + ( toBuiltinData $ + ProposalDatum + { proposalId = ProposalId 0 + , effects = + AssocMap.fromList + [ (ResultTag 0, []) + , (ResultTag 1, []) + ] + , status = Draft + , cosigners = [signer] + , thresholds = propThresholds + , votes = ProposalVotes $ AssocMap.empty + } + ) + + govBefore :: Datum + govBefore = + Datum + ( toBuiltinData $ + GovernorDatum + { proposalThresholds = propThresholds + , nextProposalId = ProposalId 0 + } + ) + govAfter :: Datum + govAfter = + Datum + ( toBuiltinData $ + GovernorDatum + { proposalThresholds = propThresholds + , nextProposalId = ProposalId 1 + } + ) + in ScriptContext + { scriptContextTxInfo = + TxInfo + { txInfoInputs = + [ TxInInfo + (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) + TxOut + { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing + , txOutValue = Value.assetClassValue proposal.governorSTAssetClass 1 + , txOutDatumHash = Just (toDatumHash govBefore) + } + ] + , txInfoOutputs = + [ TxOut + { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing + , txOutValue = + mconcat + [ st + , Value.singleton "" "" 10_000_000 + ] + , txOutDatumHash = Just (toDatumHash proposalDatum) + } + , TxOut + { txOutAddress = Address (ScriptCredential $ validatorHash govValidator) Nothing + , txOutValue = + mconcat + [ Value.assetClassValue proposal.governorSTAssetClass 1 + , Value.singleton "" "" 10_000_000 + ] + , txOutDatumHash = Just (toDatumHash govAfter) + } + ] + , txInfoFee = Value.singleton "" "" 2 + , txInfoMint = st + , txInfoDCert = [] + , txInfoWdrl = [] + , txInfoValidRange = Interval.always + , txInfoSignatories = [signer] + , txInfoData = + [ datumPair proposalDatum + , datumPair govBefore + , datumPair govAfter + ] + , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" + } + , scriptContextPurpose = Minting policySymbol + } diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs index 8f2538d..2513bab 100644 --- a/agora-test/Spec/Stake.hs +++ b/agora-test/Spec/Stake.hs @@ -49,7 +49,10 @@ tests = (stakePolicy Stake.stake) () Stake.stakeCreationUnsigned - , validatorSucceedsWith + ] + , testGroup + "validator" + [ validatorSucceedsWith "stakeDepositWithdraw deposit" (stakeValidator Stake.stake) (toDatum $ StakeDatum 100_000 signer []) diff --git a/agora.cabal b/agora.cabal index bd07338..df30ebb 100644 --- a/agora.cabal +++ b/agora.cabal @@ -162,6 +162,8 @@ test-suite agora-test Spec.Sample.Effect.TreasuryWithdrawal Spec.Sample.Stake Spec.Stake + Spec.Sample.Proposal + Spec.Proposal Spec.Util build-depends: agora diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 8f12181..7a47865 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + {- | Module : Agora.Governor Maintainer : emi@haskell.fyi @@ -21,6 +23,7 @@ module Agora.Governor ( import Agora.Proposal (ProposalId, ProposalThresholds) import Plutarch (popaque) import Plutarch.Api.V1 (PMintingPolicy, PValidator) +import PlutusTx qualified -- | Datum for the Governor script. data GovernorDatum = GovernorDatum @@ -30,6 +33,8 @@ data GovernorDatum = GovernorDatum -- ^ What tag the next proposal will get upon creating. } +PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)] + {- | Redeemer for Governor script. The governor has two primary responsibilities: @@ -43,6 +48,8 @@ data GovernorRedeemer -- and allows minting GATs for each effect script. MintGATs +PlutusTx.makeIsDataIndexed ''GovernorRedeemer [('CreateProposal, 0), ('MintGATs, 1)] + -- | Parameters for creating Governor scripts. data Governor = Governor diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 5252f0f..a32b283 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -73,6 +73,15 @@ import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) -------------------------------------------------------------------------------- -- Haskell-land +{- | Identifies a Proposal, issued upon creation of a proposal. In practice, + this number starts at zero, and increments by one for each proposal. + The 100th proposal will be @'ProposalId' 99@. This counter lives + in the 'Agora.Governor.Governor', see 'Agora.Governor.nextProposalId'. +-} +newtype ProposalId = ProposalId {proposalTag :: Integer} + deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) + deriving stock (Eq, Show, GHC.Generic) + {- | Encodes a result. Typically, for a Yes/No proposal, we encode it like this: @ @@ -162,7 +171,9 @@ newtype ProposalVotes = ProposalVotes -- | Haskell-level datum for Proposal scripts. data ProposalDatum = ProposalDatum - { -- TODO: could we encode this more efficiently? + { proposalId :: ProposalId + -- ^ Identification of the proposal. + , -- TODO: could we encode this more efficiently? -- This is shaped this way for future proofing. -- See https://github.com/Liqwid-Labs/agora/issues/39 effects :: AssocMap.Map ResultTag [(ValidatorHash, DatumHash)] @@ -227,15 +238,6 @@ PlutusTx.makeIsDataIndexed , ('AdvanceProposal, 3) ] -{- | Identifies a Proposal, issued upon creation of a proposal. In practice, - this number starts at zero, and increments by one for each proposal. - The 100th proposal will be @'ProposalId' 99@. This counter lives - in the 'Agora.Governor.Governor', see 'Agora.Governor.nextProposalId'. --} -newtype ProposalId = ProposalId {proposalTag :: Integer} - deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) - deriving stock (Eq, Show, GHC.Generic) - -- | Parameters that identify the Proposal validator script. data Proposal = Proposal { governorSTAssetClass :: AssetClass @@ -341,7 +343,8 @@ newtype PProposalDatum (s :: S) = PProposalDatum Term s ( PDataRecord - '[ "effects" ':= PMap PResultTag (PMap PValidatorHash PDatumHash) + '[ "id" ':= PProposalId + , "effects" ':= PMap PResultTag (PMap PValidatorHash PDatumHash) , "status" ':= PProposalStatus , "cosigners" ':= PBuiltinList (PAsData PPubKeyHash) , "thresholds" ':= PProposalThresholds