diff --git a/forest-cabin/app/Main.hs b/forest-cabin/app/Main.hs index 50e97b9..82c4a76 100644 --- a/forest-cabin/app/Main.hs +++ b/forest-cabin/app/Main.hs @@ -7,23 +7,55 @@ import Control.Concurrent.STM import Lens.Micro import Lens.Micro.TH import qualified Network.WebSockets as WS +import Options.Applicative import Forest.Node import Forest.Server.Branch.SharedEdit import Forest.Server.Schema import Forest.Server.TreeApp -{- Websocket server stuff -} +{- Command line options -} -pingDelay :: Int -pingDelay = 10 +data ServerOptions = ServerOptions + { serverPingDelay :: Int + , serverHost :: String + , serverPort :: Int + } -pongDelay :: Int -pongDelay = 3 * pingDelay +parser :: Parser ServerOptions +parser = ServerOptions + <$> option auto + ( long "ping-delay" + <> help "How many seconds to wait between each ping sent to the client" + <> value 10 + <> showDefault + <> metavar "SECONDS" + ) + <*> strOption + ( short 'h' + <> long "host" + <> help "The server's host" + <> value (WS.serverHost WS.defaultServerOptions) + <> showDefault + <> metavar "HOST" + ) + <*> option auto + ( short 'p' + <> long "port" + <> help "The port to listen for websocket connections on" + <> value (WS.serverPort WS.defaultServerOptions) + <> showDefault + <> metavar "PORT" + ) -options :: WS.ServerOptions -options = WS.defaultServerOptions - { WS.serverRequirePong = Just pongDelay +serverOptionsParserInfo :: ParserInfo ServerOptions +serverOptionsParserInfo = info (helper <*> parser) fullDesc + +wsOptions :: ServerOptions -> WS.ServerOptions +wsOptions o = WS.defaultServerOptions + { WS.serverHost = serverHost o + , WS.serverPort = serverPort o + , WS.serverRequirePong = Just $ serverPingDelay o * 2 } {- The actual app -} @@ -65,6 +97,8 @@ constructor broadcastChan seg cont = do main :: IO () main = do + opts <- execParser serverOptionsParserInfo + putStrLn "Preparing server" broadcastChan <- atomically newBroadcastTChan let onEditChange = atomically $ writeTChan broadcastChan UpdateSharedEdit @@ -76,4 +110,5 @@ main = do } putStrLn "Starting server" - WS.runServerWithOptions options $ runTreeApp pingDelay app + WS.runServerWithOptions (wsOptions opts) $ + runTreeApp (serverPingDelay opts) app diff --git a/forest-cabin/forest-cabin.cabal b/forest-cabin/forest-cabin.cabal index 6b40d14..4cd34f2 100644 --- a/forest-cabin/forest-cabin.cabal +++ b/forest-cabin/forest-cabin.cabal @@ -35,6 +35,7 @@ library , forest-server , microlens , microlens-th + , optparse-applicative , stm , websockets default-language: Haskell2010 @@ -53,6 +54,7 @@ executable forest-cabin , forest-server , microlens , microlens-th + , optparse-applicative , stm , websockets default-language: Haskell2010 diff --git a/forest-cabin/package.yaml b/forest-cabin/package.yaml index 143b8dc..6e7ebe9 100644 --- a/forest-cabin/package.yaml +++ b/forest-cabin/package.yaml @@ -17,6 +17,7 @@ dependencies: - forest-server - microlens - microlens-th + - optparse-applicative - stm - websockets