Change Era from BabbageEra to ConwayEra (Draft Rebase)

docs/package.json

@@ -8,8 +8,8 @@
     "build": "yarn prepare && docusaurus build",
     "build-dev": "yarn prepare && docusaurus build --no-minify -l en",
     "start": "yarn dummy-spec && docusaurus start",
-    "validate:inputs": "./validate-api.js publish '/' '../hydra-node/golden/ReasonablySized (ClientInput (Tx BabbageEra)).json'",
-    "validate:outputs": "./validate-api.js subscribe '/' '../hydra-node/golden/ReasonablySized (TimedServerOutput (Tx BabbageEra)).json'",
+    "validate:inputs": "./validate-api.js publish '/' '../hydra-node/golden/ReasonablySized (ClientInput (Tx ConwayEra)).json'",
+    "validate:outputs": "./validate-api.js subscribe '/' '../hydra-node/golden/ReasonablySized (TimedServerOutput (Tx ConwayEra)).json'",
     "validate": "yarn validate:inputs && yarn validate:outputs",
     "swizzle": "docusaurus swizzle",
     "deploy": "docusaurus deploy",

hydra-cardano-api/hydra-cardano-api.cabal

@@ -92,7 +92,6 @@ library
     , cardano-ledger-babbage  >=1.6    && <1.7
     , cardano-ledger-binary   >=1.3    && <1.4
     , cardano-ledger-byron    >=1.0.0  && <1.1
-    , cardano-ledger-conway   >=1.12   && <1.13
     , cardano-ledger-core     >=1.10   && <1.11
     , cardano-ledger-mary     >=1.5    && <1.6
     , cardano-ledger-shelley  >=1.9    && <1.10

hydra-cardano-api/src/Cardano/Api/UTxO.hs

@@ -25,7 +25,7 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Prelude
 
-type Era = BabbageEra
+type Era = ConwayEra
 
 type UTxO = UTxO' (TxOut CtxUTxO Era)
 

hydra-cardano-api/src/Hydra/Cardano/Api/Prelude.hs

@@ -55,7 +55,7 @@ import Data.Typeable (Typeable)
 import GHC.Stack (HasCallStack)
 import Test.QuickCheck (Arbitrary (..), Gen)
 
-type Era = BabbageEra
+type Era = ConwayEra
 
 -- | Currently supported ledger era.
 type LedgerEra = ShelleyLedgerEra Era

hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs

@@ -10,158 +10,32 @@ import Hydra.Cardano.Api.KeyWitness (
 import Hydra.Cardano.Api.TxScriptValidity (toLedgerScriptValidity)
 
 import Cardano.Api.UTxO qualified as UTxO
-import Cardano.Ledger.Allegra.Scripts (translateTimelock)
-import Cardano.Ledger.Alonzo qualified as Ledger
-import Cardano.Ledger.Alonzo.Scripts qualified as Ledger
-import Cardano.Ledger.Alonzo.TxAuxData (translateAlonzoTxAuxData)
 import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
 import Cardano.Ledger.Api (
-  AlonzoPlutusPurpose (..),
-  AsIndex (..),
-  ConwayPlutusPurpose (..),
   EraTx (mkBasicTx),
-  addrTxOutL,
   addrTxWitsL,
-  auxDataHashTxBodyL,
   auxDataTxL,
-  bodyTxL,
   bootAddrTxWitsL,
-  collateralInputsTxBodyL,
-  collateralReturnTxBodyL,
-  dataTxOutL,
   datsTxWitsL,
-  feeTxBodyL,
   hashScriptTxWitsL,
   inputsTxBodyL,
   isValidTxL,
-  mintTxBodyL,
   mkBasicTxBody,
-  mkBasicTxOut,
   mkBasicTxWits,
-  networkIdTxBodyL,
-  outputsTxBodyL,
   rdmrsTxWitsL,
-  referenceInputsTxBodyL,
-  referenceScriptTxOutL,
-  reqSignerHashesTxBodyL,
-  scriptIntegrityHashTxBodyL,
-  scriptTxWitsL,
-  totalCollateralTxBodyL,
-  valueTxOutL,
-  vldtTxBodyL,
-  withdrawalsTxBodyL,
   witsTxL,
  )
 import Cardano.Ledger.Api qualified as Ledger
-import Cardano.Ledger.Babbage qualified as Ledger
 import Cardano.Ledger.Babbage.Tx qualified as Ledger
-import Cardano.Ledger.Babbage.TxWits (upgradeTxDats)
 import Cardano.Ledger.BaseTypes (maybeToStrictMaybe, strictMaybeToMaybe)
 import Cardano.Ledger.Coin (Coin (..))
-import Cardano.Ledger.Conway.Scripts (PlutusScript (..))
-import Cardano.Ledger.Conway.Scripts qualified as Conway
-import Cardano.Ledger.Conway.TxBody qualified as Ledger
-import Cardano.Ledger.Plutus.Data (upgradeData)
-import Control.Lens ((&), (.~), (^.))
+import Control.Lens ((&), (.~))
 import Data.Bifunctor (bimap)
 import Data.Functor ((<&>))
 import Data.Map qualified as Map
-import Data.Maybe (mapMaybe)
 import Data.Set qualified as Set
 import Hydra.Cardano.Api.TxIn (mkTxIn, toLedgerTxIn)
 
--- * Extras
-
--- | Explicit downgrade from Conway to Babbage era.
---
--- NOTE: This is not a complete mapping and does silently drop things like
--- protocol updates, certificates and voting procedures.
-convertConwayTx :: Tx ConwayEra -> Tx BabbageEra
-convertConwayTx =
-  fromLedgerTx . convert . toLedgerTx
- where
-  convert :: Ledger.Tx (Ledger.ConwayEra StandardCrypto) -> Ledger.Tx (Ledger.BabbageEra StandardCrypto)
-  convert tx =
-    mkBasicTx (translateBody $ tx ^. bodyTxL)
-      & witsTxL .~ translateWits (tx ^. witsTxL)
-      & isValidTxL .~ tx ^. isValidTxL
-      & auxDataTxL .~ (translateAlonzoTxAuxData <$> tx ^. auxDataTxL)
-
-  translateBody ::
-    Ledger.ConwayTxBody (Ledger.ConwayEra StandardCrypto) ->
-    Ledger.BabbageTxBody (Ledger.BabbageEra StandardCrypto)
-  translateBody body =
-    mkBasicTxBody
-      & inputsTxBodyL .~ body ^. inputsTxBodyL
-      & outputsTxBodyL .~ (translateTxOut <$> body ^. outputsTxBodyL)
-      & feeTxBodyL .~ body ^. feeTxBodyL
-      & withdrawalsTxBodyL .~ body ^. withdrawalsTxBodyL
-      & auxDataHashTxBodyL .~ body ^. auxDataHashTxBodyL
-      -- NOTE: not considering 'updateTxBodyL' as upstream also does not upgrade it
-      -- NOTE: not considering 'certsTxBodyL' as we are not interested in it
-      & vldtTxBodyL .~ body ^. vldtTxBodyL
-      & mintTxBodyL .~ body ^. mintTxBodyL
-      & collateralInputsTxBodyL .~ body ^. collateralInputsTxBodyL
-      & reqSignerHashesTxBodyL .~ body ^. reqSignerHashesTxBodyL
-      & scriptIntegrityHashTxBodyL .~ body ^. scriptIntegrityHashTxBodyL
-      & networkIdTxBodyL .~ body ^. networkIdTxBodyL
-      & referenceInputsTxBodyL .~ body ^. referenceInputsTxBodyL
-      & totalCollateralTxBodyL .~ body ^. totalCollateralTxBodyL
-      & collateralReturnTxBodyL .~ (translateTxOut <$> body ^. collateralReturnTxBodyL)
-
-  translateTxOut ::
-    Ledger.BabbageTxOut (Ledger.ConwayEra StandardCrypto) ->
-    Ledger.BabbageTxOut (Ledger.BabbageEra StandardCrypto)
-  translateTxOut out =
-    mkBasicTxOut (out ^. addrTxOutL) (out ^. valueTxOutL)
-      & dataTxOutL .~ (upgradeData <$> out ^. dataTxOutL)
-      & referenceScriptTxOutL .~ (out ^. referenceScriptTxOutL >>= maybeToStrictMaybe . translateScript)
-
-  translateWits ::
-    Ledger.AlonzoTxWits (Ledger.ConwayEra StandardCrypto) ->
-    Ledger.AlonzoTxWits (Ledger.BabbageEra StandardCrypto)
-  translateWits wits =
-    mkBasicTxWits
-      & addrTxWitsL .~ wits ^. addrTxWitsL
-      & bootAddrTxWitsL .~ wits ^. bootAddrTxWitsL
-      & scriptTxWitsL .~ Map.mapMaybe translateScript (wits ^. scriptTxWitsL)
-      & datsTxWitsL .~ upgradeTxDats (wits ^. datsTxWitsL)
-      & rdmrsTxWitsL .~ translateRdmrs (wits ^. rdmrsTxWitsL)
-
-  translateScript ::
-    Ledger.AlonzoScript (Ledger.ConwayEra StandardCrypto) ->
-    Maybe (Ledger.AlonzoScript (Ledger.BabbageEra StandardCrypto))
-  translateScript = \case
-    Ledger.TimelockScript ts -> Just . Ledger.TimelockScript $ translateTimelock ts
-    Ledger.PlutusScript ps -> case ps of
-      ConwayPlutusV1 p1 -> Just . Ledger.PlutusScript $ BabbagePlutusV1 p1
-      ConwayPlutusV2 p2 -> Just . Ledger.PlutusScript $ BabbagePlutusV2 p2
-      ConwayPlutusV3{} -> Nothing
-
-  translateRdmrs ::
-    Ledger.Redeemers (Ledger.ConwayEra StandardCrypto) ->
-    Ledger.Redeemers (Ledger.BabbageEra StandardCrypto)
-  translateRdmrs (Ledger.Redeemers redeemerMap) =
-    Ledger.Redeemers
-      . Map.fromList
-      $ mapMaybe
-        ( \(purpose, (dat, units)) -> do
-            p' <- translatePlutusPurpose purpose
-            pure (p', (upgradeData dat, units))
-        )
-      $ Map.toList redeemerMap
-
-  translatePlutusPurpose ::
-    Conway.ConwayPlutusPurpose Ledger.AsIndex (Ledger.ConwayEra StandardCrypto) ->
-    Maybe (Ledger.AlonzoPlutusPurpose Ledger.AsIndex (Ledger.BabbageEra StandardCrypto))
-  translatePlutusPurpose = \case
-    ConwaySpending (AsIndex ix) -> Just $ AlonzoSpending (AsIndex ix)
-    ConwayMinting (AsIndex ix) -> Just $ AlonzoMinting (AsIndex ix)
-    ConwayCertifying (AsIndex ix) -> Just $ AlonzoCertifying (AsIndex ix)
-    ConwayRewarding (AsIndex ix) -> Just $ AlonzoRewarding (AsIndex ix)
-    ConwayVoting{} -> Nothing
-    ConwayProposing{} -> Nothing
-
 -- | Sign transaction using the provided secret key
 -- It only works for tx not containing scripts.
 -- You can't sign a script utxo with this.

hydra-cardano-api/src/Hydra/Cardano/Api/TxBody.hs

@@ -3,7 +3,7 @@ module Hydra.Cardano.Api.TxBody where
 import Hydra.Cardano.Api.Prelude
 
 import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
-import Cardano.Ledger.Api (AlonzoPlutusPurpose (..), AsIndex, AsItem (..), PlutusPurpose)
+import Cardano.Ledger.Api (AsIndex, AsItem (..), ConwayPlutusPurpose (..), PlutusPurpose)
 import Cardano.Ledger.Babbage.Core (redeemerPointer)
 import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
 import Cardano.Ledger.Core qualified as Ledger
@@ -23,7 +23,7 @@ findRedeemerSpending ::
   TxIn ->
   Maybe a
 findRedeemerSpending (getTxBody -> ShelleyTxBody _ body _ scriptData _ _) txIn = do
-  ptr <- strictMaybeToMaybe $ redeemerPointer body (AlonzoSpending . AsItem $ toLedgerTxIn txIn)
+  ptr <- strictMaybeToMaybe $ redeemerPointer body (ConwaySpending . AsItem $ toLedgerTxIn txIn)
   lookupRedeemer ptr scriptData
 
 findRedeemerMinting ::
@@ -32,7 +32,7 @@ findRedeemerMinting ::
   PolicyId ->
   Maybe a
 findRedeemerMinting (getTxBody -> ShelleyTxBody _ body _ scriptData _ _) pid = do
-  ptr <- strictMaybeToMaybe $ redeemerPointer body (AlonzoMinting . AsItem $ toLedgerPolicyID pid)
+  ptr <- strictMaybeToMaybe $ redeemerPointer body (ConwayMinting . AsItem $ toLedgerPolicyID pid)
   lookupRedeemer ptr scriptData
 
 findScriptMinting ::

hydra-chain-observer/src/Hydra/ChainObserver.hs

@@ -22,7 +22,6 @@ import Hydra.Cardano.Api (
   Tx,
   UTxO,
   connectToLocalNode,
-  convertConwayTx,
   getChainPoint,
   getTxBody,
   getTxId,
@@ -172,16 +171,14 @@ chainSyncClient tracer networkId startingPoint observerHandler =
       { recvMsgRollForward = \blockInMode _tip -> ChainSyncClient $ do
           let receivedTxIds = case blockInMode of
                 BlockInMode ConwayEra (Block _ conwayTxs) -> getTxId . getTxBody <$> conwayTxs
-                BlockInMode BabbageEra (Block _ babbageTxs) -> getTxId . getTxBody <$> babbageTxs
                 _ -> []
 
               (BlockInMode _ (Block bh@(BlockHeader _ _ blockNo) _)) = blockInMode
               point = getChainPoint bh
           traceWith tracer RollForward{point, receivedTxIds}
 
           let txs = case blockInMode of
-                BlockInMode ConwayEra (Block _ conwayTxs) -> map convertConwayTx conwayTxs
-                BlockInMode BabbageEra (Block _ babbageTxs) -> babbageTxs
+                BlockInMode ConwayEra (Block _ conwayTxs) -> conwayTxs
                 _ -> []
 
               (utxo', observations) = observeAll networkId utxo txs

hydra-cluster/config/devnet/cardano-node.json

@@ -18,6 +18,7 @@
   "TestMaryHardForkAtEpoch": 0,
   "TestAlonzoHardForkAtEpoch": 0,
   "TestBabbageHardForkAtEpoch": 0,
+  "TestConwayHardForkAtEpoch": 0,
 
   "RequiresNetworkMagic": "RequiresNoMagic",
 

hydra-cluster/src/CardanoNode.hs

@@ -276,17 +276,6 @@ setupCardanoDevnet stateDirectory = do
     Aeson.encodeFile (stateDirectory </> nodeTopologyFile args) $
       mkTopology peers
 
--- | Modify the cardano-node configuration to fork into conway at given era
--- number.
-forkIntoConwayInEpoch :: FilePath -> CardanoNodeArgs -> Natural -> IO ()
-forkIntoConwayInEpoch stateDirectory args n = do
-  config <-
-    unsafeDecodeJsonFile @Aeson.Value (stateDirectory </> nodeConfigFile args)
-      <&> atKey "TestConwayHardForkAtEpoch" ?~ toJSON n
-  Aeson.encodeFile
-    (stateDirectory </> nodeConfigFile args)
-    config
-
 withCardanoNode ::
   Tracer IO NodeLog ->
   FilePath ->