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

allow delegating stake for voting

Browse source
This commit is contained in:
Hongrui Fang 2022-07-25 18:37:22 +08:00
parent 7c36cd95ae
commit 2d6e8b4c4e
No known key found for this signature in database
GPG key ID: 1E0454204FC7D755
12 changed files with 650 additions and 585 deletions
Download patch file Download diff file Expand all files Collapse all files

1
agora-specs/Sample/Proposal/Advance.hs
View file

@ -352,6 +352,7 @@ mkStakeInputDatums ps =
StakeDatum
{ stakedAmount = Tagged ps.perStakeGTs
, owner = ""
, delegatedTo = Nothing
, lockedBy = []
}
in (\owner -> template {owner = owner})

2
agora-specs/Sample/Proposal/Cosign.hs
View file

@ -130,7 +130,7 @@ mkProposalOutputDatum ps =
-- | Create all the input stakes given the parameters.
mkStakeInputDatums :: Parameters -> [StakeDatum]
mkStakeInputDatums = fmap (\pk -> StakeDatum perStakedGTs pk []) . newCosigners
mkStakeInputDatums = fmap (\pk -> StakeDatum perStakedGTs pk Nothing []) . newCosigners
-- | Create a 'TxInfo' that tries to cosign a proposal with new cosigners.
cosign :: forall b. CombinableBuilder b => Parameters -> b

1
agora-specs/Sample/Proposal/Create.hs
View file

@ -185,6 +185,7 @@ mkStakeInputDatum ps =
in StakeDatum
{ stakedAmount = stakedGTs
, owner = stakeOwner
, delegatedTo = Nothing
, lockedBy = locks
}

1
agora-specs/Sample/Proposal/UnlockStake.hs
View file

@ -177,6 +177,7 @@ mkStakeInputDatum ps =
StakeDatum
{ stakedAmount = defStakedGTs
, owner = defOwner
, delegatedTo = Nothing
, lockedBy = mkInputStakeLocks ps
}

1
agora-specs/Sample/Proposal/Vote.hs
View file

@ -129,6 +129,7 @@ mkStakeInputDatum params =
StakeDatum
{ stakedAmount = Tagged params.voteCount
, owner = stakeOwner
, delegatedTo = Nothing
, lockedBy = existingLocks
}

6
agora-specs/Sample/Stake.hs
View file

@ -76,7 +76,7 @@ stakeCreation :: ScriptContext
stakeCreation =
let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
datum :: StakeDatum
datum = StakeDatum 424242424242 signer []
datum = StakeDatum 424242424242 signer Nothing []
builder :: MintingBuilder
builder =
@ -96,7 +96,7 @@ stakeCreation =
stakeCreationWrongDatum :: ScriptContext
stakeCreationWrongDatum =
let datum :: Datum
datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer []) -- Too much GT
datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer Nothing []) -- Too much GT
in ScriptContext
{ scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = [("", datum)]}
, scriptContextPurpose = Minting stakeSymbol
@ -128,7 +128,7 @@ stakeDepositWithdraw :: DepositWithdrawExample -> ScriptContext
stakeDepositWithdraw config =
let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
stakeBefore :: StakeDatum
stakeBefore = StakeDatum config.startAmount signer []
stakeBefore = StakeDatum config.startAmount signer Nothing []
stakeAfter :: StakeDatum
stakeAfter = stakeBefore {stakedAmount = stakeBefore.stakedAmount + config.delta}

7
agora-specs/Spec/Stake.hs
View file

@ -15,6 +15,7 @@ import Agora.Stake (
StakeRedeemer (DepositWithdraw),
)
import Agora.Stake.Scripts (stakePolicy, stakeValidator)
import Data.Maybe (Maybe (..))
import Sample.Stake (
DepositWithdrawExample (
DepositWithdrawExample,
@ -67,19 +68,19 @@ specs =
[ validatorSucceedsWith
"stakeDepositWithdraw deposit"
(stakeValidator Stake.stake)
(toDatum $ StakeDatum 100_000 signer [])
(toDatum $ StakeDatum 100_000 signer Nothing [])
(toDatum $ DepositWithdraw 100_000)
(Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = 100_000})
, validatorSucceedsWith
"stakeDepositWithdraw withdraw"
(stakeValidator Stake.stake)
(toDatum $ StakeDatum 100_000 signer [])
(toDatum $ StakeDatum 100_000 signer Nothing [])
(toDatum $ DepositWithdraw $ negate 100_000)
(Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 100_000})
, validatorFailsWith
"stakeDepositWithdraw negative GT"
(stakeValidator Stake.stake)
(toDatum $ StakeDatum 100_000 signer [])
(toDatum $ StakeDatum 100_000 signer Nothing [])
(toDatum $ DepositWithdraw 1_000_000)
(Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 1_000_000})
]

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

@ -511,6 +511,7 @@ proposalValidator proposal =
PStakeDatum
( #stakedAmount .= stakeInF.stakedAmount
.& #owner .= stakeInF.owner
.& #delegatedTo .= stakeInF.delegatedTo
.& #lockedBy .= pdata expectedProposalLocks
)
@ -588,6 +589,7 @@ proposalValidator proposal =
PStakeDatum
( #stakedAmount .= stakeInF.stakedAmount
.& #owner .= stakeInF.owner
.& #delegatedTo .= stakeInF.delegatedTo
.& #lockedBy .= pdata stakeOutputLocks
)

13
agora/Agora/Stake.hs
View file

@ -38,6 +38,7 @@ import Data.Tagged (Tagged (..))
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, HasDatatypeInfo, I (I))
import Plutarch.Api.V1 (
PMaybeData,
PPubKeyHash,
)
import Plutarch.DataRepr (
@ -170,6 +171,11 @@ data StakeRedeemer
| -- | 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
| -- | The owner can delegate the stake to another user, allowing the
-- delegate to vote on prooposals with the stake.
DelegateTo PubKeyHash
| -- | Revoke the existing delegation.
ClearDelegate
deriving stock (Show, GHC.Generic)
PlutusTx.makeIsDataIndexed
@ -179,6 +185,8 @@ PlutusTx.makeIsDataIndexed
, ('PermitVote, 2)
, ('RetractVotes, 3)
, ('WitnessStake, 4)
, ('DelegateTo, 5)
, ('ClearDelegate, 6)
]
{- | Haskell-level datum for Stake scripts.
@ -194,6 +202,8 @@ data StakeDatum = StakeDatum
--
-- TODO Support for MultiSig/Scripts is tracked here:
-- https://github.com/Liqwid-Labs/agora/issues/45
, delegatedTo :: Maybe PubKeyHash
-- ^ To whom this stake has been delegated.
, lockedBy :: [ProposalLock]
-- ^ The current proposals locking this stake. This field must be empty
-- for the stake to be usable for deposits and withdrawals.
@ -221,6 +231,7 @@ newtype PStakeDatum (s :: S) = PStakeDatum
( PDataRecord
'[ "stakedAmount" ':= PDiscrete GTTag
, "owner" ':= PPubKeyHash
, "delegatedTo" ':= PMaybeData PPubKeyHash
, "lockedBy" ':= PBuiltinList (PAsData PProposalLock)
]
)
@ -277,6 +288,8 @@ data PStakeRedeemer (s :: S)
| PPermitVote (Term s (PDataRecord '[]))
| PRetractVotes (Term s (PDataRecord '[]))
| PWitnessStake (Term s (PDataRecord '[]))
| PDelegateTo (Term s (PDataRecord '["pkh" ':= PPubKeyHash]))
| PClearDelegate (Term s (PDataRecord '[]))
deriving stock
( -- | @since 0.1.0
GHC.Generic

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

@ -10,12 +10,7 @@ module Agora.Stake.Scripts (stakePolicy, stakeValidator) where
import Agora.SafeMoney (GTTag)
import Agora.Stake (
PStakeDatum (PStakeDatum),
PStakeRedeemer (
PDepositWithdraw,
PDestroy,
PPermitVote,
PRetractVotes
),
PStakeRedeemer (..),
Stake (gtClassRef, proposalSTClass),
StakeRedeemer (WitnessStake),
pstakeLocked,
@ -23,6 +18,7 @@ import Agora.Stake (
import Agora.Utils (
mustBePJust,
mustFindDatum',
pmaybeData,
pvalidatorHashToTokenName,
)
import Data.Function (on)
@ -31,6 +27,7 @@ import Plutarch.Api.V1 (
AmountGuarantees (Positive),
PCredential (PPubKeyCredential, PScriptCredential),
PDatumHash,
PMaybeData (..),
PMintingPolicy,
PScriptPurpose (PMinting, PSpending),
PTokenName,
@ -44,6 +41,7 @@ import Plutarch.Api.V1 (
import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf)
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, ptxSignedBy, pvalueSpent)
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf)
import Plutarch.Extra.Field (pletAllC)
import Plutarch.Extra.List (pmapMaybe, pmsortBy)
import Plutarch.Extra.Maybe (pfromDJust)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
@ -239,7 +237,7 @@ stakeValidator stake =
-- TODO: Use PTryFrom
let stakeDatum' :: Term _ PStakeDatum
stakeDatum' = pfromData $ punsafeCoerce datum
stakeDatum <- pletFieldsC @'["owner", "stakedAmount", "lockedBy"] stakeDatum'
stakeDatum <- pletAllC stakeDatum'
PSpending txOutRef <- pmatchC $ pfromData ctx.purpose
@ -251,7 +249,14 @@ stakeValidator stake =
resolvedF <- pletFieldsC @'["address", "value", "datumHash"] resolved
-- Whether the owner signs this transaction or not.
ownerSignsTransaction <- pletC $ ptxSignedBy # txInfoF.signatories # stakeDatum.owner
signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
ownerSignsTransaction <- pletC $ signedBy # stakeDatum.owner
delegateSignsTransaction <-
pletC $
pmaybeData # pconstant False
# plam ((signedBy #) . pdata)
# stakeDatum.delegatedTo
stCurrencySymbol <-
pletC $
@ -378,10 +383,36 @@ stakeValidator stake =
PStakeDatum
( #stakedAmount .= stakeDatum.stakedAmount
.& #owner .= stakeDatum.owner
.& #delegatedTo .= stakeDatum.delegatedTo
.& #lockedBy .= pfield @"lockedBy" # stakeOut
)
in stakeOut #== templateStakeDatum
setDelegate <- pletC $
plam $ \maybePkh -> unTermCont $ do
pguardC
"Owner signs this transaction"
ownerSignsTransaction
pguardC "A UTXO must exist with the correct output" $
let correctOutputDatum =
stakeOut
#== mkRecordConstr
PStakeDatum
( #stakedAmount .= stakeDatum.stakedAmount
.& #owner .= stakeDatum.owner
.& #delegatedTo .= pdata maybePkh
.& #lockedBy .= stakeDatum.lockedBy
)
valueCorrect = ownOutputValueUnchanged
in foldl1
(#&&)
[ ptraceIfFalse "valueCorrect" valueCorrect
, ptraceIfFalse "datumCorrect" correctOutputDatum
]
pure $ popaque (pconstant ())
pure $
pmatch stakeRedeemer $ \case
PRetractVotes _ -> unTermCont $ do
@ -408,8 +439,8 @@ stakeValidator stake =
PPermitVote _ -> unTermCont $ do
pguardC
"Owner signs this transaction"
ownerSignsTransaction
"Owner or delegate signs this transaction"
$ ownerSignsTransaction #|| delegateSignsTransaction
let proposalTokenMinted =
passetClassValueOf # txInfoF.mint # proposalSTClass #== 1
@ -418,7 +449,6 @@ stakeValidator stake =
-- that this is not abused.
pguardC "Proposal ST spent or minted" $
proposalTokenMoved #|| proposalTokenMinted
pguardC "A UTXO must exist with the correct output" $
let correctOutputDatum = onlyLocksUpdated
valueCorrect = ownOutputValueUnchanged
@ -453,6 +483,7 @@ stakeValidator stake =
PStakeDatum
( #stakedAmount .= pdata newStakedAmount
.& #owner .= stakeDatum.owner
.& #delegatedTo .= stakeDatum.delegatedTo
.& #lockedBy .= stakeDatum.lockedBy
)
datumCorrect = stakeOut #== expectedDatum
@ -486,6 +517,20 @@ stakeValidator stake =
]
--
pure $ popaque (pconstant ())
------------------------------------------------------------
PDelegateTo ((pfield @"pkh" #) -> pkh) -> unTermCont $ do
pguardC "Cannot delegate to the owner" $
pnot #$ stakeDatum.owner #== pfromData pkh
pure $ setDelegate #$ pcon $ PDJust $ pdcons @"_0" # pkh #$ pdnil
------------------------------------------------------------
PClearDelegate _ ->
setDelegate #$ pcon $ PDNothing pdnil
------------------------------------------------------------
_ -> popaque (pconstant ())
pure $

2
agora/Agora/Utils.hs
View file

@ -268,4 +268,4 @@ pmaybeData ::
pmaybeData = phoistAcyclic $
plam $ \n f m -> pmatch m $ \case
PDJust ((pfield @"_0" #) -> x) -> f # x
_ -> n
_ -> n

1132
bench.csv
View file

File diff suppressed because it is too large Load diff