unify loggers

Before we were repeating the same code to initialise all the different
loggers. This commit introduces two stock loggers called `ioStdLogger`
and `monadicStdLogger` which can be reused many times.

It also allows the `GGTX_LOG_LEVEL` to take effect during `readConfig`,
so that the `startupInfo` would show up the correct information.

gargantext.cabal

@@ -311,6 +311,7 @@ library
       Gargantext.Orphans.Accelerate
       Gargantext.Orphans.OpenAPI
       Gargantext.System.Logging
+      Gargantext.System.Logging.Loggers
       Gargantext.System.Logging.Types
       Gargantext.Utils.Dict
       Gargantext.Utils.Jobs.Error

src/Gargantext/API.hs

@@ -70,29 +70,30 @@ import System.Cron.Schedule qualified as Cron
 
 -- | startGargantext takes as parameters port number and Toml file.
 startGargantext :: Mode -> PortNumber -> SettingsFile -> IO ()
-startGargantext mode port sf@(SettingsFile settingsFile) = withLoggerIO mode $ \logger -> do
+startGargantext mode port sf@(SettingsFile settingsFile) = do
   config <- readConfig sf <&> (gc_frontend_config . fc_appPort) .~ port
-  when (port /= config ^. gc_frontend_config . fc_appPort) $
-    panicTrace "TODO: conflicting settings of port"
-  withNotifications config $ \dispatcher -> do
-    env <- newEnv logger config dispatcher
-    let fc = env ^. env_config . gc_frontend_config
-    let proxyStatus = microServicesProxyStatus fc
-    runDbCheck env
-    startupInfo config port proxyStatus
-    app <- makeApp env
-    mid <- makeGargMiddleware (fc ^. fc_cors) mode
-    periodicActions <- schedulePeriodicActions env
-
-    let runServer = run port (mid app) `finally` stopGargantext periodicActions
-    case proxyStatus of
-      PXY_disabled
-        -> runServer -- the proxy is disabled, do not spawn the application
-      PXY_enabled proxyPort
-        -> do
-          proxyCache <- InMemory.newCache (Just oneHour)
-          let runProxy  = run proxyPort (mid (microServicesProxyApp proxyCache env))
-          Async.race_ runServer runProxy
+  withLoggerIO (config ^. gc_logging) $ \logger -> do
+    when (port /= config ^. gc_frontend_config . fc_appPort) $
+      panicTrace "TODO: conflicting settings of port"
+    withNotifications config $ \dispatcher -> do
+      env <- newEnv logger config dispatcher
+      let fc = env ^. env_config . gc_frontend_config
+      let proxyStatus = microServicesProxyStatus fc
+      runDbCheck env
+      startupInfo config port proxyStatus
+      app <- makeApp env
+      mid <- makeGargMiddleware (fc ^. fc_cors) mode
+      periodicActions <- schedulePeriodicActions env
+
+      let runServer = run port (mid app) `finally` stopGargantext periodicActions
+      case proxyStatus of
+        PXY_disabled
+          -> runServer -- the proxy is disabled, do not spawn the application
+        PXY_enabled proxyPort
+          -> do
+            proxyCache <- InMemory.newCache (Just oneHour)
+            let runProxy  = run proxyPort (mid (microServicesProxyApp proxyCache env))
+            Async.race_ runServer runProxy
 
   where runDbCheck env = do
           r <- runExceptT (runReaderT DB.dbCheck env) `catch`

src/Gargantext/API/Admin/EnvTypes.hs

@@ -38,12 +38,11 @@ module Gargantext.API.Admin.EnvTypes (
 import Control.Lens (to, view)
 import Data.List ((\\))
 import Data.Pool (Pool)
-import Data.Text qualified as T
 import Database.PostgreSQL.Simple (Connection)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Prelude (GargM, IsGargServer)
-import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..), HasManager(..), gc_logging, lc_log_level)
+import Gargantext.Core.Config
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
 import Gargantext.Core.NodeStory
@@ -58,6 +57,7 @@ import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
 import Network.HTTP.Client (Manager)
 import Servant.Auth.Server (JWTSettings)
 import System.Log.FastLogger qualified as FL
+import Gargantext.System.Logging.Loggers
 
 
 data Mode = Dev | Mock | Prod
@@ -139,21 +139,13 @@ instance MonadLogger (GargM DevEnv BackendInternalError) where
 
 instance HasLogger (GargM DevEnv BackendInternalError) where
   data instance Logger (GargM DevEnv BackendInternalError)  =
-    GargDevLogger {
-        dev_logger_mode    :: Mode
-      , dev_logger_set     :: FL.LoggerSet
-      }
-  type instance LogInitParams (GargM DevEnv BackendInternalError) = Mode
+    GargDevLogger { _GargDevLogger :: MonadicStdLogger FL.LogStr IO }
+  type instance LogInitParams (GargM DevEnv BackendInternalError) = LogConfig
   type instance LogPayload (GargM DevEnv BackendInternalError)    = FL.LogStr
-  initLogger                = \mode -> do
-    dev_logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
-    pure $ GargDevLogger mode dev_logger_set
-  destroyLogger             = \GargDevLogger{..}  -> liftIO $ FL.rmLoggerSet dev_logger_set
-  logMsg = \(GargDevLogger mode logger_set) lvl msg -> do
-    let pfx = "[" <> show lvl <> "] " :: Text
-    when (lvl `elem` (modeToLoggingLevels mode)) $
-      liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
-  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)
+  initLogger cfg = fmap GargDevLogger $ (liftIO $ monadicStdLogger cfg)
+  destroyLogger = liftIO . _msl_destroy . _GargDevLogger
+  logMsg (GargDevLogger ioLogger) lvl msg = liftIO $ _msl_log_msg ioLogger lvl msg
+  logTxt (GargDevLogger ioLogger) lvl msg = liftIO $ _msl_log_txt ioLogger lvl msg
 
 data DevEnv = DevEnv
   { _dev_env_config    :: !GargConfig
@@ -225,25 +217,14 @@ instance HasNLPServer DevEnv where
 instance IsGargServer Env BackendInternalError (GargM Env BackendInternalError)
 
 instance HasLogger (GargM Env BackendInternalError) where
-  data instance Logger (GargM Env BackendInternalError)  =
-    GargLogger {
-        logger_mode    :: Mode
-      , logger_set     :: FL.LoggerSet
-      }
-  type instance LogInitParams (GargM Env BackendInternalError) = Mode
+  newtype instance Logger (GargM Env BackendInternalError)  =
+    GargLogger { _GargLogger :: MonadicStdLogger FL.LogStr IO }
+  type instance LogInitParams (GargM Env BackendInternalError) = LogConfig
   type instance LogPayload (GargM Env BackendInternalError)    = FL.LogStr
-  initLogger mode = do
-    logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
-    pure $ GargLogger mode logger_set
-  destroyLogger (GargLogger{..}) = liftIO $ FL.rmLoggerSet logger_set
-  logMsg (GargLogger mode logger_set) lvl msg = do
-    cfg <- view hasConfig
-    let minLvl = cfg ^. gc_logging . lc_log_level
-    when (lvl >= minLvl) $ do
-      let pfx = "[" <> show lvl <> "] " :: Text
-      when (lvl `elem` (modeToLoggingLevels mode)) $
-        liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
-  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)
+  initLogger cfg = fmap GargLogger $ (liftIO $ monadicStdLogger cfg)
+  destroyLogger = liftIO . _msl_destroy . _GargLogger
+  logMsg (GargLogger ioLogger) lvl msg = liftIO $ _msl_log_msg ioLogger lvl msg
+  logTxt (GargLogger ioLogger) lvl msg = liftIO $ _msl_log_txt ioLogger lvl msg
 
 instance MonadLogger (GargM Env BackendInternalError) where
   getLogger = asks _env_logger

src/Gargantext/API/Dev.hs

@@ -16,11 +16,11 @@ import Control.Lens (view)
 import Control.Monad (fail)
 import Database.PostgreSQL.Simple qualified as PGS
 import Data.Pool (withResource)
-import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) )
+import Gargantext.API.Admin.EnvTypes ( DevEnv(..) )
 import Gargantext.API.Admin.Settings ( newPool )
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Prelude ( GargM )
-import Gargantext.Core.Config (_gc_database_config)
+import Gargantext.Core.Config (_gc_database_config, gc_logging)
 import Gargantext.Core.Config.Types (SettingsFile(..))
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
@@ -32,14 +32,14 @@ import Servant ( ServerError )
 
 -------------------------------------------------------------------
 withDevEnv :: SettingsFile -> (DevEnv -> IO a) -> IO a
-withDevEnv settingsFile k = withLoggerIO Dev $ \logger -> do
-  env <- newDevEnv logger
-  k env -- `finally` cleanEnv env
+withDevEnv settingsFile k = do
+  cfg <- readConfig settingsFile
+  withLoggerIO (cfg ^. gc_logging) $ \logger -> do
+    env <- newDevEnv logger cfg
+    k env -- `finally` cleanEnv env
 
   where
-    newDevEnv logger = do
-      cfg     <- readConfig         settingsFile
-      --nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
+    newDevEnv logger cfg = do
       pool    <- newPool (_gc_database_config cfg)
       nodeStory_env <- fromDBNodeStoryEnv pool
       manager <- newTlsManager

src/Gargantext/Core/Config/Utils.hs

@@ -16,37 +16,27 @@ module Gargantext.Core.Config.Utils (
 
 import Gargantext.Core.Config.Types (SettingsFile(..))
 import Gargantext.Prelude
--- import Network.URI (URI)
--- import Network.URI (parseURI)
 import Toml
-import Toml.Schema
+import Gargantext.Core.Config
+import System.Environment (lookupEnv)
+import Gargantext.System.Logging.Types (parseLogLevel)
+import qualified Data.Text as T
 
 
-readConfig :: FromValue a => SettingsFile -> IO a
+readConfig :: SettingsFile -> IO GargConfig
 readConfig (SettingsFile fp) = do
   c <- readFile fp
 
   case decode c of
     Failure err -> panicTrace ("Error reading TOML file: " <> show err)
-    Success _ r -> return r
-
-
--- _URI :: Toml.TomlBiMap URI Text
--- _URI = Toml.BiMap (Right . show) parseURI'
---   where
---     parseURI' :: Text -> Either Toml.TomlBiMapError URI
---     parseURI' t =
---       case parseURI (T.unpack t) of
---         Nothing -> Left $ Toml.ArbitraryError "Cannot parse URI"
---         Just u -> Right u
-
--- uriToml :: Toml.Key -> Toml.TomlCodec URI
--- uriToml = Toml.match (_URI >>> Toml._Text)
-
-
--- _Word16 :: Toml.TomlBiMap Word16 Toml.AnyValue
--- _Word16 = Toml._BoundedInteger >>> Toml._Integer
-
-
--- word16Toml :: Toml.Key -> Toml.TomlCodec Word16
--- word16Toml = Toml.match _Word16
+    Success _ r -> do
+      -- Ovverride the log level based on the GGTX_LOG_LEVEL (if set)
+      mLvl <- lookupEnv "GGTX_LOG_LEVEL"
+      case mLvl of
+        Nothing      -> pure r
+        Just s       ->
+          case parseLogLevel (T.pack s) of
+            Left err   -> do
+              putStrLn $ "unknown log level " <> s <> ": " <> T.unpack err <> " , ignoring GGTX_LOG_LEVEL"
+              pure r
+            Right lvl' -> pure $ r & gc_logging . lc_log_level .~ lvl'

src/Gargantext/Core/Worker/Env.hs

@@ -24,15 +24,13 @@ import Control.Lens.TH
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Maybe (fromJust)
 import Data.Pool qualified as Pool
-import Data.Text qualified as T
 import Database.PostgreSQL.Simple qualified as PSQL
-import Gargantext.API.Admin.EnvTypes (Mode(Dev), modeToLoggingLevels)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
 import Gargantext.API.Job (RemainingSteps(..), jobLogStart, jobLogProgress, jobLogFailures, jobLogComplete, addErrorEvent, jobLogFailTotal, jobLogFailTotalWithMessage, jobLogAddMore)
 import Gargantext.API.Prelude (GargM)
 import Gargantext.Core.Notifications.CentralExchange qualified as CE
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
-import Gargantext.Core.Config (GargConfig(..), HasConfig(..), gc_logging)
+import Gargantext.Core.Config (GargConfig(..), HasConfig(..), gc_logging, LogConfig)
 import Gargantext.Core.Config.Mail qualified as Mail
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.Config.Types (SettingsFile(..))
@@ -50,6 +48,7 @@ import Gargantext.Utils.Jobs.Monad ( MonadJobStatus(..), JobHandle )
 import GHC.IO.Exception (IOException(..), IOErrorType(OtherError))
 import Prelude qualified
 import System.Log.FastLogger qualified as FL
+import Gargantext.System.Logging.Loggers
 
 
 data WorkerEnv = WorkerEnv
@@ -70,13 +69,14 @@ data WorkerJobState = WorkerJobState
 
 
 withWorkerEnv :: SettingsFile -> (WorkerEnv -> IO a) -> IO a
-withWorkerEnv settingsFile k = withLoggerIO Dev $ \logger -> do
-  env <- newWorkerEnv logger
-  k env -- `finally` cleanEnv env
+withWorkerEnv settingsFile k = do
+  cfg <- readConfig settingsFile
+  withLoggerIO (cfg ^. gc_logging) $ \logger -> do
+    env <- newWorkerEnv logger cfg
+    k env -- `finally` cleanEnv env
 
   where
-    newWorkerEnv logger = do
-      cfg     <- readConfig         settingsFile
+    newWorkerEnv logger cfg = do
       --nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
       -- pool    <- newPool            $ _gc_database_config cfg
       let dbConfig = _gc_database_config cfg
@@ -97,22 +97,14 @@ instance HasConfig WorkerEnv where
   hasConfig = to _w_env_config
 
 instance HasLogger (GargM WorkerEnv IOException) where
-  data instance Logger (GargM WorkerEnv IOException)  =
-    GargWorkerLogger {
-        w_logger_mode    :: Mode
-      , w_logger_set     :: FL.LoggerSet
-      }
-  type instance LogInitParams (GargM WorkerEnv IOException) = Mode
+  newtype instance Logger (GargM WorkerEnv IOException)  =
+    GargWorkerLogger { _GargWorkerLogger :: MonadicStdLogger FL.LogStr IO }
+  type instance LogInitParams (GargM WorkerEnv IOException) = LogConfig
   type instance LogPayload (GargM WorkerEnv IOException)    = FL.LogStr
-  initLogger mode = do
-    w_logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
-    pure $ GargWorkerLogger mode w_logger_set
-  destroyLogger (GargWorkerLogger{..}) = liftIO $ FL.rmLoggerSet w_logger_set
-  logMsg (GargWorkerLogger mode logger_set) lvl msg = do
-    let pfx = "[" <> show lvl <> "] " :: Text
-    when (lvl `elem` (modeToLoggingLevels mode)) $
-      liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
-  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)
+  initLogger cfg = fmap GargWorkerLogger $ (liftIO $ monadicStdLogger cfg)
+  destroyLogger = liftIO . _msl_destroy . _GargWorkerLogger
+  logMsg (GargWorkerLogger ioLogger) lvl msg = liftIO $ _msl_log_msg ioLogger lvl msg
+  logTxt (GargWorkerLogger ioLogger) lvl msg = liftIO $ _msl_log_txt ioLogger lvl msg
 
 instance HasConnectionPool WorkerEnv where
   connPool = to _w_env_pool
@@ -182,29 +174,20 @@ newtype WorkerMonad a =
            , MonadFail )
 
 instance HasLogger WorkerMonad where
-  data instance Logger WorkerMonad =
-    WorkerMonadLogger {
-        wm_logger_mode    :: Mode
-      , wm_logger_set     :: FL.LoggerSet
-      }
-  type instance LogInitParams WorkerMonad = Mode
+  newtype instance Logger WorkerMonad =
+    WorkerMonadLogger { _WorkerMonadLogger :: MonadicStdLogger FL.LogStr IO }
+  type instance LogInitParams WorkerMonad = LogConfig
   type instance LogPayload WorkerMonad    = FL.LogStr
-  initLogger mode = do
-    wm_logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
-    pure $ WorkerMonadLogger mode wm_logger_set
-  destroyLogger (WorkerMonadLogger{..}) = liftIO $ FL.rmLoggerSet wm_logger_set
-  logMsg (WorkerMonadLogger mode logger_set) lvl msg = do
-    let pfx = "[" <> show lvl <> "] " :: Text
-    when (lvl `elem` (modeToLoggingLevels mode)) $
-      liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
-  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)
+  initLogger cfg = fmap WorkerMonadLogger $ (liftIO $ monadicStdLogger cfg)
+  destroyLogger = liftIO . _msl_destroy . _WorkerMonadLogger
+  logMsg (WorkerMonadLogger ioLogger) lvl msg = liftIO $ _msl_log_msg ioLogger lvl msg
+  logTxt (WorkerMonadLogger ioLogger) lvl msg = liftIO $ _msl_log_txt ioLogger lvl msg
 
 instance MonadLogger WorkerMonad where
   getLogger = do
     env <- ask
-    let (GargWorkerLogger { .. }) = _w_env_logger env
-    pure $ WorkerMonadLogger { wm_logger_mode = w_logger_mode
-                             , wm_logger_set = w_logger_set }
+    let (GargWorkerLogger lgr) = _w_env_logger env
+    pure $ WorkerMonadLogger lgr
 
 runWorkerMonad :: WorkerEnv -> WorkerMonad a -> IO a
 runWorkerMonad env m = do

src/Gargantext/System/Logging.hs

@@ -13,17 +13,15 @@ module Gargantext.System.Logging (
   ) where
 
 import Gargantext.System.Logging.Types
+import Gargantext.System.Logging.Loggers
 import Control.Exception.Safe (MonadMask, bracket)
-import Control.Monad (when)
 import Gargantext.Core.Config (LogConfig(..))
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Control
 import Data.Text qualified as T
-import Data.Time.Clock (getCurrentTime)
 import Language.Haskell.TH hiding (Type)
 import Language.Haskell.TH.Syntax qualified as TH
 import Prelude
-import System.Environment (lookupEnv)
 
 
 -- | A variant of 'logTxt' that doesn't require passing an explicit 'Logger'.
@@ -86,25 +84,10 @@ withLoggerIO params act = bracket (initLogger params) destroyLogger act
 -- | A plain logger in the IO monad, waiting for more serious logging solutions like
 -- the one described in https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/229
 instance HasLogger IO where
-  data instance Logger IO        = IOLogger LogLevel
+  data instance Logger IO        = IOLogger { _IOLogger :: IOStdLogger }
   type instance LogInitParams IO = LogConfig
   type instance LogPayload IO    = String
-  initLogger LogConfig{..} = do
-    -- let the env var take precedence over the LogConfig one.
-    mLvl <- liftIO $ lookupEnv "GGTX_LOG_LEVEL"
-    lvl <- case mLvl of
-          Nothing      -> pure _lc_log_level
-          Just s       ->
-            case parseLogLevel (T.pack s) of
-              Left err   -> do
-                liftIO $ putStrLn $ "unknown log level " <> s <> ": " <> T.unpack err <> " , ignoring GGTX_LOG_LEVEL"
-                pure $ _lc_log_level
-              Right lvl' -> pure lvl'
-    pure $ IOLogger lvl
-  destroyLogger _ = pure ()
-  logMsg (IOLogger minLvl) lvl msg = do
-    t <- getCurrentTime
-    when (lvl >= minLvl) $ do
-      let pfx = "[" <> show t <> "] [" <> show lvl <> "] "
-      putStrLn $ pfx <> msg
-  logTxt lgr lvl msg = logMsg lgr lvl (T.unpack msg)
+  initLogger cfg = fmap IOLogger $ (liftIO $ ioStdLogger cfg)
+  destroyLogger = liftIO . _iosl_destroy . _IOLogger
+  logMsg (IOLogger ioLogger) = _iosl_log_msg ioLogger
+  logTxt (IOLogger ioLogger) lvl msg = liftIO $ _iosl_log_txt ioLogger lvl msg

src/Gargantext/System/Logging/Loggers.hs

+
+{-| Canned loggers to avoid reinventing the wheel every time. -}
+
+module Gargantext.System.Logging.Loggers (
+    ioStdLogger
+  , IOStdLogger -- opaque, you can't build it directly, use 'ioStdLogger'
+  , _iosl_log_level
+  , _iosl_destroy
+  , _iosl_log_msg
+  , _iosl_log_txt
+  , monadicStdLogger
+  , _msl_log_level
+  , _msl_destroy
+  , _msl_log_msg
+  , _msl_log_txt
+  , MonadicStdLogger
+  ) where
+
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.Text qualified as T
+import Data.Time
+import Gargantext.Core.Config
+import Gargantext.System.Logging.Types
+import Prelude
+import System.Log.FastLogger qualified as FL
+
+data IOStdLogger =
+  IOStdLogger { _iosl_log_level :: LogLevel
+              , _iosl_destroy   :: IO ()
+              , _iosl_log_msg   :: LogLevel -> String -> IO ()
+              , _iosl_log_txt   :: LogLevel -> T.Text -> IO ()
+              }
+
+ioStdLogger :: LogConfig -> IO IOStdLogger
+ioStdLogger LogConfig{..} = do
+  let minLvl = _lc_log_level
+  let log_msg lvl msg = do
+        t <- getCurrentTime
+        when (lvl >= minLvl) $ do
+          let pfx = "[" <> show t <> "] [" <> show lvl <> "] "
+          putStrLn $ pfx <> msg
+  pure $ IOStdLogger
+    { _iosl_log_level = minLvl
+    , _iosl_destroy   = pure ()
+    , _iosl_log_msg   = log_msg
+    , _iosl_log_txt = \lvl msg -> log_msg lvl (T.unpack msg)
+    }
+
+-- | A monadic standard logger powered by fast-logger underneath.
+data MonadicStdLogger payload m =
+  MonadicStdLogger { _msl_log_level :: LogLevel
+                   , _msl_loggers   :: [FL.LoggerSet]
+                   , _msl_destroy   :: m ()
+                   , _msl_log_msg   :: LogLevel -> payload -> m ()
+                   , _msl_log_txt   :: LogLevel -> T.Text -> m ()
+                   }
+
+monadicStdLogger :: MonadIO m => LogConfig -> IO (MonadicStdLogger FL.LogStr m)
+monadicStdLogger LogConfig{..} = do
+  let minLvl = _lc_log_level
+  stdout_logger <- FL.newStderrLoggerSet FL.defaultBufSize
+  let log_msg lvl msg = liftIO $ do
+        t <- getCurrentTime
+        when (lvl >= minLvl) $ do
+          let pfx = "[" <> show t <> "] [" <> show lvl <> "] "
+          FL.pushLogStrLn stdout_logger $ FL.toLogStr pfx <> msg
+  pure $ MonadicStdLogger
+    { _msl_log_level = minLvl
+    , _msl_loggers   = [stdout_logger]
+    , _msl_destroy   = liftIO $ FL.rmLoggerSet stdout_logger
+    , _msl_log_msg   = log_msg
+    , _msl_log_txt   = \lvl msg -> log_msg lvl (FL.toLogStr $ T.unpack msg)
+    }

test/Test/Database/Types.hs

@@ -22,11 +22,9 @@ import Control.Monad.Trans.Control
 import Data.IORef
 import Data.Map qualified as Map
 import Data.Pool
-import Data.Text qualified as T
 import Database.PostgreSQL.Simple qualified as PG
 import Database.Postgres.Temp qualified as Tmp
 import Gargantext hiding (to)
-import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
@@ -36,6 +34,7 @@ import Gargantext.Core.Mail.Types (HasMail(..))
 import Gargantext.Core.NLP (HasNLPServer(..))
 import Gargantext.Core.NodeStory
 import Gargantext.System.Logging (HasLogger(..), Logger, MonadLogger(..))
+import Gargantext.System.Logging.Loggers
 import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
 import Network.URI (parseURI)
 import Prelude qualified
@@ -132,22 +131,11 @@ instance MonadLogger (GargM TestEnv BackendInternalError) where
   getLogger = asks test_logger
 
 instance HasLogger (GargM TestEnv BackendInternalError) where
-  data instance Logger (GargM TestEnv BackendInternalError) =
-    GargTestLogger {
-      test_logger_mode :: Mode
-    , test_logger_set  :: FL.LoggerSet
-    }
-  type instance LogInitParams (GargM TestEnv BackendInternalError) = Mode
+  newtype instance Logger (GargM TestEnv BackendInternalError) =
+    GargTestLogger { _GargTestLogger :: MonadicStdLogger FL.LogStr IO }
+  type instance LogInitParams (GargM TestEnv BackendInternalError) = LogConfig
   type instance LogPayload (GargM TestEnv BackendInternalError)    = FL.LogStr
-  initLogger mode = do
-    test_logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
-    pure $ GargTestLogger mode test_logger_set
-  destroyLogger GargTestLogger{..} = liftIO $ FL.rmLoggerSet test_logger_set
-  logMsg (GargTestLogger mode logger_set) lvl msg = do
-    cfg <- view hasConfig
-    let minLvl = cfg ^. gc_logging . lc_log_level
-    when (lvl >= minLvl) $ do
-      let pfx = "[" <> show lvl <> "] " :: Text
-      when (lvl `elem` (modeToLoggingLevels mode)) $
-        liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
-  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)
+  initLogger cfg = fmap GargTestLogger $ (liftIO $ monadicStdLogger cfg)
+  destroyLogger = liftIO . _msl_destroy . _GargTestLogger
+  logMsg (GargTestLogger ioLogger) lvl msg = liftIO $ _msl_log_msg ioLogger lvl msg
+  logTxt (GargTestLogger ioLogger) lvl msg = liftIO $ _msl_log_txt ioLogger lvl msg