SCP-4465 add flag to control simulation mode for marlowe cli dsl

input-output-hk · Sep 23, 2022 · 68db181 · 68db181
1 parent a9692b6
commit 68db181
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 11 deletions.
diff --git a/marlowe-cli/src/Language/Marlowe/CLI/Test/Script.hs b/marlowe-cli/src/Language/Marlowe/CLI/Test/Script.hs
@@ -126,6 +126,7 @@ import Language.Marlowe.CLI.Test.Types
   , seProtocolVersion
   , seSlotConfig
   , seTransactionTimeout
+  , seExecutionTimeout
   , ssContracts
   , ssCurrencies
   , ssReferenceScripts
@@ -171,15 +172,16 @@ interpret FundWallet {..} = do
   (Wallet faucetAddress faucetSigningKey _ _) <- getFaucet
   (Wallet address _ _ _) <- findWallet soWalletNickname
   connection <- view seConnection
-  Seconds timeout <- view seTransactionTimeout
+  -- Seconds timeout <- view seTransactionTimeout
+  executionTimeout <- view seExecutionTimeout
   txBody <- runCli "[FundWallet] " $ buildFaucetImpl
     connection
     values
     [address]
     faucetAddress
     faucetSigningKey
     defaultCoinSelectionStrategy
-    (Just timeout)
+    executionTimeout
 
   let
     transaction = WalletTransaction { wtFees = 0, wtTxBody=txBody  }
@@ -193,15 +195,16 @@ interpret SplitWallet {..} = do
   let
     values = [ C.lovelaceToValue v | v <- soValues ]
 
-  Seconds timeout <- view seTransactionTimeout
+  -- Seconds timeout <- view seTransactionTimeout
+  executionTimeout <- view seExecutionTimeout
   void $ runCli "[createCollaterals] " $ buildFaucetImpl
     connection
     values
     [address]
     address
     skey
     defaultCoinSelectionStrategy
-    (Just timeout)
+    executionTimeout
 
 interpret so@Mint {..} = do
   currencies <- use ssCurrencies
@@ -217,7 +220,8 @@ interpret so@Mint {..} = do
     pure ((tokenName, amount, Just destAddress), (nickname, wallet, tokenName, amount))
   logSoMsg' so $ "Minting currency " <> show soCurrencyNickname <> " with tokens distribution: " <> show soTokenDistribution
   connection <- view seConnection
-  Seconds timeout <- view seTransactionTimeout
+  -- Seconds timeout <- view seTransactionTimeout
+  executionTimeout <- view seExecutionTimeout
   (_, policy) <- runCli "[Mint] " $ buildMintingImpl
     connection
     faucetSigningKey
@@ -226,7 +230,7 @@ interpret so@Mint {..} = do
     Nothing
     2_000_000       -- FIXME: should we compute minAda here?
     faucetAddress
-    (Just timeout)
+    executionTimeout
 
   let
     currencySymbol = mpsSymbol . fromCardanoPolicyId $ policy
@@ -389,15 +393,16 @@ interpret so@Publish {..} = do
       pure marloweScriptRefs
     Nothing -> do
       logSoMsg' so "Scripts not found so publishing them."
-      Seconds timeout <- view seTransactionTimeout
+      -- Seconds timeout <- view seTransactionTimeout
+      executionTimeout <- view seExecutionTimeout
       runSoCli so $ publishImpl
         connection
         waSigningKey
         Nothing
         waAddress
         publishingStrategy
         (CoinSelectionStrategy False False [])
-        timeout
+        executionTimeout
         (PrintStats True)
 
   assign ssReferenceScripts (Just marloweScriptRefs)
@@ -450,15 +455,16 @@ autoRunTransaction currency defaultSubmitter prev curr@T.MarloweTransaction {..}
       Nothing -> throwError "[autoRunTransaction] Contract requires a role currency which was not specified."
 
   connection <- view seConnection
-  Seconds timeout <- view seTransactionTimeout
+  -- Seconds timeout <- view seTransactionTimeout
+  executionTimeout <- view seExecutionTimeout
   txBody <- runCli "[AutoRun] " $ autoRunTransactionImpl
       connection
       prev
       curr
       address
       [skey]
       C.TxMetadataNone
-      (Just timeout)
+      executionTimeout
       True
       invalid
 

diff --git a/marlowe-cli/src/Language/Marlowe/CLI/Test/Types.hs b/marlowe-cli/src/Language/Marlowe/CLI/Test/Types.hs
@@ -64,6 +64,7 @@ module Language.Marlowe.CLI.Test.Types
   , seProtocolVersion
   , seSlotConfig
   , seTransactionTimeout
+  , seExecutionTimeoute
   , ssContracts
   , ssCurrencies
   , ssReferenceScripts
@@ -113,6 +114,8 @@ data MarloweTests era a =
     }
     deriving stock (Eq, Generic, Show)
 
+-- | Configuration for executing Marlowe CLI DSL commands on the blockchain
+data ExecutionMode = PureSimulation | OnChainExecution { transactionTimeout :: Seconds }
 
 -- | An on-chain test of the Marlowe contract and payout validators.
 data ScriptTest =
@@ -486,7 +489,8 @@ data ScriptEnv era = ScriptEnv
   , _seEra                :: ScriptDataSupportedInEra era
   , _seProtocolVersion    :: ProtocolVersion
   , _seSlotConfig         :: SlotConfig
-  , _seTransactionTimeout :: Seconds
+  -- , _seTransactionTimeout :: Seconds
+  , _seExecutionTimeout   :: ExecutionMode
   }