diff --git a/agora-specs/Property/Governor.hs b/agora-specs/Property/Governor.hs index 5226637..9023a35 100644 --- a/agora-specs/Property/Governor.hs +++ b/agora-specs/Property/Governor.hs @@ -63,6 +63,7 @@ import Test.Tasty.QuickCheck ( data GovernorDatumCases = ExecuteLE0 | CreateLE0 + | ToVotingLE0 | VoteLE0 | Correct deriving stock (Eq, Show) @@ -88,9 +89,10 @@ governorDatumValidProperty = classifiedPropertyNative gen (const []) expected classifier pisGovernorDatumValid where classifier :: GovernorDatum -> GovernorDatumCases - classifier ((.proposalThresholds) -> ProposalThresholds e c v) + classifier ((.proposalThresholds) -> ProposalThresholds e c tv v) | e < 0 = ExecuteLE0 | c < 0 = CreateLE0 + | tv < 0 = ToVotingLE0 | v < 0 = VoteLE0 | otherwise = Correct @@ -110,24 +112,27 @@ governorDatumValidProperty = let validGT = taggedInteger (0, 1000000000) execute <- validGT create <- validGT + toVoting <- validGT vote <- validGT le0 <- taggedInteger (-1000, -1) case c of ExecuteLE0 -> -- execute < 0 - return $ ProposalThresholds le0 create vote + return $ ProposalThresholds le0 create toVoting vote CreateLE0 -> -- c < 0 - return $ ProposalThresholds execute le0 vote + return $ ProposalThresholds execute le0 toVoting vote + ToVotingLE0 -> + return $ ProposalThresholds execute create le0 vote VoteLE0 -> -- vote < 0 - return $ ProposalThresholds execute create le0 + return $ ProposalThresholds execute create toVoting le0 Correct -> do -- c <= vote < execute nv <- taggedInteger (0, untag execute - 1) nc <- taggedInteger (0, untag nv) - return $ ProposalThresholds execute nc nv + return $ ProposalThresholds execute nc toVoting nv data GovernorPolicyCases = ReferenceUTXONotSpent diff --git a/agora-specs/Sample/Effect/GovernorMutation.hs b/agora-specs/Sample/Effect/GovernorMutation.hs index 076584e..c88ad4a 100644 --- a/agora-specs/Sample/Effect/GovernorMutation.hs +++ b/agora-specs/Sample/Effect/GovernorMutation.hs @@ -195,7 +195,7 @@ invalidNewGovernorDatum = GovernorDatum { proposalThresholds = def - { vote = Tagged (-1) + { toVoting = Tagged (-1) } , nextProposalId = ProposalId 42 , proposalTimings = def diff --git a/agora-specs/Sample/Governor/Initialize.hs b/agora-specs/Sample/Governor/Initialize.hs index a58d862..63b56cf 100644 --- a/agora-specs/Sample/Governor/Initialize.hs +++ b/agora-specs/Sample/Governor/Initialize.hs @@ -93,7 +93,7 @@ validGovernorOutputDatum = } invalidProposalThresholds :: ProposalThresholds -invalidProposalThresholds = ProposalThresholds (-1) (-1) (-1) +invalidProposalThresholds = ProposalThresholds (-1) (-1) (-1) (-1) invalidMaxTimeRangeWidth :: MaxTimeRangeWidth invalidMaxTimeRangeWidth = MaxTimeRangeWidth 0 diff --git a/agora-specs/Sample/Governor/Mutate.hs b/agora-specs/Sample/Governor/Mutate.hs index e4ba560..fffb485 100644 --- a/agora-specs/Sample/Governor/Mutate.hs +++ b/agora-specs/Sample/Governor/Mutate.hs @@ -120,6 +120,7 @@ mkGovernorOutputDatum ValueInvalid = ProposalThresholds { execute = -1 , create = -1 + , toVoting = -1 , vote = -1 } in Just $ diff --git a/agora-specs/Sample/Proposal/Advance.hs b/agora-specs/Sample/Proposal/Advance.hs index 93c254f..5ae15f2 100644 --- a/agora-specs/Sample/Proposal/Advance.hs +++ b/agora-specs/Sample/Proposal/Advance.hs @@ -679,7 +679,7 @@ getNextState = \case -- | Calculate the number of GTs per stake in order to exceed the minimum limit. compPerStakeGTsForDraft :: NumStake -> Integer compPerStakeGTsForDraft nCosigners = - untag (def :: ProposalThresholds).vote + untag (def :: ProposalThresholds).toVoting `div` fromIntegral nCosigners + 1 dummyDatum :: () @@ -944,7 +944,7 @@ mkInsufficientCosignsBundle nCosigners nEffects = } where insuffcientPerStakeGTs = - untag (def :: ProposalThresholds).vote + untag (def :: ProposalThresholds).toVoting `div` fromIntegral nCosigners - 1 template = mkValidToNextStateBundle nCosigners nEffects False Draft diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs index 2a138b8..7aecebd 100644 --- a/agora-specs/Sample/Proposal/Vote.hs +++ b/agora-specs/Sample/Proposal/Vote.hs @@ -25,6 +25,8 @@ module Sample.Proposal.Vote ( moreThanOneProposals, invalidLocks, destroyStakes, + insufficientAmount, + insufficientAmount1, ) where import Agora.Governor (Governor (..)) @@ -526,3 +528,27 @@ destroyStakes = } } } + +insufficientAmount :: ParameterBundle +insufficientAmount = + ownerVoteWithSignleStake + { stakeParameters = + ownerVoteWithSignleStake.stakeParameters + { stakeInputParameters = + ownerVoteWithSignleStake.stakeParameters.stakeInputParameters + { perStakeGTs = 1 + } + } + } + +insufficientAmount1 :: ParameterBundle +insufficientAmount1 = + ownerVoteWithMultipleStakes + { stakeParameters = + ownerVoteWithMultipleStakes.stakeParameters + { stakeInputParameters = + ownerVoteWithMultipleStakes.stakeParameters.stakeInputParameters + { perStakeGTs = 1 + } + } + } diff --git a/agora-specs/Sample/Shared.hs b/agora-specs/Sample/Shared.hs index 9a572f3..75113e3 100644 --- a/agora-specs/Sample/Shared.hs +++ b/agora-specs/Sample/Shared.hs @@ -189,6 +189,7 @@ instance Default ProposalThresholds where ProposalThresholds { execute = Tagged 1000 , create = Tagged 1 + , toVoting = Tagged 100 , vote = Tagged 100 } diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 564a130..fb04441 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/agora-specs/Spec/Proposal.hs @@ -176,6 +176,14 @@ specs = "attempt to burn stakes" Vote.destroyStakes (Vote.Validity True False) + , Vote.mkTestTree + "insufficient staked amount" + Vote.insufficientAmount + (Vote.Validity False True) + , Vote.mkTestTree + "insufficient staked amount" + Vote.insufficientAmount1 + (Vote.Validity False True) ] ] , group diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 33bfd68..663f3d1 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -67,8 +67,7 @@ import Plutarch.DataRepr ( ), PDataFields, ) -import Plutarch.Extra.Comonad (pextract) -import Plutarch.Extra.Field (pletAllC) +import Plutarch.Extra.Field (pletAll) import Plutarch.Extra.Function (pbuiltinUncurry) import Plutarch.Extra.IsData ( DerivePConstantViaDataList (DerivePConstantViaDataList), @@ -81,14 +80,14 @@ import Plutarch.Extra.IsData ( import "liqwid-plutarch-extra" Plutarch.Extra.List (pfindJust) import Plutarch.Extra.Map qualified as PM import Plutarch.Extra.Maybe (pfromJust) -import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pmatchC) +import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC) import Plutarch.Lift ( DerivePConstantViaNewtype (DerivePConstantViaNewtype), PConstantDecl, PUnsafeLiftDecl (type PLifted), ) import Plutarch.Orphans () -import Plutarch.SafeMoney (PDiscrete (PDiscrete)) +import Plutarch.SafeMoney (PDiscrete) import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash) import PlutusTx qualified @@ -222,7 +221,7 @@ data ProposalStatus This data is stored centrally (in the 'Agora.Governor.Governor') and copied over to 'Proposal's when they are created. - @since 0.1.0 + @since 1.0.0 -} data ProposalThresholds = ProposalThresholds { execute :: Tagged GTTag Integer @@ -232,9 +231,10 @@ data ProposalThresholds = ProposalThresholds -- -- It is recommended this be a high enough amount, in order to prevent DOS from bad -- actors. + , toVoting :: Tagged GTTag Integer + -- ^ How much GT required to to move into 'Locked'. , vote :: Tagged GTTag Integer - -- ^ How much GT required to allow voting to happen. - -- (i.e. to move into 'VotingReady') + -- ^ How much GT required to vote on a outcome. } deriving stock ( -- | @since 0.1.0 @@ -553,7 +553,7 @@ deriving via (DerivePConstantViaEnum ProposalStatus PProposalStatus) instance (P {- | Plutarch-level version of 'ProposalThresholds'. - @since 0.1.0 + @since 1.0.0 -} newtype PProposalThresholds (s :: S) = PProposalThresholds { getProposalThresholds :: @@ -562,6 +562,7 @@ newtype PProposalThresholds (s :: S) = PProposalThresholds ( PDataRecord '[ "execute" ':= PDiscrete GTTag , "create" ':= PDiscrete GTTag + , "toVoting" ':= PDiscrete GTTag , "vote" ':= PDiscrete GTTag ] ) @@ -951,23 +952,18 @@ pneutralOption = phoistAcyclic $ -} pisProposalThresholdsValid :: forall (s :: S). Term s (PProposalThresholds :--> PBool) pisProposalThresholdsValid = phoistAcyclic $ - plam $ \thresholds -> unTermCont $ do - thresholdsF <- pletAllC thresholds - - PDiscrete execute' <- pmatchC thresholdsF.execute - PDiscrete draft' <- pmatchC thresholdsF.create - PDiscrete vote' <- pmatchC thresholdsF.vote - - execute <- pletC $ pextract # execute' - draft <- pletC $ pextract # draft' - vote <- pletC $ pextract # vote' - - pure $ + plam $ + flip pletAll $ \thresholdsF -> foldr1 (#&&) - [ ptraceIfFalse "Execute threshold is less than or equal to 0" $ 0 #<= execute - , ptraceIfFalse "Draft threshold is less than or equal to 0" $ 0 #<= draft - , ptraceIfFalse "Vote threshold is less than or equal to 0" $ 0 #<= vote + [ ptraceIfFalse "Execute threshold is less than or equal to 0" $ + 0 #<= pfromData thresholdsF.execute + , ptraceIfFalse "Create threshold is less than or equal to 0" $ + 0 #<= pfromData thresholdsF.create + , ptraceIfFalse "toVoting threshold is less than or equal to 0" $ + 0 #<= pfromData thresholdsF.toVoting + , ptraceIfFalse "Vote threshold is less than or equal to 0" $ + 0 #<= pfromData thresholdsF.vote ] {- | Retract votes given the option and the amount of votes. diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index a743b5e..9d7f5ec 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -458,25 +458,27 @@ proposalValidator as maximumCosigners = ---------------------------------------------------------------------- PVote r -> spendStakes $ \sctxF -> do - let totalStakeAmount = - pto $ - pfoldMap - # plam - ( \stake -> unTermCont $ do - stakeF <- pletFieldsC @'["stakedAmount", "lockedBy"] stake + totalStakeAmount <- + pletC $ + pto $ + pfoldMap + # plam + ( \stake -> unTermCont $ do + stakeF <- pletFieldsC @'["stakedAmount", "lockedBy"] stake - pguardC "Same stake shouldn't vote on the same proposal twice" $ - pnot - #$ pisVoter - #$ pgetStakeRole - # proposalInputDatumF.proposalId - # stakeF.lockedBy + pguardC "Same stake shouldn't vote on the same proposal twice" $ + pnot + #$ pisVoter + #$ pgetStakeRole + # proposalInputDatumF.proposalId + # stakeF.lockedBy - pure $ pcon $ PSum $ pfromData stakeF.stakedAmount - ) - # sctxF.inputStakes + pure $ pcon $ PSum $ pfromData stakeF.stakedAmount + ) + # sctxF.inputStakes - -- TODO(Connor): check minimum stake amount? + pguardC "Exceed minimum amount" $ + thresholdsF.vote #< totalStakeAmount pguardC "Input proposal must be in VotingReady state" $ currentStatus #== pconstant VotingReady @@ -657,7 +659,7 @@ proposalValidator as maximumCosigners = pmatchC notTooLate >>= \case PTrue -> do pguardC "More cosigns than minimum amount" $ - punsafeCoerce (pfromData thresholdsF.vote) #< sctxF.totalAmount + punsafeCoerce (pfromData thresholdsF.toVoting) #< sctxF.totalAmount pguardC "All new cosigners are witnessed by their Stake datums" $ plistEqualsBy