From 5e5c44f78d51a4ec565a5271ebaff84186f90aa2 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Wed, 3 Jan 2024 16:45:35 -0500
Subject: [PATCH 1/8] Use CDDL-compliant Tx CBOR encoding

---
 .../Marlowe/Runtime/Web/Server/DTO.hs         | 39 +++++++++++++++++--
 1 file changed, 35 insertions(+), 4 deletions(-)

diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
index 585cdfe7c9..80c0b63321 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
@@ -23,17 +23,20 @@ import Cardano.Api (
   SerialiseAsCBOR,
   ShelleyBasedEra (..),
   TextEnvelope (..),
+  TextEnvelopeCddl (..),
   TextEnvelopeType (..),
   Tx,
   TxBody,
   deserialiseAddress,
   deserialiseFromCBOR,
   deserialiseFromTextEnvelope,
+  deserialiseTxLedgerCddl,
   getTxId,
   metadataValueToJsonNoSchema,
   proxyToAsType,
   serialiseToCBOR,
   serialiseToTextEnvelope,
+  serialiseTxLedgerCddl,
  )
 import Cardano.Api.Byron (HasTextEnvelope (textEnvelopeType))
 import Cardano.Api.Shelley (
@@ -697,12 +700,10 @@ instance HasDTO (Tx era) where
   type DTO (Tx era) = Web.TextEnvelope
 
 instance (IsCardanoEra era) => ToDTO (Tx era) where
-  toDTO = toDTO . serialiseToTextEnvelope Nothing
+  toDTO = toDTO . serialiseTxLedgerCddl
 
 instance (IsCardanoEra era) => FromDTO (Tx era) where
-  fromDTO = hush . deserialiseFromTextEnvelope asType <=< fromDTO
-    where
-      asType = AsTx $ cardanoEraToAsType $ cardanoEra @era
+  fromDTO = hush . deserialiseTxLedgerCddl (cardanoEra @era) <=< fromDTO
 
 newtype ShelleyTxWitness era = ShelleyTxWitness (TxWits (ShelleyLedgerEra era))
 
@@ -796,6 +797,36 @@ instance FromDTO TextEnvelope where
           , teRawCBOR = Web.unBase16 teCborHex
           }
 
+instance HasDTO TextEnvelopeCddl where
+  type DTO TextEnvelopeCddl = Web.TextEnvelope
+
+instance ToDTO TextEnvelopeCddl where
+  toDTO
+    TextEnvelopeCddl
+      { teCddlType
+      , teCddlDescription
+      , teCddlRawCBOR
+      } =
+      Web.TextEnvelope
+        { teType = teCddlType
+        , teDescription = teCddlDescription
+        , teCborHex = Web.Base16 teCddlRawCBOR
+        }
+
+instance FromDTO TextEnvelopeCddl where
+  fromDTO
+    Web.TextEnvelope
+      { teType
+      , teDescription
+      , teCborHex
+      } =
+      Just
+        TextEnvelopeCddl
+          { teCddlType = teType
+          , teCddlDescription = teDescription
+          , teCddlRawCBOR = Web.unBase16 teCborHex
+          }
+
 instance HasDTO Tx.RoleTokensConfig where
   type DTO Tx.RoleTokensConfig = Maybe Web.RolesConfig
 

From 58d49449234a27be3b18ab27681f508b4cdec9c1 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Thu, 4 Jan 2024 16:53:32 -0500
Subject: [PATCH 2/8] Remove txbody POST response and tx PUT request

---
 .../Language/Marlowe/Runtime/Web/Common.hs    |  73 ++---
 .../Runtime/Web/Contracts/Contract/Post.hs    |  10 +-
 .../Runtime/Web/Contracts/Contract/Put.hs     |   4 +-
 .../Contracts/Transactions/Transaction/Put.hs |   4 +-
 .../Marlowe/Runtime/Web/StandardContract.hs   |  13 +-
 .../Marlowe/Runtime/Web/Withdrawal/Put.hs     |   4 +-
 marlowe-integration/app/Main.hs               | 141 ---------
 marlowe-integration/marlowe-integration.cabal |  41 ---
 marlowe-runtime-web/.golden/OpenApi/golden    | 134 ++++-----
 marlowe-runtime-web/marlowe-runtime-web.cabal |   3 -
 .../Marlowe/Runtime/Web/Server/DTO.hs         | 229 +++++----------
 .../Runtime/Web/Server/REST/Contracts.hs      |  74 +----
 .../Runtime/Web/Server/REST/Transactions.hs   |  68 +----
 .../Runtime/Web/Server/REST/Withdrawals.hs    |  84 ++----
 .../src/Language/Marlowe/Runtime/Web/API.hs   |  73 +----
 .../Language/Marlowe/Runtime/Web/Client.hs    | 122 ++------
 .../src/Language/Marlowe/Runtime/Web/Types.hs | 273 +++++-------------
 marlowe-runtime-web/test/Spec.hs              |  14 +-
 18 files changed, 337 insertions(+), 1027 deletions(-)
 delete mode 100644 marlowe-integration/app/Main.hs

diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
index acce2805c8..d9a5f08fa7 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
@@ -14,20 +14,20 @@ module Language.Marlowe.Runtime.Web.Common (
 ) where
 
 import Cardano.Api (
-  AsType (..),
+  CardanoEra (..),
+  ShelleyBasedEra (ShelleyBasedEraBabbage),
   ShelleyWitnessSigningKey (..),
-  TextEnvelope (..),
-  TextEnvelopeType (..),
-  deserialiseFromTextEnvelope,
-  serialiseToTextEnvelope,
+  TextEnvelopeCddl (..),
+  deserialiseTxLedgerCddl,
+  getTxBody,
+  getTxWitnesses,
+  serialiseWitnessLedgerCddl,
   signShelleyTransaction,
  )
 import Control.Concurrent (threadDelay)
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.String (IsString (..))
-import qualified Data.Text as T
 import qualified Language.Marlowe as V1
 import Language.Marlowe.Core.V1.Semantics.Types (
   ChoiceId (ChoiceId),
@@ -60,7 +60,7 @@ createCloseContract Wallet{..} = do
   let webExtraAddresses = Set.map toDTO extraAddresses
   let webCollateralUtxos = Set.map toDTO collateralUtxos
 
-  Web.CreateTxEnvelope{txEnvelope, ..} <-
+  Web.CreateTxEnvelope{tx, ..} <-
     postContract
       Nothing
       webChangeAddress
@@ -76,7 +76,7 @@ createCloseContract Wallet{..} = do
         , tags = mempty
         }
 
-  createTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
+  createTx <- liftIO $ signShelleyTransaction' tx signingKeys
   putContract contractId createTx
   _ <- waitUntilConfirmed (\Web.ContractState{status} -> status) $ getContract contractId
   pure contractId
@@ -87,7 +87,7 @@ applyCloseTransaction Wallet{..} contractId = do
   let webChangeAddress = toDTO changeAddress
   let webExtraAddresses = Set.map toDTO extraAddresses
   let webCollateralUtxos = Set.map toDTO collateralUtxos
-  Web.ApplyInputsTxEnvelope{transactionId, txEnvelope} <-
+  Web.ApplyInputsTxEnvelope{transactionId, tx} <-
     postTransaction
       webChangeAddress
       (Just webExtraAddresses)
@@ -102,7 +102,7 @@ applyCloseTransaction Wallet{..} contractId = do
         , tags = mempty
         }
 
-  applyTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
+  applyTx <- liftIO $ signShelleyTransaction' tx signingKeys
 
   putTransaction contractId transactionId applyTx
 
@@ -111,30 +111,30 @@ applyCloseTransaction Wallet{..} contractId = do
 
 submitContract
   :: Wallet
-  -> Web.CreateTxEnvelope Web.CardanoTxBody
+  -> Web.CreateTxEnvelope
   -> ClientM Web.BlockHeader
-submitContract Wallet{..} Web.CreateTxEnvelope{contractId, txEnvelope} = do
-  signedCreateTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
+submitContract Wallet{..} Web.CreateTxEnvelope{contractId, tx} = do
+  signedCreateTx <- liftIO $ signShelleyTransaction' tx signingKeys
   putContract contractId signedCreateTx
   Web.ContractState{block} <- waitUntilConfirmed (\Web.ContractState{status} -> status) $ getContract contractId
   liftIO $ expectJust "Expected block header" block
 
 submitTransaction
   :: Wallet
-  -> Web.ApplyInputsTxEnvelope Web.CardanoTxBody
+  -> Web.ApplyInputsTxEnvelope
   -> ClientM Web.BlockHeader
-submitTransaction Wallet{..} Web.ApplyInputsTxEnvelope{contractId, transactionId, txEnvelope} = do
-  signedTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
+submitTransaction Wallet{..} Web.ApplyInputsTxEnvelope{contractId, transactionId, tx} = do
+  signedTx <- liftIO $ signShelleyTransaction' tx signingKeys
   putTransaction contractId transactionId signedTx
   Web.Tx{block} <- waitUntilConfirmed (\Web.Tx{status} -> status) $ getTransaction contractId transactionId
   liftIO $ expectJust "Expected a block header" block
 
 submitWithdrawal
   :: Wallet
-  -> Web.WithdrawTxEnvelope Web.CardanoTxBody
+  -> Web.WithdrawTxEnvelope
   -> ClientM Web.BlockHeader
-submitWithdrawal Wallet{..} Web.WithdrawTxEnvelope{withdrawalId, txEnvelope} = do
-  signedWithdrawalTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
+submitWithdrawal Wallet{..} Web.WithdrawTxEnvelope{withdrawalId, tx} = do
+  signedWithdrawalTx <- liftIO $ signShelleyTransaction' tx signingKeys
   putWithdrawal withdrawalId signedWithdrawalTx
   Web.Withdrawal{block} <- waitUntilConfirmed (\Web.Withdrawal{status} -> status) $ getWithdrawal withdrawalId
   liftIO $ expectJust "Expected a block header" block
@@ -146,7 +146,7 @@ deposit
   -> V1.Party
   -> V1.Token
   -> Integer
-  -> ClientM (Web.ApplyInputsTxEnvelope Web.CardanoTxBody)
+  -> ClientM Web.ApplyInputsTxEnvelope
 deposit wallet contractId intoAccount fromParty ofToken quantity =
   applyInputs wallet contractId [NormalInput $ IDeposit intoAccount fromParty ofToken quantity]
 
@@ -156,20 +156,20 @@ choose
   -> PV2.BuiltinByteString
   -> V1.Party
   -> Integer
-  -> ClientM (Web.ApplyInputsTxEnvelope Web.CardanoTxBody)
+  -> ClientM Web.ApplyInputsTxEnvelope
 choose wallet contractId choice party chosenNum =
   applyInputs wallet contractId [NormalInput $ IChoice (ChoiceId choice party) chosenNum]
 
 notify
   :: Wallet
   -> Web.TxOutRef
-  -> ClientM (Web.ApplyInputsTxEnvelope Web.CardanoTxBody)
+  -> ClientM Web.ApplyInputsTxEnvelope
 notify wallet contractId = applyInputs wallet contractId [NormalInput INotify]
 
 withdraw
   :: Wallet
   -> Set Web.TxOutRef
-  -> ClientM (Web.WithdrawTxEnvelope Web.CardanoTxBody)
+  -> ClientM Web.WithdrawTxEnvelope
 withdraw Wallet{..} payouts = do
   let WalletAddresses{..} = addresses
   let webChangeAddress = toDTO changeAddress
@@ -187,7 +187,7 @@ applyInputs
   :: Wallet
   -> Web.TxOutRef
   -> [V1.Input]
-  -> ClientM (Web.ApplyInputsTxEnvelope Web.CardanoTxBody)
+  -> ClientM Web.ApplyInputsTxEnvelope
 applyInputs Wallet{..} contractId inputs = do
   let WalletAddresses{..} = addresses
   let webChangeAddress = toDTO changeAddress
@@ -208,19 +208,24 @@ applyInputs Wallet{..} contractId inputs = do
       , tags = mempty
       }
 
-signShelleyTransaction' :: Web.TextEnvelope -> [ShelleyWitnessSigningKey] -> IO Web.TextEnvelope
-signShelleyTransaction' Web.TextEnvelope{..} wits = do
+signShelleyTransaction' :: Web.UnwitnessedTx -> [ShelleyWitnessSigningKey] -> IO Web.TxWitness
+signShelleyTransaction' Web.UnwitnessedTx{..} wits = do
   let te =
-        TextEnvelope
-          { teType = TextEnvelopeType (T.unpack teType)
-          , teDescription = fromString (T.unpack teDescription)
-          , teRawCBOR = Web.unBase16 teCborHex
+        TextEnvelopeCddl
+          { teCddlType = utType
+          , teCddlDescription = utDescription
+          , teCddlRawCBOR = Web.unBase16 utCborHex
           }
-  txBody <- case deserialiseFromTextEnvelope (AsTxBody AsBabbage) te of
+  txBody <- case deserialiseTxLedgerCddl BabbageEra te of
     Left err -> fail $ show err
     Right a -> pure a
-  pure case serialiseToTextEnvelope Nothing $ signShelleyTransaction txBody wits of
-    TextEnvelope (TextEnvelopeType ty) _ bytes -> Web.TextEnvelope (T.pack ty) "" $ Web.Base16 bytes
+  let witnessCddl =
+        serialiseWitnessLedgerCddl ShelleyBasedEraBabbage $
+          head $
+            getTxWitnesses $
+              signShelleyTransaction (getTxBody txBody) wits
+  pure case witnessCddl of
+    TextEnvelopeCddl ty _ bytes -> Web.TxWitness ty "" $ Web.Base16 bytes
 
 waitUntilConfirmed :: (MonadIO m) => (a -> Web.TxStatus) -> m a -> m a
 waitUntilConfirmed getStatus getResource = do
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Post.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Post.hs
index cd5b3f709d..8ca7919691 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Post.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Post.hs
@@ -5,14 +5,14 @@ module Language.Marlowe.Runtime.Web.Contracts.Contract.Post where
 import Control.Monad.IO.Class (MonadIO (liftIO))
 
 import Cardano.Api (
-  AsType (..),
+  BabbageEra,
   TxBody (..),
   TxBodyContent (..),
   TxMetadata (TxMetadata),
   TxMetadataInEra (..),
   TxMetadataSupportedInEra (TxMetadataInBabbageEra),
   TxMetadataValue (..),
-  deserialiseFromTextEnvelope,
+  getTxBody,
  )
 import Data.Aeson (Value (String))
 import qualified Data.Aeson.Key as Key
@@ -132,10 +132,8 @@ bugPLT8712 = do
               , tags = mempty
               }
         liftIO do
-          textEnvelope <- expectJust "Failed to convert text envelope" $ fromDTO txEnvelope
-          TxBody TxBodyContent{..} <-
-            expectRight "Failed to deserialise tx body" $
-              deserialiseFromTextEnvelope (AsTxBody AsBabbageEra) textEnvelope
+          tx' <- expectJust "Failed to convert text envelope" $ fromDTO tx
+          let TxBody TxBodyContent{..} = getTxBody @BabbageEra tx'
           case txMetadata of
             TxMetadataNone -> fail "expected metadata"
             TxMetadataInEra TxMetadataInBabbageEra (TxMetadata m) -> do
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Put.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Put.hs
index 352120e068..9c1606068f 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Put.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Contract/Put.hs
@@ -36,7 +36,7 @@ spec = describe "POST /contracts/{contractId}/transactions" do
 
       let (contract, _, _) = standardContract partyBAddress now $ secondsToNominalDiffTime 100
 
-      Web.CreateTxEnvelope{contractId, txEnvelope} <-
+      Web.CreateTxEnvelope{contractId, tx} <-
         postContract
           Nothing
           partyAWebChangeAddress
@@ -55,7 +55,7 @@ spec = describe "POST /contracts/{contractId}/transactions" do
             , minUTxODeposit = Nothing
             , tags = mempty
             }
-      signedCreateTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
+      signedCreateTx <- liftIO $ signShelleyTransaction' tx signingKeys
       putContract contractId signedCreateTx
     case result of
       Left _ -> fail $ "Expected 200 response code - got " <> show result
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Transactions/Transaction/Put.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Transactions/Transaction/Put.hs
index f6ae075c4e..d7025bff1b 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Transactions/Transaction/Put.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Contracts/Transactions/Transaction/Put.hs
@@ -68,7 +68,7 @@ spec = describe "PUT /contracts/{contractId}/transactions/{transaction}" do
 
       let inputs = [NormalInput $ IDeposit partyA partyA ada 100_000_000]
 
-      Web.ApplyInputsTxEnvelope{transactionId, txEnvelope} <-
+      Web.ApplyInputsTxEnvelope{transactionId, tx} <-
         postTransaction
           partyAWebChangeAddress
           (Just partyAWebExtraAddresses)
@@ -82,7 +82,7 @@ spec = describe "PUT /contracts/{contractId}/transactions/{transaction}" do
             , inputs
             , tags = mempty
             }
-      applyTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
+      applyTx <- liftIO $ signShelleyTransaction' tx signingKeys
       putTransaction contractId transactionId applyTx
     case result of
       Left _ -> fail $ "Expected 200 response code - got " <> show result
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs
index fd41e5feae..e0ce428281 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/StandardContract.hs
@@ -22,7 +22,6 @@ import Language.Marlowe.Runtime.Transaction.Api (WalletAddresses (..))
 import Language.Marlowe.Runtime.Web (
   ApplyInputsTxEnvelope,
   BlockHeader,
-  CardanoTxBody,
   ContractOrSourceId (..),
   CreateTxEnvelope,
   PayoutHeader (..),
@@ -49,31 +48,31 @@ import Servant.Client.Streaming (ClientM)
 
 data StandardContractInit = StandardContractInit
   { makeInitialDeposit :: ClientM StandardContractFundsDeposited
-  , contractCreated :: CreateTxEnvelope CardanoTxBody
+  , contractCreated :: CreateTxEnvelope
   , createdBlock :: BlockHeader
   }
 
 data StandardContractFundsDeposited = StandardContractFundsDeposited
   { chooseGimmeTheMoney :: ClientM StandardContractChoiceMade
-  , initialFundsDeposited :: ApplyInputsTxEnvelope CardanoTxBody
+  , initialFundsDeposited :: ApplyInputsTxEnvelope
   , initialDepositBlock :: BlockHeader
   }
 
 data StandardContractChoiceMade = StandardContractChoiceMade
   { sendNotify :: ClientM StandardContractNotified
-  , gimmeTheMoneyChosen :: ApplyInputsTxEnvelope CardanoTxBody
+  , gimmeTheMoneyChosen :: ApplyInputsTxEnvelope
   , choiceBlock :: BlockHeader
   }
 
 data StandardContractNotified = StandardContractNotified
   { makeReturnDeposit :: ClientM StandardContractClosed
-  , notified :: ApplyInputsTxEnvelope CardanoTxBody
+  , notified :: ApplyInputsTxEnvelope
   , notifiedBlock :: BlockHeader
   }
 
 data StandardContractClosed = StandardContractClosed
-  { withdrawPartyAFunds :: ClientM (WithdrawTxEnvelope CardanoTxBody, BlockHeader)
-  , returnDeposited :: ApplyInputsTxEnvelope CardanoTxBody
+  { withdrawPartyAFunds :: ClientM (WithdrawTxEnvelope, BlockHeader)
+  , returnDeposited :: ApplyInputsTxEnvelope
   , returnDepositBlock :: BlockHeader
   }
 
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs
index f1b5cb9b6d..d124e9eb2a 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Withdrawal/Put.hs
@@ -44,9 +44,9 @@ spec = describe "PUT /contracts/{contractId}/withdrawals/{withdrawalId}" do
       Page{..} <- getPayouts (Just $ Set.singleton contractId) Nothing (Just Available) Nothing
       let payouts = Set.fromList $ payoutId <$> items
 
-      Web.WithdrawTxEnvelope{withdrawalId, txEnvelope} <-
+      Web.WithdrawTxEnvelope{withdrawalId, tx} <-
         postWithdrawal webChangeAddress (Just webExtraAddresses) (Just webCollateralUtxos) Web.PostWithdrawalsRequest{..}
-      signedWithdrawalTx <- liftIO $ signShelleyTransaction' txEnvelope signingKeys
+      signedWithdrawalTx <- liftIO $ signShelleyTransaction' tx signingKeys
       putWithdrawal withdrawalId signedWithdrawalTx
 
     case result of
diff --git a/marlowe-integration/app/Main.hs b/marlowe-integration/app/Main.hs
deleted file mode 100644
index a72ab0cdfc..0000000000
--- a/marlowe-integration/app/Main.hs
+++ /dev/null
@@ -1,141 +0,0 @@
-module Main where
-
-import Cardano.Api (
-  AsType (..),
-  ShelleyWitnessSigningKey (..),
-  TextEnvelope (..),
-  TextEnvelopeType (..),
-  deserialiseFromTextEnvelope,
-  serialiseToTextEnvelope,
-  signShelleyTransaction,
- )
-import Control.Concurrent (threadDelay)
-import Control.Exception (throw)
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Data.Aeson (decodeFileStrict)
-import Data.Either (fromRight)
-import Data.Maybe (fromJust)
-import Data.String (IsString (..))
-import qualified Data.Text as T
-import qualified Language.Marlowe.Core.V1.Semantics.Types as V1
-import Language.Marlowe.Runtime.ChainSync.Api (Address (..), fromBech32, toBech32)
-import Language.Marlowe.Runtime.Web (
-  ContractOrSourceId (..),
-  CreateTxEnvelope (CreateTxEnvelope),
-  PostContractsRequest (..),
- )
-import qualified Language.Marlowe.Runtime.Web as Web
-import Language.Marlowe.Runtime.Web.Client (
-  getContract,
-  getTransaction,
-  postContract,
-  postTransaction,
-  putContract,
-  putTransaction,
- )
-import Test.Integration.Marlowe
-import qualified Test.Integration.Marlowe as M (LocalTestnet (..))
-
-main :: IO ()
-main = withLocalMarloweRuntime \MarloweRuntime{..} -> do
-  putStr "Workspace: "
-  putStrLn $ workspaceDir $ M.workspace testnet
-
-  (address, signingKey) <- getFirstWallet testnet
-  putStr "Loaded wallet: "
-  let webAddress = Web.Address $ fromJust $ toBech32 address
-  print webAddress
-
-  either throw pure =<< runWebClient do
-    Web.CreateTxEnvelope{txEnvelope = createTxBody, ..} <-
-      postContract
-        Nothing
-        webAddress
-        Nothing
-        Nothing
-        Web.PostContractsRequest
-          { metadata = mempty
-          , tags = mempty
-          , threadTokenName = Nothing
-          , version = Web.V1
-          , roles = Nothing
-          , contract = ContractOrSourceId $ Left V1.Close
-          , minUTxODeposit = Nothing
-          }
-
-    liftIO $ print CreateTxEnvelope{txEnvelope = createTxBody, ..}
-
-    createTx <- liftIO $ signShelleyTransaction' createTxBody [signingKey]
-
-    putContract contractId createTx
-
-    contractState <- waitUntilConfirmed (\Web.ContractState{status} -> status) $ getContract contractId
-
-    liftIO $ print contractState
-
-    Web.ApplyInputsTxEnvelope{transactionId, txEnvelope = applyTxBody} <-
-      postTransaction
-        webAddress
-        Nothing
-        Nothing
-        contractId
-        Web.PostTransactionsRequest
-          { version = Web.V1
-          , tags = mempty
-          , metadata = mempty
-          , invalidBefore = Nothing
-          , invalidHereafter = Nothing
-          , inputs = []
-          }
-
-    applyTx <- liftIO $ signShelleyTransaction' applyTxBody [signingKey]
-
-    putTransaction contractId transactionId applyTx
-
-    tx <- waitUntilConfirmed (\Web.Tx{status} -> status) $ getTransaction contractId transactionId
-
-    liftIO $ print tx
-
-waitUntilConfirmed :: (MonadIO m) => (a -> Web.TxStatus) -> m a -> m a
-waitUntilConfirmed getStatus getResource = do
-  resource <- getResource
-  case getStatus resource of
-    Web.Confirmed -> pure resource
-    _ -> do
-      liftIO $ threadDelay 1000
-      waitUntilConfirmed getStatus getResource
-
-signShelleyTransaction' :: Web.TextEnvelope -> [ShelleyWitnessSigningKey] -> IO Web.TextEnvelope
-signShelleyTransaction' Web.TextEnvelope{..} wits = do
-  let te =
-        TextEnvelope
-          { teType = TextEnvelopeType (T.unpack teType)
-          , teDescription = fromString (T.unpack teDescription)
-          , teRawCBOR = Web.unBase16 teCborHex
-          }
-  txBody <- case deserialiseFromTextEnvelope (AsTxBody AsBabbage) te of
-    Left err -> fail $ show err
-    Right a -> pure a
-  pure case serialiseToTextEnvelope Nothing $ signShelleyTransaction txBody wits of
-    TextEnvelope (TextEnvelopeType ty) _ bytes -> Web.TextEnvelope (T.pack ty) "" $ Web.Base16 bytes
-
-getFirstWallet :: LocalTestnet -> IO (Address, ShelleyWitnessSigningKey)
-getFirstWallet LocalTestnet{..} = do
-  let PaymentKeyPair{..} = head wallets
-  address <-
-    fromJust . fromBech32 . T.pack
-      <$> execCli
-        [ "address"
-        , "build"
-        , "--verification-key-file"
-        , paymentVKey
-        , "--testnet-magic"
-        , "1"
-        ]
-  textEnvelope <- fromJust <$> decodeFileStrict paymentSKey
-  pure
-    ( address
-    , WitnessGenesisUTxOKey $
-        fromRight (error "Failed to decode text envelope") $
-          deserialiseFromTextEnvelope (AsSigningKey AsGenesisUTxOKey) textEnvelope
-    )
diff --git a/marlowe-integration/marlowe-integration.cabal b/marlowe-integration/marlowe-integration.cabal
index e5f6c48a44..02394c50eb 100644
--- a/marlowe-integration/marlowe-integration.cabal
+++ b/marlowe-integration/marlowe-integration.cabal
@@ -88,44 +88,3 @@ library
     , typed-protocols
     , unliftio
     , warp
-
-executable marlowe-integration-example
-  default-language:   Haskell2010
-  hs-source-dirs:     app
-  default-extensions:
-    BlockArguments
-    DeriveAnyClass
-    DeriveFoldable
-    DeriveFunctor
-    DeriveGeneric
-    DeriveLift
-    DeriveTraversable
-    DerivingStrategies
-    DerivingVia
-    ExplicitForAll
-    GeneralizedNewtypeDeriving
-    LambdaCase
-    NamedFieldPuns
-    NumericUnderscores
-    OverloadedStrings
-    RecordWildCards
-    ScopedTypeVariables
-    StandaloneDeriving
-    TupleSections
-    TypeApplications
-
-  ghc-options:
-    -Wall -Wnoncanonical-monad-instances -Wunused-packages
-    -Wincomplete-uni-patterns -Wincomplete-record-updates
-    -Wredundant-constraints -Widentities
-
-  main-is:            Main.hs
-  build-depends:
-    , aeson
-    , base >=4.9 && <5
-    , cardano-api ^>=8.2
-    , marlowe-cardano
-    , marlowe-chain-sync
-    , marlowe-integration
-    , marlowe-runtime-web
-    , text
diff --git a/marlowe-runtime-web/.golden/OpenApi/golden b/marlowe-runtime-web/.golden/OpenApi/golden
index 556425768a..7884a45c71 100644
--- a/marlowe-runtime-web/.golden/OpenApi/golden
+++ b/marlowe-runtime-web/.golden/OpenApi/golden
@@ -177,7 +177,6 @@
                 "type": "object"
             },
             "ApplyInputsTxEnvelope": {
-                "description": "The \"type\" property of \"tx\" must be \"Tx BabbageEra\" or \"Tx ConwayEra\"",
                 "properties": {
                     "contractId": {
                         "$ref": "#/components/schemas/TxOutRef"
@@ -186,7 +185,7 @@
                         "$ref": "#/components/schemas/TxId"
                     },
                     "tx": {
-                        "$ref": "#/components/schemas/TextEnvelope"
+                        "$ref": "#/components/schemas/UnwitnessedTx"
                     }
                 },
                 "required": [
@@ -811,7 +810,7 @@
                         "type": "object"
                     },
                     "txBody": {
-                        "$ref": "#/components/schemas/TextEnvelope"
+                        "$ref": "#/components/schemas/UnwitnessedTx"
                     },
                     "unclaimedPayouts": {
                         "items": {
@@ -859,30 +858,7 @@
                 ],
                 "type": "object"
             },
-            "CreateTxBodyEnvelope": {
-                "description": "The \"type\" property of \"txBody\" must be \"TxBody BabbageEra\" or \"TxBody ConwayEra\"",
-                "properties": {
-                    "contractId": {
-                        "$ref": "#/components/schemas/TxOutRef"
-                    },
-                    "safetyErrors": {
-                        "items": {
-                            "$ref": "#/components/schemas/SafetyError"
-                        },
-                        "type": "array"
-                    },
-                    "txBody": {
-                        "$ref": "#/components/schemas/TextEnvelope"
-                    }
-                },
-                "required": [
-                    "contractId",
-                    "txBody"
-                ],
-                "type": "object"
-            },
             "CreateTxEnvelope": {
-                "description": "The \"type\" property of \"tx\" must be \"Tx BabbageEra\" or \"Tx ConwayEra\"",
                 "properties": {
                     "contractId": {
                         "$ref": "#/components/schemas/TxOutRef"
@@ -894,12 +870,13 @@
                         "type": "array"
                     },
                     "tx": {
-                        "$ref": "#/components/schemas/TextEnvelope"
+                        "$ref": "#/components/schemas/UnwitnessedTx"
                     }
                 },
                 "required": [
                     "contractId",
-                    "tx"
+                    "tx",
+                    "safetyErrors"
                 ],
                 "type": "object"
             },
@@ -2350,26 +2327,6 @@
                     "fatal"
                 ]
             },
-            "TextEnvelope": {
-                "properties": {
-                    "cborHex": {
-                        "type": "string"
-                    },
-                    "description": {
-                        "type": "string"
-                    },
-                    "type": {
-                        "description": "What type of data is encoded in the CBOR Hex. Valid values include \"Tx <era>\", \"TxBody <era>\", and \"ShelleyTxWitness <era>\" where <era> is one of \"BabbageEra\", \"ConwayEra\".",
-                        "type": "string"
-                    }
-                },
-                "required": [
-                    "type",
-                    "description",
-                    "cborHex"
-                ],
-                "type": "object"
-            },
             "Token": {
                 "description": "A token with a currency symbol (minting policy ID) and token name.",
                 "properties": {
@@ -2786,7 +2743,7 @@
                         "$ref": "#/components/schemas/TxId"
                     },
                     "txBody": {
-                        "$ref": "#/components/schemas/TextEnvelope"
+                        "$ref": "#/components/schemas/UnwitnessedTx"
                     }
                 },
                 "required": [
@@ -2866,11 +2823,59 @@
                 ],
                 "type": "string"
             },
+            "TxWitness": {
+                "properties": {
+                    "cborHex": {
+                        "type": "string"
+                    },
+                    "description": {
+                        "type": "string"
+                    },
+                    "type": {
+                        "description": "What type of data is encoded in the CBOR Hex.",
+                        "enum": [
+                            "TxWitness BabbageEra",
+                            "TxWitness ConwayEra"
+                        ],
+                        "type": "string"
+                    }
+                },
+                "required": [
+                    "type",
+                    "description",
+                    "cborHex"
+                ],
+                "type": "object"
+            },
             "UTCTime": {
                 "example": "2016-07-22T00:00:00Z",
                 "format": "yyyy-mm-ddThh:MM:ssZ",
                 "type": "string"
             },
+            "UnwitnessedTx": {
+                "properties": {
+                    "cborHex": {
+                        "type": "string"
+                    },
+                    "description": {
+                        "type": "string"
+                    },
+                    "type": {
+                        "description": "What type of data is encoded in the CBOR Hex.",
+                        "enum": [
+                            "Unwitnessed Tx BabbageEra",
+                            "Unwitnessed Tx ConwayEra"
+                        ],
+                        "type": "string"
+                    }
+                },
+                "required": [
+                    "type",
+                    "description",
+                    "cborHex"
+                ],
+                "type": "object"
+            },
             "Value": {
                 "description": "A time-varying expression that evaluates to a boolean",
                 "oneOf": [
@@ -3188,27 +3193,10 @@
                 ],
                 "type": "object"
             },
-            "WithdrawTxBodyEnvelope": {
-                "description": "The \"type\" property of \"txBody\" must be \"TxBody BabbageEra\" or \"TxBody ConwayEra\"",
-                "properties": {
-                    "txBody": {
-                        "$ref": "#/components/schemas/TextEnvelope"
-                    },
-                    "withdrawalId": {
-                        "$ref": "#/components/schemas/TxId"
-                    }
-                },
-                "required": [
-                    "withdrawalId",
-                    "txBody"
-                ],
-                "type": "object"
-            },
             "WithdrawTxEnvelope": {
-                "description": "The \"type\" property of \"tx\" must be \"Tx BabbageEra\" or \"Tx ConwayEra\"",
                 "properties": {
                     "tx": {
-                        "$ref": "#/components/schemas/TextEnvelope"
+                        "$ref": "#/components/schemas/UnwitnessedTx"
                     },
                     "withdrawalId": {
                         "$ref": "#/components/schemas/TxId"
@@ -3565,7 +3553,7 @@
                 "responses": {
                     "201": {
                         "content": {
-                            "application/vendor.iog.marlowe-runtime.contract-tx-json": {
+                            "application/json;charset=utf-8": {
                                 "schema": {
                                     "$ref": "#/components/schemas/CreateContractResponse"
                                 }
@@ -4556,7 +4544,7 @@
                     "content": {
                         "application/json;charset=utf-8": {
                             "schema": {
-                                "$ref": "#/components/schemas/TextEnvelope"
+                                "$ref": "#/components/schemas/TxWitness"
                             }
                         }
                     }
@@ -5157,7 +5145,7 @@
                 "responses": {
                     "201": {
                         "content": {
-                            "application/vendor.iog.marlowe-runtime.apply-inputs-tx-json": {
+                            "application/json;charset=utf-8": {
                                 "schema": {
                                     "$ref": "#/components/schemas/ApplyInputsResponse"
                                 }
@@ -5502,7 +5490,7 @@
                     "content": {
                         "application/json;charset=utf-8": {
                             "schema": {
-                                "$ref": "#/components/schemas/TextEnvelope"
+                                "$ref": "#/components/schemas/TxWitness"
                             }
                         }
                     }
@@ -6423,7 +6411,7 @@
                 "responses": {
                     "201": {
                         "content": {
-                            "application/vendor.iog.marlowe-runtime.withdraw-tx-json": {
+                            "application/json;charset=utf-8": {
                                 "schema": {
                                     "$ref": "#/components/schemas/WithdrawPayoutsResponse"
                                 }
@@ -6743,7 +6731,7 @@
                     "content": {
                         "application/json;charset=utf-8": {
                             "schema": {
-                                "$ref": "#/components/schemas/TextEnvelope"
+                                "$ref": "#/components/schemas/TxWitness"
                             }
                         }
                     }
diff --git a/marlowe-runtime-web/marlowe-runtime-web.cabal b/marlowe-runtime-web/marlowe-runtime-web.cabal
index 140dbea02a..8a971eea9e 100644
--- a/marlowe-runtime-web/marlowe-runtime-web.cabal
+++ b/marlowe-runtime-web/marlowe-runtime-web.cabal
@@ -69,7 +69,6 @@ library
     , base16 ^>=0.3.2
     , bytestring >=0.10.12 && <0.12
     , containers ^>=0.6.5
-    , http-media ^>=0.8
     , lens >=5.2 && <6
     , marlowe-cardano ==0.2.1.0
     , marlowe-object ==0.2.0.1
@@ -120,10 +119,8 @@ library server
     , async >=2.2 && <3
     , async-components ==0.1.1.0
     , base >=4.9 && <5
-    , bytestring >=0.10.12 && <0.12
     , cardano-api ^>=8.2
     , cardano-ledger-alonzo ^>=1.2
-    , cardano-ledger-binary ^>=1.1
     , cardano-ledger-core ^>=1.2
     , cardano-ledger-shelley ^>=1.2
     , co-log >=0.5.0.0 && <0.6.0.0
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
index 80c0b63321..a3747e42ed 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
@@ -14,45 +14,32 @@ module Language.Marlowe.Runtime.Web.Server.DTO where
 
 import Cardano.Api (
   AsType (..),
-  HasTextEnvelope,
-  HasTypeProxy,
   IsCardanoEra (..),
   IsShelleyBasedEra (..),
+  KeyWitness,
   NetworkId (..),
   NetworkMagic (..),
-  SerialiseAsCBOR,
-  ShelleyBasedEra (..),
-  TextEnvelope (..),
   TextEnvelopeCddl (..),
-  TextEnvelopeType (..),
   Tx,
-  TxBody,
   deserialiseAddress,
-  deserialiseFromCBOR,
-  deserialiseFromTextEnvelope,
   deserialiseTxLedgerCddl,
+  deserialiseWitnessLedgerCddl,
   getTxId,
+  makeSignedTransaction,
   metadataValueToJsonNoSchema,
-  proxyToAsType,
-  serialiseToCBOR,
-  serialiseToTextEnvelope,
   serialiseTxLedgerCddl,
+  serialiseWitnessLedgerCddl,
  )
-import Cardano.Api.Byron (HasTextEnvelope (textEnvelopeType))
 import Cardano.Api.Shelley (
   ReferenceTxInsScriptsInlineDatumsSupportedInEra (..),
-  ShelleyLedgerEra,
   StakeAddress (..),
   fromShelleyStakeCredential,
  )
-import qualified Cardano.Ledger.Alonzo.Scripts as Ledger.Alonzo.Scripts
-import qualified Cardano.Ledger.Core as Ledger.Core
 import Control.Arrow (Arrow (..))
 import Control.Error.Util (hush)
 import Control.Monad ((<=<))
 import Control.Monad.Except (MonadError, throwError)
 import Data.Aeson (Value (..))
-import qualified Data.ByteString.Lazy as BSL
 import Data.Coerce (coerce)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Map (Map)
@@ -85,9 +72,6 @@ import Language.Marlowe.Protocol.Query.Types (
   Withdrawal (..),
  )
 
-import Cardano.Ledger.Alonzo.Core (TxWits)
-import Cardano.Ledger.Binary (Annotator, DecCBOR (..), Decoder, decodeFullAnnotator, serialize')
-import Cardano.Ledger.Core (EraTxWits, eraProtVerLow)
 import qualified Data.Aeson.Key as Key
 import qualified Data.Aeson.KeyMap as KeyMap
 import Data.Bitraversable (Bitraversable (..))
@@ -97,7 +81,7 @@ import Data.List (groupBy)
 import qualified Data.Map.NonEmpty as NEMap
 import Data.Set (Set)
 import qualified Language.Marlowe.Protocol.Query.Types as Query
-import Language.Marlowe.Runtime.Cardano.Api (cardanoEraToAsType, fromCardanoTxId)
+import Language.Marlowe.Runtime.Cardano.Api (fromCardanoTxId)
 import Language.Marlowe.Runtime.ChainSync.Api (AssetId (..))
 import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain
 import Language.Marlowe.Runtime.Core.Api (
@@ -122,7 +106,6 @@ import Language.Marlowe.Runtime.Web.Server.TxClient (TempTx (..), TempTxStatus (
 import Network.HTTP.Media (MediaType, parseAccept)
 import Servant.Pagination (IsRangeType)
 import qualified Servant.Pagination as Pagination
-import Unsafe.Coerce (unsafeCoerce)
 
 -- | A class that states a type has a DTO representation.
 class HasDTO a where
@@ -603,8 +586,8 @@ instance ToDTOWithTxStatus (Tx.ContractCreated v) where
       , utxo = Nothing
       , txBody = case status of
           Unsigned -> Just case era of
-            ReferenceTxInsScriptsInlineDatumsInBabbageEra -> toDTO txBody
-            ReferenceTxInsScriptsInlineDatumsInConwayEra -> toDTO txBody
+            ReferenceTxInsScriptsInlineDatumsInBabbageEra -> toDTO $ makeSignedTransaction [] txBody
+            ReferenceTxInsScriptsInlineDatumsInConwayEra -> toDTO $ makeSignedTransaction [] txBody
           Submitted -> Nothing
       , unclaimedPayouts = []
       }
@@ -640,8 +623,8 @@ instance ToDTOWithTxStatus (Tx.InputsApplied v) where
               <$> M.toList (payouts output)
       , txBody = case status of
           Unsigned -> Just case era of
-            ReferenceTxInsScriptsInlineDatumsInBabbageEra -> toDTO txBody
-            ReferenceTxInsScriptsInlineDatumsInConwayEra -> toDTO txBody
+            ReferenceTxInsScriptsInlineDatumsInBabbageEra -> toDTO $ makeSignedTransaction [] txBody
+            ReferenceTxInsScriptsInlineDatumsInConwayEra -> toDTO $ makeSignedTransaction [] txBody
           Submitted -> Nothing
       }
 
@@ -685,147 +668,75 @@ instance FromDTO Chain.StakeCredential where
       . deserialiseAddress AsStakeAddress
       . Web.unStakeAddress
 
-instance HasDTO (TxBody era) where
-  type DTO (TxBody era) = Web.TextEnvelope
-
-instance (IsCardanoEra era) => ToDTO (TxBody era) where
-  toDTO = toDTO . serialiseToTextEnvelope Nothing
-
-instance (IsCardanoEra era) => FromDTO (TxBody era) where
-  fromDTO = hush . deserialiseFromTextEnvelope asType <=< fromDTO
-    where
-      asType = AsTxBody $ cardanoEraToAsType $ cardanoEra @era
-
 instance HasDTO (Tx era) where
-  type DTO (Tx era) = Web.TextEnvelope
+  type DTO (Tx era) = Web.UnwitnessedTx
 
 instance (IsCardanoEra era) => ToDTO (Tx era) where
-  toDTO = toDTO . serialiseTxLedgerCddl
+  toDTO = textEnvelopeToUnwitnessedTx . serialiseTxLedgerCddl
 
 instance (IsCardanoEra era) => FromDTO (Tx era) where
-  fromDTO = hush . deserialiseTxLedgerCddl (cardanoEra @era) <=< fromDTO
-
-newtype ShelleyTxWitness era = ShelleyTxWitness (TxWits (ShelleyLedgerEra era))
-
-instance (HasTypeProxy era) => HasTypeProxy (ShelleyTxWitness era) where
-  data AsType (ShelleyTxWitness era) = AsShelleyTxWitness (AsType era)
-  proxyToAsType _ = AsShelleyTxWitness (proxyToAsType (Proxy :: Proxy era))
-
-instance
-  ( HasTypeProxy era
-  , EraTxWits (ShelleyLedgerEra era)
-  , Ledger.Core.Script (ShelleyLedgerEra era) ~ Ledger.Alonzo.Scripts.AlonzoScript (ShelleyLedgerEra era)
-  )
-  => SerialiseAsCBOR (ShelleyTxWitness era)
-  where
-  serialiseToCBOR (ShelleyTxWitness wit) = serialize' (eraProtVerLow @(ShelleyLedgerEra era)) wit
-
-  deserialiseFromCBOR _ bs = do
-    let lbs = BSL.fromStrict bs
-
-        annotator :: forall s. Decoder s (Annotator (TxWits (ShelleyLedgerEra era)))
-        annotator = decCBOR
-
-    (w :: TxWits (ShelleyLedgerEra era)) <-
-      decodeFullAnnotator (eraProtVerLow @(ShelleyLedgerEra era)) "Shelley Tx Witness" annotator lbs
-    pure $ ShelleyTxWitness w
-
-instance
-  ( IsShelleyBasedEra era
-  , EraTxWits (ShelleyLedgerEra era)
-  , Ledger.Core.Script (ShelleyLedgerEra era) ~ Ledger.Alonzo.Scripts.AlonzoScript (ShelleyLedgerEra era)
-  )
-  => HasTextEnvelope (ShelleyTxWitness era)
-  where
-  textEnvelopeType _ = do
-    "ShelleyTxWitness " <> case shelleyBasedEra :: ShelleyBasedEra era of
-      ShelleyBasedEraAlonzo -> "AlonzoEra"
-      ShelleyBasedEraBabbage -> "BabbageEra"
-      ShelleyBasedEraConway -> "ConwayEra"
-
-instance HasDTO (ShelleyTxWitness era) where
-  type DTO (ShelleyTxWitness era) = Web.TextEnvelope
-
-instance
-  ( IsShelleyBasedEra era
-  , EraTxWits (ShelleyLedgerEra era)
-  , Ledger.Core.Script (ShelleyLedgerEra era) ~ Ledger.Alonzo.Scripts.AlonzoScript (ShelleyLedgerEra era)
-  )
-  => ToDTO (ShelleyTxWitness era)
-  where
-  toDTO = toDTO . serialiseToTextEnvelope Nothing
-
-instance
-  ( IsShelleyBasedEra era
-  , EraTxWits (ShelleyLedgerEra era)
-  , Ledger.Core.Script (ShelleyLedgerEra era) ~ Ledger.Alonzo.Scripts.AlonzoScript (ShelleyLedgerEra era)
-  )
-  => FromDTO (ShelleyTxWitness era)
-  where
-  fromDTO = hush . deserialiseFromTextEnvelope asType <=< fromDTO
-    where
-      eraAsType = cardanoEraToAsType $ cardanoEra @era
-      asType = AsShelleyTxWitness eraAsType
-
-instance HasDTO TextEnvelope where
-  type DTO TextEnvelope = Web.TextEnvelope
-
-instance ToDTO TextEnvelope where
-  toDTO
-    TextEnvelope
-      { teType = TextEnvelopeType teType
-      , teDescription
-      , teRawCBOR
-      } =
-      Web.TextEnvelope
-        { teType = T.pack teType
-        , teDescription = T.pack $ unsafeCoerce teDescription
-        , teCborHex = Web.Base16 teRawCBOR
-        }
+  fromDTO = hush . deserialiseTxLedgerCddl (cardanoEra @era) . textEnvelopeFromUnwitnessedTx
+
+instance HasDTO (KeyWitness era) where
+  type DTO (KeyWitness era) = Web.TxWitness
+
+instance (IsShelleyBasedEra era) => ToDTO (KeyWitness era) where
+  toDTO = textEnvelopeToTxWitness . serialiseWitnessLedgerCddl (shelleyBasedEra @era)
+
+instance (IsShelleyBasedEra era) => FromDTO (KeyWitness era) where
+  fromDTO = hush . deserialiseWitnessLedgerCddl (shelleyBasedEra @era) . textEnvelopeFromTxWitness
+
+textEnvelopeToUnwitnessedTx :: TextEnvelopeCddl -> Web.UnwitnessedTx
+textEnvelopeToUnwitnessedTx
+  TextEnvelopeCddl
+    { teCddlType
+    , teCddlDescription
+    , teCddlRawCBOR
+    } =
+    Web.UnwitnessedTx
+      { utType = teCddlType
+      , utDescription = teCddlDescription
+      , utCborHex = Web.Base16 teCddlRawCBOR
+      }
 
-instance FromDTO TextEnvelope where
-  fromDTO
-    Web.TextEnvelope
-      { teType
-      , teDescription
-      , teCborHex
-      } =
-      Just
-        TextEnvelope
-          { teType = TextEnvelopeType $ T.unpack teType
-          , teDescription = fromString $ T.unpack teDescription
-          , teRawCBOR = Web.unBase16 teCborHex
-          }
-
-instance HasDTO TextEnvelopeCddl where
-  type DTO TextEnvelopeCddl = Web.TextEnvelope
-
-instance ToDTO TextEnvelopeCddl where
-  toDTO
+textEnvelopeFromUnwitnessedTx :: Web.UnwitnessedTx -> TextEnvelopeCddl
+textEnvelopeFromUnwitnessedTx
+  Web.UnwitnessedTx
+    { utType
+    , utDescription
+    , utCborHex
+    } =
     TextEnvelopeCddl
-      { teCddlType
-      , teCddlDescription
-      , teCddlRawCBOR
-      } =
-      Web.TextEnvelope
-        { teType = teCddlType
-        , teDescription = teCddlDescription
-        , teCborHex = Web.Base16 teCddlRawCBOR
-        }
+      { teCddlType = utType
+      , teCddlDescription = utDescription
+      , teCddlRawCBOR = Web.unBase16 utCborHex
+      }
+
+textEnvelopeToTxWitness :: TextEnvelopeCddl -> Web.TxWitness
+textEnvelopeToTxWitness
+  TextEnvelopeCddl
+    { teCddlType
+    , teCddlDescription
+    , teCddlRawCBOR
+    } =
+    Web.TxWitness
+      { twType = teCddlType
+      , twDescription = teCddlDescription
+      , twCborHex = Web.Base16 teCddlRawCBOR
+      }
 
-instance FromDTO TextEnvelopeCddl where
-  fromDTO
-    Web.TextEnvelope
-      { teType
-      , teDescription
-      , teCborHex
-      } =
-      Just
-        TextEnvelopeCddl
-          { teCddlType = teType
-          , teCddlDescription = teDescription
-          , teCddlRawCBOR = Web.unBase16 teCborHex
-          }
+textEnvelopeFromTxWitness :: Web.TxWitness -> TextEnvelopeCddl
+textEnvelopeFromTxWitness
+  Web.TxWitness
+    { twType
+    , twDescription
+    , twCborHex
+    } =
+    TextEnvelopeCddl
+      { teCddlType = twType
+      , teCddlDescription = twDescription
+      , teCddlRawCBOR = Web.unBase16 twCborHex
+      }
 
 instance HasDTO Tx.RoleTokensConfig where
   type DTO Tx.RoleTokensConfig = Maybe Web.RolesConfig
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Contracts.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Contracts.hs
index 3e53b39b98..d1552e0d63 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Contracts.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Contracts.hs
@@ -4,10 +4,8 @@
 -- | This module defines a server for the /contracts REST API.
 module Language.Marlowe.Runtime.Web.Server.REST.Contracts where
 
-import Cardano.Api (BabbageEra, ConwayEra, TxBody, makeSignedTransaction)
-import qualified Cardano.Api as Cardano
+import Cardano.Api (TxBody, makeSignedTransaction)
 import Cardano.Api.Shelley (ReferenceTxInsScriptsInlineDatumsSupportedInEra (..))
-import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..))
 import Data.Aeson (Value (Null))
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
@@ -15,6 +13,7 @@ import qualified Data.Set as Set
 import Data.Text (Text)
 import Language.Marlowe.Analysis.Safety.Types (SafetyError)
 import Language.Marlowe.Protocol.Query.Types (ContractFilter (..), Page (..))
+import Language.Marlowe.Runtime.Cardano.Feature (ShelleyFeature (..), withShelleyBasedEra)
 import Language.Marlowe.Runtime.ChainSync.Api (DatumHash (..), Lovelace (..))
 import Language.Marlowe.Runtime.Core.Api (
   ContractId,
@@ -47,14 +46,13 @@ import qualified Language.Marlowe.Runtime.Web.Server.REST.Contracts.Next as Next
 import qualified Language.Marlowe.Runtime.Web.Server.REST.Transactions as Transactions
 import Language.Marlowe.Runtime.Web.Server.REST.Withdrawals (TxBodyInAnyEra (..))
 import Language.Marlowe.Runtime.Web.Server.TxClient (TempTx (TempTx), TempTxStatus (Unsigned))
-import Language.Marlowe.Runtime.Web.Server.Util (makeSignedTxWithWitnessKeys)
 import Servant
 import Servant.Pagination
 
 server :: ServerT ContractsAPI ServerM
 server =
   get
-    :<|> (\stakeAddress -> postCreateTxBodyResponse stakeAddress :<|> postCreateTxResponse stakeAddress)
+    :<|> post
     :<|> contractServer
     :<|> ContractSources.server
 
@@ -98,28 +96,14 @@ postCreateTxBody PostContractsRequest{..} stakeAddressDTO changeAddressDTO mAddr
       Right
         (ContractCreated ReferenceTxInsScriptsInlineDatumsInConwayEra ContractCreatedInEra{contractId, txBody, safetyErrors}) -> pure (contractId, TxBodyInAnyEra txBody, safetyErrors)
 
-postCreateTxBodyResponse
+post
   :: Maybe StakeAddress
   -> PostContractsRequest
   -> Address
   -> Maybe (CommaList Address)
   -> Maybe (CommaList TxOutRef)
-  -> ServerM (PostContractsResponse CardanoTxBody)
-postCreateTxBodyResponse stakeAddressDTO req changeAddressDTO mAddresses mCollateralUtxos = do
-  (contractId, TxBodyInAnyEra txBody, safetyErrors) <-
-    postCreateTxBody req stakeAddressDTO changeAddressDTO mAddresses mCollateralUtxos
-  let (contractId', txBody') = toDTO (contractId, txBody)
-  let body = CreateTxEnvelope contractId' txBody' safetyErrors
-  pure $ IncludeLink (Proxy @"contract") body
-
-postCreateTxResponse
-  :: Maybe StakeAddress
-  -> PostContractsRequest
-  -> Address
-  -> Maybe (CommaList Address)
-  -> Maybe (CommaList TxOutRef)
-  -> ServerM (PostContractsResponse CardanoTx)
-postCreateTxResponse stakeAddressDTO req changeAddressDTO mAddresses mCollateralUtxos = do
+  -> ServerM PostContractsResponse
+post stakeAddressDTO req changeAddressDTO mAddresses mCollateralUtxos = do
   (contractId, TxBodyInAnyEra txBody, safetyErrors) <-
     postCreateTxBody req stakeAddressDTO changeAddressDTO mAddresses mCollateralUtxos
   let tx = makeSignedTransaction [] txBody
@@ -168,8 +152,8 @@ getOne contractId = do
       let contractState = either toDTO toDTO result
       pure $ IncludeLink (Proxy @"transactions") contractState
 
-put :: TxOutRef -> TextEnvelope -> ServerM NoContent
-put contractId body = do
+put :: TxOutRef -> TxWitness -> ServerM NoContent
+put contractId txWitness = do
   contractId' <- fromDTOThrow (badRequest' "Invalid contract id value") contractId
 
   loadContract contractId' >>= \case
@@ -182,43 +166,9 @@ put contractId body = do
   where
     handleLoaded
       :: Core.ContractId -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> TxBody era -> ServerM NoContent
-    handleLoaded contractId' ReferenceTxInsScriptsInlineDatumsInBabbageEra txBody = do
-      (req :: Maybe (Either (Cardano.Tx BabbageEra) (ShelleyTxWitness BabbageEra))) <- case teType body of
-        "Tx BabbageEra" -> pure $ Left <$> fromDTO body
-        "ShelleyTxWitness BabbageEra" -> pure $ Right <$> fromDTO body
-        _ ->
-          throwError $ badRequest' "Unknown envelope type - allowed types are: \"Tx BabbageEra\", \"ShelleyTxWitness BabbageEra\""
-
-      tx <- case req of
-        Nothing -> throwError $ badRequest' "Invalid text envelope cbor value"
-        Just (Left tx) -> pure tx
-        -- It seems that wallets provide nearly empty `TxWitness` back. Here is a quote from `CIP-30` docs:
-        -- > Only the portion of the witness set that were signed as a result of this call are returned to
-        -- > encourage dApps to verify the contents returned by this endpoint while building the final transaction.
-        Just (Right (ShelleyTxWitness (AlonzoTxWits wtKeys _ _ _ _))) -> do
-          case makeSignedTxWithWitnessKeys txBody wtKeys of
-            Just tx -> pure tx
-            Nothing -> throwError $ badRequest' "Invalid witness keys"
-      submitContract contractId' ReferenceTxInsScriptsInlineDatumsInBabbageEra tx >>= \case
-        Nothing -> pure NoContent
-        Just err -> throwError $ ApiError.toServerError $ ApiError (show err) "SubmissionError" Null 403
-    handleLoaded contractId' ReferenceTxInsScriptsInlineDatumsInConwayEra txBody = do
-      (req :: Maybe (Either (Cardano.Tx ConwayEra) (ShelleyTxWitness ConwayEra))) <- case teType body of
-        "Tx ConwayEra" -> pure $ Left <$> fromDTO body
-        "ShelleyTxWitness ConwayEra" -> pure $ Right <$> fromDTO body
-        _ ->
-          throwError $ badRequest' "Unknown envelope type - allowed types are: \"Tx ConwayEra\", \"ShelleyTxWitness ConwayEra\""
-
-      tx <- case req of
-        Nothing -> throwError $ badRequest' "Invalid text envelope cbor value"
-        Just (Left tx) -> pure tx
-        -- It seems that wallets provide nearly empty `TxWitness` back. Here is a quote from `CIP-30` docs:
-        -- > Only the portion of the witness set that were signed as a result of this call are returned to
-        -- > encourage dApps to verify the contents returned by this endpoint while building the final transaction.
-        Just (Right (ShelleyTxWitness (AlonzoTxWits wtKeys _ _ _ _))) -> do
-          case makeSignedTxWithWitnessKeys txBody wtKeys of
-            Just tx -> pure tx
-            Nothing -> throwError $ badRequest' "Invalid witness keys"
-      submitContract contractId' ReferenceTxInsScriptsInlineDatumsInConwayEra tx >>= \case
+    handleLoaded contractId' era txBody = withShelleyBasedEra (shelleyBasedEraOfFeature era) do
+      txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
+      let tx = makeSignedTransaction [txWitness'] txBody
+      submitContract contractId' era tx >>= \case
         Nothing -> pure NoContent
         Just err -> throwError $ ApiError.toServerError $ ApiError (show err) "SubmissionError" Null 403
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Transactions.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Transactions.hs
index 87315b59b7..6a54bb3cbe 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Transactions.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Transactions.hs
@@ -4,16 +4,15 @@
 -- | This module defines a server for the /contracts/:contractId/transactions REST API.
 module Language.Marlowe.Runtime.Web.Server.REST.Transactions where
 
-import Cardano.Api (BabbageEra, ConwayEra, TxBody, getTxId, makeSignedTransaction)
-import qualified Cardano.Api as Cardano
+import Cardano.Api (TxBody, getTxId, makeSignedTransaction)
 import Cardano.Api.Shelley (ReferenceTxInsScriptsInlineDatumsSupportedInEra (..))
-import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..))
 import Data.Aeson (Value (Null))
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
 import qualified Data.Set as Set
 import Language.Marlowe.Protocol.Query.Types (Page (..))
 import Language.Marlowe.Runtime.Cardano.Api (fromCardanoTxId)
+import Language.Marlowe.Runtime.Cardano.Feature (ShelleyFeature (..), withShelleyBasedEra)
 import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain
 import Language.Marlowe.Runtime.Core.Api (
   MarloweTransactionMetadata (MarloweTransactionMetadata),
@@ -42,14 +41,13 @@ import qualified Language.Marlowe.Runtime.Web.Server.REST.ApiError as ApiError
 import Language.Marlowe.Runtime.Web.Server.REST.Withdrawals (TxBodyInAnyEra (..))
 import Language.Marlowe.Runtime.Web.Server.SyncClient (LoadTxError (..))
 import Language.Marlowe.Runtime.Web.Server.TxClient (TempTx (TempTx), TempTxStatus (..))
-import Language.Marlowe.Runtime.Web.Server.Util (makeSignedTxWithWitnessKeys)
 import Servant
 import Servant.Pagination
 
 server :: TxOutRef -> ServerT TransactionsAPI ServerM
 server contractId =
   get contractId
-    :<|> (postCreateTxBodyResponse contractId :<|> postCreateTxResponse contractId)
+    :<|> post contractId
     :<|> transactionServer contractId
 
 get
@@ -94,28 +92,14 @@ postCreateTxBody contractId PostTransactionsRequest{..} changeAddressDTO mAddres
     Right (InputsApplied ReferenceTxInsScriptsInlineDatumsInBabbageEra InputsAppliedInEra{txBody}) -> pure $ TxBodyInAnyEra txBody
     Right (InputsApplied ReferenceTxInsScriptsInlineDatumsInConwayEra InputsAppliedInEra{txBody}) -> pure $ TxBodyInAnyEra txBody
 
-postCreateTxBodyResponse
+post
   :: TxOutRef
   -> PostTransactionsRequest
   -> Address
   -> Maybe (CommaList Address)
   -> Maybe (CommaList TxOutRef)
-  -> ServerM (PostTransactionsResponse CardanoTxBody)
-postCreateTxBodyResponse contractId req changeAddressDTO mAddresses mCollateralUtxos = do
-  TxBodyInAnyEra txBody <- postCreateTxBody contractId req changeAddressDTO mAddresses mCollateralUtxos
-  let txBody' = toDTO txBody
-  let txId = toDTO $ fromCardanoTxId $ getTxId txBody
-  let body = ApplyInputsTxEnvelope contractId txId txBody'
-  pure $ IncludeLink (Proxy @"transaction") body
-
-postCreateTxResponse
-  :: TxOutRef
-  -> PostTransactionsRequest
-  -> Address
-  -> Maybe (CommaList Address)
-  -> Maybe (CommaList TxOutRef)
-  -> ServerM (PostTransactionsResponse CardanoTx)
-postCreateTxResponse contractId req changeAddressDTO mAddresses mCollateralUtxos = do
+  -> ServerM PostTransactionsResponse
+post contractId req changeAddressDTO mAddresses mCollateralUtxos = do
   TxBodyInAnyEra txBody <- postCreateTxBody contractId req changeAddressDTO mAddresses mCollateralUtxos
   let txId = toDTO $ fromCardanoTxId $ getTxId txBody
   let tx = makeSignedTransaction [] txBody
@@ -140,8 +124,8 @@ getOne contractId txId = do
         IncludeLink (Proxy @"previous") $
           IncludeLink (Proxy @"next") contractState
 
-put :: TxOutRef -> TxId -> TextEnvelope -> ServerM NoContent
-put contractId txId body = do
+put :: TxOutRef -> TxId -> TxWitness -> ServerM NoContent
+put contractId txId txWitness = do
   contractId' <- fromDTOThrow (badRequest' "Invalid contract id value") contractId
   txId' <- fromDTOThrow (badRequest' "Invalid transaction id value") txId
   loadTransaction contractId' txId' >>= \case
@@ -154,37 +138,9 @@ put contractId txId body = do
   where
     handleLoaded
       :: Core.ContractId -> Chain.TxId -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> TxBody era -> ServerM NoContent
-    handleLoaded contractId' txId' ReferenceTxInsScriptsInlineDatumsInBabbageEra txBody = do
-      (req :: Maybe (Either (Cardano.Tx BabbageEra) (ShelleyTxWitness BabbageEra))) <- case teType body of
-        "Tx BabbageEra" -> pure $ Left <$> fromDTO body
-        "ShelleyTxWitness BabbageEra" -> pure $ Right <$> fromDTO body
-        _ ->
-          throwError $ badRequest' "Unknown envelope type - allowed types are: \"Tx BabbageEra\", \"ShelleyTxWitness BabbageEra\""
-
-      tx <- case req of
-        Nothing -> throwError $ badRequest' "Invalid text envelope cbor value"
-        Just (Left tx) -> pure tx
-        Just (Right (ShelleyTxWitness (AlonzoTxWits wtKeys _ _ _ _))) ->
-          case makeSignedTxWithWitnessKeys txBody wtKeys of
-            Just tx -> pure tx
-            Nothing -> throwError $ badRequest' "Invalid witness keys"
-      submitTransaction contractId' txId' ReferenceTxInsScriptsInlineDatumsInBabbageEra tx >>= \case
-        Nothing -> pure NoContent
-        Just err -> throwError $ ApiError.toServerError $ ApiError (show err) "SubmissionError" Null 403
-    handleLoaded contractId' txId' ReferenceTxInsScriptsInlineDatumsInConwayEra txBody = do
-      (req :: Maybe (Either (Cardano.Tx ConwayEra) (ShelleyTxWitness ConwayEra))) <- case teType body of
-        "Tx ConwayEra" -> pure $ Left <$> fromDTO body
-        "ShelleyTxWitness ConwayEra" -> pure $ Right <$> fromDTO body
-        _ ->
-          throwError $ badRequest' "Unknown envelope type - allowed types are: \"Tx ConwayEra\", \"ShelleyTxWitness ConwayEra\""
-
-      tx <- case req of
-        Nothing -> throwError $ badRequest' "Invalid text envelope cbor value"
-        Just (Left tx) -> pure tx
-        Just (Right (ShelleyTxWitness (AlonzoTxWits wtKeys _ _ _ _))) ->
-          case makeSignedTxWithWitnessKeys txBody wtKeys of
-            Just tx -> pure tx
-            Nothing -> throwError $ badRequest' "Invalid witness keys"
-      submitTransaction contractId' txId' ReferenceTxInsScriptsInlineDatumsInConwayEra tx >>= \case
+    handleLoaded contractId' txId' era txBody = withShelleyBasedEra (shelleyBasedEraOfFeature era) do
+      txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
+      let tx = makeSignedTransaction [txWitness'] txBody
+      submitTransaction contractId' txId' era tx >>= \case
         Nothing -> pure NoContent
         Just err -> throwError $ ApiError.toServerError $ ApiError (show err) "SubmissionError" Null 403
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs
index c28396ba7d..4f780817cb 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs
@@ -6,15 +6,14 @@
 -- | This module defines a server for the /withdrawals REST API.
 module Language.Marlowe.Runtime.Web.Server.REST.Withdrawals where
 
-import Cardano.Api (BabbageEra, ConwayEra, IsCardanoEra, TxBody, getTxId, makeSignedTransaction)
-import qualified Cardano.Api as Cardano
+import Cardano.Api (IsCardanoEra, TxBody, getTxId, makeSignedTransaction)
 import Cardano.Api.Shelley (ReferenceTxInsScriptsInlineDatumsSupportedInEra (..))
-import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..))
 import Data.Aeson (Value (..))
 import Data.Maybe (fromMaybe)
 import qualified Data.Set as Set
 import Language.Marlowe.Protocol.Query.Types (Page (..), WithdrawalFilter (..))
 import Language.Marlowe.Runtime.Cardano.Api (fromCardanoTxId)
+import Language.Marlowe.Runtime.Cardano.Feature (ShelleyFeature (..), withShelleyBasedEra)
 import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain
 import Language.Marlowe.Runtime.Core.Api (MarloweVersion (..))
 import Language.Marlowe.Runtime.Transaction.Api (WalletAddresses (..), WithdrawTx (..), WithdrawTxInEra (..))
@@ -30,26 +29,25 @@ import Language.Marlowe.Runtime.Web.Server.REST.ApiError (
  )
 import qualified Language.Marlowe.Runtime.Web.Server.REST.ApiError as ApiError
 import Language.Marlowe.Runtime.Web.Server.TxClient (TempTx (..), TempTxStatus (..))
-import Language.Marlowe.Runtime.Web.Server.Util
 import Servant
 import Servant.Pagination
 
 server :: ServerT WithdrawalsAPI ServerM
 server =
   get
-    :<|> (postCreateTxBodyResponse :<|> postCreateTxResponse)
+    :<|> post
     :<|> withdrawalServer
 
 data TxBodyInAnyEra where
   TxBodyInAnyEra :: (IsCardanoEra era) => TxBody era -> TxBodyInAnyEra
 
-postCreateTxBody
+post
   :: PostWithdrawalsRequest
   -> Address
   -> Maybe (CommaList Address)
   -> Maybe (CommaList TxOutRef)
-  -> ServerM TxBodyInAnyEra
-postCreateTxBody PostWithdrawalsRequest{..} changeAddressDTO mAddresses mCollateralUtxos = do
+  -> ServerM PostWithdrawalsResponse
+post PostWithdrawalsRequest{..} changeAddressDTO mAddresses mCollateralUtxos = do
   changeAddress <- fromDTOThrow (badRequest' "Invalid change address value") changeAddressDTO
   extraAddresses <-
     Set.fromList <$> fromDTOThrow (badRequest' "Invalid addresses header value") (maybe [] unCommaList mAddresses)
@@ -57,31 +55,11 @@ postCreateTxBody PostWithdrawalsRequest{..} changeAddressDTO mAddresses mCollate
     Set.fromList
       <$> fromDTOThrow (badRequest' "Invalid collateral header UTxO value") (maybe [] unCommaList mCollateralUtxos)
   payouts' <- fromDTOThrow (badRequest' "Invalid payouts") payouts
-  withdraw MarloweV1 WalletAddresses{..} payouts' >>= \case
-    Left err -> throwDTOError err
-    Right (WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{txBody}) -> pure $ TxBodyInAnyEra txBody
-    Right (WithdrawTx ReferenceTxInsScriptsInlineDatumsInConwayEra WithdrawTxInEra{txBody}) -> pure $ TxBodyInAnyEra txBody
-
-postCreateTxBodyResponse
-  :: PostWithdrawalsRequest
-  -> Address
-  -> Maybe (CommaList Address)
-  -> Maybe (CommaList TxOutRef)
-  -> ServerM (PostWithdrawalsResponse CardanoTxBody)
-postCreateTxBodyResponse req changeAddressDTO mAddresses mCollateralUtxos = do
-  TxBodyInAnyEra txBody <- postCreateTxBody req changeAddressDTO mAddresses mCollateralUtxos
-  let (withdrawalId, txBody') = toDTO (fromCardanoTxId $ getTxId txBody, txBody)
-  let body = WithdrawTxEnvelope withdrawalId txBody'
-  pure $ IncludeLink (Proxy @"withdrawal") body
-
-postCreateTxResponse
-  :: PostWithdrawalsRequest
-  -> Address
-  -> Maybe (CommaList Address)
-  -> Maybe (CommaList TxOutRef)
-  -> ServerM (PostWithdrawalsResponse CardanoTx)
-postCreateTxResponse req changeAddressDTO mAddresses mCollateralUtxos = do
-  TxBodyInAnyEra txBody <- postCreateTxBody req changeAddressDTO mAddresses mCollateralUtxos
+  TxBodyInAnyEra txBody <-
+    withdraw MarloweV1 WalletAddresses{..} payouts' >>= \case
+      Left err -> throwDTOError err
+      Right (WithdrawTx ReferenceTxInsScriptsInlineDatumsInBabbageEra WithdrawTxInEra{txBody}) -> pure $ TxBodyInAnyEra txBody
+      Right (WithdrawTx ReferenceTxInsScriptsInlineDatumsInConwayEra WithdrawTxInEra{txBody}) -> pure $ TxBodyInAnyEra txBody
   let tx = makeSignedTransaction [] txBody
   let (withdrawalId, tx') = toDTO (fromCardanoTxId $ getTxId txBody, tx)
   let body = WithdrawTxEnvelope withdrawalId tx'
@@ -120,8 +98,8 @@ getOne withdrawalId = do
     Nothing -> throwError $ notFound' "Withdrawal not found"
     Just result -> pure $ either toDTO toDTO result
 
-put :: TxId -> TextEnvelope -> ServerM NoContent
-put withdrawalId body = do
+put :: TxId -> TxWitness -> ServerM NoContent
+put withdrawalId txWitness = do
   withdrawalId' <- fromDTOThrow (badRequest' "Invalid withdrawal id value") withdrawalId
   loadWithdrawal withdrawalId' >>= \case
     Nothing -> throwError $ notFound' "Withdrawal not found"
@@ -132,37 +110,9 @@ put withdrawalId body = do
           ApiError "Withdrawal already submitted" "WithdrawalAlreadySubmitted" Null 409
   where
     handleLoaded :: Chain.TxId -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> TxBody era -> ServerM NoContent
-    handleLoaded withdrawalId' ReferenceTxInsScriptsInlineDatumsInBabbageEra txBody = do
-      (req :: Maybe (Either (Cardano.Tx BabbageEra) (ShelleyTxWitness BabbageEra))) <- case teType body of
-        "Tx BabbageEra" -> pure $ Left <$> fromDTO body
-        "ShelleyTxWitness BabbageEra" -> pure $ Right <$> fromDTO body
-        _ ->
-          throwError $ badRequest' "Unknown envelope type - allowed types are: \"Tx BabbageEra\", \"ShelleyTxWitness BabbageEra\""
-
-      tx <- case req of
-        Nothing -> throwError $ badRequest' "Invalid text envelope cbor value"
-        Just (Left tx) -> pure tx
-        Just (Right (ShelleyTxWitness (AlonzoTxWits wtKeys _ _ _ _))) ->
-          case makeSignedTxWithWitnessKeys txBody wtKeys of
-            Just tx -> pure tx
-            Nothing -> throwError $ badRequest' "Invalid witness keys"
-      submitWithdrawal withdrawalId' ReferenceTxInsScriptsInlineDatumsInBabbageEra tx >>= \case
-        Nothing -> pure NoContent
-        Just err -> throwError $ ApiError.toServerError $ ApiError (show err) "SubmissionError" Null 403
-    handleLoaded withdrawalId' ReferenceTxInsScriptsInlineDatumsInConwayEra txBody = do
-      (req :: Maybe (Either (Cardano.Tx ConwayEra) (ShelleyTxWitness ConwayEra))) <- case teType body of
-        "Tx ConwayEra" -> pure $ Left <$> fromDTO body
-        "ShelleyTxWitness ConwayEra" -> pure $ Right <$> fromDTO body
-        _ ->
-          throwError $ badRequest' "Unknown envelope type - allowed types are: \"Tx ConwayEra\", \"ShelleyTxWitness ConwayEra\""
-
-      tx <- case req of
-        Nothing -> throwError $ badRequest' "Invalid text envelope cbor value"
-        Just (Left tx) -> pure tx
-        Just (Right (ShelleyTxWitness (AlonzoTxWits wtKeys _ _ _ _))) ->
-          case makeSignedTxWithWitnessKeys txBody wtKeys of
-            Just tx -> pure tx
-            Nothing -> throwError $ badRequest' "Invalid witness keys"
-      submitWithdrawal withdrawalId' ReferenceTxInsScriptsInlineDatumsInConwayEra tx >>= \case
+    handleLoaded withdrawalId' era txBody = withShelleyBasedEra (shelleyBasedEraOfFeature era) do
+      txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
+      let tx = makeSignedTransaction [txWitness'] txBody
+      submitWithdrawal withdrawalId' era tx >>= \case
         Nothing -> pure NoContent
         Just err -> throwError $ ApiError.toServerError $ ApiError (show err) "SubmissionError" Null 403
diff --git a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/API.hs b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/API.hs
index d072b8a1a5..29633d01c3 100644
--- a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/API.hs
+++ b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/API.hs
@@ -63,7 +63,6 @@ import Data.Text.Encoding (encodeUtf8)
 import Language.Marlowe.Core.V1.Semantics.Types (Contract)
 import Language.Marlowe.Object.Types (Label, ObjectBundle)
 import Language.Marlowe.Runtime.Web.Types
-import Network.HTTP.Media ((//))
 import Network.Wai (mapResponseHeaders)
 import Pipes (Producer)
 import Servant
@@ -244,24 +243,11 @@ instance HasNamedLink ContractHeader API "transactions" where
       "contracts" :> Capture "contractId" TxOutRef :> "transactions" :> GetTransactionsAPI
   namedLink _ _ mkLink ContractHeader{..} = guard (status == Confirmed) $> mkLink contractId
 
-type PostContractsResponse tx = WithLink "contract" (CreateTxEnvelope tx)
+type PostContractsResponse = WithLink "contract" CreateTxEnvelope
 
-data TxJSON a
-
-data ContractTx
-
-instance Accept (TxJSON ContractTx) where
-  contentType _ = "application" // "vendor.iog.marlowe-runtime.contract-tx-json"
-
-instance MimeRender (TxJSON ContractTx) (PostContractsResponse CardanoTx) where
-  mimeRender _ = encode . toJSON
-
-instance MimeUnrender (TxJSON ContractTx) (PostContractsResponse CardanoTx) where
-  mimeUnrender _ = eitherDecode
-
-instance HasNamedLink (CreateTxEnvelope tx) API "contract" where
+instance HasNamedLink CreateTxEnvelope API "contract" where
   type
-    Endpoint (CreateTxEnvelope tx) API "contract" =
+    Endpoint CreateTxEnvelope API "contract" =
       "contracts" :> Capture "contractId" TxOutRef :> GetContractAPI
   namedLink _ _ mkLink CreateTxEnvelope{..} = Just $ mkLink contractId
 
@@ -278,9 +264,8 @@ type PostContractsAPI =
         '[Optional, Strict, Description "Where to send staking rewards for the Marlowe script outputs of this contract."]
         "X-Stake-Address"
         StakeAddress
-    :> ( ReqBody '[JSON] PostContractsRequest :> PostTxAPI (PostCreated '[JSON] (PostContractsResponse CardanoTxBody))
-          :<|> ReqBody '[JSON] PostContractsRequest :> PostTxAPI (PostCreated '[TxJSON ContractTx] (PostContractsResponse CardanoTx))
-       )
+    :> ReqBody '[JSON] PostContractsRequest
+    :> PostTxAPI (PostCreated '[JSON] PostContractsResponse)
 
 -- | /contracts/:contractId sub-API
 type ContractAPI =
@@ -369,17 +354,6 @@ type TransactionsAPI =
     :<|> PostTransactionsAPI
     :<|> Capture "transactionId" TxId :> TransactionAPI
 
-data ApplyInputsTx
-
-instance Accept (TxJSON ApplyInputsTx) where
-  contentType _ = "application" // "vendor.iog.marlowe-runtime.apply-inputs-tx-json"
-
-instance MimeRender (TxJSON ApplyInputsTx) (PostTransactionsResponse CardanoTx) where
-  mimeRender _ = encode . toJSON
-
-instance MimeUnrender (TxJSON ApplyInputsTx) (PostTransactionsResponse CardanoTx) where
-  mimeUnrender _ = eitherDecode
-
 -- | POST /contracts/:contractId/transactions sub-API
 type PostTransactionsAPI =
   Summary "Apply inputs to contract"
@@ -389,16 +363,14 @@ type PostTransactionsAPI =
         \To submit the signed transaction, use the PUT /contracts/{contractId}/transactions/{transactionId} endpoint."
     :> OperationId "applyInputsToContract"
     :> RenameResponseSchema "ApplyInputsResponse"
-    :> ( ReqBody '[JSON] PostTransactionsRequest :> PostTxAPI (PostCreated '[JSON] (PostTransactionsResponse CardanoTxBody))
-          :<|> ReqBody '[JSON] PostTransactionsRequest
-            :> PostTxAPI (PostCreated '[TxJSON ApplyInputsTx] (PostTransactionsResponse CardanoTx))
-       )
+    :> ReqBody '[JSON] PostTransactionsRequest
+    :> PostTxAPI (PostCreated '[JSON] PostTransactionsResponse)
 
-type PostTransactionsResponse tx = WithLink "transaction" (ApplyInputsTxEnvelope tx)
+type PostTransactionsResponse = WithLink "transaction" ApplyInputsTxEnvelope
 
-instance HasNamedLink (ApplyInputsTxEnvelope tx) API "transaction" where
+instance HasNamedLink ApplyInputsTxEnvelope API "transaction" where
   type
-    Endpoint (ApplyInputsTxEnvelope tx) API "transaction" =
+    Endpoint ApplyInputsTxEnvelope API "transaction" =
       "contracts"
         :> Capture "contractId" TxOutRef
         :> "transactions"
@@ -450,7 +422,7 @@ type GetTransactionAPI =
 
 type GetTransactionResponse = WithLink "previous" (WithLink "next" Tx)
 
-type PutSignedTxAPI = ReqBody '[JSON] TextEnvelope :> PutAccepted '[JSON] NoContent
+type PutSignedTxAPI = ReqBody '[JSON] TxWitness :> PutAccepted '[JSON] NoContent
 
 instance HasNamedLink Tx API "previous" where
   type
@@ -554,27 +526,14 @@ type PostWithdrawalsAPI =
         \To submit the signed transaction, use the PUT /withdrawals/{withdrawalId} endpoint."
     :> OperationId "withdrawPayouts"
     :> RenameResponseSchema "WithdrawPayoutsResponse"
-    :> ( ReqBody '[JSON] PostWithdrawalsRequest :> PostTxAPI (PostCreated '[JSON] (PostWithdrawalsResponse CardanoTxBody))
-          :<|> ReqBody '[JSON] PostWithdrawalsRequest
-            :> PostTxAPI (PostCreated '[TxJSON WithdrawTx] (PostWithdrawalsResponse CardanoTx))
-       )
-
-type PostWithdrawalsResponse tx = WithLink "withdrawal" (WithdrawTxEnvelope tx)
-
-data WithdrawTx
-
-instance Accept (TxJSON WithdrawTx) where
-  contentType _ = "application" // "vendor.iog.marlowe-runtime.withdraw-tx-json"
-
-instance MimeRender (TxJSON WithdrawTx) (PostWithdrawalsResponse CardanoTx) where
-  mimeRender _ = encode . toJSON
+    :> ReqBody '[JSON] PostWithdrawalsRequest
+    :> PostTxAPI (PostCreated '[JSON] PostWithdrawalsResponse)
 
-instance MimeUnrender (TxJSON WithdrawTx) (PostWithdrawalsResponse CardanoTx) where
-  mimeUnrender _ = eitherDecode
+type PostWithdrawalsResponse = WithLink "withdrawal" WithdrawTxEnvelope
 
-instance HasNamedLink (WithdrawTxEnvelope tx) API "withdrawal" where
+instance HasNamedLink WithdrawTxEnvelope API "withdrawal" where
   type
-    Endpoint (WithdrawTxEnvelope tx) API "withdrawal" =
+    Endpoint WithdrawTxEnvelope API "withdrawal" =
       "withdrawals" :> Capture "withdrawalId" TxId :> GetWithdrawalAPI
   namedLink _ _ mkLink WithdrawTxEnvelope{..} = Just $ mkLink withdrawalId
 
diff --git a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Client.hs b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Client.hs
index f73157601a..61a700adb1 100644
--- a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Client.hs
+++ b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Client.hs
@@ -30,18 +30,12 @@ module Language.Marlowe.Runtime.Web.Client (
   getWithdrawalsStatus,
   healthcheck,
   postContract,
-  postContractCreateTx,
-  postContractCreateTxStatus,
   postContractSource,
   postContractSourceStatus,
   postContractStatus,
   postTransaction,
-  postTransactionCreateTx,
-  postTransactionCreateTxStatus,
   postTransactionStatus,
   postWithdrawal,
-  postWithdrawalCreateTx,
-  postWithdrawalCreateTxStatus,
   postWithdrawalStatus,
   putContract,
   putContractStatus,
@@ -162,12 +156,12 @@ postContractStatus
   -> Maybe (Set Address)
   -> Maybe (Set TxOutRef)
   -> PostContractsRequest
-  -> ClientM (RuntimeStatus, CreateTxEnvelope CardanoTxBody)
+  -> ClientM (RuntimeStatus, CreateTxEnvelope)
 postContractStatus stakeAddress changeAddress otherAddresses collateralUtxos request = do
-  let (_ :<|> getPost :<|> _) :<|> _ = client
-  let (postContractCreateTxBody' :<|> _) = getPost stakeAddress
+  let (_ :<|> postContract' :<|> _) :<|> _ = client
   response <-
-    postContractCreateTxBody'
+    postContract'
+      stakeAddress
       request
       changeAddress
       (setToCommaList <$> otherAddresses)
@@ -181,37 +175,9 @@ postContract
   -> Maybe (Set Address)
   -> Maybe (Set TxOutRef)
   -> PostContractsRequest
-  -> ClientM (CreateTxEnvelope CardanoTxBody)
+  -> ClientM CreateTxEnvelope
 postContract = (fmap . fmap . fmap . fmap . fmap) snd . postContractStatus
 
-postContractCreateTxStatus
-  :: Maybe StakeAddress
-  -> Address
-  -> Maybe (Set Address)
-  -> Maybe (Set TxOutRef)
-  -> PostContractsRequest
-  -> ClientM (RuntimeStatus, CreateTxEnvelope CardanoTx)
-postContractCreateTxStatus stakeAddress changeAddress otherAddresses collateralUtxos request = do
-  let (_ :<|> getPost :<|> _) :<|> _ = client
-  let (_ :<|> postContractCreateTx') = getPost stakeAddress
-  response <-
-    postContractCreateTx'
-      request
-      changeAddress
-      (setToCommaList <$> otherAddresses)
-      (setToCommaList <$> collateralUtxos)
-  status <- extractStatus response
-  pure (status, retractLink $ getResponse response)
-
-postContractCreateTx
-  :: Maybe StakeAddress
-  -> Address
-  -> Maybe (Set Address)
-  -> Maybe (Set TxOutRef)
-  -> PostContractsRequest
-  -> ClientM (CreateTxEnvelope CardanoTx)
-postContractCreateTx = (fmap . fmap . fmap . fmap . fmap) snd . postContractCreateTxStatus
-
 postContractSourceStatus
   :: Label
   -> Producer ObjectBundle IO ()
@@ -293,7 +259,7 @@ getContractNextStatus contractId validityStart validityEnd parties = do
 getContractNext :: TxOutRef -> UTCTime -> UTCTime -> [Party] -> ClientM Next
 getContractNext = (fmap . fmap . fmap . fmap) snd . getContractNextStatus
 
-putContractStatus :: TxOutRef -> TextEnvelope -> ClientM RuntimeStatus
+putContractStatus :: TxOutRef -> TxWitness -> ClientM RuntimeStatus
 putContractStatus contractId tx = do
   let contractsClient :<|> _ = client
   let _ :<|> _ :<|> contractApi :<|> _ = contractsClient
@@ -301,7 +267,7 @@ putContractStatus contractId tx = do
   response <- putContract' tx
   extractStatus response
 
-putContract :: TxOutRef -> TextEnvelope -> ClientM ()
+putContract :: TxOutRef -> TxWitness -> ClientM ()
 putContract = fmap void . putContractStatus
 
 getWithdrawalsStatus
@@ -336,10 +302,10 @@ postWithdrawalStatus
   -> Maybe (Set Address)
   -> Maybe (Set TxOutRef)
   -> PostWithdrawalsRequest
-  -> ClientM (RuntimeStatus, WithdrawTxEnvelope CardanoTxBody)
+  -> ClientM (RuntimeStatus, WithdrawTxEnvelope)
 postWithdrawalStatus changeAddress otherAddresses collateralUtxos request = do
   let _ :<|> withdrawalsClient :<|> _ = client
-  let _ :<|> (postWithdrawal' :<|> _) :<|> _ = withdrawalsClient
+  let _ :<|> postWithdrawal' :<|> _ = withdrawalsClient
   response <-
     postWithdrawal'
       request
@@ -354,35 +320,9 @@ postWithdrawal
   -> Maybe (Set Address)
   -> Maybe (Set TxOutRef)
   -> PostWithdrawalsRequest
-  -> ClientM (WithdrawTxEnvelope CardanoTxBody)
+  -> ClientM WithdrawTxEnvelope
 postWithdrawal = (fmap . fmap . fmap . fmap) snd . postWithdrawalStatus
 
-postWithdrawalCreateTxStatus
-  :: Address
-  -> Maybe (Set Address)
-  -> Maybe (Set TxOutRef)
-  -> PostWithdrawalsRequest
-  -> ClientM (RuntimeStatus, WithdrawTxEnvelope CardanoTx)
-postWithdrawalCreateTxStatus changeAddress otherAddresses collateralUtxos request = do
-  let _ :<|> withdrawalsClient :<|> _ = client
-  let _ :<|> (_ :<|> postWithdrawalCreateTx') :<|> _ = withdrawalsClient
-  response <-
-    postWithdrawalCreateTx'
-      request
-      changeAddress
-      (setToCommaList <$> otherAddresses)
-      (setToCommaList <$> collateralUtxos)
-  status <- extractStatus response
-  pure (status, retractLink $ getResponse response)
-
-postWithdrawalCreateTx
-  :: Address
-  -> Maybe (Set Address)
-  -> Maybe (Set TxOutRef)
-  -> PostWithdrawalsRequest
-  -> ClientM (WithdrawTxEnvelope CardanoTx)
-postWithdrawalCreateTx = (fmap . fmap . fmap . fmap) snd . postWithdrawalCreateTxStatus
-
 getWithdrawalStatus :: TxId -> ClientM (RuntimeStatus, Withdrawal)
 getWithdrawalStatus withdrawalId = do
   let _ :<|> withdrawalsClient :<|> _ = client
@@ -395,7 +335,7 @@ getWithdrawalStatus withdrawalId = do
 getWithdrawal :: TxId -> ClientM Withdrawal
 getWithdrawal = fmap snd . getWithdrawalStatus
 
-putWithdrawalStatus :: TxId -> TextEnvelope -> ClientM RuntimeStatus
+putWithdrawalStatus :: TxId -> TxWitness -> ClientM RuntimeStatus
 putWithdrawalStatus withdrawalId tx = do
   let _ :<|> withdrawalsClient :<|> _ = client
   let _ :<|> _ :<|> contractApi = withdrawalsClient
@@ -403,7 +343,7 @@ putWithdrawalStatus withdrawalId tx = do
   response <- putWithdrawal' tx
   extractStatus response
 
-putWithdrawal :: TxId -> TextEnvelope -> ClientM ()
+putWithdrawal :: TxId -> TxWitness -> ClientM ()
 putWithdrawal = fmap void . putWithdrawalStatus
 
 getPayoutsStatus
@@ -491,11 +431,11 @@ postTransactionStatus
   -> Maybe (Set TxOutRef)
   -> TxOutRef
   -> PostTransactionsRequest
-  -> ClientM (RuntimeStatus, ApplyInputsTxEnvelope CardanoTxBody)
+  -> ClientM (RuntimeStatus, ApplyInputsTxEnvelope)
 postTransactionStatus changeAddress otherAddresses collateralUtxos contractId request = do
   let contractsClient :<|> _ = client
   let _ :<|> _ :<|> contractApi :<|> _ = contractsClient
-  let _ :<|> _ :<|> _ :<|> _ :<|> (postTransaction' :<|> _) :<|> _ = contractApi contractId
+  let _ :<|> _ :<|> _ :<|> _ :<|> postTransaction' :<|> _ = contractApi contractId
   response <-
     postTransaction'
       request
@@ -511,37 +451,9 @@ postTransaction
   -> Maybe (Set TxOutRef)
   -> TxOutRef
   -> PostTransactionsRequest
-  -> ClientM (ApplyInputsTxEnvelope CardanoTxBody)
+  -> ClientM ApplyInputsTxEnvelope
 postTransaction = (fmap . fmap . fmap . fmap . fmap) snd . postTransactionStatus
 
-postTransactionCreateTxStatus
-  :: Address
-  -> Maybe (Set Address)
-  -> Maybe (Set TxOutRef)
-  -> TxOutRef
-  -> PostTransactionsRequest
-  -> ClientM (RuntimeStatus, ApplyInputsTxEnvelope CardanoTx)
-postTransactionCreateTxStatus changeAddress otherAddresses collateralUtxos contractId request = do
-  let (_ :<|> _ :<|> contractApi :<|> _) :<|> _ = client
-  let _ :<|> _ :<|> _ :<|> _ :<|> (_ :<|> postTransactionCreateTx') :<|> _ = contractApi contractId
-  response <-
-    postTransactionCreateTx'
-      request
-      changeAddress
-      (setToCommaList <$> otherAddresses)
-      (setToCommaList <$> collateralUtxos)
-  status <- extractStatus response
-  pure (status, retractLink $ getResponse response)
-
-postTransactionCreateTx
-  :: Address
-  -> Maybe (Set Address)
-  -> Maybe (Set TxOutRef)
-  -> TxOutRef
-  -> PostTransactionsRequest
-  -> ClientM (ApplyInputsTxEnvelope CardanoTx)
-postTransactionCreateTx = (fmap . fmap . fmap . fmap . fmap) snd . postTransactionCreateTxStatus
-
 getTransactionStatus :: TxOutRef -> TxId -> ClientM (RuntimeStatus, Tx)
 getTransactionStatus contractId transactionId = do
   let contractsClient :<|> _ = client
@@ -555,7 +467,7 @@ getTransactionStatus contractId transactionId = do
 getTransaction :: TxOutRef -> TxId -> ClientM Tx
 getTransaction = (fmap . fmap) snd . getTransactionStatus
 
-putTransactionStatus :: TxOutRef -> TxId -> TextEnvelope -> ClientM RuntimeStatus
+putTransactionStatus :: TxOutRef -> TxId -> TxWitness -> ClientM RuntimeStatus
 putTransactionStatus contractId transactionId tx = do
   let contractsClient :<|> _ = client
   let _ :<|> _ :<|> contractApi :<|> _ = contractsClient
@@ -564,7 +476,7 @@ putTransactionStatus contractId transactionId tx = do
   response <- putTransaction' tx
   extractStatus response
 
-putTransaction :: TxOutRef -> TxId -> TextEnvelope -> ClientM ()
+putTransaction :: TxOutRef -> TxId -> TxWitness -> ClientM ()
 putTransaction = (fmap . fmap) void . putTransactionStatus
 
 setToCommaList :: Set a -> CommaList a
diff --git a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
index 41aaaa9d15..612763246d 100644
--- a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
+++ b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
@@ -375,7 +375,7 @@ data ContractState = ContractState
   , state :: Maybe Semantics.State
   , utxo :: Maybe TxOutRef
   , assets :: Assets
-  , txBody :: Maybe TextEnvelope
+  , txBody :: Maybe UnwitnessedTx
   , unclaimedPayouts :: [Payout]
   }
   deriving (Show, Eq, Generic)
@@ -571,7 +571,7 @@ data Tx = Tx
   , consumingTx :: Maybe TxId
   , invalidBefore :: UTCTime
   , invalidHereafter :: UTCTime
-  , txBody :: Maybe TextEnvelope
+  , txBody :: Maybe UnwitnessedTx
   }
   deriving (Show, Eq, Generic)
 
@@ -620,172 +620,105 @@ instance ToJSON BlockHeader
 instance FromJSON BlockHeader
 instance ToSchema BlockHeader
 
-data CardanoTx
-data CardanoTxBody
-
-data WithdrawTxEnvelope tx = WithdrawTxEnvelope
+data WithdrawTxEnvelope = WithdrawTxEnvelope
   { withdrawalId :: TxId
-  , txEnvelope :: TextEnvelope
+  , tx :: UnwitnessedTx
   }
-  deriving (Show, Eq, Ord, Generic)
-
-instance ToJSON (WithdrawTxEnvelope CardanoTx) where
-  toJSON WithdrawTxEnvelope{..} =
-    object
-      [ ("withdrawalId", toJSON withdrawalId)
-      , ("tx", toJSON txEnvelope)
-      ]
-instance ToJSON (WithdrawTxEnvelope CardanoTxBody) where
-  toJSON WithdrawTxEnvelope{..} =
-    object
-      [ ("withdrawalId", toJSON withdrawalId)
-      , ("txBody", toJSON txEnvelope)
-      ]
-
-instance FromJSON (WithdrawTxEnvelope CardanoTx) where
-  parseJSON = withObject "WithdrawTxEnvelope" \obj ->
-    WithdrawTxEnvelope
-      <$> obj .: "withdrawalId"
-      <*> obj .: "tx"
-
-instance FromJSON (WithdrawTxEnvelope CardanoTxBody) where
-  parseJSON = withObject "WithdrawTxEnvelope" \obj ->
-    WithdrawTxEnvelope
-      <$> obj .: "withdrawalId"
-      <*> obj .: "txBody"
-
-instance ToSchema (WithdrawTxEnvelope CardanoTx) where
-  declareNamedSchema _ = do
-    withdrawalIdSchema <- declareSchemaRef (Proxy :: Proxy TxId)
-    txEnvelopeSchema <- declareSchemaRef (Proxy :: Proxy TextEnvelope)
-    return $
-      NamedSchema (Just "WithdrawTxEnvelope") $
-        mempty
-          & type_ ?~ OpenApiObject
-          & OpenApi.description ?~ "The \"type\" property of \"tx\" must be \"Tx BabbageEra\" or \"Tx ConwayEra\""
-          & properties
-            .~ [ ("withdrawalId", withdrawalIdSchema)
-               , ("tx", txEnvelopeSchema)
-               ]
-          & required .~ ["withdrawalId", "tx"]
-
-instance ToSchema (WithdrawTxEnvelope CardanoTxBody) where
-  declareNamedSchema _ = do
-    withdrawalIdSchema <- declareSchemaRef (Proxy :: Proxy TxId)
-    txEnvelopeSchema <- declareSchemaRef (Proxy :: Proxy TextEnvelope)
-    return $
-      NamedSchema (Just "WithdrawTxBodyEnvelope") $
-        mempty
-          & type_ ?~ OpenApiObject
-          & OpenApi.description ?~ "The \"type\" property of \"txBody\" must be \"TxBody BabbageEra\" or \"TxBody ConwayEra\""
-          & properties
-            .~ [ ("withdrawalId", withdrawalIdSchema)
-               , ("txBody", txEnvelopeSchema)
-               ]
-          & required .~ ["withdrawalId", "txBody"]
+  deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON, ToSchema)
 
-data CreateTxEnvelope tx = CreateTxEnvelope
+data CreateTxEnvelope = CreateTxEnvelope
   { contractId :: TxOutRef
-  , txEnvelope :: TextEnvelope
+  , tx :: UnwitnessedTx
   , safetyErrors :: [SafetyError]
   }
-  deriving (Show, Eq, Generic)
+  deriving (Show, Eq, Generic, ToJSON, FromJSON, ToSchema)
 
-instance ToJSON (CreateTxEnvelope CardanoTx) where
-  toJSON CreateTxEnvelope{..} =
-    object
-      [ ("contractId", toJSON contractId)
-      , ("tx", toJSON txEnvelope)
-      , ("safetyErrors", toJSON safetyErrors)
-      ]
-instance ToJSON (CreateTxEnvelope CardanoTxBody) where
-  toJSON CreateTxEnvelope{..} =
+data ApplyInputsTxEnvelope = ApplyInputsTxEnvelope
+  { contractId :: TxOutRef
+  , transactionId :: TxId
+  , tx :: UnwitnessedTx
+  }
+  deriving (Show, Eq, Ord, Generic, ToJSON, FromJSON, ToSchema)
+
+data UnwitnessedTx = UnwitnessedTx
+  { utType :: Text
+  , utDescription :: Text
+  , utCborHex :: Base16
+  }
+  deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON UnwitnessedTx where
+  toJSON UnwitnessedTx{..} =
     object
-      [ ("contractId", toJSON contractId)
-      , ("txBody", toJSON txEnvelope)
-      , ("safetyErrors", toJSON safetyErrors)
+      [ ("type", toJSON utType)
+      , ("description", toJSON utDescription)
+      , ("cborHex", toJSON utCborHex)
       ]
 
-instance FromJSON (CreateTxEnvelope CardanoTx) where
-  parseJSON = withObject "CreateTxEnvelope" \obj ->
-    CreateTxEnvelope
-      <$> obj .: "contractId"
-      <*> obj .: "tx"
-      <*> obj .: "safetyErrors"
-
-instance FromJSON (CreateTxEnvelope CardanoTxBody) where
-  parseJSON = withObject "CreateTxEnvelope" \obj ->
-    CreateTxEnvelope
-      <$> obj .: "contractId"
-      <*> obj .: "txBody"
-      <*> obj .: "safetyErrors"
-
-instance ToSchema (CreateTxEnvelope CardanoTx) where
-  declareNamedSchema _ = do
-    contractIdSchema <- declareSchemaRef (Proxy :: Proxy TxOutRef)
-    txEnvelopeSchema <- declareSchemaRef (Proxy :: Proxy TextEnvelope)
-    safetyErrorsSchema <- declareSchemaRef (Proxy :: Proxy [SafetyError])
-    return $
-      NamedSchema (Just "CreateTxEnvelope") $
-        mempty
-          & type_ ?~ OpenApiObject
-          & OpenApi.description ?~ "The \"type\" property of \"tx\" must be \"Tx BabbageEra\" or \"Tx ConwayEra\""
-          & properties
-            .~ [ ("contractId", contractIdSchema)
-               , ("tx", txEnvelopeSchema)
-               , ("safetyErrors", safetyErrorsSchema)
-               ]
-          & required .~ ["contractId", "tx"]
+instance FromJSON UnwitnessedTx where
+  parseJSON = withObject "UnwitnessedTx" \obj ->
+    UnwitnessedTx
+      <$> obj .: "type"
+      <*> obj .: "description"
+      <*> obj .: "cborHex"
 
-instance ToSchema (CreateTxEnvelope CardanoTxBody) where
+instance ToSchema UnwitnessedTx where
   declareNamedSchema _ = do
-    contractIdSchema <- declareSchemaRef (Proxy :: Proxy TxOutRef)
-    txEnvelopeSchema <- declareSchemaRef (Proxy :: Proxy TextEnvelope)
-    safetyErrorsSchema <- declareSchemaRef (Proxy :: Proxy [SafetyError])
-    return $
-      NamedSchema (Just "CreateTxBodyEnvelope") $
+    textSchema <- declareSchemaRef (Proxy @Text)
+    let typeSchema =
+          mempty
+            & type_ ?~ OpenApiString
+            & OpenApi.description ?~ "What type of data is encoded in the CBOR Hex."
+            & enum_
+              ?~ [ "Unwitnessed Tx BabbageEra"
+                 , "Unwitnessed Tx ConwayEra"
+                 ]
+    pure $
+      NamedSchema (Just "UnwitnessedTx") $
         mempty
           & type_ ?~ OpenApiObject
-          & OpenApi.description ?~ "The \"type\" property of \"txBody\" must be \"TxBody BabbageEra\" or \"TxBody ConwayEra\""
+          & required .~ ["type", "description", "cborHex"]
           & properties
-            .~ [ ("contractId", contractIdSchema)
-               , ("txBody", txEnvelopeSchema)
-               , ("safetyErrors", safetyErrorsSchema)
+            .~ [ ("type", Inline typeSchema)
+               , ("description", textSchema)
+               , ("cborHex", textSchema)
                ]
-          & required .~ ["contractId", "txBody"]
 
-data TextEnvelope = TextEnvelope
-  { teType :: Text
-  , teDescription :: Text
-  , teCborHex :: Base16
+data TxWitness = TxWitness
+  { twType :: Text
+  , twDescription :: Text
+  , twCborHex :: Base16
   }
   deriving (Show, Eq, Ord, Generic)
 
-instance ToJSON TextEnvelope where
-  toJSON TextEnvelope{..} =
+instance ToJSON TxWitness where
+  toJSON TxWitness{..} =
     object
-      [ ("type", toJSON teType)
-      , ("description", toJSON teDescription)
-      , ("cborHex", toJSON teCborHex)
+      [ ("type", toJSON twType)
+      , ("description", toJSON twDescription)
+      , ("cborHex", toJSON twCborHex)
       ]
 
-instance FromJSON TextEnvelope where
-  parseJSON = withObject "TextEnvelope" \obj ->
-    TextEnvelope
+instance FromJSON TxWitness where
+  parseJSON = withObject "TxWitness" \obj ->
+    TxWitness
       <$> obj .: "type"
       <*> obj .: "description"
       <*> obj .: "cborHex"
 
-instance ToSchema TextEnvelope where
+instance ToSchema TxWitness where
   declareNamedSchema _ = do
     textSchema <- declareSchemaRef (Proxy @Text)
     let typeSchema =
           mempty
             & type_ ?~ OpenApiString
-            & OpenApi.description
-              ?~ "What type of data is encoded in the CBOR Hex. Valid values include \"Tx <era>\", \"TxBody <era>\", and \"ShelleyTxWitness <era>\" where <era> is one of \"BabbageEra\", \"ConwayEra\"."
+            & OpenApi.description ?~ "What type of data is encoded in the CBOR Hex."
+            & enum_
+              ?~ [ "TxWitness BabbageEra"
+                 , "TxWitness ConwayEra"
+                 ]
     pure $
-      NamedSchema (Just "TextEnvelope") $
+      NamedSchema (Just "TxWitness") $
         mempty
           & type_ ?~ OpenApiObject
           & required .~ ["type", "description", "cborHex"]
@@ -1139,76 +1072,6 @@ instance FromJSON PostTransactionsRequest
 instance ToJSON PostTransactionsRequest
 instance ToSchema PostTransactionsRequest
 
-data ApplyInputsTxEnvelope tx = ApplyInputsTxEnvelope
-  { contractId :: TxOutRef
-  , transactionId :: TxId
-  , txEnvelope :: TextEnvelope
-  }
-  deriving (Show, Eq, Ord, Generic)
-
-instance ToJSON (ApplyInputsTxEnvelope CardanoTx) where
-  toJSON ApplyInputsTxEnvelope{..} =
-    object
-      [ ("contractId", toJSON contractId)
-      , ("transactionId", toJSON transactionId)
-      , ("tx", toJSON txEnvelope)
-      ]
-instance ToJSON (ApplyInputsTxEnvelope CardanoTxBody) where
-  toJSON ApplyInputsTxEnvelope{..} =
-    object
-      [ ("contractId", toJSON contractId)
-      , ("transactionId", toJSON transactionId)
-      , ("txBody", toJSON txEnvelope)
-      ]
-
-instance FromJSON (ApplyInputsTxEnvelope CardanoTx) where
-  parseJSON = withObject "ApplyInputsTxEnvelope" \obj -> do
-    contractId <- obj .: "contractId"
-    transactionId <- obj .: "transactionId"
-    txEnvelope <- obj .: "tx"
-    pure ApplyInputsTxEnvelope{..}
-
-instance FromJSON (ApplyInputsTxEnvelope CardanoTxBody) where
-  parseJSON = withObject "ApplyInputsTxEnvelope" \obj -> do
-    contractId <- obj .: "contractId"
-    transactionId <- obj .: "transactionId"
-    txEnvelope <- obj .: "txBody"
-    pure ApplyInputsTxEnvelope{..}
-
-instance ToSchema (ApplyInputsTxEnvelope CardanoTx) where
-  declareNamedSchema _ = do
-    contractIdSchema <- declareSchemaRef (Proxy :: Proxy TxOutRef)
-    transactionIdSchema <- declareSchemaRef (Proxy :: Proxy TxId)
-    txEnvelopeSchema <- declareSchemaRef (Proxy :: Proxy TextEnvelope)
-    return $
-      NamedSchema (Just "ApplyInputsTxEnvelope") $
-        mempty
-          & type_ ?~ OpenApiObject
-          & OpenApi.description ?~ "The \"type\" property of \"tx\" must be \"Tx BabbageEra\" or \"Tx ConwayEra\""
-          & properties
-            .~ [ ("contractId", contractIdSchema)
-               , ("transactionId", transactionIdSchema)
-               , ("tx", txEnvelopeSchema)
-               ]
-          & required .~ ["contractId", "transactionId", "tx"]
-
-instance ToSchema (ApplyInputsTxEnvelope CardanoTxBody) where
-  declareNamedSchema _ = do
-    contractIdSchema <- declareSchemaRef (Proxy :: Proxy TxOutRef)
-    transactionIdSchema <- declareSchemaRef (Proxy :: Proxy TxId)
-    txEnvelopeSchema <- declareSchemaRef (Proxy :: Proxy TextEnvelope)
-    return $
-      NamedSchema (Just "ApplyInputsTxEnvelope") $
-        mempty
-          & type_ ?~ OpenApiObject
-          & OpenApi.description ?~ "The \"type\" property of \"txBody\" must be \"TxBody BabbageEra\" or \"TxBody ConwayEra\""
-          & properties
-            .~ [ ("contractId", contractIdSchema)
-               , ("transactionId", transactionIdSchema)
-               , ("txBody", txEnvelopeSchema)
-               ]
-          & required .~ ["contractId", "transactionId", "txBody"]
-
 data NetworkId
   = Mainnet
   | Testnet Word32
diff --git a/marlowe-runtime-web/test/Spec.hs b/marlowe-runtime-web/test/Spec.hs
index 6f495d59d9..9c6ae53cff 100644
--- a/marlowe-runtime-web/test/Spec.hs
+++ b/marlowe-runtime-web/test/Spec.hs
@@ -536,15 +536,15 @@ instance Arbitrary Web.PostTransactionsRequest where
       <*> arbitraryNormal -- FIXME: This should handle merkleized input, too.
   shrink = genericShrink
 
-instance Arbitrary (Web.CreateTxEnvelope tx) where
+instance Arbitrary Web.CreateTxEnvelope where
   arbitrary = Web.CreateTxEnvelope <$> arbitrary <*> arbitrary <*> resize 5 arbitrary
   shrink = genericShrink
 
-instance Arbitrary (Web.WithdrawTxEnvelope tx) where
+instance Arbitrary Web.WithdrawTxEnvelope where
   arbitrary = Web.WithdrawTxEnvelope <$> arbitrary <*> arbitrary
   shrink = genericShrink
 
-instance Arbitrary (Web.ApplyInputsTxEnvelope tx) where
+instance Arbitrary Web.ApplyInputsTxEnvelope where
   arbitrary = Web.ApplyInputsTxEnvelope <$> arbitrary <*> arbitrary <*> arbitrary
   shrink = genericShrink
 
@@ -612,8 +612,12 @@ instance (Arbitrary a) => Arbitrary (Web.ListObject a) where
   arbitrary = Web.ListObject <$> arbitrary
   shrink = genericShrink
 
-instance Arbitrary Web.TextEnvelope where
-  arbitrary = Web.TextEnvelope <$> arbitrary <*> arbitrary <*> arbitrary
+instance Arbitrary Web.TxWitness where
+  arbitrary = Web.TxWitness "TxWitness BabbageEra" <$> arbitrary <*> arbitrary
+  shrink = genericShrink
+
+instance Arbitrary Web.UnwitnessedTx where
+  arbitrary = Web.UnwitnessedTx "Unwitnessed Tx BabbageEra" <$> arbitrary <*> arbitrary
   shrink = genericShrink
 
 instance Arbitrary Web.TxOutRef where

From 6ab39eee503efdeda3793d78f14687a812ca107e Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Fri, 5 Jan 2024 11:15:42 -0500
Subject: [PATCH 3/8] Fix roundtrip encoding for integration tests

---
 .../Language/Marlowe/Runtime/Web/Common.hs    | 29 ++++---------------
 1 file changed, 6 insertions(+), 23 deletions(-)

diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
index d9a5f08fa7..6f37b9926e 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
@@ -14,14 +14,11 @@ module Language.Marlowe.Runtime.Web.Common (
 ) where
 
 import Cardano.Api (
-  CardanoEra (..),
-  ShelleyBasedEra (ShelleyBasedEraBabbage),
+  BabbageEra,
   ShelleyWitnessSigningKey (..),
-  TextEnvelopeCddl (..),
-  deserialiseTxLedgerCddl,
+  Tx,
   getTxBody,
   getTxWitnesses,
-  serialiseWitnessLedgerCddl,
   signShelleyTransaction,
  )
 import Control.Concurrent (threadDelay)
@@ -49,7 +46,7 @@ import Language.Marlowe.Runtime.Web.Client (
   putTransaction,
   putWithdrawal,
  )
-import Language.Marlowe.Runtime.Web.Server.DTO (ToDTO (toDTO))
+import Language.Marlowe.Runtime.Web.Server.DTO (FromDTO (..), ToDTO (toDTO))
 import qualified PlutusLedgerApi.V2 as PV2
 import Servant.Client.Streaming (ClientM)
 
@@ -209,23 +206,9 @@ applyInputs Wallet{..} contractId inputs = do
       }
 
 signShelleyTransaction' :: Web.UnwitnessedTx -> [ShelleyWitnessSigningKey] -> IO Web.TxWitness
-signShelleyTransaction' Web.UnwitnessedTx{..} wits = do
-  let te =
-        TextEnvelopeCddl
-          { teCddlType = utType
-          , teCddlDescription = utDescription
-          , teCddlRawCBOR = Web.unBase16 utCborHex
-          }
-  txBody <- case deserialiseTxLedgerCddl BabbageEra te of
-    Left err -> fail $ show err
-    Right a -> pure a
-  let witnessCddl =
-        serialiseWitnessLedgerCddl ShelleyBasedEraBabbage $
-          head $
-            getTxWitnesses $
-              signShelleyTransaction (getTxBody txBody) wits
-  pure case witnessCddl of
-    TextEnvelopeCddl ty _ bytes -> Web.TxWitness ty "" $ Web.Base16 bytes
+signShelleyTransaction' txEnvelope wits = do
+  tx :: Tx BabbageEra <- expectJust "Failed to deserialise tx" $ fromDTO txEnvelope
+  pure $ toDTO $ head $ getTxWitnesses $ signShelleyTransaction (getTxBody tx) wits
 
 waitUntilConfirmed :: (MonadIO m) => (a -> Web.TxStatus) -> m a -> m a
 waitUntilConfirmed getStatus getResource = do

From d326622afd6db5f324c3fea14a917797682a8287 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Fri, 5 Jan 2024 13:57:27 -0500
Subject: [PATCH 4/8] Update changelog

---
 ...57_jhbertra_plt_9086_wallet_compatible_cbor.md | 15 +++++++++++++++
 1 file changed, 15 insertions(+)
 create mode 100644 marlowe-runtime-web/changelog.d/20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md

diff --git a/marlowe-runtime-web/changelog.d/20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md b/marlowe-runtime-web/changelog.d/20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md
new file mode 100644
index 0000000000..bdf6bebf92
--- /dev/null
+++ b/marlowe-runtime-web/changelog.d/20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md
@@ -0,0 +1,15 @@
+### Removed
+
+- `TxBody` format in `POST` responses (only `Unwitnessed Tx` responses supported).
+- Full `Tx` format in `PUT` requests (only `TxWitness` responses supported).
+
+### Changed
+
+- `Tx <era>` format in `POST` responses changed to `Unwitnessed Tx <era>`
+- Transactions in `POST` responses are CDDL compliant.
+- `ShelleyTxWitness <era>` format in `PUT` requests changed to `TxWitness <era>`
+- TxWitnesses in `PUT` requests must be CDDL compliant.
+
+### Fixed
+
+- Runtime REST API does not return CDDL-compatible transaction CBOR.

From 2c05f23343408559f9ec52546aa8b1ba6754ed61 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Mon, 8 Jan 2024 09:46:40 -0500
Subject: [PATCH 5/8] Deserialise witness from text envelope instead of ledger
 cddl

---
 .../Marlowe/Runtime/Web/Server/DTO.hs         | 39 ++++++++++---------
 1 file changed, 21 insertions(+), 18 deletions(-)

diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
index a3747e42ed..6c1ce1f825 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
@@ -19,16 +19,18 @@ import Cardano.Api (
   KeyWitness,
   NetworkId (..),
   NetworkMagic (..),
+  TextEnvelope (..),
   TextEnvelopeCddl (..),
+  TextEnvelopeType (TextEnvelopeType),
   Tx,
   deserialiseAddress,
+  deserialiseFromTextEnvelope,
   deserialiseTxLedgerCddl,
-  deserialiseWitnessLedgerCddl,
   getTxId,
   makeSignedTransaction,
   metadataValueToJsonNoSchema,
+  serialiseToTextEnvelope,
   serialiseTxLedgerCddl,
-  serialiseWitnessLedgerCddl,
  )
 import Cardano.Api.Shelley (
   ReferenceTxInsScriptsInlineDatumsSupportedInEra (..),
@@ -81,7 +83,7 @@ import Data.List (groupBy)
 import qualified Data.Map.NonEmpty as NEMap
 import Data.Set (Set)
 import qualified Language.Marlowe.Protocol.Query.Types as Query
-import Language.Marlowe.Runtime.Cardano.Api (fromCardanoTxId)
+import Language.Marlowe.Runtime.Cardano.Api (cardanoEraToAsType, fromCardanoTxId)
 import Language.Marlowe.Runtime.ChainSync.Api (AssetId (..))
 import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain
 import Language.Marlowe.Runtime.Core.Api (
@@ -106,6 +108,7 @@ import Language.Marlowe.Runtime.Web.Server.TxClient (TempTx (..), TempTxStatus (
 import Network.HTTP.Media (MediaType, parseAccept)
 import Servant.Pagination (IsRangeType)
 import qualified Servant.Pagination as Pagination
+import Unsafe.Coerce (unsafeCoerce)
 
 -- | A class that states a type has a DTO representation.
 class HasDTO a where
@@ -681,10 +684,10 @@ instance HasDTO (KeyWitness era) where
   type DTO (KeyWitness era) = Web.TxWitness
 
 instance (IsShelleyBasedEra era) => ToDTO (KeyWitness era) where
-  toDTO = textEnvelopeToTxWitness . serialiseWitnessLedgerCddl (shelleyBasedEra @era)
+  toDTO = textEnvelopeToTxWitness . serialiseToTextEnvelope Nothing
 
 instance (IsShelleyBasedEra era) => FromDTO (KeyWitness era) where
-  fromDTO = hush . deserialiseWitnessLedgerCddl (shelleyBasedEra @era) . textEnvelopeFromTxWitness
+  fromDTO = hush . deserialiseFromTextEnvelope (AsKeyWitness $ cardanoEraToAsType $ cardanoEra @era) . textEnvelopeFromTxWitness
 
 textEnvelopeToUnwitnessedTx :: TextEnvelopeCddl -> Web.UnwitnessedTx
 textEnvelopeToUnwitnessedTx
@@ -712,30 +715,30 @@ textEnvelopeFromUnwitnessedTx
       , teCddlRawCBOR = Web.unBase16 utCborHex
       }
 
-textEnvelopeToTxWitness :: TextEnvelopeCddl -> Web.TxWitness
+textEnvelopeToTxWitness :: TextEnvelope -> Web.TxWitness
 textEnvelopeToTxWitness
-  TextEnvelopeCddl
-    { teCddlType
-    , teCddlDescription
-    , teCddlRawCBOR
+  TextEnvelope
+    { teType = TextEnvelopeType teType
+    , teDescription
+    , teRawCBOR
     } =
     Web.TxWitness
-      { twType = teCddlType
-      , twDescription = teCddlDescription
-      , twCborHex = Web.Base16 teCddlRawCBOR
+      { twType = T.pack teType
+      , twDescription = T.pack $ unsafeCoerce teDescription
+      , twCborHex = Web.Base16 teRawCBOR
       }
 
-textEnvelopeFromTxWitness :: Web.TxWitness -> TextEnvelopeCddl
+textEnvelopeFromTxWitness :: Web.TxWitness -> TextEnvelope
 textEnvelopeFromTxWitness
   Web.TxWitness
     { twType
     , twDescription
     , twCborHex
     } =
-    TextEnvelopeCddl
-      { teCddlType = twType
-      , teCddlDescription = twDescription
-      , teCddlRawCBOR = Web.unBase16 twCborHex
+    TextEnvelope
+      { teType = TextEnvelopeType $ T.unpack twType
+      , teDescription = fromString $ T.unpack twDescription
+      , teRawCBOR = Web.unBase16 twCborHex
       }
 
 instance HasDTO Tx.RoleTokensConfig where

From 0d6e72ea80870e33617e7540625ea244dc779e43 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Tue, 9 Jan 2024 11:53:55 -0500
Subject: [PATCH 6/8] Expect partial witness set instead of just vkey witnesses
 in CBOR

---
 .../marlowe-integration-tests.cabal           |  1 +
 .../Language/Marlowe/Runtime/Web/Common.hs    | 17 +++-
 marlowe-runtime-web/marlowe-runtime-web.cabal |  2 +
 .../Marlowe/Runtime/Web/Server/DTO.hs         | 30 +++++--
 .../Runtime/Web/Server/REST/Contracts.hs      | 10 ++-
 .../Runtime/Web/Server/REST/Transactions.hs   | 10 ++-
 .../Runtime/Web/Server/REST/Withdrawals.hs    | 10 ++-
 .../Marlowe/Runtime/Web/Server/Util.hs        | 87 +++++++++++++++----
 .../src/Language/Marlowe/Runtime/Web/Types.hs |  4 +-
 9 files changed, 139 insertions(+), 32 deletions(-)

diff --git a/marlowe-integration-tests/marlowe-integration-tests.cabal b/marlowe-integration-tests/marlowe-integration-tests.cabal
index 3fccc9b01a..9bc20e114a 100644
--- a/marlowe-integration-tests/marlowe-integration-tests.cabal
+++ b/marlowe-integration-tests/marlowe-integration-tests.cabal
@@ -95,6 +95,7 @@ executable marlowe-integration-tests
     , base16
     , bytestring
     , cardano-api ^>=8.2
+    , cardano-ledger-alonzo
     , cardano-ledger-babbage
     , co-log >=0.5.0.0 && <0.6.0.0
     , containers
diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
index 6f37b9926e..6fbd069991 100644
--- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
+++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs
@@ -21,10 +21,15 @@ import Cardano.Api (
   getTxWitnesses,
   signShelleyTransaction,
  )
+import Cardano.Api.Shelley (KeyWitness (..))
+import Cardano.Ledger.Alonzo.TxWits (Redeemers (..))
+import Cardano.Ledger.Babbage.TxWits (AlonzoTxWits (AlonzoTxWits))
 import Control.Concurrent (threadDelay)
 import Control.Monad.IO.Class (MonadIO (liftIO))
+import Data.Aeson.Text (encodeToLazyText)
 import Data.Set (Set)
 import qualified Data.Set as Set
+import qualified Data.Text.Lazy as TL
 import qualified Language.Marlowe as V1
 import Language.Marlowe.Core.V1.Semantics.Types (
   ChoiceId (ChoiceId),
@@ -47,6 +52,7 @@ import Language.Marlowe.Runtime.Web.Client (
   putWithdrawal,
  )
 import Language.Marlowe.Runtime.Web.Server.DTO (FromDTO (..), ToDTO (toDTO))
+import Language.Marlowe.Runtime.Web.Server.Util (TxWitnessSet (TxWitnessSet))
 import qualified PlutusLedgerApi.V2 as PV2
 import Servant.Client.Streaming (ClientM)
 
@@ -112,6 +118,7 @@ submitContract
   -> ClientM Web.BlockHeader
 submitContract Wallet{..} Web.CreateTxEnvelope{contractId, tx} = do
   signedCreateTx <- liftIO $ signShelleyTransaction' tx signingKeys
+  liftIO $ putStrLn $ TL.unpack $ encodeToLazyText signedCreateTx
   putContract contractId signedCreateTx
   Web.ContractState{block} <- waitUntilConfirmed (\Web.ContractState{status} -> status) $ getContract contractId
   liftIO $ expectJust "Expected block header" block
@@ -208,7 +215,15 @@ applyInputs Wallet{..} contractId inputs = do
 signShelleyTransaction' :: Web.UnwitnessedTx -> [ShelleyWitnessSigningKey] -> IO Web.TxWitness
 signShelleyTransaction' txEnvelope wits = do
   tx :: Tx BabbageEra <- expectJust "Failed to deserialise tx" $ fromDTO txEnvelope
-  pure $ toDTO $ head $ getTxWitnesses $ signShelleyTransaction (getTxBody tx) wits
+  let keyWitness = head $ getTxWitnesses $ signShelleyTransaction (getTxBody tx) wits
+  let vKeys = case keyWitness of
+        ShelleyBootstrapWitness{} -> mempty
+        ShelleyKeyWitness _ key -> Set.singleton key
+  pure
+    . toDTO
+    . TxWitnessSet @BabbageEra
+    $ AlonzoTxWits vKeys mempty mempty mempty
+    $ Redeemers mempty
 
 waitUntilConfirmed :: (MonadIO m) => (a -> Web.TxStatus) -> m a -> m a
 waitUntilConfirmed getStatus getResource = do
diff --git a/marlowe-runtime-web/marlowe-runtime-web.cabal b/marlowe-runtime-web/marlowe-runtime-web.cabal
index 8a971eea9e..b26b63b715 100644
--- a/marlowe-runtime-web/marlowe-runtime-web.cabal
+++ b/marlowe-runtime-web/marlowe-runtime-web.cabal
@@ -119,8 +119,10 @@ library server
     , async >=2.2 && <3
     , async-components ==0.1.1.0
     , base >=4.9 && <5
+    , bytestring >=0.10.12 && <0.12
     , cardano-api ^>=8.2
     , cardano-ledger-alonzo ^>=1.2
+    , cardano-ledger-binary ^>=1.1
     , cardano-ledger-core ^>=1.2
     , cardano-ledger-shelley ^>=1.2
     , co-log >=0.5.0.0 && <0.6.0.0
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
index 6c1ce1f825..5981c2b524 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/DTO.hs
@@ -15,8 +15,7 @@ module Language.Marlowe.Runtime.Web.Server.DTO where
 import Cardano.Api (
   AsType (..),
   IsCardanoEra (..),
-  IsShelleyBasedEra (..),
-  KeyWitness,
+  IsShelleyBasedEra,
   NetworkId (..),
   NetworkMagic (..),
   TextEnvelope (..),
@@ -34,6 +33,7 @@ import Cardano.Api (
  )
 import Cardano.Api.Shelley (
   ReferenceTxInsScriptsInlineDatumsSupportedInEra (..),
+  ShelleyLedgerEra,
   StakeAddress (..),
   fromShelleyStakeCredential,
  )
@@ -74,6 +74,8 @@ import Language.Marlowe.Protocol.Query.Types (
   Withdrawal (..),
  )
 
+import Cardano.Ledger.Alonzo (AlonzoScript)
+import Cardano.Ledger.Alonzo.Core (EraTxWits, Script)
 import qualified Data.Aeson.Key as Key
 import qualified Data.Aeson.KeyMap as KeyMap
 import Data.Bitraversable (Bitraversable (..))
@@ -105,6 +107,7 @@ import qualified Language.Marlowe.Runtime.Discovery.Api as Discovery
 import qualified Language.Marlowe.Runtime.Transaction.Api as Tx
 import qualified Language.Marlowe.Runtime.Web as Web
 import Language.Marlowe.Runtime.Web.Server.TxClient (TempTx (..), TempTxStatus (..))
+import Language.Marlowe.Runtime.Web.Server.Util (AsType (..), TxWitnessSet)
 import Network.HTTP.Media (MediaType, parseAccept)
 import Servant.Pagination (IsRangeType)
 import qualified Servant.Pagination as Pagination
@@ -680,14 +683,27 @@ instance (IsCardanoEra era) => ToDTO (Tx era) where
 instance (IsCardanoEra era) => FromDTO (Tx era) where
   fromDTO = hush . deserialiseTxLedgerCddl (cardanoEra @era) . textEnvelopeFromUnwitnessedTx
 
-instance HasDTO (KeyWitness era) where
-  type DTO (KeyWitness era) = Web.TxWitness
+instance HasDTO (TxWitnessSet era) where
+  type DTO (TxWitnessSet era) = Web.TxWitness
 
-instance (IsShelleyBasedEra era) => ToDTO (KeyWitness era) where
+instance
+  ( IsShelleyBasedEra era
+  , EraTxWits (ShelleyLedgerEra era)
+  , Script (ShelleyLedgerEra era) ~ AlonzoScript (ShelleyLedgerEra era)
+  )
+  => ToDTO (TxWitnessSet era)
+  where
   toDTO = textEnvelopeToTxWitness . serialiseToTextEnvelope Nothing
 
-instance (IsShelleyBasedEra era) => FromDTO (KeyWitness era) where
-  fromDTO = hush . deserialiseFromTextEnvelope (AsKeyWitness $ cardanoEraToAsType $ cardanoEra @era) . textEnvelopeFromTxWitness
+instance
+  ( IsShelleyBasedEra era
+  , EraTxWits (ShelleyLedgerEra era)
+  , Script (ShelleyLedgerEra era) ~ AlonzoScript (ShelleyLedgerEra era)
+  )
+  => FromDTO (TxWitnessSet era)
+  where
+  fromDTO =
+    hush . deserialiseFromTextEnvelope (AsTxWitnessSet $ cardanoEraToAsType $ cardanoEra @era) . textEnvelopeFromTxWitness
 
 textEnvelopeToUnwitnessedTx :: TextEnvelopeCddl -> Web.UnwitnessedTx
 textEnvelopeToUnwitnessedTx
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Contracts.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Contracts.hs
index d1552e0d63..5990c3e63d 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Contracts.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Contracts.hs
@@ -46,6 +46,7 @@ import qualified Language.Marlowe.Runtime.Web.Server.REST.Contracts.Next as Next
 import qualified Language.Marlowe.Runtime.Web.Server.REST.Transactions as Transactions
 import Language.Marlowe.Runtime.Web.Server.REST.Withdrawals (TxBodyInAnyEra (..))
 import Language.Marlowe.Runtime.Web.Server.TxClient (TempTx (TempTx), TempTxStatus (Unsigned))
+import Language.Marlowe.Runtime.Web.Server.Util (makeSignedTxWithWitnessKeys)
 import Servant
 import Servant.Pagination
 
@@ -167,8 +168,13 @@ put contractId txWitness = do
     handleLoaded
       :: Core.ContractId -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> TxBody era -> ServerM NoContent
     handleLoaded contractId' era txBody = withShelleyBasedEra (shelleyBasedEraOfFeature era) do
-      txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
-      let tx = makeSignedTransaction [txWitness'] txBody
+      tx <- case era of
+        ReferenceTxInsScriptsInlineDatumsInBabbageEra -> do
+          txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
+          pure $ makeSignedTxWithWitnessKeys txBody txWitness'
+        ReferenceTxInsScriptsInlineDatumsInConwayEra -> do
+          txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
+          pure $ makeSignedTxWithWitnessKeys txBody txWitness'
       submitContract contractId' era tx >>= \case
         Nothing -> pure NoContent
         Just err -> throwError $ ApiError.toServerError $ ApiError (show err) "SubmissionError" Null 403
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Transactions.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Transactions.hs
index 6a54bb3cbe..b9f2a505bc 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Transactions.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Transactions.hs
@@ -41,6 +41,7 @@ import qualified Language.Marlowe.Runtime.Web.Server.REST.ApiError as ApiError
 import Language.Marlowe.Runtime.Web.Server.REST.Withdrawals (TxBodyInAnyEra (..))
 import Language.Marlowe.Runtime.Web.Server.SyncClient (LoadTxError (..))
 import Language.Marlowe.Runtime.Web.Server.TxClient (TempTx (TempTx), TempTxStatus (..))
+import Language.Marlowe.Runtime.Web.Server.Util (makeSignedTxWithWitnessKeys)
 import Servant
 import Servant.Pagination
 
@@ -139,8 +140,13 @@ put contractId txId txWitness = do
     handleLoaded
       :: Core.ContractId -> Chain.TxId -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> TxBody era -> ServerM NoContent
     handleLoaded contractId' txId' era txBody = withShelleyBasedEra (shelleyBasedEraOfFeature era) do
-      txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
-      let tx = makeSignedTransaction [txWitness'] txBody
+      tx <- case era of
+        ReferenceTxInsScriptsInlineDatumsInBabbageEra -> do
+          txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
+          pure $ makeSignedTxWithWitnessKeys txBody txWitness'
+        ReferenceTxInsScriptsInlineDatumsInConwayEra -> do
+          txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
+          pure $ makeSignedTxWithWitnessKeys txBody txWitness'
       submitTransaction contractId' txId' era tx >>= \case
         Nothing -> pure NoContent
         Just err -> throwError $ ApiError.toServerError $ ApiError (show err) "SubmissionError" Null 403
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs
index 4f780817cb..f25ba61248 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/REST/Withdrawals.hs
@@ -29,6 +29,7 @@ import Language.Marlowe.Runtime.Web.Server.REST.ApiError (
  )
 import qualified Language.Marlowe.Runtime.Web.Server.REST.ApiError as ApiError
 import Language.Marlowe.Runtime.Web.Server.TxClient (TempTx (..), TempTxStatus (..))
+import Language.Marlowe.Runtime.Web.Server.Util (makeSignedTxWithWitnessKeys)
 import Servant
 import Servant.Pagination
 
@@ -111,8 +112,13 @@ put withdrawalId txWitness = do
   where
     handleLoaded :: Chain.TxId -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> TxBody era -> ServerM NoContent
     handleLoaded withdrawalId' era txBody = withShelleyBasedEra (shelleyBasedEraOfFeature era) do
-      txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
-      let tx = makeSignedTransaction [txWitness'] txBody
+      tx <- case era of
+        ReferenceTxInsScriptsInlineDatumsInBabbageEra -> do
+          txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
+          pure $ makeSignedTxWithWitnessKeys txBody txWitness'
+        ReferenceTxInsScriptsInlineDatumsInConwayEra -> do
+          txWitness' <- fromDTOThrow (badRequest' "Invalid tx witness") txWitness
+          pure $ makeSignedTxWithWitnessKeys txBody txWitness'
       submitWithdrawal withdrawalId' era tx >>= \case
         Nothing -> pure NoContent
         Just err -> throwError $ ApiError.toServerError $ ApiError (show err) "SubmissionError" Null 403
diff --git a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/Util.hs b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/Util.hs
index d518bdf09f..7dcd2f65ff 100644
--- a/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/Util.hs
+++ b/marlowe-runtime-web/server/Language/Marlowe/Runtime/Web/Server/Util.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Language.Marlowe.Runtime.Web.Server.Util where
 
@@ -8,20 +10,34 @@ import Data.Function (on)
 import qualified Data.List as List
 
 import Cardano.Api (
-  ScriptValidity (ScriptInvalid, ScriptValid),
-  TxScriptValidity (TxScriptValidity, TxScriptValidityNone),
+  HasTextEnvelope (textEnvelopeType),
+  HasTypeProxy (..),
+  IsCardanoEra,
+  IsShelleyBasedEra (..),
+  ScriptValidity (..),
+  SerialiseAsCBOR,
+  ShelleyBasedEra (..),
+  TxScriptValidity (..),
   makeSignedTransaction,
  )
-import Cardano.Api.Shelley (ShelleyLedgerEra, Tx (ShelleyTx), TxBody (ShelleyTxBody))
+import Cardano.Api.Byron (Tx (ByronTx), TxBody (..))
+import Cardano.Api.Shelley (SerialiseAsCBOR (..), ShelleyLedgerEra, Tx (ShelleyTx), TxBody (ShelleyTxBody))
+import Cardano.Ledger.Alonzo (AlonzoScript)
+import Cardano.Ledger.Alonzo.Core (EraTxWits (..), Script)
 import qualified Cardano.Ledger.Alonzo.Scripts
 import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..))
 import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
 import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..))
 import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
+import Cardano.Ledger.Binary (DecCBOR (..), Decoder, decodeFullAnnotator, serialize')
+import Cardano.Ledger.Binary.Decoding (Annotator)
+import Cardano.Ledger.Core (eraProtVerLow)
 import qualified Cardano.Ledger.Core
 import Cardano.Ledger.Era (Era (EraCrypto))
 import Cardano.Ledger.Keys (KeyRole (Witness))
 import Cardano.Ledger.Shelley.TxBody (WitVKey)
+import qualified Data.ByteString.Lazy as BSL
+import Data.Data (Proxy (..))
 import Data.Set (Set)
 import Servant.Pagination
 
@@ -40,18 +56,57 @@ applyRangeToAscList getField startFrom limit offset order =
 
 type WitVKeys era = Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))
 
+newtype TxWitnessSet era = TxWitnessSet (TxWits (ShelleyLedgerEra era))
+
+instance (IsCardanoEra era) => HasTypeProxy (TxWitnessSet era) where
+  data AsType (TxWitnessSet era) = AsTxWitnessSet (AsType era)
+  proxyToAsType _ = AsTxWitnessSet $ proxyToAsType $ Proxy @era
+
+instance
+  ( IsCardanoEra era
+  , EraTxWits (ShelleyLedgerEra era)
+  , Script (ShelleyLedgerEra era) ~ AlonzoScript (ShelleyLedgerEra era)
+  )
+  => SerialiseAsCBOR (TxWitnessSet era)
+  where
+  serialiseToCBOR (TxWitnessSet wit) = serialize' (eraProtVerLow @(ShelleyLedgerEra era)) wit
+
+  deserialiseFromCBOR _ bs = do
+    let lbs = BSL.fromStrict bs
+
+        annotator :: forall s. Decoder s (Annotator (TxWits (ShelleyLedgerEra era)))
+        annotator = decCBOR
+
+    (w :: TxWits (ShelleyLedgerEra era)) <-
+      decodeFullAnnotator (eraProtVerLow @(ShelleyLedgerEra era)) "Tx Witness Set" annotator lbs
+    pure $ TxWitnessSet w
+
+instance
+  ( IsShelleyBasedEra era
+  , EraTxWits (ShelleyLedgerEra era)
+  , Script (ShelleyLedgerEra era) ~ AlonzoScript (ShelleyLedgerEra era)
+  )
+  => HasTextEnvelope (TxWitnessSet era)
+  where
+  textEnvelopeType _ = do
+    "TxWitness Set " <> case shelleyBasedEra @era of
+      ShelleyBasedEraAlonzo -> "AlonzoEra"
+      ShelleyBasedEraBabbage -> "BabbageEra"
+      ShelleyBasedEraConway -> "ConwayEra"
+
 makeSignedTxWithWitnessKeys
   :: forall era shelleyLedgerEra
-   . ( ShelleyLedgerEra era ~ shelleyLedgerEra
+   . ( IsShelleyBasedEra era
+     , ShelleyLedgerEra era ~ shelleyLedgerEra
      , Cardano.Ledger.Era.Era shelleyLedgerEra
      , Cardano.Ledger.Core.TxWits shelleyLedgerEra ~ AlonzoTxWits shelleyLedgerEra
      , Cardano.Ledger.Core.Tx shelleyLedgerEra ~ AlonzoTx shelleyLedgerEra
      , Cardano.Ledger.Core.Script shelleyLedgerEra ~ Cardano.Ledger.Alonzo.Scripts.AlonzoScript shelleyLedgerEra
      )
   => TxBody era
-  -> WitVKeys era
-  -> Maybe (Tx era)
-makeSignedTxWithWitnessKeys txBody wtKeys = do
+  -> TxWitnessSet era
+  -> Tx era
+makeSignedTxWithWitnessKeys txBody (TxWitnessSet (AlonzoTxWits wtKeys _ _ _ _)) = do
   let txScriptValidityToIsValid :: TxScriptValidity era -> Alonzo.IsValid
       txScriptValidityToIsValid TxScriptValidityNone = Alonzo.IsValid True
       txScriptValidityToIsValid (TxScriptValidity _ scriptValidity) = case scriptValidity of
@@ -59,7 +114,7 @@ makeSignedTxWithWitnessKeys txBody wtKeys = do
         ScriptInvalid -> Alonzo.IsValid False
 
   case (txBody, makeSignedTransaction [] txBody) of
-    (ShelleyTxBody era txBody' _ _ txmetadata scriptValidity, ShelleyTx _ (AlonzoTx _ bkTxWitness _ _)) -> do
+    (ShelleyTxBody era txBody' _ _ txMeta scriptValidity, ShelleyTx _ (AlonzoTx _ bkTxWitness _ _)) -> do
       let AlonzoTxWits _ bkBoot bkScripts bkDats bkRdmrs = bkTxWitness
           wt' =
             AlonzoTxWits @shelleyLedgerEra
@@ -69,11 +124,11 @@ makeSignedTxWithWitnessKeys txBody wtKeys = do
               bkDats
               bkRdmrs
 
-      Just $
-        ShelleyTx era $
-          AlonzoTx
-            txBody'
-            wt'
-            (txScriptValidityToIsValid scriptValidity)
-            (maybeToStrictMaybe txmetadata)
-    _ -> Nothing
+      ShelleyTx era $
+        AlonzoTx
+          txBody'
+          wt'
+          (txScriptValidityToIsValid scriptValidity)
+          (maybeToStrictMaybe txMeta)
+    (ByronTxBody{}, _) -> case shelleyBasedEra @era of {}
+    (_, ByronTx{}) -> case shelleyBasedEra @era of {}
diff --git a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
index 612763246d..c4666183b1 100644
--- a/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
+++ b/marlowe-runtime-web/src/Language/Marlowe/Runtime/Web/Types.hs
@@ -714,8 +714,8 @@ instance ToSchema TxWitness where
             & type_ ?~ OpenApiString
             & OpenApi.description ?~ "What type of data is encoded in the CBOR Hex."
             & enum_
-              ?~ [ "TxWitness BabbageEra"
-                 , "TxWitness ConwayEra"
+              ?~ [ "TxWitness Set BabbageEra"
+                 , "TxWitness Set ConwayEra"
                  ]
     pure $
       NamedSchema (Just "TxWitness") $

From c2b3b57aa8c41f28e04f6df1211eee946cb1851d Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Tue, 9 Jan 2024 13:06:08 -0500
Subject: [PATCH 7/8] Update golden tests and schema tests

---
 marlowe-runtime-web/.golden/OpenApi/golden | 4 ++--
 marlowe-runtime-web/test/Spec.hs           | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/marlowe-runtime-web/.golden/OpenApi/golden b/marlowe-runtime-web/.golden/OpenApi/golden
index 7884a45c71..a1d89fb1d2 100644
--- a/marlowe-runtime-web/.golden/OpenApi/golden
+++ b/marlowe-runtime-web/.golden/OpenApi/golden
@@ -2834,8 +2834,8 @@
                     "type": {
                         "description": "What type of data is encoded in the CBOR Hex.",
                         "enum": [
-                            "TxWitness BabbageEra",
-                            "TxWitness ConwayEra"
+                            "TxWitness Set BabbageEra",
+                            "TxWitness Set ConwayEra"
                         ],
                         "type": "string"
                     }
diff --git a/marlowe-runtime-web/test/Spec.hs b/marlowe-runtime-web/test/Spec.hs
index 9c6ae53cff..078c75e505 100644
--- a/marlowe-runtime-web/test/Spec.hs
+++ b/marlowe-runtime-web/test/Spec.hs
@@ -613,7 +613,7 @@ instance (Arbitrary a) => Arbitrary (Web.ListObject a) where
   shrink = genericShrink
 
 instance Arbitrary Web.TxWitness where
-  arbitrary = Web.TxWitness "TxWitness BabbageEra" <$> arbitrary <*> arbitrary
+  arbitrary = Web.TxWitness "TxWitness Set BabbageEra" <$> arbitrary <*> arbitrary
   shrink = genericShrink
 
 instance Arbitrary Web.UnwitnessedTx where

From d1e25ab6f663abf881f9b1184ecadf54c77bbdfe Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Thu, 11 Jan 2024 11:32:19 -0500
Subject: [PATCH 8/8] Update
 marlowe-runtime-web/changelog.d/20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md

Co-authored-by: Brian W Bush <brian.bush@iohk.io>
---
 .../20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/marlowe-runtime-web/changelog.d/20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md b/marlowe-runtime-web/changelog.d/20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md
index bdf6bebf92..fe616041c5 100644
--- a/marlowe-runtime-web/changelog.d/20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md
+++ b/marlowe-runtime-web/changelog.d/20240105_135357_jhbertra_plt_9086_wallet_compatible_cbor.md
@@ -7,7 +7,7 @@
 
 - `Tx <era>` format in `POST` responses changed to `Unwitnessed Tx <era>`
 - Transactions in `POST` responses are CDDL compliant.
-- `ShelleyTxWitness <era>` format in `PUT` requests changed to `TxWitness <era>`
+- `ShelleyTxWitness <era>` format in `PUT` requests changed to `TxWitness Set <era>`
 - TxWitnesses in `PUT` requests must be CDDL compliant.
 
 ### Fixed