Merge pull request #3533 from input-output-hk/adiemand/CBR-275/mimic-…

…logging-interface

[CBR-275] stack logging ontop of 'katip', provides structured logging

.gitignore

@@ -5,6 +5,10 @@
 # From daedalus-bridge
 node_modules/*
 
+# tags
+*.tags
+tags
+
 # Config files
 .ghci
 

core/src/Pos/Core/Util/LogSafe.hs

@@ -1,19 +1,3 @@
-{-# LANGUAGE ConstraintKinds            #-}
-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE ExistentialQuantification  #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GADTs                      #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures             #-}
-{-# LANGUAGE LambdaCase                 #-}
-{-# LANGUAGE Rank2Types                 #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeApplications           #-}
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE UndecidableInstances       #-}
-
 -- | Safe/secure logging
 
 module Pos.Core.Util.LogSafe
@@ -61,6 +45,7 @@ module Pos.Core.Util.LogSafe
        , buildUnsecure
        , getSecuredText
        , deriveSafeBuildable
+       , logMCond
        ) where
 
 -- Universum has its own Rube Goldberg variant of 'Foldable' which we do not
@@ -72,8 +57,7 @@ module Pos.Core.Util.LogSafe
 import           Universum
 
 import           Control.Monad.Trans (MonadTrans)
-import           Data.Foldable (Foldable, length, null)
-import           Data.List (isSuffixOf)
+import           Data.Foldable (length, null)
 import           Data.Reflection (Reifies (..), reify)
 import           Data.Text.Lazy.Builder (Builder)
 import           Formatting (bprint, build, fconst, later, mapf, (%))
@@ -84,8 +68,10 @@ import qualified Language.Haskell.TH as TH
 import           Pos.Core (Timestamp)
 import           Pos.Core.Common (Address, Coin)
 import           Pos.Crypto (PassPhrase)
-import           Pos.Util.Wlog (CanLog (..), HasLoggerName (..),
-                     LogHandlerTag (HandlerFilelike), Severity (..), logMCond)
+
+import           Pos.Util.Log.LoggerConfig (LogSecurityLevel (..))
+import           Pos.Util.Wlog.Compatibility (CanLog (..), HasLoggerName (..),
+                     SelectionMode, Severity (..), logMCond)
 
 ----------------------------------------------------------------------------
 -- Logging
@@ -99,13 +85,10 @@ newtype SelectiveLogWrapped s m a = SelectiveLogWrapped
 instance MonadTrans (SelectiveLogWrapped s) where
     lift = SelectiveLogWrapped
 
--- | Whether to log to given log handler.
-type SelectionMode = LogHandlerTag -> Bool
-
 selectPublicLogs :: SelectionMode
 selectPublicLogs = \case
-    HandlerFilelike p -> ".pub" `isSuffixOf` p
-    _ -> False
+    PublicLogLevel -> True
+    _              -> False
 
 selectSecretLogs :: SelectionMode
 selectSecretLogs = not . selectPublicLogs
@@ -133,8 +116,7 @@ logNoticeS  = logMessageS Notice
 logWarningS = logMessageS Warning
 logErrorS   = logMessageS Error
 
--- | Same as 'logMesssage', but log to secret logs, put only insecure
--- version to memmode (to terminal).
+-- | Same as 'logMesssage', but log to secret logs.
 logMessageS
     :: (HasLoggerName m, MonadIO m)
     => Severity
@@ -181,11 +163,6 @@ newtype SecureLog a = SecureLog
     { getSecureLog :: a
     } deriving (Eq, Ord)
 
-data LogSecurityLevel
-    = SecretLogLevel
-    | PublicLogLevel
-    deriving (Eq)
-
 secure :: LogSecurityLevel
 secure = PublicLogLevel
 

db/src/Pos/DB/Update/Logic/Global.hs

@@ -79,7 +79,7 @@ type USGlobalApplyMode ctx m =
 ----------------------------------------------------------------------------
 
 withUSLogger :: WithLogger m => m a -> m a
-withUSLogger = modifyLoggerName (<> "us")
+withUSLogger = modifyLoggerName (<> ".us")
 
 -- | Apply chain of /definitely/ valid blocks to US part of GState DB
 -- and to US local data. This function assumes that no other thread

explorer/src/Pos/Explorer/ExplorerMode.hs

@@ -41,7 +41,7 @@ import           Pos.Infra.Slotting (HasSlottingVar (..), MonadSlots (..),
 import qualified Pos.Infra.Slotting as Slot
 import           Pos.Util (postfixLFields)
 import           Pos.Util.Util (HasLens (..))
-import           Pos.Util.Wlog (CanLog, HasLoggerName (..), LoggerName (..))
+import           Pos.Util.Wlog (CanLog, HasLoggerName (..), LoggerName)
 
 import           Pos.Explorer.ExtraContext (ExtraContext, ExtraContextT,
                      HasExplorerCSLInterface, HasGenesisRedeemAddressInfo,

explorer/src/Pos/Explorer/Socket/App.hs

@@ -228,7 +228,7 @@ notifierApp
     -> NotifierSettings
     -> m ()
 notifierApp genesisConfig settings =
-    modifyLoggerName (<> "notifier.socket-io") $ do
+    modifyLoggerName (<> ".notifier.socket-io") $ do
         logInfo "Starting"
         connVar <- liftIO $ STM.newTVarIO mkConnectionsState
         withAsync (periodicPollChanges genesisConfig connVar)

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

@@ -15,8 +15,8 @@ import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import           Network.EngineIO (SocketId)
 
-import           Test.Hspec (Spec, anyException, describe, it, shouldBe,
-                     shouldThrow)
+import           Test.Hspec (Spec, anyException, beforeAll_, describe, it,
+                     shouldBe, shouldThrow)
 import           Test.Hspec.QuickCheck (modifyMaxSize, prop)
 import           Test.QuickCheck (Property, arbitrary, forAll)
 import           Test.QuickCheck.Monadic (assert, monadicIO, run)
@@ -37,6 +37,8 @@ import           Pos.Explorer.Socket.Methods (addrSubParam, addressSetByTxs,
                      unsubscribeTxs)
 import           Pos.Explorer.TestUtil (secretKeyToAddress)
 import           Pos.Explorer.Web.ClientTypes (CAddress (..), toCAddress)
+import           Pos.Util.Log.LoggerConfig (defaultTestConfiguration)
+import           Pos.Util.Wlog (Severity (Debug), setupLogging)
 
 import           Test.Pos.Explorer.MockFactory (mkTxOut)
 
@@ -48,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 =
+spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $
     describe "Methods" $ do
         describe "fromCAddressOrThrow" $
             it "throws an exception if a given CAddress is invalid" $

generator/app/VerificationBench.hs

@@ -40,10 +40,10 @@ import           Pos.Launcher.Configuration (ConfigurationOptions (..),
                      HasConfigurations, defaultConfigurationOptions,
                      withConfigurationsM)
 import           Pos.Util.CompileInfo (withCompileInfo)
+import           Pos.Util.Log.LoggerConfig (defaultInteractiveConfiguration)
 import           Pos.Util.Util (realTime)
-import           Pos.Util.Wlog (LoggerConfig, LoggerName (..), consoleActionB,
-                     debugPlus, defaultHandleAction, logError, logInfo,
-                     setupLogging, termSeveritiesOutB)
+import           Pos.Util.Wlog (LoggerConfig, Severity (Debug), logError,
+                     logInfo, setupLogging)
 
 import           Test.Pos.Block.Logic.Mode (BlockTestMode, TestParams (..),
                      runBlockTestMode)
@@ -183,7 +183,7 @@ readBlocks path = do
 
 main :: IO ()
 main = do
-    setupLogging Nothing loggerConfig
+    setupLogging loggerConfig
     args <- Opts.execParser
         $ Opts.info
             (benchArgsParser <**> Opts.helper)
@@ -198,7 +198,7 @@ main = do
             , cfoSystemStart = Just (Timestamp startTime)
             }
     withCompileInfo $
-        withConfigurationsM (LoggerName "verification-bench") Nothing Nothing False cfo $ \ !genesisConfig !_ !txpConfig !_ -> do
+        withConfigurationsM "verification-bench" Nothing Nothing False cfo $ \ !genesisConfig !_ !txpConfig !_ -> do
             let genesisConfig' = genesisConfig
                     { configProtocolConstants =
                         (configProtocolConstants genesisConfig) { pcK = baK args }
@@ -261,8 +261,7 @@ main = do
                         traverse_ (logError . show) errs
     where
         loggerConfig :: LoggerConfig
-        loggerConfig = termSeveritiesOutB debugPlus
-                <> consoleActionB defaultHandleAction
+        loggerConfig = defaultInteractiveConfiguration Debug
 
         avarage :: [Float] -> Float
         avarage as = sum as / realToFrac (length as)

generator/bench/Bench/Pos/Criterion/Block/Logic.hs

@@ -41,7 +41,6 @@ import           Pos.Launcher.Configuration (ConfigurationOptions (..),
                      withConfigurationsM)
 import           Pos.Util.CompileInfo (withCompileInfo)
 import           Pos.Util.Util (realTime)
-import           Pos.Util.Wlog (LoggerName (..))
 
 import           Test.Pos.Block.Logic.Emulation (runEmulation, sudoLiftIO)
 import           Test.Pos.Block.Logic.Mode (BlockTestContext, BlockTestMode,
@@ -228,7 +227,7 @@ runBenchmark = do
             , cfoSystemStart = Just (Timestamp startTime)
             }
     withCompileInfo
-        $ withConfigurationsM (LoggerName "verifyBenchmark") Nothing Nothing False cfo
+        $ withConfigurationsM "verifyBenchmark" Nothing Nothing False cfo
         $ \genesisConfig _ txpConfig _ -> do
             let tp = TestParams
                     { _tpStartTime = Timestamp (convertUnit startTime)

generator/cardano-sl-generator.cabal

@@ -192,7 +192,6 @@ benchmark cardano-sl-verification-bench
                       , cardano-sl-generator
                       , cardano-sl-util
                       , criterion
-                      , log-warper
                       , MonadRandom
                       , QuickCheck
                       , random

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

@@ -6,7 +6,7 @@ import           Universum
 
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.Set as Set
-import           Test.Hspec (Spec, describe)
+import           Test.Hspec (Spec, beforeAll_, describe)
 import           Test.Hspec.QuickCheck (prop)
 import           Test.QuickCheck.Monadic (assert)
 
@@ -17,6 +17,8 @@ import           Pos.DB.Class (Serialized (..))
 import           Pos.Network.Block.Types (MsgBlock (..),
                      MsgSerializedBlock (..))
 import           Pos.Util.CompileInfo (withCompileInfo)
+import           Pos.Util.Log.LoggerConfig (defaultTestConfiguration)
+import           Pos.Util.Wlog (Severity (Debug), setupLogging)
 
 import           Test.Pos.Block.Logic.Mode (blockPropertyTestable)
 import           Test.Pos.Block.Logic.Util (EnableTxPayload (..),
@@ -70,7 +72,8 @@ deserializeSerilizedMsgSerializedBlockSpec = do
     descNoBlock = "deserialization of a serialized MsgNoSerializedBlock message should give back corresponding MsgNoBlock"
 
 spec :: Spec
-spec = withStaticConfigurations $ \_ _ -> withCompileInfo $
-    describe "Pos.Binary.Communication" $ do
-        describe "serializeMsgSerializedBlock" serializeMsgSerializedBlockSpec
-        describe "decode is left inverse of serializeMsgSerializedBlock" deserializeSerilizedMsgSerializedBlockSpec
+spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $
+    withStaticConfigurations $ \_ _ -> withCompileInfo $
+        describe "Pos.Binary.Communication" $ do
+            describe "serializeMsgSerializedBlock" serializeMsgSerializedBlockSpec
+            describe "decode is left inverse of serializeMsgSerializedBlock" deserializeSerilizedMsgSerializedBlockSpec

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

@@ -16,7 +16,7 @@ import           Data.List.NonEmpty (NonEmpty ((:|)))
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Ratio as Ratio
 import           Data.Semigroup ((<>))
-import           Test.Hspec (Spec, describe)
+import           Test.Hspec (Spec, beforeAll_, describe)
 import           Test.Hspec.QuickCheck (modifyMaxSuccess)
 import           Test.QuickCheck.Gen (Gen (MkGen))
 import           Test.QuickCheck.Monadic (assert, pick, pre)
@@ -41,6 +41,8 @@ import           Pos.Generator.BlockEvent.DSL (BlockApplyResult (..),
                      runBlockEventGenT)
 import qualified Pos.GState as GS
 import           Pos.Launcher (HasConfigurations)
+import           Pos.Util.Log.LoggerConfig (defaultTestConfiguration)
+import           Pos.Util.Wlog (Severity (Debug), setupLogging)
 
 import           Test.Pos.Block.Logic.Event (BlockScenarioResult (..),
                      DbNotEquivalentToSnapshot (..), runBlockScenario)
@@ -59,7 +61,7 @@ import           Test.Pos.Util.QuickCheck.Property (splitIntoChunks,
 spec :: Spec
 -- Unfortunatelly, blocks generation is quite slow nowdays.
 -- See CSL-1382.
-spec = withStaticConfigurations $ \txpConfig _ ->
+spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ withStaticConfigurations $ \txpConfig _ ->
     describe "Block.Logic.VAR" $ modifyMaxSuccess (min 4) $ do
         describe "verifyBlocksPrefix" $ verifyBlocksPrefixSpec txpConfig
         describe "verifyAndApplyBlocks" $ verifyAndApplyBlocksSpec txpConfig

infra/src/Pos/Infra/Network/Types.hs

@@ -72,7 +72,7 @@ import           Pos.Infra.Reporting.Health.Types (HealthStatus (..))
 import           Pos.Infra.Util.TimeWarp (addressToNodeId)
 import           Pos.Util.Trace (wlogTrace)
 import           Pos.Util.Util (HasLens', lensOf)
-import           Pos.Util.Wlog (LoggerName (..))
+import           Pos.Util.Wlog (LoggerName)
 
 {-------------------------------------------------------------------------------
   Network configuration
@@ -455,7 +455,7 @@ initQueue :: (MonadIO m, FormatMsg msg)
           -> m (OutboundQ msg NodeId Bucket)
 initQueue NetworkConfig{..} loggerName mStore = liftIO $ do
     let NodeName selfName = fromMaybe (NodeName "self") ncSelfName
-        oqTrace           = wlogTrace (loggerName <> LoggerName selfName)
+        oqTrace           = wlogTrace (loggerName <> "." <> selfName)
     oq <- OQ.new oqTrace
                  ncEnqueuePolicy
                  ncDequeuePolicy

infra/src/Pos/Infra/Reporting/Wlog.hs

@@ -4,7 +4,6 @@
 module Pos.Infra.Reporting.Wlog
     ( withWlogTempFile
     , readWlogFile
-    , retrieveLogFiles
     , compressLogs
     , withTempLogFile
     , LoggerConfig (..)
@@ -14,24 +13,24 @@ import           Universum
 
 import qualified Codec.Archive.Tar as Tar
 import qualified Codec.Archive.Tar.Entry as Tar
-import           Control.Lens (each, to)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
 import           Data.Conduit (runConduitRes, yield, (.|))
 import           Data.Conduit.List (consume)
 import qualified Data.Conduit.Lzma as Lzma
-import qualified Data.HashMap.Strict as HM
-import           Data.List (isSuffixOf)
+import           Data.List (isInfixOf)
 import qualified Data.Text.IO as TIO
 import           Data.Time.Clock (getCurrentTime)
 import           Data.Time.Format (defaultTimeLocale, formatTime)
 import           System.Directory (canonicalizePath, doesFileExist,
                      getTemporaryDirectory, removeFile)
-import           System.FilePath (takeFileName)
+import           System.FilePath (takeFileName, (</>))
 import           System.IO (IOMode (WriteMode), hClose, hFlush, withFile)
 
-import           Pos.Util.Wlog (LoggerConfig (..), LoggerName, hwFilePath,
-                     lcTree, ltFiles, ltSubloggers, retrieveLogContent)
+import           Pos.Util.Wlog (LoggerConfig (..), retrieveLogContent)
+
+import           Pos.Util.Log.LoggerConfig (lcBasePath, retrieveLogFiles)
+
 
 -- FIXME we get PackingError from here, but it should defined locally, since
 -- it's log-warper specific.
@@ -65,8 +64,11 @@ readWlogFile logConfig = case mLogFile of
   where
     -- Grab all public log files, using the 'LoggerConfig', and take the
     -- first one.
-    allFiles = map snd $ retrieveLogFiles logConfig
-    mLogFile = (fmap fst . uncons) (filter (".pub" `isSuffixOf`) allFiles)
+    basepath = fromMaybe "./" $ logConfig ^. lcBasePath
+    allFiles = map ((</> basepath) . snd) $ retrieveLogFiles logConfig
+    mLogFile = case filter (".json" `isInfixOf`) allFiles of
+                    []    -> Nothing
+                    (f:_) -> Just f
     -- 2 megabytes, assuming we use chars which are ASCII mostly
     charsConst :: Int
     charsConst = 1024 * 1024 * 2
@@ -76,17 +78,6 @@ readWlogFile logConfig = case mLogFile of
         let delta = curLimit - length t
         in bool [] (t : (takeGlobalSize delta xs)) (delta > 0)
 
--- | Given logger config, retrieves all (logger name, filepath) for
--- every logger that has file handle. Filepath inside does __not__
--- contain the common logger config prefix.
-retrieveLogFiles :: LoggerConfig -> [([LoggerName], FilePath)]
-retrieveLogFiles lconfig = fromLogTree $ lconfig ^. lcTree
-  where
-    fromLogTree lt =
-        let curElems = map ([],) (lt ^.. ltFiles . each . hwFilePath)
-            iterNext (part, node) = map (first (part :)) $ fromLogTree node
-        in curElems ++ concatMap iterNext (lt ^. ltSubloggers . to HM.toList)
-
 -- | Pass a list of absolute paths to log files. This function will
 -- archive and compress these files and put resulting file into log
 -- directory (returning filepath is absolute).

infra/src/Pos/Infra/Slotting/Util.hs

@@ -189,13 +189,13 @@ onNewSlotDo epochSlots withLogging expectedSlotId onsp action = do
     shortDelay = 42
     recoveryRefreshDelay :: Millisecond
     recoveryRefreshDelay = 150
-    logTTW timeToWait = modifyLoggerName (<> "slotting") $ logDebug $
+    logTTW timeToWait = modifyLoggerName (<> ".slotting") $ logDebug $
                  sformat ("Waiting for "%shown%" before new slot") timeToWait
 
 logNewSlotWorker :: MonadOnNewSlot ctx m => SlotCount -> m ()
 logNewSlotWorker epochSlots =
     onNewSlotWithLogging epochSlots defaultOnNewSlotParams $ \slotId -> do
-        modifyLoggerName (<> "slotting") $
+        modifyLoggerName (<> ".slotting") $
             logNotice $ sformat ("New slot has just started: " %slotIdF) slotId
 
 -- | Wait until system starts. This function is useful if node is