diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,9 @@ +# Change log + +## 0.1.0.0 + +* Initial release + +## 0.0.0.0 + +* Unreleased dev version diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,23 @@ +[The MIT License (MIT)][] + +Copyright (c) 2022 Jason Shipman + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + +[The MIT License (MIT)]: https://opensource.org/licenses/MIT diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,178 @@ +# [monad-logger-aeson][] + +[![Build badge][]][build] +[![Version badge][]][version] + +## Synopsis + +`monad-logger-aeson` provides structured JSON logging using `monad-logger`'s +interface. Specifically, it is intended to be a (largely) drop-in replacement +for `monad-logger`'s `Control.Monad.Logger.CallStack` module. + +For additional detail on the library, please see the [Haddocks][], the +[announcement blog post][], and the remainder of this README. + +## Crash course + +Assuming we have the following `monad-logger`-based code: + +```haskell +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedStrings #-} +module Main + ( main + ) where + +import Control.Monad.Logger.CallStack +import Data.Text (pack) + +doStuff :: (MonadLogger m) => Int -> m () +doStuff x = do + logDebug $ "Doing stuff: x=" <> pack (show x) + +main :: IO () +main = do + runStdoutLoggingT do + doStuff 42 + logInfo "Done" +``` + +We would get something like this log output: + +```text +[Debug] Doing stuff: x=42 @(main:Main app/readme-example.hs:12:3) +[Info] Done @(main:Main app/readme-example.hs:18:5) +``` + +We can change our import from this: + +```haskell +import Control.Monad.Logger.CallStack +``` + +To this: + +```haskell +import Control.Monad.Logger.Aeson +``` + +In changing the import, we'll have one compiler error to address: + +```text +monad-logger-aeson/app/readme-example.hs:12:35: error: + • Couldn't match expected type ‘Message’ + with actual type ‘Data.Text.Internal.Text’ + • In the second argument of ‘(<>)’, namely ‘pack (show x)’ + In the second argument of ‘($)’, namely + ‘"Doing stuff: x=" <> pack (show x)’ + In a stmt of a 'do' block: + logDebug $ "Doing stuff: x=" <> pack (show x) + | +12 | logDebug $ "Doing stuff: x=" <> pack (show x) + | +``` + +This indicates that we need to provide the `logDebug` call a `Message` rather +than a `Text` value. This compiler error gives us a choice depending upon our +current time constraints: we can either go ahead and convert this `Text` value +to a "proper" `Message` by moving the metadata it encodes into structured data +(i.e. a `[Series]` value, where `Series` is an `aeson` key and encoded value), +or we can defer doing that for now by tacking on an empty `[Series]` value. +We'll opt for the former here: + +```haskell +logDebug $ "Doing stuff" :# ["x" .@ x] +``` + +Note that the `logInfo` call did not give us a compiler error, as `Message` has +an `IsString` instance. + +Our log output now looks like this (formatted for readability here with `jq`): + +```jsonl +{ + "time": "2022-05-15T20:52:15.5559417Z", + "level": "debug", + "location": { + "package": "main", + "module": "Main", + "file": "app/readme-example.hs", + "line": 11, + "char": 3 + }, + "message": { + "text": "Doing stuff", + "meta": { + "x": 42 + } + } +} +{ + "time": "2022-05-15T20:52:15.5560448Z", + "level": "info", + "location": { + "package": "main", + "module": "Main", + "file": "app/readme-example.hs", + "line": 17, + "char": 5 + }, + "message": { + "text": "Done" + } +} +``` + +Voilà! Now our Haskell code is using structured logging. Our logs are fit for +parsing, ingestion into our log aggregation/analysis service of choice, etc. + +## Goals + +The following goals have underpinned the development of `monad-logger-aeson`: + +1. Structured logging _must_ be easy to add to existing Haskell codebases +1. Structured logging _should_ be performant + +We believe we have achieved goal 1 by targeting `monad-logger`'s +`MonadLogger`/`LoggingT` interface. There are many interesting logging libraries +to choose from in Haskell: `monad-logger`, `di`, `logging-effect`, `katip`, and +so on. Both by comparing the [reverse dependency list][] for `monad-logger` with +the other logging libraries' reverse dependency lists, and also consulting our +personal experiences working on Haskell codebases, `monad-logger` would seem to +be the most prevalent logging library in the wild. In developing our library as +a (largely) drop-in replacement for `monad-logger`, we hope to empower +Haskellers using this popular logging interface to add structured logging to +their programs with minimal fuss. + +We believe we have achieved goal 2 by directly representing in-flight `Message` +values using a fixed `aeson` object `Encoding`, by never (internally) converting +anything to intermediate `Value`s, and by never parsing these in-flight log +messages when assembling the final logged message. Regarding the latter point, +we need to know the origin of an input `LogStr` (i.e. is it from +`monad-logger-aeson` or not?). If we know an input `LogStr` came from +`monad-logger-aeson`, then we know the `LogStr` is an `aeson` object `Encoding` +of a `Message`, and so we can pass this encoding along untouched as a piece of +the final log message's encoding. If we know an input `LogStr` did not come from +`monad-logger-aeson`, then we can scoop this `LogStr` up into a text-only +`Message`, encode that, and pass the encoding along as a piece of the final log +message's encoding. A straightforward and relatively expensive implementation of +determining a `LogStr`'s origin would involve parsing of in-flight log messages +back into `Message` values. Rather than resort to parsing _every_ in-flight +message, we simply check the first 9 characters of the `LogStr` for a match with +`{"text":"`. Yes, there is the possibility that a `monad-logger` user logs out a +`LogStr` with this same prefix and that `LogStr` makes its way into a +`monad-logger-aeson` user's `LoggingT` runner function. This would cause +`monad-logger-aeson` to erroneously assume the message's origin is +`monad-logger-aeson`. We feel this possibility is overall unlikely, and have +accepted this as a tradeoff in the design space of the library. While we believe +the principles described previously should provide good performance, please note +that benchmarks do not yet exist for this library. Caveat emptor! + +[monad-logger-aeson]: https://github.com/jship/monad-logger-aeson +[Build badge]: https://github.com/jship/monad-logger-aeson/workflows/CI/badge.svg +[build]: https://github.com/jship/monad-logger-aeson/actions +[Version badge]: https://img.shields.io/hackage/v/monad-logger-aeson?color=brightgreen&label=version&logo=haskell +[version]: https://hackage.haskell.org/package/monad-logger-aeson +[Haddocks]: https://hackage.haskell.org/package/monad-logger-aeson +[announcement blog post]: https://jship.github.io/posts/2022-05-17-announcing-monad-logger-aeson/ +[reverse dependency list]: https://packdeps.haskellers.com/reverse/monad-logger diff --git a/app/readme-example.hs b/app/readme-example.hs new file mode 100644 --- /dev/null +++ b/app/readme-example.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedStrings #-} +module Main + ( main + ) where + +import Control.Monad.Logger.Aeson + +doStuff :: (MonadLogger m) => Int -> m () +doStuff x = do + logDebug $ "Doing stuff" :# ["x" .@ x] + +main :: IO () +main = do + runStdoutLoggingT do + doStuff 42 + logInfo "Done" diff --git a/library/Control/Monad/Logger/Aeson.hs b/library/Control/Monad/Logger/Aeson.hs new file mode 100644 --- /dev/null +++ b/library/Control/Monad/Logger/Aeson.hs @@ -0,0 +1,515 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +module Control.Monad.Logger.Aeson + ( -- * Synopsis + -- $synopsis + + -- * Types + Message(..) + , (.@) + , LoggedMessage(..) + + -- * Logging functions + -- ** Implicit call stack, no @LogSource@ + , logDebug + , logInfo + , logWarn + , logError + , logOther + -- ** Explicit call stack, no @LogSource@ + , logDebugCS + , logInfoCS + , logWarnCS + , logErrorCS + , logOtherCS + -- ** Implicit call stack, with @LogSource@ + , logDebugNS + , logInfoNS + , logWarnNS + , logErrorNS + , logOtherNS + + -- ** Thread context + , withThreadContext + , myThreadContext + + -- * @LoggingT@ runners + , runFileLoggingT + , runHandleLoggingT + , runStdoutLoggingT + , runStderrLoggingT + , runFastLoggingT + + -- * Utilities for defining our own loggers + , defaultOutput + , handleOutput + , fastLoggerOutput + , defaultOutputWith + , defaultOutputOptions + , OutputOptions + , outputIncludeThreadId + , outputBaseThreadContext + , defaultLogStr + , defaultHandleFromLevel + + -- * Re-exports from @monad-logger@ + , module Log + ) where + +-- N.B. This import is not grouped with the others as this makes it easier to +-- cross-reference with this module's exports. +import Control.Monad.Logger as Log hiding + ( logDebug + , logInfo + , logWarn + , logError + , logOther + , logDebugCS + , logInfoCS + , logWarnCS + , logErrorCS + , logOtherCS + , logWithoutLoc -- No re-export, as the 'log*NS' here use call stack for loc + , logDebugNS + , logInfoNS + , logWarnNS + , logErrorNS + , logOtherNS + , runFileLoggingT + , runStderrLoggingT + , runStdoutLoggingT + , defaultOutput + , defaultLogStr + ) + +import Control.Monad.Catch (MonadMask, MonadThrow) +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Control.Monad.Logger.Aeson.Internal + ( LoggedMessage(..), Message(..), OutputOptions(..), (.@), KeyMap + ) +import Data.Aeson (Value(String)) +import Data.Aeson.Types (Pair) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Stack (CallStack, HasCallStack, callStack) +import System.IO + ( BufferMode(LineBuffering), IOMode(AppendMode), Handle, hClose, hSetBuffering, openFile, stderr + , stdout + ) +import System.Log.FastLogger (LoggerSet) +import qualified Context +import qualified Control.Concurrent as Concurrent +import qualified Control.Monad.Catch as Catch +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.Text as Text +import qualified Data.Time as Time +import qualified System.Log.FastLogger as FastLogger + +-- | Logs a 'Message' with the location provided by an implicit 'CallStack'. +-- +-- @since 0.1.0.0 +logDebug :: (HasCallStack, MonadLogger m) => Message -> m () +logDebug = logDebugCS callStack + +-- | See 'logDebug' +-- +-- @since 0.1.0.0 +logInfo :: (HasCallStack, MonadLogger m) => Message -> m () +logInfo = logInfoCS callStack + +-- | See 'logDebug' +-- +-- @since 0.1.0.0 +logWarn :: (HasCallStack, MonadLogger m) => Message -> m () +logWarn = logWarnCS callStack + +-- | See 'logDebug' +-- +-- @since 0.1.0.0 +logError :: (HasCallStack, MonadLogger m) => Message -> m () +logError = logErrorCS callStack + +-- | See 'logDebug' +-- +-- @since 0.1.0.0 +logOther :: (HasCallStack, MonadLogger m) => LogLevel -> Message -> m () +logOther = logOtherCS callStack + +-- | Logs a 'Message' with location given by 'CallStack'. +-- +-- @since 0.1.0.0 +logDebugCS :: (MonadLogger m) => CallStack -> Message -> m () +logDebugCS cs msg = Internal.logCS cs "" LevelDebug msg + +-- | See 'logDebugCS' +-- +-- @since 0.1.0.0 +logInfoCS :: (MonadLogger m) => CallStack -> Message -> m () +logInfoCS cs msg = Internal.logCS cs "" LevelInfo msg + +-- | See 'logDebugCS' +-- +-- @since 0.1.0.0 +logWarnCS :: (MonadLogger m) => CallStack -> Message -> m () +logWarnCS cs msg = Internal.logCS cs "" LevelWarn msg + +-- | See 'logDebugCS' +-- +-- @since 0.1.0.0 +logOtherCS :: (MonadLogger m) => CallStack -> LogLevel -> Message -> m () +logOtherCS cs lvl msg = Internal.logCS cs "" lvl msg + +-- | See 'logDebugCS' +-- +-- @since 0.1.0.0 +logErrorCS :: (MonadLogger m) => CallStack -> Message -> m () +logErrorCS cs msg = Internal.logCS cs "" LevelError msg + +-- | See 'logDebugCS' +-- +-- @since 0.1.0.0 +logDebugNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m () +logDebugNS src = Internal.logCS callStack src LevelDebug + +-- | See 'logDebugNS' +-- +-- @since 0.1.0.0 +logInfoNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m () +logInfoNS src = Internal.logCS callStack src LevelInfo + +-- | See 'logDebugNS' +-- +-- @since 0.1.0.0 +logWarnNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m () +logWarnNS src = Internal.logCS callStack src LevelWarn + +-- | See 'logDebugNS' +-- +-- @since 0.1.0.0 +logErrorNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m () +logErrorNS src = Internal.logCS callStack src LevelError + +-- | See 'logDebugNS' +-- +-- @since 0.1.0.0 +logOtherNS :: (HasCallStack, MonadLogger m) => LogSource -> LogLevel -> Message -> m () +logOtherNS = Internal.logCS callStack + +-- | This function lets us register structured, contextual info for the duration +-- of the provided action. All messages logged within the provided action will +-- automatically include this contextual info. This function is thread-safe, as +-- the contextual info is scoped to the calling thread only. +-- +-- This function is additive: if we nest calls to it, each nested call will add +-- to the existing thread context. In the case of overlapping keys, the nested +-- call's 'Pair' value(s) will win. Whenever the inner action completes, the +-- thread context is rolled back to its value set in the enclosing action. +-- +-- If we wish to include the existing thread context from one thread in another +-- thread, we must register the thread context explicitly on that other thread. +-- 'myThreadContext' can be leveraged in this case. +-- +-- Registering thread context for messages can be useful in many scenarios. One +-- particularly apt scenario is in @wai@ middlewares. We can generate an ID for +-- each incoming request then include it in the thread context. Now all messages +-- subsequently logged from our endpoint handler will automatically include that +-- request ID: +-- +-- > import Control.Monad.Logger.Aeson ((.@), withThreadContext) +-- > import Network.Wai (Middleware) +-- > import qualified Data.UUID.V4 as UUID +-- > +-- > addRequestId :: Middleware +-- > addRequestId app = \request sendResponse -> do +-- > uuid <- UUID.nextRandom +-- > withThreadContext ["requestId" .@ uuid] do +-- > app request sendResponse +-- +-- If we're coming from a Java background, it may be helpful for us to draw +-- parallels between this function and @log4j2@'s @ThreadContext@ (or perhaps +-- @log4j@'s @MDC@). They all enable the same thing: setting some thread-local +-- info that will be automatically pulled into each logged message. +-- +-- @since 0.1.0.0 +withThreadContext :: (MonadIO m, MonadMask m) => [Pair] -> m a -> m a +withThreadContext pairs = + Context.adjust Internal.threadContextStore \pairsMap -> + Internal.keyMapUnion (Internal.keyMapFromList pairs) pairsMap + +-- | This function lets us retrieve the calling thread's thread context. For +-- more detail, we can consult the docs for 'withThreadContext'. +-- +-- Note that even though the type signature lists 'MonadThrow' as a required +-- constraint, the library guarantees that 'myThreadContext' will never throw. +-- +-- @since 0.1.0.0 +myThreadContext :: (MonadIO m, MonadThrow m) => m (KeyMap Value) +myThreadContext = do + Context.mine Internal.threadContextStore + +-- | Run a block using a 'MonadLogger' instance which appends to the specified +-- file. +-- +-- Note that this differs from the @monad-logger@ version in its constraints. +-- We use the @exceptions@ package's 'MonadMask' here for bracketing, rather +-- than @monad-control@. +-- +-- @since 0.1.0.0 +runFileLoggingT :: (MonadIO m, MonadMask m) => FilePath -> LoggingT m a -> m a +runFileLoggingT filePath action = + Catch.bracket (liftIO $ openFile filePath AppendMode) (liftIO . hClose) \h -> do + liftIO $ hSetBuffering h LineBuffering + runLoggingT action $ defaultOutput h + +-- | Run a block using a 'MonadLogger' instance which prints to 'stderr'. +-- +-- @since 0.1.0.0 +runStderrLoggingT :: LoggingT m a -> m a +runStderrLoggingT = flip runLoggingT (defaultOutput stderr) + +-- | Run a block using a 'MonadLogger' instance which prints to 'stdout'. +-- +-- @since 0.1.0.0 +runStdoutLoggingT :: LoggingT m a -> m a +runStdoutLoggingT = flip runLoggingT (defaultOutput stdout) + +-- | Run a block using a 'MonadLogger' instance which prints to a 'Handle' +-- determined by the log message's 'LogLevel'. +-- +-- A common use case for this function is to log warn\/error messages to 'stderr' +-- and debug\/info messages to 'stdout' in CLIs/tools (see +-- 'defaultHandleFromLevel'). +-- +-- @since 0.1.0.0 +runHandleLoggingT :: (LogLevel -> Handle) -> LoggingT m a -> m a +runHandleLoggingT = flip runLoggingT . handleOutput + +-- | Run a block using a 'MonadLogger' instance which appends to the specified +-- 'LoggerSet'. +-- +-- @since 0.1.0.0 +runFastLoggingT :: LoggerSet -> LoggingT m a -> m a +runFastLoggingT loggerSet = flip runLoggingT (fastLoggerOutput loggerSet) + +-- | A default implementation of the action that backs the 'monadLoggerLog' +-- function. It accepts a file handle as the first argument and will log +-- incoming 'LogStr' values wrapped in the JSON structure prescribed by this +-- library. +-- +-- This is used in the definition of 'runStdoutLoggingT' and +-- 'runStderrLoggingT': +-- +-- @ +-- 'runStdoutLoggingT' :: 'LoggingT' m a -> m a +-- 'runStdoutLoggingT' = 'flip' 'runLoggingT' ('defaultOutput' 'stdout') +-- @ +-- +-- We can instead use 'defaultOutputWith' if we need more control of the output. +-- +-- @since 0.1.0.0 +defaultOutput + :: Handle + -> Loc + -> LogSource + -> LogLevel + -> LogStr + -> IO () +defaultOutput handle = handleOutput (const handle) + +-- | Given an output action for log messages, this function will produce the +-- default recommended 'OutputOptions'. +-- +-- Specific options can be overriden via record update syntax using +-- 'outputIncludeThreadId', 'outputBaseThreadContext', and friends. +-- +-- @since 0.1.0.0 +defaultOutputOptions :: (LogLevel -> BS8.ByteString -> IO ()) -> OutputOptions +defaultOutputOptions outputAction = + OutputOptions + { outputAction + , outputIncludeThreadId = False + , outputBaseThreadContext = [] + } + +-- | This function is a lower-level helper for implementing the action that +-- backs the 'monadLoggerLog' function. +-- +-- We should generally prefer 'defaultOutput' over this function, but this +-- function is available if we do need more control over our output. +-- +-- @since 0.1.0.0 +defaultOutputWith + :: OutputOptions + -> Loc + -> LogSource + -> LogLevel + -> LogStr + -> IO () +defaultOutputWith outputOptions location logSource logLevel msg = do + now <- Time.getCurrentTime + threadIdText <- fmap (Text.pack . show) Concurrent.myThreadId + threadContext <- Context.mines Internal.threadContextStore \hashMap -> + ( if outputIncludeThreadId then + Internal.keyMapInsert "tid" $ String threadIdText + else + id + ) $ Internal.keyMapUnion hashMap $ baseThreadContextHashMap + outputAction logLevel + $ Internal.defaultLogStrBS now threadContext location logSource logLevel msg + where + baseThreadContextHashMap = Internal.keyMapFromList outputBaseThreadContext + OutputOptions + { outputAction + , outputIncludeThreadId + , outputBaseThreadContext + } = outputOptions + +-- | An implementation of the action that backs the 'monadLoggerLog' function, +-- where the 'Handle' destination for each log message is determined by the log +-- message's 'LogLevel'. This function will log incoming 'LogStr' values wrapped +-- in the JSON structure prescribed by this library. +-- +-- This is used in the definition of 'runHandleLoggingT': +-- +-- @ +-- 'runHandleLoggingT' :: ('LogLevel' -> 'Handle') -> 'LoggingT' m a -> m a +-- 'runHandleLoggingT' = 'flip' 'runLoggingT' . 'handleOutput' +-- @ +-- +-- @since 0.1.0.0 +handleOutput + :: (LogLevel -> Handle) + -> Loc + -> LogSource + -> LogLevel + -> LogStr + -> IO () +handleOutput levelToHandle = + defaultOutputWith $ defaultOutputOptions \logLevel bytes -> do + BS8.hPutStrLn (levelToHandle logLevel) bytes + +-- | An implementation of the action that backs the 'monadLoggerLog' function, +-- where log messages are written to a provided 'LoggerSet'. This function will +-- log incoming 'LogStr' values wrapped in the JSON structure prescribed by this +-- library. +-- +-- This is used in the definition of 'runFastLoggingT': +-- +-- @ +-- 'runFastLoggingT' :: 'LoggerSet' -> 'LoggingT' m a -> m a +-- 'runFastLoggingT' loggerSet = 'flip' 'runLoggingT' ('fastLoggerOutput' loggerSet) +-- @ +-- +-- @since 0.1.0.0 +fastLoggerOutput + :: LoggerSet + -> Loc + -> LogSource + -> LogLevel + -> LogStr + -> IO () +fastLoggerOutput loggerSet = + defaultOutputWith $ defaultOutputOptions \_logLevel bytes -> do + FastLogger.pushLogStrLn loggerSet $ toLogStr bytes + +-- | @since 0.1.0.0 +defaultLogStr + :: UTCTime + -> KeyMap Value + -> Loc + -> LogSource + -> LogLevel + -> LogStr + -> LogStr +defaultLogStr now threadContext loc logSource logLevel logStr = + toLogStr + $ Internal.defaultLogStrBS now threadContext loc logSource logLevel logStr + +-- | This function maps the possible 'LogLevel' values to 'Handle' values. +-- Specifically, 'LevelDebug' and 'LevelInfo' map to 'stdout', while 'LevelWarn' +-- and 'LevelError' map to 'stderr'. The function is most useful for CLIs/tools +-- (see 'runHandleLoggingT'). +-- +-- The input function discriminating 'Text' is used to determine the 'Handle' +-- mapping for 'LevelOther'. For example, if we wish for all 'LevelOther' +-- messages to be logged to 'stderr', we can supply @(const stderr)@ as the +-- value for this input function. +-- +-- @since 0.1.0.0 +defaultHandleFromLevel :: (Text -> Handle) -> LogLevel -> Handle +defaultHandleFromLevel otherLevelToHandle = \case + LevelDebug -> stdout + LevelInfo -> stdout + LevelWarn -> stderr + LevelError -> stderr + LevelOther otherLevel -> otherLevelToHandle otherLevel + +-- $synopsis +-- +-- @monad-logger-aeson@ provides structured JSON logging using @monad-logger@'s +-- interface. Specifically, it is intended to be a (largely) drop-in replacement +-- for @monad-logger@'s "Control.Monad.Logger.CallStack" module. +-- +-- In brief, this program: +-- +-- > {-# LANGUAGE BlockArguments #-} +-- > {-# LANGUAGE OverloadedStrings #-} +-- > module Main +-- > ( main +-- > ) where +-- > +-- > import Control.Monad.Logger.Aeson +-- > +-- > doStuff :: (MonadLogger m) => Int -> m () +-- > doStuff x = do +-- > logDebug $ "Doing stuff" :# ["x" .@ x] +-- > +-- > main :: IO () +-- > main = do +-- > runStdoutLoggingT do +-- > doStuff 42 +-- > logInfo "Done" +-- +-- Would produce this output (formatted for readability here with @jq@): +-- +-- > { +-- > "time": "2022-05-15T20:52:15.5559417Z", +-- > "level": "debug", +-- > "location": { +-- > "package": "main", +-- > "module": "Main", +-- > "file": "app/readme-example.hs", +-- > "line": 11, +-- > "char": 3 +-- > }, +-- > "message": { +-- > "text": "Doing stuff", +-- > "meta": { +-- > "x": 42 +-- > } +-- > } +-- > } +-- > { +-- > "time": "2022-05-15T20:52:15.5560448Z", +-- > "level": "info", +-- > "location": { +-- > "package": "main", +-- > "module": "Main", +-- > "file": "app/readme-example.hs", +-- > "line": 17, +-- > "char": 5 +-- > }, +-- > "message": { +-- > "text": "Done" +-- > } +-- > } +-- +-- For additional detail on the library, please see the remainder of these +-- Haddocks and the following external resources: +-- +-- * [README](https://github.com/jship/monad-logger-aeson/blob/main/monad-logger-aeson/README.md) +-- * [Announcement blog post](https://jship.github.io/posts/2022-05-17-announcing-monad-logger-aeson/) diff --git a/library/Control/Monad/Logger/Aeson/Internal.hs b/library/Control/Monad/Logger/Aeson/Internal.hs new file mode 100644 --- /dev/null +++ b/library/Control/Monad/Logger/Aeson/Internal.hs @@ -0,0 +1,513 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StrictData #-} +module Control.Monad.Logger.Aeson.Internal + ( -- * Disclaimer + -- $disclaimer + + -- ** @Message@-related + Message(..) + , (.@) + , LoggedMessage(..) + , threadContextStore + , logCS + , OutputOptions(..) + , defaultLogStrBS + , defaultLogStrLBS + , messageEncoding + , messageSeries + + -- ** @LogItem@-related + , LogItem(..) + , logItemEncoding + + -- ** Encoding-related + , pairsEncoding + , pairsSeries + , levelEncoding + , locEncoding + + -- ** @monad-logger@ internals + , mkLoggerLoc + , locFromCS + , isDefaultLoc + + -- ** Aeson compat + , Key + , KeyMap + , emptyKeyMap + , keyMapFromList + , keyMapToList + , keyMapInsert + , keyMapUnion + ) where + +import Context (Store) +import Control.Applicative (Applicative(liftA2)) +import Control.Monad.Logger (Loc(..), LogLevel(..), MonadLogger(..), ToLogStr(..), LogSource) +import Data.Aeson (KeyValue((.=)), Value(Object), (.:), (.:?), Encoding, FromJSON, ToJSON) +import Data.Aeson.Encoding.Internal (Series(..)) +import Data.Aeson.Types (Pair, Parser) +import Data.String (IsString) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) +import GHC.Stack (SrcLoc(..), CallStack, getCallStack) +import System.Log.FastLogger.Internal (LogStr(..)) +import qualified Context +import qualified Control.Monad.Logger as Logger +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Encoding as Aeson +import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as LBS8 +import qualified Data.Maybe as Maybe +import qualified Data.String as String +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text.Encoding +import qualified Data.Text.Encoding.Error as Text.Encoding.Error +import qualified System.IO.Unsafe as IO.Unsafe + +#if MIN_VERSION_aeson(2, 0, 0) +import Data.Aeson.Key (Key) +import Data.Aeson.KeyMap (KeyMap) +import qualified Data.Aeson.KeyMap as AesonCompat +#else +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as AesonCompat +type Key = Text +type KeyMap v = HashMap Key v +#endif + +emptyKeyMap :: KeyMap v +emptyKeyMap = AesonCompat.empty + +keyMapFromList :: [(Key, v)] -> KeyMap v +keyMapFromList = AesonCompat.fromList + +keyMapToList :: KeyMap v -> [(Key, v)] +keyMapToList = AesonCompat.toList + +keyMapInsert :: Key -> v -> KeyMap v -> KeyMap v +keyMapInsert = AesonCompat.insert + +keyMapUnion :: KeyMap v -> KeyMap v -> KeyMap v +keyMapUnion = AesonCompat.union + +-- | Synonym for '.=' from @aeson@. +-- +-- We export this synonym rather than directly exporting '.=' to avoid clashing +-- if the user has open-imported both "Control.Monad.Logger.Aeson" and +-- "Data.Aeson". +-- +-- @since 0.1.0.0 +(.@) :: (KeyValue kv, ToJSON v) => Key -> v -> kv +(.@) = (.=) + +-- | This type is the Haskell representation of each JSON log message produced +-- by this library. +-- +-- While we never interact with this type directly when logging messages with +-- @monad-logger-aeson@, we may wish to use this type if we are +-- parsing/processing log files generated by this library. +-- +-- @since 0.1.0.0 +data LoggedMessage = LoggedMessage + { loggedMessageTimestamp :: UTCTime + , loggedMessageLevel :: LogLevel + , loggedMessageLoc :: Maybe Loc + , loggedMessageLogSource :: Maybe LogSource + , loggedMessageThreadContext :: KeyMap Value + , loggedMessageText :: Text + , loggedMessageMeta :: KeyMap Value + } deriving stock (Eq, Generic, Ord, Show) + +instance FromJSON LoggedMessage where + parseJSON = Aeson.withObject "LoggedMessage" \obj -> do + loggedMessageTimestamp <- obj .: "time" + loggedMessageLevel <- fmap logLevelFromText $ obj .: "level" + loggedMessageLoc <- parseLoc =<< obj .:? "location" + loggedMessageLogSource <- obj .:? "source" + loggedMessageThreadContext <- parsePairs =<< obj .:? "context" + (loggedMessageText, loggedMessageMeta) <- parseMessage =<< obj .: "message" + pure LoggedMessage + { loggedMessageTimestamp + , loggedMessageLevel + , loggedMessageLoc + , loggedMessageLogSource + , loggedMessageThreadContext + , loggedMessageText + , loggedMessageMeta + } + where + logLevelFromText :: Text -> LogLevel + logLevelFromText = \case + "debug" -> LevelDebug + "info" -> LevelInfo + "warn" -> LevelWarn + "error" -> LevelError + other -> LevelOther other + + parseLoc :: Maybe Value -> Parser (Maybe Loc) + parseLoc = + traverse $ Aeson.withObject "Loc" \obj -> + Loc + <$> obj .: "file" + <*> obj .: "package" + <*> obj .: "module" + <*> (liftA2 (,) (obj .: "line") (obj .: "char")) + <*> pure (0, 0) + + parsePairs :: Maybe Value -> Parser (KeyMap Value) + parsePairs = \case + Nothing -> pure mempty + Just value -> flip (Aeson.withObject "[Pair]") value \obj -> do + pure obj + + parseMessage :: Value -> Parser (Text, KeyMap Value) + parseMessage = Aeson.withObject "Message" \obj -> + (,) <$> obj .: "text" <*> (parsePairs =<< obj .:? "meta") + +instance ToJSON LoggedMessage where + toJSON loggedMessage = + Aeson.object $ Maybe.catMaybes + [ Just $ "time" .@ loggedMessageTimestamp + , Just $ "level" .@ logLevelToText loggedMessageLevel + , case loggedMessageLoc of + Nothing -> Nothing + Just loc -> Just $ "location" .@ locToJSON loc + , case loggedMessageLogSource of + Nothing -> Nothing + Just logSource -> Just $ "source" .@ logSource + , if loggedMessageThreadContext == mempty then + Nothing + else + Just $ "context" .@ Object loggedMessageThreadContext + , Just $ "message" .@ messageJSON + ] + where + locToJSON :: Loc -> Value + locToJSON loc = + Aeson.object + [ "package" .@ loc_package + , "module" .@ loc_module + , "file" .@ loc_filename + , "line" .@ fst loc_start + , "char" .@ snd loc_start + ] + where + Loc { loc_filename, loc_package, loc_module, loc_start } = loc + + messageJSON :: Value + messageJSON = + Aeson.object $ Maybe.catMaybes + [ Just $ "text" .@ loggedMessageText + , if loggedMessageMeta == mempty then + Nothing + else + Just $ "meta" .@ Object loggedMessageMeta + ] + + LoggedMessage + { loggedMessageTimestamp + , loggedMessageLevel + , loggedMessageLoc + , loggedMessageLogSource + , loggedMessageThreadContext + , loggedMessageText + , loggedMessageMeta + } = loggedMessage + + toEncoding loggedMessage = logItemEncoding logItem + where + logItem = + LogItem + { logItemTimestamp = loggedMessageTimestamp + , logItemLoc = Maybe.fromMaybe Logger.defaultLoc loggedMessageLoc + , logItemLogSource = Maybe.fromMaybe "" loggedMessageLogSource + , logItemLevel = loggedMessageLevel + , logItemThreadContext = loggedMessageThreadContext + , logItemMessageEncoding = + messageEncoding $ + loggedMessageText :# keyMapToSeriesList loggedMessageMeta + } + + keyMapToSeriesList :: KeyMap Value -> [Series] + keyMapToSeriesList = + fmap (uncurry Aeson.pair . fmap Aeson.toEncoding) . keyMapToList + + LoggedMessage + { loggedMessageTimestamp + , loggedMessageLevel + , loggedMessageLoc + , loggedMessageLogSource + , loggedMessageThreadContext + , loggedMessageText + , loggedMessageMeta + } = loggedMessage + +-- | A 'Message' captures a textual component and a metadata component. The +-- metadata component is a list of 'Series' to support tacking on arbitrary +-- structured data to a log message. +-- +-- With the @OverloadedStrings@ extension enabled, 'Message' values can be +-- constructed without metadata fairly conveniently, just as if we were using +-- 'Text' directly: +-- +-- > logDebug "Some log message without metadata" +-- +-- Metadata may be included in a 'Message' via the ':#' constructor: +-- +-- @ +-- 'Control.Monad.Logger.Aeson.logDebug' $ "Some log message with metadata" ':#' +-- [ "bloorp" '.@' (42 :: 'Int') +-- , "bonk" '.@' ("abc" :: 'Text') +-- ] +-- @ +-- +-- The mnemonic for the ':#' constructor is that the @#@ symbol is sometimes +-- referred to as a hash, a JSON object can be thought of as a hash map, and +-- so with @:#@ (and enough squinting), we are @cons@-ing a textual message onto +-- a JSON object. Yes, this mnemonic isn't well-typed, but hopefully it still +-- helps! +-- +-- @since 0.1.0.0 +data Message = Text :# [Series] +infixr 5 :# + +instance IsString Message where + fromString string = Text.pack string :# [] + +instance ToLogStr Message where + toLogStr = toLogStr . Aeson.encodingToLazyByteString . messageEncoding + +-- | Thread-safe, global 'Store' that captures the thread context of messages. +-- +-- Note that there is a bit of somewhat unavoidable name-overloading here: this +-- binding is called 'threadContextStore' because it stores the thread context +-- (i.e. @ThreadContext@/@MDC@ from Java land) for messages. It also just so +-- happens that the 'Store' type comes from the @context@ package, which is a +-- package providing thread-indexed storage of arbitrary context values. Please +-- don't hate the player! +-- +-- @since 0.1.0.0 +threadContextStore :: Store (KeyMap Value) +threadContextStore = + IO.Unsafe.unsafePerformIO + $ Context.newStore Context.noPropagation + $ Just + $ emptyKeyMap +{-# NOINLINE threadContextStore #-} + +-- | 'OutputOptions' is for use with +-- 'Control.Monad.Logger.Aeson.defaultOutputWith' and enables us to configure +-- the JSON output produced by this library. +-- +-- We can get a hold of a value of this type via +-- 'Control.Monad.Logger.Aeson.defaultOutputOptions'. +-- +-- @since 0.1.0.0 +data OutputOptions = OutputOptions + { outputAction :: LogLevel -> BS8.ByteString -> IO () + , -- | Controls whether or not the thread ID is included in each log message's + -- thread context. + -- + -- Default: 'False' + -- + -- @since 0.1.0.0 + outputIncludeThreadId :: Bool + , -- | Allows for setting a "base" thread context, i.e. a set of 'Pair' that + -- will always be present in log messages. + -- + -- If we subsequently use 'Control.Monad.Logger.Aeson.withThreadContext' to + -- register some thread context for our messages, if any of the keys in + -- those 'Pair' values overlap with the "base" thread context, then the + -- overlapped 'Pair' values in the "base" thread context will be overridden + -- for the duration of the action provided to + -- 'Control.Monad.Logger.Aeson.withThreadContext'. + -- + -- Default: 'mempty' + -- + -- @since 0.1.0.0 + outputBaseThreadContext :: [Pair] + } + +defaultLogStrBS + :: UTCTime + -> KeyMap Value + -> Loc + -> LogSource + -> LogLevel + -> LogStr + -> BS8.ByteString +defaultLogStrBS now threadContext loc logSource logLevel logStr = + LBS.toStrict + $ defaultLogStrLBS now threadContext loc logSource logLevel logStr + +defaultLogStrLBS + :: UTCTime + -> KeyMap Value + -> Loc + -> LogSource + -> LogLevel + -> LogStr + -> LBS8.ByteString +defaultLogStrLBS now threadContext loc logSource logLevel logStr = + Aeson.encodingToLazyByteString $ logItemEncoding logItem + where + logItem :: LogItem + logItem = + case LBS8.take 9 logStrLBS of + "{\"text\":\"" -> + mkLogItem + $ Aeson.unsafeToEncoding + $ Builder.lazyByteString logStrLBS + _ -> + mkLogItem + $ messageEncoding + $ decodeLenient logStrLBS :# [] + + mkLogItem :: Encoding -> LogItem + mkLogItem messageEnc = + LogItem + { logItemTimestamp = now + , logItemLoc = loc + , logItemLogSource = logSource + , logItemLevel = logLevel + , logItemThreadContext = threadContext + , logItemMessageEncoding = messageEnc + } + + decodeLenient = + Text.Encoding.decodeUtf8With Text.Encoding.Error.lenientDecode + . LBS.toStrict + + logStrLBS = Builder.toLazyByteString logStrBuilder + LogStr _ logStrBuilder = logStr + +logCS + :: (MonadLogger m) + => CallStack + -> LogSource + -> LogLevel + -> Message + -> m () +logCS cs logSource logLevel msg = + monadLoggerLog (locFromCS cs) logSource logLevel $ toLogStr msg + +data LogItem = LogItem + { logItemTimestamp :: UTCTime + , logItemLoc :: Loc + , logItemLogSource :: LogSource + , logItemLevel :: LogLevel + , logItemThreadContext :: KeyMap Value + , logItemMessageEncoding :: Encoding + } + +logItemEncoding :: LogItem -> Encoding +logItemEncoding logItem = + Aeson.pairs $ + (Aeson.pairStr "time" $ Aeson.toEncoding logItemTimestamp) + <> (Aeson.pairStr "level" $ levelEncoding logItemLevel) + <> ( if isDefaultLoc logItemLoc then + mempty + else + Aeson.pairStr "location" $ locEncoding logItemLoc + ) + <> ( if Text.null logItemLogSource then + mempty + else + Aeson.pairStr "source" $ Aeson.toEncoding logItemLogSource + ) + <> ( if null logItemThreadContext then + mempty + else + Aeson.pairStr "context" $ Aeson.toEncoding logItemThreadContext + ) + <> (Aeson.pairStr "message" logItemMessageEncoding) + where + LogItem + { logItemTimestamp + , logItemLoc + , logItemLogSource + , logItemLevel + , logItemThreadContext + , logItemMessageEncoding + } = logItem + +messageEncoding :: Message -> Encoding +messageEncoding = Aeson.pairs . messageSeries + +messageSeries :: Message -> Series +messageSeries message = + "text" .@ messageText + <> ( if null messageMeta then + mempty + else + Aeson.pairStr "meta" $ Aeson.pairs $ mconcat messageMeta + ) + where + messageText :# messageMeta = message + +pairsEncoding :: [Pair] -> Encoding +pairsEncoding = Aeson.pairs . pairsSeries + +pairsSeries :: [Pair] -> Series +pairsSeries = mconcat . fmap (uncurry (.@)) + +levelEncoding :: LogLevel -> Encoding +levelEncoding = Aeson.text . logLevelToText + +logLevelToText :: LogLevel -> Text +logLevelToText = \case + LevelDebug -> "debug" + LevelInfo -> "info" + LevelWarn -> "warn" + LevelError -> "error" + LevelOther otherLevel -> otherLevel + +locEncoding :: Loc -> Encoding +locEncoding loc = + Aeson.pairs $ + (Aeson.pairStr "package" $ Aeson.string loc_package) + <> (Aeson.pairStr "module" $ Aeson.string loc_module) + <> (Aeson.pairStr "file" $ Aeson.string loc_filename) + <> (Aeson.pairStr "line" $ Aeson.int $ fst loc_start) + <> (Aeson.pairStr "char" $ Aeson.int $ snd loc_start) + where + Loc { loc_filename, loc_package, loc_module, loc_start } = loc + +-- | Not exported from 'monad-logger', so copied here. +mkLoggerLoc :: SrcLoc -> Loc +mkLoggerLoc loc = + Loc { loc_filename = srcLocFile loc + , loc_package = srcLocPackage loc + , loc_module = srcLocModule loc + , loc_start = ( srcLocStartLine loc + , srcLocStartCol loc) + , loc_end = ( srcLocEndLine loc + , srcLocEndCol loc) + } + +-- | Not exported from 'monad-logger', so copied here. +locFromCS :: CallStack -> Loc +locFromCS cs = case getCallStack cs of + ((_, loc):_) -> mkLoggerLoc loc + _ -> Logger.defaultLoc + +-- | Not exported from 'monad-logger', so copied here. +isDefaultLoc :: Loc -> Bool +isDefaultLoc (Loc "" "" "" (0,0) (0,0)) = True +isDefaultLoc _ = False + +-- $disclaimer +-- +-- In general, changes to this module will not be reflected in the library's +-- version updates. Direct use of this module should be done with care. diff --git a/monad-logger-aeson.cabal b/monad-logger-aeson.cabal new file mode 100644 --- /dev/null +++ b/monad-logger-aeson.cabal @@ -0,0 +1,137 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: monad-logger-aeson +version: 0.1.0.0 +synopsis: JSON logging using monad-logger interface +description: @monad-logger-aeson@ provides structured JSON logging using @monad-logger@'s + interface. + . + Specifically, it is intended to be a (largely) drop-in replacement for + @monad-logger@'s "Control.Monad.Logger.CallStack" module. +category: System +homepage: https://github.com/jship/monad-logger-aeson#readme +bug-reports: https://github.com/jship/monad-logger-aeson/issues +author: Jason Shipman +maintainer: Jason Shipman +copyright: 2022 (c) Jason Shipman +license: MIT +license-file: LICENSE.md +build-type: Simple +extra-source-files: + package.yaml + README.md + LICENSE.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/jship/monad-logger-aeson + +library + exposed-modules: + Control.Monad.Logger.Aeson + Control.Monad.Logger.Aeson.Internal + other-modules: + Paths_monad_logger_aeson + hs-source-dirs: + library + ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns -Wredundant-constraints + build-depends: + aeson >=1.5.6.0 && <2.1.3.0 + , base >=4.14.3.0 && <5 + , bytestring >=0.10.12.0 && <0.12.0.0 + , context >=0.2.0.0 && <0.3 + , exceptions >=0.10.4 && <0.11.0 + , fast-logger >=3.0.5 && <3.2.0 + , monad-logger >=0.3.36 && <0.4.0 + , text >=1.2.4.1 && <1.3.0.0 + , time >=1.9.3 && <1.12.0.0 + , unordered-containers >=0.2.16.0 && <0.3.0.0 + default-language: Haskell2010 + +executable readme-example + main-is: readme-example.hs + other-modules: + Paths_monad_logger_aeson + hs-source-dirs: + app + ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns -Wredundant-constraints + build-depends: + aeson >=1.5.6.0 && <2.1.3.0 + , base >=4.14.3.0 && <5 + , monad-logger >=0.3.36 && <0.4.0 + , monad-logger-aeson + , text >=1.2.4.1 && <1.3.0.0 + default-language: Haskell2010 + +test-suite monad-logger-aeson-test-suite + type: exitcode-stdio-1.0 + main-is: Driver.hs + other-modules: + Test.Control.Monad.Logger.AesonSpec + TestCase + TestCase.LogDebug.MetadataNoThreadContextNo + TestCase.LogDebug.MetadataNoThreadContextYes + TestCase.LogDebug.MetadataYesThreadContextNo + TestCase.LogDebug.MetadataYesThreadContextYes + TestCase.LogDebugNS.MetadataNoThreadContextNo + TestCase.LogDebugNS.MetadataNoThreadContextYes + TestCase.LogDebugNS.MetadataYesThreadContextNo + TestCase.LogDebugNS.MetadataYesThreadContextYes + TestCase.LogError.MetadataNoThreadContextNo + TestCase.LogError.MetadataNoThreadContextYes + TestCase.LogError.MetadataYesThreadContextNo + TestCase.LogError.MetadataYesThreadContextYes + TestCase.LogErrorNS.MetadataNoThreadContextNo + TestCase.LogErrorNS.MetadataNoThreadContextYes + TestCase.LogErrorNS.MetadataYesThreadContextNo + TestCase.LogErrorNS.MetadataYesThreadContextYes + TestCase.LogInfo.MetadataNoThreadContextNo + TestCase.LogInfo.MetadataNoThreadContextYes + TestCase.LogInfo.MetadataYesThreadContextNo + TestCase.LogInfo.MetadataYesThreadContextYes + TestCase.LogInfoNS.MetadataNoThreadContextNo + TestCase.LogInfoNS.MetadataNoThreadContextYes + TestCase.LogInfoNS.MetadataYesThreadContextNo + TestCase.LogInfoNS.MetadataYesThreadContextYes + TestCase.LogOther.MetadataNoThreadContextNo + TestCase.LogOther.MetadataNoThreadContextYes + TestCase.LogOther.MetadataYesThreadContextNo + TestCase.LogOther.MetadataYesThreadContextYes + TestCase.LogOtherNS.MetadataNoThreadContextNo + TestCase.LogOtherNS.MetadataNoThreadContextYes + TestCase.LogOtherNS.MetadataYesThreadContextNo + TestCase.LogOtherNS.MetadataYesThreadContextYes + TestCase.LogWarn.MetadataNoThreadContextNo + TestCase.LogWarn.MetadataNoThreadContextYes + TestCase.LogWarn.MetadataYesThreadContextNo + TestCase.LogWarn.MetadataYesThreadContextYes + TestCase.LogWarnNS.MetadataNoThreadContextNo + TestCase.LogWarnNS.MetadataNoThreadContextYes + TestCase.LogWarnNS.MetadataYesThreadContextNo + TestCase.LogWarnNS.MetadataYesThreadContextYes + TestCase.MonadLogger.LogDebug.ThreadContextNo + TestCase.MonadLogger.LogDebug.ThreadContextYes + TestCase.MonadLogger.LogDebugN.ThreadContextNo + TestCase.MonadLogger.LogDebugN.ThreadContextYes + Paths_monad_logger_aeson + hs-source-dirs: + test-suite + ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns -Wredundant-constraints + build-tool-depends: + hspec-discover:hspec-discover + build-depends: + aeson >=1.5.6.0 && <2.1.3.0 + , aeson-diff >=1.1.0.10 && <1.2.0.0 + , base >=4.14.3.0 && <5 + , bytestring >=0.10.12.0 && <0.12.0.0 + , directory >=1.3.6.0 && <1.4.0.0 + , hspec >=2.7.10 && <2.10.0 + , monad-logger >=0.3.36 && <0.4.0 + , monad-logger-aeson + , time >=1.9.3 && <1.12.0.0 + default-language: Haskell2010 diff --git a/package.yaml b/package.yaml new file mode 100644 --- /dev/null +++ b/package.yaml @@ -0,0 +1,70 @@ +name: monad-logger-aeson +version: '0.1.0.0' +github: "jship/monad-logger-aeson" +license: MIT +license-file: LICENSE.md +copyright: 2022 (c) Jason Shipman +author: "Jason Shipman" +maintainer: "Jason Shipman" +synopsis: JSON logging using monad-logger interface +description: | + @monad-logger-aeson@ provides structured JSON logging using @monad-logger@'s + interface. + + Specifically, it is intended to be a (largely) drop-in replacement for + @monad-logger@'s "Control.Monad.Logger.CallStack" module. +category: System + +extra-source-files: +- package.yaml +- README.md +- LICENSE.md +- CHANGELOG.md + +ghc-options: + - -Wall + - -fwarn-tabs + - -Wincomplete-uni-patterns + - -Wredundant-constraints + +library: + dependencies: + - aeson >=1.5.6.0 && <2.1.3.0 + - base >=4.14.3.0 && <5 + - bytestring >=0.10.12.0 && <0.12.0.0 + - context >=0.2.0.0 && <0.3 + - exceptions >=0.10.4 && <0.11.0 + - fast-logger >=3.0.5 && <3.2.0 + - monad-logger >=0.3.36 && <0.4.0 + - text >=1.2.4.1 && <1.3.0.0 + - time >=1.9.3 && <1.12.0.0 + - unordered-containers >=0.2.16.0 && <0.3.0.0 + source-dirs: library + +tests: + monad-logger-aeson-test-suite: + source-dirs: test-suite + main: Driver.hs + build-tools: + - hspec-discover + dependencies: + - aeson >=1.5.6.0 && <2.1.3.0 + - aeson-diff >=1.1.0.10 && <1.2.0.0 + - base >=4.14.3.0 && <5 + - bytestring >=0.10.12.0 && <0.12.0.0 + - directory >=1.3.6.0 && <1.4.0.0 + - hspec >=2.7.10 && <2.10.0 + - monad-logger >=0.3.36 && <0.4.0 + - monad-logger-aeson + - time >=1.9.3 && <1.12.0.0 + +executables: + readme-example: + source-dirs: app + main: readme-example.hs + dependencies: + - aeson >=1.5.6.0 && <2.1.3.0 + - base >=4.14.3.0 && <5 + - monad-logger >=0.3.36 && <0.4.0 + - monad-logger-aeson + - text >=1.2.4.1 && <1.3.0.0 diff --git a/test-suite/Driver.hs b/test-suite/Driver.hs new file mode 100644 --- /dev/null +++ b/test-suite/Driver.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test-suite/Test/Control/Monad/Logger/AesonSpec.hs b/test-suite/Test/Control/Monad/Logger/AesonSpec.hs new file mode 100644 --- /dev/null +++ b/test-suite/Test/Control/Monad/Logger/AesonSpec.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} +module Test.Control.Monad.Logger.AesonSpec + ( spec + ) where + +import Test.Hspec (Spec, aroundAll, describe, it) +import TestCase (runTest, withTempLogFile) +import qualified TestCase.LogDebug.MetadataNoThreadContextNo +import qualified TestCase.LogDebug.MetadataNoThreadContextYes +import qualified TestCase.LogDebug.MetadataYesThreadContextNo +import qualified TestCase.LogDebug.MetadataYesThreadContextYes +import qualified TestCase.LogDebugNS.MetadataNoThreadContextNo +import qualified TestCase.LogDebugNS.MetadataNoThreadContextYes +import qualified TestCase.LogDebugNS.MetadataYesThreadContextNo +import qualified TestCase.LogDebugNS.MetadataYesThreadContextYes +import qualified TestCase.LogError.MetadataNoThreadContextNo +import qualified TestCase.LogError.MetadataNoThreadContextYes +import qualified TestCase.LogError.MetadataYesThreadContextNo +import qualified TestCase.LogError.MetadataYesThreadContextYes +import qualified TestCase.LogErrorNS.MetadataNoThreadContextNo +import qualified TestCase.LogErrorNS.MetadataNoThreadContextYes +import qualified TestCase.LogErrorNS.MetadataYesThreadContextNo +import qualified TestCase.LogErrorNS.MetadataYesThreadContextYes +import qualified TestCase.LogInfo.MetadataNoThreadContextNo +import qualified TestCase.LogInfo.MetadataNoThreadContextYes +import qualified TestCase.LogInfo.MetadataYesThreadContextNo +import qualified TestCase.LogInfo.MetadataYesThreadContextYes +import qualified TestCase.LogInfoNS.MetadataNoThreadContextNo +import qualified TestCase.LogInfoNS.MetadataNoThreadContextYes +import qualified TestCase.LogInfoNS.MetadataYesThreadContextNo +import qualified TestCase.LogInfoNS.MetadataYesThreadContextYes +import qualified TestCase.LogOther.MetadataNoThreadContextNo +import qualified TestCase.LogOther.MetadataNoThreadContextYes +import qualified TestCase.LogOther.MetadataYesThreadContextNo +import qualified TestCase.LogOther.MetadataYesThreadContextYes +import qualified TestCase.LogOtherNS.MetadataNoThreadContextNo +import qualified TestCase.LogOtherNS.MetadataNoThreadContextYes +import qualified TestCase.LogOtherNS.MetadataYesThreadContextNo +import qualified TestCase.LogOtherNS.MetadataYesThreadContextYes +import qualified TestCase.LogWarn.MetadataNoThreadContextNo +import qualified TestCase.LogWarn.MetadataNoThreadContextYes +import qualified TestCase.LogWarn.MetadataYesThreadContextNo +import qualified TestCase.LogWarn.MetadataYesThreadContextYes +import qualified TestCase.LogWarnNS.MetadataNoThreadContextNo +import qualified TestCase.LogWarnNS.MetadataNoThreadContextYes +import qualified TestCase.LogWarnNS.MetadataYesThreadContextNo +import qualified TestCase.LogWarnNS.MetadataYesThreadContextYes +import qualified TestCase.MonadLogger.LogDebug.ThreadContextNo +import qualified TestCase.MonadLogger.LogDebug.ThreadContextYes +import qualified TestCase.MonadLogger.LogDebugN.ThreadContextNo +import qualified TestCase.MonadLogger.LogDebugN.ThreadContextYes + +spec :: Spec +spec = do + aroundAll withTempLogFile do + describe "Control.Monad.Logger.Aeson" do + describe "logDebug" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogDebug.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogDebug.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogDebug.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogDebug.MetadataYesThreadContextYes.testCase logFilePath + + describe "logInfo" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogInfo.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogInfo.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogInfo.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogInfo.MetadataYesThreadContextYes.testCase logFilePath + + describe "logWarn" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogWarn.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogWarn.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogWarn.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogWarn.MetadataYesThreadContextYes.testCase logFilePath + + describe "logError" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogError.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogError.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogError.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogError.MetadataYesThreadContextYes.testCase logFilePath + + describe "logOther" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogOther.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogOther.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogOther.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogOther.MetadataYesThreadContextYes.testCase logFilePath + + describe "logDebugNS" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogDebugNS.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogDebugNS.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogDebugNS.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogDebugNS.MetadataYesThreadContextYes.testCase logFilePath + + describe "logInfoNS" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogInfoNS.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogInfoNS.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogInfoNS.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogInfoNS.MetadataYesThreadContextYes.testCase logFilePath + + describe "logWarnNS" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogWarnNS.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogWarnNS.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogWarnNS.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogWarnNS.MetadataYesThreadContextYes.testCase logFilePath + + describe "logErrorNS" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogErrorNS.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogErrorNS.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogErrorNS.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogErrorNS.MetadataYesThreadContextYes.testCase logFilePath + + describe "logOtherNS" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogOtherNS.MetadataNoThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogOtherNS.MetadataNoThreadContextYes.testCase logFilePath + it "metadata + no thread context" \logFilePath -> do + runTest $ TestCase.LogOtherNS.MetadataYesThreadContextNo.testCase logFilePath + it "metadata + thread context" \logFilePath -> do + runTest $ TestCase.LogOtherNS.MetadataYesThreadContextYes.testCase logFilePath + + describe "Control.Monad.Logger.CallStack ('log*' from 'monad-logger')" do + describe "logDebug" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.MonadLogger.LogDebug.ThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.MonadLogger.LogDebug.ThreadContextYes.testCase logFilePath + + describe "logDebugN" do + it "no metadata + no thread context" \logFilePath -> do + runTest $ TestCase.MonadLogger.LogDebugN.ThreadContextNo.testCase logFilePath + it "no metadata + thread context" \logFilePath -> do + runTest $ TestCase.MonadLogger.LogDebugN.ThreadContextYes.testCase logFilePath diff --git a/test-suite/TestCase.hs b/test-suite/TestCase.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} +module TestCase + ( TestCase(..) + , runTest + , withTempLogFile + ) where + +import Control.Monad.Logger.Aeson (LoggedMessage(..), LoggingT, runFileLoggingT) +import Data.Aeson (Result(..), Value) +import Data.Aeson.Diff (Patch(..)) +import GHC.Stack (HasCallStack) +import System.IO (IOMode(..)) +import Test.Hspec (Expectation, expectationFailure, shouldBe) +import qualified Control.Exception as Exception +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Diff as Diff +import qualified Data.ByteString.Char8 as BS8 +import qualified System.Directory as Directory +import qualified System.IO as IO + +data TestCase = TestCase + { actionUnderTest :: LoggingT IO () + , logFilePath :: FilePath + , expectedValue :: Value + , expectedPatch :: Value + , expectedLoggedMessage :: LoggedMessage + } + +runTest :: (HasCallStack) => TestCase -> IO () +runTest testCase = do + clearFile logFilePath + runFileLoggingT logFilePath actionUnderTest + curLine <- IO.withFile logFilePath ReadMode BS8.hGetLine + case Aeson.decodeStrict' @Value curLine of + Nothing -> expectationFailure $ "Failed to parse log line as Value: " <> show curLine + Just actualValue -> do + case Aeson.fromJSON expectedPatch of + Error errStr -> do + expectationFailure $ "Patch is invalid: " <> show errStr + Success expectedPatch' -> do + actualValue `shouldMatchWithPatch` (expectedValue, expectedPatch') + Diff.patch expectedPatch' actualValue `shouldBe` Success expectedValue + case Aeson.fromJSON expectedValue of + Error errStr -> do + expectationFailure $ "LoggedMessage parse failed: " <> errStr + Success actualLoggedMessage -> do + actualLoggedMessage `shouldBe` expectedLoggedMessage + Aeson.toJSON actualLoggedMessage `shouldBe` Aeson.toJSON expectedLoggedMessage + Aeson.toEncoding actualLoggedMessage `shouldBe` Aeson.toEncoding expectedLoggedMessage + where + TestCase + { actionUnderTest + , logFilePath + , expectedValue + , expectedPatch + , expectedLoggedMessage + } = testCase + +withTempLogFile :: (FilePath -> IO ()) -> IO () +withTempLogFile f = do + Exception.bracket + (IO.openTempFile "." "monad-logger-aeson") + (\(filePath, handle) -> IO.hClose handle *> Directory.removeFile filePath) + \(filePath, handle) -> do + IO.hClose handle + f filePath + +shouldMatchWithPatch :: (HasCallStack) => Value -> (Value, Patch) -> Expectation +shouldMatchWithPatch actualValue (expectedValue, expectedPatch) = do + Diff.diff actualValue expectedValue `shouldBe` expectedPatch + +clearFile :: FilePath -> IO () +clearFile filePath = IO.withFile filePath WriteMode $ flip IO.hSetFileSize 0 diff --git a/test-suite/TestCase/LogDebug/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogDebug/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogDebug/MetadataNoThreadContextNo.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogDebug.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logDebug) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logDebug "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.LogDebug.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogDebug/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogDebug.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogDebug/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogDebug/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogDebug/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogDebug/MetadataNoThreadContextYes.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogDebug.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), logDebug, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logDebug "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.LogDebug.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogDebug/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogDebug.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogDebug/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogDebug/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogDebug/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogDebug/MetadataYesThreadContextNo.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogDebug.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logDebug) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logDebug $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.LogDebug.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogDebug/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogDebug.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogDebug/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogDebug/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogDebug/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogDebug/MetadataYesThreadContextYes.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogDebug.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logDebug, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logDebug $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.LogDebug.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogDebug/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogDebug.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogDebug/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogDebugNS/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogDebugNS/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogDebugNS/MetadataNoThreadContextNo.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogDebugNS.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logDebugNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logDebugNS "tests" "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.LogDebugNS.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogDebugNS/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogDebugNS.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogDebugNS/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogDebugNS/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogDebugNS/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogDebugNS/MetadataNoThreadContextYes.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogDebugNS.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), logDebugNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logDebugNS "tests" "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.LogDebugNS.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogDebugNS/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogDebugNS.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogDebugNS/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogDebugNS/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogDebugNS/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogDebugNS/MetadataYesThreadContextNo.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogDebugNS.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logDebugNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logDebugNS "tests" $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.LogDebugNS.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogDebugNS/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogDebugNS.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogDebugNS/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogDebugNS/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogDebugNS/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogDebugNS/MetadataYesThreadContextYes.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogDebugNS.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logDebugNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logDebugNS "tests" $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.LogDebugNS.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogDebugNS/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogDebugNS.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogDebugNS/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogError/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogError/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogError/MetadataNoThreadContextNo.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogError.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logError) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logError "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "error", + "location": { + "package": "main", + "module": "TestCase.LogError.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogError/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelError + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogError.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogError/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogError/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogError/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogError/MetadataNoThreadContextYes.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogError.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), logError, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logError "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "error", + "location": { + "package": "main", + "module": "TestCase.LogError.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogError/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelError + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogError.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogError/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogError/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogError/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogError/MetadataYesThreadContextNo.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogError.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logError) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logError $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "error", + "location": { + "package": "main", + "module": "TestCase.LogError.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogError/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelError + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogError.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogError/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogError/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogError/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogError/MetadataYesThreadContextYes.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogError.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logError, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logError $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "error", + "location": { + "package": "main", + "module": "TestCase.LogError.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogError/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelError + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogError.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogError/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogErrorNS/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogErrorNS/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogErrorNS/MetadataNoThreadContextNo.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogErrorNS.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logErrorNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logErrorNS "tests" "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "error", + "location": { + "package": "main", + "module": "TestCase.LogErrorNS.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogErrorNS/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelError + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogErrorNS.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogErrorNS/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogErrorNS/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogErrorNS/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogErrorNS/MetadataNoThreadContextYes.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogErrorNS.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), logErrorNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logErrorNS "tests" "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "error", + "location": { + "package": "main", + "module": "TestCase.LogErrorNS.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogErrorNS/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelError + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogErrorNS.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogErrorNS/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogErrorNS/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogErrorNS/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogErrorNS/MetadataYesThreadContextNo.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogErrorNS.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logErrorNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logErrorNS "tests" $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "error", + "location": { + "package": "main", + "module": "TestCase.LogErrorNS.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogErrorNS/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelError + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogErrorNS.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogErrorNS/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogErrorNS/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogErrorNS/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogErrorNS/MetadataYesThreadContextYes.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogErrorNS.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logErrorNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logErrorNS "tests" $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "error", + "location": { + "package": "main", + "module": "TestCase.LogErrorNS.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogErrorNS/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelError + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogErrorNS.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogErrorNS/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogInfo/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogInfo/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogInfo/MetadataNoThreadContextNo.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogInfo.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logInfo) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logInfo "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "info", + "location": { + "package": "main", + "module": "TestCase.LogInfo.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogInfo/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelInfo + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogInfo.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogInfo/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogInfo/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogInfo/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogInfo/MetadataNoThreadContextYes.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogInfo.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), logInfo, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logInfo "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "info", + "location": { + "package": "main", + "module": "TestCase.LogInfo.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogInfo/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelInfo + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogInfo.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogInfo/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogInfo/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogInfo/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogInfo/MetadataYesThreadContextNo.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogInfo.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logInfo) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logInfo $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "info", + "location": { + "package": "main", + "module": "TestCase.LogInfo.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogInfo/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelInfo + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogInfo.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogInfo/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogInfo/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogInfo/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogInfo/MetadataYesThreadContextYes.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogInfo.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logInfo, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logInfo $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "info", + "location": { + "package": "main", + "module": "TestCase.LogInfo.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogInfo/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelInfo + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogInfo.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogInfo/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogInfoNS/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogInfoNS/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogInfoNS/MetadataNoThreadContextNo.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogInfoNS.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logInfoNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logInfoNS "tests" "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "info", + "location": { + "package": "main", + "module": "TestCase.LogInfoNS.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogInfoNS/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelInfo + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogInfoNS.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogInfoNS/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogInfoNS/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogInfoNS/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogInfoNS/MetadataNoThreadContextYes.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogInfoNS.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), logInfoNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logInfoNS "tests" "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "info", + "location": { + "package": "main", + "module": "TestCase.LogInfoNS.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogInfoNS/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelInfo + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogInfoNS.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogInfoNS/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogInfoNS/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogInfoNS/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogInfoNS/MetadataYesThreadContextNo.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogInfoNS.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logInfoNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logInfoNS "tests" $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "info", + "location": { + "package": "main", + "module": "TestCase.LogInfoNS.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogInfoNS/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelInfo + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogInfoNS.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogInfoNS/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogInfoNS/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogInfoNS/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogInfoNS/MetadataYesThreadContextYes.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogInfoNS.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logInfoNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logInfoNS "tests" $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "info", + "location": { + "package": "main", + "module": "TestCase.LogInfoNS.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogInfoNS/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelInfo + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogInfoNS.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogInfoNS/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogOther/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogOther/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogOther/MetadataNoThreadContextNo.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogOther.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logOther) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logOther (LevelOther "foo") "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "foo", + "location": { + "package": "main", + "module": "TestCase.LogOther.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogOther/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelOther "foo" + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogOther.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogOther/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogOther/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogOther/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogOther/MetadataNoThreadContextYes.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogOther.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), logOther, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logOther (LevelOther "foo") "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "foo", + "location": { + "package": "main", + "module": "TestCase.LogOther.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogOther/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelOther "foo" + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogOther.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogOther/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogOther/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogOther/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogOther/MetadataYesThreadContextNo.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogOther.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logOther) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logOther (LevelOther "foo") $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "foo", + "location": { + "package": "main", + "module": "TestCase.LogOther.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogOther/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelOther "foo" + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogOther.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogOther/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogOther/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogOther/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogOther/MetadataYesThreadContextYes.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogOther.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logOther, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logOther (LevelOther "foo") $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "foo", + "location": { + "package": "main", + "module": "TestCase.LogOther.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogOther/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelOther "foo" + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogOther.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogOther/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogOtherNS/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogOtherNS/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogOtherNS/MetadataNoThreadContextNo.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogOtherNS.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logOtherNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logOtherNS "tests" (LevelOther "foo") "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "foo", + "location": { + "package": "main", + "module": "TestCase.LogOtherNS.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogOtherNS/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelOther "foo" + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogOtherNS.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogOtherNS/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogOtherNS/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogOtherNS/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogOtherNS/MetadataNoThreadContextYes.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogOtherNS.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), logOtherNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logOtherNS "tests" (LevelOther "foo") "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "foo", + "location": { + "package": "main", + "module": "TestCase.LogOtherNS.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogOtherNS/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelOther "foo" + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogOtherNS.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogOtherNS/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogOtherNS/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogOtherNS/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogOtherNS/MetadataYesThreadContextNo.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogOtherNS.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logOtherNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logOtherNS "tests" (LevelOther "foo") $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "foo", + "location": { + "package": "main", + "module": "TestCase.LogOtherNS.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogOtherNS/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelOther "foo" + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogOtherNS.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogOtherNS/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogOtherNS/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogOtherNS/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogOtherNS/MetadataYesThreadContextYes.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogOtherNS.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logOtherNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logOtherNS "tests" (LevelOther "foo") $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "foo", + "location": { + "package": "main", + "module": "TestCase.LogOtherNS.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogOtherNS/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelOther "foo" + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogOtherNS.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogOtherNS/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogWarn/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogWarn/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogWarn/MetadataNoThreadContextNo.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogWarn.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logWarn) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logWarn "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "warn", + "location": { + "package": "main", + "module": "TestCase.LogWarn.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogWarn/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelWarn + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogWarn.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogWarn/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogWarn/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogWarn/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogWarn/MetadataNoThreadContextYes.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogWarn.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), logWarn, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logWarn $ "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "warn", + "location": { + "package": "main", + "module": "TestCase.LogWarn.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogWarn/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelWarn + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogWarn.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogWarn/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogWarn/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogWarn/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogWarn/MetadataYesThreadContextNo.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogWarn.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logWarn) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logWarn $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "warn", + "location": { + "package": "main", + "module": "TestCase.LogWarn.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogWarn/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelWarn + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogWarn.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogWarn/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogWarn/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogWarn/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogWarn/MetadataYesThreadContextYes.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogWarn.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logWarn, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logWarn $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "warn", + "location": { + "package": "main", + "module": "TestCase.LogWarn.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogWarn/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelWarn + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogWarn.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogWarn/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogWarnNS/MetadataNoThreadContextNo.hs b/test-suite/TestCase/LogWarnNS/MetadataNoThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogWarnNS/MetadataNoThreadContextNo.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogWarnNS.MetadataNoThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..), logWarnNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logWarnNS "tests" "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "warn", + "location": { + "package": "main", + "module": "TestCase.LogWarnNS.MetadataNoThreadContextNo", + "file": "test-suite/TestCase/LogWarnNS/MetadataNoThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelWarn + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogWarnNS.MetadataNoThreadContextNo" + , loc_filename = "test-suite/TestCase/LogWarnNS/MetadataNoThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogWarnNS/MetadataNoThreadContextYes.hs b/test-suite/TestCase/LogWarnNS/MetadataNoThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogWarnNS/MetadataNoThreadContextYes.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogWarnNS.MetadataNoThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( Loc(..), LogLevel(..), LoggedMessage(..), (.@), logWarnNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logWarnNS "tests" "No metadata" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "warn", + "location": { + "package": "main", + "module": "TestCase.LogWarnNS.MetadataNoThreadContextYes", + "file": "test-suite/TestCase/LogWarnNS/MetadataNoThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "No metadata" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelWarn + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogWarnNS.MetadataNoThreadContextYes" + , loc_filename = "test-suite/TestCase/LogWarnNS/MetadataNoThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "No metadata" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/LogWarnNS/MetadataYesThreadContextNo.hs b/test-suite/TestCase/LogWarnNS/MetadataYesThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogWarnNS/MetadataYesThreadContextNo.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogWarnNS.MetadataYesThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logWarnNS) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + logWarnNS "tests" $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "warn", + "location": { + "package": "main", + "module": "TestCase.LogWarnNS.MetadataYesThreadContextNo", + "file": "test-suite/TestCase/LogWarnNS/MetadataYesThreadContextNo.hs", + "line": 19, + "char": 9 + }, + "source": "tests", + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelWarn + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogWarnNS.MetadataYesThreadContextNo" + , loc_filename = "test-suite/TestCase/LogWarnNS/MetadataYesThreadContextNo.hs" + , loc_start = (19, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/LogWarnNS/MetadataYesThreadContextYes.hs b/test-suite/TestCase/LogWarnNS/MetadataYesThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/LogWarnNS/MetadataYesThreadContextYes.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.LogWarnNS.MetadataYesThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson + ( (.@), Loc(..), LogLevel(..), LoggedMessage(..), Message(..), logWarnNS, withThreadContext + ) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + logWarnNS "tests" $ "With metadata" :# + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "warn", + "location": { + "package": "main", + "module": "TestCase.LogWarnNS.MetadataYesThreadContextYes", + "file": "test-suite/TestCase/LogWarnNS/MetadataYesThreadContextYes.hs", + "line": 23, + "char": 11 + }, + "source": "tests", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "With metadata", + "meta": { + "a": 42, + "b": "x" + } + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelWarn + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.LogWarnNS.MetadataYesThreadContextYes" + , loc_filename = "test-suite/TestCase/LogWarnNS/MetadataYesThreadContextYes.hs" + , loc_start = (23, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Just "tests" + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "With metadata" + , loggedMessageMeta = + Internal.keyMapFromList + [ "a" .@ (42 :: Int) + , "b" .@ ("x" :: String) + ] + } + } diff --git a/test-suite/TestCase/MonadLogger/LogDebug/ThreadContextNo.hs b/test-suite/TestCase/MonadLogger/LogDebug/ThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/MonadLogger/LogDebug/ThreadContextNo.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.MonadLogger.LogDebug.ThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (Loc(..), LogLevel(..), LoggedMessage(..)) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Control.Monad.Logger.CallStack as ML +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + ML.logDebug "Logged from 'monad-logger'" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.MonadLogger.LogDebug.ThreadContextNo", + "file": "test-suite/TestCase/MonadLogger/LogDebug/ThreadContextNo.hs", + "line": 20, + "char": 9 + }, + "message": { + "text": "Logged from 'monad-logger'" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.MonadLogger.LogDebug.ThreadContextNo" + , loc_filename = "test-suite/TestCase/MonadLogger/LogDebug/ThreadContextNo.hs" + , loc_start = (20, 9) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "Logged from 'monad-logger'" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/MonadLogger/LogDebug/ThreadContextYes.hs b/test-suite/TestCase/MonadLogger/LogDebug/ThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/MonadLogger/LogDebug/ThreadContextYes.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.MonadLogger.LogDebug.ThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), Loc(..), LogLevel(..), LoggedMessage(..), withThreadContext) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Control.Monad.Logger.CallStack as ML +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + ML.logDebug "Logged from 'monad-logger'" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "location": { + "package": "main", + "module": "TestCase.MonadLogger.LogDebug.ThreadContextYes", + "file": "test-suite/TestCase/MonadLogger/LogDebug/ThreadContextYes.hs", + "line": 22, + "char": 11 + }, + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "Logged from 'monad-logger'" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = + Just Loc + { loc_package = "main" + , loc_module = "TestCase.MonadLogger.LogDebug.ThreadContextYes" + , loc_filename = "test-suite/TestCase/MonadLogger/LogDebug/ThreadContextYes.hs" + , loc_start = (22, 11) + , loc_end = (0, 0) + } + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "Logged from 'monad-logger'" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/MonadLogger/LogDebugN/ThreadContextNo.hs b/test-suite/TestCase/MonadLogger/LogDebugN/ThreadContextNo.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/MonadLogger/LogDebugN/ThreadContextNo.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.MonadLogger.LogDebugN.ThreadContextNo + ( testCase + ) where + +import Control.Monad.Logger.Aeson (LogLevel(..), LoggedMessage(..)) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Control.Monad.Logger.CallStack as ML +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + ML.logDebugN "Logged from 'monad-logger'" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "message": { + "text": "Logged from 'monad-logger'" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = Nothing + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = Internal.emptyKeyMap + , loggedMessageText = "Logged from 'monad-logger'" + , loggedMessageMeta = Internal.emptyKeyMap + } + } diff --git a/test-suite/TestCase/MonadLogger/LogDebugN/ThreadContextYes.hs b/test-suite/TestCase/MonadLogger/LogDebugN/ThreadContextYes.hs new file mode 100644 --- /dev/null +++ b/test-suite/TestCase/MonadLogger/LogDebugN/ThreadContextYes.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module TestCase.MonadLogger.LogDebugN.ThreadContextYes + ( testCase + ) where + +import Control.Monad.Logger.Aeson ((.@), LogLevel(..), LoggedMessage(..), withThreadContext) +import Data.Aeson.QQ.Simple (aesonQQ) +import Data.Time (UTCTime(..)) +import TestCase (TestCase(..)) +import qualified Control.Monad.Logger.Aeson.Internal as Internal +import qualified Control.Monad.Logger.CallStack as ML +import qualified Data.Time as Time + +testCase :: FilePath -> TestCase +testCase logFilePath = + TestCase + { actionUnderTest = do + withThreadContext ["reqId" .@ ("74ec1d0b" :: String)] do + ML.logDebugN "Logged from 'monad-logger'" + , logFilePath + , expectedValue = + [aesonQQ| + { + "time": "2022-05-07T20:03:54.0000000Z", + "level": "debug", + "context": { + "reqId": "74ec1d0b" + }, + "message": { + "text": "Logged from 'monad-logger'" + } + } + |] + , expectedPatch = + [aesonQQ| + [ + { "op": "replace", "path": "/time", "value": "2022-05-07T20:03:54.0000000Z" } + ] + |] + , expectedLoggedMessage = + LoggedMessage + { loggedMessageTimestamp = + UTCTime + { utctDay = Time.fromGregorian 2022 05 07 + , utctDayTime = 72234 + } + , loggedMessageLevel = LevelDebug + , loggedMessageLoc = Nothing + , loggedMessageLogSource = Nothing + , loggedMessageThreadContext = + Internal.keyMapFromList + [ "reqId" .@ ("74ec1d0b" :: String) + ] + , loggedMessageText = "Logged from 'monad-logger'" + , loggedMessageMeta = Internal.emptyKeyMap + } + }