hs-opentelemetry-awsxray (empty) → 0.1.0.0

raw patch · 13 files changed

+740/−0 lines, 13 filesdep +basedep +bytestringdep +errors

Dependencies added: base, bytestring, errors, hs-opentelemetry-api, hs-opentelemetry-awsxray, hs-opentelemetry-sdk, hspec, http-types, memory, microlens, random, text, time, unliftio, unliftio-core, unordered-containers

Files

• CHANGELOG.md +5/−0
• LICENSE +21/−0
• README.md +57/−0
• hs-opentelemetry-awsxray.cabal +108/−0
• library/OpenTelemetry/AWSXRay/Baggage.hs +52/−0
• library/OpenTelemetry/AWSXRay/IdGenerator.hs +56/−0
• library/OpenTelemetry/AWSXRay/Propagator.hs +39/−0
• library/OpenTelemetry/AWSXRay/TraceInfo.hs +120/−0
• library/OpenTelemetry/Trace/Setup.hs +45/−0
• library/OpenTelemetry/Trace/Setup/Lens.hs +56/−0
• package.yaml +90/−0
• tests/OpenTelemetry/AWSXRay/TraceInfoSpec.hs +90/−0
• tests/Spec.hs +1/−0

@@ -0,0 +1,5 @@+## [_Unreleased_](https://github.com/freckle/hs-opentelemetry-awsxray/compare/v0.1.0.0...main)++## [v0.1.0.0](https://github.com/freckle/hs-opentelemetry-awsxray/tree/v0.1.0.0)++First tagged release.

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2021 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,57 @@+# AWS X-Ray Support for hs-opentelemetry++<!-- TODO+[![Hackage](https://img.shields.io/hackage/v/hs-opentelemetry-awsxray.svg?style=flat)](https://hackage.haskell.org/package/hs-opentelemetry-awsxray)+[![Stackage Nightly](http://stackage.org/package/hs-opentelemetry-awsxray/badge/nightly)](http://stackage.org/nightly/package/hs-opentelemetry-awsxray)+[![Stackage LTS](http://stackage.org/package/hs-opentelemetry-awsxray/badge/lts)](http://stackage.org/lts/package/hs-opentelemetry-awsxray)+-->++[![CI](https://github.com/freckle/hs-opentelemetry-awsxray/actions/workflows/ci.yml/badge.svg)](https://github.com/freckle/hs-opentelemetry-awsxray/actions/workflows/ci.yml)++An `IdGenerator` and `Propagator` for [`hs-opentelemetry-sdk`][sdk] that+generates and propagates `TraceId` and `SpanId` values that are [compatible with+AWS X-Ray][xray].++[sdk]: https://hackage.haskell.org/package/hs-opentelemetry-sdk+[xray]: https://docs.aws.amazon.com/xray/latest/devguide/xray-api-sendingdata.html#xray-api-traceids++## Usage++The API currently exposed by the `hs-opentelemetry-sdk` package lacks a+convenient way to modify the `TracerProviderOptions` (to tell it to use our+generator/propagator) as part of initialization. You basically have to+re-implement the internals of `initializeTracerProvider` to do so.++While we plan to open a PR upstream to address the lack of API here, the+workaround approach has at least been been encapsulated in a module of this+library for convenience:++```hs+import OpenTelemetry.AWSXRay+import OpenTelemetry.Trace+import OpenTelemetry.Trace.Setup+import OpenTelemetry.Trace.Setup.Lens++main :: IO ()+main = do+  withTracerProvider modifyTracerProviderOptions $ \tracerProvider -> do+    let tracer = makeTracer tracerProvider "my-app" tracerOptions++    -- do something with tracer++modifyTracerProviderOptions :: TracerProviderOptions -> TracerProviderOptions+modifyTracerProviderOptions =+  idGeneratorL .~ awsXRayIdGenerator+    . propagatorL <>~ awsXRayContextPropagator+```++This example uses lens, but you certainly don't have to.++## Additional References++- https://docs.aws.amazon.com/xray/latest/devguide/xray-services-adot.html+- https://aws.amazon.com/blogs/opensource/migrating-x-ray-tracing-to-aws-distro-for-opentelemetry/++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)

@@ -0,0 +1,108 @@+cabal-version:      1.18+name:               hs-opentelemetry-awsxray+version:            0.1.0.0+license:            MIT+license-file:       LICENSE+maintainer:         Freckle Education+homepage:           https://github.com/freckle/hs-opentelemetry-awsxray#readme+bug-reports:        https://github.com/freckle/hs-opentelemetry-awsxray/issues+synopsis:           [synopsis]+description:        Please see README.md+category:           Utils+build-type:         Simple+extra-source-files: package.yaml+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+    type:     git+    location: https://github.com/freckle/hs-opentelemetry-awsxray++library+    exposed-modules:+        OpenTelemetry.AWSXRay.Baggage+        OpenTelemetry.AWSXRay.IdGenerator+        OpenTelemetry.AWSXRay.Propagator+        OpenTelemetry.AWSXRay.TraceInfo+        OpenTelemetry.Trace.Setup+        OpenTelemetry.Trace.Setup.Lens++    hs-source-dirs:     library+    other-modules:      Paths_hs_opentelemetry_awsxray+    default-language:   Haskell2010+    default-extensions:+        BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+        DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+        FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+        LambdaCase MultiParamTypeClasses NoImplicitPrelude+        NoMonomorphismRestriction OverloadedStrings RankNTypes+        RecordWildCards ScopedTypeVariables StandaloneDeriving+        TypeApplications TypeFamilies++    ghc-options:+        -Weverything -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missing-local-signatures+        -Wno-monomorphism-restriction -Wno-unsafe -Wno-safe++    build-depends:+        base >=4.11.1.0 && <5,+        bytestring,+        errors,+        hs-opentelemetry-api,+        hs-opentelemetry-sdk,+        http-types,+        memory,+        microlens,+        random >=1.2.1,+        text,+        time,+        unliftio,+        unliftio-core,+        unordered-containers++    if impl(ghc >=9.2)+        ghc-options: -Wno-missing-kind-signatures++    if impl(ghc >=8.10)+        ghc-options:+            -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module++test-suite spec+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    hs-source-dirs:     tests+    other-modules:+        OpenTelemetry.AWSXRay.TraceInfoSpec+        Paths_hs_opentelemetry_awsxray++    default-language:   Haskell2010+    default-extensions:+        BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+        DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+        FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+        LambdaCase MultiParamTypeClasses NoImplicitPrelude+        NoMonomorphismRestriction OverloadedStrings RankNTypes+        RecordWildCards ScopedTypeVariables StandaloneDeriving+        TypeApplications TypeFamilies++    ghc-options:+        -Weverything -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missing-local-signatures+        -Wno-monomorphism-restriction -Wno-unsafe -Wno-safe -threaded+        -rtsopts -with-rtsopts=-N++    build-depends:+        base >=4.11.1.0 && <5,+        hs-opentelemetry-api,+        hs-opentelemetry-awsxray,+        hspec,+        text,+        unordered-containers++    if impl(ghc >=9.2)+        ghc-options: -Wno-missing-kind-signatures++    if impl(ghc >=8.10)+        ghc-options:+            -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module

@@ -0,0 +1,52 @@+-- | Functions for dealing with 'Baggage'+--+-- We ported specs about 'Baggage' from the Java Propagator:+--+-- <https://github.com/open-telemetry/opentelemetry-java-contrib/blob/04a2a481934be614e73e41194107ffdd767bc507/aws-xray-propagator/src/test/java/io/opentelemetry/contrib/awsxray/propagator/AwsXrayPropagatorTest.java#L227-L238>+--+-- And using the obvious 'encodeBaggageHeader'/'decodeBaggageHeader' functions+-- fails them. So, we roll our own stuff here.+--+module OpenTelemetry.AWSXRay.Baggage+  ( decode+  , encode+  , module OpenTelemetry.Baggage+  ) where++import Prelude++import Control.Applicative (Alternative)+import Control.Arrow ((***))+import Control.Error.Util (hush)+import Control.Monad (guard)+import Data.ByteString (ByteString)+import qualified Data.HashMap.Strict as HashMap+import Data.Maybe (mapMaybe)+import Data.Text.Encoding (decodeUtf8', encodeUtf8)+import OpenTelemetry.Baggage (Baggage, Element, Token)+import OpenTelemetry.Baggage as Baggage++-- | Only returns 'Just' if the 'Baggage' is not empty+decode :: [(ByteString, ByteString)] -> Maybe Baggage+decode =+  guarded (/= Baggage.empty)+    . Baggage.fromHashMap+    . HashMap.fromList+    . mapMaybe decodePart+    . filter ((`notElem` nonBaggageKeys) . fst)+  where nonBaggageKeys = ["Root", "Parent", "Sampled"]++decodePart :: (ByteString, ByteString) -> Maybe (Token, Element)+decodePart (bsToken, bsElement) =+  (,)+    <$> (Baggage.mkToken =<< hush (decodeUtf8' bsToken))+    <*> (Baggage.element <$> hush (decodeUtf8' bsElement))++encode :: Baggage -> [(ByteString, ByteString)]+encode = map encodePart . HashMap.toList . Baggage.values++encodePart :: (Token, Element) -> (ByteString, ByteString)+encodePart = Baggage.tokenValue *** encodeUtf8 . Baggage.value++guarded :: Alternative f => (a -> Bool) -> a -> f a+guarded p x = x <$ guard (p x)

@@ -0,0 +1,56 @@+-- |+--+-- <https://docs.aws.amazon.com/xray/latest/devguide/xray-api-sendingdata.html#xray-api-traceids>+--+module OpenTelemetry.AWSXRay.IdGenerator+  ( XRayIdGenerationError+  , awsXRayIdGenerator+  ) where++import Prelude++import Control.Monad (replicateM)+import Data.ByteArray.Encoding (convertFromBase)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8+import Data.Char (intToDigit)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Numeric (showHex)+import OpenTelemetry.Trace.Id (Base(..))+import OpenTelemetry.Trace.Id.Generator+import OpenTelemetry.Trace.Id.Generator.Default+import System.Random.Stateful (applyAtomicGen, globalStdGen, uniformR)+import UnliftIO.Exception (Exception(..), throwIO)++data XRayIdGenerationError = FailedToConvert ByteString Base String+  deriving stock Show++instance Exception XRayIdGenerationError where+  displayException = \case+    FailedToConvert bs base message ->+      "Failed to convert generated bytestring ("+        <> show bs+        <> ") in "+        <> show base+        <> ": "+        <> message++awsXRayIdGenerator :: IdGenerator+awsXRayIdGenerator = IdGenerator+  { generateSpanIdBytes = generateSpanIdBytes defaultIdGenerator+  , generateTraceIdBytes = generateXRayTraceIdBytes+  }++generateXRayTraceIdBytes :: IO ByteString+generateXRayTraceIdBytes = do+  epoch <- round @_ @Int <$> getPOSIXTime+  unique <- replicateM 24 randomHex++  let+    tid = BS8.pack $ showHex epoch "" <> unique+    base = Base16++  either (throwIO . FailedToConvert tid base) pure $ convertFromBase base tid++randomHex :: IO Char+randomHex = intToDigit <$> applyAtomicGen (uniformR (1, 15)) globalStdGen

@@ -0,0 +1,39 @@+module OpenTelemetry.AWSXRay.Propagator+  ( awsXRayContextPropagator+  , awsXRayContextPropagatorOnError+  ) where++import Prelude++import Control.Error.Util (note)+import Network.HTTP.Types.Header (HeaderName, RequestHeaders, ResponseHeaders)+import OpenTelemetry.AWSXRay.TraceInfo+import OpenTelemetry.Context+  (Context, insertBaggage, insertSpan, lookupBaggage, lookupSpan)+import OpenTelemetry.Propagator+import OpenTelemetry.Trace.Core (getSpanContext, wrapSpanContext)++awsXRayContextPropagator :: Propagator Context RequestHeaders ResponseHeaders+awsXRayContextPropagator = awsXRayContextPropagatorOnError $ \_ _ -> pure ()++awsXRayContextPropagatorOnError+  :: (RequestHeaders -> String -> IO ())+  -- ^ Called on failure to find or parse an @X-Amzn-Trace-Id@ header+  -> Propagator Context RequestHeaders ResponseHeaders+awsXRayContextPropagatorOnError onErr = Propagator+  { propagatorNames = ["awsxray trace context"]+  , extractor = \hs c -> do+    case fromXRayHeader =<< note "not found" (lookup hAmznTraceId hs) of+      Left err -> c <$ onErr hs err+      Right TraceInfo {..} -> do+        let wrapped = wrapSpanContext spanContext+        pure $ maybe id insertBaggage baggage $ insertSpan wrapped c+  , injector = \c hs -> case lookupSpan c of+    Nothing -> pure hs+    Just sp -> do+      info <- TraceInfo <$> getSpanContext sp <*> pure (lookupBaggage c)+      pure $ (hAmznTraceId, toXRayHeader info) : hs+  }++hAmznTraceId :: HeaderName+hAmznTraceId = "X-Amzn-Trace-Id"

@@ -0,0 +1,120 @@+{-# LANGUAGE NamedFieldPuns #-}++-- |+--+-- <https://docs.aws.amazon.com/xray/latest/devguide/xray-concepts.html#xray-concepts-tracingheader>+--+-- Example:+--+-- @Root=1-5759e988-bd862e3fe1be46a994272793;Parent=53995c3f42cd8ad8;Sampled=1@+--+-- @Root=1-{epoch}-{unique}[;Parent={spanId}][;Sampled={1|0}][;meta=attr...]@+--+module OpenTelemetry.AWSXRay.TraceInfo+  ( TraceInfo(..)+  , fromXRayHeader+  , toXRayHeader+  ) where++import Prelude++import Control.Error.Util (note)+import Data.Bifunctor (first)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified OpenTelemetry.AWSXRay.Baggage as Baggage+import OpenTelemetry.Baggage (Baggage)+import OpenTelemetry.Trace (SpanContext(..))+import OpenTelemetry.Trace.Core+  (defaultTraceFlags, isSampled, setSampled, unsetSampled)+import OpenTelemetry.Trace.Id+  ( Base(..)+  , baseEncodedToSpanId+  , baseEncodedToTraceId+  , spanIdBaseEncodedByteString+  , traceIdBaseEncodedByteString+  )+import qualified OpenTelemetry.Trace.TraceState as TS++-- | The data to read/write from the @X-Amzn-TraceId@ header+data TraceInfo = TraceInfo+  { spanContext :: SpanContext+  , baggage :: Maybe Baggage+  }+  deriving stock Show++fromXRayHeader :: ByteString -> Either String TraceInfo+fromXRayHeader bs = do+  kv <- bsToKeyValues bs++  root <- note "Root not present" $ lookup "Root" kv+  traceId <- case bsSplitOn '-' root of+    ["1", epoch, unique] -> do+      let+        -- AWS may trim leading zeros from epoch; we must put them back for it+        -- to be valid for OTel+        epochUnique = bsLeftPad 8 '0' epoch <> unique+        errorPrefix =+          "Root epoch+unique ("+            <> show epochUnique+            <> ") is not a valid TraceId"+      prefix errorPrefix $ baseEncodedToTraceId Base16 epochUnique+    _ -> Left "Splitting on - did not produce exactly 3 parts"++  parent <- note "Parent not present" $ lookup "Parent" kv+  spanId <- prefix "Parent is not a valid SpanId"+    $ baseEncodedToSpanId Base16 parent++  let+    sampled = (== Just "1") $ lookup "Sampled" kv++    traceFlags =+      (if sampled then setSampled else unsetSampled) defaultTraceFlags++    baggage = Baggage.decode kv++  pure $ TraceInfo+    { spanContext = SpanContext+      { traceFlags+      , traceId+      , spanId+      , isRemote = True+      , traceState = TS.empty+      }+    , baggage+    }++toXRayHeader :: TraceInfo -> ByteString+toXRayHeader TraceInfo { spanContext, baggage } =+  bsFromKeyValues+    $ [ ("Root", "1-" <> epoch <> "-" <> unique)+      , ("Parent", spanIdBaseEncodedByteString Base16 spanId)+      , ("Sampled", if isSampled traceFlags then "1" else "0")+      ]+    <> maybe [] Baggage.encode baggage+ where+  SpanContext { traceId, spanId, traceFlags } = spanContext+  (epoch, unique) = BS.splitAt 8 $ traceIdBaseEncodedByteString Base16 traceId++prefix :: String -> Either String a -> Either String a+prefix p = first (\e -> p <> ": " <> e)++bsToKeyValues :: ByteString -> Either String [(ByteString, ByteString)]+bsToKeyValues = traverse go . bsSplitOn ';'+ where+  go bs = case bsSplitOn '=' bs of+    k : vs -> Right (k, mconcat vs)+    _ -> Left "No = found in key-value piece"++bsFromKeyValues :: [(ByteString, ByteString)] -> ByteString+bsFromKeyValues = BS.intercalate ";" . map (\(k, v) -> k <> "=" <> v)++bsLeftPad :: Int -> Char -> ByteString -> ByteString+bsLeftPad n c bs+  | diff > 0 = BS8.replicate diff c <> bs+  | otherwise = bs+  where diff = BS.length bs - n++bsSplitOn :: Char -> ByteString -> [ByteString]+bsSplitOn c = BS8.splitWith (== c)

@@ -0,0 +1,45 @@+-- | Initialization of a 'TracerProvider' with modified 'TracerProviderOptions'+module OpenTelemetry.Trace.Setup+  ( withTracerProvider+  ) where++import Prelude++import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.IO.Unlift (MonadUnliftIO(..))+import OpenTelemetry.Trace+  ( TracerProvider+  , TracerProviderOptions+  , createTracerProvider+  , getTracerProviderInitializationOptions+  , setGlobalTracerProvider+  )+import qualified OpenTelemetry.Trace as Trace+import UnliftIO.Exception (bracket)++withTracerProvider+  :: MonadUnliftIO m+  => (TracerProviderOptions -> TracerProviderOptions)+  -> (TracerProvider -> m a)+  -> m a+withTracerProvider setup =+  bracket (initializeGlobalTracerProvider setup) shutdownTracerProvider++initializeGlobalTracerProvider+  :: MonadIO m+  => (TracerProviderOptions -> TracerProviderOptions)+  -> m TracerProvider+initializeGlobalTracerProvider setup = liftIO $ do+  t <- initializeTracerProvider setup+  t <$ setGlobalTracerProvider t++initializeTracerProvider+  :: MonadIO m+  => (TracerProviderOptions -> TracerProviderOptions)+  -> m TracerProvider+initializeTracerProvider setup = liftIO $ do+  (processors, opts) <- getTracerProviderInitializationOptions+  createTracerProvider processors $ setup opts++shutdownTracerProvider :: MonadIO m => TracerProvider -> m ()+shutdownTracerProvider = liftIO . Trace.shutdownTracerProvider

@@ -0,0 +1,56 @@+-- | Lenses for modifying a 'TracerProviderOptions'+module OpenTelemetry.Trace.Setup.Lens+  ( idGeneratorL+  , samplerL+  , resourcesL+  , attributeLimitsL+  , spanLimitsL+  , propagatorL+  , loggerL+  ) where++import Prelude++import Data.Text (Text)+import Lens.Micro (Lens', lens)+import Network.HTTP.Types.Header (RequestHeaders, ResponseHeaders)+import OpenTelemetry.Attributes (AttributeLimits)+import OpenTelemetry.Context (Context)+import OpenTelemetry.Logging.Core (Log)+import OpenTelemetry.Propagator (Propagator)+import OpenTelemetry.Resource (MaterializedResources)+import OpenTelemetry.Trace (TracerProviderOptions(..))+import OpenTelemetry.Trace.Core (SpanLimits)+import OpenTelemetry.Trace.Id.Generator (IdGenerator)+import OpenTelemetry.Trace.Sampler (Sampler)++idGeneratorL :: Lens' TracerProviderOptions IdGenerator+idGeneratorL = lens tracerProviderOptionsIdGenerator+  $ \x y -> x { tracerProviderOptionsIdGenerator = y }++samplerL :: Lens' TracerProviderOptions Sampler+samplerL = lens tracerProviderOptionsSampler+  $ \x y -> x { tracerProviderOptionsSampler = y }++resourcesL :: Lens' TracerProviderOptions MaterializedResources+resourcesL = lens tracerProviderOptionsResources+  $ \x y -> x { tracerProviderOptionsResources = y }++attributeLimitsL :: Lens' TracerProviderOptions AttributeLimits+attributeLimitsL = lens tracerProviderOptionsAttributeLimits+  $ \x y -> x { tracerProviderOptionsAttributeLimits = y }++spanLimitsL :: Lens' TracerProviderOptions SpanLimits+spanLimitsL = lens tracerProviderOptionsSpanLimits+  $ \x y -> x { tracerProviderOptionsSpanLimits = y }++propagatorL+  :: Lens'+       TracerProviderOptions+       (Propagator Context RequestHeaders ResponseHeaders)+propagatorL = lens tracerProviderOptionsPropagators+  $ \x y -> x { tracerProviderOptionsPropagators = y }++loggerL :: Lens' TracerProviderOptions (Log Text -> IO ())+loggerL = lens tracerProviderOptionsLogger+  $ \x y -> x { tracerProviderOptionsLogger = y }

@@ -0,0 +1,90 @@+name: hs-opentelemetry-awsxray+version: 0.1.0.0+maintainer: Freckle Education+category: Utils+github: freckle/hs-opentelemetry-awsxray+synopsis: "[synopsis]"+description: Please see README.md++extra-doc-files:+  - README.md+  - CHANGELOG.md++extra-source-files:+  - package.yaml++ghc-options:+  - -Weverything+  - -Wno-missing-exported-signatures # re-enables missing-signatures+  - -Wno-missing-import-lists+  - -Wno-missing-local-signatures+  - -Wno-monomorphism-restriction+  - -Wno-unsafe+  - -Wno-safe++when:+  - condition: "impl(ghc >= 9.2)"+    ghc-options:+      - -Wno-missing-kind-signatures+  - condition: "impl(ghc >= 8.10)"+    ghc-options:+      - -Wno-missing-safe-haskell-mode+      - -Wno-prepositive-qualified-module++dependencies:+  - base < 5++default-extensions:+  - BangPatterns+  - DataKinds+  - DeriveAnyClass+  - DeriveFoldable+  - DeriveFunctor+  - DeriveGeneric+  - DeriveLift+  - DeriveTraversable+  - DerivingStrategies+  - FlexibleContexts+  - FlexibleInstances+  - GADTs+  - GeneralizedNewtypeDeriving+  - LambdaCase+  - MultiParamTypeClasses+  - NoImplicitPrelude+  - NoMonomorphismRestriction+  - OverloadedStrings+  - RankNTypes+  - RecordWildCards+  - ScopedTypeVariables+  - StandaloneDeriving+  - TypeApplications+  - TypeFamilies++library:+  source-dirs: library+  dependencies:+    - bytestring+    - errors+    - hs-opentelemetry-api+    - hs-opentelemetry-sdk+    - http-types+    - memory+    - microlens+    - random >= 1.2.1 # globalStdGen+    - text+    - time+    - unliftio+    - unliftio-core+    - unordered-containers++tests:+  spec:+    main: Spec.hs+    source-dirs: tests+    ghc-options: -threaded -rtsopts "-with-rtsopts=-N"+    dependencies:+      - hs-opentelemetry-api+      - hs-opentelemetry-awsxray+      - hspec+      - text+      - unordered-containers

@@ -0,0 +1,90 @@+module OpenTelemetry.AWSXRay.TraceInfoSpec+  ( spec+  ) where++import Prelude++import Data.Either (isLeft)+import qualified Data.HashMap.Strict as HashMap+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import OpenTelemetry.AWSXRay.TraceInfo+import OpenTelemetry.Baggage (Token)+import qualified OpenTelemetry.Baggage as Baggage+import OpenTelemetry.Trace.Core (isSampled, traceFlags)+import Test.Hspec++spec :: Spec+spec = do+  it "round trips an example" $ do+    let+      h =+        "Root=1-5759e988-bd862e3fe1be46a994272793"+          <> ";Parent=53995c3f42cd8ad8"+          <> ";Sampled=1"++    fmap toXRayHeader (fromXRayHeader h) `shouldBe` Right h++  it "round trips an example with baggage" $ do+    let+      h =+        "Root=1-5759e988-bd862e3fe1be46a994272793"+          <> ";Parent=53995c3f42cd8ad8"+          <> ";Sampled=1"+          <> ";baz=bat" -- order matters due to HashMap+          <> ";foo=bar"++    fmap toXRayHeader (fromXRayHeader h) `shouldBe` Right h++  describe "fromXRayHeader" $ do+    it "requires Parent" $ do+      fromXRayHeader "Root=1-5759e988-bd862e3fe1be46a994272793"+        `shouldSatisfy` isLeft++    context "Sampled" $ do+      it "defaults False" $ do+        let+          eInfo =+            fromXRayHeader+              $ "Root=1-5759e988-bd862e3fe1be46a994272793"+              <> ";Parent=53995c3f42cd8ad8"++        fmap (isSampled . traceFlags . spanContext) eInfo `shouldBe` Right False++      it "interprets =1 as True" $ do+        let+          eInfo =+            fromXRayHeader+              $ "Root=1-5759e988-bd862e3fe1be46a994272793"+              <> ";Parent=53995c3f42cd8ad8"+              <> ";Sampled=1"++        fmap (isSampled . traceFlags . spanContext) eInfo `shouldBe` Right True++      it "interprets other values as as False" $ do+        let+          eInfo =+            fromXRayHeader+              $ "Root=1-5759e988-bd862e3fe1be46a994272793"+              <> ";Parent=53995c3f42cd8ad8"+              <> ";Sampled=flipFlop"++        fmap (isSampled . traceFlags . spanContext) eInfo `shouldBe` Right False++    it "grabs all other values as Baggage" $ do+      let+        eInfo =+          fromXRayHeader+            $ "Root=1-5759e988-bd862e3fe1be46a994272793"+            <> ";Parent=53995c3f42cd8ad8"+            <> ";foo=bar;baz=bat"++      fmap baggage eInfo `shouldBe` Right+        (Just $ Baggage.fromHashMap $ HashMap.fromList+          [ (mkTokenUnsafe "foo", Baggage.element "bar")+          , (mkTokenUnsafe "baz", Baggage.element "bat")+          ]+        )++mkTokenUnsafe :: Text -> Token+mkTokenUnsafe = fromMaybe (error "not a valid Token") . Baggage.mkToken

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-missing-export-lists #-}