[CBR-430] added version and configuration key to JSON logs

Signed-off-by: Alexander Diemand <codieplusplus@apax.net>

auxx/Main.hs

@@ -169,7 +169,7 @@ main = withCompileInfo $ do
             | otherwise = identity
         loggingParams = disableConsoleLog $
             CLI.loggingParams loggerName (aoCommonNodeArgs opts)
-    loggerBracket loggingParams . logException "auxx" $ do
+    loggerBracket "auxx" loggingParams . logException "auxx" $ do
         let runAction a = action opts a
         case aoAction opts of
             Repl    -> withAuxxRepl $ \c -> runAction (Left c)

explorer/src/explorer/Main.hs

@@ -49,7 +49,7 @@ main :: IO ()
 main = do
     args <- getExplorerNodeOptions
     let loggingParams = CLI.loggingParams loggerName (enaCommonNodeArgs args)
-    loggerBracket loggingParams . logException "node" $ do
+    loggerBracket "explorer" loggingParams . logException "node" $ do
         logInfo "[Attention] Software is built with explorer part"
         action args
 

explorer/test/Test/Pos/Explorer/Socket/MethodsSpec.hs

@@ -50,7 +50,7 @@ import           Test.Pos.Explorer.MockFactory (mkTxOut)
 -- stack test cardano-sl-explorer --fast --test-arguments "-m Test.Pos.Explorer.Socket"
 
 spec :: Spec
-spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $
+spec = beforeAll_ (setupLogging "test" (defaultTestConfiguration Debug)) $
     describe "Methods" $ do
         describe "fromCAddressOrThrow" $
             it "throws an exception if a given CAddress is invalid" $

generator/app/VerificationBench.hs

@@ -183,7 +183,7 @@ readBlocks path = do
 
 main :: IO ()
 main = do
-    setupLogging loggerConfig
+    setupLogging "generator" loggerConfig
     args <- Opts.execParser
         $ Opts.info
             (benchArgsParser <**> Opts.helper)

generator/test/Test/Pos/Binary/CommunicationSpec.hs

@@ -72,7 +72,7 @@ deserializeSerilizedMsgSerializedBlockSpec = do
     descNoBlock = "deserialization of a serialized MsgNoSerializedBlock message should give back corresponding MsgNoBlock"
 
 spec :: Spec
-spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $
+spec = beforeAll_ (setupLogging "test" (defaultTestConfiguration Debug)) $
     withStaticConfigurations $ \_ _ -> withCompileInfo $
         describe "Pos.Binary.Communication" $ do
             describe "serializeMsgSerializedBlock" serializeMsgSerializedBlockSpec

generator/test/Test/Pos/Block/Logic/VarSpec.hs

@@ -61,7 +61,7 @@ import           Test.Pos.Util.QuickCheck.Property (splitIntoChunks,
 spec :: Spec
 -- Unfortunatelly, blocks generation is quite slow nowdays.
 -- See CSL-1382.
-spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ withStaticConfigurations $ \txpConfig _ ->
+spec = beforeAll_ (setupLogging "test" (defaultTestConfiguration Debug)) $ withStaticConfigurations $ \txpConfig _ ->
     describe "Block.Logic.VAR" $ modifyMaxSuccess (min 4) $ do
         describe "verifyBlocksPrefix" $ verifyBlocksPrefixSpec txpConfig
         describe "verifyAndApplyBlocks" $ verifyAndApplyBlocksSpec txpConfig

lib/src/Pos/Launcher/Launcher.hs

@@ -20,7 +20,7 @@ import           Pos.Client.CLI.Params (getNodeParams)
 import           Pos.DB.DB (initNodeDBs)
 import           Pos.DB.Txp.Logic (txpGlobalSettings)
 import           Pos.Launcher.Configuration (AssetLockPath (..),
-                     HasConfigurations, WalletConfiguration,
+                     HasConfigurations, WalletConfiguration, cfoKey,
                      withConfigurations)
 import           Pos.Launcher.Param (LoggingParams (..), NodeParams (..))
 import           Pos.Launcher.Resource (NodeResources, bracketNodeResources,
@@ -48,12 +48,14 @@ launchNode
        )
     -> IO ()
 launchNode nArgs cArgs lArgs action = do
-    let withLogger' = loggerBracket lArgs . logException (lpDefaultName lArgs)
+    let confOpts = configurationOptions (commonArgs cArgs)
+    let confKey = cfoKey confOpts
+    let withLogger' = loggerBracket confKey lArgs . logException (lpDefaultName lArgs)
     let withConfigurations' = withConfigurations
             (AssetLockPath <$> cnaAssetLockPath cArgs)
             (cnaDumpGenesisDataPath cArgs)
             (cnaDumpConfiguration cArgs)
-            (configurationOptions (commonArgs cArgs))
+            confOpts
 
     withLogger' $ withConfigurations' $ \genesisConfig walletConfig txpConfig ntpConfig -> do
         (nodeParams, Just sscParams) <- getNodeParams

lib/src/Pos/Launcher/Resource.hs

@@ -247,12 +247,12 @@ getRealLoggerConfig LoggingParams{..} = do
                       -- add output to the console with severity filter >= Info
         Just False -> identity
 
-setupLoggers :: MonadIO m => LoggingParams -> m ()
-setupLoggers params = setupLogging =<< getRealLoggerConfig params
+setupLoggers :: MonadIO m => Text -> LoggingParams -> m ()
+setupLoggers cfoKey params = setupLogging cfoKey =<< getRealLoggerConfig params
 
 -- | RAII for Logging.
-loggerBracket :: LoggingParams -> IO a -> IO a
-loggerBracket lp = bracket_ (setupLoggers lp) removeAllHandlers
+loggerBracket :: Text -> LoggingParams -> IO a -> IO a
+loggerBracket cfoKey lp = bracket_ (setupLoggers cfoKey lp) removeAllHandlers
 
 ----------------------------------------------------------------------------
 -- NodeContext

lib/test/Test/Pos/Diffusion/BlockSpec.hs

@@ -122,7 +122,7 @@ clientLogic = pureLogic
 
 withServer :: Transport -> Logic IO -> (NodeId -> IO t) -> IO t
 withServer transport logic k = do
-    logTrace <- liftIO $ wsetupLogging (defaultTestConfiguration Debug) ("server.outboundqueue")
+    logTrace <- liftIO $ wsetupLogging "test" (defaultTestConfiguration Debug) ("server.outboundqueue")
     -- Morally, the server shouldn't need an outbound queue, but we have to
     -- give one.
     oq <- liftIO $ OQ.new

lib/test/Test/Pos/Launcher/ConfigurationSpec.hs

@@ -18,7 +18,7 @@ spec :: Spec
 spec = describe "Pos.Launcher.Configuration" $ do
     describe "withConfigurationsM" $ do
         it "should parse `lib/configuration.yaml` file" $ do
-            liftIO $ setupLogging (defaultTestConfiguration Debug)
+            liftIO $ setupLogging "test" (defaultTestConfiguration Debug)
             startTime <- Timestamp . round . (* 1000000) <$> liftIO getPOSIXTime
             let cfo = defaultConfigurationOptions
                         { cfoFilePath = "./configuration.yaml"

networking/src/Bench/Network/Commons.hs

@@ -106,7 +106,7 @@ loadLogConfig logsPrefix configFile = do
         Nothing  -> return defaultLogConfig
         Just lc0 -> parseLoggerConfig lc0
     lc <- liftIO $ setLogPrefix logsPrefix lc1
-    setupLogging lc
+    setupLogging "bench" lc
 
 
 -- * Logging & parsing

networking/test/Test/NodeSpec.hs

@@ -46,7 +46,7 @@ import           Test.Util (HeavyParcel (..), Parcel (..), Payload (..),
 spec :: Spec
 spec = describe "Node" $ modifyMaxSuccess (const 50) $ do
 
-    logTrace <- runIO $ wsetupLogging (defaultTestConfiguration Debug) "nodespec"
+    logTrace <- runIO $ wsetupLogging "test" (defaultTestConfiguration Debug) "nodespec"
 
         -- Take at most 25000 bytes for each Received message.
         -- We want to ensure that the MTU works, but not make the tests too

tools/src/keygen/Main.hs

@@ -156,7 +156,7 @@ genVssCert genesisConfig path = do
 main :: IO ()
 main = do
     KeygenOptions {..} <- getKeygenOptions
-    setupLogging $ defaultInteractiveConfiguration Debug
+    setupLogging "keygen" $ defaultInteractiveConfiguration Debug
     usingLoggerName "keygen"
         $ withConfigurations Nothing Nothing False koConfigurationOptions
         $ \genesisConfig _ _ _ -> do

tools/src/launcher/Main.hs

@@ -306,7 +306,7 @@ main =
             case loNodeLogConfig of
                 Nothing -> loNodeArgs
                 Just lc -> loNodeArgs ++ ["--log-config", toText lc]
-    setupLogging $
+    setupLogging (cfoKey loConfiguration) $
         defaultInteractiveConfiguration Info
             & lcBasePath .~ launcherLogsPrefix
             & lcLoggerTree %~ case launcherLogsPrefix of

util/cardano-sl-util.cabal

@@ -55,6 +55,7 @@ library
                        Pos.Util.Wlog
 
   other-modules:
+                       Paths_cardano_sl_util
                        Pos.Util.CompileInfoGit
                        Pos.Util.Log.Scribes
                        Pos.Util.Log.Rotator

util/src/Pos/Util/Log.hs

@@ -109,11 +109,11 @@ addLoggerName t f =
 
 -- | setup logging according to configuration @LoggerConfig@
 --   the backends (scribes) will be registered with katip
-setupLogging :: MonadIO m => LoggerConfig -> m LoggingHandler
-setupLogging lc = do
+setupLogging :: MonadIO m => Text -> LoggerConfig -> m LoggingHandler
+setupLogging cfoKey lc = do
     lh <- liftIO $ Internal.newConfig lc
     scribes <- liftIO $ meta lh lc
-    liftIO $ Internal.registerBackends lh scribes
+    liftIO $ Internal.registerBackends cfoKey lh scribes
     return lh
       where
         -- returns a list of: (name, Scribe, finalizer)
@@ -130,7 +130,7 @@ setupLogging lc = do
                                      (_lc ^. lcRotation)
             forM lhs (\lh -> case (lh ^. lhBackend) of
                     FileJsonBE -> do
-                        let bp = fromMaybe "." basepath
+                        let bp = fromMaybe "./" basepath
                             fp = fromMaybe "node.json" $ lh ^. lhFpath
                             fdesc = Internal.mkFileDescription bp fp
                             nm = lh ^. lhName
@@ -142,8 +142,8 @@ setupLogging lc = do
                                       K.V0
                         return (nm, scribe)
                     FileTextBE -> do
-                        let bp = fromMaybe "." basepath
-                            fp = (fromMaybe "node.log" $ lh ^. lhFpath)
+                        let bp = fromMaybe "./" basepath
+                            fp = fromMaybe "node.log" $ lh ^. lhFpath
                             fdesc = Internal.mkFileDescription bp fp
                             nm = lh ^. lhName
                         scribe <- mkTextFileScribe
@@ -179,7 +179,7 @@ setupLogging lc = do
 * example
 
     @
-      lh <- setupLogging logconf
+      lh <- setupLogging "test" logconf
       usingLoggerName lh "processXYZ" $
           logInfo "entering"
           complexWork "42"
@@ -208,7 +208,7 @@ usingLoggerNames lh names action = do
 * example
 
     @
-      lh <- setupLogging logconf
+      lh <- setupLogging "test" logconf
       loggerBracket lh "processXYZ" $
           logInfo "entering"
           complexWork "42"
@@ -236,22 +236,22 @@ loggerBracket lh name action = do
 {- |
    * interactive tests
 
-   >>> lh <- setupLogging $ defaultInteractiveConfiguration Info
+   >>> lh <- setupLogging "test" $ defaultInteractiveConfiguration Info
    >>> loggerBracket lh "testtest" $ do { logInfo "This is a message" }
 
-   >>> lh <- setupLogging $ defaultInteractiveConfiguration Info
+   >>> lh <- setupLogging "test" $ defaultInteractiveConfiguration Info
    >>> loggerBracket lh "testtest" $ do { logDebug "You won't see this message" }
 
-   >>> lh <- setupLogging $ defaultInteractiveConfiguration Info
+   >>> lh <- setupLogging "test" $ defaultInteractiveConfiguration Info
    >>> loggerBracket lh "testtest" $ do { logWarning "Attention!"; addLoggerName "levelUp" $ do { logError "..now it happened" } }
 
-   >>> lh <- setupLogging $ defaultInteractiveConfiguration Info
+   >>> lh <- setupLogging "test" $ defaultInteractiveConfiguration Info
    >>> usingLoggerName lh "testmore" $ do { logInfo "hello..." }
 
    >>> lc0 <- return $ defaultInteractiveConfiguration Info
    >>> newlt <- return $ lc0 ^. lcLoggerTree & ltNamedSeverity .~ Data.HashMap.Strict.fromList [("cardano-sl.silent", Error)]
    >>> lc <- return $ lc0 & lcLoggerTree .~ newlt
-   >>> lh <- setupLogging lc
+   >>> lh <- setupLogging "test" lc
    >>> usingLoggerName lh "silent" $ do { logWarning "you won't see this!" }
    >>> usingLoggerName lh "verbose" $ do { logWarning "now you read this!" }
 -}

util/src/Pos/Util/Log/Internal.hs

@@ -26,6 +26,8 @@ import           Control.Concurrent.MVar (modifyMVar_, newMVar, withMVar)
 
 import qualified Data.Text as T
 import           Data.Time (UTCTime, getCurrentTime)
+import           Data.Version (showVersion)
+import           Paths_cardano_sl_util (version)
 import           System.FilePath (splitFileName, (</>))
 import           Universum hiding (newMVar)
 
@@ -112,10 +114,10 @@ newConfig lc = do
     return $ LoggingHandler mv
 
 -- | register scribes in `katip`
-registerBackends :: LoggingHandler -> [(T.Text, K.Scribe)] -> IO ()
-registerBackends lh scribes = do
+registerBackends :: Text -> LoggingHandler -> [(T.Text, K.Scribe)] -> IO ()
+registerBackends cfoKey lh scribes = do
     LoggingHandlerInternal cfg _ ctx counter <- takeMVar (getLSI lh)
-    le0 <- K.initLogEnv (s2kname "cardano-sl") "production"
+    le0 <- K.initLogEnv (s2kname "cardano-sl") $ fromString $ (T.unpack cfoKey) <> ":" <> showVersion version
     -- use 'getCurrentTime' to get a more precise timestamp
     -- as katip uses per default some internal buffered time variable
     timer <- mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime, updateFreq = 10000 }

util/src/Pos/Util/Trace.hs

@@ -44,18 +44,20 @@ natTrace nat (Trace (Op tr)) = Trace $ Op $ nat . tr
 
 -- | setup logging and return a Trace
 setupLogging :: MonadIO m
-             => Log.LoggerConfig
+             => Text
+             -> Log.LoggerConfig
              -> Log.LoggerName
              -> IO (Trace m (Log.Severity, Text))
-setupLogging lc ln = do
-    lh <- Log.setupLogging lc
+setupLogging cfoKey lc ln = do
+    lh <- Log.setupLogging cfoKey lc
     return $ logTrace lh ln
 
-wsetupLogging :: Wlog.LoggerConfig
+wsetupLogging :: Text
+              -> Wlog.LoggerConfig
               -> Wlog.LoggerName
               -> IO (Trace IO (Wlog.Severity, Text))
-wsetupLogging lc ln = do
-    Wlog.setupLogging lc
+wsetupLogging cfoKey lc ln = do
+    Wlog.setupLogging cfoKey lc
     return $ wlogTrace ln
 
 trace :: Trace m s -> s -> m ()

util/src/Pos/Util/Trace/Named.hs

@@ -111,9 +111,9 @@ named = contramap (LogNamed mempty)
 -- | setup logging and return a Trace
 setupLogging
     :: MonadIO m
-    => Log.LoggerConfig -> Log.LoggerName -> m (TraceNamed m)
-setupLogging lc ln = do
-    lh <- liftIO $ Log.setupLogging lc
+    => Text -> Log.LoggerConfig -> Log.LoggerName -> m (TraceNamed m)
+setupLogging cfoKey lc ln = do
+    lh <- liftIO $ Log.setupLogging cfoKey lc
     let nt = namedTrace lh
     return $ appendName ln nt
 
@@ -145,15 +145,15 @@ namedTrace lh = Trace $ Op $ \namedLogitem ->
 
 {- testing:
 
-logTrace' <- setupLogging (Pos.Util.LoggerConfig.defaultInteractiveConfiguration Log.Debug) "named"
+logTrace' <- setupLogging "test" (Pos.Util.LoggerConfig.defaultInteractiveConfiguration Log.Debug) "named"
 let li = publicLogItem (Log.Debug, "testing")
     ni = namedItem "Tests" li
 
 traceWith logTrace' ni
 traceWith (named $ appendName "more" logTrace') li
 
 
-logTrace' <- setupLogging (Pos.Util.LoggerConfig.jsonInteractiveConfiguration Log.Debug) "named"
+logTrace' <- setupLogging "test" (Pos.Util.LoggerConfig.jsonInteractiveConfiguration Log.Debug) "named"
 logDebug logTrace' "hello"
 logDebug (appendName "blabla" logTrace') "hello"
 -}

util/src/Pos/Util/Trace/Unstructured.hs

@@ -132,9 +132,9 @@ logWarningSP logTrace = traceLogItemSP logTrace Log.Warning
 logErrorSP logTrace   = traceLogItemSP logTrace Log.Error
 
 -- | setup logging and return a Trace
-setupLogging :: MonadIO m => Log.LoggerConfig -> Log.LoggerName -> IO (Trace m LogItem)
-setupLogging lc ln = do
-    lh <- Log.setupLogging lc
+setupLogging :: MonadIO m => Text -> Log.LoggerConfig -> Log.LoggerName -> IO (Trace m LogItem)
+setupLogging cfoKey lc ln = do
+    lh <- Log.setupLogging cfoKey lc
     return $ unstructuredTrace ln lh
 
 unstructuredTrace :: MonadIO m => Log.LoggerName -> Log.LoggingHandler -> Trace m LogItem

util/src/Pos/Util/Wlog/Compatibility.hs

@@ -228,9 +228,9 @@ loggingHandler = unsafePerformIO $ do
 
 -- | setup logging according to configuration @LoggerConfig@
 --   the backends (scribes) will be registered with katip
-setupLogging :: MonadIO m => LoggerConfig -> m ()
-setupLogging lc = liftIO $
-    modifyMVar_ loggingHandler $ const $ Log.setupLogging lc
+setupLogging :: MonadIO m => Text -> LoggerConfig -> m ()
+setupLogging cfoKey lc = liftIO $
+    modifyMVar_ loggingHandler $ const $ Log.setupLogging cfoKey lc
 
 
 -- | Whether to log to given log handler.

util/test/Test/Pos/Util/LogSpec.hs

@@ -65,7 +65,7 @@ prop_sev =
 run_logging :: Severity -> Int -> Integer -> Integer -> IO (Microsecond, Integer)
 run_logging sev n n0 n1= do
         startTime <- getPOSIXTime
-        lh <- setupLogging $ defaultTestConfiguration sev
+        lh <- setupLogging "test" $ defaultTestConfiguration sev
         forM_ [1..n0] $ \_ ->
             usingLoggerName lh "test_log" $
                 forM_ [1..n1] $ \_ -> do
@@ -96,7 +96,7 @@ prop_sevS =
 run_loggingS :: Severity -> Int -> Integer -> Integer-> IO (Microsecond, Integer)
 run_loggingS sev n n0 n1= do
         startTime <- getPOSIXTime
-        lh <- setupLogging $ defaultTestConfiguration sev
+        lh <- setupLogging "test" $ defaultTestConfiguration sev
         forM_ [1..n0] $ \_ ->
             usingLoggerName lh "test_log" $
                 forM_ [1..n1] $ \_ -> do
@@ -118,7 +118,7 @@ run_loggingS sev n n0 n1= do
 -- | example: setup logging
 example_setup :: IO ()
 example_setup = do
-    lh <- setupLogging (defaultTestConfiguration Debug)
+    lh <- setupLogging "test" (defaultTestConfiguration Debug)
     usingLoggerName lh "processXYZ" $ do
         logInfo "entering"
         complexWork "42"
@@ -132,7 +132,7 @@ example_setup = do
 -- | example: bracket logging
 example_bracket :: IO ()
 example_bracket = do
-    lh <- setupLogging (defaultTestConfiguration Debug)
+    lh <- setupLogging "test" (defaultTestConfiguration Debug)
     loggerBracket lh "processXYZ" $ do
         logInfo "entering"
         complexWork "42"
@@ -223,7 +223,7 @@ spec = describe "Logging" $ do
             let lc0 = defaultTestConfiguration Info
                 newlt = lc0 ^. lcLoggerTree & ltNamedSeverity .~ HM.fromList [("cardano-sl.silent", Error)]
                 lc = lc0 & lcLoggerTree .~ newlt
-            lh <- setupLogging lc
+            lh <- setupLogging "test" lc
             lift $ usingLoggerName lh "silent" $ do { logWarning "you won't see this!" }
             lift $ threadDelay 0300000
             lift $ usingLoggerName lh "verbose" $ do { logWarning "now you read this!" }