{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module OpenTelemetry.EventlogStreaming_Internal where

import Control.Concurrent (threadDelay)
import qualified Data.Binary.Get as DBG
import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import Data.Int
import qualified Data.IntMap as IM
import Data.List (isSuffixOf)
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word
import GHC.Generics
import GHC.RTS.Events
import GHC.RTS.Events.Incremental
import GHC.Stack
import OpenTelemetry.Common hiding (Event, Timestamp)
import OpenTelemetry.Debug
import OpenTelemetry.Eventlog (InstrumentId, InstrumentName)
import OpenTelemetry.Eventlog_Internal
import OpenTelemetry.SpanContext
import System.Clock
import System.IO
import qualified System.Random.SplitMix as R
import Text.Printf

data WatDoOnEOF = StopOnEOF | SleepAndRetryOnEOF

data State = S
  { State -> Word64
originTimestamp :: !Timestamp,
    State -> IntMap Word32
cap2thread :: IM.IntMap ThreadId,
    State -> HashMap SpanId Span
spans :: HM.HashMap SpanId Span,
    State -> HashMap Word64 CaptureInstrument
instrumentMap :: HM.HashMap InstrumentId CaptureInstrument,
    State -> HashMap Word32 TraceId
traceMap :: HM.HashMap ThreadId TraceId,
    State -> HashMap Word64 SpanId
serial2sid :: HM.HashMap Word64 SpanId,
    State -> HashMap Word32 SpanId
thread2sid :: HM.HashMap ThreadId SpanId,
    State -> HashMap Word32 Word32
thread2displayThread :: HM.HashMap ThreadId ThreadId, -- https://github.com/ethercrow/opentelemetry-haskell/issues/40
    State -> Word32
nextFreeDisplayThread :: ThreadId,
    State -> Word64
gcRequestedAt :: !Timestamp,
    State -> Word64
gcStartedAt :: !Timestamp,
    State -> Int
gcGeneration :: !Int,
    State -> Int
counterEventsProcessed :: !Int,
    State -> Int
counterOpenTelemetryEventsProcessed :: !Int,
    State -> Int
counterSpansEmitted :: !Int,
    State -> SMGen
randomGen :: R.SMGen
  }
  deriving (Int -> State -> [Char] -> [Char]
[State] -> [Char] -> [Char]
State -> [Char]
(Int -> State -> [Char] -> [Char])
-> (State -> [Char]) -> ([State] -> [Char] -> [Char]) -> Show State
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> State -> [Char] -> [Char]
showsPrec :: Int -> State -> [Char] -> [Char]
$cshow :: State -> [Char]
show :: State -> [Char]
$cshowList :: [State] -> [Char] -> [Char]
showList :: [State] -> [Char] -> [Char]
Show)

initialState :: Word64 -> R.SMGen -> State
initialState :: Word64 -> SMGen -> State
initialState Word64
timestamp = Word64
-> IntMap Word32
-> HashMap SpanId Span
-> HashMap Word64 CaptureInstrument
-> HashMap Word32 TraceId
-> HashMap Word64 SpanId
-> HashMap Word32 SpanId
-> HashMap Word32 Word32
-> Word32
-> Word64
-> Word64
-> Int
-> Int
-> Int
-> Int
-> SMGen
-> State
S Word64
timestamp IntMap Word32
forall a. Monoid a => a
mempty HashMap SpanId Span
forall a. Monoid a => a
mempty HashMap Word64 CaptureInstrument
forall a. Monoid a => a
mempty HashMap Word32 TraceId
forall a. Monoid a => a
mempty HashMap Word64 SpanId
forall a. Monoid a => a
mempty HashMap Word32 SpanId
forall a. Monoid a => a
mempty HashMap Word32 Word32
forall a. Monoid a => a
mempty Word32
1 Word64
0 Word64
0 Int
0 Int
0 Int
0 Int
0

data EventSource
  = EventLogHandle Handle WatDoOnEOF
  | EventLogFilename FilePath

work :: Timestamp -> Exporter Span -> Exporter Metric -> EventSource -> IO ()
work :: Word64 -> Exporter Span -> Exporter Metric -> EventSource -> IO ()
work Word64
origin_timestamp Exporter Span
span_exporter Exporter Metric
metric_exporter EventSource
source = do
  [Char] -> IO ()
d_ [Char]
"Starting the eventlog reader"
  SMGen
smgen <- IO SMGen
R.initSMGen -- TODO(divanov): seed the random generator with something more random than current time
  let state0 :: State
state0 = Word64 -> SMGen -> State
initialState Word64
origin_timestamp SMGen
smgen
  case EventSource
source of
    EventLogFilename [Char]
path -> do
      [Char] -> IO (Either [Char] EventLog)
readEventLogFromFile [Char]
path IO (Either [Char] EventLog)
-> (Either [Char] EventLog -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right (EventLog -> Data
dat -> Data {[Event]
events :: [Event]
events :: Data -> [Event]
events}) -> do
          let go :: State -> [Event] -> IO ()
go State
_ [] = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              go State
s (Event
e : [Event]
es) = do
                [Char] -> (Word64, Maybe Int, EventInfo) -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dd_ [Char]
"event" (Event -> Word64
evTime Event
e, Event -> Maybe Int
evCap Event
e, Event -> EventInfo
evSpec Event
e)
                case Event -> State -> (State, [Span], [Metric])
processEvent Event
e State
s of
                  (State
s', [Span]
sps, [Metric]
ms) -> do
                    case [Span]
sps of
                      [] -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                      [Span]
_ -> do
                        (Span -> IO ()) -> [Span] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> IO ()
d_ ([Char] -> IO ()) -> (Span -> [Char]) -> Span -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"emit span " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char]) -> (Span -> [Char]) -> Span -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> [Char]
forall a. Show a => a -> [Char]
show) [Span]
sps
                        ExportResult
_ <- Exporter Span -> [Span] -> IO ExportResult
forall thing. Exporter thing -> [thing] -> IO ExportResult
export Exporter Span
span_exporter [Span]
sps
                        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    case [Metric]
ms of
                      [] -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                      [Metric]
_ -> do
                        (Metric -> IO ()) -> [Metric] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> IO ()
d_ ([Char] -> IO ()) -> (Metric -> [Char]) -> Metric -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"emit metric " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char]) -> (Metric -> [Char]) -> Metric -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metric -> [Char]
forall a. Show a => a -> [Char]
show) [Metric]
ms
                        ExportResult
_ <- Exporter Metric -> [Metric] -> IO ExportResult
forall thing. Exporter thing -> [thing] -> IO ExportResult
export Exporter Metric
metric_exporter [Metric]
ms
                        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    State -> [Event] -> IO ()
go State
s' [Event]
es
          State -> [Event] -> IO ()
go State
state0 ([Event] -> IO ()) -> [Event] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Event] -> [Event]
sortEvents [Event]
events
        Left [Char]
err -> do
          [Char] -> IO ()
putStrLn [Char]
err
    EventLogHandle Handle
input WatDoOnEOF
wat_do_on_eof -> do
      let go :: State -> Decoder Event -> IO ()
go State
s (Produce Event
event Decoder Event
next) = do
            case Event -> EventInfo
evSpec Event
event of
              Shutdown {} -> do
                [Char] -> IO ()
d_ [Char]
"Shutdown-like event detected"
              CapDelete {} -> do
                [Char] -> IO ()
d_ [Char]
"Shutdown-like event detected"
              CapsetDelete {} -> do
                [Char] -> IO ()
d_ [Char]
"Shutdown-like event detected"
              EventInfo
_ -> do
                -- d_ "go Produce"
                [Char] -> (Word64, Maybe Int, EventInfo) -> IO ()
forall a. Show a => [Char] -> a -> IO ()
dd_ [Char]
"event" (Event -> Word64
evTime Event
event, Event -> Maybe Int
evCap Event
event, Event -> EventInfo
evSpec Event
event)
                let (State
s', [Span]
sps, [Metric]
_ms) = Event -> State -> (State, [Span], [Metric])
processEvent Event
event State
s
                ExportResult
_ <- Exporter Span -> [Span] -> IO ExportResult
forall thing. Exporter thing -> [thing] -> IO ExportResult
export Exporter Span
span_exporter [Span]
sps
                -- print s'
                (Span -> IO ()) -> [Span] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> IO ()
d_ ([Char] -> IO ()) -> (Span -> [Char]) -> Span -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"emit " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> [Char]) -> (Span -> [Char]) -> Span -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> [Char]
forall a. Show a => a -> [Char]
show) [Span]
sps
                State -> Decoder Event -> IO ()
go State
s' Decoder Event
next
          go State
s d :: Decoder Event
d@(Consume ByteString -> Decoder Event
consume) = do
            -- d_ "go Consume"
            Bool
eof <- Handle -> IO Bool
hIsEOF Handle
input
            case Bool
eof of
              Bool
False -> do
                ByteString
chunk <- Handle -> Int -> IO ByteString
B.hGetSome Handle
input Int
4096
                -- printf "chunk = %d bytes\n" (B.length chunk)
                if ByteString -> Bool
B.null ByteString
chunk
                  then do
                    -- d_ "chunk is null"
                    Int -> IO ()
threadDelay Int
1000 -- TODO(divanov): remove the sleep by replacing the hGetSome with something that blocks until data is available
                    State -> Decoder Event -> IO ()
go State
s Decoder Event
d
                  else do
                    -- d_ "chunk is not null"
                    State -> Decoder Event -> IO ()
go State
s (Decoder Event -> IO ()) -> Decoder Event -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Decoder Event
consume ByteString
chunk
              Bool
True -> do
                [Char] -> IO ()
d_ [Char]
"EOF"
                case WatDoOnEOF
wat_do_on_eof of
                  WatDoOnEOF
StopOnEOF -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  WatDoOnEOF
SleepAndRetryOnEOF -> do
                    Int -> IO ()
threadDelay Int
1000
                    State -> Decoder Event -> IO ()
go State
s Decoder Event
d
          go State
_ (Done ByteString
_) = do
            [Char] -> IO ()
d_ [Char]
"go Done"
            () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          go State
_ (Error ByteString
_leftover [Char]
err) = do
            [Char] -> IO ()
d_ [Char]
"go Error"
            [Char] -> IO ()
d_ [Char]
err
      State -> Decoder Event -> IO ()
go State
state0 Decoder Event
decodeEventLog
  [Char] -> IO ()
d_ [Char]
"no more work"

parseOpenTelemetry :: EventInfo -> Maybe OpenTelemetryEventlogEvent
parseOpenTelemetry :: EventInfo -> Maybe OpenTelemetryEventlogEvent
parseOpenTelemetry UserMessage {Text
msg :: Text
msg :: EventInfo -> Text
msg} = [Text] -> Maybe OpenTelemetryEventlogEvent
parseText (Text -> [Text]
T.words Text
msg)
parseOpenTelemetry UserBinaryMessage {ByteString
payload :: ByteString
payload :: EventInfo -> ByteString
payload} = ByteString -> Maybe OpenTelemetryEventlogEvent
parseByteString ByteString
payload
parseOpenTelemetry EventInfo
_ = Maybe OpenTelemetryEventlogEvent
forall a. Maybe a
Nothing

processEvent :: Event -> State -> (State, [Span], [Metric])
processEvent :: Event -> State -> (State, [Span], [Metric])
processEvent (Event Word64
ts EventInfo
ev Maybe Int
m_cap) st :: State
st@S {Int
Word32
Word64
IntMap Word32
SMGen
HashMap Word32 Word32
HashMap Word32 SpanId
HashMap Word32 TraceId
HashMap Word64 SpanId
HashMap Word64 CaptureInstrument
HashMap SpanId Span
originTimestamp :: State -> Word64
cap2thread :: State -> IntMap Word32
spans :: State -> HashMap SpanId Span
instrumentMap :: State -> HashMap Word64 CaptureInstrument
traceMap :: State -> HashMap Word32 TraceId
serial2sid :: State -> HashMap Word64 SpanId
thread2sid :: State -> HashMap Word32 SpanId
thread2displayThread :: State -> HashMap Word32 Word32
nextFreeDisplayThread :: State -> Word32
gcRequestedAt :: State -> Word64
gcStartedAt :: State -> Word64
gcGeneration :: State -> Int
counterEventsProcessed :: State -> Int
counterOpenTelemetryEventsProcessed :: State -> Int
counterSpansEmitted :: State -> Int
randomGen :: State -> SMGen
originTimestamp :: Word64
cap2thread :: IntMap Word32
spans :: HashMap SpanId Span
instrumentMap :: HashMap Word64 CaptureInstrument
traceMap :: HashMap Word32 TraceId
serial2sid :: HashMap Word64 SpanId
thread2sid :: HashMap Word32 SpanId
thread2displayThread :: HashMap Word32 Word32
nextFreeDisplayThread :: Word32
gcRequestedAt :: Word64
gcStartedAt :: Word64
gcGeneration :: Int
counterEventsProcessed :: Int
counterOpenTelemetryEventsProcessed :: Int
counterSpansEmitted :: Int
randomGen :: SMGen
..} =
  let now :: Word64
now = Word64
originTimestamp Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
ts
      m_thread_id :: Maybe Word32
m_thread_id = Maybe Int
m_cap Maybe Int -> (Int -> Maybe Word32) -> Maybe Word32
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> IntMap Word32 -> Maybe Word32)
-> IntMap Word32 -> Int -> Maybe Word32
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> IntMap Word32 -> Maybe Word32
forall a. Int -> IntMap a -> Maybe a
IM.lookup IntMap Word32
cap2thread
      m_trace_id :: Maybe TraceId
m_trace_id = Maybe Word32
m_thread_id Maybe Word32 -> (Word32 -> Maybe TraceId) -> Maybe TraceId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32 -> HashMap Word32 TraceId -> Maybe TraceId)
-> HashMap Word32 TraceId -> Word32 -> Maybe TraceId
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word32 -> HashMap Word32 TraceId -> Maybe TraceId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap Word32 TraceId
traceMap
   in case (EventInfo
ev, Maybe Int
m_cap, Maybe Word32
m_thread_id) of
        (WallClockTime {Word64
sec :: Word64
sec :: EventInfo -> Word64
sec, Word32
nsec :: Word32
nsec :: EventInfo -> Word32
nsec}, Maybe Int
_, Maybe Word32
_) ->
          (State
st {originTimestamp = sec * 1_000_000_000 + fromIntegral nsec - ts}, [], [])
        (CreateThread Word32
new_tid, Maybe Int
_, Maybe Word32
_) ->
          let trace_id :: TraceId
trace_id = case Maybe TraceId
m_trace_id of
                Just TraceId
t -> TraceId
t
                Maybe TraceId
Nothing -> Word64 -> TraceId
TId Word64
originTimestamp -- TODO: something more random
           in ( State
st {traceMap = HM.insert new_tid trace_id traceMap},
                [],
                [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric CaptureInstrument
threadsI [Word64 -> Int -> MetricDatapoint Int
forall a. Word64 -> a -> MetricDatapoint a
MetricDatapoint Word64
now Int
1]]
              )
        (RunThread Word32
tid, Just Int
cap, Maybe Word32
_) ->
          (State
st {cap2thread = IM.insert cap tid cap2thread}, [], [])
        (StopThread Word32
tid ThreadStopStatus
tstatus, Just Int
cap, Maybe Word32
_)
          | ThreadStopStatus -> Bool
isTerminalThreadStatus ThreadStopStatus
tstatus ->
              let (HashMap Word32 Word32
t2dt, Word32
nfdt) = case Word32 -> HashMap Word32 Word32 -> Maybe Word32
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word32
tid HashMap Word32 Word32
thread2displayThread of
                                  Maybe Word32
Nothing -> (HashMap Word32 Word32
thread2displayThread, Word32
nextFreeDisplayThread)
                                  Just Word32
_ -> (Word32 -> HashMap Word32 Word32 -> HashMap Word32 Word32
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Word32
tid HashMap Word32 Word32
thread2displayThread, Word32
nextFreeDisplayThread Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1)
              in ( State
st
                     { cap2thread = IM.delete cap cap2thread,
                       traceMap = HM.delete tid traceMap,
                       thread2displayThread = t2dt,
                       nextFreeDisplayThread = nfdt
                     },
                   [],
                   [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric CaptureInstrument
threadsI [Word64 -> Int -> MetricDatapoint Int
forall a. Word64 -> a -> MetricDatapoint a
MetricDatapoint Word64
now (-Int
1)]]
                 )
        (EventInfo
RequestSeqGC, Maybe Int
_, Maybe Word32
_) ->
          (State
st {gcRequestedAt = now}, [], [])
        (EventInfo
RequestParGC, Maybe Int
_, Maybe Word32
_) ->
          (State
st {gcRequestedAt = now}, [], [])
        (EventInfo
StartGC, Maybe Int
_, Maybe Word32
_) ->
          (State
st {gcStartedAt = now}, [], [])
        (HeapLive {Word64
liveBytes :: Word64
liveBytes :: EventInfo -> Word64
liveBytes}, Maybe Int
_, Maybe Word32
_) -> (State
st, [], [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric CaptureInstrument
heapLiveBytesI [Word64 -> Int -> MetricDatapoint Int
forall a. Word64 -> a -> MetricDatapoint a
MetricDatapoint Word64
now (Int -> MetricDatapoint Int) -> Int -> MetricDatapoint Int
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
liveBytes]])
        (HeapAllocated {Word64
allocBytes :: Word64
allocBytes :: EventInfo -> Word64
allocBytes}, Just Int
cap, Maybe Word32
_) ->
          (State
st, [], [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric (Int -> CaptureInstrument
heapAllocBytesI Int
cap) [Word64 -> Int -> MetricDatapoint Int
forall a. Word64 -> a -> MetricDatapoint a
MetricDatapoint Word64
now (Int -> MetricDatapoint Int) -> Int -> MetricDatapoint Int
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
allocBytes]])
        (EventInfo
EndGC, Maybe Int
_, Maybe Word32
_) ->
          let (Word64
gc_span_id, SMGen
randomGen') = SMGen -> (Word64, SMGen)
R.nextWord64 SMGen
randomGen
              (Word64
gc_sync_span_id, SMGen
randomGen'') = SMGen -> (Word64, SMGen)
R.nextWord64 SMGen
randomGen'
              sp_gc :: Span
sp_gc =
                Span
                  { spanOperation :: Text
spanOperation = Text
"gc",
                    spanContext :: SpanContext
spanContext = SpanId -> TraceId -> SpanContext
SpanContext (Word64 -> SpanId
SId Word64
gc_span_id) (Word64 -> TraceId
TId Word64
gc_span_id),
                    spanStartedAt :: Word64
spanStartedAt = Word64
gcStartedAt,
                    spanFinishedAt :: Word64
spanFinishedAt = Word64
now,
                    spanThreadId :: Word32
spanThreadId = Word32
forall a. Bounded a => a
maxBound,
                    spanDisplayThreadId :: Word32
spanDisplayThreadId = Word32
forall a. Bounded a => a
maxBound,
                    spanTags :: HashMap TagName TagValue
spanTags = HashMap TagName TagValue
forall a. Monoid a => a
mempty,
                    spanEvents :: [SpanEvent]
spanEvents = [],
                    spanParentId :: Maybe SpanId
spanParentId = Maybe SpanId
forall a. Maybe a
Nothing,
                    spanStatus :: SpanStatus
spanStatus = SpanStatus
OK,
                    spanNanosecondsSpentInGC :: Word64
spanNanosecondsSpentInGC = Word64
now Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
gcStartedAt
                  }
              sp_sync :: Span
sp_sync =
                Span
                  { spanOperation :: Text
spanOperation = Text
"gc_sync",
                    spanContext :: SpanContext
spanContext = SpanId -> TraceId -> SpanContext
SpanContext (Word64 -> SpanId
SId Word64
gc_sync_span_id) (Word64 -> TraceId
TId Word64
gc_sync_span_id),
                    spanStartedAt :: Word64
spanStartedAt = Word64
gcRequestedAt,
                    spanFinishedAt :: Word64
spanFinishedAt = Word64
gcStartedAt,
                    spanThreadId :: Word32
spanThreadId = Word32
forall a. Bounded a => a
maxBound,
                    spanDisplayThreadId :: Word32
spanDisplayThreadId = Word32
forall a. Bounded a => a
maxBound,
                    spanTags :: HashMap TagName TagValue
spanTags = HashMap TagName TagValue
forall a. Monoid a => a
mempty,
                    spanEvents :: [SpanEvent]
spanEvents = [],
                    spanParentId :: Maybe SpanId
spanParentId = Maybe SpanId
forall a. Maybe a
Nothing,
                    spanStatus :: SpanStatus
spanStatus = SpanStatus
OK,
                    spanNanosecondsSpentInGC :: Word64
spanNanosecondsSpentInGC = Word64
gcStartedAt Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
gcRequestedAt
                  }
              spans' :: HashMap SpanId Span
spans' = (Span -> Span) -> HashMap SpanId Span -> HashMap SpanId Span
forall a b. (a -> b) -> HashMap SpanId a -> HashMap SpanId b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Span
live_span -> Span
live_span {spanNanosecondsSpentInGC = (now - gcRequestedAt) + spanNanosecondsSpentInGC live_span}) HashMap SpanId Span
spans
              st' :: State
st' = State
st {randomGen = randomGen'', spans = spans'}
           in (State
st', [Span
sp_sync, Span
sp_gc], [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric CaptureInstrument
gcTimeI [Word64 -> Int -> MetricDatapoint Int
forall a. Word64 -> a -> MetricDatapoint a
MetricDatapoint Word64
now (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
now Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
gcStartedAt)]])
        (EventInfo -> Maybe OpenTelemetryEventlogEvent
parseOpenTelemetry -> Just OpenTelemetryEventlogEvent
ev', Maybe Int
_, Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe Word32
1 -> Word32
tid) ->
          OpenTelemetryEventlogEvent
-> State
-> (Word32, Word64, Maybe TraceId)
-> (State, [Span], [Metric])
handleOpenTelemetryEventlogEvent OpenTelemetryEventlogEvent
ev' State
st (Word32
tid, Word64
now, Maybe TraceId
m_trace_id)
        (EventInfo, Maybe Int, Maybe Word32)
_ -> (State
st, [], [])
  where
    threadsI :: CaptureInstrument
    threadsI :: CaptureInstrument
threadsI = InstrumentType -> ByteString -> CaptureInstrument
CaptureInstrument InstrumentType
UpDownSumObserverType ByteString
"threads"

    heapLiveBytesI :: CaptureInstrument
    heapLiveBytesI :: CaptureInstrument
heapLiveBytesI = InstrumentType -> ByteString -> CaptureInstrument
CaptureInstrument InstrumentType
ValueObserverType ByteString
"heap_live_bytes"

    gcTimeI :: CaptureInstrument
    gcTimeI :: CaptureInstrument
gcTimeI = InstrumentType -> ByteString -> CaptureInstrument
CaptureInstrument InstrumentType
SumObserverType ByteString
"gc"

    heapAllocBytesI :: Int -> CaptureInstrument
    heapAllocBytesI :: Int -> CaptureInstrument
heapAllocBytesI Int
cap = InstrumentType -> ByteString -> CaptureInstrument
CaptureInstrument InstrumentType
SumObserverType (ByteString
"cap_" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Char] -> ByteString
B8.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
cap) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"_heap_alloc_bytes")

isTerminalThreadStatus :: ThreadStopStatus -> Bool
isTerminalThreadStatus :: ThreadStopStatus -> Bool
isTerminalThreadStatus ThreadStopStatus
ThreadFinished = Bool
True
isTerminalThreadStatus ThreadStopStatus
_ = Bool
False

data OpenTelemetryEventlogEvent
  = BeginSpanEv SpanInFlight SpanName
  | EndSpanEv SpanInFlight
  | TagEv SpanInFlight TagName TagVal
  | EventEv SpanInFlight EventName EventVal
  | SetParentEv SpanInFlight SpanContext
  | SetTraceEv SpanInFlight TraceId
  | SetSpanEv SpanInFlight SpanId
  | DeclareInstrumentEv InstrumentType InstrumentId InstrumentName
  | MetricCaptureEv InstrumentId Int
  deriving (Int -> OpenTelemetryEventlogEvent -> [Char] -> [Char]
[OpenTelemetryEventlogEvent] -> [Char] -> [Char]
OpenTelemetryEventlogEvent -> [Char]
(Int -> OpenTelemetryEventlogEvent -> [Char] -> [Char])
-> (OpenTelemetryEventlogEvent -> [Char])
-> ([OpenTelemetryEventlogEvent] -> [Char] -> [Char])
-> Show OpenTelemetryEventlogEvent
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> OpenTelemetryEventlogEvent -> [Char] -> [Char]
showsPrec :: Int -> OpenTelemetryEventlogEvent -> [Char] -> [Char]
$cshow :: OpenTelemetryEventlogEvent -> [Char]
show :: OpenTelemetryEventlogEvent -> [Char]
$cshowList :: [OpenTelemetryEventlogEvent] -> [Char] -> [Char]
showList :: [OpenTelemetryEventlogEvent] -> [Char] -> [Char]
Show, OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool
(OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool)
-> (OpenTelemetryEventlogEvent
    -> OpenTelemetryEventlogEvent -> Bool)
-> Eq OpenTelemetryEventlogEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool
== :: OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool
$c/= :: OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool
/= :: OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool
Eq, (forall x.
 OpenTelemetryEventlogEvent -> Rep OpenTelemetryEventlogEvent x)
-> (forall x.
    Rep OpenTelemetryEventlogEvent x -> OpenTelemetryEventlogEvent)
-> Generic OpenTelemetryEventlogEvent
forall x.
Rep OpenTelemetryEventlogEvent x -> OpenTelemetryEventlogEvent
forall x.
OpenTelemetryEventlogEvent -> Rep OpenTelemetryEventlogEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
OpenTelemetryEventlogEvent -> Rep OpenTelemetryEventlogEvent x
from :: forall x.
OpenTelemetryEventlogEvent -> Rep OpenTelemetryEventlogEvent x
$cto :: forall x.
Rep OpenTelemetryEventlogEvent x -> OpenTelemetryEventlogEvent
to :: forall x.
Rep OpenTelemetryEventlogEvent x -> OpenTelemetryEventlogEvent
Generic)

handleOpenTelemetryEventlogEvent ::
  OpenTelemetryEventlogEvent ->
  State ->
  (Word32, Timestamp, Maybe TraceId) ->
  (State, [Span], [Metric])
handleOpenTelemetryEventlogEvent :: OpenTelemetryEventlogEvent
-> State
-> (Word32, Word64, Maybe TraceId)
-> (State, [Span], [Metric])
handleOpenTelemetryEventlogEvent OpenTelemetryEventlogEvent
m State
st (Word32
tid, Word64
now, Maybe TraceId
m_trace_id) =
  case OpenTelemetryEventlogEvent
m of
    EventEv (SpanInFlight Word64
serial) EventName
k EventVal
v ->
      case Word64 -> HashMap Word64 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word64
serial (State -> HashMap Word64 SpanId
serial2sid State
st) of
        Just SpanId
span_id -> (HasCallStack => SpanId -> (Span -> Span) -> State -> State
SpanId -> (Span -> Span) -> State -> State
modifySpan SpanId
span_id (Word64 -> EventName -> EventVal -> Span -> Span
addEvent Word64
now EventName
k EventVal
v) State
st, [], [])
        Maybe SpanId
Nothing -> [Char] -> (State, [Span], [Metric])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (State, [Span], [Metric]))
-> [Char] -> (State, [Span], [Metric])
forall a b. (a -> b) -> a -> b
$ [Char]
"add event: span not found for serial " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
serial
    SetParentEv (SpanInFlight Word64
serial) (SpanContext SpanId
psid TraceId
trace_id) ->
      case Word64 -> HashMap Word64 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word64
serial (HashMap Word64 SpanId -> Maybe SpanId)
-> HashMap Word64 SpanId -> Maybe SpanId
forall a b. (a -> b) -> a -> b
$ State -> HashMap Word64 SpanId
serial2sid State
st of
        Just SpanId
span_id ->
          ( (HasCallStack => SpanId -> (Span -> Span) -> State -> State
SpanId -> (Span -> Span) -> State -> State
modifySpan SpanId
span_id (TraceId -> SpanId -> Span -> Span
setParent TraceId
trace_id SpanId
psid) State
st)
              { traceMap = HM.insert tid trace_id (traceMap st)
              },
            [],
            []
          )
        Maybe SpanId
Nothing -> [Char] -> (State, [Span], [Metric])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (State, [Span], [Metric]))
-> [Char] -> (State, [Span], [Metric])
forall a b. (a -> b) -> a -> b
$ [Char]
"set parent: span not found for serial " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
serial
    SetSpanEv (SpanInFlight Word64
serial) SpanId
span_id ->
      case Word64 -> HashMap Word64 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word64
serial (HashMap Word64 SpanId -> Maybe SpanId)
-> HashMap Word64 SpanId -> Maybe SpanId
forall a b. (a -> b) -> a -> b
$ State -> HashMap Word64 SpanId
serial2sid State
st of
        Just SpanId
old_span_id -> (HasCallStack => SpanId -> (Span -> Span) -> State -> State
SpanId -> (Span -> Span) -> State -> State
modifySpan SpanId
old_span_id (SpanId -> Span -> Span
setSpanId SpanId
span_id) State
st, [], [])
        Maybe SpanId
Nothing -> [Char] -> (State, [Span], [Metric])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (State, [Span], [Metric]))
-> [Char] -> (State, [Span], [Metric])
forall a b. (a -> b) -> a -> b
$ [Char]
"set spanid " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
serial [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SpanId -> [Char]
forall a. Show a => a -> [Char]
show SpanId
span_id [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": span id not found"
    SetTraceEv (SpanInFlight Word64
serial) TraceId
trace_id ->
      case Word64 -> HashMap Word64 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word64
serial (HashMap Word64 SpanId -> Maybe SpanId)
-> HashMap Word64 SpanId -> Maybe SpanId
forall a b. (a -> b) -> a -> b
$ State -> HashMap Word64 SpanId
serial2sid State
st of
        Maybe SpanId
Nothing -> [Char] -> (State, [Span], [Metric])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (State, [Span], [Metric]))
-> [Char] -> (State, [Span], [Metric])
forall a b. (a -> b) -> a -> b
$ [Char]
"set traceid: span id not found for serial" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
serial
        Just SpanId
span_id ->
          ( (HasCallStack => SpanId -> (Span -> Span) -> State -> State
SpanId -> (Span -> Span) -> State -> State
modifySpan SpanId
span_id (TraceId -> Span -> Span
setTraceId TraceId
trace_id) State
st)
              { traceMap = HM.insert tid trace_id $ traceMap st
              },
            [],
            []
          )
    TagEv (SpanInFlight Word64
serial) TagName
k TagVal
v ->
      case Word64 -> HashMap Word64 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word64
serial (HashMap Word64 SpanId -> Maybe SpanId)
-> HashMap Word64 SpanId -> Maybe SpanId
forall a b. (a -> b) -> a -> b
$ State -> HashMap Word64 SpanId
serial2sid State
st of
        Maybe SpanId
Nothing -> [Char] -> (State, [Span], [Metric])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (State, [Span], [Metric]))
-> [Char] -> (State, [Span], [Metric])
forall a b. (a -> b) -> a -> b
$ [Char]
"set tag: span id not found for serial" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
serial
        Just SpanId
span_id -> (HasCallStack => SpanId -> (Span -> Span) -> State -> State
SpanId -> (Span -> Span) -> State -> State
modifySpan SpanId
span_id (TagName -> TagVal -> Span -> Span
forall v. ToTagValue v => TagName -> v -> Span -> Span
setTag TagName
k TagVal
v) State
st, [], [])
    EndSpanEv (SpanInFlight Word64
serial) ->
      case Word64 -> HashMap Word64 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word64
serial (HashMap Word64 SpanId -> Maybe SpanId)
-> HashMap Word64 SpanId -> Maybe SpanId
forall a b. (a -> b) -> a -> b
$ State -> HashMap Word64 SpanId
serial2sid State
st of
        Maybe SpanId
Nothing ->
          let (State
st', SpanId
span_id) = Word64 -> State -> (State, SpanId)
inventSpanId Word64
serial State
st
              (State
st'', Word32
display_tid) = Word32 -> State -> (State, Word32)
inventDisplayTid Word32
tid State
st'
              parent :: Maybe SpanId
parent = Word32 -> HashMap Word32 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word32
tid (State -> HashMap Word32 SpanId
thread2sid State
st)
              sp :: Span
sp =
                Span
                  { spanContext :: SpanContext
spanContext = SpanId -> TraceId -> SpanContext
SpanContext SpanId
span_id (TraceId -> Maybe TraceId -> TraceId
forall a. a -> Maybe a -> a
fromMaybe (Word64 -> TraceId
TId Word64
42) Maybe TraceId
m_trace_id),
                    spanOperation :: Text
spanOperation = Text
"",
                    spanThreadId :: Word32
spanThreadId = Word32
tid,
                    spanDisplayThreadId :: Word32
spanDisplayThreadId = Word32
display_tid,
                    spanStartedAt :: Word64
spanStartedAt = Word64
0,
                    spanFinishedAt :: Word64
spanFinishedAt = Word64
now,
                    spanTags :: HashMap TagName TagValue
spanTags = HashMap TagName TagValue
forall a. Monoid a => a
mempty,
                    spanEvents :: [SpanEvent]
spanEvents = [SpanEvent]
forall a. Monoid a => a
mempty,
                    spanStatus :: SpanStatus
spanStatus = SpanStatus
OK,
                    spanNanosecondsSpentInGC :: Word64
spanNanosecondsSpentInGC = Word64
0,
                    spanParentId :: Maybe SpanId
spanParentId = Maybe SpanId
parent
                  }
           in (SpanId -> Span -> State -> State
createSpan SpanId
span_id Span
sp State
st'', [], [])
        Just SpanId
span_id ->
          let (State
st', Span
sp) = Word64 -> SpanId -> State -> (State, Span)
emitSpan Word64
serial SpanId
span_id State
st
           in (State
st', [Span
sp {spanFinishedAt = now}], [])
    BeginSpanEv (SpanInFlight Word64
serial) (SpanName Text
operation) ->
      case Word64 -> HashMap Word64 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word64
serial (State -> HashMap Word64 SpanId
serial2sid State
st) of
        Maybe SpanId
Nothing ->
          let (State
st', SpanId
span_id) = Word64 -> State -> (State, SpanId)
inventSpanId Word64
serial State
st
              parent :: Maybe SpanId
parent = Word32 -> HashMap Word32 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word32
tid (State -> HashMap Word32 SpanId
thread2sid State
st)
              (State
st'', Word32
display_tid) = Word32 -> State -> (State, Word32)
inventDisplayTid Word32
tid State
st'
              sp :: Span
sp =
                Span
                  { spanContext :: SpanContext
spanContext = SpanId -> TraceId -> SpanContext
SpanContext SpanId
span_id (TraceId -> Maybe TraceId -> TraceId
forall a. a -> Maybe a -> a
fromMaybe (Word64 -> TraceId
TId Word64
42) Maybe TraceId
m_trace_id),
                    spanOperation :: Text
spanOperation = Text
operation,
                    spanThreadId :: Word32
spanThreadId = Word32
tid,
                    spanDisplayThreadId :: Word32
spanDisplayThreadId = Word32
display_tid,
                    spanStartedAt :: Word64
spanStartedAt = Word64
now,
                    spanFinishedAt :: Word64
spanFinishedAt = Word64
0,
                    spanTags :: HashMap TagName TagValue
spanTags = HashMap TagName TagValue
forall a. Monoid a => a
mempty,
                    spanEvents :: [SpanEvent]
spanEvents = [SpanEvent]
forall a. Monoid a => a
mempty,
                    spanStatus :: SpanStatus
spanStatus = SpanStatus
OK,
                    spanNanosecondsSpentInGC :: Word64
spanNanosecondsSpentInGC = Word64
0,
                    spanParentId :: Maybe SpanId
spanParentId = Maybe SpanId
parent
                  }
           in (SpanId -> Span -> State -> State
createSpan SpanId
span_id Span
sp State
st'', [], [])
        Just SpanId
span_id ->
          let (State
st', Span
sp) = Word64 -> SpanId -> State -> (State, Span)
emitSpan Word64
serial SpanId
span_id State
st
           in (State
st', [Span
sp {spanOperation = operation, spanStartedAt = now}], [])
    DeclareInstrumentEv InstrumentType
iType Word64
iId ByteString
iName ->
      (State
st {instrumentMap = HM.insert iId (CaptureInstrument iType iName) (instrumentMap st)}, [], [])
    MetricCaptureEv Word64
instrumentId Int
val -> case Word64
-> HashMap Word64 CaptureInstrument -> Maybe CaptureInstrument
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word64
instrumentId (State -> HashMap Word64 CaptureInstrument
instrumentMap State
st) of
      Just CaptureInstrument
instrument -> (State
st, [], [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric CaptureInstrument
instrument [Word64 -> Int -> MetricDatapoint Int
forall a. Word64 -> a -> MetricDatapoint a
MetricDatapoint Word64
now Int
val]])
      Maybe CaptureInstrument
Nothing -> [Char] -> (State, [Span], [Metric])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (State, [Span], [Metric]))
-> [Char] -> (State, [Span], [Metric])
forall a b. (a -> b) -> a -> b
$ [Char]
"Undeclared instrument id: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
instrumentId

createSpan :: SpanId -> Span -> State -> State
createSpan :: SpanId -> Span -> State -> State
createSpan SpanId
span_id Span
sp State
st =
  State
st
    { spans = HM.insert span_id sp (spans st),
      thread2sid = HM.insert (spanThreadId sp) span_id (thread2sid st)
    }

emitSpan :: Word64 -> SpanId -> State -> (State, Span)
emitSpan :: Word64 -> SpanId -> State -> (State, Span)
emitSpan Word64
serial SpanId
span_id State
st =
  case (Word64 -> HashMap Word64 SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word64
serial (HashMap Word64 SpanId -> Maybe SpanId)
-> HashMap Word64 SpanId -> Maybe SpanId
forall a b. (a -> b) -> a -> b
$ State -> HashMap Word64 SpanId
serial2sid State
st, SpanId -> HashMap SpanId Span -> Maybe Span
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup SpanId
span_id (HashMap SpanId Span -> Maybe Span)
-> HashMap SpanId Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ State -> HashMap SpanId Span
spans State
st) of
    (Just SpanId
span_id', Just Span
sp)
      | SpanId
span_id SpanId -> SpanId -> Bool
forall a. Eq a => a -> a -> Bool
== SpanId
span_id' ->
        ( State
st
            { spans = HM.delete span_id $ spans st,
              serial2sid = HM.delete serial $ serial2sid st,
              thread2sid =
                HM.update
                  (const $ spanParentId sp)
                  (spanThreadId sp)
                  (thread2sid st)
            },
          Span
sp
        )
    (Maybe SpanId, Maybe Span)
_ -> [Char] -> (State, Span)
forall a. HasCallStack => [Char] -> a
error [Char]
"emitSpan invariants violated"

modifySpan :: HasCallStack => SpanId -> (Span -> Span) -> State -> State
modifySpan :: HasCallStack => SpanId -> (Span -> Span) -> State -> State
modifySpan SpanId
sid Span -> Span
f State
st = State
st {spans = HM.adjust f sid (spans st)}

setParent :: TraceId -> SpanId -> Span -> Span
setParent :: TraceId -> SpanId -> Span -> Span
setParent TraceId
ptid SpanId
psid Span
sp =
  Span
sp
    { spanParentId = Just psid,
      spanContext = SpanContext (spanId sp) ptid
    }

addEvent :: Timestamp -> EventName -> EventVal -> Span -> Span
addEvent :: Word64 -> EventName -> EventVal -> Span -> Span
addEvent Word64
ts EventName
k EventVal
v Span
sp = Span
sp {spanEvents = new_events}
  where
    new_events :: [SpanEvent]
new_events = SpanEvent
ev SpanEvent -> [SpanEvent] -> [SpanEvent]
forall a. a -> [a] -> [a]
: Span -> [SpanEvent]
spanEvents Span
sp
    ev :: SpanEvent
ev = Word64 -> EventName -> EventVal -> SpanEvent
SpanEvent Word64
ts EventName
k EventVal
v

setTraceId :: TraceId -> Span -> Span
setTraceId :: TraceId -> Span -> Span
setTraceId TraceId
tid Span
sp =
  Span
sp
    { spanContext = SpanContext (spanId sp) tid
    }

setTag :: ToTagValue v => TagName -> v -> Span -> Span
setTag :: forall v. ToTagValue v => TagName -> v -> Span -> Span
setTag TagName
k v
v Span
sp =
  Span
sp
    { spanTags = HM.insert k (toTagValue v) (spanTags sp)
    }

setSpanId :: SpanId -> Span -> Span
setSpanId :: SpanId -> Span -> Span
setSpanId SpanId
sid Span
sp =
  Span
sp
    { spanContext = SpanContext sid (spanTraceId sp)
    }

inventSpanId :: Word64 -> State -> (State, SpanId)
inventSpanId :: Word64 -> State -> (State, SpanId)
inventSpanId Word64
serial State
st = (State
st', SpanId
sid)
  where
    S {HashMap Word64 SpanId
serial2sid :: State -> HashMap Word64 SpanId
serial2sid :: HashMap Word64 SpanId
serial2sid, SMGen
randomGen :: State -> SMGen
randomGen :: SMGen
randomGen} = State
st
    (Word64 -> SpanId
SId -> SpanId
sid, SMGen
randomGen') = SMGen -> (Word64, SMGen)
R.nextWord64 SMGen
randomGen
    st' :: State
st' = State
st {serial2sid = HM.insert serial sid serial2sid, randomGen = randomGen'}

inventDisplayTid :: ThreadId -> State -> (State, ThreadId)
inventDisplayTid :: Word32 -> State -> (State, Word32)
inventDisplayTid Word32
tid st :: State
st@(S {HashMap Word32 Word32
thread2displayThread :: State -> HashMap Word32 Word32
thread2displayThread :: HashMap Word32 Word32
thread2displayThread, Word32
nextFreeDisplayThread :: State -> Word32
nextFreeDisplayThread :: Word32
nextFreeDisplayThread}) =
      case Word32 -> HashMap Word32 Word32 -> Maybe Word32
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word32
tid HashMap Word32 Word32
thread2displayThread of
        Maybe Word32
Nothing ->
                  let new_dtid :: Word32
new_dtid = Word32
nextFreeDisplayThread
                  in (State
st {thread2displayThread = HM.insert tid new_dtid thread2displayThread, nextFreeDisplayThread = new_dtid + 1}, Word32
new_dtid)
        Just Word32
dtid -> (State
st, Word32
dtid)

parseText :: [T.Text] -> Maybe OpenTelemetryEventlogEvent
parseText :: [Text] -> Maybe OpenTelemetryEventlogEvent
parseText =
  \case
    (Text
"ot2" : Text
"begin" : Text
"span" : Text
serial_text : [Text]
name) ->
      let serial :: Word64
serial = [Char] -> Word64
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
serial_text)
          operation :: Text
operation = Text -> [Text] -> Text
T.intercalate Text
" " [Text]
name
       in OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ SpanInFlight -> SpanName -> OpenTelemetryEventlogEvent
BeginSpanEv (Word64 -> SpanInFlight
SpanInFlight Word64
serial) (Text -> SpanName
SpanName Text
operation)
    [Text
"ot2", Text
"end", Text
"span", Text
serial_text] ->
      let serial :: Word64
serial = [Char] -> Word64
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
serial_text)
       in OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ SpanInFlight -> OpenTelemetryEventlogEvent
EndSpanEv (Word64 -> SpanInFlight
SpanInFlight Word64
serial)
    (Text
"ot2" : Text
"set" : Text
"tag" : Text
serial_text : Text
k : [Text]
v) ->
      let serial :: Word64
serial = [Char] -> Word64
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
serial_text)
       in OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ SpanInFlight -> TagName -> TagVal -> OpenTelemetryEventlogEvent
TagEv (Word64 -> SpanInFlight
SpanInFlight Word64
serial) (Text -> TagName
TagName Text
k) (Text -> TagVal
TagVal (Text -> TagVal) -> Text -> TagVal
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
v)
    [Text
"ot2", Text
"set", Text
"traceid", Text
serial_text, Text
trace_id_text] ->
      let serial :: Word64
serial = [Char] -> Word64
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
serial_text)
          trace_id :: TraceId
trace_id = Word64 -> TraceId
TId ([Char] -> Word64
forall a. Read a => [Char] -> a
read ([Char]
"0x" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
trace_id_text))
       in OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ SpanInFlight -> TraceId -> OpenTelemetryEventlogEvent
SetTraceEv (Word64 -> SpanInFlight
SpanInFlight Word64
serial) TraceId
trace_id
    [Text
"ot2", Text
"set", Text
"spanid", Text
serial_text, Text
new_span_id_text] ->
      let serial :: Word64
serial = [Char] -> Word64
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
serial_text)
          span_id :: SpanId
span_id = (Word64 -> SpanId
SId ([Char] -> Word64
forall a. Read a => [Char] -> a
read ([Char]
"0x" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
new_span_id_text)))
       in OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ SpanInFlight -> SpanId -> OpenTelemetryEventlogEvent
SetSpanEv (Word64 -> SpanInFlight
SpanInFlight Word64
serial) SpanId
span_id
    [Text
"ot2", Text
"set", Text
"parent", Text
serial_text, Text
trace_id_text, Text
parent_span_id_text] ->
      let trace_id :: TraceId
trace_id = Word64 -> TraceId
TId ([Char] -> Word64
forall a. Read a => [Char] -> a
read ([Char]
"0x" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
trace_id_text))
          serial :: Word64
serial = [Char] -> Word64
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
serial_text)
          psid :: SpanId
psid = Word64 -> SpanId
SId ([Char] -> Word64
forall a. Read a => [Char] -> a
read ([Char]
"0x" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
parent_span_id_text))
       in OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$
            SpanInFlight -> SpanContext -> OpenTelemetryEventlogEvent
SetParentEv
              (Word64 -> SpanInFlight
SpanInFlight Word64
serial)
              (SpanId -> TraceId -> SpanContext
SpanContext SpanId
psid TraceId
trace_id)
    (Text
"ot2" : Text
"add" : Text
"event" : Text
serial_text : Text
k : [Text]
v) ->
      let serial :: Word64
serial = [Char] -> Word64
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
serial_text)
       in OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> (EventVal -> OpenTelemetryEventlogEvent)
-> EventVal
-> Maybe OpenTelemetryEventlogEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanInFlight -> EventName -> EventVal -> OpenTelemetryEventlogEvent
EventEv (Word64 -> SpanInFlight
SpanInFlight Word64
serial) (Text -> EventName
EventName Text
k) (EventVal -> Maybe OpenTelemetryEventlogEvent)
-> EventVal -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ Text -> EventVal
EventVal (Text -> EventVal) -> Text -> EventVal
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
v
    (Text
"ot2" : Text
"metric" : Text
"create" : Text
instrumentTypeTag : Text
instrumentIdText : [Text]
instrumentNameStrs) ->
      Text -> Maybe InstrumentType
instrumentStringTagP Text
instrumentTypeTag Maybe InstrumentType
-> (InstrumentType -> Maybe OpenTelemetryEventlogEvent)
-> Maybe OpenTelemetryEventlogEvent
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \InstrumentType
instrumentType ->
        let instrumentId :: Word64
instrumentId = [Char] -> Word64
forall a. Read a => [Char] -> a
read ([Char]
"0x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
instrumentIdText)
            instrumentName :: ByteString
instrumentName = Text -> ByteString
TE.encodeUtf8 (Text -> [Text] -> Text
T.intercalate Text
" " [Text]
instrumentNameStrs)
         in OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ InstrumentType
-> Word64 -> ByteString -> OpenTelemetryEventlogEvent
DeclareInstrumentEv InstrumentType
instrumentType Word64
instrumentId ByteString
instrumentName
    (Text
"ot2" : Text
"metric" : Text
"capture" : Text
instrumentIdText : [Text]
valStr) ->
      let instrumentId :: Word64
instrumentId = [Char] -> Word64
forall a. Read a => [Char] -> a
read ([Char]
"0x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
instrumentIdText)
          val :: Int
val = [Char] -> Int
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
" " [Text]
valStr)
       in OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> OpenTelemetryEventlogEvent
MetricCaptureEv Word64
instrumentId Int
val
    (Text
"ot2" : [Text]
rest) -> [Char] -> Maybe OpenTelemetryEventlogEvent
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe OpenTelemetryEventlogEvent)
-> [Char] -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"Unrecognized %s" ([Text] -> [Char]
forall a. Show a => a -> [Char]
show [Text]
rest)
    [Text]
_ -> Maybe OpenTelemetryEventlogEvent
forall a. Maybe a
Nothing

instrumentStringTagP :: T.Text -> Maybe InstrumentType
instrumentStringTagP :: Text -> Maybe InstrumentType
instrumentStringTagP Text
"Counter" = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
CounterType
instrumentStringTagP Text
"UpDownCounter" = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
UpDownCounterType
instrumentStringTagP Text
"ValueRecorder" = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
ValueRecorderType
instrumentStringTagP Text
"SumObserver" = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
SumObserverType
instrumentStringTagP Text
"UpDownSumObserver" = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
UpDownSumObserverType
instrumentStringTagP Text
"ValueObserver" = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
ValueObserverType
instrumentStringTagP Text
_ = Maybe InstrumentType
forall a. Maybe a
Nothing

headerP :: DBG.Get (Maybe MsgType)
headerP :: Get (Maybe MsgType)
headerP = do
  Word32
h <- Get Word32
DBG.getWord32le
  let !msgTypeId :: Word32
msgTypeId = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
h Int
24
  if Int
otelMagic Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
h Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
otelMagic
    then
      if Word32
msgTypeId Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
7 Bool -> Bool -> Bool
&& Word32
msgTypeId Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
1
        then [Char] -> Get (Maybe MsgType)
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get (Maybe MsgType)) -> [Char] -> Get (Maybe MsgType)
forall a b. (a -> b) -> a -> b
$ [Char]
"Bad Msg Type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
msgTypeId
        else Maybe MsgType -> Get (Maybe MsgType)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MsgType -> Get (Maybe MsgType))
-> (Word32 -> Maybe MsgType) -> Word32 -> Get (Maybe MsgType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgType -> Maybe MsgType
forall a. a -> Maybe a
Just (MsgType -> Maybe MsgType)
-> (Word32 -> MsgType) -> Word32 -> Maybe MsgType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> MsgType
MsgType (Word8 -> MsgType) -> (Word32 -> Word8) -> Word32 -> MsgType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Get (Maybe MsgType)) -> Word32 -> Get (Maybe MsgType)
forall a b. (a -> b) -> a -> b
$ Word32
msgTypeId
    else Maybe MsgType -> Get (Maybe MsgType)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MsgType
forall a. Maybe a
Nothing

lastStringP :: DBG.Get T.Text
lastStringP :: Get Text
lastStringP = (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (LazyByteString -> ByteString) -> LazyByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
LBS.toStrict) (LazyByteString -> Text) -> Get LazyByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get LazyByteString
DBG.getRemainingLazyByteString

stringP :: Word32 -> DBG.Get T.Text
stringP :: Word32 -> Get Text
stringP Word32
len = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
DBG.getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)

logEventBodyP :: MsgType -> DBG.Get OpenTelemetryEventlogEvent
logEventBodyP :: MsgType -> Get OpenTelemetryEventlogEvent
logEventBodyP MsgType
msgType =
  case MsgType
msgType of
    MsgType
BEGIN_SPAN ->
      SpanInFlight -> SpanName -> OpenTelemetryEventlogEvent
BeginSpanEv (SpanInFlight -> SpanName -> OpenTelemetryEventlogEvent)
-> Get SpanInFlight -> Get (SpanName -> OpenTelemetryEventlogEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SpanInFlight
SpanInFlight (Word64 -> SpanInFlight) -> Get Word64 -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le)
        Get (SpanName -> OpenTelemetryEventlogEvent)
-> Get SpanName -> Get OpenTelemetryEventlogEvent
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> SpanName
SpanName (Text -> SpanName) -> Get Text -> Get SpanName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
lastStringP)
    MsgType
END_SPAN -> SpanInFlight -> OpenTelemetryEventlogEvent
EndSpanEv (SpanInFlight -> OpenTelemetryEventlogEvent)
-> Get SpanInFlight -> Get OpenTelemetryEventlogEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SpanInFlight
SpanInFlight (Word64 -> SpanInFlight) -> Get Word64 -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le)
    MsgType
TAG -> do
      SpanInFlight
sp <- Word64 -> SpanInFlight
SpanInFlight (Word64 -> SpanInFlight) -> Get Word64 -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le
      Word32
klen <- Get Word32
DBG.getWord32le
      Word32
vlen <- Get Word32
DBG.getWord32le
      TagName
k <- Text -> TagName
TagName (Text -> TagName) -> Get Text -> Get TagName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Get Text
stringP Word32
klen
      TagVal
v <- Text -> TagVal
TagVal (Text -> TagVal) -> Get Text -> Get TagVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Get Text
stringP Word32
vlen
      OpenTelemetryEventlogEvent -> Get OpenTelemetryEventlogEvent
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenTelemetryEventlogEvent -> Get OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Get OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ SpanInFlight -> TagName -> TagVal -> OpenTelemetryEventlogEvent
TagEv SpanInFlight
sp TagName
k TagVal
v
    MsgType
EVENT -> do
      SpanInFlight
sp <- Word64 -> SpanInFlight
SpanInFlight (Word64 -> SpanInFlight) -> Get Word64 -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le
      Word32
klen <- Get Word32
DBG.getWord32le
      Word32
vlen <- Get Word32
DBG.getWord32le
      EventName
k <- Text -> EventName
EventName (Text -> EventName) -> Get Text -> Get EventName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Get Text
stringP Word32
klen
      EventVal
v <- Text -> EventVal
EventVal (Text -> EventVal) -> Get Text -> Get EventVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Get Text
stringP Word32
vlen
      OpenTelemetryEventlogEvent -> Get OpenTelemetryEventlogEvent
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenTelemetryEventlogEvent -> Get OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent -> Get OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ SpanInFlight -> EventName -> EventVal -> OpenTelemetryEventlogEvent
EventEv SpanInFlight
sp EventName
k EventVal
v
    MsgType
SET_PARENT_CONTEXT ->
      SpanInFlight -> SpanContext -> OpenTelemetryEventlogEvent
SetParentEv (SpanInFlight -> SpanContext -> OpenTelemetryEventlogEvent)
-> Get SpanInFlight
-> Get (SpanContext -> OpenTelemetryEventlogEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SpanInFlight
SpanInFlight (Word64 -> SpanInFlight) -> Get Word64 -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le)
        Get (SpanContext -> OpenTelemetryEventlogEvent)
-> Get SpanContext -> Get OpenTelemetryEventlogEvent
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SpanId -> TraceId -> SpanContext
SpanContext (SpanId -> TraceId -> SpanContext)
-> Get SpanId -> Get (TraceId -> SpanContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SpanId
SId (Word64 -> SpanId) -> Get Word64 -> Get SpanId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le) Get (TraceId -> SpanContext) -> Get TraceId -> Get SpanContext
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> TraceId
TId (Word64 -> TraceId) -> Get Word64 -> Get TraceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le))
    MsgType
SET_TRACE_ID ->
      SpanInFlight -> TraceId -> OpenTelemetryEventlogEvent
SetTraceEv (SpanInFlight -> TraceId -> OpenTelemetryEventlogEvent)
-> Get SpanInFlight -> Get (TraceId -> OpenTelemetryEventlogEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SpanInFlight
SpanInFlight (Word64 -> SpanInFlight) -> Get Word64 -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le)
        Get (TraceId -> OpenTelemetryEventlogEvent)
-> Get TraceId -> Get OpenTelemetryEventlogEvent
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> TraceId
TId (Word64 -> TraceId) -> Get Word64 -> Get TraceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le)
    MsgType
SET_SPAN_ID ->
      SpanInFlight -> SpanId -> OpenTelemetryEventlogEvent
SetSpanEv (SpanInFlight -> SpanId -> OpenTelemetryEventlogEvent)
-> Get SpanInFlight -> Get (SpanId -> OpenTelemetryEventlogEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SpanInFlight
SpanInFlight (Word64 -> SpanInFlight) -> Get Word64 -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le)
        Get (SpanId -> OpenTelemetryEventlogEvent)
-> Get SpanId -> Get OpenTelemetryEventlogEvent
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> SpanId
SId (Word64 -> SpanId) -> Get Word64 -> Get SpanId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le)
    MsgType
DECLARE_INSTRUMENT ->
      InstrumentType
-> Word64 -> ByteString -> OpenTelemetryEventlogEvent
DeclareInstrumentEv
        (InstrumentType
 -> Word64 -> ByteString -> OpenTelemetryEventlogEvent)
-> Get InstrumentType
-> Get (Word64 -> ByteString -> OpenTelemetryEventlogEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int8 -> Get InstrumentType
instrumentTagP (Int8 -> Get InstrumentType) -> Get Int8 -> Get InstrumentType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Int8
DBG.getInt8)
        Get (Word64 -> ByteString -> OpenTelemetryEventlogEvent)
-> Get Word64 -> Get (ByteString -> OpenTelemetryEventlogEvent)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
DBG.getWord64le
        Get (ByteString -> OpenTelemetryEventlogEvent)
-> Get ByteString -> Get OpenTelemetryEventlogEvent
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LazyByteString -> ByteString
LBS.toStrict (LazyByteString -> ByteString)
-> Get LazyByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get LazyByteString
DBG.getRemainingLazyByteString)
    MsgType
METRIC_CAPTURE ->
      Word64 -> Int -> OpenTelemetryEventlogEvent
MetricCaptureEv
        (Word64 -> Int -> OpenTelemetryEventlogEvent)
-> Get Word64 -> Get (Int -> OpenTelemetryEventlogEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
DBG.getWord64le
        Get (Int -> OpenTelemetryEventlogEvent)
-> Get Int -> Get OpenTelemetryEventlogEvent
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Get Int64 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
DBG.getInt64le)
    MsgType Word8
mti ->
      [Char] -> Get OpenTelemetryEventlogEvent
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get OpenTelemetryEventlogEvent)
-> [Char] -> Get OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ [Char]
"Log event of type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
mti [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is not supported"

logEventP :: DBG.Get (Maybe OpenTelemetryEventlogEvent)
logEventP :: Get (Maybe OpenTelemetryEventlogEvent)
logEventP =
  Get (Maybe MsgType) -> Get (Maybe MsgType)
forall a. Get (Maybe a) -> Get (Maybe a)
DBG.lookAheadM Get (Maybe MsgType)
headerP Get (Maybe MsgType)
-> (Maybe MsgType -> Get (Maybe OpenTelemetryEventlogEvent))
-> Get (Maybe OpenTelemetryEventlogEvent)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe MsgType
Nothing -> Maybe OpenTelemetryEventlogEvent
-> Get (Maybe OpenTelemetryEventlogEvent)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OpenTelemetryEventlogEvent
forall a. Maybe a
Nothing
    Just MsgType
msgType -> MsgType -> Get OpenTelemetryEventlogEvent
logEventBodyP MsgType
msgType Get OpenTelemetryEventlogEvent
-> (OpenTelemetryEventlogEvent
    -> Get (Maybe OpenTelemetryEventlogEvent))
-> Get (Maybe OpenTelemetryEventlogEvent)
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe OpenTelemetryEventlogEvent
-> Get (Maybe OpenTelemetryEventlogEvent)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe OpenTelemetryEventlogEvent
 -> Get (Maybe OpenTelemetryEventlogEvent))
-> (OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent)
-> OpenTelemetryEventlogEvent
-> Get (Maybe OpenTelemetryEventlogEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenTelemetryEventlogEvent -> Maybe OpenTelemetryEventlogEvent
forall a. a -> Maybe a
Just

instrumentTagP :: Int8 -> DBG.Get InstrumentType
instrumentTagP :: Int8 -> Get InstrumentType
instrumentTagP Int8
1 = InstrumentType -> Get InstrumentType
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
CounterType
instrumentTagP Int8
2 = InstrumentType -> Get InstrumentType
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
UpDownCounterType
instrumentTagP Int8
3 = InstrumentType -> Get InstrumentType
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
ValueRecorderType
instrumentTagP Int8
4 = InstrumentType -> Get InstrumentType
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
SumObserverType
instrumentTagP Int8
5 = InstrumentType -> Get InstrumentType
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
UpDownSumObserverType
instrumentTagP Int8
6 = InstrumentType -> Get InstrumentType
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
ValueObserverType
instrumentTagP Int8
n = [Char] -> Get InstrumentType
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get InstrumentType) -> [Char] -> Get InstrumentType
forall a b. (a -> b) -> a -> b
$ [Char]
"Bad instrument tag: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int8 -> [Char]
forall a. Show a => a -> [Char]
show Int8
n

parseByteString :: B.ByteString -> Maybe OpenTelemetryEventlogEvent
parseByteString :: ByteString -> Maybe OpenTelemetryEventlogEvent
parseByteString = Get (Maybe OpenTelemetryEventlogEvent)
-> LazyByteString -> Maybe OpenTelemetryEventlogEvent
forall a. Get a -> LazyByteString -> a
DBG.runGet Get (Maybe OpenTelemetryEventlogEvent)
logEventP (LazyByteString -> Maybe OpenTelemetryEventlogEvent)
-> (ByteString -> LazyByteString)
-> ByteString
-> Maybe OpenTelemetryEventlogEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LazyByteString
LBS.fromStrict

exportEventlog :: Exporter Span -> Exporter Metric -> FilePath -> IO ()
exportEventlog :: Exporter Span -> Exporter Metric -> [Char] -> IO ()
exportEventlog Exporter Span
span_exporter Exporter Metric
metric_exporter [Char]
path = do
  Word64
origin_timestamp <- Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> (TimeSpec -> Integer) -> TimeSpec -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpec -> Integer
toNanoSecs (TimeSpec -> Word64) -> IO TimeSpec -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO TimeSpec
getTime Clock
Realtime
  -- TODO(divanov): better way of understanding whether filename points to a named pipe
  case [Char]
".pipe" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
path of
    Bool
True -> do
      [Char] -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile
        [Char]
path
        IOMode
ReadMode
        ( \Handle
handle ->
            Word64 -> Exporter Span -> Exporter Metric -> EventSource -> IO ()
work Word64
origin_timestamp Exporter Span
span_exporter Exporter Metric
metric_exporter (EventSource -> IO ()) -> EventSource -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> WatDoOnEOF -> EventSource
EventLogHandle Handle
handle WatDoOnEOF
SleepAndRetryOnEOF
        )
    Bool
False -> Word64 -> Exporter Span -> Exporter Metric -> EventSource -> IO ()
work Word64
origin_timestamp Exporter Span
span_exporter Exporter Metric
metric_exporter (EventSource -> IO ()) -> EventSource -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> EventSource
EventLogFilename [Char]
path