{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

-- | Tinylog convenience things.
module System.Logger.Extended
  ( module Log,
    LogFormat (..),
    mkLogger,
    mkLogger',
    LoggerT (..),
    runWithLogger,
    netStringsToLogFormat,
    structuredJSONRenderer,
  )
where

import Cassandra (MonadClient)
import Control.Monad.Catch
import Data.Aeson as Aeson
import Data.Aeson.Encoding (list, pair, text)
import Data.Aeson.Key qualified as Key
import Data.ByteString (toStrict)
import Data.ByteString.Builder qualified as B
import Data.ByteString.Lazy.Char8 qualified as L
import Data.Map.Lazy qualified as Map
import Data.Text.Encoding
import Data.Text.Encoding.Error
import GHC.Generics
import Imports
import System.Logger as Log
import System.Logger.Class qualified as LC

deriving instance Generic LC.Level

instance FromJSON LC.Level

instance ToJSON LC.Level

-- | The log formats supported
data LogFormat = JSON | Plain | Netstring | StructuredJSON
  deriving stock (LogFormat -> LogFormat -> Bool
(LogFormat -> LogFormat -> Bool)
-> (LogFormat -> LogFormat -> Bool) -> Eq LogFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogFormat -> LogFormat -> Bool
== :: LogFormat -> LogFormat -> Bool
$c/= :: LogFormat -> LogFormat -> Bool
/= :: LogFormat -> LogFormat -> Bool
Eq, Int -> LogFormat -> ShowS
[LogFormat] -> ShowS
LogFormat -> String
(Int -> LogFormat -> ShowS)
-> (LogFormat -> String)
-> ([LogFormat] -> ShowS)
-> Show LogFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogFormat -> ShowS
showsPrec :: Int -> LogFormat -> ShowS
$cshow :: LogFormat -> String
show :: LogFormat -> String
$cshowList :: [LogFormat] -> ShowS
showList :: [LogFormat] -> ShowS
Show, (forall x. LogFormat -> Rep LogFormat x)
-> (forall x. Rep LogFormat x -> LogFormat) -> Generic LogFormat
forall x. Rep LogFormat x -> LogFormat
forall x. LogFormat -> Rep LogFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LogFormat -> Rep LogFormat x
from :: forall x. LogFormat -> Rep LogFormat x
$cto :: forall x. Rep LogFormat x -> LogFormat
to :: forall x. Rep LogFormat x -> LogFormat
Generic)
  deriving anyclass ([LogFormat] -> Value
[LogFormat] -> Encoding
LogFormat -> Value
LogFormat -> Encoding
(LogFormat -> Value)
-> (LogFormat -> Encoding)
-> ([LogFormat] -> Value)
-> ([LogFormat] -> Encoding)
-> ToJSON LogFormat
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LogFormat -> Value
toJSON :: LogFormat -> Value
$ctoEncoding :: LogFormat -> Encoding
toEncoding :: LogFormat -> Encoding
$ctoJSONList :: [LogFormat] -> Value
toJSONList :: [LogFormat] -> Value
$ctoEncodingList :: [LogFormat] -> Encoding
toEncodingList :: [LogFormat] -> Encoding
ToJSON, Value -> Parser [LogFormat]
Value -> Parser LogFormat
(Value -> Parser LogFormat)
-> (Value -> Parser [LogFormat]) -> FromJSON LogFormat
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LogFormat
parseJSON :: Value -> Parser LogFormat
$cparseJSONList :: Value -> Parser [LogFormat]
parseJSONList :: Value -> Parser [LogFormat]
FromJSON)

-- | We use this as an intermediate structure to ease the implementation of the
-- ToJSON instance but we could just inline everything. I think this has
-- negligible impact and makes the code a bit more readable. Let me know
data Element' = Element' Series [Builder]

elementToEncoding :: Element' -> Encoding
elementToEncoding :: Element' -> Encoding
elementToEncoding (Element' Series
fields [Builder]
msgs) = Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Series
fields Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Series
msgsToSeries [Builder]
msgs
  where
    msgsToSeries :: [Builder] -> Series
    msgsToSeries :: [Builder] -> Series
msgsToSeries =
      Key -> Encoding -> Series
pair Key
"msgs"
        (Encoding -> Series)
-> ([Builder] -> Encoding) -> [Builder] -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Encoding) -> [Builder] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list
          ( Text -> Encoding
forall a. Text -> Encoding' a
text
              (Text -> Encoding) -> (Builder -> Text) -> Builder -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode
              (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
              (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
eval
          )

collect :: [Element] -> Element'
collect :: [Element] -> Element'
collect = (Element -> Element' -> Element')
-> Element' -> [Element] -> Element'
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Element -> Element' -> Element'
go (Series -> [Builder] -> Element'
Element' Series
forall a. Monoid a => a
mempty [])
  where
    go :: Element -> Element' -> Element'
    go :: Element -> Element' -> Element'
go (Bytes Builder
b) (Element' Series
f [Builder]
m) =
      Series -> [Builder] -> Element'
Element' Series
f (Builder
b Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
m)
    go (Field Builder
k Builder
v) (Element' Series
f [Builder]
m) =
      Series -> [Builder] -> Element'
Element'
        ( Series
f
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair
              (Text -> Key
Key.fromText (Text -> Key) -> (Builder -> Text) -> Builder -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
dec (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
eval (Builder -> Key) -> Builder -> Key
forall a b. (a -> b) -> a -> b
$ Builder
k)
              (Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding) -> (Builder -> Text) -> Builder -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
dec (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
eval (Builder -> Encoding) -> Builder -> Encoding
forall a b. (a -> b) -> a -> b
$ Builder
v)
        )
        [Builder]
m
    dec :: ByteString -> Text
dec = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode

jsonRenderer :: Renderer
jsonRenderer :: Renderer
jsonRenderer ByteString
_sep DateFormat
_dateFormat Level
_logLevel = Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding (Encoding -> Builder)
-> ([Element] -> Encoding) -> [Element] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element' -> Encoding
elementToEncoding (Element' -> Encoding)
-> ([Element] -> Element') -> [Element] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element] -> Element'
collect

data StructuredJSONOutput = StructuredJSONOutput {StructuredJSONOutput -> Maybe Level
lvl :: Maybe Level, StructuredJSONOutput -> [Text]
msgs :: [Text], StructuredJSONOutput -> Map Key [Text]
fields :: Map Key [Text]}

-- | Displays all the 'Bytes' segments in a list under key @msgs@ and 'Field'
-- segments as key-value pair in a JSON
--
-- >>> logElems = [Bytes "W", Bytes "The message", Field "field1" "val1", Field "field2" "val2", Field "field1" "val1.1"]
-- >>> B.toLazyByteString $ structuredJSONRenderer "," iso8601UTC Info logElems
-- "{\"msgs\":[\"The message\"],\"field1\":[\"val1\",\"val1.1\"],\"field2\":\"val2\",\"level\":\"Warn\"}"
structuredJSONRenderer :: Renderer
structuredJSONRenderer :: Renderer
structuredJSONRenderer ByteString
_sep DateFormat
_dateFmt Level
_lvlThreshold [Element]
logElems =
  let structuredJSON :: StructuredJSONOutput
structuredJSON = [Element] -> StructuredJSONOutput
toStructuredJSONOutput [Element]
logElems
   in Encoding -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding (Encoding -> Builder) -> (Value -> Encoding) -> Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Value -> Builder) -> Value -> Builder
forall a b. (a -> b) -> a -> b
$
        [Pair] -> Value
object
          ( [ Key
"level" Key -> Maybe Level -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= StructuredJSONOutput -> Maybe Level
lvl StructuredJSONOutput
structuredJSON,
              Key
"msgs" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= StructuredJSONOutput -> [Text]
msgs StructuredJSONOutput
structuredJSON
            ]
              [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> (Key -> [Text] -> [Pair]) -> Map Key [Text] -> [Pair]
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (\Key
k [Text]
v -> [Key
k Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= [Text] -> Value
renderTextList [Text]
v]) (StructuredJSONOutput -> Map Key [Text]
fields StructuredJSONOutput
structuredJSON)
          )
  where
    -- Renders List of Text as a String, if it only contains one element. This
    -- should be most (if not all) of the cases
    renderTextList :: [Text] -> Value
    renderTextList :: [Text] -> Value
renderTextList [Text
t] = Text -> Value
String Text
t
    renderTextList [Text]
xs = [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
xs

    builderToText :: Builder -> Text
    builderToText :: Builder -> Text
builderToText = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
eval

    -- We need to do this to work around https://gitlab.com/twittner/tinylog/-/issues/5
    parseLevel :: Text -> Maybe Level
    parseLevel :: Text -> Maybe Level
parseLevel = \case
      Text
"T" -> Level -> Maybe Level
forall a. a -> Maybe a
Just Level
Trace
      Text
"D" -> Level -> Maybe Level
forall a. a -> Maybe a
Just Level
Debug
      Text
"I" -> Level -> Maybe Level
forall a. a -> Maybe a
Just Level
Info
      Text
"W" -> Level -> Maybe Level
forall a. a -> Maybe a
Just Level
Warn
      Text
"E" -> Level -> Maybe Level
forall a. a -> Maybe a
Just Level
Log.Error
      Text
"F" -> Level -> Maybe Level
forall a. a -> Maybe a
Just Level
Fatal
      Text
_ -> Maybe Level
forall a. Maybe a
Nothing

    toStructuredJSONOutput :: [Element] -> StructuredJSONOutput
    toStructuredJSONOutput :: [Element] -> StructuredJSONOutput
toStructuredJSONOutput =
      (Element -> StructuredJSONOutput -> StructuredJSONOutput)
-> StructuredJSONOutput -> [Element] -> StructuredJSONOutput
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        ( \Element
e StructuredJSONOutput
o -> case Element
e of
            Bytes Builder
b ->
              let buildMsg :: Text
buildMsg = Builder -> Text
builderToText Builder
b
               in case Text -> Maybe Level
parseLevel Text
buildMsg of
                    Maybe Level
Nothing -> StructuredJSONOutput
o {msgs = builderToText b : msgs o}
                    Just Level
lvl -> StructuredJSONOutput
o {lvl = Just lvl}
            Field Builder
k Builder
v -> StructuredJSONOutput
o {fields = Map.insertWith (<>) (Key.fromText $ builderToText k) ([builderToText v]) (fields o)}
        )
        (Maybe Level -> [Text] -> Map Key [Text] -> StructuredJSONOutput
StructuredJSONOutput Maybe Level
forall a. Maybe a
Nothing [] Map Key [Text]
forall a. Monoid a => a
mempty)

-- | Here for backwards-compatibility reasons
netStringsToLogFormat :: Bool -> LogFormat
netStringsToLogFormat :: Bool -> LogFormat
netStringsToLogFormat Bool
True = LogFormat
Netstring
netStringsToLogFormat Bool
False = LogFormat
Plain

-- | Creates a logger given a log format Also takes an useNetstrings argument
-- which is there because we cannot immediatelly deprecate the old interface.
-- Old configs only provide the useNetstrings argument and not the logFormat
-- argument, and in that case implement the old behaviour of either enabling
-- plain text logging or netstring logging.  If both arguments are set,
-- logFormat takes presedence over useNetstrings
--
-- FUTUREWORK: Once we get rid of the useNetstrings in our config files, we can
-- remove this function and rename 'mkLoggerNew' to 'mkLogger'
mkLogger :: Log.Level -> Maybe (Last Bool) -> Maybe (Last LogFormat) -> IO Log.Logger
mkLogger :: Level -> Maybe (Last Bool) -> Maybe (Last LogFormat) -> IO Logger
mkLogger Level
lvl Maybe (Last Bool)
useNetstrings Maybe (Last LogFormat)
logFormat = do
  Level -> LogFormat -> IO Logger
mkLoggerNew Level
lvl (LogFormat -> IO Logger) -> LogFormat -> IO Logger
forall a b. (a -> b) -> a -> b
$
    LogFormat
-> (Last LogFormat -> LogFormat)
-> Maybe (Last LogFormat)
-> LogFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      LogFormat
Plain
      Last LogFormat -> LogFormat
forall a. Last a -> a
getLast
      (((Bool -> LogFormat) -> Last Bool -> Last LogFormat
forall a b. (a -> b) -> Last a -> Last b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> LogFormat
netStringsToLogFormat (Last Bool -> Last LogFormat)
-> Maybe (Last Bool) -> Maybe (Last LogFormat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Last Bool)
useNetstrings) Maybe (Last LogFormat)
-> Maybe (Last LogFormat) -> Maybe (Last LogFormat)
forall a. Semigroup a => a -> a -> a
<> Maybe (Last LogFormat)
logFormat)

-- | Version of mkLogger that doesn't support the deprecated useNetstrings option
mkLoggerNew :: Log.Level -> LogFormat -> IO Log.Logger
mkLoggerNew :: Level -> LogFormat -> IO Logger
mkLoggerNew Level
lvl LogFormat
logFormat =
  Settings -> IO Logger
forall (m :: * -> *). MonadIO m => Settings -> m Logger
Log.new
    (Settings -> IO Logger)
-> (Settings -> Settings) -> Settings -> IO Logger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Settings -> Settings
Log.setReadEnvironment Bool
False
    (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output -> Settings -> Settings
Log.setOutput Output
Log.StdOut
    (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DateFormat -> Settings -> Settings
Log.setFormat Maybe DateFormat
forall a. Maybe a
Nothing
    (Settings -> IO Logger) -> Settings -> IO Logger
forall a b. (a -> b) -> a -> b
$ Level -> LogFormat -> Settings
simpleSettings Level
lvl LogFormat
logFormat

-- | Variant of Log.defSettings:
--
--   * change log level according to first arg (iff isJust).
--
--   * pick renderNetstr or renderDefault according to 2nd arg (iff isJust).
--
--   * use 'canonicalizeWhitespace'.
simpleSettings :: Log.Level -> LogFormat -> Log.Settings
simpleSettings :: Level -> LogFormat -> Settings
simpleSettings Level
lvl LogFormat
logFormat =
  Level -> Settings -> Settings
Log.setLogLevel Level
lvl
    (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Renderer -> Settings -> Settings
Log.setRenderer (Renderer -> Renderer
canonicalizeWhitespace Renderer
rndr)
    (Settings -> Settings) -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ Settings
Log.defSettings
  where
    rndr :: Renderer
rndr = case LogFormat
logFormat of
      LogFormat
Netstring -> \ByteString
_separator DateFormat
_dateFormat Level
_level -> [Element] -> Builder
Log.renderNetstr
      LogFormat
Plain -> \ByteString
separator DateFormat
_dateFormat Level
_level -> ByteString -> [Element] -> Builder
Log.renderDefault ByteString
separator
      LogFormat
JSON -> Renderer
jsonRenderer
      LogFormat
StructuredJSON -> Renderer
structuredJSONRenderer

-- | Replace all whitespace characters in the output of a renderer by @' '@.
-- Log output must be ASCII encoding.
--
-- (Many logging processors handle newlines poorly.  Instead of hunting down all
-- places and situations in your code and your dependencies that inject newlines
-- into your log messages, you can choose to call 'canonicalizeWhitespace' on
-- your renderer.)
canonicalizeWhitespace :: Log.Renderer -> Log.Renderer
canonicalizeWhitespace :: Renderer -> Renderer
canonicalizeWhitespace Renderer
rndrRaw ByteString
delim DateFormat
df Level
lvl =
  ByteString -> Builder
B.lazyByteString (ByteString -> Builder)
-> ([Element] -> ByteString) -> [Element] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
nl2sp (ByteString -> ByteString)
-> ([Element] -> ByteString) -> [Element] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> ([Element] -> Builder) -> [Element] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Renderer
rndrRaw ByteString
delim DateFormat
df Level
lvl
  where
    nl2sp :: L.ByteString -> L.ByteString
    nl2sp :: ByteString -> ByteString
nl2sp = (Char -> ByteString) -> ByteString -> ByteString
L.concatMap ((Char -> ByteString) -> ByteString -> ByteString)
-> (Char -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
      \Char
c ->
        if Char -> Bool
isSpace Char
c
          then ByteString
" "
          else Char -> ByteString
L.singleton Char
c

-- | Like 'mkLogger', but uses Log.new which reads in LOG_* env variables.
--
-- TODO: DEPRECATED!  Use 'mkLogger' instead and get all settings from config files, not from
-- environment!
mkLogger' :: IO Log.Logger
mkLogger' :: IO Logger
mkLogger' =
  Settings -> IO Logger
forall (m :: * -> *). MonadIO m => Settings -> m Logger
Log.new
    (Settings -> IO Logger)
-> (Settings -> Settings) -> Settings -> IO Logger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output -> Settings -> Settings
Log.setOutput Output
Log.StdOut
    (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DateFormat -> Settings -> Settings
Log.setFormat Maybe DateFormat
forall a. Maybe a
Nothing
    (Settings -> IO Logger) -> Settings -> IO Logger
forall a b. (a -> b) -> a -> b
$ Settings
Log.defSettings

-- | It's a bit odd that we mention 'MonadClient' from the cql-io package here, but it's the
-- easiest way to get things done.  Alternatively, we could introduce 'LoggerT' in the gundeck
-- integration tests, which is the only place in the world where it is currently used, but we
-- may need it elsewhere in the future and here it's easier to find.
newtype LoggerT m a = LoggerT {forall (m :: * -> *) a. LoggerT m a -> ReaderT Logger m a
runLoggerT :: ReaderT Log.Logger m a}
  deriving newtype
    ( (forall a b. (a -> b) -> LoggerT m a -> LoggerT m b)
-> (forall a b. a -> LoggerT m b -> LoggerT m a)
-> Functor (LoggerT m)
forall a b. a -> LoggerT m b -> LoggerT m a
forall a b. (a -> b) -> LoggerT m a -> LoggerT m b
forall (m :: * -> *) a b.
Functor m =>
a -> LoggerT m b -> LoggerT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggerT m a -> LoggerT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggerT m a -> LoggerT m b
fmap :: forall a b. (a -> b) -> LoggerT m a -> LoggerT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> LoggerT m b -> LoggerT m a
<$ :: forall a b. a -> LoggerT m b -> LoggerT m a
Functor,
      Functor (LoggerT m)
Functor (LoggerT m) =>
(forall a. a -> LoggerT m a)
-> (forall a b. LoggerT m (a -> b) -> LoggerT m a -> LoggerT m b)
-> (forall a b c.
    (a -> b -> c) -> LoggerT m a -> LoggerT m b -> LoggerT m c)
-> (forall a b. LoggerT m a -> LoggerT m b -> LoggerT m b)
-> (forall a b. LoggerT m a -> LoggerT m b -> LoggerT m a)
-> Applicative (LoggerT m)
forall a. a -> LoggerT m a
forall a b. LoggerT m a -> LoggerT m b -> LoggerT m a
forall a b. LoggerT m a -> LoggerT m b -> LoggerT m b
forall a b. LoggerT m (a -> b) -> LoggerT m a -> LoggerT m b
forall a b c.
(a -> b -> c) -> LoggerT m a -> LoggerT m b -> LoggerT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (LoggerT m)
forall (m :: * -> *) a. Applicative m => a -> LoggerT m a
forall (m :: * -> *) a b.
Applicative m =>
LoggerT m a -> LoggerT m b -> LoggerT m a
forall (m :: * -> *) a b.
Applicative m =>
LoggerT m a -> LoggerT m b -> LoggerT m b
forall (m :: * -> *) a b.
Applicative m =>
LoggerT m (a -> b) -> LoggerT m a -> LoggerT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LoggerT m a -> LoggerT m b -> LoggerT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> LoggerT m a
pure :: forall a. a -> LoggerT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
LoggerT m (a -> b) -> LoggerT m a -> LoggerT m b
<*> :: forall a b. LoggerT m (a -> b) -> LoggerT m a -> LoggerT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LoggerT m a -> LoggerT m b -> LoggerT m c
liftA2 :: forall a b c.
(a -> b -> c) -> LoggerT m a -> LoggerT m b -> LoggerT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
LoggerT m a -> LoggerT m b -> LoggerT m b
*> :: forall a b. LoggerT m a -> LoggerT m b -> LoggerT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
LoggerT m a -> LoggerT m b -> LoggerT m a
<* :: forall a b. LoggerT m a -> LoggerT m b -> LoggerT m a
Applicative,
      Applicative (LoggerT m)
Applicative (LoggerT m) =>
(forall a b. LoggerT m a -> (a -> LoggerT m b) -> LoggerT m b)
-> (forall a b. LoggerT m a -> LoggerT m b -> LoggerT m b)
-> (forall a. a -> LoggerT m a)
-> Monad (LoggerT m)
forall a. a -> LoggerT m a
forall a b. LoggerT m a -> LoggerT m b -> LoggerT m b
forall a b. LoggerT m a -> (a -> LoggerT m b) -> LoggerT m b
forall (m :: * -> *). Monad m => Applicative (LoggerT m)
forall (m :: * -> *) a. Monad m => a -> LoggerT m a
forall (m :: * -> *) a b.
Monad m =>
LoggerT m a -> LoggerT m b -> LoggerT m b
forall (m :: * -> *) a b.
Monad m =>
LoggerT m a -> (a -> LoggerT m b) -> LoggerT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LoggerT m a -> (a -> LoggerT m b) -> LoggerT m b
>>= :: forall a b. LoggerT m a -> (a -> LoggerT m b) -> LoggerT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
LoggerT m a -> LoggerT m b -> LoggerT m b
>> :: forall a b. LoggerT m a -> LoggerT m b -> LoggerT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> LoggerT m a
return :: forall a. a -> LoggerT m a
Monad,
      Monad (LoggerT m)
Monad (LoggerT m) =>
(forall a. IO a -> LoggerT m a) -> MonadIO (LoggerT m)
forall a. IO a -> LoggerT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (LoggerT m)
forall (m :: * -> *) a. MonadIO m => IO a -> LoggerT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> LoggerT m a
liftIO :: forall a. IO a -> LoggerT m a
MonadIO,
      Monad (LoggerT m)
Monad (LoggerT m) =>
(forall e a. (HasCallStack, Exception e) => e -> LoggerT m a)
-> MonadThrow (LoggerT m)
forall e a. (HasCallStack, Exception e) => e -> LoggerT m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (LoggerT m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> LoggerT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> LoggerT m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> LoggerT m a
MonadThrow,
      MonadThrow (LoggerT m)
MonadThrow (LoggerT m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 LoggerT m a -> (e -> LoggerT m a) -> LoggerT m a)
-> MonadCatch (LoggerT m)
forall e a.
(HasCallStack, Exception e) =>
LoggerT m a -> (e -> LoggerT m a) -> LoggerT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (LoggerT m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
LoggerT m a -> (e -> LoggerT m a) -> LoggerT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
LoggerT m a -> (e -> LoggerT m a) -> LoggerT m a
catch :: forall e a.
(HasCallStack, Exception e) =>
LoggerT m a -> (e -> LoggerT m a) -> LoggerT m a
MonadCatch,
      MonadCatch (LoggerT m)
MonadCatch (LoggerT m) =>
(forall b.
 HasCallStack =>
 ((forall a. LoggerT m a -> LoggerT m a) -> LoggerT m b)
 -> LoggerT m b)
-> (forall b.
    HasCallStack =>
    ((forall a. LoggerT m a -> LoggerT m a) -> LoggerT m b)
    -> LoggerT m b)
-> (forall a b c.
    HasCallStack =>
    LoggerT m a
    -> (a -> ExitCase b -> LoggerT m c)
    -> (a -> LoggerT m b)
    -> LoggerT m (b, c))
-> MonadMask (LoggerT m)
forall b.
HasCallStack =>
((forall a. LoggerT m a -> LoggerT m a) -> LoggerT m b)
-> LoggerT m b
forall a b c.
HasCallStack =>
LoggerT m a
-> (a -> ExitCase b -> LoggerT m c)
-> (a -> LoggerT m b)
-> LoggerT m (b, c)
forall (m :: * -> *). MonadMask m => MonadCatch (LoggerT m)
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. LoggerT m a -> LoggerT m a) -> LoggerT m b)
-> LoggerT m b
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
LoggerT m a
-> (a -> ExitCase b -> LoggerT m c)
-> (a -> LoggerT m b)
-> LoggerT m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. LoggerT m a -> LoggerT m a) -> LoggerT m b)
-> LoggerT m b
mask :: forall b.
HasCallStack =>
((forall a. LoggerT m a -> LoggerT m a) -> LoggerT m b)
-> LoggerT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. LoggerT m a -> LoggerT m a) -> LoggerT m b)
-> LoggerT m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. LoggerT m a -> LoggerT m a) -> LoggerT m b)
-> LoggerT m b
$cgeneralBracket :: forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
LoggerT m a
-> (a -> ExitCase b -> LoggerT m c)
-> (a -> LoggerT m b)
-> LoggerT m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
LoggerT m a
-> (a -> ExitCase b -> LoggerT m c)
-> (a -> LoggerT m b)
-> LoggerT m (b, c)
MonadMask,
      MonadIO (LoggerT m)
MonadThrow (LoggerT m)
(MonadIO (LoggerT m), MonadThrow (LoggerT m)) =>
(forall a. Client a -> LoggerT m a)
-> (forall a.
    (ClientState -> ClientState) -> LoggerT m a -> LoggerT m a)
-> MonadClient (LoggerT m)
forall a. Client a -> LoggerT m a
forall a.
(ClientState -> ClientState) -> LoggerT m a -> LoggerT m a
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
(forall a. Client a -> m a)
-> (forall a. (ClientState -> ClientState) -> m a -> m a)
-> MonadClient m
forall (m :: * -> *). MonadClient m => MonadIO (LoggerT m)
forall (m :: * -> *). MonadClient m => MonadThrow (LoggerT m)
forall (m :: * -> *) a. MonadClient m => Client a -> LoggerT m a
forall (m :: * -> *) a.
MonadClient m =>
(ClientState -> ClientState) -> LoggerT m a -> LoggerT m a
$cliftClient :: forall (m :: * -> *) a. MonadClient m => Client a -> LoggerT m a
liftClient :: forall a. Client a -> LoggerT m a
$clocalState :: forall (m :: * -> *) a.
MonadClient m =>
(ClientState -> ClientState) -> LoggerT m a -> LoggerT m a
localState :: forall a.
(ClientState -> ClientState) -> LoggerT m a -> LoggerT m a
MonadClient
    )

instance (MonadIO m) => LC.MonadLogger (LoggerT m) where
  log :: LC.Level -> (LC.Msg -> LC.Msg) -> LoggerT m ()
  log :: Level -> (Msg -> Msg) -> LoggerT m ()
log Level
l Msg -> Msg
m = ReaderT Logger m () -> LoggerT m ()
forall (m :: * -> *) a. ReaderT Logger m a -> LoggerT m a
LoggerT (ReaderT Logger m () -> LoggerT m ())
-> ReaderT Logger m () -> LoggerT m ()
forall a b. (a -> b) -> a -> b
$ do
    Logger
logger <- ReaderT Logger m Logger
forall r (m :: * -> *). MonadReader r m => m r
ask
    Logger -> Level -> (Msg -> Msg) -> ReaderT Logger m ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Level -> (Msg -> Msg) -> m ()
Log.log Logger
logger Level
l Msg -> Msg
m

runWithLogger :: Log.Logger -> LoggerT m a -> m a
runWithLogger :: forall (m :: * -> *) a. Logger -> LoggerT m a -> m a
runWithLogger Logger
logger = (ReaderT Logger m a -> Logger -> m a)
-> Logger -> ReaderT Logger m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Logger m a -> Logger -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Logger
logger (ReaderT Logger m a -> m a)
-> (LoggerT m a -> ReaderT Logger m a) -> LoggerT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerT m a -> ReaderT Logger m a
forall (m :: * -> *) a. LoggerT m a -> ReaderT Logger m a
runLoggerT