{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}

{-# OPTIONS_GHC -Wno-partial-fields  #-}

module Cardano.Logging.Types (
    Trace(..)
  , LogFormatting(..)
  , Metric(..)
  , getMetricName
  , emptyObject
  , Documented(..)
  , DocMsg(..)
  , LoggingContext(..)
  , emptyLoggingContext
  , Namespace(..)
  , nsReplacePrefix
  , nsReplaceInner
  , nsCast
  , nsPrependInner
  , nsGetComplete
  , nsGetTuple
  , nsRawToText
  , nsToText
  , MetaTrace(..)
  , DetailLevel(..)
  , Privacy(..)
  , SeverityS(..)
  , SeverityF(..)
  , ConfigOption(..)
  , ForwarderAddr(..)
  , FormatLogging(..)
  , ForwarderMode(..)
  , Verbosity(..)
  , TraceOptionForwarder(..)
  , defaultForwarder
  , ConfigReflection(..)
  , emptyConfigReflection
  , TraceConfig(..)
  , emptyTraceConfig
  , FormattedMessage(..)
  , TraceControl(..)
  , DocCollector(..)
  , LogDoc(..)
  , emptyLogDoc
  , BackendConfig(..)
  , Folding(..)
  , unfold
  , TraceObject(..)
  , PreFormatted(..)
  , HowToConnect(..)
) where

import           Codec.Serialise (Serialise (..))
import           Control.Applicative ((<|>))
import           Control.DeepSeq (NFData)
import qualified Control.Tracer as T
import qualified Data.Aeson as AE
import qualified Data.Aeson.Types as AE (Parser)
import           Data.Bool (bool)
import           Data.ByteString (ByteString)
import qualified Data.HashMap.Strict as HM
import           Data.IORef
import           Data.Kind (Type)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Text as T (Text, breakOnEnd, intercalate, null, pack, singleton, unpack,
                   unsnoc, words)
import           Data.Text.Read as T (decimal)
import           Data.Time (UTCTime)
import           Data.Word (Word16)
import           GHC.Generics
import           Network.HostName (HostName)
import           Network.Socket (PortNumber)


-- | The Trace carries the underlying tracer Tracer from the contra-tracer package.
--   It adds a 'LoggingContext' and maybe a 'TraceControl' to every message.
newtype Trace m a = Trace
                            {forall (m :: * -> *) a.
Trace m a -> Tracer m (LoggingContext, Either TraceControl a)
unpackTrace :: T.Tracer m (LoggingContext, Either TraceControl a)}

-- | Contramap lifted to Trace
instance Monad m => T.Contravariant (Trace m) where
    contramap :: forall a' a. (a' -> a) -> Trace m a -> Trace m a'
contramap a' -> a
f (Trace Tracer m (LoggingContext, Either TraceControl a)
tr) = Tracer m (LoggingContext, Either TraceControl a') -> Trace m a'
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace (Tracer m (LoggingContext, Either TraceControl a') -> Trace m a')
-> Tracer m (LoggingContext, Either TraceControl a') -> Trace m a'
forall a b. (a -> b) -> a -> b
$
      ((LoggingContext, Either TraceControl a')
 -> (LoggingContext, Either TraceControl a))
-> Tracer m (LoggingContext, Either TraceControl a)
-> Tracer m (LoggingContext, Either TraceControl a')
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
T.contramap (\case
                      (LoggingContext
lc, Right a'
a) -> (LoggingContext
lc, a -> Either TraceControl a
forall a b. b -> Either a b
Right (a' -> a
f a'
a))
                      (LoggingContext
lc, Left TraceControl
tc) -> (LoggingContext
lc, TraceControl -> Either TraceControl a
forall a b. a -> Either a b
Left TraceControl
tc))
                  Tracer m (LoggingContext, Either TraceControl a)
tr

-- | @tr1 <> tr2@ will run @tr1@ and then @tr2@ with the same input.
instance Monad m => Semigroup (Trace m a) where
  Trace Tracer m (LoggingContext, Either TraceControl a)
a1 <> :: Trace m a -> Trace m a -> Trace m a
<> Trace Tracer m (LoggingContext, Either TraceControl a)
a2 = Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace (Tracer m (LoggingContext, Either TraceControl a)
a1 Tracer m (LoggingContext, Either TraceControl a)
-> Tracer m (LoggingContext, Either TraceControl a)
-> Tracer m (LoggingContext, Either TraceControl a)
forall a. Semigroup a => a -> a -> a
<> Tracer m (LoggingContext, Either TraceControl a)
a2)

instance Monad m => Monoid (Trace m a) where
    mappend :: Trace m a -> Trace m a -> Trace m a
mappend = Trace m a -> Trace m a -> Trace m a
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: Trace m a
mempty  = Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
forall (m :: * -> *) a.
Tracer m (LoggingContext, Either TraceControl a) -> Trace m a
Trace Tracer m (LoggingContext, Either TraceControl a)
forall (m :: * -> *) a. Monad m => Tracer m a
T.nullTracer

-- | A unique identifier for every message, composed of text
-- A namespace can as well appear with the tracer name (e.g. "ChainDB.OpenEvent.OpenedDB"),
-- or more prefixes, in this moment it is a NamespaceOuter is used
data Namespace a = Namespace {
    forall a. Namespace a -> [Text]
nsPrefix :: [Text]
  , forall a. Namespace a -> [Text]
nsInner  :: [Text]}
  deriving stock Namespace a -> Namespace a -> Bool
(Namespace a -> Namespace a -> Bool)
-> (Namespace a -> Namespace a -> Bool) -> Eq (Namespace a)
forall a. Namespace a -> Namespace a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Namespace a -> Namespace a -> Bool
== :: Namespace a -> Namespace a -> Bool
$c/= :: forall a. Namespace a -> Namespace a -> Bool
/= :: Namespace a -> Namespace a -> Bool
Eq

instance Show (Namespace a) where
  show :: Namespace a -> String
show (Namespace [] []) = String
"emptyNS"
  show (Namespace [] [Text]
nsInner') =
    Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate (Char -> Text
singleton Char
'.') [Text]
nsInner'
  show (Namespace [Text]
nsPrefix' [Text]
nsInner') =
    Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate (Char -> Text
singleton Char
'.') ([Text]
nsPrefix' [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
nsInner')

nsReplacePrefix :: [Text] -> Namespace a -> Namespace a
nsReplacePrefix :: forall a. [Text] -> Namespace a -> Namespace a
nsReplacePrefix [Text]
o (Namespace [Text]
_ [Text]
i) =  [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
i

nsReplaceInner :: [Text] -> Namespace a -> Namespace a
nsReplaceInner :: forall a. [Text] -> Namespace a -> Namespace a
nsReplaceInner [Text]
i (Namespace [Text]
o [Text]
_) =  [Text] -> [Text] -> Namespace a
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
i


nsPrependInner :: Text -> Namespace a -> Namespace b
nsPrependInner :: forall a b. Text -> Namespace a -> Namespace b
nsPrependInner Text
t (Namespace [Text]
o [Text]
i) =  [Text] -> [Text] -> Namespace b
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o (Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
i)

{-# INLINE nsCast #-}
nsCast :: Namespace a -> Namespace b
nsCast :: forall a b. Namespace a -> Namespace b
nsCast (Namespace [Text]
o [Text]
i) =  [Text] -> [Text] -> Namespace b
forall a. [Text] -> [Text] -> Namespace a
Namespace [Text]
o [Text]
i

nsGetComplete :: Namespace a -> [Text]
nsGetComplete :: forall a. Namespace a -> [Text]
nsGetComplete (Namespace [] [Text]
i) = [Text]
i
nsGetComplete (Namespace [Text]
o [Text]
i)  = [Text]
o [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
i

nsGetTuple :: Namespace a -> ([Text],[Text])
nsGetTuple :: forall a. Namespace a -> ([Text], [Text])
nsGetTuple (Namespace [Text]
o [Text]
i)  = ([Text]
o,[Text]
i)

nsRawToText :: ([Text], [Text]) -> Text
nsRawToText :: ([Text], [Text]) -> Text
nsRawToText ([Text]
ns1, [Text]
ns2) = Text -> [Text] -> Text
intercalate Text
"." ([Text]
ns1 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
ns2)

nsToText :: Namespace a -> Text
nsToText :: forall a. Namespace a -> Text
nsToText (Namespace [Text]
ns1 [Text]
ns2) = Text -> [Text] -> Text
intercalate Text
"." ([Text]
ns1 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
ns2)

-- | Every message needs this to define how to represent itself
class LogFormatting a where
  -- | Machine readable representation with the possibility to represent with varying serialisations based on the detail level.
  -- This will result in JSON formatted log output.
  -- A `forMachine` implementation is required for any instance definition.
  forMachine :: DetailLevel -> a -> AE.Object

  -- | Human-readable representation.
  -- The empty text indicates there's no specific human-readable formatting for that type - this is the default implementation.
  -- If however human-readble output is explicitly requested, e.g. by logs, the system will fall back to a JSON object
  -- conforming to the `forMachine` definition, and rendering it as a value in `{"data": <value>}`.
  -- Leaving out `forHuman` in some instance definition will not lead to loss of log information that way.
  forHuman :: a -> Text
  forHuman a
_v = Text
""

  -- | Metrics representation.
  -- The default indicates that no metric is based on trace occurrences of that type.
  asMetrics :: a -> [Metric]
  asMetrics a
_v = []


class MetaTrace a where
  namespaceFor  :: a -> Namespace a

  severityFor   :: Namespace a -> Maybe a -> Maybe SeverityS
  privacyFor    :: Namespace a -> Maybe a -> Maybe Privacy
  privacyFor Namespace a
_  Maybe a
_ =  Privacy -> Maybe Privacy
forall a. a -> Maybe a
Just Privacy
Public
  detailsFor    :: Namespace a -> Maybe a -> Maybe DetailLevel
  detailsFor Namespace a
_  Maybe a
_ =  DetailLevel -> Maybe DetailLevel
forall a. a -> Maybe a
Just DetailLevel
DNormal

  documentFor   :: Namespace a -> Maybe Text
  metricsDocFor :: Namespace a -> [(Text,Text)]
  metricsDocFor Namespace a
_ = []
  allNamespaces :: [Namespace a]

data Metric
  -- | An integer metric.
  -- Text is used to name the metric
    = IntM Text Integer
  -- | A double metric.
  -- Text is used to name the metric
    | DoubleM Text Double
  -- | A counter metric.
  -- Text is used to name the metric
    | CounterM Text (Maybe Int)
  -- | A prometheus metric with key label pairs.
  -- Text is used to name the metric
  -- [(Text, Text)] is used to represent the key label pairs
  -- The value of the metric will always be "1"
  -- e.g. if you have a prometheus metric with the name "prometheus_metric"
  -- and the key label pairs [("key1", "value1"), ("key2", "value2")]
  -- the metric will be represented as "prometheus_metric{key1=\"value1\",key2=\"value2\"} 1"

    | PrometheusM Text [(Text, Text)]
  deriving stock (Metric -> Metric -> Bool
(Metric -> Metric -> Bool)
-> (Metric -> Metric -> Bool) -> Eq Metric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metric -> Metric -> Bool
== :: Metric -> Metric -> Bool
$c/= :: Metric -> Metric -> Bool
/= :: Metric -> Metric -> Bool
Eq, Int -> Metric -> ShowS
[Metric] -> ShowS
Metric -> String
(Int -> Metric -> ShowS)
-> (Metric -> String) -> ([Metric] -> ShowS) -> Show Metric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metric -> ShowS
showsPrec :: Int -> Metric -> ShowS
$cshow :: Metric -> String
show :: Metric -> String
$cshowList :: [Metric] -> ShowS
showList :: [Metric] -> ShowS
Show)


getMetricName :: Metric -> Text
getMetricName :: Metric -> Text
getMetricName (IntM Text
name Integer
_) = Text
name
getMetricName (DoubleM Text
name Double
_) = Text
name
getMetricName (CounterM Text
name Maybe Int
_) = Text
name
getMetricName (PrometheusM Text
name [(Text, Text)]
_) = Text
name


-- | A helper function for creating an empty |Object|.
emptyObject :: HM.HashMap Text a
emptyObject :: forall a. HashMap Text a
emptyObject = HashMap Text a
forall k v. HashMap k v
HM.empty

-- Document all log messages by providing a list of DocMsgs for all constructors.
-- Because it is not enforced by the type system, it is very
-- important to provide a complete list, as the prototypes are used as well for configuration.
-- If you don't want to add an item for documentation enter an empty text.
newtype Documented a = Documented {forall a. Documented a -> [DocMsg a]
undoc :: [DocMsg a]}
  deriving stock Int -> Documented a -> ShowS
[Documented a] -> ShowS
Documented a -> String
(Int -> Documented a -> ShowS)
-> (Documented a -> String)
-> ([Documented a] -> ShowS)
-> Show (Documented a)
forall a. Int -> Documented a -> ShowS
forall a. [Documented a] -> ShowS
forall a. Documented a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Documented a -> ShowS
showsPrec :: Int -> Documented a -> ShowS
$cshow :: forall a. Documented a -> String
show :: Documented a -> String
$cshowList :: forall a. [Documented a] -> ShowS
showList :: [Documented a] -> ShowS
Show
  deriving newtype NonEmpty (Documented a) -> Documented a
Documented a -> Documented a -> Documented a
(Documented a -> Documented a -> Documented a)
-> (NonEmpty (Documented a) -> Documented a)
-> (forall b. Integral b => b -> Documented a -> Documented a)
-> Semigroup (Documented a)
forall b. Integral b => b -> Documented a -> Documented a
forall a. NonEmpty (Documented a) -> Documented a
forall a. Documented a -> Documented a -> Documented a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> Documented a -> Documented a
$c<> :: forall a. Documented a -> Documented a -> Documented a
<> :: Documented a -> Documented a -> Documented a
$csconcat :: forall a. NonEmpty (Documented a) -> Documented a
sconcat :: NonEmpty (Documented a) -> Documented a
$cstimes :: forall a b. Integral b => b -> Documented a -> Documented a
stimes :: forall b. Integral b => b -> Documented a -> Documented a
Semigroup

-- | Document a message by giving a prototype, its most special name in the namespace
-- and a comment in markdown format
data DocMsg a = DocMsg {
    forall a. DocMsg a -> Namespace a
dmNamespace :: Namespace a
  , forall a. DocMsg a -> [(Text, Text)]
dmMetricsMD :: [(Text, Text)]
  , forall a. DocMsg a -> Text
dmMarkdown  :: Text
}

instance Show (DocMsg a) where
  show :: DocMsg a -> String
show (DocMsg Namespace a
_ [(Text, Text)]
_ Text
md) = Text -> String
unpack Text
md

-- | Context any log message carries
data LoggingContext = LoggingContext {
    LoggingContext -> [Text]
lcNSInner   :: [Text]
  , LoggingContext -> [Text]
lcNSPrefix  :: [Text]
  , LoggingContext -> Maybe SeverityS
lcSeverity  :: Maybe SeverityS
  , LoggingContext -> Maybe Privacy
lcPrivacy   :: Maybe Privacy
  , LoggingContext -> Maybe DetailLevel
lcDetails   :: Maybe DetailLevel
  }
  deriving stock
    (Int -> LoggingContext -> ShowS
[LoggingContext] -> ShowS
LoggingContext -> String
(Int -> LoggingContext -> ShowS)
-> (LoggingContext -> String)
-> ([LoggingContext] -> ShowS)
-> Show LoggingContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoggingContext -> ShowS
showsPrec :: Int -> LoggingContext -> ShowS
$cshow :: LoggingContext -> String
show :: LoggingContext -> String
$cshowList :: [LoggingContext] -> ShowS
showList :: [LoggingContext] -> ShowS
Show, (forall x. LoggingContext -> Rep LoggingContext x)
-> (forall x. Rep LoggingContext x -> LoggingContext)
-> Generic LoggingContext
forall x. Rep LoggingContext x -> LoggingContext
forall x. LoggingContext -> Rep LoggingContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LoggingContext -> Rep LoggingContext x
from :: forall x. LoggingContext -> Rep LoggingContext x
$cto :: forall x. Rep LoggingContext x -> LoggingContext
to :: forall x. Rep LoggingContext x -> LoggingContext
Generic)
  deriving anyclass
    [LoggingContext] -> Encoding
LoggingContext -> Encoding
(LoggingContext -> Encoding)
-> (forall s. Decoder s LoggingContext)
-> ([LoggingContext] -> Encoding)
-> (forall s. Decoder s [LoggingContext])
-> Serialise LoggingContext
forall s. Decoder s [LoggingContext]
forall s. Decoder s LoggingContext
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: LoggingContext -> Encoding
encode :: LoggingContext -> Encoding
$cdecode :: forall s. Decoder s LoggingContext
decode :: forall s. Decoder s LoggingContext
$cencodeList :: [LoggingContext] -> Encoding
encodeList :: [LoggingContext] -> Encoding
$cdecodeList :: forall s. Decoder s [LoggingContext]
decodeList :: forall s. Decoder s [LoggingContext]
Serialise

emptyLoggingContext :: LoggingContext
emptyLoggingContext :: LoggingContext
emptyLoggingContext = [Text]
-> [Text]
-> Maybe SeverityS
-> Maybe Privacy
-> Maybe DetailLevel
-> LoggingContext
LoggingContext [] [] Maybe SeverityS
forall a. Maybe a
Nothing Maybe Privacy
forall a. Maybe a
Nothing Maybe DetailLevel
forall a. Maybe a
Nothing

-- | Formerly known as verbosity
data DetailLevel =
      DMinimal
    | DNormal
    | DDetailed
    | DMaximum
  deriving stock (DetailLevel -> DetailLevel -> Bool
(DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool) -> Eq DetailLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DetailLevel -> DetailLevel -> Bool
== :: DetailLevel -> DetailLevel -> Bool
$c/= :: DetailLevel -> DetailLevel -> Bool
/= :: DetailLevel -> DetailLevel -> Bool
Eq, Eq DetailLevel
Eq DetailLevel =>
(DetailLevel -> DetailLevel -> Ordering)
-> (DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> DetailLevel)
-> (DetailLevel -> DetailLevel -> DetailLevel)
-> Ord DetailLevel
DetailLevel -> DetailLevel -> Bool
DetailLevel -> DetailLevel -> Ordering
DetailLevel -> DetailLevel -> DetailLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DetailLevel -> DetailLevel -> Ordering
compare :: DetailLevel -> DetailLevel -> Ordering
$c< :: DetailLevel -> DetailLevel -> Bool
< :: DetailLevel -> DetailLevel -> Bool
$c<= :: DetailLevel -> DetailLevel -> Bool
<= :: DetailLevel -> DetailLevel -> Bool
$c> :: DetailLevel -> DetailLevel -> Bool
> :: DetailLevel -> DetailLevel -> Bool
$c>= :: DetailLevel -> DetailLevel -> Bool
>= :: DetailLevel -> DetailLevel -> Bool
$cmax :: DetailLevel -> DetailLevel -> DetailLevel
max :: DetailLevel -> DetailLevel -> DetailLevel
$cmin :: DetailLevel -> DetailLevel -> DetailLevel
min :: DetailLevel -> DetailLevel -> DetailLevel
Ord, Int -> DetailLevel -> ShowS
[DetailLevel] -> ShowS
DetailLevel -> String
(Int -> DetailLevel -> ShowS)
-> (DetailLevel -> String)
-> ([DetailLevel] -> ShowS)
-> Show DetailLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DetailLevel -> ShowS
showsPrec :: Int -> DetailLevel -> ShowS
$cshow :: DetailLevel -> String
show :: DetailLevel -> String
$cshowList :: [DetailLevel] -> ShowS
showList :: [DetailLevel] -> ShowS
Show, Int -> DetailLevel
DetailLevel -> Int
DetailLevel -> [DetailLevel]
DetailLevel -> DetailLevel
DetailLevel -> DetailLevel -> [DetailLevel]
DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel]
(DetailLevel -> DetailLevel)
-> (DetailLevel -> DetailLevel)
-> (Int -> DetailLevel)
-> (DetailLevel -> Int)
-> (DetailLevel -> [DetailLevel])
-> (DetailLevel -> DetailLevel -> [DetailLevel])
-> (DetailLevel -> DetailLevel -> [DetailLevel])
-> (DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel])
-> Enum DetailLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DetailLevel -> DetailLevel
succ :: DetailLevel -> DetailLevel
$cpred :: DetailLevel -> DetailLevel
pred :: DetailLevel -> DetailLevel
$ctoEnum :: Int -> DetailLevel
toEnum :: Int -> DetailLevel
$cfromEnum :: DetailLevel -> Int
fromEnum :: DetailLevel -> Int
$cenumFrom :: DetailLevel -> [DetailLevel]
enumFrom :: DetailLevel -> [DetailLevel]
$cenumFromThen :: DetailLevel -> DetailLevel -> [DetailLevel]
enumFromThen :: DetailLevel -> DetailLevel -> [DetailLevel]
$cenumFromTo :: DetailLevel -> DetailLevel -> [DetailLevel]
enumFromTo :: DetailLevel -> DetailLevel -> [DetailLevel]
$cenumFromThenTo :: DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel]
enumFromThenTo :: DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel]
Enum, DetailLevel
DetailLevel -> DetailLevel -> Bounded DetailLevel
forall a. a -> a -> Bounded a
$cminBound :: DetailLevel
minBound :: DetailLevel
$cmaxBound :: DetailLevel
maxBound :: DetailLevel
Bounded, (forall x. DetailLevel -> Rep DetailLevel x)
-> (forall x. Rep DetailLevel x -> DetailLevel)
-> Generic DetailLevel
forall x. Rep DetailLevel x -> DetailLevel
forall x. DetailLevel -> Rep DetailLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DetailLevel -> Rep DetailLevel x
from :: forall x. DetailLevel -> Rep DetailLevel x
$cto :: forall x. Rep DetailLevel x -> DetailLevel
to :: forall x. Rep DetailLevel x -> DetailLevel
Generic)
  deriving anyclass ([DetailLevel] -> Encoding
DetailLevel -> Encoding
(DetailLevel -> Encoding)
-> (forall s. Decoder s DetailLevel)
-> ([DetailLevel] -> Encoding)
-> (forall s. Decoder s [DetailLevel])
-> Serialise DetailLevel
forall s. Decoder s [DetailLevel]
forall s. Decoder s DetailLevel
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: DetailLevel -> Encoding
encode :: DetailLevel -> Encoding
$cdecode :: forall s. Decoder s DetailLevel
decode :: forall s. Decoder s DetailLevel
$cencodeList :: [DetailLevel] -> Encoding
encodeList :: [DetailLevel] -> Encoding
$cdecodeList :: forall s. Decoder s [DetailLevel]
decodeList :: forall s. Decoder s [DetailLevel]
Serialise, Maybe DetailLevel
Value -> Parser [DetailLevel]
Value -> Parser DetailLevel
(Value -> Parser DetailLevel)
-> (Value -> Parser [DetailLevel])
-> Maybe DetailLevel
-> FromJSON DetailLevel
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DetailLevel
parseJSON :: Value -> Parser DetailLevel
$cparseJSONList :: Value -> Parser [DetailLevel]
parseJSONList :: Value -> Parser [DetailLevel]
$comittedField :: Maybe DetailLevel
omittedField :: Maybe DetailLevel
AE.FromJSON)

instance AE.ToJSON DetailLevel where
    toEncoding :: DetailLevel -> Encoding
toEncoding = Options -> DetailLevel -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
AE.genericToEncoding Options
AE.defaultOptions

-- | Privacy of a message. Default is Public
data Privacy =
      Confidential              -- ^ confidential information - handle with care
    | Public                    -- ^ can be public.
  deriving stock (Privacy -> Privacy -> Bool
(Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool) -> Eq Privacy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Privacy -> Privacy -> Bool
== :: Privacy -> Privacy -> Bool
$c/= :: Privacy -> Privacy -> Bool
/= :: Privacy -> Privacy -> Bool
Eq, Eq Privacy
Eq Privacy =>
(Privacy -> Privacy -> Ordering)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Bool)
-> (Privacy -> Privacy -> Privacy)
-> (Privacy -> Privacy -> Privacy)
-> Ord Privacy
Privacy -> Privacy -> Bool
Privacy -> Privacy -> Ordering
Privacy -> Privacy -> Privacy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Privacy -> Privacy -> Ordering
compare :: Privacy -> Privacy -> Ordering
$c< :: Privacy -> Privacy -> Bool
< :: Privacy -> Privacy -> Bool
$c<= :: Privacy -> Privacy -> Bool
<= :: Privacy -> Privacy -> Bool
$c> :: Privacy -> Privacy -> Bool
> :: Privacy -> Privacy -> Bool
$c>= :: Privacy -> Privacy -> Bool
>= :: Privacy -> Privacy -> Bool
$cmax :: Privacy -> Privacy -> Privacy
max :: Privacy -> Privacy -> Privacy
$cmin :: Privacy -> Privacy -> Privacy
min :: Privacy -> Privacy -> Privacy
Ord, Int -> Privacy -> ShowS
[Privacy] -> ShowS
Privacy -> String
(Int -> Privacy -> ShowS)
-> (Privacy -> String) -> ([Privacy] -> ShowS) -> Show Privacy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Privacy -> ShowS
showsPrec :: Int -> Privacy -> ShowS
$cshow :: Privacy -> String
show :: Privacy -> String
$cshowList :: [Privacy] -> ShowS
showList :: [Privacy] -> ShowS
Show, Int -> Privacy
Privacy -> Int
Privacy -> [Privacy]
Privacy -> Privacy
Privacy -> Privacy -> [Privacy]
Privacy -> Privacy -> Privacy -> [Privacy]
(Privacy -> Privacy)
-> (Privacy -> Privacy)
-> (Int -> Privacy)
-> (Privacy -> Int)
-> (Privacy -> [Privacy])
-> (Privacy -> Privacy -> [Privacy])
-> (Privacy -> Privacy -> [Privacy])
-> (Privacy -> Privacy -> Privacy -> [Privacy])
-> Enum Privacy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Privacy -> Privacy
succ :: Privacy -> Privacy
$cpred :: Privacy -> Privacy
pred :: Privacy -> Privacy
$ctoEnum :: Int -> Privacy
toEnum :: Int -> Privacy
$cfromEnum :: Privacy -> Int
fromEnum :: Privacy -> Int
$cenumFrom :: Privacy -> [Privacy]
enumFrom :: Privacy -> [Privacy]
$cenumFromThen :: Privacy -> Privacy -> [Privacy]
enumFromThen :: Privacy -> Privacy -> [Privacy]
$cenumFromTo :: Privacy -> Privacy -> [Privacy]
enumFromTo :: Privacy -> Privacy -> [Privacy]
$cenumFromThenTo :: Privacy -> Privacy -> Privacy -> [Privacy]
enumFromThenTo :: Privacy -> Privacy -> Privacy -> [Privacy]
Enum, Privacy
Privacy -> Privacy -> Bounded Privacy
forall a. a -> a -> Bounded a
$cminBound :: Privacy
minBound :: Privacy
$cmaxBound :: Privacy
maxBound :: Privacy
Bounded, (forall x. Privacy -> Rep Privacy x)
-> (forall x. Rep Privacy x -> Privacy) -> Generic Privacy
forall x. Rep Privacy x -> Privacy
forall x. Privacy -> Rep Privacy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Privacy -> Rep Privacy x
from :: forall x. Privacy -> Rep Privacy x
$cto :: forall x. Rep Privacy x -> Privacy
to :: forall x. Rep Privacy x -> Privacy
Generic)
  deriving anyclass [Privacy] -> Encoding
Privacy -> Encoding
(Privacy -> Encoding)
-> (forall s. Decoder s Privacy)
-> ([Privacy] -> Encoding)
-> (forall s. Decoder s [Privacy])
-> Serialise Privacy
forall s. Decoder s [Privacy]
forall s. Decoder s Privacy
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: Privacy -> Encoding
encode :: Privacy -> Encoding
$cdecode :: forall s. Decoder s Privacy
decode :: forall s. Decoder s Privacy
$cencodeList :: [Privacy] -> Encoding
encodeList :: [Privacy] -> Encoding
$cdecodeList :: forall s. Decoder s [Privacy]
decodeList :: forall s. Decoder s [Privacy]
Serialise

-- | Severity of a message
data SeverityS
    = Debug                   -- ^ Debug messages
    | Info                    -- ^ Information
    | Notice                  -- ^ Normal runtime Conditions
    | Warning                 -- ^ General Warnings
    | Error                   -- ^ General Errors
    | Critical                -- ^ Severe situations
    | Alert                   -- ^ Take immediate action
    | Emergency               -- ^ System is unusable
  deriving stock (SeverityS -> SeverityS -> Bool
(SeverityS -> SeverityS -> Bool)
-> (SeverityS -> SeverityS -> Bool) -> Eq SeverityS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SeverityS -> SeverityS -> Bool
== :: SeverityS -> SeverityS -> Bool
$c/= :: SeverityS -> SeverityS -> Bool
/= :: SeverityS -> SeverityS -> Bool
Eq, Eq SeverityS
Eq SeverityS =>
(SeverityS -> SeverityS -> Ordering)
-> (SeverityS -> SeverityS -> Bool)
-> (SeverityS -> SeverityS -> Bool)
-> (SeverityS -> SeverityS -> Bool)
-> (SeverityS -> SeverityS -> Bool)
-> (SeverityS -> SeverityS -> SeverityS)
-> (SeverityS -> SeverityS -> SeverityS)
-> Ord SeverityS
SeverityS -> SeverityS -> Bool
SeverityS -> SeverityS -> Ordering
SeverityS -> SeverityS -> SeverityS
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SeverityS -> SeverityS -> Ordering
compare :: SeverityS -> SeverityS -> Ordering
$c< :: SeverityS -> SeverityS -> Bool
< :: SeverityS -> SeverityS -> Bool
$c<= :: SeverityS -> SeverityS -> Bool
<= :: SeverityS -> SeverityS -> Bool
$c> :: SeverityS -> SeverityS -> Bool
> :: SeverityS -> SeverityS -> Bool
$c>= :: SeverityS -> SeverityS -> Bool
>= :: SeverityS -> SeverityS -> Bool
$cmax :: SeverityS -> SeverityS -> SeverityS
max :: SeverityS -> SeverityS -> SeverityS
$cmin :: SeverityS -> SeverityS -> SeverityS
min :: SeverityS -> SeverityS -> SeverityS
Ord, Int -> SeverityS -> ShowS
[SeverityS] -> ShowS
SeverityS -> String
(Int -> SeverityS -> ShowS)
-> (SeverityS -> String)
-> ([SeverityS] -> ShowS)
-> Show SeverityS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SeverityS -> ShowS
showsPrec :: Int -> SeverityS -> ShowS
$cshow :: SeverityS -> String
show :: SeverityS -> String
$cshowList :: [SeverityS] -> ShowS
showList :: [SeverityS] -> ShowS
Show, ReadPrec [SeverityS]
ReadPrec SeverityS
Int -> ReadS SeverityS
ReadS [SeverityS]
(Int -> ReadS SeverityS)
-> ReadS [SeverityS]
-> ReadPrec SeverityS
-> ReadPrec [SeverityS]
-> Read SeverityS
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SeverityS
readsPrec :: Int -> ReadS SeverityS
$creadList :: ReadS [SeverityS]
readList :: ReadS [SeverityS]
$creadPrec :: ReadPrec SeverityS
readPrec :: ReadPrec SeverityS
$creadListPrec :: ReadPrec [SeverityS]
readListPrec :: ReadPrec [SeverityS]
Read, Int -> SeverityS
SeverityS -> Int
SeverityS -> [SeverityS]
SeverityS -> SeverityS
SeverityS -> SeverityS -> [SeverityS]
SeverityS -> SeverityS -> SeverityS -> [SeverityS]
(SeverityS -> SeverityS)
-> (SeverityS -> SeverityS)
-> (Int -> SeverityS)
-> (SeverityS -> Int)
-> (SeverityS -> [SeverityS])
-> (SeverityS -> SeverityS -> [SeverityS])
-> (SeverityS -> SeverityS -> [SeverityS])
-> (SeverityS -> SeverityS -> SeverityS -> [SeverityS])
-> Enum SeverityS
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SeverityS -> SeverityS
succ :: SeverityS -> SeverityS
$cpred :: SeverityS -> SeverityS
pred :: SeverityS -> SeverityS
$ctoEnum :: Int -> SeverityS
toEnum :: Int -> SeverityS
$cfromEnum :: SeverityS -> Int
fromEnum :: SeverityS -> Int
$cenumFrom :: SeverityS -> [SeverityS]
enumFrom :: SeverityS -> [SeverityS]
$cenumFromThen :: SeverityS -> SeverityS -> [SeverityS]
enumFromThen :: SeverityS -> SeverityS -> [SeverityS]
$cenumFromTo :: SeverityS -> SeverityS -> [SeverityS]
enumFromTo :: SeverityS -> SeverityS -> [SeverityS]
$cenumFromThenTo :: SeverityS -> SeverityS -> SeverityS -> [SeverityS]
enumFromThenTo :: SeverityS -> SeverityS -> SeverityS -> [SeverityS]
Enum, SeverityS
SeverityS -> SeverityS -> Bounded SeverityS
forall a. a -> a -> Bounded a
$cminBound :: SeverityS
minBound :: SeverityS
$cmaxBound :: SeverityS
maxBound :: SeverityS
Bounded, (forall x. SeverityS -> Rep SeverityS x)
-> (forall x. Rep SeverityS x -> SeverityS) -> Generic SeverityS
forall x. Rep SeverityS x -> SeverityS
forall x. SeverityS -> Rep SeverityS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SeverityS -> Rep SeverityS x
from :: forall x. SeverityS -> Rep SeverityS x
$cto :: forall x. Rep SeverityS x -> SeverityS
to :: forall x. Rep SeverityS x -> SeverityS
Generic)
  deriving anyclass ([SeverityS] -> Value
[SeverityS] -> Encoding
SeverityS -> Bool
SeverityS -> Value
SeverityS -> Encoding
(SeverityS -> Value)
-> (SeverityS -> Encoding)
-> ([SeverityS] -> Value)
-> ([SeverityS] -> Encoding)
-> (SeverityS -> Bool)
-> ToJSON SeverityS
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SeverityS -> Value
toJSON :: SeverityS -> Value
$ctoEncoding :: SeverityS -> Encoding
toEncoding :: SeverityS -> Encoding
$ctoJSONList :: [SeverityS] -> Value
toJSONList :: [SeverityS] -> Value
$ctoEncodingList :: [SeverityS] -> Encoding
toEncodingList :: [SeverityS] -> Encoding
$comitField :: SeverityS -> Bool
omitField :: SeverityS -> Bool
AE.ToJSON, Maybe SeverityS
Value -> Parser [SeverityS]
Value -> Parser SeverityS
(Value -> Parser SeverityS)
-> (Value -> Parser [SeverityS])
-> Maybe SeverityS
-> FromJSON SeverityS
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SeverityS
parseJSON :: Value -> Parser SeverityS
$cparseJSONList :: Value -> Parser [SeverityS]
parseJSONList :: Value -> Parser [SeverityS]
$comittedField :: Maybe SeverityS
omittedField :: Maybe SeverityS
AE.FromJSON, [SeverityS] -> Encoding
SeverityS -> Encoding
(SeverityS -> Encoding)
-> (forall s. Decoder s SeverityS)
-> ([SeverityS] -> Encoding)
-> (forall s. Decoder s [SeverityS])
-> Serialise SeverityS
forall s. Decoder s [SeverityS]
forall s. Decoder s SeverityS
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: SeverityS -> Encoding
encode :: SeverityS -> Encoding
$cdecode :: forall s. Decoder s SeverityS
decode :: forall s. Decoder s SeverityS
$cencodeList :: [SeverityS] -> Encoding
encodeList :: [SeverityS] -> Encoding
$cdecodeList :: forall s. Decoder s [SeverityS]
decodeList :: forall s. Decoder s [SeverityS]
Serialise)

-- | Severity for a filter
-- Nothing means don't show anything (Silence)
-- Nothing level means show messages with severity >= level
newtype SeverityF = SeverityF (Maybe SeverityS)
  deriving stock SeverityF -> SeverityF -> Bool
(SeverityF -> SeverityF -> Bool)
-> (SeverityF -> SeverityF -> Bool) -> Eq SeverityF
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SeverityF -> SeverityF -> Bool
== :: SeverityF -> SeverityF -> Bool
$c/= :: SeverityF -> SeverityF -> Bool
/= :: SeverityF -> SeverityF -> Bool
Eq

instance Enum SeverityF where
  toEnum :: Int -> SeverityF
toEnum Int
8 = Maybe SeverityS -> SeverityF
SeverityF Maybe SeverityS
forall a. Maybe a
Nothing
  toEnum Int
i = Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just (Int -> SeverityS
forall a. Enum a => Int -> a
toEnum Int
i))
  fromEnum :: SeverityF -> Int
fromEnum (SeverityF Maybe SeverityS
Nothing)  = Int
8
  fromEnum (SeverityF (Just SeverityS
s)) = SeverityS -> Int
forall a. Enum a => a -> Int
fromEnum SeverityS
s

instance AE.ToJSON SeverityF where
    toJSON :: SeverityF -> Value
toJSON (SeverityF (Just SeverityS
s)) = Text -> Value
AE.String ((String -> Text
pack (String -> Text) -> (SeverityS -> String) -> SeverityS -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeverityS -> String
forall a. Show a => a -> String
show) SeverityS
s)
    toJSON (SeverityF Maybe SeverityS
Nothing)  = Text -> Value
AE.String Text
"Silence"

instance AE.FromJSON SeverityF where
    parseJSON :: Value -> Parser SeverityF
parseJSON (AE.String Text
"Debug")     = SeverityF -> Parser SeverityF
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Debug))
    parseJSON (AE.String Text
"Info")      = SeverityF -> Parser SeverityF
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Info))
    parseJSON (AE.String Text
"Notice")    = SeverityF -> Parser SeverityF
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Notice))
    parseJSON (AE.String Text
"Warning")   = SeverityF -> Parser SeverityF
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Warning))
    parseJSON (AE.String Text
"Error")     = SeverityF -> Parser SeverityF
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Error))
    parseJSON (AE.String Text
"Critical")  = SeverityF -> Parser SeverityF
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Critical))
    parseJSON (AE.String Text
"Alert")     = SeverityF -> Parser SeverityF
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Alert))
    parseJSON (AE.String Text
"Emergency") = SeverityF -> Parser SeverityF
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SeverityS -> SeverityF
SeverityF (SeverityS -> Maybe SeverityS
forall a. a -> Maybe a
Just SeverityS
Emergency))
    parseJSON (AE.String Text
"Silence")  = SeverityF -> Parser SeverityF
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SeverityS -> SeverityF
SeverityF Maybe SeverityS
forall a. Maybe a
Nothing)
    parseJSON Value
invalid = String -> Parser SeverityF
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SeverityF) -> String -> Parser SeverityF
forall a b. (a -> b) -> a -> b
$ String
"Parsing of filter Severity failed."
                          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Unknown severity: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
invalid

instance Ord SeverityF where
  compare :: SeverityF -> SeverityF -> Ordering
compare (SeverityF (Just SeverityS
s1)) (SeverityF (Just SeverityS
s2)) = SeverityS -> SeverityS -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SeverityS
s1 SeverityS
s2
  compare (SeverityF Maybe SeverityS
Nothing) (SeverityF Maybe SeverityS
Nothing)     = Ordering
EQ
  compare (SeverityF (Just SeverityS
_s1)) (SeverityF Maybe SeverityS
Nothing)  = Ordering
LT
  compare (SeverityF Maybe SeverityS
Nothing) (SeverityF (Just SeverityS
_s2))  = Ordering
GT

instance Show SeverityF where
  show :: SeverityF -> String
show (SeverityF (Just SeverityS
s)) = SeverityS -> String
forall a. Show a => a -> String
show SeverityS
s
  show (SeverityF Maybe SeverityS
Nothing)  = String
"Silence"


----------------------------------------------------------------
-- Configuration

-- |
data ConfigReflection = ConfigReflection {
    ConfigReflection -> IORef (Set [Text])
crSilent          :: IORef (Set [Text])
  , ConfigReflection -> IORef (Set [Text])
crNoMetrics       :: IORef (Set [Text])
  , ConfigReflection -> IORef (Set [Text])
crAllTracers      :: IORef (Set [Text])
  }

emptyConfigReflection :: IO ConfigReflection
emptyConfigReflection :: IO ConfigReflection
emptyConfigReflection  = do
    IORef (Set [Text])
silence     <- Set [Text] -> IO (IORef (Set [Text]))
forall a. a -> IO (IORef a)
newIORef Set [Text]
forall a. Set a
Set.empty
    IORef (Set [Text])
hasMetrics  <- Set [Text] -> IO (IORef (Set [Text]))
forall a. a -> IO (IORef a)
newIORef Set [Text]
forall a. Set a
Set.empty
    IORef (Set [Text])
allTracers  <- Set [Text] -> IO (IORef (Set [Text]))
forall a. a -> IO (IORef a)
newIORef Set [Text]
forall a. Set a
Set.empty
    ConfigReflection -> IO ConfigReflection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConfigReflection -> IO ConfigReflection)
-> ConfigReflection -> IO ConfigReflection
forall a b. (a -> b) -> a -> b
$ IORef (Set [Text])
-> IORef (Set [Text]) -> IORef (Set [Text]) -> ConfigReflection
ConfigReflection IORef (Set [Text])
silence IORef (Set [Text])
hasMetrics IORef (Set [Text])
allTracers

data FormattedMessage =
      FormattedHuman Bool Text
      -- ^ The bool specifies if the formatting includes colours
    | FormattedMachine Text
    | FormattedMetrics [Metric]
    | FormattedForwarder TraceObject
    | FormattedCBOR ByteString
  deriving stock (FormattedMessage -> FormattedMessage -> Bool
(FormattedMessage -> FormattedMessage -> Bool)
-> (FormattedMessage -> FormattedMessage -> Bool)
-> Eq FormattedMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormattedMessage -> FormattedMessage -> Bool
== :: FormattedMessage -> FormattedMessage -> Bool
$c/= :: FormattedMessage -> FormattedMessage -> Bool
/= :: FormattedMessage -> FormattedMessage -> Bool
Eq, Int -> FormattedMessage -> ShowS
[FormattedMessage] -> ShowS
FormattedMessage -> String
(Int -> FormattedMessage -> ShowS)
-> (FormattedMessage -> String)
-> ([FormattedMessage] -> ShowS)
-> Show FormattedMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormattedMessage -> ShowS
showsPrec :: Int -> FormattedMessage -> ShowS
$cshow :: FormattedMessage -> String
show :: FormattedMessage -> String
$cshowList :: [FormattedMessage] -> ShowS
showList :: [FormattedMessage] -> ShowS
Show)


data PreFormatted = PreFormatted {
    PreFormatted -> UTCTime
pfTime              :: !UTCTime
  , PreFormatted -> Text
pfNamespace         :: !Text
  , PreFormatted -> Text
pfThreadId          :: !Text
  , PreFormatted -> Maybe Text
pfForHuman          :: !(Maybe Text)
  , PreFormatted -> Object
pfForMachineObject  :: AE.Object
}

-- | Used as interface object for ForwarderTracer
data TraceObject = TraceObject {
    TraceObject -> Maybe Text
toHuman     :: !(Maybe Text)
  , TraceObject -> Text
toMachine   :: !Text
  , TraceObject -> [Text]
toNamespace :: ![Text]
  , TraceObject -> SeverityS
toSeverity  :: !SeverityS
  , TraceObject -> DetailLevel
toDetails   :: !DetailLevel
  , TraceObject -> UTCTime
toTimestamp :: !UTCTime
  , TraceObject -> Text
toHostname  :: !Text
  , TraceObject -> Text
toThreadId  :: !Text
} deriving stock
    (TraceObject -> TraceObject -> Bool
(TraceObject -> TraceObject -> Bool)
-> (TraceObject -> TraceObject -> Bool) -> Eq TraceObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceObject -> TraceObject -> Bool
== :: TraceObject -> TraceObject -> Bool
$c/= :: TraceObject -> TraceObject -> Bool
/= :: TraceObject -> TraceObject -> Bool
Eq, Int -> TraceObject -> ShowS
[TraceObject] -> ShowS
TraceObject -> String
(Int -> TraceObject -> ShowS)
-> (TraceObject -> String)
-> ([TraceObject] -> ShowS)
-> Show TraceObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceObject -> ShowS
showsPrec :: Int -> TraceObject -> ShowS
$cshow :: TraceObject -> String
show :: TraceObject -> String
$cshowList :: [TraceObject] -> ShowS
showList :: [TraceObject] -> ShowS
Show, (forall x. TraceObject -> Rep TraceObject x)
-> (forall x. Rep TraceObject x -> TraceObject)
-> Generic TraceObject
forall x. Rep TraceObject x -> TraceObject
forall x. TraceObject -> Rep TraceObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceObject -> Rep TraceObject x
from :: forall x. TraceObject -> Rep TraceObject x
$cto :: forall x. Rep TraceObject x -> TraceObject
to :: forall x. Rep TraceObject x -> TraceObject
Generic)
  -- ^ Instances for 'TraceObject' to forward it using 'trace-forward' library.
  deriving anyclass
    ([TraceObject] -> Encoding
TraceObject -> Encoding
(TraceObject -> Encoding)
-> (forall s. Decoder s TraceObject)
-> ([TraceObject] -> Encoding)
-> (forall s. Decoder s [TraceObject])
-> Serialise TraceObject
forall s. Decoder s [TraceObject]
forall s. Decoder s TraceObject
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: TraceObject -> Encoding
encode :: TraceObject -> Encoding
$cdecode :: forall s. Decoder s TraceObject
decode :: forall s. Decoder s TraceObject
$cencodeList :: [TraceObject] -> Encoding
encodeList :: [TraceObject] -> Encoding
$cdecodeList :: forall s. Decoder s [TraceObject]
decodeList :: forall s. Decoder s [TraceObject]
Serialise)

-- |
data BackendConfig =
    Forwarder
  | Stdout FormatLogging
  | EKGBackend
  | DatapointBackend
  | PrometheusSimple Bool (Maybe HostName) PortNumber   -- boolean: drop suffixes like "_int" in exposition; default: False
  deriving stock (BackendConfig -> BackendConfig -> Bool
(BackendConfig -> BackendConfig -> Bool)
-> (BackendConfig -> BackendConfig -> Bool) -> Eq BackendConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackendConfig -> BackendConfig -> Bool
== :: BackendConfig -> BackendConfig -> Bool
$c/= :: BackendConfig -> BackendConfig -> Bool
/= :: BackendConfig -> BackendConfig -> Bool
Eq, Eq BackendConfig
Eq BackendConfig =>
(BackendConfig -> BackendConfig -> Ordering)
-> (BackendConfig -> BackendConfig -> Bool)
-> (BackendConfig -> BackendConfig -> Bool)
-> (BackendConfig -> BackendConfig -> Bool)
-> (BackendConfig -> BackendConfig -> Bool)
-> (BackendConfig -> BackendConfig -> BackendConfig)
-> (BackendConfig -> BackendConfig -> BackendConfig)
-> Ord BackendConfig
BackendConfig -> BackendConfig -> Bool
BackendConfig -> BackendConfig -> Ordering
BackendConfig -> BackendConfig -> BackendConfig
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BackendConfig -> BackendConfig -> Ordering
compare :: BackendConfig -> BackendConfig -> Ordering
$c< :: BackendConfig -> BackendConfig -> Bool
< :: BackendConfig -> BackendConfig -> Bool
$c<= :: BackendConfig -> BackendConfig -> Bool
<= :: BackendConfig -> BackendConfig -> Bool
$c> :: BackendConfig -> BackendConfig -> Bool
> :: BackendConfig -> BackendConfig -> Bool
$c>= :: BackendConfig -> BackendConfig -> Bool
>= :: BackendConfig -> BackendConfig -> Bool
$cmax :: BackendConfig -> BackendConfig -> BackendConfig
max :: BackendConfig -> BackendConfig -> BackendConfig
$cmin :: BackendConfig -> BackendConfig -> BackendConfig
min :: BackendConfig -> BackendConfig -> BackendConfig
Ord, Int -> BackendConfig -> ShowS
[BackendConfig] -> ShowS
BackendConfig -> String
(Int -> BackendConfig -> ShowS)
-> (BackendConfig -> String)
-> ([BackendConfig] -> ShowS)
-> Show BackendConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackendConfig -> ShowS
showsPrec :: Int -> BackendConfig -> ShowS
$cshow :: BackendConfig -> String
show :: BackendConfig -> String
$cshowList :: [BackendConfig] -> ShowS
showList :: [BackendConfig] -> ShowS
Show, (forall x. BackendConfig -> Rep BackendConfig x)
-> (forall x. Rep BackendConfig x -> BackendConfig)
-> Generic BackendConfig
forall x. Rep BackendConfig x -> BackendConfig
forall x. BackendConfig -> Rep BackendConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BackendConfig -> Rep BackendConfig x
from :: forall x. BackendConfig -> Rep BackendConfig x
$cto :: forall x. Rep BackendConfig x -> BackendConfig
to :: forall x. Rep BackendConfig x -> BackendConfig
Generic)

instance AE.ToJSON BackendConfig where
  toJSON :: BackendConfig -> Value
toJSON BackendConfig
Forwarder  = Text -> Value
AE.String Text
"Forwarder"
  toJSON BackendConfig
DatapointBackend = Text -> Value
AE.String Text
"DatapointBackend"
  toJSON BackendConfig
EKGBackend = Text -> Value
AE.String Text
"EKGBackend"
  toJSON (Stdout FormatLogging
f) = Text -> Value
AE.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"Stdout " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text)
-> (FormatLogging -> String) -> FormatLogging -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatLogging -> String
forall a. Show a => a -> String
show) FormatLogging
f
  toJSON (PrometheusSimple Bool
s Maybe String
h PortNumber
p) = Text -> Value
AE.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"PrometheusSimple "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
forall a. Monoid a => a
mempty Text
"nosuffix" Bool
s
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) Maybe String
h
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> (PortNumber -> String) -> PortNumber -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortNumber -> String
forall a. Show a => a -> String
show) PortNumber
p

instance AE.FromJSON BackendConfig where
  parseJSON :: Value -> Parser BackendConfig
parseJSON = String
-> (Text -> Parser BackendConfig) -> Value -> Parser BackendConfig
forall a. String -> (Text -> Parser a) -> Value -> Parser a
AE.withText String
"BackendConfig" ((Text -> Parser BackendConfig) -> Value -> Parser BackendConfig)
-> (Text -> Parser BackendConfig) -> Value -> Parser BackendConfig
forall a b. (a -> b) -> a -> b
$ \case
    Text
"Forwarder"                     -> BackendConfig -> Parser BackendConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackendConfig
Forwarder
    Text
"EKGBackend"                    -> BackendConfig -> Parser BackendConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackendConfig
EKGBackend
    Text
"DatapointBackend"              -> BackendConfig -> Parser BackendConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BackendConfig
DatapointBackend
    Text
"Stdout HumanFormatColoured"    -> BackendConfig -> Parser BackendConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BackendConfig -> Parser BackendConfig)
-> BackendConfig -> Parser BackendConfig
forall a b. (a -> b) -> a -> b
$ FormatLogging -> BackendConfig
Stdout FormatLogging
HumanFormatColoured
    Text
"Stdout HumanFormatUncoloured"  -> BackendConfig -> Parser BackendConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BackendConfig -> Parser BackendConfig)
-> BackendConfig -> Parser BackendConfig
forall a b. (a -> b) -> a -> b
$ FormatLogging -> BackendConfig
Stdout FormatLogging
HumanFormatUncoloured
    Text
"Stdout MachineFormat"          -> BackendConfig -> Parser BackendConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BackendConfig -> Parser BackendConfig)
-> BackendConfig -> Parser BackendConfig
forall a b. (a -> b) -> a -> b
$ FormatLogging -> BackendConfig
Stdout FormatLogging
MachineFormat
    Text
prometheus                      -> (String -> Parser BackendConfig)
-> (BackendConfig -> Parser BackendConfig)
-> Either String BackendConfig
-> Parser BackendConfig
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser BackendConfig
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail BackendConfig -> Parser BackendConfig
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either String BackendConfig
parsePrometheusString Text
prometheus)

parsePrometheusString :: Text -> Either String BackendConfig
parsePrometheusString :: Text -> Either String BackendConfig
parsePrometheusString Text
t = case Text -> [Text]
T.words Text
t of
  [Text
"PrometheusSimple", Text
portNo_] ->
    Text -> Either String PortNumber
forall {b}. Num b => Text -> Either String b
parsePort Text
portNo_ Either String PortNumber
-> (PortNumber -> Either String BackendConfig)
-> Either String BackendConfig
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BackendConfig -> Either String BackendConfig
forall a b. b -> Either a b
Right (BackendConfig -> Either String BackendConfig)
-> (PortNumber -> BackendConfig)
-> PortNumber
-> Either String BackendConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe String -> PortNumber -> BackendConfig
PrometheusSimple Bool
False Maybe String
forall a. Maybe a
Nothing
  [Text
"PrometheusSimple", Text
arg, Text
portNo_] ->
    Text -> Either String PortNumber
forall {b}. Num b => Text -> Either String b
parsePort Text
portNo_ Either String PortNumber
-> (PortNumber -> Either String BackendConfig)
-> Either String BackendConfig
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BackendConfig -> Either String BackendConfig
forall a b. b -> Either a b
Right (BackendConfig -> Either String BackendConfig)
-> (PortNumber -> BackendConfig)
-> PortNumber
-> Either String BackendConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. if Text -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
validSuffix Text
arg then Bool -> Maybe String -> PortNumber -> BackendConfig
PrometheusSimple (Text -> Bool
isNoSuffix Text
arg) Maybe String
forall a. Maybe a
Nothing else Bool -> Maybe String -> PortNumber -> BackendConfig
PrometheusSimple Bool
False (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
arg)
  [Text
"PrometheusSimple", Text
noSuff, Text
host, Text
portNo_]
    | Text -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
validSuffix Text
noSuff  -> Text -> Either String PortNumber
forall {b}. Num b => Text -> Either String b
parsePort Text
portNo_ Either String PortNumber
-> (PortNumber -> Either String BackendConfig)
-> Either String BackendConfig
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BackendConfig -> Either String BackendConfig
forall a b. b -> Either a b
Right (BackendConfig -> Either String BackendConfig)
-> (PortNumber -> BackendConfig)
-> PortNumber
-> Either String BackendConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe String -> PortNumber -> BackendConfig
PrometheusSimple (Text -> Bool
isNoSuffix Text
noSuff) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
host)
    | Bool
otherwise           -> String -> Either String BackendConfig
forall a b. a -> Either a b
Left (String -> Either String BackendConfig)
-> String -> Either String BackendConfig
forall a b. (a -> b) -> a -> b
$ String
"invalid modifier for PrometheusSimple: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
noSuff
  [Text]
_
    -> String -> Either String BackendConfig
forall a b. a -> Either a b
Left (String -> Either String BackendConfig)
-> String -> Either String BackendConfig
forall a b. (a -> b) -> a -> b
$ String
"unknown backend: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t
  where
    validSuffix :: a -> Bool
validSuffix a
s = a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"suffix" Bool -> Bool -> Bool
|| a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"nosuffix"
    isNoSuffix :: Text -> Bool
isNoSuffix    = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"nosuffix")
    parsePort :: Text -> Either String b
parsePort Text
p = case Reader Word
forall a. Integral a => Reader a
T.decimal Text
p of
      Right (Word
portNo :: Word, Text
rest)
        | Text -> Bool
T.null Text
rest Bool -> Bool -> Bool
&& Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
portNo Bool -> Bool -> Bool
&& Word
portNo Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
65536 -> b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b) -> b -> Either String b
forall a b. (a -> b) -> a -> b
$ Word -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
portNo
      Either String (Word, Text)
_                                               -> Either String b
failure
      where failure :: Either String b
failure = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"invalid PrometheusSimple port: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
p

data FormatLogging =
    HumanFormatColoured
  | HumanFormatUncoloured
  | MachineFormat
  deriving stock (FormatLogging -> FormatLogging -> Bool
(FormatLogging -> FormatLogging -> Bool)
-> (FormatLogging -> FormatLogging -> Bool) -> Eq FormatLogging
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatLogging -> FormatLogging -> Bool
== :: FormatLogging -> FormatLogging -> Bool
$c/= :: FormatLogging -> FormatLogging -> Bool
/= :: FormatLogging -> FormatLogging -> Bool
Eq, Eq FormatLogging
Eq FormatLogging =>
(FormatLogging -> FormatLogging -> Ordering)
-> (FormatLogging -> FormatLogging -> Bool)
-> (FormatLogging -> FormatLogging -> Bool)
-> (FormatLogging -> FormatLogging -> Bool)
-> (FormatLogging -> FormatLogging -> Bool)
-> (FormatLogging -> FormatLogging -> FormatLogging)
-> (FormatLogging -> FormatLogging -> FormatLogging)
-> Ord FormatLogging
FormatLogging -> FormatLogging -> Bool
FormatLogging -> FormatLogging -> Ordering
FormatLogging -> FormatLogging -> FormatLogging
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FormatLogging -> FormatLogging -> Ordering
compare :: FormatLogging -> FormatLogging -> Ordering
$c< :: FormatLogging -> FormatLogging -> Bool
< :: FormatLogging -> FormatLogging -> Bool
$c<= :: FormatLogging -> FormatLogging -> Bool
<= :: FormatLogging -> FormatLogging -> Bool
$c> :: FormatLogging -> FormatLogging -> Bool
> :: FormatLogging -> FormatLogging -> Bool
$c>= :: FormatLogging -> FormatLogging -> Bool
>= :: FormatLogging -> FormatLogging -> Bool
$cmax :: FormatLogging -> FormatLogging -> FormatLogging
max :: FormatLogging -> FormatLogging -> FormatLogging
$cmin :: FormatLogging -> FormatLogging -> FormatLogging
min :: FormatLogging -> FormatLogging -> FormatLogging
Ord, Int -> FormatLogging -> ShowS
[FormatLogging] -> ShowS
FormatLogging -> String
(Int -> FormatLogging -> ShowS)
-> (FormatLogging -> String)
-> ([FormatLogging] -> ShowS)
-> Show FormatLogging
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatLogging -> ShowS
showsPrec :: Int -> FormatLogging -> ShowS
$cshow :: FormatLogging -> String
show :: FormatLogging -> String
$cshowList :: [FormatLogging] -> ShowS
showList :: [FormatLogging] -> ShowS
Show)

-- Configuration options for individual namespace elements
data ConfigOption =
    -- | Severity level for a filter (default is Warning)
    ConfSeverity {ConfigOption -> SeverityF
severity :: SeverityF}
    -- | Detail level (default is DNormal)
  | ConfDetail {ConfigOption -> DetailLevel
detail :: DetailLevel}
  -- | To which backend to pass
  --   Default is [EKGBackend, Forwarder, Stdout MachineFormat]
  | ConfBackend {ConfigOption -> [BackendConfig]
backends :: [BackendConfig]}
  -- | Construct a limiter with limiting to the Double,
  -- which represents frequency in number of messages per second
  | ConfLimiter {ConfigOption -> Double
maxFrequency :: Double}
  deriving stock (ConfigOption -> ConfigOption -> Bool
(ConfigOption -> ConfigOption -> Bool)
-> (ConfigOption -> ConfigOption -> Bool) -> Eq ConfigOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigOption -> ConfigOption -> Bool
== :: ConfigOption -> ConfigOption -> Bool
$c/= :: ConfigOption -> ConfigOption -> Bool
/= :: ConfigOption -> ConfigOption -> Bool
Eq, Eq ConfigOption
Eq ConfigOption =>
(ConfigOption -> ConfigOption -> Ordering)
-> (ConfigOption -> ConfigOption -> Bool)
-> (ConfigOption -> ConfigOption -> Bool)
-> (ConfigOption -> ConfigOption -> Bool)
-> (ConfigOption -> ConfigOption -> Bool)
-> (ConfigOption -> ConfigOption -> ConfigOption)
-> (ConfigOption -> ConfigOption -> ConfigOption)
-> Ord ConfigOption
ConfigOption -> ConfigOption -> Bool
ConfigOption -> ConfigOption -> Ordering
ConfigOption -> ConfigOption -> ConfigOption
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConfigOption -> ConfigOption -> Ordering
compare :: ConfigOption -> ConfigOption -> Ordering
$c< :: ConfigOption -> ConfigOption -> Bool
< :: ConfigOption -> ConfigOption -> Bool
$c<= :: ConfigOption -> ConfigOption -> Bool
<= :: ConfigOption -> ConfigOption -> Bool
$c> :: ConfigOption -> ConfigOption -> Bool
> :: ConfigOption -> ConfigOption -> Bool
$c>= :: ConfigOption -> ConfigOption -> Bool
>= :: ConfigOption -> ConfigOption -> Bool
$cmax :: ConfigOption -> ConfigOption -> ConfigOption
max :: ConfigOption -> ConfigOption -> ConfigOption
$cmin :: ConfigOption -> ConfigOption -> ConfigOption
min :: ConfigOption -> ConfigOption -> ConfigOption
Ord, Int -> ConfigOption -> ShowS
[ConfigOption] -> ShowS
ConfigOption -> String
(Int -> ConfigOption -> ShowS)
-> (ConfigOption -> String)
-> ([ConfigOption] -> ShowS)
-> Show ConfigOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigOption -> ShowS
showsPrec :: Int -> ConfigOption -> ShowS
$cshow :: ConfigOption -> String
show :: ConfigOption -> String
$cshowList :: [ConfigOption] -> ShowS
showList :: [ConfigOption] -> ShowS
Show, (forall x. ConfigOption -> Rep ConfigOption x)
-> (forall x. Rep ConfigOption x -> ConfigOption)
-> Generic ConfigOption
forall x. Rep ConfigOption x -> ConfigOption
forall x. ConfigOption -> Rep ConfigOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConfigOption -> Rep ConfigOption x
from :: forall x. ConfigOption -> Rep ConfigOption x
$cto :: forall x. Rep ConfigOption x -> ConfigOption
to :: forall x. Rep ConfigOption x -> ConfigOption
Generic)

newtype ForwarderAddr
  = LocalSocket FilePath
  deriving stock (ForwarderAddr -> ForwarderAddr -> Bool
(ForwarderAddr -> ForwarderAddr -> Bool)
-> (ForwarderAddr -> ForwarderAddr -> Bool) -> Eq ForwarderAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForwarderAddr -> ForwarderAddr -> Bool
== :: ForwarderAddr -> ForwarderAddr -> Bool
$c/= :: ForwarderAddr -> ForwarderAddr -> Bool
/= :: ForwarderAddr -> ForwarderAddr -> Bool
Eq, Eq ForwarderAddr
Eq ForwarderAddr =>
(ForwarderAddr -> ForwarderAddr -> Ordering)
-> (ForwarderAddr -> ForwarderAddr -> Bool)
-> (ForwarderAddr -> ForwarderAddr -> Bool)
-> (ForwarderAddr -> ForwarderAddr -> Bool)
-> (ForwarderAddr -> ForwarderAddr -> Bool)
-> (ForwarderAddr -> ForwarderAddr -> ForwarderAddr)
-> (ForwarderAddr -> ForwarderAddr -> ForwarderAddr)
-> Ord ForwarderAddr
ForwarderAddr -> ForwarderAddr -> Bool
ForwarderAddr -> ForwarderAddr -> Ordering
ForwarderAddr -> ForwarderAddr -> ForwarderAddr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ForwarderAddr -> ForwarderAddr -> Ordering
compare :: ForwarderAddr -> ForwarderAddr -> Ordering
$c< :: ForwarderAddr -> ForwarderAddr -> Bool
< :: ForwarderAddr -> ForwarderAddr -> Bool
$c<= :: ForwarderAddr -> ForwarderAddr -> Bool
<= :: ForwarderAddr -> ForwarderAddr -> Bool
$c> :: ForwarderAddr -> ForwarderAddr -> Bool
> :: ForwarderAddr -> ForwarderAddr -> Bool
$c>= :: ForwarderAddr -> ForwarderAddr -> Bool
>= :: ForwarderAddr -> ForwarderAddr -> Bool
$cmax :: ForwarderAddr -> ForwarderAddr -> ForwarderAddr
max :: ForwarderAddr -> ForwarderAddr -> ForwarderAddr
$cmin :: ForwarderAddr -> ForwarderAddr -> ForwarderAddr
min :: ForwarderAddr -> ForwarderAddr -> ForwarderAddr
Ord, Int -> ForwarderAddr -> ShowS
[ForwarderAddr] -> ShowS
ForwarderAddr -> String
(Int -> ForwarderAddr -> ShowS)
-> (ForwarderAddr -> String)
-> ([ForwarderAddr] -> ShowS)
-> Show ForwarderAddr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForwarderAddr -> ShowS
showsPrec :: Int -> ForwarderAddr -> ShowS
$cshow :: ForwarderAddr -> String
show :: ForwarderAddr -> String
$cshowList :: [ForwarderAddr] -> ShowS
showList :: [ForwarderAddr] -> ShowS
Show)

instance AE.FromJSON ForwarderAddr where
  parseJSON :: Value -> Parser ForwarderAddr
parseJSON = String
-> (Object -> Parser ForwarderAddr)
-> Value
-> Parser ForwarderAddr
forall a. String -> (Object -> Parser a) -> Value -> Parser a
AE.withObject String
"ForwarderAddr" ((Object -> Parser ForwarderAddr) -> Value -> Parser ForwarderAddr)
-> (Object -> Parser ForwarderAddr)
-> Value
-> Parser ForwarderAddr
forall a b. (a -> b) -> a -> b
$ \Object
o -> String -> ForwarderAddr
LocalSocket (String -> ForwarderAddr) -> Parser String -> Parser ForwarderAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
AE..: Key
"filePath"

data ForwarderMode =
    -- | Forwarder works as a client: it initiates network connection with
    -- 'cardano-tracer' and/or another Haskell acceptor application.
    Initiator
    -- | Forwarder works as a server: it accepts network connection from
    -- 'cardano-tracer' and/or another Haskell acceptor application.
  | Responder
  deriving stock (ForwarderMode -> ForwarderMode -> Bool
(ForwarderMode -> ForwarderMode -> Bool)
-> (ForwarderMode -> ForwarderMode -> Bool) -> Eq ForwarderMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForwarderMode -> ForwarderMode -> Bool
== :: ForwarderMode -> ForwarderMode -> Bool
$c/= :: ForwarderMode -> ForwarderMode -> Bool
/= :: ForwarderMode -> ForwarderMode -> Bool
Eq, Eq ForwarderMode
Eq ForwarderMode =>
(ForwarderMode -> ForwarderMode -> Ordering)
-> (ForwarderMode -> ForwarderMode -> Bool)
-> (ForwarderMode -> ForwarderMode -> Bool)
-> (ForwarderMode -> ForwarderMode -> Bool)
-> (ForwarderMode -> ForwarderMode -> Bool)
-> (ForwarderMode -> ForwarderMode -> ForwarderMode)
-> (ForwarderMode -> ForwarderMode -> ForwarderMode)
-> Ord ForwarderMode
ForwarderMode -> ForwarderMode -> Bool
ForwarderMode -> ForwarderMode -> Ordering
ForwarderMode -> ForwarderMode -> ForwarderMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ForwarderMode -> ForwarderMode -> Ordering
compare :: ForwarderMode -> ForwarderMode -> Ordering
$c< :: ForwarderMode -> ForwarderMode -> Bool
< :: ForwarderMode -> ForwarderMode -> Bool
$c<= :: ForwarderMode -> ForwarderMode -> Bool
<= :: ForwarderMode -> ForwarderMode -> Bool
$c> :: ForwarderMode -> ForwarderMode -> Bool
> :: ForwarderMode -> ForwarderMode -> Bool
$c>= :: ForwarderMode -> ForwarderMode -> Bool
>= :: ForwarderMode -> ForwarderMode -> Bool
$cmax :: ForwarderMode -> ForwarderMode -> ForwarderMode
max :: ForwarderMode -> ForwarderMode -> ForwarderMode
$cmin :: ForwarderMode -> ForwarderMode -> ForwarderMode
min :: ForwarderMode -> ForwarderMode -> ForwarderMode
Ord, Int -> ForwarderMode -> ShowS
[ForwarderMode] -> ShowS
ForwarderMode -> String
(Int -> ForwarderMode -> ShowS)
-> (ForwarderMode -> String)
-> ([ForwarderMode] -> ShowS)
-> Show ForwarderMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForwarderMode -> ShowS
showsPrec :: Int -> ForwarderMode -> ShowS
$cshow :: ForwarderMode -> String
show :: ForwarderMode -> String
$cshowList :: [ForwarderMode] -> ShowS
showList :: [ForwarderMode] -> ShowS
Show, (forall x. ForwarderMode -> Rep ForwarderMode x)
-> (forall x. Rep ForwarderMode x -> ForwarderMode)
-> Generic ForwarderMode
forall x. Rep ForwarderMode x -> ForwarderMode
forall x. ForwarderMode -> Rep ForwarderMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ForwarderMode -> Rep ForwarderMode x
from :: forall x. ForwarderMode -> Rep ForwarderMode x
$cto :: forall x. Rep ForwarderMode x -> ForwarderMode
to :: forall x. Rep ForwarderMode x -> ForwarderMode
Generic)

data Verbosity =
    -- | Maximum verbosity for all tracers in the forwarding protocols.
    Maximum
    -- | Minimum verbosity, the forwarding will work as silently as possible.
  | Minimum
  deriving stock (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
/= :: Verbosity -> Verbosity -> Bool
Eq, Eq Verbosity
Eq Verbosity =>
(Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Verbosity -> Verbosity -> Ordering
compare :: Verbosity -> Verbosity -> Ordering
$c< :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
>= :: Verbosity -> Verbosity -> Bool
$cmax :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
min :: Verbosity -> Verbosity -> Verbosity
Ord, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verbosity -> ShowS
showsPrec :: Int -> Verbosity -> ShowS
$cshow :: Verbosity -> String
show :: Verbosity -> String
$cshowList :: [Verbosity] -> ShowS
showList :: [Verbosity] -> ShowS
Show, (forall x. Verbosity -> Rep Verbosity x)
-> (forall x. Rep Verbosity x -> Verbosity) -> Generic Verbosity
forall x. Rep Verbosity x -> Verbosity
forall x. Verbosity -> Rep Verbosity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Verbosity -> Rep Verbosity x
from :: forall x. Verbosity -> Rep Verbosity x
$cto :: forall x. Rep Verbosity x -> Verbosity
to :: forall x. Rep Verbosity x -> Verbosity
Generic)
  deriving anyclass [Verbosity] -> Value
[Verbosity] -> Encoding
Verbosity -> Bool
Verbosity -> Value
Verbosity -> Encoding
(Verbosity -> Value)
-> (Verbosity -> Encoding)
-> ([Verbosity] -> Value)
-> ([Verbosity] -> Encoding)
-> (Verbosity -> Bool)
-> ToJSON Verbosity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Verbosity -> Value
toJSON :: Verbosity -> Value
$ctoEncoding :: Verbosity -> Encoding
toEncoding :: Verbosity -> Encoding
$ctoJSONList :: [Verbosity] -> Value
toJSONList :: [Verbosity] -> Value
$ctoEncodingList :: [Verbosity] -> Encoding
toEncodingList :: [Verbosity] -> Encoding
$comitField :: Verbosity -> Bool
omitField :: Verbosity -> Bool
AE.ToJSON

instance AE.FromJSON Verbosity where
  parseJSON :: Value -> Parser Verbosity
parseJSON (AE.String Text
"Maximum") = Verbosity -> Parser Verbosity
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Maximum
  parseJSON (AE.String Text
"Minimum") = Verbosity -> Parser Verbosity
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
Minimum
  parseJSON Value
other                 = String -> Parser Verbosity
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Verbosity) -> String -> Parser Verbosity
forall a b. (a -> b) -> a -> b
$ String
"Parsing of Verbosity failed."
                                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Unknown Verbosity: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
other

data TraceOptionForwarder = TraceOptionForwarder {
    TraceOptionForwarder -> Word
tofQueueSize           :: Word
  , TraceOptionForwarder -> Verbosity
tofVerbosity           :: Verbosity
  , TraceOptionForwarder -> Word
tofMaxReconnectDelay   :: Word
} deriving stock (TraceOptionForwarder -> TraceOptionForwarder -> Bool
(TraceOptionForwarder -> TraceOptionForwarder -> Bool)
-> (TraceOptionForwarder -> TraceOptionForwarder -> Bool)
-> Eq TraceOptionForwarder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
== :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
$c/= :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
/= :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
Eq, Eq TraceOptionForwarder
Eq TraceOptionForwarder =>
(TraceOptionForwarder -> TraceOptionForwarder -> Ordering)
-> (TraceOptionForwarder -> TraceOptionForwarder -> Bool)
-> (TraceOptionForwarder -> TraceOptionForwarder -> Bool)
-> (TraceOptionForwarder -> TraceOptionForwarder -> Bool)
-> (TraceOptionForwarder -> TraceOptionForwarder -> Bool)
-> (TraceOptionForwarder
    -> TraceOptionForwarder -> TraceOptionForwarder)
-> (TraceOptionForwarder
    -> TraceOptionForwarder -> TraceOptionForwarder)
-> Ord TraceOptionForwarder
TraceOptionForwarder -> TraceOptionForwarder -> Bool
TraceOptionForwarder -> TraceOptionForwarder -> Ordering
TraceOptionForwarder
-> TraceOptionForwarder -> TraceOptionForwarder
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TraceOptionForwarder -> TraceOptionForwarder -> Ordering
compare :: TraceOptionForwarder -> TraceOptionForwarder -> Ordering
$c< :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
< :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
$c<= :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
<= :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
$c> :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
> :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
$c>= :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
>= :: TraceOptionForwarder -> TraceOptionForwarder -> Bool
$cmax :: TraceOptionForwarder
-> TraceOptionForwarder -> TraceOptionForwarder
max :: TraceOptionForwarder
-> TraceOptionForwarder -> TraceOptionForwarder
$cmin :: TraceOptionForwarder
-> TraceOptionForwarder -> TraceOptionForwarder
min :: TraceOptionForwarder
-> TraceOptionForwarder -> TraceOptionForwarder
Ord, Int -> TraceOptionForwarder -> ShowS
[TraceOptionForwarder] -> ShowS
TraceOptionForwarder -> String
(Int -> TraceOptionForwarder -> ShowS)
-> (TraceOptionForwarder -> String)
-> ([TraceOptionForwarder] -> ShowS)
-> Show TraceOptionForwarder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceOptionForwarder -> ShowS
showsPrec :: Int -> TraceOptionForwarder -> ShowS
$cshow :: TraceOptionForwarder -> String
show :: TraceOptionForwarder -> String
$cshowList :: [TraceOptionForwarder] -> ShowS
showList :: [TraceOptionForwarder] -> ShowS
Show, (forall x. TraceOptionForwarder -> Rep TraceOptionForwarder x)
-> (forall x. Rep TraceOptionForwarder x -> TraceOptionForwarder)
-> Generic TraceOptionForwarder
forall x. Rep TraceOptionForwarder x -> TraceOptionForwarder
forall x. TraceOptionForwarder -> Rep TraceOptionForwarder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceOptionForwarder -> Rep TraceOptionForwarder x
from :: forall x. TraceOptionForwarder -> Rep TraceOptionForwarder x
$cto :: forall x. Rep TraceOptionForwarder x -> TraceOptionForwarder
to :: forall x. Rep TraceOptionForwarder x -> TraceOptionForwarder
Generic)

-- A word regarding queue size:
--
-- In case of a missing forwarding service consumer, traces messages will be
-- buffered. This mitigates short forwarding interruptions, or delays at startup
-- time.
--
-- The queue capacity should thus correlate to the expected log lines per second
-- given a particular tracing configuration - to avoid unnecessarily increasing
-- memory footprint.
--
-- The default values here are chosen to accomodate verbose tracing output
-- (i.e., buffering 1min worth of trace data given ~32 messages per second). A
-- config that results in less than 5 msgs per second should also provide
-- `TraceOptionForwarder` a queue size value considerably lower.
--
-- The queue size ties in with the max number of trace objects cardano-tracer
-- requests periodically, the default for that being 100. Here, the queue can
-- hold enough traces for 10 subsequent polls by cardano-tracer.
instance AE.FromJSON TraceOptionForwarder where
    parseJSON :: Value -> Parser TraceOptionForwarder
parseJSON (AE.Object Object
obj) = do
      -- Field "queueSize" is the new field that replaces and unifies
      -- both "connQueueSize" and "disconnQueueSize".
      Maybe Word
maybeQueueSize <- Object
obj Object -> Key -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
AE..:? Key
"queueSize"
      Word
queueSize <- case Maybe Word
maybeQueueSize of
                     -- If the new field was provided we use it.
                     (Just Word
qs) -> Word -> Parser Word
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Word
qs
                     -- Else we look for the deprectaed fields.
                     Maybe Word
Nothing   -> do
                       -- We keep the same default values.
                       Word
connQueueSize    <- Object
obj Object -> Key -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
AE..:? Key
"connQueueSize"    Parser (Maybe Word) -> Word -> Parser Word
forall a. Parser (Maybe a) -> a -> Parser a
AE..!= Word
1024
                       Word
disconnQueueSize <- Object
obj Object -> Key -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
AE..:? Key
"disconnQueueSize" Parser (Maybe Word) -> Word -> Parser Word
forall a. Parser (Maybe a) -> a -> Parser a
AE..!= Word
2048
                       Word -> Parser Word
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Parser Word) -> Word -> Parser Word
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word
forall a. Ord a => a -> a -> a
max Word
connQueueSize Word
disconnQueueSize
      Verbosity
verbosity         <- Object
obj Object -> Key -> Parser (Maybe Verbosity)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
AE..:? Key
"verbosity"         Parser (Maybe Verbosity) -> Verbosity -> Parser Verbosity
forall a. Parser (Maybe a) -> a -> Parser a
AE..!= Verbosity
Minimum
      Word
maxReconnectDelay <- Object
obj Object -> Key -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
AE..:? Key
"maxReconnectDelay" Parser (Maybe Word) -> Word -> Parser Word
forall a. Parser (Maybe a) -> a -> Parser a
AE..!= Word
60
      TraceOptionForwarder -> Parser TraceOptionForwarder
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TraceOptionForwarder -> Parser TraceOptionForwarder)
-> TraceOptionForwarder -> Parser TraceOptionForwarder
forall a b. (a -> b) -> a -> b
$ Word -> Verbosity -> Word -> TraceOptionForwarder
TraceOptionForwarder Word
queueSize Verbosity
verbosity Word
maxReconnectDelay
    parseJSON Value
_ = Parser TraceOptionForwarder
forall a. Monoid a => a
mempty

instance AE.ToJSON TraceOptionForwarder where
  toJSON :: TraceOptionForwarder -> Value
toJSON TraceOptionForwarder{Word
Verbosity
tofQueueSize :: TraceOptionForwarder -> Word
tofVerbosity :: TraceOptionForwarder -> Verbosity
tofMaxReconnectDelay :: TraceOptionForwarder -> Word
tofQueueSize :: Word
tofVerbosity :: Verbosity
tofMaxReconnectDelay :: Word
..} = [Pair] -> Value
AE.object
    [
      Key
"queueSize"         Key -> Word -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
AE..= Word
tofQueueSize,
      Key
"verbosity"         Key -> Verbosity -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
AE..= Verbosity
tofVerbosity,
      Key
"maxReconnectDelay" Key -> Word -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
AE..= Word
tofMaxReconnectDelay
    ]

defaultForwarder :: TraceOptionForwarder
defaultForwarder :: TraceOptionForwarder
defaultForwarder = TraceOptionForwarder {
    tofQueueSize :: Word
tofQueueSize           = Word
2048
  , tofVerbosity :: Verbosity
tofVerbosity           = Verbosity
Minimum
  , tofMaxReconnectDelay :: Word
tofMaxReconnectDelay   = Word
60
}

instance AE.FromJSON ForwarderMode where
  parseJSON :: Value -> Parser ForwarderMode
parseJSON (AE.String Text
"Initiator") = ForwarderMode -> Parser ForwarderMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForwarderMode
Initiator
  parseJSON (AE.String Text
"Responder") = ForwarderMode -> Parser ForwarderMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForwarderMode
Responder
  parseJSON Value
other                   = String -> Parser ForwarderMode
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ForwarderMode) -> String -> Parser ForwarderMode
forall a b. (a -> b) -> a -> b
$ String
"Parsing of ForwarderMode failed."
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Unknown ForwarderMode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
other

data TraceConfig = TraceConfig {
     -- | Options specific to a certain namespace
    TraceConfig -> Map [Text] [ConfigOption]
tcOptions   :: Map.Map [Text] [ConfigOption]
     -- | Options for the forwarder
  , TraceConfig -> Maybe TraceOptionForwarder
tcForwarder :: Maybe TraceOptionForwarder
    -- | Optional human-readable name of the node.
  , TraceConfig -> Maybe Text
tcNodeName  :: Maybe Text
    -- | Optional prefix for metrics.
  , TraceConfig -> Maybe Text
tcMetricsPrefix :: Maybe Text
    -- | Optional resource trace frequency in milliseconds.
  , TraceConfig -> Maybe Int
tcResourceFrequency :: Maybe Int
    -- | Optional ledger metrics frequency in milliseconds.
  , TraceConfig -> Maybe Int
tcLedgerMetricsFrequency :: Maybe Int
}
  deriving stock (TraceConfig -> TraceConfig -> Bool
(TraceConfig -> TraceConfig -> Bool)
-> (TraceConfig -> TraceConfig -> Bool) -> Eq TraceConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TraceConfig -> TraceConfig -> Bool
== :: TraceConfig -> TraceConfig -> Bool
$c/= :: TraceConfig -> TraceConfig -> Bool
/= :: TraceConfig -> TraceConfig -> Bool
Eq, Eq TraceConfig
Eq TraceConfig =>
(TraceConfig -> TraceConfig -> Ordering)
-> (TraceConfig -> TraceConfig -> Bool)
-> (TraceConfig -> TraceConfig -> Bool)
-> (TraceConfig -> TraceConfig -> Bool)
-> (TraceConfig -> TraceConfig -> Bool)
-> (TraceConfig -> TraceConfig -> TraceConfig)
-> (TraceConfig -> TraceConfig -> TraceConfig)
-> Ord TraceConfig
TraceConfig -> TraceConfig -> Bool
TraceConfig -> TraceConfig -> Ordering
TraceConfig -> TraceConfig -> TraceConfig
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TraceConfig -> TraceConfig -> Ordering
compare :: TraceConfig -> TraceConfig -> Ordering
$c< :: TraceConfig -> TraceConfig -> Bool
< :: TraceConfig -> TraceConfig -> Bool
$c<= :: TraceConfig -> TraceConfig -> Bool
<= :: TraceConfig -> TraceConfig -> Bool
$c> :: TraceConfig -> TraceConfig -> Bool
> :: TraceConfig -> TraceConfig -> Bool
$c>= :: TraceConfig -> TraceConfig -> Bool
>= :: TraceConfig -> TraceConfig -> Bool
$cmax :: TraceConfig -> TraceConfig -> TraceConfig
max :: TraceConfig -> TraceConfig -> TraceConfig
$cmin :: TraceConfig -> TraceConfig -> TraceConfig
min :: TraceConfig -> TraceConfig -> TraceConfig
Ord, Int -> TraceConfig -> ShowS
[TraceConfig] -> ShowS
TraceConfig -> String
(Int -> TraceConfig -> ShowS)
-> (TraceConfig -> String)
-> ([TraceConfig] -> ShowS)
-> Show TraceConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceConfig -> ShowS
showsPrec :: Int -> TraceConfig -> ShowS
$cshow :: TraceConfig -> String
show :: TraceConfig -> String
$cshowList :: [TraceConfig] -> ShowS
showList :: [TraceConfig] -> ShowS
Show)

emptyTraceConfig :: TraceConfig
emptyTraceConfig :: TraceConfig
emptyTraceConfig = TraceConfig {
    tcOptions :: Map [Text] [ConfigOption]
tcOptions = Map [Text] [ConfigOption]
forall k a. Map k a
Map.empty
  , tcForwarder :: Maybe TraceOptionForwarder
tcForwarder = Maybe TraceOptionForwarder
forall a. Maybe a
Nothing
  , tcNodeName :: Maybe Text
tcNodeName = Maybe Text
forall a. Maybe a
Nothing
  , tcMetricsPrefix :: Maybe Text
tcMetricsPrefix = Maybe Text
forall a. Maybe a
Nothing
  , tcResourceFrequency :: Maybe Int
tcResourceFrequency = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5000 -- Every five seconds
  , tcLedgerMetricsFrequency :: Maybe Int
tcLedgerMetricsFrequency = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1 -- Every slot
  }

---------------------------------------------------------------------------
-- Control and Documentation

-- | When configuring a net of tracers, it should be run with Config on all
-- entry points first, and then with TCOptimize. When reconfiguring it needs to
-- run TCReset followed by Config followed by TCOptimize
data TraceControl where
    TCReset       :: TraceControl
    TCConfig      :: TraceConfig -> TraceControl
    TCOptimize    :: ConfigReflection -> TraceControl
    TCDocument    :: Int -> DocCollector -> TraceControl

newtype DocCollector = DocCollector (IORef (Map Int LogDoc))

data LogDoc = LogDoc {
    LogDoc -> Text
ldDoc             :: !Text
  , LogDoc -> Map Text Text
ldMetricsDoc      :: !(Map.Map Text Text)
  , LogDoc -> [([Text], [Text])]
ldNamespace       :: ![([Text],[Text])]
  , LogDoc -> Maybe SeverityS
ldSeverityCoded   :: !(Maybe SeverityS)
  , LogDoc -> Maybe Privacy
ldPrivacyCoded    :: !(Maybe Privacy)
  , LogDoc -> Maybe DetailLevel
ldDetailsCoded    :: !(Maybe DetailLevel)
  , LogDoc -> [DetailLevel]
ldDetails         :: ![DetailLevel]
  , LogDoc -> [BackendConfig]
ldBackends        :: ![BackendConfig]
  , LogDoc -> [SeverityF]
ldFiltered        :: ![SeverityF]
  , LogDoc -> [(Text, Double)]
ldLimiter         :: ![(Text, Double)]
  , LogDoc -> Bool
ldSilent          :: Bool
} deriving stock (LogDoc -> LogDoc -> Bool
(LogDoc -> LogDoc -> Bool)
-> (LogDoc -> LogDoc -> Bool) -> Eq LogDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogDoc -> LogDoc -> Bool
== :: LogDoc -> LogDoc -> Bool
$c/= :: LogDoc -> LogDoc -> Bool
/= :: LogDoc -> LogDoc -> Bool
Eq, Int -> LogDoc -> ShowS
[LogDoc] -> ShowS
LogDoc -> String
(Int -> LogDoc -> ShowS)
-> (LogDoc -> String) -> ([LogDoc] -> ShowS) -> Show LogDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogDoc -> ShowS
showsPrec :: Int -> LogDoc -> ShowS
$cshow :: LogDoc -> String
show :: LogDoc -> String
$cshowList :: [LogDoc] -> ShowS
showList :: [LogDoc] -> ShowS
Show)

emptyLogDoc :: Text -> [(Text, Text)] -> LogDoc
emptyLogDoc :: Text -> [(Text, Text)] -> LogDoc
emptyLogDoc Text
d [(Text, Text)]
m = Text
-> Map Text Text
-> [([Text], [Text])]
-> Maybe SeverityS
-> Maybe Privacy
-> Maybe DetailLevel
-> [DetailLevel]
-> [BackendConfig]
-> [SeverityF]
-> [(Text, Double)]
-> Bool
-> LogDoc
LogDoc Text
d ([(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
m) [] Maybe SeverityS
forall a. Maybe a
Nothing Maybe Privacy
forall a. Maybe a
Nothing Maybe DetailLevel
forall a. Maybe a
Nothing [] [] [] [] Bool
False

-- | Type for the function foldTraceM from module Cardano/Logging/Trace
newtype Folding a b = Folding b

unfold :: Folding a b -> b
unfold :: forall a b. Folding a b -> b
unfold (Folding b
b) = b
b

instance LogFormatting b => LogFormatting (Folding a b) where
  forMachine :: DetailLevel -> Folding a b -> Object
forMachine DetailLevel
v (Folding b
b) =  DetailLevel -> b -> Object
forall a. LogFormatting a => DetailLevel -> a -> Object
forMachine DetailLevel
v b
b
  forHuman :: Folding a b -> Text
forHuman (Folding b
b)     =  b -> Text
forall a. LogFormatting a => a -> Text
forHuman b
b
  asMetrics :: Folding a b -> [Metric]
asMetrics (Folding b
b)    =  b -> [Metric]
forall a. LogFormatting a => a -> [Metric]
asMetrics b
b

-- | Specifies how to connect to the peer.
--
-- Taken from ekg-forward:System.Metrics.Configuration, to avoid dependency.
type Host :: Type
type Host = Text

type Port :: Type
type Port = Word16

type HowToConnect :: Type
data HowToConnect
  = LocalPipe    !FilePath    -- ^ Local pipe (UNIX or Windows).
  | RemoteSocket !Host !Port  -- ^ Remote socket (host and port).
  deriving stock (HowToConnect -> HowToConnect -> Bool
(HowToConnect -> HowToConnect -> Bool)
-> (HowToConnect -> HowToConnect -> Bool) -> Eq HowToConnect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HowToConnect -> HowToConnect -> Bool
== :: HowToConnect -> HowToConnect -> Bool
$c/= :: HowToConnect -> HowToConnect -> Bool
/= :: HowToConnect -> HowToConnect -> Bool
Eq, (forall x. HowToConnect -> Rep HowToConnect x)
-> (forall x. Rep HowToConnect x -> HowToConnect)
-> Generic HowToConnect
forall x. Rep HowToConnect x -> HowToConnect
forall x. HowToConnect -> Rep HowToConnect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HowToConnect -> Rep HowToConnect x
from :: forall x. HowToConnect -> Rep HowToConnect x
$cto :: forall x. Rep HowToConnect x -> HowToConnect
to :: forall x. Rep HowToConnect x -> HowToConnect
Generic)
  deriving anyclass (HowToConnect -> ()
(HowToConnect -> ()) -> NFData HowToConnect
forall a. (a -> ()) -> NFData a
$crnf :: HowToConnect -> ()
rnf :: HowToConnect -> ()
NFData)

instance Show HowToConnect where
  show :: HowToConnect -> String
show = \case
    LocalPipe String
pipe         -> String
pipe
    RemoteSocket Text
host Word16
port -> Text -> String
T.unpack Text
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
port

instance AE.ToJSON HowToConnect where
  toJSON :: HowToConnect -> Value
toJSON     = String -> Value
forall a. ToJSON a => a -> Value
AE.toJSON (String -> Value)
-> (HowToConnect -> String) -> HowToConnect -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HowToConnect -> String
forall a. Show a => a -> String
show
  toEncoding :: HowToConnect -> Encoding
toEncoding = String -> Encoding
forall a. ToJSON a => a -> Encoding
AE.toEncoding (String -> Encoding)
-> (HowToConnect -> String) -> HowToConnect -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HowToConnect -> String
forall a. Show a => a -> String
show

-- first try to host:port, and if that fails revert to parsing any
-- string literal and assume it is a localpipe.
instance AE.FromJSON HowToConnect where
  parseJSON :: Value -> Parser HowToConnect
parseJSON = String
-> (Text -> Parser HowToConnect) -> Value -> Parser HowToConnect
forall a. String -> (Text -> Parser a) -> Value -> Parser a
AE.withText String
"HowToConnect" ((Text -> Parser HowToConnect) -> Value -> Parser HowToConnect)
-> (Text -> Parser HowToConnect) -> Value -> Parser HowToConnect
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        ((Text -> Word16 -> HowToConnect) -> (Text, Word16) -> HowToConnect
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Word16 -> HowToConnect
RemoteSocket ((Text, Word16) -> HowToConnect)
-> Parser (Text, Word16) -> Parser HowToConnect
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser (Text, Word16)
parseHostPort Text
t)
    Parser HowToConnect -> Parser HowToConnect -> Parser HowToConnect
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (        String -> HowToConnect
LocalPipe    (String -> HowToConnect) -> Parser String -> Parser HowToConnect
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser String
parseLocalPipe Text
t)

parseLocalPipe :: Text -> AE.Parser FilePath
parseLocalPipe :: Text -> Parser String
parseLocalPipe Text
t
  | Text -> Bool
T.null Text
t = String -> Parser String
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseLocalPipe: empty Text"
  | Bool
otherwise   = String -> Parser String
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t

parseHostPort :: Text -> AE.Parser (Text, Word16)
parseHostPort :: Text -> Parser (Text, Word16)
parseHostPort Text
t
  | Text -> Bool
T.null Text
t
  = String -> Parser (Text, Word16)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseHostPort: empty Text"
  | Bool
otherwise
  = let
    (Text
host_, Text
portText) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
":" Text
t
    host :: Text
host              = Text -> ((Text, Char) -> Text) -> Maybe (Text, Char) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text, Char) -> Text
forall a b. (a, b) -> a
fst (Text -> Maybe (Text, Char)
T.unsnoc Text
host_)
  in if
    | Text -> Bool
T.null Text
host      -> String -> Parser (Text, Word16)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseHostPort: Empty host or no colon found."
    | Text -> Bool
T.null Text
portText  -> String -> Parser (Text, Word16)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseHostPort: Empty port."
    | Right (Word16
port, Text
remainder) <- Reader Word16
forall a. Integral a => Reader a
T.decimal Text
portText
    , Text -> Bool
T.null Text
remainder
    , Word16
0 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
port, Word16
port Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
65535 -> (Text, Word16) -> Parser (Text, Word16)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
host, Word16
port)
    | Bool
otherwise -> String -> Parser (Text, Word16)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseHostPort: Non-numeric port or value out of range."