-- | This module exposes the notion of proposal within a
-- 'Cooked.Skeleton.TxSkel'
module Cooked.Skeleton.Proposal
  ( TxParameterChange (..),
    TxGovAction (..),
    TxSkelProposal (..),
    txSkelProposalAddressL,
    txSkelProposalActionL,
    txSkelProposalWitnessL,
    txSkelProposalAnchorL,
    txSkelProposalAutoConstitutionL,
    simpleTxSkelProposal,
    withWitness,
    withAnchor,
    withConstitution,
    updateConstitution,
  )
where

import Cooked.Skeleton.Redeemer as X
import Data.Map (Map)
import Optics.Core ((&), (.~), (?~), (^.))
import Optics.TH
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.Prelude qualified as PlutusTx

-- | These are all the protocol parameters. They are taken from
-- https://github.com/IntersectMBO/cardano-ledger/blob/c4fbc05999866fea7c0cb1b211fd5288f286b95d/eras/conway/impl/cddl-files/conway.cddl#L381-L412
-- and will most likely change in future eras.
data TxParameterChange where
  -- | The linear factor for the minimum fee calculation
  FeePerByte :: Integer -> TxParameterChange
  -- | The constant factor for the minimum fee calculation
  FeeFixed :: Integer -> TxParameterChange
  -- | Maximal block body size
  MaxBlockBodySize :: Integer -> TxParameterChange
  -- | Maximal transaction size
  MaxTxSize :: Integer -> TxParameterChange
  -- | Maximal block header size
  MaxBlockHeaderSize :: Integer -> TxParameterChange
  -- | The amount of a key registration deposit
  KeyDeposit :: Integer -> TxParameterChange
  -- | The amount of a pool registration deposit
  PoolDeposit :: Integer -> TxParameterChange
  -- | Maximum number of epochs in the future a pool retirement is allowed to
  -- be scheduled future for.
  PoolRetirementMaxEpoch :: Integer -> TxParameterChange
  -- | Desired number of pools
  PoolNumber :: Integer -> TxParameterChange
  -- | Pool influence
  PoolInfluence :: Rational -> TxParameterChange
  -- | Monetary expansion
  MonetaryExpansion :: Rational -> TxParameterChange
  -- | Treasury expansion
  TreasuryCut :: Rational -> TxParameterChange
  -- | Minimum Stake Pool Cost
  MinPoolCost :: Integer -> TxParameterChange
  -- | Cost in lovelace per byte of UTxO storage
  CoinsPerUTxOByte :: Integer -> TxParameterChange
  -- | Cost models for non-native script languages
  CostModels ::
    { TxParameterChange -> [Integer]
cmPlutusV1Costs :: [Integer],
      TxParameterChange -> [Integer]
cmPlutusV2Costs :: [Integer],
      TxParameterChange -> [Integer]
cmPlutusV3Costs :: [Integer]
    } ->
    TxParameterChange
  -- | Prices of execution units
  Prices ::
    { TxParameterChange -> Rational
pMemoryCost :: Rational,
      TxParameterChange -> Rational
pStepCost :: Rational
    } ->
    TxParameterChange
  -- | Max total script execution resources units allowed per tx
  MaxTxExUnits ::
    { TxParameterChange -> Integer
mteuMemory :: Integer,
      TxParameterChange -> Integer
mteuSteps :: Integer
    } ->
    TxParameterChange
  -- | Max total script execution resources units allowed per block
  MaxBlockExUnits ::
    { TxParameterChange -> Integer
mbeuMemory :: Integer,
      TxParameterChange -> Integer
mbeuSteps :: Integer
    } ->
    TxParameterChange
  -- | Max size of a Value in an output
  MaxValSize :: Integer -> TxParameterChange
  -- | Percentage of the txfee which must be provided as collateral when
  -- including non-native scripts.
  CollateralPercentage :: Integer -> TxParameterChange
  -- | Maximum number of collateral inputs allowed in a transaction
  MaxCollateralInputs :: Integer -> TxParameterChange
  -- | Thresholds for pool votes
  PoolVotingThresholds ::
    { TxParameterChange -> Rational
pvtMotionNoConfidence :: Rational,
      TxParameterChange -> Rational
pvtCommitteeNormal :: Rational,
      TxParameterChange -> Rational
pvtCommitteeNoConfidence :: Rational,
      TxParameterChange -> Rational
pvtHardFork :: Rational,
      TxParameterChange -> Rational
pvtSecurityGroup :: Rational
    } ->
    TxParameterChange
  -- | Thresholds for DRep votes
  DRepVotingThresholds ::
    { TxParameterChange -> Rational
drvtMotionNoConfidence :: Rational,
      TxParameterChange -> Rational
drvtCommitteeNormal :: Rational,
      TxParameterChange -> Rational
drvtCommitteeNoConfidence :: Rational,
      TxParameterChange -> Rational
drvtUpdateConstitution :: Rational,
      TxParameterChange -> Rational
drvtHardForkInitialization :: Rational,
      TxParameterChange -> Rational
drvtNetworkGroup :: Rational,
      TxParameterChange -> Rational
drvtEconomicGroup :: Rational,
      TxParameterChange -> Rational
drvtTechnicalGroup :: Rational,
      TxParameterChange -> Rational
drvtGovernanceGroup :: Rational,
      TxParameterChange -> Rational
drvtTreasuryWithdrawal :: Rational
    } ->
    TxParameterChange
  -- | Minimum size of the Constitutional Committee
  CommitteeMinSize :: Integer -> TxParameterChange
  -- | The Constitutional Committee Term limit in number of Slots
  CommitteeMaxTermLength :: Integer -> TxParameterChange
  -- | Gov action lifetime in number of Epochs
  GovActionLifetime :: Integer -> TxParameterChange
  -- | The amount of the Gov Action deposit
  GovActionDeposit :: Integer -> TxParameterChange
  -- | The amount of a DRep registration deposit
  DRepRegistrationDeposit :: Integer -> TxParameterChange
  -- | The number of Epochs that a DRep can perform no activity without losing
  -- their @Active@ status.
  DRepActivity :: Integer -> TxParameterChange
  -- Reference scripts fee for the minimum fee calculation
  MinFeeRefScriptCostPerByte :: Rational -> TxParameterChange
  deriving (Int -> TxParameterChange -> ShowS
[TxParameterChange] -> ShowS
TxParameterChange -> String
(Int -> TxParameterChange -> ShowS)
-> (TxParameterChange -> String)
-> ([TxParameterChange] -> ShowS)
-> Show TxParameterChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxParameterChange -> ShowS
showsPrec :: Int -> TxParameterChange -> ShowS
$cshow :: TxParameterChange -> String
show :: TxParameterChange -> String
$cshowList :: [TxParameterChange] -> ShowS
showList :: [TxParameterChange] -> ShowS
Show, TxParameterChange -> TxParameterChange -> Bool
(TxParameterChange -> TxParameterChange -> Bool)
-> (TxParameterChange -> TxParameterChange -> Bool)
-> Eq TxParameterChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxParameterChange -> TxParameterChange -> Bool
== :: TxParameterChange -> TxParameterChange -> Bool
$c/= :: TxParameterChange -> TxParameterChange -> Bool
/= :: TxParameterChange -> TxParameterChange -> Bool
Eq)

-- | This lists the various possible governance actions
data TxGovAction where
  -- If several parameter changes are of the same kind, only the last
  -- one will take effect
  TxGovActionParameterChange :: [TxParameterChange] -> TxGovAction
  TxGovActionHardForkInitiation :: Api.ProtocolVersion -> TxGovAction
  TxGovActionTreasuryWithdrawals :: Map Api.Credential Api.Lovelace -> TxGovAction
  TxGovActionNoConfidence :: TxGovAction
  TxGovActionUpdateCommittee :: [Api.ColdCommitteeCredential] -> Map Api.ColdCommitteeCredential Integer -> PlutusTx.Rational -> TxGovAction
  TxGovActionNewConstitution :: Api.Constitution -> TxGovAction
  deriving (Int -> TxGovAction -> ShowS
[TxGovAction] -> ShowS
TxGovAction -> String
(Int -> TxGovAction -> ShowS)
-> (TxGovAction -> String)
-> ([TxGovAction] -> ShowS)
-> Show TxGovAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxGovAction -> ShowS
showsPrec :: Int -> TxGovAction -> ShowS
$cshow :: TxGovAction -> String
show :: TxGovAction -> String
$cshowList :: [TxGovAction] -> ShowS
showList :: [TxGovAction] -> ShowS
Show, TxGovAction -> TxGovAction -> Bool
(TxGovAction -> TxGovAction -> Bool)
-> (TxGovAction -> TxGovAction -> Bool) -> Eq TxGovAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxGovAction -> TxGovAction -> Bool
== :: TxGovAction -> TxGovAction -> Bool
$c/= :: TxGovAction -> TxGovAction -> Bool
/= :: TxGovAction -> TxGovAction -> Bool
Eq)

-- | This bundles a governance action into an actual proposal
data TxSkelProposal where
  TxSkelProposal ::
    { -- | Whatever credential will get back the deposit
      TxSkelProposal -> Address
txSkelProposalAddress :: Api.Address,
      -- | The proposed action
      TxSkelProposal -> TxGovAction
txSkelProposalAction :: TxGovAction,
      -- | An optional script (typically the constitution script) to witness the
      -- proposal and validate it. Only parameter changes and treasury
      -- withdrawals can be subject to such a validation and transactions will
      -- not pass validation phase 1 if other actions are given a witness.
      TxSkelProposal -> Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalWitness :: Maybe (Script.Versioned Script.Script, TxSkelRedeemer),
      -- | An optional anchor to be given as additional data. It should
      -- correspond to the URL of a web page
      TxSkelProposal -> Maybe String
txSkelProposalAnchor :: Maybe String,
      -- | A flag to turn on/off the auto assignement of the constitution script
      TxSkelProposal -> Bool
txSkelProposalAutoConstitution :: Bool
    } ->
    TxSkelProposal
  deriving (Int -> TxSkelProposal -> ShowS
[TxSkelProposal] -> ShowS
TxSkelProposal -> String
(Int -> TxSkelProposal -> ShowS)
-> (TxSkelProposal -> String)
-> ([TxSkelProposal] -> ShowS)
-> Show TxSkelProposal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSkelProposal -> ShowS
showsPrec :: Int -> TxSkelProposal -> ShowS
$cshow :: TxSkelProposal -> String
show :: TxSkelProposal -> String
$cshowList :: [TxSkelProposal] -> ShowS
showList :: [TxSkelProposal] -> ShowS
Show, TxSkelProposal -> TxSkelProposal -> Bool
(TxSkelProposal -> TxSkelProposal -> Bool)
-> (TxSkelProposal -> TxSkelProposal -> Bool) -> Eq TxSkelProposal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSkelProposal -> TxSkelProposal -> Bool
== :: TxSkelProposal -> TxSkelProposal -> Bool
$c/= :: TxSkelProposal -> TxSkelProposal -> Bool
/= :: TxSkelProposal -> TxSkelProposal -> Bool
Eq)

-- | A lens to get or set the address of a 'TxSkelProposal'
makeLensesFor [("txSkelProposalAddress", "txSkelProposalAddressL")] ''TxSkelProposal

-- | A lens to get or set the governance action of a 'TxSkelProposal'
makeLensesFor [("txSkelProposalAction", "txSkelProposalActionL")] ''TxSkelProposal

-- | A lens to get or set the witness of a 'TxSkelProposal'
makeLensesFor [("txSkelProposalWitness", "txSkelProposalWitnessL")] ''TxSkelProposal

-- | A lens to get or set the anchor of a 'TxSkelProposal'
makeLensesFor [("txSkelProposalAnchor", "txSkelProposalAnchorL")] ''TxSkelProposal

-- | A lens to get or set the anchor of a 'TxSkelProposal'
makeLensesFor [("txSkelProposalAutoConstitution", "txSkelProposalAutoConstitutionL")] ''TxSkelProposal

-- | Builds a 'TxSkelProposal' from an address and a 'TxGovAction'
simpleTxSkelProposal :: (Script.ToAddress a) => a -> TxGovAction -> TxSkelProposal
simpleTxSkelProposal :: forall a. ToAddress a => a -> TxGovAction -> TxSkelProposal
simpleTxSkelProposal a
a TxGovAction
govAction = Address
-> TxGovAction
-> Maybe (Versioned Script, TxSkelRedeemer)
-> Maybe String
-> Bool
-> TxSkelProposal
TxSkelProposal (a -> Address
forall a. ToAddress a => a -> Address
Script.toAddress a
a) TxGovAction
govAction Maybe (Versioned Script, TxSkelRedeemer)
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Bool
True

-- | Assigns a witness to a 'TxSkelProposal'. Also turns off the auto
-- constitution flag, so that this witness is not overridden.
withWitness :: (Script.ToVersioned Script.Script a) => TxSkelProposal -> (a, TxSkelRedeemer) -> TxSkelProposal
withWitness :: forall a.
ToVersioned Script a =>
TxSkelProposal -> (a, TxSkelRedeemer) -> TxSkelProposal
withWitness TxSkelProposal
prop (a
s, TxSkelRedeemer
red) =
  TxSkelProposal
prop
    TxSkelProposal
-> (TxSkelProposal -> TxSkelProposal) -> TxSkelProposal
forall a b. a -> (a -> b) -> b
& Lens' TxSkelProposal (Maybe (Versioned Script, TxSkelRedeemer))
txSkelProposalWitnessL
    Lens' TxSkelProposal (Maybe (Versioned Script, TxSkelRedeemer))
-> (Versioned Script, TxSkelRedeemer)
-> TxSkelProposal
-> TxSkelProposal
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ (a -> Versioned Script
forall s a. ToVersioned s a => a -> Versioned s
Script.toVersioned a
s, TxSkelRedeemer
red)
    TxSkelProposal
-> (TxSkelProposal -> TxSkelProposal) -> TxSkelProposal
forall a b. a -> (a -> b) -> b
& Lens' TxSkelProposal Bool
txSkelProposalAutoConstitutionL
    Lens' TxSkelProposal Bool
-> Bool -> TxSkelProposal -> TxSkelProposal
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Bool
False

-- | Assigns the constitution script with an empty redeemer
withConstitution :: (Script.ToVersioned Script.Script a) => TxSkelProposal -> Maybe a -> TxSkelProposal
withConstitution :: forall a.
ToVersioned Script a =>
TxSkelProposal -> Maybe a -> TxSkelProposal
withConstitution TxSkelProposal
prop Maybe a
sM = TxSkelProposal
prop TxSkelProposal
-> (TxSkelProposal -> TxSkelProposal) -> TxSkelProposal
forall a b. a -> (a -> b) -> b
& Lens' TxSkelProposal (Maybe (Versioned Script, TxSkelRedeemer))
txSkelProposalWitnessL Lens' TxSkelProposal (Maybe (Versioned Script, TxSkelRedeemer))
-> Maybe (Versioned Script, TxSkelRedeemer)
-> TxSkelProposal
-> TxSkelProposal
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ((,TxSkelRedeemer
emptyTxSkelRedeemer) (Versioned Script -> (Versioned Script, TxSkelRedeemer))
-> (a -> Versioned Script)
-> a
-> (Versioned Script, TxSkelRedeemer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Versioned Script
forall s a. ToVersioned s a => a -> Versioned s
Script.toVersioned (a -> (Versioned Script, TxSkelRedeemer))
-> Maybe a -> Maybe (Versioned Script, TxSkelRedeemer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
sM)

-- | Assigns an anchor to a 'TxSkelProposal'
withAnchor :: TxSkelProposal -> String -> TxSkelProposal
withAnchor :: TxSkelProposal -> String -> TxSkelProposal
withAnchor TxSkelProposal
prop String
url = TxSkelProposal
prop TxSkelProposal
-> (TxSkelProposal -> TxSkelProposal) -> TxSkelProposal
forall a b. a -> (a -> b) -> b
& Lens' TxSkelProposal (Maybe String)
txSkelProposalAnchorL Lens' TxSkelProposal (Maybe String)
-> String -> TxSkelProposal -> TxSkelProposal
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ String
url

-- | Updates the constitution if 'txSkelProposalAutoConstitution' is 'True'
updateConstitution :: (Script.ToVersioned Script.Script a) => TxSkelProposal -> Maybe a -> TxSkelProposal
updateConstitution :: forall a.
ToVersioned Script a =>
TxSkelProposal -> Maybe a -> TxSkelProposal
updateConstitution TxSkelProposal
prop Maybe a
sM | TxSkelProposal
prop TxSkelProposal -> Lens' TxSkelProposal Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' TxSkelProposal Bool
txSkelProposalAutoConstitutionL = TxSkelProposal
prop TxSkelProposal -> Maybe a -> TxSkelProposal
forall a.
ToVersioned Script a =>
TxSkelProposal -> Maybe a -> TxSkelProposal
`withConstitution` Maybe a
sM
updateConstitution TxSkelProposal
prop Maybe a
_ = TxSkelProposal
prop