From a3dc644a30796bf0ed2a19d6693aaec7c9374d4e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 22 Aug 2026 08:43:40 +0200
Subject: Test hooks to trace all received packet for given service

---
 main/Test.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

(limited to 'main')

diff --git a/main/Test.hs b/main/Test.hs
index 84cce1a..da45846 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -675,9 +675,16 @@ cmdStartServer = do
             }
         ( sname, _ ) -> throwOtherError $ "unknown service `" <> T.unpack sname <> "'"
 
+    serviceTracers <- forM (map fst $ filter (("trace" `elem`) . snd) serviceNames) $ \case
+        sname -> throwOtherError $ "tracer not implemented for ‘" <> T.unpack sname <> "’"
+
+    let serverOptions' = serverOptions
+            { serverServicePacketTracers = serviceTracers
+            }
+
     let logPrint str = do BC.hPutStrLn stdout (BC.pack str)
                           hFlush stdout
-    rsServer <- liftIO $ startServer serverOptions h logPrint services
+    rsServer <- liftIO $ startServer serverOptions' h logPrint services
 
     rsPeerThread <- liftIO $ forkIO $ void $ forever $ do
         peer <- getNextPeerChange rsServer
-- 
cgit v1.2.3