From 96a50419d114e85a93668382ba3a0539011fee30 Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Fri, 8 Jul 2022 20:37:14 +0800 Subject: [PATCH] implement new stake locking mechanism --- agora/Agora/Governor.hs | 3 + agora/Agora/Governor/Scripts.hs | 34 ++- agora/Agora/Proposal.hs | 15 +- agora/Agora/Proposal/Scripts.hs | 67 +++--- agora/Agora/Stake.hs | 399 ++++++++++++++++++++++---------- agora/Agora/Stake/Scripts.hs | 62 ++--- 6 files changed, 369 insertions(+), 211 deletions(-) diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index 6a6771c..4c093fe 100644 --- a/agora/Agora/Governor.hs +++ b/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 ] ) } diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 2b5533e..dc7a72b 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/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 possibleVoteResults = pkeys #$ pto $ pfromData proposalOutputDatum.votes - - mkProposalLock :: Term _ (PProposalId :--> PAsData PResultTag :--> PAsData PProposalLock) - mkProposalLock = - phoistAcyclic $ - plam - ( \pid rt' -> - pdata $ - mkRecordConstr - PProposalLock - ( #vote .= rt' .& #proposalTag .= pdata pid - ) - ) + let newLock = + mkRecordConstr + PCreated + ( #created .= oldGovernorDatumF.nextProposalId + ) -- Append new locks to existing locks - expectedProposalLocks = - pconcat # stakeInputDatumF.lockedBy - #$ pmap # (mkProposalLock # proposalOutputDatum.proposalId) # possibleVoteResults + expectedProposalLocks = pcons # pdata newLock # stakeInputDatumF.lockedBy expectedStakeOutputDatum = pdata $ diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 922c3ac..95b2a5d 100644 --- a/agora/Agora/Proposal.hs +++ b/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 diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 85ec3f1..495c0ed 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -29,8 +29,12 @@ import Agora.Proposal.Time ( import Agora.Stake ( PProposalLock (..), PStakeDatum (..), - PStakeUsage (..), - pgetStakeUsage, + pextractVoteOption, + 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 - # plam - ( \((pfield @"proposalTag" #) . pfromData -> pid) -> - pid #== proposalF.proposalId - ) - # pfromData stakeInF.lockedBy + pnot #$ pisVoter #$ pgetStakeRole # 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 - ( #vote .= pdata voteFor - .& #proposalTag .= proposalF.proposalId + PVoted + ( #votedOn .= 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. - retractFrom <- pletC $ pfield @"resultTag" # r + stakeRole <- pletC $ pgetStakeRole # proposalF.proposalId # stakeInF.lockedBy - -- Determine if the input stake is actually locked by this proposal. - stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId + pguardC "Stake input should be relevant" $ + 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 - # proposalF.proposalId #== pcon PDidNothing + validateOutputLocks # stakeOutputLocks pure $ pconstant () diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index b5f5e16..329ace5 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -18,11 +18,17 @@ module Agora.Stake ( PStakeDatum (..), PStakeRedeemer (..), PProposalLock (..), - PStakeUsage (..), + PStakeRole (..), -- * Utility functions - stakeLocked, - pgetStakeUsage, + pstakeLocked, + 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 - depositing and withdrawing when votes are in place. +{- | Locks that are stored in the stake datums for various purposes. 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 - { vote :: ResultTag - -- ^ What was voted on. This allows retracting votes to - -- undo their vote. - , proposalId :: ProposalId - -- ^ Identifies the proposal. See 'ProposalId' for further - -- comments on its significance. - } +data ProposalLock + = -- | The stake was used to create a proposal. + -- + -- This kind of lock is placed upon the creation of a proposal, in order + -- to limit creation of proposals per stake. + -- + -- 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 + deriving anyclass ( -- | @since 0.1.0 - PlutusTx.ToData - , -- | @since 0.1.0 - PlutusTx.FromData - , -- | @since 0.1.0 - PlutusTx.UnsafeFromData + Generic ) - 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])) - | PRetractVotes (Term s (PDataRecord '["locks" ':= PBuiltinList (PAsData PProposalLock)])) + | PPermitVote (Term s (PDataRecord '[])) + | 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 -deriving via (DerivePConstantViaData StakeRedeemer PStakeRedeemer) instance (Plutarch.Lift.PConstantDecl StakeRedeemer) +-- | @since 0.1.0 +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 - { getProposalLock :: - Term - s - ( PDataRecord - '[ "vote" ':= PResultTag - , "proposalTag" ':= PProposalId - ] - ) - } - 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 +data PProposalLock (s :: S) + = PCreated (Term s (PDataRecord '["created" ':= PProposalId])) + | PVoted + ( Term + s + ( PDataRecord + '[ "votedOn" ':= PProposalId + , "votedFor" ':= PResultTag + ] + ) + ) 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, - given the 'lockedBy' field of a stake and the target proposal. +-- | @since 0.1.0 +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 :: - Term - _ - ( PBuiltinList (PAsData PProposalLock) - :--> PProposalId - :--> PStakeUsage +pstakeLocked :: forall (s :: S). Term s (PStakeDatum :--> PBool) +pstakeLocked = phoistAcyclic $ + plam $ \stakeDatum -> + let locks :: Term _ (PBuiltinList (PAsData PProposalLock)) + locks = pfield @"lockedBy" # stakeDatum + 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) - (pcon $ PJust lock') - (pcon PNothing) - ) - # locks + (pid' #== pid) + (pcon PCreator) + (pcon PIrrelevant) + PVoted lock' -> pletFields @'["votedOn", "votedFor"] lock' $ \lockF -> + 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 - in plet lockCount' $ \lockCount -> - pif (lockCount #== 0) (pcon PDidNothing) $ - pif - (lockCount #== 1) - ( pcon $ - PVotedFor $ - pfromData $ - pfield @"vote" #$ phead # filteredLocks - ) - -- Note: see the implementation of the governor. - (pcon PCreated) +{- | Get the outcome that was voted for. + + @since 0.2.0 +-} +pextractVoteOption :: Term s (PStakeRole :--> PResultTag) +pextractVoteOption = phoistAcyclic $ + plam $ \sr -> pmatch sr $ \case + PVoter r -> r + PBoth r -> r + _ -> ptraceError "not voter" diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index f84ec33..50a3ddf 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/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 - - expectedDatum = - mkRecordConstr - PStakeDatum - ( #stakedAmount .= stakeDatum.stakedAmount - .& #owner .= stakeDatum.owner - .& #lockedBy .= expectedLocks - ) - - valueCorrect = ownOutputValueUnchanged - outputDatumCorrect = stakeOut #== expectedDatum + let valueCorrect = ownOutputValueUnchanged + outputDatumCorrect = onlyLocksUpdated 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 - - -- 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 "Proposal ST spent or minted" $ + proposalTokenMoved #|| proposalTokenMinted pguardC "A UTXO must exist with the correct output" $ - let correctOutputDatum = stakeOut #== expectedDatum + let correctOutputDatum = onlyLocksUpdated valueCorrect = ownOutputValueUnchanged in foldl1 (#&&)