implement new stake locking mechanism

agora/Agora/Governor.hs

@@ -73,6 +73,8 @@ data GovernorDatum = GovernorDatum
   --   Will get copied over upon the creation of proposals.
   , createProposalTimeRangeMaxWidth :: MaxTimeRangeWidth
   -- ^ The maximum valid duration of a transaction that creats a proposal.
+  , maximumProposalsPerStake :: Integer
+  -- ^ The maximum number of *alive* proposals which were careated by a stake.
   }
   deriving stock (Show, GHC.Generic)
 
@@ -149,6 +151,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
              , "nextProposalId" ':= PProposalId
              , "proposalTimings" ':= PProposalTimingConfig
              , "createProposalTimeRangeMaxWidth" ':= PMaxTimeRangeWidth
+             , "maximumProposalsPerStake" ':= PInteger
              ]
         )
   }

agora/Agora/Governor/Scripts.hs

@@ -46,8 +46,6 @@ import Agora.Governor (
  )
 import Agora.Proposal (
   PProposalDatum (..),
-  PProposalId (..),
-  PResultTag,
   Proposal (..),
   ProposalStatus (Draft, Finished, Locked),
   pemptyVotesFor,
@@ -65,6 +63,7 @@ import Agora.Stake (
   PProposalLock (..),
   PStakeDatum (..),
   Stake (..),
+  pnumCreatedProposals,
  )
 import Agora.Stake.Scripts (
   stakePolicy,
@@ -108,7 +107,6 @@ import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisUTXOSpent, ptryFin
 import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
 import Plutarch.Extra.IsData (pmatchEnumFromData)
 import Plutarch.Extra.Map (
-  pkeys,
   plookup,
   plookup',
  )
@@ -300,6 +298,7 @@ governorValidator gov =
           , "nextProposalId"
           , "proposalTimings"
           , "createProposalTimeRangeMaxWidth"
+          , "maximumProposalsPerStake"
           ]
         oldGovernorDatum
 
@@ -341,6 +340,8 @@ governorValidator gov =
                       .& #proposalTimings .= oldGovernorDatumF.proposalTimings
                       .& #createProposalTimeRangeMaxWidth
                         .= oldGovernorDatumF.createProposalTimeRangeMaxWidth
+                      .& #maximumProposalsPerStake
+                        .= oldGovernorDatumF.maximumProposalsPerStake
                   )
           pguardC "Unexpected governor state datum" $
             newGovernorDatum #== expectedNewDatum
@@ -377,6 +378,10 @@ governorValidator gov =
           stakeInputDatumF <-
             pletFieldsC @["stakedAmount", "owner", "lockedBy"] stakeInputDatum
 
+          pguardC "Didn't created too many proposals" $
+            pnumCreatedProposals # stakeInputDatumF.lockedBy
+              #< oldGovernorDatumF.maximumProposalsPerStake
+
           pguardC "Required amount of stake GTs should be presented" $
             stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeInputF.value)
 
@@ -479,25 +484,14 @@ governorValidator gov =
                 mustBePJust # "Stake output not found" #$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums
 
           -- The stake should be locked by the newly created proposal.
-
+          let newLock =
-          let possibleVoteResults = pkeys #$ pto $ pfromData proposalOutputDatum.votes
+                mkRecordConstr
-
+                  PCreated
-              mkProposalLock :: Term _ (PProposalId :--> PAsData PResultTag :--> PAsData PProposalLock)
+                  ( #created .= oldGovernorDatumF.nextProposalId
-              mkProposalLock =
+                  )
-                phoistAcyclic $
-                  plam
-                    ( \pid rt' ->
-                        pdata $
-                          mkRecordConstr
-                            PProposalLock
-                            ( #vote .= rt' .& #proposalTag .= pdata pid
-                            )
-                    )
 
               -- Append new locks to existing locks
-              expectedProposalLocks =
+              expectedProposalLocks = pcons # pdata newLock # stakeInputDatumF.lockedBy
-                pconcat # stakeInputDatumF.lockedBy
-                  #$ pmap # (mkProposalLock # proposalOutputDatum.proposalId) # possibleVoteResults
 
               expectedStakeOutputDatum =
                 pdata $

agora/Agora/Proposal.hs

@@ -68,6 +68,7 @@ import Plutarch.Lift (
   PUnsafeLiftDecl (..),
  )
 import Plutarch.SafeMoney (PDiscrete)
+import Plutarch.Show (PShow (..))
 import PlutusLedgerApi.V1 (DatumHash, PubKeyHash, ValidatorHash)
 import PlutusLedgerApi.V1.Value (AssetClass)
 import PlutusTx qualified
@@ -328,7 +329,7 @@ data ProposalRedeemer
     --   This list should be sorted in ascending order.
     Cosign [PubKeyHash]
   | -- | Allow unlocking one or more stakes with votes towards particular 'ResultTag'.
-    Unlock ResultTag
+    Unlock
   | -- | Advance the proposal, performing the required checks for whether that is legal.
     --
     --   These are roughly the checks for each possible transition:
@@ -426,6 +427,11 @@ deriving via
   instance
     PTryFrom PData (PAsData PResultTag)
 
+-- | @since 0.2.0
+instance PShow PResultTag where
+  pshow' :: Bool -> Term s PResultTag -> Term s PString
+  pshow' _ x = pshow @PInteger $ pto x
+
 {- | Plutarch-level version of 'PProposalId'.
 
      @since 0.1.0
@@ -458,6 +464,11 @@ deriving via
   instance
     (PConstantDecl ProposalId)
 
+-- | @since 0.2.0
+instance PShow PProposalId where
+  pshow' :: Bool -> Term s PProposalId -> Term s PString
+  pshow' _ x = pshow @PInteger $ pto x
+
 {- | Plutarch-level version of 'ProposalStatus'.
 
      @since 0.1.0
@@ -665,7 +676,7 @@ deriving via (DerivePConstantViaDataList ProposalDatum PProposalDatum) instance
 data PProposalRedeemer (s :: S)
   = PVote (Term s (PDataRecord '["resultTag" ':= PResultTag]))
   | PCosign (Term s (PDataRecord '["newCosigners" ':= PBuiltinList (PAsData PPubKeyHash)]))
-  | PUnlock (Term s (PDataRecord '["resultTag" ':= PResultTag]))
+  | PUnlock (Term s (PDataRecord '[]))
   | PAdvanceProposal (Term s (PDataRecord '[]))
   deriving stock
     ( -- | @since 0.1.0

agora/Agora/Proposal/Scripts.hs

@@ -29,8 +29,12 @@ import Agora.Proposal.Time (
 import Agora.Stake (
   PProposalLock (..),
   PStakeDatum (..),
-  PStakeUsage (..),
+  pextractVoteOption,
-  pgetStakeUsage,
+  pgetStakeRole,
+  pisCreator,
+  pisIrrelevant,
+  pisPureCreator,
+  pisVoter,
  )
 import Agora.Utils (
   getMintingPolicySymbol,
@@ -469,12 +473,7 @@ proposalValidator proposal =
 
             -- 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
+              pnot #$ pisVoter #$ pgetStakeRole # proposalF.proposalId # pfromData stakeInF.lockedBy
-                # 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.
@@ -510,9 +509,9 @@ proposalValidator proposal =
 
             let newProposalLock =
                   mkRecordConstr
-                    PProposalLock
+                    PVoted
-                    ( #vote .= pdata voteFor
+                    ( #votedOn .= proposalF.proposalId
-                        .& #proposalTag .= proposalF.proposalId
+                        .& #votedFor .= pdata voteFor
                     )
                 -- Prepend the new lock to existing locks
                 expectedProposalLocks =
@@ -533,30 +532,16 @@ proposalValidator proposal =
 
           ----------------------------------------------------------------------
 
-          PUnlock r -> withSingleStake $ \stakeInF stakeOut _ -> do
+          PUnlock _ -> withSingleStake $ \stakeInF stakeOut _ -> do
             -- At draft stage, the votes should be empty.
             pguardC "Shouldn't retract votes from a draft proposal" $
               pnot #$ currentStatus #== pconstant Draft
 
-            -- This is the vote option we're retracting from.
+            stakeRole <- pletC $ pgetStakeRole # proposalF.proposalId # stakeInF.lockedBy
-            retractFrom <- pletC $ pfield @"resultTag" # r
 
-            -- Determine if the input stake is actually locked by this proposal.
+            pguardC "Stake input should be relevant" $
-            stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId
+              pnot #$ pisIrrelevant # stakeRole
 
-            pguardC "Stake input relevant" $
-              pmatch stakeUsage $ \case
-                PDidNothing ->
-                  ptraceIfFalse "Stake should be relevant" $
-                    pconstant False
-                PCreated ->
-                  ptraceIfFalse "Removing creator's locks means status is Finished" $
-                    currentStatus #== pconstant 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
@@ -564,13 +549,28 @@ proposalValidator proposal =
             -- The votes can only change when the proposal still allows voting.
             let shouldUpdateVotes =
                   currentStatus #== pconstant VotingReady
-                    #&& pnot # (pcon PCreated #== stakeUsage)
+                    #&& pnot # (pisPureCreator # stakeRole)
+
+                allowRemovingCreatorLock =
+                  currentStatus #== pconstant Finished
+
+                isCreator = pisCreator # stakeRole
+
+                validateOutputLocks = plam $ \locks ->
+                  plet
+                    ( pgetStakeRole # proposalF.proposalId # locks
+                    )
+                    $ \newStakeRole ->
+                      pif
+                        (isCreator #&& pnot # allowRemovingCreatorLock)
+                        (pisPureCreator # newStakeRole)
+                        (pisIrrelevant # newStakeRole)
 
             pguardC "Proposal output correct" $
               pif
                 shouldUpdateVotes
                 ( let -- Remove votes and leave other parts of the proposal as it.
-                      expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes
+                      expectedVotes = pretractVotes # (pextractVoteOption # stakeRole) # retractCount # proposalF.votes
 
                       expectedProposalOut =
                         mkRecordConstr
@@ -598,15 +598,14 @@ proposalValidator proposal =
                     PStakeDatum
                     ( #stakedAmount .= stakeInF.stakedAmount
                         .& #owner .= stakeInF.owner
-                        .& #lockedBy .= stakeOutputLocks
+                        .& #lockedBy .= pdata stakeOutputLocks
                     )
 
             pguardC "Only locks updated in the output stake" $
               templateStakeOut #== stakeOut
 
             pguardC "All relevant locks removed from the stake" $
-              pgetStakeUsage # pfromData stakeOutputLocks
+              validateOutputLocks # stakeOutputLocks
-                # proposalF.proposalId #== pcon PDidNothing
 
             pure $ pconstant ()
 

agora/Agora/Stake.hs

@@ -18,11 +18,17 @@ module Agora.Stake (
   PStakeDatum (..),
   PStakeRedeemer (..),
   PProposalLock (..),
-  PStakeUsage (..),
+  PStakeRole (..),
 
   -- * Utility functions
-  stakeLocked,
+  pstakeLocked,
-  pgetStakeUsage,
+  pnumCreatedProposals,
+  pextractVoteOption,
+  pgetStakeRole,
+  pisVoter,
+  pisCreator,
+  pisPureCreator,
+  pisIrrelevant,
 ) where
 
 import Agora.Plutarch.Orphans ()
@@ -43,14 +49,15 @@ import Plutarch.Extra.IsData (
   DerivePConstantViaDataList (..),
   ProductIsData (ProductIsData),
  )
-import Plutarch.Extra.List (pmapMaybe, pnotNull)
+import Plutarch.Extra.List (pnotNull)
 import Plutarch.Extra.Other (DerivePNewtype' (..))
-import Plutarch.Extra.TermCont (pletFieldsC)
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
 import Plutarch.SafeMoney (PDiscrete)
+import Plutarch.Show (PShow (..))
 import PlutusLedgerApi.V1 (PubKeyHash)
 import PlutusLedgerApi.V1.Value (AssetClass)
 import PlutusTx qualified
+import Prelude ((+))
 import Prelude hiding (Num (..))
 
 --------------------------------------------------------------------------------
@@ -69,8 +76,7 @@ data Stake = Stake
       GHC.Generic
     )
 
-{- | A lock placed on a Stake datum in order to prevent
+{- | Locks that are stored in the stake datums for various purposes.
-     depositing and withdrawing when votes are in place.
 
      NOTE: Due to retracting votes always being possible,
      this lock will only lock with contention on the proposal.
@@ -97,30 +103,47 @@ data Stake = Stake
 
      @since 0.1.0
 -}
-data ProposalLock = ProposalLock
+data ProposalLock
-  { vote :: ResultTag
+  = -- | The stake was used to create a proposal.
-  -- ^ What was voted on. This allows retracting votes to
+    --
-  --   undo their vote.
+    --   This kind of lock is placed upon the creation of a proposal, in order
-  , proposalId :: ProposalId
+    --    to limit creation of proposals per stake.
-  -- ^ Identifies the proposal. See 'ProposalId' for further
+    --
-  -- comments on its significance.
+    --   See also: https://github.com/Liqwid-Labs/agora/issues/68
-  }
+    --
+    --   @since 0.2.0
+    Created
+      { craeted :: ProposalId
+      -- ^ The identifier of the proposal.
+      }
+  | -- | The stake was used to vote on a proposal.
+    --
+    --   This kind of lock is placed while voting on a propsoal, in order to
+    --    prevent depositing and withdrawing when votes are in place.
+    --
+    --   @since 0.2.0
+    Voted
+      { votedOn :: ProposalId
+      -- ^ The identifier of the proposal.
+      , votedFor :: ResultTag
+      -- ^ The option which was voted on. This allows votes to be retracted.
+      }
   deriving stock
     ( -- | @since 0.1.0
       Show
     , -- | @since 0.1.0
       GHC.Generic
     )
-  deriving anyclass (Generic)
+  deriving anyclass
-  deriving
     ( -- | @since 0.1.0
-      PlutusTx.ToData
+      Generic
-    , -- | @since 0.1.0
-      PlutusTx.FromData
-    , -- | @since 0.1.0
-      PlutusTx.UnsafeFromData
     )
-    via (ProductIsData ProposalLock)
+
+PlutusTx.makeIsDataIndexed
+  ''ProposalLock
+  [ ('Created, 0)
+  , ('Voted, 1)
+  ]
 
 {- | Haskell-level redeemer for Stake scripts.
 
@@ -138,12 +161,12 @@ data StakeRedeemer
     --   This needs to be done in sync with casting a vote, otherwise
     --   it's possible for a lock to be permanently placed on the stake,
     --   and then the funds are lost.
-    PermitVote ProposalLock
+    PermitVote
   | -- | Retract a vote, removing it from the 'lockedBy' field. See 'ProposalLock'.
     --   This action checks for permission of the 'Agora.Proposal.Proposal'. Finished proposals are
     --   always allowed to have votes retracted and won't affect the Proposal datum,
     --   allowing 'Stake's to be unlocked.
-    RetractVotes [ProposalLock]
+    RetractVotes
   | -- | The owner can consume stake if nothing is changed about it.
     --   If the proposal token moves, this is equivalent to the owner consuming it.
     WitnessStake
@@ -165,7 +188,7 @@ PlutusTx.makeIsDataIndexed
 data StakeDatum = StakeDatum
   { stakedAmount :: Tagged GTTag Integer
   -- ^ Tracks the amount of governance token staked in the datum.
-  -- This also acts as the voting weight for 'Agora.Proposal.Proposal's.
+  --   This also acts as the voting weight for 'Agora.Proposal.Proposal's.
   , owner :: PubKeyHash
   -- ^ The hash of the public key this stake belongs to.
   --
@@ -173,7 +196,7 @@ data StakeDatum = StakeDatum
   --      https://github.com/Liqwid-Labs/agora/issues/45
   , lockedBy :: [ProposalLock]
   -- ^ The current proposals locking this stake. This field must be empty
-  -- for the stake to be usable for deposits and withdrawals.
+  --   for the stake to be usable for deposits and withdrawals.
   }
   deriving stock (Show, GHC.Generic)
   deriving anyclass (Generic)
@@ -227,13 +250,20 @@ newtype PStakeDatum (s :: S) = PStakeDatum
     via (DerivePNewtype' PStakeDatum)
 
 -- | @since 0.1.0
-instance Plutarch.Lift.PUnsafeLiftDecl PStakeDatum where type PLifted PStakeDatum = StakeDatum
+instance Plutarch.Lift.PUnsafeLiftDecl PStakeDatum where
+  type PLifted PStakeDatum = StakeDatum
 
 -- | @since 0.1.0
-deriving via (DerivePConstantViaDataList StakeDatum PStakeDatum) instance (Plutarch.Lift.PConstantDecl StakeDatum)
+deriving via
+  (DerivePConstantViaDataList StakeDatum PStakeDatum)
+  instance
+    (Plutarch.Lift.PConstantDecl StakeDatum)
 
 -- | @since 0.1.0
-deriving via PAsData (DerivePNewtype' PStakeDatum) instance PTryFrom PData (PAsData PStakeDatum)
+deriving via
+  PAsData (DerivePNewtype' PStakeDatum)
+  instance
+    PTryFrom PData (PAsData PStakeDatum)
 
 {- | Plutarch-level redeemer for Stake scripts.
 
@@ -244,8 +274,8 @@ data PStakeRedeemer (s :: S)
     PDepositWithdraw (Term s (PDataRecord '["delta" ':= PDiscrete GTTag]))
   | -- | Destroy a stake, retrieving its LQ, the minimum ADA and any other assets.
     PDestroy (Term s (PDataRecord '[]))
-  | PPermitVote (Term s (PDataRecord '["lock" ':= PProposalLock]))
+  | PPermitVote (Term s (PDataRecord '[]))
-  | PRetractVotes (Term s (PDataRecord '["locks" ':= PBuiltinList (PAsData PProposalLock)]))
+  | PRetractVotes (Term s (PDataRecord '[]))
   | PWitnessStake (Term s (PDataRecord '[]))
   deriving stock
     ( -- | @since 0.1.0
@@ -267,65 +297,37 @@ data PStakeRedeemer (s :: S)
     )
     via PIsDataReprInstances PStakeRedeemer
 
+-- | @since 0.1.0
 deriving via
   PAsData (PIsDataReprInstances PStakeRedeemer)
   instance
     PTryFrom PData (PAsData PStakeRedeemer)
 
-instance Plutarch.Lift.PUnsafeLiftDecl PStakeRedeemer where type PLifted PStakeRedeemer = StakeRedeemer
+-- | @since 0.1.0
-deriving via (DerivePConstantViaData StakeRedeemer PStakeRedeemer) instance (Plutarch.Lift.PConstantDecl StakeRedeemer)
+instance Plutarch.Lift.PUnsafeLiftDecl PStakeRedeemer where
+  type PLifted PStakeRedeemer = StakeRedeemer
+
+-- | @since 0.1.0
+deriving via
+  (DerivePConstantViaData StakeRedeemer PStakeRedeemer)
+  instance
+    (Plutarch.Lift.PConstantDecl StakeRedeemer)
 
 {- | Plutarch-level version of 'ProposalLock'.
 
-     @since 0.1.0
+     @since 0.2.0
 -}
-newtype PProposalLock (s :: S) = PProposalLock
+data PProposalLock (s :: S)
-  { getProposalLock ::
+  = PCreated (Term s (PDataRecord '["created" ':= PProposalId]))
-      Term
+  | PVoted
-        s
+      ( Term
-        ( PDataRecord
+          s
-            '[ "vote" ':= PResultTag
+          ( PDataRecord
-             , "proposalTag" ':= PProposalId
+              '[ "votedOn" ':= PProposalId
-             ]
+               , "votedFor" ':= PResultTag
-        )
+               ]
-  }
+          )
-  deriving stock (GHC.Generic)
+      )
-  deriving anyclass (Generic)
-  deriving anyclass (PIsDataRepr)
-  deriving
-    (PlutusType, PIsData, PDataFields, PEq)
-    via (DerivePNewtype' PProposalLock)
-
-deriving via
-  PAsData (DerivePNewtype' PProposalLock)
-  instance
-    PTryFrom PData (PAsData PProposalLock)
-
-instance Plutarch.Lift.PUnsafeLiftDecl PProposalLock where type PLifted PProposalLock = ProposalLock
-deriving via (DerivePConstantViaDataList ProposalLock PProposalLock) instance (Plutarch.Lift.PConstantDecl ProposalLock)
-
---------------------------------------------------------------------------------
-
-{- | Check whether a Stake is locked. If it is locked, various actions are unavailable.
-
-     @since 0.1.0
--}
-stakeLocked :: forall (s :: S). Term s (PStakeDatum :--> PBool)
-stakeLocked = phoistAcyclic $
-  plam $ \stakeDatum ->
-    let locks :: Term _ (PBuiltinList (PAsData PProposalLock))
-        locks = pfield @"lockedBy" # stakeDatum
-     in pnotNull # locks
-
-{- | Represent the usage of a stake on a particular proposal.
-     A stake can be used to either create or vote on a proposal.
-
-     @since 0.1.0
--}
-data PStakeUsage (s :: S)
-  = PVotedFor (Term s PResultTag)
-  | PCreated
-  | PDidNothing
   deriving stock
     ( -- | @since 0.1.0
       GHC.Generic
@@ -334,51 +336,212 @@ data PStakeUsage (s :: S)
     ( -- | @since 0.1.0
       Generic
     , -- | @since 0.1.0
+      HasDatatypeInfo
+    )
+  deriving anyclass
+    ( -- | @since 0.1.0
+      PIsDataRepr
+    )
+  deriving
+    ( -- | @since 0.1.0
       PlutusType
     , -- | @since 0.1.0
-      HasDatatypeInfo
+      PIsData
     , -- | @since 0.1.0
       PEq
     )
+    via (PIsDataReprInstances PProposalLock)
 
-{- | / O(n) /.Return the usage of a stake on a particular proposal,
+-- | @since 0.1.0
-     given the 'lockedBy' field of a stake and the target proposal.
+deriving via
+  PAsData (PIsDataReprInstances PProposalLock)
+  instance
+    PTryFrom PData (PAsData PProposalLock)
 
-     @since 0.1.0
+-- | @since 0.1.0
+instance Plutarch.Lift.PUnsafeLiftDecl PProposalLock where
+  type PLifted PProposalLock = ProposalLock
+
+-- | @since 0.1.0
+deriving via
+  (DerivePConstantViaData ProposalLock PProposalLock)
+  instance
+    (Plutarch.Lift.PConstantDecl ProposalLock)
+
+-- | @since 0.2.0
+instance PShow PProposalLock where
+  pshow' :: Bool -> Term s PProposalLock -> Term s PString
+  pshow' True _ = "(..)"
+  pshow' False lock = pmatch lock $ \case
+    PCreated ((pfield @"created" #) -> pid) -> "Created " <> pshow pid
+    PVoted x -> pletFields @'["votedOn", "votedFor"] x $ \xF ->
+      "Voted on " <> pshow xF.votedOn <> " for " <> pshow xF.votedFor
+
+--------------------------------------------------------------------------------
+
+{- | Check whether a Stake is locked. If it is locked, various actions are unavailable.
+
+     @since 0.2.0
 -}
-pgetStakeUsage ::
+pstakeLocked :: forall (s :: S). Term s (PStakeDatum :--> PBool)
-  Term
+pstakeLocked = phoistAcyclic $
-    _
+  plam $ \stakeDatum ->
-    ( PBuiltinList (PAsData PProposalLock)
+    let locks :: Term _ (PBuiltinList (PAsData PProposalLock))
-        :--> PProposalId
+        locks = pfield @"lockedBy" # stakeDatum
-        :--> PStakeUsage
+     in pnotNull # locks
+
+{- | Get the number of *alive* proposals that were created by the given stake.
+
+     @since 0.2.0
+-}
+pnumCreatedProposals :: Term s (PBuiltinList (PAsData PProposalLock) :--> PInteger)
+pnumCreatedProposals =
+  phoistAcyclic $
+    plam $ \l ->
+      pfoldl
+        # phoistAcyclic
+          ( plam
+              ( \c (pfromData -> lock) ->
+                  c
+                    + pmatch
+                      lock
+                      ( \case
+                          PCreated _ -> 1
+                          _ -> 0
+                      )
+              )
+          )
+        # 0
+        # l
+
+{- | The role of a stake for a particular proposal. Scott-encoded.
+
+     @since 0.2.0
+-}
+data PStakeRole (s :: S)
+  = -- | The stake was used to vote on the proposal.
+    PVoter
+      (Term s PResultTag)
+      -- ^ The option which was voted for.
+  | -- | The stake was used to create the propsoal.
+    PCreator
+  | -- | The stake was used to both create and vote on the proposal.
+    PBoth
+      (Term s PResultTag)
+      -- ^ The option which was voted for.
+  | -- | The stake has nothing to do with the given propsoal.
+    PIrrelevant
+  deriving stock
+    ( -- | @since 0.2.0
+      GHC.Generic
+    )
+  deriving anyclass
+    ( -- | @since 0.2.0
+      Generic
+    , -- | @since 0.2.0
+      PlutusType
+    , -- | @since 0.2.0
+      HasDatatypeInfo
+    , -- | @since 0.2.0
+      PEq
     )
-pgetStakeUsage = phoistAcyclic $
-  plam $ \locks pid ->
-    let -- All locks from the given proposal.
-        filteredLocks =
-          pmapMaybe
-            # plam
-              ( \lock'@(pfromData -> lock) -> unTermCont $ do
-                  lockF <- pletFieldsC @'["proposalTag"] lock
 
-                  pure $
+{- | Retutn true if the stake was used to voted on the proposal.
+
+     @since 0.2.0
+-}
+pisVoter :: Term s (PStakeRole :--> PBool)
+pisVoter = phoistAcyclic $
+  plam $ \sr -> pmatch sr $ \case
+    PVoter _ -> pconstant True
+    PBoth _ -> pconstant True
+    _ -> pconstant False
+
+{- | Retutn true if the stake was used to create the proposal.
+
+     @since 0.2.0
+-}
+pisCreator :: Term s (PStakeRole :--> PBool)
+pisCreator = phoistAcyclic $
+  plam $ \sr -> pmatch sr $ \case
+    PCreator -> pconstant True
+    PBoth _ -> pconstant True
+    _ -> pconstant False
+
+{- | Retutn true if the stake was used to create the proposal, but not vote on
+     the proposal.
+
+     @since 0.2.0
+-}
+pisPureCreator :: Term s (PStakeRole :--> PBool)
+pisPureCreator = phoistAcyclic $
+  plam $ \sr -> pmatch sr $ \case
+    PCreator -> pconstant True
+    _ -> pconstant False
+
+{- | Return true if the stake isn't related to the proposal.
+
+     @since 0.2.0
+-}
+pisIrrelevant :: Term s (PStakeRole :--> PBool)
+pisIrrelevant = phoistAcyclic $
+  plam $ \sr -> pmatch sr $ \case
+    PIrrelevant -> pconstant True
+    _ -> pconstant False
+
+{- | Get the role of a stake for the proposal specified by the poroposal id,
+      given the 'StakeDatum.lockedBy' field of the stake.
+
+     Note that the list of locks is cosidered valid only if it contains at most
+      two locks from the given proposal: one voter lock and one creator lock.
+
+     @since 0.2.0
+-}
+pgetStakeRole :: Term s (PProposalId :--> PBuiltinList (PAsData PProposalLock) :--> PStakeRole)
+pgetStakeRole = phoistAcyclic $
+  plam $ \pid locks ->
+    pfoldl
+      # plam
+        ( \role (pfromData -> lock) ->
+            let thisRole = pmatch lock $ \case
+                  PCreated ((pfield @"created" #) -> pid') ->
                     pif
-                      (lockF.proposalTag #== pid)
+                      (pid' #== pid)
-                      (pcon $ PJust lock')
+                      (pcon PCreator)
-                      (pcon PNothing)
+                      (pcon PIrrelevant)
-              )
+                  PVoted lock' -> pletFields @'["votedOn", "votedFor"] lock' $ \lockF ->
-            # locks
+                    pif
+                      (lockF.votedOn #== pid)
+                      (pcon $ PVoter lockF.votedFor)
+                      (pcon PIrrelevant)
+             in pcombineStakeRole # thisRole # role
+        )
+      # pcon PIrrelevant
+      # locks
+  where
+    pcombineStakeRole :: Term s (PStakeRole :--> PStakeRole :--> PStakeRole)
+    pcombineStakeRole = phoistAcyclic $
+      plam $ \x y ->
+        let cannotCombine = ptraceError "duplicate roles"
+         in pmatch x $ \case
+              PVoter r -> pmatch y $ \case
+                PCreator -> pcon $ PBoth r
+                PIrrelevant -> x
+                _ -> cannotCombine
+              PCreator -> pmatch y $ \case
+                PVoter r -> pcon $ PBoth r
+                PIrrelevant -> x
+                _ -> cannotCombine
+              PBoth _ -> cannotCombine
+              PIrrelevant -> y
 
-        lockCount' = plength # filteredLocks
+{- | Get the outcome that was voted for.
-     in plet lockCount' $ \lockCount ->
+
-          pif (lockCount #== 0) (pcon PDidNothing) $
+     @since 0.2.0
-            pif
+-}
-              (lockCount #== 1)
+pextractVoteOption :: Term s (PStakeRole :--> PResultTag)
-              ( pcon $
+pextractVoteOption = phoistAcyclic $
-                  PVotedFor $
+  plam $ \sr -> pmatch sr $ \case
-                    pfromData $
+    PVoter r -> r
-                      pfield @"vote" #$ phead # filteredLocks
+    PBoth r -> r
-              )
+    _ -> ptraceError "not voter"
-              -- Note: see the implementation of the governor.
-              (pcon PCreated)

agora/Agora/Stake/Scripts.hs

@@ -18,7 +18,7 @@ import Agora.Stake (
   ),
   Stake (gtClassRef, proposalSTClass),
   StakeRedeemer (WitnessStake),
-  stakeLocked,
+  pstakeLocked,
  )
 import Agora.Utils (
   mustBePJust,
@@ -109,7 +109,7 @@ stakePolicy gtClassRef =
                       pif
                         (psymbolValueOf # ownSymbol # txOutF.value #== 1)
                         ( let datum = mustFindDatum' @PStakeDatum # txOutF.datumHash # txInfoF.datums
-                           in pnot # (stakeLocked # datum)
+                           in pnot # (pstakeLocked # datum)
                         )
                         (pconstant False)
                 )
@@ -263,7 +263,7 @@ stakeValidator stake =
     spentST <- pletC $ psymbolValueOf # stCurrencySymbol #$ valueSpent
 
     -- Is the stake currently locked?
-    stakeIsLocked <- pletC $ stakeLocked # stakeDatum'
+    stakeIsLocked <- pletC $ pstakeLocked # stakeDatum'
 
     pure $
       pmatch stakeRedeemer $ \case
@@ -287,7 +287,7 @@ stakeValidator stake =
               proposalSTClass = passetClass # pconstant propCs # pconstant propTn
               spentProposalST = passetClassValueOf # valueSpent # proposalSTClass
 
-          proposalTokenMoved <- pletC $ spentProposalST #== 1
+          proposalTokenMoved <- pletC $ 1 #<= spentProposalST
 
           -- Filter out own outputs using own address and ST.
           ownOutputs <-
@@ -371,9 +371,20 @@ stakeValidator stake =
                   pletC $
                     pdata resolvedF.value #== pdata ownOutputValue
 
+                onlyLocksUpdated <-
+                  pletC $
+                    let templateStakeDatum =
+                          mkRecordConstr
+                            PStakeDatum
+                            ( #stakedAmount .= stakeDatum.stakedAmount
+                                .& #owner .= stakeDatum.owner
+                                .& #lockedBy .= pfield @"lockedBy" # stakeOut
+                            )
+                     in stakeOut #== templateStakeDatum
+
                 pure $
                   pmatch stakeRedeemer $ \case
-                    PRetractVotes l -> unTermCont $ do
+                    PRetractVotes _ -> unTermCont $ do
                       pguardC
                         "Owner signs this transaction"
                         ownerSignsTransaction
@@ -383,18 +394,8 @@ stakeValidator stake =
                       pguardC "Proposal ST spent" proposalTokenMoved
 
                       pguardC "A UTXO must exist with the correct output" $
-                        let expectedLocks = pfield @"locks" # l
+                        let valueCorrect = ownOutputValueUnchanged
-
+                            outputDatumCorrect = onlyLocksUpdated
-                            expectedDatum =
-                              mkRecordConstr
-                                PStakeDatum
-                                ( #stakedAmount .= stakeDatum.stakedAmount
-                                    .& #owner .= stakeDatum.owner
-                                    .& #lockedBy .= expectedLocks
-                                )
-
-                            valueCorrect = ownOutputValueUnchanged
-                            outputDatumCorrect = stakeOut #== expectedDatum
                          in foldl1
                               (#&&)
                               [ ptraceIfFalse "valueCorrect" valueCorrect
@@ -405,34 +406,21 @@ stakeValidator stake =
 
                     ------------------------------------------------------------
 
-                    PPermitVote l -> unTermCont $ do
+                    PPermitVote _ -> unTermCont $ do
                       pguardC
                         "Owner signs this transaction"
                         ownerSignsTransaction
 
+                      let proposalTokenMinted =
+                            passetClassValueOf # txInfoF.mint # proposalSTClass #== 1
+
                       -- This puts trust into the Proposal. The Proposal must necessarily check
                       -- that this is not abused.
-                      pguardC "Proposal ST spent" proposalTokenMoved
+                      pguardC "Proposal ST spent or minted" $
-
+                        proposalTokenMoved #|| proposalTokenMinted
-                      -- Update the stake datum, but only the 'lockedBy' field.
-
-                      let -- We actually don't know whether the given lock is valid or not.
-                          -- This is checked in the proposal validator.
-                          newLock = pfield @"lock" # l
-                          -- Prepend the new lock to the existing locks.
-                          expectedLocks = pcons # newLock # stakeDatum.lockedBy
-
-                      expectedDatum <-
-                        pletC $
-                          mkRecordConstr
-                            PStakeDatum
-                            ( #stakedAmount .= stakeDatum.stakedAmount
-                                .& #owner .= stakeDatum.owner
-                                .& #lockedBy .= pdata expectedLocks
-                            )
 
                       pguardC "A UTXO must exist with the correct output" $
-                        let correctOutputDatum = stakeOut #== expectedDatum
+                        let correctOutputDatum = onlyLocksUpdated
                             valueCorrect = ownOutputValueUnchanged
                          in foldl1
                               (#&&)