Merge pull request #1179 from input-output-hk/fix-network-reliability…

…-missconfigured-peer

Prevents node from starting given persisted network state is inconsistent with configuration

CHANGELOG.md

@@ -52,6 +52,11 @@ changes.
 
 - Fixed TUI key bindings for exiting in dialogs.
 
+- Prevent users from resuming a Hydra node after changing its configurations.
+Ensure that the node terminates when attempting to start a Hydra node with a
+number of configured peers that doesn't match the persisted state (i.e., the
+number of parties in the /acks vector).
+
 ## [0.13.0] - 2023-10-03
 
 - **BREAKING** Update to plutus 1.9. This changes the script hashes.

hydra-cluster/bench/Bench/EndToEnd.hs

@@ -94,7 +94,7 @@ bench startingNodeId timeoutSeconds workDir dataset@Dataset{clientDatasets, titl
             let contestationPeriod = UnsafeContestationPeriod 10
             withHydraCluster hydraTracer workDir nodeSocket startingNodeId cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \(leader :| followers) -> do
               let clients = leader : followers
-              waitForNodesConnected hydraTracer clients
+              waitForNodesConnected hydraTracer 20 clients
 
               putTextLn "Initializing Head"
               send leader $ input "Init" []

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

@@ -4,7 +4,7 @@
 module Hydra.Cluster.Scenarios where
 
 import Hydra.Prelude
-import Test.Hydra.Prelude (failure)
+import Test.Hydra.Prelude (HUnitFailure, anyException, failure)
 
 import Cardano.Api.UTxO qualified as UTxO
 import CardanoClient (
@@ -96,7 +96,9 @@ import Network.HTTP.Req (
   (/:),
  )
 import PlutusLedgerApi.Test.Examples qualified as Plutus
-import Test.Hspec.Expectations (shouldBe, shouldReturn, shouldThrow)
+import System.Directory (removeDirectoryRecursive)
+import System.FilePath ((</>))
+import Test.Hspec.Expectations (Selector, shouldBe, shouldReturn, shouldThrow)
 import Test.QuickCheck (generate)
 
 data EndToEndLog
@@ -147,6 +149,50 @@ restartedNodeCanObserveCommitTx tracer workDir cardanoNode hydraScriptsTxId = do
  where
   RunningNode{nodeSocket, networkId} = cardanoNode
 
+testPreventResumeReconfiguredPeer :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO ()
+testPreventResumeReconfiguredPeer tracer workDir cardanoNode hydraScriptsTxId = do
+  let contestationPeriod = UnsafeContestationPeriod 1
+  aliceChainConfig <-
+    chainConfigFor Alice workDir nodeSocket [Bob] contestationPeriod
+      <&> \config -> (config :: ChainConfig){networkId}
+
+  aliceChainConfigWithoutBob <-
+    chainConfigFor Alice workDir nodeSocket [] contestationPeriod
+      <&> \config -> (config :: ChainConfig){networkId}
+
+  bobChainConfig <-
+    chainConfigFor Bob workDir nodeSocket [Alice] contestationPeriod
+      <&> \config -> (config :: ChainConfig){networkId}
+
+  let hydraTracer = contramap FromHydraNode tracer
+      aliceStartsWithoutKnowingBob =
+        withHydraNode hydraTracer aliceChainConfigWithoutBob workDir 2 aliceSk [] [1, 2] hydraScriptsTxId
+      aliceRestartsWithBobConfigured =
+        withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId
+
+  withHydraNode hydraTracer bobChainConfig workDir 1 bobSk [aliceVk] [1, 2] hydraScriptsTxId $ \n1 -> do
+    aliceStartsWithoutKnowingBob $ \n2 -> do
+      failToConnect hydraTracer [n1, n2]
+
+    threadDelay 1
+
+    aliceRestartsWithBobConfigured (const $ threadDelay 1)
+      `shouldThrow` aFailure
+
+    threadDelay 1
+
+    removeDirectoryRecursive $ workDir </> "state-2"
+
+    aliceRestartsWithBobConfigured $ \n2 -> do
+      waitForNodesConnected hydraTracer 10 [n1, n2]
+ where
+  RunningNode{nodeSocket, networkId} = cardanoNode
+
+  aFailure :: Selector HUnitFailure
+  aFailure = const True
+
+  failToConnect tr nodes = waitForNodesConnected tr 10 nodes `shouldThrow` anyException
+
 restartedNodeCanAbort :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO ()
 restartedNodeCanAbort tracer workDir cardanoNode hydraScriptsTxId = do
   refuelIfNeeded tracer cardanoNode Alice 100_000_000
@@ -517,7 +563,7 @@ threeNodesNoErrorsOnOpen tracer tmpDir node@RunningNode{nodeSocket} hydraScripts
   let hydraTracer = contramap FromHydraNode tracer
   withHydraCluster hydraTracer tmpDir nodeSocket 0 cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \(leader :| rest) -> do
     let clients = leader : rest
-    waitForNodesConnected hydraTracer clients
+    waitForNodesConnected hydraTracer 20 clients
 
     -- Funds to be used as fuel by Hydra protocol transactions
     seedFromFaucet_ node aliceCardanoVk 100_000_000 (contramap FromFaucet tracer)

hydra-cluster/src/HydraNode.hs

@@ -218,8 +218,8 @@ withHydraCluster ::
   ContestationPeriod ->
   (NonEmpty HydraClient -> IO a) ->
   IO a
-withHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys hydraScriptsTxId contestationPeriod action =
-  withConfiguredHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys hydraScriptsTxId (const $ id) contestationPeriod action
+withHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys hydraScriptsTxId =
+  withConfiguredHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys hydraScriptsTxId (const id)
 
 withConfiguredHydraCluster ::
   HasCallStack =>
@@ -298,14 +298,11 @@ withHydraNode ::
 withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds hydraScriptsTxId action = do
   withLogFile logFilePath $ \logFileHandle -> do
     withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds hydraScriptsTxId (Just logFileHandle) $ do
-      \_ _err processHandle -> do
-        result <-
-          race
-            (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle)
-            (withConnectionToNode tracer hydraNodeId action)
-        case result of
-          Left e -> absurd e
-          Right a -> pure a
+      \_ processHandle -> do
+        race
+          (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle)
+          (withConnectionToNode tracer hydraNodeId action)
+          <&> either absurd id
  where
   logFilePath = workDir </> "logs" </> "hydra-node-" <> show hydraNodeId <.> "log"
 
@@ -322,7 +319,7 @@ withHydraNode' ::
   TxId ->
   -- | If given use this as std out.
   Maybe Handle ->
-  (Handle -> Handle -> ProcessHandle -> IO a) ->
+  (Handle -> ProcessHandle -> IO a) ->
   IO a
 withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds hydraScriptsTxId mGivenStdOut action = do
   withSystemTempDirectory "hydra-node" $ \dir -> do
@@ -357,12 +354,12 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h
                 }
           )
             { std_out = maybe CreatePipe UseHandle mGivenStdOut
-            , std_err = CreatePipe
+            , std_err = Inherit
             }
     withCreateProcess p $ \_stdin mCreatedHandle mErr processHandle ->
       case (mCreatedHandle, mGivenStdOut, mErr) of
-        (Just out, _, Just err) -> action out err processHandle
-        (Nothing, Just out, Just err) -> action out err processHandle
+        (Just out, _, _) -> action out processHandle
+        (Nothing, Just out, _) -> action out processHandle
         (_, _, _) -> error "Should not happen™"
  where
   peers =
@@ -377,13 +374,15 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h
 withConnectionToNode :: Tracer IO HydraNodeLog -> Int -> (HydraClient -> IO a) -> IO a
 withConnectionToNode tracer hydraNodeId action = do
   connectedOnce <- newIORef False
-  tryConnect connectedOnce
+  tryConnect connectedOnce (200 :: Int)
  where
-  tryConnect connectedOnce =
-    doConnect connectedOnce `catch` \(e :: IOException) -> do
-      readIORef connectedOnce >>= \case
-        False -> threadDelay 0.1 >> tryConnect connectedOnce
-        True -> throwIO e
+  tryConnect connectedOnce n
+    | n == 0 = failure $ "Timed out waiting for connection to hydra-node " <> show hydraNodeId
+    | otherwise =
+        doConnect connectedOnce `catch` \(e :: IOException) -> do
+          readIORef connectedOnce >>= \case
+            False -> threadDelay 0.1 >> tryConnect connectedOnce (n - 1)
+            True -> throwIO e
 
   doConnect connectedOnce = runClient "127.0.0.1" (4_000 + hydraNodeId) "/" $ \connection -> do
     atomicWriteIORef connectedOnce True
@@ -395,13 +394,13 @@ withConnectionToNode tracer hydraNodeId action = do
 hydraNodeProcess :: RunOptions -> CreateProcess
 hydraNodeProcess = proc "hydra-node" . toArgs
 
-waitForNodesConnected :: HasCallStack => Tracer IO HydraNodeLog -> [HydraClient] -> IO ()
-waitForNodesConnected tracer clients =
+waitForNodesConnected :: HasCallStack => Tracer IO HydraNodeLog -> DiffTime -> [HydraClient] -> IO ()
+waitForNodesConnected tracer timeOut clients =
   mapM_ waitForNodeConnected clients
  where
   allNodeIds = hydraNodeId <$> clients
   waitForNodeConnected n@HydraClient{hydraNodeId} =
-    waitForAll tracer (fromIntegral $ 20 * length allNodeIds) [n] $
+    waitForAll tracer timeOut [n] $
       fmap
         ( \nodeId ->
             object

hydra-cluster/test/Test/CardanoClientSpec.hs

@@ -15,7 +15,7 @@ import Test.EndToEndSpec (withClusterTempDir)
 
 spec :: Spec
 spec =
-  around showLogsOnFailure $
+  around (showLogsOnFailure "CardanoClientSpec") $
     it "queryGenesisParameters works as expected" $ \tracer ->
       failAfter 60 $
         withClusterTempDir "queryGenesisParameters" $ \tmpDir -> do

hydra-cluster/test/Test/CardanoNodeSpec.hs

@@ -26,7 +26,7 @@ spec = do
   -- genesis-shelley.json
   it "withCardanoNodeDevnet does start a block-producing devnet within 5 seconds" $
     failAfter 5 $
-      showLogsOnFailure $ \tr -> do
+      showLogsOnFailure "CardanoNodeSpec" $ \tr -> do
         withTempDir "hydra-cluster" $ \tmp -> do
           withCardanoNodeDevnet tr tmp $ \RunningNode{nodeSocket, networkId} -> do
             doesFileExist (unFile nodeSocket) `shouldReturn` True

hydra-cluster/test/Test/ChainObserverSpec.hs

@@ -31,7 +31,7 @@ spec :: Spec
 spec = do
   it "can observe hydra transactions created by hydra-nodes" $
     failAfter 60 $
-      showLogsOnFailure $ \tracer -> do
+      showLogsOnFailure "ChainObserverSpec" $ \tracer -> do
         withTempDir "hydra-chain-observer" $ \tmpDir -> do
           -- Start a cardano devnet
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \cardanoNode@RunningNode{nodeSocket} -> do

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -81,7 +81,7 @@ import System.Process (proc, readCreateProcess)
 import Test.QuickCheck (generate)
 
 spec :: Spec
-spec = around showLogsOnFailure $ do
+spec = around (showLogsOnFailure "DirectChainSpec") $ do
   it "can init and abort a head given nothing has been committed" $ \tracer -> do
     withTempDir "hydra-cluster" $ \tmp -> do
       withCardanoNodeDevnet (contramap FromNode tracer) tmp $ \node@RunningNode{nodeSocket} -> do

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -67,6 +67,7 @@ import Hydra.Cluster.Scenarios (
   singlePartyCommitsExternalScriptWithInlineDatum,
   singlePartyCommitsFromExternalScript,
   singlePartyHeadFullLifeCycle,
+  testPreventResumeReconfiguredPeer,
   threeNodesNoErrorsOnOpen,
  )
 import Hydra.Cluster.Util (chainConfigFor, keysFor)
@@ -111,7 +112,7 @@ withClusterTempDir name =
   withTempDir ("hydra-cluster-e2e-" <> name)
 
 spec :: Spec
-spec = around showLogsOnFailure $
+spec = around (showLogsOnFailure "EndToEndSpec") $
   describe "End-to-end on Cardano devnet" $ do
     describe "single party hydra head" $ do
       it "full head life-cycle" $ \tracer -> do
@@ -184,7 +185,7 @@ spec = around showLogsOnFailure $
               let hydraTracer = contramap FromHydraNode tracer
               withHydraCluster hydraTracer tmpDir nodeSocket firstNodeId cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \nodes -> do
                 let [n1, n2, n3] = toList nodes
-                waitForNodesConnected hydraTracer [n1, n2, n3]
+                waitForNodesConnected hydraTracer 20 [n1, n2, n3]
 
                 -- Funds to be used as fuel by Hydra protocol transactions
                 seedFromFaucet_ node aliceCardanoVk 100_000_000 (contramap FromFaucet tracer)
@@ -241,6 +242,12 @@ spec = around showLogsOnFailure $
             publishHydraScriptsAs node Faucet
               >>= restartedNodeCanObserveCommitTx tracer tmpDir node
 
+      it "prevent resuming a head after reconfiguring a peer" $ \tracer -> do
+        withClusterTempDir "prevent-resume-reconfiguring-peer" $ \tmpDir -> do
+          withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
+            publishHydraScriptsAs node Faucet
+              >>= testPreventResumeReconfiguredPeer tracer tmpDir node
+
       it "can start chain from the past and replay on-chain events" $ \tracer ->
         withClusterTempDir "replay-chain-events" $ \tmp ->
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmp $ \node@RunningNode{nodeSocket, networkId} -> do
@@ -300,7 +307,7 @@ spec = around showLogsOnFailure $
 
             withAliceNode $ \n1 -> do
               headId <- withBobNode $ \n2 -> do
-                waitForNodesConnected hydraTracer [n1, n2]
+                waitForNodesConnected hydraTracer 20 [n1, n2]
 
                 send n1 $ input "Init" []
                 headId <- waitForAllMatch 10 [n1, n2] $ headIsInitializingWith (Set.fromList [alice, bob])
@@ -420,7 +427,7 @@ spec = around showLogsOnFailure $
                   withHydraNode hydraTracer carolChainConfig tmpDir 3 carolSk [aliceVk, bobVk] allNodeIds hydraScriptsTxId $ \n3 -> do
                     -- Funds to be used as fuel by Hydra protocol transactions
                     seedFromFaucet_ node aliceCardanoVk 100_000_000 (contramap FromFaucet tracer)
-                    waitForNodesConnected hydraTracer [n1, n2, n3]
+                    waitForNodesConnected hydraTracer 20 [n1, n2, n3]
                     send n1 $ input "Init" []
                     void $ waitForAllMatch 3 [n1] $ headIsInitializingWith (Set.fromList [alice, bob, carol])
                     metrics <- getMetrics n1
@@ -432,7 +439,7 @@ spec = around showLogsOnFailure $
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) dir $ \node@RunningNode{nodeSocket} -> do
             chainConfig <- chainConfigFor Alice dir nodeSocket [] (UnsafeContestationPeriod 1)
             hydraScriptsTxId <- publishHydraScriptsAs node Faucet
-            withHydraNode' chainConfig dir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \stdOut _stdErr _processHandle -> do
+            withHydraNode' chainConfig dir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \stdOut _processHandle -> do
               waitForLog 10 stdOut "JSON object with key NodeOptions" $ \line ->
                 line ^? key "message" . key "tag" == Just (Aeson.String "NodeOptions")
 
@@ -492,7 +499,7 @@ timedTx tmpDir tracer node@RunningNode{networkId, nodeSocket} hydraScriptsTxId =
   aliceChainConfig <- chainConfigFor Alice tmpDir nodeSocket [] contestationPeriod
   let hydraTracer = contramap FromHydraNode tracer
   withHydraNode hydraTracer aliceChainConfig tmpDir 1 aliceSk [] [1] hydraScriptsTxId $ \n1 -> do
-    waitForNodesConnected hydraTracer [n1]
+    waitForNodesConnected hydraTracer 20 [n1]
     let lovelaceBalanceValue = 100_000_000
 
     -- Funds to be used as fuel by Hydra protocol transactions
@@ -563,7 +570,7 @@ initAndClose tmpDir tracer clusterIx hydraScriptsTxId node@RunningNode{nodeSocke
   let hydraTracer = contramap FromHydraNode tracer
   withHydraCluster hydraTracer tmpDir nodeSocket firstNodeId cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \nodes -> do
     let [n1, n2, n3] = toList nodes
-    waitForNodesConnected hydraTracer [n1, n2, n3]
+    waitForNodesConnected hydraTracer 20 [n1, n2, n3]
 
     -- Funds to be used as fuel by Hydra protocol transactions
     seedFromFaucet_ node aliceCardanoVk 100_000_000 (contramap FromFaucet tracer)

hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs

@@ -19,7 +19,7 @@ spec :: Spec
 spec = do
   describe "seedFromFaucet" $
     it "should work concurrently" $
-      showLogsOnFailure $ \tracer ->
+      showLogsOnFailure "FaucetSpec" $ \tracer ->
         failAfter 30 $
           withTempDir "end-to-end-cardano-node" $ \tmpDir ->
             withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
@@ -29,7 +29,7 @@ spec = do
 
   describe "returnFundsToFaucet" $
     it "seedFromFaucet and returnFundsToFaucet work together" $ do
-      showLogsOnFailure $ \tracer ->
+      showLogsOnFailure "FaucetSpec" $ \tracer ->
         withTempDir "end-to-end-cardano-node" $ \tmpDir ->
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node@RunningNode{networkId, nodeSocket} -> do
             let faucetTracer = contramap FromFaucet tracer

hydra-node/hydra-node.cabal

@@ -95,6 +95,7 @@ library
     Hydra.Node
     Hydra.Node.EventQueue
     Hydra.Node.Network
+    Hydra.Node.ParameterMismatch
     Hydra.Options
     Hydra.Party
     Hydra.Persistence

hydra-node/json-schemas/logs.yaml

@@ -720,6 +720,22 @@ definitions:
               "$ref": "api.yaml#/components/schemas/Party"
             description: >-
               Parties configured as the node argument.
+      - title: SavedNetworkPartiesInconsistent
+        description: >-
+          The configured peer list does not match with the value from the loaded state.
+        type: object
+        additionalProperties: false
+        required:
+          - tag
+          - numberOfParties
+        properties:
+          tag:
+            type: string
+            enum: ["SavedNetworkPartiesInconsistent"]
+          numberOfParties:
+            type: number
+            description: >-
+              Number of parties configured as the node argument.
 
   # TODO: Fill the gap!
   Network: {}

hydra-node/src/Hydra/Logging.hs

@@ -128,19 +128,21 @@ withTracerOutputTo hdl namespace action = do
 -- metadata.
 showLogsOnFailure ::
   (MonadSTM m, MonadCatch m, MonadFork m, MonadTime m, MonadSay m, ToJSON msg) =>
+  Text ->
   (Tracer m msg -> m a) ->
   m a
-showLogsOnFailure action = do
+showLogsOnFailure namespace action = do
   tvar <- newTVarIO []
-  action (traceInTVar tvar)
+  action (traceInTVar tvar namespace)
     `onException` (readTVarIO tvar >>= mapM_ (say . decodeUtf8 . Aeson.encode) . reverse)
 
 traceInTVar ::
   (MonadFork m, MonadTime m, MonadSTM m) =>
   TVar m [Envelope msg] ->
+  Text ->
   Tracer m msg
-traceInTVar tvar = Tracer $ \msg -> do
-  envelope <- mkEnvelope "" msg
+traceInTVar tvar namespace = Tracer $ \msg -> do
+  envelope <- mkEnvelope namespace msg
   atomically $ modifyTVar tvar (envelope :)
 -- * Internal functions