Sulkta-Coop/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

implement new stake locking mechanism

Browse source
This commit is contained in:
Hongrui Fang 2022-07-08 20:37:14 +08:00
parent 79563c8d64
commit 96a50419d1
No known key found for this signature in database
GPG key ID: 1C4711FFF64C0254
6 changed files with 369 additions and 211 deletions
Download patch file Download diff file Expand all files Collapse all files

3
agora/Agora/Governor.hs
View file

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

34
agora/Agora/Governor/Scripts.hs
View file

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

15
agora/Agora/Proposal.hs
View file

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

67
agora/Agora/Proposal/Scripts.hs
View file

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

399
agora/Agora/Stake.hs
View file

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

62
agora/Agora/Stake/Scripts.hs
View file

@ -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
(#&&)