packages feed

hs-opentelemetry-propagator-b3 (empty) → 0.0.1.0

raw patch · 8 files changed

+473/−0 lines, 8 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, hs-opentelemetry-api, hs-opentelemetry-propagator-b3, http-types, memory, primitive, text

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for hs-opentelemetry-propagator-b3++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ian Duncan (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ian Duncan nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# hs-opentelemetry-propagator-b3
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple+++main = defaultMain
+ hs-opentelemetry-propagator-b3.cabal view
@@ -0,0 +1,66 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name:               hs-opentelemetry-propagator-b3+version:            0.0.1.0+synopsis:           Trace propagation via HTTP headers following the b3 tracestate spec.+description:        Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/propagators/b3#readme>+category:           OpenTelemetry, Tracing, Web+homepage:           https://github.com/iand675/hs-opentelemetry#readme+bug-reports:        https://github.com/iand675/hs-opentelemetry/issues+author:             Ian Duncan+maintainer:         ian@iankduncan.com+copyright:          2021 Ian Duncan+license:            BSD3+license-file:       LICENSE+build-type:         Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/iand675/hs-opentelemetry++library+  exposed-modules:+      OpenTelemetry.Propagator.B3+      OpenTelemetry.Propagator.B3.Internal+  other-modules:+      Paths_hs_opentelemetry_propagator_b3+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      attoparsec+    , base >=4.7 && <5+    , bytestring+    , hs-opentelemetry-api ==0.0.3.*+    , http-types+    , memory+    , primitive+    , text+  default-language: Haskell2010++test-suite hs-opentelemetry-propagator-b3-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_hs_opentelemetry_propagator_b3+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      attoparsec+    , base >=4.7 && <5+    , bytestring+    , hs-opentelemetry-api ==0.0.3.*+    , hs-opentelemetry-propagator-b3+    , http-types+    , memory+    , primitive+    , text+  default-language: Haskell2010
+ src/OpenTelemetry/Propagator/B3.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}++{- | B3 Propagation Requirements:+ https://github.com/openzipkin/b3-propagation+ https://github.com/open-telemetry/opentelemetry-specification/blob/main/specification/context/api-propagators.md#b3-requirements+-}+module OpenTelemetry.Propagator.B3 (+  b3TraceContextPropagator,+  b3MultiTraceContextPropagator,+) where++--------------------------------------------------------------------------------++import Control.Applicative ((<|>))+import Data.ByteString (ByteString)+import Data.List (intersperse)+import Data.Maybe (catMaybes, fromMaybe)+import qualified Data.Text.Encoding as Text+import Network.HTTP.Types (HeaderName, RequestHeaders, ResponseHeaders)+import OpenTelemetry.Common (TraceFlags (..))+import OpenTelemetry.Context (Context)+import qualified OpenTelemetry.Context as Context+import OpenTelemetry.Propagator (Propagator (..))+import OpenTelemetry.Propagator.B3.Internal+import qualified OpenTelemetry.Trace.Core as Core+import qualified OpenTelemetry.Trace.TraceState as TS+import Prelude+++--------------------------------------------------------------------------------++b3TraceContextPropagator :: Propagator Context RequestHeaders ResponseHeaders+b3TraceContextPropagator =+  Propagator+    { propagatorNames = ["B3 Trace Context"]+    , extractor = \hs c ->+        case b3Extractor hs of+          Nothing -> pure c+          Just spanContext' -> pure $ Context.insertSpan (Core.wrapSpanContext spanContext') c+    , injector = \c hs ->+        case Context.lookupSpan c of+          Nothing -> pure hs+          Just span' -> do+            Core.SpanContext {traceId, spanId, traceState = TS.TraceState traceState} <- Core.getSpanContext span'+            let traceIdValue = encodeTraceId traceId+                spanIdValue = encodeSpanId spanId+                samplingStateValue = lookup (TS.Key "sampling-state") traceState >>= samplingStateFromValue >>= printSamplingStateSingle+                value = mconcat $ intersperse "-" $ [traceIdValue, spanIdValue] <> catMaybes [Text.encodeUtf8 <$> samplingStateValue]++            pure $ (b3Header, value) : hs+    }+++b3MultiTraceContextPropagator :: Propagator Context RequestHeaders ResponseHeaders+b3MultiTraceContextPropagator =+  Propagator+    { propagatorNames = ["B3 Multi Trace Context"]+    , extractor = \hs c -> do+        case b3Extractor hs of+          Nothing -> pure c+          Just spanContext' -> pure $ Context.insertSpan (Core.wrapSpanContext spanContext') c+    , injector = \c hs ->+        case Context.lookupSpan c of+          Nothing -> pure hs+          Just span' -> do+            Core.SpanContext {traceId, spanId, traceState = TS.TraceState traceState} <- Core.getSpanContext span'+            let traceIdValue = encodeTraceId traceId+                spanIdValue = encodeSpanId spanId+                samplingStateValue = lookup (TS.Key "sampling-state") traceState >>= samplingStateFromValue >>= printSamplingStateMulti++            pure $+              (xb3TraceIdHeader, traceIdValue)+                : (xb3SpanIdHeader, spanIdValue)+                : hs+                ++ catMaybes [fmap Text.encodeUtf8 <$> samplingStateValue]+    }+++--------------------------------------------------------------------------------++{- | For both @B3@ and @B3 Multi@ formats, we must attempt single and+ multi header extraction:+ https://github.com/open-telemetry/opentelemetry-specification/blob/main/specification/context/api-propagators.md#configuration+-}+b3Extractor :: [(HeaderName, ByteString)] -> Maybe Core.SpanContext+b3Extractor hs = b3SingleExtractor hs <|> b3MultiExtractor hs+++b3SingleExtractor :: [(HeaderName, ByteString)] -> Maybe Core.SpanContext+b3SingleExtractor hs = do+  B3SingleHeader {..} <- decodeB3SingleHeader =<< Prelude.lookup b3Header hs++  let traceFlags = if samplingState == Accept || samplingState == Debug then TraceFlags 1 else TraceFlags 0++  pure $+    Core.SpanContext+      { traceId = traceId+      , spanId = spanId+      , isRemote = True+      , traceFlags = traceFlags+      , traceState = TS.TraceState [(TS.Key "sampling-state", samplingStateToValue samplingState)]+      }+++b3MultiExtractor :: [(HeaderName, ByteString)] -> Maybe Core.SpanContext+b3MultiExtractor hs = do+  traceId <- decodeXb3TraceIdHeader =<< Prelude.lookup xb3TraceIdHeader hs+  spanId <- decodeXb3SpanIdHeader =<< Prelude.lookup xb3SpanIdHeader hs++  let sampled = decodeXb3SampledHeader =<< Prelude.lookup xb3SampledHeader hs+      debug = decodeXb3FlagsHeader =<< Prelude.lookup xb3FlagsHeader hs+      -- NOTE: Debug implies Accept (https://github.com/openzipkin/b3-propagation#debug-flag)+      samplingState = fromMaybe Defer $ sampled <|> debug+  let traceFlags = if samplingState == Accept || samplingState == Debug then TraceFlags 1 else TraceFlags 0++  pure $+    Core.SpanContext+      { traceId = traceId+      , spanId = spanId+      , isRemote = True+      , traceFlags = traceFlags+      , traceState = TS.TraceState [(TS.Key "sampling-state", samplingStateToValue samplingState)]+      }
+ src/OpenTelemetry/Propagator/B3/Internal.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}++{- | Conversion of the hs-opentelemetry internal representation of the trace ID and the span ID and the B3 header representation of them each other.++|----------------+---------------------------------------+------------------------------|+|                | Trace ID                              | Span ID                      |+|----------------+---------------------------------------+------------------------------|+| Internal       | 128-bit integer                       | 64-bit integer               |+| B3 Header      | Hex text of 64-bit or 128-bit integer | Hex text of 64-bit integer   |+|----------------+---------------------------------------+------------------------------|+-}+module OpenTelemetry.Propagator.B3.Internal (+  -- * Encoders+  encodeTraceId,+  encodeSpanId,++  -- * Decoders+  decodeXb3TraceIdHeader,+  decodeXb3SpanIdHeader,+  decodeXb3SampledHeader,+  decodeXb3FlagsHeader,+  decodeB3SampleHeader,+  decodeB3SingleHeader,++  -- * B3SingleHeader+  B3SingleHeader (..),++  -- * SampleState+  SamplingState (..),++  -- ** Conversions+  samplingStateToValue,+  samplingStateFromValue,+  printSamplingStateSingle,+  printSamplingStateMulti,++  -- * Header Keys+  b3Header,+  xb3TraceIdHeader,+  xb3SpanIdHeader,+  xb3SampledHeader,+  xb3FlagsHeader,+) where++--------------------------------------------------------------------------------++import Control.Applicative ((<|>))+import Control.Monad (void)+import qualified Data.Attoparsec.ByteString.Char8 as Atto+import Data.ByteString (ByteString)+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Data.Char as C+import Data.Functor (($>))+import Data.Text (Text)+import Network.HTTP.Types (HeaderName)+import OpenTelemetry.Trace.Id (Base (..), SpanId, TraceId, baseEncodedToSpanId, baseEncodedToTraceId, spanIdBaseEncodedBuilder, traceIdBaseEncodedBuilder)+import OpenTelemetry.Trace.TraceState (Value (..))+++--------------------------------------------------------------------------------++encodeTraceId ::+  TraceId ->+  -- | ASCII text of 64-bit integer+  ByteString+encodeTraceId = BL.toStrict . BB.toLazyByteString . traceIdBaseEncodedBuilder Base16+++encodeSpanId ::+  SpanId ->+  -- | ASCII text of 64-bit integer+  ByteString+encodeSpanId = BL.toStrict . BB.toLazyByteString . spanIdBaseEncodedBuilder Base16+++--------------------------------------------------------------------------------++decodeXb3TraceIdHeader :: ByteString -> Maybe TraceId+decodeXb3TraceIdHeader tp = case Atto.parseOnly parserTraceId tp of+  Left _ -> Nothing+  Right traceId -> Just traceId+++decodeXb3SpanIdHeader :: ByteString -> Maybe SpanId+decodeXb3SpanIdHeader tp = case Atto.parseOnly parserSpanId tp of+  Left _ -> Nothing+  Right spanId -> Just spanId+++decodeXb3SampledHeader :: ByteString -> Maybe SamplingState+decodeXb3SampledHeader tp = case Atto.parseOnly parserXb3Sampled tp of+  Left _ -> Nothing+  Right sampled -> Just sampled+++decodeXb3FlagsHeader :: ByteString -> Maybe SamplingState+decodeXb3FlagsHeader tp = case Atto.parseOnly parserXb3Flags tp of+  Left _ -> Nothing+  Right flags -> Just flags+++decodeB3SingleHeader :: ByteString -> Maybe B3SingleHeader+decodeB3SingleHeader tp = case Atto.parseOnly parserB3Single tp of+  Left _ -> Nothing+  Right b3 -> Just b3+++decodeB3SampleHeader :: ByteString -> Maybe SamplingState+decodeB3SampleHeader tp = case Atto.parseOnly parserSamplingState tp of+  Left _ -> Nothing+  Right b3 -> Just b3+++--------------------------------------------------------------------------------++parserTraceId :: Atto.Parser TraceId+parserTraceId = do+  traceIdBs <- Atto.takeWhile C.isHexDigit+  case baseEncodedToTraceId Base16 traceIdBs of+    Left err -> fail err+    Right traceId -> pure traceId+++parserSpanId :: Atto.Parser SpanId+parserSpanId = do+  parentIdBs <- Atto.takeWhile C.isHexDigit+  case baseEncodedToSpanId Base16 parentIdBs of+    Left err -> fail err+    Right ok -> pure ok+++data SamplingState = Accept | Deny | Debug | Defer+  deriving (Eq)+++-- | Parser for the @x-b3-sampled@ header value.+parserXb3Sampled :: Atto.Parser SamplingState+parserXb3Sampled = accept <|> deny+  where+    accept = "1" $> Accept+    deny = "0" $> Deny+++parserXb3Flags :: Atto.Parser SamplingState+parserXb3Flags = "1" $> Debug+++{- | Note that this parser is only correct for the B3 single header+ format. In B3 Multi you can only pass a @0@ or @1@ for the sample+ state for 'Accept' and 'Deny' respectively.+-}+parserSamplingState :: Atto.Parser SamplingState+parserSamplingState = accept <|> deny <|> debug+  where+    accept = "1" $> Accept+    deny = "0" $> Deny+    debug = "d" $> Debug+++{- | Encode a 'SamplingState' as the Sampling State component of the+ @b3@ header value.+-}+printSamplingStateSingle :: SamplingState -> Maybe Text+printSamplingStateSingle = \case+  Accept -> Just "1"+  Deny -> Just "0"+  Debug -> Just "d"+  Defer -> Nothing+++printSamplingStateMulti :: SamplingState -> Maybe (HeaderName, Text)+printSamplingStateMulti = \case+  Accept -> Just (xb3SampledHeader, "1")+  Deny -> Just (xb3SampledHeader, "0")+  Debug -> Just (xb3FlagsHeader, "1")+  Defer -> Nothing+++-- | Encode a 'SamplingState' as a 'Value'.+samplingStateToValue :: SamplingState -> Value+samplingStateToValue = \case+  Accept -> Value "accept"+  Deny -> Value "deny"+  Debug -> Value "debug"+  Defer -> Value "defer"+++-- | Used to decode the 'SamplingState' from a 'TraceState' 'Value'.+samplingStateFromValue :: Value -> Maybe SamplingState+samplingStateFromValue = \case+  Value "accept" -> Just Accept+  Value "deny" -> Just Deny+  Value "debug" -> Just Debug+  Value "defer" -> Just Defer+  _ -> Nothing+++data B3SingleHeader = B3SingleHeader+  { traceId :: TraceId+  , spanId :: SpanId+  , samplingState :: SamplingState+  , parentSpanId :: Maybe SpanId+  }+++parserB3Single :: Atto.Parser B3SingleHeader+parserB3Single = do+  traceId <- parserTraceId+  spanId <- void "-" *> parserSpanId+  samplingState <- Atto.option Defer (void "-" *> parserSamplingState)+  parentSpanId <- Atto.option Nothing (void "-" *> fmap Just parserSpanId)+  pure B3SingleHeader {..}+++--------------------------------------------------------------------------------++b3Header :: HeaderName+b3Header = "b3"+++xb3TraceIdHeader :: HeaderName+xb3TraceIdHeader = "X-B3-TraceId"+++xb3SpanIdHeader :: HeaderName+xb3SpanIdHeader = "X-B3-SpanId"+++xb3SampledHeader :: HeaderName+xb3SampledHeader = "X-B3-Sampled"+++xb3FlagsHeader :: HeaderName+xb3FlagsHeader = "X-B3-Flags"
+ test/Spec.hs view
@@ -0,0 +1,3 @@++main :: IO ()+main = putStrLn "Test suite not yet implemented"