Skip to content

Commit 4f54b91

Browse files
Jimbo4350Jimbo4350
committed
Replace caseShelleyToBabbageOrConwayEraOnwards with inEonForShelleyBasedEra
`caseShelleyToBabbageOrConwayEraOnwards` hands both branches an era witness, which most call sites did not need. Where the pre-Conway branch ignored its witness, this replaces the combinator with `inEonForShelleyBasedEra`. `pUpdateProtocolParametersCmd` was the one site that could not be converted directly, because it fed a `ShelleyToBabbageEra` into the `eon` field of `UpdateProtocolParametersPreConway`. That field was never read — the only consumer, `shelleyToBabbageProtocolParametersUpdate`, bound it as `_stB` — so it has been dropped, removing the seven-way match on the `ShelleyBasedEra` constructors that existed only to conjure the witness. The no-op `forShelleyBasedEraMaybeEon` lookup in `pGovernanceActionProtocolParametersUpdateCmd` collapses to `Just` for the same reason. No behaviour change: `create-protocol-parameters-update` is still registered for all five pre-Conway eras and for Conway onwards.
1 parent 13097aa commit 4f54b91

6 files changed

Lines changed: 76 additions & 70 deletions

File tree

‎.changes/replace-era-case-combinators.yml‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
project: cardano-cli
2+
pr: 1438
3+
kind:
4+
- refactoring
5+
description: |
6+
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.

‎cardano-cli/src/Cardano/CLI/Compatible/Governance/Option.hs‎

Lines changed: 57 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -33,22 +33,21 @@ pCompatibleGovernanceCmds
3333
pCompatibleGovernanceCmds sbe =
3434
asum $
3535
catMaybes
36-
[ caseShelleyToBabbageOrConwayEraOnwards
37-
( const $
38-
subInfoParser
39-
"governance"
40-
( Opt.progDesc $
41-
mconcat
42-
[ "Governance commands."
43-
]
44-
)
45-
[ pCreateMirCertificatesCmds sbe
46-
, pGovernanceGenesisKeyDelegationCertificate
47-
, fmap CreateCompatibleProtocolParametersUpdateCmd <$> pGovernanceActionCmds sbe
48-
]
36+
[ inEonForShelleyBasedEra
37+
( subInfoParser
38+
"governance"
39+
( Opt.progDesc $
40+
mconcat
41+
[ "Governance commands."
42+
]
43+
)
44+
[ pCreateMirCertificatesCmds sbe
45+
, pGovernanceGenesisKeyDelegationCertificate
46+
, fmap CreateCompatibleProtocolParametersUpdateCmd <$> pGovernanceActionCmds sbe
47+
]
4948
)
5049
( \w ->
51-
fmap LatestCompatibleGovernanceCmds <$> obtainCommonConstraints (convert w) Latest.pGovernanceCmds
50+
fmap LatestCompatibleGovernanceCmds <$> obtainCommonConstraints w Latest.pGovernanceCmds
5251
)
5352
sbe
5453
]
@@ -67,54 +66,56 @@ pGovernanceActionCmds sbe =
6766
]
6867

6968
pGovernanceActionProtocolParametersUpdateCmd
70-
:: ()
71-
=> ShelleyBasedEra era
69+
:: ShelleyBasedEra era
7270
-> Maybe (Parser (GovernanceActionProtocolParametersUpdateCmdArgs era))
73-
pGovernanceActionProtocolParametersUpdateCmd sbe = do
74-
w <- forShelleyBasedEraMaybeEon sbe
75-
pure $
76-
pUpdateProtocolParametersCmd w
71+
pGovernanceActionProtocolParametersUpdateCmd =
72+
Just . pUpdateProtocolParametersCmd
7773

7874
pUpdateProtocolParametersCmd
7975
:: ShelleyBasedEra era -> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era)
80-
pUpdateProtocolParametersCmd =
81-
caseShelleyToBabbageOrConwayEraOnwards
82-
( \shelleyToBab ->
83-
let sbe = convert shelleyToBab
84-
in Opt.hsubparser
85-
$ commandWithMetavar "create-protocol-parameters-update"
86-
$ Opt.info
87-
( GovernanceActionProtocolParametersUpdateCmdArgs
88-
(convert shelleyToBab)
89-
<$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab)
90-
<*> pure Nothing
91-
<*> pGovActionProtocolParametersUpdate sbe
92-
<*> pCostModelsFile sbe
93-
<*> pOutputFile
94-
)
95-
$ Opt.progDesc "Create a protocol parameters update."
96-
)
97-
( \conwayOnwards ->
98-
let sbe = convert conwayOnwards
99-
ppup = fmap Just (obtainCommonConstraints (convert conwayOnwards) pUpdateProtocolParametersPostConway)
100-
in Opt.hsubparser
101-
$ commandWithMetavar "create-protocol-parameters-update"
102-
$ Opt.info
103-
( GovernanceActionProtocolParametersUpdateCmdArgs
104-
(convert conwayOnwards)
105-
Nothing
106-
<$> ppup
107-
<*> pGovActionProtocolParametersUpdate sbe
108-
<*> pCostModelsFile sbe
109-
<*> pOutputFile
110-
)
111-
$ Opt.progDesc "Create a protocol parameters update."
112-
)
76+
pUpdateProtocolParametersCmd sbe =
77+
inEonForShelleyBasedEra (preConway sbe) postConway sbe
78+
where
79+
preConway
80+
:: ShelleyBasedEra era'
81+
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era')
82+
preConway sbe' =
83+
Opt.hsubparser
84+
$ commandWithMetavar "create-protocol-parameters-update"
85+
$ Opt.info
86+
( GovernanceActionProtocolParametersUpdateCmdArgs
87+
sbe'
88+
<$> fmap Just pUpdateProtocolParametersPreConway
89+
<*> pure Nothing
90+
<*> pGovActionProtocolParametersUpdate sbe'
91+
<*> pCostModelsFile sbe'
92+
<*> pOutputFile
93+
)
94+
$ Opt.progDesc "Create a protocol parameters update."
95+
96+
postConway
97+
:: ConwayEraOnwards era'
98+
-> Parser (GovernanceActionProtocolParametersUpdateCmdArgs era')
99+
postConway conwayOnwards =
100+
let sbe' = convert conwayOnwards
101+
ppup = fmap Just (obtainCommonConstraints (convert conwayOnwards) pUpdateProtocolParametersPostConway)
102+
in Opt.hsubparser
103+
$ commandWithMetavar "create-protocol-parameters-update"
104+
$ Opt.info
105+
( GovernanceActionProtocolParametersUpdateCmdArgs
106+
sbe'
107+
Nothing
108+
<$> ppup
109+
<*> pGovActionProtocolParametersUpdate sbe'
110+
<*> pCostModelsFile sbe'
111+
<*> pOutputFile
112+
)
113+
$ Opt.progDesc "Create a protocol parameters update."
113114

114115
pUpdateProtocolParametersPreConway
115-
:: ShelleyToBabbageEra era -> Parser (UpdateProtocolParametersPreConway era)
116-
pUpdateProtocolParametersPreConway shelleyToBab =
117-
UpdateProtocolParametersPreConway shelleyToBab
116+
:: Parser (UpdateProtocolParametersPreConway era)
117+
pUpdateProtocolParametersPreConway =
118+
UpdateProtocolParametersPreConway
118119
<$> pEpochNoUpdateProp
119120
<*> pProtocolParametersUpdateGenesisKeys
120121

‎cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -132,7 +132,7 @@ shelleyToBabbageProtocolParametersUpdate
132132
shelleyToBabbageProtocolParametersUpdate sbe args = do
133133
let oFp = uppFilePath args
134134
anyEra = AnyShelleyBasedEra sbe
135-
UpdateProtocolParametersPreConway _stB expEpoch genesisVerKeys <-
135+
UpdateProtocolParametersPreConway expEpoch genesisVerKeys <-
136136
fromExceptTCli $
137137
hoistMaybe (GovernanceActionsValueUpdateProtocolParametersNotFound anyEra) $
138138
uppPreConway args

‎cardano-cli/src/Cardano/CLI/Compatible/Governance/Types.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -38,8 +38,7 @@ data GovernanceActionProtocolParametersUpdateCmdArgs era
3838

3939
data UpdateProtocolParametersPreConway era
4040
= UpdateProtocolParametersPreConway
41-
{ eon :: !(ShelleyToBabbageEra era)
42-
, expiryEpoch :: !EpochNo
41+
{ expiryEpoch :: !EpochNo
4342
, genesisVerificationKeys :: ![VerificationKeyFile In]
4443
}
4544

‎cardano-cli/src/Cardano/CLI/Compatible/Transaction/Option.hs‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
{-# LANGUAGE LambdaCase #-}
55
{-# LANGUAGE RankNTypes #-}
66
{-# LANGUAGE ScopedTypeVariables #-}
7+
{-# LANGUAGE TypeApplications #-}
78

89
module Cardano.CLI.Compatible.Transaction.Option
910
( pAllCompatibleTransactionCommands
@@ -150,8 +151,8 @@ pTxOutDatum sbe =
150151

151152
pRefScriptFp :: ShelleyBasedEra era -> Parser ReferenceScriptAnyEra
152153
pRefScriptFp =
153-
caseShelleyToBabbageOrConwayEraOnwards
154-
(const $ pure ReferenceScriptAnyEraNone)
154+
inEonForShelleyBasedEra @ConwayEraOnwards
155+
(pure ReferenceScriptAnyEraNone)
155156
( const $
156157
ReferenceScriptAnyEra
157158
<$> parseFilePath "tx-out-reference-script-file" "Reference script input file."
@@ -163,7 +164,7 @@ pVoteFiles
163164
-> BalanceTxExecUnits
164165
-> Parser [(VoteFile In, Maybe AnyNonAssetScript)]
165166
pVoteFiles sbe bExUnits =
166-
caseShelleyToBabbageOrConwayEraOnwards
167-
(const $ pure [])
167+
inEonForShelleyBasedEra @ConwayEraOnwards
168+
(pure [])
168169
(const . many $ pVoteFile bExUnits)
169170
sbe

‎cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs‎

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -78,13 +78,12 @@ runCompatibleTransactionCmd
7878
]
7979

8080
(protocolUpdates, votes) :: (AnyProtocolUpdate era, AnyVote era) <-
81-
caseShelleyToBabbageOrConwayEraOnwards
82-
( const $ do
83-
case mUpdateProposal of
84-
Nothing -> return (NoPParamsUpdate sbe, NoVotes)
85-
Just p -> do
86-
pparamUpdate <- readUpdateProposalFile p
87-
return (pparamUpdate, NoVotes)
81+
inEonForShelleyBasedEra
82+
( case mUpdateProposal of
83+
Nothing -> return (NoPParamsUpdate sbe, NoVotes)
84+
Just p -> do
85+
pparamUpdate <- readUpdateProposalFile p
86+
return (pparamUpdate, NoVotes)
8887
)
8988
( \w ->
9089
case mProposalProcedure of

0 commit comments

Comments
 (0)