From 5fb262d0c7ead713f0bdfc4664ecc3e53d74d7ea Mon Sep 17 00:00:00 2001 From: Alexander Diemand Date: Tue, 28 Aug 2018 15:56:22 +0200 Subject: [PATCH] [CBR-213] introduce 'Trace.Named' - cold --- util/Pos/Util/Trace.hs | 50 +++++++ util/Pos/Util/Trace/Named.hs | 159 ++++++++++++++++++++++ util/Pos/Util/Trace/Unstructured.hs | 145 ++++++++++++++++++++ util/cardano-sl-util.cabal | 3 + util/test/Test/Pos/Util/TraceSpec.hs | 193 +++++++++++++++++++++++++++ 5 files changed, 550 insertions(+) create mode 100644 util/Pos/Util/Trace/Named.hs create mode 100644 util/Pos/Util/Trace/Unstructured.hs create mode 100644 util/test/Test/Pos/Util/TraceSpec.hs diff --git a/util/Pos/Util/Trace.hs b/util/Pos/Util/Trace.hs index acc7faf162d..fa9d4e6fb95 100644 --- a/util/Pos/Util/Trace.hs +++ b/util/Pos/Util/Trace.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE RankNTypes #-} module Pos.Util.Trace ( Trace (..) + , TraceIO + , natTrace , trace , traceWith , noTrace @@ -8,10 +11,20 @@ module Pos.Util.Trace -- TODO put wlog tracing into its own module. , wlogTrace , Wlog.Severity (..) + -- * trace setup + , setupLogging + , logTrace + -- * log messages + , logDebug + , logInfo + , logWarning + , logNotice + , logError ) where import Data.Functor.Contravariant (Contravariant (..), Op (..)) import qualified Data.Text.IO as TIO +import qualified Pos.Util.Log as Log import qualified Pos.Util.Wlog as Wlog import Universum hiding (trace) @@ -20,9 +33,23 @@ newtype Trace m s = Trace { runTrace :: Op (m ()) s } +type TraceIO = Trace IO (Log.Severity, Text) + instance Contravariant (Trace m) where contramap f = Trace . contramap f . runTrace +natTrace :: (forall x . m x -> n x) -> Trace m s -> Trace n s +natTrace nat (Trace (Op tr)) = Trace $ Op $ nat . tr + +-- | setup logging and return a Trace +setupLogging :: MonadIO m + => Log.LoggerConfig + -> Log.LoggerName + -> IO (Trace m (Log.Severity, Text)) +setupLogging lc ln = do + lh <- Log.setupLogging lc + return $ logTrace lh ln + trace :: Trace m s -> s -> m () trace = getOp . runTrace @@ -44,3 +71,26 @@ stdoutTrace = Trace $ Op $ TIO.putStrLn wlogTrace :: Wlog.LoggerName -> Trace IO (Wlog.Severity, Text) wlogTrace loggerName = Trace $ Op $ \(severity, txt) -> Wlog.usingLoggerName loggerName $ Wlog.logMessage severity txt + +-- | A 'Trace' that uses logging from @Pos.Util.Log@ +logTrace :: MonadIO m + => Log.LoggingHandler + -> Log.LoggerName + -> Trace m (Log.Severity, Text) +logTrace lh loggerName = Trace $ Op $ \(severity, txt) -> + liftIO $ Log.usingLoggerName lh loggerName $ Log.logMessage severity txt + +logDebug :: TraceIO -> Trace IO Text +logDebug = contramap ((,) Log.Debug) + +logInfo :: TraceIO -> Trace IO Text +logInfo = contramap ((,) Log.Info) + +logWarning :: TraceIO -> Trace IO Text +logWarning = contramap ((,) Log.Warning) + +logNotice :: TraceIO -> Trace IO Text +logNotice = contramap ((,) Log.Notice) + +logError :: TraceIO -> Trace IO Text +logError = contramap ((,) Log.Error) diff --git a/util/Pos/Util/Trace/Named.hs b/util/Pos/Util/Trace/Named.hs new file mode 100644 index 00000000000..8e3f98dd0bf --- /dev/null +++ b/util/Pos/Util/Trace/Named.hs @@ -0,0 +1,159 @@ +-- | 'Trace' for named logging. + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Pos.Util.Trace.Named + ( TraceNamed + , LogNamed (..) + , TrU.LogItem + , named + , setupLogging + , namedTrace + , appendName + -- * rexports + , natTrace + -- * log functions + , logMessage, logMessageS, logMessageP + , logDebug, logDebugS, logDebugP, logDebugSP, logDebugUnsafeP + , logError, logErrorS, logErrorP, logErrorSP, logErrorUnsafeP + , logInfo, logInfoS, logInfoP, logInfoSP, logInfoUnsafeP + , logNotice, logNoticeS, logNoticeP, logNoticeSP, logNoticeUnsafeP + , logWarning, logWarningS, logWarningP, logWarningSP, logWarningUnsafeP + ) where + +import Universum + +import Data.Functor.Contravariant (Op (..), contramap) +import qualified Pos.Util.Log as Log +import Pos.Util.Log.LoggerConfig (LogSecurityLevel (..)) +import Pos.Util.Log.LogSafe (SecuredText, logMCond, logMessageUnsafeP, + selectPublicLogs, selectSecretLogs) +import Pos.Util.Trace (Trace (..), natTrace, traceWith) +import qualified Pos.Util.Trace.Unstructured as TrU (LogItem (..), + LogPrivacy (..)) + +type TraceNamed m = Trace m (LogNamed TrU.LogItem) + +-- | Attach a 'LoggerName' to something. +data LogNamed item = LogNamed + { lnName :: [Log.LoggerName] + , lnItem :: item + } deriving (Show) + +traceNamedItem + :: TraceNamed m + -> TrU.LogPrivacy + -> Log.Severity + -> Text + -> m () +traceNamedItem logTrace p s m = + traceWith (named logTrace) TrU.LogItem{ TrU.liPrivacy = p + , TrU.liSeverity = s + , TrU.liMessage = m + } + +logMessage, logMessageS, logMessageP :: TraceNamed m -> Log.Severity -> Text -> m () +logMessage logTrace = traceNamedItem logTrace TrU.Both +logMessageS logTrace = traceNamedItem logTrace TrU.Private +logMessageP logTrace = traceNamedItem logTrace TrU.Public + +logDebug, logInfo, logNotice, logWarning, logError + :: TraceNamed m -> Text -> m () +logDebug logTrace = traceNamedItem logTrace TrU.Both Log.Debug +logInfo logTrace = traceNamedItem logTrace TrU.Both Log.Info +logNotice logTrace = traceNamedItem logTrace TrU.Both Log.Notice +logWarning logTrace = traceNamedItem logTrace TrU.Both Log.Warning +logError logTrace = traceNamedItem logTrace TrU.Both Log.Error +logDebugS, logInfoS, logNoticeS, logWarningS, logErrorS + :: TraceNamed m -> Text -> m () +logDebugS logTrace = traceNamedItem logTrace TrU.Private Log.Debug +logInfoS logTrace = traceNamedItem logTrace TrU.Private Log.Info +logNoticeS logTrace = traceNamedItem logTrace TrU.Private Log.Notice +logWarningS logTrace = traceNamedItem logTrace TrU.Private Log.Warning +logErrorS logTrace = traceNamedItem logTrace TrU.Private Log.Error +logDebugP, logInfoP, logNoticeP, logWarningP, logErrorP + :: TraceNamed m -> Text -> m () +logDebugP logTrace = traceNamedItem logTrace TrU.Public Log.Debug +logInfoP logTrace = traceNamedItem logTrace TrU.Public Log.Info +logNoticeP logTrace = traceNamedItem logTrace TrU.Public Log.Notice +logWarningP logTrace = traceNamedItem logTrace TrU.Public Log.Warning +logErrorP logTrace = traceNamedItem logTrace TrU.Public Log.Error +logDebugSP, logInfoSP, logNoticeSP, logWarningSP, logErrorSP + :: Monad m => TraceNamed m -> SecuredText -> m () +logDebugSP logTrace f = logDebugS logTrace (f SecretLogLevel) >> logDebugP logTrace (f PublicLogLevel) +logInfoSP logTrace f = logInfoS logTrace (f SecretLogLevel) >> logInfoP logTrace (f PublicLogLevel) +logNoticeSP logTrace f = logNoticeS logTrace (f SecretLogLevel) >> logNoticeP logTrace (f PublicLogLevel) +logWarningSP logTrace f = logWarningS logTrace (f SecretLogLevel) >> logWarningP logTrace (f PublicLogLevel) +logErrorSP logTrace f = logErrorS logTrace (f SecretLogLevel) >> logErrorP logTrace (f PublicLogLevel) +logDebugUnsafeP, logInfoUnsafeP, logNoticeUnsafeP, logWarningUnsafeP, logErrorUnsafeP + :: TraceNamed m -> Text -> m () +logDebugUnsafeP logTrace = traceNamedItem logTrace TrU.PublicUnsafe Log.Debug +logInfoUnsafeP logTrace = traceNamedItem logTrace TrU.PublicUnsafe Log.Info +logNoticeUnsafeP logTrace = traceNamedItem logTrace TrU.PublicUnsafe Log.Notice +logWarningUnsafeP logTrace = traceNamedItem logTrace TrU.PublicUnsafe Log.Warning +logErrorUnsafeP logTrace = traceNamedItem logTrace TrU.PublicUnsafe Log.Error + +modifyName + :: ([Log.LoggerName] -> [Log.LoggerName]) + -> TraceNamed m + -> TraceNamed m +modifyName k = contramap f + where + f (LogNamed name item) = LogNamed (k name) item + +appendName :: Log.LoggerName -> TraceNamed m -> TraceNamed m +appendName lname = modifyName (\e -> [lname] <> e) + +named :: Trace m (LogNamed i) -> Trace m i +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 + let nt = namedTrace lh + return $ appendName ln nt + +namedTrace + :: MonadIO m => Log.LoggingHandler -> TraceNamed m +namedTrace lh = Trace $ Op $ \namedLogitem -> + let loggerNames = lnName namedLogitem + litem = lnItem namedLogitem + privacy = TrU.liPrivacy litem + severity = TrU.liSeverity litem + message = TrU.liMessage litem + in + liftIO $ case privacy of + TrU.Both -> Log.usingLoggerNames lh loggerNames $ + Log.logMessage severity message + -- pass to every logging scribe + TrU.Public -> Log.usingLoggerNames lh loggerNames $ + logMCond lh severity message selectPublicLogs + -- pass to logging scribes that are marked as + -- public (LogSecurityLevel == PublicLogLevel). + TrU.PublicUnsafe -> Log.usingLoggerNames lh loggerNames $ + logMessageUnsafeP severity lh message + -- pass to logging scribes that are marked as + -- public (LogSecurityLevel == PublicLogLevel). + TrU.Private -> Log.usingLoggerNames lh loggerNames $ + logMCond lh severity message selectSecretLogs + -- pass to logging scribes that are marked as + -- private (LogSecurityLevel == SecretLogLevel). + +{- testing: + +logTrace' <- setupLogging (Pos.Util.LoggerConfig.defaultInteractiveConfiguration Log.Debug) "named" +let li = publicLogItem (Log.Debug, "testing") + ni = namedItem "Tests" li + +traceWith logTrace' ni +traceWith (named $ appendName "more" logTrace') li + + +logTrace' <- setupLogging (Pos.Util.LoggerConfig.jsonInteractiveConfiguration Log.Debug) "named" +logDebug logTrace' "hello" +logDebug (appendName "blabla" logTrace') "hello" +-} diff --git a/util/Pos/Util/Trace/Unstructured.hs b/util/Pos/Util/Trace/Unstructured.hs new file mode 100644 index 00000000000..c16cdd52228 --- /dev/null +++ b/util/Pos/Util/Trace/Unstructured.hs @@ -0,0 +1,145 @@ +-- | Unstructured logging via Pos.Util.Trace: a text message with severity +-- and privacy levels. + +module Pos.Util.Trace.Unstructured + ( LogItem (..) + , LogPrivacy (..) + + , publicLogItem + , privateLogItem + , publicPrivateLogItem + + , setupLogging + + , logDebug + , logError + , logInfo + , logNotice + , logWarning + + , logDebugP + , logErrorP + , logInfoP + , logNoticeP + , logWarningP + + , logDebugS + , logErrorS + , logInfoS + , logNoticeS + , logWarningS + + , LogSecurityLevel (..) + , traceLogItemSP + , logDebugSP + , logErrorSP + , logInfoSP + , logNoticeSP + , logWarningSP + ) where + +import Universum + +import Data.Functor.Contravariant (Op (..)) +import qualified Pos.Util.Log as Log +import Pos.Util.Trace (Trace (..), traceWith) + + +data LogPrivacy = + Public -- only to public logs. + | PublicUnsafe -- only to public logs, not console. + | Private -- only to private logs. + | Both -- to public and private logs. + deriving (Show) + +-- | An unstructured log item. +data LogItem = LogItem + { liPrivacy :: LogPrivacy + , liSeverity :: Log.Severity + , liMessage :: Text + } deriving (Show) + +publicLogItem :: (Log.Severity, Text) -> LogItem +publicLogItem = uncurry (LogItem Public) + +privateLogItem :: (Log.Severity, Text) -> LogItem +privateLogItem = uncurry (LogItem Private) + +publicPrivateLogItem :: (Log.Severity, Text) -> LogItem +publicPrivateLogItem = uncurry (LogItem Both) + +traceLogItem + :: Trace m LogItem + -> LogPrivacy + -> Log.Severity + -> Text + -> m () +traceLogItem logTrace privacy severity message = + traceWith logTrace logItem + where + logItem = LogItem + { liPrivacy = privacy + , liSeverity = severity + , liMessage = message + } + +logDebug, logInfo, logNotice, logWarning, logError + :: Trace m LogItem -> Text -> m () +logDebug logTrace = traceLogItem logTrace Both Log.Debug +logInfo logTrace = traceLogItem logTrace Both Log.Info +logNotice logTrace = traceLogItem logTrace Both Log.Notice +logWarning logTrace = traceLogItem logTrace Both Log.Warning +logError logTrace = traceLogItem logTrace Both Log.Error + +logDebugP, logInfoP, logNoticeP, logWarningP, logErrorP + :: Trace m LogItem -> Text -> m () +logDebugP logTrace = traceLogItem logTrace Public Log.Debug +logInfoP logTrace = traceLogItem logTrace Public Log.Info +logNoticeP logTrace = traceLogItem logTrace Public Log.Notice +logWarningP logTrace = traceLogItem logTrace Public Log.Warning +logErrorP logTrace = traceLogItem logTrace Public Log.Error + +logDebugS, logInfoS, logNoticeS, logWarningS, logErrorS + :: Trace m LogItem -> Text -> m () +logDebugS logTrace = traceLogItem logTrace Private Log.Debug +logInfoS logTrace = traceLogItem logTrace Private Log.Info +logNoticeS logTrace = traceLogItem logTrace Private Log.Notice +logWarningS logTrace = traceLogItem logTrace Private Log.Warning +logErrorS logTrace = traceLogItem logTrace Private Log.Error + +type SecuredText = LogSecurityLevel -> Text + +data LogSecurityLevel = SecretLogLevel | PublicLogLevel + +-- | Log to public logs, and to private logs securely (the 'SecuredText' is +-- run at the 'SecretLogLevel'). +traceLogItemSP + :: Applicative m + => Trace m LogItem + -> Log.Severity + -> SecuredText + -> m () +traceLogItemSP logTrace severity securedText = + traceLogItem logTrace Private severity (securedText SecretLogLevel) + *> traceLogItem logTrace Public severity (securedText PublicLogLevel) + +logDebugSP, logInfoSP, logNoticeSP, logWarningSP, logErrorSP + :: Applicative m => Trace m LogItem -> SecuredText -> m () +logDebugSP logTrace = traceLogItemSP logTrace Log.Debug +logInfoSP logTrace = traceLogItemSP logTrace Log.Info +logNoticeSP logTrace = traceLogItemSP logTrace Log.Notice +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 + return $ unstructuredTrace ln lh + +unstructuredTrace :: MonadIO m => Log.LoggerName -> Log.LoggingHandler -> Trace m LogItem +unstructuredTrace ln lh = Trace $ Op $ \logitem -> + let severity = liSeverity logitem + message = liMessage logitem + in + liftIO $ Log.usingLoggerName lh ln $ Log.logMessage severity message diff --git a/util/cardano-sl-util.cabal b/util/cardano-sl-util.cabal index 38f25a8dae4..9e640a1e03c 100644 --- a/util/cardano-sl-util.cabal +++ b/util/cardano-sl-util.cabal @@ -47,6 +47,8 @@ library Pos.Util.Some Pos.Util.Timer Pos.Util.Trace + Pos.Util.Trace.Unstructured + Pos.Util.Trace.Named Pos.Util.Util Pos.Util.Wlog @@ -146,6 +148,7 @@ test-suite test Test.Pos.Util.ModifierSpec Test.Pos.Util.QuickCheck.Property Test.Pos.Util.TimerSpec + Test.Pos.Util.TraceSpec Test.Pos.Util.Tripping build-depends: aeson diff --git a/util/test/Test/Pos/Util/TraceSpec.hs b/util/test/Test/Pos/Util/TraceSpec.hs new file mode 100644 index 00000000000..65119e23bb9 --- /dev/null +++ b/util/test/Test/Pos/Util/TraceSpec.hs @@ -0,0 +1,193 @@ +module Test.Pos.Util.TraceSpec + ( spec) +where + +import Universum hiding (replicate) + +import Control.Concurrent (threadDelay) +import Control.Monad (when) + +import Data.Text (append, replicate) +import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) +import Data.Time.Units (Microsecond, fromMicroseconds) +import Test.Hspec (Spec, describe, it) +import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess) +import Test.QuickCheck (Property, property) +import Test.QuickCheck.Monadic (assert, monadicIO, run) + +import qualified Pos.Util.Log as Log +import Pos.Util.Log.Internal (getLinesLogged) +import Pos.Util.Log.LoggerConfig (defaultInteractiveConfiguration, + defaultTestConfiguration) +import qualified Pos.Util.Trace as Tr +import qualified Pos.Util.Trace.Named as Tn +import qualified Pos.Util.Trace.Unstructured as Tu + +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} + +nominalDiffTimeToMicroseconds :: POSIXTime -> Microsecond +nominalDiffTimeToMicroseconds = fromMicroseconds . round . (* 1000000) + +prop_small :: Property +prop_small = + monadicIO $ do + (diffTime,_) <- run (run_logging Log.Debug 1 20 10) + assert (diffTime > 0) + +prop_large :: Property +prop_large = + monadicIO $ do + (diffTime,_) <- run (run_logging Log.Debug 100 200 100) + assert (diffTime > 0) + +-- | Count as many lines as you itented to log. +prop_lines :: Property +prop_lines = + monadicIO $ do + let n0 = 20 + n1 = 1 + (_, linesLogged) <- run (run_logging Log.Debug 10 n0 n1) + -- multiply by 5 because we log 5 different messages (no * n1) times + assert (linesLogged == n0 * n1 * 5) + +-- | Count as many lines as you itented to log. +prop_sev :: Property +prop_sev = + monadicIO $ do + let n0 = 20 + n1 = 1 + (_, linesLogged) <- run (run_logging Log.Warning 10 n0 n1) + -- multiply by 2 because Debug, Info and Notice messages must not be logged + assert (linesLogged == n0 * n1 * 2) + +-- | Count as many lines as you itented to log. +prop_sevS :: Property +prop_sevS = + monadicIO $ do + let n0 = 20 + n1 = 1 + (_, linesLogged) <- run (run_loggingS Log.Warning 10 n0 n1) + -- multiply by 2 because Debug, Info and Notice messages must not be logged + assert (linesLogged == 0) + +run_logging :: Log.Severity -> Int -> Integer -> Integer -> IO (Microsecond, Integer) +run_logging sev n n0 n1= do + startTime <- getPOSIXTime +{- -} + lh <- Log.setupLogging (defaultTestConfiguration sev) + let logTrace' = Tr.logTrace lh "processXYZ" + forM_ [1..n0] $ \_ -> + forM_ [1..n1] $ \_ -> do + Tr.traceWith (Tr.logDebug logTrace') msg + Tr.traceWith (Tr.logInfo logTrace') msg + Tr.traceWith (Tr.logNotice logTrace') msg + Tr.traceWith (Tr.logWarning logTrace') msg + Tr.traceWith (Tr.logError logTrace') msg +{- -} + endTime <- getPOSIXTime + threadDelay $ fromIntegral (5000 * n0) + let diffTime = nominalDiffTimeToMicroseconds (endTime - startTime) + putStrLn $ " time for " ++ (show (n0*n1)) ++ " iterations: " ++ (show diffTime) + linesLogged <- getLinesLogged lh + putStrLn $ " lines logged :" ++ (show linesLogged) + return (diffTime, linesLogged) + where msg :: Text + msg = replicate n "abcdefghijklmnopqrstuvwxyz" + +run_loggingS :: Log.Severity -> Int -> Integer -> Integer -> IO (Microsecond, Integer) +run_loggingS sev n n0 n1= do + startTime <- getPOSIXTime +{- -} + lh <- Log.setupLogging (defaultTestConfiguration sev) + let logTrace' = Tn.appendName "run_loggingS" $ Tn.namedTrace lh + + Tn.logInfo logTrace' "entering" + forM_ [1..n0] $ \_ -> + forM_ [1..n1] $ \_ -> do + Tn.logDebugS logTrace' msg + Tn.logInfoS logTrace' msg + Tn.logNoticeS logTrace' msg + Tn.logWarningS logTrace' msg + Tn.logErrorS logTrace' msg +{- -} + endTime <- getPOSIXTime + threadDelay $ fromIntegral (5000 * n0) + let diffTime = nominalDiffTimeToMicroseconds (endTime - startTime) + putStrLn $ " time for " ++ (show (n0*n1)) ++ " iterations: " ++ (show diffTime) + linesLogged <- getLinesLogged lh + putStrLn $ " lines logged :" ++ (show linesLogged) + return (diffTime, linesLogged) + where msg :: Text + msg = replicate n "abcdefghijklmnopqrstuvwxyz" + +-- | example: setup trace +example_setup :: IO () +example_setup = do + logTrace' <- Tr.setupLogging (defaultTestConfiguration Log.Debug) "example" + Tr.traceWith logTrace' (Log.Info, "entering") + complexWork logTrace' "42" + Tr.traceWith logTrace' (Log.Info, "done.") + where + --complexWork :: MonadIO m => TraceIO -> Text -> m () + complexWork tr msg = do + Tr.traceWith tr (Log.Debug, "let's see: " `append` msg) + +-- | example: unstructured trace +example_unstructured :: IO () +example_unstructured = do + logTrace' <- Tu.setupLogging (defaultTestConfiguration Log.Debug) "unstructured" + Tu.logInfo logTrace' "entering" + complexWork logTrace' "42" + Tu.logInfo logTrace' "done." + where + --complexWork :: MonadIO m => TraceIO -> Text -> m () + complexWork tr msg = do + Tu.logDebug tr ("let's see: " `append` msg) + +-- | example: named context trace +example_named :: IO () +example_named = do + logTrace' <- Tn.setupLogging (defaultInteractiveConfiguration Log.Debug) "named" + Tn.logInfo logTrace' "entering" + complexWork (Tn.appendName "complex" logTrace') "42" + -- ^ the named context will include "complex" in the logged message + Tn.logInfo logTrace' "done." + where + --complexWork :: MonadIO m => TraceIO -> Text -> m () + complexWork tr msg = do + Tn.logDebug tr ("let's see: " `append` msg) + when (msg == "42") $ + complexWork (Tn.appendName "work" tr) "done." + + +spec :: Spec +spec = describe "Trace" $ do + modifyMaxSuccess (const 2) $ modifyMaxSize (const 2) $ + it "measure time for logging small messages" $ + property prop_small + + modifyMaxSuccess (const 2) $ modifyMaxSize (const 2) $ + it "measure time for logging LARGE messages" $ + property prop_large + + modifyMaxSuccess (const 2) $ modifyMaxSize (const 2) $ + it "lines counted as logged must be equal to how many was itended to be written" $ + property prop_lines + + modifyMaxSuccess (const 2) $ modifyMaxSize (const 2) $ + it "Debug, Info and Notice messages must not be logged" $ + property prop_sev + + modifyMaxSuccess (const 2) $ modifyMaxSize (const 2) $ + it "DebugS, InfoS, NoticeS, WarningS and ErrorS messages must not be logged in public logs" $ + property prop_sevS + + it "demonstrating setup and initialisation of logging" $ + example_setup + + it "demonstrating unstructured logging" $ + example_unstructured + + it "demonstrating named context logging" $ + example_named +