opentelemetry-extra 0.5.3 → 0.6.0
raw patch · 9 files changed
+265/−109 lines, 9 filesdep +quickcheck-instancesdep ~opentelemetry
Dependencies added: quickcheck-instances
Dependency ranges changed: opentelemetry
Files
- exe/eventlog-summary/Main.hs +16/−17
- exe/eventlog-to-zipkin/Main.hs +1/−1
- opentelemetry-extra.cabal +12/−11
- src/OpenTelemetry/ChromeExporter.hs +17/−22
- src/OpenTelemetry/Common.hs +100/−3
- src/OpenTelemetry/EventlogStreaming_Internal.hs +91/−54
- src/OpenTelemetry/ZipkinExporter.hs +0/−1
- unit-tests/Arbitrary.hs +16/−0
- unit-tests/LogEventSerializer.hs +12/−0
exe/eventlog-summary/Main.hs view
@@ -3,6 +3,11 @@ module Main where import Control.Monad+import qualified Data.Text as T+import qualified Data.ByteString.Char8 as B8+import OpenTelemetry.Common+import OpenTelemetry.EventlogStreaming_Internal+import System.Environment import Data.Char (isDigit) import Data.Function import qualified Data.HashTable.IO as H@@ -10,13 +15,8 @@ import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IntMap import Data.List (sortOn)-import qualified Data.Text as T import Data.Word import Graphics.Vega.VegaLite hiding (name)-import OpenTelemetry.Common-import OpenTelemetry.EventlogStreaming_Internal-import OpenTelemetry.Exporter-import System.Environment import Text.Printf type HashTable k v = H.BasicHashTable k v@@ -68,18 +68,17 @@ pure ExportSuccess ) (pure ())- metric_exporter =- Exporter- ( \metrics -> do- forM_ metrics $ \(Gauge _ label value) ->- modifyIORef metricStats $ \s -> case splitCapability $ T.unpack label of- (_, "threads") -> s {max_threads = max value (max_threads s)}- (Just cap, "heap_alloc_bytes") -> s {total_alloc_bytes = IntMap.insert cap value (total_alloc_bytes s)}- (_, "heap_live_bytes") -> s {max_live_bytes = max value (max_live_bytes s)}- _ -> s- pure ExportSuccess- )- (pure ())+ metric_exporter <- aggregated $ Exporter+ ( \metrics -> do+ forM_ metrics $ \(AggregatedMetric (CaptureInstrument _ name) (MetricDatapoint _ value)) ->+ modifyIORef metricStats $ \s -> case splitCapability (B8.unpack name) of+ (_, "threads") -> s { max_threads = max value (max_threads s) }+ (Just cap, "heap_alloc_bytes") -> s { total_alloc_bytes = IntMap.insert cap value (total_alloc_bytes s) }+ (_, "heap_live_bytes") -> s { max_live_bytes = max value (max_live_bytes s) }+ _ -> s+ pure ExportSuccess+ )+ (pure ()) exportEventlog span_exporter metric_exporter path leaderboard <- sortOn (total_ns . snd) <$> H.toList opCounts printf "Count\tTot ms\tMin ms\tMax ms\tOperation\n"
exe/eventlog-to-zipkin/Main.hs view
@@ -4,7 +4,7 @@ import qualified Data.Text as T import OpenTelemetry.EventlogStreaming_Internal-import OpenTelemetry.Exporter+import OpenTelemetry.Common import OpenTelemetry.ZipkinExporter import System.Environment (getArgs) import System.FilePath
opentelemetry-extra.cabal view
@@ -2,7 +2,7 @@ name: opentelemetry-extra description: The OpenTelemetry Haskell Client https://opentelemetry.io category: OpenTelemetry-version: 0.5.3+version: 0.6.0 license-file: LICENSE license: Apache-2.0 author: Dmitry Ivanov@@ -63,7 +63,7 @@ http-client, http-client-tls, http-types,- opentelemetry >= 0.5.3,+ opentelemetry >= 0.6.0, random >= 1.1, scientific, text-show,@@ -97,7 +97,7 @@ bytestring, ghc-events, hashable,- opentelemetry >= 0.5.3,+ opentelemetry >= 0.6.0, opentelemetry-extra, splitmix, tasty,@@ -107,7 +107,8 @@ generic-arbitrary, text, text-show,- unordered-containers+ unordered-containers,+ quickcheck-instances executable eventlog-to-zipkin import: options@@ -121,7 +122,7 @@ filepath, http-client, http-client-tls,- opentelemetry >= 0.5.3,+ opentelemetry >= 0.6.0, opentelemetry-extra, text, typed-process@@ -140,7 +141,7 @@ build-depends: base, gauge >= 0.2.4,- opentelemetry >= 0.5.3,+ opentelemetry >= 0.6.0, executable eventlog-to-chrome import: options@@ -150,7 +151,7 @@ base, exceptions, clock,- opentelemetry >= 0.5.3,+ opentelemetry >= 0.6.0, opentelemetry-extra, executable eventlog-to-tracy@@ -161,7 +162,7 @@ base, clock, directory,- opentelemetry >= 0.5.3,+ opentelemetry >= 0.6.0, opentelemetry-extra, process, @@ -173,8 +174,8 @@ base, hashtables, containers,- opentelemetry >= 0.5.3,+ opentelemetry >= 0.6.0, opentelemetry-extra, hvega,- text-+ text,+ bytestring
src/OpenTelemetry/ChromeExporter.hs view
@@ -5,14 +5,14 @@ import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text.Encoding as TE import Data.Function import Data.HashMap.Strict as HM import Data.List (sortOn) import Data.Word import OpenTelemetry.Common-import OpenTelemetry.EventlogStreaming_Internal-import OpenTelemetry.Exporter import System.IO+import OpenTelemetry.EventlogStreaming_Internal newtype ChromeBeginSpan = ChromeBegin Span @@ -101,26 +101,21 @@ hPutStrLn f "\n]" hClose f )- metric_exporter =- Exporter- ( \metrics -> do- mapM_- ( \case- Gauge ts name value -> do- LBS.hPutStr f $- encode $- object- [ "ph" .= ("C" :: String),- "name" .= name,- "ts" .= (div ts 1000),- "args" .= object [name .= Number (fromIntegral value)]- ]- LBS.hPutStr f ",\n"- )- metrics- pure ExportSuccess- )- (pure ())+ metric_exporter <- aggregated $ Exporter+ ( \metrics -> do+ -- forM_ metrics $ \(AggregatedMetric (SomeInstrument (TE.decodeUtf8 . instrumentName -> name)) (MetricDatapoint ts value)) -> do+ forM_ metrics $ \(AggregatedMetric (CaptureInstrument _ (TE.decodeUtf8 -> name)) (MetricDatapoint ts value)) -> do+ LBS.hPutStr f $ encode $+ object+ [ "ph" .= ("C" :: String),+ "name" .= name,+ "ts" .= (div ts 1000),+ "args" .= object [name .= Number (fromIntegral value)]+ ]+ LBS.hPutStr f ",\n"+ pure ExportSuccess+ )+ (pure ()) pure (span_exporter, metric_exporter) data DoWeCollapseThreads = CollapseThreads | SplitThreads
src/OpenTelemetry/Common.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} module OpenTelemetry.Common where@@ -10,9 +13,13 @@ import qualified Data.Text as T import Data.Word import GHC.Generics-import OpenTelemetry.Exporter import OpenTelemetry.SpanContext import System.Clock+import Data.IORef (readIORef, modifyIORef, newIORef)+import Control.Monad+import Data.List (sortOn)+import qualified Data.ByteString as BS+import GHC.Int (Int8) type Timestamp = Word64 @@ -68,10 +75,43 @@ } deriving (Show, Eq) -data Metric- = Gauge !Timestamp !T.Text !Int+-- | Reflects the constructors of 'OpenTelemetry.Metrics_Internal.Instrument'+data InstrumentType+ = CounterType+ | UpDownCounterType+ | ValueRecorderType+ | SumObserverType+ | UpDownSumObserverType+ | ValueObserverType+ deriving (Show, Eq, Enum, Generic)+instance Hashable InstrumentType++data CaptureInstrument = CaptureInstrument+ { instrumentType :: !InstrumentType,+ instrumentName :: !BS.ByteString+ }+ deriving (Show, Eq, Generic)+instance Hashable CaptureInstrument++-- | Based on https://github.com/open-telemetry/opentelemetry-proto/blob/1a931b4b57c34e7fd8f7dddcaa9b7587840e9c08/opentelemetry/proto/metrics/v1/metrics.proto#L96-L107+data Metric = Metric+ { instrument :: !CaptureInstrument,+ datapoints :: ![MetricDatapoint Int]+ } deriving (Show, Eq) +data AggregatedMetric = AggregatedMetric+ { instrument :: !CaptureInstrument,+ datapoint :: !(MetricDatapoint Int)+ }+ deriving (Show, Eq)++data MetricDatapoint a = MetricDatapoint+ { timestamp :: !Timestamp,+ value :: !a+ }+ deriving (Show, Eq, Functor)+ spanTraceId :: Span -> TraceId spanTraceId Span {spanContext = SpanContext _ tid} = tid @@ -100,6 +140,63 @@ data OpenTelemetryConfig = OpenTelemetryConfig { otcSpanExporter :: Exporter Span }++data ExportResult+ = ExportSuccess+ | ExportFailedRetryable+ | ExportFailedNotRetryable+ deriving (Show, Eq)++data Exporter thing+ = Exporter+ { export :: [thing] -> IO ExportResult,+ shutdown :: IO ()+ }++readInstrumentTag :: Int8 -> Maybe InstrumentType+readInstrumentTag 1 = Just CounterType+readInstrumentTag 2 = Just UpDownCounterType+readInstrumentTag 3 = Just ValueRecorderType+readInstrumentTag 4 = Just SumObserverType+readInstrumentTag 5 = Just UpDownSumObserverType+readInstrumentTag 6 = Just ValueObserverType+readInstrumentTag _ = Nothing++additive :: InstrumentType -> Bool+additive CounterType = True+additive UpDownCounterType = True+additive ValueRecorderType = False+additive SumObserverType = True+additive UpDownSumObserverType = True+additive ValueObserverType = False++noopExporter :: Exporter whatever+noopExporter = Exporter (const (pure ExportFailedNotRetryable)) (pure ())++aggregated :: Exporter AggregatedMetric -> IO (Exporter Metric)+aggregated (Exporter export shutdown) = do+ -- We keep a mutable map of latest metric values. When a new datapoint comes+ -- in, it either replaces or gets added to the current value, based on whether+ -- the instrument is additive.+ currentValuesRef <- newIORef HM.empty+ return $ Exporter+ { export = \metrics -> do+ forM_ metrics $ \(Metric instrument datapoints) -> do+ forM_ (sortOn timestamp datapoints) $ \dp@(MetricDatapoint ts value) ->+ modifyIORef currentValuesRef $+ if additive (instrumentType instrument)+ then HM.alter+ (\case+ Nothing -> Just dp+ Just (MetricDatapoint _ oldValue) -> Just (MetricDatapoint ts $ oldValue+value))+ instrument+ else HM.insert instrument dp++ -- Read the latest value for each instrument+ currentValues <- readIORef currentValuesRef+ export [AggregatedMetric i (currentValues HM.! i) | Metric i _ <- metrics]+ , shutdown+ } now64 :: IO Timestamp now64 = do
src/OpenTelemetry/EventlogStreaming_Internal.hs view
@@ -6,7 +6,9 @@ import Control.Concurrent (threadDelay) import qualified Data.Binary.Get as DBG import Data.Bits+import Data.Int 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 qualified Data.IntMap as IM@@ -21,13 +23,14 @@ import GHC.Stack import OpenTelemetry.Common hiding (Event, Timestamp) import OpenTelemetry.Debug-import OpenTelemetry.Eventlog_Internal-import OpenTelemetry.Exporter import OpenTelemetry.SpanContext+import OpenTelemetry.Eventlog (InstrumentId, InstrumentName)+import Text.Printf+import qualified System.Random.SplitMix as R++import OpenTelemetry.Eventlog_Internal import System.Clock import System.IO-import qualified System.Random.SplitMix as R-import Text.Printf data WatDoOnEOF = StopOnEOF | SleepAndRetryOnEOF @@ -35,6 +38,7 @@ { originTimestamp :: !Timestamp, threadMap :: IM.IntMap ThreadId, spans :: HM.HashMap SpanId Span,+ instrumentMap :: HM.HashMap InstrumentId CaptureInstrument, traceMap :: HM.HashMap ThreadId TraceId, serial2sid :: HM.HashMap Word64 SpanId, thread2sid :: HM.HashMap ThreadId SpanId,@@ -43,13 +47,12 @@ counterEventsProcessed :: !Int, counterOpenTelemetryEventsProcessed :: !Int, counterSpansEmitted :: !Int,- threadCount :: !Int, randomGen :: R.SMGen } deriving (Show) initialState :: Word64 -> R.SMGen -> State-initialState timestamp = S timestamp mempty mempty mempty mempty mempty 0 0 0 0 0 0+initialState timestamp = S timestamp mempty mempty mempty mempty mempty mempty 0 0 0 0 0 data EventSource = EventLogHandle Handle WatDoOnEOF@@ -150,30 +153,24 @@ let trace_id = case m_trace_id of Just t -> t Nothing -> TId originTimestamp -- TODO: something more random- in ( st- { traceMap = HM.insert new_tid trace_id traceMap,- threadCount = threadCount + 1- },- [],- [Gauge now "threads" (threadCount + 1)]- )+ in (st { traceMap = HM.insert new_tid trace_id traceMap }+ , []+ , [Metric threadsI [MetricDatapoint now 1]]) (RunThread tid, Just cap, _) -> (st {threadMap = IM.insert cap tid threadMap}, [], []) (StopThread tid tstatus, Just cap, _) | isTerminalThreadStatus tstatus -> ( st- { threadMap = IM.delete cap threadMap,- traceMap = HM.delete tid traceMap,- threadCount = threadCount - 1+ { threadMap = IM.delete cap threadMap+ , traceMap = HM.delete tid traceMap },- [],- [Gauge now "threads" (threadCount - 1)]- )+ []+ , [Metric threadsI [MetricDatapoint now (-1)]]) (StartGC, _, _) -> (st {gcStartedAt = now}, [], [])- (HeapLive {liveBytes}, _, _) -> (st, [], [Gauge now "heap_live_bytes" $ fromIntegral liveBytes])+ (HeapLive {liveBytes}, _, _) -> (st, [], [Metric heapLiveBytesI [MetricDatapoint now $ fromIntegral liveBytes]]) (HeapAllocated {allocBytes}, (Just cap), _) ->- (st, [], [Gauge now ("cap_" <> T.pack (show cap) <> "_heap_alloc_bytes") $ fromIntegral allocBytes])+ (st, [], [Metric (heapAllocBytesI cap) [MetricDatapoint now $ fromIntegral allocBytes]]) (EndGC, _, _) -> let (span_id, randomGen') = R.nextWord64 randomGen sp =@@ -191,11 +188,24 @@ } spans' = fmap (\live_span -> live_span {spanNanosecondsSpentInGC = (now - gcStartedAt) + spanNanosecondsSpentInGC live_span}) spans st' = st {randomGen = randomGen', spans = spans'}- in (st', [sp], [Gauge now "gc" (fromIntegral $ now - gcStartedAt)])+ in (st', [sp], [Metric gcTimeI [MetricDatapoint now (fromIntegral $ now - gcStartedAt)]]) (parseOpenTelemetry -> Just ev', _, fromMaybe 1 -> tid) -> handleOpenTelemetryEventlogEvent ev' st (tid, now, m_trace_id) _ -> (st, [], [])+ where+ threadsI :: CaptureInstrument+ threadsI = CaptureInstrument UpDownSumObserverType "threads" + heapLiveBytesI :: CaptureInstrument+ heapLiveBytesI = CaptureInstrument ValueObserverType "heap_live_bytes"++ gcTimeI :: CaptureInstrument+ gcTimeI = CaptureInstrument SumObserverType "gc"++ heapAllocBytesI :: Int -> CaptureInstrument+ heapAllocBytesI cap = CaptureInstrument SumObserverType ("cap_" <> B8.pack (show cap) <> "_heap_alloc_bytes")++ isTerminalThreadStatus :: ThreadStopStatus -> Bool isTerminalThreadStatus ThreadFinished = True isTerminalThreadStatus _ = False@@ -208,6 +218,8 @@ | SetParentEv SpanInFlight SpanContext | SetTraceEv SpanInFlight TraceId | SetSpanEv SpanInFlight SpanId+ | DeclareInstrumentEv InstrumentType InstrumentId InstrumentName+ | MetricCaptureEv InstrumentId Int deriving (Show, Eq, Generic) handleOpenTelemetryEventlogEvent ::@@ -293,6 +305,11 @@ Just span_id -> let (st', sp) = emitSpan serial span_id st in (st', [sp {spanOperation = operation, spanStartedAt = now, spanThreadId = tid}], [])+ DeclareInstrumentEv iType iId iName ->+ (st { instrumentMap = HM.insert iId (CaptureInstrument iType iName) (instrumentMap st) }, [], [])+ MetricCaptureEv instrumentId val -> case HM.lookup instrumentId (instrumentMap st) of+ Just instrument -> (st, [], [Metric instrument [MetricDatapoint now val]])+ Nothing -> error $ "Undeclared instrument id: " ++ show instrumentId createSpan :: SpanId -> Span -> State -> State createSpan span_id sp st =@@ -362,38 +379,42 @@ parseText :: [T.Text] -> Maybe OpenTelemetryEventlogEvent parseText =- \case- ("ot2" : "begin" : "span" : serial_text : name) ->- let serial = read (T.unpack serial_text)- operation = T.intercalate " " name- in Just $ BeginSpanEv (SpanInFlight serial) (SpanName operation)- ["ot2", "end", "span", serial_text] ->- let serial = read (T.unpack serial_text)- in Just $ EndSpanEv (SpanInFlight serial)- ("ot2" : "set" : "tag" : serial_text : k : v) ->- let serial = read (T.unpack serial_text)- in Just $ TagEv (SpanInFlight serial) (TagName k) (TagVal $ T.unwords v)- ["ot2", "set", "traceid", serial_text, trace_id_text] ->- let serial = read (T.unpack serial_text)- trace_id = TId (read ("0x" <> T.unpack trace_id_text))- in Just $ SetTraceEv (SpanInFlight serial) trace_id- ["ot2", "set", "spanid", serial_text, new_span_id_text] ->- let serial = read (T.unpack serial_text)- span_id = (SId (read ("0x" <> T.unpack new_span_id_text)))- in Just $ SetSpanEv (SpanInFlight serial) span_id- ["ot2", "set", "parent", serial_text, trace_id_text, parent_span_id_text] ->- let trace_id = TId (read ("0x" <> T.unpack trace_id_text))- serial = read (T.unpack serial_text)- psid = SId (read ("0x" <> T.unpack parent_span_id_text))- in Just $- SetParentEv- (SpanInFlight serial)- (SpanContext psid trace_id)- ("ot2" : "add" : "event" : serial_text : k : v) ->- let serial = read (T.unpack serial_text)- in Just . EventEv (SpanInFlight serial) (EventName k) $ EventVal $ T.unwords v- ("ot2" : rest) -> error $ printf "Unrecognized %s" (show rest)- _ -> Nothing+ \case+ ("ot2" : "begin" : "span" : serial_text : name) ->+ let serial = read (T.unpack serial_text)+ operation = T.intercalate " " name+ in Just $ BeginSpanEv (SpanInFlight serial) (SpanName operation)+ ["ot2", "end", "span", serial_text] ->+ let serial = read (T.unpack serial_text)+ in Just $ EndSpanEv (SpanInFlight serial)+ ("ot2" : "set" : "tag" : serial_text : k : v) ->+ let serial = read (T.unpack serial_text)+ in Just $ TagEv (SpanInFlight serial) (TagName k) (TagVal $ T.unwords v)+ ["ot2", "set", "traceid", serial_text, trace_id_text] ->+ let serial = read (T.unpack serial_text)+ trace_id = TId (read ("0x" <> T.unpack trace_id_text))+ in Just $ SetTraceEv (SpanInFlight serial) trace_id+ ["ot2", "set", "spanid", serial_text, new_span_id_text] ->+ let serial = read (T.unpack serial_text)+ span_id = (SId (read ("0x" <> T.unpack new_span_id_text)))+ in Just $ SetSpanEv (SpanInFlight serial) span_id+ ["ot2", "set", "parent", serial_text, trace_id_text, parent_span_id_text] ->+ let trace_id = TId (read ("0x" <> T.unpack trace_id_text))+ serial = read (T.unpack serial_text)+ psid = SId (read ("0x" <> T.unpack parent_span_id_text))+ in Just $+ SetParentEv+ (SpanInFlight serial)+ (SpanContext psid trace_id)+ ("ot2" : "add" : "event" : serial_text : k : v) ->+ let serial = read (T.unpack serial_text)+ in Just . EventEv (SpanInFlight serial) (EventName k) $ EventVal $ T.unwords v+ ("ot2" : "metric" : "capture" : instrumentIdText : valStr) ->+ let instrumentId = read ("0x" ++ T.unpack instrumentIdText)+ val = read (T.unpack $ T.intercalate " " valStr)+ in Just $ MetricCaptureEv instrumentId val+ ("ot2" : rest) -> error $ printf "Unrecognized %s" (show rest)+ _ -> Nothing headerP :: DBG.Get (Maybe MsgType) headerP = do@@ -442,6 +463,13 @@ SET_SPAN_ID -> SetSpanEv <$> (SpanInFlight <$> DBG.getWord64le) <*> (SId <$> DBG.getWord64le)+ DECLARE_INSTRUMENT -> DeclareInstrumentEv+ <$> (instrumentTagP =<< DBG.getInt8)+ <*> DBG.getWord64le+ <*> (LBS.toStrict <$> DBG.getRemainingLazyByteString)+ METRIC_CAPTURE -> MetricCaptureEv+ <$> DBG.getWord64le+ <*> (fromIntegral <$> DBG.getInt64le) MsgType mti -> fail $ "Log event of type " ++ show mti ++ " is not supported" @@ -450,6 +478,15 @@ DBG.lookAheadM headerP >>= \case Nothing -> return Nothing Just msgType -> logEventBodyP msgType >>= return . Just++instrumentTagP :: MonadFail m => Int8 -> m InstrumentType+instrumentTagP 1 = return CounterType+instrumentTagP 2 = return UpDownCounterType+instrumentTagP 3 = return ValueRecorderType+instrumentTagP 4 = return SumObserverType+instrumentTagP 5 = return UpDownSumObserverType+instrumentTagP 6 = return ValueObserverType+instrumentTagP n = fail $ "Bad instrument tag: " ++ show n parseByteString :: B.ByteString -> Maybe OpenTelemetryEventlogEvent parseByteString = DBG.runGet logEventP . LBS.fromStrict
src/OpenTelemetry/ZipkinExporter.hs view
@@ -17,7 +17,6 @@ import Network.HTTP.Types import OpenTelemetry.Common import OpenTelemetry.Debug-import OpenTelemetry.Exporter import OpenTelemetry.SpanContext import System.IO.Unsafe import Text.Printf
unit-tests/Arbitrary.hs view
@@ -10,10 +10,12 @@ import qualified Data.Text as T import OpenTelemetry.Common import OpenTelemetry.Eventlog+import OpenTelemetry.Metrics_Internal import OpenTelemetry.EventlogStreaming_Internal import OpenTelemetry.SpanContext import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic+import Test.QuickCheck.Instances.ByteString() import TextShow newtype TextWithout0 = TextWithout0 T.Text@@ -44,7 +46,21 @@ deriving instance Arbitrary TraceId +instance Arbitrary SomeInstrument where+ arbitrary = oneof+ [ SomeInstrument <$> (Counter <$> arbitrary <*> arbitrary)+ , SomeInstrument <$> (UpDownCounter <$> arbitrary <*> arbitrary)+ , SomeInstrument <$> (ValueRecorder <$> arbitrary <*> arbitrary)+ , SomeInstrument <$> (SumObserver <$> arbitrary <*> arbitrary)+ , SomeInstrument <$> (UpDownSumObserver <$> arbitrary <*> arbitrary)+ , SomeInstrument <$> (ValueObserver <$> arbitrary <*> arbitrary)+ ]+ instance Arbitrary SpanContext where+ arbitrary = genericArbitrary+ shrink = genericShrink++instance Arbitrary InstrumentType where arbitrary = genericArbitrary shrink = genericShrink
unit-tests/LogEventSerializer.hs view
@@ -8,6 +8,7 @@ import OpenTelemetry.Common import OpenTelemetry.EventlogStreaming_Internal import qualified OpenTelemetry.Eventlog_Internal as BE+import OpenTelemetry.Metrics_Internal logEventToBs :: OpenTelemetryEventlogEvent -> BS.ByteString logEventToBs = LBS.toStrict . toLazyByteString . logEventToBuilder@@ -23,6 +24,17 @@ logEventToBuilder (SetParentEv locId spnCtx) = BE.builder_setParentSpanContext locId spnCtx logEventToBuilder (SetTraceEv localId traceId) = BE.builder_setTraceId localId traceId logEventToBuilder (SetSpanEv localId spanId') = BE.builder_setSpanId localId spanId'+logEventToBuilder (DeclareInstrumentEv tag iId iName) = case declareInstrumentEvToInstrument tag iId iName of+ SomeInstrument i -> BE.builder_declareInstrument i+logEventToBuilder (MetricCaptureEv i val) = BE.builder_captureMetric i val logEventToUserBinaryMessage :: OpenTelemetryEventlogEvent -> EventInfo logEventToUserBinaryMessage = UserBinaryMessage . logEventToBs++declareInstrumentEvToInstrument :: InstrumentType -> InstrumentId -> InstrumentName -> SomeInstrument+declareInstrumentEvToInstrument CounterType iid name = SomeInstrument $ Counter name iid+declareInstrumentEvToInstrument UpDownCounterType iid name = SomeInstrument $ UpDownCounter name iid+declareInstrumentEvToInstrument ValueRecorderType iid name = SomeInstrument $ ValueRecorder name iid+declareInstrumentEvToInstrument SumObserverType iid name = SomeInstrument $ SumObserver name iid+declareInstrumentEvToInstrument UpDownSumObserverType iid name = SomeInstrument $ UpDownSumObserver name iid+declareInstrumentEvToInstrument ValueObserverType iid name = SomeInstrument $ ValueObserver name iid