Skip to content

Add SerialiseAsCBOR instance for TxOut #960

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Add SerialiseAsCBOR instance for TxOut #960

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
51a5f4b
Add `SerialiseAsCBOR` instance for `TxOut`
palas Sep 18, 2025
42577bd
Fix lints
palas Sep 22, 2025
753f06b
Specialise roundtrip test to hash supplemental datums before testing
palas Sep 22, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 24 additions & 2 deletions cardano-api/src/Cardano/Api/Tx/Internal/Output.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,17 +1,20 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Api.Tx.Internal.Output
( -- * Transaction outputs
Expand Down Expand Up @@ -62,7 +65,7 @@ import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards
import Cardano.Api.Era.Internal.Eon.Convert
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Error (Error (..), displayError)
import Cardano.Api.Hash
import Cardano.Api.HasTypeProxy qualified as HTP
import Cardano.Api.Ledger.Internal.Reexport qualified as Ledger
import Cardano.Api.Monad.Error
import Cardano.Api.Parser.Text qualified as P
Expand All @@ -81,11 +84,11 @@ import Cardano.Ledger.Alonzo.Core qualified as L
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Coin qualified as L
import Cardano.Ledger.Core ()
import Cardano.Ledger.Core qualified as Core
import Cardano.Ledger.Core qualified as Ledger
import Cardano.Ledger.Plutus.Data qualified as Plutus

import Codec.CBOR.Encoding (Encoding)
import Data.Aeson (object, withObject, (.:), (.:?), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Key qualified as Aeson
Expand All @@ -99,6 +102,7 @@ import Data.Sequence.Strict qualified as Seq
import Data.Text (Text)
import Data.Text.Encoding qualified as Text
import Data.Type.Equality
import Data.Typeable (Typeable)
import Data.Word
import GHC.Exts (IsList (..))
import GHC.Stack
Expand All @@ -120,6 +124,24 @@ data TxOut ctx era
(TxOutValue era)
(TxOutDatum ctx era)
(ReferenceScript era)
deriving SerialiseAsCBOR

instance (Typeable ctx, IsShelleyBasedEra era) => HTP.HasTypeProxy (TxOut ctx era) where
data AsType (TxOut ctx era) = AsTxOut (AsType era)
proxyToAsType :: HTP.Proxy (TxOut ctx era) -> AsType (TxOut ctx era)
proxyToAsType _ = AsTxOut (HTP.asType @era)

instance (Typeable ctx, IsShelleyBasedEra era) => ToCBOR (TxOut ctx era) where
toCBOR :: TxOut ctx era -> Encoding
toCBOR txOut =
shelleyBasedEraConstraints (shelleyBasedEra @era) $
Ledger.toEraCBOR @(ShelleyLedgerEra era) (toShelleyTxOutAny shelleyBasedEra txOut)

instance (Typeable ctx, IsShelleyBasedEra era) => FromCBOR (TxOut ctx era) where
fromCBOR :: Ledger.Decoder s (TxOut ctx era)
fromCBOR =
shelleyBasedEraConstraints (shelleyBasedEra @era) $
pure (fromShelleyTxOut shelleyBasedEra) <*> L.fromEraCBOR @(ShelleyLedgerEra era)

deriving instance Eq (TxOut ctx era)

Expand Down
16 changes: 16 additions & 0 deletions cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -110,6 +110,21 @@ prop_roundtrip_tx_CBOR = H.property $ do
x <- H.forAll $ genTx era
shelleyBasedEraConstraints era $ H.trippingCbor (proxyToAsType Proxy) x

prop_roundtrip_tx_out_CBOR :: Property
prop_roundtrip_tx_out_CBOR = H.property $ do
AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound]
x <- H.forAll $ genTx era
txOut <- H.forAll $ Gen.element $ txOuts $ getTxBodyContent $ getTxBody x
let fixedTxOut = hashDatum txOut
shelleyBasedEraConstraints era $ H.trippingCbor (proxyToAsType Proxy) fixedTxOut
where
hashDatum :: TxOut CtxTx era -> TxOut CtxTx era
hashDatum txOut@(TxOut aie val datum rs) =
case datum of
(TxOutSupplementalDatum aeo d) ->
TxOut aie val (TxOutDatumHash aeo (hashScriptDataBytes d)) rs
Comment on lines +124 to +125
Copy link
Contributor

@carbolymer carbolymer Sep 22, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am not sure how usable will be such deserialised txout. I think after you convert datum to hash, it's no longer included in the transaction datums: https://github.com/IntersectMBO/cardano-api/pull/814/files?diff=split&w=1#diff-dbfef7b82f6c05596cde61360e58ef674ad0bea7ac8c3e416178ccbde84b98b9R3107

Tactical merge block, since we're still discussing design.

_ -> txOut

prop_roundtrip_witness_CBOR :: Property
prop_roundtrip_witness_CBOR = H.property $ do
AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound]
Expand Down Expand Up @@ -521,6 +536,7 @@ tests =
, testProperty "roundtrip ScriptData CBOR" prop_roundtrip_ScriptData_CBOR
, testProperty "roundtrip TxWitness Cddl" prop_roundtrip_TxWitness_Cddl
, testProperty "roundtrip tx CBOR" prop_roundtrip_tx_CBOR
, testProperty "roundtrip tx out CBOR" prop_roundtrip_tx_out_CBOR
, testProperty
"roundtrip GovernancePoll CBOR"
prop_roundtrip_GovernancePoll_CBOR
Expand Down
Loading