diff --git a/agora-specs/Sample/Proposal.hs b/agora-specs/Sample/Proposal.hs index 23357c2..25c3fb4 100644 --- a/agora-specs/Sample/Proposal.hs +++ b/agora-specs/Sample/Proposal.hs @@ -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 diff --git a/agora-specs/Sample/Proposal/Shared.hs b/agora-specs/Sample/Proposal/Shared.hs new file mode 100644 index 0000000..1a2ee64 --- /dev/null +++ b/agora-specs/Sample/Proposal/Shared.hs @@ -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 diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs new file mode 100644 index 0000000..e961009 --- /dev/null +++ b/agora-specs/Sample/Proposal/UnlockStake.hs @@ -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 diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 579a8dc..9381eb5 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -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] ] ] diff --git a/agora-testlib/Test/Util.hs b/agora-testlib/Test/Util.hs index 50fb1e4..fdfcd98 100644 --- a/agora-testlib/Test/Util.hs +++ b/agora-testlib/Test/Util.hs @@ -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 diff --git a/agora.cabal b/agora.cabal index 7cf71c2..143f880 100644 --- a/agora.cabal +++ b/agora.cabal @@ -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 diff --git a/bench.csv b/bench.csv index e331364..1a3497e 100644 --- a/bench.csv +++ b/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