Testing dsl: log runtime tx bodies

input-output-hk · Mar 10, 2024 · 3ee6895 · 3ee6895
1 parent a93cac3
commit 3ee6895
Showing 1 changed file with 12 additions and 1 deletion.
diff --git a/marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Runtime/Interpret.hs b/marlowe-cli/cli-test/Language/Marlowe/CLI/Test/Runtime/Interpret.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Language.Marlowe.CLI.Test.Runtime.Interpret where
@@ -44,7 +45,7 @@ import Data.Traversable (for)
 import Language.Marlowe.CLI.Test.Contract (ContractNickname (ContractNickname), Source (InlineContract, UseTemplate))
 import Language.Marlowe.CLI.Test.Contract.Source (useTemplate)
 import Language.Marlowe.CLI.Test.InterpreterError (runtimeOperationFailed', testExecutionFailed', timeoutReached')
-import Language.Marlowe.CLI.Test.Log (Label, logStoreLabeledMsg, throwLabeledError)
+import Language.Marlowe.CLI.Test.Log (Label, logStoreLabeledMsg, logTxBody, throwLabeledError)
 import Language.Marlowe.CLI.Test.Runtime.Types (
   ContractInfo (ContractInfo, _ciContinuations, _ciContract, _ciContractId, _ciMarloweThread, _ciRoleCurrency),
   DoMerkleize (ClientSide, RuntimeSide),
@@ -372,6 +373,7 @@ withdraw ro contractId tokenName walletNickname Wallet{_waAddress, _waSigningKey
 interpret
   :: forall era env m st
    . (InterpretMonad env st m era)
+  => (C.IsShelleyBasedEra era)
   => RuntimeOperation
   -> m ()
 interpret ro@RuntimeAwaitTxsConfirmed{..} = do
@@ -575,6 +577,11 @@ interpret ro@RuntimeCreateContract{..} = do
         res <- liftIO $ flip runMarloweT connector do
           Marlowe.Class.submitAndWait BabbageEraOnwardsConway tx
         logStoreLabeledMsg ro $ "Submitted" <> show contractId
+
+        case C.cardanoEra @era of
+          C.ConwayEra -> logTxBody ("Submitted tx" :: String) "" txBody id
+          _ -> pure ()
+
         case res of
           Right _ -> do
             logStoreLabeledMsg ro $ "Contract created: " <> show tx
@@ -708,6 +715,10 @@ interpret ro@RuntimeApplyInputs{..} = do
           Marlowe.Class.submitAndWait BabbageEraOnwardsConway tx
         logStoreLabeledMsg ro "Submitted and confirmed."
 
+        case C.cardanoEra @era of
+          C.ConwayEra -> logTxBody ("Submitted tx" :: String) "" txBody id
+          _ -> pure ()
+
         case res of
           Right bl -> do
             logStoreLabeledMsg ro $ "Inputs applied: " <> show bl