Replace caseShelleyToBabbageOrConwayEraOnwards with inEonForShelleyBasedEra

.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.

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

@@ -1,14 +1,11 @@
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.CLI.Compatible.Governance.Option
   ( pCompatibleGovernanceCmds
   )
 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
 

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

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]
   }
 

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

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