{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Core.Telemetry.Structured
( structuredExporter
) where
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TQueue (TQueue, writeTQueue)
import Core.Data.Structures (insertKeyValue)
import Core.Encoding.Json
import Core.Program.Arguments
import Core.Program.Context
import Core.Text.Rope
structuredExporter :: Exporter
structuredExporter :: Exporter
structuredExporter =
Exporter
{ $sel:codenameFrom:Exporter :: Rope
codenameFrom = Rope
"structured"
, $sel:setupConfigFrom:Exporter :: Config -> Config
setupConfigFrom = Config -> Config
setupStructuredConfig
, $sel:setupActionFrom:Exporter :: forall τ. Context τ -> IO Forwarder
setupActionFrom = forall τ. Context τ -> IO Forwarder
setupStructuredAction
}
setupStructuredConfig :: Config -> Config
setupStructuredConfig :: Config -> Config
setupStructuredConfig = forall a. a -> a
id
setupStructuredAction :: Context τ -> IO Forwarder
setupStructuredAction :: forall τ. Context τ -> IO Forwarder
setupStructuredAction Context τ
context = do
let out :: TQueue (Maybe Rope)
out = forall τ. Context τ -> TQueue (Maybe Rope)
outputChannelFrom Context τ
context
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Forwarder
{ $sel:telemetryHandlerFrom:Forwarder :: [Datum] -> IO ()
telemetryHandlerFrom = TQueue (Maybe Rope) -> [Datum] -> IO ()
processStructuredOutput TQueue (Maybe Rope)
out
}
)
convertDatumToJson :: Datum -> JsonValue
convertDatumToJson :: Datum -> JsonValue
convertDatumToJson Datum
datum =
let spani :: Maybe Span
spani = Datum -> Maybe Span
spanIdentifierFrom Datum
datum
trace :: Maybe Trace
trace = Datum -> Maybe Trace
traceIdentifierFrom Datum
datum
parent :: Maybe Span
parent = Datum -> Maybe Span
parentIdentifierFrom Datum
datum
meta0 :: Map JsonKey JsonValue
meta0 = Datum -> Map JsonKey JsonValue
attachedMetadataFrom Datum
datum
meta1 :: Map JsonKey JsonValue
meta1 = forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue JsonKey
"span_name" (Rope -> JsonValue
JsonString (Datum -> Rope
spanNameFrom Datum
datum)) Map JsonKey JsonValue
meta0
meta2 :: Map JsonKey JsonValue
meta2 = case Maybe Span
spani of
Maybe Span
Nothing -> Map JsonKey JsonValue
meta1
Just Span
value -> forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue JsonKey
"span_id" (Rope -> JsonValue
JsonString (Span -> Rope
unSpan Span
value)) Map JsonKey JsonValue
meta1
meta3 :: Map JsonKey JsonValue
meta3 = case Maybe Span
parent of
Maybe Span
Nothing -> Map JsonKey JsonValue
meta2
Just Span
value -> forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue JsonKey
"parent_id" (Rope -> JsonValue
JsonString (Span -> Rope
unSpan Span
value)) Map JsonKey JsonValue
meta2
meta4 :: Map JsonKey JsonValue
meta4 = case Maybe Trace
trace of
Maybe Trace
Nothing -> Map JsonKey JsonValue
meta3
Just Trace
value -> forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue JsonKey
"trace_id" (Rope -> JsonValue
JsonString (Trace -> Rope
unTrace Trace
value)) Map JsonKey JsonValue
meta3
meta5 :: Map JsonKey JsonValue
meta5 = case Datum -> Maybe Rope
serviceNameFrom Datum
datum of
Maybe Rope
Nothing -> Map JsonKey JsonValue
meta4
Just Rope
service -> forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue JsonKey
"service_name" (Rope -> JsonValue
JsonString Rope
service) Map JsonKey JsonValue
meta4
meta6 :: Map JsonKey JsonValue
meta6 = case Datum -> Maybe Int64
durationFrom Datum
datum of
Maybe Int64
Nothing -> Map JsonKey JsonValue
meta5
Just Int64
duration ->
forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue
JsonKey
"duration"
(Scientific -> JsonValue
JsonNumber (forall a. Fractional a => Rational -> a
fromRational (forall a. Real a => a -> Rational
toRational Int64
duration forall a. Fractional a => a -> a -> a
/ Rational
1e9)))
Map JsonKey JsonValue
meta5
time :: Rope
time = forall α. Textual α => α -> Rope
intoRope (forall a. Show a => a -> String
show (Datum -> Time
spanTimeFrom Datum
datum))
meta7 :: Map JsonKey JsonValue
meta7 = forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue JsonKey
"timestamp" (Rope -> JsonValue
JsonString Rope
time) Map JsonKey JsonValue
meta6
in Map JsonKey JsonValue -> JsonValue
JsonObject Map JsonKey JsonValue
meta7
processStructuredOutput :: TQueue (Maybe Rope) -> [Datum] -> IO ()
processStructuredOutput :: TQueue (Maybe Rope) -> [Datum] -> IO ()
processStructuredOutput TQueue (Maybe Rope)
out [Datum]
datums = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Datum -> IO ()
processOne [Datum]
datums
where
processOne :: Datum -> IO ()
processOne :: Datum -> IO ()
processOne Datum
datum = do
let object :: JsonValue
object = Datum -> JsonValue
convertDatumToJson Datum
datum
text :: Rope
text = forall α. Textual α => α -> Rope
intoRope (JsonValue -> Bytes
encodeToUTF8 JsonValue
object)
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Maybe Rope)
out (forall a. a -> Maybe a
Just Rope
text)