From 6804a6bea4602b63b2943cbc699df3316f905b11 Mon Sep 17 00:00:00 2001 From: Daniel Firth Date: Wed, 2 Oct 2024 23:15:22 +0000 Subject: [PATCH] Remove convertConwayTx --- hydra-cardano-api/hydra-cardano-api.cabal | 1 - hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs | 130 ------------------ 2 files changed, 131 deletions(-) diff --git a/hydra-cardano-api/hydra-cardano-api.cabal b/hydra-cardano-api/hydra-cardano-api.cabal index 75d7e08f485..85e91fb533c 100644 --- a/hydra-cardano-api/hydra-cardano-api.cabal +++ b/hydra-cardano-api/hydra-cardano-api.cabal @@ -91,7 +91,6 @@ library , cardano-ledger-babbage , cardano-ledger-binary , cardano-ledger-byron - , cardano-ledger-conway , cardano-ledger-core , cardano-ledger-mary , cardano-ledger-shelley diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs index 1ae9decc4c0..97e233fc813 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs @@ -10,66 +10,25 @@ where import Hydra.Cardano.Api.Prelude 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 (..), - AsIx (..), - Babbage, - Conway, - ConwayPlutusPurpose (..), EraTx (mkBasicTx), - addrTxOutL, - addrTxWitsL, - auxDataHashTxBodyL, - auxDataTxL, bodyTxL, - bootAddrTxWitsL, - collateralInputsTxBodyL, - collateralReturnTxBodyL, - dataTxOutL, datsTxWitsL, - feeTxBodyL, getLanguageView, 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 (hashScriptIntegrity) -import Cardano.Ledger.Babbage.TxWits (upgradeTxDats) -import Cardano.Ledger.BaseTypes (maybeToStrictMaybe) 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 Cardano.Ledger.Plutus.Language qualified as Ledger 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) @@ -146,92 +105,3 @@ recomputeIntegrityHash pp languages tx = do (Set.fromList $ getLanguageView pp <$> languages) (tx ^. witsTxL . rdmrsTxWitsL) (tx ^. witsTxL . datsTxWitsL) - --- | Explicit downgrade from Conway to Babbage era. --- --- XXX: This will invalidate the script integrity hash as datums and redeemers --- are serialized differently. --- --- XXX: This is not a complete mapping and does silently drop things like --- protocol updates, certificates and voting procedures. -convertConwayTx :: Ledger.Tx Conway -> Ledger.Tx Babbage -convertConwayTx tx = - mkBasicTx (translateBody $ tx ^. bodyTxL) - & witsTxL .~ translateWits (tx ^. witsTxL) - & isValidTxL .~ tx ^. isValidTxL - & auxDataTxL .~ (translateAlonzoTxAuxData <$> tx ^. auxDataTxL) - where - translateBody :: - Ledger.ConwayTxBody Ledger.Conway -> - Ledger.BabbageTxBody Ledger.Babbage - 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.Conway -> - Ledger.BabbageTxOut Ledger.Babbage - translateTxOut out = - mkBasicTxOut (out ^. addrTxOutL) (out ^. valueTxOutL) - & dataTxOutL .~ (upgradeData <$> out ^. dataTxOutL) - & referenceScriptTxOutL .~ (out ^. referenceScriptTxOutL >>= maybeToStrictMaybe . translateScript) - - translateWits :: - Ledger.AlonzoTxWits Ledger.Conway -> - Ledger.AlonzoTxWits Ledger.Babbage - 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.Conway -> - Maybe (Ledger.AlonzoScript Ledger.Babbage) - 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.Conway -> - Ledger.Redeemers Ledger.Babbage - 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.AsIx Ledger.Conway -> - Maybe (Ledger.AlonzoPlutusPurpose Ledger.AsIx Ledger.Babbage) - translatePlutusPurpose = \case - ConwaySpending (AsIx ix) -> Just $ AlonzoSpending (AsIx ix) - ConwayMinting (AsIx ix) -> Just $ AlonzoMinting (AsIx ix) - ConwayCertifying (AsIx ix) -> Just $ AlonzoCertifying (AsIx ix) - ConwayRewarding (AsIx ix) -> Just $ AlonzoRewarding (AsIx ix) - ConwayVoting{} -> Nothing - ConwayProposing{} -> Nothing