introducing experimental eras code

IntersectMBO · Sep 4, 2024 · 9440560 · 9440560
1 parent c9fbcda
commit 9440560
Show file tree

Hide file tree

Showing 21 changed files with 123 additions and 2,482 deletions.
diff --git a/cabal.project b/cabal.project
@@ -57,3 +57,10 @@ write-ghc-environment-files: always
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
+
+source-repository-package
+    type: git
+    location: https://github.com/input-output-hk/cardano-api
+    --sha256: sha256-4xuBSgNHfRxFSrHJn7aziKwQmR9ctPjyLl08Oz6jOh4=
+    tag: a9cabb04b7e61ffc95ad8aa9756e3807ead0e754
+    subdir: cardano-api
diff --git a/cardano-cli/src/Cardano/CLI/Environment.hs b/cardano-cli/src/Cardano/CLI/Environment.hs
@@ -4,18 +4,17 @@
 -- | This module defines constants derived from the environment.
 module Cardano.CLI.Environment
   ( EnvCli (..)
-  , envCliAnyShelleyBasedEra
-  , envCliAnyShelleyToBabbageEra
+  , 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           Data.Typeable
 import           Data.Word (Word32)
 import qualified System.Environment as IO
 import qualified System.IO as IO
@@ -40,13 +39,8 @@ getEnvCli = do
       , envCliAnyCardanoEra = mCardanoEra
       }
 
-envCliAnyShelleyBasedEra :: EnvCli -> Maybe (EraInEon ShelleyBasedEra)
-envCliAnyShelleyBasedEra envCli = do
-  AnyCardanoEra era <- envCliAnyCardanoEra envCli
-  forEraInEonMaybe era EraInEon
-
-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
 

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs b/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
       ]
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/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

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/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)

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/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,11 +148,13 @@ 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
+  beo <- forEraMaybeEon (toCardanoEra sbe)
   pure $
     subParser "build" $
-      Opt.info (pCmd era) $
+      Opt.info (pCmd beo) $
         Opt.progDescDoc $
           Just $
             mconcat
@@ -167,10 +170,10 @@ pTransactionBuildCmd era envCli = do
                     ]
               ]
  where
-  pCmd :: ShelleyBasedEra era -> Parser (TransactionCmds era)
-  pCmd sbe =
+  pCmd :: BabbageEraOnwards era -> Parser (TransactionCmds era)
+  pCmd beo = do
     fmap TransactionBuildCmd $
-      TransactionBuildCmdArgs sbe
+      TransactionBuildCmdArgs (Exp.babbageEraOnwardsToEra beo)
         <$> 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