\subsection{Cardano.BM.Data.LogItem}
\label{code:Cardano.BM.Data.LogItem}

%if style == newcode
\begin{code}
{-# LANGUAGE DefaultSignatures  #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE NumericUnderscores #-}

module Cardano.BM.Data.LogItem
  ( LogObject (..)
  , loType
  , loType2Name
  , loTypeEq
  , LOMeta (..), mkLOMeta
  , LOContent (..)
  , locTypeEq
  , CommandValue (..)
  , LoggerName
  , MonitorAction (..)
  , PrivacyAnnotation (..)
  , PrivacyAndSeverityAnnotated (..)
  , utc2ns
  , mapLogObject
  , mapLOContent
  , loContentEq
  , loname2text
  )
  where

import           Control.Applicative (Alternative ((<|>)))
import           Control.Concurrent (myThreadId)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.Aeson (FromJSON (..), ToJSON (..), Value (..), (.=),
                     (.:), object, withText, withObject)
import           Data.Aeson.Types (Object, Parser)
import           Data.Function (on)
import           Data.List (foldl')
import           Data.Maybe (fromMaybe)
import qualified Data.Text as T
import           Data.Text (Text, pack, stripPrefix)
import           Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import           Data.Time.Clock (UTCTime (..), getCurrentTime)
import           Data.Word (Word64)

import           Cardano.BM.Data.Aggregated (Aggregated (..), Measurable (..))
import           Cardano.BM.Data.BackendKind
import           Cardano.BM.Data.Counter
import           Cardano.BM.Data.Severity

\end{code}
%endif

\subsubsection{LoggerName}\label{code:LoggerName}\index{LoggerName}
A |LoggerName| has currently type |Text|.
\begin{code}
type LoggerName = Text

\end{code}

\subsubsection{Logging of outcomes with |LogObject|}
\label{code:LogObject}\index{LogObject}
\label{code:LOMeta}\index{LOMeta}
\label{code:LOContent}\index{LOContent}

\begin{code}
data LogObject a = LogObject
                     { LogObject a -> LoggerName
loName    :: LoggerName
                     , LogObject a -> LOMeta
loMeta    :: !LOMeta
                     , LogObject a -> LOContent a
loContent :: !(LOContent a)
                     } deriving (Int -> LogObject a -> ShowS
[LogObject a] -> ShowS
LogObject a -> String
(Int -> LogObject a -> ShowS)
-> (LogObject a -> String)
-> ([LogObject a] -> ShowS)
-> Show (LogObject a)
forall a. Show a => Int -> LogObject a -> ShowS
forall a. Show a => [LogObject a] -> ShowS
forall a. Show a => LogObject a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogObject a] -> ShowS
$cshowList :: forall a. Show a => [LogObject a] -> ShowS
show :: LogObject a -> String
$cshow :: forall a. Show a => LogObject a -> String
showsPrec :: Int -> LogObject a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LogObject a -> ShowS
Show, LogObject a -> LogObject a -> Bool
(LogObject a -> LogObject a -> Bool)
-> (LogObject a -> LogObject a -> Bool) -> Eq (LogObject a)
forall a. Eq a => LogObject a -> LogObject a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogObject a -> LogObject a -> Bool
$c/= :: forall a. Eq a => LogObject a -> LogObject a -> Bool
== :: LogObject a -> LogObject a -> Bool
$c== :: forall a. Eq a => LogObject a -> LogObject a -> Bool
Eq)

instance ToJSON a => ToJSON (LogObject a) where
    toJSON :: LogObject a -> Value
toJSON (LogObject LoggerName
_loname LOMeta
_lometa LOContent a
_locontent) =
        [Pair] -> Value
object [ LoggerName
"loname"    LoggerName -> LoggerName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName
_loname
               , LoggerName
"lometa"    LoggerName -> LOMeta -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LOMeta
_lometa
               , LoggerName
"locontent" LoggerName -> LOContent a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LOContent a
_locontent
               ]
instance (FromJSON a) => FromJSON (LogObject a) where
    parseJSON :: Value -> Parser (LogObject a)
parseJSON = String
-> (Object -> Parser (LogObject a))
-> Value
-> Parser (LogObject a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LogObject" ((Object -> Parser (LogObject a)) -> Value -> Parser (LogObject a))
-> (Object -> Parser (LogObject a))
-> Value
-> Parser (LogObject a)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
                    LoggerName -> LOMeta -> LOContent a -> LogObject a
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject (LoggerName -> LOMeta -> LOContent a -> LogObject a)
-> Parser LoggerName
-> Parser (LOMeta -> LOContent a -> LogObject a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"loname"
                              Parser (LOMeta -> LOContent a -> LogObject a)
-> Parser LOMeta -> Parser (LOContent a -> LogObject a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> LoggerName -> Parser LOMeta
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"lometa"
                              Parser (LOContent a -> LogObject a)
-> Parser (LOContent a) -> Parser (LogObject a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> LoggerName -> Parser (LOContent a)
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"locontent"

\end{code}

\label{code:mkLOMeta}\index{mkLOMeta}
Meta data for a |LogObject|.
Text was selected over ThreadId in order to be able to use the logging system
under SimM of ouroboros-network because ThreadId from Control.Concurrent lacks a Read
instance.
\begin{code}
data LOMeta = LOMeta {
                  LOMeta -> UTCTime
tstamp   :: {-# UNPACK #-} !UTCTime
                , LOMeta -> LoggerName
tid      :: {-# UNPACK #-} !Text
                , LOMeta -> LoggerName
hostname :: {-# UNPACK #-} !Text
                , LOMeta -> Severity
severity :: !Severity
                , LOMeta -> PrivacyAnnotation
privacy  :: !PrivacyAnnotation
                }

instance ToJSON LOMeta where
    toJSON :: LOMeta -> Value
toJSON (LOMeta UTCTime
_tstamp LoggerName
_tid LoggerName
_hn Severity
_sev PrivacyAnnotation
_priv) =
        [Pair] -> Value
object [ LoggerName
"tstamp"   LoggerName -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= UTCTime
_tstamp
               , LoggerName
"tid"      LoggerName -> LoggerName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName
_tid
               , LoggerName
"hostname" LoggerName -> LoggerName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName
_hn
               , LoggerName
"severity" LoggerName -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= Severity -> String
forall a. Show a => a -> String
show Severity
_sev
               , LoggerName
"privacy"  LoggerName -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= PrivacyAnnotation -> String
forall a. Show a => a -> String
show PrivacyAnnotation
_priv
               ]
instance FromJSON LOMeta where
    parseJSON :: Value -> Parser LOMeta
parseJSON = String -> (Object -> Parser LOMeta) -> Value -> Parser LOMeta
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LOMeta" ((Object -> Parser LOMeta) -> Value -> Parser LOMeta)
-> (Object -> Parser LOMeta) -> Value -> Parser LOMeta
forall a b. (a -> b) -> a -> b
$ \Object
v ->
                    UTCTime
-> LoggerName
-> LoggerName
-> Severity
-> PrivacyAnnotation
-> LOMeta
LOMeta (UTCTime
 -> LoggerName
 -> LoggerName
 -> Severity
 -> PrivacyAnnotation
 -> LOMeta)
-> Parser UTCTime
-> Parser
     (LoggerName
      -> LoggerName -> Severity -> PrivacyAnnotation -> LOMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser UTCTime
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"tstamp"
                           Parser
  (LoggerName
   -> LoggerName -> Severity -> PrivacyAnnotation -> LOMeta)
-> Parser LoggerName
-> Parser (LoggerName -> Severity -> PrivacyAnnotation -> LOMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"tid"
                           Parser (LoggerName -> Severity -> PrivacyAnnotation -> LOMeta)
-> Parser LoggerName
-> Parser (Severity -> PrivacyAnnotation -> LOMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"hostname"
                           Parser (Severity -> PrivacyAnnotation -> LOMeta)
-> Parser Severity -> Parser (PrivacyAnnotation -> LOMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> LoggerName -> Parser Severity
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"severity"
                           Parser (PrivacyAnnotation -> LOMeta)
-> Parser PrivacyAnnotation -> Parser LOMeta
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> LoggerName -> Parser PrivacyAnnotation
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"privacy"
instance Show LOMeta where
    show :: LOMeta -> String
show (LOMeta UTCTime
tstamp1 LoggerName
tid1 LoggerName
hn1 Severity
_sev1 PrivacyAnnotation
_priv1) =
        String
"LOMeta@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UTCTime -> String
forall a. Show a => a -> String
show UTCTime
tstamp1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" tid=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LoggerName -> String
forall a. Show a => a -> String
show LoggerName
tid1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ if (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ LoggerName -> String
forall a. Show a => a -> String
show LoggerName
hn1) then String
" on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LoggerName -> String
forall a. Show a => a -> String
show LoggerName
hn1 else String
""
instance Eq LOMeta where
    == :: LOMeta -> LOMeta -> Bool
(==) (LOMeta UTCTime
tstamp1 LoggerName
tid1 LoggerName
hn1 Severity
sev1 PrivacyAnnotation
priv1) (LOMeta UTCTime
tstamp2 LoggerName
tid2 LoggerName
hn2 Severity
sev2 PrivacyAnnotation
priv2) =
        UTCTime
tstamp1 UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== UTCTime
tstamp2 Bool -> Bool -> Bool
&& LoggerName
tid1 LoggerName -> LoggerName -> Bool
forall a. Eq a => a -> a -> Bool
== LoggerName
tid2 Bool -> Bool -> Bool
&& LoggerName
hn1 LoggerName -> LoggerName -> Bool
forall a. Eq a => a -> a -> Bool
== LoggerName
hn2 Bool -> Bool -> Bool
&& Severity
sev1 Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
== Severity
sev2 Bool -> Bool -> Bool
&& PrivacyAnnotation
priv1 PrivacyAnnotation -> PrivacyAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== PrivacyAnnotation
priv2

mkLOMeta :: MonadIO m => Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta :: Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
sev PrivacyAnnotation
priv =
    UTCTime
-> LoggerName
-> LoggerName
-> Severity
-> PrivacyAnnotation
-> LOMeta
LOMeta (UTCTime
 -> LoggerName
 -> LoggerName
 -> Severity
 -> PrivacyAnnotation
 -> LOMeta)
-> m UTCTime
-> m (LoggerName
      -> LoggerName -> Severity -> PrivacyAnnotation -> LOMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
           m (LoggerName
   -> LoggerName -> Severity -> PrivacyAnnotation -> LOMeta)
-> m LoggerName
-> m (LoggerName -> Severity -> PrivacyAnnotation -> LOMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ThreadId -> LoggerName
forall a. Show a => a -> LoggerName
cleantid (ThreadId -> LoggerName) -> m ThreadId -> m LoggerName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ThreadId -> m ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ThreadId
myThreadId)
           m (LoggerName -> Severity -> PrivacyAnnotation -> LOMeta)
-> m LoggerName -> m (Severity -> PrivacyAnnotation -> LOMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LoggerName -> m LoggerName
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoggerName
""
           m (Severity -> PrivacyAnnotation -> LOMeta)
-> m Severity -> m (PrivacyAnnotation -> LOMeta)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Severity -> m Severity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Severity
sev
           m (PrivacyAnnotation -> LOMeta) -> m PrivacyAnnotation -> m LOMeta
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PrivacyAnnotation -> m PrivacyAnnotation
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrivacyAnnotation
priv
  where
    cleantid :: a -> LoggerName
cleantid a
threadid = do
        let prefixText :: LoggerName
prefixText = LoggerName
"ThreadId "
            condStripPrefix :: LoggerName -> LoggerName
condStripPrefix LoggerName
s = LoggerName -> Maybe LoggerName -> LoggerName
forall a. a -> Maybe a -> a
fromMaybe LoggerName
s (Maybe LoggerName -> LoggerName) -> Maybe LoggerName -> LoggerName
forall a b. (a -> b) -> a -> b
$ LoggerName -> LoggerName -> Maybe LoggerName
stripPrefix LoggerName
prefixText LoggerName
s
        LoggerName -> LoggerName
condStripPrefix (LoggerName -> LoggerName) -> LoggerName -> LoggerName
forall a b. (a -> b) -> a -> b
$ (String -> LoggerName
pack (String -> LoggerName) -> (a -> String) -> a -> LoggerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) a
threadid

\end{code}

Convert a timestamp to ns since epoch:\label{code:utc2ns}\index{utc2ns}
\begin{code}
utc2ns :: UTCTime -> Word64
utc2ns :: UTCTime -> Word64
utc2ns UTCTime
utctime = Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64)
-> (POSIXTime -> Integer) -> POSIXTime -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Word64) -> POSIXTime -> Word64
forall a b. (a -> b) -> a -> b
$ POSIXTime
1000_000_000 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utctime

\end{code}

\begin{code}
data MonitorAction = MonitorAlert Text
                   | MonitorAlterGlobalSeverity Severity
                   | MonitorAlterSeverity LoggerName Severity
                   deriving (Int -> MonitorAction -> ShowS
[MonitorAction] -> ShowS
MonitorAction -> String
(Int -> MonitorAction -> ShowS)
-> (MonitorAction -> String)
-> ([MonitorAction] -> ShowS)
-> Show MonitorAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MonitorAction] -> ShowS
$cshowList :: [MonitorAction] -> ShowS
show :: MonitorAction -> String
$cshow :: MonitorAction -> String
showsPrec :: Int -> MonitorAction -> ShowS
$cshowsPrec :: Int -> MonitorAction -> ShowS
Show, MonitorAction -> MonitorAction -> Bool
(MonitorAction -> MonitorAction -> Bool)
-> (MonitorAction -> MonitorAction -> Bool) -> Eq MonitorAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorAction -> MonitorAction -> Bool
$c/= :: MonitorAction -> MonitorAction -> Bool
== :: MonitorAction -> MonitorAction -> Bool
$c== :: MonitorAction -> MonitorAction -> Bool
Eq)

instance ToJSON MonitorAction where
    toJSON :: MonitorAction -> Value
toJSON (MonitorAlert LoggerName
m) =
        [Pair] -> Value
object [ LoggerName
"kind"    LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"MonitorAlert"
               , LoggerName
"message" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
forall a. ToJSON a => a -> Value
toJSON LoggerName
m ]
    toJSON (MonitorAlterGlobalSeverity Severity
s) =
        [Pair] -> Value
object [ LoggerName
"kind"     LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"MonitorAlterGlobalSeverity"
               , LoggerName
"severity" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= Severity -> Value
forall a. ToJSON a => a -> Value
toJSON Severity
s ]
    toJSON (MonitorAlterSeverity LoggerName
n Severity
s) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"MonitorAlterSeverity"
               , LoggerName
"name" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
forall a. ToJSON a => a -> Value
toJSON LoggerName
n
               , LoggerName
"severity" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= Severity -> Value
forall a. ToJSON a => a -> Value
toJSON Severity
s ]
instance FromJSON MonitorAction where
    parseJSON :: Value -> Parser MonitorAction
parseJSON = String
-> (Object -> Parser MonitorAction)
-> Value
-> Parser MonitorAction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MonitorAction" ((Object -> Parser MonitorAction) -> Value -> Parser MonitorAction)
-> (Object -> Parser MonitorAction)
-> Value
-> Parser MonitorAction
forall a b. (a -> b) -> a -> b
$ \Object
v ->
                    (Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"kind" :: Parser Text)
                    Parser LoggerName
-> (LoggerName -> Parser MonitorAction) -> Parser MonitorAction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    \case LoggerName
"MonitorAlert" ->
                            LoggerName -> MonitorAction
MonitorAlert (LoggerName -> MonitorAction)
-> Parser LoggerName -> Parser MonitorAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"message"
                          LoggerName
"MonitorAlterGlobalSeverity" ->
                            Severity -> MonitorAction
MonitorAlterGlobalSeverity (Severity -> MonitorAction)
-> Parser Severity -> Parser MonitorAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser Severity
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"severity"
                          LoggerName
"MonitorAlterSeverity" ->
                            LoggerName -> Severity -> MonitorAction
MonitorAlterSeverity (LoggerName -> Severity -> MonitorAction)
-> Parser LoggerName -> Parser (Severity -> MonitorAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"name" Parser (Severity -> MonitorAction)
-> Parser Severity -> Parser MonitorAction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> LoggerName -> Parser Severity
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"severity"
                          LoggerName
_ -> String -> Parser MonitorAction
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown MonitorAction"

\end{code}

\label{code:LogMessage}\index{LogMessage}
\label{code:LogError}\index{LogError}
\label{code:LogValue}\index{LogValue}
\label{code:LogStructured}\index{LogStructured}
\label{code:ObserveOpen}\index{ObserveOpen}
\label{code:ObserveDiff}\index{ObserveDiff}
\label{code:ObserveClose}\index{ObserveClose}
\label{code:AggregatedMessage}\index{AggregatedMessage}
\label{code:MonitoringEffect}\index{MonitoringEffect}
\label{code:Command}\index{Command}
\label{code:KillPill}\index{KillPill}

LogStructured could also be:

\begin{spec}
 forall b . (ToJSON b) => LogStructured b
\end{spec}

Payload of a |LogObject|:
\begin{code}
data LOContent a = LogMessage a
                 | LogError !Text
                 | LogValue !Text !Measurable
                 | LogStructuredText Object Text
                 | LogStructured Object
                 | ObserveOpen !CounterState
                 | ObserveDiff !CounterState
                 | ObserveClose !CounterState
                 | AggregatedMessage [(Text, Aggregated)]
                 | MonitoringEffect !MonitorAction
                 | Command !CommandValue
                 | KillPill
                 deriving (Int -> LOContent a -> ShowS
[LOContent a] -> ShowS
LOContent a -> String
(Int -> LOContent a -> ShowS)
-> (LOContent a -> String)
-> ([LOContent a] -> ShowS)
-> Show (LOContent a)
forall a. Show a => Int -> LOContent a -> ShowS
forall a. Show a => [LOContent a] -> ShowS
forall a. Show a => LOContent a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LOContent a] -> ShowS
$cshowList :: forall a. Show a => [LOContent a] -> ShowS
show :: LOContent a -> String
$cshow :: forall a. Show a => LOContent a -> String
showsPrec :: Int -> LOContent a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LOContent a -> ShowS
Show, LOContent a -> LOContent a -> Bool
(LOContent a -> LOContent a -> Bool)
-> (LOContent a -> LOContent a -> Bool) -> Eq (LOContent a)
forall a. Eq a => LOContent a -> LOContent a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LOContent a -> LOContent a -> Bool
$c/= :: forall a. Eq a => LOContent a -> LOContent a -> Bool
== :: LOContent a -> LOContent a -> Bool
$c== :: forall a. Eq a => LOContent a -> LOContent a -> Bool
Eq)
-- WARNING: update 'locTypeEq' when extending this!

instance ToJSON a => ToJSON (LOContent a) where
    toJSON :: LOContent a -> Value
toJSON (LogMessage a
m) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"LogMessage"
               , LoggerName
"message" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
m]
    toJSON (LogError LoggerName
m) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"LogError"
               , LoggerName
"message" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
forall a. ToJSON a => a -> Value
toJSON LoggerName
m]
    toJSON (LogValue LoggerName
n Measurable
v) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"LogValue"
               , LoggerName
"name" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
forall a. ToJSON a => a -> Value
toJSON LoggerName
n
               , LoggerName
"value" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= Measurable -> Value
forall a. ToJSON a => a -> Value
toJSON Measurable
v]
    toJSON (LogStructured Object
m) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"LogStructured"
               , LoggerName
"data" LoggerName -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= Object
m]
    toJSON (LogStructuredText Object
o LoggerName
t) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"LogStructuredText"
               , LoggerName
"data" LoggerName -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= Object
o
               , LoggerName
"text" LoggerName -> LoggerName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName
t]
    toJSON (ObserveOpen CounterState
c) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"ObserveOpen"
               , LoggerName
"counters" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= CounterState -> Value
forall a. ToJSON a => a -> Value
toJSON CounterState
c]
    toJSON (ObserveDiff CounterState
c) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"ObserveDiff"
               , LoggerName
"counters" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= CounterState -> Value
forall a. ToJSON a => a -> Value
toJSON CounterState
c]
    toJSON (ObserveClose CounterState
c) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"ObserveClose"
               , LoggerName
"counters" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= CounterState -> Value
forall a. ToJSON a => a -> Value
toJSON CounterState
c ]
    toJSON (AggregatedMessage [(LoggerName, Aggregated)]
ps) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"AggregatedMessage"
               , LoggerName
"pairs" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= [(LoggerName, Aggregated)] -> Value
forall a. ToJSON a => a -> Value
toJSON [(LoggerName, Aggregated)]
ps ]
    toJSON (MonitoringEffect MonitorAction
a) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"MonitoringEffect"
               , LoggerName
"action" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= MonitorAction -> Value
forall a. ToJSON a => a -> Value
toJSON MonitorAction
a ]
    toJSON (Command CommandValue
c) =
        [Pair] -> Value
object [ LoggerName
"kind" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"Command"
               , LoggerName
"command" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= CommandValue -> Value
forall a. ToJSON a => a -> Value
toJSON CommandValue
c ]
    toJSON LOContent a
KillPill =
        LoggerName -> Value
String LoggerName
"KillPill"

instance (FromJSON a) => FromJSON (LOContent a) where
    parseJSON :: Value -> Parser (LOContent a)
parseJSON Value
j = String
-> (Object -> Parser (LOContent a))
-> Value
-> Parser (LOContent a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LOContent"
          (\Object
v -> (Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"kind" :: Parser Text)
                  Parser LoggerName
-> (LoggerName -> Parser (LOContent a)) -> Parser (LOContent a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                  \case LoggerName
"LogMessage" -> a -> LOContent a
forall a. a -> LOContent a
LogMessage (a -> LOContent a) -> Parser a -> Parser (LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser a
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"message"
                        LoggerName
"LogError" -> LoggerName -> LOContent a
forall a. LoggerName -> LOContent a
LogError (LoggerName -> LOContent a)
-> Parser LoggerName -> Parser (LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"message"
                        LoggerName
"LogValue" -> LoggerName -> Measurable -> LOContent a
forall a. LoggerName -> Measurable -> LOContent a
LogValue (LoggerName -> Measurable -> LOContent a)
-> Parser LoggerName -> Parser (Measurable -> LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"name" Parser (Measurable -> LOContent a)
-> Parser Measurable -> Parser (LOContent a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> LoggerName -> Parser Measurable
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"value"
                        LoggerName
"LogStructured" -> Object -> LOContent a
forall a. Object -> LOContent a
LogStructured (Object -> LOContent a) -> Parser Object -> Parser (LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser Object
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"data"
                        LoggerName
"LogStructuredText" -> Object -> LoggerName -> LOContent a
forall a. Object -> LoggerName -> LOContent a
LogStructuredText (Object -> LoggerName -> LOContent a)
-> Parser Object -> Parser (LoggerName -> LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser Object
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"data" Parser (LoggerName -> LOContent a)
-> Parser LoggerName -> Parser (LOContent a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"text"
                        LoggerName
"ObserveOpen" -> CounterState -> LOContent a
forall a. CounterState -> LOContent a
ObserveOpen (CounterState -> LOContent a)
-> Parser CounterState -> Parser (LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser CounterState
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"counters"
                        LoggerName
"ObserveDiff" -> CounterState -> LOContent a
forall a. CounterState -> LOContent a
ObserveDiff (CounterState -> LOContent a)
-> Parser CounterState -> Parser (LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser CounterState
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"counters"
                        LoggerName
"ObserveClose" -> CounterState -> LOContent a
forall a. CounterState -> LOContent a
ObserveClose (CounterState -> LOContent a)
-> Parser CounterState -> Parser (LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser CounterState
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"counters"
                        LoggerName
"AggregatedMessage" -> [(LoggerName, Aggregated)] -> LOContent a
forall a. [(LoggerName, Aggregated)] -> LOContent a
AggregatedMessage ([(LoggerName, Aggregated)] -> LOContent a)
-> Parser [(LoggerName, Aggregated)] -> Parser (LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser [(LoggerName, Aggregated)]
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"pairs"
                        LoggerName
"MonitoringEffect" -> MonitorAction -> LOContent a
forall a. MonitorAction -> LOContent a
MonitoringEffect (MonitorAction -> LOContent a)
-> Parser MonitorAction -> Parser (LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser MonitorAction
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"action"
                        LoggerName
"Command" -> CommandValue -> LOContent a
forall a. CommandValue -> LOContent a
Command (CommandValue -> LOContent a)
-> Parser CommandValue -> Parser (LOContent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser CommandValue
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"command"
                        LoggerName
_ -> String -> Parser (LOContent a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown LOContent" )
          Value
j
        Parser (LOContent a)
-> Parser (LOContent a) -> Parser (LOContent a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          String
-> (LoggerName -> Parser (LOContent a))
-> Value
-> Parser (LOContent a)
forall a. String -> (LoggerName -> Parser a) -> Value -> Parser a
withText String
"LOContent"
          (\case LoggerName
"KillPill" -> LOContent a -> Parser (LOContent a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LOContent a
forall a. LOContent a
KillPill
                 LoggerName
_ -> String -> Parser (LOContent a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown LOContent (String)")
          Value
j

loType :: LogObject a -> Text
loType :: LogObject a -> LoggerName
loType (LogObject LoggerName
_ LOMeta
_ LOContent a
content) = LOContent a -> LoggerName
forall a. LOContent a -> LoggerName
loType2Name LOContent a
content

-- Equality between LogObjects based on their log content types.
loTypeEq :: LogObject a -> LogObject a -> Bool
loTypeEq :: LogObject a -> LogObject a -> Bool
loTypeEq = LOContent a -> LOContent a -> Bool
forall a. LOContent a -> LOContent a -> Bool
locTypeEq (LOContent a -> LOContent a -> Bool)
-> (LogObject a -> LOContent a)
-> LogObject a
-> LogObject a
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LogObject a -> LOContent a
forall a. LogObject a -> LOContent a
loContent

locTypeEq :: LOContent a -> LOContent a -> Bool
locTypeEq :: LOContent a -> LOContent a -> Bool
locTypeEq LogMessage{}        LogMessage{}        = Bool
True
locTypeEq LogError{}          LogError{}          = Bool
True
locTypeEq LogValue{}          LogValue{}          = Bool
True
locTypeEq LogStructured{}     LogStructured{}     = Bool
True
locTypeEq ObserveOpen{}       ObserveOpen{}       = Bool
True
locTypeEq ObserveDiff{}       ObserveDiff{}       = Bool
True
locTypeEq ObserveClose{}      ObserveClose{}      = Bool
True
locTypeEq AggregatedMessage{} AggregatedMessage{} = Bool
True
locTypeEq MonitoringEffect{}  MonitoringEffect{}  = Bool
True
locTypeEq Command{}           Command{}           = Bool
True
locTypeEq KillPill{}          KillPill{}          = Bool
True
locTypeEq LOContent a
_ LOContent a
_ = Bool
False

\end{code}

Name of a message content type
\begin{code}
loType2Name :: LOContent a -> Text
loType2Name :: LOContent a -> LoggerName
loType2Name = \case
    LogMessage a
_          -> LoggerName
"LogMessage"
    LogError LoggerName
_            -> LoggerName
"LogError"
    LogValue LoggerName
_ Measurable
_          -> LoggerName
"LogValue"
    LogStructured Object
_       -> LoggerName
"LogStructured"
    LogStructuredText Object
_ LoggerName
_ -> LoggerName
"LogStructuredText"
    ObserveOpen CounterState
_         -> LoggerName
"ObserveOpen"
    ObserveDiff CounterState
_         -> LoggerName
"ObserveDiff"
    ObserveClose CounterState
_        -> LoggerName
"ObserveClose"
    AggregatedMessage [(LoggerName, Aggregated)]
_   -> LoggerName
"AggregatedMessage"
    MonitoringEffect MonitorAction
_    -> LoggerName
"MonitoringEffect"
    Command CommandValue
_             -> LoggerName
"Command"
    LOContent a
KillPill              -> LoggerName
"KillPill"

\end{code}

\label{code:CommandValue}\index{CommandValue}
Backends can enter commands to the trace. Commands will end up in the
|Switchboard|, which will interpret them and take action.
\begin{code}
newtype CommandValue = DumpBufferedTo BackendKind
  deriving (Int -> CommandValue -> ShowS
[CommandValue] -> ShowS
CommandValue -> String
(Int -> CommandValue -> ShowS)
-> (CommandValue -> String)
-> ([CommandValue] -> ShowS)
-> Show CommandValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandValue] -> ShowS
$cshowList :: [CommandValue] -> ShowS
show :: CommandValue -> String
$cshow :: CommandValue -> String
showsPrec :: Int -> CommandValue -> ShowS
$cshowsPrec :: Int -> CommandValue -> ShowS
Show, CommandValue -> CommandValue -> Bool
(CommandValue -> CommandValue -> Bool)
-> (CommandValue -> CommandValue -> Bool) -> Eq CommandValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandValue -> CommandValue -> Bool
$c/= :: CommandValue -> CommandValue -> Bool
== :: CommandValue -> CommandValue -> Bool
$c== :: CommandValue -> CommandValue -> Bool
Eq)

instance ToJSON CommandValue where
    toJSON :: CommandValue -> Value
toJSON (DumpBufferedTo BackendKind
be) =
        [Pair] -> Value
object [ LoggerName
"kind"    LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= LoggerName -> Value
String LoggerName
"DumpBufferedTo"
               , LoggerName
"backend" LoggerName -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => LoggerName -> v -> kv
.= BackendKind -> Value
forall a. ToJSON a => a -> Value
toJSON BackendKind
be ]
instance FromJSON CommandValue where
    parseJSON :: Value -> Parser CommandValue
parseJSON = String
-> (Object -> Parser CommandValue) -> Value -> Parser CommandValue
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CommandValue" ((Object -> Parser CommandValue) -> Value -> Parser CommandValue)
-> (Object -> Parser CommandValue) -> Value -> Parser CommandValue
forall a b. (a -> b) -> a -> b
$ \Object
v ->
                    (Object
v Object -> LoggerName -> Parser LoggerName
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"kind" :: Parser Text)
                    Parser LoggerName
-> (LoggerName -> Parser CommandValue) -> Parser CommandValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    \case LoggerName
"DumpBufferedTo" -> BackendKind -> CommandValue
DumpBufferedTo (BackendKind -> CommandValue)
-> Parser BackendKind -> Parser CommandValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> LoggerName -> Parser BackendKind
forall a. FromJSON a => Object -> LoggerName -> Parser a
.: LoggerName
"backend"
                          LoggerName
_ -> String -> Parser CommandValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown CommandValue"

\end{code}

\subsubsection{Privacy annotation}
\label{code:PrivacyAnnotation}\index{PrivacyAnnotation}
\label{code:Confidential}\index{PrivacyAnnotation!Confidential}
\label{code:Public}\index{PrivacyAnnotation!Public}
\begin{code}
data PrivacyAnnotation =
      Confidential -- confidential information - handle with care
    | Public       -- indifferent - can be public.
    deriving (Int -> PrivacyAnnotation -> ShowS
[PrivacyAnnotation] -> ShowS
PrivacyAnnotation -> String
(Int -> PrivacyAnnotation -> ShowS)
-> (PrivacyAnnotation -> String)
-> ([PrivacyAnnotation] -> ShowS)
-> Show PrivacyAnnotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivacyAnnotation] -> ShowS
$cshowList :: [PrivacyAnnotation] -> ShowS
show :: PrivacyAnnotation -> String
$cshow :: PrivacyAnnotation -> String
showsPrec :: Int -> PrivacyAnnotation -> ShowS
$cshowsPrec :: Int -> PrivacyAnnotation -> ShowS
Show, PrivacyAnnotation -> PrivacyAnnotation -> Bool
(PrivacyAnnotation -> PrivacyAnnotation -> Bool)
-> (PrivacyAnnotation -> PrivacyAnnotation -> Bool)
-> Eq PrivacyAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
$c/= :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
== :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
$c== :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
Eq, Eq PrivacyAnnotation
Eq PrivacyAnnotation
-> (PrivacyAnnotation -> PrivacyAnnotation -> Ordering)
-> (PrivacyAnnotation -> PrivacyAnnotation -> Bool)
-> (PrivacyAnnotation -> PrivacyAnnotation -> Bool)
-> (PrivacyAnnotation -> PrivacyAnnotation -> Bool)
-> (PrivacyAnnotation -> PrivacyAnnotation -> Bool)
-> (PrivacyAnnotation -> PrivacyAnnotation -> PrivacyAnnotation)
-> (PrivacyAnnotation -> PrivacyAnnotation -> PrivacyAnnotation)
-> Ord PrivacyAnnotation
PrivacyAnnotation -> PrivacyAnnotation -> Bool
PrivacyAnnotation -> PrivacyAnnotation -> Ordering
PrivacyAnnotation -> PrivacyAnnotation -> PrivacyAnnotation
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
min :: PrivacyAnnotation -> PrivacyAnnotation -> PrivacyAnnotation
$cmin :: PrivacyAnnotation -> PrivacyAnnotation -> PrivacyAnnotation
max :: PrivacyAnnotation -> PrivacyAnnotation -> PrivacyAnnotation
$cmax :: PrivacyAnnotation -> PrivacyAnnotation -> PrivacyAnnotation
>= :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
$c>= :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
> :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
$c> :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
<= :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
$c<= :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
< :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
$c< :: PrivacyAnnotation -> PrivacyAnnotation -> Bool
compare :: PrivacyAnnotation -> PrivacyAnnotation -> Ordering
$ccompare :: PrivacyAnnotation -> PrivacyAnnotation -> Ordering
$cp1Ord :: Eq PrivacyAnnotation
Ord, Int -> PrivacyAnnotation
PrivacyAnnotation -> Int
PrivacyAnnotation -> [PrivacyAnnotation]
PrivacyAnnotation -> PrivacyAnnotation
PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation]
PrivacyAnnotation
-> PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation]
(PrivacyAnnotation -> PrivacyAnnotation)
-> (PrivacyAnnotation -> PrivacyAnnotation)
-> (Int -> PrivacyAnnotation)
-> (PrivacyAnnotation -> Int)
-> (PrivacyAnnotation -> [PrivacyAnnotation])
-> (PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation])
-> (PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation])
-> (PrivacyAnnotation
    -> PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation])
-> Enum PrivacyAnnotation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PrivacyAnnotation
-> PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation]
$cenumFromThenTo :: PrivacyAnnotation
-> PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation]
enumFromTo :: PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation]
$cenumFromTo :: PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation]
enumFromThen :: PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation]
$cenumFromThen :: PrivacyAnnotation -> PrivacyAnnotation -> [PrivacyAnnotation]
enumFrom :: PrivacyAnnotation -> [PrivacyAnnotation]
$cenumFrom :: PrivacyAnnotation -> [PrivacyAnnotation]
fromEnum :: PrivacyAnnotation -> Int
$cfromEnum :: PrivacyAnnotation -> Int
toEnum :: Int -> PrivacyAnnotation
$ctoEnum :: Int -> PrivacyAnnotation
pred :: PrivacyAnnotation -> PrivacyAnnotation
$cpred :: PrivacyAnnotation -> PrivacyAnnotation
succ :: PrivacyAnnotation -> PrivacyAnnotation
$csucc :: PrivacyAnnotation -> PrivacyAnnotation
Enum, PrivacyAnnotation
PrivacyAnnotation -> PrivacyAnnotation -> Bounded PrivacyAnnotation
forall a. a -> a -> Bounded a
maxBound :: PrivacyAnnotation
$cmaxBound :: PrivacyAnnotation
minBound :: PrivacyAnnotation
$cminBound :: PrivacyAnnotation
Bounded)

instance FromJSON PrivacyAnnotation where
    parseJSON :: Value -> Parser PrivacyAnnotation
parseJSON = String
-> (LoggerName -> Parser PrivacyAnnotation)
-> Value
-> Parser PrivacyAnnotation
forall a. String -> (LoggerName -> Parser a) -> Value -> Parser a
withText String
"PrivacyAnnotation" ((LoggerName -> Parser PrivacyAnnotation)
 -> Value -> Parser PrivacyAnnotation)
-> (LoggerName -> Parser PrivacyAnnotation)
-> Value
-> Parser PrivacyAnnotation
forall a b. (a -> b) -> a -> b
$
                    \case LoggerName
"Confidential" -> PrivacyAnnotation -> Parser PrivacyAnnotation
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrivacyAnnotation
Confidential
                          LoggerName
"Public"       -> PrivacyAnnotation -> Parser PrivacyAnnotation
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrivacyAnnotation
Public
                          LoggerName
_ -> String -> Parser PrivacyAnnotation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown PrivacyAnnotation"

\end{code}

Data structure for annotating the severity and privacy of an object.
\begin{code}
data PrivacyAndSeverityAnnotated a
            = PSA { PrivacyAndSeverityAnnotated a -> Severity
psaSeverity :: !Severity
                  , PrivacyAndSeverityAnnotated a -> PrivacyAnnotation
psaPrivacy  :: !PrivacyAnnotation
                  , PrivacyAndSeverityAnnotated a -> a
psaPayload  :: a
                  }
            deriving (Int -> PrivacyAndSeverityAnnotated a -> ShowS
[PrivacyAndSeverityAnnotated a] -> ShowS
PrivacyAndSeverityAnnotated a -> String
(Int -> PrivacyAndSeverityAnnotated a -> ShowS)
-> (PrivacyAndSeverityAnnotated a -> String)
-> ([PrivacyAndSeverityAnnotated a] -> ShowS)
-> Show (PrivacyAndSeverityAnnotated a)
forall a. Show a => Int -> PrivacyAndSeverityAnnotated a -> ShowS
forall a. Show a => [PrivacyAndSeverityAnnotated a] -> ShowS
forall a. Show a => PrivacyAndSeverityAnnotated a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivacyAndSeverityAnnotated a] -> ShowS
$cshowList :: forall a. Show a => [PrivacyAndSeverityAnnotated a] -> ShowS
show :: PrivacyAndSeverityAnnotated a -> String
$cshow :: forall a. Show a => PrivacyAndSeverityAnnotated a -> String
showsPrec :: Int -> PrivacyAndSeverityAnnotated a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PrivacyAndSeverityAnnotated a -> ShowS
Show)

\end{code}

\subsubsection{Mapping Log Objects}
\label{code:mapLogObject}\index{mapLogObject}
\label{code:mapLOContent}\index{mapLOContent}

This provides a helper function to transform log items. It would often
be used with |contramap|.

\begin{code}
mapLogObject :: (a -> b) -> LogObject a -> LogObject b
mapLogObject :: (a -> b) -> LogObject a -> LogObject b
mapLogObject a -> b
f (LogObject LoggerName
nm LOMeta
me LOContent a
loc) = LoggerName -> LOMeta -> LOContent b -> LogObject b
forall a. LoggerName -> LOMeta -> LOContent a -> LogObject a
LogObject LoggerName
nm LOMeta
me ((a -> b) -> LOContent a -> LOContent b
forall a b. (a -> b) -> LOContent a -> LOContent b
mapLOContent a -> b
f LOContent a
loc)

instance Functor LogObject where
  fmap :: (a -> b) -> LogObject a -> LogObject b
fmap = (a -> b) -> LogObject a -> LogObject b
forall a b. (a -> b) -> LogObject a -> LogObject b
mapLogObject

mapLOContent :: (a -> b) -> LOContent a -> LOContent b
mapLOContent :: (a -> b) -> LOContent a -> LOContent b
mapLOContent a -> b
f = \case
    LogMessage a
msg        -> b -> LOContent b
forall a. a -> LOContent a
LogMessage (a -> b
f a
msg)
    LogError LoggerName
a            -> LoggerName -> LOContent b
forall a. LoggerName -> LOContent a
LogError LoggerName
a
    LogStructured Object
o       -> Object -> LOContent b
forall a. Object -> LOContent a
LogStructured Object
o
    LogStructuredText Object
o LoggerName
m -> Object -> LoggerName -> LOContent b
forall a. Object -> LoggerName -> LOContent a
LogStructuredText Object
o LoggerName
m
    LogValue LoggerName
n Measurable
v          -> LoggerName -> Measurable -> LOContent b
forall a. LoggerName -> Measurable -> LOContent a
LogValue LoggerName
n Measurable
v
    ObserveOpen CounterState
st        -> CounterState -> LOContent b
forall a. CounterState -> LOContent a
ObserveOpen CounterState
st
    ObserveDiff CounterState
st        -> CounterState -> LOContent b
forall a. CounterState -> LOContent a
ObserveDiff CounterState
st
    ObserveClose CounterState
st       -> CounterState -> LOContent b
forall a. CounterState -> LOContent a
ObserveClose CounterState
st
    AggregatedMessage [(LoggerName, Aggregated)]
ag  -> [(LoggerName, Aggregated)] -> LOContent b
forall a. [(LoggerName, Aggregated)] -> LOContent a
AggregatedMessage [(LoggerName, Aggregated)]
ag
    MonitoringEffect MonitorAction
act  -> MonitorAction -> LOContent b
forall a. MonitorAction -> LOContent a
MonitoringEffect MonitorAction
act
    Command CommandValue
v             -> CommandValue -> LOContent b
forall a. CommandValue -> LOContent a
Command CommandValue
v
    LOContent a
KillPill              -> LOContent b
forall a. LOContent a
KillPill

-- Equality between LogObjects based on their log content values.
loContentEq :: Eq a => LogObject a -> LogObject a -> Bool
loContentEq :: LogObject a -> LogObject a -> Bool
loContentEq = LOContent a -> LOContent a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (LOContent a -> LOContent a -> Bool)
-> (LogObject a -> LOContent a)
-> LogObject a
-> LogObject a
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LogObject a -> LOContent a
forall a. LogObject a -> LOContent a
loContent

\end{code}

\subsubsection{Render context name as text}
\label{code:loname2text}\index{loname2text}
\begin{code}
loname2text :: [LoggerName] -> Text
loname2text :: [LoggerName] -> LoggerName
loname2text [LoggerName]
nms = LoggerName -> LoggerName
T.init (LoggerName -> LoggerName) -> LoggerName -> LoggerName
forall a b. (a -> b) -> a -> b
$ (LoggerName -> LoggerName -> LoggerName)
-> LoggerName -> [LoggerName] -> LoggerName
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\LoggerName
el LoggerName
acc -> LoggerName
acc LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
"." LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
el) LoggerName
"" [LoggerName]
nms
\end{code}