From edac5b6cf5c2d380e7745ed03290d57cde6b82fe Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 31 May 2022 13:52:17 +0800 Subject: [PATCH 1/9] share stake check code among redeemers --- agora-specs/Sample/Proposal.hs | 72 +++++++++++++++++---- agora-specs/Spec/Proposal.hs | 4 +- agora/Agora/Proposal/Scripts.hs | 111 +++++++++++++++++++------------- bench.csv | 24 +++---- 4 files changed, 141 insertions(+), 70 deletions(-) diff --git a/agora-specs/Sample/Proposal.hs b/agora-specs/Sample/Proposal.hs index 0ec892d..458154f 100644 --- a/agora-specs/Sample/Proposal.hs +++ b/agora-specs/Sample/Proposal.hs @@ -18,7 +18,7 @@ module Sample.Proposal ( TransitionParameters (..), advanceFinishedPropsoal, advanceProposalInsufficientVotes, - advancePropsoalWithsStake, + advancePropsoalWithInvalidOutputStake, ) where import Agora.Governor (GovernorDatum (..)) @@ -403,9 +403,12 @@ mkTransitionTxInfo :: ProposalStartingTime -> -- | Valid time range of the transaction. POSIXTimeRange -> + -- | Add a unchanged stake or not. + Bool -> TxInfo -mkTransitionTxInfo from to effects votes startingTime validTime = +mkTransitionTxInfo from to effects votes startingTime validTime shouldAddUnchangedStake = let pst = Value.singleton proposalPolicySymbol "" 1 + sst = Value.assetClassValue stakeAssetClass 1 proposalInputDatum :: ProposalDatum proposalInputDatum = @@ -426,11 +429,48 @@ mkTransitionTxInfo from to effects votes startingTime validTime = { status = to } + stakeOwner = signer + stakedAmount = 200 + + existingLocks :: [ProposalLock] + existingLocks = + [ ProposalLock (ResultTag 0) (ProposalId 0) + , ProposalLock (ResultTag 2) (ProposalId 1) + ] + + stakeInputDatum :: StakeDatum + stakeInputDatum = + StakeDatum + { stakedAmount = Tagged stakedAmount + , owner = stakeOwner + , lockedBy = existingLocks + } + + stakeOutputDatum :: StakeDatum + stakeOutputDatum = stakeInputDatum + + stakeBuilder :: BaseBuilder + stakeBuilder = + if shouldAddUnchangedStake + then + mconcat + [ input $ + script stakeValidatorHash + . withValue sst + . withDatum stakeInputDatum + . withTxId (txOutRefId stakeRef) + , output $ + script stakeValidatorHash + . withValue (sst <> minAda) + . withDatum stakeOutputDatum + ] + else mempty + builder :: BaseBuilder builder = mconcat [ txId "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a" - , signedWith signer + , signedWith stakeOwner , timeRange validTime , input $ script proposalValidatorHash @@ -442,13 +482,19 @@ mkTransitionTxInfo from to effects votes startingTime validTime = . withValue (pst <> minAda) . withDatum proposalOutputDatum ] - in buildTxInfoUnsafe builder + in buildTxInfoUnsafe $ builder <> stakeBuilder + +-- | Wrapper around 'advanceProposalSuccess'', with valid stake. +advanceProposalSuccess :: TransitionParameters -> TxInfo +advanceProposalSuccess ps = advanceProposalSuccess' ps True {- | Create a valid 'TxInfo' that advances a proposal, given the parameters. + The second parameter determines wherther valid stake should be included. + Note that 'TransitionParameters.initialProposalStatus' should not be 'Finished'. -} -advanceProposalSuccess :: TransitionParameters -> TxInfo -advanceProposalSuccess params = +advanceProposalSuccess' :: TransitionParameters -> Bool -> TxInfo +advanceProposalSuccess' params = let -- Status of the output proposal. toStatus :: ProposalStatus toStatus = case params.initialProposalStatus of @@ -615,6 +661,7 @@ advanceProposalFailureTimeout params = votes params.proposalStartingTime timeRange + True -- | An invalid 'TxInfo' that tries to advance a 'VotingReady' proposal without sufficient votes. advanceProposalInsufficientVotes :: TxInfo @@ -643,6 +690,7 @@ advanceProposalInsufficientVotes = votes (ProposalStartingTime proposalStartingTime) timeRange + True -- | An invalid 'TxInfo' that tries to advance a 'Finished' proposal. advanceFinishedPropsoal :: TxInfo @@ -675,19 +723,21 @@ advanceFinishedPropsoal = outcome0WinningVotes (ProposalStartingTime 0) timeRange + True -{- | An illegal 'TxInfo' that tries to use 'AdvanceProposal' with a stake. - From the perspective of stake validator, the transition is valid, +{- | An illegal 'TxInfo' that tries to output a changed stake with 'AdvanceProposal'. + From the perspective of stake validator, the transition is totally valid, so the proposal validator should reject this. -} -advancePropsoalWithsStake :: TxInfo -advancePropsoalWithsStake = +advancePropsoalWithInvalidOutputStake :: TxInfo +advancePropsoalWithInvalidOutputStake = let templateTxInfo = - advanceProposalSuccess + advanceProposalSuccess' TransitionParameters { initialProposalStatus = VotingReady , proposalStartingTime = ProposalStartingTime 0 } + False --- -- Now we create a new lock on an arbitrary stake diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index fa1fd1c..39250cc 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -51,7 +51,7 @@ import Sample.Proposal qualified as Proposal ( advanceProposalFailureTimeout, advanceProposalInsufficientVotes, advanceProposalSuccess, - advancePropsoalWithsStake, + advancePropsoalWithInvalidOutputStake, cosignProposal, proposalCreation, proposalRef, @@ -352,7 +352,7 @@ specs = ) AdvanceProposal ( ScriptContext - Proposal.advancePropsoalWithsStake + Proposal.advancePropsoalWithInvalidOutputStake (Spending Proposal.proposalRef) ) ] diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index f35e95f..53e6974 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -54,6 +54,7 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.TermCont ( pguardC, pletC, + pletFieldsC, pmatchC, ptryFromC, ) @@ -184,29 +185,37 @@ proposalValidator proposal = valueSpent <- pletC $ pvalueSpent # txInfoF.inputs spentST <- pletC $ psymbolValueOf # stCurrencySymbol #$ valueSpent - let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass - stakeSTAssetClass <- - pletC $ passetClass # pconstant stakeSym # pconstant stakeTn - spentStakeST <- - pletC $ passetClassValueOf # valueSpent # stakeSTAssetClass - signedBy <- pletC $ ptxSignedBy # txInfoF.signatories - pguardC "ST at inputs must be 1" (spentST #== 1) - currentTime <- pletC $ currentProposalTime # txInfoF.validRange - -- Filter out own output with own address and PST. - -- Delay the evaluation cause in some cases there won't be any continuing output. + -- Own output is an output that + -- * is sent to the address of the proposal validator + -- * has an PST + -- * has the same proposal id as the proposal input + -- + -- We match the proposal id here so that we can support multiple + -- proposal inputs in one thansaction. ownOutput <- pletC $ mustBePJust # "Own output should be present" #$ pfind # plam ( \input -> unTermCont $ do - inputF <- tcont $ pletFields @'["address", "value"] input + inputF <- tcont $ pletFields @'["address", "value", "datumHash"] input + + -- TODO: this is highly inefficient: O(n) for every output, + -- Maybe we can cache the sorted datum map? + let datum = + mustFindDatum' @PProposalDatum + # inputF.datumHash + # txInfoF.datums + + proposalId = pfield @"proposalId" # datum + pure $ inputF.address #== ownAddress #&& psymbolValueOf # stCurrencySymbol # inputF.value #== 1 + #&& proposalId #== proposalF.proposalId ) # pfromData txInfoF.outputs @@ -216,6 +225,46 @@ proposalValidator proposal = # (pfield @"datumHash" # ownOutput) # txInfoF.datums + -------------------------------------------------------------------------- + -- Find the stake input and stake output by SST. + + let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass + stakeSTAssetClass <- + pletC $ passetClass # pconstant stakeSym # pconstant stakeTn + spentStakeST <- + pletC $ passetClassValueOf # valueSpent # stakeSTAssetClass + + pguardC "ST at inputs must be 1" (spentST #== 1) + + let stakeInput = + pfield @"resolved" + #$ mustBePJust + # "Stake input should be present" + #$ pfind + # plam + ( \(pfromData . (pfield @"value" #) . (pfield @"resolved" #) -> value) -> + passetClassValueOf # value # stakeSTAssetClass #== 1 + ) + # pfromData txInfoF.inputs + + stakeIn <- pletC $ mustFindDatum' @PStakeDatum # (pfield @"datumHash" # stakeInput) # txInfoF.datums + stakeInF <- pletFieldsC @'["stakedAmount", "lockedBy", "owner"] stakeIn + + let stakeOutput = + mustBePJust # "Stake output should be present" + #$ pfind + # plam + ( \(pfromData . (pfield @"value" #) -> value) -> + passetClassValueOf # value # stakeSTAssetClass #== 1 + ) + # pfromData txInfoF.outputs + + stakeOut <- pletC $ mustFindDatum' @PStakeDatum # (pfield @"datumHash" # stakeOutput) # txInfoF.datums + + stakeUnchanged <- pletC $ stakeIn #== stakeOut + + -------------------------------------------------------------------------- + pure $ pmatch proposalRedeemer $ \case PVote r -> unTermCont $ do @@ -232,23 +281,6 @@ proposalValidator proposal = pguardC "Vote option should be valid" $ pisJust #$ plookup # voteFor # voteMap - -- Find the input stake, the amount of new votes should be the 'stakedAmount'. - let stakeInput = - pfield @"resolved" - #$ mustBePJust - # "Stake input should be present" - #$ pfind - # plam - ( \(pfromData . (pfield @"value" #) . (pfield @"resolved" #) -> value) -> - passetClassValueOf # value # stakeSTAssetClass #== 1 - ) - # pfromData txInfoF.inputs - - stakeIn :: Term _ PStakeDatum - stakeIn = mustFindDatum' # (pfield @"datumHash" # stakeInput) # txInfoF.datums - - stakeInF <- tcont $ pletFields @'["stakedAmount", "lockedBy", "owner"] stakeIn - -- Ensure that no lock with the current proposal id has been put on the stake. pguardC "Same stake shouldn't vote on the same propsoal twice" $ pnot #$ pany @@ -258,7 +290,8 @@ proposalValidator proposal = ) # pfromData stakeInF.lockedBy - let -- Update the vote counter of the proposal, and leave other stuff as is. + let -- The amount of new votes should be the 'stakedAmount'. + -- Update the vote counter of the proposal, and leave other stuff as is. expectedNewVotes = pmatch (pfromData proposalF.votes) $ \(PProposalVotes m) -> pcon $ PProposalVotes $ @@ -289,18 +322,6 @@ proposalValidator proposal = -- to create a valid 'ProposalLock', however the vote option is encoded -- in the proposal redeemer, which is invisible for the stake validator. - let stakeOutput = - mustBePJust # "Stake output should be present" - #$ pfind - # plam - ( \(pfromData . (pfield @"value" #) -> value) -> - passetClassValueOf # value # stakeSTAssetClass #== 1 - ) - # pfromData txInfoF.outputs - - stakeOut :: Term _ PStakeDatum - stakeOut = mustFindDatum' # (pfield @"datumHash" # stakeOutput) # txInfoF.datums - let newProposalLock = mkRecordConstr PProposalLock @@ -325,6 +346,8 @@ proposalValidator proposal = pure $ popaque (pconstant ()) -------------------------------------------------------------------------- PCosign r -> unTermCont $ do + pguardC "Stake should not change" stakeUnchanged + newSigs <- pletC $ pfield @"newCosigners" # r pguardC "Cosigners are unique" $ @@ -374,13 +397,11 @@ proposalValidator proposal = pure $ popaque (pconstant ()) -------------------------------------------------------------------------- - PUnlock _r -> - popaque (pconstant ()) + PUnlock _r -> popaque (pconstant ()) -------------------------------------------------------------------------- PAdvanceProposal _r -> unTermCont $ do - pguardC "No stake input is allowed" $ spentStakeST #== 0 + pguardC "Stake should not change" stakeUnchanged - currentTime <- pletC $ currentProposalTime # txInfoF.validRange proposalOutStatus <- pletC $ pfield @"status" # proposalOut let -- Only the status of proposals should be updated in this case. diff --git a/bench.csv b/bench.csv index 08cfa2c..b40f538 100644 --- a/bench.csv +++ b/bench.csv @@ -2,28 +2,28 @@ name,cpu,mem,size Agora/Effects/Treasury Withdrawal Effect/effect/Simple,289461528,703055,3191 Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,448521458,1070167,3518 Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,408085321,966048,3383 -Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7665 +Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7664 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,97345575,266935,3358 Agora/Stake/policy/stakeCreation,43114795,124549,2156 Agora/Stake/validator/stakeDepositWithdraw deposit,171823342,464745,4144 Agora/Stake/validator/stakeDepositWithdraw withdraw,171823342,464745,4132 Agora/Proposal/policy/proposalCreation,23140177,69194,1517 -Agora/Proposal/validator/cosignature/proposal,145357978,397941,5721 +Agora/Proposal/validator/cosignature/proposal,213692648,591151,5767 Agora/Proposal/validator/cosignature/stake,115369581,282557,4681 -Agora/Proposal/validator/voting/proposal,154824944,415642,5650 +Agora/Proposal/validator/voting/proposal,167847632,446101,5696 Agora/Proposal/validator/voting/stake,99545453,256941,4655 -Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,94701799,249495,5027 -Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,93858377,247992,5030 -Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,95554844,251598,5030 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,93571998,246765,5029 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,92163087,244060,5030 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,93294065,246464,5030 +Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,167492034,450393,5594 +Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,166648612,448890,5597 +Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,168345079,452496,5597 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,166362233,447663,5596 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,164953322,444958,5597 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,166084300,447362,5597 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Governor/policy/GST minting,43087287,120125,1829 -Agora/Governor/validator/proposal creation,261928725,689487,8181 -Agora/Governor/validator/GATs minting,349849353,933334,8302 -Agora/Governor/validator/mutate governor state,84905433,234687,7766 +Agora/Governor/validator/proposal creation,262494214,690689,8180 +Agora/Governor/validator/GATs minting,349283864,932132,8301 +Agora/Governor/validator/mutate governor state,84905433,234687,7765 From a1c5d0e33906acd0006dff7c2596f16254958275 Mon Sep 17 00:00:00 2001 From: fanghr Date: Tue, 31 May 2022 18:15:59 +0800 Subject: [PATCH 2/9] add validation logic for unlocking stakes --- agora/Agora/Proposal.hs | 21 +++++++- agora/Agora/Proposal/Scripts.hs | 90 +++++++++++++++++++++++++++++++-- agora/Agora/Stake.hs | 62 +++++++++++++++++++++-- agora/Agora/Stake/Scripts.hs | 19 ++++--- bench.csv | 34 ++++++------- 5 files changed, 192 insertions(+), 34 deletions(-) diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 9202bcc..02093f5 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -33,6 +33,7 @@ module Agora.Proposal ( pemptyVotesFor, pwinner, pneutralOption, + pretractVotes, ) where -------------------------------------------------------------------------------- @@ -63,7 +64,7 @@ import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprI import Plutarch.Extra.List (pnotNull) import Plutarch.Extra.Map qualified as PM import Plutarch.Extra.Map.Unsorted qualified as PUM -import Plutarch.Extra.TermCont (pletC) +import Plutarch.Extra.TermCont (pguardC, pletC) import Plutarch.Lift ( DerivePConstantViaNewtype (..), PConstantDecl, @@ -367,6 +368,24 @@ newtype PProposalVotes (s :: S) = PProposalVotes (Term s (PMap 'Unsorted PResultTag PInteger)) deriving (PlutusType, PIsData) via (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger)) +-- | Retract votes given the option and the amount of votes. +pretractVotes :: Term s (PProposalVotes :--> PResultTag :--> PInteger :--> PProposalVotes) +pretractVotes = phoistAcyclic $ + plam $ \votes rt count -> + let voteMap :: Term _ (PMap 'Unsorted PResultTag PInteger) + voteMap = pto votes + in pcon $ + PProposalVotes $ + PM.pupdate + # plam + ( \oldCount -> unTermCont $ do + newCount <- pletC $ oldCount - count + pguardC "Resulting vote count greater or equal to 0" $ 0 #<= newCount + pure $ pcon $ PJust newCount + ) + # rt + # voteMap + instance PUnsafeLiftDecl PProposalVotes where type PLifted PProposalVotes = ProposalVotes deriving via (DerivePConstantViaNewtype ProposalVotes PProposalVotes (PMap 'Unsorted PResultTag PInteger)) diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 53e6974..0d2084c 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -17,6 +17,7 @@ import Agora.Proposal ( PProposalVotes (PProposalVotes), Proposal (governorSTAssetClass, stakeSTAssetClass), ProposalStatus (..), + pretractVotes, ) import Agora.Proposal.Time ( currentProposalTime, @@ -25,7 +26,13 @@ import Agora.Proposal.Time ( isLockingPeriod, isVotingPeriod, ) -import Agora.Stake (PProposalLock (..), PStakeDatum (..), findStakeOwnedBy) +import Agora.Stake ( + PProposalLock (..), + PStakeDatum (..), + PStakeUsage (..), + findStakeOwnedBy, + pgetStakeUsage, + ) import Agora.Utils ( findTxOutByTxOutRef, getMintingPolicySymbol, @@ -183,7 +190,6 @@ proposalValidator proposal = let stCurrencySymbol = pconstant $ getMintingPolicySymbol (proposalPolicy proposal.governorSTAssetClass) valueSpent <- pletC $ pvalueSpent # txInfoF.inputs - spentST <- pletC $ psymbolValueOf # stCurrencySymbol #$ valueSpent signedBy <- pletC $ ptxSignedBy # txInfoF.signatories @@ -225,6 +231,7 @@ proposalValidator proposal = # (pfield @"datumHash" # ownOutput) # txInfoF.datums + proposalUnchanged <- pletC $ proposalOut #== proposalDatum -------------------------------------------------------------------------- -- Find the stake input and stake output by SST. @@ -234,8 +241,6 @@ proposalValidator proposal = spentStakeST <- pletC $ passetClassValueOf # valueSpent # stakeSTAssetClass - pguardC "ST at inputs must be 1" (spentST #== 1) - let stakeInput = pfield @"resolved" #$ mustBePJust @@ -397,7 +402,82 @@ proposalValidator proposal = pure $ popaque (pconstant ()) -------------------------------------------------------------------------- - PUnlock _r -> popaque (pconstant ()) + PUnlock r -> unTermCont $ do + -- At draft stage, the votes should be empty. + pguardC "Shouldn't retract votes from a draft propsoal" $ + pnot #$ proposalF.status #== pconstantData Draft + + -- This is the vote option we're retracting from. + retractFrom <- pletC $ pfield @"resultTag" # r + + -- Determine if the input stake is actually locked by this proposal. + stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId + + pguardC "Stake input relevant" $ + pmatch stakeUsage $ \case + PDidNothing -> + ptrace "Not relevant" $ + pconstant False + PCreated -> + ptraceIfFalse "Too early" $ + proposalF.status #== pconstantData Finished + PVotedFor rt -> + ptraceIfFalse "Result tag not match" $ + rt #== retractFrom + + -- The count of removing votes is equal to the 'stakeAmount' of input stake. + retractCount <- + pletC $ + pmatch stakeInF.stakedAmount $ (\(PDiscrete v) -> pextract # v) + + -- The votes can only change when the proposal still allows voting. + let shouldUpdateVotes = + proposalF.status #== pconstantData VotingReady + #&& pnot # (pcon PCreated #== stakeUsage) + + pguardC "Proposal output correct" $ + pif + shouldUpdateVotes + ( let -- Remove votes and leave other parts of the proposal as it. + expectedVotes = pretractVotes # proposalF.votes # retractFrom # retractCount + + expectedProposalOut = + mkRecordConstr + PProposalDatum + ( #proposalId .= proposalF.proposalId + .& #effects .= proposalF.effects + .& #status .= proposalF.status + .& #cosigners .= proposalF.cosigners + .& #thresholds .= proposalF.thresholds + .& #votes .= pdata expectedVotes + .& #timingConfig .= proposalF.timingConfig + .& #startingTime .= proposalF.startingTime + ) + in ptraceIfFalse "Update votes" $ + expectedProposalOut #== proposalOut + ) + -- No change to the proposal is allowed. + $ ptraceIfFalse "Proposal unchanged" proposalUnchanged + + -- At last, we ensure that all locks belong to this proposal will be removed. + stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut + + let templateStakeOut = + mkRecordConstr + PStakeDatum + ( #stakedAmount .= stakeInF.stakedAmount + .& #owner .= stakeInF.owner + .& #lockedBy .= stakeOutputLocks + ) + + pguardC "Only locks updated in the output stake" $ + templateStakeOut #== stakeOut + + pguardC "All relevant locks removed from the stake" $ + pgetStakeUsage # pfromData stakeOutputLocks + # proposalF.proposalId #== pcon PDidNothing + + pure $ popaque (pconstant ()) -------------------------------------------------------------------------- PAdvanceProposal _r -> unTermCont $ do pguardC "Stake should not change" stakeUnchanged diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 3558d9e..61b6b68 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -18,10 +18,12 @@ module Agora.Stake ( PStakeDatum (..), PStakeRedeemer (..), PProposalLock (..), + PStakeUsage (..), -- * Utility functions stakeLocked, findStakeOwnedBy, + pgetStakeUsage, ) where -------------------------------------------------------------------------------- @@ -29,7 +31,7 @@ module Agora.Stake ( import Control.Applicative (Const) import Data.Tagged (Tagged (..)) import GHC.Generics qualified as GHC -import Generics.SOP (Generic, I (I)) +import Generics.SOP (Generic, HasDatatypeInfo, I (I)) import Prelude hiding (Num (..)) -------------------------------------------------------------------------------- @@ -56,8 +58,8 @@ import Plutarch.DataRepr ( PDataFields, PIsDataReprInstances (PIsDataReprInstances), ) -import Plutarch.Extra.List (pnotNull) -import Plutarch.Extra.TermCont (pletC, pmatchC) +import Plutarch.Extra.List (pmapMaybe, pnotNull) +import Plutarch.Extra.TermCont (pletC, pletFieldsC, pmatchC) import Plutarch.Internal (punsafeCoerce) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import Plutarch.SafeMoney (PDiscrete) @@ -286,7 +288,7 @@ stakeDatumOwnedBy = pletFields @'["owner"] (pto stakeDatum) $ \stakeDatumF -> stakeDatumF.owner #== pdata pk --- Does the input have a `Stake` owned by a particular PK? +-- | Does the input have a `Stake` owned by a particular PK? isInputStakeOwnedBy :: Term _ @@ -299,7 +301,7 @@ isInputStakeOwnedBy = plam $ \ac ss datums txInInfo' -> unTermCont $ do PTxInInfo ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfromData txInInfo' PTxOut txOut' <- pmatchC txOut - txOutF <- tcont $ pletFields @'["value", "datumHash"] txOut' + txOutF <- pletFieldsC @'["value", "datumHash"] txOut' outStakeST <- pletC $ passetClassValueOf # txOutF.value # ac pure $ pmatch txOutF.datumHash $ \case @@ -312,3 +314,53 @@ isInputStakeOwnedBy = PJust v -> stakeDatumOwnedBy # ss # pfromData (punsafeCoerce v) ) (pcon PFalse) + +{- | Represent the usage of a stake on a particular proposal. + A stake can be used to either create or vote on a proposal. +-} +data PStakeUsage (s :: S) + = PVotedFor (Term s PResultTag) + | PCreated + | PDidNothing + deriving stock (GHC.Generic) + deriving anyclass (Generic, PlutusType, HasDatatypeInfo, PEq) + +{- | / O(n) /.Return the usage of a stake on a particular proposal, + given the 'lockedBy' field of a stake and the target proposal. +-} +pgetStakeUsage :: + Term + _ + ( PBuiltinList (PAsData PProposalLock) + :--> PProposalId + :--> PStakeUsage + ) +pgetStakeUsage = phoistAcyclic $ + plam $ \locks pid -> + let -- All locks from the given proposal. + filteredLocks = + pmapMaybe + # plam + ( \lock'@(pfromData -> lock) -> unTermCont $ do + lockF <- pletFieldsC @'["proposalTag"] lock + + pure $ + pif + (lockF.proposalTag #== pid) + (pcon $ PJust lock') + (pcon PNothing) + ) + # locks + + lockCount' = plength # filteredLocks + in plet lockCount' $ \lockCount -> + pif (lockCount #== 0) (pcon PDidNothing) $ + pif + (lockCount #== 1) + ( pcon $ + PVotedFor $ + pfromData $ + pfield @"vote" #$ phead # filteredLocks + ) + -- Note: see the implementation of the governor. + (pcon PCreated) diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index d0ca147..a1c8c3f 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -287,7 +287,7 @@ stakeValidator stake = pure $ pmatch stakeRedeemer $ \case - PRetractVotes _ -> unTermCont $ do + PRetractVotes l -> unTermCont $ do pguardC "Owner signs this transaction" ownerSignsTransaction @@ -301,15 +301,22 @@ stakeValidator stake = spentProposalST #== 1 pguardC "A UTXO must exist with the correct output" $ - unTermCont $ do - let valueCorrect = ownOutputValueUnchanged + let expectedLocks = pfield @"locks" # l - -- TODO: check output datum is expected. + expectedDatum = + mkRecordConstr + PStakeDatum + ( #stakedAmount .= stakeDatum.stakedAmount + .& #owner .= stakeDatum.owner + .& #lockedBy .= expectedLocks + ) - pure $ - foldl1 + valueCorrect = ownOutputValueUnchanged + outputDatumCorrect = stakeOut #== expectedDatum + in foldl1 (#&&) [ ptraceIfFalse "valueCorrect" valueCorrect + , ptraceIfFalse "datumCorrect" outputDatumCorrect ] pure $ popaque (pconstant ()) diff --git a/bench.csv b/bench.csv index b40f538..9630163 100644 --- a/bench.csv +++ b/bench.csv @@ -2,28 +2,28 @@ name,cpu,mem,size Agora/Effects/Treasury Withdrawal Effect/effect/Simple,289461528,703055,3191 Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,448521458,1070167,3518 Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,408085321,966048,3383 -Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7664 +Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7665 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,97345575,266935,3358 Agora/Stake/policy/stakeCreation,43114795,124549,2156 -Agora/Stake/validator/stakeDepositWithdraw deposit,171823342,464745,4144 -Agora/Stake/validator/stakeDepositWithdraw withdraw,171823342,464745,4132 -Agora/Proposal/policy/proposalCreation,23140177,69194,1517 -Agora/Proposal/validator/cosignature/proposal,213692648,591151,5767 -Agora/Proposal/validator/cosignature/stake,115369581,282557,4681 -Agora/Proposal/validator/voting/proposal,167847632,446101,5696 -Agora/Proposal/validator/voting/stake,99545453,256941,4655 -Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,167492034,450393,5594 -Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,166648612,448890,5597 -Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,168345079,452496,5597 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,166362233,447663,5596 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,164953322,444958,5597 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,166084300,447362,5597 +Agora/Stake/validator/stakeDepositWithdraw deposit,171823342,464745,4189 +Agora/Stake/validator/stakeDepositWithdraw withdraw,171823342,464745,4177 +Agora/Proposal/policy/proposalCreation,23140177,69194,1518 +Agora/Proposal/validator/cosignature/proposal,204675349,564476,6565 +Agora/Proposal/validator/cosignature/stake,114125937,284821,4726 +Agora/Proposal/validator/voting/proposal,166129664,437310,6494 +Agora/Proposal/validator/voting/stake,107127768,275725,4700 +Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,162018766,433842,6392 +Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,161175344,432339,6395 +Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,162871811,435945,6395 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160888965,431112,6394 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159480054,428407,6395 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160611032,430811,6395 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Governor/policy/GST minting,43087287,120125,1829 -Agora/Governor/validator/proposal creation,262494214,690689,8180 -Agora/Governor/validator/GATs minting,349283864,932132,8301 -Agora/Governor/validator/mutate governor state,84905433,234687,7765 +Agora/Governor/validator/proposal creation,261928725,689487,8181 +Agora/Governor/validator/GATs minting,352305185,937264,8302 +Agora/Governor/validator/mutate governor state,84905433,234687,7766 From 034e55c34fd5f523fe2bfdaf29345b9e87223231 Mon Sep 17 00:00:00 2001 From: fanghr Date: Wed, 1 Jun 2022 21:35:57 +0800 Subject: [PATCH 3/9] add samples and tests for unlocking stakes --- agora-specs/Sample/Proposal.hs | 292 ++++++++++++++++++++++++++++++++- agora-specs/Spec/Proposal.hs | 250 ++++++++++++++++++++++++++++ bench.csv | 4 + 3 files changed, 541 insertions(+), 5 deletions(-) diff --git a/agora-specs/Sample/Proposal.hs b/agora-specs/Sample/Proposal.hs index 458154f..1d352b9 100644 --- a/agora-specs/Sample/Proposal.hs +++ b/agora-specs/Sample/Proposal.hs @@ -19,6 +19,14 @@ module Sample.Proposal ( advanceFinishedPropsoal, advanceProposalInsufficientVotes, advancePropsoalWithInvalidOutputStake, + voterUnlockStakeAndRetractVotesWhile, + voterUnlockStakeWhile, + creatorRetractVotesWhile, + creatorUnlockStakeWhile, + unlockStakeAndRetractVotesUsingIrrelevantStakeWhile, + unlockStakeUsingIrrelevantStakeWhile, + unlockStakeProposalId, + unlockStake, ) where import Agora.Governor (GovernorDatum (..)) @@ -78,17 +86,14 @@ import PlutusLedgerApi.V1.Value qualified as Value ( assetClassValue, singleton, ) -import PlutusTx.AssocMap qualified as AssocMap ( - Map, - empty, - fromList, - ) +import PlutusTx.AssocMap qualified as AssocMap import Sample.Shared ( govValidatorHash, minAda, proposal, proposalPolicySymbol, proposalStartingTimeFromTimeRange, + proposalValidatorAddress, proposalValidatorHash, signer, signer2, @@ -808,3 +813,280 @@ advancePropsoalWithInvalidOutputStake = <> templateTxInfo.txInfoData , txInfoSignatories = [stakeOwner] } + +-------------------------------------------------------------------------------- + +-- | Create empty effects for every result tag given the votes. +emptyEffectFor :: + ProposalVotes -> + AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash) +emptyEffectFor (ProposalVotes vs) = + AssocMap.fromList $ + map (,AssocMap.empty) (AssocMap.keys vs) + +-- | The proposal id shared by all the samples relate to unlocking stake. +unlockStakeProposalId :: ProposalId +unlockStakeProposalId = ProposalId 0 + +-- | A 'ProposalVotes' that has only two options, serves as a template for unlokcing stake samples. +unlockStakePropsoalVotesTemplate :: ProposalVotes +unlockStakePropsoalVotesTemplate = + ProposalVotes $ + AssocMap.fromList + [ (ResultTag 0, 0) + , (ResultTag 1, 0) + ] + +-- | Create a 'TxInfo' that unlocks a stake from a proposal. For internal use only. +mkUnlockStakeTxInfo :: + -- | The current state of the proposal. + ProposalStatus -> + -- | The votes of the input propsoal + ProposalVotes -> + -- | The votes of the output proposal. + ProposalVotes -> + -- | Stake amount. + Integer -> + -- | Retract from option. + [ProposalLock] -> + -- | The locks of output stake. + [ProposalLock] -> + TxInfo +mkUnlockStakeTxInfo + status + votesBefore + votesAfter + stakedAmount + locksBefore + locksAfter = + let stakeOwner = signer + + stakeInputDatum' :: StakeDatum + stakeInputDatum' = + StakeDatum + { stakedAmount = Tagged stakedAmount + , owner = stakeOwner + , lockedBy = locksBefore + } + + stakeOutputDatum' :: StakeDatum + stakeOutputDatum' = + stakeInputDatum' + { lockedBy = locksAfter + } + + --- + + effects = emptyEffectFor votesBefore + + proposalInputDatum' :: ProposalDatum + proposalInputDatum' = + ProposalDatum + { proposalId = unlockStakeProposalId + , effects = effects + , status = status + , cosigners = [signer] + , thresholds = def + , votes = votesBefore + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + + proposalOutputDatum' :: ProposalDatum + proposalOutputDatum' = + proposalInputDatum' + { votes = votesAfter + } + + --- + + sst = Value.assetClassValue stakeAssetClass 1 + + stakeInputDatum :: Datum + stakeInputDatum = Datum $ toBuiltinData stakeInputDatum' + stakeInput :: TxOut + stakeInput = + TxOut + { txOutAddress = stakeAddress + , txOutValue = + mconcat + [ sst + , Value.assetClassValue (untag stake.gtClassRef) stakedAmount + , minAda + ] + , txOutDatumHash = Just $ toDatumHash stakeInputDatum + } + + stakeOutputDatum :: Datum + stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum' + stakeOutput :: TxOut + stakeOutput = + stakeInput + { txOutDatumHash = Just $ toDatumHash stakeOutputDatum + } + + --- + + pst = Value.singleton proposalPolicySymbol "" 1 + + proposalInputDatum :: Datum + proposalInputDatum = Datum $ toBuiltinData proposalInputDatum' + proposalInput :: TxOut + proposalInput = + TxOut + { txOutAddress = proposalValidatorAddress + , txOutValue = pst + , txOutDatumHash = Just $ toDatumHash proposalInputDatum + } + + --- + + proposalOutputDatum :: Datum + proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum' + proposalOutput :: TxOut + proposalOutput = + proposalInput + { txOutValue = proposalInput.txOutValue <> minAda + , txOutDatumHash = Just $ toDatumHash proposalOutputDatum + } + in TxInfo + { txInfoInputs = [TxInInfo proposalRef proposalInput, TxInInfo stakeRef stakeInput] + , txInfoOutputs = [proposalOutput, stakeOutput] + , txInfoFee = Value.singleton "" "" 2 + , txInfoMint = mempty + , txInfoDCert = [] + , txInfoWdrl = [] + , -- Time doesn't matter int this case. + txInfoValidRange = closedBoundedInterval 0 100 + , txInfoSignatories = [signer] + , txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum, stakeInputDatum, stakeOutputDatum] + , txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a" + } + +-- | How a stake has been used on a particular proposal. +data StakeUsage + = -- | The stake was spent to vote for a paraticular option. + VotedFor ResultTag + | -- | The stake was used to created the proposal. + Created + | -- | The stake has nothing to do with the proposal. + DidNothing + +-- | Create a bunch of 'ProposalLock' given the 'StakeUsgae'. +mkStakeLocks :: StakeUsage -> [ProposalLock] +mkStakeLocks (VotedFor rt) = [ProposalLock rt unlockStakeProposalId] +mkStakeLocks Created = + map (`ProposalLock` unlockStakeProposalId) $ + AssocMap.keys $ getProposalVotes unlockStakePropsoalVotesTemplate +mkStakeLocks _ = [] + +-- | Assemble the votes of the input propsoal based on 'unlockStakePropsoalVotesTemplate'. +mkVotesBefore :: + StakeUsage -> + -- | The staked amount/votes. + Integer -> + ProposalVotes +mkVotesBefore (VotedFor rt) vc = + ProposalVotes $ + updateMap (Just . const vc) rt $ + getProposalVotes unlockStakePropsoalVotesTemplate +mkVotesBefore _ vc = mkVotesBefore (VotedFor $ ResultTag 0) vc + +{- | Create a 'TxInfo' that unlocks the stake from the proposal. + The last parameter controls whether votes should be retracted or not. +-} +unlockStake :: + -- | The status of both the input and output propsoals. + ProposalStatus -> + StakeUsage -> + -- | Staked amount/vote count. + Integer -> + -- | Should we retract votes? + Bool -> + TxInfo +unlockStake ps su staked shouldRetract = + let votesBefore = mkVotesBefore su staked + votesAfter = + if shouldRetract + then unlockStakePropsoalVotesTemplate + else votesBefore + + locksBefore = mkStakeLocks su + locksAfter = [] + in mkUnlockStakeTxInfo + ps + votesBefore + votesAfter + staked + locksBefore + locksAfter + +{- | Create a 'TxInfo' that unlocks a stake which is used to vote on the proposal. + Correct count of votes is also retracted. The 'TxInfo' is valid only if the given + proposal status is 'VotingReady'. +-} +voterUnlockStakeAndRetractVotesWhile :: ProposalStatus -> TxInfo +voterUnlockStakeAndRetractVotesWhile ps = + unlockStake + ps + (VotedFor $ ResultTag 0) + 42 + True + +{- | Create a 'TxInfo' that unlocks a stake which is used to vote on the proposal + without retracting the votes, given the status of the proposal. + + The 'TxInfo' is valid only if the status of the propsoal is either 'Locked' + or 'Finished'. +-} +voterUnlockStakeWhile :: ProposalStatus -> TxInfo +voterUnlockStakeWhile ps = + unlockStake + ps + (VotedFor $ ResultTag 0) + 42 + False + +{- | Create an invalid 'TxInfo' that retracts votes using the stake + that is used to create the proposal. +-} +creatorRetractVotesWhile :: ProposalStatus -> TxInfo +creatorRetractVotesWhile ps = + unlockStake + ps + Created + 42 + True + +{- | Create a 'TxInfo' to unlock the stake that is used to create the propsoal. + The 'TxInfo' is valid only if the given proposal status is 'Finished'. +-} +creatorUnlockStakeWhile :: ProposalStatus -> TxInfo +creatorUnlockStakeWhile ps = + unlockStake + ps + Created + 42 + False + +{- | Create an invalid 'TxInfo' that tries to retract votes and also unlock a stake + which is not locked by the proposal, given the status of the proposal. +-} +unlockStakeAndRetractVotesUsingIrrelevantStakeWhile :: ProposalStatus -> TxInfo +unlockStakeAndRetractVotesUsingIrrelevantStakeWhile ps = + unlockStake + ps + DidNothing + 42 + True + +{- | Create an invalid 'TxInfo' that tries to unlock a stake which is not locked by the proposal, + given the status of the proposal. +-} +unlockStakeUsingIrrelevantStakeWhile :: ProposalStatus -> TxInfo +unlockStakeUsingIrrelevantStakeWhile ps = + unlockStake + ps + DidNothing + 42 + False diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 39250cc..579a8dc 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -53,10 +53,16 @@ import Sample.Proposal qualified as Proposal ( advanceProposalSuccess, advancePropsoalWithInvalidOutputStake, cosignProposal, + creatorRetractVotesWhile, + creatorUnlockStakeWhile, proposalCreation, proposalRef, stakeRef, + unlockStakeAndRetractVotesUsingIrrelevantStakeWhile, + unlockStakeUsingIrrelevantStakeWhile, voteOnProposal, + voterUnlockStakeAndRetractVotesWhile, + voterUnlockStakeWhile, ) import Sample.Shared (signer, signer2) import Sample.Shared qualified as Shared (proposal, stake) @@ -356,5 +362,249 @@ specs = (Spending Proposal.proposalRef) ) ] + , group + "unlocking" + [ group + "legal" + [ validatorSucceedsWith + "retract votes and unlock stake while voting" + (proposalValidator Shared.proposal) + ( ProposalDatum + { proposalId = ProposalId 0 + , effects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + , status = VotingReady + , cosigners = [signer] + , thresholds = def + , votes = + ProposalVotes + ( AssocMap.fromList + [ (ResultTag 0, 42) + , (ResultTag 1, 0) + ] + ) + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + ) + (Unlock (ResultTag 0)) + ( ScriptContext + (Proposal.voterUnlockStakeAndRetractVotesWhile VotingReady) + (Spending Proposal.proposalRef) + ) + , validatorSucceedsWith + "unlock the stake that has been used to create the proposal" + (proposalValidator Shared.proposal) + ( ProposalDatum + { proposalId = ProposalId 0 + , effects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + , status = Finished + , cosigners = [signer] + , thresholds = def + , votes = + ProposalVotes + ( AssocMap.fromList + [ (ResultTag 0, 42) + , (ResultTag 1, 0) + ] + ) + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + ) + (Unlock (ResultTag 0)) + ( ScriptContext + (Proposal.creatorUnlockStakeWhile Finished) + (Spending Proposal.proposalRef) + ) + , group "unlock stake after voting" $ + map + ( \ps -> + validatorSucceedsWith + (show ps) + (proposalValidator Shared.proposal) + ( ProposalDatum + { proposalId = ProposalId 0 + , effects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + , status = ps + , cosigners = [signer] + , thresholds = def + , votes = + ProposalVotes + ( AssocMap.fromList + [ (ResultTag 0, 42) + , (ResultTag 1, 0) + ] + ) + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + ) + (Unlock (ResultTag 0)) + ( ScriptContext + (Proposal.voterUnlockStakeWhile ps) + (Spending Proposal.proposalRef) + ) + ) + [Locked, Finished] + ] + , group + "illegal" + [ group "retract votes while the proposal is not voting ready" $ + map + ( \ps -> + validatorFailsWith + (show ps) + (proposalValidator Shared.proposal) + ( ProposalDatum + { proposalId = ProposalId 0 + , effects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + , status = ps + , cosigners = [signer] + , thresholds = def + , votes = + ProposalVotes + ( AssocMap.fromList + [ (ResultTag 0, 42) + , (ResultTag 1, 0) + ] + ) + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + ) + (Unlock (ResultTag 0)) + ( ScriptContext + (Proposal.voterUnlockStakeAndRetractVotesWhile ps) + (Spending Proposal.proposalRef) + ) + ) + [Draft, Locked, Finished] + , group + "irrelevant stake" + $ foldMap + ( \(f, s) -> + map + ( \ps -> + validatorFailsWith + (s <> " (" <> show ps <> ")") + (proposalValidator Shared.proposal) + ( ProposalDatum + { proposalId = ProposalId 0 + , effects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + , status = ps + , cosigners = [signer] + , thresholds = def + , votes = + ProposalVotes + ( AssocMap.fromList + [ (ResultTag 0, 42) + , (ResultTag 1, 0) + ] + ) + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + ) + (Unlock (ResultTag 0)) + ( ScriptContext + (f ps) + (Spending Proposal.proposalRef) + ) + ) + [Draft, VotingReady, Locked, Finished] + ) + [ (Proposal.unlockStakeAndRetractVotesUsingIrrelevantStakeWhile, "unlock stake + retract votes") + , (Proposal.unlockStakeUsingIrrelevantStakeWhile, "unlock stake") + ] + , group "unlock stake that has been used to create the proposal before finished" $ + map + ( \ps -> + validatorFailsWith + (show ps) + (proposalValidator Shared.proposal) + ( ProposalDatum + { proposalId = ProposalId 0 + , effects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + , status = ps + , cosigners = [signer] + , thresholds = def + , votes = + ProposalVotes + ( AssocMap.fromList + [ (ResultTag 0, 42) + , (ResultTag 1, 0) + ] + ) + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + ) + (Unlock (ResultTag 0)) + ( ScriptContext + (Proposal.creatorUnlockStakeWhile ps) + (Spending Proposal.proposalRef) + ) + ) + [Draft, VotingReady, Locked] + , group "creator stake retract votes" $ + map + ( \ps -> + validatorFailsWith + (show ps) + (proposalValidator Shared.proposal) + ( ProposalDatum + { proposalId = ProposalId 0 + , effects = + AssocMap.fromList + [ (ResultTag 0, AssocMap.empty) + , (ResultTag 1, AssocMap.empty) + ] + , status = ps + , cosigners = [signer] + , thresholds = def + , votes = + ProposalVotes + ( AssocMap.fromList + [ (ResultTag 0, 42) + , (ResultTag 1, 0) + ] + ) + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + ) + (Unlock (ResultTag 0)) + ( ScriptContext + (Proposal.creatorRetractVotesWhile ps) + (Spending Proposal.proposalRef) + ) + ) + [Draft, VotingReady, Locked, Finished] + ] + ] ] ] diff --git a/bench.csv b/bench.csv index 9630163..32fcd3f 100644 --- a/bench.csv +++ b/bench.csv @@ -18,6 +18,10 @@ Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160888965,431112,6394 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159480054,428407,6395 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160611032,430811,6395 +Agora/Proposal/validator/unlocking/legal/retract votes and unlock stake while voting,171592676,462566,6467 +Agora/Proposal/validator/unlocking/legal/unlock the stake that has been used to create the proposal,149988973,407906,6474 +Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Locked,149056062,408201,6468 +Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Finished,149056062,408201,6468 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390 From feb3f2daaf4f2ec968c6ca34cbb0f29bd1b87985 Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 6 Jun 2022 21:19:51 +0800 Subject: [PATCH 4/9] apply Emily's suggestions --- agora-specs/Sample/Proposal.hs | 2 +- agora/Agora/Proposal.hs | 4 ++-- agora/Agora/Proposal/Scripts.hs | 10 +++++----- bench.csv | 32 ++++++++++++++++---------------- 4 files changed, 24 insertions(+), 24 deletions(-) diff --git a/agora-specs/Sample/Proposal.hs b/agora-specs/Sample/Proposal.hs index 1d352b9..23357c2 100644 --- a/agora-specs/Sample/Proposal.hs +++ b/agora-specs/Sample/Proposal.hs @@ -408,7 +408,7 @@ mkTransitionTxInfo :: ProposalStartingTime -> -- | Valid time range of the transaction. POSIXTimeRange -> - -- | Add a unchanged stake or not. + -- | Whether to add an unchanged stake or not. Bool -> TxInfo mkTransitionTxInfo from to effects votes startingTime validTime shouldAddUnchangedStake = diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 02093f5..2705291 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -369,9 +369,9 @@ newtype PProposalVotes (s :: S) deriving (PlutusType, PIsData) via (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger)) -- | Retract votes given the option and the amount of votes. -pretractVotes :: Term s (PProposalVotes :--> PResultTag :--> PInteger :--> PProposalVotes) +pretractVotes :: Term s (PResultTag :--> PInteger :--> PProposalVotes :--> PProposalVotes) pretractVotes = phoistAcyclic $ - plam $ \votes rt count -> + plam $ \rt count votes -> let voteMap :: Term _ (PMap 'Unsorted PResultTag PInteger) voteMap = pto votes in pcon $ diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 0d2084c..2d40389 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -416,19 +416,19 @@ proposalValidator proposal = pguardC "Stake input relevant" $ pmatch stakeUsage $ \case PDidNothing -> - ptrace "Not relevant" $ + ptraceIfFalse "Stake should be relevant" $ pconstant False PCreated -> - ptraceIfFalse "Too early" $ + ptraceIfFalse "Removing creator's locks means status is Finished" $ proposalF.status #== pconstantData Finished PVotedFor rt -> - ptraceIfFalse "Result tag not match" $ + ptraceIfFalse "Result tag should match the one given in the redeemer" $ rt #== retractFrom -- The count of removing votes is equal to the 'stakeAmount' of input stake. retractCount <- pletC $ - pmatch stakeInF.stakedAmount $ (\(PDiscrete v) -> pextract # v) + pmatch stakeInF.stakedAmount $ \(PDiscrete v) -> pextract # v -- The votes can only change when the proposal still allows voting. let shouldUpdateVotes = @@ -439,7 +439,7 @@ proposalValidator proposal = pif shouldUpdateVotes ( let -- Remove votes and leave other parts of the proposal as it. - expectedVotes = pretractVotes # proposalF.votes # retractFrom # retractCount + expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes expectedProposalOut = mkRecordConstr diff --git a/bench.csv b/bench.csv index 32fcd3f..e331364 100644 --- a/bench.csv +++ b/bench.csv @@ -2,32 +2,32 @@ name,cpu,mem,size Agora/Effects/Treasury Withdrawal Effect/effect/Simple,289461528,703055,3191 Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,448521458,1070167,3518 Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,408085321,966048,3383 -Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7665 +Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7664 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,97345575,266935,3358 Agora/Stake/policy/stakeCreation,43114795,124549,2156 Agora/Stake/validator/stakeDepositWithdraw deposit,171823342,464745,4189 Agora/Stake/validator/stakeDepositWithdraw withdraw,171823342,464745,4177 Agora/Proposal/policy/proposalCreation,23140177,69194,1518 -Agora/Proposal/validator/cosignature/proposal,204675349,564476,6565 +Agora/Proposal/validator/cosignature/proposal,204675349,564476,6654 Agora/Proposal/validator/cosignature/stake,114125937,284821,4726 -Agora/Proposal/validator/voting/proposal,166129664,437310,6494 +Agora/Proposal/validator/voting/proposal,166129664,437310,6583 Agora/Proposal/validator/voting/stake,107127768,275725,4700 -Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,162018766,433842,6392 -Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,161175344,432339,6395 -Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,162871811,435945,6395 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160888965,431112,6394 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159480054,428407,6395 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160611032,430811,6395 -Agora/Proposal/validator/unlocking/legal/retract votes and unlock stake while voting,171592676,462566,6467 -Agora/Proposal/validator/unlocking/legal/unlock the stake that has been used to create the proposal,149988973,407906,6474 -Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Locked,149056062,408201,6468 -Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Finished,149056062,408201,6468 +Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,162018766,433842,6481 +Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,161175344,432339,6484 +Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,162871811,435945,6484 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160888965,431112,6483 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159480054,428407,6484 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160611032,430811,6484 +Agora/Proposal/validator/unlocking/legal/retract votes and unlock stake while voting,171454676,461966,6556 +Agora/Proposal/validator/unlocking/legal/unlock the stake that has been used to create the proposal,149988973,407906,6563 +Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Locked,149056062,408201,6557 +Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Finished,149056062,408201,6557 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Governor/policy/GST minting,43087287,120125,1829 -Agora/Governor/validator/proposal creation,261928725,689487,8181 -Agora/Governor/validator/GATs minting,352305185,937264,8302 -Agora/Governor/validator/mutate governor state,84905433,234687,7766 +Agora/Governor/validator/proposal creation,262494214,690689,8180 +Agora/Governor/validator/GATs minting,351739696,936062,8301 +Agora/Governor/validator/mutate governor state,84905433,234687,7765 From 4ac80516c5ac83da3a28a3528e371534a58bb3e2 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Fri, 17 Jun 2022 23:01:44 +0800 Subject: [PATCH 5/9] allow multiple proposals in the samples of unlocking stake --- agora-specs/Sample/Proposal.hs | 293 +--------------- agora-specs/Sample/Proposal/Shared.hs | 9 + agora-specs/Sample/Proposal/UnlockStake.hs | 275 +++++++++++++++ agora-specs/Spec/Proposal.hs | 368 ++++++--------------- agora-testlib/Test/Util.hs | 23 +- agora.cabal | 2 + bench.csv | 12 +- 7 files changed, 422 insertions(+), 560 deletions(-) create mode 100644 agora-specs/Sample/Proposal/Shared.hs create mode 100644 agora-specs/Sample/Proposal/UnlockStake.hs diff --git a/agora-specs/Sample/Proposal.hs b/agora-specs/Sample/Proposal.hs index 23357c2..25c3fb4 100644 --- a/agora-specs/Sample/Proposal.hs +++ b/agora-specs/Sample/Proposal.hs @@ -19,14 +19,6 @@ module Sample.Proposal ( advanceFinishedPropsoal, advanceProposalInsufficientVotes, advancePropsoalWithInvalidOutputStake, - voterUnlockStakeAndRetractVotesWhile, - voterUnlockStakeWhile, - creatorRetractVotesWhile, - creatorUnlockStakeWhile, - unlockStakeAndRetractVotesUsingIrrelevantStakeWhile, - unlockStakeUsingIrrelevantStakeWhile, - unlockStakeProposalId, - unlockStake, ) where import Agora.Governor (GovernorDatum (..)) @@ -87,13 +79,13 @@ import PlutusLedgerApi.V1.Value qualified as Value ( singleton, ) import PlutusTx.AssocMap qualified as AssocMap +import Sample.Proposal.Shared (proposalRef, stakeRef) import Sample.Shared ( govValidatorHash, minAda, proposal, proposalPolicySymbol, proposalStartingTimeFromTimeRange, - proposalValidatorAddress, proposalValidatorHash, signer, signer2, @@ -169,12 +161,6 @@ proposalCreation = ] in buildMintingUnsafe builder -proposalRef :: TxOutRef -proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1 - -stakeRef :: TxOutRef -stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0 - -- | This script context should be a valid transaction. cosignProposal :: [PubKeyHash] -> TxInfo cosignProposal newSigners = @@ -813,280 +799,3 @@ advancePropsoalWithInvalidOutputStake = <> templateTxInfo.txInfoData , txInfoSignatories = [stakeOwner] } - --------------------------------------------------------------------------------- - --- | Create empty effects for every result tag given the votes. -emptyEffectFor :: - ProposalVotes -> - AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash) -emptyEffectFor (ProposalVotes vs) = - AssocMap.fromList $ - map (,AssocMap.empty) (AssocMap.keys vs) - --- | The proposal id shared by all the samples relate to unlocking stake. -unlockStakeProposalId :: ProposalId -unlockStakeProposalId = ProposalId 0 - --- | A 'ProposalVotes' that has only two options, serves as a template for unlokcing stake samples. -unlockStakePropsoalVotesTemplate :: ProposalVotes -unlockStakePropsoalVotesTemplate = - ProposalVotes $ - AssocMap.fromList - [ (ResultTag 0, 0) - , (ResultTag 1, 0) - ] - --- | Create a 'TxInfo' that unlocks a stake from a proposal. For internal use only. -mkUnlockStakeTxInfo :: - -- | The current state of the proposal. - ProposalStatus -> - -- | The votes of the input propsoal - ProposalVotes -> - -- | The votes of the output proposal. - ProposalVotes -> - -- | Stake amount. - Integer -> - -- | Retract from option. - [ProposalLock] -> - -- | The locks of output stake. - [ProposalLock] -> - TxInfo -mkUnlockStakeTxInfo - status - votesBefore - votesAfter - stakedAmount - locksBefore - locksAfter = - let stakeOwner = signer - - stakeInputDatum' :: StakeDatum - stakeInputDatum' = - StakeDatum - { stakedAmount = Tagged stakedAmount - , owner = stakeOwner - , lockedBy = locksBefore - } - - stakeOutputDatum' :: StakeDatum - stakeOutputDatum' = - stakeInputDatum' - { lockedBy = locksAfter - } - - --- - - effects = emptyEffectFor votesBefore - - proposalInputDatum' :: ProposalDatum - proposalInputDatum' = - ProposalDatum - { proposalId = unlockStakeProposalId - , effects = effects - , status = status - , cosigners = [signer] - , thresholds = def - , votes = votesBefore - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - - proposalOutputDatum' :: ProposalDatum - proposalOutputDatum' = - proposalInputDatum' - { votes = votesAfter - } - - --- - - sst = Value.assetClassValue stakeAssetClass 1 - - stakeInputDatum :: Datum - stakeInputDatum = Datum $ toBuiltinData stakeInputDatum' - stakeInput :: TxOut - stakeInput = - TxOut - { txOutAddress = stakeAddress - , txOutValue = - mconcat - [ sst - , Value.assetClassValue (untag stake.gtClassRef) stakedAmount - , minAda - ] - , txOutDatumHash = Just $ toDatumHash stakeInputDatum - } - - stakeOutputDatum :: Datum - stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum' - stakeOutput :: TxOut - stakeOutput = - stakeInput - { txOutDatumHash = Just $ toDatumHash stakeOutputDatum - } - - --- - - pst = Value.singleton proposalPolicySymbol "" 1 - - proposalInputDatum :: Datum - proposalInputDatum = Datum $ toBuiltinData proposalInputDatum' - proposalInput :: TxOut - proposalInput = - TxOut - { txOutAddress = proposalValidatorAddress - , txOutValue = pst - , txOutDatumHash = Just $ toDatumHash proposalInputDatum - } - - --- - - proposalOutputDatum :: Datum - proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum' - proposalOutput :: TxOut - proposalOutput = - proposalInput - { txOutValue = proposalInput.txOutValue <> minAda - , txOutDatumHash = Just $ toDatumHash proposalOutputDatum - } - in TxInfo - { txInfoInputs = [TxInInfo proposalRef proposalInput, TxInInfo stakeRef stakeInput] - , txInfoOutputs = [proposalOutput, stakeOutput] - , txInfoFee = Value.singleton "" "" 2 - , txInfoMint = mempty - , txInfoDCert = [] - , txInfoWdrl = [] - , -- Time doesn't matter int this case. - txInfoValidRange = closedBoundedInterval 0 100 - , txInfoSignatories = [signer] - , txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum, stakeInputDatum, stakeOutputDatum] - , txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a" - } - --- | How a stake has been used on a particular proposal. -data StakeUsage - = -- | The stake was spent to vote for a paraticular option. - VotedFor ResultTag - | -- | The stake was used to created the proposal. - Created - | -- | The stake has nothing to do with the proposal. - DidNothing - --- | Create a bunch of 'ProposalLock' given the 'StakeUsgae'. -mkStakeLocks :: StakeUsage -> [ProposalLock] -mkStakeLocks (VotedFor rt) = [ProposalLock rt unlockStakeProposalId] -mkStakeLocks Created = - map (`ProposalLock` unlockStakeProposalId) $ - AssocMap.keys $ getProposalVotes unlockStakePropsoalVotesTemplate -mkStakeLocks _ = [] - --- | Assemble the votes of the input propsoal based on 'unlockStakePropsoalVotesTemplate'. -mkVotesBefore :: - StakeUsage -> - -- | The staked amount/votes. - Integer -> - ProposalVotes -mkVotesBefore (VotedFor rt) vc = - ProposalVotes $ - updateMap (Just . const vc) rt $ - getProposalVotes unlockStakePropsoalVotesTemplate -mkVotesBefore _ vc = mkVotesBefore (VotedFor $ ResultTag 0) vc - -{- | Create a 'TxInfo' that unlocks the stake from the proposal. - The last parameter controls whether votes should be retracted or not. --} -unlockStake :: - -- | The status of both the input and output propsoals. - ProposalStatus -> - StakeUsage -> - -- | Staked amount/vote count. - Integer -> - -- | Should we retract votes? - Bool -> - TxInfo -unlockStake ps su staked shouldRetract = - let votesBefore = mkVotesBefore su staked - votesAfter = - if shouldRetract - then unlockStakePropsoalVotesTemplate - else votesBefore - - locksBefore = mkStakeLocks su - locksAfter = [] - in mkUnlockStakeTxInfo - ps - votesBefore - votesAfter - staked - locksBefore - locksAfter - -{- | Create a 'TxInfo' that unlocks a stake which is used to vote on the proposal. - Correct count of votes is also retracted. The 'TxInfo' is valid only if the given - proposal status is 'VotingReady'. --} -voterUnlockStakeAndRetractVotesWhile :: ProposalStatus -> TxInfo -voterUnlockStakeAndRetractVotesWhile ps = - unlockStake - ps - (VotedFor $ ResultTag 0) - 42 - True - -{- | Create a 'TxInfo' that unlocks a stake which is used to vote on the proposal - without retracting the votes, given the status of the proposal. - - The 'TxInfo' is valid only if the status of the propsoal is either 'Locked' - or 'Finished'. --} -voterUnlockStakeWhile :: ProposalStatus -> TxInfo -voterUnlockStakeWhile ps = - unlockStake - ps - (VotedFor $ ResultTag 0) - 42 - False - -{- | Create an invalid 'TxInfo' that retracts votes using the stake - that is used to create the proposal. --} -creatorRetractVotesWhile :: ProposalStatus -> TxInfo -creatorRetractVotesWhile ps = - unlockStake - ps - Created - 42 - True - -{- | Create a 'TxInfo' to unlock the stake that is used to create the propsoal. - The 'TxInfo' is valid only if the given proposal status is 'Finished'. --} -creatorUnlockStakeWhile :: ProposalStatus -> TxInfo -creatorUnlockStakeWhile ps = - unlockStake - ps - Created - 42 - False - -{- | Create an invalid 'TxInfo' that tries to retract votes and also unlock a stake - which is not locked by the proposal, given the status of the proposal. --} -unlockStakeAndRetractVotesUsingIrrelevantStakeWhile :: ProposalStatus -> TxInfo -unlockStakeAndRetractVotesUsingIrrelevantStakeWhile ps = - unlockStake - ps - DidNothing - 42 - True - -{- | Create an invalid 'TxInfo' that tries to unlock a stake which is not locked by the proposal, - given the status of the proposal. --} -unlockStakeUsingIrrelevantStakeWhile :: ProposalStatus -> TxInfo -unlockStakeUsingIrrelevantStakeWhile ps = - unlockStake - ps - DidNothing - 42 - False diff --git a/agora-specs/Sample/Proposal/Shared.hs b/agora-specs/Sample/Proposal/Shared.hs new file mode 100644 index 0000000..1a2ee64 --- /dev/null +++ b/agora-specs/Sample/Proposal/Shared.hs @@ -0,0 +1,9 @@ +module Sample.Proposal.Shared (proposalRef, stakeRef) where + +import PlutusLedgerApi.V1 (TxOutRef (..)) + +proposalRef :: TxOutRef +proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1 + +stakeRef :: TxOutRef +stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0 diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs new file mode 100644 index 0000000..e961009 --- /dev/null +++ b/agora-specs/Sample/Proposal/UnlockStake.hs @@ -0,0 +1,275 @@ +module Sample.Proposal.UnlockStake ( + unlockStake, + StakeRole (..), + UnlockStakeParameters (..), + votesTemplate, + emptyEffectFor, + mkProposalInputDatum, + mkStakeInputDatum, + mkProposalValidatorTestCase, +) where + +-------------------------------------------------------------------------------- + +import PlutusLedgerApi.V1 ( + Datum (Datum), + DatumHash, + ScriptContext (..), + ScriptPurpose (Spending), + ToData (toBuiltinData), + TxInInfo (TxInInfo), + TxInfo (..), + TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue), + TxOutRef (..), + ValidatorHash, + ) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusTx.AssocMap qualified as AssocMap + +-------------------------------------------------------------------------------- + +import Agora.Proposal ( + ProposalDatum (..), + ProposalId (..), + ProposalRedeemer (Unlock), + ProposalStatus (..), + ProposalVotes (..), + ResultTag (..), + ) +import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime)) +import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..)) +import Sample.Shared ( + minAda, + proposalPolicySymbol, + proposalValidatorAddress, + signer, + stake, + stakeAssetClass, + ) +import Test.Util (closedBoundedInterval, datumPair, sortValue, toDatumHash, updateMap) + +-------------------------------------------------------------------------------- + +import Agora.Proposal.Scripts (proposalValidator) +import Control.Monad (join) +import Data.Default.Class (Default (def)) +import Data.Tagged (Tagged (..), untag) +import Sample.Proposal.Shared (proposalRef, stakeRef) +import Sample.Shared qualified as Shared +import Test.Specification (SpecificationTree, validatorFailsWith, validatorSucceedsWith) + +-------------------------------------------------------------------------------- + +-- | The template "shape" that votes of proposals generated by 'mkProposalDatumPair' have. +votesTemplate :: ProposalVotes +votesTemplate = + ProposalVotes $ + AssocMap.fromList + [ (ResultTag 0, 0) + , (ResultTag 1, 0) + ] + +-- | Create empty effects for every result tag given the votes. +emptyEffectFor :: + ProposalVotes -> + AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash) +emptyEffectFor (ProposalVotes vs) = + AssocMap.fromList $ + map (,AssocMap.empty) (AssocMap.keys vs) + +-- | The default vote option that will be used by functions in this module. +defaultVoteFor :: ResultTag +defaultVoteFor = ResultTag 0 + +-- | The default number of GTs the stake will have. +defaultStakedGTs :: Tagged _ Integer +defaultStakedGTs = Tagged 100000 + +-- | How a stake has been used on a particular proposal. +data StakeRole + = -- | The stake was spent to vote for a paraticular option. + Voter + | -- | The stake was used to created the proposal. + Creator + | -- | The stake has nothing to do with the proposal. + Irrelevant + +-- | Parameters for creating a 'TxOut' that unlocks a stake. +data UnlockStakeParameters = UnlockStakeParameters + { proposalCount :: Integer + -- ^ The number of proposals in the 'TxOut'. + , stakeUsage :: StakeRole + -- ^ The role of the stake we're unlocking. + , retractVotes :: Bool + -- ^ Whether to retract votes or not. + , proposalStatus :: ProposalStatus + -- ^ The state of all the proposals. + } + +instance Show UnlockStakeParameters where + show p = + let role = case p.stakeUsage of + Voter -> "voter" + Creator -> "creator" + _ -> "irrelevant stake" + + action = + if p.retractVotes + then "unlock stake + retract votes" + else "unlock stake" + + while = show p.proposalStatus + + proposalInfo = mconcat [show p.proposalCount, " proposals"] + in mconcat [proposalInfo, ", ", role, ", ", action, ", ", while] + +-- | Generate some input proposals and their corresponding output proposals. +mkProposals :: UnlockStakeParameters -> ([ProposalDatum], [ProposalDatum]) +mkProposals p = unzip $ forEachProposalId p.proposalCount $ mkProposalDatumPair p + +-- | Iterate over the proposal id of every proposal, given the number of proposals. +forEachProposalId :: Integer -> (ProposalId -> a) -> [a] +forEachProposalId 0 _ = error "zero proposal" +forEachProposalId n f = f . ProposalId <$> [0 .. n - 1] + +-- | Create a valid stake 'TxOut' given the stake datum. +mkStakeTxOut :: StakeDatum -> TxOut +mkStakeTxOut sd = + let sst = Value.assetClassValue stakeAssetClass 1 + gts = Value.assetClassValue (untag stake.gtClassRef) (untag sd.stakedAmount) + in TxOut + { txOutAddress = proposalValidatorAddress + , txOutValue = sortValue $ sst <> minAda <> gts + , txOutDatumHash = Just $ toDatumHash sd + } + +-- | Create the input stake and its corresponding output stake. +mkStakeDatumPair :: UnlockStakeParameters -> (StakeDatum, StakeDatum) +mkStakeDatumPair c = + let output = + StakeDatum + { stakedAmount = defaultStakedGTs + , owner = signer + , lockedBy = [] + } + + inputLocks = join $ forEachProposalId c.proposalCount (mkStakeLocks c.stakeUsage) + + input = output {lockedBy = inputLocks} + in (input, output) + where + mkStakeLocks :: StakeRole -> ProposalId -> [ProposalLock] + mkStakeLocks Voter pid = [ProposalLock defaultVoteFor pid] + mkStakeLocks Creator pid = + map (`ProposalLock` pid) $ + AssocMap.keys $ getProposalVotes votesTemplate + mkStakeLocks _ _ = [] + +-- | Create a valid proposal 'TxOut' given the proposal datum. +mkProposalTxOut :: ProposalDatum -> TxOut +mkProposalTxOut pd = + let pst = Value.singleton proposalPolicySymbol "" 1 + in TxOut + { txOutAddress = proposalValidatorAddress + , txOutValue = sortValue $ pst <> minAda + , txOutDatumHash = Just $ toDatumHash pd + } + +-- | Create a input proposal and its corresponding output proposal. +mkProposalDatumPair :: + UnlockStakeParameters -> + ProposalId -> + (ProposalDatum, ProposalDatum) +mkProposalDatumPair params pid = + let owner = signer + + inputVotes = mkInputVotes params.stakeUsage $ untag defaultStakedGTs + + input = + ProposalDatum + { proposalId = pid + , effects = emptyEffectFor votesTemplate + , status = params.proposalStatus + , cosigners = [owner] + , thresholds = def + , votes = inputVotes + , timingConfig = def + , startingTime = ProposalStartingTime 0 + } + + output = + if params.retractVotes + then input {votes = votesTemplate} + else input + in (input, output) + where + -- Assemble the votes of the input proposal based on 'votesTemplate'. + mkInputVotes :: + StakeRole -> + -- The staked amount/votes. + Integer -> + ProposalVotes + mkInputVotes Voter vc = + ProposalVotes $ + updateMap (Just . const vc) defaultVoteFor $ + getProposalVotes votesTemplate + mkInputVotes Creator _ = + ProposalVotes $ + updateMap (Just . const 1000) defaultVoteFor $ + getProposalVotes votesTemplate + mkInputVotes _ _ = votesTemplate + +-- | Create a 'TxInfo' that tries to unlock a stake. +unlockStake :: UnlockStakeParameters -> TxInfo +unlockStake p = + let (pInDatums, pOutDatums) = mkProposals p + (sInDatum, sOutDatum) = mkStakeDatumPair p + + pIns = + zipWith + ( \i d -> + ( let txOut = mkProposalTxOut d + ref = proposalRef {txOutRefIdx = i} + in TxInInfo ref txOut + ) + ) + [1 ..] + pInDatums + pOuts = map mkProposalTxOut pOutDatums + + sIn = TxInInfo stakeRef $ mkStakeTxOut sInDatum + sOut = mkStakeTxOut sOutDatum + + mkDatum :: forall d. (ToData d) => d -> Datum + mkDatum = Datum . toBuiltinData + in TxInfo + { txInfoInputs = sIn : pIns + , txInfoOutputs = sOut : pOuts + , txInfoFee = Value.singleton "" "" 2 + , txInfoMint = mempty + , txInfoDCert = [] + , txInfoWdrl = [] + , -- Time doesn't matter int this case. + txInfoValidRange = closedBoundedInterval 0 100 + , txInfoSignatories = [signer] + , txInfoData = datumPair <$> (mkDatum <$> [sInDatum, sOutDatum]) <> (mkDatum <$> pInDatums <> pOutDatums) + , txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a" + } + +-- | Create the input proposal datum. +mkProposalInputDatum :: UnlockStakeParameters -> ProposalId -> ProposalDatum +mkProposalInputDatum p pid = fst $ mkProposalDatumPair p pid + +-- | Create the input stake datum. +mkStakeInputDatum :: UnlockStakeParameters -> StakeDatum +mkStakeInputDatum = fst . mkStakeDatumPair + +-- | Create a test case that tests the proposal validator's @'Unlock' _@ redeemer. +mkProposalValidatorTestCase :: UnlockStakeParameters -> Bool -> SpecificationTree +mkProposalValidatorTestCase p shouldSucceed = + let datum = mkProposalInputDatum p $ ProposalId 0 + redeemer = Unlock (ResultTag 0) + name = show p + scriptContext = ScriptContext (unlockStake p) (Spending proposalRef) + f = if shouldSucceed then validatorSucceedsWith else validatorFailsWith + in f name (proposalValidator Shared.proposal) datum redeemer scriptContext diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 579a8dc..9381eb5 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -36,34 +36,13 @@ import Agora.Stake ( StakeRedeemer (PermitVote, WitnessStake), ) import Agora.Stake.Scripts (stakeValidator) +import Control.Monad (join) import Data.Default.Class (Default (def)) import Data.Tagged (Tagged (Tagged), untag) import PlutusLedgerApi.V1 (ScriptContext (..), ScriptPurpose (..)) -import PlutusTx.AssocMap qualified as AssocMap (empty, fromList) -import Sample.Proposal qualified as Proposal ( - TransitionParameters ( - TransitionParameters, - initialProposalStatus, - proposalStartingTime - ), - VotingParameters (VotingParameters, voteCount, voteFor), - advanceFinishedPropsoal, - advanceProposalFailureTimeout, - advanceProposalInsufficientVotes, - advanceProposalSuccess, - advancePropsoalWithInvalidOutputStake, - cosignProposal, - creatorRetractVotesWhile, - creatorUnlockStakeWhile, - proposalCreation, - proposalRef, - stakeRef, - unlockStakeAndRetractVotesUsingIrrelevantStakeWhile, - unlockStakeUsingIrrelevantStakeWhile, - voteOnProposal, - voterUnlockStakeAndRetractVotesWhile, - voterUnlockStakeWhile, - ) +import PlutusTx.AssocMap qualified as AssocMap +import Sample.Proposal qualified as Proposal +import Sample.Proposal.UnlockStake qualified as UnlockStake import Sample.Shared (signer, signer2) import Sample.Shared qualified as Shared (proposal, stake) import Test.Specification ( @@ -364,247 +343,110 @@ specs = ] , group "unlocking" - [ group - "legal" - [ validatorSucceedsWith - "retract votes and unlock stake while voting" - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = VotingReady - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 42) - , (ResultTag 1, 0) - ] + $ map + ( \pc -> + group + (show pc <> " proposals") + [ group + "legal" + [ group + "retract votes and unlock stake while voting" + [ UnlockStake.mkProposalValidatorTestCase + ( UnlockStake.UnlockStakeParameters + pc + UnlockStake.Voter + True + VotingReady + ) + True + ] + , group + "unlock the stake that has been used to create the proposal" + [ UnlockStake.mkProposalValidatorTestCase + ( UnlockStake.UnlockStakeParameters + pc + UnlockStake.Creator + False + Finished + ) + True + ] + , group "unlock stake after voting" $ + map + ( \ps -> + UnlockStake.mkProposalValidatorTestCase + ( UnlockStake.UnlockStakeParameters + pc + UnlockStake.Voter + False + ps + ) + True ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - (Unlock (ResultTag 0)) - ( ScriptContext - (Proposal.voterUnlockStakeAndRetractVotesWhile VotingReady) - (Spending Proposal.proposalRef) - ) - , validatorSucceedsWith - "unlock the stake that has been used to create the proposal" - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = Finished - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 42) - , (ResultTag 1, 0) - ] + [Finished, Locked] + ] + , group + "illegal" + [ group "retract votes while the proposal is not voting ready" $ + map + ( \ps -> + UnlockStake.mkProposalValidatorTestCase + ( UnlockStake.UnlockStakeParameters + pc + UnlockStake.Voter + True + ps + ) + False ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - (Unlock (ResultTag 0)) - ( ScriptContext - (Proposal.creatorUnlockStakeWhile Finished) - (Spending Proposal.proposalRef) - ) - , group "unlock stake after voting" $ - map - ( \ps -> - validatorSucceedsWith - (show ps) - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = ps - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 42) - , (ResultTag 1, 0) - ] - ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - (Unlock (ResultTag 0)) - ( ScriptContext - (Proposal.voterUnlockStakeWhile ps) - (Spending Proposal.proposalRef) - ) - ) - [Locked, Finished] - ] - , group - "illegal" - [ group "retract votes while the proposal is not voting ready" $ - map - ( \ps -> - validatorFailsWith - (show ps) - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = ps - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 42) - , (ResultTag 1, 0) - ] - ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - (Unlock (ResultTag 0)) - ( ScriptContext - (Proposal.voterUnlockStakeAndRetractVotesWhile ps) - (Spending Proposal.proposalRef) - ) - ) - [Draft, Locked, Finished] - , group - "irrelevant stake" - $ foldMap - ( \(f, s) -> - map - ( \ps -> - validatorFailsWith - (s <> " (" <> show ps <> ")") - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = ps - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 42) - , (ResultTag 1, 0) - ] + [Draft, Locked, Finished] + , group "irrelevant stake" $ + join $ + map + ( \rv -> + map + ( \ps -> + UnlockStake.mkProposalValidatorTestCase + ( UnlockStake.UnlockStakeParameters + pc + UnlockStake.Irrelevant + rv + ps ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - (Unlock (ResultTag 0)) - ( ScriptContext - (f ps) - (Spending Proposal.proposalRef) - ) - ) - [Draft, VotingReady, Locked, Finished] - ) - [ (Proposal.unlockStakeAndRetractVotesUsingIrrelevantStakeWhile, "unlock stake + retract votes") - , (Proposal.unlockStakeUsingIrrelevantStakeWhile, "unlock stake") - ] - , group "unlock stake that has been used to create the proposal before finished" $ - map - ( \ps -> - validatorFailsWith - (show ps) - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = ps - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 42) - , (ResultTag 1, 0) - ] + False ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - (Unlock (ResultTag 0)) - ( ScriptContext - (Proposal.creatorUnlockStakeWhile ps) - (Spending Proposal.proposalRef) - ) - ) - [Draft, VotingReady, Locked] - , group "creator stake retract votes" $ - map - ( \ps -> - validatorFailsWith - (show ps) - (proposalValidator Shared.proposal) - ( ProposalDatum - { proposalId = ProposalId 0 - , effects = - AssocMap.fromList - [ (ResultTag 0, AssocMap.empty) - , (ResultTag 1, AssocMap.empty) - ] - , status = ps - , cosigners = [signer] - , thresholds = def - , votes = - ProposalVotes - ( AssocMap.fromList - [ (ResultTag 0, 42) - , (ResultTag 1, 0) - ] - ) - , timingConfig = def - , startingTime = ProposalStartingTime 0 - } - ) - (Unlock (ResultTag 0)) - ( ScriptContext - (Proposal.creatorRetractVotesWhile ps) - (Spending Proposal.proposalRef) - ) - ) - [Draft, VotingReady, Locked, Finished] - ] - ] + [Draft, VotingReady, Locked, Finished] + ) + [True, False] + , group "unlock stake that has been used to create the proposal before finished" $ + map + ( \ps -> + UnlockStake.mkProposalValidatorTestCase + ( UnlockStake.UnlockStakeParameters + pc + UnlockStake.Creator + False + ps + ) + False + ) + [Draft, VotingReady, Locked] + , group "creator stake retract votes" $ + map + ( \ps -> + UnlockStake.mkProposalValidatorTestCase + ( UnlockStake.UnlockStakeParameters + pc + UnlockStake.Creator + True + ps + ) + False + ) + [Draft, VotingReady, Locked, Finished] + ] + ] + ) + [1, 25] ] ] diff --git a/agora-testlib/Test/Util.hs b/agora-testlib/Test/Util.hs index 50fb1e4..fdfcd98 100644 --- a/agora-testlib/Test/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -11,6 +11,8 @@ module Test.Util ( datumPair, closedBoundedInterval, updateMap, + sortMap, + sortValue, ) where -------------------------------------------------------------------------------- @@ -24,9 +26,12 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy -------------------------------------------------------------------------------- +import Data.Bifunctor (second) +import Data.List (sortBy) import Plutarch.Crypto (pblake2b_256) -import PlutusLedgerApi.V1.Interval as PlutusTx +import PlutusLedgerApi.V1.Interval qualified as PlutusTx import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash)) +import PlutusLedgerApi.V1.Value (Value (..)) import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.Builtins qualified as PlutusTx import PlutusTx.IsData qualified as PlutusTx @@ -84,3 +89,19 @@ updateMap f k = then f v else Just v ) + +-------------------------------------------------------------------------------- + +sortMap :: forall k v. Ord k => AssocMap.Map k v -> AssocMap.Map k v +sortMap (AssocMap.toList -> l) = + AssocMap.fromList $ + sortBy + ( \(k1, _) + (k2, _) -> compare k1 k2 + ) + l + +sortValue :: Value -> Value +sortValue (AssocMap.toList . getValue -> l) = + let innerSorted = second sortMap <$> l + in Value $ sortMap $ AssocMap.fromList innerSorted diff --git a/agora.cabal b/agora.cabal index 7cf71c2..143f880 100644 --- a/agora.cabal +++ b/agora.cabal @@ -182,6 +182,8 @@ library agora-specs Sample.Effect.TreasuryWithdrawal Sample.Governor Sample.Proposal + Sample.Proposal.Shared + Sample.Proposal.UnlockStake Sample.Shared Sample.Stake Sample.Treasury diff --git a/bench.csv b/bench.csv index e331364..1a3497e 100644 --- a/bench.csv +++ b/bench.csv @@ -18,10 +18,14 @@ Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160888965,431112,6483 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159480054,428407,6484 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160611032,430811,6484 -Agora/Proposal/validator/unlocking/legal/retract votes and unlock stake while voting,171454676,461966,6556 -Agora/Proposal/validator/unlocking/legal/unlock the stake that has been used to create the proposal,149988973,407906,6563 -Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Locked,149056062,408201,6557 -Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Finished,149056062,408201,6557 +"Agora/Proposal/validator/unlocking/1 proposals/legal/retract votes and unlock stake while voting/1 proposals, voter, unlock stake + retract votes, VotingReady",189052005,492891,6583 +"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock the stake that has been used to create the proposal/1 proposals, creator, unlock stake, Finished",167586302,438831,6587 +"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Finished",166653391,439126,6587 +"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Locked",166653391,439126,6587 +"Agora/Proposal/validator/unlocking/25 proposals/legal/retract votes and unlock stake while voting/25 proposals, voter, unlock stake + retract votes, VotingReady",1105824237,3030675,19333 +"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock the stake that has been used to create the proposal/25 proposals, creator, unlock stake, Finished",935680982,2549151,19483 +"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Finished",934748071,2549446,19434 +"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Locked",934748071,2549446,19434 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390 From c49e623504ad10c8936436c12c191b95abfc7eb4 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Fri, 17 Jun 2022 23:26:18 +0800 Subject: [PATCH 6/9] forgot to remove some upstreamed utils for some reason :) --- agora/Agora/Effect/TreasuryWithdrawal.hs | 5 +-- agora/Agora/Proposal/Scripts.hs | 4 +-- agora/Agora/Utils.hs | 29 ++------------- bench.csv | 46 ++++++++++++------------ 4 files changed, 30 insertions(+), 54 deletions(-) diff --git a/agora/Agora/Effect/TreasuryWithdrawal.hs b/agora/Agora/Effect/TreasuryWithdrawal.hs index 1024e9b..9104e33 100644 --- a/agora/Agora/Effect/TreasuryWithdrawal.hs +++ b/agora/Agora/Effect/TreasuryWithdrawal.hs @@ -18,7 +18,7 @@ import GHC.Generics qualified as GHC import Generics.SOP (Generic, I (I)) import Agora.Effect (makeEffect) -import Agora.Utils (findTxOutByTxOutRef, isPubKey) +import Agora.Utils (isPubKey) import Plutarch.Api.V1 ( AmountGuarantees (Positive), KeyGuarantees (Sorted), @@ -30,6 +30,7 @@ import Plutarch.Api.V1 ( ) import Plutarch.Internal (punsafeCoerce) +import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef) import "plutarch" Plutarch.Api.V1.Value (pnormalize) import Plutarch.DataRepr ( DerivePConstantViaData (..), @@ -112,7 +113,7 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $ \_cs (datum' :: Term _ PTreasuryWithdrawalDatum) txOutRef' txInfo' -> unTermCont $ do datum <- tcont $ pletFields @'["receivers", "treasuries"] datum' txInfo <- tcont $ pletFields @'["outputs", "inputs"] txInfo' - PJust txOut <- pmatchC $ findTxOutByTxOutRef # txOutRef' # pfromData txInfo.inputs + PJust ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfindTxInByTxOutRef # txOutRef' # pfromData txInfo.inputs effInput <- tcont $ pletFields @'["address", "value"] $ txOut outputValues <- pletC $ diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 2d40389..a8d3c0f 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -34,7 +34,6 @@ import Agora.Stake ( pgetStakeUsage, ) import Agora.Utils ( - findTxOutByTxOutRef, getMintingPolicySymbol, mustBePJust, mustFindDatum', @@ -48,6 +47,7 @@ import Plutarch.Api.V1 ( ) import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf) import Plutarch.Api.V1.ScriptContext ( + pfindTxInByTxOutRef, pisTokenSpent, ptxSignedBy, pvalueSpent, @@ -163,7 +163,7 @@ proposalValidator proposal = txInfo' PSpending ((pfield @"_0" #) -> txOutRef) <- pmatchC $ pfromData ctx.purpose - PJust txOut <- pmatchC $ findTxOutByTxOutRef # txOutRef # txInfoF.inputs + PJust ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfindTxInByTxOutRef # txOutRef # txInfoF.inputs txOutF <- tcont $ pletFields @'["address", "value"] $ txOut (pfromData -> proposalDatum, _) <- diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index 9425da2..b772445 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -6,7 +6,6 @@ Description: Plutarch utility functions that should be upstreamed or don't belon Plutarch utility functions that should be upstreamed or don't belong anywhere else. -} module Agora.Utils ( - findTxOutByTxOutRef, scriptHashFromAddress, findOutputsToAddress, findTxOutDatum, @@ -20,7 +19,6 @@ module Agora.Utils ( validatorHashToAddress, isScriptAddress, isPubKey, - psingletonValue, ) where -------------------------------------------------------------------------------- @@ -47,19 +45,15 @@ import Plutarch.Api.V1 ( PMintingPolicy, PTokenName (PTokenName), PTuple, - PTxInInfo, PTxOut, - PTxOutRef, PValidatorHash, PValue, mintingPolicySymbol, mkMintingPolicy, ) -import Plutarch.Api.V1.AssocMap (PMap (PMap)) -import Plutarch.Api.V1.ScriptContext (pfindDatum, pfindTxInByTxOutRef) +import Plutarch.Api.V1.ScriptContext (pfindDatum) import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf) -import "plutarch" Plutarch.Api.V1.Value (PValue (PValue)) -import Plutarch.Builtin (pforgetData, ppairDataBuiltin) +import Plutarch.Builtin (pforgetData) import Plutarch.Extra.List (plookupTuple) import Plutarch.Extra.TermCont (pletC, pmatchC) @@ -67,25 +61,6 @@ import Plutarch.Extra.TermCont (pletC, pmatchC) All of these functions are quite inefficient. -} --- | Create a value with a single asset class. -psingletonValue :: - forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S). - Term s (PCurrencySymbol :--> PTokenName :--> PInteger :--> PValue keys amounts) -psingletonValue = phoistAcyclic $ - plam $ \sym tok int -> - let innerTup = pcon $ PMap $ psingleton #$ ppairDataBuiltin # pdata tok # pdata int - outerTup = pcon $ PMap $ psingleton #$ ppairDataBuiltin # pdata sym # pdata innerTup - res = pcon $ PValue outerTup - in res - --- | Finds the TxOut of an effect from TxInfo and TxOutRef -findTxOutByTxOutRef :: Term s (PTxOutRef :--> PBuiltinList (PAsData PTxInInfo) :--> PMaybe PTxOut) -findTxOutByTxOutRef = phoistAcyclic $ - plam $ \txOutRef inputs -> - pmatch (pfindTxInByTxOutRef # txOutRef # inputs) $ \case - PJust ((pfield @"resolved" #) -> txOut) -> pcon $ PJust txOut - PNothing -> pcon PNothing - -- | Get script hash from an Address. scriptHashFromAddress :: Term s (PAddress :--> PMaybe PValidatorHash) scriptHashFromAddress = phoistAcyclic $ diff --git a/bench.csv b/bench.csv index 1a3497e..3f4d4b5 100644 --- a/bench.csv +++ b/bench.csv @@ -1,37 +1,37 @@ name,cpu,mem,size -Agora/Effects/Treasury Withdrawal Effect/effect/Simple,289461528,703055,3191 -Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,448521458,1070167,3518 -Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,408085321,966048,3383 -Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7664 +Agora/Effects/Treasury Withdrawal Effect/effect/Simple,289254528,702155,3182 +Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,448314458,1069267,3509 +Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,407878321,965148,3374 +Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7665 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,97345575,266935,3358 Agora/Stake/policy/stakeCreation,43114795,124549,2156 Agora/Stake/validator/stakeDepositWithdraw deposit,171823342,464745,4189 Agora/Stake/validator/stakeDepositWithdraw withdraw,171823342,464745,4177 Agora/Proposal/policy/proposalCreation,23140177,69194,1518 -Agora/Proposal/validator/cosignature/proposal,204675349,564476,6654 +Agora/Proposal/validator/cosignature/proposal,204468349,563576,6644 Agora/Proposal/validator/cosignature/stake,114125937,284821,4726 -Agora/Proposal/validator/voting/proposal,166129664,437310,6583 +Agora/Proposal/validator/voting/proposal,165922664,436410,6573 Agora/Proposal/validator/voting/stake,107127768,275725,4700 -Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,162018766,433842,6481 -Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,161175344,432339,6484 -Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,162871811,435945,6484 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160888965,431112,6483 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159480054,428407,6484 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160611032,430811,6484 -"Agora/Proposal/validator/unlocking/1 proposals/legal/retract votes and unlock stake while voting/1 proposals, voter, unlock stake + retract votes, VotingReady",189052005,492891,6583 -"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock the stake that has been used to create the proposal/1 proposals, creator, unlock stake, Finished",167586302,438831,6587 -"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Finished",166653391,439126,6587 -"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Locked",166653391,439126,6587 -"Agora/Proposal/validator/unlocking/25 proposals/legal/retract votes and unlock stake while voting/25 proposals, voter, unlock stake + retract votes, VotingReady",1105824237,3030675,19333 -"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock the stake that has been used to create the proposal/25 proposals, creator, unlock stake, Finished",935680982,2549151,19483 -"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Finished",934748071,2549446,19434 -"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Locked",934748071,2549446,19434 +Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,161811766,432942,6471 +Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,160968344,431439,6474 +Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,162664811,435045,6474 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160681965,430212,6473 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159273054,427507,6474 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160404032,429911,6474 +"Agora/Proposal/validator/unlocking/1 proposals/legal/retract votes and unlock stake while voting/1 proposals, voter, unlock stake + retract votes, VotingReady",188845005,491991,6573 +"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock the stake that has been used to create the proposal/1 proposals, creator, unlock stake, Finished",167379302,437931,6577 +"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Finished",166446391,438226,6577 +"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Locked",166446391,438226,6577 +"Agora/Proposal/validator/unlocking/25 proposals/legal/retract votes and unlock stake while voting/25 proposals, voter, unlock stake + retract votes, VotingReady",1105617237,3029775,19323 +"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock the stake that has been used to create the proposal/25 proposals, creator, unlock stake, Finished",935473982,2548251,19473 +"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Finished",934541071,2548546,19424 +"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Locked",934541071,2548546,19424 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Governor/policy/GST minting,43087287,120125,1829 -Agora/Governor/validator/proposal creation,262494214,690689,8180 -Agora/Governor/validator/GATs minting,351739696,936062,8301 -Agora/Governor/validator/mutate governor state,84905433,234687,7765 +Agora/Governor/validator/proposal creation,261928725,689487,8181 +Agora/Governor/validator/GATs minting,352305185,937264,8302 +Agora/Governor/validator/mutate governor state,84905433,234687,7766 From 3ecb6a351d23e055a97b2466ec6a6bd912cd6135 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Fri, 17 Jun 2022 23:36:44 +0800 Subject: [PATCH 7/9] fix some typo --- agora-specs/Sample/Proposal.hs | 16 ++++++++-------- agora-specs/Spec/Proposal.hs | 4 ++-- agora/Agora/Proposal/Scripts.hs | 4 ++-- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/agora-specs/Sample/Proposal.hs b/agora-specs/Sample/Proposal.hs index 25c3fb4..3aa30c7 100644 --- a/agora-specs/Sample/Proposal.hs +++ b/agora-specs/Sample/Proposal.hs @@ -16,9 +16,9 @@ module Sample.Proposal ( advanceProposalSuccess, advanceProposalFailureTimeout, TransitionParameters (..), - advanceFinishedPropsoal, + advanceFinishedProposal, advanceProposalInsufficientVotes, - advancePropsoalWithInvalidOutputStake, + advanceProposalWithInvalidOutputStake, ) where import Agora.Governor (GovernorDatum (..)) @@ -374,9 +374,9 @@ voteOnProposal params = -- | Parameters for state transition of proposals. data TransitionParameters = TransitionParameters - { -- The initial status of the propsoal. + { -- The initial status of the proposal. initialProposalStatus :: ProposalStatus - , -- The starting time of the propsoal. + , -- The starting time of the proposal. proposalStartingTime :: ProposalStartingTime } @@ -684,8 +684,8 @@ advanceProposalInsufficientVotes = True -- | An invalid 'TxInfo' that tries to advance a 'Finished' proposal. -advanceFinishedPropsoal :: TxInfo -advanceFinishedPropsoal = +advanceFinishedProposal :: TxInfo +advanceFinishedProposal = let effects = AssocMap.fromList [ (ResultTag 0, AssocMap.empty) @@ -720,8 +720,8 @@ advanceFinishedPropsoal = From the perspective of stake validator, the transition is totally valid, so the proposal validator should reject this. -} -advancePropsoalWithInvalidOutputStake :: TxInfo -advancePropsoalWithInvalidOutputStake = +advanceProposalWithInvalidOutputStake :: TxInfo +advanceProposalWithInvalidOutputStake = let templateTxInfo = advanceProposalSuccess' TransitionParameters diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 9381eb5..c6ba3e3 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -308,7 +308,7 @@ specs = ) AdvanceProposal ( ScriptContext - Proposal.advanceFinishedPropsoal + Proposal.advanceFinishedProposal (Spending Proposal.proposalRef) ) , validatorFailsWith @@ -337,7 +337,7 @@ specs = ) AdvanceProposal ( ScriptContext - Proposal.advancePropsoalWithInvalidOutputStake + Proposal.advanceProposalWithInvalidOutputStake (Spending Proposal.proposalRef) ) ] diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index a8d3c0f..c560e1b 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -287,7 +287,7 @@ proposalValidator proposal = pisJust #$ plookup # voteFor # voteMap -- Ensure that no lock with the current proposal id has been put on the stake. - pguardC "Same stake shouldn't vote on the same propsoal twice" $ + pguardC "Same stake shouldn't vote on the same proposal twice" $ pnot #$ pany # plam ( \((pfield @"proposalTag" #) . pfromData -> pid) -> @@ -404,7 +404,7 @@ proposalValidator proposal = -------------------------------------------------------------------------- PUnlock r -> unTermCont $ do -- At draft stage, the votes should be empty. - pguardC "Shouldn't retract votes from a draft propsoal" $ + pguardC "Shouldn't retract votes from a draft proposal" $ pnot #$ proposalF.status #== pconstantData Draft -- This is the vote option we're retracting from. From 3b15fedc264022a82f012bafe0f7c895ee732ce7 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Mon, 20 Jun 2022 20:53:59 +0800 Subject: [PATCH 8/9] use PCB to simplify samples --- agora-specs/Sample/Proposal/UnlockStake.hs | 127 +++++++++++---------- bench.csv | 37 ------ 2 files changed, 64 insertions(+), 100 deletions(-) diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs index e961009..d8ac396 100644 --- a/agora-specs/Sample/Proposal/UnlockStake.hs +++ b/agora-specs/Sample/Proposal/UnlockStake.hs @@ -12,14 +12,10 @@ module Sample.Proposal.UnlockStake ( -------------------------------------------------------------------------------- import PlutusLedgerApi.V1 ( - Datum (Datum), DatumHash, ScriptContext (..), ScriptPurpose (Spending), - ToData (toBuiltinData), - TxInInfo (TxInInfo), TxInfo (..), - TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue), TxOutRef (..), ValidatorHash, ) @@ -41,19 +37,22 @@ import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..)) import Sample.Shared ( minAda, proposalPolicySymbol, - proposalValidatorAddress, + proposalValidatorHash, signer, stake, stakeAssetClass, + stakeValidatorHash, ) -import Test.Util (closedBoundedInterval, datumPair, sortValue, toDatumHash, updateMap) +import Test.Util (sortValue, updateMap) -------------------------------------------------------------------------------- import Agora.Proposal.Scripts (proposalValidator) import Control.Monad (join) +import Data.Coerce (coerce) import Data.Default.Class (Default (def)) import Data.Tagged (Tagged (..), untag) +import Plutarch.Context (BaseBuilder, buildTxInfoUnsafe, input, output, script, txId, withDatum, withRefIndex, withTxId, withValue) import Sample.Proposal.Shared (proposalRef, stakeRef) import Sample.Shared qualified as Shared import Test.Specification (SpecificationTree, validatorFailsWith, validatorSucceedsWith) @@ -124,25 +123,14 @@ instance Show UnlockStakeParameters where in mconcat [proposalInfo, ", ", role, ", ", action, ", ", while] -- | Generate some input proposals and their corresponding output proposals. -mkProposals :: UnlockStakeParameters -> ([ProposalDatum], [ProposalDatum]) -mkProposals p = unzip $ forEachProposalId p.proposalCount $ mkProposalDatumPair p +mkProposals :: UnlockStakeParameters -> [(ProposalDatum, ProposalDatum)] +mkProposals p = forEachProposalId p.proposalCount $ mkProposalDatumPair p -- | Iterate over the proposal id of every proposal, given the number of proposals. forEachProposalId :: Integer -> (ProposalId -> a) -> [a] forEachProposalId 0 _ = error "zero proposal" forEachProposalId n f = f . ProposalId <$> [0 .. n - 1] --- | Create a valid stake 'TxOut' given the stake datum. -mkStakeTxOut :: StakeDatum -> TxOut -mkStakeTxOut sd = - let sst = Value.assetClassValue stakeAssetClass 1 - gts = Value.assetClassValue (untag stake.gtClassRef) (untag sd.stakedAmount) - in TxOut - { txOutAddress = proposalValidatorAddress - , txOutValue = sortValue $ sst <> minAda <> gts - , txOutDatumHash = Just $ toDatumHash sd - } - -- | Create the input stake and its corresponding output stake. mkStakeDatumPair :: UnlockStakeParameters -> (StakeDatum, StakeDatum) mkStakeDatumPair c = @@ -165,15 +153,13 @@ mkStakeDatumPair c = AssocMap.keys $ getProposalVotes votesTemplate mkStakeLocks _ _ = [] --- | Create a valid proposal 'TxOut' given the proposal datum. -mkProposalTxOut :: ProposalDatum -> TxOut -mkProposalTxOut pd = - let pst = Value.singleton proposalPolicySymbol "" 1 - in TxOut - { txOutAddress = proposalValidatorAddress - , txOutValue = sortValue $ pst <> minAda - , txOutDatumHash = Just $ toDatumHash pd - } +-- | Create the input proposal datum. +mkProposalInputDatum :: UnlockStakeParameters -> ProposalId -> ProposalDatum +mkProposalInputDatum p pid = fst $ mkProposalDatumPair p pid + +-- | Create the input stake datum. +mkStakeInputDatum :: UnlockStakeParameters -> StakeDatum +mkStakeInputDatum = fst . mkStakeDatumPair -- | Create a input proposal and its corresponding output proposal. mkProposalDatumPair :: @@ -222,47 +208,62 @@ mkProposalDatumPair params pid = -- | Create a 'TxInfo' that tries to unlock a stake. unlockStake :: UnlockStakeParameters -> TxInfo unlockStake p = - let (pInDatums, pOutDatums) = mkProposals p + let pst = Value.singleton proposalPolicySymbol "" 1 + sst = Value.assetClassValue stakeAssetClass 1 + + pIODatums = mkProposals p (sInDatum, sOutDatum) = mkStakeDatumPair p - pIns = - zipWith - ( \i d -> - ( let txOut = mkProposalTxOut d - ref = proposalRef {txOutRefIdx = i} - in TxInInfo ref txOut - ) + proposals = + foldMap + ( \(i, o) -> + mconcat + @BaseBuilder + [ input $ + script proposalValidatorHash + . withValue pst + . withDatum i + . withTxId (txOutRefId proposalRef) + . withRefIndex (txOutRefIdx proposalRef + coerce i.proposalId) + , output $ + script proposalValidatorHash + . withValue (sortValue $ pst <> minAda) + . withDatum o + ] ) - [1 ..] - pInDatums - pOuts = map mkProposalTxOut pOutDatums + pIODatums - sIn = TxInInfo stakeRef $ mkStakeTxOut sInDatum - sOut = mkStakeTxOut sOutDatum + stakeValue = + sortValue $ + mconcat + [ Value.assetClassValue + (untag stake.gtClassRef) + (untag defaultStakedGTs) + , sst + , minAda + ] - mkDatum :: forall d. (ToData d) => d -> Datum - mkDatum = Datum . toBuiltinData - in TxInfo - { txInfoInputs = sIn : pIns - , txInfoOutputs = sOut : pOuts - , txInfoFee = Value.singleton "" "" 2 - , txInfoMint = mempty - , txInfoDCert = [] - , txInfoWdrl = [] - , -- Time doesn't matter int this case. - txInfoValidRange = closedBoundedInterval 0 100 - , txInfoSignatories = [signer] - , txInfoData = datumPair <$> (mkDatum <$> [sInDatum, sOutDatum]) <> (mkDatum <$> pInDatums <> pOutDatums) - , txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a" - } + stakes = + mconcat @BaseBuilder + [ input $ + script stakeValidatorHash + . withValue stakeValue + . withDatum sInDatum + . withTxId (txOutRefId stakeRef) + . withRefIndex (txOutRefIdx stakeRef) + , output $ + script stakeValidatorHash + . withValue stakeValue + . withDatum sOutDatum + ] --- | Create the input proposal datum. -mkProposalInputDatum :: UnlockStakeParameters -> ProposalId -> ProposalDatum -mkProposalInputDatum p pid = fst $ mkProposalDatumPair p pid - --- | Create the input stake datum. -mkStakeInputDatum :: UnlockStakeParameters -> StakeDatum -mkStakeInputDatum = fst . mkStakeDatumPair + builder = + mconcat @BaseBuilder + [ txId "388bc0b897b3dadcd479da4c88291de4113a50b72ddbed001faf7fc03f11bc52" + , proposals + , stakes + ] + in buildTxInfoUnsafe builder -- | Create a test case that tests the proposal validator's @'Unlock' _@ redeemer. mkProposalValidatorTestCase :: UnlockStakeParameters -> Bool -> SpecificationTree diff --git a/bench.csv b/bench.csv index 3f4d4b5..e69de29 100644 --- a/bench.csv +++ b/bench.csv @@ -1,37 +0,0 @@ -name,cpu,mem,size -Agora/Effects/Treasury Withdrawal Effect/effect/Simple,289254528,702155,3182 -Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,448314458,1069267,3509 -Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,407878321,965148,3374 -Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,83758582,229228,7665 -Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,97345575,266935,3358 -Agora/Stake/policy/stakeCreation,43114795,124549,2156 -Agora/Stake/validator/stakeDepositWithdraw deposit,171823342,464745,4189 -Agora/Stake/validator/stakeDepositWithdraw withdraw,171823342,464745,4177 -Agora/Proposal/policy/proposalCreation,23140177,69194,1518 -Agora/Proposal/validator/cosignature/proposal,204468349,563576,6644 -Agora/Proposal/validator/cosignature/stake,114125937,284821,4726 -Agora/Proposal/validator/voting/proposal,165922664,436410,6573 -Agora/Proposal/validator/voting/stake,107127768,275725,4700 -Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,161811766,432942,6471 -Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,160968344,431439,6474 -Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,162664811,435045,6474 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160681965,430212,6473 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159273054,427507,6474 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160404032,429911,6474 -"Agora/Proposal/validator/unlocking/1 proposals/legal/retract votes and unlock stake while voting/1 proposals, voter, unlock stake + retract votes, VotingReady",188845005,491991,6573 -"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock the stake that has been used to create the proposal/1 proposals, creator, unlock stake, Finished",167379302,437931,6577 -"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Finished",166446391,438226,6577 -"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Locked",166446391,438226,6577 -"Agora/Proposal/validator/unlocking/25 proposals/legal/retract votes and unlock stake while voting/25 proposals, voter, unlock stake + retract votes, VotingReady",1105617237,3029775,19323 -"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock the stake that has been used to create the proposal/25 proposals, creator, unlock stake, Finished",935473982,2548251,19473 -"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Finished",934541071,2548546,19424 -"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Locked",934541071,2548546,19424 -Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 -Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 -Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390 -Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 -Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 -Agora/Governor/policy/GST minting,43087287,120125,1829 -Agora/Governor/validator/proposal creation,261928725,689487,8181 -Agora/Governor/validator/GATs minting,352305185,937264,8302 -Agora/Governor/validator/mutate governor state,84905433,234687,7766 From 2d3f8f0463d4c735ee4ab8f44e5597013d1b815e Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Mon, 20 Jun 2022 21:49:39 +0800 Subject: [PATCH 9/9] improve readability of test code --- agora-specs/Spec/Proposal.hs | 211 +++++++++++++++++------------------ agora-testlib/Test/Util.hs | 23 ++-- 2 files changed, 116 insertions(+), 118 deletions(-) diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index c6ba3e3..85d8b96 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -36,7 +36,6 @@ import Agora.Stake ( StakeRedeemer (PermitVote, WitnessStake), ) import Agora.Stake.Scripts (stakeValidator) -import Control.Monad (join) import Data.Default.Class (Default (def)) import Data.Tagged (Tagged (Tagged), untag) import PlutusLedgerApi.V1 (ScriptContext (..), ScriptPurpose (..)) @@ -341,112 +340,110 @@ specs = (Spending Proposal.proposalRef) ) ] - , group - "unlocking" - $ map - ( \pc -> - group - (show pc <> " proposals") - [ group - "legal" - [ group - "retract votes and unlock stake while voting" - [ UnlockStake.mkProposalValidatorTestCase - ( UnlockStake.UnlockStakeParameters - pc - UnlockStake.Voter - True - VotingReady - ) - True - ] - , group - "unlock the stake that has been used to create the proposal" - [ UnlockStake.mkProposalValidatorTestCase - ( UnlockStake.UnlockStakeParameters - pc - UnlockStake.Creator - False - Finished - ) - True - ] - , group "unlock stake after voting" $ - map - ( \ps -> - UnlockStake.mkProposalValidatorTestCase - ( UnlockStake.UnlockStakeParameters - pc - UnlockStake.Voter - False - ps - ) - True - ) - [Finished, Locked] - ] - , group - "illegal" - [ group "retract votes while the proposal is not voting ready" $ - map - ( \ps -> - UnlockStake.mkProposalValidatorTestCase - ( UnlockStake.UnlockStakeParameters - pc - UnlockStake.Voter - True - ps - ) - False - ) - [Draft, Locked, Finished] - , group "irrelevant stake" $ - join $ - map - ( \rv -> - map - ( \ps -> - UnlockStake.mkProposalValidatorTestCase - ( UnlockStake.UnlockStakeParameters - pc - UnlockStake.Irrelevant - rv - ps - ) - False - ) - [Draft, VotingReady, Locked, Finished] - ) - [True, False] - , group "unlock stake that has been used to create the proposal before finished" $ - map - ( \ps -> - UnlockStake.mkProposalValidatorTestCase - ( UnlockStake.UnlockStakeParameters - pc - UnlockStake.Creator - False - ps - ) - False - ) - [Draft, VotingReady, Locked] - , group "creator stake retract votes" $ - map - ( \ps -> - UnlockStake.mkProposalValidatorTestCase - ( UnlockStake.UnlockStakeParameters - pc - UnlockStake.Creator - True - ps - ) - False - ) - [Draft, VotingReady, Locked, Finished] - ] + , group "unlocking" $ do + proposalCount <- [1, 42] + + let legalGroup = group "legal" $ do + let voterRetractVotesAndUnlockStakeWhileVoting = + UnlockStake.mkProposalValidatorTestCase + UnlockStake.UnlockStakeParameters + { UnlockStake.proposalCount = proposalCount + , UnlockStake.stakeUsage = UnlockStake.Voter + , UnlockStake.retractVotes = True + , UnlockStake.proposalStatus = VotingReady + } + True + creatorUnlockStakeWhileFinished = + UnlockStake.mkProposalValidatorTestCase + UnlockStake.UnlockStakeParameters + { UnlockStake.proposalCount = proposalCount + , UnlockStake.stakeUsage = UnlockStake.Creator + , UnlockStake.retractVotes = False + , UnlockStake.proposalStatus = Finished + } + True + + let voterUnlockStakeAfterVoting = group "voter unlocks stake after voting" $ do + status <- [Finished, Locked] + + pure $ + UnlockStake.mkProposalValidatorTestCase + UnlockStake.UnlockStakeParameters + { UnlockStake.proposalCount = proposalCount + , UnlockStake.stakeUsage = UnlockStake.Voter + , UnlockStake.retractVotes = False + , UnlockStake.proposalStatus = status + } + True + + [ voterRetractVotesAndUnlockStakeWhileVoting + , creatorUnlockStakeWhileFinished + , voterUnlockStakeAfterVoting ] - ) - [1, 25] + + let illegalGroup = group "illegal" $ do + let retractsVotesWhileNotVotingReady = + group "voter retracts votes while not voting" $ do + status <- [Draft, Locked, Finished] + + pure $ + UnlockStake.mkProposalValidatorTestCase + UnlockStake.UnlockStakeParameters + { UnlockStake.proposalCount = proposalCount + , UnlockStake.stakeUsage = UnlockStake.Voter + , UnlockStake.retractVotes = True + , UnlockStake.proposalStatus = status + } + False + + unlockIrrelevantStake = + group "unlock an irrelevant stake" $ do + status <- [Draft, VotingReady, Locked, Finished] + shouldRetractVotes <- [True, False] + + pure $ + UnlockStake.mkProposalValidatorTestCase + UnlockStake.UnlockStakeParameters + { UnlockStake.proposalCount = proposalCount + , UnlockStake.stakeUsage = UnlockStake.Irrelevant + , UnlockStake.retractVotes = shouldRetractVotes + , UnlockStake.proposalStatus = status + } + False + + unlockCreatorStakeBeforeFinished = + group "unlock creator stake before finished" $ do + status <- [Draft, VotingReady, Locked] + + pure $ + UnlockStake.mkProposalValidatorTestCase + UnlockStake.UnlockStakeParameters + { UnlockStake.proposalCount = proposalCount + , UnlockStake.stakeUsage = UnlockStake.Creator + , UnlockStake.retractVotes = False + , UnlockStake.proposalStatus = status + } + False + retractVotesWithCreatorStake = + group "creator stake retracts votes" $ do + status <- [Draft, VotingReady, Locked, Finished] + + pure $ + UnlockStake.mkProposalValidatorTestCase + UnlockStake.UnlockStakeParameters + { UnlockStake.proposalCount = proposalCount + , UnlockStake.stakeUsage = UnlockStake.Creator + , UnlockStake.retractVotes = True + , UnlockStake.proposalStatus = status + } + False + + [ retractsVotesWhileNotVotingReady + , unlockIrrelevantStake + , unlockCreatorStakeBeforeFinished + , retractVotesWithCreatorStake + ] + + [legalGroup, illegalGroup] ] ] diff --git a/agora-testlib/Test/Util.hs b/agora-testlib/Test/Util.hs index fdfcd98..78600a5 100644 --- a/agora-testlib/Test/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -27,7 +27,7 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy -------------------------------------------------------------------------------- import Data.Bifunctor (second) -import Data.List (sortBy) +import Data.List (sortOn) import Plutarch.Crypto (pblake2b_256) import PlutusLedgerApi.V1.Interval qualified as PlutusTx import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash)) @@ -93,15 +93,16 @@ updateMap f k = -------------------------------------------------------------------------------- sortMap :: forall k v. Ord k => AssocMap.Map k v -> AssocMap.Map k v -sortMap (AssocMap.toList -> l) = - AssocMap.fromList $ - sortBy - ( \(k1, _) - (k2, _) -> compare k1 k2 - ) - l +sortMap = + AssocMap.fromList + . sortOn fst + . AssocMap.toList sortValue :: Value -> Value -sortValue (AssocMap.toList . getValue -> l) = - let innerSorted = second sortMap <$> l - in Value $ sortMap $ AssocMap.fromList innerSorted +sortValue = + Value + . sortMap + . AssocMap.fromList + . fmap (second sortMap) + . AssocMap.toList + . getValue