diff --git a/trace-dispatcher/bench/trace-dispatcher-bench.hs b/trace-dispatcher/bench/trace-dispatcher-bench.hs index 98dee97d605..7ab9c3a4c24 100644 --- a/trace-dispatcher/bench/trace-dispatcher-bench.hs +++ b/trace-dispatcher/bench/trace-dispatcher-bench.hs @@ -10,7 +10,6 @@ import Cardano.Logging.Test.Tracer import Cardano.Logging.Test.Types import System.Remote.Monitoring (forkServer) -import Debug.Trace -- Can be run with: -- cabal bench trace-dispatcher-bench --benchmark-option='-o benchmark-trace.html' diff --git a/trace-dispatcher/test/Cardano/Logging/ForwardingStressTest/Script.hs b/trace-dispatcher/test/Cardano/Logging/ForwardingStressTest/Script.hs index 4f16d569095..4140065c4ed 100644 --- a/trace-dispatcher/test/Cardano/Logging/ForwardingStressTest/Script.hs +++ b/trace-dispatcher/test/Cardano/Logging/ForwardingStressTest/Script.hs @@ -37,6 +37,9 @@ import Cardano.Logging.Test.Messages import Cardano.Logging.Test.Types +import Debug.Trace + + data TestSetup a = TestSetup { tsTime :: !(a Double) @@ -111,7 +114,8 @@ runScriptForwarding :: -> Trace IO FormattedMessage -> IORef Int -> Property -runScriptForwarding TestSetup{..} fwdTracer stdoutTracer' accumulationCounter = do +runScriptForwarding ts@TestSetup{..} fwdTracer stdoutTracer' accumulationCounter = + trace ("Test setup " ++ show ts) $ do let generator :: Gen [Script] = vectorOf (runIdentity tsThreads) $ case runIdentity tsMessages of Nothing -> scale (* 1000) arbitrary @@ -127,14 +131,16 @@ runScriptForwarding TestSetup{..} fwdTracer stdoutTracer' accumulationCounter = severityForMessage privacyForMessage configureTracers simpleTestConfig docMessage [tr] - let scripts' = map (\ (Script sc) -> - Script (sort sc)) scripts - scripts'' = map (\ (Script sc) -> - Script (withMessageIds 0 sc)) scripts' - scripts''' = map (\ (Script sc) -> - Script $ map (withTimeFactor (runIdentity tsTime)) sc) scripts'' - scripts'''' = map (\ (Script sc) -> - Script $ filter (\(ScriptedMessage _ msg) -> namesForMessage msg /= ["Message2"]) sc) scripts''' + let scripts' = map (\ (Script sc) -> Script + $ filter (\(ScriptedMessage _ msg) -> + namesForMessage msg /= ["Message2"]) sc) scripts + scripts'' = map (\ (Script sc) -> Script (sort sc)) scripts' + scripts''' = zipWith (\ (Script sc) ind -> Script ( + withMessageIds (runIdentity tsThreads) ind sc)) scripts'' [0..] + scripts'''' = map (\ (Script sc) -> Script + $ map (withTimeFactor (runIdentity tsTime)) sc) scripts''' + + -- putStrLn ("runTest " ++ show scripts) children :: MVar [MVar (Either SomeException ())] <- newMVar [] mapM_ (\sc -> forkChild children (playIt sc tr 0.0)) scripts'''' @@ -150,7 +156,7 @@ runScriptForwarding TestSetup{..} fwdTracer stdoutTracer' accumulationCounter = let numMsg = sum (map (\ (Script sc) -> length sc) scripts'''') in if numMsg > 0 then do -- TODO mutiple files - contents <- readFile "/tmp/cardano-tracer-logs/tmp-tracersock@0/node.json" + contents <- readFile "/tmp/cardano-forwarder-test-logs/tmp-tracersock@0/node.json" let lineLength = length (lines contents) - 1 putStrLn $ "Line length " ++ show lineLength putStrLn $ "Msg length " ++ show numMsg @@ -198,12 +204,12 @@ playIt (Script (ScriptedMessage d1 m1 : rest)) tr d = do -- MessageId gives the id to start with. -- Returns a tuple with the messages with ids and -- the successor of the last used messageId -withMessageIds :: MessageID -> [ScriptedMessage] -> [ScriptedMessage] -withMessageIds mid sMsgs = go mid sMsgs [] +withMessageIds :: Int -> MessageID -> [ScriptedMessage] -> [ScriptedMessage] +withMessageIds numThreads mid sMsgs = go mid sMsgs [] where go _mid' [] acc = reverse acc go mid' (ScriptedMessage time msg : tl) acc = - go (mid' + 1) tl (ScriptedMessage time (setMessageID msg mid') : acc) + go (mid' + numThreads) tl (ScriptedMessage time (setMessageID msg mid') : acc) withTimeFactor :: Double -> ScriptedMessage -> ScriptedMessage withTimeFactor factor (ScriptedMessage time msg) = diff --git a/trace-dispatcher/test/Cardano/Logging/Test/Types.hs b/trace-dispatcher/test/Cardano/Logging/Test/Types.hs index 62695767383..aa377e066f8 100644 --- a/trace-dispatcher/test/Cardano/Logging/Test/Types.hs +++ b/trace-dispatcher/test/Cardano/Logging/Test/Types.hs @@ -39,7 +39,7 @@ instance LogFormatting Message where ] forMachine _dtal (Message3 mid d) = mconcat [ "kind" .= String "Message3" - , "mid" .= String (showT mid) + , "mid" .= String ("<" <> showT mid <> ">") , "workload" .= String (showT d) ] forHuman (Message1 mid i) = diff --git a/trace-dispatcher/test/cardano-tracer-config.yaml b/trace-dispatcher/test/cardano-tracer-config.yaml index d51531a033d..6fe7c52c48d 100644 --- a/trace-dispatcher/test/cardano-tracer-config.yaml +++ b/trace-dispatcher/test/cardano-tracer-config.yaml @@ -4,6 +4,6 @@ network: tag: AcceptAt contents: "/tmp/tracer.sock" logging: -- logRoot: "/tmp/cardano-tracer-logs" +- logRoot: "/tmp/cardano-forwarder-test-logs" logMode: FileMode logFormat: ForMachine diff --git a/trace-dispatcher/test/trace-dispatcher-test.hs b/trace-dispatcher/test/trace-dispatcher-test.hs index e8d0f95d36c..80c19484cb9 100644 --- a/trace-dispatcher/test/trace-dispatcher-test.hs +++ b/trace-dispatcher/test/trace-dispatcher-test.hs @@ -23,7 +23,7 @@ import Ouroboros.Network.NodeToClient (withIOManager) main :: IO () main = do ts <- getTestSetup - let logPath = "/tmp/cardano-tracer-logs" + let logPath = "/tmp/cardano-forwarder-test-logs" fe <- fileExist logPath when fe (removeDirectoryRecursive logPath)