From 6ab39eee503efdeda3793d78f14687a812ca107e Mon Sep 17 00:00:00 2001 From: Jamie Bertram Date: Fri, 5 Jan 2024 11:15:42 -0500 Subject: [PATCH] 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