diff --git a/agora-specs/Sample/Proposal.hs b/agora-specs/Sample/Proposal.hs deleted file mode 100644 index dc63fa5..0000000 --- a/agora-specs/Sample/Proposal.hs +++ /dev/null @@ -1,115 +0,0 @@ -{- | -Module : Sample.Proposal -Maintainer : emi@haskell.fyi -Description: Sample based testing for Proposal utxos - -This module tests primarily the happy path for Proposal interactions --} -module Sample.Proposal ( - -- * Script contexts - proposalCreation, -) where - -import Agora.Governor (GovernorDatum (..)) -import Agora.Proposal ( - Proposal (..), - ProposalDatum (..), - ProposalId (..), - ProposalStatus (..), - ResultTag (..), - emptyVotesFor, - ) -import Data.Default.Class (Default (def)) -import Plutarch.Context ( - MintingBuilder, - buildMintingUnsafe, - input, - mint, - output, - script, - signedWith, - txId, - withDatum, - withTxId, - withValue, - ) -import PlutusLedgerApi.V1 ( - ScriptContext (..), - ) -import PlutusLedgerApi.V1.Value qualified as Value ( - assetClassValue, - singleton, - ) -import PlutusTx.AssocMap qualified as AssocMap -import Sample.Shared ( - govValidatorHash, - proposal, - proposalPolicySymbol, - proposalStartingTimeFromTimeRange, - proposalValidatorHash, - signer, - ) -import Test.Util ( - closedBoundedInterval, - ) - -proposalCreation :: ScriptContext -proposalCreation = - let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST - effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - proposalDatum :: ProposalDatum - proposalDatum = - ProposalDatum - { proposalId = ProposalId 0 - , effects = effects - , status = Draft - , cosigners = [signer] - , thresholds = def - , votes = emptyVotesFor effects - , timingConfig = def - , startingTime = proposalStartingTimeFromTimeRange validTimeRange - } - - govBefore :: GovernorDatum - govBefore = - GovernorDatum - { proposalThresholds = def - , nextProposalId = ProposalId 0 - , proposalTimings = def - , createProposalTimeRangeMaxWidth = def - , maximumProposalsPerStake = 3 - } - - govAfter :: GovernorDatum - govAfter = govBefore {nextProposalId = ProposalId 1} - - validTimeRange = closedBoundedInterval 10 15 - - builder :: MintingBuilder - builder = - mconcat - [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" - , signedWith signer - , mint st - , input $ - script govValidatorHash - . withValue (Value.assetClassValue proposal.governorSTAssetClass 1) - . withDatum govBefore - . withTxId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" - , output $ - script proposalValidatorHash - . withValue (st <> Value.singleton "" "" 10_000_000) - . withDatum proposalDatum - , output $ - script govValidatorHash - . withValue - ( Value.assetClassValue proposal.governorSTAssetClass 1 - <> Value.singleton "" "" 10_000_000 - ) - . withDatum govAfter - ] - in buildMintingUnsafe builder diff --git a/agora-specs/Sample/Proposal/Advance.hs b/agora-specs/Sample/Proposal/Advance.hs index 05b4fc4..7d7b673 100644 --- a/agora-specs/Sample/Proposal/Advance.hs +++ b/agora-specs/Sample/Proposal/Advance.hs @@ -69,7 +69,7 @@ import PlutusLedgerApi.V1 ( ) import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap -import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) +import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Shared ( minAda, proposalPolicySymbol, @@ -79,7 +79,7 @@ import Sample.Shared ( stakeValidatorHash, ) import Sample.Shared qualified as Shared -import Test.Specification (SpecificationTree, group) +import Test.Specification (SpecificationTree, group, testValidator) import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue, updateMap) -- | Parameters for state transition of proposals. @@ -512,7 +512,7 @@ mkTestTree name ps isValidForProposalValidator = group name [proposal, stake] proposal = let proposalInputDatum = mkProposalInputDatum ps - in testFunc + in testValidator isValidForProposalValidator "propsoal" (proposalValidator Shared.proposal) @@ -527,7 +527,7 @@ mkTestTree name ps isValidForProposalValidator = group name [proposal, stake] let idx = 0 stakeInputDatum = mkStakeInputDatums ps !! idx isValid = not $ ps.alterOutputStakes - in testFunc + in testValidator isValid "stake" (stakeValidator Shared.stake) diff --git a/agora-specs/Sample/Proposal/Cosign.hs b/agora-specs/Sample/Proposal/Cosign.hs index f04535a..3ce7609 100644 --- a/agora-specs/Sample/Proposal/Cosign.hs +++ b/agora-specs/Sample/Proposal/Cosign.hs @@ -57,7 +57,7 @@ import PlutusLedgerApi.V1 ( ) import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap -import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) +import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Shared ( minAda, proposalPolicySymbol, @@ -71,6 +71,7 @@ import Sample.Shared qualified as Shared import Test.Specification ( SpecificationTree, group, + testValidator, ) import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue) @@ -317,7 +318,7 @@ mkTestTree name ps isValid = group name [proposal, stake] proposal = let proposalInputDatum = mkProposalInputDatum ps - in testFunc + in testValidator isValid "propsoal" (proposalValidator Shared.proposal) @@ -332,7 +333,7 @@ mkTestTree name ps isValid = group name [proposal, stake] let idx = 0 stakeInputDatum = mkStakeInputDatums ps !! idx isValid = not ps.alterOutputStakes - in testFunc + in testValidator isValid "stake" (stakeValidator Shared.stake) diff --git a/agora-specs/Sample/Proposal/Create.hs b/agora-specs/Sample/Proposal/Create.hs new file mode 100644 index 0000000..44eacfa --- /dev/null +++ b/agora-specs/Sample/Proposal/Create.hs @@ -0,0 +1,454 @@ +module Sample.Proposal.Create ( + Parameters (..), + mkTestTree, + totallyValidParameters, + invalidOutputGovernorDatumParameters, + useStakeOwnBySomeoneElseParameters, + invalidOutputStakeParameters, + addInvalidLocksParameters, + exceedMaximumProposalsParameters, + timeRangeNotTightParameters, + timeRangeNotClosedParameters, + invalidProposalStatusParameters, +) where + +import Agora.Governor ( + GovernorDatum (..), + GovernorRedeemer (CreateProposal), + ) +import Agora.Governor.Scripts (governorValidator) +import Agora.Proposal ( + Proposal (governorSTAssetClass), + ProposalDatum (..), + ProposalId (ProposalId), + ProposalStatus (..), + ResultTag (ResultTag), + emptyVotesFor, + ) +import Agora.Proposal.Scripts (proposalPolicy) +import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalStartingTime (..)) +import Agora.Stake ( + ProposalLock (..), + Stake (gtClassRef), + StakeDatum (..), + StakeRedeemer (PermitVote), + ) +import Agora.Stake.Scripts (stakeValidator) +import Data.Coerce (coerce) +import Data.Default (Default (def)) +import Data.Tagged (Tagged, untag) +import Plutarch.Context ( + BaseBuilder, + buildTxInfoUnsafe, + input, + mint, + output, + script, + signedWith, + timeRange, + txId, + withDatum, + withOutRef, + withValue, + ) +import PlutusLedgerApi.V1 ( + DatumHash, + POSIXTime (POSIXTime), + POSIXTimeRange, + PubKeyHash, + ScriptContext (ScriptContext), + ScriptPurpose (Minting, Spending), + TxInfo, + TxOutRef (TxOutRef), + ValidatorHash, + always, + ) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusTx.AssocMap qualified as AssocMap +import Sample.Proposal.Shared (stakeTxRef) +import Sample.Shared ( + govValidatorHash, + minAda, + proposal, + proposalPolicySymbol, + proposalStartingTimeFromTimeRange, + proposalValidatorHash, + signer, + signer2, + stake, + stakeAssetClass, + stakeValidatorHash, + ) +import Sample.Shared qualified as Shared +import Test.Specification (SpecificationTree, group, testPolicy, testValidator) +import Test.Util (closedBoundedInterval, sortValue) + +-- | Parameters for creating a proposal. +data Parameters = Parameters + { advanceNextProposalId :: Bool + -- ^ Whether to advance 'GovernorDatum.nextProposalId'. + , createdMoreThanMaximumProposals :: Bool + -- ^ Try creating more than maximum amount of proposals. + , stakeOwnerSignsTheTransaction :: Bool + -- ^ Should the stake owner sign the transaction? + , invalidNewLocks :: Bool + -- ^ Place invalid new locks on the output stake. + , alterOutputStakeOwner :: Bool + -- ^ Whether to change the 'owner' field of the output stake datum. + , timeRangeTightEnough :: Bool + -- ^ Is 'TxInfo.validTimeRange' tight enough? + , timeRangeClosed :: Bool + -- ^ Is 'TxInfo.validTimeRange' closed? + , proposalStatus :: ProposalStatus + -- ^ The status of the newly created proposal. + } + +-------------------------------------------------------------------------------- + +-- | See 'GovernorDatum.maximumProposalsPerStake'. +maxProposalPerStake :: Integer +maxProposalPerStake = 3 + +-- | The id of the proposal we are creating. +thisProposalId :: ProposalId +thisProposalId = ProposalId 25 + +-- | The arbitrary staked amount. Doesn;t really matter in this case. +stakedGTs :: Tagged _ Integer +stakedGTs = 5 + +-- | The owner of the stake. +stakeOwner :: PubKeyHash +stakeOwner = signer + +{- | The invalid stake owner. If the 'alterOutputStakeOwner' is set to true, + the output stake owner will be set to this. +-} +alteredStakeOwner :: PubKeyHash +alteredStakeOwner = signer2 + +-- | Locks the stake that the input stake already has. +defLocks :: [ProposalLock] +defLocks = [Created (ProposalId 0)] + +-- | The effect of the newly created proposal. +defEffects :: AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash) +defEffects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + +-------------------------------------------------------------------------------- + +-- | The governor input datum. +governorInputDatum :: GovernorDatum +governorInputDatum = + GovernorDatum + { proposalThresholds = def + , nextProposalId = thisProposalId + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def + , maximumProposalsPerStake = maxProposalPerStake + } + +-- | Create governor output datum given the parameters. +mkGovernorOutputDatum :: Parameters -> GovernorDatum +mkGovernorOutputDatum ps = + let nextPid = + if ps.advanceNextProposalId + then ProposalId $ coerce thisProposalId + 1 + else thisProposalId + in GovernorDatum + { proposalThresholds = def + , nextProposalId = nextPid + , proposalTimings = def + , createProposalTimeRangeMaxWidth = def + , maximumProposalsPerStake = maxProposalPerStake + } + +-------------------------------------------------------------------------------- + +-- | Create the stake input datum given the parameters. +mkStakeInputDatum :: Parameters -> StakeDatum +mkStakeInputDatum ps = + let locks = + if ps.createdMoreThanMaximumProposals + then + Created . ProposalId + <$> take + (fromInteger maxProposalPerStake) + [1 ..] + else defLocks + in StakeDatum + { stakedAmount = stakedGTs + , owner = stakeOwner + , lockedBy = locks + } + +-- | Create the stake output datum given the parameters. +mkStakeOutputDatum :: Parameters -> StakeDatum +mkStakeOutputDatum ps = + let inputDatum = mkStakeInputDatum ps + newLocks = + if ps.invalidNewLocks + then + [ Voted thisProposalId (ResultTag 0) + , Voted thisProposalId (ResultTag 1) + ] + else [Created thisProposalId] + locks = newLocks <> inputDatum.lockedBy + newOwner = mkOwner ps + in inputDatum + { owner = newOwner + , lockedBy = locks + } + +-------------------------------------------------------------------------------- + +{- | Create the proposal datum for the newly created proposal, given the + parameters. +-} +mkProposalOutputDatum :: Parameters -> ProposalDatum +mkProposalOutputDatum ps = + ProposalDatum + { proposalId = thisProposalId + , effects = defEffects + , status = ps.proposalStatus + , cosigners = [mkOwner ps] + , thresholds = def + , votes = emptyVotesFor defEffects + , timingConfig = def + , startingTime = mkProposalStartingTime ps + } + +-------------------------------------------------------------------------------- + +-- | Create time range for 'TxInfo.validTimeRange'. +mkTimeRange :: Parameters -> POSIXTimeRange +mkTimeRange ps = + if ps.timeRangeClosed + then + let s = 0 + di :: POSIXTime = coerce (def @MaxTimeRangeWidth) + o = if ps.timeRangeTightEnough then (-1) else 1 + in closedBoundedInterval s $ o + di + else always + +-- | Get the starting time of the propsoal. +mkProposalStartingTime :: Parameters -> ProposalStartingTime +mkProposalStartingTime ps = + if ps.timeRangeClosed + then proposalStartingTimeFromTimeRange $ mkTimeRange ps + else ProposalStartingTime 0 + +-- | Who should be the 'owner' of the output stake. +mkOwner :: Parameters -> PubKeyHash +mkOwner ps = + if ps.alterOutputStakeOwner + then alteredStakeOwner + else stakeOwner + +-------------------------------------------------------------------------------- + +-- | Reference to the input stake UTXO. +stakeRef :: TxOutRef +stakeRef = TxOutRef stakeTxRef 1 + +-- | Reference to the input governor UTXO. +governorRef :: TxOutRef +governorRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 3 + +-------------------------------------------------------------------------------- + +-- | Create a 'TxInfo' that spends a stake to create a new proposal. +createProposal :: Parameters -> TxInfo +createProposal ps = buildTxInfoUnsafe builder + where + pst = Value.singleton proposalPolicySymbol "" 1 + sst = Value.assetClassValue stakeAssetClass 1 + gst = Value.assetClassValue proposal.governorSTAssetClass 1 + + --- + + governorValue = sortValue $ gst <> minAda + stakeValue = + sortValue $ + sortValue $ + sst + <> Value.assetClassValue (untag stake.gtClassRef) (untag stakedGTs) + <> minAda + proposalValue = sortValue $ pst <> minAda + + --- + + withSig = + if ps.stakeOwnerSignsTheTransaction + then signedWith stakeOwner + else mempty + + --- + + builder :: BaseBuilder + builder = + mconcat + [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" + , --- + withSig + , --- + mint pst + , --- + timeRange $ mkTimeRange ps + , input $ + script govValidatorHash + . withValue governorValue + . withDatum governorInputDatum + . withOutRef governorRef + , output $ + script govValidatorHash + . withValue governorValue + . withDatum (mkGovernorOutputDatum ps) + , --- + input $ + script stakeValidatorHash + . withValue stakeValue + . withDatum (mkStakeInputDatum ps) + . withOutRef stakeRef + , output $ + script stakeValidatorHash + . withValue stakeValue + . withDatum (mkStakeOutputDatum ps) + , --- + output $ + script proposalValidatorHash + . withValue proposalValue + . withDatum (mkProposalOutputDatum ps) + ] + +-------------------------------------------------------------------------------- + +-- | Spend the stake with the 'PermitVote' redeemer. +stakeRedeemer :: StakeRedeemer +stakeRedeemer = PermitVote + +-- | Spend the governor with the 'CreateProposal' redeemer. +governorRedeemer :: GovernorRedeemer +governorRedeemer = CreateProposal + +-- | Mint the PST with an arbitrary redeemer. Doesn't really matter. +proposalPolicyRedeemer :: () +proposalPolicyRedeemer = () + +-------------------------------------------------------------------------------- + +totallyValidParameters :: Parameters +totallyValidParameters = + Parameters + { advanceNextProposalId = True + , createdMoreThanMaximumProposals = False + , stakeOwnerSignsTheTransaction = True + , invalidNewLocks = False + , alterOutputStakeOwner = False + , timeRangeTightEnough = True + , timeRangeClosed = True + , proposalStatus = Draft + } + +invalidOutputGovernorDatumParameters :: Parameters +invalidOutputGovernorDatumParameters = + totallyValidParameters + { advanceNextProposalId = False + } + +useStakeOwnBySomeoneElseParameters :: Parameters +useStakeOwnBySomeoneElseParameters = + totallyValidParameters + { stakeOwnerSignsTheTransaction = False + } + +invalidOutputStakeParameters :: Parameters +invalidOutputStakeParameters = + totallyValidParameters + { alterOutputStakeOwner = True + } + +addInvalidLocksParameters :: Parameters +addInvalidLocksParameters = + totallyValidParameters + { invalidNewLocks = True + } + +exceedMaximumProposalsParameters :: Parameters +exceedMaximumProposalsParameters = + totallyValidParameters + { createdMoreThanMaximumProposals = True + } + +timeRangeNotTightParameters :: Parameters +timeRangeNotTightParameters = + totallyValidParameters + { timeRangeTightEnough = False + } + +timeRangeNotClosedParameters :: Parameters +timeRangeNotClosedParameters = + totallyValidParameters + { timeRangeClosed = False + } + +invalidProposalStatusParameters :: [Parameters] +invalidProposalStatusParameters = + map + ( \st -> + totallyValidParameters {proposalStatus = st} + ) + [VotingReady, Locked, Finished] + +-------------------------------------------------------------------------------- + +{- | Create a test tree that runs the propsoal minting policy, the governor + validator and the stake validator to test the functionalities of creting + proposals +-} +mkTestTree :: String -> Parameters -> Bool -> Bool -> Bool -> SpecificationTree +mkTestTree + name + ps + validForProposalPolicy + validForGovernorValidator + validForStakeValidator = + group name [proposalTest, governorTest, stakeTest] + where + txInfo = createProposal ps + + proposalTest = + testPolicy + validForProposalPolicy + "proposal" + (proposalPolicy Shared.proposal.governorSTAssetClass) + proposalPolicyRedeemer + (ScriptContext txInfo (Minting proposalPolicySymbol)) + + governorTest = + testValidator + validForGovernorValidator + "governor" + (governorValidator Shared.governor) + governorInputDatum + governorRedeemer + ( ScriptContext + txInfo + (Spending governorRef) + ) + + stakeTest = + testValidator + validForStakeValidator + "stake" + (stakeValidator Shared.stake) + (mkStakeInputDatum ps) + stakeRedeemer + ( ScriptContext + txInfo + (Spending stakeRef) + ) diff --git a/agora-specs/Sample/Proposal/Shared.hs b/agora-specs/Sample/Proposal/Shared.hs index 17028ee..21b2ce1 100644 --- a/agora-specs/Sample/Proposal/Shared.hs +++ b/agora-specs/Sample/Proposal/Shared.hs @@ -1,13 +1,6 @@ -module Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) where +module Sample.Proposal.Shared (proposalTxRef, stakeTxRef) where -import Plutarch.Api.V1 (PValidator) -import Plutarch.Lift (PUnsafeLiftDecl (..)) -import PlutusLedgerApi.V1 (ScriptContext, ToData, TxId) -import Test.Specification ( - SpecificationTree, - validatorFailsWith, - validatorSucceedsWith, - ) +import PlutusLedgerApi.V1 (TxId) -- | 'TxId' of all the propsoal inputs in the samples. proposalTxRef :: TxId @@ -16,24 +9,3 @@ proposalTxRef = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" -- | 'TxId' of all the stake inputs in the samples. stakeTxRef :: TxId stakeTxRef = "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" - --- | Get the test function given whether a test case is valid. -testFunc :: - forall {datum :: PType} {redeemer :: PType}. - ( PUnsafeLiftDecl datum - , PUnsafeLiftDecl redeemer - , ToData (PLifted datum) - , ToData (PLifted redeemer) - ) => - -- | Should the validator pass? - Bool -> - String -> - ClosedTerm PValidator -> - PLifted datum -> - PLifted redeemer -> - ScriptContext -> - SpecificationTree -testFunc isValid = - if isValid - then validatorSucceedsWith - else validatorFailsWith diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs index 46dd491..529e397 100644 --- a/agora-specs/Sample/Proposal/UnlockStake.hs +++ b/agora-specs/Sample/Proposal/UnlockStake.hs @@ -55,7 +55,7 @@ import PlutusLedgerApi.V1 ( ) import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap -import Sample.Proposal.Shared (stakeTxRef, testFunc) +import Sample.Proposal.Shared (stakeTxRef) import Sample.Shared ( minAda, proposalPolicySymbol, @@ -66,7 +66,7 @@ import Sample.Shared ( stakeValidatorHash, ) import Sample.Shared qualified as Shared -import Test.Specification (SpecificationTree, group) +import Test.Specification (SpecificationTree, group, testValidator) import Test.Util (sortValue, updateMap) -------------------------------------------------------------------------------- @@ -519,7 +519,7 @@ mkTestTree name ps isValid = group name [stake, proposal] txInfo = unlockStake ps stake = - testFunc + testValidator (not ps.alterOutputStake) "stake" (stakeValidator Shared.stake) @@ -531,7 +531,7 @@ mkTestTree name ps isValid = group name [stake, proposal] let idx = 0 pid = ProposalId $ fromIntegral idx ref = mkProposalRef idx - in testFunc + in testValidator isValid "propsoal" (proposalValidator Shared.proposal) diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs index 3dbc916..c2af036 100644 --- a/agora-specs/Sample/Proposal/Vote.hs +++ b/agora-specs/Sample/Proposal/Vote.hs @@ -47,7 +47,7 @@ import PlutusLedgerApi.V1 ( ) import PlutusLedgerApi.V1.Value qualified as Value import PlutusTx.AssocMap qualified as AssocMap -import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) +import Sample.Proposal.Shared (proposalTxRef, stakeTxRef) import Sample.Shared ( minAda, proposalPolicySymbol, @@ -61,6 +61,7 @@ import Sample.Shared qualified as Shared import Test.Specification ( SpecificationTree, group, + testValidator, validatorSucceedsWith, ) import Test.Util (closedBoundedInterval, sortValue, updateMap) @@ -243,7 +244,7 @@ mkTestTree name ps isValid = group name [proposal, stake] txInfo = vote ps proposal = - testFunc + testValidator isValid "propsoal" (proposalValidator Shared.proposal) diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 0e5b0ad..9ef2416 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -7,32 +7,83 @@ Tests for Proposal policy and validator -} module Spec.Proposal (specs) where -import Agora.Proposal ( - Proposal (..), - ) -import Agora.Proposal.Scripts (proposalPolicy) -import Sample.Proposal qualified as Proposal import Sample.Proposal.Advance qualified as Advance import Sample.Proposal.Cosign qualified as Cosign +import Sample.Proposal.Create qualified as Create import Sample.Proposal.UnlockStake qualified as UnlockStake import Sample.Proposal.Vote qualified as Vote -import Sample.Shared qualified as Shared (proposal) import Test.Specification ( SpecificationTree, group, - policySucceedsWith, ) -- | Stake specs. specs :: [SpecificationTree] specs = [ group - "policy" - [ policySucceedsWith - "proposalCreation" - (proposalPolicy Shared.proposal.governorSTAssetClass) - () - Proposal.proposalCreation + "policy (proposal creation)" + [ Create.mkTestTree + "legal" + Create.totallyValidParameters + True + True + True + , group + "illegal" + [ Create.mkTestTree + "invalid next proposal id" + Create.invalidOutputGovernorDatumParameters + True + False + True + , Create.mkTestTree + "use other's stake" + Create.useStakeOwnBySomeoneElseParameters + True + False + False + , Create.mkTestTree + "altered stake" + Create.invalidOutputStakeParameters + True + False + False + , Create.mkTestTree + "invalid stake locks" + Create.addInvalidLocksParameters + True + False + True + , Create.mkTestTree + "has reached maximum proposals limit" + Create.exceedMaximumProposalsParameters + True + False + True + , Create.mkTestTree + "loose time range" + Create.timeRangeNotTightParameters + True + False + True + , Create.mkTestTree + "open time range" + Create.timeRangeNotClosedParameters + True + False + True + , group "invalid proposal status" $ + map + ( \ps -> + Create.mkTestTree + (show ps.proposalStatus) + ps + True + False + True + ) + Create.invalidProposalStatusParameters + ] ] , group "validator" diff --git a/agora-testlib/Test/Specification.hs b/agora-testlib/Test/Specification.hs index e228a68..2594b01 100644 --- a/agora-testlib/Test/Specification.hs +++ b/agora-testlib/Test/Specification.hs @@ -42,6 +42,8 @@ module Test.Specification ( validatorFailsWith, effectSucceedsWith, effectFailsWith, + testValidator, + testPolicy, -- * Converters toTestTree, @@ -253,3 +255,37 @@ effectFailsWith :: ScriptContext -> SpecificationTree effectFailsWith tag eff datum = validatorFailsWith tag eff datum () + +testValidator :: + ( PLift datum + , PlutusTx.ToData (PLifted datum) + , PLift redeemer + , PlutusTx.ToData (PLifted redeemer) + ) => + -- | Should the validator pass? + Bool -> + String -> + ClosedTerm PValidator -> + PLifted datum -> + PLifted redeemer -> + ScriptContext -> + SpecificationTree +testValidator isValid = + if isValid + then validatorSucceedsWith + else validatorFailsWith + +testPolicy :: + ( PLift redeemer + , PlutusTx.ToData (PLifted redeemer) + ) => + Bool -> + String -> + ClosedTerm PMintingPolicy -> + PLifted redeemer -> + ScriptContext -> + SpecificationTree +testPolicy isValid = + if isValid + then policySucceedsWith + else policyFailsWith diff --git a/agora.cabal b/agora.cabal index 08f9e99..cb0283c 100644 --- a/agora.cabal +++ b/agora.cabal @@ -188,9 +188,9 @@ library agora-specs Sample.Effect.GovernorMutation Sample.Effect.TreasuryWithdrawal Sample.Governor - Sample.Proposal Sample.Proposal.Advance Sample.Proposal.Cosign + Sample.Proposal.Create Sample.Proposal.Shared Sample.Proposal.UnlockStake Sample.Proposal.Vote diff --git a/bench.csv b/bench.csv index ccb5238..cc60437 100644 --- a/bench.csv +++ b/bench.csv @@ -7,7 +7,27 @@ Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect Agora/Stake/policy/stakeCreation,51008580,149029,2522 Agora/Stake/validator/stakeDepositWithdraw deposit,183506412,498838,4745 Agora/Stake/validator/stakeDepositWithdraw withdraw,183506412,498838,4733 -Agora/Proposal/policy/proposalCreation,23140177,69194,1517 +Agora/Proposal/policy (proposal creation)/legal/proposal,34975627,103548,2117 +Agora/Proposal/policy (proposal creation)/legal/governor,327971301,871386,9322 +Agora/Proposal/policy (proposal creation)/legal/stake,152415805,398403,5404 +Agora/Proposal/policy (proposal creation)/illegal/invalid next proposal id/proposal,34975627,103548,2117 +Agora/Proposal/policy (proposal creation)/illegal/invalid next proposal id/stake,152415805,398403,5404 +Agora/Proposal/policy (proposal creation)/illegal/use other's stake/proposal,34975627,103548,2086 +Agora/Proposal/policy (proposal creation)/illegal/altered stake/proposal,34975627,103548,2117 +Agora/Proposal/policy (proposal creation)/illegal/invalid stake locks/proposal,34975627,103548,2125 +Agora/Proposal/policy (proposal creation)/illegal/invalid stake locks/stake,157849465,413053,5412 +Agora/Proposal/policy (proposal creation)/illegal/has reached maximum proposals limit/proposal,34975627,103548,2137 +Agora/Proposal/policy (proposal creation)/illegal/has reached maximum proposals limit/stake,158878297,416511,5434 +Agora/Proposal/policy (proposal creation)/illegal/loose time range/proposal,34975627,103548,2117 +Agora/Proposal/policy (proposal creation)/illegal/loose time range/stake,152415805,398403,5404 +Agora/Proposal/policy (proposal creation)/illegal/open time range/proposal,34975627,103548,2113 +Agora/Proposal/policy (proposal creation)/illegal/open time range/stake,152415805,398403,5400 +Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/VotingReady/proposal,34975627,103548,2117 +Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/VotingReady/stake,152415805,398403,5404 +Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/Locked/proposal,34975627,103548,2117 +Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/Locked/stake,152415805,398403,5404 +Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/Finished/proposal,34975627,103548,2117 +Agora/Proposal/policy (proposal creation)/illegal/invalid proposal status/Finished/stake,152415805,398403,5404 Agora/Proposal/validator/cosignature/legal/with 1 cosigners/propsoal,231665387,648239,8164 Agora/Proposal/validator/cosignature/legal/with 1 cosigners/stake,122255811,317464,5213 Agora/Proposal/validator/cosignature/legal/with 5 cosigners/propsoal,662329378,1846986,10794