{-# 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 :: Typeable era => CompatibleGovernanceCmds era -> CIO e ()
runCompatibleGovernanceCmds :: forall era e.
Typeable era =>
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 ShelleyToBabbageEra era
sta VerificationKeyOrHashOrFile GenesisKey
genVk VerificationKeyOrHashOrFile GenesisDelegateKey
genDelegVk VerificationKeyOrHashOrFile VrfKey
vrfVk File () 'Out
out ->
    ShelleyToBabbageEra era
-> VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> File () 'Out
-> CIO e ()
forall era e.
Typeable era =>
ShelleyToBabbageEra era
-> VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> File () 'Out
-> CIO e ()
runGovernanceGenesisKeyDelegationCertificate ShelleyToBabbageEra era
sta 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.
Typeable era =>
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.
Typeable era =>
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.
Typeable era =>
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
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'
    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
    -> EraBasedProtocolParametersUpdate era)
-> EraBasedProtocolParametersUpdate era
-> RIO e (EraBasedProtocolParametersUpdate era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoEraOnwards era
-> CostModels
-> EraBasedProtocolParametersUpdate era
-> EraBasedProtocolParametersUpdate era
forall era.
AlonzoEraOnwards era
-> CostModels
-> EraBasedProtocolParametersUpdate era
-> EraBasedProtocolParametersUpdate era
addCostModelsToEraBasedProtocolParametersUpdate AlonzoEraOnwards era
alonzoOnwards CostModels
costModels (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

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
    Era ConwayEra
_cOnwards
    Network
network
    Coin
deposit'
    StakeIdentifier
returnAddr'
    ProposalUrl
proposalUrl'
    SafeHash AnchorData
proposalHash'
    MustCheckHash ProposalUrl
checkProposalHash'
    Maybe GovActionId
mPrevGovActId
    Maybe ScriptHash
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

  EraBasedProtocolParametersUpdate ConwayEra
eraBasedPParams <- GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
-> CIO e (EraBasedProtocolParametersUpdate ConwayEra)
forall era e.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> CIO e (EraBasedProtocolParametersUpdate era)
maybeAddUpdatedCostModel GovernanceActionProtocolParametersUpdateCmdArgs ConwayEra
args

  StakeCredential
depositStakeCredential <-
    StakeIdentifier -> CIO e StakeCredential
forall e. StakeIdentifier -> CIO e StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
returnAddr'

  let updateProtocolParams :: PParamsUpdate (ShelleyLedgerEra ConwayEra)
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 :: StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
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 :: Anchor
proposalAnchor =
        L.Anchor
          { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl'
          , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
proposalHash'
          }

  ExceptT GovernanceActionsError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceActionsError IO () -> RIO e ())
-> ExceptT GovernanceActionsError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ MustCheckHash ProposalUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash' Anchor
proposalAnchor AnchorDataTypeCheck
ProposalCheck

  let govAct :: GovernanceAction ConwayEra
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 :: Proposal ConwayEra
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

  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
    ShelleyBasedEra ConwayEra
-> (ShelleyBasedEraConstraints ConwayEra =>
    IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra ConwayEra
sbe ((ShelleyBasedEraConstraints ConwayEra =>
  IO (Either (FileError ()) ()))
 -> IO (Either (FileError ()) ()))
-> (ShelleyBasedEraConstraints ConwayEra =>
    IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
      File () 'Out
-> Maybe TextEnvelopeDescr
-> Proposal ConwayEra
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope File () 'Out
oFp (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"Update protocol parameters proposal") Proposal ConwayEra
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 ShelleyToBabbageEra era
_stB EpochNo
expEpoch [VerificationKeyFile 'In]
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

  EraBasedProtocolParametersUpdate era
eraBasedPParams <- GovernanceActionProtocolParametersUpdateCmdArgs era
-> CIO e (EraBasedProtocolParametersUpdate era)
forall era e.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> CIO e (EraBasedProtocolParametersUpdate era)
maybeAddUpdatedCostModel GovernanceActionProtocolParametersUpdateCmdArgs era
args

  let updateProtocolParams :: PParamsUpdate (ShelleyLedgerEra era)
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 :: ProtocolParametersUpdate
apiUpdateProtocolParamsType = ShelleyBasedEra era
-> PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall era.
ShelleyBasedEra era
-> PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
sbe PParamsUpdate (ShelleyLedgerEra era)
updateProtocolParams

  [VerificationKey GenesisKey]
genVKeys <-
    [RIO e (VerificationKey GenesisKey)]
-> RIO e [VerificationKey GenesisKey]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
      [ IO
  (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> RIO e (VerificationKey GenesisKey)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
 -> RIO e (VerificationKey GenesisKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> RIO e (VerificationKey GenesisKey)
forall a b. (a -> b) -> a -> b
$
          VerificationKeyFile 'In
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope VerificationKeyFile 'In
vkeyFile
      | VerificationKeyFile 'In
vkeyFile <- [VerificationKeyFile 'In]
genesisVerKeys
      ]

  let genKeyHashes :: [Hash GenesisKey]
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 :: UpdateProposal
upProp = ProtocolParametersUpdate
-> [Hash GenesisKey] -> EpochNo -> UpdateProposal
makeShelleyUpdateProposal ProtocolParametersUpdate
apiUpdateProtocolParamsType [Hash GenesisKey]
genKeyHashes EpochNo
expEpoch

  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => IO (Either (FileError ()) ()))
 -> IO (Either (FileError ()) ()))
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
      File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
oFp (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
        Maybe TextEnvelopeDescr -> UpdateProposal -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing UpdateProposal
upProp