{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Instana.SDK.TracingHeadersTest (allTests) where import qualified Data.CaseInsensitive as CI import qualified Network.Wai as Wai import Test.HUnit import Instana.SDK.TracingHeaders (TracingLevel (..)) import qualified Instana.SDK.TracingHeaders as TracingHeaders allTests :: Test allTests = TestList [ TestLabel "shouldReadHeaders" shouldReadHeaders , TestLabel "shouldReadHeaderNamesCaseInsensitive" shouldReadHeaderNamesCaseInsensitive , TestLabel "shouldReadDefaultValues" shouldReadDefaultValues , TestLabel "shouldParseNonExistingXInstanaL" shouldParseNonExistingXInstanaL , TestLabel "shouldParseXInstanaL1" shouldParseXInstanaL1 , TestLabel "shouldParseXInstanaL1Untrimmed" shouldParseXInstanaL1Untrimmed , TestLabel "shouldParseXInstanaL0" shouldParseXInstanaL0 , TestLabel "shouldParseXInstanaL0Untrimmed" shouldParseXInstanaL0Untrimmed , TestLabel "shouldParseXInstanaL0AndIgnoreCorrelation" shouldParseXInstanaL0AndIgnoreCorrelation , TestLabel "shouldParseXInstanaL1WithCorrelation" shouldParseXInstanaL1WithCorrelation , TestLabel "shouldParseXInstanaL1WithOddlyFormattedCorrelation" shouldParseXInstanaL1WithOddlyFormattedCorrelation ] shouldReadDefaultValues :: Test shouldReadDefaultValues = let tracingHeaders = TracingHeaders.readHttpTracingHeaders Wai.defaultRequest in TestCase $ do assertEqual "trace ID" Nothing (TracingHeaders.traceId tracingHeaders) assertEqual "span ID" Nothing (TracingHeaders.spanId tracingHeaders) assertEqual "level" Trace (TracingHeaders.level tracingHeaders) assertEqual "correlationType" Nothing (TracingHeaders.correlationType tracingHeaders) assertEqual "correlationId" Nothing (TracingHeaders.correlationId tracingHeaders) assertEqual "synthetic" False (TracingHeaders.synthetic tracingHeaders) assertEqual "traceparent" Nothing (TracingHeaders.traceparent tracingHeaders) assertEqual "tracestate" Nothing (TracingHeaders.tracestate tracingHeaders) shouldReadHeaders :: Test shouldReadHeaders = let tracingHeaders = TracingHeaders.readHttpTracingHeaders $ Wai.defaultRequest { Wai.requestHeaders = [ (CI.mk "X-INSTANA-T", "1234567890abcdef") , (CI.mk "X-INSTANA-S", "abcdef1234567890") , (CI.mk "X-INSTANA-L", "1") , (CI.mk "X-INSTANA-SYNTHETIC", "1") , (CI.mk "traceparent", "00-00000000000000001234567890abcdef-abcdef1234567890-01" ) , (CI.mk "tracestate", "foo=bar,in=1234567890abcdef;abcdef1234567890,beep=bop" ) ] } in TestCase $ do assertEqual "trace ID" (Just "1234567890abcdef") (TracingHeaders.traceId tracingHeaders) assertEqual "span ID" (Just "abcdef1234567890") (TracingHeaders.spanId tracingHeaders) assertEqual "level" Trace (TracingHeaders.level tracingHeaders) assertEqual "correlationType" Nothing (TracingHeaders.correlationType tracingHeaders) assertEqual "correlationId" Nothing (TracingHeaders.correlationId tracingHeaders) assertEqual "synthetic" True (TracingHeaders.synthetic tracingHeaders) assertEqual "traceparent" (Just "00-00000000000000001234567890abcdef-abcdef1234567890-01") (TracingHeaders.traceparent tracingHeaders) assertEqual "tracestate" (Just "foo=bar,in=1234567890abcdef;abcdef1234567890,beep=bop") (TracingHeaders.tracestate tracingHeaders) shouldReadHeaderNamesCaseInsensitive :: Test shouldReadHeaderNamesCaseInsensitive = let tracingHeaders = TracingHeaders.readHttpTracingHeaders $ Wai.defaultRequest { Wai.requestHeaders = [ (CI.mk "x-inSTanA-t", "1234567890abcdef") , (CI.mk "X-Instana-S", "abcdef1234567890") , (CI.mk "x-instana-synthetic", "1") , (CI.mk "TRACEPARENT", "00-00000000000000001234567890abcdef-abcdef1234567890-01" ) , (CI.mk "TRACESTATE", "foo=bar,in=1234567890abcdef;abcdef1234567890,beep=bop" ) ] } in TestCase $ do assertEqual "trace ID" (Just "1234567890abcdef") (TracingHeaders.traceId tracingHeaders) assertEqual "span ID" (Just "abcdef1234567890") (TracingHeaders.spanId tracingHeaders) assertEqual "level" Trace (TracingHeaders.level tracingHeaders) assertEqual "correlationType" Nothing (TracingHeaders.correlationType tracingHeaders) assertEqual "correlationId" Nothing (TracingHeaders.correlationId tracingHeaders) assertEqual "synthetic" True (TracingHeaders.synthetic tracingHeaders) assertEqual "traceparent" (Just "00-00000000000000001234567890abcdef-abcdef1234567890-01") (TracingHeaders.traceparent tracingHeaders) assertEqual "tracestate" (Just "foo=bar,in=1234567890abcdef;abcdef1234567890,beep=bop") (TracingHeaders.tracestate tracingHeaders) shouldParseNonExistingXInstanaL :: Test shouldParseNonExistingXInstanaL = let (level, correlationType, correlationId) = TracingHeaders.parseXInstanaL Nothing in TestCase $ do assertEqual "level" Trace level assertEqual "correlation type" Nothing correlationType assertEqual "correlation ID" Nothing correlationId shouldParseXInstanaL1 :: Test shouldParseXInstanaL1 = let (level, correlationType, correlationId) = TracingHeaders.parseXInstanaL $ Just "1" in TestCase $ do assertEqual "level" Trace level assertEqual "correlation type" Nothing correlationType assertEqual "correlation ID" Nothing correlationId shouldParseXInstanaL1Untrimmed :: Test shouldParseXInstanaL1Untrimmed = let (level, correlationType, correlationId) = TracingHeaders.parseXInstanaL $ Just " 1 " in TestCase $ do assertEqual "level" Trace level assertEqual "correlation type" Nothing correlationType assertEqual "correlation ID" Nothing correlationId shouldParseXInstanaL0 :: Test shouldParseXInstanaL0 = let (level, correlationType, correlationId) = TracingHeaders.parseXInstanaL $ Just "0" in TestCase $ do assertEqual "level" level Suppress assertEqual "correlation type" Nothing correlationType assertEqual "correlation ID" Nothing correlationId shouldParseXInstanaL0Untrimmed :: Test shouldParseXInstanaL0Untrimmed = let (level, correlationType, correlationId) = TracingHeaders.parseXInstanaL $ Just " 0 " in TestCase $ do assertEqual "level" level Suppress assertEqual "correlation type" Nothing correlationType assertEqual "correlation ID" Nothing correlationId shouldParseXInstanaL0AndIgnoreCorrelation :: Test shouldParseXInstanaL0AndIgnoreCorrelation = let (level, correlationType, correlationId) = TracingHeaders.parseXInstanaL $ Just " 0 , correlationType=web; correlationId=1234567890abcdef" in TestCase $ do assertEqual "level" level Suppress assertEqual "correlation type" Nothing correlationType assertEqual "correlation ID" Nothing correlationId shouldParseXInstanaL1WithCorrelation :: Test shouldParseXInstanaL1WithCorrelation = let (level, correlationType, correlationId) = TracingHeaders.parseXInstanaL $ Just "1,correlationType=web;correlationId=1234567890abcdef" in TestCase $ do assertEqual "level" Trace level assertEqual "correlation type" (Just "web") correlationType assertEqual "correlation ID" (Just "1234567890abcdef") correlationId shouldParseXInstanaL1WithOddlyFormattedCorrelation :: Test shouldParseXInstanaL1WithOddlyFormattedCorrelation = let (level, correlationType, correlationId) = TracingHeaders.parseXInstanaL $ Just " 1 , correlationType = web ; correlationId = 1234567890abcdef" in TestCase $ do assertEqual "level" Trace level assertEqual "correlation type" (Just "web") correlationType assertEqual "correlation ID" (Just "1234567890abcdef") correlationId