opentelemetry 0.1.0 → 0.2.0
raw patch · 8 files changed
+25/−91 lines, 8 files
Files
- just-some-usage-code-that-must-compile/SomeUsageOfExplicitApi.hs +0/−28
- just-some-usage-code-that-must-compile/SomeUsageOfImplicitApi.hs +1/−1
- opentelemetry.cabal +1/−3
- src/OpenTelemetry/Common.hs +3/−3
- src/OpenTelemetry/Explicit.hs +0/−49
- src/OpenTelemetry/Implicit.hs +2/−3
- src/OpenTelemetry/Propagation.hs +1/−2
- unit-tests/TestCommon.hs +17/−2
− just-some-usage-code-that-must-compile/SomeUsageOfExplicitApi.hs
@@ -1,28 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module SomeUsageOfExplicitApi where--import Control.Concurrent-import OpenTelemetry.Explicit-import OpenTelemetry.FileExporter--main :: IO ()-main = do- exporter <- createFileSpanExporter "helloworld.trace"- ot <- createOpenTelemetryClient exporter- --- mainSpan <- startRootSpan ot "main"- threadDelay 10000- warmUpSpan <- startChildSpan ot mainSpan "warm up the cache"- threadDelay 5000- addEvent ot warmUpSpan "still cold"- threadDelay 10000- addEvent ot warmUpSpan "warm now"- setTag ot warmUpSpan "size" 9001- endSpan ot warmUpSpan- dataScienceSpan <- startChildSpan ot mainSpan "perform data science"- threadDelay 100000- setTag ot dataScienceSpan "reviews" 0- endSpan ot dataScienceSpan- threadDelay 10000- endSpan ot mainSpan
just-some-usage-code-that-must-compile/SomeUsageOfImplicitApi.hs view
@@ -43,7 +43,7 @@ addEvent "log" "rpc roundtrip end" withSpan "project" $ do -- Connecting spans across threads requires some manual plumbing- sp <- getCurrentActiveSpan+ Just sp <- getCurrentActiveSpan asyncWork <- async $ withChildSpanOf sp "data science" $ do threadDelay 1000000 pure 42
opentelemetry.cabal view
@@ -2,7 +2,7 @@ name: opentelemetry description: The OpenTelemetry Haskell Client https://opentelemetry.io category: OpenTelemetry-version: 0.1.0+version: 0.2.0 license-file: LICENSE license: Apache-2.0 author: Dmitry Ivanov@@ -63,7 +63,6 @@ exposed-modules: OpenTelemetry.Common OpenTelemetry.Debug- OpenTelemetry.Explicit OpenTelemetry.FileExporter OpenTelemetry.Implicit OpenTelemetry.Propagation@@ -74,7 +73,6 @@ main-is: Main.hs other-modules: SomeUsageOfImplicitApi- SomeUsageOfExplicitApi hs-source-dirs: just-some-usage-code-that-must-compile build-depends: base,
src/OpenTelemetry/Common.hs view
@@ -80,6 +80,9 @@ instance ToTagValue String where toTagValue = StringTagValue . T.pack +instance ToTagValue T.Text where+ toTagValue = StringTagValue+ instance ToTagValue Bool where toTagValue = BoolTagValue @@ -98,9 +101,6 @@ spanParentId :: Maybe SpanId } deriving (Show, Eq)--emptySpan :: Span-emptySpan = Span (SpanContext (SId 0) (TId 0)) "" 0 0 mempty mempty OK Nothing spanTraceId :: Span -> TraceId spanTraceId Span {spanContext = SpanContext _ tid} = tid
− src/OpenTelemetry/Explicit.hs
@@ -1,49 +0,0 @@-module OpenTelemetry.Explicit- ( startRootSpan,- startChildSpan,- endSpan,- setTag,- addEvent,- createOpenTelemetryClient,- )-where--import qualified Data.Text as T-import GHC.Conc-import OpenTelemetry.Common-import System.Random--data Client- = Client- { cTracer :: Tracer ThreadId,- cSpanExporter :: Exporter Span- }--startRootSpan :: Client -> T.Text -> IO Span-startRootSpan _tracer name = do- timestamp <- now64- sid <- randomIO- pure $! Span (SpanContext (SId sid) (TId sid)) name timestamp 0 mempty mempty OK Nothing--startChildSpan :: Client -> Span -> T.Text -> IO Span-startChildSpan _tracer parent name = do- timestamp <- now64- sid <- randomIO- pure $! Span (SpanContext (SId sid) (spanTraceId parent)) name timestamp 0 mempty mempty OK (Just $ spanId parent)--endSpan :: Client -> Span -> IO ()-endSpan _tracer sp = do- timestamp <- now64- pure $! sp {spanFinishedAt = timestamp}- pure ()--setTag :: Monad m => Client -> Span -> T.Text -> value -> m ()-setTag _tracer _span _key _value = pure ()--addEvent :: Monad m => Client -> Span -> T.Text -> m ()-addEvent _tracer _span _name = pure ()--createOpenTelemetryClient :: Exporter Span -> IO Client-createOpenTelemetryClient e = do- t <- createTracer- pure $ Client t e
src/OpenTelemetry/Implicit.hs view
@@ -8,7 +8,6 @@ import Control.Monad.IO.Class import qualified Data.HashMap.Strict as HM import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Maybe import qualified Data.Text as T import OpenTelemetry.Common import OpenTelemetry.FileExporter@@ -122,11 +121,11 @@ GlobalSharedMutableState {..} <- liftIO $ readMVar globalSharedMutableState pure $ spanContext <$> tracerGetCurrentActiveSpan gTracer tid -getCurrentActiveSpan :: MonadIO m => m Span+getCurrentActiveSpan :: MonadIO m => m (Maybe Span) getCurrentActiveSpan = do tid <- liftIO myThreadId GlobalSharedMutableState {..} <- liftIO $ readMVar globalSharedMutableState- pure $ fromMaybe emptySpan $ tracerGetCurrentActiveSpan gTracer tid+ pure $ tracerGetCurrentActiveSpan gTracer tid modifyCurrentSpan :: MonadIO m => (Span -> Span) -> m () modifyCurrentSpan f = liftIO $ do
src/OpenTelemetry/Propagation.hs view
@@ -19,8 +19,7 @@ extractSpanContextFromHeaders :: (IsString key, Eq key) => [(key, BS.ByteString)] -> Maybe SpanContext extractSpanContextFromHeaders headers = case find ((== "traceparent") . fst) headers of- Just (_, value) -> case parseSpanContext value of- Just c -> Just c+ Just (_, (parseSpanContext -> mctx)) -> mctx _ -> Nothing parseSpanContext :: BS.ByteString -> Maybe SpanContext
unit-tests/TestCommon.hs view
@@ -1,19 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}+ module TestCommon where import Data.Word import OpenTelemetry.Common +mkTestSpan :: Word64 -> Word64 -> Span+mkTestSpan sid tid =+ Span+ { spanContext = SpanContext (SId sid) (TId tid),+ spanStartedAt = 0,+ spanFinishedAt = 10,+ spanTags = mempty,+ spanEvents = mempty,+ spanStatus = OK,+ spanOperation = "foo",+ spanParentId = Nothing+ }+ prop_tracer_push_does_something :: Word64 -> Word64 -> Int -> Bool prop_tracer_push_does_something sid tid threadid = let tracer0 = Tracer mempty- sp0 = emptySpan {spanContext = SpanContext (SId sid) (TId tid)}+ sp0 = mkTestSpan sid tid tracer1 = tracerPushSpan tracer0 threadid sp0 in tracer0 /= tracer1 prop_tracer_push_pop :: Word64 -> Word64 -> Int -> Bool prop_tracer_push_pop sid tid threadid = let tracer0 = Tracer mempty- sp0 = emptySpan {spanContext = SpanContext (SId sid) (TId tid)}+ sp0 = mkTestSpan sid tid tracer1 = tracerPushSpan tracer0 threadid sp0 (Just sp1, tracer2) = tracerPopSpan tracer1 threadid in tracer0 == tracer2 && sp0 == sp1