From b8d6111a7d6389b15b5a4932bdcd83ff91641d13 Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Fri, 15 Nov 2024 10:53:05 +0100 Subject: [PATCH] fix specs by defining waitNoMatch helper --- hydra-cluster/src/HydraNode.hs | 8 ++++++++ .../Test/Hydra/Cluster/HydraClientSpec.hs | 19 +++++++++++++------ hydra-node/src/Hydra/API/WSServer.hs | 8 +++----- hydra-node/src/Hydra/Node/Run.hs | 3 +-- 4 files changed, 25 insertions(+), 13 deletions(-) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 70e88010428..d458ed4d5a9 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -88,6 +88,14 @@ output tag pairs = object $ ("tag" .= tag) : pairs waitFor :: HasCallStack => Tracer IO HydraNodeLog -> NominalDiffTime -> [HydraClient] -> Aeson.Value -> IO () waitFor tracer delay nodes v = waitForAll tracer delay nodes [v] +-- | Wait up to some time and succeed if no API server output matches the given predicate. +waitNoMatch :: HasCallStack => NominalDiffTime -> HydraClient -> (Aeson.Value -> Maybe a) -> IO () +waitNoMatch delay client match = do + result <- try (void $ waitMatch delay client match) :: IO (Either SomeException ()) + case result of + Left _ -> pure () -- Success: waitMatch failed to find a match + Right _ -> failure "waitNoMatch: A match was found when none was expected" + -- | Wait up to some time for an API server output to match the given predicate. waitMatch :: HasCallStack => NominalDiffTime -> HydraClient -> (Aeson.Value -> Maybe a) -> IO a waitMatch delay client@HydraClient{tracer, hydraNodeId} match = do diff --git a/hydra-cluster/test/Test/Hydra/Cluster/HydraClientSpec.hs b/hydra-cluster/test/Test/Hydra/Cluster/HydraClientSpec.hs index c8460ec3abc..9531c69d7ea 100644 --- a/hydra-cluster/test/Test/Hydra/Cluster/HydraClientSpec.hs +++ b/hydra-cluster/test/Test/Hydra/Cluster/HydraClientSpec.hs @@ -44,7 +44,7 @@ import Hydra.Ledger.Cardano (mkSimpleTx) import Hydra.Logging (Tracer, showLogsOnFailure) import Hydra.Tx (IsTx (..)) import Hydra.Tx.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) -import HydraNode (HydraClient (..), HydraNodeLog, input, output, requestCommitTx, send, waitFor, waitForAllMatch, waitForNodesConnected, waitMatch, withConnectionToNodeHost, withHydraCluster) +import HydraNode (HydraClient (..), HydraNodeLog, input, output, requestCommitTx, send, waitFor, waitForAllMatch, waitForNodesConnected, waitMatch, waitNoMatch, withConnectionToNodeHost, withHydraCluster) import Test.Hydra.Tx.Fixture (testNetworkId) import Test.Hydra.Tx.Gen (genKeyPair) import Test.QuickCheck (generate) @@ -71,9 +71,9 @@ filterTxValidByAddressScenario :: Tracer IO EndToEndLog -> FilePath -> IO () filterTxValidByAddressScenario tracer tmpDir = do scenarioSetup tracer tmpDir $ \node nodes hydraTracer -> do (expectedTxId, (aliceExternalVk, bobExternalVk)) <- prepareScenario node nodes tracer - let [n1, n2, _] = toList nodes + let [n1, n2, n3] = toList nodes - -- 1/ query alice address from alice node -> Does Not see the tx + -- 1/ query alice address from alice node -> Does see the tx runScenario hydraTracer n1 (textAddrOf aliceExternalVk) $ \con -> do waitMatch 3 con $ \v -> do guard $ v ^? key "tag" == Just "TxValid" @@ -94,6 +94,13 @@ filterTxValidByAddressScenario tracer tmpDir = do tx :: Tx <- v ^? key "transaction" >>= parseMaybe parseJSON guard $ txId tx == expectedTxId + -- 3/ query bob address from carol node -> Does Not see the tx + runScenario hydraTracer n3 (textAddrOf bobExternalVk) $ \con -> do + waitNoMatch 3 con $ \v -> do + guard $ v ^? key "tag" == Just "TxValid" + tx :: Tx <- v ^? key "transaction" >>= parseMaybe parseJSON + guard $ txId tx == expectedTxId + filterTxValidByRandomAddressScenario :: Tracer IO EndToEndLog -> FilePath -> IO () filterTxValidByRandomAddressScenario tracer tmpDir = do scenarioSetup tracer tmpDir $ \node nodes hydraTracer -> do @@ -102,7 +109,7 @@ filterTxValidByRandomAddressScenario tracer tmpDir = do (randomVk, _) <- generate genKeyPair runScenario hydraTracer n1 (textAddrOf randomVk) $ \con -> do - waitMatch 3 con $ \v -> do + waitNoMatch 3 con $ \v -> do guard $ v ^? key "tag" == Just "TxValid" tx :: Tx <- v ^? key "transaction" >>= parseMaybe parseJSON guard $ txId tx == expectedTxId @@ -113,8 +120,8 @@ filterTxValidByWrongAddressScenario tracer tmpDir = do (expectedTxId, _) <- prepareScenario node nodes tracer let [_, _, n3] = toList nodes - runScenario hydraTracer n3 "pepe" $ \con -> do - waitMatch 3 con $ \v -> do + runScenario hydraTracer n3 "invalid" $ \con -> do + waitNoMatch 3 con $ \v -> do guard $ v ^? key "tag" == Just "TxValid" tx :: Tx <- v ^? key "transaction" >>= parseMaybe parseJSON guard $ txId tx == expectedTxId diff --git a/hydra-node/src/Hydra/API/WSServer.hs b/hydra-node/src/Hydra/API/WSServer.hs index 32ad236646c..7b82b4db57d 100644 --- a/hydra-node/src/Hydra/API/WSServer.hs +++ b/hydra-node/src/Hydra/API/WSServer.hs @@ -65,14 +65,12 @@ wsApp :: IO () wsApp party tracer history callback headStatusP headIdP snapshotUtxoP responseChannel ServerOutputFilter{txContainsAddr} pending = do traceWith tracer NewAPIConnection - -- pepe - path: "/?history=yes&address=addr_test1vz3n9qpu38xuzfx7a8va72qml00mcg6vdre3mztlz0l24aqjgjfxp" - let path = (spy' "pepe - path" $ requestPath $ pendingRequest pending) - let aux = (spy' "pepe - aux" <$> mkURIBs path) - queryParams <- uriQuery <$> aux + let path = requestPath $ pendingRequest pending + queryParams <- uriQuery <$> mkURIBs path con <- acceptRequest pending chan <- STM.atomically $ dupTChan responseChannel - let outConfig = mkServerOutputConfig (spy' "pepe - queryParams" queryParams) + let outConfig = mkServerOutputConfig queryParams -- api client can decide if they want to see the past history of server outputs unless (shouldNotServeHistory queryParams) $ diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 7cf8f6dfd8b..fa1150068e2 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -121,8 +121,7 @@ run opts = do -- TODO! move somewhere else matchingAddr tx address = not . null $ flip filter (txOuts' tx) $ \(TxOut addr _ _ _) -> - spy' "pepe - unwrapAddress addr" $ - unwrapAddress addr == address + unwrapAddress addr == address -- TODO! move somewhere else unwrapAddress :: AddressInEra -> Text