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

allow multiple proposals in the samples of unlocking stake

Browse source
This commit is contained in:
Hongrui Fang 2022-06-17 23:01:44 +08:00
parent feb3f2daaf
commit 4ac80516c5
No known key found for this signature in database
GPG key ID: 1C4711FFF64C0254
7 changed files with 422 additions and 560 deletions
Download patch file Download diff file Expand all files Collapse all files

293
agora-specs/Sample/Proposal.hs
View file

@ -19,14 +19,6 @@ module Sample.Proposal (
advanceFinishedPropsoal,
advanceProposalInsufficientVotes,
advancePropsoalWithInvalidOutputStake,
voterUnlockStakeAndRetractVotesWhile,
voterUnlockStakeWhile,
creatorRetractVotesWhile,
creatorUnlockStakeWhile,
unlockStakeAndRetractVotesUsingIrrelevantStakeWhile,
unlockStakeUsingIrrelevantStakeWhile,
unlockStakeProposalId,
unlockStake,
) where
import Agora.Governor (GovernorDatum (..))
@ -87,13 +79,13 @@ import PlutusLedgerApi.V1.Value qualified as Value (
singleton,
)
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (proposalRef, stakeRef)
import Sample.Shared (
govValidatorHash,
minAda,
proposal,
proposalPolicySymbol,
proposalStartingTimeFromTimeRange,
proposalValidatorAddress,
proposalValidatorHash,
signer,
signer2,
@ -169,12 +161,6 @@ proposalCreation =
]
in buildMintingUnsafe builder
proposalRef :: TxOutRef
proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
stakeRef :: TxOutRef
stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0
-- | This script context should be a valid transaction.
cosignProposal :: [PubKeyHash] -> TxInfo
cosignProposal newSigners =
@ -813,280 +799,3 @@ advancePropsoalWithInvalidOutputStake =
<> templateTxInfo.txInfoData
, txInfoSignatories = [stakeOwner]
}
--------------------------------------------------------------------------------
-- | Create empty effects for every result tag given the votes.
emptyEffectFor ::
ProposalVotes ->
AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
emptyEffectFor (ProposalVotes vs) =
AssocMap.fromList $
map (,AssocMap.empty) (AssocMap.keys vs)
-- | The proposal id shared by all the samples relate to unlocking stake.
unlockStakeProposalId :: ProposalId
unlockStakeProposalId = ProposalId 0
-- | A 'ProposalVotes' that has only two options, serves as a template for unlokcing stake samples.
unlockStakePropsoalVotesTemplate :: ProposalVotes
unlockStakePropsoalVotesTemplate =
ProposalVotes $
AssocMap.fromList
[ (ResultTag 0, 0)
, (ResultTag 1, 0)
]
-- | Create a 'TxInfo' that unlocks a stake from a proposal. For internal use only.
mkUnlockStakeTxInfo ::
-- | The current state of the proposal.
ProposalStatus ->
-- | The votes of the input propsoal
ProposalVotes ->
-- | The votes of the output proposal.
ProposalVotes ->
-- | Stake amount.
Integer ->
-- | Retract from option.
[ProposalLock] ->
-- | The locks of output stake.
[ProposalLock] ->
TxInfo
mkUnlockStakeTxInfo
status
votesBefore
votesAfter
stakedAmount
locksBefore
locksAfter =
let stakeOwner = signer
stakeInputDatum' :: StakeDatum
stakeInputDatum' =
StakeDatum
{ stakedAmount = Tagged stakedAmount
, owner = stakeOwner
, lockedBy = locksBefore
}
stakeOutputDatum' :: StakeDatum
stakeOutputDatum' =
stakeInputDatum'
{ lockedBy = locksAfter
}
---
effects = emptyEffectFor votesBefore
proposalInputDatum' :: ProposalDatum
proposalInputDatum' =
ProposalDatum
{ proposalId = unlockStakeProposalId
, effects = effects
, status = status
, cosigners = [signer]
, thresholds = def
, votes = votesBefore
, timingConfig = def
, startingTime = ProposalStartingTime 0
}
proposalOutputDatum' :: ProposalDatum
proposalOutputDatum' =
proposalInputDatum'
{ votes = votesAfter
}
---
sst = Value.assetClassValue stakeAssetClass 1
stakeInputDatum :: Datum
stakeInputDatum = Datum $ toBuiltinData stakeInputDatum'
stakeInput :: TxOut
stakeInput =
TxOut
{ txOutAddress = stakeAddress
, txOutValue =
mconcat
[ sst
, Value.assetClassValue (untag stake.gtClassRef) stakedAmount
, minAda
]
, txOutDatumHash = Just $ toDatumHash stakeInputDatum
}
stakeOutputDatum :: Datum
stakeOutputDatum = Datum $ toBuiltinData stakeOutputDatum'
stakeOutput :: TxOut
stakeOutput =
stakeInput
{ txOutDatumHash = Just $ toDatumHash stakeOutputDatum
}
---
pst = Value.singleton proposalPolicySymbol "" 1
proposalInputDatum :: Datum
proposalInputDatum = Datum $ toBuiltinData proposalInputDatum'
proposalInput :: TxOut
proposalInput =
TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue = pst
, txOutDatumHash = Just $ toDatumHash proposalInputDatum
}
---
proposalOutputDatum :: Datum
proposalOutputDatum = Datum $ toBuiltinData proposalOutputDatum'
proposalOutput :: TxOut
proposalOutput =
proposalInput
{ txOutValue = proposalInput.txOutValue <> minAda
, txOutDatumHash = Just $ toDatumHash proposalOutputDatum
}
in TxInfo
{ txInfoInputs = [TxInInfo proposalRef proposalInput, TxInInfo stakeRef stakeInput]
, txInfoOutputs = [proposalOutput, stakeOutput]
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = mempty
, txInfoDCert = []
, txInfoWdrl = []
, -- Time doesn't matter int this case.
txInfoValidRange = closedBoundedInterval 0 100
, txInfoSignatories = [signer]
, txInfoData = datumPair <$> [proposalInputDatum, proposalOutputDatum, stakeInputDatum, stakeOutputDatum]
, txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
}
-- | How a stake has been used on a particular proposal.
data StakeUsage
= -- | The stake was spent to vote for a paraticular option.
VotedFor ResultTag
| -- | The stake was used to created the proposal.
Created
| -- | The stake has nothing to do with the proposal.
DidNothing
-- | Create a bunch of 'ProposalLock' given the 'StakeUsgae'.
mkStakeLocks :: StakeUsage -> [ProposalLock]
mkStakeLocks (VotedFor rt) = [ProposalLock rt unlockStakeProposalId]
mkStakeLocks Created =
map (`ProposalLock` unlockStakeProposalId) $
AssocMap.keys $ getProposalVotes unlockStakePropsoalVotesTemplate
mkStakeLocks _ = []
-- | Assemble the votes of the input propsoal based on 'unlockStakePropsoalVotesTemplate'.
mkVotesBefore ::
StakeUsage ->
-- | The staked amount/votes.
Integer ->
ProposalVotes
mkVotesBefore (VotedFor rt) vc =
ProposalVotes $
updateMap (Just . const vc) rt $
getProposalVotes unlockStakePropsoalVotesTemplate
mkVotesBefore _ vc = mkVotesBefore (VotedFor $ ResultTag 0) vc
{- | Create a 'TxInfo' that unlocks the stake from the proposal.
The last parameter controls whether votes should be retracted or not.
-}
unlockStake ::
-- | The status of both the input and output propsoals.
ProposalStatus ->
StakeUsage ->
-- | Staked amount/vote count.
Integer ->
-- | Should we retract votes?
Bool ->
TxInfo
unlockStake ps su staked shouldRetract =
let votesBefore = mkVotesBefore su staked
votesAfter =
if shouldRetract
then unlockStakePropsoalVotesTemplate
else votesBefore
locksBefore = mkStakeLocks su
locksAfter = []
in mkUnlockStakeTxInfo
ps
votesBefore
votesAfter
staked
locksBefore
locksAfter
{- | Create a 'TxInfo' that unlocks a stake which is used to vote on the proposal.
Correct count of votes is also retracted. The 'TxInfo' is valid only if the given
proposal status is 'VotingReady'.
-}
voterUnlockStakeAndRetractVotesWhile :: ProposalStatus -> TxInfo
voterUnlockStakeAndRetractVotesWhile ps =
unlockStake
ps
(VotedFor $ ResultTag 0)
42
True
{- | Create a 'TxInfo' that unlocks a stake which is used to vote on the proposal
without retracting the votes, given the status of the proposal.
The 'TxInfo' is valid only if the status of the propsoal is either 'Locked'
or 'Finished'.
-}
voterUnlockStakeWhile :: ProposalStatus -> TxInfo
voterUnlockStakeWhile ps =
unlockStake
ps
(VotedFor $ ResultTag 0)
42
False
{- | Create an invalid 'TxInfo' that retracts votes using the stake
that is used to create the proposal.
-}
creatorRetractVotesWhile :: ProposalStatus -> TxInfo
creatorRetractVotesWhile ps =
unlockStake
ps
Created
42
True
{- | Create a 'TxInfo' to unlock the stake that is used to create the propsoal.
The 'TxInfo' is valid only if the given proposal status is 'Finished'.
-}
creatorUnlockStakeWhile :: ProposalStatus -> TxInfo
creatorUnlockStakeWhile ps =
unlockStake
ps
Created
42
False
{- | Create an invalid 'TxInfo' that tries to retract votes and also unlock a stake
which is not locked by the proposal, given the status of the proposal.
-}
unlockStakeAndRetractVotesUsingIrrelevantStakeWhile :: ProposalStatus -> TxInfo
unlockStakeAndRetractVotesUsingIrrelevantStakeWhile ps =
unlockStake
ps
DidNothing
42
True
{- | Create an invalid 'TxInfo' that tries to unlock a stake which is not locked by the proposal,
given the status of the proposal.
-}
unlockStakeUsingIrrelevantStakeWhile :: ProposalStatus -> TxInfo
unlockStakeUsingIrrelevantStakeWhile ps =
unlockStake
ps
DidNothing
42
False

9
agora-specs/Sample/Proposal/Shared.hs Normal file
View file

@ -0,0 +1,9 @@
module Sample.Proposal.Shared (proposalRef, stakeRef) where
import PlutusLedgerApi.V1 (TxOutRef (..))
proposalRef :: TxOutRef
proposalRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1
stakeRef :: TxOutRef
stakeRef = TxOutRef "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15" 0

275
agora-specs/Sample/Proposal/UnlockStake.hs Normal file
View file

@ -0,0 +1,275 @@
module Sample.Proposal.UnlockStake (
unlockStake,
StakeRole (..),
UnlockStakeParameters (..),
votesTemplate,
emptyEffectFor,
mkProposalInputDatum,
mkStakeInputDatum,
mkProposalValidatorTestCase,
) where
--------------------------------------------------------------------------------
import PlutusLedgerApi.V1 (
Datum (Datum),
DatumHash,
ScriptContext (..),
ScriptPurpose (Spending),
ToData (toBuiltinData),
TxInInfo (TxInInfo),
TxInfo (..),
TxOut (TxOut, txOutAddress, txOutDatumHash, txOutValue),
TxOutRef (..),
ValidatorHash,
)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
--------------------------------------------------------------------------------
import Agora.Proposal (
ProposalDatum (..),
ProposalId (..),
ProposalRedeemer (Unlock),
ProposalStatus (..),
ProposalVotes (..),
ResultTag (..),
)
import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime))
import Agora.Stake (ProposalLock (ProposalLock), Stake (..), StakeDatum (..))
import Sample.Shared (
minAda,
proposalPolicySymbol,
proposalValidatorAddress,
signer,
stake,
stakeAssetClass,
)
import Test.Util (closedBoundedInterval, datumPair, sortValue, toDatumHash, updateMap)
--------------------------------------------------------------------------------
import Agora.Proposal.Scripts (proposalValidator)
import Control.Monad (join)
import Data.Default.Class (Default (def))
import Data.Tagged (Tagged (..), untag)
import Sample.Proposal.Shared (proposalRef, stakeRef)
import Sample.Shared qualified as Shared
import Test.Specification (SpecificationTree, validatorFailsWith, validatorSucceedsWith)
--------------------------------------------------------------------------------
-- | The template "shape" that votes of proposals generated by 'mkProposalDatumPair' have.
votesTemplate :: ProposalVotes
votesTemplate =
ProposalVotes $
AssocMap.fromList
[ (ResultTag 0, 0)
, (ResultTag 1, 0)
]
-- | Create empty effects for every result tag given the votes.
emptyEffectFor ::
ProposalVotes ->
AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
emptyEffectFor (ProposalVotes vs) =
AssocMap.fromList $
map (,AssocMap.empty) (AssocMap.keys vs)
-- | The default vote option that will be used by functions in this module.
defaultVoteFor :: ResultTag
defaultVoteFor = ResultTag 0
-- | The default number of GTs the stake will have.
defaultStakedGTs :: Tagged _ Integer
defaultStakedGTs = Tagged 100000
-- | How a stake has been used on a particular proposal.
data StakeRole
= -- | The stake was spent to vote for a paraticular option.
Voter
| -- | The stake was used to created the proposal.
Creator
| -- | The stake has nothing to do with the proposal.
Irrelevant
-- | Parameters for creating a 'TxOut' that unlocks a stake.
data UnlockStakeParameters = UnlockStakeParameters
{ proposalCount :: Integer
-- ^ The number of proposals in the 'TxOut'.
, stakeUsage :: StakeRole
-- ^ The role of the stake we're unlocking.
, retractVotes :: Bool
-- ^ Whether to retract votes or not.
, proposalStatus :: ProposalStatus
-- ^ The state of all the proposals.
}
instance Show UnlockStakeParameters where
show p =
let role = case p.stakeUsage of
Voter -> "voter"
Creator -> "creator"
_ -> "irrelevant stake"
action =
if p.retractVotes
then "unlock stake + retract votes"
else "unlock stake"
while = show p.proposalStatus
proposalInfo = mconcat [show p.proposalCount, " proposals"]
in mconcat [proposalInfo, ", ", role, ", ", action, ", ", while]
-- | Generate some input proposals and their corresponding output proposals.
mkProposals :: UnlockStakeParameters -> ([ProposalDatum], [ProposalDatum])
mkProposals p = unzip $ forEachProposalId p.proposalCount $ mkProposalDatumPair p
-- | Iterate over the proposal id of every proposal, given the number of proposals.
forEachProposalId :: Integer -> (ProposalId -> a) -> [a]
forEachProposalId 0 _ = error "zero proposal"
forEachProposalId n f = f . ProposalId <$> [0 .. n - 1]
-- | Create a valid stake 'TxOut' given the stake datum.
mkStakeTxOut :: StakeDatum -> TxOut
mkStakeTxOut sd =
let sst = Value.assetClassValue stakeAssetClass 1
gts = Value.assetClassValue (untag stake.gtClassRef) (untag sd.stakedAmount)
in TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue = sortValue $ sst <> minAda <> gts
, txOutDatumHash = Just $ toDatumHash sd
}
-- | Create the input stake and its corresponding output stake.
mkStakeDatumPair :: UnlockStakeParameters -> (StakeDatum, StakeDatum)
mkStakeDatumPair c =
let output =
StakeDatum
{ stakedAmount = defaultStakedGTs
, owner = signer
, lockedBy = []
}
inputLocks = join $ forEachProposalId c.proposalCount (mkStakeLocks c.stakeUsage)
input = output {lockedBy = inputLocks}
in (input, output)
where
mkStakeLocks :: StakeRole -> ProposalId -> [ProposalLock]
mkStakeLocks Voter pid = [ProposalLock defaultVoteFor pid]
mkStakeLocks Creator pid =
map (`ProposalLock` pid) $
AssocMap.keys $ getProposalVotes votesTemplate
mkStakeLocks _ _ = []
-- | Create a valid proposal 'TxOut' given the proposal datum.
mkProposalTxOut :: ProposalDatum -> TxOut
mkProposalTxOut pd =
let pst = Value.singleton proposalPolicySymbol "" 1
in TxOut
{ txOutAddress = proposalValidatorAddress
, txOutValue = sortValue $ pst <> minAda
, txOutDatumHash = Just $ toDatumHash pd
}
-- | Create a input proposal and its corresponding output proposal.
mkProposalDatumPair ::
UnlockStakeParameters ->
ProposalId ->
(ProposalDatum, ProposalDatum)
mkProposalDatumPair params pid =
let owner = signer
inputVotes = mkInputVotes params.stakeUsage $ untag defaultStakedGTs
input =
ProposalDatum
{ proposalId = pid
, effects = emptyEffectFor votesTemplate
, status = params.proposalStatus
, cosigners = [owner]
, thresholds = def
, votes = inputVotes
, timingConfig = def
, startingTime = ProposalStartingTime 0
}
output =
if params.retractVotes
then input {votes = votesTemplate}
else input
in (input, output)
where
-- Assemble the votes of the input proposal based on 'votesTemplate'.
mkInputVotes ::
StakeRole ->
-- The staked amount/votes.
Integer ->
ProposalVotes
mkInputVotes Voter vc =
ProposalVotes $
updateMap (Just . const vc) defaultVoteFor $
getProposalVotes votesTemplate
mkInputVotes Creator _ =
ProposalVotes $
updateMap (Just . const 1000) defaultVoteFor $
getProposalVotes votesTemplate
mkInputVotes _ _ = votesTemplate
-- | Create a 'TxInfo' that tries to unlock a stake.
unlockStake :: UnlockStakeParameters -> TxInfo
unlockStake p =
let (pInDatums, pOutDatums) = mkProposals p
(sInDatum, sOutDatum) = mkStakeDatumPair p
pIns =
zipWith
( \i d ->
( let txOut = mkProposalTxOut d
ref = proposalRef {txOutRefIdx = i}
in TxInInfo ref txOut
)
)
[1 ..]
pInDatums
pOuts = map mkProposalTxOut pOutDatums
sIn = TxInInfo stakeRef $ mkStakeTxOut sInDatum
sOut = mkStakeTxOut sOutDatum
mkDatum :: forall d. (ToData d) => d -> Datum
mkDatum = Datum . toBuiltinData
in TxInfo
{ txInfoInputs = sIn : pIns
, txInfoOutputs = sOut : pOuts
, txInfoFee = Value.singleton "" "" 2
, txInfoMint = mempty
, txInfoDCert = []
, txInfoWdrl = []
, -- Time doesn't matter int this case.
txInfoValidRange = closedBoundedInterval 0 100
, txInfoSignatories = [signer]
, txInfoData = datumPair <$> (mkDatum <$> [sInDatum, sOutDatum]) <> (mkDatum <$> pInDatums <> pOutDatums)
, txInfoId = "95ba4015e30aef16a3461ea97a779f814aeea6b8009d99a94add4b8293be737a"
}
-- | Create the input proposal datum.
mkProposalInputDatum :: UnlockStakeParameters -> ProposalId -> ProposalDatum
mkProposalInputDatum p pid = fst $ mkProposalDatumPair p pid
-- | Create the input stake datum.
mkStakeInputDatum :: UnlockStakeParameters -> StakeDatum
mkStakeInputDatum = fst . mkStakeDatumPair
-- | Create a test case that tests the proposal validator's @'Unlock' _@ redeemer.
mkProposalValidatorTestCase :: UnlockStakeParameters -> Bool -> SpecificationTree
mkProposalValidatorTestCase p shouldSucceed =
let datum = mkProposalInputDatum p $ ProposalId 0
redeemer = Unlock (ResultTag 0)
name = show p
scriptContext = ScriptContext (unlockStake p) (Spending proposalRef)
f = if shouldSucceed then validatorSucceedsWith else validatorFailsWith
in f name (proposalValidator Shared.proposal) datum redeemer scriptContext