diff --git a/opentelemetry-extra.cabal b/opentelemetry-extra.cabal --- a/opentelemetry-extra.cabal +++ b/opentelemetry-extra.cabal @@ -2,7 +2,7 @@ name: opentelemetry-extra description: The OpenTelemetry Haskell Client https://opentelemetry.io category: OpenTelemetry -version: 0.5.2 +version: 0.5.3 license-file: LICENSE license: Apache-2.0 author: Dmitry Ivanov @@ -63,7 +63,7 @@ http-client, http-client-tls, http-types, - opentelemetry >= 0.5.2, + opentelemetry >= 0.5.3, random >= 1.1, scientific, text-show, @@ -97,8 +97,9 @@ bytestring, ghc-events, hashable, - opentelemetry >= 0.5.2, + opentelemetry >= 0.5.3, opentelemetry-extra, + splitmix, tasty, tasty-discover, tasty-hunit, @@ -120,7 +121,7 @@ filepath, http-client, http-client-tls, - opentelemetry >= 0.5.2, + opentelemetry >= 0.5.3, opentelemetry-extra, text, typed-process @@ -139,7 +140,7 @@ build-depends: base, gauge >= 0.2.4, - opentelemetry >= 0.5.2, + opentelemetry >= 0.5.3, executable eventlog-to-chrome import: options @@ -149,7 +150,7 @@ base, exceptions, clock, - opentelemetry >= 0.5.2, + opentelemetry >= 0.5.3, opentelemetry-extra, executable eventlog-to-tracy @@ -160,7 +161,7 @@ base, clock, directory, - opentelemetry >= 0.5.2, + opentelemetry >= 0.5.3, opentelemetry-extra, process, @@ -172,7 +173,7 @@ base, hashtables, containers, - opentelemetry >= 0.5.2, + opentelemetry >= 0.5.3, opentelemetry-extra, hvega, text diff --git a/src/OpenTelemetry/EventlogStreaming_Internal.hs b/src/OpenTelemetry/EventlogStreaming_Internal.hs --- a/src/OpenTelemetry/EventlogStreaming_Internal.hs +++ b/src/OpenTelemetry/EventlogStreaming_Internal.hs @@ -192,9 +192,6 @@ 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)]) - -- (HeapAllocated {allocBytes}, _, Just tid) -> - -- (modifySpan tid (addEvent now "heap_alloc_bytes" (showT allocBytes)) st, [], []) - (parseOpenTelemetry -> Just ev', _, fromMaybe 1 -> tid) -> handleOpenTelemetryEventlogEvent ev' st (tid, now, m_trace_id) _ -> (st, [], []) @@ -270,13 +267,7 @@ spanNanosecondsSpentInGC = 0, spanParentId = parent } - in ( st' - { spans = HM.insert span_id sp $ spans st, - thread2sid = HM.insert tid span_id $ thread2sid st - }, - [], - [] - ) + in (createSpan span_id sp st', [], []) Just span_id -> let (st', sp) = emitSpan serial span_id st in (st', [sp {spanFinishedAt = now}], []) @@ -298,17 +289,18 @@ spanNanosecondsSpentInGC = 0, spanParentId = parent } - in ( st' - { spans = HM.insert span_id sp (spans st), - thread2sid = HM.insert tid span_id (thread2sid st) - }, - [], - [] - ) + in (createSpan span_id sp st', [], []) Just span_id -> let (st', sp) = emitSpan serial span_id st in (st', [sp {spanOperation = operation, spanStartedAt = now, spanThreadId = tid}], []) +createSpan :: SpanId -> Span -> State -> State +createSpan span_id sp st = + st + { spans = HM.insert span_id sp (spans st), + thread2sid = HM.insert (spanThreadId sp) span_id (thread2sid st) + } + emitSpan :: Word64 -> SpanId -> State -> (State, Span) emitSpan serial span_id st = case (HM.lookup serial $ serial2sid st, HM.lookup span_id $ spans st) of @@ -362,9 +354,11 @@ } inventSpanId :: Word64 -> State -> (State, SpanId) -inventSpanId serial st = (st {serial2sid = HM.insert serial sid (serial2sid st)}, sid) +inventSpanId serial st = (st', sid) where - sid = SId serial -- TODO: use random generator instead + S {serial2sid, randomGen} = st + (SId -> sid, randomGen') = R.nextWord64 randomGen + st' = st {serial2sid = HM.insert serial sid serial2sid, randomGen = randomGen'} parseText :: [T.Text] -> Maybe OpenTelemetryEventlogEvent parseText = @@ -416,7 +410,7 @@ lastStringP = (TE.decodeUtf8 . LBS.toStrict) <$> DBG.getRemainingLazyByteString stringP :: Word32 -> DBG.Get T.Text -stringP len = TE.decodeUtf8 <$> DBG.getByteString (fromIntegral len) +stringP len = TE.decodeUtf8 <$> DBG.getByteString (fromIntegral len) logEventBodyP :: MsgType -> DBG.Get OpenTelemetryEventlogEvent logEventBodyP msgType = diff --git a/unit-tests/TestEventlogStreaming.hs b/unit-tests/TestEventlogStreaming.hs --- a/unit-tests/TestEventlogStreaming.hs +++ b/unit-tests/TestEventlogStreaming.hs @@ -14,9 +14,13 @@ import OpenTelemetry.Eventlog import OpenTelemetry.EventlogStreaming_Internal import OpenTelemetry.SpanContext +import qualified System.Random.SplitMix as R import Test.QuickCheck import TextShow +smgen0 :: R.SMGen +smgen0 = R.mkSMGen 0 + processEvents :: [Event] -> State -> (State, [Span], [Metric]) processEvents events st0 = foldl' go (st0, [], []) events where @@ -31,7 +35,7 @@ [ Event 0 (logEventToUserBinaryMessage $ BeginSpanEv span_serial_number spanName) (Just 0), Event 42 (logEventToUserBinaryMessage $ EndSpanEv span_serial_number) (Just 0) ] - (_end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 (error "randomGen seed")) + (_end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 smgen0) in length emitted_spans === length spans prop_user_specified_span_ids_are_used :: [(SpanInFlight, SpanId, SpanName)] -> Property @@ -42,7 +46,7 @@ Event 1 (logEventToUserBinaryMessage $ SetSpanEv span_serial_number sid) (Just 0), Event 42 (logEventToUserBinaryMessage $ EndSpanEv span_serial_number) (Just 0) ] - (_end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 (error "randomGen seed")) + (_end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 smgen0) in sort (map (\(_, x, _) -> x) spans) === sort (map spanId emitted_spans) prop_user_specified_things_are_used :: [(SpanInFlight, SpanId, SpanName)] -> Property @@ -59,7 +63,7 @@ Event 4 (logEventToUserBinaryMessage $ EventEv span_serial_number (EventName "message") (EventVal $ showt sid')) (Just 0), Event 42 (logEventToUserBinaryMessage $ EndSpanEv span_serial_number) (Just 0) ] - (_end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 (error "randomGen seed")) + (_end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 smgen0) corresponding_span_was_emitted (_serial, SId sid, _thread_id) = emitted_spans & filter @@ -90,7 +94,7 @@ Event 1 (logEventToUserBinaryMessage $ BeginSpanEv serial $ SpanName $ showt serial) (Just 0) convert_end serial = Event 42 (logEventToUserBinaryMessage $ EndSpanEv serial) (Just 0) - (_end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 (error "randomGen seed")) + (_end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 smgen0) check_relationship (sp, psp) = spanParentId sp === Just (spanId psp) in conjoin $ map check_relationship (zip (tail emitted_spans) emitted_spans) @@ -104,7 +108,7 @@ Event 4 (RunThread end_tid) (Just end_cap), Event 5 (logEventToUserBinaryMessage $ EndSpanEv serial) (Just end_cap) ] - (end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 (error "randomGen seed")) + (end_state, emitted_spans, _emitted_metrics) = processEvents input_events (initialState 0 smgen0) in conjoin [ length emitted_spans === 1, spanOperation (head emitted_spans) === showt serial,