Merge pull request #1160 from input-output-hk/misleading-error-collect

Misleading error collect

CHANGELOG.md

@@ -10,6 +10,9 @@ changes.
 
 ## [0.14.0] - UNRELEASED
 
+- Removed false positive `PostTxOnChainFailed` error from API outputs when the
+  collect transaction of another `hydra-node` was "faster" than ours.
+
 - Add a `hydra-chain-observer` executable to subscribe to a chain and just
   observe Hydra Head transactions (with minimal information right now).
 

hydra-cluster/bench/Main.hs

@@ -22,7 +22,7 @@ import Options.Applicative (
 import System.Directory (createDirectory, createDirectoryIfMissing, doesDirectoryExist)
 import System.Environment (withArgs)
 import System.FilePath ((</>))
-import Test.HUnit.Lang (HUnitFailure (..), formatFailureReason)
+import Test.HUnit.Lang (formatFailureReason)
 import Test.QuickCheck (generate, getSize, scale)
 
 main :: IO ()

hydra-cluster/src/Hydra/Cluster/Scenarios.hs

@@ -16,6 +16,7 @@ import CardanoClient (
   submitTx,
  )
 import CardanoNode (NodeLog, RunningNode (..))
+import Control.Concurrent.Async (mapConcurrently_)
 import Control.Lens ((^?))
 import Data.Aeson (Value, object, (.=))
 import Data.Aeson qualified as Aeson
@@ -58,7 +59,7 @@ import Hydra.Chain (HeadId)
 import Hydra.Chain.Direct.Tx (assetNameFromVerificationKey)
 import Hydra.Cluster.Faucet (FaucetLog, createOutputAtAddress, seedFromFaucet, seedFromFaucet_)
 import Hydra.Cluster.Faucet qualified as Faucet
-import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bob, bobSk, bobVk)
+import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bob, bobSk, bobVk, carol, carolSk)
 import Hydra.Cluster.Util (chainConfigFor, keysFor)
 import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod))
 import Hydra.Ledger (IsTx (balance))
@@ -67,15 +68,17 @@ import Hydra.Logging (Tracer, traceWith)
 import Hydra.Options (ChainConfig (..), networkId, startChainFrom)
 import Hydra.Party (Party)
 import HydraNode (
-  HydraClient,
+  HydraClient (..),
   HydraNodeLog,
   input,
   output,
   requestCommitTx,
   send,
   waitFor,
   waitForAllMatch,
+  waitForNodesConnected,
   waitMatch,
+  withHydraCluster,
   withHydraNode,
  )
 import Network.HTTP.Conduit qualified as L
@@ -498,6 +501,50 @@ canSubmitTransactionThroughAPI tracer workDir node hydraScriptsTxId =
         (Proxy :: Proxy (JsonResponse TransactionSubmitted))
         (port $ 4000 + hydraNodeId)
 
+-- | Three hydra nodes open a head and we assert that none of them sees errors.
+-- This was particularly misleading when everyone tries to post the collect
+-- transaction concurrently.
+threeNodesNoErrorsOnOpen :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO ()
+threeNodesNoErrorsOnOpen tracer tmpDir node@RunningNode{nodeSocket} hydraScriptsTxId = do
+  aliceKeys@(aliceCardanoVk, _) <- generate genKeyPair
+  bobKeys@(bobCardanoVk, _) <- generate genKeyPair
+  carolKeys@(carolCardanoVk, _) <- generate genKeyPair
+
+  let cardanoKeys = [aliceKeys, bobKeys, carolKeys]
+      hydraKeys = [aliceSk, bobSk, carolSk]
+
+  let contestationPeriod = UnsafeContestationPeriod 2
+  let hydraTracer = contramap FromHydraNode tracer
+  withHydraCluster hydraTracer tmpDir nodeSocket 0 cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \(leader :| rest) -> do
+    let clients = leader : rest
+    waitForNodesConnected hydraTracer clients
+
+    -- Funds to be used as fuel by Hydra protocol transactions
+    seedFromFaucet_ node aliceCardanoVk 100_000_000 (contramap FromFaucet tracer)
+    seedFromFaucet_ node bobCardanoVk 100_000_000 (contramap FromFaucet tracer)
+    seedFromFaucet_ node carolCardanoVk 100_000_000 (contramap FromFaucet tracer)
+
+    send leader $ input "Init" []
+    void . waitForAllMatch 10 clients $
+      headIsInitializingWith (Set.fromList [alice, bob, carol])
+
+    mapConcurrently_ (\n -> requestCommitTx n mempty >>= submitTx node) clients
+
+    mapConcurrently_ shouldNotReceivePostTxError clients
+ where
+  --  Fail if a 'PostTxOnChainFailed' message is received.
+  shouldNotReceivePostTxError client@HydraClient{hydraNodeId} = do
+    err <- waitMatch 10 client $ \v -> do
+      case v ^? key "tag" of
+        Just "PostTxOnChainFailed" -> pure $ Left $ v ^? key "postTxError"
+        Just "HeadIsOpen" -> pure $ Right ()
+        _ -> Nothing
+    case err of
+      Left receivedError ->
+        failure $ "node " <> show hydraNodeId <> " should not receive error: " <> show receivedError
+      Right _headIsOpen ->
+        pure ()
+
 -- | Two hydra node setup where Alice is wrongly configured to use Carol's
 -- cardano keys instead of Bob's which will prevent him to be notified the
 -- `HeadIsInitializing` but he should still receive some notification.
@@ -532,6 +579,8 @@ initWithWrongKeys workDir tracer node@RunningNode{nodeSocket} hydraScriptsTxId =
 
       Set.fromList pubKeyHashes `shouldBe` Set.fromList expectedHashes
 
+-- * Utilities
+
 -- | Refuel given 'Actor' with given 'Lovelace' if current marked UTxO is below that amount.
 refuelIfNeeded ::
   Tracer IO EndToEndLog ->

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -67,6 +67,7 @@ import Hydra.Cluster.Scenarios (
   singlePartyCommitsExternalScriptWithInlineDatum,
   singlePartyCommitsFromExternalScript,
   singlePartyHeadFullLifeCycle,
+  threeNodesNoErrorsOnOpen,
  )
 import Hydra.Cluster.Util (chainConfigFor, keysFor)
 import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod))
@@ -150,6 +151,13 @@ spec = around showLogsOnFailure $
               >>= canSubmitTransactionThroughAPI tracer tmpDir node
 
     describe "three hydra nodes scenario" $ do
+      it "does not error when all nodes open the head concurrently" $ \tracer ->
+        failAfter 60 $
+          withClusterTempDir "three-no-errors" $ \tmpDir -> do
+            withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node -> do
+              publishHydraScriptsAs node Faucet
+                >>= threeNodesNoErrorsOnOpen tracer tmpDir node
+
       it "inits a Head, processes a single Cardano transaction and closes it again" $ \tracer ->
         failAfter 60 $
           withClusterTempDir "three-full-life-cycle" $ \tmpDir -> do

hydra-node/src/Hydra/Chain/Direct.hs

@@ -322,7 +322,7 @@ chainSyncClient handler wallet startingPoint =
 
 txSubmissionClient ::
   forall m.
-  MonadSTM m =>
+  (MonadSTM m, MonadDelay m) =>
   Tracer m DirectChainLog ->
   TQueue m (Tx, TMVar m (Maybe (PostTxError Tx))) ->
   LocalTxSubmissionClient (TxInMode CardanoMode) (TxValidationErrorInMode CardanoMode) m ()
@@ -347,6 +347,11 @@ txSubmissionClient tracer queue =
               -- possible because of missing data constructors from cardano-api
               let postTxError = FailedToPostTx{failureReason = show err}
               traceWith tracer PostingFailed{tx, postTxError}
+              -- NOTE: Delay callback in case our transaction got invalidated
+              -- because of a transaction seen in a block. This gives the
+              -- observing side of the chain layer time to process the
+              -- transaction and business logic might even ignore this error.
+              threadDelay 1
               atomically (putTMVar response (Just postTxError))
               clientStIdle
         )

hydra-node/src/Hydra/HeadLogic.hs

@@ -691,6 +691,10 @@ update env ledger st ev = case (st, ev) of
     -- TODO: Is it really intuitive that we respond from the confirmed ledger if
     -- transactions are validated against the seen ledger?
     Effects [ClientEffect . ServerOutput.GetUTxOResponse headId $ getField @"utxo" $ getSnapshot confirmedSnapshot]
+  -- NOTE: If posting the collectCom transaction failed in the open state, then
+  -- another party likely opened the head before us and it's okay to ignore.
+  (Open{}, PostTxError{postChainTx = CollectComTx{}}) ->
+    Effects []
   -- Closed
   (Closed closedState, OnChainEvent Observation{observedTx = OnContestTx{snapshotNumber}}) ->
     onClosedChainContestTx closedState snapshotNumber

hydra-node/test/Test/Util.hs

@@ -21,7 +21,7 @@ import Data.Aeson qualified as Aeson
 import Data.List (isInfixOf)
 import Hydra.Ledger.Simple (SimpleTx)
 import Hydra.Node (HydraNodeLog)
-import Test.HUnit.Lang (FailureReason (ExpectedButGot), HUnitFailure (HUnitFailure))
+import Test.HUnit.Lang (FailureReason (ExpectedButGot))
 import Test.QuickCheck (forAll, withMaxSuccess)
 
 -- | Run given 'action' in 'IOSim' and rethrow any exceptions.

hydra-test-utils/src/Test/Hydra/Prelude.hs

@@ -1,6 +1,7 @@
 module Test.Hydra.Prelude (
   createSystemTempDirectory,
   failure,
+  HUnitFailure (..),
   location,
   failAfter,
   combinedHspecFormatter,