Skip to content
This repository was archived by the owner on Aug 18, 2020. It is now read-only.

Commit cb8dae3

Browse files
CodiePPCodiePP
authored
Merge pull request #3523 from input-output-hk/adiemand/CBR-348/logger-tree-severity-filter
[CBR-348] log-config defines Loggername - Severity mapping
2 parents cc689a6 + c08e421 commit cb8dae3

File tree

5 files changed

+109
-39
lines changed

5 files changed

+109
-39
lines changed

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

Lines changed: 22 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,7 @@ import Data.Text.Lazy.Builder
4343
import Pos.Util.Log.Internal (LoggingHandler)
4444
import qualified Pos.Util.Log.Internal as Internal
4545
import Pos.Util.Log.LoggerConfig
46+
import Pos.Util.Log.LoggerName (LoggerName)
4647
import Pos.Util.Log.Scribes
4748
import Pos.Util.Log.Severity (Severity (..))
4849

@@ -56,8 +57,6 @@ type LogContextT = K.KatipContextT
5657

5758
type WithLogger m = (CanLog m)
5859

59-
type LoggerName = Text
60-
6160
-- -- | compatibility
6261
class (MonadIO m, LogContext m) => CanLog m where
6362
dispatchMessage :: LoggingHandler -> Severity -> Text -> m ()
@@ -121,8 +120,11 @@ setupLogging lc = do
121120
-- setup scribes according to configuration
122121
let lhs = _lc ^. lcLoggerTree ^. ltHandlers ^.. each
123122
basepath = _lc ^. lcBasePath
123+
sevfilter = _lc ^. lcLoggerTree ^. ltNamedSeverity
124124
-- default rotation parameters: max. 24 hours, max. 10 files kept, max. size 5 MB
125-
rotation = fromMaybe (RotationParameters {_rpMaxAgeHours=24,_rpKeepFilesNum=10,_rpLogLimitBytes=5*1000*1000})
125+
rotation = fromMaybe (RotationParameters { _rpMaxAgeHours=24,
126+
_rpKeepFilesNum=10,
127+
_rpLogLimitBytes=5*1000*1000 })
126128
(_lc ^. lcRotation)
127129
forM lhs (\lh -> case (lh ^. lhBackend) of
128130
FileJsonBE -> do
@@ -132,8 +134,9 @@ setupLogging lc = do
132134
nm = lh ^. lhName
133135
scribe <- mkJsonFileScribe
134136
rotation
137+
sevfilter
135138
fdesc
136-
(Internal.sev2klog $ fromMaybe Debug $ lh ^. lhMinSeverity)
139+
(fromMaybe Debug $ lh ^. lhMinSeverity)
137140
K.V0
138141
return (nm, scribe)
139142
FileTextBE -> do
@@ -143,24 +146,28 @@ setupLogging lc = do
143146
nm = lh ^. lhName
144147
scribe <- mkTextFileScribe
145148
rotation
149+
sevfilter
146150
fdesc
147151
True
148-
(Internal.sev2klog $ fromMaybe Debug $ lh ^. lhMinSeverity)
152+
(fromMaybe Debug $ lh ^. lhMinSeverity)
149153
K.V0
150154
return (nm, scribe)
151155
StdoutBE -> do
152156
scribe <- mkStdoutScribe
153-
(Internal.sev2klog $ fromMaybe Debug $ lh ^. lhMinSeverity)
157+
sevfilter
158+
(fromMaybe Debug $ lh ^. lhMinSeverity)
154159
K.V0
155160
return (lh ^. lhName, scribe)
156161
StderrBE -> do
157162
scribe <- mkStderrScribe
158-
(Internal.sev2klog $ fromMaybe Debug $ lh ^. lhMinSeverity)
163+
sevfilter
164+
(fromMaybe Debug $ lh ^. lhMinSeverity)
159165
K.V0
160166
return (lh ^. lhName, scribe)
161167
DevNullBE -> do
162168
scribe <- mkDevNullScribe _lh
163-
(Internal.sev2klog $ fromMaybe Debug $ lh ^. lhMinSeverity)
169+
sevfilter
170+
(fromMaybe Debug $ lh ^. lhMinSeverity)
164171
K.V0
165172
return (lh ^. lhName, scribe)
166173
)
@@ -238,5 +245,12 @@ loggerBracket lh name action = do
238245
239246
>>> lh <- setupLogging $ defaultInteractiveConfiguration Info
240247
>>> usingLoggerName lh "testmore" $ do { logInfo "hello..." }
248+
249+
>>> lc0 <- return $ defaultInteractiveConfiguration Info
250+
>>> newlt <- return $ lc0 ^. lcLoggerTree & ltNamedSeverity .~ Data.HashMap.Strict.fromList [("cardano-sl.silent", Error)]
251+
>>> lc <- return $ lc0 & lcLoggerTree .~ newlt
252+
>>> lh <- setupLogging lc
253+
>>> usingLoggerName lh "silent" $ do { logWarning "you won't see this!" }
254+
>>> usingLoggerName lh "verbose" $ do { logWarning "now you read this!" }
241255
-}
242256

‎util/src/Pos/Util/Log/LoggerConfig.hs‎

Lines changed: 29 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module Pos.Util.Log.LoggerConfig
88
, RotationParameters (..)
99
, LogHandler (..)
1010
, LoggerTree (..)
11+
, NamedSeverity
1112
, BackendKind (..)
1213
, LogSecurityLevel (..)
1314
, defaultTestConfiguration
@@ -20,6 +21,7 @@ module Pos.Util.Log.LoggerConfig
2021
, lcBasePath
2122
, ltHandlers
2223
, ltMinSeverity
24+
, ltNamedSeverity
2325
, rpKeepFilesNum
2426
, rpLogLimitBytes
2527
, rpMaxAgeHours
@@ -39,10 +41,13 @@ import GHC.Generics
3941
import Universum
4042

4143
import Control.Lens (each, makeLenses)
44+
import qualified Data.HashMap.Strict as HM
4245
import qualified Data.Text as T
46+
import Data.Traversable (for)
4347

4448
import System.FilePath (normalise)
4549

50+
import Pos.Util.Log.LoggerName (LoggerName)
4651
import Pos.Util.Log.Severity
4752

4853

@@ -96,7 +101,7 @@ data LogHandler = LogHandler
96101
-- ^ describes the backend (scribe for katip) to be loaded
97102
, _lhMinSeverity :: !(Maybe Severity)
98103
-- ^ the minimum severity to be logged
99-
} deriving (Generic, Show, Eq)
104+
} deriving (Eq, Generic, Show)
100105

101106
instance ToJSON LogHandler
102107
instance FromJSON LogHandler where
@@ -110,12 +115,22 @@ instance FromJSON LogHandler where
110115

111116
makeLenses ''LogHandler
112117

118+
-- | a mapping LoggerName -> Severity
119+
-- can override the '_ltMinSeverity' for a named context
120+
type NamedSeverity = HashMap LoggerName Severity
121+
122+
filterKnowns :: HashMap Text a -> HashMap LoggerName a
123+
filterKnowns = HM.filterWithKey (\k _ -> k `notElem` known)
124+
where
125+
known = ["file","files","severity","handlers"]
126+
113127
-- | @'LoggerTree'@ contains the actual logging configuration,
114128
-- 'Severity' and 'LogHandler'
115129
data LoggerTree = LoggerTree
116-
{ _ltMinSeverity :: !Severity
117-
, _ltHandlers :: ![LogHandler]
118-
} deriving (Generic, Show, Eq)
130+
{ _ltMinSeverity :: !Severity
131+
, _ltHandlers :: ![LogHandler]
132+
, _ltNamedSeverity :: !NamedSeverity
133+
} deriving (Eq, Generic, Show)
119134

120135
instance ToJSON LoggerTree
121136
instance FromJSON LoggerTree where
@@ -135,14 +150,16 @@ instance FromJSON LoggerTree where
135150
LogHandler { _lhName=name
136151
, _lhFpath=Just fp
137152
, _lhBackend=FileTextBE
138-
, _lhMinSeverity=Just Debug
153+
, _lhMinSeverity=Just Info
139154
, _lhSecurityLevel=case ".pub" `T.isSuffixOf` name of
140155
True -> Just PublicLogLevel
141156
_ -> Just SecretLogLevel
142157
}) $
143158
maybeToList singleFile ++ manyFiles
144159
let _ltHandlers = fileHandlers <> handlers <> [consoleHandler]
145-
(_ltMinSeverity :: Severity) <- o .: "severity" .!= Debug
160+
(_ltMinSeverity :: Severity) <- o .: "severity" .!= Info
161+
-- everything else is considered a severity filter
162+
(_ltNamedSeverity :: NamedSeverity) <- for (filterKnowns o) parseJSON
146163
return LoggerTree{..}
147164

148165
mkUniq :: [LogHandler] -> [LogHandler]
@@ -160,13 +177,15 @@ instance Semigroup LoggerTree where
160177
lt1 <> lt2 = LoggerTree {
161178
_ltMinSeverity = _ltMinSeverity lt1 `min` _ltMinSeverity lt2
162179
, _ltHandlers = mkUniq $ _ltHandlers lt1 <> _ltHandlers lt2
180+
, _ltNamedSeverity = _ltNamedSeverity lt1 <> _ltNamedSeverity lt2
163181
}
164182
instance Monoid LoggerTree where
165183
mempty = LoggerTree { _ltMinSeverity = Info
166184
, _ltHandlers = [LogHandler { _lhName="console", _lhFpath=Nothing
167185
, _lhBackend=StdoutBE
168186
, _lhMinSeverity=Just Info
169187
, _lhSecurityLevel=Just PublicLogLevel}]
188+
, _ltNamedSeverity = HM.empty
170189
}
171190
-- default values
172191
mappend = (<>)
@@ -240,6 +259,7 @@ defaultInteractiveConfiguration minSeverity =
240259
_lcBasePath = Nothing
241260
_lcLoggerTree = LoggerTree {
242261
_ltMinSeverity = Debug,
262+
_ltNamedSeverity = HM.empty,
243263
_ltHandlers = [ LogHandler {
244264
_lhBackend = StdoutBE,
245265
_lhName = "console",
@@ -259,6 +279,7 @@ defaultStdErrConfiguration minSeverity =
259279
_lcBasePath = Nothing
260280
_lcLoggerTree = LoggerTree {
261281
_ltMinSeverity = Debug,
282+
_ltNamedSeverity = HM.empty,
262283
_ltHandlers = [ LogHandler {
263284
_lhBackend = StderrBE,
264285
_lhName = "stderr",
@@ -278,6 +299,7 @@ jsonInteractiveConfiguration minSeverity =
278299
_lcBasePath = Nothing
279300
_lcLoggerTree = LoggerTree {
280301
_ltMinSeverity = Debug,
302+
_ltNamedSeverity = HM.empty,
281303
_ltHandlers = [ LogHandler {
282304
_lhBackend = StdoutBE,
283305
_lhName = "console",
@@ -303,6 +325,7 @@ defaultTestConfiguration minSeverity =
303325
_lcBasePath = Nothing
304326
_lcLoggerTree = LoggerTree {
305327
_ltMinSeverity = Debug,
328+
_ltNamedSeverity = HM.empty,
306329
_ltHandlers = [ LogHandler {
307330
_lhBackend = DevNullBE,
308331
_lhName = "devnull",

‎util/src/Pos/Util/Log/LoggerName.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ module Pos.Util.Log.LoggerName
77

88
import Universum
99

10-
import Pos.Util.Log (LoggerName)
10+
type LoggerName = Text
1111

1212
class HasLoggerName' ctx where
1313
loggerName :: Lens' ctx LoggerName

‎util/src/Pos/Util/Log/Scribes.hs‎

Lines changed: 36 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ import Control.AutoUpdate (UpdateSettings (..), defaultUpdateSettings,
1818
import Control.Concurrent.MVar (modifyMVar_)
1919

2020
import Data.Aeson.Text (encodeToLazyText)
21+
import qualified Data.HashMap.Strict as HM
2122
import qualified Data.Text as T
2223
import Data.Text.Lazy.Builder
2324
import qualified Data.Text.Lazy.IO as TIO
@@ -27,28 +28,31 @@ import Katip.Core
2728
import Katip.Scribes.Handle (brackets)
2829

2930
import qualified Pos.Util.Log.Internal as Internal
30-
import Pos.Util.Log.LoggerConfig (RotationParameters (..))
31+
import Pos.Util.Log.LoggerConfig (NamedSeverity,
32+
RotationParameters (..))
33+
import Pos.Util.Log.LoggerName (LoggerName)
3134
import Pos.Util.Log.Rotator (cleanupRotator, evalRotator,
3235
initializeRotator)
36+
import qualified Pos.Util.Log.Severity as Log (Severity (..))
3337

3438
import System.IO (BufferMode (LineBuffering), Handle,
3539
IOMode (WriteMode), hClose, hSetBuffering, stderr, stdout)
3640

3741
-- | create a katip scribe for logging to a file in JSON representation
38-
mkJsonFileScribe :: RotationParameters -> Internal.FileDescription -> Severity -> Verbosity -> IO Scribe
39-
mkJsonFileScribe rot fdesc s v = do
40-
mkFileScribe rot fdesc formatter False s v
42+
mkJsonFileScribe :: RotationParameters -> NamedSeverity -> Internal.FileDescription -> Log.Severity -> Verbosity -> IO Scribe
43+
mkJsonFileScribe rot sevfilter fdesc s v = do
44+
mkFileScribe rot sevfilter fdesc formatter False s v
4145
where
42-
formatter :: LogItem a => Handle -> Bool -> Verbosity -> Item a -> IO Int
46+
formatter :: (LogItem a) => Handle -> Bool -> Verbosity -> Item a -> IO Int
4347
formatter hdl _ v' item = do
4448
let tmsg = encodeToLazyText $ itemJson v' item
4549
TIO.hPutStrLn hdl tmsg
4650
return $ length tmsg
4751

4852
-- | create a katip scribe for logging to a file in textual representation
49-
mkTextFileScribe :: RotationParameters -> Internal.FileDescription -> Bool -> Severity -> Verbosity -> IO Scribe
50-
mkTextFileScribe rot fdesc colorize s v = do
51-
mkFileScribe rot fdesc formatter colorize s v
53+
mkTextFileScribe :: RotationParameters -> NamedSeverity -> Internal.FileDescription -> Bool -> Log.Severity -> Verbosity -> IO Scribe
54+
mkTextFileScribe rot sevfilter fdesc colorize s v = do
55+
mkFileScribe rot sevfilter fdesc formatter colorize s v
5256
where
5357
formatter :: Handle -> Bool -> Verbosity -> Item a -> IO Int
5458
formatter hdl colorize' v' item = do
@@ -60,12 +64,13 @@ mkTextFileScribe rot fdesc colorize s v = do
6064
-- and handle file rotation within the katip-invoked logging function
6165
mkFileScribe
6266
:: RotationParameters
67+
-> NamedSeverity
6368
-> Internal.FileDescription
6469
-> (forall a . LogItem a => Handle -> Bool -> Verbosity -> Item a -> IO Int) -- format and output function, returns written bytes
6570
-> Bool -- whether the output is colourized
66-
-> Severity -> Verbosity
71+
-> Log.Severity -> Verbosity
6772
-> IO Scribe
68-
mkFileScribe rot fdesc formatter colorize s v = do
73+
mkFileScribe rot sevfilter fdesc formatter colorize s v = do
6974
trp <- initializeRotator rot fdesc
7075
scribestate <- newMVar trp -- triple of (handle), (bytes remaining), (rotate time)
7176
-- sporadically remove old log files - every 10 seconds
@@ -77,7 +82,7 @@ mkFileScribe rot fdesc formatter colorize s v = do
7782
return (hdl, b, t)
7883
let logger :: forall a. LogItem a => Item a -> IO ()
7984
logger item =
80-
when (permitItem s item) $
85+
when (checkItem s sevfilter item) $
8186
modifyMVar_ scribestate $ \(hdl, bytes, rottime) -> do
8287
byteswritten <- formatter hdl colorize v item
8388
-- remove old files
@@ -97,38 +102,47 @@ mkFileScribe rot fdesc formatter colorize s v = do
97102
return $ Scribe logger finalizer
98103

99104
-- | create a katip scribe for logging to a file
100-
mkFileScribeH :: Handle -> Bool -> Severity -> Verbosity -> IO Scribe
101-
mkFileScribeH h colorize s v = do
105+
mkFileScribeH :: Handle -> Bool -> NamedSeverity -> Log.Severity -> Verbosity -> IO Scribe
106+
mkFileScribeH h colorize sevfilter s v = do
102107
hSetBuffering h LineBuffering
103108
locklocal <- newMVar ()
104-
let logger :: forall a. Item a -> IO ()
105-
logger item = when (permitItem s item) $
109+
let logger :: Item a -> IO ()
110+
logger item = when (checkItem s sevfilter item) $
106111
bracket_ (takeMVar locklocal) (putMVar locklocal ()) $
107112
TIO.hPutStrLn h $! toLazyText $ formatItem colorize v item
108113
pure $ Scribe logger (hClose h)
109114

110115
-- | create a katip scribe for logging to the console
111-
mkStdoutScribe :: Severity -> Verbosity -> IO Scribe
116+
mkStdoutScribe :: NamedSeverity -> Log.Severity -> Verbosity -> IO Scribe
112117
mkStdoutScribe = mkFileScribeH stdout True
113118

114119
-- | create a katip scribe for logging to stderr
115-
mkStderrScribe :: Severity -> Verbosity -> IO Scribe
120+
mkStderrScribe :: NamedSeverity -> Log.Severity -> Verbosity -> IO Scribe
116121
mkStderrScribe = mkFileScribeH stderr True
117122

118123
-- | @Scribe@ that outputs to '/dev/null' without locking
119-
mkDevNullScribe :: Internal.LoggingHandler -> Severity -> Verbosity -> IO Scribe
120-
mkDevNullScribe lh s v = do
124+
mkDevNullScribe :: Internal.LoggingHandler -> NamedSeverity -> Log.Severity -> Verbosity -> IO Scribe
125+
mkDevNullScribe lh sevfilter s v = do
121126
h <- openFile "/dev/null" WriteMode
122127
let colorize = False
123128
hSetBuffering h LineBuffering
124-
let logger :: forall a. Item a -> IO ()
125-
logger item = when (permitItem s item) $
129+
let logger :: Item a -> IO ()
130+
logger item = when (checkItem s sevfilter item) $
126131
Internal.incrementLinesLogged lh
127132
>> (TIO.hPutStrLn h $! toLazyText $ formatItem colorize v item)
128133
pure $ Scribe logger (hClose h)
129134

135+
-- | check if item passes severity filter
136+
checkItem :: Log.Severity -> NamedSeverity -> Item a -> Bool
137+
checkItem s sevfilter item@Item{..} =
138+
permitItem (Internal.sev2klog severity) item
139+
where
140+
severity :: Log.Severity
141+
severity = fromMaybe s $ HM.lookup namedcontext sevfilter
142+
namedcontext :: LoggerName
143+
namedcontext = mconcat $ intercalateNs _itemNamespace
130144

131-
-- | format a @LogItem@ with subsecond precision (ISO 8601)
145+
-- | format a @Item@
132146
formatItem :: Bool -> Verbosity -> Item a -> Builder
133147
formatItem withColor _verb Item{..} =
134148
fromText header <>

0 commit comments

Comments
 (0)