\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)
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
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
| 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
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}