Skip to content

Commit

Permalink
TBD: Define toLedgerTx and fromLedgerTx using ShelleyTx
Browse files Browse the repository at this point in the history
The cardano-api Tx type is just a wrapper around the ledger and we
should be using that data constructor to do this "conversion".

This also drops a test for "self-healing" auxiliary data hashes, but we
did not require that in the first place: if you modify a transaction
using the ledger-api, make sure to re-compute the auxDataHashTxBodyL.
  • Loading branch information
ch1bo committed May 15, 2024
1 parent 58b6f68 commit aeff9b9
Show file tree
Hide file tree
Showing 2 changed files with 9 additions and 68 deletions.
67 changes: 8 additions & 59 deletions hydra-cardano-api/src/Hydra/Cardano/Api/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,13 +2,6 @@ module Hydra.Cardano.Api.Tx where

import Hydra.Cardano.Api.Prelude

import Hydra.Cardano.Api.KeyWitness (
fromLedgerTxWitness,
toLedgerBootstrapWitness,
toLedgerKeyWitness,
)
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
Expand All @@ -31,8 +24,6 @@ import Cardano.Ledger.Api (
dataTxOutL,
datsTxWitsL,
feeTxBodyL,
hashScriptTxWitsL,
hashTxAuxData,
inputsTxBodyL,
isValidTxL,
mintTxBodyL,
Expand All @@ -55,9 +46,8 @@ import Cardano.Ledger.Api (
)
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 (StrictMaybe (..), maybeToStrictMaybe, strictMaybeToMaybe)
import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Scripts (PlutusScript (..))
import Cardano.Ledger.Conway.Scripts qualified as Conway
Expand Down Expand Up @@ -207,55 +197,14 @@ txFee' (getTxBody -> TxBody body) =

-- | Convert a cardano-api 'Tx' into a matching cardano-ledger 'Tx'.
toLedgerTx ::
forall era.
( Ledger.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
, Ledger.AlonzoEraTx (ShelleyLedgerEra era)
) =>
Tx era ->
Ledger.Tx (ShelleyLedgerEra era)
toLedgerTx = \case
Tx (ShelleyTxBody _era body scripts scriptsData auxData validity) vkWits ->
let (datums, redeemers) =
case scriptsData of
TxBodyScriptData _ ds rs -> (ds, rs)
TxBodyNoScriptData -> (mempty, Ledger.Redeemers mempty)
wits =
mkBasicTxWits
& addrTxWitsL .~ toLedgerKeyWitness vkWits
& bootAddrTxWitsL .~ toLedgerBootstrapWitness vkWits
& hashScriptTxWitsL .~ scripts
& datsTxWitsL .~ datums
& rdmrsTxWitsL .~ redeemers
in mkBasicTx
(body & auxDataHashTxBodyL .~ maybe SNothing (SJust . hashTxAuxData) auxData)
& isValidTxL .~ toLedgerScriptValidity validity
& auxDataTxL .~ maybeToStrictMaybe auxData
& witsTxL .~ wits
toLedgerTx (ShelleyTx _era tx) = tx

-- | Convert a cardano-ledger's 'Tx' in the Babbage era into a cardano-api 'Tx'.
fromLedgerTx :: Ledger.Tx (ShelleyLedgerEra Era) -> Tx Era
fromLedgerTx ledgerTx =
Tx
(ShelleyTxBody shelleyBasedEra body' scripts scriptsData (strictMaybeToMaybe auxData) validity)
(fromLedgerTxWitness wits)
where
-- XXX: The suggested way (by the ledger team) forward is to use lenses to
-- introspect ledger transactions.
Ledger.AlonzoTx body wits isValid auxData = ledgerTx
body' = body & auxDataHashTxBodyL .~ (hashTxAuxData <$> auxData)

scripts =
Map.elems $ Ledger.txscripts' wits

scriptsData :: TxBodyScriptData Era
scriptsData =
TxBodyScriptData
alonzoEraOnwards
(Ledger.txdats' wits)
(Ledger.txrdmrs' wits)

validity = case isValid of
Ledger.IsValid True ->
TxScriptValidity alonzoEraOnwards ScriptValid
Ledger.IsValid False ->
TxScriptValidity alonzoEraOnwards ScriptInvalid
fromLedgerTx ::
IsShelleyBasedEra era =>
Ledger.Tx (ShelleyLedgerEra era) ->
Tx era
fromLedgerTx =
ShelleyTx shelleyBasedEra
10 changes: 1 addition & 9 deletions hydra-node/test/Hydra/Ledger/CardanoSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,11 +8,9 @@ import Hydra.Prelude
import Test.Hydra.Prelude

import Cardano.Binary (decodeFull, serialize')
import Cardano.Ledger.Api (auxDataHashTxBodyL, bodyTxL, ensureMinCoinTxOut)
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Api (ensureMinCoinTxOut)
import Cardano.Ledger.Core (PParams ())
import Cardano.Ledger.Credential (Credential (..))
import Control.Lens ((.~))
import Data.Aeson (eitherDecode, encode)
import Data.Aeson qualified as Aeson
import Data.Aeson.Lens (key)
Expand Down Expand Up @@ -73,8 +71,6 @@ spec =

prop "Roundtrip to and from Ledger" roundtripLedger

prop "Roundtrip tx metadata" roundtripTxMetadata

prop "Roundtrip CBOR encoding" $ roundtripCBOR @Tx

prop "JSON encoding of Tx according to schema" $
Expand Down Expand Up @@ -156,10 +152,6 @@ roundtripLedger :: Tx -> Property
roundtripLedger tx =
fromLedgerTx (toLedgerTx tx) === tx

roundtripTxMetadata :: Tx -> Property
roundtripTxMetadata tx =
fromLedgerTx (toLedgerTx tx & bodyTxL . auxDataHashTxBodyL .~ SNothing) === tx

roundtripCBOR :: (Eq a, Show a, ToCBOR a, FromCBOR a) => a -> Property
roundtripCBOR a =
let encoded = serialize' a
Expand Down

0 comments on commit aeff9b9

Please sign in to comment.