refactoring(logging): add log_file and log_config to Toml config

Furthermore, the env var we used to override (in some parts) the logging
level from `LOG_LEVEL`  to `GGTX_LOG_LEVEL`, to avoid the env var
`LOG_LEVEL` clashing with some other service.

This will eventually allow us to properly override the logging level in
the tests, silencing non interesting stuff.

bin/gargantext-cli/CLI/Ini.hs

@@ -19,17 +19,17 @@ Import a corpus binary.
 module CLI.Ini where
 
 import CLI.Types
-import Control.Monad.Logger (LogLevel(LevelDebug))
-import Data.Text qualified as T
-import Data.Text.IO qualified as T (writeFile)
 import Database.PostgreSQL.Simple qualified as PGS
-import Gargantext.Core.Config qualified as Config
+import Data.Text.IO qualified as T (writeFile)
+import Data.Text qualified as T
 import Gargantext.Core.Config.Ini.Ini qualified as Ini
 import Gargantext.Core.Config.Ini.Mail qualified as IniMail
 import Gargantext.Core.Config.Ini.NLP qualified as IniNLP
+import Gargantext.Core.Config qualified as Config
 import Gargantext.Core.Config.Types qualified as CTypes
 import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..))
 import Gargantext.Prelude
+import Gargantext.System.Logging (LogLevel(..))
 import Options.Applicative
 import Servant.Client.Core (parseBaseUrl)
 import Toml qualified
@@ -87,7 +87,10 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
                                                   , _wsDefaultVisibilityTimeout = 1
                                                   , _wsDefaultDelay = 0
                                                   , _wsDatabase = connInfo { PGS.connectDatabase = "pgmq"} }
-                    , _gc_log_level = LevelDebug
+                    , _gc_logging = Config.LogConfig {
+                        _lc_log_level = INFO
+                      , _lc_log_file = Nothing
+                      }
                     }
   where
     _ac_scrapyd_url =

gargantext-settings.toml_toModify

@@ -102,7 +102,7 @@ pass = PASSWORD_TO_CHANGE
 
 [logs]
 log_file = "/var/log/gargantext/backend.log"
-log_level = "LevelDebug"
+log_level = "info"
 log_formatter = "verbose"
 
 

gargantext.cabal

@@ -694,7 +694,6 @@ executable gargantext
     , gargantext-prelude
     , haskell-bee
     , MonadRandom ^>= 0.6
-    , monad-logger ^>= 0.3.36
     , optparse-applicative
     , postgresql-simple >= 0.6.4 && <= 0.7.0.0
     , servant >= 0.20.1 && < 0.21

hie.yaml

@@ -4,61 +4,61 @@ cradle:
       component: "lib:gargantext"
 
     - path: "./bin/gargantext-cli/Main.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Admin.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/FileDiff.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/FilterTermsAndCooc.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Import.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Ini.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Init.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Invitations.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/ObfuscateDB.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Parsers.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Phylo.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Phylo/Common.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Phylo/Profile.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Server/Routes.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Types.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/CLI/Upgrade.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-cli/Paths_gargantext.hs"
-      component: "gargantext:exe:gargantext-cli"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-server/Main.hs"
-      component: "gargantext:exe:gargantext-server"
+      component: "gargantext:exe:gargantext"
 
     - path: "./bin/gargantext-server/Paths_gargantext.hs"
-      component: "gargantext:exe:gargantext-server"
+      component: "gargantext:exe:gargantext"
 
     - path: "./test"
       component: "gargantext:test:garg-test-tasty"

src/Gargantext/API.hs

@@ -48,14 +48,14 @@ import Gargantext.API.Middleware (logStdoutDevSanitised)
 import Gargantext.API.Routes.Named (API)
 import Gargantext.API.Routes.Named.EKG (EkgAPI)
 import Gargantext.API.Server.Named (server)
-import Gargantext.Core.Config (gc_notifications_config, gc_frontend_config)
+import Gargantext.Core.Config
 import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, MicroServicesProxyStatus(..), NotificationsConfig(..), PortNumber, SettingsFile(..), corsAllowedOrigins, fc_appPort, fc_cors, fc_cookie_settings, microServicesProxyStatus)
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.Notifications (withNotifications)
 import Gargantext.Database.Prelude qualified as DB
 import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
 import Gargantext.Prelude hiding (putStrLn, to)
-import Gargantext.System.Logging (withLoggerIO)
+import Gargantext.System.Logging (withLoggerIO, renderLogLevel)
 import Network.HTTP.Types hiding (Query)
 import Network.Wai (Middleware, Request, requestHeaders)
 import Network.Wai.Handler.Warp hiding (defaultSettings)
@@ -80,7 +80,7 @@ startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerIO mode $ \
     let fc = env ^. env_config . gc_frontend_config
     let proxyStatus = microServicesProxyStatus fc
     runDbCheck env
-    portRouteInfo nc port proxyStatus
+    startupInfo config port proxyStatus
     app <- makeApp env
     mid <- makeGargMiddleware (fc ^. fc_cors) mode
     periodicActions <- schedulePeriodicActions env
@@ -106,11 +106,12 @@ startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerIO mode $ \
             Left err -> panicTrace $ "Unexpected exception:" <> show err
         oneHour = Clock.fromNanoSecs 3600_000_000_000
 
-portRouteInfo :: NotificationsConfig -> PortNumber -> MicroServicesProxyStatus -> IO ()
-portRouteInfo nc mainPort proxyStatus = do
+startupInfo :: GargConfig -> PortNumber -> MicroServicesProxyStatus -> IO ()
+startupInfo config mainPort proxyStatus = do
   putStrLn   "=========================================================================================================="
-  putStrLn   " GarganText Main Routes"
+  putStrLn   " GarganText Server"
   putStrLn   "=========================================================================================================="
+  putStrLn $ " - Log Level ...............................: " <> renderLogLevel ll
   putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece mainPort <> "/index.html"
   putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece mainPort <> "/swagger-ui"
   putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece mainPort <> "/gql"
@@ -121,6 +122,8 @@ portRouteInfo nc mainPort proxyStatus = do
   putStrLn $ " - WebSocket address........................: " <> "ws://localhost:" <> toUrlPiece mainPort <> "/ws"
   putStrLn   "=========================================================================================================="
   where
+    nc = config ^. gc_notifications_config
+    ll = config ^. gc_logging . lc_log_level
     renderProxyStatus = case proxyStatus of
       PXY_disabled ->
         " - Microservices proxy .....................: DISABLED (enable in gargantext-settings.toml)"

src/Gargantext/API/Admin/Settings.hs

@@ -62,7 +62,7 @@ settingsFromEnvironment =
     Settings <$> (encodeUtf8 <$> reqSetting "ALLOWED_ORIGIN")
              <*> (encodeUtf8 <$> reqSetting "ALLOWED_HOST")
              <*> optSetting "PORT" 3000
-             <*> (parseLogLevel <$> optSetting "LOG_LEVEL" "warn")
+             <*> (parseLogLevel <$> optSetting "GGTX_LOG_LEVEL" "warn")
              <*> reqSetting "DB_SERVER"
              <*> (parseJwk <$> reqSetting "JWT_SECRET")
              <*> optSetting "SEND_EMAIL" SendEmailViaAws

src/Gargantext/API/Worker.hs

@@ -36,7 +36,7 @@ serveWorkerAPI f = WorkerAPI { workerAPIPost }
   where
     workerAPIPost i = do
       let job = f i
-      logM DDEBUG $ "[serveWorkerAPI] sending job " <> show job
+      logM DEBUG $ "[serveWorkerAPI] sending job " <> show job
       mId <- sendJob job
       pure $ JobInfo { _ji_message_id = mId
                      , _ji_mNode_id = getWorkerMNodeId job }

src/Gargantext/Core/Config.hs

@@ -12,10 +12,12 @@ Configuration for the gargantext server
 -}
 
 {-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE LambdaCase          #-}
 
 module Gargantext.Core.Config (
     -- * Types
     GargConfig(..)
+  , LogConfig(..)
 
     -- * Lenses
   , gc_datafilepath
@@ -29,7 +31,9 @@ module Gargantext.Core.Config (
   , gc_secrets
   , gc_apis
   , gc_worker
-  , gc_log_level
+  , gc_logging
+  , lc_log_level
+  , lc_log_file
 
   , mkProxyUrl
 
@@ -39,24 +43,43 @@ module Gargantext.Core.Config (
   ) where
 
 import Control.Lens (Getter)
-import Control.Monad.Logger (LogLevel(LevelDebug))
-import Data.Text as T
+import Gargantext.System.Logging (LogLevel, parseLogLevel)
 import Database.PostgreSQL.Simple qualified as PSQL
+import Data.Text as T
 import Gargantext.Core.Config.Mail (MailConfig)
 import Gargantext.Core.Config.NLP (NLPConfig)
-import Gargantext.Core.Config.Worker (WorkerSettings)
 import Gargantext.Core.Config.Types
+import Gargantext.Core.Config.Worker (WorkerSettings)
 import Gargantext.Prelude
 import Network.HTTP.Client qualified as HTTP
 import Servant.Auth.Server (JWTSettings)
 import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl)
 import Toml.Schema
+import Toml.Schema.FromValue (typeError)
 
 
 -- | strip a given character from end of string
 -- stripRight :: Char -> T.Text -> T.Text
 -- stripRight c s = if T.last s == c then stripRight c (T.take (T.length s - 1) s) else s
 
+data LogConfig = LogConfig
+  { _lc_log_file  :: Maybe FilePath
+  , _lc_log_level :: !LogLevel
+  } deriving Show
+
+instance FromValue LogConfig where
+  fromValue = parseTableFromValue $ do
+    _lc_log_file  <- optKey "log_file"
+    _lc_log_level <- reqKeyOf "log_level" parse_log_level
+    pure LogConfig{..}
+
+parse_log_level :: Value' l -> Matcher l LogLevel
+parse_log_level = \case
+  Text' a txt -> case parseLogLevel txt of
+    Left err  -> typeError (T.unpack err) (Text' a txt)
+    Right ll  -> pure ll
+  xs          -> typeError "parse_log_level" xs
+
 -- Non-strict data so that we can use it in tests
 data GargConfig = GargConfig { _gc_datafilepath         :: ~FilePath
                              -- , _gc_repofilepath      :: ~FilePath
@@ -70,12 +93,10 @@ data GargConfig = GargConfig { _gc_datafilepath         :: ~FilePath
                              , _gc_secrets              :: ~SecretsConfig
                              , _gc_apis                 :: ~APIsConfig
                              , _gc_worker               :: ~WorkerSettings
-                             , _gc_log_level            :: ~LogLevel
+                             , _gc_logging              :: ~LogConfig
                              }
   deriving (Generic, Show)
 
-makeLenses ''GargConfig
-
 instance FromValue GargConfig where
   fromValue = parseTableFromValue $ do
     _gc_frontend_config <- reqKey "frontend"
@@ -89,7 +110,7 @@ instance FromValue GargConfig where
     _gc_apis <- reqKey "apis"
     _gc_notifications_config <- reqKey "notifications"
     _gc_worker <- reqKey "worker"
-    let _gc_log_level = LevelDebug
+    _gc_logging <- reqKey "logs"
     return $ GargConfig { _gc_datafilepath
                         , _gc_jobs
                         , _gc_apis
@@ -101,7 +122,7 @@ instance FromValue GargConfig where
                         , _gc_frames
                         , _gc_secrets
                         , _gc_worker
-                        , _gc_log_level }
+                        , _gc_logging }
 instance ToValue GargConfig where
   toValue = defaultTableToValue
 instance ToTable GargConfig where
@@ -139,3 +160,11 @@ class HasJWTSettings env where
 
 class HasManager env where
   gargHttpManager :: Getter env HTTP.Manager
+
+--
+-- Lenses
+--
+
+makeLenses ''LogConfig
+makeLenses ''GargConfig
+

src/Gargantext/Core/Notifications/CentralExchange.hs

@@ -50,10 +50,10 @@ gServer (NotificationsConfig { .. }) = do
   withSocket Pull $ \s -> do
     withSocket Push $ \s_dispatcher -> do
       withLogger () $ \ioLogger -> do
-        logMsg ioLogger DDEBUG $ "[central_exchange] binding to " <> T.unpack _nc_central_exchange_bind
+        logMsg ioLogger DEBUG $ "[central_exchange] binding to " <> T.unpack _nc_central_exchange_bind
       _ <- bind s $ T.unpack _nc_central_exchange_bind
       withLogger () $ \ioLogger -> do
-        logMsg ioLogger DDEBUG $ "[central_exchange] connecting to " <> T.unpack _nc_dispatcher_bind
+        logMsg ioLogger DEBUG $ "[central_exchange] connecting to " <> T.unpack _nc_dispatcher_bind
       _ <- connect s_dispatcher $ T.unpack _nc_dispatcher_connect
 
       tChan <- TChan.newTChanIO
@@ -67,7 +67,7 @@ gServer (NotificationsConfig { .. }) = do
           forever $ do
             -- putText "[central_exchange] receiving"
             r <- recv s
-            logMsg ioLogger DDEBUG $ "[central_exchange] received: " <> show r
+            logMsg ioLogger DEBUG $ "[central_exchange] received: " <> show r
             -- C.putStrLn $ "[central_exchange] " <> r
             atomically $ TChan.writeTChan tChan r
   where
@@ -111,7 +111,7 @@ notify (NotificationsConfig { _nc_central_exchange_connect }) ceMessage = do
       _ <- connect s $ T.unpack _nc_central_exchange_connect
       let str = Aeson.encode ceMessage
       withLogger () $ \ioLogger ->
-        logMsg ioLogger DDEBUG $ "[central_exchange] sending: " <> (T.unpack $ TE.decodeUtf8 $ BSL.toStrict str)
+        logMsg ioLogger DEBUG $ "[central_exchange] sending: " <> (T.unpack $ TE.decodeUtf8 $ BSL.toStrict str)
       -- err <- sendNonblocking s $ BSL.toStrict str
       -- putText $ "[notify] err: " <> show err
       void $ timeout 100_000 $ send s $ BSL.toStrict str

src/Gargantext/Core/Notifications/Dispatcher.hs

@@ -71,7 +71,7 @@ dispatcherListener :: NotificationsConfig -> SSet.Set Subscription -> IO ()
 dispatcherListener (NotificationsConfig { _nc_dispatcher_bind }) subscriptions = do
   withSocket Pull $ \s -> do
     withLogger () $ \ioLogger -> do
-      logMsg ioLogger DDEBUG $ "[dispatcherListener] binding to " <> T.unpack _nc_dispatcher_bind
+      logMsg ioLogger DEBUG $ "[dispatcherListener] binding to " <> T.unpack _nc_dispatcher_bind
     _ <- bind s $ T.unpack _nc_dispatcher_bind
 
     tChan <- TChan.newTChanIO
@@ -102,7 +102,7 @@ dispatcherListener (NotificationsConfig { _nc_dispatcher_bind }) subscriptions =
               logMsg ioL DEBUG "[dispatcher_listener] unknown message from central exchange"
           Just ceMessage -> do
             withLogger () $ \ioL ->
-              logMsg ioL DDEBUG $ "[dispatcher_listener] received " <> show ceMessage
+              logMsg ioL DEBUG $ "[dispatcher_listener] received " <> show ceMessage
             -- subs <- atomically $ readTVar subscriptions
             filteredSubs <- atomically $ do
               let subs' = UnfoldlM.filter (pure . ceMessageSubPred ceMessage) $ SSet.unfoldlM subscriptions
@@ -164,7 +164,7 @@ sendNotification throttleTChan ceMessage sub = do
 sendDataMessageThrottled :: (WS.Connection, WS.DataMessage) -> IO ()
 sendDataMessageThrottled (conn, msg) = do
   withLogger () $ \ioL ->
-    logMsg ioL DDEBUG $ "[sendDataMessageThrottled] dispatching notification: " <> show msg
+    logMsg ioL DEBUG $ "[sendDataMessageThrottled] dispatching notification: " <> show msg
   WS.sendDataMessage conn msg
 
 

src/Gargantext/Core/Worker/Env.hs

@@ -138,7 +138,7 @@ instance CET.HasCentralExchangeNotification WorkerEnv where
     c <- asks (view $ to _w_env_config)
     liftBase $ do
       withLogger () $ \ioL ->
-        logMsg ioL DDEBUG $ "[ce_notify]: " <> show (_gc_notifications_config c) <> " :: " <> show m
+        logMsg ioL DEBUG $ "[ce_notify]: " <> show (_gc_notifications_config c) <> " :: " <> show m
       CE.notify (_gc_notifications_config c) m
 
 ---------

src/Gargantext/System/Logging.hs

 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies    #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Gargantext.System.Logging (
     LogLevel(..)
   , HasLogger(..)
   , MonadLogger(..)
+  , parseLogLevel
+  , renderLogLevel
+  , prop_loglevel_roundtrip
   , logM
   , logLocM
   , logLoc
@@ -28,26 +32,35 @@ import Text.Read (readMaybe)
 
 
 data LogLevel =
-  -- | Detailed debug messages
-  DDEBUG
   -- | Debug messages
-  | DEBUG
+    DEBUG
   -- | Information
   | INFO
   -- | Normal runtime conditions
-  | NOTICE
-  -- | General Warnings
   | WARNING
   -- | General Errors
   | ERROR
-  -- | Severe situations
-  | CRITICAL
-  -- | Take immediate action
-  | ALERT
-  -- | System is unusable
-  | EMERGENCY
   deriving (Show, Eq, Ord, Enum, Bounded, Read)
 
+renderLogLevel :: LogLevel -> T.Text
+renderLogLevel = \case
+  DEBUG   -> "debug"
+  INFO    -> "info"
+  WARNING -> "warning"
+  ERROR   -> "error"
+
+parseLogLevel :: T.Text -> Either T.Text LogLevel
+parseLogLevel = \case
+  "debug"   -> Right DEBUG
+  "info"    -> Right INFO
+  "warning" -> Right WARNING
+  "warn"    -> Right WARNING
+  "error"   -> Right ERROR
+  xs -> Left ("Invalid log level found: " <> xs)
+
+prop_loglevel_roundtrip :: LogLevel -> Bool
+prop_loglevel_roundtrip ll = (parseLogLevel . renderLogLevel $ ll) == Right ll
+
 -- | This is a barebore logging interface which we
 -- can extend to plug a proper logging library, without
 -- the details of the logger cropping up everywhere in
@@ -132,7 +145,7 @@ instance HasLogger IO where
   type instance LogInitParams IO = ()
   type instance LogPayload IO    = String
   initLogger () = do
-    mLvl <- liftIO $ lookupEnv "LOG_LEVEL"
+    mLvl <- liftIO $ lookupEnv "GGTX_LOG_LEVEL"
     let lvl = case mLvl of
           Nothing      -> INFO
           Just s       ->

test-data/test_config.toml

@@ -52,6 +52,10 @@ user = "gargantua"
 pass = "gargantua_test"
 name = "gargandb_test"
 
+[logs]
+log_file = "/var/log/gargantext/backend.log"
+log_level = "warn"
+
 [mail]
 port = 25
 host = "localhost"