diff options
| author | stuebinm | 2024-05-15 01:04:32 +0200 |
|---|---|---|
| committer | stuebinm | 2024-05-15 01:09:13 +0200 |
| commit | 59670bdb6f0a3bba898274eadf47707e93bea195 (patch) | |
| tree | b0f8c4e7a402a587366b0fdf57c78d8f27e030a4 | |
| parent | 1e04f049b101d8250b8964dd0b465e703d03a4c2 (diff) | |
config: add a debug mode option
this is meant to be false by default, and otherwise relaxes requirements
on e.g. incoming pings, which are inconvenient when testing by hand.
| -rw-r--r-- | lib/Config.hs | 2 | ||||
| -rw-r--r-- | lib/Server.hs | 9 |
2 files changed, 8 insertions, 3 deletions
diff --git a/lib/Config.hs b/lib/Config.hs index 94fdd28..4aa62fc 100644 --- a/lib/Config.hs +++ b/lib/Config.hs @@ -24,6 +24,7 @@ data ServerConfig = ServerConfig , serverConfigGtfs :: FilePath , serverConfigAssets :: FilePath , serverConfigZoneinfoPath :: FilePath + , serverConfigDebugMode :: Bool , serverConfigLogin :: UffdConfig , serverConfigLogging :: LoggingConfig } deriving (Generic) @@ -43,6 +44,7 @@ instance DefaultConfig ServerConfig where , serverConfigGtfs = "./gtfs.zip" , serverConfigAssets = "./assets" , serverConfigZoneinfoPath = "/etc/zoneinfo/" + , serverConfigDebugMode = False , serverConfigLogin = configDef , serverConfigLogging = configDef } diff --git a/lib/Server.hs b/lib/Server.hs index 055e440..30141af 100644 --- a/lib/Server.hs +++ b/lib/Server.hs @@ -8,9 +8,9 @@ import API (API, CompleteAPI, Metrics (..)) import Conduit (ResourceT) import Config (LoggingConfig, ServerConfig (..)) import Control.Concurrent.STM (newTVarIO) -import Control.Monad.Extra (forM) +import Control.Monad.Extra (forM, when) import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Logger (MonadLogger) +import Control.Monad.Logger (MonadLogger, logWarnN) import Control.Monad.Reader (ReaderT) import Data.ByteString.Lazy (toStrict) import Data.Functor ((<&>)) @@ -45,13 +45,16 @@ import Server.GTFS_RT (gtfsRealtimeServer) import Server.Ingest (handleTrackerRegister, handleTrainPing, handleWS) import Server.Subscribe (handleSubscribe) -import Server.Util (Service, runService) +import Server.Util (Service, runService, runLogging) import System.IO.Unsafe (unsafePerformIO) import Yesod (toWaiAppPlain) application :: GTFS.GTFS -> Pool SqlBackend -> ServerConfig -> IO Application application gtfs dbpool settings = do + when (serverConfigDebugMode settings) $ + runLogging (serverConfigLogging settings) $ + logWarnN "warning: tracktrain running in debug mode" doMigration dbpool metrics <- Metrics <$> register (gauge (Info "ws_connections" "Number of WS Connections")) |