diff --git a/.changes/replace-era-case-combinators.yml b/.changes/replace-era-case-combinators.yml new file mode 100644 index 0000000000..7f6f11bdbb --- /dev/null +++ b/.changes/replace-era-case-combinators.yml @@ -0,0 +1,6 @@ +project: cardano-cli +pr: 1438 +kind: + - refactoring +description: | + Replaced uses of cardano-api's `caseShelleyToBabbageOrConwayEraOnwards` with `inEonForShelleyBasedEra`, and dropped the unused `ShelleyToBabbageEra` witness from `UpdateProtocolParametersPreConway` so the pre-Conway protocol parameters update parser no longer needs an era case split. diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs index e9dfa2105c..762e7d2de1 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} module Cardano.CLI.Compatible.Governance.Option ( pCompatibleGovernanceCmds @@ -8,7 +6,6 @@ module Cardano.CLI.Compatible.Governance.Option where import Cardano.Api -import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.CLI.Compatible.Governance.Command import Cardano.CLI.Compatible.Governance.Types @@ -33,24 +30,29 @@ pCompatibleGovernanceCmds pCompatibleGovernanceCmds sbe = asum $ catMaybes - [ caseShelleyToBabbageOrConwayEraOnwards - ( const $ - subInfoParser - "governance" - ( Opt.progDesc $ - mconcat - [ "Governance commands." - ] - ) - [ pCreateMirCertificatesCmds sbe - , pGovernanceGenesisKeyDelegationCertificate - , fmap CreateCompatibleProtocolParametersUpdateCmd <$> pGovernanceActionCmds sbe - ] - ) - ( \w -> - fmap LatestCompatibleGovernanceCmds <$> obtainCommonConstraints (convert w) Latest.pGovernanceCmds - ) - sbe + [ case sbe of + ShelleyBasedEraShelley -> preConway + ShelleyBasedEraAllegra -> preConway + ShelleyBasedEraMary -> preConway + ShelleyBasedEraAlonzo -> preConway + ShelleyBasedEraBabbage -> preConway + ShelleyBasedEraConway -> + fmap LatestCompatibleGovernanceCmds <$> Latest.pGovernanceCmds + ShelleyBasedEraDijkstra -> + fmap LatestCompatibleGovernanceCmds <$> Latest.pGovernanceCmds + ] + where + preConway = + subInfoParser + "governance" + ( Opt.progDesc $ + mconcat + [ "Governance commands." + ] + ) + [ pCreateMirCertificatesCmds sbe + , pGovernanceGenesisKeyDelegationCertificate + , fmap CreateCompatibleProtocolParametersUpdateCmd <$> pGovernanceActionCmds sbe ] pGovernanceActionCmds @@ -63,58 +65,64 @@ pGovernanceActionCmds sbe = [ "Governance action commands." ] ) - [ pGovernanceActionProtocolParametersUpdateCmd sbe + [ Just $ pUpdateProtocolParametersCmd sbe ] -pGovernanceActionProtocolParametersUpdateCmd - :: () - => ShelleyBasedEra era - -> Maybe (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)) -pGovernanceActionProtocolParametersUpdateCmd sbe = do - w <- forShelleyBasedEraMaybeEon sbe - pure $ - pUpdateProtocolParametersCmd w - pUpdateProtocolParametersCmd :: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era) -pUpdateProtocolParametersCmd = - caseShelleyToBabbageOrConwayEraOnwards - ( \shelleyToBab -> - let sbe = convert shelleyToBab - in Opt.hsubparser - $ commandWithMetavar "create-protocol-parameters-update" - $ Opt.info - ( GovernanceActionProtocolParametersUpdateCmdArgs - (convert shelleyToBab) - <$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab) - <*> pure Nothing - <*> pGovActionProtocolParametersUpdate sbe - <*> pCostModelsFile sbe - <*> pOutputFile - ) - $ Opt.progDesc "Create a protocol parameters update." - ) - ( \conwayOnwards -> - let sbe = convert conwayOnwards - ppup = fmap Just (obtainCommonConstraints (convert conwayOnwards) pUpdateProtocolParametersPostConway) - in Opt.hsubparser - $ commandWithMetavar "create-protocol-parameters-update" - $ Opt.info - ( GovernanceActionProtocolParametersUpdateCmdArgs - (convert conwayOnwards) - Nothing - <$> ppup - <*> pGovActionProtocolParametersUpdate sbe - <*> pCostModelsFile sbe - <*> pOutputFile - ) - $ Opt.progDesc "Create a protocol parameters update." - ) +pUpdateProtocolParametersCmd sbe = + case sbe of + ShelleyBasedEraShelley -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraAllegra -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraMary -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraAlonzo -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraBabbage -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraConway -> pPostConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraDijkstra -> pPostConwayUpdateProtocolParametersCmd sbe + +pPreConwayUpdateProtocolParametersCmd + :: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era) +pPreConwayUpdateProtocolParametersCmd sbe = + Opt.hsubparser + $ commandWithMetavar "create-protocol-parameters-update" + $ Opt.info + ( GovernanceActionProtocolParametersUpdateCmdArgs sbe + <$> fmap Just pUpdateProtocolParametersPreConway + <*> pure Nothing + <*> pGovActionProtocolParametersUpdate sbe + <*> pCostModelsFile sbe + <*> pOutputFile + ) + $ Opt.progDesc "Create a protocol parameters update." + +pPostConwayUpdateProtocolParametersCmd + :: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era) +pPostConwayUpdateProtocolParametersCmd sbe = + Opt.hsubparser + $ commandWithMetavar "create-protocol-parameters-update" + $ Opt.info + ( GovernanceActionProtocolParametersUpdateCmdArgs sbe Nothing + <$> pConwayOnwards + <*> pGovActionProtocolParametersUpdate sbe + <*> pCostModelsFile sbe + <*> pOutputFile + ) + $ Opt.progDesc "Create a protocol parameters update." + where + pConwayOnwards = + case sbe of + ShelleyBasedEraShelley -> pure Nothing + ShelleyBasedEraAllegra -> pure Nothing + ShelleyBasedEraMary -> pure Nothing + ShelleyBasedEraAlonzo -> pure Nothing + ShelleyBasedEraBabbage -> pure Nothing + ShelleyBasedEraConway -> Just <$> pUpdateProtocolParametersPostConway + ShelleyBasedEraDijkstra -> Just <$> pUpdateProtocolParametersPostConway pUpdateProtocolParametersPreConway - :: ShelleyToBabbageEra era -> Parser (UpdateProtocolParametersPreConway era) -pUpdateProtocolParametersPreConway shelleyToBab = - UpdateProtocolParametersPreConway shelleyToBab + :: Parser (UpdateProtocolParametersPreConway era) +pUpdateProtocolParametersPreConway = + UpdateProtocolParametersPreConway <$> pEpochNoUpdateProp <*> pProtocolParametersUpdateGenesisKeys diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs index 3e30460737..21f7e40325 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs @@ -132,7 +132,7 @@ shelleyToBabbageProtocolParametersUpdate shelleyToBabbageProtocolParametersUpdate sbe args = do let oFp = uppFilePath args anyEra = AnyShelleyBasedEra sbe - UpdateProtocolParametersPreConway _stB expEpoch genesisVerKeys <- + UpdateProtocolParametersPreConway expEpoch genesisVerKeys <- fromExceptTCli $ hoistMaybe (GovernanceActionsValueUpdateProtocolParametersNotFound anyEra) $ uppPreConway args diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Types.hs b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Types.hs index 4fe79bc3a9..5c37fe5811 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Types.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Types.hs @@ -38,8 +38,7 @@ data GovernanceActionProtocolParametersUpdateCmdArgs era data UpdateProtocolParametersPreConway era = UpdateProtocolParametersPreConway - { eon :: !(ShelleyToBabbageEra era) - , expiryEpoch :: !EpochNo + { expiryEpoch :: !EpochNo , genesisVerificationKeys :: ![VerificationKeyFile In] } diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Option.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Option.hs index 7cea1d92a2..8ded828e58 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Option.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Option.hs @@ -4,6 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.CLI.Compatible.Transaction.Option ( pAllCompatibleTransactionCommands @@ -150,8 +151,8 @@ pTxOutDatum sbe = pRefScriptFp :: ShelleyBasedEra era -> Parser ReferenceScriptAnyEra pRefScriptFp = - caseShelleyToBabbageOrConwayEraOnwards - (const $ pure ReferenceScriptAnyEraNone) + inEonForShelleyBasedEra @ConwayEraOnwards + (pure ReferenceScriptAnyEraNone) ( const $ ReferenceScriptAnyEra <$> parseFilePath "tx-out-reference-script-file" "Reference script input file." @@ -163,7 +164,7 @@ pVoteFiles -> BalanceTxExecUnits -> Parser [(VoteFile In, Maybe AnyNonAssetScript)] pVoteFiles sbe bExUnits = - caseShelleyToBabbageOrConwayEraOnwards - (const $ pure []) + inEonForShelleyBasedEra @ConwayEraOnwards + (pure []) (const . many $ pVoteFile bExUnits) sbe diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs index dae4b1e91e..1b80825768 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs @@ -78,13 +78,12 @@ runCompatibleTransactionCmd ] (protocolUpdates, votes) :: (AnyProtocolUpdate era, AnyVote era) <- - caseShelleyToBabbageOrConwayEraOnwards - ( const $ do - case mUpdateProposal of - Nothing -> return (NoPParamsUpdate sbe, NoVotes) - Just p -> do - pparamUpdate <- readUpdateProposalFile p - return (pparamUpdate, NoVotes) + inEonForShelleyBasedEra + ( case mUpdateProposal of + Nothing -> return (NoPParamsUpdate sbe, NoVotes) + Just p -> do + pparamUpdate <- readUpdateProposalFile p + return (pparamUpdate, NoVotes) ) ( \w -> case mProposalProcedure of