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

Optimize AdvanceProposal

agora-specs/Sample/Proposal/Advance.hs

@@ -35,6 +35,7 @@ module Sample.Proposal.Advance (
   mkGATsWithWrongDatumBundle,
   mkMintGATsWithoutTagBundle,
   mkBadGovernorOutputDatumBundle,
+  mkUnexpectedOutputStakeBundles,
 ) where
 
 import Agora.Governor (
@@ -568,6 +569,9 @@ mkTestTree name pb val =
               (spend proposalRef)
 
     stake =
+      if pb.stakeParameters.numStake == 0
+        then mempty
+        else
           let idx = 0
            in singleton $
                 testValidator
@@ -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

agora-specs/Spec/Proposal.hs

@@ -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)

agora/Agora/Proposal.hs

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

agora/Agora/Proposal/Scripts.hs

@@ -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,10 +600,38 @@ proposalValidator as maximumCosigners =
 
           ----------------------------------------------------------------------
 
-          PAdvanceProposal _ ->
+          PAdvanceProposal _ -> unTermCont $ do
-            let currentTime' = pfromJust # currentTime
+            currentTime' <- pletC $ pfromJust # currentTime
-                fromDraft = withMultipleStakes $ \totalStakedAmount sortedStakeOwners ->
+            let inDraftPeriod = isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
-                  pmatchC (isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime') >>= \case
+                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 "GST not moved" $ pnot # gstMoved
+
+                  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
@@ -620,61 +648,16 @@ proposalValidator as maximumCosigners =
                         pguardC "Advance to failed state" $ proposalOutStatus #== pconstant Finished
 
                         pure $ pconstant ()
-
+                PVotingReady -> unTermCont $ do
-                fromOther = withSingleStake $ \_ _ stakeUnchanged -> do
+                  let notTooLate = inLockedPeriod
-                  pguardC "Stake should not change" stakeUnchanged
+                      notTooEarly = pnot # inVotingPeriod
-
-                  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
+                  -- FIXME: This should be checked by Stake, as opposed to here.
-
+                  pguardC "No stakes must be present" $ stakeInputNum #== 0
-                  let gstSymbol = pconstant $ governorSTSymbol as
+                  pure $
-
+                    pif
-                  gstMoved <-
+                      notTooLate
-                    pletC $
+                      ( unTermCont $ do
-                      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
-
-                        pure $ pconstant ()
-
-                      toNextState = pmatchEnum proposalStatus $ \case
-                        VotingReady -> 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"