aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorstuebinm2024-05-15 01:04:32 +0200
committerstuebinm2024-05-15 01:09:13 +0200
commit59670bdb6f0a3bba898274eadf47707e93bea195 (patch)
treeb0f8c4e7a402a587366b0fdf57c78d8f27e030a4 /lib
parent1e04f049b101d8250b8964dd0b465e703d03a4c2 (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.
Diffstat (limited to 'lib')
-rw-r--r--lib/Config.hs2
-rw-r--r--lib/Server.hs9
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"))