hs-opentelemetry-propagator-w3c (empty) → 0.0.1.0
raw patch · 8 files changed
+286/−0 lines, 8 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, hs-opentelemetry-api, hs-opentelemetry-propagator-w3c, http-types, text
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- hs-opentelemetry-propagator-w3c.cabal +60/−0
- src/OpenTelemetry/Propagator/W3CBaggage.hs +33/−0
- src/OpenTelemetry/Propagator/W3CTraceContext.hs +155/−0
- test/Spec.hs +2/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for hs-opentelemetry-propagator-w3c++## 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-w3c
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hs-opentelemetry-propagator-w3c.cabal view
@@ -0,0 +1,60 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: hs-opentelemetry-propagator-w3c+version: 0.0.1.0+description: Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/propagators/w3c#readme>+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.W3CBaggage+ OpenTelemetry.Propagator.W3CTraceContext+ other-modules:+ Paths_hs_opentelemetry_propagator_w3c+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ attoparsec+ , base >=4.7 && <5+ , bytestring+ , hs-opentelemetry-api+ , http-types+ , text+ default-language: Haskell2010++test-suite hs-opentelemetry-propagator-w3c-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_hs_opentelemetry_propagator_w3c+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ attoparsec+ , base >=4.7 && <5+ , bytestring+ , hs-opentelemetry-api+ , hs-opentelemetry-propagator-w3c+ , http-types+ , text+ default-language: Haskell2010
+ src/OpenTelemetry/Propagator/W3CBaggage.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module OpenTelemetry.Propagator.W3CBaggage where++import Data.ByteString+import Network.HTTP.Types+import qualified OpenTelemetry.Baggage as Baggage+import OpenTelemetry.Context (Context, insertBaggage, lookupBaggage)+import OpenTelemetry.Propagator++decodeBaggage :: ByteString -> Maybe Baggage.Baggage+decodeBaggage bs = case Baggage.decodeBaggageHeader bs of+ Left _ -> Nothing+ Right b -> Just b++encodeBaggage :: Baggage.Baggage -> ByteString+encodeBaggage = Baggage.encodeBaggageHeader++w3cBaggagePropagator :: Propagator Context RequestHeaders ResponseHeaders+w3cBaggagePropagator = Propagator{..}+ where+ propagatorNames = [ "baggage" ]++ extractor hs c = case Prelude.lookup "baggage" hs of+ Nothing -> pure c+ Just baggageHeader -> case decodeBaggage baggageHeader of+ Nothing -> pure c+ Just baggage -> pure $! insertBaggage baggage c++ injector c hs = do+ case lookupBaggage c of+ Nothing -> pure hs+ Just baggage -> pure $! (("baggage", encodeBaggage baggage) : hs)
+ src/OpenTelemetry/Propagator/W3CTraceContext.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+-----------------------------------------------------------------------------+-- |+-- Module : OpenTelemetry.Propagators.W3CTraceContext+-- Copyright : (c) Ian Duncan, 2021+-- License : BSD-3+-- Description : Standardized trace context propagation format intended for HTTP headers+-- Maintainer : Ian Duncan+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- Distributed tracing is a methodology implemented by tracing tools to follow, analyze and debug a transaction across multiple software components. Typically, a distributed trace traverses more than one component which requires it to be uniquely identifiable across all participating systems. Trace context propagation passes along this unique identification. Today, trace context propagation is implemented individually by each tracing vendor. In multi-vendor environments, this causes interoperability problems, like:+--+-- - Traces that are collected by different tracing vendors cannot be correlated as there is no shared unique identifier.+-- - Traces that cross boundaries between different tracing vendors can not be propagated as there is no uniformly agreed set of identification that is forwarded.+-- - Vendor specific metadata might be dropped by intermediaries.+-- - Cloud platform vendors, intermediaries and service providers, cannot guarantee to support trace context propagation as there is no standard to follow.+-- - In the past, these problems did not have a significant impact as most applications were monitored by a single tracing vendor and stayed within the boundaries of a single platform provider. Today, an increasing number of applications are highly distributed and leverage multiple middleware services and cloud platforms.+--+-- - This transformation of modern applications calls for a distributed tracing context propagation standard.+--+-- This module therefore provides support for tracing context propagation in accordance with the W3C tracing context+-- propagation specifications: https://www.w3.org/TR/trace-context/+--+-----------------------------------------------------------------------------+module OpenTelemetry.Propagator.W3CTraceContext where++import Data.Attoparsec.ByteString.Char8+ ( parseOnly, string, Parser, hexadecimal, takeWhile )+import Data.ByteString (ByteString)+import Data.Char (isHexDigit)+import Data.Word (Word8)+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy as L+import Network.HTTP.Types ( RequestHeaders, ResponseHeaders )+import qualified OpenTelemetry.Context as Ctxt+import OpenTelemetry.Trace.Core+ ( traceFlagsFromWord8,+ traceFlagsValue,+ getSpanContext,+ wrapSpanContext,+ Span,+ SpanContext(..),+ TraceFlags )+import OpenTelemetry.Propagator ( Propagator(..) )+import OpenTelemetry.Trace.Id (TraceId, SpanId, Base(..), spanIdBaseEncodedBuilder, traceIdBaseEncodedBuilder, baseEncodedToTraceId, baseEncodedToSpanId)+import OpenTelemetry.Trace.TraceState ( TraceState, empty )+import Prelude hiding (takeWhile)++{-+TODO: test against the conformance spec:+https://github.com/w3c/trace-context+-}+data TraceParent = TraceParent+ { version :: {-# UNPACK #-} !Word8+ , traceId :: {-# UNPACK #-} !TraceId+ , parentId :: {-# UNPACK #-} !SpanId+ , traceFlags :: {-# UNPACK #-} !TraceFlags+ } deriving (Show)++-- | Attempt to decode a 'SpanContext' from optional @traceparent@ and @tracestate@ header inputs.+--+-- @since 0.0.1.0+decodeSpanContext :: + Maybe ByteString + -- ^ @traceparent@ header value+ -> Maybe ByteString + -- ^ @tracestate@ header value+ -> Maybe SpanContext+decodeSpanContext Nothing _ = Nothing+decodeSpanContext (Just traceparentHeader) mTracestateHeader = do+ TraceParent{..} <- decodeTraceparentHeader traceparentHeader+ ts <- case mTracestateHeader of+ Nothing -> pure empty+ Just tracestateHeader -> pure $ decodeTracestateHeader tracestateHeader+ pure $ SpanContext+ { traceFlags = traceFlags+ , isRemote = True+ , traceId = traceId+ , spanId = parentId+ , traceState = ts+ }+ where+ decodeTraceparentHeader :: ByteString -> Maybe TraceParent+ decodeTraceparentHeader tp = case parseOnly traceparentParser tp of+ Left _ -> Nothing+ Right ok -> Just ok++ decodeTracestateHeader :: ByteString -> TraceState+ decodeTracestateHeader _ = empty++traceparentParser :: Parser TraceParent+traceparentParser = do+ version <- hexadecimal+ _ <- string "-"+ traceIdBs <- takeWhile isHexDigit+ traceId <- case baseEncodedToTraceId Base16 traceIdBs of+ Left err -> fail err+ Right ok -> pure ok+ _ <- string "-"+ parentIdBs <- takeWhile isHexDigit+ parentId <- case baseEncodedToSpanId Base16 parentIdBs of+ Left err -> fail err+ Right ok -> pure ok+ _ <- string "-"+ traceFlags <- traceFlagsFromWord8 <$> hexadecimal+ -- Intentionally not consuming end of input in case of version > 0+ pure $ TraceParent {..}++-- | Encoded the given 'Span' into a @traceparent@, @tracestate@ tuple.+--+-- @since 0.0.1.0+encodeSpanContext :: Span -> IO (ByteString, ByteString)+encodeSpanContext s = do+ ctxt <- getSpanContext s+ -- TODO tracestate+ pure (L.toStrict $ B.toLazyByteString $ traceparentHeader ctxt, "")+ where+ traceparentHeader SpanContext{..} = + -- version+ B.word8HexFixed 0 <>+ B.char7 '-' <>+ traceIdBaseEncodedBuilder Base16 traceId <>+ B.char7 '-' <>+ spanIdBaseEncodedBuilder Base16 spanId <>+ B.char7 '-' <>+ B.word8HexFixed (traceFlagsValue traceFlags)++-- | Propagate trace context information via headers using the w3c specification format+--+-- @since 0.0.1.0+w3cTraceContextPropagator :: Propagator Ctxt.Context RequestHeaders ResponseHeaders+w3cTraceContextPropagator = Propagator{..}+ where+ propagatorNames = [ "tracecontext" ]++ extractor hs c = do+ let traceParentHeader = Prelude.lookup "traceparent" hs+ traceStateHeader = Prelude.lookup "tracestate" hs+ mspanContext = decodeSpanContext traceParentHeader traceStateHeader+ pure $! case mspanContext of+ Nothing -> c+ Just s -> Ctxt.insertSpan (wrapSpanContext (s { isRemote = True })) c++ injector c hs = case Ctxt.lookupSpan c of+ Nothing -> pure hs+ Just s -> do+ (traceParentHeader, traceStateHeader) <- encodeSpanContext s+ pure + (+ ("traceparent", traceParentHeader) :+ ("tracestate", traceStateHeader) :+ hs+ )
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"