Remove txbody POST response and tx PUT request

Author: Jamie Bertram

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

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

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

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

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
   }
 

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