diff --git a/agora-specs/Property/Governor.hs b/agora-specs/Property/Governor.hs index 1c85e6e..cbd9a08 100644 --- a/agora-specs/Property/Governor.hs +++ b/agora-specs/Property/Governor.hs @@ -121,7 +121,7 @@ governorDatumValidProperty = genDatumForCase c = do thres <- genProposalThresholds c - let timing = ProposalTimingConfig 0 0 0 0 + let timing = ProposalTimingConfig 0 0 0 0 0 0 pure $ GovernorDatum thres (ProposalId 0) timing (MaxTimeRangeWidth 1) 3 where diff --git a/agora-specs/Sample/Governor/Initialize.hs b/agora-specs/Sample/Governor/Initialize.hs index ec7cce6..1855935 100644 --- a/agora-specs/Sample/Governor/Initialize.hs +++ b/agora-specs/Sample/Governor/Initialize.hs @@ -106,7 +106,7 @@ invalidMaxTimeRangeWidth :: MaxTimeRangeWidth invalidMaxTimeRangeWidth = MaxTimeRangeWidth 0 invalidProposalTimings :: ProposalTimingConfig -invalidProposalTimings = ProposalTimingConfig (-1) (-1) (-1) (-1) +invalidProposalTimings = ProposalTimingConfig (-1) (-1) (-1) (-1) (-1) (-1) witnessRef :: TxOutRef witnessRef = TxOutRef "b0353c22b0bd6c5296a8eef160ba25d90b5dc82a9bb8bdaa6823ffc19515d6ad" 0 diff --git a/agora-specs/Sample/Proposal/Cosign.hs b/agora-specs/Sample/Proposal/Cosign.hs index 7ea6601..44bc01e 100644 --- a/agora-specs/Sample/Proposal/Cosign.hs +++ b/agora-specs/Sample/Proposal/Cosign.hs @@ -40,7 +40,8 @@ import Agora.Proposal.Time ( ) import Agora.SafeMoney (GTTag) import Agora.Stake ( - ProposalLock (Cosigned, Created), + ProposalAction (Cosigned, Created), + ProposalLock (ProposalLock), StakeDatum (..), StakeRedeemer (PermitVote), ) @@ -196,7 +197,7 @@ mkStakeInputDatum ps = amount = mkStakeAmount sps.gtAmount owner = mkStakeOwner sps.stakeOwner locks = case sps.stakeOwner of - Creator -> [Created defProposalId] + Creator -> [ProposalLock defProposalId Created] _ -> [] in StakeDatum { stakedAmount = amount @@ -212,7 +213,7 @@ mkStakeOuputDatum ps = locks = if sps.dontUpdateLocks then inpDatum.lockedBy - else Cosigned defProposalId : inpDatum.lockedBy + else ProposalLock defProposalId Cosigned : inpDatum.lockedBy in inpDatum {lockedBy = locks} stakeRedeemer :: StakeRedeemer diff --git a/agora-specs/Sample/Proposal/Create.hs b/agora-specs/Sample/Proposal/Create.hs index 04d4486..bcd49df 100644 --- a/agora-specs/Sample/Proposal/Create.hs +++ b/agora-specs/Sample/Proposal/Create.hs @@ -47,7 +47,8 @@ import Agora.Proposal.Time ( ) import Agora.SafeMoney (GTTag) import Agora.Stake ( - ProposalLock (..), + ProposalAction (Created, Voted), + ProposalLock (ProposalLock), StakeDatum (..), StakeRedeemer (PermitVote), ) @@ -160,7 +161,7 @@ alteredStakeOwner = PubKeyCredential signer2 -- | Locks the stake that the input stake already has. defLocks :: [ProposalLock] -defLocks = [Created (ProposalId 0)] +defLocks = [ProposalLock (ProposalId 0) Created] -- | The effect of the newly created proposal. defEffects :: StrictMap.Map ResultTag ProposalEffectGroup @@ -207,7 +208,7 @@ mkStakeInputDatum ps = let locks = if ps.createdMoreThanMaximumProposals then - Created . ProposalId + flip ProposalLock Created . ProposalId <$> take (fromInteger maxProposalPerStake) [1 ..] @@ -226,10 +227,10 @@ mkStakeOutputDatum ps = newLocks = if ps.invalidNewLocks then - [ Voted thisProposalId (ResultTag 0) - , Voted thisProposalId (ResultTag 1) + [ ProposalLock thisProposalId $ Voted (ResultTag 0) 100 + , ProposalLock thisProposalId $ Voted (ResultTag 1) 100 ] - else [Created thisProposalId] + else [ProposalLock thisProposalId Created] locks = newLocks <> inputDatum.lockedBy newOwner = mkOwner ps in inputDatum diff --git a/agora-specs/Sample/Proposal/PrivilegeEscalate.hs b/agora-specs/Sample/Proposal/PrivilegeEscalate.hs index 2c305de..157e609 100644 --- a/agora-specs/Sample/Proposal/PrivilegeEscalate.hs +++ b/agora-specs/Sample/Proposal/PrivilegeEscalate.hs @@ -20,9 +20,10 @@ import Agora.Proposal.Time ( ) import Agora.SafeMoney (GTTag) import Agora.Stake ( - ProposalLock ( + ProposalAction ( Voted ), + ProposalLock (ProposalLock), StakeDatum (..), StakeRedeemer (PermitVote, RetractVotes), ) @@ -128,8 +129,19 @@ mkStakeInputOutputDatums op = allStakes = take 10 $ firstStake : otherStakes + createdAt = (def :: ProposalTimingConfig).votingTime - 1 + stakeWithLock = - (\stake -> stake {lockedBy = [Voted defProposalId defResultTag]}) + ( \stake -> + stake + { lockedBy = + [ ProposalLock defProposalId $ + Voted + defResultTag + createdAt + ] + } + ) <$> allStakes in wrap op (,) allStakes stakeWithLock diff --git a/agora-specs/Sample/Proposal/Unlock.hs b/agora-specs/Sample/Proposal/Unlock.hs index 9186952..7e86ef1 100644 --- a/agora-specs/Sample/Proposal/Unlock.hs +++ b/agora-specs/Sample/Proposal/Unlock.hs @@ -28,6 +28,7 @@ module Sample.Proposal.Unlock ( mkCreatorRetractVotes, mkChangeOutputStakeValue, mkUseFakeStakes, + mkDisrespectCooldown, ) where -------------------------------------------------------------------------------- @@ -42,13 +43,18 @@ import Agora.Proposal ( ProposalVotes (..), ResultTag (..), ) -import Agora.Proposal.Time (ProposalStartingTime (ProposalStartingTime), ProposalTimingConfig (..)) +import Agora.Proposal.Time ( + ProposalStartingTime (ProposalStartingTime), + ProposalTimingConfig (..), + ) import Agora.SafeMoney (GTTag) import Agora.Stake ( + ProposalAction (Created, Voted), ProposalLock (..), StakeDatum (..), StakeRedeemer (RetractVotes), ) +import Data.Coerce (coerce) import Data.Default.Class (Default (def)) import Data.Map.Strict qualified as StrictMap import Data.Tagged (Tagged, untag) @@ -70,6 +76,7 @@ import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V2 ( Credential (PubKeyCredential), + POSIXTime, PubKeyHash, TxOutRef (..), ) @@ -142,7 +149,7 @@ data ParameterBundle = ParameterBundle data SignedBy = Owner | Delegatee | Unknown -data TimeRange = WhileVoting | AfterVoting +data TimeRange = WhileVoting {offset :: POSIXTime} | AfterVoting data TransactionParameters = TransactionParameters { signedBy :: SignedBy @@ -177,6 +184,7 @@ data StakeParameters = StakeParameters , removeCreatorLock :: Bool , alterOutputValue :: Bool , sstOwner :: SSTOwner + , votingLockCreatedAt :: POSIXTime } data Validity = Validity @@ -203,14 +211,20 @@ mkStakeInputDatum ps = where stakeLocks = mkStakeLocks' ps.stakeRole - mkStakeLocks' Voter = [Voted defProposalId defVoteFor] - mkStakeLocks' Creator = [Created defProposalId] + mkStakeLocks' Voter = + [ ProposalLock defProposalId $ + Voted defVoteFor ps.votingLockCreatedAt + ] + mkStakeLocks' Creator = [ProposalLock defProposalId Created] 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) + in [ ProposalLock (ProposalId $ pid + 1) $ + Voted + (ResultTag $ vid + 1) + ps.votingLockCreatedAt + , ProposalLock (ProposalId $ pid + 1) Created ] -------------------------------------------------------------------------------- @@ -292,14 +306,13 @@ unlock ps = builder stakeInputDatum = mkStakeInputDatum ps.stakeParameters + -- TODO respect timing removeLocks v c = - filter $ - not - . ( \case - Created pid -> c && pid == defProposalId - Cosigned pid -> c && pid == defProposalId - Voted pid _ -> v && pid == defProposalId - ) + filter $ \(ProposalLock pid action) -> + pid == defProposalId + && case action of + Voted _ _ -> v + _ -> c stakeOutputDatum = stakeInputDatum @@ -355,9 +368,14 @@ unlock ps = builder ProposalStartingTime s = defStartingTime time = case ps.transactionParameters.timeRange of - WhileVoting -> - let lb = s + (def :: ProposalTimingConfig).draftTime - ub = lb + (def :: ProposalTimingConfig).votingTime + WhileVoting offset -> + let lb = + ps.stakeParameters.votingLockCreatedAt + + offset + ub = + s + + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime in closedBoundedInterval (lb + 1) (ub - 1) AfterVoting -> let lb = @@ -429,12 +447,21 @@ mkValidVoterRetractVotes i = , removeCreatorLock = False , alterOutputValue = False , sstOwner = StakeValidator + , votingLockCreatedAt = + coerce defStartingTime + + (def :: ProposalTimingConfig).draftTime + + 1 } , transactionParameters = TransactionParameters { signedBy = Owner , timeRange = WhileVoting + { offset = + coerce + (def :: ProposalTimingConfig).minStakeVotingTime + + 5 + } } } @@ -544,10 +571,6 @@ mkCreatorRetractVotes i = template.stakeParameters { stakeRole = Creator } - , transactionParameters = - template.transactionParameters - { timeRange = WhileVoting - } } mkChangeOutputStakeValue :: Integer -> ParameterBundle @@ -569,3 +592,19 @@ mkUseFakeStakes i = { sstOwner = Attacker } } + +mkDisrespectCooldown :: Integer -> ParameterBundle +mkDisrespectCooldown i = + let template = mkValidVoterCreatorRetractVotes i + in template + { transactionParameters = + template.transactionParameters + { timeRange = + WhileVoting + { offset = + coerce + (def :: ProposalTimingConfig).minStakeVotingTime + - 5 + } + } + } diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs index 8c950d4..576e190 100644 --- a/agora-specs/Sample/Proposal/Vote.hs +++ b/agora-specs/Sample/Proposal/Vote.hs @@ -46,7 +46,8 @@ import Agora.Proposal.Time ( ) import Agora.SafeMoney (GTTag) import Agora.Stake ( - ProposalLock (Voted), + ProposalAction (Voted), + ProposalLock (ProposalLock), StakeDatum (..), StakeRedeemer (Destroy, PermitVote), ) @@ -68,7 +69,7 @@ import Plutarch.Context ( withValue, ) import Plutarch.Extra.AssetClass (adaClass, assetClassValue) -import PlutusLedgerApi.V2 (Credential (PubKeyCredential), PubKeyHash) +import PlutusLedgerApi.V2 (Credential (PubKeyCredential), Interval, POSIXTime, PubKeyHash) import PlutusLedgerApi.V2.Contexts (TxOutRef (TxOutRef)) import Sample.Proposal.Shared (proposalTxRef) import Sample.Shared ( @@ -145,6 +146,24 @@ delegatee = pubKeyHashes !! 1 unknownSig :: PubKeyHash unknownSig = pubKeyHashes !! 2 +validTimeRangeLowerBound :: POSIXTime +validTimeRangeLowerBound = + 0 + + (def :: ProposalTimingConfig).draftTime + + 1 + +validTimeRangeUpperBound :: POSIXTime +validTimeRangeUpperBound = + validTimeRangeLowerBound + + (def :: ProposalTimingConfig).votingTime + - 2 + +validTimeRange :: Interval POSIXTime +validTimeRange = + closedBoundedInterval + validTimeRangeLowerBound + validTimeRangeUpperBound + -------------------------------------------------------------------------------- initialVotes :: StrictMap.Map ResultTag Integer @@ -197,8 +216,8 @@ mkStakeInputDatum params = , owner = PubKeyCredential stakeOwner , delegatedTo = Just (PubKeyCredential delegatee) , lockedBy = - [ Voted (ProposalId 0) (ResultTag 0) - , Voted (ProposalId 1) (ResultTag 2) + [ ProposalLock (ProposalId 0) $ Voted (ResultTag 0) 100 + , ProposalLock (ProposalId 1) $ Voted (ResultTag 2) 200 ] } @@ -227,9 +246,11 @@ vote params = <> minAda newLock = - Voted + ProposalLock proposalInputDatum.proposalId - params.voteParameters.voteFor + $ Voted + params.voteParameters.voteFor + validTimeRangeUpperBound updatedLocks = if params.stakeParameters.stakeOutputParameters.dontAddNewLock @@ -357,13 +378,6 @@ vote params = -------------------------------------------------------------------------- - validTimeRange = - closedBoundedInterval - ((def :: ProposalTimingConfig).draftTime + 1) - ((def :: ProposalTimingConfig).votingTime - 1) - - -------------------------------------------------------------------------- - miscBuilder :: b miscBuilder = mconcat diff --git a/agora-specs/Sample/Shared.hs b/agora-specs/Sample/Shared.hs index dbacb22..e203e4d 100644 --- a/agora-specs/Sample/Shared.hs +++ b/agora-specs/Sample/Shared.hs @@ -240,6 +240,8 @@ instance Default ProposalTimingConfig where , votingTime = 1000 , lockingTime = 2000 , executingTime = 3000 + , minStakeVotingTime = 100 + , votingTimeRangeMaxWidth = 1000000 } {- | Default value of 'Agora.Governor.GovernorDatum.createProposalTimeRangeMaxWidth'. diff --git a/agora-specs/Sample/Stake/Create.hs b/agora-specs/Sample/Stake/Create.hs index 38f13f7..b8eac00 100644 --- a/agora-specs/Sample/Stake/Create.hs +++ b/agora-specs/Sample/Stake/Create.hs @@ -20,7 +20,7 @@ module Sample.Stake.Create ( import Agora.Governor (Governor (gtClassRef)) import Agora.Proposal (ProposalId (ProposalId)) import Agora.SafeMoney (GTTag) -import Agora.Stake (ProposalLock (Created), StakeDatum (..)) +import Agora.Stake (ProposalAction (Created), ProposalLock (ProposalLock), StakeDatum (..)) import Data.Semigroup (stimesMonoid) import Data.Tagged (Tagged) import Plutarch.Context ( @@ -255,6 +255,6 @@ alreadyHasLocks = { stakedAmount = 114514 , owner = PubKeyCredential signer , delegatedTo = Nothing - , lockedBy = [Created $ ProposalId 0] + , lockedBy = [ProposalLock (ProposalId 0) Created] } } diff --git a/agora-specs/Sample/Stake/Destroy.hs b/agora-specs/Sample/Stake/Destroy.hs index 451c208..c107768 100644 --- a/agora-specs/Sample/Stake/Destroy.hs +++ b/agora-specs/Sample/Stake/Destroy.hs @@ -20,7 +20,8 @@ module Sample.Stake.Destroy ( import Agora.Proposal (ProposalId (..)) import Agora.Stake ( - ProposalLock (Created), + ProposalAction (Created), + ProposalLock (ProposalLock), StakeDatum (..), StakeRedeemer (Destroy), ) @@ -105,7 +106,7 @@ mkStakeInputDatum ps = { stakedAmount = 114514 , owner = PubKeyCredential owner , delegatedTo = Just $ PubKeyCredential delegatee - , lockedBy = [Created $ ProposalId 0 | ps.notUnlocked] + , lockedBy = [ProposalLock (ProposalId 0) Created | ps.notUnlocked] } mkStakeRef :: Int -> TxOutRef diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 1bba2ed..c0624c7 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -437,6 +437,10 @@ specs = "use fake stake" (Unlock.mkUseFakeStakes nStakes) (Unlock.Validity False False) + , Unlock.mkTestTree + "retract votes in cooldown" + (Unlock.mkDisrespectCooldown nStakes) + (Unlock.Validity True False) ] legalGroup = group "legal" $ map mkLegalGroup stakeCountCases