Remove eras older than Babbag support in transaction build

cardano-cli/src/Cardano/CLI/Environment.hs

@@ -4,18 +4,19 @@
 -- | This module defines constants derived from the environment.
 module Cardano.CLI.Environment
  ( EnvCli (..)
- , envCliAnyShelleyBasedEra
- , envCliAnyShelleyToBabbageEra
+ , envCliSomeEra
+ , envCliAnyEon
  , getEnvCli
  , getEnvNetworkId
  , getEnvSocketPath
  )
 where
 
-import Cardano.Api (AnyCardanoEra (..), CardanoEra (..), EraInEon (..), NetworkId (..),
- NetworkMagic (..), ShelleyBasedEra (..), ShelleyToBabbageEra (..),
- forEraInEonMaybe)
+import Cardano.Api (AnyCardanoEra (..), CardanoEra (..), Eon, EraInEon (..),
+ NetworkId (..), NetworkMagic (..), forEraInEonMaybe)
+import qualified Cardano.Api.Experimental as Exp
 
+import Data.Typeable
 import Data.Word (Word32)
 import qualified System.Environment as IO
 import qualified System.IO as IO
@@ -40,13 +41,13 @@ getEnvCli = do
  , envCliAnyCardanoEra = mCardanoEra
  }
 
-envCliAnyShelleyBasedEra :: EnvCli -> Maybe (EraInEon ShelleyBasedEra)
-envCliAnyShelleyBasedEra envCli = do
+envCliSomeEra :: EnvCli -> Maybe (Exp.Some Exp.Era)
+envCliSomeEra envCli = do
  AnyCardanoEra era <- envCliAnyCardanoEra envCli
- forEraInEonMaybe era EraInEon
+ forEraInEonMaybe era Exp.Some
 
-envCliAnyShelleyToBabbageEra :: EnvCli -> Maybe (EraInEon ShelleyToBabbageEra)
-envCliAnyShelleyToBabbageEra envCli = do
+envCliAnyEon :: Typeable eon => Eon eon => EnvCli -> Maybe (EraInEon eon)
+envCliAnyEon envCli = do
  AnyCardanoEra era <- envCliAnyCardanoEra envCli
  forEraInEonMaybe era EraInEon
 

cardano-cli/src/Cardano/CLI/EraBased/Commands.hs

@@ -20,7 +20,7 @@ import Cardano.CLI.EraBased.Commands.Key
 import Cardano.CLI.EraBased.Commands.Node
 import Cardano.CLI.EraBased.Commands.Query
 import Cardano.CLI.EraBased.Commands.StakeAddress
-import Cardano.CLI.EraBased.Commands.StakePool
+import Cardano.CLI.EraBased.Commands.StakePool hiding (sbe)
 import Cardano.CLI.EraBased.Commands.TextView
 import Cardano.CLI.EraBased.Commands.Transaction
 import Cardano.CLI.EraBased.Options.Address
@@ -113,17 +113,18 @@ pAnyEraCommand envCli =
  ]
 
 pCmds :: ShelleyBasedEra era -> EnvCli -> Parser (Cmds era)
-pCmds era envCli =
+pCmds sbe' envCli = do
+ let cEra = toCardanoEra sbe'
  asum $
  catMaybes
- [ fmap AddressCmds <$> pAddressCmds (toCardanoEra era) envCli
+ [ fmap AddressCmds <$> pAddressCmds cEra envCli
  , fmap KeyCmds <$> pKeyCmds
- , fmap GenesisCmds <$> pGenesisCmds (toCardanoEra era) envCli
- , fmap GovernanceCmds <$> pGovernanceCmds (toCardanoEra era)
+ , fmap GenesisCmds <$> pGenesisCmds cEra envCli
+ , fmap GovernanceCmds <$> pGovernanceCmds cEra
  , fmap NodeCmds <$> pNodeCmds
- , fmap QueryCmds <$> pQueryCmds (toCardanoEra era) envCli
- , fmap StakeAddressCmds <$> pStakeAddressCmds (toCardanoEra era) envCli
- , fmap StakePoolCmds <$> pStakePoolCmds (toCardanoEra era) envCli
+ , fmap QueryCmds <$> pQueryCmds cEra envCli
+ , fmap StakeAddressCmds <$> pStakeAddressCmds cEra envCli
+ , fmap StakePoolCmds <$> pStakePoolCmds cEra envCli
  , fmap TextViewCmds <$> pTextViewCmds
- , fmap TransactionCmds <$> pTransactionCmds era envCli
+ , fmap TransactionCmds <$> pTransactionCmds sbe' envCli
  ]

cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs

@@ -21,6 +21,7 @@ module Cardano.CLI.EraBased.Commands.Transaction
  )
 where
 
+import qualified Cardano.Api.Experimental as Exp
 import Cardano.Api.Ledger (Coin)
 import Cardano.Api.Shelley
 
@@ -87,7 +88,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
 
 -- | Like 'TransactionBuildRaw' but without the fee, and with a change output.
 data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
- { eon :: !(ShelleyBasedEra era)
+ { era :: !(Exp.Era era)
  , nodeSocketPath :: !SocketPath
  , consensusModeParams :: !ConsensusModeParams
  , networkId :: !NetworkId
@@ -135,7 +136,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
 
 -- | Like 'TransactionBuildCmd' but does not require explicit access to a running node
 data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
- { eon :: !(MaryEraOnwards era)
+ { era :: !(Exp.Era era)
  , mScriptValidity :: !(Maybe ScriptValidity)
  -- ^ Mark script as expected to pass or fail validation
  , shelleyWitnesses :: !Int

cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs

@@ -16,8 +16,7 @@ import Cardano.Api
 import qualified Cardano.Api.Ledger as L
 import Cardano.Api.Shelley
 
-import Cardano.CLI.Environment (EnvCli (..), envCliAnyShelleyBasedEra,
- envCliAnyShelleyToBabbageEra)
+import Cardano.CLI.Environment (EnvCli (..), envCliAnyEon)
 import Cardano.CLI.Parser
 import Cardano.CLI.Read
 import Cardano.CLI.Types.Common
@@ -379,7 +378,7 @@ pAnyShelleyBasedEra envCli =
  , Opt.flag' (EraInEon ShelleyBasedEraConway) $
  mconcat [Opt.long "conway-era", Opt.help "Specify the Conway era"]
  ]
- , maybeToList $ pure <$> envCliAnyShelleyBasedEra envCli
+ , maybeToList $ pure <$> envCliAnyEon envCli
  , pure . pure $ EraInEon ShelleyBasedEraBabbage
  ]
 
@@ -402,7 +401,7 @@ pAnyShelleyToBabbageEra envCli =
  , Opt.flag' (EraInEon ShelleyToBabbageEraBabbage) $
  mconcat [Opt.long "babbage-era", Opt.help $ "Specify the Babbage era (default)" <> deprecationText]
  ]
- , maybeToList $ pure <$> envCliAnyShelleyToBabbageEra envCli
+ , maybeToList $ pure <$> envCliAnyEon envCli
  , pure . pure $ EraInEon ShelleyToBabbageEraBabbage
  ]
 
@@ -417,7 +416,7 @@ pShelleyBasedShelley envCli =
  , maybeToList $
  fmap pure $
  mfilter (== EraInEon ShelleyBasedEraShelley) $
- envCliAnyShelleyBasedEra envCli
+ envCliAnyEon envCli
  ]
 
 pShelleyBasedAllegra :: EnvCli -> Parser (EraInEon ShelleyBasedEra)
@@ -431,7 +430,7 @@ pShelleyBasedAllegra envCli =
  , maybeToList $
  fmap pure $
  mfilter (== EraInEon ShelleyBasedEraAllegra) $
- envCliAnyShelleyBasedEra envCli
+ envCliAnyEon envCli
  ]
 
 pShelleyBasedMary :: EnvCli -> Parser (EraInEon ShelleyBasedEra)
@@ -445,7 +444,7 @@ pShelleyBasedMary envCli =
  , maybeToList $
  fmap pure $
  mfilter (== EraInEon ShelleyBasedEraMary) $
- envCliAnyShelleyBasedEra envCli
+ envCliAnyEon envCli
  ]
 
 pShelleyBasedAlonzo :: EnvCli -> Parser (EraInEon ShelleyBasedEra)
@@ -459,7 +458,7 @@ pShelleyBasedAlonzo envCli =
  , maybeToList $
  fmap pure $
  mfilter (== EraInEon ShelleyBasedEraAlonzo) $
- envCliAnyShelleyBasedEra envCli
+ envCliAnyEon envCli
  ]
 
 pShelleyBasedBabbage :: EnvCli -> Parser (EraInEon ShelleyBasedEra)
@@ -473,7 +472,7 @@ pShelleyBasedBabbage envCli =
  , maybeToList $
  fmap pure $
  mfilter (== EraInEon ShelleyBasedEraBabbage) $
- envCliAnyShelleyBasedEra envCli
+ envCliAnyEon envCli
  ]
 
 pShelleyBasedConway :: EnvCli -> Parser (EraInEon ShelleyBasedEra)
@@ -487,7 +486,7 @@ pShelleyBasedConway envCli =
  , maybeToList $
  fmap pure $
  mfilter (== EraInEon ShelleyBasedEraConway) $
- envCliAnyShelleyBasedEra envCli
+ envCliAnyEon envCli
  ]
 
 pFileOutDirection :: String -> String -> Parser (File a Out)

cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs

@@ -10,9 +10,10 @@ module Cardano.CLI.EraBased.Options.Transaction
 where
 
 import Cardano.Api hiding (QueryInShelleyBasedEra (..))
+import qualified Cardano.Api.Experimental as Exp
 
 import Cardano.CLI.Environment (EnvCli (..))
-import Cardano.CLI.EraBased.Commands.Transaction
+import Cardano.CLI.EraBased.Commands.Transaction hiding (era)
 import Cardano.CLI.EraBased.Options.Common
 import Cardano.CLI.Types.Common
 
@@ -147,8 +148,10 @@ pScriptValidity =
  ]
  ]
 
-pTransactionBuildCmd :: ShelleyBasedEra era -> EnvCli -> Maybe (Parser (TransactionCmds era))
-pTransactionBuildCmd era envCli = do
+pTransactionBuildCmd
+ :: forall era. ShelleyBasedEra era -> EnvCli -> Maybe (Parser (TransactionCmds era))
+pTransactionBuildCmd sbe envCli = do
+ era <- forEraMaybeEon (toCardanoEra sbe)
  pure $
  subParser "build" $
  Opt.info (pCmd era) $
@@ -167,10 +170,10 @@ pTransactionBuildCmd era envCli = do
  ]
  ]
  where
- pCmd :: ShelleyBasedEra era -> Parser (TransactionCmds era)
- pCmd sbe =
+ pCmd :: Exp.Era era -> Parser (TransactionCmds era)
+ pCmd era' = do
  fmap TransactionBuildCmd $
- TransactionBuildCmdArgs sbe
+ TransactionBuildCmdArgs era'
  <$> pSocketPath envCli
  <*> pConsensusModeParams
  <*> pNetworkId envCli
@@ -204,8 +207,10 @@ pTransactionBuildCmd era envCli = do
  <*> pTxBuildOutputOptions
 
 -- | Estimate the transaction fees without access to a live node.
-pTransactionBuildEstimateCmd :: MaryEraOnwards era -> EnvCli -> Maybe (Parser (TransactionCmds era))
-pTransactionBuildEstimateCmd era _envCli = do
+pTransactionBuildEstimateCmd
+ :: forall era. MaryEraOnwards era -> EnvCli -> Maybe (Parser (TransactionCmds era))
+pTransactionBuildEstimateCmd eon' _envCli = do
+ era <- forEraMaybeEon (toCardanoEra eon')
  pure $
  subParser "build-estimate" $
  Opt.info (pCmd era) $
@@ -225,11 +230,11 @@ pTransactionBuildEstimateCmd era _envCli = do
  ]
  ]
  where
- pCmd :: MaryEraOnwards era -> Parser (TransactionCmds era)
- pCmd w = do
- let sbe = maryEraOnwardsToShelleyBasedEra w
+ pCmd :: Exp.Era era -> Parser (TransactionCmds era)
+ pCmd era = do
+ let sbe = Exp.eraToSbe era
  fmap TransactionBuildEstimateCmd $
- TransactionBuildEstimateCmdArgs w
+ TransactionBuildEstimateCmdArgs era
  <$> optional pScriptValidity
  <*> pNumberOfShelleyKeyWitnesses
  <*> optional pNumberOfByronKeyWitnesses