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,16 +569,19 @@ mkTestTree name pb val =
               (spend proposalRef)
 
     stake =
-      let idx = 0
+      if pb.stakeParameters.numStake == 0
-       in singleton $
+        then mempty
-            testValidator
+        else
-              val.forStakeValidator
+          let idx = 0
-              "stake"
+           in singleton $
-              agoraScripts.compiledStakeValidator
+                testValidator
-              (getStakeInputDatumAt pb.stakeParameters idx)
+                  val.forStakeValidator
-              stakeRedeemer
+                  "stake"
-              ( spend (mkStakeRef idx)
+                  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

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,81 +600,64 @@ 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'
-                    PTrue -> do
+                inExecutionPeriod = isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
-                      pguardC "More cosigns than minimum amount" $
+            inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime'
-                        punsafeCoerce (pfromData thresholdsF.vote) #< totalStakedAmount
+            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" $
+                  pguardC "GST not moved" $ pnot # gstMoved
-                        plistEquals # sortedStakeOwners # proposalF.cosigners
 
-                      -- 'Draft' -> 'VotingReady'
+                  pure $ pconstant ()
-                      pguardC "Proposal status set to VotingReady" $
+            pure $
-                        proposalOutStatus #== pconstant VotingReady
+              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 ()
+                        pguardC "All new cosigners are witnessed by their Stake datums" $
-                    PFalse -> do
+                          plistEquals # sortedStakeOwners # proposalF.cosigners
-                      pguardC "Advance to failed state" $ proposalOutStatus #== pconstant Finished
 
-                      pure $ pconstant ()
+                        -- 'Draft' -> 'VotingReady'
-
+                        pguardC "Proposal status set to VotingReady" $
-                fromOther = withSingleStake $ \_ _ stakeUnchanged -> do
+                          proposalOutStatus #== pconstant VotingReady
-                  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
 
                         pure $ pconstant ()
+                      PFalse -> do
+                        pguardC "Advance to failed state" $ proposalOutStatus #== pconstant Finished
 
-                      toNextState = pmatchEnum proposalStatus $ \case
+                        pure $ pconstant ()
-                        VotingReady -> unTermCont $ do
+                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"