From 5c9a270c086bbf33e91b738e47bcae4bfa8ad3b0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 21 Mar 2026 20:14:15 +0100
Subject: Debug logs for WebSocket connection

---
 main/Main.hs      | 10 +++++++++-
 main/WebSocket.hs | 24 +++++++++++++++++++++---
 2 files changed, 30 insertions(+), 4 deletions(-)

(limited to 'main')

diff --git a/main/Main.hs b/main/Main.hs
index 8dee414..c24e471 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -70,6 +70,7 @@ data Options = Options
     , optChatroomAutoSubscribe :: Maybe Int
     , optDmBotEcho :: Maybe Text
     , optWebSocketServer :: Maybe Int
+    , optWebSocketDebugLog :: Bool
     , optShowHelp :: Bool
     , optShowVersion :: Bool
     }
@@ -95,6 +96,7 @@ defaultOptions = Options
     , optChatroomAutoSubscribe = Nothing
     , optDmBotEcho = Nothing
     , optWebSocketServer = Nothing
+    , optWebSocketDebugLog = False
     , optShowHelp = False
     , optShowVersion = False
     }
@@ -209,6 +211,9 @@ debugOptions =
     [ Option [] [ "discovery-debug-log" ]
         (NoArg (serviceAttr $ \attrs -> return attrs { discoveryDebugLog = True }))
         ""
+    , Option [] [ "websocket-debug-log" ]
+        (NoArg (\opts -> return opts { optWebSocketDebugLog = True }))
+        ""
     ]
   where
     updateService :: (Service s, Monad m, Typeable m) => (ServiceAttributes s -> m (ServiceAttributes s)) -> SomeService -> m SomeService
@@ -460,7 +465,10 @@ interactiveLoop st opts = withTerminal commandCompletion $ \term -> do
             map soptService $ filter soptEnabled $ optServices opts
 
     case optWebSocketServer opts of
-        Just port -> startWebsocketServer server "::" port (extPrintLn . plainText . T.pack)
+        Just port -> startWebsocketServer server (extPrintLn . plainText . T.pack) defaultWebSocketOptions
+            { wsPort = port
+            , wsDebugLog = optWebSocketDebugLog opts
+            }
         Nothing -> return ()
 
     void $ liftIO $ forkIO $ void $ forever $ do
diff --git a/main/WebSocket.hs b/main/WebSocket.hs
index 48b4483..41ae027 100644
--- a/main/WebSocket.hs
+++ b/main/WebSocket.hs
@@ -1,5 +1,6 @@
 module WebSocket (
     WebSocketAddress(..),
+    WebSocketOptions(..), defaultWebSocketOptions,
     startWebsocketServer,
 ) where
 
@@ -34,10 +35,27 @@ instance PeerAddressType WebSocketAddress where
             | Just WS.ConnectionClosed <- fromException e -> return ()
             | otherwise -> throwIO e
 
-startWebsocketServer :: Server -> String -> Int -> (String -> IO ()) -> IO ()
-startWebsocketServer server addr port logd = do
+
+data WebSocketOptions = WebSocketOptions
+    { wsAddress :: String
+    , wsPort :: Int
+    , wsDebugLog :: Bool
+    }
+
+defaultWebSocketOptions :: WebSocketOptions
+defaultWebSocketOptions = WebSocketOptions
+    { wsAddress = "::"
+    , wsPort = 80
+    , wsDebugLog = False
+    }
+
+
+startWebsocketServer :: Server -> (String -> IO ()) -> WebSocketOptions -> IO ()
+startWebsocketServer server logd WebSocketOptions {..} = do
     void $ forkIO $ do
-        WS.runServer addr port $ \pending -> do
+        WS.runServer wsAddress wsPort $ \pending -> do
+            when wsDebugLog $ do
+                logd $ "WebSocket request: " <> show (WS.pendingRequest pending)
             conn <- WS.acceptRequest pending
             u <- newUnique
             let paddr = WebSocketAddress u conn
-- 
cgit v1.2.3