From 59670bdb6f0a3bba898274eadf47707e93bea195 Mon Sep 17 00:00:00 2001 From: stuebinm Date: Wed, 15 May 2024 01:04:32 +0200 Subject: 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. --- lib/Server.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lib/Server.hs') 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")) -- cgit v1.2.3