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