[CBR-423] Demonstrate structured logging.

util/cardano-sl-util.cabal

@@ -54,11 +54,11 @@ library
                        Pos.Util.Trace.Named
                        Pos.Util.Util
                        Pos.Util.Wlog
+                       Pos.Util.Log.Rotator
 
   other-modules:
                        Pos.Util.CompileInfoGit
                        Pos.Util.Log.Scribes
-                       Pos.Util.Log.Rotator
 
   build-depends:       aeson
                      , auto-update
@@ -159,6 +159,7 @@ test-suite test
                        Test.Pos.Util.TraceSpec
                        Test.Pos.Util.Tripping
                        Test.Pos.Util.WlogSpec
+                       Test.Pos.Util.LogStructuredSpec
 
   build-depends:       aeson
                      , base
@@ -176,6 +177,7 @@ test-suite test
                      , quickcheck-instances
                      , stm
                      , template-haskell
+                     , temporary
                      , text
                      , time
                      , time-units

util/src/Pos/Util/Log.hs

@@ -35,6 +35,7 @@ module Pos.Util.Log
        , addLoggerName
        -- * other functions
        , logItem'
+       , closeLogScribes
        ) where
 
 import           Universum
@@ -235,6 +236,12 @@ loggerBracket lh name action = do
       finalizer le_ = void $ liftIO $ K.closeScribes le_
       body le_ = K.runKatipContextT le_ () (Internal.s2kname name) $ action
 
+closeLogScribes :: MonadIO m => LoggingHandler -> m ()
+closeLogScribes lh = do
+    mayle <- liftIO $ Internal.getLogEnv lh
+    case mayle of
+            Nothing -> error "logging not yet initialized. Abort."
+            Just le -> void $ liftIO $ K.closeScribes le
 
 {- |
    * interactive tests

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

@@ -6,6 +6,7 @@ module Pos.Util.Log.Rotator
        ( cleanupRotator
        , evalRotator
        , initializeRotator
+       , latestLogFile
        ) where
 
 import           Universum

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

@@ -9,6 +9,7 @@ module Pos.Util.Wlog.Compatibility
          , dispatchEvents
          , LogEvent (..)
          , setupLogging
+         , setupLogging'
            -- * Logging functions
          , logDebug
          , logError
@@ -234,6 +235,11 @@ setupLogging :: MonadIO m => LoggerConfig -> m ()
 setupLogging lc = liftIO $
     modifyMVar_ loggingHandler $ const $ Log.setupLogging lc
 
+--  | Same with 'setupLogging' but also returns the 'LoggingHandler'
+setupLogging' :: MonadIO m => LoggerConfig -> m LoggingHandler
+setupLogging' lc = liftIO $ do
+    modifyMVar_ loggingHandler $ const $ Log.setupLogging lc
+    readMVar loggingHandler
 
 -- | Whether to log to given log handler.
 type SelectionMode = LogSecurityLevel -> Bool

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

@@ -0,0 +1,92 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Test.Pos.Util.LogStructuredSpec
+    ( spec)
+where
+
+import           Universum
+
+import qualified Data.HashMap.Strict as HM
+import           System.Directory (getCurrentDirectory, removeFile)
+import           Test.Hspec (Spec, describe, it)
+import           Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess)
+import           Test.QuickCheck.Monadic (monadicIO)
+
+import           Pos.Util.Log (closeLogScribes)
+import           Pos.Util.Log.Internal (FileDescription (..))
+import           Pos.Util.Log.LoggerConfig (BackendKind (..), LogHandler (..),
+                     LogSecurityLevel (..), LoggerConfig (..), LoggerTree (..),
+                     jsonInteractiveConfiguration)
+import           Pos.Util.Log.Rotator (latestLogFile)
+import           Pos.Util.Log.Structured (logDebugX, logErrorX, logInfoX,
+                     logNoticeX, logWarningX)
+import           Pos.Util.Wlog
+import           Pos.Util.Wlog.Compatibility (setupLogging')
+
+someLogging :: IO ()
+someLogging = do
+    lh <- setupLogging' loggerConfig
+    usingLoggerName "testing" $ do
+        testLog
+        closeLogScribes lh
+  where
+    loggerConfig :: LoggerConfig
+    loggerConfig = let
+        _lcRotation = Nothing
+        _lcBasePath = Nothing
+        _lcLoggerTree = LoggerTree {
+            _ltMinSeverity = Debug,
+            _ltNamedSeverity = HM.empty,
+            _ltHandlers = [ LogHandler {
+                _lhBackend = StderrBE,
+                _lhName = "stderr",
+                _lhFpath = Nothing,
+                _lhSecurityLevel = Just SecretLogLevel,
+                _lhMinSeverity = Just Debug }
+                          , LogHandler {
+                _lhBackend = FileJsonBE,
+                _lhName = "json",
+                _lhFpath = Just "node.json",
+                _lhSecurityLevel = Just SecretLogLevel,
+                _lhMinSeverity = Just Debug}
+                          ]
+          }
+        in
+        LoggerConfig{..}
+
+testLog :: (MonadIO m, WithLogger m) => m ()
+testLog = do
+    logDebug "debug"
+    -- the following will be shown only in JSON file
+    logDebugX item
+
+    logInfo "info"
+    logInfoX item
+
+    logNotice "notice"
+    logNoticeX item
+
+    logWarning "warning"
+    logWarningX item
+
+    logError "error"
+    logErrorX item
+  where
+    item = jsonInteractiveConfiguration Debug
+
+spec :: Spec
+spec = describe "Strucutured logging" $ do
+    modifyMaxSuccess (const 1) $ modifyMaxSize (const 1) $
+      it "demonstrate structured logging (see node.json-{timestamp})" $
+        monadicIO $ do
+            lift $ someLogging
+            dir <- liftIO $ getCurrentDirectory
+            mayLogFile <- liftIO $ latestLogFile $
+                FileDescription { prefixpath = dir, filename = "node.json"}
+            case mayLogFile of
+                Just logFile -> do
+                    putStrLn ("\nContents of JSON file: " <> (show logFile) :: Text)
+                    contents <- readFile logFile
+                    putStrLn contents
+                    liftIO $ removeFile logFile
+                Nothing -> putStrLn ("JSON file NOT found:" :: Text)