diff --git a/agora-specs/Sample/Proposal/Unlock.hs b/agora-specs/Sample/Proposal/Unlock.hs new file mode 100644 index 0000000..8eca632 --- /dev/null +++ b/agora-specs/Sample/Proposal/Unlock.hs @@ -0,0 +1,541 @@ +{- | +Module : Sample.Proposal.UnlockStake +Maintainer : connor@mlabs.city +Description: Generate sample data for testing the functionalities of unlocking stake and retracting votes + +Sample and utilities for testing the functionalities of unlocking stake and retracting votes +-} +module Sample.Proposal.Unlock ( + ParameterBundle (..), + StakeRole (..), + TimeRange (..), + SignedBy (..), + TransactionParameters (..), + ProposalParameters (..), + StakeParameters (..), + Validity (..), + unlock, + mkTestTree, + mkValidVoterRetractVotes, + mkValidDelegateeRetractVotes, + mkValidVoterCreatorRetractVotes, + mkValidCreatorRemoveLock, + mkValidVoterRemoveLockAfterVoting, + mkRetractVotesWhileNotVoting, + mkUnockIrrelevantStakes, + mkRemoveCreatorLockBeforeFinished, + mkCreatorRetractVotes, + mkChangeOutputStakeValue, +) where + +-------------------------------------------------------------------------------- + +import Agora.Governor (Governor (..)) +import Agora.Proposal ( + ProposalDatum (..), + ProposalEffectGroup, + ProposalId (..), + ProposalRedeemer (Unlock), + ProposalStatus (..), + ProposalVotes (..), + ResultTag (..), + ) +import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..)) +import Agora.Scripts (AgoraScripts (..)) +import Agora.Stake ( + ProposalLock (..), + StakeDatum (..), + StakeRedeemer (RetractVotes), + ) +import Data.Default.Class (Default (def)) +import Data.Map.Strict qualified as StrictMap +import Data.Tagged (Tagged (Tagged), untag) +import Plutarch.Context ( + input, + normalizeValue, + output, + script, + signedWith, + timeRange, + txId, + withDatum, + withRedeemer, + withRef, + withValue, + ) +import Plutarch.SafeMoney (Discrete (Discrete)) +import PlutusLedgerApi.V1.Value qualified as Value +import PlutusLedgerApi.V2 ( + Credential (PubKeyCredential), + PubKeyHash, + TxOutRef (..), + ) +import Sample.Proposal.Shared (stakeTxRef) +import Sample.Shared ( + agoraScripts, + governor, + minAda, + proposalPolicySymbol, + proposalValidatorHash, + stakeAssetClass, + stakeValidatorHash, + ) +import Test.Specification (SpecificationTree, group, testValidator) +import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes) + +-------------------------------------------------------------------------------- + +votesTemplate :: ProposalVotes +votesTemplate = + ProposalVotes $ + StrictMap.fromList + [ (ResultTag 0, 0) + , (ResultTag 1, 0) + ] + +-- | Create empty effects for every result tag given the votes. +emptyEffectFor :: + ProposalVotes -> + StrictMap.Map ResultTag ProposalEffectGroup +emptyEffectFor (ProposalVotes vs) = + StrictMap.fromList $ + map (,StrictMap.empty) (StrictMap.keys vs) + +-- | The default vote option that will be used by functions in this module. +defVoteFor :: ResultTag +defVoteFor = ResultTag 0 + +-- | The default number of GTs the stake will have. +defStakedGTs :: Integer +defStakedGTs = 100000 + +alteredStakedGTs :: Integer +alteredStakedGTs = 100 + +-- | Default owner of the stakes. +defOwner :: PubKeyHash +defOwner = pubKeyHashes !! 1 + +defDelegatee :: PubKeyHash +defDelegatee = pubKeyHashes !! 2 + +defUnknown :: PubKeyHash +defUnknown = pubKeyHashes !! 3 + +defProposalId :: ProposalId +defProposalId = ProposalId 0 + +defStartingTime :: ProposalStartingTime +defStartingTime = ProposalStartingTime 0 + +-------------------------------------------------------------------------------- + +data ParameterBundle = ParameterBundle + { proposalParameters :: ProposalParameters + , stakeParameters :: StakeParameters + , transactionParameters :: TransactionParameters + } + +data SignedBy = Owner | Delegatee | Unknown + +data TimeRange = WhileVoting | AfterVoting + +data TransactionParameters = TransactionParameters + { signedBy :: SignedBy + , timeRange :: TimeRange + } + +data ProposalParameters = ProposalParameters + { proposalStatus :: ProposalStatus + , retractVotes :: Bool + } + +-- | 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 create the proposal. + Creator + | -- | The stake was used to both create and vote for the proposal. + Both + | -- | The stake has nothing to do with the proposal. + Irrelevant + deriving stock (Bounded, Enum, Show) + +data StakeParameters = StakeParameters + { numStakes :: Integer + , stakeRole :: StakeRole + , removeVoterLock :: Bool + , removeCreatorLock :: Bool + , alterOutputValue :: Bool + } + +data Validity = Validity + { forProposalValidator :: Bool + , forStakeValidator :: Bool + } + +-------------------------------------------------------------------------------- + +mkStakeRef :: Integer -> TxOutRef +mkStakeRef = TxOutRef stakeTxRef + +stakeRedeemer :: StakeRedeemer +stakeRedeemer = RetractVotes + +mkStakeInputDatum :: StakeParameters -> StakeDatum +mkStakeInputDatum ps = + StakeDatum + { stakedAmount = Discrete $ Tagged defStakedGTs + , owner = PubKeyCredential defOwner + , delegatedTo = Just $ PubKeyCredential defDelegatee + , lockedBy = stakeLocks + } + where + stakeLocks = mkStakeLocks' ps.stakeRole + + mkStakeLocks' Voter = [Voted defProposalId defVoteFor] + mkStakeLocks' Creator = [Created defProposalId] + mkStakeLocks' Both = mkStakeLocks' Voter <> mkStakeLocks' Creator + mkStakeLocks' Irrelevant = + let ProposalId pid = defProposalId + ResultTag vid = defVoteFor + in [ Voted (ProposalId $ pid + 1) (ResultTag $ vid + 1) + , Created (ProposalId $ pid + 1) + ] + +-------------------------------------------------------------------------------- + +proposalRef :: TxOutRef +proposalRef = TxOutRef stakeTxRef 0 + +proposalRedeemer :: ProposalRedeemer +proposalRedeemer = Unlock + +mkProposalInputDatum :: + StakeParameters -> + ProposalParameters -> + ProposalDatum +mkProposalInputDatum sps pps = + ProposalDatum + { proposalId = defProposalId + , effects = emptyEffectFor votesTemplate + , status = pps.proposalStatus + , cosigners = [PubKeyCredential $ head pubKeyHashes] + , thresholds = def + , votes = updatVotes votesTemplate + , timingConfig = def + , startingTime = defStartingTime + } + where + updatVotes (ProposalVotes vt) = + ProposalVotes $ + StrictMap.adjust + (+ sps.numStakes * defStakedGTs) + defVoteFor + vt + +-------------------------------------------------------------------------------- + +unlock :: forall b. CombinableBuilder b => ParameterBundle -> b +unlock ps = builder + where + pst = Value.singleton proposalPolicySymbol "" 1 + + proposalInputDatum = + mkProposalInputDatum + ps.stakeParameters + ps.proposalParameters + + proposalOutputDatum = + if ps.proposalParameters.retractVotes + then proposalInputDatum {votes = votesTemplate} + else proposalInputDatum + + proposalValue = normalizeValue $ pst <> minAda + + proposalBuilder :: b + proposalBuilder = + mconcat + [ input $ + mconcat + [ script proposalValidatorHash + , withValue proposalValue + , withDatum proposalInputDatum + , withRef proposalRef + , withRedeemer proposalRedeemer + ] + , output $ + mconcat + [ script proposalValidatorHash + , withValue proposalValue + , withDatum proposalOutputDatum + ] + ] + + --- + + sst = Value.assetClassValue stakeAssetClass 1 + + stakeInputDatum = mkStakeInputDatum ps.stakeParameters + + removeLocks v c = + filter $ + not + . ( \case + Created pid -> c && pid == defProposalId + Voted pid _ -> v && pid == defProposalId + ) + + stakeOutputDatum = + stakeInputDatum + { lockedBy = + removeLocks + ps.stakeParameters.removeVoterLock + ps.stakeParameters.removeCreatorLock + stakeInputDatum.lockedBy + } + + mkStakeValue gt = + normalizeValue $ + mconcat + [ minAda + , sst + , Value.assetClassValue + (untag governor.gtClassRef) + gt + ] + + stakeInputValue = mkStakeValue defStakedGTs + + stakeOutputValue = + mkStakeValue $ + if ps.stakeParameters.alterOutputValue + then alteredStakedGTs + else defStakedGTs + + stakeBuilder :: b + stakeBuilder = + foldMap + ( \i -> + mconcat + [ input $ + mconcat + [ script stakeValidatorHash + , withValue stakeInputValue + , withDatum stakeInputDatum + , withRef $ mkStakeRef i + ] + , output $ + mconcat + [ script stakeValidatorHash + , withValue stakeOutputValue + , withDatum stakeOutputDatum + ] + ] + ) + [1 .. ps.stakeParameters.numStakes] + + --- + + time = case ps.transactionParameters.timeRange of + WhileVoting -> + closedBoundedInterval + ((def :: ProposalTimingConfig).draftTime + 1) + ((def :: ProposalTimingConfig).votingTime - 1) + AfterVoting -> + closedBoundedInterval + ((def :: ProposalTimingConfig).votingTime + 1) + ((def :: ProposalTimingConfig).lockingTime - 1) + + sig = case ps.transactionParameters.signedBy of + Unknown -> defUnknown + Owner -> defOwner + Delegatee -> defDelegatee + + --- + + builder = + mconcat + [ txId "388bc0b897b3dadcd479da4c88291de4113a50b72ddbed001faf7fc03f11bc52" + , proposalBuilder + , stakeBuilder + , signedWith sig + , timeRange time + ] + +-------------------------------------------------------------------------------- + +{- | Create a test tree that runs both the stake validator and the proposal + validator. +-} +mkTestTree :: String -> ParameterBundle -> Validity -> SpecificationTree +mkTestTree name ps val = group name [stake, proposal] + where + spend = mkSpending unlock ps + + stake = + testValidator + val.forStakeValidator + "stake" + agoraScripts.compiledStakeValidator + (mkStakeInputDatum ps.stakeParameters) + stakeRedeemer + (spend $ mkStakeRef 1) + + proposal = + testValidator + val.forProposalValidator + "proposal" + agoraScripts.compiledProposalValidator + (mkProposalInputDatum ps.stakeParameters ps.proposalParameters) + proposalRedeemer + (spend proposalRef) + +-------------------------------------------------------------------------------- + +mkValidVoterRetractVotes :: Integer -> ParameterBundle +mkValidVoterRetractVotes i = + ParameterBundle + { proposalParameters = + ProposalParameters + { proposalStatus = VotingReady + , retractVotes = True + } + , stakeParameters = + StakeParameters + { numStakes = i + , stakeRole = Voter + , removeVoterLock = True + , removeCreatorLock = False + , alterOutputValue = False + } + , transactionParameters = + TransactionParameters + { signedBy = Owner + , timeRange = + WhileVoting + } + } + +mkValidDelegateeRetractVotes :: Integer -> ParameterBundle +mkValidDelegateeRetractVotes i = + let template = mkValidVoterRetractVotes i + in template + { transactionParameters = + template.transactionParameters + { signedBy = Delegatee + } + } + +mkValidVoterCreatorRetractVotes :: Integer -> ParameterBundle +mkValidVoterCreatorRetractVotes i = + let template = mkValidVoterRetractVotes i + in template + { stakeParameters = + template.stakeParameters + { stakeRole = Both + } + } + +mkValidCreatorRemoveLock :: Integer -> ParameterBundle +mkValidCreatorRemoveLock i = + let template = mkValidVoterRetractVotes i + in template + { proposalParameters = + template.proposalParameters + { proposalStatus = Finished + , retractVotes = False + } + , stakeParameters = + template.stakeParameters + { stakeRole = Creator + , removeCreatorLock = True + } + , transactionParameters = + template.transactionParameters + { timeRange = AfterVoting + } + } + +mkValidVoterRemoveLockAfterVoting :: Integer -> ParameterBundle +mkValidVoterRemoveLockAfterVoting i = + let template = mkValidVoterRetractVotes i + in template + { proposalParameters = + template.proposalParameters + { proposalStatus = Finished + , retractVotes = False + } + , transactionParameters = + template.transactionParameters + { timeRange = AfterVoting + } + } + +mkRetractVotesWhileNotVoting :: Integer -> [ParameterBundle] +mkRetractVotesWhileNotVoting i = + let template = mkValidVoterRetractVotes i + in map + ( \s -> + template + { proposalParameters = + template.proposalParameters + { proposalStatus = s + } + } + ) + [Draft, Locked, Finished] + +mkUnockIrrelevantStakes :: Integer -> ParameterBundle +mkUnockIrrelevantStakes i = + let template = mkValidVoterRetractVotes i + in template + { stakeParameters = + template.stakeParameters + { stakeRole = Irrelevant + , removeCreatorLock = True + } + } + +mkRemoveCreatorLockBeforeFinished :: Integer -> [ParameterBundle] +mkRemoveCreatorLockBeforeFinished i = + let template = mkValidCreatorRemoveLock i + in map + ( \s -> + template + { proposalParameters = + template.proposalParameters + { proposalStatus = s + } + } + ) + [Draft, VotingReady, Locked] + +mkCreatorRetractVotes :: Integer -> ParameterBundle +mkCreatorRetractVotes i = + let template = mkValidVoterRetractVotes i + in template + { proposalParameters = + template.proposalParameters + { proposalStatus = VotingReady + } + , stakeParameters = + template.stakeParameters + { stakeRole = Creator + } + , transactionParameters = + template.transactionParameters + { timeRange = WhileVoting + } + } + +mkChangeOutputStakeValue :: Integer -> ParameterBundle +mkChangeOutputStakeValue i = + let template = mkValidVoterRetractVotes i + in template + { stakeParameters = + template.stakeParameters + { alterOutputValue = True + } + } diff --git a/agora-specs/Sample/Proposal/UnlockStake.hs b/agora-specs/Sample/Proposal/UnlockStake.hs deleted file mode 100644 index 510de7c..0000000 --- a/agora-specs/Sample/Proposal/UnlockStake.hs +++ /dev/null @@ -1,559 +0,0 @@ -{- | -Module : Sample.Proposal.UnlockStake -Maintainer : connor@mlabs.city -Description: Generate sample data for testing the functionalities of unlocking stake and retracting votes - -Sample and utilities for testing the functionalities of unlocking stake and retracting votes --} -module Sample.Proposal.UnlockStake ( - StakeRole (..), - Parameters (..), - unlockStake, - mkTestTree, - mkVoterRetractVotesWhileVotingParameters, - mkVoterCreatorRetractVotesWhileVotingParameters, - mkCreatorRemoveCreatorLocksWhenFinishedParameters, - mkVoterCreatorRemoveAllLocksWhenFinishedParameters, - mkVoterUnlockStakeAfterVotingParameters, - mkVoterCreatorRemoveVoteLocksWhenLockedParameters, - mkRetractVotesWhileNotVoting, - mkUnockIrrelevantStakeParameters, - mkRemoveCreatorLockBeforeFinishedParameters, - mkRetractVotesWithCreatorStakeParamaters, - mkAlterStakeParameters, -) where - --------------------------------------------------------------------------------- - -import Agora.Governor (Governor (..)) -import Agora.Proposal ( - ProposalDatum (..), - ProposalEffectGroup, - ProposalId (..), - ProposalRedeemer (Unlock), - ProposalStatus (..), - ProposalVotes (..), - ResultTag (..), - ) -import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime)) -import Agora.SafeMoney (GTTag) -import Agora.Scripts (AgoraScripts (..)) -import Agora.Stake ( - ProposalLock (..), - StakeDatum (..), - StakeRedeemer (RetractVotes), - ) -import Data.Default.Class (Default (def)) -import Data.Map.Strict qualified as StrictMap -import Data.Tagged (untag) -import Plutarch.Context ( - input, - output, - script, - signedWith, - txId, - withDatum, - withRedeemer, - withRef, - withValue, - ) -import Plutarch.SafeMoney (Discrete) -import PlutusLedgerApi.V1.Value qualified as Value -import PlutusLedgerApi.V2 ( - Credential (PubKeyCredential), - PubKeyHash, - TxOutRef (..), - ) -import Sample.Proposal.Shared (stakeTxRef) -import Sample.Shared ( - agoraScripts, - fromDiscrete, - governor, - minAda, - proposalPolicySymbol, - proposalValidatorHash, - signer, - stakeAssetClass, - stakeValidatorHash, - ) -import Test.Specification (SpecificationTree, group, testValidator) -import Test.Util (CombinableBuilder, mkSpending, sortValue) - --------------------------------------------------------------------------------- - --- | The template "shape" that votes of proposals generated by 'mkProposalDatumPair' have. -votesTemplate :: ProposalVotes -votesTemplate = - ProposalVotes $ - StrictMap.fromList - [ (ResultTag 0, 0) - , (ResultTag 1, 0) - ] - --- | Create empty effects for every result tag given the votes. -emptyEffectFor :: - ProposalVotes -> - StrictMap.Map ResultTag ProposalEffectGroup -emptyEffectFor (ProposalVotes vs) = - StrictMap.fromList $ - map (,StrictMap.empty) (StrictMap.keys vs) - --- | The default vote option that will be used by functions in this module. -defVoteFor :: ResultTag -defVoteFor = ResultTag 0 - --- | The default number of GTs the stake will have. -defStakedGTs :: Discrete GTTag -defStakedGTs = 100000 - -{- | If 'Parameters.alterOutputStake' is set to true, the - 'StakeDatum.stakedAmount' will be set to this. --} -alteredStakedGTs :: Discrete GTTag -alteredStakedGTs = 100 - --- | Default owner of the stakes. -defOwner :: PubKeyHash -defOwner = signer - --- | 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 create the proposal. - Creator - | -- | The stake was used to both create and vote for the proposal. - Both - | -- | The stake has nothing to do with the proposal. - Irrelevant - deriving stock (Bounded, Enum, Show) - --- | Parameters for creating a 'TxOut' that unlocks a stake. -data Parameters = Parameters - { proposalCount :: Integer - -- ^ The number of proposals in the 'TxOut'. - , stakeRole :: StakeRole - -- ^ The role of the stake we're unlocking. - , retractVotes :: Bool - -- ^ Whether to retract votes or not. - , removeVoterLock :: Bool - -- ^ Remove the voter locks from the input stake. - , removeCreatorLock :: Bool - -- ^ Remove the creator locks from the input stake. - , proposalStatus :: ProposalStatus - -- ^ The state of all the proposals. - , alterOutputStake :: Bool - } - --- | Iterate over the proposal id of every proposal, given the number of proposals. -forEachProposalId :: Parameters -> (ProposalId -> a) -> [a] -forEachProposalId ps = forEachProposalId' ps.proposalCount - where - forEachProposalId' :: Integer -> (ProposalId -> a) -> [a] - forEachProposalId' 0 _ = error "zero proposal" - forEachProposalId' n f = f . ProposalId <$> [0 .. n - 1] - --- | Create locks for the input stake given the parameters. -mkInputStakeLocks :: Parameters -> [ProposalLock] -mkInputStakeLocks ps = mconcat $ forEachProposalId ps $ mkStakeLocksFor ps.stakeRole - where - mkStakeLocksFor :: StakeRole -> ProposalId -> [ProposalLock] - mkStakeLocksFor sr pid = - let voted = [Voted pid defVoteFor] - created = [Created pid] - in case sr of - Voter -> voted - Creator -> created - Both -> voted <> created - _ -> [] - --- | Create locks for the output stake by removing locks from the input locks. -mkOutputStakeLocks :: Parameters -> [ProposalLock] -mkOutputStakeLocks ps = - filter - ( \lock -> not $ case lock of - Voted _ _ -> ps.removeVoterLock - Created _ -> ps.removeCreatorLock - ) - inputLocks - where - inputLocks = mkInputStakeLocks ps - --- | Create the stake input datum given the parameters. -mkStakeInputDatum :: Parameters -> StakeDatum -mkStakeInputDatum ps = - StakeDatum - { stakedAmount = defStakedGTs - , owner = PubKeyCredential defOwner - , delegatedTo = Nothing - , lockedBy = mkInputStakeLocks ps - } - --- | Create stake output datum given the parameters. -mkStakeOutputDatum :: Parameters -> StakeDatum -mkStakeOutputDatum ps = - let template = mkStakeInputDatum ps - stakedAmount' = - if ps.alterOutputStake - then alteredStakedGTs - else defStakedGTs - in template - { stakedAmount = stakedAmount' - , lockedBy = mkOutputStakeLocks ps - } - --- | Generate some input proposals and their corresponding output proposals. -mkProposals :: Parameters -> [(ProposalDatum, ProposalDatum)] -mkProposals ps = forEachProposalId ps $ mkProposalDatumPair ps - --- | Create the input proposal datum. -mkProposalInputDatum :: Parameters -> ProposalId -> ProposalDatum -mkProposalInputDatum p pid = fst $ mkProposalDatumPair p pid - --- | Create a input proposal and its corresponding output proposal. -mkProposalDatumPair :: - Parameters -> - ProposalId -> - (ProposalDatum, ProposalDatum) -mkProposalDatumPair params pid = - let inputVotes = mkInputVotes params.stakeRole $ fromDiscrete defStakedGTs - - input = - ProposalDatum - { proposalId = pid - , effects = emptyEffectFor votesTemplate - , status = params.proposalStatus - , cosigners = [PubKeyCredential defOwner] - , 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 Creator _ = - ProposalVotes $ - StrictMap.adjust (const 1000) defVoteFor $ - votesTemplate.getProposalVotes - mkInputVotes Irrelevant _ = votesTemplate - mkInputVotes _ vc = - ProposalVotes $ - StrictMap.adjust (const vc) defVoteFor $ - votesTemplate.getProposalVotes - --- | Create a 'TxInfo' that tries to unlock a stake. -unlockStake :: forall b. CombinableBuilder b => Parameters -> b -unlockStake ps = - let pst = Value.singleton proposalPolicySymbol "" 1 - sst = Value.assetClassValue stakeAssetClass 1 - - pIODatums = mkProposals ps - - proposals = - foldMap - ( \((i, o), idx) -> - mconcat - [ input $ - mconcat - [ script proposalValidatorHash - , withValue pst - , withDatum i - , withRef (mkProposalRef idx) - , withRedeemer proposalRedeemer - ] - , output $ - mconcat - [ script proposalValidatorHash - , withValue (sortValue $ pst <> minAda) - , withDatum o - ] - ] - ) - (zip pIODatums [0 ..]) - - stakeValue = - sortValue $ - mconcat - [ Value.assetClassValue - (untag governor.gtClassRef) - (fromDiscrete defStakedGTs) - , sst - , minAda - ] - - sInDatum = mkStakeInputDatum ps - sOutDatum = mkStakeOutputDatum ps - - stakes = - mconcat - [ input $ - mconcat - [ script stakeValidatorHash - , withValue stakeValue - , withDatum sInDatum - , withRef stakeRef - ] - , output $ - mconcat - [ script stakeValidatorHash - , withValue stakeValue - , withDatum sOutDatum - ] - ] - - builder = - mconcat - [ txId "388bc0b897b3dadcd479da4c88291de4113a50b72ddbed001faf7fc03f11bc52" - , proposals - , stakes - , signedWith defOwner - ] - in builder - --- | Reference to the stake UTXO. -stakeRef :: TxOutRef -stakeRef = TxOutRef stakeTxRef 1 - --- | Generate the reference to a proposal UTXOs, given the index of the proposal. -mkProposalRef :: Int -> TxOutRef -mkProposalRef offset = TxOutRef stakeTxRef $ 2 + fromIntegral offset - --- | Proposal redeemer used by 'mkTestTree', in this case it's always 'Unlock'. -proposalRedeemer :: ProposalRedeemer -proposalRedeemer = Unlock - --- | Stake redeemer used by 'mkTestTree', in this case it's always 'RetractVotes'. -stakeRedeemer :: StakeRedeemer -stakeRedeemer = RetractVotes - --------------------------------------------------------------------------------- - -{- | Legal parameters that retract votes while the proposals is in 'VotingReady' - state, and also remove voter locks from the stake, which is - used to vote on the proposals. --} -mkVoterRetractVotesWhileVotingParameters :: Integer -> Parameters -mkVoterRetractVotesWhileVotingParameters nProposals = - Parameters - { proposalCount = nProposals - , stakeRole = Voter - , retractVotes = True - , removeVoterLock = True - , removeCreatorLock = False - , proposalStatus = VotingReady - , alterOutputStake = False - } - -{- | Legal parameters that retract votes while the proposals is in 'VotingReady' - state, and also remove voter locks from the stake, which is - used to both create and vote on the proposals. --} -mkVoterCreatorRetractVotesWhileVotingParameters :: Integer -> Parameters -mkVoterCreatorRetractVotesWhileVotingParameters nProposals = - Parameters - { proposalCount = nProposals - , stakeRole = Both - , retractVotes = True - , removeVoterLock = True - , removeCreatorLock = False - , proposalStatus = VotingReady - , alterOutputStake = False - } - -{- | Legal parameters that remove creator locks from the stake while the - proposals is in 'Finished' state. The stake was only used for creating - the proposals. --} -mkCreatorRemoveCreatorLocksWhenFinishedParameters :: Integer -> Parameters -mkCreatorRemoveCreatorLocksWhenFinishedParameters nProposals = - Parameters - { proposalCount = nProposals - , stakeRole = Creator - , retractVotes = False - , removeVoterLock = False - , removeCreatorLock = True - , proposalStatus = Finished - , alterOutputStake = False - } - -{- | Legal parameters that remove voter and creator locks from the stake while - the proposals is in 'Finished' state. The stake was used for creating - and voting on the proposals. --} -mkVoterCreatorRemoveAllLocksWhenFinishedParameters :: Integer -> Parameters -mkVoterCreatorRemoveAllLocksWhenFinishedParameters nProposals = - Parameters - { proposalCount = nProposals - , stakeRole = Both - , retractVotes = False - , removeVoterLock = True - , removeCreatorLock = True - , proposalStatus = Finished - , alterOutputStake = False - } - -{- Legal parameters that remove voter locks from the stake after the voting - phrase. The stake was used only for voting on the proposals. --} -mkVoterUnlockStakeAfterVotingParameters :: Integer -> [Parameters] -mkVoterUnlockStakeAfterVotingParameters nProposals = - map - ( \st -> - Parameters - { proposalCount = nProposals - , stakeRole = Voter - , retractVotes = False - , removeVoterLock = True - , removeCreatorLock = False - , proposalStatus = st - , alterOutputStake = False - } - ) - [Locked, Finished] - -{- Legal parameters that remove voter locks whenproposals are in phrase. - The stake was used for crating and voting on the proposals. --} -mkVoterCreatorRemoveVoteLocksWhenLockedParameters :: Integer -> Parameters -mkVoterCreatorRemoveVoteLocksWhenLockedParameters nProposals = - Parameters - { proposalCount = nProposals - , stakeRole = Both - , retractVotes = False - , removeVoterLock = True - , removeCreatorLock = False - , proposalStatus = Locked - , alterOutputStake = False - } - -{- | Illegal parameters that retract votes when the proposals are not in voting - phrase. --} -mkRetractVotesWhileNotVoting :: Integer -> [Parameters] -mkRetractVotesWhileNotVoting nProposals = do - role <- enumFrom Voter - status <- [Draft, Locked, Finished] - - pure $ - Parameters - { proposalCount = nProposals - , stakeRole = role - , retractVotes = True - , removeVoterLock = True - , removeCreatorLock = False - , proposalStatus = status - , alterOutputStake = False - } - -{- | Illegal parameter that try to unlock a stake that has nothing to do with - the proposals. --} -mkUnockIrrelevantStakeParameters :: Integer -> [Parameters] -mkUnockIrrelevantStakeParameters nProposals = do - status <- [Draft, VotingReady, Locked, Finished] - retractVotes <- [True, False] - - pure $ - Parameters - { proposalCount = nProposals - , stakeRole = Irrelevant - , retractVotes = retractVotes - , removeVoterLock = True - , removeCreatorLock = True - , proposalStatus = status - , alterOutputStake = False - } - -{- | Illegal parameters that remove the creator locks before the proposals are - 'Finished'. --} -mkRemoveCreatorLockBeforeFinishedParameters :: Integer -> [Parameters] -mkRemoveCreatorLockBeforeFinishedParameters nProposals = do - status <- [Draft, VotingReady, Locked] - - pure $ - Parameters - { proposalCount = nProposals - , stakeRole = Creator - , retractVotes = False - , removeVoterLock = False - , removeCreatorLock = True - , proposalStatus = status - , alterOutputStake = False - } - -{- | Illegal parameters that try to retract votes with a stake that was only used - for creating the proposals. --} -mkRetractVotesWithCreatorStakeParamaters :: Integer -> Parameters -mkRetractVotesWithCreatorStakeParamaters nProposals = - Parameters - { proposalCount = nProposals - , stakeRole = Creator - , retractVotes = True - , removeVoterLock = True - , removeCreatorLock = True - , proposalStatus = VotingReady - , alterOutputStake = False - } - -{- | Illegal parameters that try to change the 'StakeDatum.stakedAmount' field of - the output stake datum. --} -mkAlterStakeParameters :: Integer -> [Parameters] -mkAlterStakeParameters nProposals = do - role <- enumFrom Voter - status <- [Draft, Locked, Finished] - - pure $ - Parameters - { proposalCount = nProposals - , stakeRole = role - , retractVotes = True - , removeVoterLock = True - , removeCreatorLock = False - , proposalStatus = status - , alterOutputStake = True - } - --------------------------------------------------------------------------------- - -{- | Create a test tree that runs both the stake validator and the proposal - validator. --} -mkTestTree :: String -> Parameters -> Bool -> SpecificationTree -mkTestTree name ps isValid = group name [stake, proposal] - where - spend = mkSpending unlockStake ps - - stake = - testValidator - (not ps.alterOutputStake) - "stake" - agoraScripts.compiledStakeValidator - (mkStakeInputDatum ps) - stakeRedeemer - (spend stakeRef) - - proposal = - let idx = 0 - pid = ProposalId $ fromIntegral idx - ref = mkProposalRef idx - in testValidator - isValid - "proposal" - agoraScripts.compiledProposalValidator - (mkProposalInputDatum ps pid) - proposalRedeemer - (spend ref) diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 4a30c7f..564a130 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -10,10 +10,9 @@ module Spec.Proposal (specs) where import Sample.Proposal.Advance qualified as Advance import Sample.Proposal.Cosign qualified as Cosign import Sample.Proposal.Create qualified as Create -import Sample.Proposal.UnlockStake qualified as UnlockStake +import Sample.Proposal.Unlock qualified as Unlock import Sample.Proposal.Vote qualified as Vote --- import Sample.Proposal.UnlockStake qualified as UnlockStake import Test.Specification ( SpecificationTree, group, @@ -324,103 +323,72 @@ specs = ] ] , group "unlocking" $ - let proposalCountCases = [1, 5, 10, 42] + let stakeCountCases = [1, 3, 5, 7, 9, 11] - mkSubgroupName nProposals = unwords ["with", show nProposals, "proposals"] + mkSubgroupName nStakes = unwords ["with", show nStakes, "stakes"] - mkLegalGroup nProposals = + mkLegalGroup nStakes = group - (mkSubgroupName nProposals) - [ UnlockStake.mkTestTree + (mkSubgroupName nStakes) + [ Unlock.mkTestTree "voter: retract votes while voting" - (UnlockStake.mkVoterRetractVotesWhileVotingParameters nProposals) - True - , UnlockStake.mkTestTree + (Unlock.mkValidVoterRetractVotes nStakes) + (Unlock.Validity True True) + , Unlock.mkTestTree + "voter: retract votes while voting by delegatee" + (Unlock.mkValidDelegateeRetractVotes nStakes) + (Unlock.Validity True True) + , Unlock.mkTestTree "voter/creator: retract votes while voting" - (UnlockStake.mkVoterCreatorRetractVotesWhileVotingParameters nProposals) - True - , UnlockStake.mkTestTree - "creator: remove creator locks when finished" - (UnlockStake.mkCreatorRemoveCreatorLocksWhenFinishedParameters nProposals) - True - , UnlockStake.mkTestTree - "voter/creator: remove all locks when finished" - (UnlockStake.mkVoterCreatorRemoveAllLocksWhenFinishedParameters nProposals) - True - , group "voter: unlock after voting" $ - map - ( \ps -> - let name = show ps.proposalStatus - in UnlockStake.mkTestTree name ps True - ) - (UnlockStake.mkVoterUnlockStakeAfterVotingParameters nProposals) - , UnlockStake.mkTestTree - "voter/creator: remove vote locks when locked" - (UnlockStake.mkVoterCreatorRemoveVoteLocksWhenLockedParameters nProposals) - True + (Unlock.mkValidVoterCreatorRetractVotes nStakes) + (Unlock.Validity True True) + , Unlock.mkTestTree + "creator: remove creator lock after voting" + (Unlock.mkValidCreatorRemoveLock nStakes) + (Unlock.Validity True True) + , Unlock.mkTestTree + "Voter: remove lock after voting" + (Unlock.mkValidVoterRemoveLockAfterVoting nStakes) + (Unlock.Validity True True) ] - mkIllegalGroup nProposals = + mkIllegalGroup nStakes = group - (mkSubgroupName nProposals) + (mkSubgroupName nStakes) [ group "retract votes while not voting" $ map - ( \ps -> - let name = - unwords - [ "role:" - , show ps.stakeRole - , "," - , "status:" - , show ps.proposalStatus - ] - in UnlockStake.mkTestTree name ps False + ( \c -> + Unlock.mkTestTree + "(negative test)" + c + (Unlock.Validity False True) ) - (UnlockStake.mkRetractVotesWhileNotVoting nProposals) - , group "unlock an irrelevant stake" $ - map - ( \ps -> - let name = - unwords - [ "status:" - , show ps.proposalStatus - , "retract votes:" - , show ps.retractVotes - ] - in UnlockStake.mkTestTree name ps False - ) - (UnlockStake.mkUnockIrrelevantStakeParameters nProposals) + (Unlock.mkRetractVotesWhileNotVoting nStakes) , group "remove creator too early" $ map - ( \ps -> - let name = - unwords - ["status:", show ps.proposalStatus] - in UnlockStake.mkTestTree name ps False + ( \c -> + Unlock.mkTestTree + "(negative test)" + c + (Unlock.Validity True False) ) - (UnlockStake.mkRemoveCreatorLockBeforeFinishedParameters nProposals) - , UnlockStake.mkTestTree + (Unlock.mkRemoveCreatorLockBeforeFinished nStakes) + , Unlock.mkTestTree + "unlock an irrelevant stake" + (Unlock.mkUnockIrrelevantStakes nStakes) + (Unlock.Validity False True) + , Unlock.mkTestTree "creator: retract votes" - (UnlockStake.mkRetractVotesWithCreatorStakeParamaters nProposals) - False - , group "alter output stake datum" $ - map - ( \ps -> - let name = - unwords - [ "role:" - , show ps.stakeRole - , "," - , "status:" - , show ps.proposalStatus - ] - in UnlockStake.mkTestTree name ps False - ) - (UnlockStake.mkAlterStakeParameters nProposals) + (Unlock.mkCreatorRetractVotes nStakes) + (Unlock.Validity False True) + , Unlock.mkTestTree + "change output stake value" + (Unlock.mkChangeOutputStakeValue nStakes) + (Unlock.Validity True False) ] - legalGroup = group "legal" $ map mkLegalGroup proposalCountCases - illegalGroup = group "illegal" $ map mkIllegalGroup proposalCountCases + legalGroup = group "legal" $ map mkLegalGroup stakeCountCases + illegalGroup = group "illegal" $ map mkIllegalGroup stakeCountCases in [legalGroup, illegalGroup] ] ] diff --git a/agora.cabal b/agora.cabal index ef56307..717cf1c 100644 --- a/agora.cabal +++ b/agora.cabal @@ -198,7 +198,7 @@ library agora-specs Sample.Proposal.Cosign Sample.Proposal.Create Sample.Proposal.Shared - Sample.Proposal.UnlockStake + Sample.Proposal.Unlock Sample.Proposal.Vote Sample.Shared Sample.Stake