{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Logging.Types.TraceMessage
  ( TraceMessage (..)
  ) where

import           Cardano.Logging.Types

import           Codec.CBOR.JSON
import           Codec.Serialise (Serialise (..))
import           Data.Aeson as AE hiding (decode, encode)
import           Data.Text (Text)
import           Data.Time.Clock (UTCTime)


-- | base for a machine readable trace message (JSON or CBOR), with metadata, and enclosed payload data from the trace itself.
data TraceMessage = TraceMessage
  { TraceMessage -> UTCTime
tmsgAt      :: !UTCTime
  , TraceMessage -> Text
tmsgNS      :: !Text
  , TraceMessage -> Object
tmsgData    :: !AE.Object
  , TraceMessage -> SeverityS
tmsgSev     :: !SeverityS
  , TraceMessage -> Text
tmsgThread  :: !Text
  , TraceMessage -> Text
tmsgHost    :: !Text
  }
  deriving Int -> TraceMessage -> ShowS
[TraceMessage] -> ShowS
TraceMessage -> String
(Int -> TraceMessage -> ShowS)
-> (TraceMessage -> String)
-> ([TraceMessage] -> ShowS)
-> Show TraceMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceMessage -> ShowS
showsPrec :: Int -> TraceMessage -> ShowS
$cshow :: TraceMessage -> String
show :: TraceMessage -> String
$cshowList :: [TraceMessage] -> ShowS
showList :: [TraceMessage] -> ShowS
Show

instance Serialise AE.Object where
  encode :: Object -> Encoding
encode = Value -> Encoding
encodeValue (Value -> Encoding) -> (Object -> Value) -> Object -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
Object
  decode :: forall s. Decoder s Object
decode = Bool -> Decoder s Value
forall s. Bool -> Decoder s Value
decodeValue Bool
True Decoder s Value -> (Value -> Decoder s Object) -> Decoder s Object
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Object Object
o -> Object -> Decoder s Object
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
o
    Value
x        -> String -> Decoder s Object
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s Object) -> String -> Decoder s Object
forall a b. (a -> b) -> a -> b
$ String
"decode(TraceMessage): expected JSON object, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
x


-- Serialisations are hand-rolled for higher degree of stability, and making them transparent.
instance Serialise TraceMessage where
  encode :: TraceMessage -> Encoding
encode TraceMessage{Text
UTCTime
Object
SeverityS
tmsgAt :: TraceMessage -> UTCTime
tmsgNS :: TraceMessage -> Text
tmsgData :: TraceMessage -> Object
tmsgSev :: TraceMessage -> SeverityS
tmsgThread :: TraceMessage -> Text
tmsgHost :: TraceMessage -> Text
tmsgAt :: UTCTime
tmsgNS :: Text
tmsgData :: Object
tmsgSev :: SeverityS
tmsgThread :: Text
tmsgHost :: Text
..} =
        UTCTime -> Encoding
forall a. Serialise a => a -> Encoding
encode UTCTime
tmsgAt
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>  Text -> Encoding
forall a. Serialise a => a -> Encoding
encode Text
tmsgNS
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>  SeverityS -> Encoding
forall a. Serialise a => a -> Encoding
encode SeverityS
tmsgSev
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>  Object -> Encoding
forall a. Serialise a => a -> Encoding
encode Object
tmsgData
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>  Text -> Encoding
forall a. Serialise a => a -> Encoding
encode Text
tmsgThread
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>  Text -> Encoding
forall a. Serialise a => a -> Encoding
encode Text
tmsgHost

  decode :: forall s. Decoder s TraceMessage
decode = do
    UTCTime
tmsgAt      <- Decoder s UTCTime
forall s. Decoder s UTCTime
forall a s. Serialise a => Decoder s a
decode
    Text
tmsgNS      <- Decoder s Text
forall s. Decoder s Text
forall a s. Serialise a => Decoder s a
decode
    SeverityS
tmsgSev     <- Decoder s SeverityS
forall s. Decoder s SeverityS
forall a s. Serialise a => Decoder s a
decode
    Object
tmsgData    <- Decoder s Object
forall s. Decoder s Object
forall a s. Serialise a => Decoder s a
decode
    Text
tmsgThread  <- Decoder s Text
forall s. Decoder s Text
forall a s. Serialise a => Decoder s a
decode
    Text
tmsgHost    <- Decoder s Text
forall s. Decoder s Text
forall a s. Serialise a => Decoder s a
decode
    TraceMessage -> Decoder s TraceMessage
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TraceMessage{Text
UTCTime
Object
SeverityS
tmsgAt :: UTCTime
tmsgNS :: Text
tmsgData :: Object
tmsgSev :: SeverityS
tmsgThread :: Text
tmsgHost :: Text
tmsgAt :: UTCTime
tmsgNS :: Text
tmsgSev :: SeverityS
tmsgData :: Object
tmsgThread :: Text
tmsgHost :: Text
..}


instance ToJSON TraceMessage where
  toJSON :: TraceMessage -> Value
toJSON TraceMessage{Text
UTCTime
Object
SeverityS
tmsgAt :: TraceMessage -> UTCTime
tmsgNS :: TraceMessage -> Text
tmsgData :: TraceMessage -> Object
tmsgSev :: TraceMessage -> SeverityS
tmsgThread :: TraceMessage -> Text
tmsgHost :: TraceMessage -> Text
tmsgAt :: UTCTime
tmsgNS :: Text
tmsgData :: Object
tmsgSev :: SeverityS
tmsgThread :: Text
tmsgHost :: Text
..} = [Pair] -> Value
AE.object
    [ Key
"at"      Key -> UTCTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
tmsgAt
    , Key
"ns"      Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tmsgNS
    , Key
"data"    Key -> Object -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Object
tmsgData
    , Key
"sev"     Key -> SeverityS -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SeverityS
tmsgSev
    , Key
"thread"  Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tmsgThread
    , Key
"host"    Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tmsgHost
    ]
  toEncoding :: TraceMessage -> Encoding
toEncoding TraceMessage{Text
UTCTime
Object
SeverityS
tmsgAt :: TraceMessage -> UTCTime
tmsgNS :: TraceMessage -> Text
tmsgData :: TraceMessage -> Object
tmsgSev :: TraceMessage -> SeverityS
tmsgThread :: TraceMessage -> Text
tmsgHost :: TraceMessage -> Text
tmsgAt :: UTCTime
tmsgNS :: Text
tmsgData :: Object
tmsgSev :: SeverityS
tmsgThread :: Text
tmsgHost :: Text
..} = Series -> Encoding
AE.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
       Key
"at"     Key -> UTCTime -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
tmsgAt
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"ns"     Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tmsgNS
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"data"   Key -> Object -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Object
tmsgData
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"sev"    Key -> SeverityS -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SeverityS
tmsgSev
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"thread" Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tmsgThread
    Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"host"   Key -> Text -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
tmsgHost

instance FromJSON TraceMessage where
  parseJSON :: Value -> Parser TraceMessage
parseJSON = String
-> (Object -> Parser TraceMessage) -> Value -> Parser TraceMessage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
AE.withObject String
"TraceMessage" ((Object -> Parser TraceMessage) -> Value -> Parser TraceMessage)
-> (Object -> Parser TraceMessage) -> Value -> Parser TraceMessage
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    UTCTime
tmsgAt      <- Object
v Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"at"
    Text
tmsgNS      <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ns"
    Object
tmsgData    <- Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    SeverityS
tmsgSev     <- Object
v Object -> Key -> Parser SeverityS
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sev"
    Text
tmsgThread  <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"thread"
    Text
tmsgHost    <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"host"
    TraceMessage -> Parser TraceMessage
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TraceMessage{Text
UTCTime
Object
SeverityS
tmsgAt :: UTCTime
tmsgNS :: Text
tmsgData :: Object
tmsgSev :: SeverityS
tmsgThread :: Text
tmsgHost :: Text
tmsgAt :: UTCTime
tmsgNS :: Text
tmsgData :: Object
tmsgSev :: SeverityS
tmsgThread :: Text
tmsgHost :: Text
..}