From fee95daeb269985743ca7d748d2a4900e8019a61 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 20 Nov 2025 15:31:47 -0400 Subject: [PATCH] Implement writeTxFileTextEnvelope and writeTxFileTextEnvelopeCanonical for SignedTx --- cardano-api/cardano-api.cabal | 2 + .../src/Cardano/Api/Experimental/Tx.hs | 85 +----------- .../Api/Experimental/Tx/Internal/Serialise.hs | 62 +++++++++ .../Api/Experimental/Tx/Internal/Type.hs | 121 ++++++++++++++++++ 4 files changed, 191 insertions(+), 79 deletions(-) create mode 100644 cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Serialise.hs create mode 100644 cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Type.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 217a3f6595..278769b28b 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -235,7 +235,9 @@ library Cardano.Api.Experimental.Tx.Internal.Certificate.Type Cardano.Api.Experimental.Tx.Internal.Compatible Cardano.Api.Experimental.Tx.Internal.Fee + Cardano.Api.Experimental.Tx.Internal.Serialise Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements + Cardano.Api.Experimental.Tx.Internal.Type Cardano.Api.Genesis.Internal Cardano.Api.Genesis.Internal.Parameters Cardano.Api.Governance.Internal.Action.ProposalProcedure diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx.hs b/cardano-api/src/Cardano/Api/Experimental/Tx.hs index 6872ff7a72..e8e2fa12ca 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx.hs @@ -3,11 +3,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -140,6 +137,10 @@ module Cardano.Api.Experimental.Tx , getTxScriptWitnessesRequirements , obtainMonoidConstraint + -- ** Serialisation + , writeTxFileTextEnvelope + , writeTxFileTextEnvelopeCanonical + -- ** Internal functions , extractExecutionUnits , getTxScriptWitnessRequirements @@ -153,67 +154,26 @@ import Cardano.Api.Era.Internal.Feature import Cardano.Api.Experimental.Era import Cardano.Api.Experimental.Tx.Internal.AnyWitness import Cardano.Api.Experimental.Tx.Internal.Body +import Cardano.Api.Experimental.Tx.Internal.Serialise import Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements -import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType) +import Cardano.Api.Experimental.Tx.Internal.Type import Cardano.Api.Ledger.Internal.Reexport (StrictMaybe (..), maybeToStrictMaybe) import Cardano.Api.Ledger.Internal.Reexport qualified as L import Cardano.Api.Pretty (docToString, pretty) -import Cardano.Api.Serialise.Raw - ( SerialiseAsRawBytes (..) - , SerialiseAsRawBytesError (SerialiseAsRawBytesError) - ) import Cardano.Api.Tx.Internal.Body import Cardano.Api.Tx.Internal.Sign import Cardano.Crypto.Hash qualified as Hash import Cardano.Ledger.Alonzo.TxBody qualified as L import Cardano.Ledger.Api qualified as L -import Cardano.Ledger.Binary qualified as Ledger import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Hashes qualified as L hiding (Hash) -import Control.Exception (displayException) -import Data.Bifunctor (bimap) -import Data.ByteString.Lazy (fromStrict) import Data.Set qualified as Set import GHC.Exts (IsList (..)) import GHC.Stack import Lens.Micro --- | A transaction that can contain everything --- except key witnesses. -data UnsignedTx era - = L.EraTx (LedgerEra era) => UnsignedTx (Ledger.Tx (LedgerEra era)) - -instance HasTypeProxy era => HasTypeProxy (UnsignedTx era) where - data AsType (UnsignedTx era) = AsUnsignedTx (AsType era) - proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era) - proxyToAsType _ = AsUnsignedTx (asType @era) - -instance - ( HasTypeProxy era - , L.EraTx (LedgerEra era) - ) - => SerialiseAsRawBytes (UnsignedTx era) - where - serialiseToRawBytes (UnsignedTx tx) = - Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx - deserialiseFromRawBytes _ = - bimap wrapError UnsignedTx - . Ledger.decodeFullAnnotator - (Ledger.eraProtVerHigh @(LedgerEra era)) - "UnsignedTx" - Ledger.decCBOR - . fromStrict - where - wrapError - :: Ledger.DecoderError -> SerialiseAsRawBytesError - wrapError = SerialiseAsRawBytesError . displayException - -deriving instance Eq (UnsignedTx era) - -deriving instance Show (UnsignedTx era) - newtype UnsignedTxError = UnsignedTxError TxBodyError @@ -341,39 +301,6 @@ makeKeyWitness era (UnsignedTx unsignedTx) wsk = signature = makeShelleySignature txhash sk in L.WitVKey vk signature --- | A transaction that has been witnesssed -data SignedTx era - = L.EraTx (LedgerEra era) => SignedTx (Ledger.Tx (LedgerEra era)) - -deriving instance Eq (SignedTx era) - -deriving instance Show (SignedTx era) - -instance HasTypeProxy era => HasTypeProxy (SignedTx era) where - data AsType (SignedTx era) = AsSignedTx (AsType era) - proxyToAsType :: Proxy (SignedTx era) -> AsType (SignedTx era) - proxyToAsType _ = AsSignedTx (asType @era) - -instance - ( HasTypeProxy era - , L.EraTx (LedgerEra era) - ) - => SerialiseAsRawBytes (SignedTx era) - where - serialiseToRawBytes (SignedTx tx) = - Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx - deserialiseFromRawBytes _ = - bimap wrapError SignedTx - . Ledger.decodeFullAnnotator - (Ledger.eraProtVerHigh @(LedgerEra era)) - "SignedTx" - Ledger.decCBOR - . fromStrict - where - wrapError - :: Ledger.DecoderError -> SerialiseAsRawBytesError - wrapError = SerialiseAsRawBytesError . displayException - signTx :: Era era -> [L.BootstrapWitness] diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Serialise.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Serialise.hs new file mode 100644 index 0000000000..454a243a66 --- /dev/null +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Serialise.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Api.Experimental.Tx.Internal.Serialise + ( writeTxFileTextEnvelope + , writeTxFileTextEnvelopeCanonical + ) +where + +import Cardano.Api.Error +import Cardano.Api.Experimental.Era +import Cardano.Api.Experimental.Tx.Internal.Type +import Cardano.Api.IO +import Cardano.Api.Serialise.Cbor.Canonical +import Cardano.Api.Serialise.TextEnvelope.Internal + +writeTxFileTextEnvelope + :: IsEra era + => File content Out + -> SignedTx era + -> IO (Either (FileError ()) ()) +writeTxFileTextEnvelope path = + writeLazyByteStringFile path + . serialiseTextEnvelope + . serialiseTxToTextEnvelope + +serialiseTxToTextEnvelope :: forall era. IsEra era => SignedTx era -> TextEnvelope +serialiseTxToTextEnvelope tx' = + obtainCommonConstraints (useEra @era) $ + serialiseToTextEnvelope (Just "Ledger Cddl Format") tx' + +-- | Write transaction in the text envelope format. The CBOR will be in canonical format according +-- to RFC 7049. It is also a requirement of CIP-21, which is not fully implemented. +-- +-- 1. RFC 7049: https://datatracker.ietf.org/doc/html/rfc7049#section-3.9 +-- 2. CIP-21: https://github.com/cardano-foundation/CIPs/blob/master/CIP-0021/README.md#canonical-cbor-serialization-format +writeTxFileTextEnvelopeCanonical + :: IsEra era + => File content Out + -> SignedTx era + -> IO (Either (FileError ()) ()) +writeTxFileTextEnvelopeCanonical path = + writeLazyByteStringFile path + . serialiseTextEnvelope + . canonicaliseTextEnvelopeCbor + . serialiseTxToTextEnvelope + where + canonicaliseTextEnvelopeCbor :: TextEnvelope -> TextEnvelope + canonicaliseTextEnvelopeCbor te = do + let canonicalisedTxBs = + either + ( \err -> + error $ + "writeTxFileTextEnvelopeCanonical: Impossible - deserialisation of just serialised bytes failed " + <> show err + ) + id + . canonicaliseCborBs + $ teRawCBOR te + te{teRawCBOR = canonicalisedTxBs} diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Type.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Type.hs new file mode 100644 index 0000000000..508d1e4757 --- /dev/null +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Type.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Cardano.Api.Experimental.Tx.Internal.Type + ( SignedTx (..) + , UnsignedTx (..) + ) +where + +import Cardano.Api.Experimental.Era +import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType) +import Cardano.Api.Ledger.Internal.Reexport qualified as L +import Cardano.Api.Serialise.Cbor +import Cardano.Api.Serialise.Raw + ( SerialiseAsRawBytes (..) + , SerialiseAsRawBytesError (SerialiseAsRawBytesError) + ) +import Cardano.Api.Serialise.TextEnvelope.Internal + +import Cardano.Ledger.Binary qualified as Ledger +import Cardano.Ledger.Core qualified as Ledger + +import Control.Exception (displayException) +import Data.Bifunctor (bimap) +import Data.ByteString.Lazy (fromStrict) + +-- | A transaction that has been witnesssed +data SignedTx era + = L.EraTx (LedgerEra era) => SignedTx (Ledger.Tx (LedgerEra era)) + +deriving instance Eq (SignedTx era) + +deriving instance Show (SignedTx era) + +instance + ( HasTypeProxy era + , L.EraTx (LedgerEra era) + ) + => SerialiseAsCBOR (SignedTx era) + where + serialiseToCBOR (SignedTx tx) = + Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx + deserialiseFromCBOR _ = + fmap SignedTx + . Ledger.decodeFullAnnotator + (Ledger.eraProtVerHigh @(LedgerEra era)) + "UnsignedTx" + Ledger.decCBOR + . fromStrict + +instance (L.EraTx (LedgerEra era), HasTypeProxy era) => HasTextEnvelope (SignedTx era) where + textEnvelopeType _ = "Tx" + +instance HasTypeProxy era => HasTypeProxy (SignedTx era) where + data AsType (SignedTx era) = AsSignedTx (AsType era) + proxyToAsType :: Proxy (SignedTx era) -> AsType (SignedTx era) + proxyToAsType _ = AsSignedTx (asType @era) + +instance + ( HasTypeProxy era + , L.EraTx (LedgerEra era) + ) + => SerialiseAsRawBytes (SignedTx era) + where + serialiseToRawBytes (SignedTx tx) = + Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx + deserialiseFromRawBytes _ = + bimap wrapError SignedTx + . Ledger.decodeFullAnnotator + (Ledger.eraProtVerHigh @(LedgerEra era)) + "SignedTx" + Ledger.decCBOR + . fromStrict + where + wrapError + :: Ledger.DecoderError -> SerialiseAsRawBytesError + wrapError = SerialiseAsRawBytesError . displayException + +-- | A transaction that can contain everything +-- except key witnesses. +data UnsignedTx era + = L.EraTx (LedgerEra era) => UnsignedTx (Ledger.Tx (LedgerEra era)) + +instance HasTypeProxy era => HasTypeProxy (UnsignedTx era) where + data AsType (UnsignedTx era) = AsUnsignedTx (AsType era) + proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era) + proxyToAsType _ = AsUnsignedTx (asType @era) + +instance + ( HasTypeProxy era + , L.EraTx (LedgerEra era) + ) + => SerialiseAsRawBytes (UnsignedTx era) + where + serialiseToRawBytes (UnsignedTx tx) = + Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx + deserialiseFromRawBytes _ = + bimap wrapError UnsignedTx + . Ledger.decodeFullAnnotator + (Ledger.eraProtVerHigh @(LedgerEra era)) + "UnsignedTx" + Ledger.decCBOR + . fromStrict + where + wrapError + :: Ledger.DecoderError -> SerialiseAsRawBytesError + wrapError = SerialiseAsRawBytesError . displayException + +deriving instance Eq (UnsignedTx era) + +deriving instance Show (UnsignedTx era)