Make log truncation configurable

bin/gargantext-cli/CLI/Ini.hs

@@ -93,6 +93,8 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
                     , _gc_logging = Config.LogConfig {
                         _lc_log_level = INFO
                       , _lc_log_file = Nothing
+                      , _lc_log_truncation_threshold = 1000
+                      , _lc_log_truncation_enabled   = False
                       }
                     }
   where

bin/gargantext-cli/CLI/Server.hs

@@ -54,7 +54,7 @@ serverCLI (CLIS_startAll serverArgs@(ServerArgs { .. })) = withServerCLILogger s
       Right (Right ())
         -> pure ()
 
-serverCLI (CLIS_version) = withLogger (LogConfig Nothing DEBUG) $ \ioLogger -> do
+serverCLI (CLIS_version) = withLogger (LogConfig Nothing DEBUG 1000 False) $ \ioLogger -> do
     -- Sets the locale to avoid encoding issues like in #284.
   setLocaleEncoding utf8
   logMsg ioLogger INFO $ "Version: " <> showVersion PG.version

gargantext-settings.toml_toModify

@@ -103,7 +103,8 @@ pass = PASSWORD_TO_CHANGE
 log_file = "/var/log/gargantext/backend.log"
 log_level = "info"
 log_formatter = "verbose"
-
+log_truncate_after_chars = 1000
+log_truncate_enabled     = true
 
 [mail]
 #port = 25

src/Gargantext/API.hs

@@ -74,7 +74,8 @@ import Gargantext.API.Errors.Types (BackendInternalError (..))
 startGargantext :: Mode -> SettingsFile -> IO ()
 startGargantext mode sf@(SettingsFile settingsFile) = do
   config <- readConfig sf
-  withLoggerIO (config ^. gc_logging) $ \logger -> do
+  let logConfig = config ^. gc_logging
+  withLoggerIO logConfig $ \logger -> do
     withNotifications config $ \dispatcher -> do
       env <- newEnv logger config dispatcher
       let fc = env ^. env_config . gc_frontend_config
@@ -83,7 +84,7 @@ startGargantext mode sf@(SettingsFile settingsFile) = do
       runDbCheck env
       startupInfo config port proxyStatus
       app <- makeApp env
-      mid <- makeGargMiddleware (fc ^. fc_cors) mode
+      mid <- makeGargMiddleware logConfig (fc ^. fc_cors) mode
       periodicActions <- schedulePeriodicActions env
 
       let runServer = run port (mid app) `finally` stopGargantext periodicActions
@@ -180,8 +181,8 @@ fireWall req fw = do
        then pure True
        else pure False
 
-makeGargMiddleware :: CORSSettings -> Mode -> IO Middleware
-makeGargMiddleware crsSettings mode = do
+makeGargMiddleware :: LogConfig -> CORSSettings -> Mode -> IO Middleware
+makeGargMiddleware logConfig crsSettings mode = do
     let corsMiddleware = cors $ \_incomingRq -> Just
           simpleCorsResourcePolicy
             { corsOrigins = Just $ (Set.toList $ Set.fromList $ map mkCorsOrigin (crsSettings ^. corsAllowedOrigins), True)
@@ -194,7 +195,7 @@ makeGargMiddleware crsSettings mode = do
     case mode of
       Prod -> pure $ logStdout . corsMiddleware
       _    -> do
-        loggerMiddleware <- logStdoutDevSanitised
+        loggerMiddleware <- logStdoutDevSanitised logConfig
         pure $ loggerMiddleware . corsMiddleware
   where
     mkCorsOrigin :: CORSOrigin -> Origin

src/Gargantext/API/Middleware.hs

@@ -17,7 +17,7 @@ module Gargantext.API.Middleware (
   logStdoutDevSanitised
   ) where
 
-import Control.Lens (Traversal', at, over)
+import Control.Lens (Traversal', at, over, (^.))
 import Control.Monad.Logger (LogStr, toLogStr)
 import Data.Aeson qualified as A
 import Data.Aeson.Lens qualified as L
@@ -31,6 +31,7 @@ import Data.List qualified as L
 import Data.String (fromString)
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
+import Gargantext.Core.Config
 import Network.HTTP.Types (QueryItem, Status(..))
 import Network.HTTP.Types.Header (Header, hAuthorization, hCookie, hSetCookie)
 import Network.Wai (Middleware, queryString, requestMethod, rawPathInfo)
@@ -40,8 +41,8 @@ import System.Console.ANSI (Color(..), setSGRCode, SGR(..), ConsoleLayer(..), Co
 
 -- | Like 'logStdoutDev' from \"wai-extra\", but redacts (or omits altogether) payloads which might have
 -- sensitive information
-logStdoutDevSanitised :: IO Middleware
-logStdoutDevSanitised = mkRequestLogger $ defaultRequestLoggerSettings { outputFormat = CustomOutputFormatWithDetailsAndHeaders customOutput }
+logStdoutDevSanitised :: LogConfig -> IO Middleware
+logStdoutDevSanitised lc = mkRequestLogger $ defaultRequestLoggerSettings { outputFormat = CustomOutputFormatWithDetailsAndHeaders (customOutput lc) }
 -- |
 -- Like 'key', but uses 'at' instead of 'ix'. This is handy when
 -- adding and removing object keys:
@@ -55,16 +56,8 @@ atKey :: L.AsValue t => T.Text -> Traversal' t (Maybe A.Value)
 atKey i = L._Object . at (fromString $ T.unpack i)
 {-# INLINE atKey #-}
 
--- | After how many characters we should truncated the output.
-truncationThreshold :: Int
-truncationThreshold = 1000
-
--- | Set to default locally if you really insist in displaying the full output.
-logTruncateEnabled :: Bool
-logTruncateEnabled = True
-
-customOutput :: OutputFormatterWithDetailsAndHeaders
-customOutput _zonedDate rq status _mb_response_size request_dur (sanitiseBody . mconcat -> reqbody) raw_response (map sanitiseHeader -> headers) =
+customOutput :: LogConfig -> OutputFormatterWithDetailsAndHeaders
+customOutput lc _zonedDate rq status _mb_response_size request_dur (sanitiseBody . mconcat -> reqbody) raw_response (map sanitiseHeader -> headers) =
   let params = map sanitiseQueryItem (queryString rq)
   in mkRequestLog params reqbody <> mkResponseLog
 
@@ -72,8 +65,8 @@ customOutput _zonedDate rq status _mb_response_size request_dur (sanitiseBody .
     -- Truncates the body if too long.
     truncatedIfTooLong :: ByteString -> ByteString
     truncatedIfTooLong b
-      | not logTruncateEnabled = b
-      | C8.length b > truncationThreshold = C8.take 1000 b <> " ... (output truncated because too long)"
+      | not (lc ^. lc_log_truncation_enabled) = b
+      | C8.length b > (lc ^. lc_log_truncation_threshold) = C8.take 1000 b <> " ... (output truncated because too long)"
       | otherwise = b
 
     mkRequestLog :: [QueryItem] -> ByteString -> LogStr

src/Gargantext/Core/Config.hs

@@ -34,6 +34,8 @@ module Gargantext.Core.Config (
   , gc_logging
   , lc_log_level
   , lc_log_file
+  , lc_log_truncation_threshold
+  , lc_log_truncation_enabled
 
   , mkProxyUrl
 
@@ -65,12 +67,23 @@ import Toml.Schema.FromValue (typeError)
 data LogConfig = LogConfig
   { _lc_log_file  :: Maybe FilePath
   , _lc_log_level :: !LogLevel
+  -- | Truncates (development) logs after this many characters.
+  -- Avoids huge payloads to take too much screen estate, hiding
+  -- potentially-useful information.
+  , _lc_log_truncation_threshold :: !Int
+  -- | Whether or not log truncation is enabled. At the moment
+  -- this setting takes effect only for the development middleware,
+  -- because the rationale is that in production we always want to
+  -- see as much log output as possible.
+  , _lc_log_truncation_enabled   :: !Bool
   } deriving Show
 
 instance FromValue LogConfig where
   fromValue = parseTableFromValue $ do
     _lc_log_file  <- optKey "log_file"
     _lc_log_level <- reqKeyOf "log_level" parse_log_level
+    _lc_log_truncation_threshold <- fromMaybe 1000  <$> optKey "log_truncate_after_chars"
+    _lc_log_truncation_enabled   <- fromMaybe False <$> optKey "log_truncate_enabled"
     pure LogConfig{..}
 
 parse_log_level :: Value' l -> Matcher l LogLevel

test/Test/Database/Transactions.hs

@@ -113,11 +113,11 @@ instance HasLogger (TestMonadM DBHandle err) where
 
 instance MonadLogger (TestMonadM DBHandle IOException) where
   getLogger = TestMonad $ do
-    initLogger @(TestMonadM DBHandle IOException) (LogConfig Nothing ERROR)
+    initLogger @(TestMonadM DBHandle IOException) (LogConfig Nothing ERROR 1000 False)
 
 instance MonadLogger (TestMonadM TestEnv NodeError) where
   getLogger = TestMonad $ do
-    initLogger @(TestMonadM TestEnv NodeError) (LogConfig Nothing ERROR)
+    initLogger @(TestMonadM TestEnv NodeError) (LogConfig Nothing ERROR 1000 False)
 
 runTestDBTxMonad :: DBHandle -> TestMonadM DBHandle IOException a -> IO a
 runTestDBTxMonad env m = do

test/Test/Database/Types.hs

@@ -87,7 +87,7 @@ instance HasLogger (TestMonadM TestEnv err) where
 
 instance MonadLogger (TestMonadM TestEnv BackendInternalError) where
   getLogger = TestMonad $ do
-    initLogger @(TestMonadM TestEnv BackendInternalError) (LogConfig Nothing ERROR)
+    initLogger @(TestMonadM TestEnv BackendInternalError) (LogConfig Nothing ERROR 1000 False)
 
 runTestMonadM :: Show err => env -> TestMonadM env err a -> IO a
 runTestMonadM env m = do