allow delegating stake for voting

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

@@ -129,6 +129,7 @@ mkStakeInputDatum params =
   StakeDatum
     { stakedAmount = Tagged params.voteCount
     , owner = stakeOwner
+    , delegatedTo = Nothing
     , lockedBy = existingLocks
     }
 

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/Spec/Stake.hs

@@ -15,6 +15,7 @@ import Agora.Stake (
   StakeRedeemer (DepositWithdraw),
  )
 import Agora.Stake.Scripts (stakePolicy, stakeValidator)
+import Data.Maybe (Maybe (..))
 import Sample.Stake (
   DepositWithdrawExample (
     DepositWithdrawExample,
@@ -67,19 +68,19 @@ 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})
       ]

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,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"
+                        "Owner or delegate signs this transaction"
-                        ownerSignsTransaction
+                        $ 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 $