{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module OpenTelemetry.Propagator.W3CIntegrationSpec (spec) where
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import OpenTelemetry.Common (TraceFlags (..))
import OpenTelemetry.Propagator.W3CTraceContext
import OpenTelemetry.Trace.Core
import OpenTelemetry.Trace.Id
import OpenTelemetry.Trace.TraceState (Key (..), Value (..), empty, fromList, insert, toList)
import Test.Hspec
spec :: Spec
spec = describe "W3C TraceContext Integration" $ do
describe "decodeSpanContext" $ do
it "decodes traceparent and empty tracestate" $ do
let traceparent = Just "00-0af7651916cd43dd8448eb211c80319c-b7ad6b7169203331-01"
tracestate = Nothing
result = decodeSpanContext traceparent tracestate
case result of
Just spanCtx -> do
OpenTelemetry.Trace.Core.traceFlags spanCtx `shouldBe` TraceFlags 1
traceState spanCtx `shouldBe` empty
Nothing -> expectationFailure "Failed to decode span context"
it "decodes traceparent and tracestate with single entry" $ do
let traceparent = Just "00-0af7651916cd43dd8448eb211c80319c-b7ad6b7169203331-01"
tracestate = Just "vendor1=value1"
result = decodeSpanContext traceparent tracestate
case result of
Just spanCtx -> do
OpenTelemetry.Trace.Core.traceFlags spanCtx `shouldBe` TraceFlags 1
traceState spanCtx `shouldBe` insert (Key "vendor1") (Value "value1") empty
Nothing -> expectationFailure "Failed to decode span context"
it "decodes traceparent and tracestate with multiple entries" $ do
let traceparent = Just "00-0af7651916cd43dd8448eb211c80319c-b7ad6b7169203331-01"
tracestate = Just "vendor1=value1,vendor2=value2,vendor3=value3"
result = decodeSpanContext traceparent tracestate
case result of
Just spanCtx -> do
OpenTelemetry.Trace.Core.traceFlags spanCtx `shouldBe` TraceFlags 1
let decodedPairs = toList (traceState spanCtx)
decodedPairs `shouldContain` [(Key "vendor1", Value "value1")]
decodedPairs `shouldContain` [(Key "vendor2", Value "value2")]
decodedPairs `shouldContain` [(Key "vendor3", Value "value3")]
length decodedPairs `shouldBe` 3
Nothing -> expectationFailure "Failed to decode span context"
it "handles invalid tracestate gracefully" $ do
let traceparent = Just "00-0af7651916cd43dd8448eb211c80319c-b7ad6b7169203331-01"
tracestate = Just "INVALID$KEY=value1" -- Invalid key format
result = decodeSpanContext traceparent tracestate
case result of
Just spanCtx -> do
OpenTelemetry.Trace.Core.traceFlags spanCtx `shouldBe` TraceFlags 1
traceState spanCtx `shouldBe` empty -- Should fall back to empty
Nothing -> expectationFailure "Failed to decode span context"
it "returns Nothing for invalid traceparent" $ do
let traceparent = Just "invalid-traceparent"
tracestate = Just "vendor1=value1"
result = decodeSpanContext traceparent tracestate
result `shouldBe` Nothing
it "returns Nothing for missing traceparent" $ do
let traceparent = Nothing
tracestate = Just "vendor1=value1"
result = decodeSpanContext traceparent tracestate
result `shouldBe` Nothing
describe "encodeTraceState integration" $ do
it "encodes complex tracestate correctly" $ do
let complexState =
fromList
[ (Key "tenant@vendor", Value "complex-value_with*chars")
, (Key "simple", Value "value")
, (Key "numeric123", Value "123-456")
]
encoded = encodeTraceState complexState
-- Verify it can be round-tripped
let traceparent = Just "00-0af7651916cd43dd8448eb211c80319c-b7ad6b7169203331-01"
result = decodeSpanContext traceparent (Just encoded)
case result of
Just spanCtx -> do
let decodedState = traceState spanCtx
decodedState `shouldBe` complexState
Nothing -> expectationFailure "Failed to round-trip complex tracestate"
it "handles empty tracestate in round-trip" $ do
let encoded = encodeTraceState empty
encoded `shouldBe` ""
let traceparent = Just "00-0af7651916cd43dd8448eb211c80319c-b7ad6b7169203331-01"
result = decodeSpanContext traceparent (if encoded == "" then Nothing else Just encoded)
case result of
Just spanCtx -> traceState spanCtx `shouldBe` empty
Nothing -> expectationFailure "Failed to handle empty tracestate"
describe "W3C specification compliance" $ do
it "respects 32 entry limit in parsing" $ do
let entries = ["key" ++ show i ++ "=value" ++ show i | i <- [1 .. 40]]
longTracestate = C8.intercalate "," $ map C8.pack entries
traceparent = Just "00-0af7651916cd43dd8448eb211c80319c-b7ad6b7169203331-01"
result = decodeSpanContext traceparent (Just longTracestate)
case result of
Just spanCtx -> do
let stateEntries = traceState spanCtx
length (toList stateEntries) `shouldBe` 32
Nothing -> expectationFailure "Failed to parse long tracestate"
it "validates key format according to spec" $ do
let testCases =
[ ("validkey", True)
, ("valid123", True)
, ("valid_key", True)
, ("valid-key", True)
, ("valid*key", True)
, ("valid/key", True)
, ("tenant@vendor", True)
, ("123numeric", True)
, ("INVALIDKEY", False) -- Must start with lowercase
, ("invalid$key", False) -- Invalid character
, ("", False) -- Empty key
]
mapM_
( \(key, shouldSucceed) -> do
let tracestate = C8.pack $ T.unpack key ++ "=value"
traceparent = Just "00-0af7651916cd43dd8448eb211c80319c-b7ad6b7169203331-01"
result = decodeSpanContext traceparent (Just tracestate)
if shouldSucceed
then
result
`shouldSatisfy` ( \case
Just spanCtx -> not $ null $ toList $ traceState spanCtx
Nothing -> False
)
else
result
`shouldSatisfy` ( \case
Just spanCtx -> null $ toList $ traceState spanCtx
Nothing -> True
)
)
testCases
it "validates value format according to spec" $ do
let testCases =
[ ("validvalue", True)
, ("valid value with spaces", True)
, ("valid-value_with*special/chars", True)
, ("valid!value#with$symbols%", True)
, ("value,with,comma", False) -- Comma not allowed
, ("value=with=equals", False) -- Equals not allowed in continuation
]
mapM_
( \(value, shouldSucceed) -> do
let tracestate = C8.pack $ "validkey=" ++ T.unpack value
traceparent = Just "00-0af7651916cd43dd8448eb211c80319c-b7ad6b7169203331-01"
result = decodeSpanContext traceparent (Just tracestate)
if shouldSucceed
then
result
`shouldSatisfy` ( \case
Just spanCtx -> not $ null $ toList $ traceState spanCtx
Nothing -> False
)
else
result
`shouldSatisfy` ( \case
Just spanCtx -> null $ toList $ traceState spanCtx
Nothing -> True
)
)
testCases