From 33add1fb412a9af173c10f8cdd957c3638d4df7f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 13 Jul 2025 21:05:02 +0200
Subject: Server test log

---
 main/Test.hs | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

(limited to 'main/Test.hs')

diff --git a/main/Test.hs b/main/Test.hs
index c978a6a..b1c8f01 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -504,16 +504,18 @@ cmdStartServer = do
 
     let parseParams = \case
             (name : value : rest)
-                | name == "services" -> T.splitOn "," value
+                | name == "services" -> second ( map splitServiceParams (T.splitOn "," value) ++ ) (parseParams rest)
+            (name : rest)
+                | name == "test-log" -> first (\o -> o { serverTestLog = True }) (parseParams rest)
                 | otherwise -> parseParams rest
-            _ -> []
+            _ -> ( defaultServerOptions { serverErrorPrefix = "server-error-message " }, [] )
 
         splitServiceParams svc =
             case T.splitOn ":" svc of
                 name : params -> ( name, params )
                 _ -> ( svc, [] )
 
-    serviceNames <- map splitServiceParams . parseParams <$> asks tiParams
+    ( serverOptions, serviceNames ) <- parseParams <$> asks tiParams
 
     h <- getOrLoadHead
     rsPeers <- liftIO $ newMVar (1, [])
@@ -547,7 +549,9 @@ cmdStartServer = do
             }
         ( sname, _ ) -> throwOtherError $ "unknown service `" <> T.unpack sname <> "'"
 
-    rsServer <- liftIO $ startServer defaultServerOptions h (B.hPutStr stderr . (`BC.snoc` '\n') . BC.pack) services
+    let logPrint str = do BC.hPutStrLn stdout (BC.pack str)
+                          hFlush stdout
+    rsServer <- liftIO $ startServer serverOptions h logPrint services
 
     rsPeerThread <- liftIO $ forkIO $ void $ forever $ do
         peer <- getNextPeerChange rsServer
-- 
cgit v1.2.3