diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ -# Changelog for logstash +# Changelog for monad-logger-logstash +## v0.2 + +- Add `runTBMQueueLoggingT` and `unTBMQueueLoggingT` +- Rename `runLogstashLoggerT` and `withLogstashLoggerT` to use the right monad name + ## v0.1 -- First release with support for connecting to `tcp` (incl. TLS) Logstash inputs and the `json_lines` codec. +- Support for synchronous logging with `runLogstashLoggerT` and asynchronous logging with `withLogstashLoggerT` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,12 +3,13 @@ ![MIT](https://img.shields.io/github/license/mbg/logstash) ![CI](https://github.com/mbg/logstash/workflows/Build/badge.svg?branch=master) ![stackage-nightly](https://github.com/mbg/logstash/workflows/stackage-nightly/badge.svg) +[![logstash](https://img.shields.io/hackage/v/logstash)](https://hackage.haskell.org/package/logstash) This library implements a client for Logstash in Haskell. The following features are currently supported: - Connections to Logstash via TCP or TLS (`tcp` input type). - Support for the `json_lines` codec out of the box and custom codecs can be implemented (arbitrary `ByteString` data can be sent across the connections). -- This library can either be used without any logging framework or as a backend for [`monad-logger`](http://hackage.haskell.org/package/monad-logger/). +- This library can either be used without any logging framework, as a backend for [`monad-logger`](http://hackage.haskell.org/package/monad-logger/), or as a backend for [`katip`](http://hackage.haskell.org/package/katip/). - Log messages can either be written synchronously or asynchronously. For example, to connect to a Logstash server via TCP at `127.0.0.1:5000` (configuration given by `def`) and send a JSON document synchronously with a timeout of 1s and the default retry policy from [`Control.Retry`](https://hackage.haskell.org/package/retry/docs/Control-Retry.html): @@ -124,18 +125,19 @@ The queue is automatically closed when the inner computation returns. The worker threads will continue running until the queue is empty and then terminate. `withLogstashQueue` will not return until all worker threads have returned. ### Usage with `monad-logger` +[![monad-logger-logstash](https://img.shields.io/hackage/v/monad-logger-logstash)](https://hackage.haskell.org/package/monad-logger-logstash) The `monad-logger-logstash` package provides convenience functions and types for working with [`monad-logger`](http://hackage.haskell.org/package/monad-logger/). #### Synchronous logging -The following example demonstrates how to use the `runLogstashLoggerT` function with a TCP connection to Logstash, the default retry policy from [`Control.Retry`](https://hackage.haskell.org/package/retry/docs/Control-Retry.html), a 1s timeout for each attempt, and the `json_lines` codec: +The following example demonstrates how to use the `runLogstashLoggingT` function with a TCP connection to Logstash, the default retry policy from [`Control.Retry`](https://hackage.haskell.org/package/retry/docs/Control-Retry.html), a 1s timeout for each attempt, and the `json_lines` codec: ```haskell main :: IO () main = do let ctx = logstashTcp def - runLogstashLoggerT ctx retryPolicyDefault 1000000 (const stashJsonLine) $ + runLogstashLoggingT ctx retryPolicyDefault 1000000 (const stashJsonLine) $ logInfoN "Hello World" ``` @@ -143,17 +145,37 @@ #### Asynchronous logging -The `withLogstashLoggerT` function is the analogue of `withLogstashQueue` for `monad-logger`. It performs the same setup as `withLogstashQueue`, but automatically adds all log messages from logging functions to the queue. A minimal example with default settings is: +The `withLogstashLoggingT` function is the analogue of `withLogstashQueue` for `monad-logger`. It performs the same setup as `withLogstashQueue`, but automatically adds all log messages from logging functions to the queue. A minimal example with default settings is: ```haskell main :: IO () main = do let ctx = logstashTcp def - withLogstashLoggerT (defaultLogstashQueueCfg ctx) (const stashJsonLine) [] $ + withLogstashLoggingT (defaultLogstashQueueCfg ctx) (const stashJsonLine) [] $ logInfoN "Hello World" ``` +While `withLogstashLoggingT` is useful for scenarios where there is a single producer for which log messages should be dispatched asynchronously, we may wish to share the same queue among several producers. For such applications, the `runTBMQueueLoggingT` in combination with `withLogstashQueue` is a better fit: + +```haskell +main :: IO () +main = do + let ctx = logstashTcp def + let cfg = defaultLogstashQueueCfg ctx + + withLogstashQueue cfg (const stashJsonLine) [] $ \queue -> do + thread <- async $ runTBMQueueLoggingT queue $ do + liftIO $ threadDelay (60*1000*1000) + logInfoN "I am consumer #2" + + runTBMQueueLoggingT queue $ do + logInfoN "I am consumer #1" + + wait thread +``` + ### Usage with `katip` +[![katip-logstash](https://img.shields.io/hackage/v/katip-logstash)](https://hackage.haskell.org/package/katip-logstash) The `katip-logstash` package provides convenience functions and types for working with [`katip`](http://hackage.haskell.org/package/katip/). diff --git a/monad-logger-logstash.cabal b/monad-logger-logstash.cabal --- a/monad-logger-logstash.cabal +++ b/monad-logger-logstash.cabal @@ -1,49 +1,41 @@ -cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.33.0. --- --- see: https://github.com/sol/hpack --- --- hash: bb6eb2cc0b9c0d5e471d1f67b2ea8090faedc57f0ec5d4876da0475551b756f4 +cabal-version: 1.12 +name: monad-logger-logstash +version: 0.2.0.1 +license: MIT +license-file: LICENSE +copyright: Copyright (c) 2021 Michael B. Gale +maintainer: github@michael-gale.co.uk +author: Michael B. Gale +homepage: https://github.com/mbg/logstash#readme +bug-reports: https://github.com/mbg/logstash/issues +synopsis: Logstash backend for monad-logger. +description: + Please see the README on GitHub at -name: monad-logger-logstash -version: 0.1.0.0 -synopsis: Logstash backend for monad-logger. -description: Please see the README on GitHub at -category: System -homepage: https://github.com/mbg/logstash#readme -bug-reports: https://github.com/mbg/logstash/issues -author: Michael B. Gale -maintainer: m.gale@warwick.ac.uk -copyright: Copyright (c) 2020 Michael B. Gale -license: MIT -license-file: LICENSE -build-type: Simple +category: System +build-type: Simple extra-source-files: README.md ChangeLog.md source-repository head - type: git - location: https://github.com/mbg/logstash + type: git + location: https://github.com/mbg/logstash library - exposed-modules: - Control.Monad.Logger.Logstash - other-modules: - Paths_monad_logger_logstash - hs-source-dirs: - src - default-extensions: RecordWildCards OverloadedStrings - build-depends: - aeson - , base >=4.7 && <5 - , logstash - , monad-logger - , retry - , stm - , stm-chans - , text - , transformers - , unliftio - default-language: Haskell2010 + exposed-modules: Control.Monad.Logger.Logstash + hs-source-dirs: src + other-modules: Paths_monad_logger_logstash + default-language: Haskell2010 + default-extensions: RecordWildCards OverloadedStrings + build-depends: + aeson <1.6, + base >=4.7 && <5, + logstash <0.2, + monad-logger <0.4, + retry <0.9, + stm <2.6, + stm-chans <3.1, + text <1.3, + transformers <0.6, + unliftio <0.3 diff --git a/src/Control/Monad/Logger/Logstash.hs b/src/Control/Monad/Logger/Logstash.hs --- a/src/Control/Monad/Logger/Logstash.hs +++ b/src/Control/Monad/Logger/Logstash.hs @@ -5,17 +5,17 @@ -- file in the root directory of this source tree. -- -------------------------------------------------------------------------------- --- | This module implements `runLogstashLoggerT` which can be +-- | This module implements `runLogstashLoggingT` which can be -- used to write log messages that arise in a `LoggingT` computation to a -- given `LogstashContext`. The following example demonstrates how to use the --- `runLogstashLoggerT` function with a TCP connection to Logstash, the +-- `runLogstashLoggingT` function with a TCP connection to Logstash, the -- default retry policy from `Control.Retry`, a 1s timeout for each attempt, -- and the @json_lines@ codec: -- -- > main :: IO () -- > main = do -- > let ctx = logstashTcp def --- > runLogstashLoggerT ctx retryPolicyDefault 1000000 (const stashJsonLine) $ +-- > runLogstashLoggingT ctx retryPolicyDefault 1000000 (const stashJsonLine) $ -- > logInfoN "Hello World" -- -- Assuming a suitable Logstash server that can receive this message, @@ -43,10 +43,13 @@ -- attempted again. If all attempts fail, the most recent exception is thrown -- to the caller. module Control.Monad.Logger.Logstash ( - runLogstashLoggerT, + runLogstashLoggingT, stashJsonLine, + jsonLogLine, - withLogstashLoggerT, + withLogstashLoggingT, + runTBMQueueLoggingT, + unTBMQueueLoggingT, -- * Re-exports LogstashContext(..) @@ -68,20 +71,20 @@ import Data.Text (Text) import Data.Text.Encoding (decodeUtf8) -import UnliftIO (MonadUnliftIO) +import UnliftIO (MonadIO(..), MonadUnliftIO) import Logstash hiding (stashJsonLine) import qualified Logstash as L (stashJsonLine) -------------------------------------------------------------------------------- --- | `runLogstashLoggerT` @context retryPolicy time codec logger@ runs a +-- | `runLogstashLoggingT` @context retryPolicy time codec logger@ runs a -- `LoggingT` computation which writes all log entries to the Logstash -- @context@ using the given @codec@. The @retryPolicy@ determines whether -- and how the handler should deal with failures that arise. Each attempt -- that is made by the @retryPolicy@ will have a timeout of @time@ -- microseconds applied to it. -runLogstashLoggerT +runLogstashLoggingT :: LogstashContext ctx => ctx -> RetryPolicyM IO @@ -92,14 +95,14 @@ ) -> LoggingT m a -> m a -runLogstashLoggerT ctx policy time codec log = runLoggingT log $ +runLogstashLoggingT ctx policy time codec log = runLoggingT log $ \logLoc logSource logLevel logStr -> runLogstash ctx policy time $ \s -> codec s (logLoc, logSource, logLevel, logStr) --- | `withLogstashLoggerT` @cfg codec exceptionHandlers logger@ is like +-- | `withLogstashLoggingT` @cfg codec exceptionHandlers logger@ is like -- `withLogstashQueue` except for `LoggingT` computations so that log messages -- are automatically added to the queue. -withLogstashLoggerT +withLogstashLoggingT :: (LogstashContext ctx, MonadUnliftIO m) => LogstashQueueCfg ctx -> ( RetryStatus -> @@ -109,11 +112,38 @@ -> [(Loc, LogSource, LogLevel, LogStr) -> Handler ()] -> LoggingT m a -> m a -withLogstashLoggerT cfg dispatch hs log = withLogstashQueue cfg dispatch hs $ - \queue -> runLoggingT log $ +withLogstashLoggingT cfg dispatch hs log = withLogstashQueue cfg dispatch hs $ + \queue -> runTBMQueueLoggingT queue log + +-- | `runTBMQueueLoggingT` @queue logger@ runs @logger@ so that log messages +-- are automatically added to @queue@. This can be used if the same queue and +-- consumer should be shared among multiple producer threads. The queue should +-- be initialised by `withLogstashQueue`. +runTBMQueueLoggingT + :: MonadUnliftIO m + => TBMQueue (Loc, LogSource, LogLevel, LogStr) + -> LoggingT m a + -> m a +runTBMQueueLoggingT queue log = runLoggingT log $ \logLoc logSource logLevel logStr -> atomically $ writeTBMQueue queue (logLoc, logSource, logLevel, logStr) +-- | `unTBMQueueLoggingT` @queue@ is like `unChanLoggingT` but for a +-- `TBMQueue`. Since a `TBMQueue` can be closed, this function does not run +-- forever like `unChanLoggingT` and will return when @queue@ is closed. +unTBMQueueLoggingT + :: (MonadIO m, MonadLogger m) + => TBMQueue (Loc, LogSource, LogLevel, LogStr) + -> m () +unTBMQueueLoggingT queue = do + mLine <- liftIO $ atomically $ readTBMQueue queue + + case mLine of + Nothing -> pure () + Just (loc,src,lvl,msg) -> do + monadLoggerLog loc src lvl msg + unTBMQueueLoggingT queue + -------------------------------------------------------------------------------- -- | `stashJsonLine` @entry@ serialises @entry@ as JSON using reasonable @@ -122,21 +152,26 @@ -- and sends the result to Logstash using the @json_lines@ codec. stashJsonLine :: (Loc, LogSource, LogLevel, LogStr) -> ReaderT LogstashConnection IO () -stashJsonLine (logEntryLoc, logEntrySource, logEntryLevel, logEntryMessage) = - L.stashJsonLine $ object - [ "message" .= decodeUtf8 (fromLogStr logEntryMessage) +stashJsonLine = L.stashJsonLine . jsonLogLine + +-- | `jsonLogLine` @entry@ serialises @entry@ as JSON using reasonable +-- defaults for Elasticsearch based on +-- https://www.elastic.co/guide/en/ecs/current/ecs-field-reference.html +jsonLogLine :: (Loc, LogSource, LogLevel, LogStr) -> Value +jsonLogLine (loc, src, lvl, msg) = object + [ "message" .= decodeUtf8 (fromLogStr msg) , "log" .= object - [ "logger" .= logEntrySource - , "level" .= jsonLogLevel logEntryLevel + [ "logger" .= src + , "level" .= jsonLogLevel lvl , "origin" .= object [ "file" .= object - [ "name" .= loc_filename logEntryLoc - , "line" .= fst (loc_start logEntryLoc) + [ "name" .= loc_filename loc + , "line" .= fst (loc_start loc) -- the following fields are not part of the ECS - , "package" .= loc_package logEntryLoc - , "module" .= loc_module logEntryLoc - , "start" .= jsonCharPos (loc_start logEntryLoc) - , "end" .= jsonCharPos (loc_end logEntryLoc) + , "package" .= loc_package loc + , "module" .= loc_module loc + , "start" .= jsonCharPos (loc_start loc) + , "end" .= jsonCharPos (loc_end loc) ] ] ]