diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index c15aefb..c9ebf9b 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -30,7 +30,6 @@ import Agora.Stake ( PProposalLock (..), PStakeDatum (..), PStakeUsage (..), - findStakeOwnedBy, pgetStakeUsage, ) import Agora.Utils ( @@ -39,25 +38,27 @@ import Agora.Utils ( mustFindDatum', ) import Plutarch.Api.V1 ( + PDatumHash, PMintingPolicy, PScriptContext (PScriptContext), PScriptPurpose (PMinting, PSpending), PTxInfo (PTxInfo), + PTxOut, PValidator, ) import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf) import Plutarch.Api.V1.ScriptContext ( pfindTxInByTxOutRef, pisTokenSpent, + ptryFindDatum, ptxSignedBy, - pvalueSpent, ) import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf) import Plutarch.Extra.Comonad (pextract) import Plutarch.Extra.IsData (pmatchEnum) -import Plutarch.Extra.List (pisUniqBy) +import Plutarch.Extra.List (pisUniqBy, pmapMaybe, pmsortBy) import Plutarch.Extra.Map (plookup, pupdate) -import Plutarch.Extra.Maybe (pisJust) +import Plutarch.Extra.Maybe (pfromDJust, pfromJust, pisJust) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.TermCont ( pguardC, @@ -193,7 +194,6 @@ proposalValidator proposal = let stCurrencySymbol = pconstant $ getMintingPolicySymbol (proposalPolicy proposal.governorSTAssetClass) - valueSpent <- pletC $ pvalueSpent # txInfoF.inputs signedBy <- pletC $ ptxSignedBy # txInfoF.signatories @@ -236,159 +236,93 @@ proposalValidator proposal = # txInfoF.datums proposalUnchanged <- pletC $ proposalOut #== proposalDatum + -------------------------------------------------------------------------- - -- Find the stake input and stake output by SST. + + -- Find the stake inputs/outputs by SST. let AssetClass (stakeSym, stakeTn) = proposal.stakeSTAssetClass stakeSTAssetClass <- pletC $ passetClass # pconstant stakeSym # pconstant stakeTn - spentStakeST <- - pletC $ passetClassValueOf # valueSpent # stakeSTAssetClass - let stakeInput = - pfield @"resolved" - #$ mustBePJust - # "Stake input should be present" - #$ pfind - # plam - ( \(pfromData . (pfield @"value" #) . (pfield @"resolved" #) -> value) -> - passetClassValueOf # value # stakeSTAssetClass #== 1 + filterStakeDatumHash :: Term _ (PAsData PTxOut :--> PMaybe (PAsData PDatumHash)) <- + pletC $ + plam $ \(pfromData -> txOut) -> unTermCont $ do + txOutF <- pletFieldsC @'["value", "datumHash"] txOut + pure $ + pif + (passetClassValueOf # txOutF.value # stakeSTAssetClass #== 1) + ( let datumHash = pfromDJust # txOutF.datumHash + in pcon $ PJust $ pdata datumHash ) - # pfromData txInfoF.inputs + (pcon PNothing) - stakeIn <- pletC $ mustFindDatum' @PStakeDatum # (pfield @"datumHash" # stakeInput) # txInfoF.datums - stakeInF <- pletFieldsC @'["stakedAmount", "lockedBy", "owner"] stakeIn + stakeInputDatumHashes <- + pletC $ + pmapMaybe @PBuiltinList + # plam ((filterStakeDatumHash #) . (pfield @"resolved" #)) + # txInfoF.inputs - let stakeOutput = - mustBePJust # "Stake output should be present" - #$ pfind - # plam - ( \(pfromData . (pfield @"value" #) -> value) -> - passetClassValueOf # value # stakeSTAssetClass #== 1 - ) - # pfromData txInfoF.outputs + stakeOutputDatumHashes <- + pletC $ + pmapMaybe @PBuiltinList + # filterStakeDatumHash + # txInfoF.outputs - stakeOut <- pletC $ mustFindDatum' @PStakeDatum # (pfield @"datumHash" # stakeOutput) # txInfoF.datums + stakeInputNum <- pletC $ plength # stakeInputDatumHashes - stakeUnchanged <- pletC $ stakeIn #== stakeOut + pguardC "Every stake input should have a correspoding output" $ + stakeInputNum #== plength # stakeOutputDatumHashes -------------------------------------------------------------------------- pure $ pmatch proposalRedeemer $ \case - PVote r -> unTermCont $ do - pguardC "Input proposal must be in VotingReady state" $ - proposalF.status #== pconstant VotingReady - - pguardC "Proposal time should be wthin the voting period" $ - isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime - - -- Ensure the transaction is voting to a valid 'ResultTag'(outcome). - PProposalVotes voteMap <- pmatchC proposalF.votes - voteFor <- pletC $ pfromData $ pfield @"resultTag" # r - - pguardC "Vote option should be valid" $ - 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 proposal twice" $ - pnot #$ pany - # plam - ( \((pfield @"proposalTag" #) . pfromData -> pid) -> - pid #== proposalF.proposalId - ) - # pfromData stakeInF.lockedBy - - 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 $ - pupdate - # plam - ( \votes -> unTermCont $ do - PDiscrete v <- pmatchC stakeInF.stakedAmount - pure $ pcon $ PJust $ votes + (pextract # v) - ) - # voteFor - # m - expectedProposalOut = - mkRecordConstr - PProposalDatum - ( #proposalId .= proposalF.proposalId - .& #effects .= proposalF.effects - .& #status .= proposalF.status - .& #cosigners .= proposalF.cosigners - .& #thresholds .= proposalF.thresholds - .& #votes .= pdata expectedNewVotes - .& #timingConfig .= proposalF.timingConfig - .& #startingTime .= proposalF.startingTime - ) - - pguardC "Output proposal should be valid" $ proposalOut #== expectedProposalOut - - -- We validate the output stake datum here as well: We need the vote option - -- to create a valid 'ProposalLock', however the vote option is encoded - -- in the proposal redeemer, which is invisible for the stake validator. - - let newProposalLock = - mkRecordConstr - PProposalLock - ( #vote .= pdata voteFor - .& #proposalTag .= proposalF.proposalId - ) - -- Prepend the new lock to existing locks - expectedProposalLocks = - pcons - # pdata newProposalLock - # pfromData stakeInF.lockedBy - expectedStakeOut = - mkRecordConstr - PStakeDatum - ( #stakedAmount .= stakeInF.stakedAmount - .& #owner .= stakeInF.owner - .& #lockedBy .= pdata expectedProposalLocks - ) - - pguardC "Output stake should be locked by the proposal" $ expectedStakeOut #== stakeOut - - pure $ popaque (pconstant ()) - -------------------------------------------------------------------------- PCosign r -> unTermCont $ do - pguardC "Stake should not change" stakeUnchanged + pguardC "Should be in draft state" $ + proposalF.status #== pconstant Draft newSigs <- pletC $ pfield @"newCosigners" # r - pguardC "Cosigners are unique" $ - pisUniqBy - # phoistAcyclic (plam (#==)) - # phoistAcyclic (plam $ \(pfromData -> x) (pfromData -> y) -> x #< y) - # newSigs - pguardC "Signed by all new cosigners" $ pall # signedBy # newSigs - pguardC "As many new cosigners as Stake datums" $ - spentStakeST #== plength # newSigs + pguardC "As many new cosigners as stake datums" $ + plength # stakeInputDatumHashes #== plength # newSigs + + updatedSigs <- pletC $ pconcat # newSigs # proposalF.cosigners + + -- Cannot cosign a proposal with a single stake more than once. + pguardC "Cosigners are unique" $ + pisUniqBy + # phoistAcyclic (plam (#==)) + # phoistAcyclic + ( plam + ( \(pfromData -> x) + (pfromData -> y) -> x #< y + ) + ) + # updatedSigs + + let inputStakeOwners = + pmap + # plam + ( \(pfromData -> dh) -> + pfield @"owner" + #$ pfromJust + #$ ptryFindDatum + @(PAsData PStakeDatum) + # dh + # txInfoF.datums + ) + # stakeInputDatumHashes pguardC "All new cosigners are witnessed by their Stake datums" $ pall - # plam - ( \sig -> - pmatch - ( findStakeOwnedBy # stakeSTAssetClass - # pfromData sig - # txInfoF.datums - # txInfoF.inputs - ) - $ \case - PNothing -> pcon PFalse - PJust _ -> pcon PTrue - ) + # plam (\sig -> pelem # sig # inputStakeOwners) # newSigs - let updatedSigs = pconcat # newSigs # proposalF.cosigners - expectedDatum = + let expectedDatum = mkRecordConstr PProposalDatum ( #proposalId .= proposalF.proposalId @@ -404,47 +338,97 @@ proposalValidator proposal = pguardC "Signatures are correctly added to cosignature list" $ proposalOut #== expectedDatum + -- The following code ensures that all the stake datums are not + -- changed. + -- + -- TODO: This is quite inefficient (O(nlogn)) but for now we don't + -- have a nice way to check this. In plutus v2 we'll have map of + -- (Script -> Redeemer) in ScriptContext, which should be the + -- straight up solution. + let sortDatumHashes = + phoistAcyclic $ + pmsortBy + # phoistAcyclic + ( plam + ( \(pfromData -> l) + (pfromData -> r) -> l #< r + ) + ) + + sortedStakeInputDatumHashes = + sortDatumHashes # stakeInputDatumHashes + + sortedStakeOutputDatumHashes = + sortDatumHashes # stakeOutputDatumHashes + + pguardC "All stake datum are unchanged" $ + plistEquals + # sortedStakeInputDatumHashes + # sortedStakeOutputDatumHashes + pure $ popaque (pconstant ()) - -------------------------------------------------------------------------- - PUnlock r -> unTermCont $ do - -- At draft stage, the votes should be empty. - pguardC "Shouldn't retract votes from a draft proposal" $ - pnot #$ proposalF.status #== pconstantData Draft - -- This is the vote option we're retracting from. - retractFrom <- pletC $ pfield @"resultTag" # r + ------------------------------------------------------------------------ + _ -> unTermCont $ do + pguardC "Can only deal with one stake" $ + stakeInputNum #== 1 - -- Determine if the input stake is actually locked by this proposal. - stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId + let stakeInputHash = pfromData $ phead # stakeInputDatumHashes + stakeOutputHash = pfromData $ phead # stakeOutputDatumHashes - pguardC "Stake input relevant" $ - pmatch stakeUsage $ \case - PDidNothing -> - ptraceIfFalse "Stake should be relevant" $ - pconstant False - PCreated -> - ptraceIfFalse "Removing creator's locks means status is Finished" $ - proposalF.status #== pconstantData Finished - PVotedFor rt -> - 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 <- + stakeIn :: Term _ PStakeDatum <- pletC $ - pmatch stakeInF.stakedAmount $ \(PDiscrete v) -> pextract # v + pfromData $ + pfromJust #$ ptryFindDatum # stakeInputHash # txInfoF.datums + stakeInF <- pletFieldsC @'["stakedAmount", "lockedBy", "owner"] stakeIn - -- The votes can only change when the proposal still allows voting. - let shouldUpdateVotes = - proposalF.status #== pconstantData VotingReady - #&& pnot # (pcon PCreated #== stakeUsage) + stakeOut :: Term _ PStakeDatum <- + pletC $ + pfromData $ + pfromJust #$ ptryFindDatum # stakeOutputHash # txInfoF.datums - pguardC "Proposal output correct" $ - pif - shouldUpdateVotes - ( let -- Remove votes and leave other parts of the proposal as it. - expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes + ---------------------------------------------------------------------- + pure $ + pmatch proposalRedeemer $ \case + PVote r -> unTermCont $ do + pguardC "Input proposal must be in VotingReady state" $ + proposalF.status #== pconstant VotingReady + + pguardC "Proposal time should be wthin the voting period" $ + isVotingPeriod # proposalF.timingConfig + # proposalF.startingTime + # currentTime + + -- Ensure the transaction is voting to a valid 'ResultTag'(outcome). + PProposalVotes voteMap <- pmatchC proposalF.votes + voteFor <- pletC $ pfromData $ pfield @"resultTag" # r + + pguardC "Vote option should be valid" $ + 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 proposal twice" $ + pnot #$ pany + # plam + ( \((pfield @"proposalTag" #) . pfromData -> pid) -> + pid #== proposalF.proposalId + ) + # pfromData stakeInF.lockedBy + + 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 $ + pupdate + # plam + ( \votes -> unTermCont $ do + PDiscrete v <- pmatchC stakeInF.stakedAmount + pure $ pcon $ PJust $ votes + (pextract # v) + ) + # voteFor + # m expectedProposalOut = mkRecordConstr PProposalDatum @@ -453,122 +437,206 @@ proposalValidator proposal = .& #status .= proposalF.status .& #cosigners .= proposalF.cosigners .& #thresholds .= proposalF.thresholds - .& #votes .= pdata expectedVotes + .& #votes .= pdata expectedNewVotes .& #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 + pguardC "Output proposal should be valid" $ proposalOut #== expectedProposalOut - let templateStakeOut = - mkRecordConstr - PStakeDatum - ( #stakedAmount .= stakeInF.stakedAmount - .& #owner .= stakeInF.owner - .& #lockedBy .= stakeOutputLocks - ) + -- We validate the output stake datum here as well: We need the vote option + -- to create a valid 'ProposalLock', however the vote option is encoded + -- in the proposal redeemer, which is invisible for the stake validator. - pguardC "Only locks updated in the output stake" $ - templateStakeOut #== stakeOut + let newProposalLock = + mkRecordConstr + PProposalLock + ( #vote .= pdata voteFor + .& #proposalTag .= proposalF.proposalId + ) + -- Prepend the new lock to existing locks + expectedProposalLocks = + pcons + # pdata newProposalLock + # pfromData stakeInF.lockedBy + expectedStakeOut = + mkRecordConstr + PStakeDatum + ( #stakedAmount .= stakeInF.stakedAmount + .& #owner .= stakeInF.owner + .& #lockedBy .= pdata expectedProposalLocks + ) - pguardC "All relevant locks removed from the stake" $ - pgetStakeUsage # pfromData stakeOutputLocks - # proposalF.proposalId #== pcon PDidNothing + pguardC "Output stake should be locked by the proposal" $ expectedStakeOut #== stakeOut - pure $ popaque (pconstant ()) - -------------------------------------------------------------------------- - PAdvanceProposal _r -> unTermCont $ do - pguardC "Stake should not change" stakeUnchanged + pure $ popaque (pconstant ()) + -------------------------------------------------------------------------- - proposalOutStatus <- pletC $ pfield @"status" # proposalOut + PUnlock r -> unTermCont $ do + -- At draft stage, the votes should be empty. + pguardC "Shouldn't retract votes from a draft proposal" $ + pnot #$ proposalF.status #== pconstantData Draft - let -- Only the status of proposals should be updated in this case. - templateProposalOut = - mkRecordConstr - PProposalDatum - ( #proposalId .= proposalF.proposalId - .& #effects .= proposalF.effects - .& #status .= proposalOutStatus - .& #cosigners .= proposalF.cosigners - .& #thresholds .= proposalF.thresholds - .& #votes .= proposalF.votes - .& #timingConfig .= proposalF.timingConfig - .& #startingTime .= proposalF.startingTime - ) + -- This is the vote option we're retracting from. + retractFrom <- pletC $ pfield @"resultTag" # r - pguardC "Only status changes in the output proposal" $ - templateProposalOut #== proposalOut + -- Determine if the input stake is actually locked by this proposal. + stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId - inDraftPeriod <- pletC $ isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime - inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime - inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime - inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime + pguardC "Stake input relevant" $ + pmatch stakeUsage $ \case + PDidNothing -> + ptraceIfFalse "Stake should be relevant" $ + pconstant False + PCreated -> + ptraceIfFalse "Removing creator's locks means status is Finished" $ + proposalF.status #== pconstantData Finished + PVotedFor rt -> + ptraceIfFalse "Result tag should match the one given in the redeemer" $ + rt #== retractFrom - proposalStatus <- pletC $ pto $ pfromData proposalF.status + -- The count of removing votes is equal to the 'stakeAmount' of input stake. + retractCount <- + pletC $ + pmatch stakeInF.stakedAmount $ \(PDiscrete v) -> pextract # v - -- Check the timings. - let isFinished = proposalF.status #== pconstantData Finished + -- The votes can only change when the proposal still allows voting. + let shouldUpdateVotes = + proposalF.status #== pconstantData VotingReady + #&& pnot # (pcon PCreated #== stakeUsage) - notTooLate = pmatchEnum proposalStatus $ \case - Draft -> inDraftPeriod - -- Can only advance after the voting period is over. - VotingReady -> inLockedPeriod - Locked -> inExecutionPeriod - _ -> pconstant False + pguardC "Proposal output correct" $ + pif + shouldUpdateVotes + ( let -- Remove votes and leave other parts of the proposal as it. + expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes - notTooEarly = pmatchEnum (pto $ pfromData proposalF.status) $ \case - VotingReady -> pnot # inVotingPeriod - Locked -> pnot # inLockedPeriod - _ -> pconstant True + 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 - pguardC "Cannot advance ahead of time" notTooEarly - pguardC "Finished proposals cannot be advanced" $ pnot # isFinished + -- At last, we ensure that all locks belong to this proposal will be removed. + stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut - thresholdsF <- pletFieldsC @'["execute"] proposalF.thresholds + let templateStakeOut = + mkRecordConstr + PStakeDatum + ( #stakedAmount .= stakeInF.stakedAmount + .& #owner .= stakeInF.owner + .& #lockedBy .= stakeOutputLocks + ) - pure $ - pif - notTooLate - -- On time: advance to next status. - ( pmatchEnum proposalStatus $ \case - Draft -> unTermCont $ do - -- TODO: Perform other necessary checks. + pguardC "Only locks updated in the output stake" $ + templateStakeOut #== stakeOut - -- 'Draft' -> 'VotingReady' - pguardC "Proposal status set to VotingReady" $ - proposalOutStatus #== pconstantData VotingReady + pguardC "All relevant locks removed from the stake" $ + pgetStakeUsage # pfromData stakeOutputLocks + # proposalF.proposalId #== pcon PDidNothing - pure $ popaque (pconstant ()) - VotingReady -> unTermCont $ do - -- 'VotingReady' -> 'Locked' - pguardC "Proposal status set to Locked" $ - proposalOutStatus #== pconstantData Locked + pure $ popaque (pconstant ()) + ------------------------------------------------------------------ + PAdvanceProposal _ -> unTermCont $ do + pguardC "Stake should not change" $ + stakeInputHash #== stakeOutputHash - pguardC "Winner outcome not found" $ - pisJust #$ pwinner' # proposalF.votes - #$ punsafeCoerce - $ pfromData thresholdsF.execute + proposalOutStatus <- pletC $ pfield @"status" # proposalOut - pure $ popaque (pconstant ()) - Locked -> unTermCont $ do - -- 'Locked' -> 'Finished' - pguardC "Proposal status set to Finished" $ - proposalOutStatus #== pconstantData Finished + let -- Only the status of proposals should be updated in this case. + templateProposalOut = + mkRecordConstr + PProposalDatum + ( #proposalId .= proposalF.proposalId + .& #effects .= proposalF.effects + .& #status .= proposalOutStatus + .& #cosigners .= proposalF.cosigners + .& #thresholds .= proposalF.thresholds + .& #votes .= proposalF.votes + .& #timingConfig .= proposalF.timingConfig + .& #startingTime .= proposalF.startingTime + ) - -- TODO: Perform other necessary checks. - pure $ popaque (pconstant ()) - _ -> popaque (pconstant ()) - ) - -- Too late: failed proposal, status set to 'Finished'. - ( popaque $ - ptraceIfFalse "Proposal should fail: not on time" $ - proposalOutStatus #== pconstantData Finished - -- TODO: Should check that the GST is not moved - -- if the proposal is in 'Locked' state. - ) + pguardC "Only status changes in the output proposal" $ + templateProposalOut #== proposalOut + + inDraftPeriod <- pletC $ isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime + inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime + inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime + inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime + + proposalStatus <- pletC $ pto $ pfromData proposalF.status + + -- Check the timings. + let isFinished = proposalF.status #== pconstantData Finished + + notTooLate = pmatchEnum proposalStatus $ \case + Draft -> inDraftPeriod + -- Can only advance after the voting period is over. + VotingReady -> inLockedPeriod + Locked -> inExecutionPeriod + _ -> pconstant False + + notTooEarly = pmatchEnum (pto $ pfromData proposalF.status) $ \case + VotingReady -> pnot # inVotingPeriod + Locked -> pnot # inLockedPeriod + _ -> pconstant True + + pguardC "Cannot advance ahead of time" notTooEarly + pguardC "Finished proposals cannot be advanced" $ pnot # isFinished + + thresholdsF <- pletFieldsC @'["execute"] proposalF.thresholds + + pure $ + pif + notTooLate + -- On time: advance to next status. + ( pmatchEnum proposalStatus $ \case + Draft -> unTermCont $ do + -- TODO: Perform other necessary checks. + + -- 'Draft' -> 'VotingReady' + pguardC "Proposal status set to VotingReady" $ + proposalOutStatus #== pconstantData VotingReady + + pure $ popaque (pconstant ()) + VotingReady -> unTermCont $ do + -- 'VotingReady' -> 'Locked' + pguardC "Proposal status set to Locked" $ + proposalOutStatus #== pconstantData Locked + + pguardC "Winner outcome not found" $ + pisJust #$ pwinner' # proposalF.votes + #$ punsafeCoerce + $ pfromData thresholdsF.execute + + pure $ popaque (pconstant ()) + Locked -> unTermCont $ do + -- 'Locked' -> 'Finished' + pguardC "Proposal status set to Finished" $ + proposalOutStatus #== pconstantData Finished + + -- TODO: Perform other necessary checks. + pure $ popaque (pconstant ()) + _ -> popaque (pconstant ()) + ) + -- Too late: failed proposal, status set to 'Finished'. + ( popaque $ + ptraceIfFalse "Proposal should fail: not on time" $ + proposalOutStatus #== pconstantData Finished + -- TODO: Should check that the GST is not moved + -- if the proposal is in 'Locked' state. + ) + _ -> popaque (pconstant ()) diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index a4fded9..b5f5e16 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -22,7 +22,6 @@ module Agora.Stake ( -- * Utility functions stakeLocked, - findStakeOwnedBy, pgetStakeUsage, ) where @@ -33,16 +32,8 @@ import Data.Tagged (Tagged (..)) import GHC.Generics qualified as GHC import Generics.SOP (Generic, HasDatatypeInfo, I (I)) import Plutarch.Api.V1 ( - PDatum, - PDatumHash, - PMaybeData (PDJust, PDNothing), PPubKeyHash, - PTuple, - PTxInInfo (PTxInInfo), - PTxOut (PTxOut), ) -import Plutarch.Api.V1.AssetClass (PAssetClass, passetClassValueOf) -import Plutarch.Api.V1.ScriptContext (ptryFindDatum) import Plutarch.DataRepr ( DerivePConstantViaData (..), PDataFields, @@ -54,8 +45,7 @@ import Plutarch.Extra.IsData ( ) import Plutarch.Extra.List (pmapMaybe, pnotNull) import Plutarch.Extra.Other (DerivePNewtype' (..)) -import Plutarch.Extra.TermCont (pletC, pletFieldsC, pmatchC) -import Plutarch.Internal (punsafeCoerce) +import Plutarch.Extra.TermCont (pletFieldsC) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import Plutarch.SafeMoney (PDiscrete) import PlutusLedgerApi.V1 (PubKeyHash) @@ -327,73 +317,6 @@ stakeLocked = phoistAcyclic $ locks = pfield @"lockedBy" # stakeDatum in pnotNull # locks -{- | Find a stake owned by a particular PK. - - @since 0.1.0 --} -findStakeOwnedBy :: - Term - s - ( PAssetClass - :--> PPubKeyHash - :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum)) - :--> PBuiltinList (PAsData PTxInInfo) - :--> PMaybe (PAsData PStakeDatum) - ) -findStakeOwnedBy = phoistAcyclic $ - plam $ \ac pk datums inputs -> - pmatch (pfind # (isInputStakeOwnedBy # ac # pk # datums) # inputs) $ \case - PNothing -> pcon PNothing - PJust (pfromData -> v) -> unTermCont $ do - let txOut = pfield @"resolved" # pto v - txOutF <- pletFieldsC @'["datumHash"] $ txOut - pure $ - pmatch txOutF.datumHash $ \case - PDNothing _ -> pcon PNothing - PDJust ((pfield @"_0" #) -> dh) -> - ptryFindDatum @(PAsData PStakeDatum) # dh # datums - -{- | Check if a StakeDatum is owned by a particular public key. - - @since 0.1.0 --} -stakeDatumOwnedBy :: Term _ (PPubKeyHash :--> PStakeDatum :--> PBool) -stakeDatumOwnedBy = - phoistAcyclic $ - plam $ \pk stakeDatum -> - pletFields @'["owner"] (pto stakeDatum) $ \stakeDatumF -> - stakeDatumF.owner #== pdata pk - -{- | Does the input have a `Stake` owned by a particular PK? - - @since 0.1.0 --} -isInputStakeOwnedBy :: - Term - _ - ( PAssetClass :--> PPubKeyHash - :--> PBuiltinList (PAsData (PTuple PDatumHash PDatum)) - :--> PAsData PTxInInfo - :--> PBool - ) -isInputStakeOwnedBy = - plam $ \ac ss datums txInInfo' -> unTermCont $ do - PTxInInfo ((pfield @"resolved" #) -> txOut) <- pmatchC $ pfromData txInInfo' - PTxOut txOut' <- pmatchC txOut - txOutF <- pletFieldsC @'["value", "datumHash"] txOut' - outStakeST <- pletC $ passetClassValueOf # txOutF.value # ac - pure $ - pmatch txOutF.datumHash $ \case - PDNothing _ -> pcon PFalse - PDJust ((pfield @"_0" #) -> datumHash) -> - pif - (outStakeST #== 1) - ( pmatch (ptryFindDatum @(PAsData PStakeDatum) # datumHash # datums) $ \case - PNothing -> pcon PFalse - 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. diff --git a/bench.csv b/bench.csv index c8b0da0..e5bdec1 100644 --- a/bench.csv +++ b/bench.csv @@ -8,24 +8,24 @@ Agora/Stake/policy/stakeCreation,50939580,148729,2387 Agora/Stake/validator/stakeDepositWithdraw deposit,181581435,493259,4413 Agora/Stake/validator/stakeDepositWithdraw withdraw,181581435,493259,4401 Agora/Proposal/policy/proposalCreation,23140177,69194,1515 -Agora/Proposal/validator/cosignature/proposal,312261341,886430,8188 -Agora/Proposal/validator/cosignature/stake,125315872,312659,4942 -Agora/Proposal/validator/voting/proposal,268025219,751750,8106 -Agora/Proposal/validator/voting/stake,120122971,320497,4899 -Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,263397893,738746,8013 -Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,278686368,780686,8022 -Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,267078383,746859,8022 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,262901404,737844,8015 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,264319938,741149,8016 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,265450916,743553,8016 -"Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",276198245,772878,8066 -"Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",246477596,697110,8068 -"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",242771264,688789,8070 -"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",242771264,688789,8070 -"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",2814657239,7934307,29173 -"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",2488302451,7053012,29357 -"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",2379658464,6713247,29341 -"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",2379658464,6713247,29341 +Agora/Proposal/validator/cosignature/proposal,242933842,689669,8224 +Agora/Proposal/validator/cosignature/stake,124072228,314923,4942 +Agora/Proposal/validator/voting/proposal,236945537,666233,8142 +Agora/Proposal/validator/voting/stake,131045998,349073,4899 +Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,237984765,667020,8049 +Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,253273240,708960,8058 +Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,241665255,675133,8058 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,237488276,666118,8051 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,238906810,669423,8052 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,240037788,671827,8052 +"Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",240815652,676043,8102 +"Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",211095003,600275,8104 +"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",207388671,591954,8106 +"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",207388671,591954,8106 +"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",1770480224,5186822,29209 +"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",1444125436,4305527,29393 +"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",1335481449,3965762,29377 +"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",1335481449,3965762,29377 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,31556709,81546,1452 @@ -33,5 +33,5 @@ Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,80 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/Governor/policy/GST minting,51007235,144191,2034 Agora/Governor/validator/proposal creation,309689999,834675,9064 -Agora/Governor/validator/GATs minting,418560845,1137908,9187 +Agora/Governor/validator/GATs minting,421016677,1141838,9187 Agora/Governor/validator/mutate governor state,88986020,248491,8662