diff --git a/auxx/Main.hs b/auxx/Main.hs index 8846ca0ea1b..881b7e85437 100644 --- a/auxx/Main.hs +++ b/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) diff --git a/explorer/src/explorer/Main.hs b/explorer/src/explorer/Main.hs index 53463e57a0b..133e2a0cb3b 100644 --- a/explorer/src/explorer/Main.hs +++ b/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 diff --git a/explorer/test/Test/Pos/Explorer/Socket/MethodsSpec.hs b/explorer/test/Test/Pos/Explorer/Socket/MethodsSpec.hs index 88149b2b2b1..80b7e0cdca9 100644 --- a/explorer/test/Test/Pos/Explorer/Socket/MethodsSpec.hs +++ b/explorer/test/Test/Pos/Explorer/Socket/MethodsSpec.hs @@ -37,8 +37,7 @@ 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 Pos.Util.Wlog (setupTestLogging) import Test.Pos.Explorer.MockFactory (mkTxOut) @@ -50,7 +49,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_ setupTestLogging $ describe "Methods" $ do describe "fromCAddressOrThrow" $ it "throws an exception if a given CAddress is invalid" $ diff --git a/generator/app/VerificationBench.hs b/generator/app/VerificationBench.hs index be21b656ddd..399ee21740b 100644 --- a/generator/app/VerificationBench.hs +++ b/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) diff --git a/generator/test/Test/Pos/Binary/CommunicationSpec.hs b/generator/test/Test/Pos/Binary/CommunicationSpec.hs index 324fdc59705..2c165430d19 100644 --- a/generator/test/Test/Pos/Binary/CommunicationSpec.hs +++ b/generator/test/Test/Pos/Binary/CommunicationSpec.hs @@ -17,8 +17,7 @@ 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 Pos.Util.Wlog (setupTestLogging) import Test.Pos.Block.Logic.Mode (blockPropertyTestable) import Test.Pos.Block.Logic.Util (EnableTxPayload (..), @@ -72,7 +71,7 @@ deserializeSerilizedMsgSerializedBlockSpec = do descNoBlock = "deserialization of a serialized MsgNoSerializedBlock message should give back corresponding MsgNoBlock" spec :: Spec -spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ +spec = beforeAll_ setupTestLogging $ withStaticConfigurations $ \_ _ -> withCompileInfo $ describe "Pos.Binary.Communication" $ do describe "serializeMsgSerializedBlock" serializeMsgSerializedBlockSpec diff --git a/generator/test/Test/Pos/Block/Logic/VarSpec.hs b/generator/test/Test/Pos/Block/Logic/VarSpec.hs index 931a141254c..58a380e9842 100644 --- a/generator/test/Test/Pos/Block/Logic/VarSpec.hs +++ b/generator/test/Test/Pos/Block/Logic/VarSpec.hs @@ -41,8 +41,7 @@ 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 Pos.Util.Wlog (setupTestLogging) import Test.Pos.Block.Logic.Event (BlockScenarioResult (..), DbNotEquivalentToSnapshot (..), runBlockScenario) @@ -61,7 +60,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_ setupTestLogging $ withStaticConfigurations $ \txpConfig _ -> describe "Block.Logic.VAR" $ modifyMaxSuccess (min 4) $ do describe "verifyBlocksPrefix" $ verifyBlocksPrefixSpec txpConfig describe "verifyAndApplyBlocks" $ verifyAndApplyBlocksSpec txpConfig diff --git a/lib/src/Pos/Launcher/Launcher.hs b/lib/src/Pos/Launcher/Launcher.hs index 346a171150d..c83f587f2fa 100644 --- a/lib/src/Pos/Launcher/Launcher.hs +++ b/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 diff --git a/lib/src/Pos/Launcher/Resource.hs b/lib/src/Pos/Launcher/Resource.hs index 42d1cf3daed..499867e95f3 100644 --- a/lib/src/Pos/Launcher/Resource.hs +++ b/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 diff --git a/lib/test/Test/Pos/Diffusion/BlockSpec.hs b/lib/test/Test/Pos/Diffusion/BlockSpec.hs index 77c64dd1360..d89e734de7c 100644 --- a/lib/test/Test/Pos/Diffusion/BlockSpec.hs +++ b/lib/test/Test/Pos/Diffusion/BlockSpec.hs @@ -45,9 +45,7 @@ import Pos.Infra.Network.Types (Bucket (..)) import Pos.Infra.Reporting.Health.Types (HealthStatus (..)) import Pos.Logic.Pure (pureLogic) import Pos.Logic.Types as Logic (Logic (..)) -import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) -import Pos.Util.Trace (wlogTrace, wsetupLogging) -import Pos.Util.Wlog (Severity (Debug)) +import Pos.Util.Trace (setupTestTrace, wlogTrace) import Test.Pos.Chain.Block.Arbitrary.Generate (generateMainBlock) @@ -122,7 +120,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 $ setupTestTrace -- Morally, the server shouldn't need an outbound queue, but we have to -- give one. oq <- liftIO $ OQ.new diff --git a/lib/test/Test/Pos/Launcher/ConfigurationSpec.hs b/lib/test/Test/Pos/Launcher/ConfigurationSpec.hs index d6503a32ab7..bb49dbca29d 100644 --- a/lib/test/Test/Pos/Launcher/ConfigurationSpec.hs +++ b/lib/test/Test/Pos/Launcher/ConfigurationSpec.hs @@ -11,14 +11,13 @@ import Pos.Core.Slotting (Timestamp (..)) import Pos.Launcher.Configuration (ConfigurationOptions (..), defaultConfigurationOptions, withConfigurationsM) import Pos.Util.Config (ConfigurationException) -import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) -import Pos.Util.Wlog (Severity (Debug), setupLogging) +import Pos.Util.Wlog (setupTestLogging) spec :: Spec spec = describe "Pos.Launcher.Configuration" $ do describe "withConfigurationsM" $ do it "should parse `lib/configuration.yaml` file" $ do - liftIO $ setupLogging (defaultTestConfiguration Debug) + liftIO $ setupTestLogging startTime <- Timestamp . round . (* 1000000) <$> liftIO getPOSIXTime let cfo = defaultConfigurationOptions { cfoFilePath = "./configuration.yaml" diff --git a/networking/src/Bench/Network/Commons.hs b/networking/src/Bench/Network/Commons.hs index e6e7b1d012e..55f8105a376 100644 --- a/networking/src/Bench/Network/Commons.hs +++ b/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 diff --git a/networking/test/Test/NodeSpec.hs b/networking/test/Test/NodeSpec.hs index f3fc0a932e8..540f74e4dbb 100644 --- a/networking/test/Test/NodeSpec.hs +++ b/networking/test/Test/NodeSpec.hs @@ -35,9 +35,7 @@ import Test.QuickCheck.Modifiers (NonEmptyList (..), getNonEmpty) import Node import Node.Message.Binary (binaryPacking) -import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) -import Pos.Util.Trace (wsetupLogging) -import Pos.Util.Wlog (Severity (Debug)) +import Pos.Util.Trace (setupTestTrace) import Test.Util (HeavyParcel (..), Parcel (..), Payload (..), TestState, deliveryTest, expected, makeInMemoryTransport, makeTCPTransport, mkTestState, modifyTestState, @@ -46,7 +44,7 @@ import Test.Util (HeavyParcel (..), Parcel (..), Payload (..), spec :: Spec spec = describe "Node" $ modifyMaxSuccess (const 50) $ do - logTrace <- runIO $ wsetupLogging (defaultTestConfiguration Debug) "nodespec" + logTrace <- runIO $ setupTestTrace -- Take at most 25000 bytes for each Received message. -- We want to ensure that the MTU works, but not make the tests too diff --git a/tools/src/keygen/Main.hs b/tools/src/keygen/Main.hs index f6b28ad06c0..68e94e33906 100644 --- a/tools/src/keygen/Main.hs +++ b/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 diff --git a/tools/src/launcher/Main.hs b/tools/src/launcher/Main.hs index 2de44090747..0e72136f4a0 100644 --- a/tools/src/launcher/Main.hs +++ b/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 diff --git a/util/cardano-sl-util.cabal b/util/cardano-sl-util.cabal index e8338185c6e..d6e0f8e968a 100644 --- a/util/cardano-sl-util.cabal +++ b/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 diff --git a/util/src/Pos/Util/Log.hs b/util/src/Pos/Util/Log.hs index 9ca389d0214..990cb087bc1 100644 --- a/util/src/Pos/Util/Log.hs +++ b/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!" } -} diff --git a/util/src/Pos/Util/Log/Internal.hs b/util/src/Pos/Util/Log/Internal.hs index b8a0d48b90a..23f878cade8 100644 --- a/util/src/Pos/Util/Log/Internal.hs +++ b/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 } diff --git a/util/src/Pos/Util/Trace.hs b/util/src/Pos/Util/Trace.hs index 805e41e3457..ab04a3dc22f 100644 --- a/util/src/Pos/Util/Trace.hs +++ b/util/src/Pos/Util/Trace.hs @@ -13,7 +13,7 @@ module Pos.Util.Trace , Wlog.Severity (..) -- * trace setup , setupLogging - , wsetupLogging + , setupTestTrace , logTrace -- * log messages , logDebug @@ -26,6 +26,7 @@ module Pos.Util.Trace import Data.Functor.Contravariant (Contravariant (..), Op (..)) import qualified Data.Text.IO as TIO import qualified Pos.Util.Log as Log +import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) import qualified Pos.Util.Wlog as Wlog import Universum hiding (trace) @@ -44,20 +45,26 @@ 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 +setupTestTrace :: IO (Trace IO (Wlog.Severity, Text)) +setupTestTrace = + wsetupLogging "test" (defaultTestConfiguration Wlog.Debug) "testing" + trace :: Trace m s -> s -> m () trace = getOp . runTrace diff --git a/util/src/Pos/Util/Trace/Named.hs b/util/src/Pos/Util/Trace/Named.hs index 8e3f98dd0bf..361b28ed99c 100644 --- a/util/src/Pos/Util/Trace/Named.hs +++ b/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,7 +145,7 @@ 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 @@ -153,7 +153,7 @@ 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" -} diff --git a/util/src/Pos/Util/Trace/Unstructured.hs b/util/src/Pos/Util/Trace/Unstructured.hs index c16cdd52228..4c3fae11823 100644 --- a/util/src/Pos/Util/Trace/Unstructured.hs +++ b/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 diff --git a/util/src/Pos/Util/Wlog.hs b/util/src/Pos/Util/Wlog.hs index 965e85b5f83..a261e30329f 100644 --- a/util/src/Pos/Util/Wlog.hs +++ b/util/src/Pos/Util/Wlog.hs @@ -15,6 +15,7 @@ module Pos.Util.Wlog , runNamedPureLog -- * Setup , setupLogging + , setupTestLogging -- * Logging functions , logDebug , logError @@ -55,4 +56,4 @@ import Pos.Util.Wlog.Compatibility (CanLog (..), HasLoggerName (..), launchNamedPureLog, logDebug, logError, logInfo, logMCond, logMessage, logNotice, logWarning, productionB, removeAllHandlers, retrieveLogContent, runNamedPureLog, - setupLogging, usingLoggerName) + setupLogging, setupTestLogging, usingLoggerName) diff --git a/util/src/Pos/Util/Wlog/Compatibility.hs b/util/src/Pos/Util/Wlog/Compatibility.hs index af100fca64c..20f185252f4 100644 --- a/util/src/Pos/Util/Wlog/Compatibility.hs +++ b/util/src/Pos/Util/Wlog/Compatibility.hs @@ -9,6 +9,7 @@ module Pos.Util.Wlog.Compatibility , dispatchEvents , LogEvent (..) , setupLogging + , setupTestLogging -- * Logging functions , logDebug , logError @@ -56,8 +57,8 @@ import qualified Pos.Util.Log as Log import qualified Pos.Util.Log.Internal as Internal import Pos.Util.Log.LoggerConfig (LogHandler (..), LogSecurityLevel (..), LoggerConfig (..), - defaultInteractiveConfiguration, lcLoggerTree, lhName, - ltHandlers) + defaultInteractiveConfiguration, defaultTestConfiguration, + lcLoggerTree, lhName, ltHandlers) import System.IO.Unsafe (unsafePerformIO) import Universum @@ -226,11 +227,15 @@ loggingHandler :: MVar LoggingHandler loggingHandler = unsafePerformIO $ do newMVar $ error "LoggingHandler MVar is not initialized." +-- | setup logging used in tests +setupTestLogging :: IO () +setupTestLogging = setupLogging "test" (defaultTestConfiguration Debug) + -- | 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. diff --git a/util/test/Test/Pos/Util/LogSpec.hs b/util/test/Test/Pos/Util/LogSpec.hs index c6fc5666784..598b6f27079 100644 --- a/util/test/Test/Pos/Util/LogSpec.hs +++ b/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!" } diff --git a/util/test/Test/Pos/Util/TraceSpec.hs b/util/test/Test/Pos/Util/TraceSpec.hs index 65119e23bb9..dbbd8b6e979 100644 --- a/util/test/Test/Pos/Util/TraceSpec.hs +++ b/util/test/Test/Pos/Util/TraceSpec.hs @@ -74,7 +74,7 @@ run_logging :: Log.Severity -> Int -> Integer -> Integer -> IO (Microsecond, Int run_logging sev n n0 n1= do startTime <- getPOSIXTime {- -} - lh <- Log.setupLogging (defaultTestConfiguration sev) + lh <- Log.setupLogging "test" (defaultTestConfiguration sev) let logTrace' = Tr.logTrace lh "processXYZ" forM_ [1..n0] $ \_ -> forM_ [1..n1] $ \_ -> do @@ -98,7 +98,7 @@ run_loggingS :: Log.Severity -> Int -> Integer -> Integer -> IO (Microsecond, In run_loggingS sev n n0 n1= do startTime <- getPOSIXTime {- -} - lh <- Log.setupLogging (defaultTestConfiguration sev) + lh <- Log.setupLogging "test" (defaultTestConfiguration sev) let logTrace' = Tn.appendName "run_loggingS" $ Tn.namedTrace lh Tn.logInfo logTrace' "entering" @@ -123,7 +123,7 @@ run_loggingS sev n n0 n1= do -- | example: setup trace example_setup :: IO () example_setup = do - logTrace' <- Tr.setupLogging (defaultTestConfiguration Log.Debug) "example" + logTrace' <- Tr.setupLogging "test" (defaultTestConfiguration Log.Debug) "example" Tr.traceWith logTrace' (Log.Info, "entering") complexWork logTrace' "42" Tr.traceWith logTrace' (Log.Info, "done.") @@ -135,7 +135,7 @@ example_setup = do -- | example: unstructured trace example_unstructured :: IO () example_unstructured = do - logTrace' <- Tu.setupLogging (defaultTestConfiguration Log.Debug) "unstructured" + logTrace' <- Tu.setupLogging "test" (defaultTestConfiguration Log.Debug) "unstructured" Tu.logInfo logTrace' "entering" complexWork logTrace' "42" Tu.logInfo logTrace' "done." @@ -147,7 +147,7 @@ example_unstructured = do -- | example: named context trace example_named :: IO () example_named = do - logTrace' <- Tn.setupLogging (defaultInteractiveConfiguration Log.Debug) "named" + logTrace' <- Tn.setupLogging "test" (defaultInteractiveConfiguration Log.Debug) "named" Tn.logInfo logTrace' "entering" complexWork (Tn.appendName "complex" logTrace') "42" -- ^ the named context will include "complex" in the logged message diff --git a/util/test/Test/Pos/Util/WlogSpec.hs b/util/test/Test/Pos/Util/WlogSpec.hs index baea1797e9a..08f24c5671e 100644 --- a/util/test/Test/Pos/Util/WlogSpec.hs +++ b/util/test/Test/Pos/Util/WlogSpec.hs @@ -100,7 +100,7 @@ spec = describe "Logging" $ do let lc0 = defaultTestConfiguration Debug newlt = lc0 ^. lcLoggerTree & ltNamedSeverity .~ HM.fromList [("cardano-sl.silent", Error)] lc = lc0 & lcLoggerTree .~ newlt - setupLogging lc + setupLogging "test" lc modifyMaxSuccess (const 1) $ modifyMaxSize (const 1) $ it "demonstrate logging" $ diff --git a/wallet-new/integration/TransactionSpecs.hs b/wallet-new/integration/TransactionSpecs.hs index 414b9d9fe01..6a6f537c382 100644 --- a/wallet-new/integration/TransactionSpecs.hs +++ b/wallet-new/integration/TransactionSpecs.hs @@ -31,7 +31,7 @@ ppShowT :: Show a => a -> Text ppShowT = fromString . ppShow transactionSpecs :: WalletRef -> WalletClient IO -> Spec -transactionSpecs wRef wc = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ +transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs" (defaultTestConfiguration Debug)) $ describe "Transactions" $ do randomTest "posted transactions appear in the index" 1 $ do diff --git a/wallet-new/test/InternalAPISpec.hs b/wallet-new/test/InternalAPISpec.hs index 9dd6c9beb9a..1b7e96a4ac6 100644 --- a/wallet-new/test/InternalAPISpec.hs +++ b/wallet-new/test/InternalAPISpec.hs @@ -20,8 +20,7 @@ import Pos.Client.KeyStorage (getSecretKeysPlain) import Pos.Wallet.Web.Account (genSaveRootKey) import Pos.Launcher (HasConfigurations) -import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) -import Pos.Util.Wlog (Severity (Debug), setupLogging) +import Pos.Util.Wlog (setupTestLogging) import Test.Pos.Util.QuickCheck.Property (assertProperty) import Test.Hspec (Spec, beforeAll_, describe) @@ -37,7 +36,7 @@ import Servant {-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-} spec :: Spec -spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ +spec = beforeAll_ setupTestLogging $ withDefConfigurations $ \_ _ _ -> describe "development endpoint" $ describe "secret-keys" $ modifyMaxSuccess (const 10) deleteAllSecretKeysSpec diff --git a/wallet/test/Test/Pos/Wallet/Web/AddressSpec.hs b/wallet/test/Test/Pos/Wallet/Web/AddressSpec.hs index 6d0fa7e2416..084e1978d09 100644 --- a/wallet/test/Test/Pos/Wallet/Web/AddressSpec.hs +++ b/wallet/test/Test/Pos/Wallet/Web/AddressSpec.hs @@ -20,8 +20,7 @@ import Pos.Client.Txp.Addresses (getFakeChangeAddress, getNewAddress) import Pos.Core.Common (Address) import Pos.Crypto (PassPhrase) -import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) -import Pos.Util.Wlog (Severity (Debug), setupLogging) +import Pos.Util.Wlog (setupTestLogging) import Pos.Wallet.Web.Account (GenSeed (..), genUniqueAddress) import Pos.Wallet.Web.ClientTypes (AccountId, CAccountInit (..), caId) import Pos.Wallet.Web.Error (WalletError (..)) @@ -37,7 +36,7 @@ import Test.Pos.Wallet.Web.Util (importSingleWallet, mostlyEmptyPassphrases) spec :: Spec -spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ +spec = beforeAll_ setupTestLogging $ withDefConfigurations $ \_ _ _ -> describe "Fake address has maximal possible size" $ modifyMaxSuccess (const 10) $ do diff --git a/wallet/test/Test/Pos/Wallet/Web/Methods/BackupDefaultAddressesSpec.hs b/wallet/test/Test/Pos/Wallet/Web/Methods/BackupDefaultAddressesSpec.hs index 4b092d0ce94..95ad0fc915e 100644 --- a/wallet/test/Test/Pos/Wallet/Web/Methods/BackupDefaultAddressesSpec.hs +++ b/wallet/test/Test/Pos/Wallet/Web/Methods/BackupDefaultAddressesSpec.hs @@ -9,8 +9,7 @@ import Universum import Pos.Launcher (HasConfigurations) -import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) -import Pos.Util.Wlog (Severity (Debug), setupLogging) +import Pos.Util.Wlog (setupTestLogging) import Pos.Wallet.Web.ClientTypes (CWallet (..)) import Pos.Wallet.Web.Methods.Restore (restoreWalletFromBackup) import Test.Hspec (Spec, beforeAll_, describe) @@ -23,7 +22,7 @@ import Test.QuickCheck (Arbitrary (..)) import Test.QuickCheck.Monadic (pick) spec :: Spec -spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ +spec = beforeAll_ setupTestLogging $ withDefConfigurations $ \_ _ _ -> describe "restoreAddressFromWalletBackup" $ modifyMaxSuccess (const 10) $ do restoreWalletAddressFromBackupSpec diff --git a/wallet/test/Test/Pos/Wallet/Web/Methods/LogicSpec.hs b/wallet/test/Test/Pos/Wallet/Web/Methods/LogicSpec.hs index 3b0f0bf976f..b82a391dcdb 100644 --- a/wallet/test/Test/Pos/Wallet/Web/Methods/LogicSpec.hs +++ b/wallet/test/Test/Pos/Wallet/Web/Methods/LogicSpec.hs @@ -10,8 +10,7 @@ import Universum import Test.Hspec (Spec, beforeAll_, describe) import Test.Hspec.QuickCheck (prop) -import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) -import Pos.Util.Wlog (Severity (Debug), setupLogging) +import Pos.Util.Wlog (setupTestLogging) import Pos.Wallet.Web.Methods.Logic (getAccounts, getWallets) import Test.Pos.Configuration (withDefConfigurations) @@ -20,7 +19,7 @@ import Test.Pos.Wallet.Web.Mode (WalletProperty) -- TODO remove HasCompileInfo when MonadWalletWebMode will be splitted. spec :: Spec -spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ +spec = beforeAll_ setupTestLogging $ withDefConfigurations $ \_ _ _ -> describe "Pos.Wallet.Web.Methods" $ do prop emptyWalletOnStarts emptyWallet diff --git a/wallet/test/Test/Pos/Wallet/Web/Methods/PaymentSpec.hs b/wallet/test/Test/Pos/Wallet/Web/Methods/PaymentSpec.hs index 738d9be3b86..96d544506b0 100644 --- a/wallet/test/Test/Pos/Wallet/Web/Methods/PaymentSpec.hs +++ b/wallet/test/Test/Pos/Wallet/Web/Methods/PaymentSpec.hs @@ -44,9 +44,8 @@ import qualified Pos.Wallet.Web.State.State as WS import Pos.Wallet.Web.State.Storage (AddressInfo (..), wamAddress) import Pos.Wallet.Web.Util (decodeCTypeOrFail, getAccountAddrsOrThrow) -import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) import Pos.Util.Servant (encodeCType) -import Pos.Util.Wlog (Severity (Debug), setupLogging) +import Pos.Util.Wlog (setupTestLogging) import Test.Pos.Chain.Genesis.Dummy (dummyConfig, dummyGenesisData) import Test.Pos.Configuration (withDefConfigurations) @@ -63,7 +62,7 @@ deriving instance Eq CTx -- TODO remove HasCompileInfo when MonadWalletWebMode will be splitted. spec :: Spec -spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ +spec = beforeAll_ setupTestLogging $ withCompileInfo $ withDefConfigurations $ \_ txpConfig _ -> describe "Wallet.Web.Methods.Payment" $ modifyMaxSuccess (const 10) $ do diff --git a/wallet/test/Test/Pos/Wallet/Web/Tracking/SyncSpec.hs b/wallet/test/Test/Pos/Wallet/Web/Tracking/SyncSpec.hs index 8b3298eb49d..4247c0a2c2c 100644 --- a/wallet/test/Test/Pos/Wallet/Web/Tracking/SyncSpec.hs +++ b/wallet/test/Test/Pos/Wallet/Web/Tracking/SyncSpec.hs @@ -25,8 +25,7 @@ import Pos.Core.Chrono (nonEmptyOldestFirst, toNewestFirst) import Pos.Crypto (emptyPassphrase) import Pos.DB.Block (rollbackBlocks) import Pos.Launcher (HasConfigurations) -import Pos.Util.Log.LoggerConfig (defaultTestConfiguration) -import Pos.Util.Wlog (Severity (Debug), setupLogging) +import Pos.Util.Wlog (setupTestLogging) import qualified Pos.Wallet.Web.State as WS import Pos.Wallet.Web.State.Storage (WalletStorage (..)) import Pos.Wallet.Web.Tracking.Decrypt (WalletDecrCredentialsKey (..), @@ -51,7 +50,7 @@ import Test.Pos.Wallet.Web.Mode (walletPropertySpec) import Test.Pos.Wallet.Web.Util (importSomeWallets, wpGenBlocks) spec :: Spec -spec = beforeAll_ (setupLogging (defaultTestConfiguration Debug)) $ +spec = beforeAll_ setupTestLogging $ withDefConfigurations $ \_ _ _ -> do describe "Pos.Wallet.Web.Tracking.BListener" $ modifyMaxSuccess (const 10) $ do describe "Two applications and rollbacks" twoApplyTwoRollbacksSpec