partially fix cosigning logic; improve performance

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 =
+    filterStakeDatumHash :: Term _ (PAsData PTxOut :--> PMaybe (PAsData PDatumHash)) <-
-          pfield @"resolved"
+      pletC $
-            #$ mustBePJust
+        plam $ \(pfromData -> txOut) -> unTermCont $ do
-            # "Stake input should be present"
+          txOutF <- pletFieldsC @'["value", "datumHash"] txOut
-              #$ pfind
+          pure $
-            # plam
+            pif
-              ( \(pfromData . (pfield @"value" #) . (pfield @"resolved" #) -> value) ->
+              (passetClassValueOf # txOutF.value # stakeSTAssetClass #== 1)
-                  passetClassValueOf # 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
+    stakeInputDatumHashes <-
-    stakeInF <- pletFieldsC @'["stakedAmount", "lockedBy", "owner"] stakeIn
+      pletC $
+        pmapMaybe @PBuiltinList
+          # plam ((filterStakeDatumHash #) . (pfield @"resolved" #))
+          # txInfoF.inputs
 
-    let stakeOutput =
+    stakeOutputDatumHashes <-
-          mustBePJust # "Stake output should be present"
+      pletC $
-            #$ pfind
+        pmapMaybe @PBuiltinList
-            # plam
+          # filterStakeDatumHash
-              ( \(pfromData . (pfield @"value" #) -> value) ->
+          # txInfoF.outputs
-                  passetClassValueOf # value # stakeSTAssetClass #== 1
-              )
-            # pfromData 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" $
+          pguardC "As many new cosigners as stake datums" $
-            spentStakeST #== plength # newSigs
+            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
+              # plam (\sig -> pelem # sig # inputStakeOwners)
-                ( \sig ->
-                    pmatch
-                      ( findStakeOwnedBy # stakeSTAssetClass
-                          # pfromData sig
-                          # txInfoF.datums
-                          # txInfoF.inputs
-                      )
-                      $ \case
-                        PNothing -> pcon PFalse
-                        PJust _ -> pcon PTrue
-                )
               # newSigs
 
-          let updatedSigs = pconcat # newSigs # proposalF.cosigners
+          let expectedDatum =
-              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.
+          let stakeInputHash = pfromData $ phead # stakeInputDatumHashes
-          stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId
+              stakeOutputHash = pfromData $ phead # stakeOutputDatumHashes
 
-          pguardC "Stake input relevant" $
+          stakeIn :: Term _ PStakeDatum <-
-            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 <-
             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.
+          stakeOut :: Term _ PStakeDatum <-
-          let shouldUpdateVotes =
+            pletC $
-                proposalF.status #== pconstantData VotingReady
+              pfromData $
-                  #&& pnot # (pcon PCreated #== stakeUsage)
+                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.
+                pguardC "Output proposal should be valid" $ proposalOut #== expectedProposalOut
-          stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut
 
-          let templateStakeOut =
+                -- We validate the output stake datum here as well: We need the vote option
-                mkRecordConstr
+                -- to create a valid 'ProposalLock', however the vote option is encoded
-                  PStakeDatum
+                -- in the proposal redeemer, which is invisible for the stake validator.
-                  ( #stakedAmount .= stakeInF.stakedAmount
-                      .& #owner .= stakeInF.owner
-                      .& #lockedBy .= stakeOutputLocks
-                  )
 
-          pguardC "Only locks updated in the output stake" $
+                let newProposalLock =
-            templateStakeOut #== stakeOut
+                      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" $
+                pguardC "Output stake should be locked by the proposal" $ expectedStakeOut #== stakeOut
-            pgetStakeUsage # pfromData stakeOutputLocks
-              # proposalF.proposalId #== pcon PDidNothing
 
-          pure $ popaque (pconstant ())
+                pure $ popaque (pconstant ())
-        --------------------------------------------------------------------------
+              --------------------------------------------------------------------------
-        PAdvanceProposal _r -> unTermCont $ do
-          pguardC "Stake should not change" stakeUnchanged
 
-          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.
+                -- This is the vote option we're retracting from.
-              templateProposalOut =
+                retractFrom <- pletC $ pfield @"resultTag" # r
-                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
-                  )
 
-          pguardC "Only status changes in the output proposal" $
+                -- Determine if the input stake is actually locked by this proposal.
-            templateProposalOut #== proposalOut
+                stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId
 
-          inDraftPeriod <- pletC $ isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
+                pguardC "Stake input relevant" $
-          inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
+                  pmatch stakeUsage $ \case
-          inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
+                    PDidNothing ->
-          inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
+                      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.
+                -- The votes can only change when the proposal still allows voting.
-          let isFinished = proposalF.status #== pconstantData Finished
+                let shouldUpdateVotes =
+                      proposalF.status #== pconstantData VotingReady
+                        #&& pnot # (pcon PCreated #== stakeUsage)
 
-              notTooLate = pmatchEnum proposalStatus $ \case
+                pguardC "Proposal output correct" $
-                Draft -> inDraftPeriod
+                  pif
-                -- Can only advance after the voting period is over.
+                    shouldUpdateVotes
-                VotingReady -> inLockedPeriod
+                    ( let -- Remove votes and leave other parts of the proposal as it.
-                Locked -> inExecutionPeriod
+                          expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes
-                _ -> pconstant False
 
-              notTooEarly = pmatchEnum (pto $ pfromData proposalF.status) $ \case
+                          expectedProposalOut =
-                VotingReady -> pnot # inVotingPeriod
+                            mkRecordConstr
-                Locked -> pnot # inLockedPeriod
+                              PProposalDatum
-                _ -> pconstant True
+                              ( #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
+                -- At last, we ensure that all locks belong to this proposal will be removed.
-          pguardC "Finished proposals cannot be advanced" $ pnot # isFinished
+                stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut
 
-          thresholdsF <- pletFieldsC @'["execute"] proposalF.thresholds
+                let templateStakeOut =
+                      mkRecordConstr
+                        PStakeDatum
+                        ( #stakedAmount .= stakeInF.stakedAmount
+                            .& #owner .= stakeInF.owner
+                            .& #lockedBy .= stakeOutputLocks
+                        )
 
-          pure $
+                pguardC "Only locks updated in the output stake" $
-            pif
+                  templateStakeOut #== stakeOut
-              notTooLate
-              -- On time: advance to next status.
-              ( pmatchEnum proposalStatus $ \case
-                  Draft -> unTermCont $ do
-                    -- TODO: Perform other necessary checks.
 
-                    -- 'Draft' -> 'VotingReady'
+                pguardC "All relevant locks removed from the stake" $
-                    pguardC "Proposal status set to VotingReady" $
+                  pgetStakeUsage # pfromData stakeOutputLocks
-                      proposalOutStatus #== pconstantData VotingReady
+                    # proposalF.proposalId #== pcon PDidNothing
 
-                    pure $ popaque (pconstant ())
+                pure $ popaque (pconstant ())
-                  VotingReady -> unTermCont $ do
+              ------------------------------------------------------------------
-                    -- 'VotingReady' -> 'Locked'
+              PAdvanceProposal _ -> unTermCont $ do
-                    pguardC "Proposal status set to Locked" $
+                pguardC "Stake should not change" $
-                      proposalOutStatus #== pconstantData Locked
+                  stakeInputHash #== stakeOutputHash
 
-                    pguardC "Winner outcome not found" $
+                proposalOutStatus <- pletC $ pfield @"status" # proposalOut
-                      pisJust #$ pwinner' # proposalF.votes
-                        #$ punsafeCoerce
-                        $ pfromData thresholdsF.execute
 
-                    pure $ popaque (pconstant ())
+                let -- Only the status of proposals should be updated in this case.
-                  Locked -> unTermCont $ do
+                    templateProposalOut =
-                    -- 'Locked' -> 'Finished'
+                      mkRecordConstr
-                    pguardC "Proposal status set to Finished" $
+                        PProposalDatum
-                      proposalOutStatus #== pconstantData Finished
+                        ( #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.
+                pguardC "Only status changes in the output proposal" $
-                    pure $ popaque (pconstant ())
+                  templateProposalOut #== proposalOut
-                  _ -> popaque (pconstant ())
+
-              )
+                inDraftPeriod <- pletC $ isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
-              -- Too late: failed proposal, status set to 'Finished'.
+                inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
-              ( popaque $
+                inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
-                  ptraceIfFalse "Proposal should fail: not on time" $
+                inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
-                    proposalOutStatus #== pconstantData Finished
+
-                    -- TODO: Should check that the GST is not moved
+                proposalStatus <- pletC $ pto $ pfromData proposalF.status
-                    --        if the proposal is in 'Locked' state.
+
-              )
+                -- 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 ())

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.Extra.TermCont (pletFieldsC)
-import Plutarch.Internal (punsafeCoerce)
 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.
 

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/proposal,242933842,689669,8224
-Agora/Proposal/validator/cosignature/stake,125315872,312659,4942
+Agora/Proposal/validator/cosignature/stake,124072228,314923,4942
-Agora/Proposal/validator/voting/proposal,268025219,751750,8106
+Agora/Proposal/validator/voting/proposal,236945537,666233,8142
-Agora/Proposal/validator/voting/stake,120122971,320497,4899
+Agora/Proposal/validator/voting/stake,131045998,349073,4899
-Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,263397893,738746,8013
+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,278686368,780686,8022
+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,267078383,746859,8022
+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,262901404,737844,8015
+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,264319938,741149,8016
+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,265450916,743553,8016
+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",276198245,772878,8066
+"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",246477596,697110,8068
+"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",242771264,688789,8070
+"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",242771264,688789,8070
+"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",2814657239,7934307,29173
+"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",2488302451,7053012,29357
+"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",2379658464,6713247,29341
+"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",2379658464,6713247,29341
+"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