From 60024f928cd0c9fb60640c4f41babd106d4e4e4d Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Fri, 16 Feb 2024 11:18:07 +0100
Subject: [PATCH] All nodes wait to observe a commit

We added a threadDelay in the performAbort and realised this fixed
one of the issues we had, pinpointing the fact that there's some race
conditions in the abort logic: It's perfectly possible that a party
Aborts while other parties Commited and the Abort fails.

We don't model this behaviour for now, but this could be done using
"Negative" actions
---
 hydra-node/test/Hydra/Model.hs     | 15 ++++++++-------
 hydra-node/test/Hydra/ModelSpec.hs |  2 +-
 2 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/hydra-node/test/Hydra/Model.hs b/hydra-node/test/Hydra/Model.hs
index 2e555fbe74e..44940623a7b 100644
--- a/hydra-node/test/Hydra/Model.hs
+++ b/hydra-node/test/Hydra/Model.hs
@@ -617,17 +617,18 @@ performCommit parties party paymentUTxO = do
   SimulatedChainNetwork{simulateCommit} <- gets chain
   case Map.lookup party nodes of
     Nothing -> throwIO $ UnexpectedParty party
-    Just actorNode -> do
+    Just{} -> do
       let realUTxO = toRealUTxO paymentUTxO
       lift $ simulateCommit (party, realUTxO)
       observedUTxO <-
         lift $
-          waitMatch actorNode $ \case
-            Committed{party = cp, utxo = committedUTxO}
-              | cp == party, committedUTxO == realUTxO -> Just committedUTxO
-            err@CommandFailed{} -> error $ show err
-            _ -> Nothing
-      pure $ fromUtxo observedUTxO
+          forM nodes $ \n ->
+            waitMatch n $ \case
+              Committed{party = cp, utxo = committedUTxO}
+                | cp == party, committedUTxO == realUTxO -> Just committedUTxO
+              err@CommandFailed{} -> error $ show err
+              _ -> Nothing
+      pure $ fromUtxo $ List.head $ toList observedUTxO
  where
   fromUtxo :: UTxO -> [(CardanoSigningKey, Value)]
   fromUtxo utxo = findSigningKey . (txOutAddress &&& txOutValue) . snd <$> pairs utxo
diff --git a/hydra-node/test/Hydra/ModelSpec.hs b/hydra-node/test/Hydra/ModelSpec.hs
index 3637115c948..f94de23ac41 100644
--- a/hydra-node/test/Hydra/ModelSpec.hs
+++ b/hydra-node/test/Hydra/ModelSpec.hs
@@ -145,7 +145,7 @@ import Hydra.Model (
 import Hydra.Model qualified as Model
 import Hydra.Model.Payment qualified as Payment
 import Hydra.Party (Party (..), deriveParty)
-import Test.QuickCheck (Property, Testable, counterexample, forAll, forAllShrink, property, withMaxSuccess, within)
+import Test.QuickCheck (Property, Testable, counterexample, forAllShrink, property, withMaxSuccess, within)
 import Test.QuickCheck.DynamicLogic (
   DL,
   Quantification,