From dae4c8720b862949001aface5f77117265531999 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Thu, 23 Nov 2023 09:46:24 +0100 Subject: [PATCH 01/17] Draft e2e spec --- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 25 +++++++++++++++++++- hydra-cluster/src/HydraNode.hs | 21 ++++++++-------- hydra-cluster/test/Test/EndToEndSpec.hs | 7 ++++++ 3 files changed, 41 insertions(+), 12 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index ccca0ae5377..c51edc3534d 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/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 (anyException, failure) import Cardano.Api.UTxO qualified as UTxO import CardanoClient ( @@ -147,6 +147,29 @@ restartedNodeCanObserveCommitTx tracer workDir cardanoNode hydraScriptsTxId = do where RunningNode{nodeSocket, networkId} = cardanoNode +testReceivedMalformedAcks :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO () +testReceivedMalformedAcks tracer workDir cardanoNode hydraScriptsTxId = do + let contestationPeriod = UnsafeContestationPeriod 1 + aliceChainConfig <- + chainConfigFor Alice workDir nodeSocket [Bob] contestationPeriod + <&> \config -> (config :: ChainConfig){networkId} + + bobChainConfig <- + chainConfigFor Bob workDir nodeSocket [Alice] contestationPeriod + <&> \config -> (config :: ChainConfig){networkId} + + let hydraTracer = contramap FromHydraNode tracer + withHydraNode hydraTracer bobChainConfig workDir 1 bobSk [aliceVk] [1, 2] hydraScriptsTxId $ \n1 -> do + withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [2] hydraScriptsTxId $ \n2 -> do + waitForNodesConnected hydraTracer [n1, n2] `shouldThrow` anyException + threadDelay 1 + withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId $ \n2 -> do + waitForNodesConnected hydraTracer [n1, n2] + + True `shouldBe` False + where + RunningNode{nodeSocket, networkId} = cardanoNode + restartedNodeCanAbort :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO () restartedNodeCanAbort tracer workDir cardanoNode hydraScriptsTxId = do refuelIfNeeded tracer cardanoNode Alice 100_000_000 diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 61f67cb657d..6477947b845 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -6,7 +6,7 @@ import Hydra.Cardano.Api import Hydra.Prelude hiding (delete) import Cardano.BM.Tracing (ToObject) -import Control.Concurrent.Async (forConcurrently_) +import Control.Concurrent.Async (forConcurrently_, link) import Control.Concurrent.Class.MonadSTM (modifyTVar', newTVarIO, readTVarIO) import Control.Exception (IOException) import Control.Monad.Class.MonadAsync (forConcurrently) @@ -30,6 +30,7 @@ import Network.HTTP.Req (GET (..), HttpException, JsonResponse, NoReqBody (..), import Network.HTTP.Req qualified as Req import Network.WebSockets (Connection, receiveData, runClient, sendClose, sendTextData) import System.FilePath ((<.>), ()) +import System.IO (hGetLine, hPutStrLn) import System.IO.Temp (withSystemTempDirectory) import System.Process ( CreateProcess (..), @@ -218,8 +219,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 +299,12 @@ 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 + \_ stdErr processHandle -> do + withAsync (forever $ hGetLine stdErr >>= hPutStrLn stderr) $ \a -> do + link a + withAsync (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle) $ \b -> do + link b + withConnectionToNode tracer hydraNodeId action where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 0f1646d88b7..6586c2e454d 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -67,6 +67,7 @@ import Hydra.Cluster.Scenarios ( singlePartyCommitsExternalScriptWithInlineDatum, singlePartyCommitsFromExternalScript, singlePartyHeadFullLifeCycle, + testReceivedMalformedAcks, threeNodesNoErrorsOnOpen, ) import Hydra.Cluster.Util (chainConfigFor, keysFor) @@ -241,6 +242,12 @@ spec = around showLogsOnFailure $ publishHydraScriptsAs node Faucet >>= restartedNodeCanObserveCommitTx tracer tmpDir node + it "can resume a head after reconfiguring a peer" $ \tracer -> do + withClusterTempDir "resume-reconfiguring-peer" $ \tmpDir -> do + withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node -> + publishHydraScriptsAs node Faucet + >>= testReceivedMalformedAcks 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 From 201fc45c4807967e40026ac89d829d39ca348a93 Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Thu, 23 Nov 2023 11:01:57 +0100 Subject: [PATCH 02/17] Capture stderr from child process This is needed in order to see in our test the node has died with a misconfiguration, which is not the problem we are trying to solve but which is an important information to have. --- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 2 +- hydra-cluster/src/HydraNode.hs | 37 ++++++++++---------- hydra-cluster/test/Test/EndToEndSpec.hs | 2 +- 3 files changed, 21 insertions(+), 20 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index c51edc3534d..47cc194e23d 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -160,7 +160,7 @@ testReceivedMalformedAcks tracer workDir cardanoNode hydraScriptsTxId = do let hydraTracer = contramap FromHydraNode tracer withHydraNode hydraTracer bobChainConfig workDir 1 bobSk [aliceVk] [1, 2] hydraScriptsTxId $ \n1 -> do - withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [2] hydraScriptsTxId $ \n2 -> do + withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [] [1, 2] hydraScriptsTxId $ \n2 -> do waitForNodesConnected hydraTracer [n1, n2] `shouldThrow` anyException threadDelay 1 withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId $ \n2 -> do diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 6477947b845..07589860f1f 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -6,7 +6,7 @@ import Hydra.Cardano.Api import Hydra.Prelude hiding (delete) import Cardano.BM.Tracing (ToObject) -import Control.Concurrent.Async (forConcurrently_, link) +import Control.Concurrent.Async (forConcurrently_) import Control.Concurrent.Class.MonadSTM (modifyTVar', newTVarIO, readTVarIO) import Control.Exception (IOException) import Control.Monad.Class.MonadAsync (forConcurrently) @@ -299,12 +299,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 - \_ stdErr processHandle -> do - withAsync (forever $ hGetLine stdErr >>= hPutStrLn stderr) $ \a -> do - link a - withAsync (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle) $ \b -> do - link b - withConnectionToNode tracer hydraNodeId action + \_ processHandle -> do + race + (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle) + (withConnectionToNode tracer hydraNodeId action) + >>= pure . either absurd id where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" @@ -321,7 +320,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 @@ -356,12 +355,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 = @@ -376,13 +375,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 @@ -400,7 +401,7 @@ waitForNodesConnected tracer clients = where allNodeIds = hydraNodeId <$> clients waitForNodeConnected n@HydraClient{hydraNodeId} = - waitForAll tracer (fromIntegral $ 20 * length allNodeIds) [n] $ + waitForAll tracer (fromIntegral $ 2 * length allNodeIds) [n] $ fmap ( \nodeId -> object diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 6586c2e454d..793c9189998 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -439,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") From d0bd9856d25419dc81f220cabf69f0c737dc270c Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Thu, 23 Nov 2023 11:25:09 +0100 Subject: [PATCH 03/17] Fix draft e2e spec so it fails for the right reason Also renaming the spec to better match the scenarion. --- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 10 +++++++--- hydra-cluster/test/Test/EndToEndSpec.hs | 4 ++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 47cc194e23d..10499fd8054 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -147,20 +147,24 @@ restartedNodeCanObserveCommitTx tracer workDir cardanoNode hydraScriptsTxId = do where RunningNode{nodeSocket, networkId} = cardanoNode -testReceivedMalformedAcks :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO () -testReceivedMalformedAcks tracer workDir cardanoNode hydraScriptsTxId = do +testResumeReconfiguredPeer :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO () +testResumeReconfiguredPeer 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 withHydraNode hydraTracer bobChainConfig workDir 1 bobSk [aliceVk] [1, 2] hydraScriptsTxId $ \n1 -> do - withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [] [1, 2] hydraScriptsTxId $ \n2 -> do + withHydraNode hydraTracer aliceChainConfigWithoutBob workDir 2 aliceSk [] [1, 2] hydraScriptsTxId $ \n2 -> do waitForNodesConnected hydraTracer [n1, n2] `shouldThrow` anyException threadDelay 1 withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId $ \n2 -> do diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 793c9189998..d3c3b37e352 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -67,7 +67,7 @@ import Hydra.Cluster.Scenarios ( singlePartyCommitsExternalScriptWithInlineDatum, singlePartyCommitsFromExternalScript, singlePartyHeadFullLifeCycle, - testReceivedMalformedAcks, + testResumeReconfiguredPeer, threeNodesNoErrorsOnOpen, ) import Hydra.Cluster.Util (chainConfigFor, keysFor) @@ -246,7 +246,7 @@ spec = around showLogsOnFailure $ withClusterTempDir "resume-reconfiguring-peer" $ \tmpDir -> do withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node -> publishHydraScriptsAs node Faucet - >>= testReceivedMalformedAcks tracer tmpDir node + >>= testResumeReconfiguredPeer tracer tmpDir node it "can start chain from the past and replay on-chain events" $ \tracer -> withClusterTempDir "replay-chain-events" $ \tmp -> From bc980586db2a47f9a474a5ac8fe76e23d4a397fe Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Thu, 23 Nov 2023 16:53:54 +0100 Subject: [PATCH 04/17] Check when acks dir missmatches with the peers configuration --- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 18 +++++++++++------- hydra-cluster/src/HydraNode.hs | 3 +-- hydra-cluster/test/Test/EndToEndSpec.hs | 8 ++++---- hydra-node/src/Hydra/Node/Network.hs | 13 ++++++++++--- 4 files changed, 26 insertions(+), 16 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 10499fd8054..ec3e8349fc9 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -4,7 +4,7 @@ module Hydra.Cluster.Scenarios where import Hydra.Prelude -import Test.Hydra.Prelude (anyException, failure) +import Test.Hydra.Prelude (HUnitFailure (HUnitFailure), anyException, anyIOException, failure) import Cardano.Api.UTxO qualified as UTxO import CardanoClient ( @@ -96,7 +96,7 @@ import Network.HTTP.Req ( (/:), ) import PlutusLedgerApi.Test.Examples qualified as Plutus -import Test.Hspec.Expectations (shouldBe, shouldReturn, shouldThrow) +import Test.Hspec.Expectations (Selector, shouldBe, shouldReturn, shouldThrow) import Test.QuickCheck (generate) data EndToEndLog @@ -147,8 +147,8 @@ restartedNodeCanObserveCommitTx tracer workDir cardanoNode hydraScriptsTxId = do where RunningNode{nodeSocket, networkId} = cardanoNode -testResumeReconfiguredPeer :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO () -testResumeReconfiguredPeer tracer workDir cardanoNode hydraScriptsTxId = do +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 @@ -168,12 +168,16 @@ testResumeReconfiguredPeer tracer workDir cardanoNode hydraScriptsTxId = do waitForNodesConnected hydraTracer [n1, n2] `shouldThrow` anyException threadDelay 1 withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId $ \n2 -> do - waitForNodesConnected hydraTracer [n1, n2] - - True `shouldBe` False + -- XXX: because I do not want to restart a node and silently change the persistence state + -- because of a missconfiguration. + -- I want any change to the persistent state to be explicit. + waitForNodesConnected hydraTracer [n1, n2] `shouldThrow` aFailure where RunningNode{nodeSocket, networkId} = cardanoNode + aFailure :: Selector HUnitFailure + aFailure = const True + restartedNodeCanAbort :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> TxId -> IO () restartedNodeCanAbort tracer workDir cardanoNode hydraScriptsTxId = do refuelIfNeeded tracer cardanoNode Alice 100_000_000 diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 07589860f1f..e6199be1251 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -30,7 +30,6 @@ import Network.HTTP.Req (GET (..), HttpException, JsonResponse, NoReqBody (..), import Network.HTTP.Req qualified as Req import Network.WebSockets (Connection, receiveData, runClient, sendClose, sendTextData) import System.FilePath ((<.>), ()) -import System.IO (hGetLine, hPutStrLn) import System.IO.Temp (withSystemTempDirectory) import System.Process ( CreateProcess (..), @@ -303,7 +302,7 @@ withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNod race (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle) (withConnectionToNode tracer hydraNodeId action) - >>= pure . either absurd id + <&> either absurd id where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index d3c3b37e352..c61197141c2 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -67,7 +67,7 @@ import Hydra.Cluster.Scenarios ( singlePartyCommitsExternalScriptWithInlineDatum, singlePartyCommitsFromExternalScript, singlePartyHeadFullLifeCycle, - testResumeReconfiguredPeer, + testPreventResumeReconfiguredPeer, threeNodesNoErrorsOnOpen, ) import Hydra.Cluster.Util (chainConfigFor, keysFor) @@ -242,11 +242,11 @@ spec = around showLogsOnFailure $ publishHydraScriptsAs node Faucet >>= restartedNodeCanObserveCommitTx tracer tmpDir node - it "can resume a head after reconfiguring a peer" $ \tracer -> do - withClusterTempDir "resume-reconfiguring-peer" $ \tmpDir -> do + 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 - >>= testResumeReconfiguredPeer tracer tmpDir node + >>= testPreventResumeReconfiguredPeer tracer tmpDir node it "can start chain from the past and replay on-chain events" $ \tracer -> withClusterTempDir "replay-chain-events" $ \tmp -> diff --git a/hydra-node/src/Hydra/Node/Network.hs b/hydra-node/src/Hydra/Node/Network.hs index 037454f463e..66b8412dc6c 100644 --- a/hydra-node/src/Hydra/Node/Network.hs +++ b/hydra-node/src/Hydra/Node/Network.hs @@ -78,7 +78,7 @@ import Hydra.Network.Heartbeat (ConnectionMessages, Heartbeat (..), withHeartbea import Hydra.Network.Ouroboros (TraceOuroborosNetwork, WithHost, withOuroborosNetwork) import Hydra.Network.Reliability (ReliableMsg, mkMessagePersistence, withReliability) import Hydra.Party (Party, deriveParty) -import Hydra.Persistence (createPersistence, createPersistenceIncremental) +import Hydra.Persistence (Persistence (..), createPersistence, createPersistenceIncremental) -- | An alias for logging messages output by network component. -- The type is made complicated because the various subsystems use part of the tracer only. @@ -118,8 +118,15 @@ withNetwork tracer connectionMessages configuration callback action = do me = deriveParty signingKey numberOfParties = length $ me : otherParties msgPersistence <- createPersistenceIncremental $ persistenceDir <> "/network-messages" - ackPersistence <- createPersistence $ persistenceDir <> "/acks" - let messagePersistence = mkMessagePersistence numberOfParties msgPersistence ackPersistence + ackPersistence@Persistence{load} <- createPersistence $ persistenceDir <> "/acks" + mAcks <- load + ackPersistence' <- case fmap (\acks -> length acks == numberOfParties) mAcks of + Just p -> + if p + then pure ackPersistence + else die "Peers configuration missmatches with /acks persistence" + _ -> pure ackPersistence + let messagePersistence = mkMessagePersistence numberOfParties msgPersistence ackPersistence' reliability = withFlipHeartbeats $ withReliability (contramap Reliability tracer) messagePersistence me otherParties $ From a172a207bc0266ada032334639cccb435588a76d Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Fri, 24 Nov 2023 10:24:19 +0100 Subject: [PATCH 05/17] Extend spec to check we can resume a well configured peer --- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 27 +++++++++++++++----- hydra-cluster/src/HydraNode.hs | 5 +++- hydra-node/src/Hydra/Logging.hs | 2 +- hydra-node/src/Hydra/Node/Network.hs | 2 ++ 4 files changed, 28 insertions(+), 8 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index ec3e8349fc9..69ee1b0364c 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -4,9 +4,10 @@ module Hydra.Cluster.Scenarios where import Hydra.Prelude -import Test.Hydra.Prelude (HUnitFailure (HUnitFailure), anyException, anyIOException, failure) +import Test.Hydra.Prelude (HUnitFailure, anyException, failure) import Cardano.Api.UTxO qualified as UTxO +import Cardano.BM.Data.Tracer (stdoutTracer) import CardanoClient ( QueryPoint (QueryTip), buildTransaction, @@ -64,7 +65,7 @@ import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) import Hydra.HeadId (HeadId) import Hydra.Ledger (IsTx (balance)) import Hydra.Ledger.Cardano (genKeyPair) -import Hydra.Logging (Tracer, traceWith) +import Hydra.Logging (Tracer, traceWith, withTracerOutputTo) import Hydra.Options (ChainConfig (..), networkId, startChainFrom) import Hydra.Party (Party) import HydraNode ( @@ -96,6 +97,8 @@ import Network.HTTP.Req ( (/:), ) import PlutusLedgerApi.Test.Examples qualified as Plutus +import System.Directory (listDirectory, removeDirectoryRecursive) +import System.FilePath (()) import Test.Hspec.Expectations (Selector, shouldBe, shouldReturn, shouldThrow) import Test.QuickCheck (generate) @@ -165,13 +168,25 @@ testPreventResumeReconfiguredPeer tracer workDir cardanoNode hydraScriptsTxId = let hydraTracer = contramap FromHydraNode tracer withHydraNode hydraTracer bobChainConfig workDir 1 bobSk [aliceVk] [1, 2] hydraScriptsTxId $ \n1 -> do withHydraNode hydraTracer aliceChainConfigWithoutBob workDir 2 aliceSk [] [1, 2] hydraScriptsTxId $ \n2 -> do - waitForNodesConnected hydraTracer [n1, n2] `shouldThrow` anyException - threadDelay 1 - withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId $ \n2 -> do -- XXX: because I do not want to restart a node and silently change the persistence state -- because of a missconfiguration. -- I want any change to the persistent state to be explicit. - waitForNodesConnected hydraTracer [n1, n2] `shouldThrow` aFailure + waitForNodesConnected hydraTracer [n1, n2] `shouldThrow` anyException + threadDelay 1 + ( withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId $ + ( \_ -> do + -- We do not care what happens in this action as we expect this process to die + threadDelay 1 + ) + ) + `shouldThrow` aFailure + + threadDelay 1 + removeDirectoryRecursive $ workDir "state-2" + + withTracerOutputTo stdout "alice" $ \tracer' -> + withHydraNode tracer' aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId $ \n2 -> do + waitForNodesConnected hydraTracer [n1, n2] where RunningNode{nodeSocket, networkId} = cardanoNode diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index e6199be1251..623aad86629 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -392,7 +392,10 @@ withConnectionToNode tracer hydraNodeId action = do pure res hydraNodeProcess :: RunOptions -> CreateProcess -hydraNodeProcess = proc "hydra-node" . toArgs +hydraNodeProcess ro = + trace ("RunOptions: " <> show (toArgs ro)) $ + proc "hydra-node" . toArgs $ + ro waitForNodesConnected :: HasCallStack => Tracer IO HydraNodeLog -> [HydraClient] -> IO () waitForNodesConnected tracer clients = diff --git a/hydra-node/src/Hydra/Logging.hs b/hydra-node/src/Hydra/Logging.hs index 97eed7fc200..6c8f9e16533 100644 --- a/hydra-node/src/Hydra/Logging.hs +++ b/hydra-node/src/Hydra/Logging.hs @@ -140,7 +140,7 @@ traceInTVar :: TVar m [Envelope msg] -> Tracer m msg traceInTVar tvar = Tracer $ \msg -> do - envelope <- mkEnvelope "" msg + envelope <- mkEnvelope "TEST" msg atomically $ modifyTVar tvar (envelope :) -- * Internal functions diff --git a/hydra-node/src/Hydra/Node/Network.hs b/hydra-node/src/Hydra/Node/Network.hs index 66b8412dc6c..e86d618b03b 100644 --- a/hydra-node/src/Hydra/Node/Network.hs +++ b/hydra-node/src/Hydra/Node/Network.hs @@ -118,6 +118,7 @@ withNetwork tracer connectionMessages configuration callback action = do me = deriveParty signingKey numberOfParties = length $ me : otherParties msgPersistence <- createPersistenceIncremental $ persistenceDir <> "/network-messages" + -- TODO: refactor ackPersistence@Persistence{load} <- createPersistence $ persistenceDir <> "/acks" mAcks <- load ackPersistence' <- case fmap (\acks -> length acks == numberOfParties) mAcks of @@ -126,6 +127,7 @@ withNetwork tracer connectionMessages configuration callback action = do then pure ackPersistence else die "Peers configuration missmatches with /acks persistence" _ -> pure ackPersistence + let messagePersistence = mkMessagePersistence numberOfParties msgPersistence ackPersistence' reliability = withFlipHeartbeats $ From 08bc46cf6edaa3bc5eb34b063974f1fd96ae95bd Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Fri, 24 Nov 2023 10:50:14 +0100 Subject: [PATCH 06/17] Parameterize peers connectivity check This is not strictly needed but allows for fine tuning the time we wait for connection depending on the exact context of the check, and not blindly on the number of nodes. --- hydra-cluster/bench/Bench/EndToEnd.hs | 2 +- hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 36 ++++++++++---------- hydra-cluster/src/HydraNode.hs | 11 +++--- hydra-cluster/test/Test/EndToEndSpec.hs | 10 +++--- 4 files changed, 28 insertions(+), 31 deletions(-) diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index 25d39ceb08f..3356734e1f9 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/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" [] diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 69ee1b0364c..6fa2ba71742 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -7,7 +7,6 @@ import Hydra.Prelude import Test.Hydra.Prelude (HUnitFailure, anyException, failure) import Cardano.Api.UTxO qualified as UTxO -import Cardano.BM.Data.Tracer (stdoutTracer) import CardanoClient ( QueryPoint (QueryTip), buildTransaction, @@ -65,7 +64,7 @@ import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) import Hydra.HeadId (HeadId) import Hydra.Ledger (IsTx (balance)) import Hydra.Ledger.Cardano (genKeyPair) -import Hydra.Logging (Tracer, traceWith, withTracerOutputTo) +import Hydra.Logging (Tracer, traceWith) import Hydra.Options (ChainConfig (..), networkId, startChainFrom) import Hydra.Party (Party) import HydraNode ( @@ -97,7 +96,7 @@ import Network.HTTP.Req ( (/:), ) import PlutusLedgerApi.Test.Examples qualified as Plutus -import System.Directory (listDirectory, removeDirectoryRecursive) +import System.Directory (removeDirectoryRecursive) import System.FilePath (()) import Test.Hspec.Expectations (Selector, shouldBe, shouldReturn, shouldThrow) import Test.QuickCheck (generate) @@ -166,33 +165,34 @@ testPreventResumeReconfiguredPeer tracer workDir cardanoNode hydraScriptsTxId = <&> \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 - withHydraNode hydraTracer aliceChainConfigWithoutBob workDir 2 aliceSk [] [1, 2] hydraScriptsTxId $ \n2 -> do - -- XXX: because I do not want to restart a node and silently change the persistence state - -- because of a missconfiguration. - -- I want any change to the persistent state to be explicit. - waitForNodesConnected hydraTracer [n1, n2] `shouldThrow` anyException + aliceStartsWithoutKnowingBob $ \n2 -> do + failToConnect hydraTracer [n1, n2] + threadDelay 1 - ( withHydraNode hydraTracer aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId $ - ( \_ -> do - -- We do not care what happens in this action as we expect this process to die - threadDelay 1 - ) - ) + + aliceRestartsWithBobConfigured (const $ threadDelay 1) `shouldThrow` aFailure threadDelay 1 + removeDirectoryRecursive $ workDir "state-2" - withTracerOutputTo stdout "alice" $ \tracer' -> - withHydraNode tracer' aliceChainConfig workDir 2 aliceSk [bobVk] [1, 2] hydraScriptsTxId $ \n2 -> do - waitForNodesConnected hydraTracer [n1, n2] + 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 @@ -563,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) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 623aad86629..e52b28f8443 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -392,18 +392,15 @@ withConnectionToNode tracer hydraNodeId action = do pure res hydraNodeProcess :: RunOptions -> CreateProcess -hydraNodeProcess ro = - trace ("RunOptions: " <> show (toArgs ro)) $ - proc "hydra-node" . toArgs $ - ro +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 $ 2 * length allNodeIds) [n] $ + waitForAll tracer timeOut [n] $ fmap ( \nodeId -> object diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index c61197141c2..277ec6f31fd 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -185,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) @@ -307,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]) @@ -427,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 @@ -499,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 @@ -570,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) From 73278b31b3d0eff907f45d62ef3596087f99575e Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Fri, 24 Nov 2023 11:59:56 +0100 Subject: [PATCH 07/17] Provide a more specific exception for network persistence mismatch --- hydra-node/hydra-node.cabal | 1 + hydra-node/src/Hydra/Node.hs | 17 +-------- hydra-node/src/Hydra/Node/Network.hs | 38 ++++++++++++------- .../src/Hydra/Node/ParameterMismatch.hs | 26 +++++++++++++ hydra-node/test/Hydra/NetworkSpec.hs | 11 +++++- hydra-node/test/Hydra/NodeSpec.hs | 2 +- 6 files changed, 64 insertions(+), 31 deletions(-) create mode 100644 hydra-node/src/Hydra/Node/ParameterMismatch.hs diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 4d9cf76f009..18d2a170dee 100644 --- a/hydra-node/hydra-node.cabal +++ b/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 diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 64425bed482..bd43cae6d28 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -28,7 +28,6 @@ import Hydra.Chain ( PostTxError, ) import Hydra.Chain.Direct.Util (readFileTextEnvelopeThrow) -import Hydra.ContestationPeriod (ContestationPeriod) import Hydra.Crypto (AsType (AsHydraKey)) import Hydra.HeadLogic ( Effect (..), @@ -52,6 +51,7 @@ import Hydra.Logging (Tracer, traceWith) import Hydra.Network (Network (..)) import Hydra.Network.Message (Message) import Hydra.Node.EventQueue (EventQueue (..), Queued (..)) +import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) import Hydra.Options (ChainConfig (..), RunOptions (..)) import Hydra.Party (Party (..), deriveParty) import Hydra.Persistence (PersistenceIncremental (..), loadAll) @@ -74,21 +74,6 @@ initEnvironment RunOptions{hydraSigningKey, hydraVerificationKeys, chainConfig = loadParty p = Party <$> readFileTextEnvelopeThrow (AsVerificationKey AsHydraKey) p --- | Exception used to indicate command line options not matching the persisted --- state. -newtype ParameterMismatch = ParameterMismatch [ParamMismatch] - deriving stock (Eq, Show) - deriving anyclass (Exception) - -data ParamMismatch - = ContestationPeriodMismatch {loadedCp :: ContestationPeriod, configuredCp :: ContestationPeriod} - | PartiesMismatch {loadedParties :: [Party], configuredParties :: [Party]} - deriving stock (Generic, Eq, Show) - deriving anyclass (ToJSON, FromJSON) - -instance Arbitrary ParamMismatch where - arbitrary = genericArbitrary - -- | Checks that command line options match a given 'HeadState'. This funciton -- takes 'Environment' because it is derived from 'RunOptions' via -- 'initEnvironment'. diff --git a/hydra-node/src/Hydra/Node/Network.hs b/hydra-node/src/Hydra/Node/Network.hs index e86d618b03b..076b571328e 100644 --- a/hydra-node/src/Hydra/Node/Network.hs +++ b/hydra-node/src/Hydra/Node/Network.hs @@ -65,6 +65,7 @@ module Hydra.Node.Network ( NetworkConfiguration (..), withNetwork, withFlipHeartbeats, + configureMessagePersistence, ) where import Hydra.Prelude hiding (fromList, replicate) @@ -76,7 +77,8 @@ import Hydra.Network (Host (..), IP, NetworkComponent, NodeId, PortNumber) import Hydra.Network.Authenticate (Authenticated (Authenticated), Signed, withAuthentication) import Hydra.Network.Heartbeat (ConnectionMessages, Heartbeat (..), withHeartbeat) import Hydra.Network.Ouroboros (TraceOuroborosNetwork, WithHost, withOuroborosNetwork) -import Hydra.Network.Reliability (ReliableMsg, mkMessagePersistence, withReliability) +import Hydra.Network.Reliability (MessagePersistence, ReliableMsg, mkMessagePersistence, withReliability) +import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) import Hydra.Party (Party, deriveParty) import Hydra.Persistence (Persistence (..), createPersistence, createPersistenceIncremental) @@ -117,19 +119,9 @@ withNetwork tracer connectionMessages configuration callback action = do let localhost = Host{hostname = show host, port} me = deriveParty signingKey numberOfParties = length $ me : otherParties - msgPersistence <- createPersistenceIncremental $ persistenceDir <> "/network-messages" - -- TODO: refactor - ackPersistence@Persistence{load} <- createPersistence $ persistenceDir <> "/acks" - mAcks <- load - ackPersistence' <- case fmap (\acks -> length acks == numberOfParties) mAcks of - Just p -> - if p - then pure ackPersistence - else die "Peers configuration missmatches with /acks persistence" - _ -> pure ackPersistence + messagePersistence <- configureMessagePersistence persistenceDir numberOfParties - let messagePersistence = mkMessagePersistence numberOfParties msgPersistence ackPersistence' - reliability = + let reliability = withFlipHeartbeats $ withReliability (contramap Reliability tracer) messagePersistence me otherParties $ withAuthentication (contramap Authentication tracer) signingKey otherParties $ @@ -140,6 +132,26 @@ withNetwork tracer connectionMessages configuration callback action = do where NetworkConfiguration{persistenceDir, signingKey, otherParties, host, port, peers, nodeId} = configuration +-- | Create `MessagePersistence` handle to be used by `Reliability` network layer. +-- +-- This function will `throw` a `ConfigurationMismatch` exception if: +-- +-- * Some state already exists and is loaded, +-- * The number of parties is not the same as the number of acknowledgments saved. +configureMessagePersistence :: + (MonadIO m, MonadThrow m, FromJSON msg, ToJSON msg) => + FilePath -> + Int -> + m (MessagePersistence m msg) +configureMessagePersistence persistenceDir numberOfParties = do + msgPersistence <- createPersistenceIncremental $ persistenceDir <> "/network-messages" + ackPersistence@Persistence{load} <- createPersistence $ persistenceDir <> "/acks" + mAcks <- load + ackPersistence' <- case fmap (\acks -> length acks == numberOfParties) mAcks of + Just False -> throwIO $ ParameterMismatch [SavedNetworkPartiesInconsistent{numberOfParties}] + _ -> pure ackPersistence + pure $ mkMessagePersistence numberOfParties msgPersistence ackPersistence' + withFlipHeartbeats :: NetworkComponent m (Authenticated (Heartbeat msg)) msg1 a -> NetworkComponent m (Heartbeat (Authenticated msg)) msg1 a diff --git a/hydra-node/src/Hydra/Node/ParameterMismatch.hs b/hydra-node/src/Hydra/Node/ParameterMismatch.hs new file mode 100644 index 00000000000..0a7bcc0e41f --- /dev/null +++ b/hydra-node/src/Hydra/Node/ParameterMismatch.hs @@ -0,0 +1,26 @@ +-- | Structured errors related to configuration mismatch. +-- +-- When we start a `Hydra.Node` we need to do sanity checks between what's +-- provided as parameters to the node and what's persisted. +module Hydra.Node.ParameterMismatch where + +import Hydra.Prelude + +import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.Party (Party) + +-- | Exception used to indicate command line options not matching the persisted +-- state. +newtype ParameterMismatch = ParameterMismatch [ParamMismatch] + deriving stock (Eq, Show) + deriving anyclass (Exception) + +data ParamMismatch + = ContestationPeriodMismatch {loadedCp :: ContestationPeriod, configuredCp :: ContestationPeriod} + | PartiesMismatch {loadedParties :: [Party], configuredParties :: [Party]} + | SavedNetworkPartiesInconsistent {numberOfParties :: Int} + deriving stock (Generic, Eq, Show) + deriving anyclass (ToJSON, FromJSON) + +instance Arbitrary ParamMismatch where + arbitrary = genericArbitrary diff --git a/hydra-node/test/Hydra/NetworkSpec.hs b/hydra-node/test/Hydra/NetworkSpec.hs index e9a8cf0bdcc..9f5b787ca85 100644 --- a/hydra-node/test/Hydra/NetworkSpec.hs +++ b/hydra-node/test/Hydra/NetworkSpec.hs @@ -14,6 +14,9 @@ import Hydra.Logging (showLogsOnFailure) import Hydra.Network (Host (..), Network) import Hydra.Network.Message (Message (..)) import Hydra.Network.Ouroboros (broadcast, withOuroborosNetwork) +import Hydra.Node.Network (configureMessagePersistence) +import Hydra.Node.ParameterMismatch (ParameterMismatch) +import System.FilePath (()) import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs) import Test.Network.Ports (randomUnusedTCPPorts) import Test.QuickCheck ( @@ -52,8 +55,14 @@ spec = do prop "can roundtrip CBOR encoding/decoding of Hydra Message" $ prop_canRoundtripCBOREncoding @(Message SimpleTx) roundtripAndGoldenSpecs (Proxy @(Message SimpleTx)) + describe "Message Persistence" $ do + it "throws ParameterMismatch when configuring given number of acks does not match number of parties" $ do + withTempDir "persistence" $ \dir -> do + writeFile (dir "acks") "[0,0,0]" + configureMessagePersistence @_ @Int dir 4 `shouldThrow` (const True :: Selector ParameterMismatch) + withNodeBroadcastingForever :: Network IO Integer -> Integer -> IO b -> IO b -withNodeBroadcastingForever node value continuation = withNodesBroadcastingForever [(node, value)] continuation +withNodeBroadcastingForever node value = withNodesBroadcastingForever [(node, value)] withNodesBroadcastingForever :: [(Network IO Integer, Integer)] -> IO b -> IO b withNodesBroadcastingForever [] continuation = continuation diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index e24b5a919ec..4f4f3b8709a 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -39,13 +39,13 @@ import Hydra.Network.Message (Message (..)) import Hydra.Node ( HydraNode (..), HydraNodeLog (..), - ParameterMismatch (..), checkHeadState, createNodeState, loadState, stepHydraNode, ) import Hydra.Node.EventQueue (EventQueue (..), createEventQueue) +import Hydra.Node.ParameterMismatch (ParameterMismatch (..)) import Hydra.Options (defaultContestationPeriod) import Hydra.Party (Party, deriveParty) import Hydra.Persistence (PersistenceIncremental (..)) From deb49b054412c33bf453bf62fa8c1be77bc96c7e Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Fri, 24 Nov 2023 12:39:20 +0100 Subject: [PATCH 08/17] Trace params mismatch missconfiguration error when SavedNetworkPartiesInconsistent occur --- hydra-node/src/Hydra/Node/Network.hs | 12 +++++++++--- hydra-node/test/Hydra/NetworkSpec.hs | 4 ++-- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/hydra-node/src/Hydra/Node/Network.hs b/hydra-node/src/Hydra/Node/Network.hs index 076b571328e..bcfcff0a4ab 100644 --- a/hydra-node/src/Hydra/Node/Network.hs +++ b/hydra-node/src/Hydra/Node/Network.hs @@ -72,12 +72,14 @@ import Hydra.Prelude hiding (fromList, replicate) import Control.Tracer (Tracer) import Hydra.Crypto (HydraKey, SigningKey) +import Hydra.Logging (traceWith) import Hydra.Logging.Messages (HydraLog (..)) import Hydra.Network (Host (..), IP, NetworkComponent, NodeId, PortNumber) import Hydra.Network.Authenticate (Authenticated (Authenticated), Signed, withAuthentication) import Hydra.Network.Heartbeat (ConnectionMessages, Heartbeat (..), withHeartbeat) import Hydra.Network.Ouroboros (TraceOuroborosNetwork, WithHost, withOuroborosNetwork) import Hydra.Network.Reliability (MessagePersistence, ReliableMsg, mkMessagePersistence, withReliability) +import Hydra.Node (HydraNodeLog (..)) import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) import Hydra.Party (Party, deriveParty) import Hydra.Persistence (Persistence (..), createPersistence, createPersistenceIncremental) @@ -119,7 +121,7 @@ withNetwork tracer connectionMessages configuration callback action = do let localhost = Host{hostname = show host, port} me = deriveParty signingKey numberOfParties = length $ me : otherParties - messagePersistence <- configureMessagePersistence persistenceDir numberOfParties + messagePersistence <- configureMessagePersistence (contramap Node tracer) persistenceDir numberOfParties let reliability = withFlipHeartbeats $ @@ -140,15 +142,19 @@ withNetwork tracer connectionMessages configuration callback action = do -- * The number of parties is not the same as the number of acknowledgments saved. configureMessagePersistence :: (MonadIO m, MonadThrow m, FromJSON msg, ToJSON msg) => + Tracer m (HydraNodeLog tx) -> FilePath -> Int -> m (MessagePersistence m msg) -configureMessagePersistence persistenceDir numberOfParties = do +configureMessagePersistence tracer persistenceDir numberOfParties = do msgPersistence <- createPersistenceIncremental $ persistenceDir <> "/network-messages" ackPersistence@Persistence{load} <- createPersistence $ persistenceDir <> "/acks" mAcks <- load ackPersistence' <- case fmap (\acks -> length acks == numberOfParties) mAcks of - Just False -> throwIO $ ParameterMismatch [SavedNetworkPartiesInconsistent{numberOfParties}] + Just False -> do + let paramsMismatch = [SavedNetworkPartiesInconsistent{numberOfParties}] + traceWith tracer (Misconfiguration paramsMismatch) + throwIO $ ParameterMismatch paramsMismatch _ -> pure ackPersistence pure $ mkMessagePersistence numberOfParties msgPersistence ackPersistence' diff --git a/hydra-node/test/Hydra/NetworkSpec.hs b/hydra-node/test/Hydra/NetworkSpec.hs index 9f5b787ca85..b63f76c2154 100644 --- a/hydra-node/test/Hydra/NetworkSpec.hs +++ b/hydra-node/test/Hydra/NetworkSpec.hs @@ -10,7 +10,7 @@ import Codec.CBOR.Read (deserialiseFromBytes) import Codec.CBOR.Write (toLazyByteString) import Control.Concurrent.Class.MonadSTM (newTQueue, readTQueue, writeTQueue) import Hydra.Ledger.Simple (SimpleTx (..)) -import Hydra.Logging (showLogsOnFailure) +import Hydra.Logging (nullTracer, showLogsOnFailure) import Hydra.Network (Host (..), Network) import Hydra.Network.Message (Message (..)) import Hydra.Network.Ouroboros (broadcast, withOuroborosNetwork) @@ -59,7 +59,7 @@ spec = do it "throws ParameterMismatch when configuring given number of acks does not match number of parties" $ do withTempDir "persistence" $ \dir -> do writeFile (dir "acks") "[0,0,0]" - configureMessagePersistence @_ @Int dir 4 `shouldThrow` (const True :: Selector ParameterMismatch) + configureMessagePersistence @_ @Int nullTracer dir 4 `shouldThrow` (const True :: Selector ParameterMismatch) withNodeBroadcastingForever :: Network IO Integer -> Integer -> IO b -> IO b withNodeBroadcastingForever node value = withNodesBroadcastingForever [(node, value)] From 37283d644a3d75475a2b8518a2d60553d48133d7 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Fri, 24 Nov 2023 15:57:06 +0100 Subject: [PATCH 09/17] Update logs schema with new params mismatch --- hydra-node/json-schemas/logs.yaml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml index 46cad7ba7ae..a8204457d70 100644 --- a/hydra-node/json-schemas/logs.yaml +++ b/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 /acks 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: {} From 10609c436f5b244a1e12d3411b4d15ebd2f4f236 Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Mon, 27 Nov 2023 07:57:42 +0100 Subject: [PATCH 10/17] Encapsulate file name in a more explicit function --- hydra-node/src/Hydra/Node/Network.hs | 14 ++++++++++++-- hydra-node/test/Hydra/NetworkSpec.hs | 5 ++--- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/hydra-node/src/Hydra/Node/Network.hs b/hydra-node/src/Hydra/Node/Network.hs index bcfcff0a4ab..bb86b29748a 100644 --- a/hydra-node/src/Hydra/Node/Network.hs +++ b/hydra-node/src/Hydra/Node/Network.hs @@ -66,6 +66,7 @@ module Hydra.Node.Network ( withNetwork, withFlipHeartbeats, configureMessagePersistence, + acksFile ) where import Hydra.Prelude hiding (fromList, replicate) @@ -83,6 +84,7 @@ import Hydra.Node (HydraNodeLog (..)) import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) import Hydra.Party (Party, deriveParty) import Hydra.Persistence (Persistence (..), createPersistence, createPersistenceIncremental) +import System.FilePath (()) -- | An alias for logging messages output by network component. -- The type is made complicated because the various subsystems use part of the tracer only. @@ -147,8 +149,8 @@ configureMessagePersistence :: Int -> m (MessagePersistence m msg) configureMessagePersistence tracer persistenceDir numberOfParties = do - msgPersistence <- createPersistenceIncremental $ persistenceDir <> "/network-messages" - ackPersistence@Persistence{load} <- createPersistence $ persistenceDir <> "/acks" + msgPersistence <- createPersistenceIncremental $ storedMessagesFile persistenceDir + ackPersistence@Persistence{load} <- createPersistence $ acksFile persistenceDir mAcks <- load ackPersistence' <- case fmap (\acks -> length acks == numberOfParties) mAcks of Just False -> do @@ -167,3 +169,11 @@ withFlipHeartbeats withBaseNetwork callback = unwrapHeartbeats = \case Authenticated (Data nid msg) party -> callback $ Data nid (Authenticated msg party) Authenticated (Ping nid) _ -> callback $ Ping nid + +-- | Where are the messages stored, relative to given directory. +storedMessagesFile :: FilePath -> FilePath +storedMessagesFile = ( "network-messages") + +-- | Where is the acknowledgments vector stored, relative to given directory. +acksFile :: FilePath -> FilePath +acksFile = ( "acks") diff --git a/hydra-node/test/Hydra/NetworkSpec.hs b/hydra-node/test/Hydra/NetworkSpec.hs index b63f76c2154..2a800a9d243 100644 --- a/hydra-node/test/Hydra/NetworkSpec.hs +++ b/hydra-node/test/Hydra/NetworkSpec.hs @@ -14,9 +14,8 @@ import Hydra.Logging (nullTracer, showLogsOnFailure) import Hydra.Network (Host (..), Network) import Hydra.Network.Message (Message (..)) import Hydra.Network.Ouroboros (broadcast, withOuroborosNetwork) -import Hydra.Node.Network (configureMessagePersistence) +import Hydra.Node.Network (acksFile, configureMessagePersistence) import Hydra.Node.ParameterMismatch (ParameterMismatch) -import System.FilePath (()) import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs) import Test.Network.Ports (randomUnusedTCPPorts) import Test.QuickCheck ( @@ -58,7 +57,7 @@ spec = do describe "Message Persistence" $ do it "throws ParameterMismatch when configuring given number of acks does not match number of parties" $ do withTempDir "persistence" $ \dir -> do - writeFile (dir "acks") "[0,0,0]" + writeFile (acksFile dir) "[0,0,0]" configureMessagePersistence @_ @Int nullTracer dir 4 `shouldThrow` (const True :: Selector ParameterMismatch) withNodeBroadcastingForever :: Network IO Integer -> Integer -> IO b -> IO b From ecd41d442c4a8cd8c349d123e5d41345f5c4bb1b Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Mon, 27 Nov 2023 09:42:48 +0100 Subject: [PATCH 11/17] Add spec namespace when showing logs on failure --- hydra-cluster/test/Test/CardanoClientSpec.hs | 2 +- hydra-cluster/test/Test/CardanoNodeSpec.hs | 2 +- hydra-cluster/test/Test/ChainObserverSpec.hs | 2 +- hydra-cluster/test/Test/DirectChainSpec.hs | 2 +- hydra-cluster/test/Test/EndToEndSpec.hs | 2 +- .../test/Test/Hydra/Cluster/FaucetSpec.hs | 4 +-- hydra-node/src/Hydra/Logging.hs | 10 ++++--- hydra-node/test/Hydra/API/ServerSpec.hs | 26 +++++++++---------- .../test/Hydra/Network/AuthenticateSpec.hs | 2 +- hydra-node/test/Hydra/NetworkSpec.hs | 4 +-- hydra-node/test/Hydra/NodeSpec.hs | 20 +++++++------- hydra-tui/test/Hydra/TUISpec.hs | 2 +- 12 files changed, 40 insertions(+), 38 deletions(-) diff --git a/hydra-cluster/test/Test/CardanoClientSpec.hs b/hydra-cluster/test/Test/CardanoClientSpec.hs index 3431b6dc5e4..740752a1186 100644 --- a/hydra-cluster/test/Test/CardanoClientSpec.hs +++ b/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 diff --git a/hydra-cluster/test/Test/CardanoNodeSpec.hs b/hydra-cluster/test/Test/CardanoNodeSpec.hs index 9a47dc1e01a..c284cfd4bab 100644 --- a/hydra-cluster/test/Test/CardanoNodeSpec.hs +++ b/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 diff --git a/hydra-cluster/test/Test/ChainObserverSpec.hs b/hydra-cluster/test/Test/ChainObserverSpec.hs index 104778d6643..a8a6eb02e73 100644 --- a/hydra-cluster/test/Test/ChainObserverSpec.hs +++ b/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 diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index 1a8d86fbd32..8254898582f 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/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 diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 277ec6f31fd..175fec9e6b8 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -112,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 diff --git a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs b/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs index 5a2f450d90c..048c74f81ce 100644 --- a/hydra-cluster/test/Test/Hydra/Cluster/FaucetSpec.hs +++ b/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 diff --git a/hydra-node/src/Hydra/Logging.hs b/hydra-node/src/Hydra/Logging.hs index 6c8f9e16533..08c5f31af47 100644 --- a/hydra-node/src/Hydra/Logging.hs +++ b/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 "TEST" msg +traceInTVar tvar namespace = Tracer $ \msg -> do + envelope <- mkEnvelope namespace msg atomically $ modifyTVar tvar (envelope :) -- * Internal functions diff --git a/hydra-node/test/Hydra/API/ServerSpec.hs b/hydra-node/test/Hydra/API/ServerSpec.hs index cd97760a27f..bf19f9f343d 100644 --- a/hydra-node/test/Hydra/API/ServerSpec.hs +++ b/hydra-node/test/Hydra/API/ServerSpec.hs @@ -58,7 +58,7 @@ spec :: Spec spec = describe "ServerSpec" $ parallel $ do it "should fail on port in use" $ do - showLogsOnFailure $ \tracer -> failAfter 5 $ do + showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $ do let withServerOnPort p = withTestAPIServer p alice mockPersistence tracer withFreePort $ \port -> do -- We should not be able to start the server on the same port twice @@ -70,7 +70,7 @@ spec = describe "ServerSpec" $ it "greets" $ do failAfter 5 $ - showLogsOnFailure $ \tracer -> + showLogsOnFailure "ServerSpec" $ \tracer -> withFreePort $ \port -> withTestAPIServer port alice mockPersistence tracer $ \_ -> do withClient port "/" $ \conn -> do @@ -78,7 +78,7 @@ spec = describe "ServerSpec" $ it "Greetings should contain the hydra-node version" $ do failAfter 5 $ - showLogsOnFailure $ \tracer -> + showLogsOnFailure "ServerSpec" $ \tracer -> withFreePort $ \port -> withTestAPIServer port alice mockPersistence tracer $ \_ -> do withClient port "/" $ \conn -> do @@ -89,7 +89,7 @@ spec = describe "ServerSpec" $ it "sends sendOutput to all connected clients" $ do queue <- atomically newTQueue - showLogsOnFailure $ \tracer -> failAfter 5 $ + showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $ withFreePort $ \port -> do withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do semaphore <- newTVarIO 0 @@ -110,7 +110,7 @@ spec = describe "ServerSpec" $ failAfter 1 $ atomically (tryReadTQueue queue) `shouldReturn` Nothing it "sends all sendOutput history to all connected clients after a restart" $ do - showLogsOnFailure $ \tracer -> failAfter 5 $ + showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $ withTempDir "ServerSpec" $ \tmpDir -> do let persistentFile = tmpDir <> "/history" arbitraryMsg <- generate arbitrary @@ -158,7 +158,7 @@ spec = describe "ServerSpec" $ monitor $ cover 0.1 (length outputs == 1) "only one message when reconnecting" monitor $ cover 1 (length outputs > 1) "more than one message when reconnecting" run $ - showLogsOnFailure $ \tracer -> + showLogsOnFailure "ServerSpec" $ \tracer -> withFreePort $ \port -> withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do mapM_ sendOutput outputs @@ -178,7 +178,7 @@ spec = describe "ServerSpec" $ monitor $ cover 0.1 (length history == 1) "only one message when reconnecting" monitor $ cover 1 (length history > 1) "more than one message when reconnecting" run $ - showLogsOnFailure $ \tracer -> + showLogsOnFailure "ServerSpec" $ \tracer -> withFreePort $ \port -> withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do let sendFromApiServer = sendOutput @@ -202,7 +202,7 @@ spec = describe "ServerSpec" $ (output <$> timedOutputs') `shouldBe` [notHistoryMessage] it "outputs tx as cbor or json depending on the client" $ - showLogsOnFailure $ \tracer -> + showLogsOnFailure "ServerSpec" $ \tracer -> withFreePort $ \port -> withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do tx :: SimpleTx <- generate arbitrary @@ -264,7 +264,7 @@ spec = describe "ServerSpec" $ guardForValue v (toJSON tx) it "removes UTXO from snapshot when clients request it" $ - showLogsOnFailure $ \tracer -> failAfter 5 $ + showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $ withFreePort $ \port -> withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do snapshot <- generate arbitrary @@ -285,7 +285,7 @@ spec = describe "ServerSpec" $ monadicIO $ do outputs :: [ServerOutput SimpleTx] <- pick arbitrary run $ - showLogsOnFailure $ \tracer -> failAfter 5 $ + showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $ withFreePort $ \port -> withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do mapM_ sendOutput outputs @@ -298,7 +298,7 @@ spec = describe "ServerSpec" $ seq <$> timedOutputs `shouldSatisfy` strictlyMonotonic it "displays correctly headStatus and snapshotUtxo in a Greeting message" $ - showLogsOnFailure $ \tracer -> + showLogsOnFailure "ServerSpec" $ \tracer -> withFreePort $ \port -> do -- Prime some relevant server outputs already into persistence to -- check whether the latest headStatus is loaded correctly. @@ -341,7 +341,7 @@ spec = describe "ServerSpec" $ guard $ v ^? key "snapshotUtxo" == Just (toJSON utxo') it "greets with correct head status and snapshot utxo after restart" $ - showLogsOnFailure $ \tracer -> + showLogsOnFailure "ServerSpec" $ \tracer -> withTempDir "api-server-head-status" $ \persistenceDir -> withFreePort $ \port -> do let generateSnapshot = @@ -379,7 +379,7 @@ strictlyMonotonic = \case sendsAnErrorWhenInputCannotBeDecoded :: PortNumber -> Expectation sendsAnErrorWhenInputCannotBeDecoded port = do - showLogsOnFailure $ \tracer -> + showLogsOnFailure "ServerSpec" $ \tracer -> withTestAPIServer port alice mockPersistence tracer $ \_server -> do withClient port "/" $ \con -> do _greeting :: ByteString <- receiveData con diff --git a/hydra-node/test/Hydra/Network/AuthenticateSpec.hs b/hydra-node/test/Hydra/Network/AuthenticateSpec.hs index c18992922c3..c66aa5672dd 100644 --- a/hydra-node/test/Hydra/Network/AuthenticateSpec.hs +++ b/hydra-node/test/Hydra/Network/AuthenticateSpec.hs @@ -107,7 +107,7 @@ spec = parallel $ do let traced = runSimOrThrow $ do traces <- newTVarIO [] - let tracer = traceInTVar traces + let tracer = traceInTVar traces "AuthenticateSpec" withAuthentication tracer aliceSk [bob, carol] (\incoming _ -> incoming signedMsg) noop $ \_ -> threadDelay 1 diff --git a/hydra-node/test/Hydra/NetworkSpec.hs b/hydra-node/test/Hydra/NetworkSpec.hs index 2a800a9d243..8609c208e4f 100644 --- a/hydra-node/test/Hydra/NetworkSpec.hs +++ b/hydra-node/test/Hydra/NetworkSpec.hs @@ -31,7 +31,7 @@ spec = do describe "Ouroboros Network" $ do it "broadcasts messages to single connected peer" $ do received <- atomically newTQueue - showLogsOnFailure $ \tracer -> failAfter 30 $ do + showLogsOnFailure "NetworkSpec" $ \tracer -> failAfter 30 $ do [port1, port2] <- fmap fromIntegral <$> randomUnusedTCPPorts 2 withOuroborosNetwork tracer (Host lo port1) [Host lo port2] (const @_ @Integer $ pure ()) $ \hn1 -> withOuroborosNetwork @Integer tracer (Host lo port2) [Host lo port1] (atomically . writeTQueue received) $ \_ -> do @@ -42,7 +42,7 @@ spec = do node1received <- atomically newTQueue node2received <- atomically newTQueue node3received <- atomically newTQueue - showLogsOnFailure $ \tracer -> failAfter 30 $ do + showLogsOnFailure "NetworkSpec" $ \tracer -> failAfter 30 $ do [port1, port2, port3] <- fmap fromIntegral <$> randomUnusedTCPPorts 3 withOuroborosNetwork @Integer tracer (Host lo port1) [Host lo port2, Host lo port3] (atomically . writeTQueue node1received) $ \hn1 -> withOuroborosNetwork tracer (Host lo port2) [Host lo port1, Host lo port3] (atomically . writeTQueue node2received) $ \hn2 -> do diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index 4f4f3b8709a..72c3a2ffb01 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -54,7 +54,7 @@ import Test.Hydra.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk, cperiod) spec :: Spec spec = parallel $ do it "emits a single ReqSn and AckSn as leader, even after multiple ReqTxs" $ - showLogsOnFailure $ \tracer -> do + showLogsOnFailure "NodeSpec" $ \tracer -> do -- NOTE(SN): Sequence of parties in OnInitTx of -- 'eventsToOpenHead' is relevant, so 10 is the (initial) snapshot leader let tx1 = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]} @@ -73,7 +73,7 @@ spec = parallel $ do getNetworkMessages `shouldReturn` [ReqSn 1 [1], AckSn signedSnapshot 1] it "rotates snapshot leaders" $ - showLogsOnFailure $ \tracer -> do + showLogsOnFailure "NodeSpec" $ \tracer -> do let tx1 = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]} sn1 = testSnapshot 1 (utxoRefs [1, 2, 3]) mempty sn2 = testSnapshot 2 (utxoRefs [1, 3, 4]) [1] @@ -92,7 +92,7 @@ spec = parallel $ do getNetworkMessages `shouldReturn` [AckSn (sign bobSk sn1) 1, ReqSn 2 [1], AckSn (sign bobSk sn2) 2] it "processes out-of-order AckSn" $ - showLogsOnFailure $ \tracer -> do + showLogsOnFailure "NodeSpec" $ \tracer -> do let snapshot = testSnapshot 1 (utxoRefs [1, 2, 3]) [] sigBob = sign bobSk snapshot sigAlice = sign aliceSk snapshot @@ -107,7 +107,7 @@ spec = parallel $ do getNetworkMessages `shouldReturn` [AckSn{signed = sigAlice, snapshotNumber = 1}] it "notifies client when postTx throws PostTxError" $ - showLogsOnFailure $ \tracer -> do + showLogsOnFailure "NodeSpec" $ \tracer -> do let events = [ClientEvent Init] (node, getServerOutputs) <- createHydraNode aliceSk [bob, carol] cperiod events >>= throwExceptionOnPostTx NoSeedInput >>= recordServerOutputs @@ -118,7 +118,7 @@ spec = parallel $ do it "signs snapshot even if it has seen conflicting transactions" $ failAfter 1 $ - showLogsOnFailure $ \tracer -> do + showLogsOnFailure "NodeSpec" $ \tracer -> do let snapshot = testSnapshot 1 (utxoRefs [1, 3, 5]) [2] sigBob = sign bobSk snapshot events = @@ -134,7 +134,7 @@ spec = parallel $ do it "can continue after restart via persisted state" $ failAfter 1 $ - showLogsOnFailure $ \tracer -> do + showLogsOnFailure "NodeSpec" $ \tracer -> do persistence <- createPersistenceInMemory createHydraNode' persistence bobSk [alice, carol] defaultContestationPeriod eventsToOpenHead @@ -161,18 +161,18 @@ spec = parallel $ do headState = inInitialState [alice, bob] it "accepts configuration consistent with HeadState" $ - showLogsOnFailure $ \tracer -> do + showLogsOnFailure "NodeSpec" $ \tracer -> do checkHeadState tracer defaultEnv headState `shouldReturn` () it "throws exception given contestation period differs" $ - showLogsOnFailure $ \tracer -> do + showLogsOnFailure "NodeSpec" $ \tracer -> do let invalidPeriodEnv = defaultEnv{HeadLogic.contestationPeriod = defaultContestationPeriod} checkHeadState tracer invalidPeriodEnv headState `shouldThrow` \(_ :: ParameterMismatch) -> True it "throws exception given parties differ" $ - showLogsOnFailure $ \tracer -> do + showLogsOnFailure "NodeSpec" $ \tracer -> do let invalidPeriodEnv = defaultEnv{otherParties = []} checkHeadState tracer invalidPeriodEnv headState `shouldThrow` \(_ :: ParameterMismatch) -> True @@ -184,7 +184,7 @@ spec = parallel $ do Misconfiguration{} -> True _ -> False - checkHeadState (traceInTVar logs) invalidPeriodEnv headState + checkHeadState (traceInTVar logs "NodeSpec") invalidPeriodEnv headState `catch` \(_ :: ParameterMismatch) -> pure () entries <- fmap Logging.message <$> readTVarIO logs diff --git a/hydra-tui/test/Hydra/TUISpec.hs b/hydra-tui/test/Hydra/TUISpec.hs index 5f29ca41e1f..f7a5e746e92 100644 --- a/hydra-tui/test/Hydra/TUISpec.hs +++ b/hydra-tui/test/Hydra/TUISpec.hs @@ -144,7 +144,7 @@ spec = do setupNodeAndTUI' :: Lovelace -> (TUITest -> IO ()) -> IO () setupNodeAndTUI' lovelace action = - showLogsOnFailure $ \tracer -> + showLogsOnFailure "TUISpec" $ \tracer -> withTempDir "tui-end-to-end" $ \tmpDir -> do (aliceCardanoVk, _) <- keysFor Alice withCardanoNodeDevnet (contramap FromCardano tracer) tmpDir $ \node@RunningNode{nodeSocket, networkId} -> do From 49acf786088eb24be38fa25632f6ce61fa37ca5c Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Mon, 27 Nov 2023 10:10:48 +0100 Subject: [PATCH 12/17] Update CHANGELOG --- CHANGELOG.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 19e0315041e..186a52c9cdc 100644 --- a/CHANGELOG.md +++ b/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. From 813dd54293b5f66b4d2ec4d3e8c3b892ace54a90 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Mon, 27 Nov 2023 10:10:55 +0100 Subject: [PATCH 13/17] Minor formatting fixes --- hydra-node/src/Hydra/Node/Network.hs | 2 +- hydra-node/test/Hydra/Chain/Direct/Contract/Commit.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/hydra-node/src/Hydra/Node/Network.hs b/hydra-node/src/Hydra/Node/Network.hs index bb86b29748a..3e4542dc6a7 100644 --- a/hydra-node/src/Hydra/Node/Network.hs +++ b/hydra-node/src/Hydra/Node/Network.hs @@ -66,7 +66,7 @@ module Hydra.Node.Network ( withNetwork, withFlipHeartbeats, configureMessagePersistence, - acksFile + acksFile, ) where import Hydra.Prelude hiding (fromList, replicate) diff --git a/hydra-node/test/Hydra/Chain/Direct/Contract/Commit.hs b/hydra-node/test/Hydra/Chain/Direct/Contract/Commit.hs index 769d1604f87..2dc5d79306c 100644 --- a/hydra-node/test/Hydra/Chain/Direct/Contract/Commit.hs +++ b/hydra-node/test/Hydra/Chain/Direct/Contract/Commit.hs @@ -11,7 +11,7 @@ import Hydra.Chain.Direct.TxSpec () import Cardano.Api.UTxO qualified as UTxO import Cardano.Ledger.Api (bodyTxL) import Cardano.Ledger.Api.Tx.Body (EraTxBody (outputsTxBodyL), setMinCoinTxOut) -import Control.Lens (mapped, (%~), (.~), (^.)) +import Control.Lens (mapped, (%~)) import Data.List qualified as List import Data.Maybe (fromJust) import Hydra.Chain.Direct.Contract.Gen (genMintedOrBurnedValue) From d7095be85b455a62342d7d26d68b64f72fff5fb2 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Mon, 27 Nov 2023 13:12:14 +0100 Subject: [PATCH 14/17] Use the function name in the describe scope when unit testing about a specific function This helps in finding relevant tests and eases future renaming of this function. Co-authored-by: Sebastian Nagel --- hydra-node/test/Hydra/NetworkSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hydra-node/test/Hydra/NetworkSpec.hs b/hydra-node/test/Hydra/NetworkSpec.hs index 8609c208e4f..12ca6928b6f 100644 --- a/hydra-node/test/Hydra/NetworkSpec.hs +++ b/hydra-node/test/Hydra/NetworkSpec.hs @@ -54,7 +54,7 @@ spec = do prop "can roundtrip CBOR encoding/decoding of Hydra Message" $ prop_canRoundtripCBOREncoding @(Message SimpleTx) roundtripAndGoldenSpecs (Proxy @(Message SimpleTx)) - describe "Message Persistence" $ do + describe "configureMessagePersistence" $ do it "throws ParameterMismatch when configuring given number of acks does not match number of parties" $ do withTempDir "persistence" $ \dir -> do writeFile (acksFile dir) "[0,0,0]" From 34d9249f2b1463df041461af5bdbb0692e2c371c Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Mon, 27 Nov 2023 15:26:46 +0100 Subject: [PATCH 15/17] Improve network haddock on configureMessagePersistence --- hydra-node/src/Hydra/Node/Network.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hydra-node/src/Hydra/Node/Network.hs b/hydra-node/src/Hydra/Node/Network.hs index 3e4542dc6a7..d6c0d4776bc 100644 --- a/hydra-node/src/Hydra/Node/Network.hs +++ b/hydra-node/src/Hydra/Node/Network.hs @@ -138,7 +138,7 @@ withNetwork tracer connectionMessages configuration callback action = do -- | Create `MessagePersistence` handle to be used by `Reliability` network layer. -- --- This function will `throw` a `ConfigurationMismatch` exception if: +-- This function will `throw` a `ParameterMismatch` exception if: -- -- * Some state already exists and is loaded, -- * The number of parties is not the same as the number of acknowledgments saved. From 1191264131ef2e437ce9abe6ba635b6587120dce Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Mon, 27 Nov 2023 15:30:16 +0100 Subject: [PATCH 16/17] Fix logs description for SavedNetworkPartiesInconsistent by not being too concrete --- hydra-node/json-schemas/logs.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml index a8204457d70..54866e2fa67 100644 --- a/hydra-node/json-schemas/logs.yaml +++ b/hydra-node/json-schemas/logs.yaml @@ -722,7 +722,7 @@ definitions: Parties configured as the node argument. - title: SavedNetworkPartiesInconsistent description: >- - The configured peer list does not match with the value from the loaded /acks state. + The configured peer list does not match with the value from the loaded state. type: object additionalProperties: false required: From 3989d2bf2bd61471439084a1178de7425cda14ea Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Mon, 27 Nov 2023 15:36:00 +0100 Subject: [PATCH 17/17] Improve network spec by avoid writing the internal representation when saving acks Instead, we can use the interface provided for 'the system under test', here: configureMessagePersistence. --- hydra-node/test/Hydra/NetworkSpec.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/hydra-node/test/Hydra/NetworkSpec.hs b/hydra-node/test/Hydra/NetworkSpec.hs index 12ca6928b6f..6353d57072c 100644 --- a/hydra-node/test/Hydra/NetworkSpec.hs +++ b/hydra-node/test/Hydra/NetworkSpec.hs @@ -14,7 +14,8 @@ import Hydra.Logging (nullTracer, showLogsOnFailure) import Hydra.Network (Host (..), Network) import Hydra.Network.Message (Message (..)) import Hydra.Network.Ouroboros (broadcast, withOuroborosNetwork) -import Hydra.Node.Network (acksFile, configureMessagePersistence) +import Hydra.Network.Reliability (MessagePersistence (..)) +import Hydra.Node.Network (configureMessagePersistence) import Hydra.Node.ParameterMismatch (ParameterMismatch) import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs) import Test.Network.Ports (randomUnusedTCPPorts) @@ -57,7 +58,8 @@ spec = do describe "configureMessagePersistence" $ do it "throws ParameterMismatch when configuring given number of acks does not match number of parties" $ do withTempDir "persistence" $ \dir -> do - writeFile (acksFile dir) "[0,0,0]" + MessagePersistence{saveAcks} <- configureMessagePersistence @_ @Int nullTracer dir 3 + saveAcks (fromList [0, 0, 0]) configureMessagePersistence @_ @Int nullTracer dir 4 `shouldThrow` (const True :: Selector ParameterMismatch) withNodeBroadcastingForever :: Network IO Integer -> Integer -> IO b -> IO b