{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.CLI.Compatible.Governance.Run
  ( runCompatibleGovernanceCmds
  )
where

import Cardano.Api as Api
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Compatible.Governance.Command
import Cardano.CLI.Compatible.Governance.Types
import Cardano.CLI.EraBased.Governance.Actions.Run
import Cardano.CLI.EraBased.Governance.GenesisKeyDelegationCertificate.Run
import Cardano.CLI.EraBased.Governance.Run
import Cardano.CLI.Read
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.GovernanceActionsError

import Data.Typeable (Typeable)

runCompatibleGovernanceCmds :: CompatibleGovernanceCmds era -> CIO e ()
runCompatibleGovernanceCmds :: forall era e. CompatibleGovernanceCmds era -> CIO e ()
runCompatibleGovernanceCmds = \case
  CreateCompatibleProtocolParametersUpdateCmd GovernanceActionProtocolParametersUpdateCmdArgs era
cmd ->
    GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
forall era e.
GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
runCompatibleGovernanceActionCreateProtocolParametersUpdateCmd GovernanceActionProtocolParametersUpdateCmdArgs era
cmd
  LatestCompatibleGovernanceCmds GovernanceCmds era
cmd -> GovernanceCmds era -> CIO e ()
forall era e. GovernanceCmds era -> CIO e ()
runGovernanceCmds GovernanceCmds era
cmd
  CompatibleGenesisKeyDelegationCertificate VerificationKeyOrHashOrFile GenesisKey
genVk VerificationKeyOrHashOrFile GenesisDelegateKey
genDelegVk VerificationKeyOrHashOrFile VrfKey
vrfVk File () 'Out
out ->
    VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> File () 'Out
-> CIO e ()
forall e.
VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> File () 'Out
-> CIO e ()
runGovernanceGenesisKeyDelegationCertificate VerificationKeyOrHashOrFile GenesisKey
genVk VerificationKeyOrHashOrFile GenesisDelegateKey
genDelegVk VerificationKeyOrHashOrFile VrfKey
vrfVk File () 'Out
out
  CompatibleCreateMirCertificateStakeAddressesCmd ShelleyToBabbageEra era
w MIRPot
mirpot [StakeAddress]
vKeys [Coin]
rewards File () 'Out
out ->
    ShelleyToBabbageEra era
-> MIRPot -> [StakeAddress] -> [Coin] -> File () 'Out -> CIO e ()
forall era e.
ShelleyToBabbageEra era
-> MIRPot -> [StakeAddress] -> [Coin] -> File () 'Out -> CIO e ()
runGovernanceMIRCertificatePayStakeAddrs ShelleyToBabbageEra era
w MIRPot
mirpot [StakeAddress]
vKeys [Coin]
rewards File () 'Out
out
  CompatibleCreateMirCertificateTransferToReservesCmd ShelleyToBabbageEra era
w Coin
ll File () 'Out
oFp ->
    ShelleyToBabbageEra era -> Coin -> File () 'Out -> CIO e ()
forall era e.
ShelleyToBabbageEra era -> Coin -> File () 'Out -> CIO e ()
runGovernanceCreateMirCertificateTransferToReservesCmd ShelleyToBabbageEra era
w Coin
ll File () 'Out
oFp
  CompatibleCreateMirCertificateTransferToTreasuryCmd ShelleyToBabbageEra era
w Coin
ll File () 'Out
oFp ->
    ShelleyToBabbageEra era -> Coin -> File () 'Out -> CIO e ()
forall era e.
ShelleyToBabbageEra era -> Coin -> File () 'Out -> CIO e ()
runGovernanceCreateMirCertificateTransferToReservesCmd ShelleyToBabbageEra era
w Coin
ll File () 'Out
oFp

runCompatibleGovernanceActionCreateProtocolParametersUpdateCmd
  :: forall era e
   . ()
  => GovernanceActionProtocolParametersUpdateCmdArgs era
  -> CIO e ()
runCompatibleGovernanceActionCreateProtocolParametersUpdateCmd :: forall era e.
GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
runCompatibleGovernanceActionCreateProtocolParametersUpdateCmd GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams' = do
  let sbe :: ShelleyBasedEra era
sbe = GovernanceActionProtocolParametersUpdateCmdArgs era
-> ShelleyBasedEra era
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> ShelleyBasedEra era
uppShelleyBasedEra GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
forall era e.
Typeable era =>
ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
shelleyToBabbageProtocolParametersUpdate ShelleyBasedEra era
sbe GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
forall era e.
Typeable era =>
ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
shelleyToBabbageProtocolParametersUpdate ShelleyBasedEra era
sbe GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
forall era e.
Typeable era =>
ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
shelleyToBabbageProtocolParametersUpdate ShelleyBasedEra era
sbe GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
forall era e.
Typeable era =>
ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
shelleyToBabbageProtocolParametersUpdate ShelleyBasedEra era
sbe GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
    ShelleyBasedEra era
ShelleyBasedEraBabbage ->
      ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
forall era e.
Typeable era =>
ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
shelleyToBabbageProtocolParametersUpdate ShelleyBasedEra era
sbe GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
    ShelleyBasedEra era
ShelleyBasedEraConway -> ShelleyBasedEra ConwayEra
-> GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
-> CIO e ()
forall e.
ShelleyBasedEra ConwayEra
-> GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
-> CIO e ()
conwayProtocolParametersUpdate ShelleyBasedEra era
ShelleyBasedEra ConwayEra
sbe GovernanceActionProtocolParametersUpdateCmdArgs era
GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
eraBasedPParams'
    ShelleyBasedEra era
ShelleyBasedEraDijkstra ->
      -- TODO: Dijkstra
      [Char] -> RIO e ()
forall a. HasCallStack => [Char] -> a
error [Char]
"runCompatibleGovernanceActionCreateProtocolParametersUpdateCmd: Dijkstra not supported yet"

maybeAddUpdatedCostModel
  :: GovernanceActionProtocolParametersUpdateCmdArgs era
  -> CIO e (EraBasedProtocolParametersUpdate era)
maybeAddUpdatedCostModel :: forall era e.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> CIO e (EraBasedProtocolParametersUpdate era)
maybeAddUpdatedCostModel GovernanceActionProtocolParametersUpdateCmdArgs era
args = case GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (CostModelsFile era)
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (CostModelsFile era)
uppCostModelsFile GovernanceActionProtocolParametersUpdateCmdArgs era
args of
  Maybe (CostModelsFile era)
Nothing -> EraBasedProtocolParametersUpdate era
-> RIO e (EraBasedProtocolParametersUpdate era)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraBasedProtocolParametersUpdate era
 -> RIO e (EraBasedProtocolParametersUpdate era))
-> EraBasedProtocolParametersUpdate era
-> RIO e (EraBasedProtocolParametersUpdate era)
forall a b. (a -> b) -> a -> b
$ GovernanceActionProtocolParametersUpdateCmdArgs era
-> EraBasedProtocolParametersUpdate era
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> EraBasedProtocolParametersUpdate era
uppNewPParams GovernanceActionProtocolParametersUpdateCmdArgs era
args
  Just (CostModelsFile AlonzoEraOnwards era
alonzoOnwards File CostModels 'In
costModelsFile') -> do
    costModels <-
      ExceptT CostModelsError IO CostModels -> RIO e CostModels
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT CostModelsError IO CostModels -> RIO e CostModels)
-> ExceptT CostModelsError IO CostModels -> RIO e CostModels
forall a b. (a -> b) -> a -> b
$
        File CostModels 'In -> ExceptT CostModelsError IO CostModels
readCostModels File CostModels 'In
costModelsFile'
    pure . addCostModelsToEraBasedProtocolParametersUpdate alonzoOnwards costModels $
      uppNewPParams args

conwayProtocolParametersUpdate
  :: ShelleyBasedEra ConwayEra
  -> GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
  -> CIO e ()
conwayProtocolParametersUpdate :: forall e.
ShelleyBasedEra ConwayEra
-> GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
-> CIO e ()
conwayProtocolParametersUpdate ShelleyBasedEra ConwayEra
sbe GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
args = do
  let oFp :: File () 'Out
oFp = GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
-> File () 'Out
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era -> File () 'Out
uppFilePath GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
args
      anyEra :: AnyShelleyBasedEra
anyEra = ShelleyBasedEra ConwayEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ConwayEra
sbe

  UpdateProtocolParametersConwayOnwards
    _cOnwards
    network
    deposit'
    returnAddr'
    proposalUrl'
    proposalHash'
    checkProposalHash'
    mPrevGovActId
    mConstitutionalScriptHash <-
    ExceptT
  GovernanceActionsError
  IO
  (UpdateProtocolParametersConwayOnwards ConwayEra)
-> RIO e (UpdateProtocolParametersConwayOnwards ConwayEra)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT
   GovernanceActionsError
   IO
   (UpdateProtocolParametersConwayOnwards ConwayEra)
 -> RIO e (UpdateProtocolParametersConwayOnwards ConwayEra))
-> ExceptT
     GovernanceActionsError
     IO
     (UpdateProtocolParametersConwayOnwards ConwayEra)
-> RIO e (UpdateProtocolParametersConwayOnwards ConwayEra)
forall a b. (a -> b) -> a -> b
$
      GovernanceActionsError
-> Maybe (UpdateProtocolParametersConwayOnwards ConwayEra)
-> ExceptT
     GovernanceActionsError
     IO
     (UpdateProtocolParametersConwayOnwards ConwayEra)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyShelleyBasedEra -> GovernanceActionsError
GovernanceActionsValueUpdateProtocolParametersNotFound AnyShelleyBasedEra
anyEra) (Maybe (UpdateProtocolParametersConwayOnwards ConwayEra)
 -> ExceptT
      GovernanceActionsError
      IO
      (UpdateProtocolParametersConwayOnwards ConwayEra))
-> Maybe (UpdateProtocolParametersConwayOnwards ConwayEra)
-> ExceptT
     GovernanceActionsError
     IO
     (UpdateProtocolParametersConwayOnwards ConwayEra)
forall a b. (a -> b) -> a -> b
$
        GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
-> Maybe (UpdateProtocolParametersConwayOnwards ConwayEra)
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (UpdateProtocolParametersConwayOnwards era)
uppConwayOnwards GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
args

  eraBasedPParams <- maybeAddUpdatedCostModel args

  depositStakeCredential <-
    getStakeCredentialFromIdentifier returnAddr'

  let updateProtocolParams = ShelleyBasedEra ConwayEra
-> EraBasedProtocolParametersUpdate ConwayEra
-> PParamsUpdate (ShelleyLedgerEra ConwayEra)
forall era.
ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
createEraBasedProtocolParamUpdate ShelleyBasedEra ConwayEra
sbe EraBasedProtocolParametersUpdate ConwayEra
eraBasedPParams

      prevGovActId = Maybe (GovPurposeId 'PParamUpdatePurpose)
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'PParamUpdatePurpose)
 -> StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
-> Maybe (GovPurposeId 'PParamUpdatePurpose)
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
forall a b. (a -> b) -> a -> b
$ GovActionId -> GovPurposeId 'PParamUpdatePurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
L.GovPurposeId (GovActionId -> GovPurposeId 'PParamUpdatePurpose)
-> Maybe GovActionId -> Maybe (GovPurposeId 'PParamUpdatePurpose)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GovActionId
mPrevGovActId
      proposalAnchor =
        L.Anchor
          { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl'
          , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
proposalHash'
          }

  fromExceptTCli $ carryHashChecks checkProposalHash' proposalAnchor ProposalCheck

  let govAct =
        StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> PParamsUpdate (ShelleyLedgerEra ConwayEra)
-> StrictMaybe ScriptHash
-> GovernanceAction ConwayEra
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe ScriptHash
-> GovernanceAction era
UpdatePParams
          StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
prevGovActId
          PParamsUpdate (ShelleyLedgerEra ConwayEra)
updateProtocolParams
          (ScriptHash -> ScriptHash
toShelleyScriptHash (ScriptHash -> ScriptHash)
-> StrictMaybe ScriptHash -> StrictMaybe ScriptHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScriptHash -> StrictMaybe ScriptHash
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe Maybe ScriptHash
mConstitutionalScriptHash)

  let proposalProcedure = ShelleyBasedEra ConwayEra
-> Network
-> Coin
-> StakeCredential
-> GovernanceAction ConwayEra
-> Anchor
-> Proposal ConwayEra
forall era.
ShelleyBasedEra era
-> Network
-> Coin
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
createProposalProcedure ShelleyBasedEra ConwayEra
sbe Network
network Coin
deposit' StakeCredential
depositStakeCredential GovernanceAction ConwayEra
govAct Anchor
proposalAnchor

  fromEitherIOCli @(FileError ()) $
    shelleyBasedEraConstraints sbe $
      writeFileTextEnvelope oFp (Just "Update protocol parameters proposal") proposalProcedure

shelleyToBabbageProtocolParametersUpdate
  :: Typeable era
  => ShelleyBasedEra era
  -> GovernanceActionProtocolParametersUpdateCmdArgs era
  -> CIO e ()
shelleyToBabbageProtocolParametersUpdate :: forall era e.
Typeable era =>
ShelleyBasedEra era
-> GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
shelleyToBabbageProtocolParametersUpdate ShelleyBasedEra era
sbe GovernanceActionProtocolParametersUpdateCmdArgs era
args = do
  let oFp :: File () 'Out
oFp = GovernanceActionProtocolParametersUpdateCmdArgs era -> File () 'Out
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era -> File () 'Out
uppFilePath GovernanceActionProtocolParametersUpdateCmdArgs era
args
      anyEra :: AnyShelleyBasedEra
anyEra = ShelleyBasedEra era -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra era
sbe
  UpdateProtocolParametersPreConway _stB expEpoch genesisVerKeys <-
    ExceptT
  GovernanceActionsError IO (UpdateProtocolParametersPreConway era)
-> RIO e (UpdateProtocolParametersPreConway era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT
   GovernanceActionsError IO (UpdateProtocolParametersPreConway era)
 -> RIO e (UpdateProtocolParametersPreConway era))
-> ExceptT
     GovernanceActionsError IO (UpdateProtocolParametersPreConway era)
-> RIO e (UpdateProtocolParametersPreConway era)
forall a b. (a -> b) -> a -> b
$
      GovernanceActionsError
-> Maybe (UpdateProtocolParametersPreConway era)
-> ExceptT
     GovernanceActionsError IO (UpdateProtocolParametersPreConway era)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyShelleyBasedEra -> GovernanceActionsError
GovernanceActionsValueUpdateProtocolParametersNotFound AnyShelleyBasedEra
anyEra) (Maybe (UpdateProtocolParametersPreConway era)
 -> ExceptT
      GovernanceActionsError IO (UpdateProtocolParametersPreConway era))
-> Maybe (UpdateProtocolParametersPreConway era)
-> ExceptT
     GovernanceActionsError IO (UpdateProtocolParametersPreConway era)
forall a b. (a -> b) -> a -> b
$
        GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (UpdateProtocolParametersPreConway era)
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (UpdateProtocolParametersPreConway era)
uppPreConway GovernanceActionProtocolParametersUpdateCmdArgs era
args

  eraBasedPParams <- maybeAddUpdatedCostModel args

  let updateProtocolParams = ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
createEraBasedProtocolParamUpdate ShelleyBasedEra era
sbe EraBasedProtocolParametersUpdate era
eraBasedPParams
      apiUpdateProtocolParamsType = ShelleyBasedEra era
-> PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall era.
ShelleyBasedEra era
-> PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
sbe PParamsUpdate (ShelleyLedgerEra era)
updateProtocolParams

  genVKeys <-
    sequence
      [ fromEitherIOCli $
          readFileTextEnvelope vkeyFile
      | vkeyFile <- genesisVerKeys
      ]

  let genKeyHashes = (VerificationKey GenesisKey -> Hash GenesisKey)
-> [VerificationKey GenesisKey] -> [Hash GenesisKey]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VerificationKey GenesisKey -> Hash GenesisKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash [VerificationKey GenesisKey]
genVKeys
      upProp = ProtocolParametersUpdate
-> [Hash GenesisKey] -> EpochNo -> UpdateProposal
makeShelleyUpdateProposal ProtocolParametersUpdate
apiUpdateProtocolParamsType [Hash GenesisKey]
genKeyHashes EpochNo
expEpoch

  fromEitherIOCli @(FileError ()) $
    shelleyBasedEraConstraints sbe $
      writeLazyByteStringFile oFp $
        textEnvelopeToJSON Nothing upProp