From 9dfb018025f7731897320bcbf887696963ae123e Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 3 Sep 2026 13:51:10 -0400 Subject: [PATCH 1/3] Replace caseShelleyToBabbageOrConwayEraOnwards with inEonForShelleyBasedEra MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `caseShelleyToBabbageOrConwayEraOnwards` hands both branches an era witness, which most call sites did not need. Where a branch ignored its witness, this replaces the combinator with `inEonForShelleyBasedEra`. `pUpdateProtocolParametersCmd` looked like it needed both witnesses, but the pre-Conway one was not load-bearing: it only fed a `ShelleyToBabbageEra` into the `eon` field of `UpdateProtocolParametersPreConway`, and nothing ever read that field — the only consumer, `shelleyToBabbageProtocolParametersUpdate`, bound it as `_stB`. The field is dropped, which removes the seven-way match on the `ShelleyBasedEra` constructors that existed only to conjure the witness. The Conway branch keeps its `ConwayEraOnwards`, since `pUpdateProtocolParametersPostConway` needs the `Exp.IsEra` constraint and neither `ShelleyBasedEra` nor `conwayEraOnwardsConstraints` can supply it. With the pre-Conway witness gone the branches are identical apart from which of the two optional payloads they populate, so the shared command scaffolding moves into `mkCmd`. Also folds away the no-op `forShelleyBasedEraMaybeEon` lookup in `pGovernanceActionProtocolParametersUpdateCmd`, and drops the `DataKinds`, `GADTs` and `ScopedTypeVariables` pragmas, which the module no longer needs. No change to the executable's interface: `create-protocol-parameters-update` is still registered for all five pre-Conway eras and for Conway onwards, with identical help output. --- .changes/replace-era-case-combinators.yml | 6 + .../CLI/Compatible/Governance/Option.hs | 122 ++++++++---------- .../Cardano/CLI/Compatible/Governance/Run.hs | 2 +- .../CLI/Compatible/Governance/Types.hs | 3 +- .../CLI/Compatible/Transaction/Option.hs | 9 +- .../Cardano/CLI/Compatible/Transaction/Run.hs | 13 +- 6 files changed, 76 insertions(+), 79 deletions(-) create mode 100644 .changes/replace-era-case-combinators.yml 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..a9f23c5086 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs @@ -1,14 +1,10 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} - module Cardano.CLI.Compatible.Governance.Option ( pCompatibleGovernanceCmds ) where import Cardano.Api -import Cardano.Api.Experimental (obtainCommonConstraints) +import Cardano.Api.Experimental qualified as Exp import Cardano.CLI.Compatible.Governance.Command import Cardano.CLI.Compatible.Governance.Types @@ -33,22 +29,21 @@ pCompatibleGovernanceCmds pCompatibleGovernanceCmds sbe = asum $ catMaybes - [ caseShelleyToBabbageOrConwayEraOnwards - ( const $ - subInfoParser - "governance" - ( Opt.progDesc $ - mconcat - [ "Governance commands." - ] - ) - [ pCreateMirCertificatesCmds sbe - , pGovernanceGenesisKeyDelegationCertificate - , fmap CreateCompatibleProtocolParametersUpdateCmd <$> pGovernanceActionCmds sbe - ] + [ inEonForShelleyBasedEra + ( subInfoParser + "governance" + ( Opt.progDesc $ + mconcat + [ "Governance commands." + ] + ) + [ pCreateMirCertificatesCmds sbe + , pGovernanceGenesisKeyDelegationCertificate + , fmap CreateCompatibleProtocolParametersUpdateCmd <$> pGovernanceActionCmds sbe + ] ) ( \w -> - fmap LatestCompatibleGovernanceCmds <$> obtainCommonConstraints (convert w) Latest.pGovernanceCmds + fmap LatestCompatibleGovernanceCmds <$> Exp.obtainCommonConstraints w Latest.pGovernanceCmds ) sbe ] @@ -63,58 +58,55 @@ 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 = + inEonForShelleyBasedEra (preConway sbe) postConway sbe + where + -- The two branches build the same command and differ only in which of the two + -- optional payloads they populate. + mkCmd + :: ShelleyBasedEra era' + -> Parser (Maybe (UpdateProtocolParametersPreConway era')) + -> Parser (Maybe (UpdateProtocolParametersConwayOnwards era')) + -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era') + mkCmd sbe' pPreConway pConwayOnwards = + Opt.hsubparser + $ commandWithMetavar "create-protocol-parameters-update" + $ Opt.info + ( GovernanceActionProtocolParametersUpdateCmdArgs sbe' + <$> pPreConway + <*> pConwayOnwards + <*> pGovActionProtocolParametersUpdate sbe' + <*> pCostModelsFile sbe' + <*> pOutputFile + ) + $ Opt.progDesc "Create a protocol parameters update." + + preConway + :: ShelleyBasedEra era' + -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era') + preConway sbe' = + mkCmd sbe' (Just <$> pUpdateProtocolParametersPreConway) (pure Nothing) + + postConway + :: ConwayEraOnwards era' + -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era') + postConway conwayOnwards = + mkCmd + (convert conwayOnwards) + (pure Nothing) + ( Just + <$> Exp.obtainCommonConstraints (convert conwayOnwards) 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 From 8f890fb7cdeec0f2c30f63a3a6e0ea7c8611b6c2 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 4 Sep 2026 10:08:08 -0400 Subject: [PATCH 2/3] Elaborate compatible governance parsers over all ShelleyBasedEra constructors inEonForShelleyBasedEra infers its eon from the branch that consumes the witness. In pCompatibleGovernanceCmds that was the experimental Era, whose membership shrinks as eras are retired: once Conway leaves it, Conway would silently take the pre-Conway branch and lose its governance commands, with no compilation error. Match on the ShelleyBasedEra constructors instead. The branches refine era to a concrete one, so IsEra resolves directly and no experimental witness needs to be threaded through this compatible module. pUpdateProtocolParametersCmd gets the same treatment, dropping its ConwayEraOnwards witness and the convert round trip to the experimental Era. --- .../CLI/Compatible/Governance/Option.hs | 72 ++++++++++--------- 1 file changed, 37 insertions(+), 35 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs index a9f23c5086..c9f685f790 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs @@ -1,10 +1,11 @@ +{-# LANGUAGE GADTs #-} + module Cardano.CLI.Compatible.Governance.Option ( pCompatibleGovernanceCmds ) where import Cardano.Api -import Cardano.Api.Experimental qualified as Exp import Cardano.CLI.Compatible.Governance.Command import Cardano.CLI.Compatible.Governance.Types @@ -29,23 +30,29 @@ pCompatibleGovernanceCmds pCompatibleGovernanceCmds sbe = asum $ catMaybes - [ inEonForShelleyBasedEra - ( subInfoParser - "governance" - ( Opt.progDesc $ - mconcat - [ "Governance commands." - ] - ) - [ pCreateMirCertificatesCmds sbe - , pGovernanceGenesisKeyDelegationCertificate - , fmap CreateCompatibleProtocolParametersUpdateCmd <$> pGovernanceActionCmds sbe - ] - ) - ( \w -> - fmap LatestCompatibleGovernanceCmds <$> Exp.obtainCommonConstraints 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 @@ -64,7 +71,16 @@ pGovernanceActionCmds sbe = pUpdateProtocolParametersCmd :: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era) pUpdateProtocolParametersCmd sbe = - inEonForShelleyBasedEra (preConway sbe) postConway sbe + case sbe of + ShelleyBasedEraShelley -> preConway + ShelleyBasedEraAllegra -> preConway + ShelleyBasedEraMary -> preConway + ShelleyBasedEraAlonzo -> preConway + ShelleyBasedEraBabbage -> preConway + ShelleyBasedEraConway -> + mkCmd sbe (pure Nothing) (Just <$> pUpdateProtocolParametersPostConway) + ShelleyBasedEraDijkstra -> + mkCmd sbe (pure Nothing) (Just <$> pUpdateProtocolParametersPostConway) where -- The two branches build the same command and differ only in which of the two -- optional payloads they populate. @@ -86,22 +102,8 @@ pUpdateProtocolParametersCmd sbe = ) $ Opt.progDesc "Create a protocol parameters update." - preConway - :: ShelleyBasedEra era' - -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era') - preConway sbe' = - mkCmd sbe' (Just <$> pUpdateProtocolParametersPreConway) (pure Nothing) - - postConway - :: ConwayEraOnwards era' - -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era') - postConway conwayOnwards = - mkCmd - (convert conwayOnwards) - (pure Nothing) - ( Just - <$> Exp.obtainCommonConstraints (convert conwayOnwards) pUpdateProtocolParametersPostConway - ) + preConway = + mkCmd sbe (Just <$> pUpdateProtocolParametersPreConway) (pure Nothing) pUpdateProtocolParametersPreConway :: Parser (UpdateProtocolParametersPreConway era) From 1722e58d62d032512504651ac9e642ed0177c277 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 4 Sep 2026 13:05:31 -0400 Subject: [PATCH 3/3] Split pUpdateProtocolParametersCmd into pre- and post-Conway parsers Replaces the shared mkCmd helper, which forced both branches to pass a 'pure Nothing' for the payload they do not populate. --- .../CLI/Compatible/Governance/Option.hs | 76 +++++++++++-------- 1 file changed, 45 insertions(+), 31 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs index c9f685f790..762e7d2de1 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs @@ -72,38 +72,52 @@ pUpdateProtocolParametersCmd :: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era) pUpdateProtocolParametersCmd sbe = case sbe of - ShelleyBasedEraShelley -> preConway - ShelleyBasedEraAllegra -> preConway - ShelleyBasedEraMary -> preConway - ShelleyBasedEraAlonzo -> preConway - ShelleyBasedEraBabbage -> preConway - ShelleyBasedEraConway -> - mkCmd sbe (pure Nothing) (Just <$> pUpdateProtocolParametersPostConway) - ShelleyBasedEraDijkstra -> - mkCmd sbe (pure Nothing) (Just <$> pUpdateProtocolParametersPostConway) - where - -- The two branches build the same command and differ only in which of the two - -- optional payloads they populate. - mkCmd - :: ShelleyBasedEra era' - -> Parser (Maybe (UpdateProtocolParametersPreConway era')) - -> Parser (Maybe (UpdateProtocolParametersConwayOnwards era')) - -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era') - mkCmd sbe' pPreConway pConwayOnwards = - Opt.hsubparser - $ commandWithMetavar "create-protocol-parameters-update" - $ Opt.info - ( GovernanceActionProtocolParametersUpdateCmdArgs sbe' - <$> pPreConway - <*> pConwayOnwards - <*> pGovActionProtocolParametersUpdate sbe' - <*> pCostModelsFile sbe' - <*> pOutputFile - ) - $ Opt.progDesc "Create a protocol parameters update." + ShelleyBasedEraShelley -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraAllegra -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraMary -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraAlonzo -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraBabbage -> pPreConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraConway -> pPostConwayUpdateProtocolParametersCmd sbe + ShelleyBasedEraDijkstra -> pPostConwayUpdateProtocolParametersCmd sbe - preConway = - mkCmd sbe (Just <$> pUpdateProtocolParametersPreConway) (pure Nothing) +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 :: Parser (UpdateProtocolParametersPreConway era)