Test follower history responses. Expand companion test to two contracts.

input-output-hk · Apr 20, 2022 · 1f52b0c · 1f52b0c
1 parent ec30cf7
commit 1f52b0c
Show file tree

Hide file tree

Showing 6 changed files with 183 additions and 97 deletions.
diff --git a/marlowe-cli/test/run-tests.sh b/marlowe-cli/test/run-tests.sh
@@ -41,8 +41,7 @@ BURN_ADDRESS=addr_test1vqxdw4rlu6krp9fwgwcnld6y84wdahg585vrdy67n5urp9qyts0y7
 PAB_PASSPHRASE=fixme-allow-pass-per-wallet
 
 if [ -z "$1" ]; then
-  # TEST_CASES="wait refund wallet-failure simple escrow escrow-with-collateral zero-coupon-bond zero-coupon-bond-too-late zero-coupon-bond-immediate-timeout coupon-bond-guaranteed contract-for-differences contract-for-differences-with-oracle swap-of-ada-for-ada follower-non-empty-payouts-initialization follower-notifies-about-payout-redemption"
-  TEST_CASES="follower-non-empty-payouts-initialization follower-notifies-about-payout-redemption"
+  TEST_CASES="companion-notifications-for-two-contracts wait refund wallet-failure simple escrow escrow-with-collateral zero-coupon-bond zero-coupon-bond-too-late zero-coupon-bond-immediate-timeout coupon-bond-guaranteed contract-for-differences contract-for-differences-with-oracle swap-of-ada-for-ada follower-non-empty-payouts-initialization follower-notifies-about-payout-redemption"
 else
   TEST_CASES=$1
 fi

diff --git a/marlowe-cli/test/test-companion-notifications-for-two-contracts.yaml b/marlowe-cli/test/test-companion-notifications-for-two-contracts.yaml
@@ -0,0 +1,141 @@
+ptTestName: Test companion app notifies about new contract
+
+ptPabOperations:
+  - tag: CreateWallet
+    poOwner: Sender
+
+  - tag: CreateWallet
+    poOwner: Receiver
+
+  - tag: FundWallet
+    poOwner: Sender
+    poValue:
+      lovelace: 80000000
+
+  - tag: ActivateCompanion
+    poOwner: Receiver
+    poInstance: Receiver
+
+  - tag: AwaitCompanion
+    poInstance: Receiver
+    poResponsePattern:
+      parts: []
+
+  - tag: ActivateApp
+    poOwner: Sender
+    poInstance: Sender-1
+
+  - tag: CallCreate
+    poInstance: Sender-1
+    poOwners:
+      - Receiver
+      - Sender
+    poContract:
+      when:
+        - case:
+            party:
+              role_token: Sender
+            deposits: 8000000
+            into_account:
+              role_token: Receiver
+            of_token:
+              currency_symbol: ""
+              token_name: ""
+          then:
+            pay: 8000000
+            token:
+              currency_symbol: ""
+              token_name: ""
+            from_account:
+              role_token: Receiver
+            to:
+              party:
+                role_token: Receiver
+            then: close
+      timeout: 1929587625000
+      timeout_continuation: close
+
+  - tag: AwaitCreate
+    poInstance: Sender-1
+
+  - tag: AwaitCompanion
+    poInstance: Receiver
+    poResponsePattern:
+      parts:
+        - - {}
+          - marloweContract:
+              when:
+                - case:
+                    party:
+                      role_token: Sender
+                    deposits: 8000000
+                    into_account:
+                      role_token: Receiver
+                    of_token:
+                      currency_symbol: ""
+                      token_name: ""
+                  then:
+                    pay: 8000000
+                    token:
+                      currency_symbol: ""
+                      token_name: ""
+                    from_account:
+                      role_token: Receiver
+                    to:
+                      party:
+                        role_token: Receiver
+                    then: close
+              timeout: 1929587625000
+              timeout_continuation: close
+            marloweState:
+              accounts:
+                [[[{}, { "currency_symbol": "", "token_name": "" }], 2000000]]
+              boundValues: []
+              choices: []
+
+  - tag: ActivateApp
+    poOwner: Sender
+    poInstance: Sender-2
+
+  - tag: CallCreate
+    poInstance: Sender-2
+    poOwners:
+      - Receiver
+      - Sender
+    poContract:
+      when:
+        - case:
+            party:
+              role_token: Sender
+            deposits: 8000000
+            into_account:
+              role_token: Receiver
+            of_token:
+              currency_symbol: ""
+              token_name: ""
+          then:
+            pay: 8000000
+            token:
+              currency_symbol: ""
+              token_name: ""
+            from_account:
+              role_token: Receiver
+            to:
+              party:
+                role_token: Receiver
+            then: close
+      timeout: 1929587625000
+      timeout_continuation: close
+
+  - tag: AwaitCreate
+    poInstance: Sender-2
+
+  - tag: AwaitCompanion
+    poInstance: Receiver
+    poResponsePattern:
+      # We should get notification about two running contracts
+      parts:
+        - - {}
+          - marloweContract: {}
+        - - {}
+          - marloweContract: {}
diff --git a/marlowe-cli/test/test-follower-non-empty-payouts-initialization.yaml b/marlowe-cli/test/test-follower-non-empty-payouts-initialization.yaml
@@ -106,6 +106,16 @@ ptPabOperations:
     poInstance: Follower
     poResponsePattern:
       parts:
+        chHistory:
+          - tx_inputs:
+              - input_from_party:
+                  role_token: PAB
+                that_deposits: 15000000
+                of_token:
+                  currency_symbol: ""
+                  token_name: ""
+                into_account:
+                  role_token: PAB
         chUnspentPayouts:
           - rolePayoutName:
               unTokenName: "PAB"

diff --git a/marlowe-cli/test/test-follower-notifies-about-payout-redemption.yaml b/marlowe-cli/test/test-follower-notifies-about-payout-redemption.yaml
@@ -109,6 +109,16 @@ ptPabOperations:
     poInstance: Follower
     poResponsePattern:
       parts:
+        chHistory:
+          - tx_inputs:
+              - input_from_party:
+                  role_token: PAB
+                that_deposits: 15000000
+                of_token:
+                  currency_symbol: ""
+                  token_name: ""
+                into_account:
+                  role_token: PAB
         chUnspentPayouts:
           - rolePayoutName:
               unTokenName: "PAB"
@@ -153,6 +163,18 @@ ptPabOperations:
     poInstance: Follower
     poResponsePattern:
       parts:
+        chHistory:
+          - tx_inputs:
+              - input_from_party:
+                  role_token: PAB
+                that_deposits: 15000000
+                of_token:
+                  currency_symbol: ""
+                  token_name: ""
+                into_account:
+                  role_token: PAB
+          - tx_inputs:
+              - "input_notify"
         chUnspentPayouts:
           - rolePayoutName:
               unTokenName: "PAB"

diff --git a/marlowe-cli/test/test-single-companion-notification.yaml b/marlowe-cli/test/test-single-companion-notification.yaml
diff --git a/marlowe/src/Language/Marlowe/Client.hs b/marlowe/src/Language/Marlowe/Client.hs
@@ -294,21 +294,11 @@ minLovelaceDeposit = 2_000_000
 {- NOTE: Chain index / cardano-node query consistency
   It seems that we are able to experience inconsistency between chain-index state and
   `cardano-node` state. For example we can be notified about `utxoIsProduced` but subsequent
-  query about the same address can result in an empty set. To work around that problem we
-  should probably provide some helper for check looping but for now we use trivial strategy
-  of using ad hoc `waitNMilliSeconds` in multiple places.
-
-  I think that consistency of a `Contract` block is just broken:
-
-    * We have no way to express "transactionallity" - that we want to work against single the same tip
-    in a particular query block.
-
-    * We have no quarantees about consistency between async and sync parts of the Contract interpretion
-    and the tip.
-
+  query about to the chain index like `utxosAt` for the same address can result in an empty set.
+  To work around that problem we should probably provide some proper conditional loop or sync check
+  primitive but... we for now let's just use `waitNMilliSeconds` with arbitrary timeout instead :-P
 
 -}
-
 waitForChainIndex :: forall st sc err. AsContractError err => Contract st sc err ()
 waitForChainIndex = void $ waitNMilliSeconds 2_500
 
@@ -918,9 +908,13 @@ getOnChainStateTxOuts ::
 getOnChainStateTxOuts validator = do
     (outRefs, utxos) <- mapError (review _MarloweError) $ marloweUtxoStatesAt validator
     case outRefs of
-        []       -> pure Nothing
+        []       -> do
+          debug "Language.Marlowe.Client.getOnChainState" "No state found on the chain"
+          pure Nothing
         [outRef] -> pure $ Just (OnChainState outRef, utxos)
-        _        -> throwing_ _AmbiguousOnChainState
+        _        -> do
+          debug "Language.Marlowe.Client.getOnChainState" "Multiple Marlowe UTxOs found"
+          throwing_ _AmbiguousOnChainState
 
 {-| Get the current on-chain state of the state machine instance.
     Return Nothing if there is no state on chain.