Merge pull request #3613 from input-output-hk/adiemand/CBR-345/apply_…

…minSeverity

[CBR-345] apply minSeverity as soon as possible

util/src/Pos/Util/Wlog/Compatibility.hs

@@ -58,7 +58,7 @@ import qualified Pos.Util.Log.Internal as Internal
 import           Pos.Util.Log.LoggerConfig (LogHandler (..),
                      LogSecurityLevel (..), LoggerConfig (..),
                      defaultInteractiveConfiguration, defaultTestConfiguration,
-                     lcLoggerTree, lhName, ltHandlers)
+                     lcLoggerTree, lhName, ltHandlers, ltMinSeverity)
 import           System.IO.Unsafe (unsafePerformIO)
 
 import           Universum
@@ -90,12 +90,17 @@ instance CanLog IO where
         mayEnv <- Internal.getLogEnv lh
         case mayEnv of
             Nothing -> error "logging not yet initialized. Abort."
-            Just env -> Log.logItem' ()
-                                     (K.Namespace (T.split (=='.') name))
-                                     env
-                                     Nothing
-                                     (Internal.sev2klog severity)
-                                     (K.logStr msg)
+            Just env -> do
+                mayConfig <- Internal.getConfig lh
+                case mayConfig of
+                    Nothing -> error "no logging configuration. Abort."
+                    Just lc -> when (severity >= lc ^. lcLoggerTree ^. ltMinSeverity)
+                                 $ Log.logItem' ()
+                                       (K.Namespace (T.split (=='.') name))
+                                       env
+                                       Nothing
+                                       (Internal.sev2klog severity)
+                                       (K.logStr msg)
 
 type WithLogger m = (CanLog m, HasLoggerName m)
 
@@ -262,7 +267,9 @@ logItemS lhandler a ns loc sev cond msg = do
             let cfg = case maycfg of
                     Nothing -> error "No Configuration for logging found. Abort."
                     Just c  -> c
-            liftIO $ do
+            let sevmin = Internal.sev2klog $ cfg ^. lcLoggerTree ^. ltMinSeverity
+            when (sev >= sevmin)
+              $ liftIO $ do
                 item <- K.Item
                     <$> pure (K._logEnvApp le)
                     <*> pure (K._logEnvEnv le)

util/test/Test/Pos/Util/WlogSpec.hs

@@ -61,12 +61,13 @@ run_logging _ n n0 n1= do
                     logWarning msg
                     logError msg
         endTime <- getPOSIXTime
-        threadDelay $ fromIntegral (5000 * n0)
+        threadDelay $ fromIntegral (8000 * n0)
         let diffTime = nominalDiffTimeToMicroseconds (endTime - startTime)
         putStrLn $ "  time for " ++ (show (n0*n1)) ++ " iterations: " ++ (show diffTime)
         lineslogged1 <- getLinesLogged
         let lineslogged = lineslogged1 - lineslogged0
         putStrLn $ "  lines logged :" ++ (show lineslogged)
+        threadDelay 0500000   -- wait for empty queue
         return (diffTime, lineslogged)
         where msg :: Text
               msg = replicate n "abcdefghijklmnopqrstuvwxyz"
@@ -102,6 +103,19 @@ spec = describe "Logging" $ do
                 lc = lc0 & lcLoggerTree .~ newlt
             setupLogging "test" lc
 
+    modifyMaxSuccess (const 2) $ modifyMaxSize (const 2) $
+      it "change minimum severity filter for a specific context" $
+        monadicIO $ do
+            lineslogged0 <- lift $ getLinesLogged
+            lift $ usingLoggerName "silent" $ do { logWarning "you won't see this!" }
+            lift $ threadDelay 0300000
+            lift $ usingLoggerName "verbose" $ do { logWarning "now you read this!" }
+            lift $ threadDelay 0300000
+            lineslogged1 <- lift $ getLinesLogged
+            let lineslogged = lineslogged1 - lineslogged0
+            putStrLn $ "lines logged: " ++ (show lineslogged)
+            assert (lineslogged == 1)
+
     modifyMaxSuccess (const 1) $ modifyMaxSize (const 1) $
       it "demonstrate logging" $
         monadicIO $ lift $ someLogging
@@ -118,16 +132,3 @@ spec = describe "Logging" $ do
       it "lines counted as logged must be equal to how many was intended to be written" $
         property prop_lines
 
-    modifyMaxSuccess (const 2) $ modifyMaxSize (const 2) $
-      it "change minimum severity filter for a specific context" $
-        monadicIO $ do
-            lineslogged0 <- lift $ getLinesLogged
-            lift $ usingLoggerName "silent" $ do { logWarning "you won't see this!" }
-            lift $ threadDelay 0300000
-            lift $ usingLoggerName "verbose" $ do { logWarning "now you read this!" }
-            lift $ threadDelay 0300000
-            lineslogged1 <- lift $ getLinesLogged
-            let lineslogged = lineslogged1 - lineslogged0
-            putStrLn $ "lines logged: " ++ (show lineslogged)
-            assert (lineslogged == 1)
-