introducing experimental eras code

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

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
 

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,17 @@ pAnyEraCommand envCli =
     ]
 
 pCmds :: ShelleyBasedEra era -> EnvCli -> Parser (Cmds era)
-pCmds era envCli =
+pCmds sbe envCli =
   asum $
     catMaybes
-      [ fmap AddressCmds <$> pAddressCmds (toCardanoEra era) envCli
+      [ fmap AddressCmds <$> pAddressCmds (toCardanoEra sbe) envCli
       , fmap KeyCmds <$> pKeyCmds
-      , fmap GenesisCmds <$> pGenesisCmds (toCardanoEra era) envCli
-      , fmap GovernanceCmds <$> pGovernanceCmds (toCardanoEra era)
+      , fmap GenesisCmds <$> pGenesisCmds (toCardanoEra sbe) envCli
+      , fmap GovernanceCmds <$> pGovernanceCmds (toCardanoEra sbe)
       , fmap NodeCmds <$> pNodeCmds
-      , fmap QueryCmds <$> pQueryCmds (toCardanoEra era) envCli
-      , fmap StakeAddressCmds <$> pStakeAddressCmds (toCardanoEra era) envCli
-      , fmap StakePoolCmds <$> pStakePoolCmds (toCardanoEra era) envCli
+      , fmap QueryCmds <$> pQueryCmds (toCardanoEra sbe) envCli
+      , fmap StakeAddressCmds <$> pStakeAddressCmds (toCardanoEra sbe) envCli
+      , fmap StakePoolCmds <$> pStakePoolCmds (toCardanoEra sbe) 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

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

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

@@ -36,6 +36,7 @@ where
 
 import           Cardano.Api
 import           Cardano.Api.Byron hiding (SomeByronSigningKey (..))
+import qualified Cardano.Api.Experimental as Exp
 import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley
 
@@ -103,12 +104,13 @@ runTransactionCmds = \case
 --
 
 runTransactionBuildCmd
-  :: ()
+  :: forall era
+   . ()
   => Cmd.TransactionBuildCmdArgs era
   -> ExceptT TxCmdError IO ()
 runTransactionBuildCmd
   Cmd.TransactionBuildCmdArgs
-    { eon
+    { era
     , nodeSocketPath
     , consensusModeParams
     , networkId = networkId
@@ -135,8 +137,9 @@ runTransactionBuildCmd
     , proposalFiles
     , treasuryDonation -- Maybe TxTreasuryDonation
     , buildOutputOptions
-    } = shelleyBasedEraConstraints eon $ do
-    let era = toCardanoEra eon
+    } = do
+    let eon = Exp.eraToSbe era
+        era' = toCardanoEra eon :: CardanoEra era
 
     -- The user can specify an era prior to the era that the node is currently in.
     -- We cannot use the user specified era to construct a query against a node because it may differ
@@ -159,7 +162,8 @@ runTransactionBuildCmd
         [ fmap
             (,mSwit)
             ( firstExceptT TxCmdReadTextViewFileError . newExceptT $
-                readFileTextEnvelope AsCertificate (File certFile)
+                shelleyBasedEraConstraints eon $
+                  readFileTextEnvelope AsCertificate (File certFile)
             )
         | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits
         ]
@@ -192,7 +196,7 @@ runTransactionBuildCmd
       inEonForEra
         (pure mempty)
         (\w -> firstExceptT TxCmdVoteError $ ExceptT (readVotingProceduresFiles w voteFiles))
-        era
+        era'
 
     proposals <-
       newExceptT $
@@ -237,7 +241,7 @@ runTransactionBuildCmd
             (Just td, Just ctv) -> Just (ctv, td)
 
     -- We need to construct the txBodycontent outside of runTxBuild
-    BalancedTxBody txBodyContent balancedTxBody _ _ <-
+    BalancedTxBody txBodyContent unsignedTx@(Exp.UnsignedTx balancedTxBody) _ _ <-
       runTxBuild
         eon
         nodeSocketPath
@@ -273,24 +277,24 @@ runTransactionBuildCmd
 
         pparams <- pure mTxProtocolParams & onNothing (left TxCmdProtocolParametersNotPresentInTxBody)
         executionUnitPrices <-
-          pure (getExecutionUnitPrices era pparams) & onNothing (left TxCmdPParamExecutionUnitsNotAvailable)
+          pure (getExecutionUnitPrices era' pparams) & onNothing (left TxCmdPParamExecutionUnitsNotAvailable)
 
         Refl <-
-          testEquality era nodeEra
-            & hoistMaybe (TxCmdTxNodeEraMismatchError $ NodeEraMismatchError era nodeEra)
+          testEquality era' nodeEra
+            & hoistMaybe (TxCmdTxNodeEraMismatchError $ NodeEraMismatchError era' nodeEra)
 
         scriptExecUnitsMap <-
           firstExceptT (TxCmdTxExecUnitsErr . AnyTxCmdTxExecUnitsErr) $
             hoistEither $
-              evaluateTransactionExecutionUnits
-                era
+              evaluateTransactionExecutionUnitsShelley
+                eon
                 systemStart
                 (toLedgerEpochInfo eraHistory)
                 pparams
                 txEraUtxo
-                balancedTxBody
+                (Exp.obtainCommonConstraints era balancedTxBody)
 
-        let mScriptWits = forEraInEon era [] $ \sbe -> collectTxBodyScriptWitnesses sbe txBodyContent
+        let mScriptWits = forEraInEon era' [] $ \sbe -> collectTxBodyScriptWitnesses sbe txBodyContent
 
         scriptCostOutput <-
           firstExceptT TxCmdPlutusScriptCostErr $
@@ -301,10 +305,10 @@ runTransactionBuildCmd
                 mScriptWits
                 scriptExecUnitsMap
         liftIO $ LBS.writeFile (unFile fp) $ encodePretty scriptCostOutput
-      OutputTxBodyOnly fpath ->
-        let noWitTx = makeSignedTransaction [] balancedTxBody
-         in lift (cardanoEraConstraints era $ writeTxFileTextEnvelopeCddl eon fpath noWitTx)
-              & onLeft (left . TxCmdWriteFileError)
+      OutputTxBodyOnly fpath -> do
+        let noWitTx = ShelleyTx eon $ Exp.obtainCommonConstraints era $ Exp.signTx era [] [] unsignedTx
+        lift (writeTxFileTextEnvelopeCddl eon fpath noWitTx)
+          & onLeft (left . TxCmdWriteFileError)
 
 runTransactionBuildEstimateCmd
   :: ()
@@ -342,6 +346,10 @@ runTransactionBuildEstimateCmd -- TODO change type
     , txBodyOutFile
     } = do
     let sbe = maryEraOnwardsToShelleyBasedEra eon
+    let era' = toCardanoEra eon
+    beo <- forEraMaybeEon @BabbageEraOnwards era' & hoistMaybe (error "FIXME error out on < babbage")
+    let era = Exp.babbageEraOnwardsToEra beo
+
     ledgerPParams <-
       firstExceptT TxCmdProtocolParamsError $ readProtocolParameters sbe protocolParamsFile
     inputsAndMaybeScriptWits <-
@@ -442,7 +450,7 @@ runTransactionBuildEstimateCmd -- TODO change type
                 collectTxBodyScriptWitnesses sbe txBodyContent
             ]
 
-    BalancedTxBody _ balancedTxBody _ _ <-
+    BalancedTxBody _ unsignedTx _ _ <-
       hoistEither $
         first TxCmdFeeEstimationError $
           estimateBalancedTxBody
@@ -460,7 +468,7 @@ runTransactionBuildEstimateCmd -- TODO change type
             (anyAddressInShelleyBasedEra sbe changeAddr)
             totalUTxOValue
 
-    let noWitTx = makeSignedTransaction [] balancedTxBody
+    let noWitTx = ShelleyTx sbe $ Exp.obtainCommonConstraints era $ Exp.signTx era [] [] unsignedTx
     lift (writeTxFileTextEnvelopeCddl sbe txBodyOutFile noWitTx)
       & onLeft (left . TxCmdWriteFileError)
 
@@ -759,7 +767,7 @@ runTxBuildRaw
         proposals
         mCurrentTreasuryValueAndDonation
 
-    first TxCmdTxBodyError $ createAndValidateTransactionBody sbe txBodyContent
+    first TxCmdTxBodyError $ createTransactionBody sbe txBodyContent
 
 constructTxBodyContent
   :: forall era
@@ -1330,7 +1338,7 @@ createTxMintValue
   -> (Value, [ScriptWitness WitCtxMint era])
   -> Either TxCmdError (TxMintValue BuildTx era)
 createTxMintValue era (val, scriptWitnesses) =
-  if List.null (valueToList val) && List.null scriptWitnesses
+  if List.null (toList val) && List.null scriptWitnesses
     then return TxMintNone
     else do
       caseShelleyToAllegraOrMaryEraOnwards
@@ -1339,7 +1347,7 @@ createTxMintValue era (val, scriptWitnesses) =
             -- The set of policy ids for which we need witnesses:
             let witnessesNeededSet :: Set PolicyId
                 witnessesNeededSet =
-                  fromList [pid | (AssetId pid _, _) <- valueToList val]
+                  fromList [pid | (AssetId pid _, _) <- toList val]
 
             let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
                 witnessesProvidedMap = fromList $ gatherMintingWitnesses scriptWitnesses