hotel-california 0.0.2.0 → 0.0.3.0

raw patch · 4 files changed

+65/−24 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−1
• hotel-california.cabal +1/−1
• src/HotelCalifornia/Tracing.hs +1/−8
• src/HotelCalifornia/Tracing/TraceParent.hs +57/−14

@@ -6,7 +6,12 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). -## Unreleased+## 0.0.3.0 - 2023-09-18++- [#13](https://github.com/parsonsmatt/hotel-california/pull/13)+    - The `hotel` command will now propagate the `BAGGAGE` environment variable,+      according to the [W3C working draft](https://www.w3.org/TR/baggage/),+      similar how it already propagates `TRACEPARENT` and `TRACESTATE`.  ## 0.0.2.0 - 2023-09-15 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hotel-california-version:        0.0.2.0+version:        0.0.3.0 description:    Please see the README on GitHub at <https://github.com/parsonsmatt/hotel-california#readme> homepage:       https://github.com/parsonsmatt/hotel-california#readme bug-reports:    https://github.com/parsonsmatt/hotel-california/issues

@@ -33,7 +33,7 @@ withGlobalTracing act = do     void $ attachContext Context.empty     liftIO setParentSpanFromEnvironment-    bracket initializeTracing shutdownTracerProvider $ \_ -> do+    bracket (liftIO initializeGlobalTracerProvider) shutdownTracerProvider $ \_ -> do         -- note: this is not in a span since we don't have a root span yet so it         -- would not wind up in the trace in a helpful way anyway         void $@@ -50,13 +50,6 @@         act   where     initializationTimeout = secondsToNominalDiffTime 3--initializeTracing :: MonadUnliftIO m => m TracerProvider-initializeTracing = do-  (processors, tracerOptions') <- liftIO getTracerProviderInitializationOptions-  provider <- createTracerProvider processors tracerOptions'-  setGlobalTracerProvider provider-  pure provider  globalTracer :: MonadIO m => m Tracer globalTracer = getGlobalTracerProvider >>= \tp -> pure $ makeTracer tp "hotel-california" tracerOptions

@@ -1,16 +1,22 @@ -- | This module defines the type of 'TraceParent' which can be parsed-module HotelCalifornia.Tracing.TraceParent where+module HotelCalifornia.Tracing.TraceParent+    ( spanContextFromEnvironment+    , baggageFromEnvironment+    , spanContextToEnvironment+    , setParentSpanFromEnvironment+    ) where -import Data.Foldable (for_) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.Text.Encoding as TE import qualified Data.Text as Text+import OpenTelemetry.Baggage (Baggage) import OpenTelemetry.Propagator.W3CTraceContext import OpenTelemetry.Trace.Core (SpanContext, isRemote, wrapSpanContext, Span) import System.Environment import OpenTelemetry.Context.ThreadLocal import qualified OpenTelemetry.Context as Ctxt+import qualified OpenTelemetry.Propagator.W3CBaggage as W3CBaggage  -- | This function looks up the @TRACEPARENT@ and @TRACECONTEXT@ environment -- variables and returns a @'Maybe' 'SpanContext'@ constructed from them.@@ -19,31 +25,68 @@     mtraceParent <- lookupEnvBS "TRACEPARENT"     mtraceContext <- lookupEnvBS "TRACESTATE"     pure $ decodeSpanContext mtraceParent mtraceContext-  where-    lookupEnvBS :: String -> IO (Maybe BS.ByteString)-    lookupEnvBS str = fmap (TE.encodeUtf8 . Text.pack) <$> lookupEnv str +-- | This function looks up the @BAGGAGE@ environment variable and returns a+-- @'Maybe' 'Baggage'@ constructed from that.+baggageFromEnvironment :: IO (Maybe Baggage)+baggageFromEnvironment = do+    mBaggageBytes <- lookupEnvBS "BAGGAGE"++    let mBaggage = do+            baggageBytes <- mBaggageBytes+            W3CBaggage.decodeBaggage baggageBytes++    pure mBaggage++lookupEnvBS :: String -> IO (Maybe BS.ByteString)+lookupEnvBS str = fmap (TE.encodeUtf8 . Text.pack) <$> lookupEnv str+ -- | This function takes the given 'Span' and converts it into a list of -- environment variables consisting of: -- -- @ -- [ ( "TRACEPARENT", traceParent) -- , ( "TRACESTATE", traceState)+-- , ( "BAGGAGE", traceParent) -- ] -- @ spanContextToEnvironment :: Span -> IO [(String, String)]-spanContextToEnvironment spanContext = do-    (traceParent, traceState) <- encodeSpanContext spanContext-    pure-        [ ("TRACEPARENT", BS8.unpack traceParent)-        , ("TRACESTATE", BS8.unpack traceState)-        ]+spanContextToEnvironment span_ = do+    (traceParent, traceState) <- encodeSpanContext span_ +    context <- getContext +    let baggageVariables =+            case Ctxt.lookupBaggage context of+                Just baggage ->+                    [("BAGGAGE", BS8.unpack (W3CBaggage.encodeBaggage baggage))]+                Nothing ->+                    []++    pure+        (   [ ("TRACEPARENT", BS8.unpack traceParent)+            , ("TRACESTATE", BS8.unpack traceState)+            ]+        <>  baggageVariables+        )+ -- | This function should be called after you've initialized and attached the -- thread local 'Context'. setParentSpanFromEnvironment :: IO () setParentSpanFromEnvironment = do-    mspanContext <- spanContextFromEnvironment-    for_ mspanContext \spanContext -> do-        adjustContext $ Ctxt.insertSpan (wrapSpanContext (spanContext {isRemote = True}))+    mSpanContext <- spanContextFromEnvironment+    mBaggage <- baggageFromEnvironment++    let insertSpanContext =+            case mSpanContext of+                Nothing ->+                    id+                Just spanContext ->+                    Ctxt.insertSpan (wrapSpanContext spanContext{ isRemote = True })++    let insertBaggage =+            case mBaggage of+                Nothing      -> id+                Just baggage -> Ctxt.insertBaggage baggage++    adjustContext (insertBaggage . insertSpanContext)