diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-08-22 08:43:40 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-08-23 22:10:03 +0200 |
| commit | a3dc644a30796bf0ed2a19d6693aaec7c9374d4e (patch) | |
| tree | 88ac9a73095d3c4812cd910f39a60d110261ef31 /main/Test.hs | |
| parent | d969662c35fee0bebce8cae285750e0c8848713e (diff) | |
Test hooks to trace all received packet for given service
Diffstat (limited to 'main/Test.hs')
| -rw-r--r-- | main/Test.hs | 9 |
1 files changed, 8 insertions, 1 deletions
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 |