From be1eabc26109eec0beb6df6aeafc0269fc5d266c Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Mon, 25 Jul 2022 22:07:27 +0800 Subject: [PATCH] simple tests for setting delegate --- agora-specs/Sample/Stake/SetDelegate.hs | 204 ++++++++++++++++++++++++ agora-specs/Spec/Stake.hs | 29 ++++ agora.cabal | 1 + agora/Agora/Stake/Scripts.hs | 2 +- bench.csv | 3 + 5 files changed, 238 insertions(+), 1 deletion(-) create mode 100644 agora-specs/Sample/Stake/SetDelegate.hs diff --git a/agora-specs/Sample/Stake/SetDelegate.hs b/agora-specs/Sample/Stake/SetDelegate.hs new file mode 100644 index 0000000..cf46e2a --- /dev/null +++ b/agora-specs/Sample/Stake/SetDelegate.hs @@ -0,0 +1,204 @@ +{- | +Module : Sample.Stake.SetDelegate +Maintainer : connor@mlabs.city +Description: Generate sample data for testing the functionalities of setting the delegate. + +Sample and utilities for testing the functionalities of setting the delegate. +-} +module Sample.Stake.SetDelegate ( + Parameters (..), + setDelegate, + mkStakeRedeemer, + mkStakeInputDatum, + mkTestCase, + overrideExistingDelegateParameters, + clearDelegateParameters, + setDelegateParameters, + invalidOutputStakeDatumParameters, + ownerDoesntSignParameters, + delegateToOwnerParameters, +) where + +import Agora.Stake ( + Stake (gtClassRef), + StakeDatum (..), + StakeRedeemer (ClearDelegate, DelegateTo), + ) +import Agora.Stake.Scripts (stakeValidator) +import Data.Tagged (untag) +import Plutarch.Context ( + SpendingBuilder, + buildSpendingUnsafe, + input, + output, + script, + signedWith, + txId, + withDatum, + withOutRef, + withSpendingOutRef, + withValue, + ) +import PlutusLedgerApi.V1 ( + PubKeyHash, + ScriptContext, + TxOutRef (TxOutRef), + ) +import PlutusLedgerApi.V1.Value qualified as Value +import Sample.Shared ( + minAda, + signer, + signer2, + stake, + stakeAssetClass, + stakeValidatorHash, + ) +import Test.Specification (SpecificationTree, testValidator) +import Test.Util (pubKeyHashes, sortValue) + +-------------------------------------------------------------------------------- + +-- | Parameters that control the script context generation of 'setDelegate'. +data Parameters = Parameters + { existingDelegate :: Maybe PubKeyHash + -- ^ Whom the stake has been delegated to. + , newDelegate :: Maybe PubKeyHash + -- ^ The new delegate to set to. + , invalidOutputStake :: Bool + -- ^ The output stake datum will be invalid if this is set to true. + , signedByOwner :: Bool + -- ^ Whether the stake owner signs the transaction o not. + } + +-- | Select the correct stake redeemer based on the existence of the new delegate. +mkStakeRedeemer :: Parameters -> StakeRedeemer +mkStakeRedeemer (newDelegate -> d) = maybe ClearDelegate DelegateTo d + +-- | The owner of the input stake. +stakeOwner :: PubKeyHash +stakeOwner = signer + +-- | Create input stake datum given the parameters. +mkStakeInputDatum :: Parameters -> StakeDatum +mkStakeInputDatum ps = + StakeDatum + { stakedAmount = 5 + , owner = stakeOwner + , delegatedTo = ps.existingDelegate + , lockedBy = [] + } + +-- | Generate a 'ScriptContext' that tries to change the delegate of a stake. +setDelegate :: Parameters -> ScriptContext +setDelegate ps = buildSpendingUnsafe builder + where + stakeRef :: TxOutRef + stakeRef = TxOutRef "0ffef57e30cc604342c738e31e0451593837b313e7bfb94b0922b142782f98e6" 1 + + stakeInput = mkStakeInputDatum ps + + stakeOutput = + let stakedAmount = + if ps.invalidOutputStake + then stakeInput.stakedAmount - 1 + else stakeInput.stakedAmount + in stakeInput + { stakedAmount = stakedAmount + , delegatedTo = ps.newDelegate + } + + signer = + if ps.signedByOwner + then stakeInput.owner + else signer2 + + st = Value.assetClassValue stakeAssetClass 1 -- Stake ST + stakeValue = + sortValue $ + mconcat + [ st + , Value.assetClassValue + (untag stake.gtClassRef) + (untag stakeInput.stakedAmount) + , minAda + ] + + builder :: SpendingBuilder + builder = + mconcat + [ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" + , signedWith signer + , input $ + script stakeValidatorHash + . withValue stakeValue + . withDatum stakeInput + . withOutRef stakeRef + , output $ + script stakeValidatorHash + . withValue stakeValue + . withDatum stakeOutput + , withSpendingOutRef stakeRef + ] + +-------------------------------------------------------------------------------- + +{- | Create a test case that runs the stake validator to test the functionality + of setting the delegate.P +-} +mkTestCase :: String -> Parameters -> Bool -> SpecificationTree +mkTestCase name ps valid = + testValidator + valid + name + (stakeValidator stake) + (mkStakeInputDatum ps) + (mkStakeRedeemer ps) + (setDelegate ps) + +-------------------------------------------------------------------------------- + +-- * Valid Parameters + +overrideExistingDelegateParameters :: Parameters +overrideExistingDelegateParameters = + Parameters + { existingDelegate = Just $ head pubKeyHashes + , newDelegate = Just $ pubKeyHashes !! 2 + , invalidOutputStake = False + , signedByOwner = True + } + +clearDelegateParameters :: Parameters +clearDelegateParameters = + overrideExistingDelegateParameters + { newDelegate = Nothing + } + +setDelegateParameters :: Parameters +setDelegateParameters = + overrideExistingDelegateParameters + { existingDelegate = Nothing + } + +-------------------------------------------------------------------------------- + +-- * Invalid Parameters + +ownerDoesntSignParameters :: Parameters +ownerDoesntSignParameters = + overrideExistingDelegateParameters + { signedByOwner = False + } + +delegateToOwnerParameters :: Parameters +delegateToOwnerParameters = + overrideExistingDelegateParameters + { existingDelegate = Nothing + , newDelegate = Just stakeOwner + } + +invalidOutputStakeDatumParameters :: Parameters +invalidOutputStakeDatumParameters = + overrideExistingDelegateParameters + { invalidOutputStake = True + } diff --git a/agora-specs/Spec/Stake.hs b/agora-specs/Spec/Stake.hs index 7c39597..686e441 100644 --- a/agora-specs/Spec/Stake.hs +++ b/agora-specs/Spec/Stake.hs @@ -15,6 +15,7 @@ import Agora.Stake ( StakeRedeemer (DepositWithdraw), ) import Agora.Stake.Scripts (stakePolicy, stakeValidator) +import Data.Bool (Bool (..)) import Data.Maybe (Maybe (..)) import Sample.Stake ( DepositWithdrawExample ( @@ -31,6 +32,7 @@ import Sample.Stake qualified as Stake ( stakeCreationWrongDatum, stakeDepositWithdraw, ) +import Sample.Stake.SetDelegate qualified as SetDelegate import Test.Specification ( SpecificationTree, group, @@ -83,5 +85,32 @@ specs = (toDatum $ StakeDatum 100_000 signer Nothing []) (toDatum $ DepositWithdraw 1_000_000) (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 1_000_000}) + , group + "set delegate" + [ SetDelegate.mkTestCase + "override existing delegate" + SetDelegate.overrideExistingDelegateParameters + True + , SetDelegate.mkTestCase + "remove existing delegate" + SetDelegate.clearDelegateParameters + True + , SetDelegate.mkTestCase + "set delegate to something" + SetDelegate.setDelegateParameters + True + , SetDelegate.mkTestCase + "owner doesn't sign the transaction" + SetDelegate.ownerDoesntSignParameters + False + , SetDelegate.mkTestCase + "delegate to the owner" + SetDelegate.delegateToOwnerParameters + False + , SetDelegate.mkTestCase + "invalid output stake" + SetDelegate.invalidOutputStakeDatumParameters + False + ] ] ] diff --git a/agora.cabal b/agora.cabal index 8c7d860..1050c07 100644 --- a/agora.cabal +++ b/agora.cabal @@ -197,6 +197,7 @@ library agora-specs Sample.Proposal.Vote Sample.Shared Sample.Stake + Sample.Stake.SetDelegate Sample.Treasury Spec.AuthorityToken Spec.Effect.GovernorMutation diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index 0fa20d6..2c09e30 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -522,7 +522,7 @@ stakeValidator stake = PDelegateTo ((pfield @"pkh" #) -> pkh) -> unTermCont $ do pguardC "Cannot delegate to the owner" $ - pnot #$ stakeDatum.owner #== pfromData pkh + pnot #$ stakeDatum.owner #== pfromData pkh pure $ setDelegate #$ pcon $ PDJust $ pdcons @"_0" # pkh #$ pdnil ------------------------------------------------------------ diff --git a/bench.csv b/bench.csv index 9d6770f..cbb095b 100644 --- a/bench.csv +++ b/bench.csv @@ -7,6 +7,9 @@ Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect Agora/Stake/policy/stakeCreation,51392011,150393,2536 Agora/Stake/validator/stakeDepositWithdraw deposit,186634362,508256,5324 Agora/Stake/validator/stakeDepositWithdraw withdraw,186634362,508256,5312 +Agora/Stake/validator/set delegate/override existing delegate,113448429,294926,5376 +Agora/Stake/validator/set delegate/remove existing delegate,110848776,287015,5313 +Agora/Stake/validator/set delegate/set delegate to something,110031522,287900,5313 Agora/Proposal/policy (proposal creation)/legal/proposal,33689644,100286,2011 Agora/Proposal/policy (proposal creation)/legal/governor,325452519,864627,8802 Agora/Proposal/policy (proposal creation)/legal/stake,157124919,412988,5978