simple tests for setting delegate

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
+    }

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
+          ]
       ]
   ]

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

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
                     ------------------------------------------------------------

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