Merge pull request #149 from Liqwid-Labs/connor/stake-delegation

Stake delegation

CHANGELOG.md

@@ -11,6 +11,10 @@ This format is based on [Keep A Changelog](https://keepachangelog.com/en/1.0.0).
 
 ### Modified
 
+- Stake delegation.
+  
+  Included by [#149](https://github.com/Liqwid-Labs/agora/pull/149).
+
 - Fixed bug that checks the proposal thresholds in an incorrect way. Added negative tests for the governor scripts.
 
   Included by [#146](https://github.com/Liqwid-Labs/agora/pull/146).

agora-specs/Sample/Proposal/Advance.hs

@@ -352,6 +352,7 @@ mkStakeInputDatums ps =
         StakeDatum
           { stakedAmount = Tagged ps.perStakeGTs
           , owner = ""
+          , delegatedTo = Nothing
           , lockedBy = []
           }
    in (\owner -> template {owner = owner})

agora-specs/Sample/Proposal/Cosign.hs

@@ -130,7 +130,7 @@ mkProposalOutputDatum ps =
 
 -- | Create all the input stakes given the parameters.
 mkStakeInputDatums :: Parameters -> [StakeDatum]
-mkStakeInputDatums = fmap (\pk -> StakeDatum perStakedGTs pk []) . newCosigners
+mkStakeInputDatums = fmap (\pk -> StakeDatum perStakedGTs pk Nothing []) . newCosigners
 
 -- | Create a 'TxInfo' that tries to cosign a proposal with new cosigners.
 cosign :: forall b. CombinableBuilder b => Parameters -> b

agora-specs/Sample/Proposal/Create.hs

@@ -185,6 +185,7 @@ mkStakeInputDatum ps =
    in StakeDatum
         { stakedAmount = stakedGTs
         , owner = stakeOwner
+        , delegatedTo = Nothing
         , lockedBy = locks
         }
 

agora-specs/Sample/Proposal/UnlockStake.hs

@@ -177,6 +177,7 @@ mkStakeInputDatum ps =
   StakeDatum
     { stakedAmount = defStakedGTs
     , owner = defOwner
+    , delegatedTo = Nothing
     , lockedBy = mkInputStakeLocks ps
     }
 

agora-specs/Sample/Proposal/Vote.hs

@@ -8,6 +8,7 @@ Sample and utilities for testing the functionalities of voting on proposals.
 module Sample.Proposal.Vote (
   validVoteParameters,
   mkTestTree,
+  validVoteAsDelegateParameters,
 ) where
 
 import Agora.Proposal (
@@ -66,7 +67,7 @@ import Test.Specification (
   testValidator,
   validatorSucceedsWith,
  )
-import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, sortValue, updateMap)
+import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes, sortValue, updateMap)
 
 -- | Reference to the proposal UTXO.
 proposalRef :: TxOutRef
@@ -82,6 +83,8 @@ data Parameters = Parameters
   -- ^ The outcome the transaction is voting for.
   , voteCount :: Integer
   -- ^ The count of votes.
+  , voteAsDelegate :: Bool
+  -- ^ Delegate the stake and use it to vote.
   }
 
 -- | The public key hash of the stake owner.
@@ -121,6 +124,9 @@ existingLocks =
   , Voted (ProposalId 1) (ResultTag 2)
   ]
 
+delegate :: PubKeyHash
+delegate = head pubKeyHashes
+
 {- | Set the 'StakeDatum.stakedAmount' according to the number of votes being
       casted.
 -}
@@ -129,6 +135,10 @@ mkStakeInputDatum params =
   StakeDatum
     { stakedAmount = Tagged params.voteCount
     , owner = stakeOwner
+    , delegatedTo =
+        if params.voteAsDelegate
+          then Just delegate
+          else Nothing
     , lockedBy = existingLocks
     }
 
@@ -198,10 +208,15 @@ vote params =
             <> Value.assetClassValue (untag stake.gtClassRef) params.voteCount
             <> minAda
 
+      signer =
+        if params.voteAsDelegate
+          then delegate
+          else stakeOwner
+
       builder =
         mconcat
           [ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c"
-          , signedWith stakeOwner
+          , signedWith signer
           , timeRange validTimeRange
           , input $
               script proposalValidatorHash
@@ -232,6 +247,13 @@ validVoteParameters =
   Parameters
     { voteFor = ResultTag 0
     , voteCount = 27
+    , voteAsDelegate = False
+    }
+
+validVoteAsDelegateParameters :: Parameters
+validVoteAsDelegateParameters =
+  validVoteParameters
+    { voteAsDelegate = True
     }
 
 ---

agora-specs/Sample/Stake.hs

@@ -76,7 +76,7 @@ stakeCreation :: ScriptContext
 stakeCreation =
   let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
       datum :: StakeDatum
-      datum = StakeDatum 424242424242 signer []
+      datum = StakeDatum 424242424242 signer Nothing []
 
       builder :: MintingBuilder
       builder =
@@ -96,7 +96,7 @@ stakeCreation =
 stakeCreationWrongDatum :: ScriptContext
 stakeCreationWrongDatum =
   let datum :: Datum
-      datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer []) -- Too much GT
+      datum = Datum (toBuiltinData $ StakeDatum 4242424242424242 signer Nothing []) -- Too much GT
    in ScriptContext
         { scriptContextTxInfo = stakeCreation.scriptContextTxInfo {txInfoData = [("", datum)]}
         , scriptContextPurpose = Minting stakeSymbol
@@ -128,7 +128,7 @@ stakeDepositWithdraw :: DepositWithdrawExample -> ScriptContext
 stakeDepositWithdraw config =
   let st = Value.assetClassValue stakeAssetClass 1 -- Stake ST
       stakeBefore :: StakeDatum
-      stakeBefore = StakeDatum config.startAmount signer []
+      stakeBefore = StakeDatum config.startAmount signer Nothing []
 
       stakeAfter :: StakeDatum
       stakeAfter = stakeBefore {stakedAmount = stakeBefore.stakedAmount + config.delta}

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/Proposal.hs

@@ -130,8 +130,12 @@ specs =
              in [legalGroup, illegalGroup]
       , group
           "voting"
-          [ Vote.mkTestTree "legal" Vote.validVoteParameters True
+          [ group
-          -- TODO: add negative test cases
+              "legal"
+              [ Vote.mkTestTree "ordinary" Vote.validVoteParameters True
+              , Vote.mkTestTree "delegate" Vote.validVoteAsDelegateParameters True
+              ]
+              -- TODO: add negative test cases
           ]
       , group
           "advancing"

agora-specs/Spec/Stake.hs

@@ -15,6 +15,8 @@ import Agora.Stake (
   StakeRedeemer (DepositWithdraw),
  )
 import Agora.Stake.Scripts (stakePolicy, stakeValidator)
+import Data.Bool (Bool (..))
+import Data.Maybe (Maybe (..))
 import Sample.Stake (
   DepositWithdrawExample (
     DepositWithdrawExample,
@@ -30,6 +32,7 @@ import Sample.Stake qualified as Stake (
   stakeCreationWrongDatum,
   stakeDepositWithdraw,
  )
+import Sample.Stake.SetDelegate qualified as SetDelegate
 import Test.Specification (
   SpecificationTree,
   group,
@@ -67,20 +70,47 @@ specs =
       [ validatorSucceedsWith
           "stakeDepositWithdraw deposit"
           (stakeValidator Stake.stake)
-          (toDatum $ StakeDatum 100_000 signer [])
+          (toDatum $ StakeDatum 100_000 signer Nothing [])
           (toDatum $ DepositWithdraw 100_000)
           (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = 100_000})
       , validatorSucceedsWith
           "stakeDepositWithdraw withdraw"
           (stakeValidator Stake.stake)
-          (toDatum $ StakeDatum 100_000 signer [])
+          (toDatum $ StakeDatum 100_000 signer Nothing [])
           (toDatum $ DepositWithdraw $ negate 100_000)
           (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 100_000})
       , validatorFailsWith
           "stakeDepositWithdraw negative GT"
           (stakeValidator Stake.stake)
-          (toDatum $ StakeDatum 100_000 signer [])
+          (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/Proposal/Scripts.hs

@@ -511,6 +511,7 @@ proposalValidator proposal =
                     PStakeDatum
                     ( #stakedAmount .= stakeInF.stakedAmount
                         .& #owner .= stakeInF.owner
+                        .& #delegatedTo .= stakeInF.delegatedTo
                         .& #lockedBy .= pdata expectedProposalLocks
                     )
 
@@ -588,6 +589,7 @@ proposalValidator proposal =
                     PStakeDatum
                     ( #stakedAmount .= stakeInF.stakedAmount
                         .& #owner .= stakeInF.owner
+                        .& #delegatedTo .= stakeInF.delegatedTo
                         .& #lockedBy .= pdata stakeOutputLocks
                     )
 

agora/Agora/Stake.hs

@@ -38,6 +38,7 @@ import Data.Tagged (Tagged (..))
 import GHC.Generics qualified as GHC
 import Generics.SOP (Generic, HasDatatypeInfo, I (I))
 import Plutarch.Api.V1 (
+  PMaybeData,
   PPubKeyHash,
  )
 import Plutarch.DataRepr (
@@ -170,6 +171,11 @@ data StakeRedeemer
   | -- | The owner can consume stake if nothing is changed about it.
     --   If the proposal token moves, this is equivalent to the owner consuming it.
     WitnessStake
+  | -- | The owner can delegate the stake to another user, allowing the
+    --    delegate to vote on prooposals with the stake.
+    DelegateTo PubKeyHash
+  | -- | Revoke the existing delegation.
+    ClearDelegate
   deriving stock (Show, GHC.Generic)
 
 PlutusTx.makeIsDataIndexed
@@ -179,6 +185,8 @@ PlutusTx.makeIsDataIndexed
   , ('PermitVote, 2)
   , ('RetractVotes, 3)
   , ('WitnessStake, 4)
+  , ('DelegateTo, 5)
+  , ('ClearDelegate, 6)
   ]
 
 {- | Haskell-level datum for Stake scripts.
@@ -194,6 +202,8 @@ data StakeDatum = StakeDatum
   --
   -- TODO Support for MultiSig/Scripts is tracked here:
   --      https://github.com/Liqwid-Labs/agora/issues/45
+  , delegatedTo :: Maybe PubKeyHash
+  -- ^ To whom this stake has been delegated.
   , lockedBy :: [ProposalLock]
   -- ^ The current proposals locking this stake. This field must be empty
   --   for the stake to be usable for deposits and withdrawals.
@@ -221,6 +231,7 @@ newtype PStakeDatum (s :: S) = PStakeDatum
         ( PDataRecord
             '[ "stakedAmount" ':= PDiscrete GTTag
              , "owner" ':= PPubKeyHash
+             , "delegatedTo" ':= PMaybeData PPubKeyHash
              , "lockedBy" ':= PBuiltinList (PAsData PProposalLock)
              ]
         )
@@ -277,6 +288,8 @@ data PStakeRedeemer (s :: S)
   | PPermitVote (Term s (PDataRecord '[]))
   | PRetractVotes (Term s (PDataRecord '[]))
   | PWitnessStake (Term s (PDataRecord '[]))
+  | PDelegateTo (Term s (PDataRecord '["pkh" ':= PPubKeyHash]))
+  | PClearDelegate (Term s (PDataRecord '[]))
   deriving stock
     ( -- | @since 0.1.0
       GHC.Generic

agora/Agora/Stake/Scripts.hs

@@ -10,12 +10,7 @@ module Agora.Stake.Scripts (stakePolicy, stakeValidator) where
 import Agora.SafeMoney (GTTag)
 import Agora.Stake (
   PStakeDatum (PStakeDatum),
-  PStakeRedeemer (
+  PStakeRedeemer (..),
-    PDepositWithdraw,
-    PDestroy,
-    PPermitVote,
-    PRetractVotes
-  ),
   Stake (gtClassRef, proposalSTClass),
   StakeRedeemer (WitnessStake),
   pstakeLocked,
@@ -23,6 +18,9 @@ import Agora.Stake (
 import Agora.Utils (
   mustBePJust,
   mustFindDatum',
+  pdjust,
+  pdnothing,
+  pmaybeData,
   pvalidatorHashToTokenName,
  )
 import Data.Function (on)
@@ -44,6 +42,7 @@ import Plutarch.Api.V1 (
 import Plutarch.Api.V1.AssetClass (passetClass, passetClassValueOf, pvalueOf)
 import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, ptxSignedBy, pvalueSpent)
 import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (pgeqByClass', pgeqBySymbol, psymbolValueOf)
+import Plutarch.Extra.Field (pletAllC)
 import Plutarch.Extra.List (pmapMaybe, pmsortBy)
 import Plutarch.Extra.Maybe (pfromDJust)
 import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
@@ -239,7 +238,7 @@ stakeValidator stake =
     -- TODO: Use PTryFrom
     let stakeDatum' :: Term _ PStakeDatum
         stakeDatum' = pfromData $ punsafeCoerce datum
-    stakeDatum <- pletFieldsC @'["owner", "stakedAmount", "lockedBy"] stakeDatum'
+    stakeDatum <- pletAllC stakeDatum'
 
     PSpending txOutRef <- pmatchC $ pfromData ctx.purpose
 
@@ -251,7 +250,14 @@ stakeValidator stake =
     resolvedF <- pletFieldsC @'["address", "value", "datumHash"] resolved
 
     -- Whether the owner signs this transaction or not.
-    ownerSignsTransaction <- pletC $ ptxSignedBy # txInfoF.signatories # stakeDatum.owner
+    signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
+
+    ownerSignsTransaction <- pletC $ signedBy # stakeDatum.owner
+    delegateSignsTransaction <-
+      pletC $
+        pmaybeData # pconstant False
+          # plam ((signedBy #) . pdata)
+          # stakeDatum.delegatedTo
 
     stCurrencySymbol <-
       pletC $
@@ -378,16 +384,42 @@ stakeValidator stake =
                             PStakeDatum
                             ( #stakedAmount .= stakeDatum.stakedAmount
                                 .& #owner .= stakeDatum.owner
+                                .& #delegatedTo .= stakeDatum.delegatedTo
                                 .& #lockedBy .= pfield @"lockedBy" # stakeOut
                             )
                      in stakeOut #== templateStakeDatum
 
+                setDelegate <- pletC $
+                  plam $ \maybePkh -> unTermCont $ do
+                    pguardC
+                      "Owner signs this transaction"
+                      ownerSignsTransaction
+
+                    pguardC "A UTXO must exist with the correct output" $
+                      let correctOutputDatum =
+                            stakeOut
+                              #== mkRecordConstr
+                                PStakeDatum
+                                ( #stakedAmount .= stakeDatum.stakedAmount
+                                    .& #owner .= stakeDatum.owner
+                                    .& #delegatedTo .= pdata maybePkh
+                                    .& #lockedBy .= stakeDatum.lockedBy
+                                )
+                          valueCorrect = ownOutputValueUnchanged
+                       in foldl1
+                            (#&&)
+                            [ ptraceIfFalse "valueCorrect" valueCorrect
+                            , ptraceIfFalse "datumCorrect" correctOutputDatum
+                            ]
+
+                    pure $ popaque (pconstant ())
+
                 pure $
                   pmatch stakeRedeemer $ \case
                     PRetractVotes _ -> unTermCont $ do
                       pguardC
-                        "Owner signs this transaction"
+                        "Owner or delegate signs this transaction"
-                        ownerSignsTransaction
+                        $ ownerSignsTransaction #|| delegateSignsTransaction
 
                       -- This puts trust into the Proposal. The Proposal must necessarily check
                       -- that this is not abused.
@@ -408,8 +440,8 @@ stakeValidator stake =
 
                     PPermitVote _ -> unTermCont $ do
                       pguardC
-                        "Owner signs this transaction"
+                        "Owner or delegate signs this transaction"
-                        ownerSignsTransaction
+                        $ ownerSignsTransaction #|| delegateSignsTransaction
 
                       let proposalTokenMinted =
                             passetClassValueOf # txInfoF.mint # proposalSTClass #== 1
@@ -418,7 +450,6 @@ stakeValidator stake =
                       -- that this is not abused.
                       pguardC "Proposal ST spent or minted" $
                         proposalTokenMoved #|| proposalTokenMinted
-
                       pguardC "A UTXO must exist with the correct output" $
                         let correctOutputDatum = onlyLocksUpdated
                             valueCorrect = ownOutputValueUnchanged
@@ -453,6 +484,7 @@ stakeValidator stake =
                                   PStakeDatum
                                   ( #stakedAmount .= pdata newStakedAmount
                                       .& #owner .= stakeDatum.owner
+                                      .& #delegatedTo .= stakeDatum.delegatedTo
                                       .& #lockedBy .= stakeDatum.lockedBy
                                   )
                               datumCorrect = stakeOut #== expectedDatum
@@ -486,6 +518,20 @@ stakeValidator stake =
                               ]
                       --
                       pure $ popaque (pconstant ())
+
+                    ------------------------------------------------------------
+
+                    PDelegateTo ((pfromData . (pfield @"pkh" #)) -> pkh) -> unTermCont $ do
+                      pguardC "Cannot delegate to the owner" $
+                        pnot #$ stakeDatum.owner #== pkh
+
+                      pure $ setDelegate #$ pdjust # pkh
+                    ------------------------------------------------------------
+
+                    PClearDelegate _ ->
+                      setDelegate # pdnothing
+                    ------------------------------------------------------------
+
                     _ -> popaque (pconstant ())
 
           pure $

agora/Agora/Utils.hs

@@ -24,6 +24,10 @@ module Agora.Utils (
   pltAsData,
   pon,
   withBuiltinPairAsData,
+  pmaybeData,
+  pmaybe,
+  pdjust,
+  pdnothing,
 ) where
 
 import Plutarch.Api.V1 (
@@ -34,7 +38,7 @@ import Plutarch.Api.V1 (
   PCurrencySymbol,
   PDatum,
   PDatumHash,
-  PMaybeData (PDJust),
+  PMaybeData (PDJust, PDNothing),
   PMintingPolicy,
   PTokenName (PTokenName),
   PTuple,
@@ -240,3 +244,54 @@ withBuiltinPairAsData f p =
   let a = pfromData $ pfstBuiltin # p
       b = pfromData $ psndBuiltin # p
    in f a b
+
+{- | Plutarch version of 'Data.Maybe.maybe'. Take a default value and a function
+      @f@. If the given 'PMaybe' value is @'PJust' x@, apply the function @f@ to
+      @x@, otherewise the default value will be retuned.
+
+     @since 0.2.0
+-}
+pmaybe ::
+  forall (a :: PType) (b :: PType) (s :: S).
+  Term s (b :--> (a :--> b) :--> PMaybe a :--> b)
+pmaybe = phoistAcyclic $
+  plam $ \n f m -> pmatch m $ \case
+    PJust x -> f # x
+    _ -> n
+
+{- | Special version of 'pmaybe' that works with 'PMaybedata'.
+
+     @since 0.2.0
+-}
+pmaybeData ::
+  forall (a :: PType) (b :: PType) (s :: S).
+  PIsData a =>
+  Term s (b :--> (a :--> b) :--> PMaybeData a :--> b)
+pmaybeData = phoistAcyclic $
+  plam $ \n f m -> pmatch m $ \case
+    PDJust ((pfield @"_0" #) -> x) -> f # x
+    _ -> n
+
+{- Construct a 'PDJust' value.
+
+    @since 0.2.0
+-}
+pdjust ::
+  forall (a :: PType) (s :: S).
+  (PIsData a) =>
+  Term s (a :--> PMaybeData a)
+pdjust = phoistAcyclic $
+  plam $ \x ->
+    pcon $
+      PDJust $
+        pdcons @"_0" # pdata x #$ pdnil
+
+{- Construct a 'PDNothing' value.
+
+    @since 0.2.0
+-}
+pdnothing ::
+  forall (a :: PType) (s :: S).
+  (PIsData a) =>
+  Term s (PMaybeData a)
+pdnothing = phoistAcyclic $ pcon $ PDNothing pdnil