{-# 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 -> Timestamp
originTimestamp :: !Timestamp,
    State -> IntMap ThreadId
cap2thread :: IM.IntMap ThreadId,
    State -> HashMap SpanId Span
spans :: HM.HashMap SpanId Span,
    State -> HashMap Timestamp CaptureInstrument
instrumentMap :: HM.HashMap InstrumentId CaptureInstrument,
    State -> HashMap ThreadId TraceId
traceMap :: HM.HashMap ThreadId TraceId,
    State -> HashMap Timestamp SpanId
serial2sid :: HM.HashMap Word64 SpanId,
    State -> HashMap ThreadId SpanId
thread2sid :: HM.HashMap ThreadId SpanId,
    State -> HashMap ThreadId ThreadId
thread2displayThread :: HM.HashMap ThreadId ThreadId, -- https://github.com/ethercrow/opentelemetry-haskell/issues/40
    State -> ThreadId
nextFreeDisplayThread :: ThreadId,
    State -> Timestamp
gcRequestedAt :: !Timestamp,
    State -> Timestamp
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 -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)

initialState :: Word64 -> R.SMGen -> State
initialState :: Timestamp -> SMGen -> State
initialState Timestamp
timestamp = Timestamp
-> IntMap ThreadId
-> HashMap SpanId Span
-> HashMap Timestamp CaptureInstrument
-> HashMap ThreadId TraceId
-> HashMap Timestamp SpanId
-> HashMap ThreadId SpanId
-> HashMap ThreadId ThreadId
-> ThreadId
-> Timestamp
-> Timestamp
-> Int
-> Int
-> Int
-> Int
-> SMGen
-> State
S Timestamp
timestamp IntMap ThreadId
forall a. Monoid a => a
mempty HashMap SpanId Span
forall a. Monoid a => a
mempty HashMap Timestamp CaptureInstrument
forall a. Monoid a => a
mempty HashMap ThreadId TraceId
forall a. Monoid a => a
mempty HashMap Timestamp SpanId
forall a. Monoid a => a
mempty HashMap ThreadId SpanId
forall a. Monoid a => a
mempty HashMap ThreadId ThreadId
forall a. Monoid a => a
mempty ThreadId
1 Timestamp
0 Timestamp
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 :: Timestamp
-> Exporter Span -> Exporter Metric -> EventSource -> IO ()
work Timestamp
origin_timestamp Exporter Span
span_exporter Exporter Metric
metric_exporter EventSource
source = do
  String -> IO ()
d_ String
"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 = Timestamp -> SMGen -> State
initialState Timestamp
origin_timestamp SMGen
smgen
  case EventSource
source of
    EventLogFilename String
path -> do
      String -> IO (Either String EventLog)
readEventLogFromFile String
path IO (Either String EventLog)
-> (Either String EventLog -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right (EventLog -> Data
dat -> Data {[Event]
events :: Data -> [Event]
events :: [Event]
events}) -> do
          let go :: State -> [Event] -> IO ()
go State
_ [] = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              go State
s (Event
e : [Event]
es) = do
                String -> (Timestamp, Maybe Int, EventInfo) -> IO ()
forall a. Show a => String -> a -> IO ()
dd_ String
"event" (Event -> Timestamp
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 (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_ (String -> IO ()
d_ (String -> IO ()) -> (Span -> String) -> Span -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"emit span " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (Span -> String) -> Span -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> String
forall a. Show a => a -> String
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    case [Metric]
ms of
                      [] -> () -> IO ()
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_ (String -> IO ()
d_ (String -> IO ()) -> (Metric -> String) -> Metric -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"emit metric " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (Metric -> String) -> Metric -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metric -> String
forall a. Show a => a -> String
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 (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 String
err -> do
          String -> IO ()
putStrLn String
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
                String -> IO ()
d_ String
"Shutdown-like event detected"
              CapDelete {} -> do
                String -> IO ()
d_ String
"Shutdown-like event detected"
              CapsetDelete {} -> do
                String -> IO ()
d_ String
"Shutdown-like event detected"
              EventInfo
_ -> do
                -- d_ "go Produce"
                String -> (Timestamp, Maybe Int, EventInfo) -> IO ()
forall a. Show a => String -> a -> IO ()
dd_ String
"event" (Event -> Timestamp
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_ (String -> IO ()
d_ (String -> IO ()) -> (Span -> String) -> Span -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"emit " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (Span -> String) -> Span -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> String
forall a. Show a => a -> String
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
                String -> IO ()
d_ String
"EOF"
                case WatDoOnEOF
wat_do_on_eof of
                  WatDoOnEOF
StopOnEOF -> () -> IO ()
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
            String -> IO ()
d_ String
"go Done"
            () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          go State
_ (Error ByteString
_leftover String
err) = do
            String -> IO ()
d_ String
"go Error"
            String -> IO ()
d_ String
err
      State -> Decoder Event -> IO ()
go State
state0 Decoder Event
decodeEventLog
  String -> IO ()
d_ String
"no more work"

parseOpenTelemetry :: EventInfo -> Maybe OpenTelemetryEventlogEvent
parseOpenTelemetry :: EventInfo -> Maybe OpenTelemetryEventlogEvent
parseOpenTelemetry UserMessage {Text
msg :: EventInfo -> Text
msg :: Text
msg} = [Text] -> Maybe OpenTelemetryEventlogEvent
parseText (Text -> [Text]
T.words Text
msg)
parseOpenTelemetry UserBinaryMessage {ByteString
payload :: EventInfo -> ByteString
payload :: 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 Timestamp
ts EventInfo
ev Maybe Int
m_cap) st :: State
st@S {Int
ThreadId
Timestamp
IntMap ThreadId
SMGen
HashMap ThreadId ThreadId
HashMap ThreadId TraceId
HashMap ThreadId SpanId
HashMap Timestamp SpanId
HashMap Timestamp CaptureInstrument
HashMap SpanId Span
randomGen :: SMGen
counterSpansEmitted :: Int
counterOpenTelemetryEventsProcessed :: Int
counterEventsProcessed :: Int
gcGeneration :: Int
gcStartedAt :: Timestamp
gcRequestedAt :: Timestamp
nextFreeDisplayThread :: ThreadId
thread2displayThread :: HashMap ThreadId ThreadId
thread2sid :: HashMap ThreadId SpanId
serial2sid :: HashMap Timestamp SpanId
traceMap :: HashMap ThreadId TraceId
instrumentMap :: HashMap Timestamp CaptureInstrument
spans :: HashMap SpanId Span
cap2thread :: IntMap ThreadId
originTimestamp :: Timestamp
randomGen :: State -> SMGen
counterSpansEmitted :: State -> Int
counterOpenTelemetryEventsProcessed :: State -> Int
counterEventsProcessed :: State -> Int
gcGeneration :: State -> Int
gcStartedAt :: State -> Timestamp
gcRequestedAt :: State -> Timestamp
nextFreeDisplayThread :: State -> ThreadId
thread2displayThread :: State -> HashMap ThreadId ThreadId
thread2sid :: State -> HashMap ThreadId SpanId
serial2sid :: State -> HashMap Timestamp SpanId
traceMap :: State -> HashMap ThreadId TraceId
instrumentMap :: State -> HashMap Timestamp CaptureInstrument
spans :: State -> HashMap SpanId Span
cap2thread :: State -> IntMap ThreadId
originTimestamp :: State -> Timestamp
..} =
  let now :: Timestamp
now = Timestamp
originTimestamp Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
+ Timestamp
ts
      m_thread_id :: Maybe ThreadId
m_thread_id = Maybe Int
m_cap Maybe Int -> (Int -> Maybe ThreadId) -> Maybe ThreadId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> IntMap ThreadId -> Maybe ThreadId)
-> IntMap ThreadId -> Int -> Maybe ThreadId
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> IntMap ThreadId -> Maybe ThreadId
forall a. Int -> IntMap a -> Maybe a
IM.lookup IntMap ThreadId
cap2thread
      m_trace_id :: Maybe TraceId
m_trace_id = Maybe ThreadId
m_thread_id Maybe ThreadId -> (ThreadId -> Maybe TraceId) -> Maybe TraceId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ThreadId -> HashMap ThreadId TraceId -> Maybe TraceId)
-> HashMap ThreadId TraceId -> ThreadId -> Maybe TraceId
forall a b c. (a -> b -> c) -> b -> a -> c
flip ThreadId -> HashMap ThreadId TraceId -> Maybe TraceId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup HashMap ThreadId TraceId
traceMap
   in case (EventInfo
ev, Maybe Int
m_cap, Maybe ThreadId
m_thread_id) of
        (WallClockTime {Timestamp
sec :: EventInfo -> Timestamp
sec :: Timestamp
sec, ThreadId
nsec :: EventInfo -> ThreadId
nsec :: ThreadId
nsec}, Maybe Int
_, Maybe ThreadId
_) ->
          (State
st {originTimestamp :: Timestamp
originTimestamp = Timestamp
sec Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
* Timestamp
1_000_000_000 Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
+ ThreadId -> Timestamp
forall a b. (Integral a, Num b) => a -> b
fromIntegral ThreadId
nsec Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
- Timestamp
ts}, [], [])
        (CreateThread ThreadId
new_tid, Maybe Int
_, Maybe ThreadId
_) ->
          let trace_id :: TraceId
trace_id = case Maybe TraceId
m_trace_id of
                Just TraceId
t -> TraceId
t
                Maybe TraceId
Nothing -> Timestamp -> TraceId
TId Timestamp
originTimestamp -- TODO: something more random
           in ( State
st {traceMap :: HashMap ThreadId TraceId
traceMap = ThreadId
-> TraceId -> HashMap ThreadId TraceId -> HashMap ThreadId TraceId
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ThreadId
new_tid TraceId
trace_id HashMap ThreadId TraceId
traceMap},
                [],
                [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric CaptureInstrument
threadsI [Timestamp -> Int -> MetricDatapoint Int
forall a. Timestamp -> a -> MetricDatapoint a
MetricDatapoint Timestamp
now Int
1]]
              )
        (RunThread ThreadId
tid, Just Int
cap, Maybe ThreadId
_) ->
          (State
st {cap2thread :: IntMap ThreadId
cap2thread = Int -> ThreadId -> IntMap ThreadId -> IntMap ThreadId
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
cap ThreadId
tid IntMap ThreadId
cap2thread}, [], [])
        (StopThread ThreadId
tid ThreadStopStatus
tstatus, Just Int
cap, Maybe ThreadId
_)
          | ThreadStopStatus -> Bool
isTerminalThreadStatus ThreadStopStatus
tstatus ->
              let (HashMap ThreadId ThreadId
t2dt, ThreadId
nfdt) = case ThreadId -> HashMap ThreadId ThreadId -> Maybe ThreadId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ThreadId
tid HashMap ThreadId ThreadId
thread2displayThread of
                                  Maybe ThreadId
Nothing -> (HashMap ThreadId ThreadId
thread2displayThread, ThreadId
nextFreeDisplayThread)
                                  Just ThreadId
_ -> (ThreadId -> HashMap ThreadId ThreadId -> HashMap ThreadId ThreadId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete ThreadId
tid HashMap ThreadId ThreadId
thread2displayThread, ThreadId
nextFreeDisplayThread ThreadId -> ThreadId -> ThreadId
forall a. Num a => a -> a -> a
- ThreadId
1)
              in ( State
st
                     { cap2thread :: IntMap ThreadId
cap2thread = Int -> IntMap ThreadId -> IntMap ThreadId
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
cap IntMap ThreadId
cap2thread,
                       traceMap :: HashMap ThreadId TraceId
traceMap = ThreadId -> HashMap ThreadId TraceId -> HashMap ThreadId TraceId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete ThreadId
tid HashMap ThreadId TraceId
traceMap,
                       thread2displayThread :: HashMap ThreadId ThreadId
thread2displayThread = HashMap ThreadId ThreadId
t2dt,
                       nextFreeDisplayThread :: ThreadId
nextFreeDisplayThread = ThreadId
nfdt
                     },
                   [],
                   [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric CaptureInstrument
threadsI [Timestamp -> Int -> MetricDatapoint Int
forall a. Timestamp -> a -> MetricDatapoint a
MetricDatapoint Timestamp
now (-Int
1)]]
                 )
        (EventInfo
RequestSeqGC, Maybe Int
_, Maybe ThreadId
_) ->
          (State
st {gcRequestedAt :: Timestamp
gcRequestedAt = Timestamp
now}, [], [])
        (EventInfo
RequestParGC, Maybe Int
_, Maybe ThreadId
_) ->
          (State
st {gcRequestedAt :: Timestamp
gcRequestedAt = Timestamp
now}, [], [])
        (EventInfo
StartGC, Maybe Int
_, Maybe ThreadId
_) ->
          (State
st {gcStartedAt :: Timestamp
gcStartedAt = Timestamp
now}, [], [])
        (HeapLive {Timestamp
liveBytes :: EventInfo -> Timestamp
liveBytes :: Timestamp
liveBytes}, Maybe Int
_, Maybe ThreadId
_) -> (State
st, [], [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric CaptureInstrument
heapLiveBytesI [Timestamp -> Int -> MetricDatapoint Int
forall a. Timestamp -> a -> MetricDatapoint a
MetricDatapoint Timestamp
now (Int -> MetricDatapoint Int) -> Int -> MetricDatapoint Int
forall a b. (a -> b) -> a -> b
$ Timestamp -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Timestamp
liveBytes]])
        (HeapAllocated {Timestamp
allocBytes :: EventInfo -> Timestamp
allocBytes :: Timestamp
allocBytes}, Just Int
cap, Maybe ThreadId
_) ->
          (State
st, [], [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric (Int -> CaptureInstrument
heapAllocBytesI Int
cap) [Timestamp -> Int -> MetricDatapoint Int
forall a. Timestamp -> a -> MetricDatapoint a
MetricDatapoint Timestamp
now (Int -> MetricDatapoint Int) -> Int -> MetricDatapoint Int
forall a b. (a -> b) -> a -> b
$ Timestamp -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Timestamp
allocBytes]])
        (EventInfo
EndGC, Maybe Int
_, Maybe ThreadId
_) ->
          let (Timestamp
gc_span_id, SMGen
randomGen') = SMGen -> (Timestamp, SMGen)
R.nextWord64 SMGen
randomGen
              (Timestamp
gc_sync_span_id, SMGen
randomGen'') = SMGen -> (Timestamp, SMGen)
R.nextWord64 SMGen
randomGen'
              sp_gc :: Span
sp_gc =
                Span :: SpanContext
-> Text
-> ThreadId
-> ThreadId
-> Timestamp
-> Timestamp
-> HashMap TagName TagValue
-> [SpanEvent]
-> SpanStatus
-> Maybe SpanId
-> Timestamp
-> Span
Span
                  { $sel:spanOperation:Span :: Text
spanOperation = Text
"gc",
                    $sel:spanContext:Span :: SpanContext
spanContext = SpanId -> TraceId -> SpanContext
SpanContext (Timestamp -> SpanId
SId Timestamp
gc_span_id) (Timestamp -> TraceId
TId Timestamp
gc_span_id),
                    $sel:spanStartedAt:Span :: Timestamp
spanStartedAt = Timestamp
gcStartedAt,
                    $sel:spanFinishedAt:Span :: Timestamp
spanFinishedAt = Timestamp
now,
                    $sel:spanThreadId:Span :: ThreadId
spanThreadId = ThreadId
forall a. Bounded a => a
maxBound,
                    $sel:spanDisplayThreadId:Span :: ThreadId
spanDisplayThreadId = ThreadId
forall a. Bounded a => a
maxBound,
                    $sel:spanTags:Span :: HashMap TagName TagValue
spanTags = HashMap TagName TagValue
forall a. Monoid a => a
mempty,
                    $sel:spanEvents:Span :: [SpanEvent]
spanEvents = [],
                    $sel:spanParentId:Span :: Maybe SpanId
spanParentId = Maybe SpanId
forall a. Maybe a
Nothing,
                    $sel:spanStatus:Span :: SpanStatus
spanStatus = SpanStatus
OK,
                    $sel:spanNanosecondsSpentInGC:Span :: Timestamp
spanNanosecondsSpentInGC = Timestamp
now Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
- Timestamp
gcStartedAt
                  }
              sp_sync :: Span
sp_sync =
                Span :: SpanContext
-> Text
-> ThreadId
-> ThreadId
-> Timestamp
-> Timestamp
-> HashMap TagName TagValue
-> [SpanEvent]
-> SpanStatus
-> Maybe SpanId
-> Timestamp
-> Span
Span
                  { $sel:spanOperation:Span :: Text
spanOperation = Text
"gc_sync",
                    $sel:spanContext:Span :: SpanContext
spanContext = SpanId -> TraceId -> SpanContext
SpanContext (Timestamp -> SpanId
SId Timestamp
gc_sync_span_id) (Timestamp -> TraceId
TId Timestamp
gc_sync_span_id),
                    $sel:spanStartedAt:Span :: Timestamp
spanStartedAt = Timestamp
gcRequestedAt,
                    $sel:spanFinishedAt:Span :: Timestamp
spanFinishedAt = Timestamp
gcStartedAt,
                    $sel:spanThreadId:Span :: ThreadId
spanThreadId = ThreadId
forall a. Bounded a => a
maxBound,
                    $sel:spanDisplayThreadId:Span :: ThreadId
spanDisplayThreadId = ThreadId
forall a. Bounded a => a
maxBound,
                    $sel:spanTags:Span :: HashMap TagName TagValue
spanTags = HashMap TagName TagValue
forall a. Monoid a => a
mempty,
                    $sel:spanEvents:Span :: [SpanEvent]
spanEvents = [],
                    $sel:spanParentId:Span :: Maybe SpanId
spanParentId = Maybe SpanId
forall a. Maybe a
Nothing,
                    $sel:spanStatus:Span :: SpanStatus
spanStatus = SpanStatus
OK,
                    $sel:spanNanosecondsSpentInGC:Span :: Timestamp
spanNanosecondsSpentInGC = Timestamp
gcStartedAt Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
- Timestamp
gcRequestedAt
                  }
              spans' :: HashMap SpanId Span
spans' = (Span -> Span) -> HashMap SpanId Span -> HashMap SpanId Span
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Span
live_span -> Span
live_span {$sel:spanNanosecondsSpentInGC:Span :: Timestamp
spanNanosecondsSpentInGC = (Timestamp
now Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
- Timestamp
gcRequestedAt) Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
+ Span -> Timestamp
spanNanosecondsSpentInGC Span
live_span}) HashMap SpanId Span
spans
              st' :: State
st' = State
st {randomGen :: SMGen
randomGen = SMGen
randomGen'', spans :: HashMap SpanId Span
spans = HashMap SpanId Span
spans'}
           in (State
st', [Span
sp_sync, Span
sp_gc], [CaptureInstrument -> [MetricDatapoint Int] -> Metric
Metric CaptureInstrument
gcTimeI [Timestamp -> Int -> MetricDatapoint Int
forall a. Timestamp -> a -> MetricDatapoint a
MetricDatapoint Timestamp
now (Timestamp -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Timestamp -> Int) -> Timestamp -> Int
forall a b. (a -> b) -> a -> b
$ Timestamp
now Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
- Timestamp
gcStartedAt)]])
        (EventInfo -> Maybe OpenTelemetryEventlogEvent
parseOpenTelemetry -> Just OpenTelemetryEventlogEvent
ev', Maybe Int
_, ThreadId -> Maybe ThreadId -> ThreadId
forall a. a -> Maybe a -> a
fromMaybe ThreadId
1 -> ThreadId
tid) ->
          OpenTelemetryEventlogEvent
-> State
-> (ThreadId, Timestamp, Maybe TraceId)
-> (State, [Span], [Metric])
handleOpenTelemetryEventlogEvent OpenTelemetryEventlogEvent
ev' State
st (ThreadId
tid, Timestamp
now, Maybe TraceId
m_trace_id)
        (EventInfo, Maybe Int, Maybe ThreadId)
_ -> (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
<> String -> ByteString
B8.pack (Int -> String
forall a. Show a => a -> String
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 -> ShowS
[OpenTelemetryEventlogEvent] -> ShowS
OpenTelemetryEventlogEvent -> String
(Int -> OpenTelemetryEventlogEvent -> ShowS)
-> (OpenTelemetryEventlogEvent -> String)
-> ([OpenTelemetryEventlogEvent] -> ShowS)
-> Show OpenTelemetryEventlogEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenTelemetryEventlogEvent] -> ShowS
$cshowList :: [OpenTelemetryEventlogEvent] -> ShowS
show :: OpenTelemetryEventlogEvent -> String
$cshow :: OpenTelemetryEventlogEvent -> String
showsPrec :: Int -> OpenTelemetryEventlogEvent -> ShowS
$cshowsPrec :: Int -> OpenTelemetryEventlogEvent -> ShowS
Show, OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool
(OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool)
-> (OpenTelemetryEventlogEvent
    -> OpenTelemetryEventlogEvent -> Bool)
-> Eq OpenTelemetryEventlogEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool
$c/= :: OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool
== :: OpenTelemetryEventlogEvent -> OpenTelemetryEventlogEvent -> Bool
$c== :: 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
$cto :: forall x.
Rep OpenTelemetryEventlogEvent x -> OpenTelemetryEventlogEvent
$cfrom :: forall x.
OpenTelemetryEventlogEvent -> Rep OpenTelemetryEventlogEvent x
Generic)

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

createSpan :: SpanId -> Span -> State -> State
createSpan :: SpanId -> Span -> State -> State
createSpan SpanId
span_id Span
sp State
st =
  State
st
    { spans :: HashMap SpanId Span
spans = SpanId -> Span -> HashMap SpanId Span -> HashMap SpanId Span
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert SpanId
span_id Span
sp (State -> HashMap SpanId Span
spans State
st),
      thread2sid :: HashMap ThreadId SpanId
thread2sid = ThreadId
-> SpanId -> HashMap ThreadId SpanId -> HashMap ThreadId SpanId
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (Span -> ThreadId
spanThreadId Span
sp) SpanId
span_id (State -> HashMap ThreadId SpanId
thread2sid State
st)
    }

emitSpan :: Word64 -> SpanId -> State -> (State, Span)
emitSpan :: Timestamp -> SpanId -> State -> (State, Span)
emitSpan Timestamp
serial SpanId
span_id State
st =
  case (Timestamp -> HashMap Timestamp SpanId -> Maybe SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Timestamp
serial (HashMap Timestamp SpanId -> Maybe SpanId)
-> HashMap Timestamp SpanId -> Maybe SpanId
forall a b. (a -> b) -> a -> b
$ State -> HashMap Timestamp 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 :: HashMap SpanId Span
spans = SpanId -> HashMap SpanId Span -> HashMap SpanId Span
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete SpanId
span_id (HashMap SpanId Span -> HashMap SpanId Span)
-> HashMap SpanId Span -> HashMap SpanId Span
forall a b. (a -> b) -> a -> b
$ State -> HashMap SpanId Span
spans State
st,
              serial2sid :: HashMap Timestamp SpanId
serial2sid = Timestamp -> HashMap Timestamp SpanId -> HashMap Timestamp SpanId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Timestamp
serial (HashMap Timestamp SpanId -> HashMap Timestamp SpanId)
-> HashMap Timestamp SpanId -> HashMap Timestamp SpanId
forall a b. (a -> b) -> a -> b
$ State -> HashMap Timestamp SpanId
serial2sid State
st,
              thread2sid :: HashMap ThreadId SpanId
thread2sid =
                (SpanId -> Maybe SpanId)
-> ThreadId -> HashMap ThreadId SpanId -> HashMap ThreadId SpanId
forall k a.
(Eq k, Hashable k) =>
(a -> Maybe a) -> k -> HashMap k a -> HashMap k a
HM.update
                  (Maybe SpanId -> SpanId -> Maybe SpanId
forall a b. a -> b -> a
const (Maybe SpanId -> SpanId -> Maybe SpanId)
-> Maybe SpanId -> SpanId -> Maybe SpanId
forall a b. (a -> b) -> a -> b
$ Span -> Maybe SpanId
spanParentId Span
sp)
                  (Span -> ThreadId
spanThreadId Span
sp)
                  (State -> HashMap ThreadId SpanId
thread2sid State
st)
            },
          Span
sp
        )
    (Maybe SpanId, Maybe Span)
_ -> String -> (State, Span)
forall a. HasCallStack => String -> a
error String
"emitSpan invariants violated"

modifySpan :: HasCallStack => SpanId -> (Span -> Span) -> State -> State
modifySpan :: SpanId -> (Span -> Span) -> State -> State
modifySpan SpanId
sid Span -> Span
f State
st = State
st {spans :: HashMap SpanId Span
spans = (Span -> Span)
-> SpanId -> HashMap SpanId Span -> HashMap SpanId Span
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HM.adjust Span -> Span
f SpanId
sid (State -> HashMap SpanId Span
spans State
st)}

setParent :: TraceId -> SpanId -> Span -> Span
setParent :: TraceId -> SpanId -> Span -> Span
setParent TraceId
ptid SpanId
psid Span
sp =
  Span
sp
    { $sel:spanParentId:Span :: Maybe SpanId
spanParentId = SpanId -> Maybe SpanId
forall a. a -> Maybe a
Just SpanId
psid,
      $sel:spanContext:Span :: SpanContext
spanContext = SpanId -> TraceId -> SpanContext
SpanContext (Span -> SpanId
spanId Span
sp) TraceId
ptid
    }

addEvent :: Timestamp -> EventName -> EventVal -> Span -> Span
addEvent :: Timestamp -> EventName -> EventVal -> Span -> Span
addEvent Timestamp
ts EventName
k EventVal
v Span
sp = Span
sp {$sel:spanEvents:Span :: [SpanEvent]
spanEvents = [SpanEvent]
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 = Timestamp -> EventName -> EventVal -> SpanEvent
SpanEvent Timestamp
ts EventName
k EventVal
v

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

setTag :: ToTagValue v => TagName -> v -> Span -> Span
setTag :: TagName -> v -> Span -> Span
setTag TagName
k v
v Span
sp =
  Span
sp
    { $sel:spanTags:Span :: HashMap TagName TagValue
spanTags = TagName
-> TagValue -> HashMap TagName TagValue -> HashMap TagName TagValue
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert TagName
k (v -> TagValue
forall a. ToTagValue a => a -> TagValue
toTagValue v
v) (Span -> HashMap TagName TagValue
spanTags Span
sp)
    }

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

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

inventDisplayTid :: ThreadId -> State -> (State, ThreadId)
inventDisplayTid :: ThreadId -> State -> (State, ThreadId)
inventDisplayTid ThreadId
tid st :: State
st@(S {HashMap ThreadId ThreadId
thread2displayThread :: HashMap ThreadId ThreadId
thread2displayThread :: State -> HashMap ThreadId ThreadId
thread2displayThread, ThreadId
nextFreeDisplayThread :: ThreadId
nextFreeDisplayThread :: State -> ThreadId
nextFreeDisplayThread}) =
      case ThreadId -> HashMap ThreadId ThreadId -> Maybe ThreadId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ThreadId
tid HashMap ThreadId ThreadId
thread2displayThread of
        Maybe ThreadId
Nothing ->
                  let new_dtid :: ThreadId
new_dtid = ThreadId
nextFreeDisplayThread
                  in (State
st {thread2displayThread :: HashMap ThreadId ThreadId
thread2displayThread = ThreadId
-> ThreadId
-> HashMap ThreadId ThreadId
-> HashMap ThreadId ThreadId
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ThreadId
tid ThreadId
new_dtid HashMap ThreadId ThreadId
thread2displayThread, nextFreeDisplayThread :: ThreadId
nextFreeDisplayThread = ThreadId
new_dtid ThreadId -> ThreadId -> ThreadId
forall a. Num a => a -> a -> a
+ ThreadId
1}, ThreadId
new_dtid)
        Just ThreadId
dtid -> (State
st, ThreadId
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 :: Timestamp
serial = String -> Timestamp
forall a. Read a => String -> a
read (Text -> String
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 (Timestamp -> SpanInFlight
SpanInFlight Timestamp
serial) (Text -> SpanName
SpanName Text
operation)
    [Text
"ot2", Text
"end", Text
"span", Text
serial_text] ->
      let serial :: Timestamp
serial = String -> Timestamp
forall a. Read a => String -> a
read (Text -> String
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 (Timestamp -> SpanInFlight
SpanInFlight Timestamp
serial)
    (Text
"ot2" : Text
"set" : Text
"tag" : Text
serial_text : Text
k : [Text]
v) ->
      let serial :: Timestamp
serial = String -> Timestamp
forall a. Read a => String -> a
read (Text -> String
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 (Timestamp -> SpanInFlight
SpanInFlight Timestamp
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 :: Timestamp
serial = String -> Timestamp
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
serial_text)
          trace_id :: TraceId
trace_id = Timestamp -> TraceId
TId (String -> Timestamp
forall a. Read a => String -> a
read (String
"0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
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 (Timestamp -> SpanInFlight
SpanInFlight Timestamp
serial) TraceId
trace_id
    [Text
"ot2", Text
"set", Text
"spanid", Text
serial_text, Text
new_span_id_text] ->
      let serial :: Timestamp
serial = String -> Timestamp
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
serial_text)
          span_id :: SpanId
span_id = (Timestamp -> SpanId
SId (String -> Timestamp
forall a. Read a => String -> a
read (String
"0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
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 (Timestamp -> SpanInFlight
SpanInFlight Timestamp
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 = Timestamp -> TraceId
TId (String -> Timestamp
forall a. Read a => String -> a
read (String
"0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
trace_id_text))
          serial :: Timestamp
serial = String -> Timestamp
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
serial_text)
          psid :: SpanId
psid = Timestamp -> SpanId
SId (String -> Timestamp
forall a. Read a => String -> a
read (String
"0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
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
              (Timestamp -> SpanInFlight
SpanInFlight Timestamp
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 :: Timestamp
serial = String -> Timestamp
forall a. Read a => String -> a
read (Text -> String
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 (Timestamp -> SpanInFlight
SpanInFlight Timestamp
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \InstrumentType
instrumentType ->
        let instrumentId :: Timestamp
instrumentId = String -> Timestamp
forall a. Read a => String -> a
read (String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
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
-> Timestamp -> ByteString -> OpenTelemetryEventlogEvent
DeclareInstrumentEv InstrumentType
instrumentType Timestamp
instrumentId ByteString
instrumentName
    (Text
"ot2" : Text
"metric" : Text
"capture" : Text
instrumentIdText : [Text]
valStr) ->
      let instrumentId :: Timestamp
instrumentId = String -> Timestamp
forall a. Read a => String -> a
read (String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
instrumentIdText)
          val :: Int
val = String -> Int
forall a. Read a => String -> a
read (Text -> String
T.unpack (Text -> String) -> Text -> String
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
$ Timestamp -> Int -> OpenTelemetryEventlogEvent
MetricCaptureEv Timestamp
instrumentId Int
val
    (Text
"ot2" : [Text]
rest) -> String -> Maybe OpenTelemetryEventlogEvent
forall a. HasCallStack => String -> a
error (String -> Maybe OpenTelemetryEventlogEvent)
-> String -> Maybe OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Unrecognized %s" ([Text] -> String
forall a. Show a => a -> String
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
  ThreadId
h <- Get ThreadId
DBG.getWord32le
  let !msgTypeId :: ThreadId
msgTypeId = ThreadId -> Int -> ThreadId
forall a. Bits a => a -> Int -> a
shiftR ThreadId
h Int
24
  if Int
otelMagic Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ThreadId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ThreadId
h Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
otelMagic
    then
      if ThreadId
msgTypeId ThreadId -> ThreadId -> Bool
forall a. Ord a => a -> a -> Bool
> ThreadId
7 Bool -> Bool -> Bool
&& ThreadId
msgTypeId ThreadId -> ThreadId -> Bool
forall a. Ord a => a -> a -> Bool
< ThreadId
1
        then String -> Get (Maybe MsgType)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe MsgType)) -> String -> Get (Maybe MsgType)
forall a b. (a -> b) -> a -> b
$ String
"Bad Msg Type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ThreadId -> String
forall a. Show a => a -> String
show ThreadId
msgTypeId
        else Maybe MsgType -> Get (Maybe MsgType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MsgType -> Get (Maybe MsgType))
-> (ThreadId -> Maybe MsgType) -> ThreadId -> 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)
-> (ThreadId -> MsgType) -> ThreadId -> Maybe MsgType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> MsgType
MsgType (Word8 -> MsgType) -> (ThreadId -> Word8) -> ThreadId -> MsgType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ThreadId -> Get (Maybe MsgType))
-> ThreadId -> Get (Maybe MsgType)
forall a b. (a -> b) -> a -> b
$ ThreadId
msgTypeId
    else Maybe MsgType -> Get (Maybe MsgType)
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)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict) (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
DBG.getRemainingLazyByteString

stringP :: Word32 -> DBG.Get T.Text
stringP :: ThreadId -> Get Text
stringP ThreadId
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 (ThreadId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ThreadId
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
<$> (Timestamp -> SpanInFlight
SpanInFlight (Timestamp -> SpanInFlight) -> Get Timestamp -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le)
        Get (SpanName -> OpenTelemetryEventlogEvent)
-> Get SpanName -> Get OpenTelemetryEventlogEvent
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
<$> (Timestamp -> SpanInFlight
SpanInFlight (Timestamp -> SpanInFlight) -> Get Timestamp -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le)
    MsgType
TAG -> do
      SpanInFlight
sp <- Timestamp -> SpanInFlight
SpanInFlight (Timestamp -> SpanInFlight) -> Get Timestamp -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le
      ThreadId
klen <- Get ThreadId
DBG.getWord32le
      ThreadId
vlen <- Get ThreadId
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
<$> ThreadId -> Get Text
stringP ThreadId
klen
      TagVal
v <- Text -> TagVal
TagVal (Text -> TagVal) -> Get Text -> Get TagVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreadId -> Get Text
stringP ThreadId
vlen
      OpenTelemetryEventlogEvent -> Get OpenTelemetryEventlogEvent
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 <- Timestamp -> SpanInFlight
SpanInFlight (Timestamp -> SpanInFlight) -> Get Timestamp -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le
      ThreadId
klen <- Get ThreadId
DBG.getWord32le
      ThreadId
vlen <- Get ThreadId
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
<$> ThreadId -> Get Text
stringP ThreadId
klen
      EventVal
v <- Text -> EventVal
EventVal (Text -> EventVal) -> Get Text -> Get EventVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThreadId -> Get Text
stringP ThreadId
vlen
      OpenTelemetryEventlogEvent -> Get OpenTelemetryEventlogEvent
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
<$> (Timestamp -> SpanInFlight
SpanInFlight (Timestamp -> SpanInFlight) -> Get Timestamp -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le)
        Get (SpanContext -> OpenTelemetryEventlogEvent)
-> Get SpanContext -> Get OpenTelemetryEventlogEvent
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
<$> (Timestamp -> SpanId
SId (Timestamp -> SpanId) -> Get Timestamp -> Get SpanId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le) Get (TraceId -> SpanContext) -> Get TraceId -> Get SpanContext
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Timestamp -> TraceId
TId (Timestamp -> TraceId) -> Get Timestamp -> Get TraceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
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
<$> (Timestamp -> SpanInFlight
SpanInFlight (Timestamp -> SpanInFlight) -> Get Timestamp -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le)
        Get (TraceId -> OpenTelemetryEventlogEvent)
-> Get TraceId -> Get OpenTelemetryEventlogEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Timestamp -> TraceId
TId (Timestamp -> TraceId) -> Get Timestamp -> Get TraceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
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
<$> (Timestamp -> SpanInFlight
SpanInFlight (Timestamp -> SpanInFlight) -> Get Timestamp -> Get SpanInFlight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le)
        Get (SpanId -> OpenTelemetryEventlogEvent)
-> Get SpanId -> Get OpenTelemetryEventlogEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Timestamp -> SpanId
SId (Timestamp -> SpanId) -> Get Timestamp -> Get SpanId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le)
    MsgType
DECLARE_INSTRUMENT ->
      InstrumentType
-> Timestamp -> ByteString -> OpenTelemetryEventlogEvent
DeclareInstrumentEv
        (InstrumentType
 -> Timestamp -> ByteString -> OpenTelemetryEventlogEvent)
-> Get InstrumentType
-> Get (Timestamp -> 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 (Timestamp -> ByteString -> OpenTelemetryEventlogEvent)
-> Get Timestamp -> Get (ByteString -> OpenTelemetryEventlogEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Timestamp
DBG.getWord64le
        Get (ByteString -> OpenTelemetryEventlogEvent)
-> Get ByteString -> Get OpenTelemetryEventlogEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
DBG.getRemainingLazyByteString)
    MsgType
METRIC_CAPTURE ->
      Timestamp -> Int -> OpenTelemetryEventlogEvent
MetricCaptureEv
        (Timestamp -> Int -> OpenTelemetryEventlogEvent)
-> Get Timestamp -> Get (Int -> OpenTelemetryEventlogEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
DBG.getWord64le
        Get (Int -> OpenTelemetryEventlogEvent)
-> Get Int -> Get OpenTelemetryEventlogEvent
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 ->
      String -> Get OpenTelemetryEventlogEvent
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get OpenTelemetryEventlogEvent)
-> String -> Get OpenTelemetryEventlogEvent
forall a b. (a -> b) -> a -> b
$ String
"Log event of type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
mti String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe MsgType
Nothing -> Maybe OpenTelemetryEventlogEvent
-> Get (Maybe OpenTelemetryEventlogEvent)
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe OpenTelemetryEventlogEvent
-> Get (Maybe OpenTelemetryEventlogEvent)
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 (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
CounterType
instrumentTagP Int8
2 = InstrumentType -> Get InstrumentType
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
UpDownCounterType
instrumentTagP Int8
3 = InstrumentType -> Get InstrumentType
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
ValueRecorderType
instrumentTagP Int8
4 = InstrumentType -> Get InstrumentType
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
SumObserverType
instrumentTagP Int8
5 = InstrumentType -> Get InstrumentType
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
UpDownSumObserverType
instrumentTagP Int8
6 = InstrumentType -> Get InstrumentType
forall (m :: * -> *) a. Monad m => a -> m a
return InstrumentType
ValueObserverType
instrumentTagP Int8
n = String -> Get InstrumentType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get InstrumentType) -> String -> Get InstrumentType
forall a b. (a -> b) -> a -> b
$ String
"Bad instrument tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int8 -> String
forall a. Show a => a -> String
show Int8
n

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

exportEventlog :: Exporter Span -> Exporter Metric -> FilePath -> IO ()
exportEventlog :: Exporter Span -> Exporter Metric -> String -> IO ()
exportEventlog Exporter Span
span_exporter Exporter Metric
metric_exporter String
path = do
  Timestamp
origin_timestamp <- Integer -> Timestamp
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Timestamp)
-> (TimeSpec -> Integer) -> TimeSpec -> Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeSpec -> Integer
toNanoSecs (TimeSpec -> Timestamp) -> IO TimeSpec -> IO Timestamp
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 String
".pipe" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
path of
    Bool
True -> do
      String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile
        String
path
        IOMode
ReadMode
        ( \Handle
handle ->
            Timestamp
-> Exporter Span -> Exporter Metric -> EventSource -> IO ()
work Timestamp
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 -> Timestamp
-> Exporter Span -> Exporter Metric -> EventSource -> IO ()
work Timestamp
origin_timestamp Exporter Span
span_exporter Exporter Metric
metric_exporter (EventSource -> IO ()) -> EventSource -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> EventSource
EventLogFilename String
path