Created
April 14, 2022 22:31
-
-
Save KtorZ/3ecf66966f94605992de639007d2e9a3 to your computer and use it in GitHub Desktop.
A Plutus smart-validator "that allows one to stake & then send the interest to an address other than the principal’s address".
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- | ⚠️ 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment