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