allow delegating stake for voting

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 (
-    PDepositWithdraw,
-    PDestroy,
-    PPermitVote,
-    PRetractVotes
-  ),
+  PStakeRedeemer (..),
   Stake (gtClassRef, proposalSTClass),
   StakeRedeemer (WitnessStake),
   pstakeLocked,
@@ -23,6 +18,7 @@ import Agora.Stake (
 import Agora.Utils (
   mustBePJust,
   mustFindDatum',
+  pmaybeData,
   pvalidatorHashToTokenName,
  )
 import Data.Function (on)
@@ -31,6 +27,7 @@ import Plutarch.Api.V1 (
   AmountGuarantees (Positive),
   PCredential (PPubKeyCredential, PScriptCredential),
   PDatumHash,
+  PMaybeData (..),
   PMintingPolicy,
   PScriptPurpose (PMinting, PSpending),
   PTokenName,
@@ -44,6 +41,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 +237,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 +249,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,10 +383,36 @@ 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
@@ -408,8 +439,8 @@ stakeValidator stake =
 
                     PPermitVote _ -> unTermCont $ do
                       pguardC
-                        "Owner signs this transaction"
-                        ownerSignsTransaction
+                        "Owner or delegate signs this transaction"
+                        $ ownerSignsTransaction #|| delegateSignsTransaction
 
                       let proposalTokenMinted =
                             passetClassValueOf # txInfoF.mint # proposalSTClass #== 1
@@ -418,7 +449,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 +483,7 @@ stakeValidator stake =
                                   PStakeDatum
                                   ( #stakedAmount .= pdata newStakedAmount
                                       .& #owner .= stakeDatum.owner
+                                      .& #delegatedTo .= stakeDatum.delegatedTo
                                       .& #lockedBy .= stakeDatum.lockedBy
                                   )
                               datumCorrect = stakeOut #== expectedDatum
@@ -486,6 +517,20 @@ stakeValidator stake =
                               ]
                       --
                       pure $ popaque (pconstant ())
+
+                    ------------------------------------------------------------
+
+                    PDelegateTo ((pfield @"pkh" #) -> pkh) -> unTermCont $ do
+                      pguardC "Cannot delegate to the owner" $
+                        pnot #$ stakeDatum.owner  #== pfromData pkh 
+
+                      pure $ setDelegate #$ pcon $ PDJust $ pdcons @"_0" # pkh #$ pdnil
+                    ------------------------------------------------------------
+
+                    PClearDelegate _ ->
+                      setDelegate #$ pcon $ PDNothing pdnil
+                    ------------------------------------------------------------
+
                     _ -> popaque (pconstant ())
 
           pure $

agora/Agora/Utils.hs

@@ -268,4 +268,4 @@ pmaybeData ::
 pmaybeData = phoistAcyclic $
   plam $ \n f m -> pmatch m $ \case
     PDJust ((pfield @"_0" #) -> x) -> f # x
-    _ -> n
+    _ -> n