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

Commit

Permalink
[CBR-275] cleanup; revisit tests in 'util'
Browse files Browse the repository at this point in the history
Signed-off-by: Alexander Diemand <codieplusplus@apax.net>
  • Loading branch information
CodiePP committed Sep 14, 2018
1 parent 89bff76 commit acd8c64
Show file tree
Hide file tree
Showing 8 changed files with 143 additions and 72 deletions.
4 changes: 2 additions & 2 deletions infra/src/Pos/Infra/Reporting/Wlog.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions lib/src/Pos/Launcher/Resource.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,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)

Expand Down Expand Up @@ -242,7 +242,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

Expand Down
1 change: 0 additions & 1 deletion util/src/Pos/Util/Log.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@ module Pos.Util.Log
-- * Logging
Severity (..)
, LogContext
, LogContextT
, LoggingHandler
-- * Compatibility
, CanLog (..)
Expand Down
2 changes: 1 addition & 1 deletion util/src/Pos/Util/Log/Rotator.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions util/src/Pos/Util/Wlog.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down
4 changes: 2 additions & 2 deletions util/src/Pos/Util/Wlog/Compatibility.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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

Expand Down
90 changes: 36 additions & 54 deletions util/test/Test/Pos/Util/LogSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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) #-}

Expand All @@ -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
Expand All @@ -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
Expand All @@ -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."
Expand All @@ -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."
Expand All @@ -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
Expand All @@ -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 }))
Expand Down Expand Up @@ -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)

Loading

0 comments on commit acd8c64

Please sign in to comment.