[CBR-275] cleanup; revisit tests in 'util'

CodiePP · CodiePP · commit 9365bcbf29ad · 2018-09-15T14:24:52.000+02:00
Signed-off-by: Alexander Diemand &lt;codieplusplus@apax.net&gt;
diff --git a/infra/src/Pos/Infra/Reporting/Wlog.hs b/infra/src/Pos/Infra/Reporting/Wlog.hs
@@ -18,7 +18,7 @@ import qualified Data.ByteString.Lazy as BSL
 import           Data.Conduit (runConduitRes, yield, (.|))
 import           Data.Conduit.List (consume)
 import qualified Data.Conduit.Lzma as Lzma
-import           Data.List (isSuffixOf)
+import           Data.List (isInfixOf)
 import qualified Data.Text.IO as TIO
 import           Data.Time.Clock (getCurrentTime)
 import           Data.Time.Format (defaultTimeLocale, formatTime)
@@ -66,7 +66,7 @@ readWlogFile logConfig = case mLogFile of
     -- first one.
     basepath = fromMaybe "./" $ logConfig ^. lcBasePath
     allFiles = map ((</> basepath) . snd) $ retrieveLogFiles logConfig
-    mLogFile = case filter (".pub" `isSuffixOf`) allFiles of
+    mLogFile = case filter (".json" `isInfixOf`) allFiles of
                     []    -> Nothing
                     (f:_) -> Just f
     -- 2 megabytes, assuming we use chars which are ASCII mostly
diff --git a/lib/src/Pos/Launcher/Resource.hs b/lib/src/Pos/Launcher/Resource.hs
@@ -66,7 +66,7 @@ import           Pos.Launcher.Param (BaseParams (..), LoggingParams (..),
                      NodeParams (..))
 import           Pos.Util (bracketWithLogging, newInitFuture)
 import           Pos.Util.Log.LoggerConfig (defaultInteractiveConfiguration)
-import           Pos.Util.Wlog (LoggerConfig (..), Severity (Debug), WithLogger,
+import           Pos.Util.Wlog (LoggerConfig (..), Severity (..), WithLogger,
                      logDebug, logInfo, parseLoggerConfig, removeAllHandlers,
                      setupLogging)
 
@@ -243,7 +243,7 @@ getRealLoggerConfig LoggingParams{..} = do
     overrideConsoleLog :: LoggerConfig -> LoggerConfig
     overrideConsoleLog = case lpConsoleLog of
         Nothing    -> identity
-        Just True  -> (<>) (defaultInteractiveConfiguration Debug)
+        Just True  -> (<>) (defaultInteractiveConfiguration Info)
                       -- add output to the console with severity filter >= Info
         Just False -> identity
 
diff --git a/lib/src/Pos/Launcher/Scenario.hs b/lib/src/Pos/Launcher/Scenario.hs
@@ -36,8 +36,7 @@ import           Pos.Infra.Util.LogSafe (logInfoS)
 import           Pos.Launcher.Resource (NodeResources (..))
 import           Pos.Util.AssertMode (inAssertMode)
 import           Pos.Util.CompileInfo (HasCompileInfo, compileInfo)
-import           Pos.Util.Wlog (LoggerName (..), WithLogger, askLoggerName,
-                     logInfo)
+import           Pos.Util.Wlog (WithLogger, askLoggerName, logInfo)
 import           Pos.Worker (allWorkers)
 import           Pos.WorkMode.Class (WorkMode)
 
@@ -98,7 +97,7 @@ runNode' genesisConfig NodeResources {..} workers' plugins' = \diffusion -> do
     reportHandler (SomeException e) = do
         loggerName <- askLoggerName
         let msg = "Worker/plugin with logger name "%shown%" failed with exception: "%shown
-        reportError $ sformat msg (getLoggerName loggerName) e
+        reportError $ sformat msg loggerName e
         exitFailure
 
 -- | Entry point of full node.
diff --git a/networking/cardano-sl-networking.cabal b/networking/cardano-sl-networking.cabal
@@ -45,32 +45,33 @@ Library
                       , async
                       , attoparsec
                       , base
+                      , binary >= 0.8
+                      , bytestring
                       , cardano-sl-chain
                       , cardano-sl-core
                       , cardano-sl-util
                       , containers
-                      , binary >= 0.8
-                      , bytestring
+                      , ekg-core
+                      , formatting
                       , formatting
                       , hashable
                       , kademlia
                       , lens
                       , mtl
+                      , mtl >= 2.2.1
                       , network
                       , network-transport
                       , network-transport-tcp
-                      , mtl >= 2.2.1
                       , random
-                      , universum
                       , safe-exceptions
                       , scientific
                       , stm
                       , text
                       , these
-                      , formatting
                       , time
                       , time-units
-                      , ekg-core
+                      , universum
+                      , unordered-containers
 
   hs-source-dirs:       src
   default-language:     Haskell2010
diff --git a/pkgs/default.nix b/pkgs/default.nix
@@ -16843,6 +16843,7 @@ license = stdenv.lib.licenses.mit;
 , time
 , time-units
 , universum
+, unordered-containers
 , vector
 }:
 mkDerivation {
@@ -16887,6 +16888,7 @@ these
 time
 time-units
 universum
+unordered-containers
 ];
 executableHaskellDepends = [
 async
diff --git a/tools/src/launcher/Main.hs b/tools/src/launcher/Main.hs
@@ -323,7 +323,7 @@ main =
                                                        , _lhSecurityLevel=Just PublicLogLevel}] ++ xs)) .
                     set ltMinSeverity Info
     logException loggerName . usingLoggerName loggerName $
-        withConfigurations Nothing Nothing False loConfiguration $ \coreConfig _ _ _ -> do
+        withConfigurations Nothing Nothing False loConfiguration $ \genesisConfig _ _ _ -> do
 
         -- Generate TLS certificates as needed
         generateTlsCertificates loConfiguration loX509ToolPath loTlsPath
diff --git a/util/src/Pos/Util/Log.hs b/util/src/Pos/Util/Log.hs
@@ -5,7 +5,6 @@ module Pos.Util.Log
        -- * Logging
          Severity (..)
        , LogContext
-       , LogContextT
        , LoggingHandler
        -- * Compatibility
        , CanLog (..)
diff --git a/util/src/Pos/Util/Log/Rotator.hs b/util/src/Pos/Util/Log/Rotator.hs
@@ -109,7 +109,7 @@ initializeRotator rotation fdesc = do
                                  return stdout    -- fallback to standard output in case of exception
                   hSetBuffering hdl LineBuffering
                   cursize <- hFileSize hdl
-                  let rottime = addUTCTime (fromInteger $ maxAge * 3600) now
+                  let rottime = addUTCTime (fromInteger $ maxAge * 3600) tsfp
                   return (hdl, (maxSize - cursize), rottime)
   where
     fplen = length $ filename fdesc
diff --git a/util/src/Pos/Util/Wlog.hs b/util/src/Pos/Util/Wlog.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE Rank2Types #-}
 
--- | an interface to 'log-warper'
---  functions and types gradually migrate towards 'katip'
+-- | a compatible interface to 'log-warper'
+--   logging output is directed to 'katip'
 
 module Pos.Util.Wlog
         ( -- * CanLog
diff --git a/util/src/Pos/Util/Wlog/Compatibility.hs b/util/src/Pos/Util/Wlog/Compatibility.hs
@@ -90,7 +90,7 @@ instance CanLog IO where
         case mayEnv of
             Nothing -> error "logging not yet initialized. Abort."
             Just env -> Log.logItem' ()
-                                     (K.Namespace [name])
+                                     (K.Namespace (T.split (=='.') name))
                                      env
                                      Nothing
                                      (Internal.sev2klog severity)
@@ -284,7 +284,7 @@ logItemS lhandler a ns loc sev cond msg = do
 
 logMCond :: MonadIO m => LoggerName -> Severity -> Text -> SelectionMode -> m ()
 logMCond name severity msg cond = do
-    let ns = K.Namespace [name]
+    let ns = K.Namespace (T.split (=='.') name)
     lh <- liftIO $ readMVar loggingHandler
     logItemS lh () ns Nothing (Internal.sev2klog severity) cond $ K.logStr msg
 
diff --git a/util/test/Test/Pos/Util/LogSpec.hs b/util/test/Test/Pos/Util/LogSpec.hs
@@ -15,15 +15,15 @@ import           Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess)
 import           Test.QuickCheck (Property, property)
 import           Test.QuickCheck.Monadic (assert, monadicIO, run)
 
+import           Pos.Util.Log
+import           Pos.Util.Log.Internal (getLinesLogged)
 import           Pos.Util.Log.LoggerConfig (BackendKind (..), LogHandler (..),
                      LogSecurityLevel (..), LoggerConfig (..), LoggerTree (..),
                      defaultInteractiveConfiguration, defaultTestConfiguration,
                      lcLoggerTree, ltMinSeverity, ltNamedSeverity)
-import           Pos.Util.Wlog (Severity (..), WithLogger, getLinesLogged,
-                     logDebug, logError, logInfo, logNotice, logWarning,
-                     setupLogging, usingLoggerName)
---import           Pos.Util.Log.LogSafe (logDebugS, logErrorS, logInfoS,
---                     logNoticeS, logWarningS)
+import           Pos.Util.Log.LogSafe (logDebugS, logErrorS, logInfoS,
+                     logNoticeS, logWarningS)
+import           Pos.Util.Log.Severity (Severity (..))
 
 {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
 
@@ -48,30 +48,26 @@ prop_lines =
     monadicIO $ do
         let n0 = 20
             n1 = 1
-        (_, linesLogged) <- run (run_logging Debug 10 n0 n1)
+        (_, lineslogged) <- run (run_logging Debug 10 n0 n1)
         -- multiply by 5 because we log 5 different messages (n0 * n1) times
-        assert (linesLogged == n0 * n1 * 5)
-        -- assert (linesLogged >= n0 * n1 * 5 `div` 2)    -- weaker
+        assert (lineslogged == n0 * n1 * 5)
 
-  {-
 -- | Count as many lines as you intended to log.
 prop_sev :: Property
 prop_sev =
     monadicIO $ do
         let n0 = 20
             n1 = 1
-        (_, linesLogged) <- run (run_logging Warning 10 n0 n1)
+        (_, lineslogged) <- run (run_logging Warning 10 n0 n1)
         -- multiply by 2 because Debug, Info and Notice messages must not be logged
-        assert (linesLogged == n0 * n1 * 2)
-        -- assert (linesLogged >= n0 * n1 * 2 `div` 2)    -- weaker
--}
+        assert (lineslogged == n0 * n1 * 2)
+
 run_logging :: Severity -> Int -> Integer -> Integer -> IO (Microsecond, Integer)
-run_logging _ n n0 n1= do
+run_logging sev n n0 n1= do
         startTime <- getPOSIXTime
-        --setupLogging $ defaultTestConfiguration sev
-        lineslogged0 <- getLinesLogged
+        lh <- setupLogging $ defaultTestConfiguration sev
         forM_ [1..n0] $ \_ ->
-            usingLoggerName "test_log" $
+            usingLoggerName lh "test_log" $
                 forM_ [1..n1] $ \_ -> do
                     logDebug msg
                     logInfo msg
@@ -82,29 +78,27 @@ run_logging _ n n0 n1= do
         threadDelay $ fromIntegral (5000 * n0)
         let diffTime = nominalDiffTimeToMicroseconds (endTime - startTime)
         putStrLn $ "  time for " ++ (show (n0*n1)) ++ " iterations: " ++ (show diffTime)
-        lineslogged1 <- getLinesLogged
-        let lineslogged = lineslogged1 - lineslogged0
+        lineslogged <- getLinesLogged lh
         putStrLn $ "  lines logged :" ++ (show lineslogged)
         return (diffTime, lineslogged)
         where msg :: Text
               msg = replicate n "abcdefghijklmnopqrstuvwxyz"
 
-  {-
 prop_sevS :: Property
 prop_sevS =
     monadicIO $ do
         let n0 = 200
             n1 = 1
-        (_, linesLogged) <- run (run_loggingS Warning 10 n0 n1)
+        (_, lineslogged) <- run (run_loggingS Warning 10 n0 n1)
         -- multiply by 2 because Debug, Info and Notice messages must not be logged
-        assert (linesLogged == 0)
+        assert (lineslogged == 0)
 
 run_loggingS :: Severity -> Int -> Integer -> Integer-> IO (Microsecond, Integer)
 run_loggingS sev n n0 n1= do
         startTime <- getPOSIXTime
-        --setupLogging $ defaultTestConfiguration sev
+        lh <- setupLogging $ defaultTestConfiguration sev
         forM_ [1..n0] $ \_ ->
-            usingLoggerName "test_log" $
+            usingLoggerName lh "test_log" $
                 forM_ [1..n1] $ \_ -> do
                     logDebugS   lh msg
                     logInfoS    lh msg
@@ -115,17 +109,17 @@ run_loggingS sev n n0 n1= do
         threadDelay 0500000
         let diffTime = nominalDiffTimeToMicroseconds (endTime - startTime)
         putStrLn $ "  time for " ++ (show (n0*n1)) ++ " iterations: " ++ (show diffTime)
-        linesLogged <- getLinesLogged
-        putStrLn $ "  lines logged :" ++ (show linesLogged)
-        return (diffTime, linesLogged)
+        lineslogged <- getLinesLogged lh
+        putStrLn $ "  lines logged :" ++ (show lineslogged)
+        return (diffTime, lineslogged)
         where msg :: Text
               msg = replicate n "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
--}
+
 -- | example: setup logging
 example_setup :: IO ()
 example_setup = do
-    --setupLogging (defaultTestConfiguration Debug)
-    usingLoggerName "processXYZ" $ do
+    lh <- setupLogging (defaultTestConfiguration Debug)
+    usingLoggerName lh "processXYZ" $ do
         logInfo "entering"
         complexWork "42"
         logInfo "done."
@@ -135,12 +129,11 @@ example_setup = do
         complexWork m = do
             logDebug $ "let's see: " `append` m
 
-{-
 -- | example: bracket logging
 example_bracket :: IO ()
 example_bracket = do
-    setupLogging (defaultTestConfiguration Debug)
-    loggerBracket "processXYZ" $ do
+    lh <- setupLogging (defaultTestConfiguration Debug)
+    loggerBracket lh "processXYZ" $ do
         logInfo "entering"
         complexWork "42"
         logInfo "done."
@@ -150,17 +143,9 @@ example_bracket = do
         complexWork m =
             addLoggerName "in_complex" $ do
                 logDebug $ "let's see: " `append` m
--}
+
 spec :: Spec
 spec = describe "Logging" $ do
-    modifyMaxSuccess (const 1) $ modifyMaxSize (const 1) $
-      it "setup logging" $
-        monadicIO $ do
-            let lc0 = defaultTestConfiguration Debug
-                newlt = lc0 ^. lcLoggerTree & ltNamedSeverity .~ HM.fromList [("cardano-sl.silent", Error)]
-                lc = lc0 & lcLoggerTree .~ newlt
-            setupLogging lc
-
     modifyMaxSuccess (const 2) $ modifyMaxSize (const 2) $
       it "measure time for logging small messages" $
         property prop_small
@@ -173,24 +158,20 @@ 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 "Debug, Info and Notice messages must not be logged" $
         property prop_sev
--}
 
-{-  disabled for now
     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
 
-{-  disabled for now
     it "demonstrating bracket logging" $
         example_bracket
--}
+
     it "compose default LoggerConfig" $
         ((mempty :: LoggerConfig) <> (LoggerConfig { _lcBasePath = Nothing, _lcRotation = Nothing
                                              , _lcLoggerTree = mempty }))
@@ -239,13 +220,14 @@ spec = describe "Logging" $ do
     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!" }
+            let lc0 = defaultTestConfiguration Info
+                newlt = lc0 ^. lcLoggerTree & ltNamedSeverity .~ HM.fromList [("cardano-sl.silent", Error)]
+                lc = lc0 & lcLoggerTree .~ newlt
+            lh <- setupLogging lc
+            lift $ usingLoggerName lh "silent" $ do { logWarning "you won't see this!" }
             lift $ threadDelay 0300000
-            lift $ usingLoggerName "verbose" $ do { logWarning "now you read this!" }
+            lift $ usingLoggerName lh "verbose" $ do { logWarning "now you read this!" }
             lift $ threadDelay 0300000
-            lineslogged1 <- lift $ getLinesLogged
-            let lineslogged = lineslogged1 - lineslogged0
-            putStrLn $ "lines logged: " ++ (show lineslogged)
+            lineslogged <- lift $ getLinesLogged lh
             assert (lineslogged == 1)
 
diff --git a/util/test/Test/Pos/Util/WlogSpec.hs b/util/test/Test/Pos/Util/WlogSpec.hs
