A Plutus smart-validator "that allows one to stake & then send the interest to an address other than the principal’s address".

ManagedDelegation.hs

-- | ⚠️  IMPORTANT
--
-- This code is UNTESTED and UNLICENSED. Use at your own risk and do whatever
-- you want with it.

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Plutus.ManagedDelegation where

import PlutusTx
import PlutusTx.Prelude

import Plutus.V1.Ledger.Api
import Plutus.V1.Ledger.Contexts
import Plutus.V1.Ledger.Value (valueOf)

import Ledger.Typed.Scripts as Scripts
import PlutusTx.AssocMap as Map

-- | A smart-validator "that allows one to stake & then send the interest to an
-- address other than the principal’s address".
--
-- https://twitter.com/cburniske/status/1514528686870962177
validator
  -- | Verification key hash identifying the delegation manager, able to
  -- decide who the funds gets delegated to.
  :: PubKeyHash
  -- | Verification key hash of whom is allowed to receive collected rewards; in
  -- all likelihood owned by a different person that the manager.
  -> PubKeyHash
  -- | Empty redeemer, no use for this validator.
  -> ()
  -- | The local script context received when executing the script.
  -> ScriptContext
  -- | The validator outcome.
  -> Bool
validator manager recipient _ ctx =
  case scriptContextPurpose ctx of
    Rewarding rewardSource ->
      (scriptContextTxInfo ctx) `mustPayRewardsTo` (recipient, rewardSource)

    Certifying DCertDelegDelegate{} ->
      (scriptContextTxInfo ctx) `mustBeSignedBy` manager

    _otherwise ->
      traceError "Validator misused"

-- | Checks that the recipient receives *at least* the reward amount. We won't
-- deny the recipient from receiving more. We could though, that's a choice.
mustPayRewardsTo
  :: TxInfo
  -> (PubKeyHash, StakingCredential)
  -> Bool
mustPayRewardsTo tx (recipient, rewardSource) =
  let
    valueAtOutput = valueOf (valuePaidTo tx recipient) adaSymbol adaToken
  in
    case Map.lookup rewardSource (Map.fromList (txInfoWdrl tx)) of
      Nothing ->
        traceError "No rewards"

      Just valueInRewards ->
        traceIfFalse "Insufficient payout" (valueAtOutput >= valueInRewards)

-- | Just an alias which gets anyway removed by the compiler during compilation,
-- because it makes the above validator more consistent and easier to review.
mustBeSignedBy
  :: TxInfo
  -> PubKeyHash
  -> Bool
mustBeSignedBy =
  txSignedBy

-- | Compiled code to put in addresses as staking credentials (see type-02 and
-- type-03 addresses).
--
-- Note that the script is parameterized by two arguments which both sets who
-- can manage (i.e. choose delegation settings) the stake and who can enjoy the
-- rewards. This means that the compiled code -- and therefore the hash of it to
-- put in staking credentials -- depends on those parameters and is only known
-- once those parameters have been chosen.
compiledValidator
  :: PubKeyHash
  -> PubKeyHash
  -> CompiledCode (BuiltinData -> BuiltinData -> ())
compiledValidator manager recipient =
  $$(compile [||\a0 a1 -> wrapStakeValidator (validator a0 a1)||])
    `applyCode` liftCode manager
    `applyCode` liftCode recipient