102 lines
2.8 KiB
Haskell
102 lines
2.8 KiB
Haskell
{-# OPTIONS_GHC -Wwarn #-}
|
|
|
|
{- |
|
|
Module: Agora.Treasury
|
|
Maintainer: jack@mlabs.city
|
|
Description: Treasury scripts.
|
|
|
|
Contains the datum, redeemer and validator for a template DAO
|
|
treasury.
|
|
-}
|
|
module Agora.Treasury (treasuryV) where
|
|
|
|
import GHC.Generics qualified as GHC
|
|
import Generics.SOP
|
|
import Plutarch.Api.V1.Contexts (
|
|
PScriptContext,
|
|
PTuple,
|
|
PTxInfo (PTxInfo),
|
|
)
|
|
import Plutarch.Api.V1.Maybe (PMaybeData (PDJust))
|
|
import Plutarch.Api.V1.Scripts (PDatum, PDatumHash)
|
|
import Plutarch.Api.V1.Tx (
|
|
PTxInInfo,
|
|
PTxOut,
|
|
)
|
|
import Plutarch.Api.V1.Value (PCurrencySymbol, PValue)
|
|
import Plutarch.Builtin (pforgetData)
|
|
import Plutarch.DataRepr (
|
|
PDataFields,
|
|
PIsDataReprInstances (PIsDataReprInstances),
|
|
)
|
|
import Plutarch.Monadic qualified as P
|
|
import Agora.Utils (pisValueSubset)
|
|
|
|
{- | Validator ensuring that transactions consuming the treasury
|
|
do so in a valid manner.
|
|
-}
|
|
treasuryV ::
|
|
Term
|
|
s
|
|
( PAsData PTreasuryDatum
|
|
:--> PAsData PTreasuryRedeemer
|
|
:--> PAsData PScriptContext
|
|
:--> PUnit
|
|
)
|
|
treasuryV = plam $ \d r ctx' -> P.do
|
|
pmatch (pfromData r) $ \case
|
|
-- Redeemer seeking to alter treasury parameters. Must ensure
|
|
-- a valid GAT is burned in the transaction.
|
|
PAlterTrParams _ ->
|
|
ptraceError "Altering treasury parameters is not currently supported."
|
|
-- Redeemer for all other treasury actions. Must ensure datum
|
|
-- is unchanged and no value has been removed from the
|
|
-- treasury.
|
|
PRedeemTreasury _ -> P.do
|
|
-- Amount of value treasury has before transaction.
|
|
let valueTrIn = undefined
|
|
|
|
-- Amount of value treasury has after transaction.
|
|
let valueTrOut = undefined
|
|
|
|
let vOutExceedsVIn = pisValueSubset # valueTrIn # valueTrOut
|
|
|
|
pif
|
|
(vOutExceedsVIn)
|
|
(pconstant ())
|
|
(ptraceError "Value has been illegally deducted from treasury.")
|
|
|
|
{- | Plutarch level type representing datum of the treasury.
|
|
Contains:
|
|
|
|
- @stateThread@ representing the asset class of the
|
|
treasury's state thread token.
|
|
-}
|
|
newtype PTreasuryDatum (s :: S)
|
|
= PTreasuryDatum
|
|
( Term
|
|
s
|
|
( PDataRecord
|
|
'[ "stateThread" ':= PCurrencySymbol
|
|
]
|
|
)
|
|
)
|
|
deriving stock (GHC.Generic)
|
|
deriving anyclass (Generic, PIsDataRepr)
|
|
deriving
|
|
(PlutusType, PIsData, PDataFields)
|
|
via PIsDataReprInstances PTreasuryDatum
|
|
|
|
{- | Plutarch level type representing valid redeemers of the
|
|
treasury.
|
|
-}
|
|
data PTreasuryRedeemer (s :: S)
|
|
= -- | TODO: will allow the burning of GATs to alter Treasury params.
|
|
PAlterTrParams (Term s (PDataRecord '[]))
|
|
| -- | All other treasury actions. Value must not decrease.
|
|
PRedeemTreasury (Term s (PDataRecord '[]))
|
|
deriving stock (GHC.Generic)
|
|
deriving anyclass (Generic, PIsDataRepr)
|
|
deriving
|
|
(PlutusType, PIsData)
|
|
via PIsDataReprInstances PTreasuryRedeemer
|