module Cooked.Skeleton.Proposal
(
ParameterChange (..),
GovernanceAction (..),
TxSkelProposal (..),
txSkelProposalAnchorL,
txSkelProposalMConstitutionAT,
txSkelProposalReturnCredentialL,
txSkelProposalGovernanceActionAT,
txSkelProposalConstitutionAT,
simpleProposal,
fillConstitution,
)
where
import Cooked.Skeleton.Anchor
import Cooked.Skeleton.Redeemer
import Cooked.Skeleton.User
import Data.Kind (Type)
import Data.Map (Map)
import Data.Typeable
import Optics.Core
import Optics.TH
import Plutus.Script.Utils.Address qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.Prelude qualified as PlutusTx
data ParameterChange where
FeePerByte :: Integer -> ParameterChange
FeeFixed :: Integer -> ParameterChange
MaxBlockBodySize :: Integer -> ParameterChange
MaxTxSize :: Integer -> ParameterChange
:: Integer -> ParameterChange
KeyDeposit :: Integer -> ParameterChange
PoolDeposit :: Integer -> ParameterChange
PoolRetirementMaxEpoch :: Integer -> ParameterChange
PoolNumber :: Integer -> ParameterChange
PoolInfluence :: Rational -> ParameterChange
MonetaryExpansion :: Rational -> ParameterChange
TreasuryCut :: Rational -> ParameterChange
MinPoolCost :: Integer -> ParameterChange
CoinsPerUTxOByte :: Integer -> ParameterChange
CostModels ::
{ ParameterChange -> [Integer]
cmPlutusV1Costs :: [Integer],
ParameterChange -> [Integer]
cmPlutusV2Costs :: [Integer],
ParameterChange -> [Integer]
cmPlutusV3Costs :: [Integer]
} ->
ParameterChange
Prices ::
{ ParameterChange -> Rational
pMemoryCost :: Rational,
ParameterChange -> Rational
pStepCost :: Rational
} ->
ParameterChange
MaxTxExUnits ::
{ ParameterChange -> Integer
mteuMemory :: Integer,
ParameterChange -> Integer
mteuSteps :: Integer
} ->
ParameterChange
MaxBlockExUnits ::
{ ParameterChange -> Integer
mbeuMemory :: Integer,
ParameterChange -> Integer
mbeuSteps :: Integer
} ->
ParameterChange
MaxValSize :: Integer -> ParameterChange
CollateralPercentage :: Integer -> ParameterChange
MaxCollateralInputs :: Integer -> ParameterChange
PoolVotingThresholds ::
{ ParameterChange -> Rational
pvtMotionNoConfidence :: Rational,
ParameterChange -> Rational
pvtCommitteeNormal :: Rational,
ParameterChange -> Rational
pvtCommitteeNoConfidence :: Rational,
ParameterChange -> Rational
pvtHardFork :: Rational,
ParameterChange -> Rational
pvtSecurityGroup :: Rational
} ->
ParameterChange
DRepVotingThresholds ::
{ ParameterChange -> Rational
drvtMotionNoConfidence :: Rational,
ParameterChange -> Rational
drvtCommitteeNormal :: Rational,
ParameterChange -> Rational
drvtCommitteeNoConfidence :: Rational,
ParameterChange -> Rational
drvtUpdateConstitution :: Rational,
ParameterChange -> Rational
drvtHardForkInitialization :: Rational,
ParameterChange -> Rational
drvtNetworkGroup :: Rational,
ParameterChange -> Rational
drvtEconomicGroup :: Rational,
ParameterChange -> Rational
drvtTechnicalGroup :: Rational,
ParameterChange -> Rational
drvtGovernanceGroup :: Rational,
ParameterChange -> Rational
drvtTreasuryWithdrawal :: Rational
} ->
ParameterChange
CommitteeMinSize :: Integer -> ParameterChange
CommitteeMaxTermLength :: Integer -> ParameterChange
GovActionLifetime :: Integer -> ParameterChange
GovActionDeposit :: Integer -> ParameterChange
DRepRegistrationDeposit :: Integer -> ParameterChange
DRepActivity :: Integer -> ParameterChange
MinFeeRefScriptCostPerByte :: Rational -> ParameterChange
deriving (Int -> ParameterChange -> ShowS
[ParameterChange] -> ShowS
ParameterChange -> String
(Int -> ParameterChange -> ShowS)
-> (ParameterChange -> String)
-> ([ParameterChange] -> ShowS)
-> Show ParameterChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterChange -> ShowS
showsPrec :: Int -> ParameterChange -> ShowS
$cshow :: ParameterChange -> String
show :: ParameterChange -> String
$cshowList :: [ParameterChange] -> ShowS
showList :: [ParameterChange] -> ShowS
Show, ParameterChange -> ParameterChange -> Bool
(ParameterChange -> ParameterChange -> Bool)
-> (ParameterChange -> ParameterChange -> Bool)
-> Eq ParameterChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterChange -> ParameterChange -> Bool
== :: ParameterChange -> ParameterChange -> Bool
$c/= :: ParameterChange -> ParameterChange -> Bool
/= :: ParameterChange -> ParameterChange -> Bool
Eq)
data GovernanceAction :: UserKind -> Type where
ParameterChange :: [ParameterChange] -> GovernanceAction IsScript
TreasuryWithdrawals :: Map Api.Credential Api.Lovelace -> GovernanceAction IsScript
HardForkInitiation :: Api.ProtocolVersion -> GovernanceAction IsNone
NoConfidence :: GovernanceAction IsNone
UpdateCommittee :: [Api.ColdCommitteeCredential] -> Map Api.ColdCommitteeCredential Integer -> PlutusTx.Rational -> GovernanceAction IsNone
NewConstitution :: Api.Constitution -> GovernanceAction IsNone
deriving instance Show (GovernanceAction a)
deriving instance Eq (GovernanceAction a)
data TxSkelProposal where
TxSkelProposal ::
( Typeable kind,
Script.ToCredential cred
) =>
{
()
txSkelProposalReturnCredential :: cred,
()
txSkelProposalGovernanceAction :: GovernanceAction kind,
()
txSkelProposalConstitution :: Maybe (User kind Redemption),
TxSkelProposal -> TxSkelAnchor
txSkelProposalAnchor :: TxSkelAnchor
} ->
TxSkelProposal
instance Show TxSkelProposal where
show :: TxSkelProposal -> String
show (TxSkelProposal (cred -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) GovernanceAction kind
action Maybe (User kind 'Redemption)
constit TxSkelAnchor
anchor) = [String] -> String
forall a. Show a => a -> String
show [Credential -> String
forall a. Show a => a -> String
show Credential
cred, GovernanceAction kind -> String
forall a. Show a => a -> String
show GovernanceAction kind
action, Maybe (User kind 'Redemption) -> String
forall a. Show a => a -> String
show Maybe (User kind 'Redemption)
constit, TxSkelAnchor -> String
forall a. Show a => a -> String
show TxSkelAnchor
anchor]
instance Eq TxSkelProposal where
(TxSkelProposal (cred -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) GovernanceAction kind
action Maybe (User kind 'Redemption)
constit TxSkelAnchor
anchor) == :: TxSkelProposal -> TxSkelProposal -> Bool
== (TxSkelProposal (cred -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred') GovernanceAction kind
action' Maybe (User kind 'Redemption)
constit' TxSkelAnchor
anchor') =
Credential
cred Credential -> Credential -> Bool
forall a. Eq a => a -> a -> Bool
== Credential
cred' Bool -> Bool -> Bool
&& GovernanceAction kind -> Maybe (GovernanceAction kind)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast GovernanceAction kind
action Maybe (GovernanceAction kind)
-> Maybe (GovernanceAction kind) -> Bool
forall a. Eq a => a -> a -> Bool
== GovernanceAction kind -> Maybe (GovernanceAction kind)
forall a. a -> Maybe a
Just GovernanceAction kind
action' Bool -> Bool -> Bool
&& Maybe (User kind 'Redemption)
-> Maybe (Maybe (User kind 'Redemption))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Maybe (User kind 'Redemption)
constit Maybe (Maybe (User kind 'Redemption))
-> Maybe (Maybe (User kind 'Redemption)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (User kind 'Redemption)
-> Maybe (Maybe (User kind 'Redemption))
forall a. a -> Maybe a
Just Maybe (User kind 'Redemption)
constit' Bool -> Bool -> Bool
&& TxSkelAnchor
anchor TxSkelAnchor -> TxSkelAnchor -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelAnchor
anchor'
txSkelProposalReturnCredentialL :: Lens' TxSkelProposal Api.Credential
txSkelProposalReturnCredentialL :: Lens' TxSkelProposal Credential
txSkelProposalReturnCredentialL =
(TxSkelProposal -> Credential)
-> (TxSkelProposal -> Credential -> TxSkelProposal)
-> Lens' TxSkelProposal Credential
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(\(TxSkelProposal {cred
txSkelProposalReturnCredential :: ()
txSkelProposalReturnCredential :: cred
txSkelProposalReturnCredential}) -> cred -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential cred
txSkelProposalReturnCredential)
(\TxSkelProposal
txSkelProposal Credential
cred -> TxSkelProposal
txSkelProposal {txSkelProposalReturnCredential = cred})
txSkelProposalMConstitutionAT :: forall kind. (Typeable kind) => AffineTraversal' TxSkelProposal (Maybe (User kind Redemption))
txSkelProposalMConstitutionAT :: forall (kind :: UserKind).
Typeable kind =>
AffineTraversal' TxSkelProposal (Maybe (User kind 'Redemption))
txSkelProposalMConstitutionAT =
(TxSkelProposal
-> Either TxSkelProposal (Maybe (User kind 'Redemption)))
-> (TxSkelProposal
-> Maybe (User kind 'Redemption) -> TxSkelProposal)
-> AffineTraversal
TxSkelProposal
TxSkelProposal
(Maybe (User kind 'Redemption))
(Maybe (User kind 'Redemption))
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
(\prop :: TxSkelProposal
prop@(TxSkelProposal {Maybe (User kind 'Redemption)
txSkelProposalConstitution :: ()
txSkelProposalConstitution :: Maybe (User kind 'Redemption)
txSkelProposalConstitution}) -> Either TxSkelProposal (Maybe (User kind 'Redemption))
-> (Maybe (User kind 'Redemption)
-> Either TxSkelProposal (Maybe (User kind 'Redemption)))
-> Maybe (Maybe (User kind 'Redemption))
-> Either TxSkelProposal (Maybe (User kind 'Redemption))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TxSkelProposal
-> Either TxSkelProposal (Maybe (User kind 'Redemption))
forall a b. a -> Either a b
Left TxSkelProposal
prop) Maybe (User kind 'Redemption)
-> Either TxSkelProposal (Maybe (User kind 'Redemption))
forall a b. b -> Either a b
Right (Maybe (Maybe (User kind 'Redemption))
-> Either TxSkelProposal (Maybe (User kind 'Redemption)))
-> Maybe (Maybe (User kind 'Redemption))
-> Either TxSkelProposal (Maybe (User kind 'Redemption))
forall a b. (a -> b) -> a -> b
$ Maybe (User kind 'Redemption)
-> Maybe (Maybe (User kind 'Redemption))
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast Maybe (User kind 'Redemption)
txSkelProposalConstitution)
(\prop :: TxSkelProposal
prop@(TxSkelProposal @kind' cred
cred GovernanceAction kind
action Maybe (User kind 'Redemption)
_ TxSkelAnchor
anchor) Maybe (User kind 'Redemption)
constit' -> TxSkelProposal
-> ((kind :~: kind) -> TxSkelProposal)
-> Maybe (kind :~: kind)
-> TxSkelProposal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxSkelProposal
prop (\kind :~: kind
Refl -> cred
-> GovernanceAction kind
-> Maybe (User kind 'Redemption)
-> TxSkelAnchor
-> TxSkelProposal
forall (kind :: UserKind) cred.
(Typeable kind, ToCredential cred) =>
cred
-> GovernanceAction kind
-> Maybe (User kind 'Redemption)
-> TxSkelAnchor
-> TxSkelProposal
TxSkelProposal cred
cred GovernanceAction kind
action Maybe (User kind 'Redemption)
Maybe (User kind 'Redemption)
constit' TxSkelAnchor
anchor) (Maybe (kind :~: kind) -> TxSkelProposal)
-> Maybe (kind :~: kind) -> TxSkelProposal
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall (a :: UserKind) (b :: UserKind).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @kind @kind')
txSkelProposalConstitutionAT :: AffineTraversal' TxSkelProposal (User IsScript Redemption)
txSkelProposalConstitutionAT :: AffineTraversal' TxSkelProposal (User 'IsScript 'Redemption)
txSkelProposalConstitutionAT = AffineTraversal'
TxSkelProposal (Maybe (User 'IsScript 'Redemption))
forall (kind :: UserKind).
Typeable kind =>
AffineTraversal' TxSkelProposal (Maybe (User kind 'Redemption))
txSkelProposalMConstitutionAT AffineTraversal'
TxSkelProposal (Maybe (User 'IsScript 'Redemption))
-> Optic
A_Prism
NoIx
(Maybe (User 'IsScript 'Redemption))
(Maybe (User 'IsScript 'Redemption))
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
-> AffineTraversal' TxSkelProposal (User 'IsScript 'Redemption)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Prism
NoIx
(Maybe (User 'IsScript 'Redemption))
(Maybe (User 'IsScript 'Redemption))
(User 'IsScript 'Redemption)
(User 'IsScript 'Redemption)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
txSkelProposalGovernanceActionAT :: forall req. (Typeable req) => AffineTraversal' TxSkelProposal (GovernanceAction req)
txSkelProposalGovernanceActionAT :: forall (req :: UserKind).
Typeable req =>
AffineTraversal' TxSkelProposal (GovernanceAction req)
txSkelProposalGovernanceActionAT =
(TxSkelProposal -> Either TxSkelProposal (GovernanceAction req))
-> (TxSkelProposal -> GovernanceAction req -> TxSkelProposal)
-> AffineTraversal
TxSkelProposal
TxSkelProposal
(GovernanceAction req)
(GovernanceAction req)
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
(\prop :: TxSkelProposal
prop@(TxSkelProposal {GovernanceAction kind
txSkelProposalGovernanceAction :: ()
txSkelProposalGovernanceAction :: GovernanceAction kind
txSkelProposalGovernanceAction}) -> Either TxSkelProposal (GovernanceAction req)
-> (GovernanceAction req
-> Either TxSkelProposal (GovernanceAction req))
-> Maybe (GovernanceAction req)
-> Either TxSkelProposal (GovernanceAction req)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TxSkelProposal -> Either TxSkelProposal (GovernanceAction req)
forall a b. a -> Either a b
Left TxSkelProposal
prop) GovernanceAction req
-> Either TxSkelProposal (GovernanceAction req)
forall a b. b -> Either a b
Right (Maybe (GovernanceAction req)
-> Either TxSkelProposal (GovernanceAction req))
-> Maybe (GovernanceAction req)
-> Either TxSkelProposal (GovernanceAction req)
forall a b. (a -> b) -> a -> b
$ GovernanceAction kind -> Maybe (GovernanceAction req)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast GovernanceAction kind
txSkelProposalGovernanceAction)
(\prop :: TxSkelProposal
prop@(TxSkelProposal @req' cred
cred GovernanceAction kind
_ Maybe (User kind 'Redemption)
constit TxSkelAnchor
anchor) GovernanceAction req
newAction -> TxSkelProposal
-> ((req :~: kind) -> TxSkelProposal)
-> Maybe (req :~: kind)
-> TxSkelProposal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxSkelProposal
prop (\req :~: kind
Refl -> cred
-> GovernanceAction req
-> Maybe (User req 'Redemption)
-> TxSkelAnchor
-> TxSkelProposal
forall (kind :: UserKind) cred.
(Typeable kind, ToCredential cred) =>
cred
-> GovernanceAction kind
-> Maybe (User kind 'Redemption)
-> TxSkelAnchor
-> TxSkelProposal
TxSkelProposal cred
cred GovernanceAction req
newAction Maybe (User req 'Redemption)
Maybe (User kind 'Redemption)
constit TxSkelAnchor
anchor) (Maybe (req :~: kind) -> TxSkelProposal)
-> Maybe (req :~: kind) -> TxSkelProposal
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall (a :: UserKind) (b :: UserKind).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @req @req')
makeLensesFor [("txSkelProposalAnchor", "txSkelProposalAnchorL")] ''TxSkelProposal
simpleProposal :: (Script.ToCredential cred, Typeable kind) => cred -> GovernanceAction kind -> TxSkelProposal
simpleProposal :: forall cred (kind :: UserKind).
(ToCredential cred, Typeable kind) =>
cred -> GovernanceAction kind -> TxSkelProposal
simpleProposal cred
cred GovernanceAction kind
action = cred
-> GovernanceAction kind
-> Maybe (User kind 'Redemption)
-> TxSkelAnchor
-> TxSkelProposal
forall (kind :: UserKind) cred.
(Typeable kind, ToCredential cred) =>
cred
-> GovernanceAction kind
-> Maybe (User kind 'Redemption)
-> TxSkelAnchor
-> TxSkelProposal
TxSkelProposal cred
cred GovernanceAction kind
action Maybe (User kind 'Redemption)
forall a. Maybe a
Nothing TxSkelAnchor
forall a. Maybe a
Nothing
fillConstitution :: (ToVScript script, Typeable script) => script -> TxSkelProposal -> TxSkelProposal
fillConstitution :: forall script.
(ToVScript script, Typeable script) =>
script -> TxSkelProposal -> TxSkelProposal
fillConstitution script
constitution =
AffineTraversal'
TxSkelProposal (Maybe (User 'IsScript 'Redemption))
-> (Maybe (User 'IsScript 'Redemption)
-> Maybe (User 'IsScript 'Redemption))
-> TxSkelProposal
-> TxSkelProposal
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
(forall (kind :: UserKind).
Typeable kind =>
AffineTraversal' TxSkelProposal (Maybe (User kind 'Redemption))
txSkelProposalMConstitutionAT @IsScript)
(Maybe (User 'IsScript 'Redemption)
-> (User 'IsScript 'Redemption
-> Maybe (User 'IsScript 'Redemption))
-> Maybe (User 'IsScript 'Redemption)
-> Maybe (User 'IsScript 'Redemption)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (User 'IsScript 'Redemption -> Maybe (User 'IsScript 'Redemption)
forall a. a -> Maybe a
Just (User 'IsScript 'Redemption -> Maybe (User 'IsScript 'Redemption))
-> User 'IsScript 'Redemption -> Maybe (User 'IsScript 'Redemption)
forall a b. (a -> b) -> a -> b
$ script -> TxSkelRedeemer -> User 'IsScript 'Redemption
forall script (a :: UserKind).
(a ∈ '[ 'IsScript, 'IsEither], ToVScript script,
Typeable script) =>
script -> TxSkelRedeemer -> User a 'Redemption
UserRedeemedScript script
constitution TxSkelRedeemer
emptyTxSkelRedeemer) User 'IsScript 'Redemption -> Maybe (User 'IsScript 'Redemption)
forall a. a -> Maybe a
Just)