diff options
Diffstat (limited to 'main')
| -rw-r--r-- | main/Main.hs | 10 | ||||
| -rw-r--r-- | main/WebSocket.hs | 24 |
2 files changed, 30 insertions, 4 deletions
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 |