From b19faa7cfe15c74f205681035134501c5a798f94 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Wed, 26 Oct 2022 21:15:20 +0800 Subject: [PATCH] correctly handle proposal time --- agora-specs/Sample/Proposal/Unlock.hs | 16 ++- agora/Agora/Proposal/Scripts.hs | 93 +++++---------- agora/Agora/Proposal/Time.hs | 163 ++++++++++++++++---------- 3 files changed, 141 insertions(+), 131 deletions(-) diff --git a/agora-specs/Sample/Proposal/Unlock.hs b/agora-specs/Sample/Proposal/Unlock.hs index e36ba5f..20c92b7 100644 --- a/agora-specs/Sample/Proposal/Unlock.hs +++ b/agora-specs/Sample/Proposal/Unlock.hs @@ -339,15 +339,19 @@ unlock ps = builder --- + ProposalStartingTime s = defStartingTime + time = case ps.transactionParameters.timeRange of WhileVoting -> - closedBoundedInterval - ((def :: ProposalTimingConfig).draftTime + 1) - ((def :: ProposalTimingConfig).votingTime - 1) + let lb = s + (def :: ProposalTimingConfig).draftTime + ub = lb + (def :: ProposalTimingConfig).votingTime + in closedBoundedInterval (lb + 1) (ub - 1) AfterVoting -> - closedBoundedInterval - ((def :: ProposalTimingConfig).votingTime + 1) - ((def :: ProposalTimingConfig).lockingTime - 1) + let lb = + s + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + ub = lb + (def :: ProposalTimingConfig).lockingTime + in closedBoundedInterval (lb + 1) (ub - 1) sig = case ps.transactionParameters.signedBy of Unknown -> defUnknown diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index bfff2b4..7396e73 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -20,11 +20,11 @@ import Agora.Proposal ( pwinner', ) import Agora.Proposal.Time ( + PPeriod (PDraftingPeriod, PExecutingPeriod, PLockingPeriod, PVotingPeriod), + PTimingRelation (PAfter, PWithin), currentProposalTime, - isDraftPeriod, - isExecutionPeriod, - isLockingPeriod, - isVotingPeriod, + pgetRelation, + pisWithin, ) import Agora.Stake ( PStakeDatum, @@ -232,8 +232,6 @@ proposalValidator = ] txInfo - currentTime <- pletC $ currentProposalTime # txInfoF.validRange - ---------------------------------------------------------------------------- PSpending ((pfield @"_0" #) -> propsalInputRef) <- @@ -292,6 +290,20 @@ proposalValidator = -------------------------------------------------------------------------- + getTimingRelation' <- + pletC $ + let currentTime = + passertPJust # "Current time should be resolved" + #$ currentProposalTime # txInfoF.validRange + in pgetRelation + # proposalInputDatumF.timingConfig + # proposalInputDatumF.startingTime + # currentTime + + let getTimingRelation = (getTimingRelation' #) . pcon + + -------------------------------------------------------------------------- + -- Handle stake inputs/outputs. -- Reslove stake datum if the given UTxO is a stake UTxO. @@ -473,11 +485,7 @@ proposalValidator = currentStatus #== pconstant VotingReady pguardC "Proposal time should be wthin the voting period" $ - isVotingPeriod # proposalInputDatumF.timingConfig - # proposalInputDatumF.startingTime - #$ passertPJust - # "Should be able to get current time" - # currentTime + pisWithin # getTimingRelation PVotingPeriod -- Ensure the transaction is voting to a valid 'ResultTag'(outcome). PProposalVotes voteMap <- pmatchC proposalInputDatumF.votes @@ -557,15 +565,8 @@ proposalValidator = # proposalInputDatumF.votes # sctxF.inputStakes - currentTime' = - passertPJust - # "Should be able to get current time" - # currentTime - inVotingPeriod = - isVotingPeriod # proposalInputDatumF.timingConfig - # proposalInputDatumF.startingTime - # currentTime' + pisWithin # getTimingRelation PVotingPeriod -- The votes can only change when the proposal still allows voting. shouldUpdateVotes = @@ -599,24 +600,6 @@ proposalValidator = ---------------------------------------------------------------------- PAdvanceProposal _ -> unTermCont $ do - currentTime' <- - pletC $ - passertPJust - # "Should be able to get current time" - # currentTime - - applyIs <- pletC $ - plam $ \f -> - f - # proposalInputDatumF.timingConfig - # proposalInputDatumF.startingTime - # currentTime' - let inDraftPeriod = applyIs # isDraftPeriod - inVotingPeriod = applyIs # isVotingPeriod - inExecutionPeriod = applyIs # isExecutionPeriod - - inLockedPeriod <- pletC $ applyIs # isLockingPeriod - proposalOutputStatus <- pletC $ pfromData $ @@ -641,10 +624,8 @@ proposalValidator = pmatch currentStatus $ \case PDraft -> witnessStakes $ \sctxF -> do - let notTooLate = inDraftPeriod - - pmatchC notTooLate >>= \case - PTrue -> do + pmatchC (getTimingRelation PDraftingPeriod) >>= \case + PWithin -> do pguardC "More cosigns than minimum amount" $ punsafeCoerce (pfromData thresholdsF.toVoting) #<= sctxF.totalAmount @@ -658,20 +639,15 @@ proposalValidator = pguardC "Proposal status set to VotingReady" $ proposalOutputStatus #== pconstant VotingReady -- Too late: failed proposal, status set to 'Finished'. - PFalse -> + PAfter -> pguardC "Proposal should fail: not on time" $ proposalOutputStatus #== pconstant Finished ---------------------------------------------------------------- PVotingReady -> unTermCont $ do - let notTooLate = inLockedPeriod - notTooEarly = pnot # inVotingPeriod - - pguardC "Cannot advance ahead of time" notTooEarly - - pmatchC notTooLate >>= \case - PTrue -> do + pmatchC (getTimingRelation PLockingPeriod) >>= \case + PWithin -> do -- 'VotingReady' -> 'Locked' pguardC "Proposal status set to Locked" $ proposalOutputStatus #== pconstant Locked @@ -681,7 +657,7 @@ proposalValidator = #$ punsafeCoerce $ pfromData thresholdsF.execute -- Too late: failed proposal, status set to 'Finished'. - PFalse -> + PAfter -> pguardC "Proposal should fail: not on time" $ proposalOutputStatus #== pconstant Finished @@ -690,11 +666,6 @@ proposalValidator = ---------------------------------------------------------------- PLocked -> unTermCont $ do - let notTooLate = inExecutionPeriod - notTooEarly = pnot # inLockedPeriod - - pguardC "Not too early" notTooEarly - pguardC "Proposal status set to Finished" $ proposalOutputStatus #== pconstant Finished @@ -710,12 +681,12 @@ proposalValidator = # pfromData txInfoF.inputs pguardC "GST not moved if too late, moved otherwise" $ - pif - notTooLate - -- Not too late: GST should moved - pidentity - -- Not too late: GST should not moved - pnot + pmatch + (getTimingRelation PExecutingPeriod) + ( \case + PWithin -> pidentity + PAfter -> pnot + ) # gstMoved pure $ popaque $ pconstant () diff --git a/agora/Agora/Proposal/Time.hs b/agora/Agora/Proposal/Time.hs index 9eb5a85..3dd8a49 100644 --- a/agora/Agora/Proposal/Time.hs +++ b/agora/Agora/Proposal/Time.hs @@ -18,20 +18,21 @@ module Agora.Proposal.Time ( PProposalTimingConfig (..), PProposalStartingTime (..), PMaxTimeRangeWidth (..), + PTimingRelation (..), + PPeriod (..), -- * Compute periods given config and starting time. validateProposalStartingTime, currentProposalTime, - isDraftPeriod, - isVotingPeriod, - isLockingPeriod, - isExecutionPeriod, pisProposalTimingConfigValid, pisMaxTimeRangeWidthValid, + pgetRelation, + pisWithin, ) where import Agora.Utils (pcurrentTimeDuration) import Control.Composition ((.*)) +import Data.Functor ((<&>)) import Plutarch.Api.V1 ( PExtended (PFinite), PInterval (PInterval), @@ -46,11 +47,11 @@ import Plutarch.DataRepr ( ) import Plutarch.Extra.Applicative (PApply (pliftA2)) import Plutarch.Extra.Field (pletAll, pletAllC) +import Plutarch.Extra.IsData (PlutusTypeEnumData) import Plutarch.Extra.Maybe (pjust, pmaybe, pnothing) -import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pmatchC) +import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pletC, pmatchC) import Plutarch.Extra.Time ( PCurrentTime (PCurrentTime), - pisCurrentTimeWithin, pisWithinCurrentTime, ) import Plutarch.Lift ( @@ -388,74 +389,108 @@ currentProposalTime = phoistAcyclic $ mkTime = phoistAcyclic $ plam $ pcon .* PCurrentTime pure $ pliftA2 # mkTime # lowerBound # upperBound -{- | True if the 'PProposalTime' is in the draft period. +{- | Represent relation between current time and a given period. - @since 0.1.0 + Note that the "before" relation isn't present due to the fact that + it's considered as an error in the proposal script. + + @since 1.0.0 -} -isDraftPeriod :: +data PTimingRelation (s :: S) + = PWithin + | PAfter + deriving stock + ( -- | @since 1.0.0 + Generic + , -- | @since 1.0.0 + Enum + , -- | @since 1.0.0 + Bounded + ) + deriving anyclass + ( -- | @since 1.0.0 + PlutusType + ) + +-- | @since 1.0.0 +instance DerivePlutusType PTimingRelation where + type DPTStrat _ = PlutusTypeEnumData + +{- | Return truw if a relation is 'PWithin'. + + @since 1.0.0 +-} +pisWithin :: forall (s :: S). Term s (PTimingRelation :--> PBool) +pisWithin = phoistAcyclic $ + plam $ + flip pmatch $ \case + PWithin -> pconstant True + _ -> pconstant False + +{- | Represent a proposal period. + + @since 1.0.0 +-} +data PPeriod (s :: S) + = PDraftingPeriod + | PVotingPeriod + | PLockingPeriod + | PExecutingPeriod + deriving stock + ( -- | @since 1.0.0 + Generic + , -- | @since 1.0.0 + Enum + , -- | @since 1.0.0 + Bounded + ) + deriving anyclass + ( -- | @since 1.0.0 + PlutusType + ) + +-- | @since 1.0.0 +instance DerivePlutusType PPeriod where + type DPTStrat _ = PlutusTypeEnumData + +{- | Compute the relation between current time range and the given peroid, + providing the starting time and timing configuration of a proposal. If the + relation cannot be ddetermined, error out. + + @since 1.0.0 +-} +pgetRelation :: forall (s :: S). Term s ( PProposalTimingConfig :--> PProposalStartingTime :--> PProposalTime - :--> PBool + :--> PPeriod + :--> PTimingRelation ) -isDraftPeriod = phoistAcyclic $ - plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) -> - pisCurrentTimeWithin # s # (s + (pfield @"draftTime" # config)) +pgetRelation = phoistAcyclic $ + plam $ \config startingTime currentTime period -> unTermCont $ do + configF <- pletAllC config -{- | True if the 'PProposalTime' is in the voting period. + PProposalStartingTime s <- pmatchC startingTime + PCurrentTime lb ub <- pmatchC currentTime - @since 0.1.0 --} -isVotingPeriod :: - forall (s :: S). - Term - s - ( PProposalTimingConfig - :--> PProposalStartingTime - :--> PProposalTime - :--> PBool - ) -isVotingPeriod = phoistAcyclic $ - plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) -> - pletFields @'["draftTime", "votingTime"] config $ \f -> - pisCurrentTimeWithin # s # (s + f.draftTime + f.votingTime) + dub <- pletC $ s + configF.draftTime + vub <- pletC $ dub + configF.votingTime + lub <- pletC $ vub + configF.lockingTime + eub <- pletC $ lub + configF.executingTime -{- | True if the 'PProposalTime' is in the locking period. + (plb, pub) <- + pmatchC period + <&> ( \case + PDraftingPeriod -> (s, dub) + PVotingPeriod -> (dub, vub) + PLockingPeriod -> (vub, lub) + PExecutingPeriod -> (lub, eub) + ) - @since 0.1.0 --} -isLockingPeriod :: - forall (s :: S). - Term - s - ( PProposalTimingConfig - :--> PProposalStartingTime - :--> PProposalTime - :--> PBool - ) -isLockingPeriod = phoistAcyclic $ - plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) -> - pletFields @'["draftTime", "votingTime", "lockingTime"] config $ \f -> - pisCurrentTimeWithin # s # (s + f.draftTime + f.votingTime + f.lockingTime) - -{- | True if the 'PProposalTime' is in the execution period. - - @since 0.1.0 --} -isExecutionPeriod :: - forall (s :: S). - Term - s - ( PProposalTimingConfig - :--> PProposalStartingTime - :--> PProposalTime - :--> PBool - ) -isExecutionPeriod = phoistAcyclic $ - plam $ \config s' -> pmatch s' $ \(PProposalStartingTime s) -> - pletFields @'["draftTime", "votingTime", "lockingTime", "executingTime"] config $ \f -> - pisCurrentTimeWithin # s - # (s + f.draftTime + f.votingTime + f.lockingTime + f.executingTime) + pure $ + pif (plb #<= lb #&& ub #<= pub) (pcon PWithin) $ + pif (pub #< lb) (pcon PAfter) $ + ptraceError "pgetRelation: too early or invalid current time"