allow multiple proposals in the samples of unlocking stake
This commit is contained in:
Hongrui Fang
parent
feb3f2daaf
commit
4ac80516c5
7 changed files with 422 additions and 560 deletions
|
|
@ -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
9
agora-specs/Sample/Proposal/Shared.hs
Normal 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
275
agora-specs/Sample/Proposal/UnlockStake.hs
Normal 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
|
||||
|
|
@ -36,34 +36,13 @@ import Agora.Stake (
|
|||
StakeRedeemer (PermitVote, WitnessStake),
|
||||
)
|
||||
import Agora.Stake.Scripts (stakeValidator)
|
||||
import Control.Monad (join)
|
||||
import Data.Default.Class (Default (def))
|
||||
import Data.Tagged (Tagged (Tagged), untag)
|
||||
import PlutusLedgerApi.V1 (ScriptContext (..), ScriptPurpose (..))
|
||||
import PlutusTx.AssocMap qualified as AssocMap (empty, fromList)
|
||||
import Sample.Proposal qualified as Proposal (
|
||||
TransitionParameters (
|
||||
TransitionParameters,
|
||||
initialProposalStatus,
|
||||
proposalStartingTime
|
||||
),
|
||||
VotingParameters (VotingParameters, voteCount, voteFor),
|
||||
advanceFinishedPropsoal,
|
||||
advanceProposalFailureTimeout,
|
||||
advanceProposalInsufficientVotes,
|
||||
advanceProposalSuccess,
|
||||
advancePropsoalWithInvalidOutputStake,
|
||||
cosignProposal,
|
||||
creatorRetractVotesWhile,
|
||||
creatorUnlockStakeWhile,
|
||||
proposalCreation,
|
||||
proposalRef,
|
||||
stakeRef,
|
||||
unlockStakeAndRetractVotesUsingIrrelevantStakeWhile,
|
||||
unlockStakeUsingIrrelevantStakeWhile,
|
||||
voteOnProposal,
|
||||
voterUnlockStakeAndRetractVotesWhile,
|
||||
voterUnlockStakeWhile,
|
||||
)
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import Sample.Proposal qualified as Proposal
|
||||
import Sample.Proposal.UnlockStake qualified as UnlockStake
|
||||
import Sample.Shared (signer, signer2)
|
||||
import Sample.Shared qualified as Shared (proposal, stake)
|
||||
import Test.Specification (
|
||||
|
|
@ -364,247 +343,110 @@ specs =
|
|||
]
|
||||
, group
|
||||
"unlocking"
|
||||
[ group
|
||||
"legal"
|
||||
[ validatorSucceedsWith
|
||||
"retract votes and unlock stake while voting"
|
||||
(proposalValidator Shared.proposal)
|
||||
( ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, status = VotingReady
|
||||
, cosigners = [signer]
|
||||
, thresholds = def
|
||||
, votes =
|
||||
ProposalVotes
|
||||
( AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 0)
|
||||
]
|
||||
$ map
|
||||
( \pc ->
|
||||
group
|
||||
(show pc <> " proposals")
|
||||
[ group
|
||||
"legal"
|
||||
[ group
|
||||
"retract votes and unlock stake while voting"
|
||||
[ UnlockStake.mkProposalValidatorTestCase
|
||||
( UnlockStake.UnlockStakeParameters
|
||||
pc
|
||||
UnlockStake.Voter
|
||||
True
|
||||
VotingReady
|
||||
)
|
||||
True
|
||||
]
|
||||
, group
|
||||
"unlock the stake that has been used to create the proposal"
|
||||
[ UnlockStake.mkProposalValidatorTestCase
|
||||
( UnlockStake.UnlockStakeParameters
|
||||
pc
|
||||
UnlockStake.Creator
|
||||
False
|
||||
Finished
|
||||
)
|
||||
True
|
||||
]
|
||||
, group "unlock stake after voting" $
|
||||
map
|
||||
( \ps ->
|
||||
UnlockStake.mkProposalValidatorTestCase
|
||||
( UnlockStake.UnlockStakeParameters
|
||||
pc
|
||||
UnlockStake.Voter
|
||||
False
|
||||
ps
|
||||
)
|
||||
True
|
||||
)
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
)
|
||||
(Unlock (ResultTag 0))
|
||||
( ScriptContext
|
||||
(Proposal.voterUnlockStakeAndRetractVotesWhile VotingReady)
|
||||
(Spending Proposal.proposalRef)
|
||||
)
|
||||
, validatorSucceedsWith
|
||||
"unlock the stake that has been used to create the proposal"
|
||||
(proposalValidator Shared.proposal)
|
||||
( ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, status = Finished
|
||||
, cosigners = [signer]
|
||||
, thresholds = def
|
||||
, votes =
|
||||
ProposalVotes
|
||||
( AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 0)
|
||||
]
|
||||
[Finished, Locked]
|
||||
]
|
||||
, group
|
||||
"illegal"
|
||||
[ group "retract votes while the proposal is not voting ready" $
|
||||
map
|
||||
( \ps ->
|
||||
UnlockStake.mkProposalValidatorTestCase
|
||||
( UnlockStake.UnlockStakeParameters
|
||||
pc
|
||||
UnlockStake.Voter
|
||||
True
|
||||
ps
|
||||
)
|
||||
False
|
||||
)
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
)
|
||||
(Unlock (ResultTag 0))
|
||||
( ScriptContext
|
||||
(Proposal.creatorUnlockStakeWhile Finished)
|
||||
(Spending Proposal.proposalRef)
|
||||
)
|
||||
, group "unlock stake after voting" $
|
||||
map
|
||||
( \ps ->
|
||||
validatorSucceedsWith
|
||||
(show ps)
|
||||
(proposalValidator Shared.proposal)
|
||||
( ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, status = ps
|
||||
, cosigners = [signer]
|
||||
, thresholds = def
|
||||
, votes =
|
||||
ProposalVotes
|
||||
( AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 0)
|
||||
]
|
||||
)
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
)
|
||||
(Unlock (ResultTag 0))
|
||||
( ScriptContext
|
||||
(Proposal.voterUnlockStakeWhile ps)
|
||||
(Spending Proposal.proposalRef)
|
||||
)
|
||||
)
|
||||
[Locked, Finished]
|
||||
]
|
||||
, group
|
||||
"illegal"
|
||||
[ group "retract votes while the proposal is not voting ready" $
|
||||
map
|
||||
( \ps ->
|
||||
validatorFailsWith
|
||||
(show ps)
|
||||
(proposalValidator Shared.proposal)
|
||||
( ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, status = ps
|
||||
, cosigners = [signer]
|
||||
, thresholds = def
|
||||
, votes =
|
||||
ProposalVotes
|
||||
( AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 0)
|
||||
]
|
||||
)
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
)
|
||||
(Unlock (ResultTag 0))
|
||||
( ScriptContext
|
||||
(Proposal.voterUnlockStakeAndRetractVotesWhile ps)
|
||||
(Spending Proposal.proposalRef)
|
||||
)
|
||||
)
|
||||
[Draft, Locked, Finished]
|
||||
, group
|
||||
"irrelevant stake"
|
||||
$ foldMap
|
||||
( \(f, s) ->
|
||||
map
|
||||
( \ps ->
|
||||
validatorFailsWith
|
||||
(s <> " (" <> show ps <> ")")
|
||||
(proposalValidator Shared.proposal)
|
||||
( ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, status = ps
|
||||
, cosigners = [signer]
|
||||
, thresholds = def
|
||||
, votes =
|
||||
ProposalVotes
|
||||
( AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 0)
|
||||
]
|
||||
[Draft, Locked, Finished]
|
||||
, group "irrelevant stake" $
|
||||
join $
|
||||
map
|
||||
( \rv ->
|
||||
map
|
||||
( \ps ->
|
||||
UnlockStake.mkProposalValidatorTestCase
|
||||
( UnlockStake.UnlockStakeParameters
|
||||
pc
|
||||
UnlockStake.Irrelevant
|
||||
rv
|
||||
ps
|
||||
)
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
)
|
||||
(Unlock (ResultTag 0))
|
||||
( ScriptContext
|
||||
(f ps)
|
||||
(Spending Proposal.proposalRef)
|
||||
)
|
||||
)
|
||||
[Draft, VotingReady, Locked, Finished]
|
||||
)
|
||||
[ (Proposal.unlockStakeAndRetractVotesUsingIrrelevantStakeWhile, "unlock stake + retract votes")
|
||||
, (Proposal.unlockStakeUsingIrrelevantStakeWhile, "unlock stake")
|
||||
]
|
||||
, group "unlock stake that has been used to create the proposal before finished" $
|
||||
map
|
||||
( \ps ->
|
||||
validatorFailsWith
|
||||
(show ps)
|
||||
(proposalValidator Shared.proposal)
|
||||
( ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, status = ps
|
||||
, cosigners = [signer]
|
||||
, thresholds = def
|
||||
, votes =
|
||||
ProposalVotes
|
||||
( AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 0)
|
||||
]
|
||||
False
|
||||
)
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
)
|
||||
(Unlock (ResultTag 0))
|
||||
( ScriptContext
|
||||
(Proposal.creatorUnlockStakeWhile ps)
|
||||
(Spending Proposal.proposalRef)
|
||||
)
|
||||
)
|
||||
[Draft, VotingReady, Locked]
|
||||
, group "creator stake retract votes" $
|
||||
map
|
||||
( \ps ->
|
||||
validatorFailsWith
|
||||
(show ps)
|
||||
(proposalValidator Shared.proposal)
|
||||
( ProposalDatum
|
||||
{ proposalId = ProposalId 0
|
||||
, effects =
|
||||
AssocMap.fromList
|
||||
[ (ResultTag 0, AssocMap.empty)
|
||||
, (ResultTag 1, AssocMap.empty)
|
||||
]
|
||||
, status = ps
|
||||
, cosigners = [signer]
|
||||
, thresholds = def
|
||||
, votes =
|
||||
ProposalVotes
|
||||
( AssocMap.fromList
|
||||
[ (ResultTag 0, 42)
|
||||
, (ResultTag 1, 0)
|
||||
]
|
||||
)
|
||||
, timingConfig = def
|
||||
, startingTime = ProposalStartingTime 0
|
||||
}
|
||||
)
|
||||
(Unlock (ResultTag 0))
|
||||
( ScriptContext
|
||||
(Proposal.creatorRetractVotesWhile ps)
|
||||
(Spending Proposal.proposalRef)
|
||||
)
|
||||
)
|
||||
[Draft, VotingReady, Locked, Finished]
|
||||
]
|
||||
]
|
||||
[Draft, VotingReady, Locked, Finished]
|
||||
)
|
||||
[True, False]
|
||||
, group "unlock stake that has been used to create the proposal before finished" $
|
||||
map
|
||||
( \ps ->
|
||||
UnlockStake.mkProposalValidatorTestCase
|
||||
( UnlockStake.UnlockStakeParameters
|
||||
pc
|
||||
UnlockStake.Creator
|
||||
False
|
||||
ps
|
||||
)
|
||||
False
|
||||
)
|
||||
[Draft, VotingReady, Locked]
|
||||
, group "creator stake retract votes" $
|
||||
map
|
||||
( \ps ->
|
||||
UnlockStake.mkProposalValidatorTestCase
|
||||
( UnlockStake.UnlockStakeParameters
|
||||
pc
|
||||
UnlockStake.Creator
|
||||
True
|
||||
ps
|
||||
)
|
||||
False
|
||||
)
|
||||
[Draft, VotingReady, Locked, Finished]
|
||||
]
|
||||
]
|
||||
)
|
||||
[1, 25]
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -11,6 +11,8 @@ module Test.Util (
|
|||
datumPair,
|
||||
closedBoundedInterval,
|
||||
updateMap,
|
||||
sortMap,
|
||||
sortValue,
|
||||
) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -24,9 +26,12 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Data.Bifunctor (second)
|
||||
import Data.List (sortBy)
|
||||
import Plutarch.Crypto (pblake2b_256)
|
||||
import PlutusLedgerApi.V1.Interval as PlutusTx
|
||||
import PlutusLedgerApi.V1.Interval qualified as PlutusTx
|
||||
import PlutusLedgerApi.V1.Scripts (Datum (Datum), DatumHash (DatumHash))
|
||||
import PlutusLedgerApi.V1.Value (Value (..))
|
||||
import PlutusTx.AssocMap qualified as AssocMap
|
||||
import PlutusTx.Builtins qualified as PlutusTx
|
||||
import PlutusTx.IsData qualified as PlutusTx
|
||||
|
|
@ -84,3 +89,19 @@ updateMap f k =
|
|||
then f v
|
||||
else Just v
|
||||
)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
sortMap :: forall k v. Ord k => AssocMap.Map k v -> AssocMap.Map k v
|
||||
sortMap (AssocMap.toList -> l) =
|
||||
AssocMap.fromList $
|
||||
sortBy
|
||||
( \(k1, _)
|
||||
(k2, _) -> compare k1 k2
|
||||
)
|
||||
l
|
||||
|
||||
sortValue :: Value -> Value
|
||||
sortValue (AssocMap.toList . getValue -> l) =
|
||||
let innerSorted = second sortMap <$> l
|
||||
in Value $ sortMap $ AssocMap.fromList innerSorted
|
||||
|
|
|
|||
|
|
@ -182,6 +182,8 @@ library agora-specs
|
|||
Sample.Effect.TreasuryWithdrawal
|
||||
Sample.Governor
|
||||
Sample.Proposal
|
||||
Sample.Proposal.Shared
|
||||
Sample.Proposal.UnlockStake
|
||||
Sample.Shared
|
||||
Sample.Stake
|
||||
Sample.Treasury
|
||||
|
|
|
|||
12
bench.csv
12
bench.csv
|
|
@ -18,10 +18,14 @@ Agora/Proposal/validator/advancing/successfully advance to next state/Locked ->
|
|||
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,160888965,431112,6483
|
||||
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,159480054,428407,6484
|
||||
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,160611032,430811,6484
|
||||
Agora/Proposal/validator/unlocking/legal/retract votes and unlock stake while voting,171454676,461966,6556
|
||||
Agora/Proposal/validator/unlocking/legal/unlock the stake that has been used to create the proposal,149988973,407906,6563
|
||||
Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Locked,149056062,408201,6557
|
||||
Agora/Proposal/validator/unlocking/legal/unlock stake after voting/Finished,149056062,408201,6557
|
||||
"Agora/Proposal/validator/unlocking/1 proposals/legal/retract votes and unlock stake while voting/1 proposals, voter, unlock stake + retract votes, VotingReady",189052005,492891,6583
|
||||
"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock the stake that has been used to create the proposal/1 proposals, creator, unlock stake, Finished",167586302,438831,6587
|
||||
"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Finished",166653391,439126,6587
|
||||
"Agora/Proposal/validator/unlocking/1 proposals/legal/unlock stake after voting/1 proposals, voter, unlock stake, Locked",166653391,439126,6587
|
||||
"Agora/Proposal/validator/unlocking/25 proposals/legal/retract votes and unlock stake while voting/25 proposals, voter, unlock stake + retract votes, VotingReady",1105824237,3030675,19333
|
||||
"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock the stake that has been used to create the proposal/25 proposals, creator, unlock stake, Finished",935680982,2549151,19483
|
||||
"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Finished",934748071,2549446,19434
|
||||
"Agora/Proposal/validator/unlocking/25 proposals/legal/unlock stake after voting/25 proposals, voter, unlock stake, Locked",934748071,2549446,19434
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
|
||||
Agora/Treasury/Validator/Positive/Allows for effect changes,29938856,79744,1390
|
||||
|
|
|
|||
|
Loading…
Add table
Add a link
Reference in a new issue