Change Era from BabbageEra to ConwayEra

Do filter protocol updates in Arbitrary Tx anymore Those are now represented differently in Conway and we'll see how the fully random transactions (including governance actions that supersede protocol updates) behave in situations where we use this generator.
input-output-hk · May 13, 2024 · 5f9b8bf · 5f9b8bf
1 parent 711b5ad
commit 5f9b8bf
Show file tree

Hide file tree

Showing 39 changed files with 35,659 additions and 42,038 deletions.
diff --git a/docs/package.json b/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",

diff --git a/hydra-cardano-api/hydra-cardano-api.cabal b/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

diff --git a/hydra-cardano-api/src/Cardano/Api/UTxO.hs b/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)
 

diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Prelude.hs b/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

diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs b/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.

diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/TxBody.hs b/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 ::

diff --git a/hydra-chain-observer/src/Hydra/ChainObserver.hs b/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

diff --git a/hydra-cluster/config/devnet/cardano-node.json b/hydra-cluster/config/devnet/cardano-node.json
@@ -18,6 +18,7 @@
   "TestMaryHardForkAtEpoch": 0,
   "TestAlonzoHardForkAtEpoch": 0,
   "TestBabbageHardForkAtEpoch": 0,
+  "TestConwayHardForkAtEpoch": 0,
 
   "RequiresNetworkMagic": "RequiresNoMagic",
 

diff --git a/hydra-cluster/src/CardanoNode.hs b/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 ->