Less flaky multimode tests

.github/workflows/applications.yml

@@ -520,12 +520,13 @@ jobs:
 
   multi-node-network-tests:
     # disabled for now on the evm branches. 10 nodes with 100 chains probably overwhelms the runners.
-    if: false
+    if: true
     name: Multi-node network tests
     needs: [config, build]
     runs-on: ${{ matrix.os }}
     env:
       ARTIFACTS_NAME: chainweb-applications.${{ matrix.use-freeze-file }}.${{ matrix.ghc }}.${{ matrix.os }}
+      CHAINWEB_MULTINODE_TESTS_NODE_COUNT: 2
     strategy:
       fail-fast: false
       matrix: ${{ fromJson(needs.config.outputs.matrix) }}

test/lib/Chainweb/Test/MultiNode.hs

@@ -150,12 +150,12 @@ multiConfig n = defaultChainwebConfiguration implicitVersion
     & set (configP2p . p2pConfigMaxPeerCount) (n * 2)
         -- We make room for all test peers in peer db.
 
-    & set (configP2p . p2pConfigMaxSessionCount) 4
+    & set (configP2p . p2pConfigMaxSessionCount) 3
         -- We set this to a low number in order to keep the network sparse (or
         -- at last no being a clique) and to also limit the number of
         -- port allocations
 
-    & set (configP2p . p2pConfigSessionTimeout) 20
+    & set (configP2p . p2pConfigSessionTimeout) 10
         -- Use short sessions to cover session timeouts and setup logic in the
         -- test.
 
@@ -170,7 +170,7 @@ multiConfig n = defaultChainwebConfiguration implicitVersion
 
     & set (configServiceApi . serviceApiConfigPort) 0
     & set (configServiceApi . serviceApiConfigInterface) interface
-    & set (configCuts . cutFetchTimeout) 10_000_000
+    & set (configCuts . cutFetchTimeout) 5_000_000
     & set (configPayloadProviders . payloadProviderConfigPact)
         (onChains $
             [(cid, defaultPactProviderConfig
@@ -188,8 +188,8 @@ multiConfig n = defaultChainwebConfiguration implicitVersion
         }
 
     throttling = defaultThrottlingConfig
-        { _throttlingRate = 10_000 -- per second
-        , _throttlingPeerRate = 10_000 -- per second, one for each p2p network
+        { _throttlingRate = 100_000 -- per second
+        , _throttlingPeerRate = 100_000 -- per second, one for each p2p network
         }
 
 -- | Configure a bootstrap node
@@ -248,16 +248,16 @@ multiNode
     -> IO ()
 multiNode loglevel write bootstrapPeerInfoVar conf rdb pactDbDir nid inner = do
     withSystemTempDirectory "multiNode-backup-dir" $ \backupTmpDir ->
-            withChainweb conf logger namespacedNodeRocksDb (pactDbDir </> show nid) backupTmpDir $ \cw -> do
-                case cw of
-                    StartedChainweb cw' ->
-                        when (nid == 0) $ putMVar bootstrapPeerInfoVar
-                            $ view (chainwebPeer . peerResPeer . peerInfo) cw'
-                    RewoundToCut _ -> return ()
-                inner nid cw namespacedNodeRocksDb
+       withChainweb conf logger namespacedNodeRocksDb (pactDbDir </> show nid) backupTmpDir $ \cw -> do
+           case cw of
+               StartedChainweb cw' ->
+                   when (nid == 0) $ putMVar bootstrapPeerInfoVar
+                       $ view (chainwebPeer . peerResPeer . peerInfo) cw'
+               RewoundToCut _ -> return ()
+           inner nid cw namespacedNodeRocksDb
   where
     logger :: GenericLogger
-    logger = addLabel ("node", toText nid) $ genericLogger loglevel T.putStrLn
+    logger = addLabel ("node", toText nid) $ genericLogger loglevel write
 
     namespacedNodeRocksDb = rdb { _rocksDbNamespace = T.encodeUtf8 $ toText nid }
 
@@ -617,16 +617,23 @@ test
     -> (String -> IO ())
     -> IO ()
 test loglevel n seconds rdb pactDbDir step = do
+
     -- Count log messages and only print the first 60 messages
     let tastylog = step . T.unpack
     let logFun = T.putStrLn
         maxLogMsgs = 60
     var <- newMVar (0 :: Int)
     let countedLog msg = modifyMVar_ var $ \c -> force (succ c) <$
-            when (c < maxLogMsgs) (logFun msg)
+            if c < maxLogMsgs
+              then logFun msg
+              else when (c == maxLogMsgs) $
+                logFun $ "Got " <> sshow maxLogMsgs <> " log messages, not printing any addtional messages"
+
     stateVar <- newMVar emptyConsensusState
+
     runNodesForSeconds loglevel countedLog (multiConfig n) n seconds rdb pactDbDir
         (harvestConsensusState (genericLogger loglevel logFun) stateVar)
+
     consensusStateSummary <$> readMVar stateVar >>= \case
         Nothing -> assertFailure "chainweb didn't make any progress"
         Just stats -> do
@@ -641,20 +648,20 @@ test loglevel n seconds rdb pactDbDir step = do
                 , "avgEfficiency%" .= (realToFrac (bc $ round (_statAvgHeight stats)) * (100 :: Double) / int (_statBlockCount stats))
                 ]
 
-            (assertGe "number of blocks") (Actual $ _statBlockCount stats) (Expected $ _statBlockCount l)
-            (assertLe "max stored cut count")
+            assertGe "number of blocks" (Actual $ _statBlockCount stats) (Expected $ _statBlockCount l)
+            assertLe "max stored cut count"
                 (Actual $ _statMaxCutCount stats)
                 (Expected $ ceiling (avgBlockHeightAtCutHeight $ _statMaxHeight stats)
                     + int (diameterAtCutHeight (_statMaxHeight stats)))
-            (assertGe "maximum cut height") (Actual $ _statMaxHeight stats) (Expected $ _statMaxHeight l)
-            (assertGe "minimum cut height") (Actual $ _statMinHeight stats) (Expected $ _statMinHeight l)
-            (assertGe "median cut height") (Actual $ _statMedHeight stats) (Expected $ _statMedHeight l)
-            (assertGe "average cut height") (Actual $ _statAvgHeight stats) (Expected $ _statAvgHeight l)
-
-            (assertLe "maximum cut height") (Actual $ _statMaxHeight stats) (Expected $ _statMaxHeight u)
-            (assertLe "minimum cut height") (Actual $ _statMinHeight stats) (Expected $ _statMinHeight u)
-            (assertLe "median cut height") (Actual $ _statMedHeight stats) (Expected $ _statMedHeight u)
-            (assertLe "average cut height") (Actual $ _statAvgHeight stats) (Expected $ _statAvgHeight u)
+            assertGe "maximum cut height" (Actual $ _statMaxHeight stats) (Expected $ _statMaxHeight l)
+            assertGe "minimum cut height" (Actual $ _statMinHeight stats) (Expected $ _statMinHeight l)
+            assertGe "median cut height" (Actual $ _statMedHeight stats) (Expected $ _statMedHeight l)
+            assertGe "average cut height" (Actual $ _statAvgHeight stats) (Expected $ _statAvgHeight l)
+
+            assertLe "maximum cut height" (Actual $ _statMaxHeight stats) (Expected $ _statMaxHeight u)
+            assertLe "minimum cut height" (Actual $ _statMinHeight stats) (Expected $ _statMinHeight u)
+            assertLe "median cut height" (Actual $ _statMedHeight stats) (Expected $ _statMedHeight u)
+            assertLe "average cut height" (Actual $ _statAvgHeight stats) (Expected $ _statAvgHeight u)
 
   where
     l = lowerStats seconds

test/multinode/MultiNodeNetworkTests.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- |
@@ -14,42 +15,76 @@ module Main ( main ) where
 
 import Chainweb.Graph
 import Chainweb.Storage.Table.RocksDB
+import Chainweb.Test.MultiNode
 import Chainweb.Test.TestVersions
 import Chainweb.Test.Utils
+import Chainweb.Version (withVersion)
+import GHC.Conc (getNumProcessors)
+import Numeric.Natural
+import System.Environment
 import System.IO.Temp
+import System.IO.Unsafe (unsafePerformIO)
 import System.LogLevel
 import Test.Tasty
 import Test.Tasty.HUnit
-import qualified Chainweb.Test.MultiNode
-import Chainweb.Version (withVersion)
+import Text.Read (readMaybe)
 
 main :: IO ()
 main = defaultMain suite
 
 loglevel :: LogLevel
 loglevel = Warn
 
--- note that because these tests run in parallel they must all use distinct rocksdb and sqlite dirs.
+-- | NOTE: This is the number of /physical/ processors. This may be different
+-- from the number of CPU cores that are avaialble to the process, for instance
+-- in a containerized environment.
+--
+-- A more appropriate value can be obtained via querying cgroup settings (cf.
+-- the cgroup-rts-threads package for an implementation of this). However, for
+-- the purpose of these tests this should be rarly needed. Almost always one
+-- should run these tests with all available processors.
+--
+nodeCount :: Natural
+nodeCount = unsafePerformIO $ do
+    lookupEnv "CHAINWEB_MULTINODE_TESTS_NODE_COUNT" >>= \case
+        Just s -> case readMaybe s of
+            Just i -> return i
+            Nothing -> error $ "Invalid CHAINWEB_MULTINODE_TESTS_NODE_COUNT value: " <> s
+        Nothing -> fromIntegral <$> getNumProcessors
+{-# NOINLINE nodeCount #-}
+
+-- |
+--
+-- Note that because these tests run in parallel they must all use distinct
+-- rocksdb and sqlite dirs.
+--
+-- Note that it seems that these tsets don't mind that much running in parallel.
+-- However, they do mind if the number of nodes in each of these tests execeeds
+-- the number of available capabilities.
+--
 suite :: TestTree
 suite = independentSequentialTestGroup "MultiNodeNetworkTests"
-    [ testCaseSteps "ConsensusNetwork - TimedConsensus - 10 nodes - 30 seconds" $ \step ->
+    [ testCaseSteps ("ConsensusNetwork - TimedConsensus - " <> show nodeCount <> " nodes - 30 seconds") $ \step ->
         withTempRocksDb "multinode-tests-timedconsensus-petersen-twenty-rocks" $ \rdb ->
         withSystemTempDirectory "multinode-tests-timedconsensus-petersen-twenty-pact" $ \pactDbDir ->
         withVersion (timedConsensusVersion petersenChainGraph twentyChainGraph) $
-            Chainweb.Test.MultiNode.test loglevel 10 30 rdb pactDbDir step
-    , testCaseSteps "ConsensusNetwork - TimedConsensus - 10 nodes - 30 seconds - d4k4 upgrade" $ \step ->
+            Chainweb.Test.MultiNode.test loglevel nodeCount 30 rdb pactDbDir step
+
+    , testCaseSteps ("ConsensusNetwork - TimedConsensus - " <> show nodeCount <> " nodes - 60 seconds - d4k4 upgrade") $ \step ->
         withTempRocksDb "multinode-tests-timedconsensus-twenty-d4k4-rocks" $ \rdb ->
         withSystemTempDirectory "multinode-tests-timedconsensus-twenty-d4k4-pact" $ \pactDbDir ->
         withVersion (timedConsensusVersion twentyChainGraph d4k4ChainGraph) $
-            Chainweb.Test.MultiNode.test loglevel 4 100 rdb pactDbDir step
-    , testCaseSteps "ConsensusNetwork - InstantTimedCPM singleChainGraph - 10 nodes - 30 seconds" $ \step ->
+            Chainweb.Test.MultiNode.test loglevel nodeCount 30 rdb pactDbDir step
+
+    , testCaseSteps ("ConsensusNetwork - InstantTimedCPM singleChainGraph - " <> show nodeCount <> " nodes - 30 seconds") $ \step ->
         withTempRocksDb "multinode-tests-instantcpm-single-rocks" $ \rdb ->
         withSystemTempDirectory "multinode-tests-instantcpm-single-pact" $ \pactDbDir ->
         withVersion (instantCpmTestVersion singletonChainGraph) $
-            Chainweb.Test.MultiNode.test loglevel 10 30 rdb pactDbDir step
-    , testCaseSteps "Replay - InstantTimedCPM - 6 nodes" $ \step ->
+            Chainweb.Test.MultiNode.test loglevel nodeCount 30 rdb pactDbDir step
+
+    , testCaseSteps ("Replay - InstantTimedCPM - " <> show nodeCount <> " nodes") $ \step ->
         withTempRocksDb "replay-test-instantcpm-pair-rocks" $ \rdb ->
         withSystemTempDirectory "replay-test-instantcpm-pair-pact" $ \pactDbDir ->
         withVersion (instantCpmTestVersion pairChainGraph) $
-            Chainweb.Test.MultiNode.replayTest loglevel 6 rdb pactDbDir step
+            Chainweb.Test.MultiNode.replayTest loglevel nodeCount rdb pactDbDir step
     ]