diff --git a/src/Network/Wreq/Wrecker.hs b/src/Network/Wreq/Wrecker.hs --- a/src/Network/Wreq/Wrecker.hs +++ b/src/Network/Wreq/Wrecker.hs @@ -16,6 +16,12 @@ , withWreq , withWreqNoCookies , withWreqSettings + -- * Logging functions + , logDebug + , logInfo + , logWarn + , logError + , Logger.Logger -- * HTTP Methods , get , post @@ -53,7 +59,9 @@ import qualified Network.Wreq as Wreq import qualified Network.Wreq.Session as Session import qualified Network.Wreq.Types as Wreq +import System.Log.FastLogger (ToLogStr) import Wrecker +import qualified Wrecker.Logger as Logger {-| An opaque type created by 'withWreq', 'withWreqNoCookies', or 'withWreqSettings'. All HTTP calls require a 'Session'. @@ -64,6 +72,8 @@ , sRecord :: forall a. Recorder -> String -> IO a -> IO a -- ^ A custom function to record the time of of executing the IO action -- By default, it will use 'Wrecker.Recorder.record' + , sLogger :: Logger.Logger + -- ^ A custom logger that can be used for logging messages from the test functions } {- | Create 'ManagerSettings' with no timeout using a shared TLS @@ -84,6 +94,7 @@ withWreq f env = withWreqSettings (recorder env) + (logger env) (Just (HTTP.createCookieJar [])) (defaultManagerSettings (context env)) f @@ -95,7 +106,7 @@ -- which typically do not use cookies. withWreqNoCookies :: (Session -> IO a) -> Environment -> IO a withWreqNoCookies f env = - withWreqSettings (recorder env) Nothing (defaultManagerSettings (context env)) f + withWreqSettings (recorder env) (logger env) Nothing (defaultManagerSettings (context env)) f -- | Replaces the record function of the Session with the provided one. -- @@ -107,15 +118,16 @@ -- | Create a session, using the given cookie jar and manager settings. withWreqSettings :: Recorder + -> Logger.Logger -> Maybe HTTP.CookieJar -- ^ If 'Nothing' is specified, no cookie management -- will be performed. -> HTTP.ManagerSettings -> (Session -> IO a) -> IO a -withWreqSettings recorder cookie settings f = do +withWreqSettings recorder logFunc cookie settings f = do session <- Session.newSessionControl cookie settings - f (Session session recorder record) + f (Session session recorder record logFunc) -- this records things. It's not ideal, but an more acurate -- implementation is harder. Pull requests welcome. @@ -216,6 +228,18 @@ -> IO (HTTP.Response b) putJSONWith opts = withRecorder1 (\sess url body -> Session.putWith opts sess url body >>= fromJSON "PUT" url) + +logDebug :: ToLogStr msg => Session -> msg -> IO () +logDebug Session {..} = Logger.logDebug sLogger + +logInfo :: ToLogStr msg => Session -> msg -> IO () +logInfo Session {..} = Logger.logDebug sLogger + +logWarn :: ToLogStr msg => Session -> msg -> IO () +logWarn Session {..} = Logger.logDebug sLogger + +logError :: ToLogStr msg => Session -> msg -> IO () +logError Session {..} = Logger.logDebug sLogger -- | 'Session'-specific version of 'Network.Wreq.deleteWith' that expects a JSON response. deleteJSONWith :: FromJSON a => Wreq.Options -> Session -> String -> IO (HTTP.Response a) diff --git a/src/Wrecker/Logger.hs b/src/Wrecker/Logger.hs --- a/src/Wrecker/Logger.hs +++ b/src/Wrecker/Logger.hs @@ -1,13 +1,13 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module Wrecker.Logger where -import Control.Concurrent -import qualified Control.Concurrent.Chan.Unagi.Bounded as U -import Data.Foldable (traverse_) -import Data.Function -import System.IO -import System.Timeout +import Control.Monad (when) +import Data.Aeson +import Data.Monoid ((<>)) +import qualified Data.Text.Encoding as TE +import System.Log.FastLogger data LogLevel = LevelDebug @@ -16,74 +16,81 @@ | LevelError deriving (Show, Eq, Ord, Read) +data LogFormat + = PlainText + | Json + deriving (Eq, Show, Read) + data Logger = Logger - { thread :: ThreadId - , inChan :: U.InChan (Maybe String) - , wait :: IO () - , currentLevel :: LogLevel + { currentLevel :: LogLevel + , logFormat :: LogFormat + , logFunc :: FastLogger + , cleanup :: IO () + , timeFormatter :: IO FormattedTime } -{- | Create a 'Logger' with the given 'Handle' and max buffer size. - The logger will drop messages if it is unable to keep up and it's message buffer - goes over the max size. --} -newLogger :: - Handle -- ^ The 'Handle' to log to. - -> Int -- ^ Max buffer size - -> LogLevel -- ^ Minimum log level to log. - -> IO Logger -newLogger handle maxSize currentLevel = do - (inChan, outChan) <- U.newChan maxSize - lock <- newEmptyMVar - thread <- readLoop handle outChan lock - let wait = takeMVar lock - return Logger {..} - -- | Create a logger using stderr. This is the typical way a logger is created. -newStdErrLogger :: Int -> LogLevel -> IO Logger -newStdErrLogger = newLogger stderr - -readLoop :: Handle -> U.OutChan (Maybe String) -> MVar () -> IO ThreadId -readLoop handle chan lock = - forkIO $ do - fix $ \next - -- Block on the next elemen - -- If it "Just" print it and loop - -- Otherwise we are not with the loop - -> do - U.readChan chan >>= - traverse_ - (\msg -> do - hPutStrLn handle msg - next) - putMVar lock () +newStdErrLogger :: LogLevel -> LogFormat -> IO Logger +newStdErrLogger level format = do + let timeFormat = + if format == PlainText + then "%FT%T" + else "%s" + timeCache <- newTimeCache timeFormat + (logger, clean) <- newFastLogger (LogStderr defaultBufSize) + return + Logger + { currentLevel = level + , logFormat = format + , logFunc = logger + , cleanup = clean + , timeFormatter = timeCache + } -- True if the write was successful or False otherwise -writeLogger :: Logger -> LogLevel -> String -> IO Bool +writeLogger :: Logger -> LogLevel -> LogStr -> IO () writeLogger Logger {..} messageLevel msg = - if (currentLevel <= messageLevel) - then U.tryWriteChan inChan $ Just msg - else return False + when (currentLevel <= messageLevel) $ do + t <- timeFormatter + logFunc (formatMsg logFormat messageLevel t msg) -shutdownLogger :: Int -> Logger -> IO () -shutdownLogger waitTime logger@(Logger {..}) = do - U.writeChan inChan Nothing - mtimedOut <- timeout waitTime wait - case mtimedOut of - Nothing -> forceShutdownLogger logger - Just () -> return () +formatMsg :: LogFormat -> LogLevel -> FormattedTime -> LogStr -> LogStr +formatMsg PlainText level prettyTime msg = + toLogStr ("[" <> prettyTime <> "] - ") <> formatLevel level <> msg <> "\n" +formatMsg Json level prettyTime msg = toLogStr (encode jsonMsg) <> "\n" + where + jsonMsg = + object + [ "level" .= toLevelCode level + , "timestamp" .= TE.decodeUtf8 prettyTime + , "full_message" .= TE.decodeUtf8 (fromLogStr msg) + ] -forceShutdownLogger :: Logger -> IO () -forceShutdownLogger Logger {..} = killThread thread +formatLevel :: LogLevel -> LogStr +formatLevel level = "[" <> lvl level <> "] - " + where + lvl LevelDebug = "DBUG" + lvl LevelInfo = "INFO" + lvl LevelWarn = "WARN" + lvl LevelError = "ERRO" -logDebug :: Logger -> String -> IO Bool -logDebug logger = writeLogger logger LevelDebug +toLevelCode :: LogLevel -> Int +toLevelCode LevelDebug = 7 +toLevelCode LevelInfo = 6 +toLevelCode LevelWarn = 4 +toLevelCode LevelError = 3 -logInfo :: Logger -> String -> IO Bool -logInfo logger = writeLogger logger LevelInfo +shutdownLogger :: Logger -> IO () +shutdownLogger Logger {..} = cleanup -logWarn :: Logger -> String -> IO Bool -logWarn logger = writeLogger logger LevelWarn +logDebug :: ToLogStr msg => Logger -> msg -> IO () +logDebug logger = writeLogger logger LevelDebug . toLogStr -logError :: Logger -> String -> IO Bool -logError logger = writeLogger logger LevelError +logInfo :: ToLogStr msg => Logger -> msg -> IO () +logInfo logger = writeLogger logger LevelInfo . toLogStr + +logWarn :: ToLogStr msg => Logger -> msg -> IO () +logWarn logger = writeLogger logger LevelWarn . toLogStr + +logError :: ToLogStr msg => Logger -> msg -> IO () +logError logger = writeLogger logger LevelError . toLogStr diff --git a/src/Wrecker/Main.hs b/src/Wrecker/Main.hs --- a/src/Wrecker/Main.hs +++ b/src/Wrecker/Main.hs @@ -4,8 +4,7 @@ import Control.Monad (void) import Wrecker.Options (runParser) -import Wrecker.Runner (run) -import Wrecker.Runner (Environment) +import Wrecker.Runner (Environment, run) {- | 'defaultMain' is typically the main entry point for 'wrecker' benchmarks. 'defaultMain' will parse all command line arguments and then call 'run' @@ -26,27 +25,30 @@ > > wrecker - HTTP stress tester and benchmarker > -> Usage: example [--concurrency ARG] [--bin-count ARG] ([--run-count ARG] | -> [--run-timed ARG]) [--timeout-time ARG] [--display-mode ARG] -> [--log-level ARG] [--match ARG] [--request-name-size ARG] -> [--output-path ARG] [--silent] [--record-query] -> Welcome to wrecker +> Usage: wreck [--concurrency ARG] [--bin-count ARG] ([--run-count ARG] | +> [--run-timed ARG]) [--timeout-time ARG] ([--non-interactive] | +> [--interactive]) [--log-level ARG] [--log-format ARG] [--match ARG] +> [--request-name-size ARG] [--output-path ARG] [--silent] +> ([--relative-url-display] | [--absolute-url-display]) +> [--record-query] [--list-test-groups] +> Welcome to wrecker > > Available options: -> -h,--help Show this help text -> --concurrency ARG Number of threads for concurrent requests -> --bin-count ARG Number of bins for latency histogram -> --run-count ARG number of times to repeat -> --run-timed ARG number of seconds to repeat -> --timeout-time ARG How long to wait for all requests to finish -> --display-mode ARG Display results interactively -> --log-level ARG Display results interactively -> --match ARG Only run tests that match the glob -> --request-name-size ARG Request name size for the terminal display -> --output-path ARG Save a JSON file of the the statistics to given path -> --silent Disable all output -> --record-query Take in consideration the query string for the report - +> -h,--help Show this help text +> --concurrency ARG Number of threads for concurrent requests +> --bin-count ARG Number of bins for latency histogram +> --run-count ARG number of times to repeat +> --run-timed ARG number of seconds to repeat +> --timeout-time ARG How long to wait for all requests to finish +> --log-level ARG Log to stderr events of criticality greater than the +> LOG_LEVEL +> --log-format ARG Log format to use +> --match ARG Only run tests that match the glob +> --request-name-size ARG Request name size for the terminal display +> --output-path ARG Save a JSON file of the the statistics to given path +> --silent Disable all output +> --record-query Take in consideration the query string for the report +> --list-test-groups Shows the list of tests to run and exit -} defaultMain :: [(String, Environment -> IO ())] -> IO () defaultMain actions = void . flip run actions =<< runParser diff --git a/src/Wrecker/Options.hs b/src/Wrecker/Options.hs --- a/src/Wrecker/Options.hs +++ b/src/Wrecker/Options.hs @@ -47,7 +47,9 @@ -- ^ This controls the command line display. It can be either Interactive -- of NonInteractive , logLevel :: LogLevel - -- ^ + -- ^ The log severity to shown in stderr + , logFmt :: LogFormat + -- ^ The log format to use in stderr (either Json or PlainText) , match :: String -- ^ Set this to filter the benchmarks using a pattern , requestNameColumnSize :: Maybe Int @@ -75,6 +77,7 @@ , timeoutTime = 100000000 , displayMode = NonInteractive , logLevel = LevelError + , logFmt = Json , match = "" , requestNameColumnSize = Nothing , outputFilePath = Nothing @@ -91,6 +94,7 @@ , mTimeoutTime :: Maybe Int , mDisplayMode :: Maybe DisplayMode , mLogLevel :: Maybe LogLevel + , mLogFmt :: Maybe LogFormat , mMatch :: Maybe String , mRequestNameColumnSize :: Maybe Int , mOutputFilePath :: Maybe FilePath @@ -109,6 +113,7 @@ , mTimeoutTime = Just $ timeoutTime defaultOptions , mDisplayMode = Just $ displayMode defaultOptions , mLogLevel = Just $ logLevel defaultOptions + , mLogFmt = Just $ logFmt defaultOptions , mMatch = Just $ match defaultOptions , mRequestNameColumnSize = requestNameColumnSize defaultOptions , mOutputFilePath = outputFilePath defaultOptions @@ -125,6 +130,7 @@ , mTimeoutTime = mTimeoutTime x <|> mTimeoutTime y , mDisplayMode = mDisplayMode x <|> mDisplayMode y , mLogLevel = mLogLevel x <|> mLogLevel y + , mLogFmt = mLogFmt x <|> mLogFmt y , mMatch = mMatch x <|> mMatch y , mRequestNameColumnSize = mRequestNameColumnSize x <|> mRequestNameColumnSize y , mOutputFilePath = mOutputFilePath x <|> mOutputFilePath y @@ -143,6 +149,7 @@ , mTimeoutTime = Just timeoutTime , mDisplayMode = Just displayMode , mLogLevel = Just logLevel + , mLogFmt = Just logFmt , mMatch = Just match , mRequestNameColumnSize = requestNameColumnSize , mOutputFilePath = outputFilePath @@ -150,7 +157,7 @@ , murlDisplay = Just urlDisplay , mRecordQuery = Just recordQuery , mListTestGroups = Just listTestGroups - } -> Just $ Options {..} + } -> Just Options {..} _ -> Nothing optionalOption :: Read a => Mod OptionFields a -> Parser (Maybe a) @@ -180,8 +187,12 @@ Interactive <$ switch (long "interactive")) <*> -- optionalOption - (long "log-level" <> help "Log to stderr events of criticality greater than the LOG_LEVEL") <*> + (long "log-level" <> + help + "Log to stderr events of criticality greater than the LOG_LEVEL (LevelWarn | LevelError | LevelInfo | LevelDebug)") <*> -- + optionalOption (long "log-format" <> help "Log format to use (Json | PlainText)") <*> + -- optionalStrOption (long "match" <> help "Only run tests that match the glob") <*> -- optionalOption (long "request-name-size" <> help "Request name size for the terminal display") <*> @@ -199,36 +210,7 @@ -- optionalSwitch (long "list-test-groups" <> help "Shows the list of tests to run and exit") --- {- | Run the command line parse and return the 'Options' - -'runParser' can parse the following options - -> $ wrecker-based-app --help -> -> wrecker - HTTP stress tester and benchmarker -> -> Usage: example [--concurrency ARG] [--bin-count ARG] ([--run-count ARG] | -> [--run-timed ARG]) [--timeout-time ARG] [--display-mode ARG] -> [--log-level ARG] [--match ARG] [--request-name-size ARG] -> [--output-path ARG] [--silent] [--record-query] -> Welcome to wrecker -> -> Available options: -> -h,--help Show this help text -> --concurrency ARG Number of threads for concurrent requests -> --bin-count ARG Number of bins for latency histogram -> --run-count ARG number of times to repeat -> --run-timed ARG number of seconds to repeat -> --timeout-time ARG How long to wait for all requests to finish -> --display-mode ARG Display results interactively -> --log-level ARG Display results interactively -> --match ARG Only run tests that match the glob -> --request-name-size ARG Request name size for the terminal display -> --output-path ARG Save a JSON file of the the statistics to given path -> --silent Disable all output -> --record-query Take in consideration the query string for the report -> --list-test-groups Shows the list of tests to run and exit -} runParser :: IO Options runParser = do diff --git a/src/Wrecker/Runner.hs b/src/Wrecker/Runner.hs --- a/src/Wrecker/Runner.hs +++ b/src/Wrecker/Runner.hs @@ -43,6 +43,7 @@ , context :: ConnectionContext -- ^ Provided as a convience, this is a shared TLS context to reuse for -- better performance. + , logger :: Logger } {- | Typically 'wrecker' will control benchmarking actions. However in some situations @@ -55,14 +56,13 @@ newStandaloneRecorder :: IO (NextRef AllStats, Immortal.Thread, Recorder) newStandaloneRecorder = do recorder <- Recorder.newRecorder True 10000 - logger <- newStdErrLogger 1000 LevelError - (ref, thread) <- sinkRecorder logger recorder + (ref, thread) <- sinkRecorder recorder return (ref, thread, recorder) -sinkRecorder :: Logger -> Recorder -> IO (NextRef AllStats, Immortal.Thread) -sinkRecorder logger recorder = do +sinkRecorder :: Recorder -> IO (NextRef AllStats, Immortal.Thread) +sinkRecorder recorder = do ref <- newNextRef emptyAllStats - immortal <- Immortal.createWithLabel "collectEvent" $ \_ -> collectEvent logger ref recorder + immortal <- Immortal.createWithLabel "collectEvent" $ \_ -> collectEvent ref recorder return (ref, immortal) updateSampler :: NextRef AllStats -> Event -> IO AllStats @@ -71,13 +71,12 @@ let !new = stepAllStats x (eRunIndex event) (Recorder.name $ eResult event) (eResult event) in (new, new) -collectEvent :: Logger -> NextRef AllStats -> Recorder -> IO () -collectEvent logger ref recorder = +collectEvent :: NextRef AllStats -> Recorder -> IO () +collectEvent ref recorder = fix $ \next -> do mevent <- Recorder.readEvent recorder for_ mevent $ \event -> do - sampler <- updateSampler ref event - logDebug logger $ show sampler + _ <- updateSampler ref event next runAction :: Logger -> Int -> Int -> RunType -> (Environment -> IO ()) -> Environment -> IO () @@ -125,18 +124,18 @@ recorder <- Recorder.newRecorder recordQuery 100000 context <- Connection.initConnectionContext sampler <- newNextRef emptyAllStats - logger <- newStdErrLogger 100000 logLevel + logger <- newStdErrLogger logLevel logFmt -- Collect events and forkIO $ handle (\(e :: SomeException) -> void $ logError logger $ show e) $ - collectEvent logger sampler recorder + collectEvent sampler recorder consumer sampler logDebug logger "Starting Runs" let env = Environment {..} runAction logger timeoutTime concurrency runStyle action env `finally` (do logDebug logger "Shutting Down" Recorder.stopRecorder recorder - shutdownLogger 1000000 logger + shutdownLogger logger final sampler) readLast sampler diff --git a/wrecker.cabal b/wrecker.cabal --- a/wrecker.cabal +++ b/wrecker.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: ba28c486ce0f76d696c6aabcb155909519ce09949843c4bb1e3159edb06b09ac +-- hash: 1a942b8332864cd112ccea2578c97845dd6909f862d8c624f9383e8d42f88cec name: wrecker -version: 1.2.4.0 +version: 1.3.0.0 synopsis: An HTTP Performance Benchmarker description: 'wrecker' is a library and executable for creating HTTP benchmarks. It is designed for benchmarking a series of dependent requests. @@ -52,6 +52,7 @@ , data-default-class >=0.0.1 , deepseq >=1.3 , exceptions >=0.8 + , fast-logger >=2.4.10 , filepath >=1.3 , http-client >=0.5.5 , http-client-tls >=0.3.3 @@ -76,7 +77,6 @@ , time >=1.4 , tls >=1.2 , transformers >=0.3 - , unagi-chan >=0.4.0 , unix >=2.7 , unordered-containers >=0.2.5 , vector >=0.10.12