Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #166 from Liqwid-Labs/emiflake/optimizations

Browse source 
Optimize AdvanceProposal
This commit is contained in:
emiflake 2022-08-30 16:41:20 +02:00 • committed by GitHub
commit 156a73212c
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
5 changed files with 495 additions and 668 deletions
Download patch file Download diff file Expand all files Collapse all files

46
agora-specs/Sample/Proposal/Advance.hs
View file

@ -35,6 +35,7 @@ module Sample.Proposal.Advance (
mkGATsWithWrongDatumBundle,
mkMintGATsWithoutTagBundle,
mkBadGovernorOutputDatumBundle,
mkUnexpectedOutputStakeBundles,
) where
import Agora.Governor (
@ -568,16 +569,19 @@ mkTestTree name pb val =
(spend proposalRef)
stake =
let idx = 0
in singleton $
testValidator
val.forStakeValidator
"stake"
agoraScripts.compiledStakeValidator
(getStakeInputDatumAt pb.stakeParameters idx)
stakeRedeemer
( spend (mkStakeRef idx)
)
if pb.stakeParameters.numStake == 0
then mempty
else
let idx = 0
in singleton $
testValidator
val.forStakeValidator
"stake"
agoraScripts.compiledStakeValidator
(getStakeInputDatumAt pb.stakeParameters idx)
stakeRedeemer
( spend (mkStakeRef idx)
)
governor =
maybe [] singleton $
@ -813,7 +817,7 @@ mkValidToNextStateBundle nCosigners nEffects authScript from =
}
, stakeParameters =
StakeParameters
{ numStake = 1
{ numStake = 0
, perStakeGTs =
compPerStakeGTsForDraft $
fromIntegral nCosigners
@ -911,7 +915,7 @@ mkValidToFailedStateBundles nCosigners nEffects =
}
, stakeParameters =
StakeParameters
{ numStake = 1
{ numStake = 0
, perStakeGTs =
compPerStakeGTsForDraft $
fromIntegral nCosigners
@ -966,7 +970,7 @@ mkInvalidOutputStakeBundles nCosigners nEffects =
liftA2
mkBundle
[True, False]
[Draft, VotingReady, Locked]
[Draft]
where
mkBundle authScript from =
let template = mkValidToNextStateBundle nCosigners nEffects authScript from
@ -977,6 +981,22 @@ mkInvalidOutputStakeBundles nCosigners nEffects =
}
}
mkUnexpectedOutputStakeBundles :: Word -> Word -> [ParameterBundle]
mkUnexpectedOutputStakeBundles nCosigners nEffects =
liftA2
mkBundle
[True, False]
[VotingReady, Locked]
where
mkBundle authScript from =
let template = mkValidToNextStateBundle nCosigners nEffects authScript from
in template
{ stakeParameters =
template.stakeParameters
{ numStake = 1
}
}
-- * From Draft
mkInsufficientCosignsBundle :: Word -> Word -> ParameterBundle

10
agora-specs/Spec/Proposal.hs
View file

@ -244,6 +244,16 @@ specs =
, forGovernorValidator = Just True
, forAuthorityTokenPolicy = Just True
}
, Advance.mkTestTree'
"unexpected stake datum"
(\b -> unwords ["from", show b.proposalParameters.fromStatus])
(Advance.mkUnexpectedOutputStakeBundles cs es)
Advance.Validity
{ forProposalValidator = False
, forStakeValidator = True
, forGovernorValidator = Just True
, forAuthorityTokenPolicy = Just True
}
, Advance.mkTestTree
"forget to mint GATs"
(Advance.mkNoGATMintedBundle cs es)

4
agora/Agora/Proposal.hs
View file

@ -488,8 +488,8 @@ deriving via
data PProposalStatus (s :: S)
= -- | @since 0.2.0
PDraft
| -- | @since 0.2.0
PVoting
| -- | @since 1.0.0
PVotingReady
| -- | @since 0.2.0
PLocked
| -- | @since 0.2.0

146
agora/Agora/Proposal/Scripts.hs
View file

@ -14,6 +14,7 @@ import Agora.Credential (authorizationContext, pauthorizedBy)
import Agora.Proposal (
PProposalDatum (PProposalDatum),
PProposalRedeemer (PAdvanceProposal, PCosign, PUnlock, PVote),
PProposalStatus (PDraft, PFinished, PLocked, PVotingReady),
PProposalVotes (PProposalVotes),
ProposalStatus (Draft, Finished, Locked, VotingReady),
pretractVotes,
@ -53,7 +54,6 @@ import Plutarch.Api.V2 (
import Plutarch.Extra.AssetClass (passetClass, passetClassValueOf)
import Plutarch.Extra.Comonad (pextract)
import Plutarch.Extra.Field (pletAllC)
import Plutarch.Extra.IsData (pmatchEnum)
import Plutarch.Extra.List (pisUniq', pmapMaybe, pmergeBy, pmsortBy)
import Plutarch.Extra.Map (plookup, pupdate)
import Plutarch.Extra.Maybe (passertPJust, pfromJust, pisJust)
@ -600,81 +600,64 @@ proposalValidator as maximumCosigners =
----------------------------------------------------------------------
PAdvanceProposal _ ->
let currentTime' = pfromJust # currentTime
fromDraft = withMultipleStakes $ \totalStakedAmount sortedStakeOwners ->
pmatchC (isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime') >>= \case
PTrue -> do
pguardC "More cosigns than minimum amount" $
punsafeCoerce (pfromData thresholdsF.vote) #< totalStakedAmount
PAdvanceProposal _ -> unTermCont $ do
currentTime' <- pletC $ pfromJust # currentTime
let inDraftPeriod = isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
inVotingPeriod = isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
inExecutionPeriod = isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
pguardC "Only status changes in the output proposal" onlyStatusChanged
let gstSymbol = pconstant $ governorSTSymbol as
gstMoved <-
pletC $
pany
# plam
( \( (pfield @"value" #)
. (pfield @"resolved" #) ->
value
) ->
psymbolValueOf # gstSymbol # value #== 1
)
# pfromData txInfoF.inputs
let toFailedState = unTermCont $ do
-- -> 'Finished'
pguardC "Proposal should fail: not on time" $
proposalOutStatus #== pconstant Finished
pguardC "All new cosigners are witnessed by their Stake datums" $
plistEquals # sortedStakeOwners # proposalF.cosigners
pguardC "GST not moved" $ pnot # gstMoved
-- 'Draft' -> 'VotingReady'
pguardC "Proposal status set to VotingReady" $
proposalOutStatus #== pconstant VotingReady
pure $ pconstant ()
pure $
pmatch currentStatus $ \case
PDraft ->
withMultipleStakes $ \totalStakedAmount sortedStakeOwners ->
pmatchC inDraftPeriod >>= \case
PTrue -> do
pguardC "More cosigns than minimum amount" $
punsafeCoerce (pfromData thresholdsF.vote) #< totalStakedAmount
pure $ pconstant ()
PFalse -> do
pguardC "Advance to failed state" $ proposalOutStatus #== pconstant Finished
pguardC "All new cosigners are witnessed by their Stake datums" $
plistEquals # sortedStakeOwners # proposalF.cosigners
pure $ pconstant ()
fromOther = withSingleStake $ \_ _ stakeUnchanged -> do
pguardC "Stake should not change" stakeUnchanged
pguardC
"Only status changes in the output proposal"
onlyStatusChanged
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 = currentStatus #== pconstant Finished
notTooLate = pmatchEnum proposalStatus $ \case
-- 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
let gstSymbol = pconstant $ governorSTSymbol as
gstMoved <-
pletC $
pany
# plam
( \( (pfield @"value" #)
. (pfield @"resolved" #) ->
value
) ->
psymbolValueOf # gstSymbol # value #== 1
)
# pfromData txInfoF.inputs
let toFailedState = unTermCont $ do
pguardC "Proposal should fail: not on time" $
proposalOutStatus #== pconstant Finished
pguardC "GST not moved" $ pnot # gstMoved
-- 'Draft' -> 'VotingReady'
pguardC "Proposal status set to VotingReady" $
proposalOutStatus #== pconstant VotingReady
pure $ pconstant ()
PFalse -> do
pguardC "Advance to failed state" $ proposalOutStatus #== pconstant Finished
toNextState = pmatchEnum proposalStatus $ \case
VotingReady -> unTermCont $ do
pure $ pconstant ()
PVotingReady -> unTermCont $ do
let notTooLate = inLockedPeriod
notTooEarly = pnot # inVotingPeriod
pguardC "Cannot advance ahead of time" notTooEarly
-- FIXME: This should be checked by Stake, as opposed to here.
pguardC "No stakes must be present" $ stakeInputNum #== 0
pure $
pif
notTooLate
( unTermCont $ do
-- 'VotingReady' -> 'Locked'
pguardC "Proposal status set to Locked" $
proposalOutStatus #== pconstant Locked
@ -685,22 +668,25 @@ proposalValidator as maximumCosigners =
$ pfromData thresholdsF.execute
pure $ pconstant ()
Locked -> unTermCont $ do
)
-- Too late: failed proposal, status set to 'Finished'.
toFailedState
PLocked -> unTermCont $ do
let notTooLate = inExecutionPeriod
notTooEarly = pnot # inLockedPeriod
pguardC "Not too early" notTooEarly
pguardC "No stakes must be present" $ stakeInputNum #== 0
pure $
pif
notTooLate
( unTermCont $ do
-- 'Locked' -> 'Finished'
pguardC "Proposal status set to Finished" $
proposalOutStatus #== pconstant Finished
pguardC "GST moved" gstMoved
-- TODO: Perform other necessary checks.
pure $ pconstant ()
_ -> pconstant ()
pure $
pif
notTooLate
-- On time: advance to next status.
toNextState
-- Too late: failed proposal, status set to 'Finished'.
)
toFailedState
in pif (currentStatus #== pconstant Draft) fromDraft fromOther
PFinished -> ptraceError "Finished proposals cannot be advanced"

957
bench.csv
View file

File diff suppressed because it is too large Load diff