Recompute integrity hash in wallet after convertConwayTx

This is needed because data is serialized different in Conway than
in Babbage.

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

@@ -11,6 +11,8 @@ import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
 import Cardano.Ledger.Api (
   AlonzoPlutusPurpose (..),
   AsIx (..),
+  Babbage,
+  Conway,
   ConwayPlutusPurpose (..),
   EraTx (mkBasicTx),
   addrTxOutL,
@@ -24,6 +26,7 @@ import Cardano.Ledger.Api (
   dataTxOutL,
   datsTxWitsL,
   feeTxBodyL,
+  getLanguageView,
   inputsTxBodyL,
   isValidTxL,
   mintTxBodyL,
@@ -46,12 +49,14 @@ import Cardano.Ledger.Api (
  )
 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.Language qualified as Ledger
 import Cardano.Ledger.Plutus.Data (upgradeData)
 import Control.Lens ((&), (.~), (^.))
 import Data.Bifunctor (bimap)
@@ -63,24 +68,95 @@ import Hydra.Cardano.Api.TxIn (mkTxIn, toLedgerTxIn)
 
 -- * Extras
 
+-- | Sign transaction using the provided secret key
+-- It only works for tx not containing scripts.
+-- You can't sign a script utxo with this.
+signTx ::
+  IsShelleyBasedEra era =>
+  SigningKey PaymentKey ->
+  Tx era ->
+  Tx era
+signTx signingKey (Tx body wits) =
+  makeSignedTransaction (witness : wits) body
+ where
+  witness = makeShelleyKeyWitness shelleyBasedEra body (WitnessPaymentKey signingKey)
+
+-- | Create a transaction spending all given `UTxO`.
+txSpendingUTxO :: UTxO -> Tx Era
+txSpendingUTxO utxo =
+  fromLedgerTx $
+    mkBasicTx
+      ( mkBasicTxBody
+          & inputsTxBodyL .~ (toLedgerTxIn `Set.map` inputs)
+      )
+ where
+  inputs = UTxO.inputSet utxo
+
+-- | Get the UTxO that are produced by some transaction.
+-- XXX: Defined here to avoid cyclic module dependency
+utxoProducedByTx :: Tx Era -> UTxO
+utxoProducedByTx tx =
+  UTxO.fromPairs $
+    zip [0 ..] (txOuts body)
+      <&> bimap (mkTxIn tx) toCtxUTxOTxOut
+ where
+  TxBody body = getTxBody tx
+
+-- | Get explicit fees allocated to a transaction.
+txFee' :: Tx era -> Coin
+txFee' (getTxBody -> TxBody body) =
+  case txFee body of
+    TxFeeExplicit _ y -> y
+
+-- * Type Conversions
+
+-- | Convert a cardano-api 'Tx' into a matching cardano-ledger 'Tx'.
+toLedgerTx ::
+  Tx era ->
+  Ledger.Tx (ShelleyLedgerEra era)
+toLedgerTx (ShelleyTx _era tx) = tx
+
+-- | Convert a cardano-ledger's 'Tx' in the Babbage era into a cardano-api 'Tx'.
+fromLedgerTx ::
+  IsShelleyBasedEra era =>
+  Ledger.Tx (ShelleyLedgerEra era) ->
+  Tx era
+fromLedgerTx =
+  ShelleyTx shelleyBasedEra
+
+-- | Compute the integrity hash of a transaction using a list of plutus languages.
+recomputeIntegrityHash ::
+  (Ledger.AlonzoEraPParams ppera, Ledger.AlonzoEraTxWits txera, Ledger.AlonzoEraTxBody txera, EraTx txera) =>
+  Ledger.PParams ppera ->
+  [Ledger.Language] ->
+  Ledger.Tx txera ->
+  Ledger.Tx txera
+recomputeIntegrityHash pp languages tx = do
+  tx & bodyTxL . scriptIntegrityHashTxBodyL .~ integrityHash
+ where
+  integrityHash =
+    hashScriptIntegrity
+      (Set.fromList $ getLanguageView pp <$> languages)
+      (tx ^. witsTxL . rdmrsTxWitsL)
+      (tx ^. witsTxL . datsTxWitsL)
+
 -- | Explicit downgrade from Conway to Babbage era.
 --
--- NOTE: This is not a complete mapping and does silently drop things like
+-- 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 :: Tx ConwayEra -> Tx BabbageEra
-convertConwayTx =
-  fromLedgerTx . convert . toLedgerTx
+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
-  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)
+    Ledger.ConwayTxBody Ledger.Conway ->
+    Ledger.BabbageTxBody Ledger.Babbage
   translateBody body =
     mkBasicTxBody
       & inputsTxBodyL .~ body ^. inputsTxBodyL
@@ -101,16 +177,16 @@ convertConwayTx =
       & collateralReturnTxBodyL .~ (translateTxOut <$> body ^. collateralReturnTxBodyL)
 
   translateTxOut ::
-    Ledger.BabbageTxOut (Ledger.ConwayEra StandardCrypto) ->
-    Ledger.BabbageTxOut (Ledger.BabbageEra StandardCrypto)
+    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.ConwayEra StandardCrypto) ->
-    Ledger.AlonzoTxWits (Ledger.BabbageEra StandardCrypto)
+    Ledger.AlonzoTxWits Ledger.Conway ->
+    Ledger.AlonzoTxWits Ledger.Babbage
   translateWits wits =
     mkBasicTxWits
       & addrTxWitsL .~ wits ^. addrTxWitsL
@@ -120,8 +196,8 @@ convertConwayTx =
       & rdmrsTxWitsL .~ translateRdmrs (wits ^. rdmrsTxWitsL)
 
   translateScript ::
-    Ledger.AlonzoScript (Ledger.ConwayEra StandardCrypto) ->
-    Maybe (Ledger.AlonzoScript (Ledger.BabbageEra StandardCrypto))
+    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
@@ -130,8 +206,8 @@ convertConwayTx =
       ConwayPlutusV3{} -> Nothing
 
   translateRdmrs ::
-    Ledger.Redeemers (Ledger.ConwayEra StandardCrypto) ->
-    Ledger.Redeemers (Ledger.BabbageEra StandardCrypto)
+    Ledger.Redeemers Ledger.Conway ->
+    Ledger.Redeemers Ledger.Babbage
   translateRdmrs (Ledger.Redeemers redeemerMap) =
     Ledger.Redeemers
       . Map.fromList
@@ -143,68 +219,12 @@ convertConwayTx =
       $ Map.toList redeemerMap
 
   translatePlutusPurpose ::
-    Conway.ConwayPlutusPurpose Ledger.AsIx (Ledger.ConwayEra StandardCrypto) ->
-    Maybe (Ledger.AlonzoPlutusPurpose Ledger.AsIx (Ledger.BabbageEra StandardCrypto))
+    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
-
--- | Sign transaction using the provided secret key
--- It only works for tx not containing scripts.
--- You can't sign a script utxo with this.
-signTx ::
-  IsShelleyBasedEra era =>
-  SigningKey PaymentKey ->
-  Tx era ->
-  Tx era
-signTx signingKey (Tx body wits) =
-  makeSignedTransaction (witness : wits) body
- where
-  witness = makeShelleyKeyWitness shelleyBasedEra body (WitnessPaymentKey signingKey)
-
--- | Create a transaction spending all given `UTxO`.
-txSpendingUTxO :: UTxO -> Tx Era
-txSpendingUTxO utxo =
-  fromLedgerTx $
-    mkBasicTx
-      ( mkBasicTxBody
-          & inputsTxBodyL .~ (toLedgerTxIn `Set.map` inputs)
-      )
- where
-  inputs = UTxO.inputSet utxo
-
--- | Get the UTxO that are produced by some transaction.
--- XXX: Defined here to avoid cyclic module dependency
-utxoProducedByTx :: Tx Era -> UTxO
-utxoProducedByTx tx =
-  UTxO.fromPairs $
-    zip [0 ..] (txOuts body)
-      <&> bimap (mkTxIn tx) toCtxUTxOTxOut
- where
-  TxBody body = getTxBody tx
-
--- | Get explicit fees allocated to a transaction.
-txFee' :: Tx era -> Coin
-txFee' (getTxBody -> TxBody body) =
-  case txFee body of
-    TxFeeExplicit _ y -> y
-
--- * Type Conversions
-
--- | Convert a cardano-api 'Tx' into a matching cardano-ledger 'Tx'.
-toLedgerTx ::
-  Tx era ->
-  Ledger.Tx (ShelleyLedgerEra era)
-toLedgerTx (ShelleyTx _era tx) = tx
-
--- | Convert a cardano-ledger's 'Tx' in the Babbage era into a cardano-api 'Tx'.
-fromLedgerTx ::
-  IsShelleyBasedEra era =>
-  Ledger.Tx (ShelleyLedgerEra era) ->
-  Tx era
-fromLedgerTx =
-  ShelleyTx shelleyBasedEra

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

@@ -23,9 +23,11 @@ import Hydra.Cardano.Api (
   UTxO,
   connectToLocalNode,
   convertConwayTx,
+  fromLedgerTx,
   getChainPoint,
   getTxBody,
   getTxId,
+  toLedgerTx,
   pattern Block,
  )
 import Hydra.Cardano.Api.Prelude (TxId)
@@ -181,7 +183,7 @@ chainSyncClient tracer networkId startingPoint observerHandler =
           traceWith tracer RollForward{point, receivedTxIds}
 
           let txs = case blockInMode of
-                BlockInMode ConwayEra (Block _ conwayTxs) -> map convertConwayTx conwayTxs
+                BlockInMode ConwayEra (Block _ conwayTxs) -> map (fromLedgerTx . convertConwayTx . toLedgerTx) conwayTxs
                 BlockInMode BabbageEra (Block _ babbageTxs) -> babbageTxs
                 _ -> []
 

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -7,15 +7,12 @@ import Hydra.Prelude
 import Test.Hydra.Prelude
 
 import Cardano.Api.UTxO qualified as UTxO
-import Cardano.Ledger.Api (PParams, emptyPParams)
-import Cardano.Ledger.Conway.PParams (ppMinFeeRefScriptCostPerByteL)
 import CardanoClient (
   QueryPoint (..),
   RunningNode (..),
   queryCurrentEraExpr,
   queryEpochNo,
   queryGenesisParameters,
-  queryProtocolParameters',
   queryTip,
   queryTipSlotNo,
   runQueryExpr,
@@ -580,14 +577,8 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do
                 waitFor hydraTracer 3 [n1] $ output "HeadIsOpen" ["utxo" .= committedUTxOByAlice, "headId" .= headId]
 
                 guardEra networkId nodeSocket (AnyCardanoEra BabbageEra)
-                print =<< queryProtocolParameters' @BabbageEra networkId nodeSocket QueryTip
-
                 waitUntilEpoch tmpDir args node 10
-
                 guardEra networkId nodeSocket (AnyCardanoEra ConwayEra)
-                pp <- queryProtocolParameters' @ConwayEra networkId nodeSocket QueryTip
-                pp ^? ppMinFeeRefScriptCostPerByteL `shouldNotBe` Nothing
-                print pp
 
                 send n1 $ input "Close" []
                 waitMatch 3 n1 $ \v -> do

hydra-node/src/Hydra/Chain/Direct.hs

@@ -44,8 +44,10 @@ import Hydra.Cardano.Api (
   chainTipToChainPoint,
   connectToLocalNode,
   convertConwayTx,
+  fromLedgerTx,
   getTxBody,
   getTxId,
+  toLedgerTx,
   toLedgerUTxO,
   pattern Block,
  )
@@ -323,7 +325,7 @@ chainSyncClient handler wallet startingPoint =
       { recvMsgRollForward = \blockInMode _tip -> ChainSyncClient $ do
           case blockInMode of
             BlockInMode ConwayEra (Block header conwayTxs) -> do
-              let txs = map convertConwayTx conwayTxs
+              let txs = map (fromLedgerTx . convertConwayTx . toLedgerTx) conwayTxs
               -- Update the tiny wallet
               update wallet header txs
               -- Observe Hydra transactions