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

Commit 37b6295

Browse files
CodiePPCodiePP
committed
[CBR-348] log-config defines Loggername - Severity mapping
Signed-off-by: Alexander Diemand <[email protected]>
1 parent 35fd1b8 commit 37b6295

File tree

5 files changed

+105
-35
lines changed

5 files changed

+105
-35
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: 32 additions & 18 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 Data.Text.Lazy.Builder
2223
import qualified Data.Text.Lazy.IO as TIO
2324
import Data.Time (diffUTCTime)
@@ -26,17 +27,20 @@ import Katip.Format.Time (formatAsIso8601)
2627
import Katip.Scribes.Handle (brackets, getKeys)
2728

2829
import qualified Pos.Util.Log.Internal as Internal
29-
import Pos.Util.Log.LoggerConfig (RotationParameters (..))
30+
import Pos.Util.Log.LoggerConfig (NamedSeverity,
31+
RotationParameters (..))
32+
import Pos.Util.Log.LoggerName (LoggerName)
3033
import Pos.Util.Log.Rotator (cleanupRotator, evalRotator,
3134
initializeRotator)
35+
import qualified Pos.Util.Log.Severity as Log (Severity (..))
3236

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

3640
-- | create a katip scribe for logging to a file in JSON representation
37-
mkJsonFileScribe :: RotationParameters -> Internal.FileDescription -> Severity -> Verbosity -> IO Scribe
38-
mkJsonFileScribe rot fdesc s v = do
39-
mkFileScribe rot fdesc formatter False s v
41+
mkJsonFileScribe :: RotationParameters -> NamedSeverity -> Internal.FileDescription -> Log.Severity -> Verbosity -> IO Scribe
42+
mkJsonFileScribe rot sevfilter fdesc s v = do
43+
mkFileScribe rot sevfilter fdesc formatter False s v
4044
where
4145
formatter :: LogItem a => Handle -> Bool -> Verbosity -> Item a -> IO Int
4246
formatter hdl _ v' item = do
@@ -45,9 +49,9 @@ mkJsonFileScribe rot fdesc s v = do
4549
return $ length tmsg
4650

4751
-- | create a katip scribe for logging to a file in textual representation
48-
mkTextFileScribe :: RotationParameters -> Internal.FileDescription -> Bool -> Severity -> Verbosity -> IO Scribe
49-
mkTextFileScribe rot fdesc colorize s v = do
50-
mkFileScribe rot fdesc formatter colorize s v
52+
mkTextFileScribe :: RotationParameters -> NamedSeverity -> Internal.FileDescription -> Bool -> Log.Severity -> Verbosity -> IO Scribe
53+
mkTextFileScribe rot sevfilter fdesc colorize s v = do
54+
mkFileScribe rot sevfilter fdesc formatter colorize s v
5155
where
5256
formatter :: LogItem a => Handle -> Bool -> Verbosity -> Item a -> IO Int
5357
formatter hdl colorize' v' item = do
@@ -59,12 +63,13 @@ mkTextFileScribe rot fdesc colorize s v = do
5963
-- and handle file rotation within the katip-invoked logging function
6064
mkFileScribe
6165
:: RotationParameters
66+
-> NamedSeverity
6267
-> Internal.FileDescription
6368
-> (forall a . LogItem a => Handle -> Bool -> Verbosity -> Item a -> IO Int) -- format and output function, returns written bytes
6469
-> Bool -- whether the output is colourized
65-
-> Severity -> Verbosity
70+
-> Log.Severity -> Verbosity
6671
-> IO Scribe
67-
mkFileScribe rot fdesc formatter colorize s v = do
72+
mkFileScribe rot sevfilter fdesc formatter colorize s v = do
6873
trp <- initializeRotator rot fdesc
6974
scribestate <- newMVar trp -- triple of (handle), (bytes remaining), (rotate time)
7075
-- sporadically remove old log files - every 10 seconds
@@ -76,7 +81,7 @@ mkFileScribe rot fdesc formatter colorize s v = do
7681
return (hdl, b, t)
7782
let logger :: forall a. LogItem a => Item a -> IO ()
7883
logger item =
79-
when (permitItem s item) $
84+
when (checkItem s sevfilter item) $
8085
modifyMVar_ scribestate $ \(hdl, bytes, rottime) -> do
8186
byteswritten <- formatter hdl colorize v item
8287
-- remove old files
@@ -96,36 +101,45 @@ mkFileScribe rot fdesc formatter colorize s v = do
96101
return $ Scribe logger finalizer
97102

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

109114
-- | create a katip scribe for logging to the console
110-
mkStdoutScribe :: Severity -> Verbosity -> IO Scribe
115+
mkStdoutScribe :: NamedSeverity -> Log.Severity -> Verbosity -> IO Scribe
111116
mkStdoutScribe = mkFileScribeH stdout True
112117

113118
-- | create a katip scribe for logging to stderr
114-
mkStderrScribe :: Severity -> Verbosity -> IO Scribe
119+
mkStderrScribe :: NamedSeverity -> Log.Severity -> Verbosity -> IO Scribe
115120
mkStderrScribe = mkFileScribeH stderr True
116121

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

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

130144
-- | format a @LogItem@ with subsecond precision (ISO 8601)
131145
formatItem :: LogItem a => Bool -> Verbosity -> Item a -> Builder

0 commit comments

Comments
 (0)