instana-haskell-trace-sdk 0.7.1.0 → 0.8.0.0

raw patch · 36 files changed

+2042/−717 lines, 36 filesdep +aeson-casingPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson-casing

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +2/−2
• instana-haskell-trace-sdk.cabal +14/−2
• src/Instana/SDK/Internal/AgentConnection/Json/AnnounceResponse.hs +13/−1
• src/Instana/SDK/Internal/Context.hs +64/−8
• src/Instana/SDK/Internal/WireSpan.hs +12/−11
• src/Instana/SDK/SDK.hs +219/−115
• src/Instana/SDK/Span/EntrySpan.hs +20/−8
• src/Instana/SDK/Span/ExitSpan.hs +23/−18
• src/Instana/SDK/Span/NonRootEntry.hs +23/−18
• src/Instana/SDK/Span/RootEntry.hs +25/−20
• src/Instana/SDK/Span/SimpleSpan.hs +6/−7
• src/Instana/SDK/Span/Span.hs +102/−40
• src/Instana/SDK/Span/SpanData.hs +282/−0
• src/Instana/SDK/Span/SpanType.hs +7/−43
• test/agent-stub/Instana/SDK/AgentStub/Config.hs +61/−22
• test/agent-stub/Instana/SDK/AgentStub/Server.hs +38/−10
• test/apps/downstream-target/Main.hs +6/−5
• test/apps/wai-with-middleware/Main.hs +26/−8
• test/apps/wai/Main.hs +53/−35
• test/integration/Instana/SDK/IntegrationTest/CustomSecrets.hs +91/−0
• test/integration/Instana/SDK/IntegrationTest/ExtraHttpHeaders.hs +79/−0
• test/integration/Instana/SDK/IntegrationTest/HUnitExtra.hs +1/−0
• test/integration/Instana/SDK/IntegrationTest/HttpTracing.hs +70/−19
• test/integration/Instana/SDK/IntegrationTest/Metrics.hs +1/−1
• test/integration/Instana/SDK/IntegrationTest/Runner.hs +5/−0
• test/integration/Instana/SDK/IntegrationTest/SpecCompliance.hs +1/−1
• test/integration/Instana/SDK/IntegrationTest/Suite.hs +36/−12
• test/integration/Instana/SDK/IntegrationTest/TestSuites.hs +66/−12
• test/integration/Instana/SDK/IntegrationTest/WaiMiddleware.hs +1/−1
• test/shared/Instana/SDK/AgentStub/DiscoveryResponse.hs +16/−5
• test/unit/Instana/SDK/Internal/SpanStackTest.hs +6/−11
• test/unit/Instana/SDK/Internal/SpanTest.hs +0/−281
• test/unit/Instana/SDK/SpanDataTest.hs +271/−0
• test/unit/Instana/SDK/SpanTest.hs +391/−0
• test/unit/Main.hs +3/−1

@@ -1,5 +1,13 @@ # Changelog for instana-haskell-trace-sdk +## 0.8.0.0+- Fix: Apply secrets config from agent configuration.+- Fix: Redact secrets from query parameters instead of removing them.+- Feature: Automatically capture HTTP request and response headers on HTTP entry and exit spans, based on the agent configuration.+- BREAKING: Refactor and simplify the API to add nnotations via `Instana.SDK.SDK`:+    - Use `addAnnotation` instead of `addRegisteredData` and `addTag`. This variant requires an `Annotation`, use the functions in `Instana.SDK.Span.SpanData` to create an annotation.+    - Use `addAnnotationValueAt` or `addAnnotationAt` instead of `addRegisteredDataAt` and `addTagAt`. Both variants require the path to the annotation/value as a dot-separated string (same as before). The function `addAnnotationAt` accepts anything that implements `ToJSON`, and `addAnnotationValueAt` requires an `Instana.SDK.Span.SpanData.AnnotationValue` (previously you needed to pass in an `Aeson.Value`).+ ## 0.7.1.0 - Fix: Limit the number of list-members (key-value pairs) to 32 in the W3C trace context `tracestate` header. 

@@ -15,7 +15,7 @@  ``` extra-deps:-- instana-haskell-trace-sdk-0.7.1.0+- instana-haskell-trace-sdk-0.8.0.0 ```  Depending on the stack resolver you use, you might also need to add `aeson-extra` to your extra-deps:@@ -155,7 +155,7 @@  #### Best Practices -Make sure you have read Instana's [docs on custom tracing](https://docs.instana.io/quick_start/custom_tracing/#tips--best-practices) and in particular the [best practices section](https://docs.instana.io/quick_start/custom_tracing/#tips--best-practices). This documentation contains a lot of useful info for integrating Instana tracing into your code; among other things, it explains which [metadata](https://docs.instana.io/quick_start/custom_tracing/#list-of-processed-tags) can be added to spans (via `InstanaSDK.addTag` and `InstanaSDK.addTagAt`).+Make sure you have read Instana's [docs on custom tracing](https://docs.instana.io/quick_start/custom_tracing/#tips--best-practices) and in particular the [best practices section](https://docs.instana.io/quick_start/custom_tracing/#tips--best-practices). This documentation contains a lot of useful info for integrating Instana tracing into your code; among other things, it explains which [annotations](https://docs.instana.io/quick_start/custom_tracing/#list-of-processed-tags) can be added to spans (via `InstanaSDK.addAnnotation`, `InstanaSDK.addAnnotationAt`, and `InstanaSDK.addAnnotationValueAt`).  Instana differentiates between so-called registered spans and SDK spans. Registered spans are usually created by automatic tracing and there is specialized handling for each registered in Instana's processing pipeline. SDK spans, in contrast, are the type of spans created by using a trace SDK (like the Haskell trace SDK or other, similar SDKs for other runtime platforms). SDK span are processed in a more generic fashion by Instana's processing pipeline. 

@@ -1,5 +1,5 @@ name:           instana-haskell-trace-sdk-version:        0.7.1.0+version:        0.8.0.0 synopsis:       SDK for adding custom Instana tracing support to Haskell applications. description:    Please also see the README on Github at <https://github.com/instana/haskell-trace-sdk#readme> homepage:       https://www.instana.com/@@ -35,8 +35,10 @@   build-depends:       base >=4.7 && <5     , aeson+    , aeson-casing     , aeson-extra     , bytestring+    , case-insensitive     , containers     , directory     , ekg-core@@ -60,6 +62,7 @@     , time     , unix     , unordered-containers+    , vector     , wai   if flag(dev)     ghc-options:@@ -76,6 +79,7 @@       Instana.SDK.Span.RootEntry       Instana.SDK.Span.SimpleSpan       Instana.SDK.Span.Span+      Instana.SDK.Span.SpanData       Instana.SDK.Span.SpanType       Instana.SDK.TracingHeaders       Instana.Wai.Middleware.Entry@@ -168,6 +172,7 @@     , scientific     , text     , unordered-containers+    , vector     , wai   other-modules:       -- the actual tests@@ -180,8 +185,9 @@       Instana.SDK.Internal.SecretsTest       Instana.SDK.Internal.ServerTimingTest       Instana.SDK.Internal.SpanStackTest-      Instana.SDK.Internal.SpanTest       Instana.SDK.Internal.W3CTraceContextTest+      Instana.SDK.SpanTest+      Instana.SDK.SpanDataTest       Instana.SDK.TracingHeadersTest       -- modules under test       Instana.SDK.Internal.Config@@ -195,6 +201,7 @@       Instana.SDK.Internal.ServerTiming       Instana.SDK.Span.SimpleSpan       Instana.SDK.Span.Span+      Instana.SDK.Span.SpanData       Instana.SDK.TracingHeaders       Instana.SDK.Internal.W3CTraceContext       -- dependencies of modules under test@@ -205,6 +212,7 @@       Instana.SDK.Span.ExitSpan       Instana.SDK.Span.NonRootEntry       Instana.SDK.Span.RootEntry+      Instana.SDK.Span.SpanType   default-language: Haskell2010  @@ -222,6 +230,7 @@   build-depends:       base >=4.7 && <5     , aeson+    , aeson-casing     , hslogger     , servant     , servant-server@@ -263,6 +272,7 @@   build-depends:       base >=4.7 && <5     , aeson+    , aeson-casing     , array     , bytestring     , case-insensitive@@ -287,6 +297,8 @@     , Instana.SDK.AgentStub.TraceRequest     , Instana.SDK.IntegrationTest.BracketApi     , Instana.SDK.IntegrationTest.Connection+    , Instana.SDK.IntegrationTest.CustomSecrets+    , Instana.SDK.IntegrationTest.ExtraHttpHeaders     , Instana.SDK.IntegrationTest.HUnitExtra     , Instana.SDK.IntegrationTest.HttpHelper     , Instana.SDK.IntegrationTest.HttpTracing

@@ -5,10 +5,13 @@ -} module Instana.SDK.Internal.AgentConnection.Json.AnnounceResponse     ( AnnounceResponse(..)+    , TracingConfig(..)     ) where   import           Data.Aeson                   (FromJSON)+import qualified Data.Aeson                   as Aeson+import           Data.Aeson.Casing            as AesonCasing import           Data.Text                    (Text) import           GHC.Generics @@ -19,9 +22,18 @@ data AnnounceResponse = AnnounceResponse   { pid          :: Int   , agentUuid    :: Text-  , extraHeaders :: Maybe [Text]+  , tracing      :: Maybe TracingConfig+  , extraHeaders :: Maybe [String]   , secrets      :: SecretsMatcher   } deriving (Eq, Show, Generic)  instance FromJSON AnnounceResponse ++data TracingConfig = TracingConfig+  { extraHttpHeaders :: Maybe [String]+  } deriving (Eq, Show, Generic)++instance FromJSON TracingConfig where+   parseJSON = Aeson.genericParseJSON $+     AesonCasing.aesonDrop 0 AesonCasing.trainCase

@@ -10,6 +10,8 @@   , isAgentConnectionEstablished   , mkAgentReadyState   , readAgentUuid+  , readExtraHeaders+  , readSecretsMatcher   , readPid   , whenConnected   ) where@@ -18,7 +20,11 @@ import           Control.Concurrent                                         (ThreadId) import           Control.Concurrent.STM                                     (STM) import qualified Control.Concurrent.STM                                     as STM+import qualified Data.ByteString.Char8                                      as BSC8+import           Data.CaseInsensitive                                       (CI)+import qualified Data.CaseInsensitive                                       as CI import           Data.Map.Strict                                            (Map)+import           Data.Maybe                                                 as Maybe import           Data.Sequence                                              (Seq) import           Data.Text                                                  (Text) import qualified Foreign.C.Types                                            as CTypes@@ -31,6 +37,8 @@ import           Instana.SDK.Internal.Command                               (Command) import           Instana.SDK.Internal.Config                                (FinalConfig) import           Instana.SDK.Internal.Metrics.Sample                        (TimedSample)+import           Instana.SDK.Internal.Secrets                               (SecretsMatcher)+import qualified Instana.SDK.Internal.Secrets                               as SecretsMatcher import           Instana.SDK.Internal.SpanStack                             (SpanStack) import           Instana.SDK.Internal.WireSpan                              (QueuedSpan) @@ -73,13 +81,17 @@   AgentConnection     {       -- |the host of the agent we are connected to-      agentHost :: String+      agentHost      :: String       -- |the port of the agent we are connected to-    , agentPort :: Int+    , agentPort      :: Int       -- |the PID of the monitored process-    , pid       :: String+    , pid            :: String       -- |the agent's UUID-    , agentUuid :: Text+    , agentUuid      :: Text+      -- |the configured secrets matcher+    , secretsMatcher :: SecretsMatcher+      -- |the configured list of HTTP headers to capture (or an empty list)+    , extraHeaders   :: [CI BSC8.ByteString]     }   deriving (Eq, Show, Generic) @@ -92,11 +104,25 @@   -> ConnectionState mkAgentReadyState (host_, port_) announceResponse metricsStore =   let+    maybeTracingConfig = AnnounceResponse.tracing announceResponse+    maybeExtraHeaders = AnnounceResponse.extraHttpHeaders <$> maybeTracingConfig+    maybeLegacyExtraHeaders = AnnounceResponse.extraHeaders announceResponse+    extraHeadersList =+      (Maybe.fromMaybe [] $+        Maybe.fromMaybe+          -- Fall back to legacy extraHeaders if tracing.extra-http-headers is+          -- not present.+          maybeLegacyExtraHeaders+          -- Prefer the tracing.extra-http-headers over the legacy+          -- extraHeaders attribute.+          maybeExtraHeaders)     agentConnection = AgentConnection-      { agentHost    = host_-      , agentPort    = port_-      , pid          = show $ AnnounceResponse.pid announceResponse-      , agentUuid    = AnnounceResponse.agentUuid announceResponse+      { agentHost      = host_+      , agentPort      = port_+      , pid            = show $ AnnounceResponse.pid announceResponse+      , agentUuid      = AnnounceResponse.agentUuid announceResponse+      , secretsMatcher = AnnounceResponse.secrets announceResponse+      , extraHeaders   = fmap (CI.mk . BSC8.pack) extraHeadersList       }   in   AgentReady $@@ -163,6 +189,36 @@ readPid :: InternalContext -> IO (Maybe String) readPid context =   STM.atomically $ readPidSTM context+++readSecretsMatcherSTM :: InternalContext -> STM SecretsMatcher+readSecretsMatcherSTM context = do+  state <- STM.readTVar $ connectionState context+  let+    secretsMacherMaybe = mapConnectionState secretsMatcher state+  return $+    Maybe.fromMaybe SecretsMatcher.defaultSecretsMatcher secretsMacherMaybe+++-- |accessor for the secrets matching config+readSecretsMatcher :: InternalContext -> IO SecretsMatcher+readSecretsMatcher context =+  STM.atomically $ readSecretsMatcherSTM context+++readExtraHeadersSTM :: InternalContext -> STM [CI BSC8.ByteString]+readExtraHeadersSTM context = do+  state <- STM.readTVar $ connectionState context+  let+    extraHeadersMaybe = mapConnectionState extraHeaders state+  return $+    Maybe.fromMaybe [] extraHeadersMaybe+++-- |accessor for the extra http headers config+readExtraHeaders :: InternalContext -> IO [CI BSC8.ByteString]+readExtraHeaders context =+  STM.atomically $ readExtraHeadersSTM context   mapConnectionState :: (AgentConnection -> a) -> ConnectionState -> Maybe a

@@ -13,16 +13,17 @@   ) where  -import           Control.Applicative     ((<|>))-import           Data.Aeson              (FromJSON, ToJSON, Value, (.:), (.=))-import qualified Data.Aeson              as Aeson-import qualified Data.Aeson.Extra.Merge  as AesonExtra-import           Data.Aeson.Types        (Parser)-import           Data.Text               (Text)+import           Control.Applicative       ((<|>))+import           Data.Aeson                (FromJSON, ToJSON, Value, (.:), (.=))+import qualified Data.Aeson                as Aeson+import           Data.Aeson.Types          (Parser)+import           Data.Text                 (Text) import           GHC.Generics -import           Instana.SDK.Internal.Id (Id)-import qualified Instana.SDK.Internal.Id as Id+import           Instana.SDK.Internal.Id   (Id)+import qualified Instana.SDK.Internal.Id   as Id+import           Instana.SDK.Span.SpanData (SpanData)+import qualified Instana.SDK.Span.SpanData as SpanData   -- |Direction of the call.@@ -103,7 +104,7 @@   , tpFlag          :: Maybe Bool   , instanaAncestor :: Maybe (String, String)   , synthetic       :: Maybe Bool-  , spanData        :: Value+  , spanData        :: SpanData   } deriving (Eq, Generic, Show)  @@ -143,9 +144,9 @@       spanData_ =         case (serviceName span_ <|> serviceNameConfig_) of           Just service ->-            AesonExtra.lodashMerge+            SpanData.merge+              (SpanData.simpleAnnotation "service" service)               (spanData span_)-              (Aeson.object [ "service" .= service ])           _ ->             spanData span_     in

@@ -11,11 +11,10 @@ module Instana.SDK.SDK     ( Config     , InstanaContext+    , addAnnotation+    , addAnnotationAt+    , addAnnotationValueAt     , addHttpTracingHeaders-    , addRegisteredData-    , addRegisteredDataAt-    , addTag-    , addTagAt     , addToErrorCount     , addWebsiteMonitoringBackEndCorrelation     , agentHost@@ -23,8 +22,8 @@     , captureHttpStatus     , completeEntry     , completeExit-    , currentSpan     , currentParentId+    , currentSpan     , currentSpanId     , currentTraceId     , currentTraceIdInternal@@ -65,9 +64,10 @@ import qualified Control.Concurrent.STM               as STM import           Control.Monad                        (join, when) import           Control.Monad.IO.Class               (MonadIO, liftIO)-import           Data.Aeson                           (Value, (.=))-import qualified Data.Aeson                           as Aeson+import           Data.Aeson                           (ToJSON) import qualified Data.ByteString.Char8                as BSC8+import           Data.CaseInsensitive                 (CI)+import qualified Data.CaseInsensitive                 as CI import qualified Data.List                            as List import qualified Data.Map.Strict                      as Map import qualified Data.Maybe                           as Maybe@@ -115,6 +115,9 @@ import qualified Instana.SDK.Span.SimpleSpan          as SimpleSpan import           Instana.SDK.Span.Span                (Span (..), SpanKind (..)) import qualified Instana.SDK.Span.Span                as Span+import           Instana.SDK.Span.SpanData            (Annotation (..),+                                                       AnnotationValue)+import qualified Instana.SDK.Span.SpanData            as SpanData import           Instana.SDK.Span.SpanType            (SpanType (RegisteredSpan)) import qualified Instana.SDK.Span.SpanType            as SpanType import           Instana.SDK.TracingHeaders           (TracingHeaders,@@ -454,14 +457,14 @@         RootEntrySpan $           RootEntry             { RootEntry.spanAndTraceId  = traceId-            , RootEntry.spanName        = SpanType.spanName spanType+            , RootEntry.spanType        = spanType             , RootEntry.timestamp       = timestamp             , RootEntry.errorCount      = 0             , RootEntry.serviceName     = Nothing             , RootEntry.synthetic       = False             , RootEntry.correlationType = Nothing             , RootEntry.correlationId   = Nothing-            , RootEntry.spanData        = SpanType.initialData EntryKind spanType+            , RootEntry.spanData        = Span.initialData EntryKind spanType             , RootEntry.w3cTraceContext = Nothing             }     pushSpan@@ -515,12 +518,12 @@             { NonRootEntry.traceId         = traceId             , NonRootEntry.spanId          = spanId             , NonRootEntry.parentId        = parentId-            , NonRootEntry.spanName        = SpanType.spanName spanType+            , NonRootEntry.spanType        = spanType             , NonRootEntry.timestamp       = timestamp             , NonRootEntry.errorCount      = 0             , NonRootEntry.serviceName     = Nothing             , NonRootEntry.synthetic       = False-            , NonRootEntry.spanData        = SpanType.initialData EntryKind spanType+            , NonRootEntry.spanData        = Span.initialData EntryKind spanType             , NonRootEntry.w3cTraceContext = Nothing             , NonRootEntry.tpFlag          = False             }@@ -824,26 +827,60 @@   Bool ->   m () addHttpData context request synthetic = do+  extraHeadersConfig <- liftIO $ InternalContext.readExtraHeaders context+  secretsMatcher <- liftIO $ InternalContext.readSecretsMatcher context   let     host :: String     host =       Wai.requestHeaderHost request       |> fmap BSC8.unpack       |> Maybe.fromMaybe ""-  addRegisteredData-    context-    (Aeson.object [ "http" .=-      Aeson.object-        [ "method" .= Wai.requestMethod request |> BSC8.unpack-        , "url"    .= Wai.rawPathInfo request |> BSC8.unpack-        , "host"   .= host-        , "params" .= (processQueryString $ Wai.rawQueryString request)-        ]+    capturedHeaders = collectHeaders extraHeadersConfig $ Wai.requestHeaders request+    httpAnnotations =+      [ SpanData.simpleAnnotation "method" $+          Wai.requestMethod request |> BSC8.unpack+      , SpanData.simpleAnnotation "url"    $+          Wai.rawPathInfo request |> BSC8.unpack+      , SpanData.simpleAnnotation "host" $ host+      , SpanData.optionalAnnotation "params" $+           (processQueryString secretsMatcher (Wai.rawQueryString request))       ]-    )+    httpAnnotations' =+      case capturedHeaders of+        Just headers ->+          httpAnnotations ++ [SpanData.listAnnotation "header" headers]+        Nothing ->+          httpAnnotations++  addAnnotation context (Object "http" httpAnnotations')   setSynthetic context synthetic  +collectHeaders ::+  [CI BSC8.ByteString]+  -> [HTTPTypes.Header]+  -> Maybe [(String, String)]+collectHeaders extraHeadersConfig allHeaders =+  let+    all2 = allHeaders+    filtered = filterHeaders extraHeadersConfig all2+    serialized =+      fmap+        (\(name, value) -> (BSC8.unpack $ CI.original name, BSC8.unpack value))+        filtered+  in+  if null serialized then Nothing else Just serialized+++filterHeaders :: [CI BSC8.ByteString] -> [HTTPTypes.Header] -> [HTTPTypes.Header]+filterHeaders configuredList allHeaders =+  let+    filterFn (name, _) =+      elem name configuredList+  in+  filter filterFn allHeaders++ -- |Adds website correlation annotations to the HTTP entry span. addCorrelationTypeAndIdToSpan ::   MonadIO m =>@@ -896,8 +933,9 @@   -> m Wai.Response postProcessHttpResponse context response = do   liftIO $ do-    response' <- captureHttpStatusUnlifted context response-    addWebsiteMonitoringBackEndCorrelationUnlifted context response'+    captureHttpStatusUnlifted context response+    captureResponseHeaders context response+    addWebsiteMonitoringBackEndCorrelationUnlifted context response   -- |Captures the status code of the HTTP response and adds it to the currently@@ -916,7 +954,7 @@   MonadIO m =>   InstanaContext   -> Wai.Response-  -> m Wai.Response+  -> m () captureHttpStatus context response = do   liftIO $ captureHttpStatusUnlifted context response @@ -927,20 +965,61 @@ captureHttpStatusUnlifted ::   InstanaContext   -> Wai.Response-  -> IO Wai.Response+  -> IO () captureHttpStatusUnlifted context response = do   let     (HTTPTypes.Status statusCode statusMessage) =       Wai.responseStatus response-  addRegisteredDataToEntryAt context "http.status" statusCode+  addAnnotationToEntrySpanAt context "http.status" $+    SpanData.simpleValue statusCode   when     (statusCode >= 500 )-    (addRegisteredDataAt context "http.message" $-      BSC8.unpack statusMessage+    (addAnnotationAt context "http.message" $+      SpanData.simpleValue $ BSC8.unpack statusMessage     )-  return response  +-- |Captures the HTTP headers of the response, if extra headers for capture have+-- been configured. The captured header (if any) will be added to the currently+-- active span. This function needs be called while the HTTP entry span is still+-- active. It can be used inside a 'withHttpEntry_' block or between+-- 'startHttpEntry' and 'completeEntry'.+--+-- Client code should rarely have the need to call this directly. Instead,+-- capture incoming HTTP requests with 'withHttpEntry', which captures the+-- headers automatically. When not using 'withHttpEntry', the function+-- 'postProcessHttpResponse' should be preferred over this function.+captureResponseHeaders ::+  MonadIO m =>+  InstanaContext+  -> Wai.Response+  -> m ()+captureResponseHeaders context response = do+  liftIO $ captureResponseHeadersUnlifted context response+++-- |Captures the HTTP headers of the response, if extra headers for capture have+-- been configured. The captured header (if any) will be added to the currently+-- active span.+captureResponseHeadersUnlifted ::+  InstanaContext+  -> Wai.Response+  -> IO ()+captureResponseHeadersUnlifted context response = do+  extraHeadersConfig <- liftIO $ InternalContext.readExtraHeaders context+  let+    capturedHeaders =+      collectHeaders extraHeadersConfig $ Wai.responseHeaders response+  when+    (Maybe.isJust capturedHeaders)+    (do+       let+         Just headers = capturedHeaders+       addAnnotationValueToEntrySpanAt context "http.header" $+         SpanData.listValue headers+    )++ -- |Adds an additional HTTP response header (Server-Timing) to the given HTTP -- response that enables website monitoring back end correlation. In case the -- response already has a Server-Timing header, a value is appended to the@@ -1019,11 +1098,11 @@               ExitSpan                 { ExitSpan.parentSpan      = parent                 , ExitSpan.spanId          = spanId-                , ExitSpan.spanName        = SpanType.spanName spanType+                , ExitSpan.spanType        = spanType                 , ExitSpan.timestamp       = timestamp                 , ExitSpan.errorCount      = 0                 , ExitSpan.serviceName     = Nothing-                , ExitSpan.spanData        = SpanType.initialData+                , ExitSpan.spanData        = Span.initialData                                                ExitKind                                                spanType                 , ExitSpan.w3cTraceContext = w3cTraceContext@@ -1065,23 +1144,37 @@   -> HTTP.Request   -> m HTTP.Request startHttpExit context request = do+  extraHeadersConfig <- liftIO $ InternalContext.readExtraHeaders context+  secretsMatcher <- liftIO $ InternalContext.readSecretsMatcher context+   let     originalCheckResponse = HTTP.checkResponse request     request' =       request+        -- Inject a checkResponse hook to capture the response status and+        -- response headers.         { HTTP.checkResponse = (\req res -> do             let               status =                 res                   |> HTTP.responseStatus                   |> HTTPTypes.statusCode-            addRegisteredData context-              (Aeson.object [ "http" .=-                Aeson.object-                  [ "status" .= status-                  ]-                ]+              capturedResponseHeaders =+                collectHeaders extraHeadersConfig $+                  HTTP.responseHeaders res++            addAnnotationAt context "http.status" $+              SpanData.simpleValue status++            when+              (Maybe.isJust capturedResponseHeaders)+              (do+                 let+                   Just responseHeaders = capturedResponseHeaders+                 addAnnotationValueAt context "http.header" $+                   SpanData.listValue responseHeaders               )+             originalCheckResponse req res           )         }@@ -1090,40 +1183,61 @@     host = BSC8.unpack $ HTTP.host request     path = BSC8.unpack $ HTTP.path request     url = protocol ++ host ++ port ++ path+    capturedRequestHeaders = collectHeaders extraHeadersConfig $ HTTP.requestHeaders request+    httpAnnotations =+      [ SpanData.simpleAnnotation "method" $ BSC8.unpack $ HTTP.method request+      , SpanData.simpleAnnotation "url"    url+      , SpanData.optionalAnnotation "params"+          (processQueryString secretsMatcher (HTTP.queryString request))+      ]+    httpAnnotations' =+      case capturedRequestHeaders of+        Just requestHeaders ->+          httpAnnotations ++ [SpanData.listAnnotation "header" requestHeaders]+        Nothing ->+          httpAnnotations    startExit context (RegisteredSpan SpanType.HaskellHttpClient)   request'' <- addHttpTracingHeaders context request'-  addRegisteredData-    context-    (Aeson.object [ "http" .=-      Aeson.object-        [ "method" .= (BSC8.unpack $ HTTP.method request)-        , "url"    .= url-        , "params" .= (processQueryString $ HTTP.queryString request)-        ]-      ]-    )+  addAnnotation context (Object "http" httpAnnotations')   return request''  -processQueryString :: BSC8.ByteString -> Text-processQueryString queryString =-  let-    matcher = Secrets.defaultSecretsMatcher-  in+processQueryString :: Secrets.SecretsMatcher -> BSC8.ByteString -> Maybe Text+processQueryString secretsMatcher queryString =   queryString     |> BSC8.unpack     |> T.pack-    |> (\t -> if (not . T.null) t && T.head  t == '?' then T.tail t else t)+    -- drop leading "?" character+    |> (\t -> if (not . T.null) t && T.head t == '?' then T.tail t else t)+    -- split on "&" delimiter     |> T.splitOn "&"-    |> List.map (T.splitOn "=")-    |> List.filter-        (\pair ->-          List.length pair == 2 &&-          (not . Secrets.isSecret matcher) (List.head pair)-        )-    |> List.map (T.intercalate "=")+    -- splitOn can yield "" elements, drop them+    |> List.filter (not . T.null)+    -- convert to pairs of query string name and value+    |> List.map (T.breakOn "=")+    -- drop leading "=" from value (breakOn includes the delimiter if present)+    |> List.map (\tuple ->+         if T.isPrefixOf "=" (snd tuple)+           then+             (fst tuple, T.tail $ snd tuple)+           else+             tuple+       )+    -- redact secrets+    |> List.map (\tuple ->+         if (Secrets.isSecret secretsMatcher) (fst tuple)+           then+             (fst tuple, "<redacted>")+           else+             tuple+       )+    -- put pairs back together+    |> List.map (\tuple -> T.concat [fst tuple, "=", snd tuple])+    -- concat into one string again     |> T.intercalate "&"+    -- drop param if there were no query parameters+    |> (\t -> if t == "" then Nothing else Just t)   -- |Completes an entry span, to be called at the last possible moment before the@@ -1258,49 +1372,44 @@     (\span_ -> Span.setSynthetic synthetic span_)  --- |Adds additional custom tags to the currently active span. Call this--- between startEntry/startRootEntry/startExit and completeEntry/completeExit or--- inside the IO action given to with withEntry/withExit/withRootEntry.+-- |Adds an annotation to the currently active span. Call this between+-- startEntry/startRootEntry/startExit and completeEntry/completeExit or+-- inside the IO action given to withEntry/withExit/withRootEntry. -- The given path can be a nested path, with path fragments separated by dots, -- like "http.url". This will result in -- "data": { --   ...---   "sdk": {---     "custom": {---       "tags": {---         "http": {---           "url": "..."---         },---       },---     },+--   "http": {+--     "url": "..." --   }, --   ... -- }------ This should be used for SDK spans instead of addRegisteredDataAt.-addTagAt :: (MonadIO m, Aeson.ToJSON a) => InstanaContext -> Text -> a -> m ()-addTagAt context path value =+addAnnotationAt ::+  (MonadIO m, ToJSON a) =>+  InstanaContext+  -> Text+  -> a+  -> m ()+addAnnotationAt context path value =   liftIO $ modifyCurrentSpan context-    (\span_ -> Span.addTagAt path value span_)+    (\span_ -> Span.addAnnotationAt path value span_)  --- |Adds additional custom tags to the currently active span. Call this--- between startEntry/startRootEntry/startExit and completeEntry/completeExit or+-- |Adds an annotation to the currently active span. Call this between+-- startEntry/startRootEntry/startExit and completeEntry/completeExit or -- inside the IO action given to with withEntry/withExit/withRootEntry. Can be -- called multiple times, data from multiple calls will be merged.------ This should be used for SDK spans instead of addRegisteredData.-addTag :: MonadIO m => InstanaContext -> Value -> m ()-addTag context value =+addAnnotation :: MonadIO m => InstanaContext -> Annotation -> m ()+addAnnotation context annotation =   liftIO $ modifyCurrentSpan context-    (\span_ -> Span.addTag value span_)+    (\span_ -> Span.addAnnotation annotation span_)  --- |Adds additional meta data to the currently active registered span. Call this--- between startEntry/startRootEntry/startExit and completeEntry/completeExit or--- inside the IO action given to with withEntry/withExit/withRootEntry.--- The given path can be a nested path, with path fragments separated by dots,--- like "http.url". This will result in+-- |Adds an annotation with the given value to the currently active span. Call+-- this between startEntry/startRootEntry/startExit and+-- completeEntry/completeExit or inside the IO action given to with+-- withEntry/withExit/withRootEntry. The given path can be a nested path, with+-- path fragments separated by dots, like "http.url". This will result in -- "data": { --   ... --   "http": {@@ -1308,46 +1417,41 @@ --   }, --   ... -- }------ Note that this should only be used for registered spans, not for SDK spans.--- Use addTagAt for SDK spans instead.-addRegisteredDataAt ::-  (MonadIO m, Aeson.ToJSON a) =>+addAnnotationValueAt ::+  (MonadIO m) =>   InstanaContext   -> Text-  -> a+  -> AnnotationValue   -> m ()-addRegisteredDataAt context path value =+addAnnotationValueAt context path value =   liftIO $ modifyCurrentSpan context-    (\span_ -> Span.addRegisteredDataAt path value span_)+    (\span_ -> Span.addAnnotationValueAt path value span_)  --- |Adds additional meta data to the currently active entry span, even if the--- currently active span is an exit child of that entry span.------ Note that this should only be used for registered spans, not for SDK spans.-addRegisteredDataToEntryAt ::-  (MonadIO m, Aeson.ToJSON a) =>+-- |Adds an additional annotation to the currently active entry span, even if+-- the currently active span is an exit child of that entry span.+addAnnotationToEntrySpanAt ::+  (MonadIO m, ToJSON a) =>   InstanaContext   -> Text   -> a   -> m ()-addRegisteredDataToEntryAt context path value =+addAnnotationToEntrySpanAt context path value =   liftIO $ modifyCurrentEntrySpan context-    (\span_ -> Span.addRegisteredDataAt path value span_)+    (\span_ -> Span.addAnnotationAt path value span_)  --- |Adds additional data to the currently active registered span. Call this--- between startEntry/startRootEntry/startExit and completeEntry/completeExit or--- inside the IO action given to with withEntry/withExit/withRootEntry. Can be--- called multiple times, data from multiple calls will be merged.------ Note that this should only be used for registered spans, not for SDK spans.--- Use addTag for SDK spans instead.-addRegisteredData :: MonadIO m => InstanaContext -> Value -> m ()-addRegisteredData context value =-  liftIO $ modifyCurrentSpan context-    (\span_ -> Span.addRegisteredData value span_)+-- |Adds an additional annotation to the currently active entry span, even if+-- the currently active span is an exit child of that entry span.+addAnnotationValueToEntrySpanAt ::+  (MonadIO m) =>+  InstanaContext+  -> Text+  -> AnnotationValue+  -> m ()+addAnnotationValueToEntrySpanAt context path value =+  liftIO $ modifyCurrentEntrySpan context+    (\span_ -> Span.addAnnotationValueAt path value span_)   -- |Adds the Instana tracing headers

@@ -5,7 +5,7 @@ -} module Instana.SDK.Span.EntrySpan   ( EntrySpan(..)-  , addData+  , addAnnotation   , addToErrorCount   , correlationId   , correlationType@@ -21,6 +21,7 @@   , spanData   , spanId   , spanName+  , spanType   , synthetic   , tpFlag   , timestamp@@ -29,7 +30,6 @@   ) where  -import           Data.Aeson                           (Value) import           Data.Text                            (Text) import           GHC.Generics @@ -39,6 +39,8 @@ import qualified Instana.SDK.Span.NonRootEntry        as NonRootEntry import           Instana.SDK.Span.RootEntry           (RootEntry) import qualified Instana.SDK.Span.RootEntry           as RootEntry+import           Instana.SDK.Span.SpanData            (Annotation, SpanData)+import           Instana.SDK.Span.SpanType            (SpanType)   -- |An entry span.@@ -72,6 +74,14 @@     NonRootEntrySpan entry -> Just $ NonRootEntry.parentId entry  +-- |Type of span (registerd span vs. SDK span)+spanType :: EntrySpan -> SpanType+spanType entrySpan =+  case entrySpan of+    RootEntrySpan entry   -> RootEntry.spanType entry+    NonRootEntrySpan exit -> NonRootEntry.spanType exit++ -- |Name of span. spanName :: EntrySpan -> Text spanName entrySpan =@@ -225,19 +235,21 @@   -- |Optional additional span data.-spanData :: EntrySpan -> Value+spanData :: EntrySpan -> SpanData spanData entrySpan =   case entrySpan of     RootEntrySpan    entry -> RootEntry.spanData entry     NonRootEntrySpan entry -> NonRootEntry.spanData entry  --- |Add a value to the span's data section.-addData :: Value -> EntrySpan -> EntrySpan-addData value entrySpan =+-- |Add an annotation to the span's data section. For SDK spans, the annotation+-- is added to span.data.sdk.custom.tags, for registered spans it is added+-- directly to span.data.+addAnnotation :: Annotation-> EntrySpan -> EntrySpan+addAnnotation value entrySpan =   case entrySpan of     RootEntrySpan    entry ->-      RootEntrySpan $ RootEntry.addData value entry+      RootEntrySpan $ RootEntry.addAnnotation value entry     NonRootEntrySpan entry ->-      NonRootEntrySpan $ NonRootEntry.addData value entry+      NonRootEntrySpan $ NonRootEntry.addAnnotation value entry 

@@ -7,15 +7,14 @@   ( ExitSpan(..)   , parentId   , traceId-  , addData+  , addAnnotation   , addToErrorCount   , setServiceName   , setW3cTraceContext+  , spanName   ) where  -import           Data.Aeson                           (Value)-import qualified Data.Aeson.Extra.Merge               as AesonExtra import           Data.Text                            (Text) import           GHC.Generics @@ -23,6 +22,10 @@ import           Instana.SDK.Internal.W3CTraceContext (W3CTraceContext) import           Instana.SDK.Span.EntrySpan           (EntrySpan) import qualified Instana.SDK.Span.EntrySpan           as EntrySpan+import           Instana.SDK.Span.SpanData            (Annotation, SpanData)+import qualified Instana.SDK.Span.SpanData            as SpanData+import           Instana.SDK.Span.SpanType            (SpanType)+import qualified Instana.SDK.Span.SpanType            as SpanType   -- |An exit span.@@ -33,19 +36,16 @@       parentSpan      :: EntrySpan       -- |The span ID     , spanId          :: Id-      -- |The span name/type, e.g. a short string like "haskell.wai.server",-      -- "haskell.http.client". For SDK spans this is always "sdk", the actual-      -- name is then in span.data.sdk.name.-    , spanName        :: Text+      -- |The type of the span (SDK span or registerd span)+    , spanType        :: SpanType       -- |The time the span started     , timestamp       :: Int       -- |An attribute for overriding the name of the service in Instana     , serviceName     :: Maybe Text       -- |The number of errors that occured during processing     , errorCount      :: Int-      -- |Additional data for the span. Must be provided as an-      -- 'Data.Aeson.Value'.-    , spanData        :: Value+      -- |Additional data for the span.+    , spanData        :: SpanData       -- |The W3C Trace Context. An entry span only has an associated W3C trace       -- context, if W3C trace context headers have been received. In contrast,       -- spans always have an associated W3C trace context.@@ -53,6 +53,13 @@     } deriving (Eq, Generic, Show)  +-- |The span name/type, e.g. a short string like "haskell.wai.server",+-- "haskell.http.client". For SDK spans this is always "sdk", the actual+-- name is then in span.data.sdk.name.+spanName :: ExitSpan -> Text+spanName = SpanType.spanName . spanType++ -- |Accessor for the trace ID. traceId :: ExitSpan -> Id traceId exitSpan =@@ -86,12 +93,10 @@   exitSpan { w3cTraceContext = w3cTraceContext_ }  --- |Add a value to the span's data section.-addData :: Value -> ExitSpan -> ExitSpan-addData newData exitSpan =-  let-    currentData = spanData exitSpan-    mergedData = AesonExtra.lodashMerge currentData newData-  in-  exitSpan { spanData = mergedData }+-- |Add an annotation to the span's data section. For SDK spans, the annotation+-- is added to span.data.sdk.custom.tags, for registered spans it is added+-- directly to span.data.+addAnnotation :: Annotation -> ExitSpan -> ExitSpan+addAnnotation annotation exitSpan =+  exitSpan { spanData = SpanData.merge annotation $ spanData exitSpan } 

@@ -5,22 +5,25 @@ -} module Instana.SDK.Span.NonRootEntry   ( NonRootEntry(..)-  , addData+  , addAnnotation   , addToErrorCount   , setServiceName   , setSynthetic   , setTpFlag   , setW3cTraceContext+  , spanName   ) where  -import           Data.Aeson                           (Value)-import qualified Data.Aeson.Extra.Merge               as AesonExtra import           Data.Text                            (Text) import           GHC.Generics  import           Instana.SDK.Internal.Id              (Id) import           Instana.SDK.Internal.W3CTraceContext (W3CTraceContext)+import           Instana.SDK.Span.SpanData            (Annotation, SpanData)+import qualified Instana.SDK.Span.SpanData            as SpanData+import           Instana.SDK.Span.SpanType            (SpanType)+import qualified Instana.SDK.Span.SpanType            as SpanType   -- |An entry span that is not the root span of a trace.@@ -33,10 +36,8 @@     , spanId          :: Id       -- |The ID of the parent span     , parentId        :: Id-      -- |The span name/type, e.g. a short string like "haskell.wai.server",-      -- "haskell.http.client". For SDK spans this is always "sdk", the actual-      -- name is then in span.data.sdk.name.-    , spanName        :: Text+      -- |The type of the span (SDK span or registerd span)+    , spanType        :: SpanType       -- |The time the span started     , timestamp       :: Int       -- |The number of errors that occured during processing@@ -45,9 +46,8 @@     , serviceName     :: Maybe Text       -- |A flag indicating that this span represents a synthetic call     , synthetic       :: Bool-      -- |Additional data for the span. Must be provided as an-      -- 'Data.Aeson.Value'.-    , spanData        :: Value+      -- |Additional data for the span.+    , spanData        :: SpanData       -- |The W3C Trace Context. An entry span only has an associated W3C trace       -- context, if W3C trace context headers have been received.     , w3cTraceContext :: Maybe W3CTraceContext@@ -57,6 +57,13 @@     } deriving (Eq, Generic, Show)  +-- |The span name/type, e.g. a short string like "haskell.wai.server",+-- "haskell.http.client". For SDK spans this is always "sdk", the actual+-- name is then in span.data.sdk.name.+spanName :: NonRootEntry -> Text+spanName = SpanType.spanName . spanType++ -- |Add to the error count. addToErrorCount :: Int -> NonRootEntry -> NonRootEntry addToErrorCount increment nonRootEntry =@@ -91,12 +98,10 @@   nonRootEntry { synthetic = synthetic_ }  --- |Add a value to the span's data section.-addData :: Value -> NonRootEntry -> NonRootEntry-addData newData nonRootEntry =-  let-    currentData = spanData nonRootEntry-    mergedData = AesonExtra.lodashMerge currentData newData-  in-  nonRootEntry { spanData = mergedData }+-- |Add an annotation to the span's data section. For SDK spans, the annotation+-- is added to span.data.sdk.custom.tags, for registered spans it is added+-- directly to span.data.+addAnnotation :: Annotation -> NonRootEntry -> NonRootEntry+addAnnotation annotation nonRootEntry =+  nonRootEntry { spanData = SpanData.merge annotation $ spanData nonRootEntry } 

@@ -7,23 +7,26 @@   ( RootEntry(..)   , spanId   , traceId-  , addData+  , addAnnotation   , addToErrorCount   , setServiceName   , setCorrelationType   , setCorrelationId   , setSynthetic   , setW3cTraceContext+  , spanName   ) where  -import           Data.Aeson                           (Value)-import qualified Data.Aeson.Extra.Merge               as AesonExtra import           Data.Text                            (Text) import           GHC.Generics  import           Instana.SDK.Internal.Id              (Id) import           Instana.SDK.Internal.W3CTraceContext (W3CTraceContext)+import           Instana.SDK.Span.SpanData            (Annotation, SpanData)+import qualified Instana.SDK.Span.SpanData            as SpanData+import           Instana.SDK.Span.SpanType            (SpanType)+import qualified Instana.SDK.Span.SpanType            as SpanType   -- |An entry span that is the root span of a trace.@@ -31,12 +34,10 @@   RootEntry     {       -- |The trace ID and span ID (those are identical for root spans)-      spanAndTraceId  :: Id-      -- |The span name/type, e.g. a short string like "haskell.wai.server",-      -- "haskell.http.client". For SDK spans this is always "sdk", the actual-      -- name is then in span.data.sdk.name.-    , spanName        :: Text-      -- |The time the span (and trace) started+       spanAndTraceId :: Id+      -- |The type of the span (SDK span or registerd span)+     , spanType       :: SpanType+     -- |The time the span (and trace) started     , timestamp       :: Int       -- |The number of errors that occured during processing     , errorCount      :: Int@@ -48,9 +49,8 @@     , correlationType :: Maybe Text       -- |The website monitoring correlation ID     , correlationId   :: Maybe Text-      -- |Additional data for the span. Must be provided as an-      -- 'Data.Aeson.Value'.-    , spanData        :: Value+      -- |Additional data for the span.+    , spanData        :: SpanData       -- |The W3C Trace Context. An entry span only has an associated W3C trace       -- context, if W3C trace context headers have been received.     , w3cTraceContext :: Maybe W3CTraceContext@@ -58,6 +58,13 @@     } deriving (Eq, Generic, Show)  +-- |The span name/type, e.g. a short string like "haskell.wai.server",+-- "haskell.http.client". For SDK spans this is always "sdk", the actual+-- name is then in span.data.sdk.name.+spanName :: RootEntry -> Text+spanName = SpanType.spanName . spanType++ -- |Accessor for the trace ID. traceId :: RootEntry -> Id traceId = spanAndTraceId@@ -107,12 +114,10 @@   rootEntry { correlationId = Just correlationId_ }  --- |Add a value to the span's data section.-addData :: Value -> RootEntry -> RootEntry-addData newData rootEntry =-  let-    currentData = spanData rootEntry-    mergedData = AesonExtra.lodashMerge currentData newData-  in-  rootEntry { spanData = mergedData }+-- |Add an annotation to the span's data section. For SDK spans, the annotation+-- is added to span.data.sdk.custom.tags, for registered spans it is added+-- directly to span.data.+addAnnotation :: Annotation -> RootEntry -> RootEntry+addAnnotation annotation rootEntry =+  rootEntry { spanData = SpanData.merge annotation $ spanData rootEntry } 

@@ -10,14 +10,13 @@   ) where  -import qualified Data.Aeson              as Aeson-import qualified Data.Text               as T+import qualified Data.Text                 as T import           GHC.Generics -import qualified Instana.SDK.Internal.Id as Id-import           Instana.SDK.Span.Span   (SpanKind (..))-import           Instana.SDK.Span.Span   (Span)-import qualified Instana.SDK.Span.Span   as Span+import qualified Instana.SDK.Internal.Id   as Id+import           Instana.SDK.Span.Span     (Span, SpanKind (..))+import qualified Instana.SDK.Span.Span     as Span+import           Instana.SDK.Span.SpanData (SpanData)   -- |A representation of the span fit for external use by clients of the SDK.@@ -29,7 +28,7 @@   , timestamp  :: Int   , kind       :: SpanKind   , errorCount :: Int-  , spanData   :: Aeson.Value+  , spanData   :: SpanData   } deriving (Eq, Generic, Show)  

@@ -7,26 +7,27 @@ module Instana.SDK.Span.Span   ( Span (Entry, Exit)   , SpanKind (EntryKind, ExitKind, IntermediateKind)-  , addRegisteredData-  , addRegisteredDataAt-  , addTag-  , addTagAt+  , addAnnotation+  , addAnnotationAt+  , addAnnotationValueAt   , addToErrorCount   , correlationId   , correlationType   , errorCount+  , initialData   , parentId   , serviceName   , setCorrelationId   , setCorrelationType   , setServiceName   , setSynthetic+  , setTpFlag   , setW3cTraceContext   , spanData-  , setTpFlag   , spanId   , spanKind   , spanName+  , spanType   , synthetic   , timestamp   , tpFlag@@ -35,9 +36,8 @@   ) where  -import           Data.Aeson                           (Value, (.=))-import qualified Data.Aeson                           as Aeson-import qualified Data.List                            as List+import           Data.Aeson                           (ToJSON)+import           Data.List                            as List import           Data.Text                            as T import           GHC.Generics @@ -47,6 +47,11 @@ import qualified Instana.SDK.Span.EntrySpan           as EntrySpan import           Instana.SDK.Span.ExitSpan            (ExitSpan) import qualified Instana.SDK.Span.ExitSpan            as ExitSpan+import           Instana.SDK.Span.SpanData            (Annotation,+                                                       AnnotationValue,+                                                       SpanData (SpanData))+import qualified Instana.SDK.Span.SpanData            as SpanData+import           Instana.SDK.Span.SpanType            (SpanType (RegisteredSpan, SdkSpan))   -- |The span kind (entry, exit or intermediate).@@ -92,6 +97,14 @@     Exit exit   -> Just $ ExitSpan.parentId exit  +-- |Type of span (registerd span vs. SDK span)+spanType :: Span -> SpanType+spanType span_ =+  case span_ of+    Entry entry -> EntrySpan.spanType entry+    Exit exit   -> ExitSpan.spanType exit++ -- |Name of span. spanName :: Span -> Text spanName span_ =@@ -253,52 +266,101 @@   -- |Optional additional span data.-spanData :: Span -> Value+spanData :: Span -> SpanData spanData span_ =   case span_ of     Entry entry -> EntrySpan.spanData entry     Exit exit   -> ExitSpan.spanData exit  --- |Add a value to the span's custom tags section. This should be used for SDK--- spans instead of addRegisteredData.-addTag :: Value -> Span -> Span-addTag value span_ =-  addRegisteredDataAt "sdk.custom.tags" value span_----- |Add a value to the given path to the span's custom tags section. This should--- be used for SDK spans instead of addRegisteredDataAt.-addTagAt :: Aeson.ToJSON a => Text -> a -> Span -> Span-addTagAt path value span_ =-  addRegisteredDataAt (T.concat ["sdk.custom.tags.", path]) value span_-+-- |Add an annotation to the span's data section. For SDK spans, the annotation+-- is added to span.data.sdk.custom.tags, for registered spans it is added+-- directly to span.data.+addAnnotation :: Annotation -> Span -> Span+addAnnotation annotation span_ =+  let+    wrappedAnnotation = wrapAnnotationIfNecessary span_ annotation+  in+  case span_ of+    Entry entry -> Entry $ EntrySpan.addAnnotation wrappedAnnotation entry+    Exit exit   -> Exit $ ExitSpan.addAnnotation wrappedAnnotation exit  --- |Add a value to the span's data section. This should only be used for--- registered spans, not for SDK spans. For SDK spans, you should use addTag--- instead.-addRegisteredData :: Value -> Span -> Span-addRegisteredData value span_ =-  case span_ of-    Entry entry -> Entry $ EntrySpan.addData value entry-    Exit exit   -> Exit $ ExitSpan.addData value exit+-- |Add a simple value (string, boolean, number) at the given path to the span's+-- data section.+addAnnotationAt :: ToJSON a => Text -> a -> Span -> Span+addAnnotationAt path value span_ =+  let+    pathSegments = T.splitOn "." path+    lastPathSegment = List.last pathSegments+    pathPrefix = List.take (List.length pathSegments - 1) pathSegments+    newData = List.foldr+      (\nextPathSegment accumulated ->+        SpanData.objectAnnotation nextPathSegment [accumulated]+      )+      (SpanData.simpleAnnotation lastPathSegment value)+      pathPrefix+  in+  addAnnotation newData span_  --- |Add a value at the given path to the span's data section. For SDK spans, you--- should use addTagAt instead.-addRegisteredDataAt :: Aeson.ToJSON a => Text -> a -> Span -> Span-addRegisteredDataAt path value span_ =+-- |Add a list value at the given path to the span's data section. For SDK+-- spans, you should use addAnnotationValueToSdkSpan instead. For annotations with simple+-- values (string, number, boolean, etc.), you can also use the convenience+-- function addAnnotationAt.+addAnnotationValueAt :: Text -> AnnotationValue -> Span -> Span+addAnnotationValueAt path value span_ =   let     pathSegments = T.splitOn "." path+    lastPathSegment = List.last pathSegments+    pathPrefix = List.take (List.length pathSegments - 1) pathSegments     newData = List.foldr-      (\nextPathSegment accumulatedAesonValue ->-        Aeson.object [-          nextPathSegment .= accumulatedAesonValue+      (\nextPathSegment accumulated ->+        SpanData.objectAnnotation nextPathSegment [accumulated]+      )+      (SpanData.singleAnnotation lastPathSegment value)+      pathPrefix+  in+  addAnnotation newData span_+++wrapAnnotationIfNecessary :: Span -> Annotation -> Annotation+wrapAnnotationIfNecessary span_ annotation =+  case spanType span_ of+    RegisteredSpan _ ->+      annotation+    SdkSpan _ ->+      ( SpanData.objectAnnotation "sdk" [+          SpanData.objectAnnotation "custom" [+            SpanData.objectAnnotation "tags" [+              annotation+            ]+          ]         ]       )-      (Aeson.toJSON value)-      pathSegments+++-- |Returns the initial data (span.data) for a SpanType value.+initialData :: SpanKind -> SpanType -> SpanData+initialData kind (SdkSpan s)     = initialSdkData kind s+initialData _ (RegisteredSpan _) = SpanData.empty+++-- |Provides the initial data for an SDK span.+initialSdkData :: SpanKind -> Text -> SpanData+initialSdkData kind spanName_ =+  let+    sdkKind :: Text+    sdkKind =+      case kind of+        EntryKind        -> "entry"+        ExitKind         -> "exit"+        IntermediateKind -> "intermediate"   in-  addRegisteredData newData span_+  SpanData+    [ SpanData.objectAnnotation "sdk"+        [ SpanData.simpleAnnotation "name" spanName_+        , SpanData.simpleAnnotation "type" sdkKind+        ]+    ] 

@@ -0,0 +1,282 @@+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-|+Module      : Instana.SDK.Span.SpanData+Description : A type for span data, that is, the content in span.data.+-}+module Instana.SDK.Span.SpanData+  ( SpanData (SpanData)+  , Annotation (..)+  , AnnotationValue (..)+  , empty+  , listAnnotation+  , listValue+  , merge+  , nullAnnotation+  , objectAnnotation+  , optionalAnnotation+  , optionalValue+  , simpleAnnotation+  , simpleValue+  , singleAnnotation+  ) where+++import           Data.Aeson                (KeyValue, ToJSON, Value, (.=))+import qualified Data.Aeson                as Aeson+import qualified Data.List                 as L+import qualified Data.Maybe                as Maybe+import           Data.Text                 (Text)+import qualified Data.Vector               as V+import           GHC.Generics++import           Instana.SDK.Internal.Util ((|>))+++-- |Represents span.data, that is, the tree of free-form annotatiations for a+-- span.+data SpanData =+  SpanData [Annotation]+  deriving (Eq, Generic, Show)+++instance ToJSON SpanData where+  toJSON :: SpanData -> Value+  toJSON (SpanData annotations) =+    Aeson.object $+      map annotationToJson annotations+      |> Maybe.catMaybes+++-- |Creates empty span data.+empty :: SpanData+empty = SpanData []+++-- |Merges the given annotation into the given span data. If there is a conflict+-- between existing annotations and a new annotation (that is, both are at the+-- same path of keys), this will be resolved as follows:+-- - If both the existing and the new annotation are list annotations, they will+--   be merged. Duplicates are allowed (that is, duplicate values will not be+--   removed).+-- - Otherwise, if the existing annotation or the new annotation is a single+--   annotation, the new annotation will overwrite the existing one.+-- - If both the existing and the new annotation are object annotations, they+--   will be merged by applying these rules recursively.+merge :: Annotation -> SpanData -> SpanData+merge newAnnotation (SpanData existingAnnotations) =+  SpanData $ mergeAnnotation newAnnotation existingAnnotations+++mergeAnnotation :: Annotation -> [Annotation] -> [Annotation]+mergeAnnotation newAnnotation existingAnnotations =+  let+    key =+      getKey newAnnotation+    existingAnnotationForKeyMaybe =+      L.find ((== key) . getKey) existingAnnotations+  in+  case existingAnnotationForKeyMaybe of+    Nothing ->+      -- The new key does not exist yet, simply add it.+      existingAnnotations ++ [newAnnotation]+    Just existingAnnotationForKey ->+      let+        annotationsWithoutPrevious =+          (L.delete existingAnnotationForKey existingAnnotations)+      in+      case (existingAnnotationForKey, newAnnotation) of+        (Single _ (List values1), Single _ (List values2)) ->++          -- The key exists already and both the existing and the new annotation+          -- are lists. Merge both list values into one list annotation.+          annotationsWithoutPrevious +++            [Single key $ List $ values1 ++ values2]++        (Single _ _, _) ->++          -- The key exists already but was previously a single value. We+          -- cannot merge the new annotation into the single value annotation,+          -- overwrite it.+          annotationsWithoutPrevious ++ [newAnnotation]++        (_, Single _ _) ->++          -- The key exists already but the new value is single value. We+          -- cannot merge the new annotation into an existing annotation,+          -- overwrite it.+          annotationsWithoutPrevious ++ [newAnnotation]++        (Object _ previousChildren, Object _ newChildren) ->++          -- The key exists already and both the existing and the new annotation+          -- are object annotations. We merge both structures by recursively+          -- merging all child annotations from the new object annotation with+          -- the child annotations from the existing object annotation.+          let+            mergedChildAnnotations =+              L.foldr+                mergeAnnotation+                previousChildren -- starting value for foldr+                newChildren      -- the list we iterate over+          in+          annotationsWithoutPrevious ++ [Object key mergedChildAnnotations]+++-- |Represents a single item in span.data, either an object with child+-- annotations or a single annotation (String, Int, Boolean, List, Maybe etc.)+data Annotation =+  -- |Similar to the type Data.Aeson.Types.Object, an object annotation can hold+  -- multiple child annotations. In+  -- { "http":+  --   { "url": "http://localhost:8080"+  --   , "method": "GET"+  --   , "headers": [("X-Header-1", "value 1), ("X-Header-2", "value 2)]+  --   }+  -- }+  -- the "http" key would be an Object annotation.+  Object Text [Annotation]+  -- |Somewhat similar to Data.Aeson.Types.Pair, a single annotation holds one+  -- single value (String, Number, Boolean, List, Maybe etc.). In the example+  -- above, "url", "method" and headers would be Single annotations.+  | Single Text AnnotationValue+  deriving (Eq, Generic, Show)+++-- |Converts a single annotation to a Aeson.KeyValue. An annotation on its own+-- cannot be converted into an Aeson.Value, since it needs to be  wrapped in+-- another Object annotationa and ultimately in SpanData. This implementation+-- will also take care of removing optional annotations that are Nothing.+annotationToJson :: forall kv . KeyValue kv => Annotation -> Maybe kv+annotationToJson annotation =+  case annotation of+    Object key childAnnotations ->+      let+        object :: Value+        object =+          Aeson.object $+            map annotationToJson childAnnotations |> Maybe.catMaybes+        keyValue :: kv+        keyValue = (key .= object)+      in+      Just keyValue++    Single _ (Optional Nothing) ->+      -- drop optional annotations that are Nothing+      Nothing++    Single key annotationValue ->+      let+        pair :: kv+        pair = (key .= (Aeson.toJSON annotationValue))+      in+      Just pair+++-- |Retrieves the key from an annotation.+getKey :: Annotation -> Text+getKey (Object key _) = key+getKey (Single key _) = key+++-- |Creates a new object annotation. Similar to the type+-- Data.Aeson.Types.Object, an object annotation can hold multiple child+-- annotations. In+-- { "http":+--   { "url": "http://localhost:8080"+--   , "method": "GET"+--   }+-- }+-- the "http" key would be an Object annotation.+objectAnnotation :: Text -> [Annotation] -> Annotation+objectAnnotation key children = Object key children+++-- |Creates a single annotation. Somewhat similar to Data.Aeson.Types.Pair, a+-- single annotation holds one value+-- (String, Number, Boolean, List, Maybe etc.).+--+-- The convenience functions simpleAnnotation, listAnnotation, and+-- optionalAnnotation allow creating a single annotation without creating the+-- AnnotationValue explicitly.+singleAnnotation :: Text -> AnnotationValue -> Annotation+singleAnnotation key value = Single key value+++-- |Creates a simple annotation, which holds one primitive value (String,+-- Number, Boolean, etc.).+simpleAnnotation :: ToJSON a => Text -> a -> Annotation+simpleAnnotation key = (Single key) . simpleValue+++-- |Creates a list annotation, which holds a list of items. For list+-- annotations, consecutive merges with the same key will add to the list+-- instead of overwriting previous values.+listAnnotation :: ToJSON a => Text -> [a] -> Annotation+listAnnotation key = (Single key) . listValue+++-- |Creates an optional annotation, which holds a Maybe. If an optional+-- annotation holds a Nothing value, it will be ommitted when SpanData is+-- encoded to JSON.+optionalAnnotation :: ToJSON a => Text -> Maybe a -> Annotation+optionalAnnotation key = (Single key) . optionalValue+++-- |A convenience function to create an optional annotation that holds a+-- Nothing.+nullAnnotation :: Text -> Annotation+nullAnnotation key = Single key $ Optional Nothing+++-- |Represents the value of a span.data item.+data AnnotationValue =+  Simple Value+  -- |For list annotations consecutive merges with the same key will add to the+  -- list instead of overwriting previous values.+  | List [Value]+  -- |If an annotation is marked as optional, it will be ommitted from the+  -- encoded JSON if it is Nothing.+  | Optional (Maybe Value)+  deriving (Eq, Generic, Show)+++instance ToJSON AnnotationValue where+  toJSON :: AnnotationValue -> Value+  toJSON annotation =+    case annotation of+      Simple value ->+        value+      List values ->+        Aeson.Array $ V.fromList values+      Optional maybeValue ->+        case maybeValue of+          Just value -> value+          -- Optional Nothing is actually already dropped in annotationToJson.+          Nothing    -> Aeson.Null+++-- |Creates the value part of a simple annotation, that is, a primitive value+-- (String, Number, Boolean, etc.). You might want to use simpleAnnotation+-- directly instead of creating the simple value beforehand.+simpleValue :: ToJSON a => a -> AnnotationValue+simpleValue =+  Simple . Aeson.toJSON+++-- |Creates the value part of a list annotation. You might want to use+-- listAnnotation directly instead of creating the list value beforehand.+listValue :: ToJSON a => [a] -> AnnotationValue+listValue =+  List . map Aeson.toJSON+++-- |Creates the value part of an optional annotation. You might want to use+-- optionalAnnotation directly instead of creating the optional value+-- beforehand.+optionalValue :: ToJSON a => Maybe a -> AnnotationValue+optionalValue value =+  Optional $ Aeson.toJSON <$> value+

@@ -7,33 +7,28 @@               registered span. -} module Instana.SDK.Span.SpanType-  ( Registered (..)+  ( RegisteredSpanType (..)   , SpanType (SdkSpan, RegisteredSpan)   , spanName-  , initialData   ) where  -import           Data.Aeson            (Value, (.=))-import qualified Data.Aeson            as Aeson-import           Data.String           (IsString (fromString))-import           Data.Text             (Text)-import qualified Data.Text             as T+import           Data.String  (IsString (fromString))+import           Data.Text    (Text)+import qualified Data.Text    as T import           GHC.Generics -import           Instana.SDK.Span.Span (SpanKind (EntryKind, ExitKind, IntermediateKind)) - -- |Differentiates between SDK spans and registered spans (which receive -- special treatment by Instana's processing pipeline. data SpanType =     SdkSpan Text-  | RegisteredSpan Registered+  | RegisteredSpan RegisteredSpanType   deriving (Eq, Generic, Show)   -- |All registered spans that the Haskell trace SDK will produce.-data Registered =+data RegisteredSpanType =     HaskellWaiServer   | HaskellHttpClient   deriving (Eq, Generic, Show)@@ -46,45 +41,14 @@   -- |Returns the wire value of span.n for a registered span.-registeredSpanName :: Registered -> Text+registeredSpanName :: RegisteredSpanType -> Text registeredSpanName HaskellWaiServer  = "haskell.wai.server" registeredSpanName HaskellHttpClient = "haskell.http.client"  --- |Returns the initial data (span.data) for a SpanType value.-initialData :: SpanKind -> SpanType -> Value-initialData kind (SdkSpan s)     = initialSdkData kind s-initialData _ (RegisteredSpan _) = emptyValue-- -- |Enables passing any string as the span type argument to SDK.startEntrySpan -- etc. - this will be automatically converted to an SDK span. instance IsString SpanType where   fromString :: String -> SpanType   fromString s = SdkSpan $ T.pack s----- |Provides the initial data for an SDK span.-initialSdkData :: SpanKind -> Text -> Value-initialSdkData kind spanName_ =-  let-    sdkKind :: String-    sdkKind =-      case kind of-        EntryKind        -> "entry"-        ExitKind         -> "exit"-        IntermediateKind -> "intermediate"-  in-  (Aeson.object [ "sdk" .=-    Aeson.object-      [ "name" .= spanName_-      , "type" .= sdkKind-      ]-    ]-  )----- |Provides an empty Aeson value.-emptyValue :: Value-emptyValue = Aeson.object [] 

@@ -1,28 +1,43 @@-{-# LANGUAGE DeriveGeneric #-}-+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-} module Instana.SDK.AgentStub.Config   ( AgentStubConfig(..)   , readConfig   ) where  -import           Data.Maybe               (fromMaybe)-import           Data.String              (fromString)+import           Data.Maybe                              (fromMaybe)+import           Data.String                             (fromString)+import qualified Data.Text                               as T import           GHC.Generics-import qualified Network.Wai.Handler.Warp as Warp-import           System.Environment       (lookupEnv)-import           Text.Read                (readMaybe)+import           Instana.SDK.AgentStub.DiscoveryResponse (SecretsConfig (SecretsConfig))+import qualified Instana.SDK.AgentStub.DiscoveryResponse as DiscoveryResponse+import qualified Network.Wai.Handler.Warp                as Warp+import           System.Environment                      (lookupEnv)+import           Text.Read                               (readMaybe)  + data AgentStubConfig = AgentStubConfig-  { bindHost               :: Warp.HostPreference-  , bindPort               :: Int-  , startupDelay           :: Int-  , simulateConnectionLoss :: Bool-  , simulatPidTranslation  :: Bool+  { bindHost                     :: Warp.HostPreference+  , bindPort                     :: Int+  , secretsConfig                :: SecretsConfig+  , extraHeadersViaTracingConfig :: Bool+  , extraHeadersViaLegacyConfig  :: Bool+  , startupDelay                 :: Int+  , simulateConnectionLoss       :: Bool+  , simulatPidTranslation        :: Bool   } deriving (Eq, Show, Generic)  +defaultSecretsConfig :: SecretsConfig+defaultSecretsConfig =+  SecretsConfig+    { DiscoveryResponse.matcher = "contains-ignore-case"+    , DiscoveryResponse.list = ["key", "pass", "secret"]+    }++ readConfig :: IO AgentStubConfig readConfig = do   -- Since the stub is only used locally, binding to host "127.0.0.1" is safer@@ -30,21 +45,27 @@   -- (see https://hackage.haskell.org/package/warp-3.2.9/docs/Network-Wai-Handler-Warp.html#t:HostPreference),   -- as it prevents the MacOS firewall from asking if it is okay to accept   -- incoming connections every time the app is recompiled and restarted.-  hostString     <- lookupEnvWithDefault    "HOST" "127.0.0.1"-  port           <- lookupEnvIntWithDefault "PORT" 1302-  delay          <- lookupEnvIntWithDefault "STARTUP_DELAY" 0-  connectionLoss <- lookupFlag              "SIMULATE_CONNECTION_LOSS"-  pidTranslation <- lookupFlag              "SIMULATE_PID_TRANSLATION"+  hostString          <- lookupEnvWithDefault    "HOST" "127.0.0.1"+  port                <- lookupEnvIntWithDefault "PORT" 1302+  secrets             <- parseSecretsConfig+  extraHeadersTracing <- lookupFlag              "EXTRA_HEADERS_VIA_TRACING_CONFIG"+  extraHeadersLegacy  <- lookupFlag              "EXTRA_HEADERS_VIA_LEGACY_CONFIG"+  delay               <- lookupEnvIntWithDefault "STARTUP_DELAY" 0+  connectionLoss      <- lookupFlag              "SIMULATE_CONNECTION_LOSS"+  pidTranslation      <- lookupFlag              "SIMULATE_PID_TRANSLATION"   let     hostPreference :: Warp.HostPreference     hostPreference = fromString hostString   return     AgentStubConfig-      { bindHost               = hostPreference-      , bindPort               = port-      , startupDelay           = delay-      , simulateConnectionLoss = connectionLoss-      , simulatPidTranslation  = pidTranslation+      { bindHost                     = hostPreference+      , bindPort                     = port+      , secretsConfig                = secrets+      , extraHeadersViaTracingConfig = extraHeadersTracing+      , extraHeadersViaLegacyConfig  = extraHeadersLegacy+      , startupDelay                 = delay+      , simulateConnectionLoss       = connectionLoss+      , simulatPidTranslation        = pidTranslation       }  @@ -82,4 +103,22 @@   return $ case maybeValue of              Just _ -> True              _      -> False+++parseSecretsConfig :: IO SecretsConfig+parseSecretsConfig = do+  maybeSecretsConfigString <- lookupEnv "SECRETS_CONFIG"+  case maybeSecretsConfigString of+    Just secretsString -> do+      let+        matcherAndList = T.splitOn ":" (T.pack secretsString)+        matcher = head matcherAndList+        listAsString = head $ tail matcherAndList+        list = T.splitOn "," listAsString+      return SecretsConfig+        { DiscoveryResponse.matcher = matcher+        , DiscoveryResponse.list = list+        }+    Nothing -> do+      return defaultSecretsConfig 

@@ -10,10 +10,10 @@ import           Data.STRef                              (modifySTRef,                                                           readSTRef) import           Data.Time.Clock.POSIX                   (getPOSIXTime)-import           Servant                                 ((:<|>) (..), Header,-                                                          Headers,+import           Servant                                 (Header, Headers,                                                           NoContent (NoContent),-                                                          err404, err503)+                                                          err404, err503,+                                                          (:<|>) (..)) import qualified Servant import           System.Log.Logger                       (debugM, warningM) import           Text.Read                               (readMaybe)@@ -24,7 +24,7 @@ import           Instana.SDK.AgentStub.DiscoveryRequest  (DiscoveryRequest) import qualified Instana.SDK.AgentStub.DiscoveryRequest  as DiscoveryRequest import           Instana.SDK.AgentStub.DiscoveryResponse (DiscoveryResponse (DiscoveryResponse),-                                                          SecretsConfig (SecretsConfig))+                                                          TracingConfig (TracingConfig)) import qualified Instana.SDK.AgentStub.DiscoveryResponse as DiscoveryResponse import           Instana.SDK.AgentStub.EntityDataRequest (EntityDataRequest) import           Instana.SDK.AgentStub.Logging           (agentStubLogger)@@ -80,20 +80,48 @@            else pid         translatedDiscoveryRequest =           discoveryRequest { DiscoveryRequest.pid = show translatedPid }+        tracingConfig =+          if Config.extraHeadersViaTracingConfig config+            then+              Just TracingConfig+                { DiscoveryResponse.extraHttpHeaders =+                    Just+                      [ "X-Request-Header-On-Entry"+                      , "X-Response-Header-On-Entry"+                      , "X-Request-Header-On-Exit"+                      , "X-Response-Header-On-Exit"+                      ]+                }+            else+              Nothing++        extraHeadersLegacyConfig =+          if Config.extraHeadersViaLegacyConfig config+            then+              Just+                [ "X-Request-Header-On-Entry"+                , "X-Response-Header-On-Entry"+                , "X-Request-Header-On-Exit"+                , "X-Response-Header-On-Exit"+                ]+            else+              Nothing+       stToServant $         modifySTRef           (Recorders.discoveryRecorder recorders)           ((++) [translatedDiscoveryRequest])+       return $         DiscoveryResponse           { DiscoveryResponse.pid = translatedPid           , DiscoveryResponse.agentUuid = "agent-stub-id"-          , DiscoveryResponse.extraHeaders = Nothing-          , DiscoveryResponse.secrets =-            SecretsConfig-              { DiscoveryResponse.matcher = "contains-ignore-case"-              , DiscoveryResponse.list = ["key", "pass", "secret"]-              }+          , DiscoveryResponse.tracing = tracingConfig+          , DiscoveryResponse.extraHeaders = extraHeadersLegacyConfig+          , DiscoveryResponse.secrets = Config.secretsConfig config+          -- add a bogus attribute to make sure the trace SDK ignores unknown+          -- attributes in the announce response+          , DiscoveryResponse.unknownAttribute = "whatever"           }  

@@ -20,10 +20,9 @@ import           System.Log.Handler         (setFormatter) import           System.Log.Handler.Simple  (GenericHandler, fileHandler,                                              streamHandler)-import           System.Log.Logger          (Priority (..), rootLoggerName,-                                             setHandlers, setLevel,-                                             updateGlobalLogger)-import           System.Log.Logger          (infoM)+import           System.Log.Logger          (Priority (..), infoM,+                                             rootLoggerName, setHandlers,+                                             setLevel, updateGlobalLogger) import qualified System.Posix.Process       as Posix import           System.Posix.Types         (CPid) @@ -89,7 +88,9 @@   respond $     Wai.responseLBS       HTTPTypes.status200-      [("Content-Type", "application/json; charset=UTF-8")]+      [ ("Content-Type", "application/json; charset=UTF-8")+      , ("X-Response-Header-On-Exit", "response header on exit value")+      ]       encodedHeaders  

@@ -31,6 +31,14 @@ appLogger = "WaiWithMiddleware"  +downstreamUrl :: String+downstreamUrl = "http://127.0.0.1:1208/echo?" +++                  "some=query&" +++                  "parameters=2&" +++                  "pass=secret" +++                  "will-be-obscured-when-custom-secrets-regex-is-configured"++ application :: InstanaContext -> HTTP.Manager -> CPid -> Wai.Application application instana httpManager pid request respond = do   let@@ -77,11 +85,10 @@   -> IO Wai.ResponseReceived apiUnderTest instana httpManager _ respond = do   downstreamRequest <--    HTTP.parseUrlThrow $-      "http://127.0.0.1:1208/echo?some=query&parameters=2&pass=secret"+    HTTP.parseUrlThrow $ downstreamUrl   downstreamResponse <- InstanaSDK.withHttpExit     instana-    downstreamRequest+    (addDowntreamRequestHeaders downstreamRequest)     (\req -> do       -- make sure there is a duration > 0       threadDelay $ 1000@@ -91,7 +98,9 @@   respond $     Wai.responseLBS       HTTPTypes.status200-      [("Content-Type", "application/json; charset=UTF-8")]+      [ ("Content-Type", "application/json; charset=UTF-8")+      , ("X-Response-Header-On-Entry", "response header on entry value")+      ]       (HTTP.responseBody downstreamResponse)  @@ -106,11 +115,10 @@   -> IO Wai.ResponseReceived apiUnderTestWithWrongNesting instana httpManager _ respond = do   downstreamRequest <--    HTTP.parseUrlThrow $-      "http://127.0.0.1:1208/echo?some=query&parameters=2&pass=secret"+    HTTP.parseUrlThrow $ downstreamUrl   InstanaSDK.withHttpExit     instana-    downstreamRequest+    (addDowntreamRequestHeaders downstreamRequest)     (\req -> do       -- make sure there is a duration > 0       threadDelay $ 1000@@ -123,7 +131,9 @@       respond $         Wai.responseLBS           HTTPTypes.status200-          [("Content-Type", "application/json; charset=UTF-8")]+          [ ("Content-Type", "application/json; charset=UTF-8")+          , ("X-Response-Header-On-Entry", "response header on entry value")+          ]           (HTTP.responseBody downstreamResponse)     ) @@ -136,6 +146,14 @@   _ <-liftIO $ Posix.exitImmediately Exit.ExitSuccess   respond $     Wai.responseBuilder HTTPTypes.status204 [] Builder.empty+++addDowntreamRequestHeaders :: HTTP.Request -> HTTP.Request+addDowntreamRequestHeaders request =+  request {+    HTTP.requestHeaders =+      [ ("X-Request-Header-On-Exit", "request header on exit value") ]+  }   respondWithPlainText ::

@@ -5,8 +5,6 @@ import           Control.Concurrent         (threadDelay) import           Control.Monad              (join) import           Control.Monad.IO.Class     (liftIO)-import           Data.Aeson                 (Value, (.=))-import qualified Data.Aeson                 as Aeson import qualified Data.Binary.Builder        as Builder import           Data.ByteString            (ByteString) import qualified Data.ByteString.Char8      as BS@@ -15,6 +13,8 @@ import qualified Data.Text                  as T import           Instana.SDK.SDK            (InstanaContext) import qualified Instana.SDK.SDK            as InstanaSDK+import           Instana.SDK.Span.SpanData  (Annotation)+import qualified Instana.SDK.Span.SpanData  as SpanData import qualified Instana.SDK.Span.SpanType  as SpanType import qualified Network.HTTP.Client        as HTTP import qualified Network.HTTP.Types         as HTTPTypes@@ -27,10 +27,9 @@ import           System.Log.Handler         (setFormatter) import           System.Log.Handler.Simple  (GenericHandler, fileHandler,                                              streamHandler)-import           System.Log.Logger          (Priority (..), rootLoggerName,-                                             setHandlers, setLevel,-                                             updateGlobalLogger)-import           System.Log.Logger          (infoM)+import           System.Log.Logger          (Priority (..), infoM,+                                             rootLoggerName, setHandlers,+                                             setLevel, updateGlobalLogger) import qualified System.Posix.Process       as Posix import           System.Posix.Types         (CPid) @@ -146,27 +145,27 @@  withExitWithTags :: InstanaContext -> IO String withExitWithTags instana = do-  InstanaSDK.addTag instana (someSpanData "entry")+  addAnnotations instana (someSpanData "entry")   exitCallResult <-     InstanaSDK.withExit       instana       "haskell.dummy.exit"       (simulateExitCallWithTags instana)   InstanaSDK.incrementErrorCount instana-  InstanaSDK.addTag instana (moreSpanData "entry")+  addAnnotations instana (moreSpanData "entry")   return $ exitCallResult ++ "::entry done"   simulateExitCallWithTags :: InstanaContext -> IO String simulateExitCallWithTags instana = do-  InstanaSDK.addTag instana (someSpanData "exit")+  addAnnotations instana (someSpanData "exit")   -- some time needs to pass, otherwise the exit span's duration will be 0   threadDelay $ 10 * 1000   InstanaSDK.addToErrorCount instana 2-  InstanaSDK.addTag instana (moreSpanData "exit")-  InstanaSDK.addTagAt instana "nested.key1" ("nested.text.value1" :: String)-  InstanaSDK.addTagAt instana "nested.key2" ("nested.text.value2" :: String)-  InstanaSDK.addTagAt instana "nested.key3" (1604 :: Int)+  addAnnotations instana (moreSpanData "exit")+  InstanaSDK.addAnnotationAt instana "nested.key1" ("nested.text.value1" :: String)+  InstanaSDK.addAnnotationAt instana "nested.key2" ("nested.text.value2" :: String)+  InstanaSDK.addAnnotationAt instana "nested.key3" (1604 :: Int)   return "exit done"  @@ -271,11 +270,11 @@   InstanaSDK.startRootEntry     instana     "haskell.dummy.root.entry"-  InstanaSDK.addTag instana (someSpanData "entry")+  addAnnotations instana (someSpanData "entry")   result <- doExitCallWithTags instana   InstanaSDK.incrementErrorCount instana-  InstanaSDK.addTag instana (moreSpanData "entry")-  InstanaSDK.addTagAt+  addAnnotations instana (moreSpanData "entry")+  InstanaSDK.addAnnotationAt     instana "nested.entry.key" ("nested.entry.value" :: String)   InstanaSDK.completeEntry instana   respondWithPlainText respond result@@ -286,11 +285,11 @@   InstanaSDK.startExit     instana     "haskell.dummy.exit"-  InstanaSDK.addTag instana (someSpanData "exit")+  addAnnotations instana (someSpanData "exit")   result <- simulateExitCall   InstanaSDK.incrementErrorCount instana-  InstanaSDK.addTag instana (moreSpanData "exit")-  InstanaSDK.addTagAt instana "nested.exit.key" ("nested.exit.value" :: String)+  addAnnotations instana (moreSpanData "exit")+  InstanaSDK.addAnnotationAt instana "nested.exit.key" ("nested.exit.value" :: String)   InstanaSDK.completeExit instana   return result @@ -302,22 +301,27 @@   return "exit done"  -someSpanData :: String -> Value+addAnnotations :: InstanaContext -> [Annotation] -> IO ()+addAnnotations instana annotations =+  mapM_+    (\annotation -> InstanaSDK.addAnnotation instana annotation)+    annotations+++someSpanData :: String -> [Annotation] someSpanData kind =-   Aeson.object-     [ "data1"     .= ("value1" :: String)-     , "data2"     .= (42 :: Int)-     , "startKind" .= kind-     ]+  [ SpanData.simpleAnnotation "data1"     ("value1" :: String)+  , SpanData.simpleAnnotation "data2"     (42 :: Int)+  , SpanData.simpleAnnotation "startKind" kind+  ]  -moreSpanData :: String -> Value+moreSpanData :: String -> [Annotation] moreSpanData kind =-   Aeson.object-     [ "data2"   .= (1302 :: Int)-     , "data3"   .= ("value3" :: String)-     , "endKind" .= kind-     ]+  [ SpanData.simpleAnnotation "data2"   (1302 :: Int)+  , SpanData.simpleAnnotation "data3"   ("value3" :: String)+  , SpanData.simpleAnnotation "endKind" kind+  ]   httpBracketApi ::@@ -334,7 +338,7 @@           "http://127.0.0.1:1208/echo?some=query&parameters=2&pass=secret"       downstreamResponse <- InstanaSDK.withHttpExit         instana-        downstreamRequest+        (addDowntreamRequestHeaders downstreamRequest)         (\req -> do           downstreamRespone' <- HTTP.httpLbs req httpManager           threadDelay $ 1000 -- make sure there is a duration > 0@@ -343,7 +347,9 @@       return $         Wai.responseLBS           HTTPTypes.status200-          [("Content-Type", "application/json; charset=UTF-8")]+          [ ("Content-Type", "application/json; charset=UTF-8")+          , ("X-Response-Header-On-Entry", "response header on entry value")+          ]           (HTTP.responseBody downstreamResponse)   respond response @@ -359,7 +365,9 @@   downstreamRequest <-     HTTP.parseUrlThrow $       "http://127.0.0.1:1208/echo?some=query&parameters=2&pass=secret"-  downstreamRequest' <- InstanaSDK.startHttpExit instana downstreamRequest+  downstreamRequest' <-+    InstanaSDK.startHttpExit instana $+      addDowntreamRequestHeaders downstreamRequest   downstreamResponse <- HTTP.httpLbs downstreamRequest' httpManager   threadDelay $ 1000 -- make sure there is a duration > 0   InstanaSDK.completeExit instana@@ -367,7 +375,9 @@     response =       Wai.responseLBS         HTTPTypes.status200-        [("Content-Type", "application/json; charset=UTF-8")]+        [ ("Content-Type", "application/json; charset=UTF-8")+        , ("X-Response-Header-On-Entry", "response header on entry value")+        ]         (HTTP.responseBody downstreamResponse)   response' <-     InstanaSDK.postProcessHttpResponse instana response@@ -405,6 +415,14 @@   _ <-liftIO $ Posix.exitImmediately Exit.ExitSuccess   respond $     Wai.responseBuilder HTTPTypes.status204 [] Builder.empty+++addDowntreamRequestHeaders :: HTTP.Request -> HTTP.Request+addDowntreamRequestHeaders request =+  request {+    HTTP.requestHeaders =+      [ ("X-Request-Header-On-Exit", "request header on exit value") ]+  }   respondWithPlainText ::

@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}+module Instana.SDK.IntegrationTest.CustomSecrets (allTests) where+++import           Data.Aeson                              ((.=))+import qualified Data.Aeson                              as Aeson+import           Instana.SDK.AgentStub.TraceRequest      (Span)+import qualified Instana.SDK.AgentStub.TraceRequest      as TraceRequest+import           Instana.SDK.IntegrationTest.HUnitExtra  (applyLabel)+import           Instana.SDK.IntegrationTest.HttpTracing (runHttpTest)+import           Test.HUnit++++allTests :: String -> [IO Test]+allTests pid =+  [ shouldRedactCustomSecrets pid+  ]+++shouldRedactCustomSecrets :: String -> IO Test+shouldRedactCustomSecrets pid =+  applyLabel "shouldRedactCustomSecrets" $+    runHttpTest+      pid+      ("http/bracket/api?"+        -- this will be captured since the custom secret config overrides the default secret list+        ++ "api-key=1234&"+        -- this should be redacted according to the custom config+        ++ "hidden-param=value&"+        -- this will be captured since the custom secret config overrides the default secret list+        ++ "MYPASSWORD=abc&"+        -- this should be redacted according to the custom config+        ++ "this-will-be-obscured-by-the-regex-matcher=value&"+        -- this will be captured since the custom secret config overrides the default secret list+        ++ "secret=yes&"+        -- this will be captured since the regex for hidden has no leading .*+        ++ "not-hidden=value"+      )+      []+      entrySpanDataAsserts+      exitSpanDataAsserts+++entrySpanDataAsserts :: Span -> [Assertion]+entrySpanDataAsserts entrySpan =+  [ assertEqual "entry data"+    ( Aeson.object+      [ "http"       .= (Aeson.object+          [ "method" .= ("GET" :: String)+          , "host"   .= ("127.0.0.1:1207" :: String)+          , "url"    .= ("/http/bracket/api" :: String)+          , "params" .= (+              -- this will be captured since the custom secret config overrides the default secret list+              "api-key=1234&"+              -- this should be filterd according to the custom config+              ++ "hidden-param=<redacted>&"+              -- this will be captured since the custom secret config overrides the default secret list+              ++ "MYPASSWORD=abc&"+              -- this should be filterd according to the custom config+              ++ "this-will-be-obscured-by-the-regex-matcher=<redacted>&"+              -- this will be captured since the custom secret config overrides the default secret list+              ++ "secret=yes&"+              -- this will be captured since the regex for hidden has no leading .*+              ++ "not-hidden=value" :: String+            )+          , "status" .= (200 :: Int)+          ]+        )+      ]+    )+    (TraceRequest.spanData entrySpan)+  ]+++exitSpanDataAsserts :: Span -> [Assertion]+exitSpanDataAsserts exitSpan =+  [ assertEqual "exit data"+    ( Aeson.object+      [ "http" .= (Aeson.object+          [ "method" .= ("GET" :: String)+          , "url"    .= ("http://127.0.0.1:1208/echo" :: String)+          , "params" .= ("some=query&parameters=2&pass=secret" :: String)+          , "status" .= (200 :: Int)+          ]+        )+      ]+    )+    (TraceRequest.spanData exitSpan)+  ]+

@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}+module Instana.SDK.IntegrationTest.ExtraHttpHeaders+  ( shouldApplyExtraHeadersFromCommonTracerConfig+  , shouldApplyExtraHeadersFromLegacyConfig+  ) where+++import           Data.Aeson                              ((.=))+import qualified Data.Aeson                              as Aeson+import           Instana.SDK.AgentStub.TraceRequest      (Span)+import qualified Instana.SDK.AgentStub.TraceRequest      as TraceRequest+import           Instana.SDK.IntegrationTest.HUnitExtra  (applyLabel)+import           Instana.SDK.IntegrationTest.HttpTracing (runHttpTest)+import           Test.HUnit+++shouldApplyExtraHeadersFromCommonTracerConfig :: String -> IO Test+shouldApplyExtraHeadersFromCommonTracerConfig pid =+  applyLabel "shouldApplyExtraHeadersFromCommonTracerConfig" $+    runHttpTest+      pid+      "http/bracket/api"+      [("X-Request-Header-On-Entry", "request header on entry value")]+      entrySpanDataAsserts+      exitSpanDataAsserts+++shouldApplyExtraHeadersFromLegacyConfig :: String -> IO Test+shouldApplyExtraHeadersFromLegacyConfig pid =+  applyLabel "shouldApplyExtraHeadersFromLegacyConfig" $+    runHttpTest+      pid+      "http/bracket/api"+      [("X-Request-Header-On-Entry", "request header on entry value")]+      entrySpanDataAsserts+      exitSpanDataAsserts+++entrySpanDataAsserts :: Span -> [Assertion]+entrySpanDataAsserts entrySpan =+  [ assertEqual "entry data"+    ( Aeson.object+      [ "http"       .= (Aeson.object+          [ "method" .= ("GET" :: String)+          , "host"   .= ("127.0.0.1:1207" :: String)+          , "url"    .= ("/http/bracket/api" :: String)+          , "status" .= (200 :: Int)+          , "header" .= (+            [ ("X-Response-Header-On-Entry", "response header on entry value")+            , ("X-Request-Header-On-Entry", "request header on entry value")+            ] :: [(String, String)])+          ]+        )+      ]+    )+    (TraceRequest.spanData entrySpan)+  ]+++exitSpanDataAsserts :: Span -> [Assertion]+exitSpanDataAsserts exitSpan =+  [ assertEqual "exit data"+    ( Aeson.object+      [ "http" .= (Aeson.object+          [ "method" .= ("GET" :: String)+          , "url"    .= ("http://127.0.0.1:1208/echo" :: String)+          , "status" .= (200 :: Int)+          , "params" .= ("some=query&parameters=2&pass=<redacted>" :: String)+          , "header" .= (+            [ ("X-Request-Header-On-Exit", "request header on exit value")+            , ("X-Response-Header-On-Exit", "response header on exit value")+            ] :: [(String, String)])+          ]+        )+      ]+    )+    (TraceRequest.spanData exitSpan)+  ]+

@@ -35,6 +35,7 @@  applyLabel :: String -> IO Test -> IO Test applyLabel label testIO = do+  infoM testLogger $ "Running: " ++ label   t <- testIO   return $ TestLabel label t 

@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-module Instana.SDK.IntegrationTest.HttpTracing (allTests) where+module Instana.SDK.IntegrationTest.HttpTracing (allTests, runHttpTest) where   import           Control.Concurrent                     (threadDelay)@@ -31,6 +31,7 @@   , shouldCreateNonRootEntryWithBracketApi pid   , shouldSetSpanSyWithBracketApi pid   , shouldSuppressWithBracketApi+  , shouldRedactDefaultSecrets pid   , shouldCreateRootEntryWithLowLevelApi pid   , shouldAddWebsiteMonitoringCorrelationWithLowLevelApi pid   , shouldIgnoreTraceIdParentIdIfWebsiteMonitoringCorrelationIsPresentWithLowLevelApi pid@@ -109,6 +110,19 @@     runSuppressedTest "http/bracket/api"  +shouldRedactDefaultSecrets :: String -> IO Test+shouldRedactDefaultSecrets pid =+  applyLabel "shouldRedactDefaultSecrets" $+    runTest+      pid+      "http/bracket/api?query-param=value&api-key=1234&MYPASSWORD=abc&another-query-param=zzz1&secret=yes"+      []+      (applyConcat+        [ rootEntryAsserts+        , filterDefaultSecretsAsserts+        ])++ shouldCreateRootEntryWithLowLevelApi :: String -> IO Test shouldCreateRootEntryWithLowLevelApi pid =   applyLabel "shouldCreateRootEntryWithLowLevelApi" $@@ -177,17 +191,47 @@   runBracketTest :: String -> [Header] -> (Span -> [Assertion]) -> IO Test-runBracketTest pid headers extraAsserts =-  runTest pid "http/bracket/api?some=query&parameters=1" headers extraAsserts+runBracketTest pid headers extraAssertsForEntrySpan =+  runTest pid "http/bracket/api?some=query&parameters=1" headers extraAssertsForEntrySpan   runLowLevelTest :: String -> [Header] -> (Span -> [Assertion]) -> IO Test-runLowLevelTest pid headers extraAsserts =-  runTest pid "http/low/level/api?some=query&parameters=2" headers extraAsserts+runLowLevelTest pid headers extraAssertsForEntrySpan =+  runTest pid "http/low/level/api?some=query&parameters=2" headers extraAssertsForEntrySpan   runTest :: String -> String -> [Header] -> (Span -> [Assertion]) -> IO Test-runTest pid urlPath headers extraAsserts = do+runTest pid urlPath headers extraAssertsForEntrySpan =+  runHttpTest+    pid+    urlPath+    headers+    extraAssertsForEntrySpan+    (\exitSpan ->+      [ assertEqual "exit data"+        ( Aeson.object+          [ "http" .= (Aeson.object+              [ "method" .= ("GET" :: String)+              , "url"    .= ("http://127.0.0.1:1208/echo" :: String)+              , "params" .= ("some=query&parameters=2&pass=<redacted>" :: String)+              , "status" .= (200 :: Int)+              ]+            )+          ]+        )+        (TraceRequest.spanData exitSpan)+      ]+    )+++runHttpTest ::+  String+  -> String+  -> [Header]+  -> (Span -> [Assertion])+  -> (Span -> [Assertion])+  -> IO Test+runHttpTest pid urlPath headers extraAssertsForEntrySpan extraAssertsForExitSpan = do   response <-     HttpHelper.doAppRequest Suite.testServer urlPath "GET" headers   let@@ -223,7 +267,8 @@             Just exitSpan = maybeExitSpan           assertAllIO $             (commonAsserts entrySpan exitSpan responseBody from serverTimingValue) ++-            (extraAsserts entrySpan)+            (extraAssertsForEntrySpan entrySpan) +++            (extraAssertsForExitSpan exitSpan)   runSuppressedTest :: String -> IO Test@@ -327,18 +372,6 @@   , assertEqual "exit kind" 2 (TraceRequest.k exitSpan)   , assertEqual "exit error" 0 (TraceRequest.ec exitSpan)   , assertEqual "exit from" from $ TraceRequest.f exitSpan-  , assertEqual "exit data"-    ( Aeson.object-      [ "http" .= (Aeson.object-          [ "method" .= ("GET" :: String)-          , "url"    .= ("http://127.0.0.1:1208/echo" :: String)-          , "params" .= ("some=query&parameters=2" :: String)-          , "status" .= (200 :: Int)-          ]-        )-      ]-    )-    (TraceRequest.spanData exitSpan)   ]  @@ -398,6 +431,24 @@ notSyntheticAssert :: Span -> [Assertion] notSyntheticAssert span_ =   [ assertEqual "span.sy" Nothing (TraceRequest.sy span_)+  ]+++filterDefaultSecretsAsserts :: Span -> [Assertion]+filterDefaultSecretsAsserts entrySpan =+  [ assertEqual "entry data"+    ( Aeson.object+      [ "http"       .= (Aeson.object+          [ "method" .= ("GET" :: String)+          , "host"   .= ("127.0.0.1:1207" :: String)+          , "url"    .= ("/http/bracket/api" :: String)+          , "params" .= ("query-param=value&api-key=<redacted>&MYPASSWORD=<redacted>&another-query-param=zzz1&secret=<redacted>" :: String)+          , "status" .= (200 :: Int)+          ]+        )+      ]+    )+    (TraceRequest.spanData entrySpan)   ]  

@@ -51,7 +51,7 @@               (EntityDataRequest.arguments entityData)           , assertLabelIs               "sensorVersion"-              "0.7.1.0"+              "0.8.0.0"               (EntityDataRequest.sensorVersion entityData)           , assertCounterSatisfies               "startTime"

@@ -126,6 +126,11 @@             (if Suite.startupDelay options then Just "2500" else Nothing))         , ("SIMULATE_CONNECTION_LOSS",              booleanEnv $ Suite.simulateConnectionLoss options)+        , ("SECRETS_CONFIG", Suite.customSecretsConfig options)+        , ("EXTRA_HEADERS_VIA_TRACING_CONFIG",+             booleanEnv $ Suite.tracingConfigForExtraHeaders options)+        , ("EXTRA_HEADERS_VIA_LEGACY_CONFIG",+             booleanEnv $ Suite.legacyConfigForExtraHeaders options)         , ("LOG_LEVEL", Just logLevel)         ]         "stack exec instana-haskell-agent-stub"

@@ -680,7 +680,7 @@       [ "http" .= (Aeson.object           [ "method" .= ("GET" :: String)           , "url"    .= ("http://127.0.0.1:1208/echo" :: String)-          , "params" .= ("some=query&parameters=2" :: String)+          , "params" .= ("some=query&parameters=2&pass=<redacted>" :: String)           , "status" .= (200 :: Int)           ]         )

@@ -9,9 +9,12 @@   , testServer   , testServerWithMiddleware   , withConnectionLoss+  , withCustomSecretsConfig   , withCustomServiceName+  , withLegacyConfigForExtraHeaders   , withPidTranslation   , withStartupDelay+  , withTracingConfigForExtraHeaders   , withW3cTraceCorrelationDisabled   ) where @@ -31,12 +34,15 @@ -- |Describes options for running a test suite. data SuiteOptions =   SuiteOptions-    { usePidTranslation          :: Bool-    , startupDelay               :: Bool-    , simulateConnectionLoss     :: Bool-    , customServiceName          :: Maybe String-    , disableW3cTraceCorrelation :: Bool-    , appsUnderTest              :: [AppUnderTest]+    { usePidTranslation            :: Bool+    , startupDelay                 :: Bool+    , simulateConnectionLoss       :: Bool+    , customServiceName            :: Maybe String+    , customSecretsConfig          :: Maybe String+    , tracingConfigForExtraHeaders :: Bool+    , legacyConfigForExtraHeaders  :: Bool+    , disableW3cTraceCorrelation   :: Bool+    , appsUnderTest                :: [AppUnderTest]     }  @@ -52,12 +58,15 @@ defaultOptions :: SuiteOptions defaultOptions =   SuiteOptions-    { usePidTranslation           = False-    , startupDelay                = False-    , simulateConnectionLoss      = False-    , customServiceName           = Nothing-    , disableW3cTraceCorrelation  = False-    , appsUnderTest               = [testServer]+    { usePidTranslation            = False+    , startupDelay                 = False+    , simulateConnectionLoss       = False+    , customServiceName            = Nothing+    , customSecretsConfig          = Nothing+    , tracingConfigForExtraHeaders = False+    , legacyConfigForExtraHeaders  = False+    , disableW3cTraceCorrelation   = False+    , appsUnderTest                = [testServer]     }  @@ -106,6 +115,21 @@ withCustomServiceName :: String -> SuiteOptions withCustomServiceName serviceName =   defaultOptions { customServiceName = Just serviceName }+++withCustomSecretsConfig :: String -> SuiteOptions+withCustomSecretsConfig secretsConfig =+  defaultOptions { customSecretsConfig = Just secretsConfig }+++withTracingConfigForExtraHeaders :: SuiteOptions+withTracingConfigForExtraHeaders =+  defaultOptions { tracingConfigForExtraHeaders = True }+++withLegacyConfigForExtraHeaders :: SuiteOptions+withLegacyConfigForExtraHeaders =+  defaultOptions { legacyConfigForExtraHeaders = True }   withW3cTraceCorrelationDisabled :: SuiteOptions

@@ -1,18 +1,20 @@ module Instana.SDK.IntegrationTest.TestSuites (allSuites) where  -import qualified Data.Aeson                                 as Aeson-import qualified Instana.SDK.IntegrationTest.BracketApi     as BracketApi-import qualified Instana.SDK.IntegrationTest.Connection     as Connection-import qualified Instana.SDK.IntegrationTest.HttpTracing    as HttpTracing-import qualified Instana.SDK.IntegrationTest.LowLevelApi    as LowLevelApi-import qualified Instana.SDK.IntegrationTest.Metrics        as Metrics-import qualified Instana.SDK.IntegrationTest.ServiceName    as ServiceName-import qualified Instana.SDK.IntegrationTest.SpecCompliance as SpecCompliance-import           Instana.SDK.IntegrationTest.Suite          (ConditionalSuite (..),-                                                             Suite (..))-import qualified Instana.SDK.IntegrationTest.Suite          as Suite-import qualified Instana.SDK.IntegrationTest.WaiMiddleware  as WaiMiddleware+import qualified Data.Aeson                                   as Aeson+import qualified Instana.SDK.IntegrationTest.BracketApi       as BracketApi+import qualified Instana.SDK.IntegrationTest.Connection       as Connection+import qualified Instana.SDK.IntegrationTest.CustomSecrets    as CustomSecrets+import qualified Instana.SDK.IntegrationTest.ExtraHttpHeaders as ExtraHttpHeaders+import qualified Instana.SDK.IntegrationTest.HttpTracing      as HttpTracing+import qualified Instana.SDK.IntegrationTest.LowLevelApi      as LowLevelApi+import qualified Instana.SDK.IntegrationTest.Metrics          as Metrics+import qualified Instana.SDK.IntegrationTest.ServiceName      as ServiceName+import qualified Instana.SDK.IntegrationTest.SpecCompliance   as SpecCompliance+import           Instana.SDK.IntegrationTest.Suite            (ConditionalSuite (..),+                                                               Suite (..))+import qualified Instana.SDK.IntegrationTest.Suite            as Suite+import qualified Instana.SDK.IntegrationTest.WaiMiddleware    as WaiMiddleware   allSuites :: Aeson.Array -> [ConditionalSuite]@@ -25,6 +27,9 @@   , testPidTranslation   , testServiceName   , testHttpTracing+  , testCustomSecrets+  , testExtraHttpHeaders+  , testExtraHttpHeadersLegacyConfig   , testWaiMiddleware   , testSpecComplianceW3cOn       specificationComplianceTestCases@@ -133,6 +138,55 @@       { Suite.label = "HTTP Tracing"       , Suite.tests = HttpTracing.allTests       , Suite.options = Suite.defaultOptions {+            Suite.appsUnderTest =+              [ Suite.testServer+              , Suite.downstreamTarget+              ]+          }+      }+++testCustomSecrets :: ConditionalSuite+testCustomSecrets =+  Run $+    Suite+      { Suite.label = "Custom Secrets"+      , Suite.tests = CustomSecrets.allTests+      , Suite.options = (Suite.withCustomSecretsConfig "regex:.*obscured.*,hidden.*") {+            Suite.appsUnderTest =+              [ Suite.testServer+              , Suite.downstreamTarget+              ]+          }+      }+++testExtraHttpHeaders :: ConditionalSuite+testExtraHttpHeaders =+  Run $+    Suite+      { Suite.label = "Extra HTTP Headers"+      , Suite.tests = (\pid -> [+          ExtraHttpHeaders.shouldApplyExtraHeadersFromCommonTracerConfig pid+        ])+      , Suite.options = Suite.withTracingConfigForExtraHeaders {+            Suite.appsUnderTest =+              [ Suite.testServer+              , Suite.downstreamTarget+              ]+          }+      }+++testExtraHttpHeadersLegacyConfig :: ConditionalSuite+testExtraHttpHeadersLegacyConfig =+  Run $+    Suite+      { Suite.label = "Extra HTTP Headers (legacy config)"+      , Suite.tests = (\pid -> [+          ExtraHttpHeaders.shouldApplyExtraHeadersFromLegacyConfig pid+        ])+      , Suite.options = Suite.withLegacyConfigForExtraHeaders {             Suite.appsUnderTest =               [ Suite.testServer               , Suite.downstreamTarget

@@ -239,7 +239,7 @@       [ "http" .= (Aeson.object           [ "method" .= ("GET" :: String)           , "url"    .= ("http://127.0.0.1:1208/echo" :: String)-          , "params" .= ("some=query&parameters=2" :: String)+          , "params" .= ("some=query&parameters=2&pass=<redacted>" :: String)           , "status" .= (200 :: Int)           ]         )

@@ -2,19 +2,30 @@ module Instana.SDK.AgentStub.DiscoveryResponse where  import           Data.Aeson-import           Data.Text    (Text)+import           Data.Aeson.Casing as AesonCasing+import           Data.Text         (Text) import           GHC.Generics   data DiscoveryResponse =   DiscoveryResponse-   { pid          :: Int-   , agentUuid    :: Text-   , extraHeaders :: Maybe [Text]-   , secrets      :: SecretsConfig+   { pid              :: Int+   , agentUuid        :: Text+   , tracing          :: Maybe TracingConfig+   , extraHeaders     :: Maybe [Text]+   , secrets          :: SecretsConfig+   , unknownAttribute :: String    } deriving (Eq, Show, Generic)  instance ToJSON DiscoveryResponse+++data TracingConfig = TracingConfig+  { extraHttpHeaders :: Maybe [Text]+  } deriving (Eq, Show, Generic)++instance ToJSON TracingConfig where+   toJSON = genericToJSON $ AesonCasing.aesonDrop 0 AesonCasing.trainCase   data SecretsConfig = SecretsConfig

@@ -2,8 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module Instana.SDK.Internal.SpanStackTest (allTests) where -import           Data.Aeson                           (Value)-import qualified Data.Aeson                           as Aeson import           Test.HUnit  import qualified Instana.SDK.Internal.Id              as Id@@ -20,7 +18,8 @@ import qualified Instana.SDK.Span.RootEntry           as RootEntry import           Instana.SDK.Span.Span                (Span (..), SpanKind (..)) import qualified Instana.SDK.Span.Span                as Span-+import qualified Instana.SDK.Span.SpanData            as SpanData+import           Instana.SDK.Span.SpanType            (SpanType (SdkSpan))  allTests :: Test allTests =@@ -395,14 +394,14 @@ rootEntry =     RootEntry       { RootEntry.spanAndTraceId  = Id.fromString "traceId"-      , RootEntry.spanName        = "test.entry"+      , RootEntry.spanType        = SdkSpan "test.entry"       , RootEntry.timestamp       = 1514761200000       , RootEntry.errorCount      = 0       , RootEntry.serviceName     = Nothing       , RootEntry.synthetic       = False       , RootEntry.correlationType = Nothing       , RootEntry.correlationId   = Nothing-      , RootEntry.spanData        = emptyValue+      , RootEntry.spanData        = SpanData.empty       , RootEntry.w3cTraceContext = Nothing       } @@ -412,11 +411,11 @@   ExitSpan     { ExitSpan.parentSpan      = entrySpan     , ExitSpan.spanId          = Id.fromString "spanId"-    , ExitSpan.spanName        = "test.exit"+    , ExitSpan.spanType        = SdkSpan "test.exit"     , ExitSpan.timestamp       = 1514761201000     , ExitSpan.errorCount      = 0     , ExitSpan.serviceName     = Nothing-    , ExitSpan.spanData        = emptyValue+    , ExitSpan.spanData        = SpanData.empty     , ExitSpan.w3cTraceContext = dummyW3cTraceContext     } @@ -443,10 +442,6 @@ increaseEc :: Span -> Span increaseEc =   Span.addToErrorCount 1---emptyValue :: Value-emptyValue = Aeson.object []   fst3 :: (a, b, c) -> a

@@ -1,281 +0,0 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Instana.SDK.Internal.SpanTest (allTests) where---import           Data.Aeson                  (Value, (.=))-import qualified Data.Aeson                  as Aeson-import           Test.HUnit--import qualified Instana.SDK.Internal.Id     as Id-import           Instana.SDK.Span.EntrySpan  (EntrySpan (RootEntrySpan))-import           Instana.SDK.Span.RootEntry  (RootEntry (RootEntry))-import qualified Instana.SDK.Span.RootEntry  as RootEntry-import qualified Instana.SDK.Span.SimpleSpan as SimpleSpan-import           Instana.SDK.Span.Span       (Span (..), SpanKind (..))-import qualified Instana.SDK.Span.Span       as Span---allTests :: Test-allTests =-  TestList-    [ TestLabel "shouldAddStringNotNested" shouldAddStringNotNested-    , TestLabel "shouldAddStringNested" shouldAddStringNested-    , TestLabel "shouldAddStringDeeplyNested" shouldAddStringDeeplyNested-    , TestLabel "shouldAddIntDeeplyNested" shouldAddIntDeeplyNested-    , TestLabel "shouldAddDoubleDeeplyNested" shouldAddDoubleDeeplyNested-    , TestLabel "shouldAddBooleanDeeplyNested" shouldAddBooleanDeeplyNested-    , TestLabel "shouldAddMultipleRegistered" shouldAddMultipleRegistered-    , TestLabel "shouldAddMultipleTags" shouldAddMultipleTags-    , TestLabel "shouldConvertToSimpleSpanFormat" shouldConvertToSimpleSpanFormat-    ]---shouldAddStringNotNested :: Test-shouldAddStringNotNested =-  let-    span_ = Span.addRegisteredDataAt "path" ("value" :: String) $ entrySpan-    spanData = Span.spanData span_-  in-  TestCase $-    assertEqual "add non nested"-      (Aeson.object [-        "path" .= ("value" :: String)-      ])-      spanData---shouldAddStringNested :: Test-shouldAddStringNested =-  let-    span_ =-      Span.addRegisteredDataAt-        "nested.path"-        ("value" :: String) $-          entrySpan-    spanData = Span.spanData span_-  in-  TestCase $-    assertEqual "add nested"-      (Aeson.object [-        "nested" .= (Aeson.object [-          "path" .= ("value" :: String)-        ])-      ])-      spanData---shouldAddStringDeeplyNested :: Test-shouldAddStringDeeplyNested =-  let-    span_ =-      Span.addRegisteredDataAt-        "really.deeply.nested.path"-        ("deeplyNestedValue" :: String) $-          entrySpan-    spanData = Span.spanData span_-  in-  TestCase $-    assertEqual "add deeply nested"-      (Aeson.object [-        "really" .= (Aeson.object [-          "deeply" .= (Aeson.object [-            "nested" .= (Aeson.object [-              "path" .= ("deeplyNestedValue" :: String)-            ])-          ])-        ])-      ])-      spanData---shouldAddIntDeeplyNested :: Test-shouldAddIntDeeplyNested =-  let-    span_ =-      Span.addRegisteredDataAt-        "really.deeply.nested.path"-        (42 :: Int) $-          entrySpan-    spanData = Span.spanData span_-  in-  TestCase $-    assertEqual "add deeply nested"-      (Aeson.object [-        "really" .= (Aeson.object [-          "deeply" .= (Aeson.object [-            "nested" .= (Aeson.object [-              "path" .= (42 :: Int)-            ])-          ])-        ])-      ])-      spanData---shouldAddDoubleDeeplyNested :: Test-shouldAddDoubleDeeplyNested =-  let-    span_ =-      Span.addRegisteredDataAt-        "really.deeply.nested.path"-        (28.08 :: Double) $-          entrySpan-    spanData = Span.spanData span_-  in-  TestCase $-    assertEqual "add deeply nested"-      (Aeson.object [-        "really" .= (Aeson.object [-          "deeply" .= (Aeson.object [-            "nested" .= (Aeson.object [-              "path" .= (28.08 :: Double)-            ])-          ])-        ])-      ])-      spanData---shouldAddBooleanDeeplyNested :: Test-shouldAddBooleanDeeplyNested =-  let-    span_ = Span.addRegisteredDataAt "really.deeply.nested.path" True $ entrySpan-    spanData = Span.spanData span_-  in-  TestCase $-    assertEqual "add deeply nested"-      (Aeson.object [-        "really" .= (Aeson.object [-          "deeply" .= (Aeson.object [-            "nested" .= (Aeson.object [-              "path" .= True-            ])-          ])-        ])-      ])-      spanData---shouldAddMultipleRegistered :: Test-shouldAddMultipleRegistered =-  let-    span_ =-      Span.addRegisteredDataAt "nested.key3" (12.07 :: Double) $-      Span.addRegisteredDataAt "nested.key2" (2 :: Int) $-      Span.addRegisteredDataAt "nested.key1" ("value.n.1" :: String) $-      Span.addRegisteredDataAt "key3" (16.04 :: Double) $-      Span.addRegisteredDataAt "key2" (13 :: Int) $-      Span.addRegisteredDataAt "key1" ("value1" :: String) $-      entrySpan-    spanData = Span.spanData span_-  in-  TestCase $-    assertEqual "add deeply nested"-      (Aeson.object-        [ "key1" .= ("value1" :: String)-        , "key2" .= (13 :: Int)-        , "key3" .= (16.04 :: Double)-        , "nested" .= (Aeson.object-          [ "key1" .= ("value.n.1" :: String)-          , "key2" .= (2 :: Int)-          , "key3" .= (12.07 :: Double)-          ])-        ]-      )-      spanData---shouldAddMultipleTags :: Test-shouldAddMultipleTags =-  let-    span_ =-      Span.addTagAt "nested.key3" (12.07 :: Double) $-      Span.addTagAt "nested.key2" (2 :: Int) $-      Span.addTagAt "nested.key1" ("value.n.1" :: String) $-      Span.addTagAt "key3" (16.04 :: Double) $-      Span.addTagAt "key2" (13 :: Int) $-      Span.addTagAt "key1" ("value1" :: String) $-      entrySpan-    spanData = Span.spanData span_-  in-  TestCase $-    assertEqual "add deeply nested"-      (Aeson.object-        [ "sdk" .= (Aeson.object-          [ "custom" .= (Aeson.object-            [ "tags" .= (Aeson.object-              [ "key1" .= ("value1" :: String)-              , "key2" .= (13 :: Int)-              , "key3" .= (16.04 :: Double)-              , "nested" .= (Aeson.object-                [ "key1" .= ("value.n.1" :: String)-                , "key2" .= (2 :: Int)-                , "key3" .= (12.07 :: Double)-                ])-              ])-            ])-          ])-        ]-      )-      spanData---shouldConvertToSimpleSpanFormat :: Test-shouldConvertToSimpleSpanFormat =-  let-    span_ =-      Span.addRegisteredDataAt "really.deeply.nested.path" True $ entrySpan-    simple = SimpleSpan.convert span_-    traceId = SimpleSpan.traceId simple-    spanId = SimpleSpan.spanId simple-    parentId = SimpleSpan.parentId simple-    spanName = SimpleSpan.spanName simple-    timestamp = SimpleSpan.timestamp simple-    kind = SimpleSpan.kind simple-    errorCount = SimpleSpan.errorCount simple-    spanData = SimpleSpan.spanData simple-  in-  TestCase $ do-    assertEqual "traceId" "traceId" traceId-    assertEqual "spanId" "traceId" spanId-    assertEqual "parentId" Nothing parentId-    assertEqual "spanName" "test.entry" spanName-    assertEqual "timestamp" 1514761200000 timestamp-    assertEqual "kind" EntryKind kind-    assertEqual "errorCount" 0 errorCount-    assertEqual-      "spanData"-      (Aeson.object [-        "really" .= (Aeson.object [-          "deeply" .= (Aeson.object [-            "nested" .= (Aeson.object [-              "path" .= True-            ])-          ])-        ])-      ])-      spanData---entrySpan :: Span-entrySpan =-  Entry $-    RootEntrySpan $-      RootEntry-        { RootEntry.spanAndTraceId  = Id.fromString "traceId"-        , RootEntry.spanName        = "test.entry"-        , RootEntry.timestamp       = 1514761200000-        , RootEntry.errorCount      = 0-        , RootEntry.serviceName     = Nothing-        , RootEntry.synthetic       = False-        , RootEntry.correlationType = Nothing-        , RootEntry.correlationId   = Nothing-        , RootEntry.spanData        = initialData-        , RootEntry.w3cTraceContext = Nothing-        }---initialData :: Value-initialData = Aeson.object []-

@@ -0,0 +1,271 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Instana.SDK.SpanDataTest (allTests) where+++import           Data.Aeson                ((.=))+import qualified Data.Aeson                as Aeson+import           Test.HUnit++import           Instana.SDK.Span.SpanData (SpanData (SpanData))+import qualified Instana.SDK.Span.SpanData as SpanData+++allTests :: Test+allTests =+  TestList+    [ TestLabel "shouldCreateEmpty" shouldCreateEmpty+    , TestLabel "shouldSerializeNothingToNull" shouldSerializeNothingToNull+    , TestLabel "shouldSerializeToJson" shouldSerializeToJson+    , TestLabel "shouldMergeSimpleAnnotationIntoEmpty" shouldMergeSimpleAnnotationIntoEmpty+    , TestLabel "shouldMergeObjectAnnotationIntoEmpty" shouldMergeObjectAnnotationIntoEmpty+    , TestLabel "shouldMergeObjects" shouldMergeObjects+    , TestLabel "shouldMergeNestedObjects" shouldMergeNestedObjects+    , TestLabel "shouldOverwriteSingleAnnotation" shouldOverwriteSingleAnnotation+    , TestLabel "shouldOverwriteWithSingleAnnotation" shouldOverwriteWithSingleAnnotation+    , TestLabel "shouldMergeTwoAtDifferentPaths" shouldMergeTwoAtDifferentPaths+    , TestLabel "shouldMergeListValues" shouldMergeListValues+    ]+++shouldCreateEmpty :: Test+shouldCreateEmpty =+  TestCase $+    assertEqual "shouldCreateEmpty"+      (SpanData []) SpanData.empty+++shouldSerializeNothingToNull :: Test+shouldSerializeNothingToNull =+  TestCase $+    assertEqual "shouldSerializeNothingToNull"+      (Aeson.object [])+      (Aeson.toJSON+        (SpanData [SpanData.optionalAnnotation "key" (Nothing :: Maybe String)])+      )+++shouldSerializeToJson :: Test+shouldSerializeToJson =+  TestCase $+    assertEqual "shouldSerializeToJson"+      (Aeson.object+        [ "sdk" .= (Aeson.object+          [ "custom" .= (Aeson.object+            [ "tags" .= (Aeson.object+              [ "tag1" .= ("value1" :: String)+              , "tag2" .= (["a", "b"] :: [String])+              , "tag3" .= (16.04 :: Double)+              , "nested" .= (Aeson.object+                [ "nested1" .= ("value.n.1" :: String)+                , "nested2" .= (2 :: Int)+                , "nested3" .= (12.07 :: Double)+                ]+              )]+            )]+          )]+        )+        , "simple" .= ("value" :: String)+        , "list" .= ([1, 2, 3] :: [Int])+        , "optional-exists" .= ("yes" :: String)+        ]+      )+      (Aeson.toJSON+        (SpanData+          [ SpanData.objectAnnotation "sdk"+            [ SpanData.objectAnnotation "custom"+              [ SpanData.objectAnnotation "tags"+                [ SpanData.simpleAnnotation "tag1" ("value1" :: String)+                , SpanData.listAnnotation "tag2" (["a", "b"] :: [String])+                , SpanData.simpleAnnotation "tag3" (16.04 :: Double)+                , SpanData.objectAnnotation "nested"+                  [ SpanData.simpleAnnotation "nested1" ("value.n.1" :: String)+                  , SpanData.simpleAnnotation "nested2" (2 :: Int)+                  , SpanData.simpleAnnotation "nested3" (12.07 :: Double)+                  ]+                ]+              ]+            ]+          , SpanData.simpleAnnotation "simple" ("value" :: String)+          , SpanData.listAnnotation "list" ([1, 2, 3] :: [Int])+          , SpanData.optionalAnnotation "optional-exists" (Just "yes" :: Maybe String)+          , SpanData.optionalAnnotation "optional-does-not-exist" (Nothing :: Maybe String)+          ]+        )+      )+++shouldMergeSimpleAnnotationIntoEmpty :: Test+shouldMergeSimpleAnnotationIntoEmpty =+  let+    spanData =+      SpanData.merge+        (SpanData.simpleAnnotation "path" ("value" :: String))+        SpanData.empty+  in+  TestCase $+    assertEqual "shouldMergeSimpleAnnotationIntoEmpty"+      (SpanData [+        SpanData.simpleAnnotation "path" ("value" :: String)+      ])+      spanData+++shouldMergeObjectAnnotationIntoEmpty :: Test+shouldMergeObjectAnnotationIntoEmpty =+  let+    spanData =+      SpanData.merge+        (SpanData.objectAnnotation "nested" [+          SpanData.simpleAnnotation "path" ("value" :: String)+        ])+        SpanData.empty+  in+  TestCase $+    assertEqual "shouldMergeObjectAnnotationIntoEmpty"+      (SpanData [+        SpanData.objectAnnotation "nested" [+          SpanData.simpleAnnotation "path" ("value" :: String)+        ]+      ])+      spanData+++shouldMergeObjects :: Test+shouldMergeObjects =+  let+    spanData =+      SpanData.merge+        ( SpanData.objectAnnotation "nested"+          [ SpanData.simpleAnnotation "key2" (2 :: Int) ]+        ) $+        SpanData.merge+          ( SpanData.objectAnnotation "nested"+            [ SpanData.simpleAnnotation "key1" (1 :: Int) ]+          )+          SpanData.empty+  in+  TestCase $+    assertEqual "shouldMergeObjects"+      (SpanData+        [ SpanData.objectAnnotation "nested"+          [ SpanData.simpleAnnotation "key1" (1 :: Int)+          , SpanData.simpleAnnotation "key2" (2 :: Int)+          ]+        ]+      )+      spanData+++shouldMergeNestedObjects :: Test+shouldMergeNestedObjects =+  let+    spanData =+      SpanData.merge+        ( SpanData.objectAnnotation "nested"+          [ SpanData.objectAnnotation "deeper"+            [ SpanData.simpleAnnotation "key2" (2 :: Int) ]+          ]+        ) $+        SpanData.merge+          ( SpanData.objectAnnotation "nested"+            [ SpanData.objectAnnotation "deeper"+              [ SpanData.simpleAnnotation "key1" (1 :: Int) ]+            ]+          )+          SpanData.empty+  in+  TestCase $+    assertEqual "shouldMergeNestedObjects"+      (SpanData+        [ SpanData.objectAnnotation "nested"+          [ SpanData.objectAnnotation "deeper"+            [ SpanData.simpleAnnotation "key1" (1 :: Int)+            , SpanData.simpleAnnotation "key2" (2 :: Int)+            ]+          ]+        ]+      )+      spanData+++shouldOverwriteSingleAnnotation :: Test+shouldOverwriteSingleAnnotation =+  let+    spanData =+      SpanData.merge+        (SpanData.objectAnnotation "key"+            [ SpanData.simpleAnnotation "value" (2 :: Int) ]+        )+        (SpanData [ SpanData.simpleAnnotation "key" (1 :: Int) ])+  in+  TestCase $+    assertEqual "shouldOverwriteSingleAnnotation"+      (SpanData+        [ SpanData.objectAnnotation "key"+          [ SpanData.simpleAnnotation "value" (2 :: Int) ]+        ]+      )+      spanData+++shouldOverwriteWithSingleAnnotation :: Test+shouldOverwriteWithSingleAnnotation =+  let+    spanData =+      SpanData.merge+        (SpanData.simpleAnnotation "key" (2 :: Int))+        (SpanData+          [ SpanData.objectAnnotation "key"+            [ SpanData.simpleAnnotation "value" (1 :: Int) ]+          ]+        )++  in+  TestCase $+    assertEqual "shouldOverwriteSingleAnnotation"+      (SpanData [ SpanData.simpleAnnotation "key"  (2 :: Int) ])+      spanData+++shouldMergeTwoAtDifferentPaths :: Test+shouldMergeTwoAtDifferentPaths =+  let+    spanData =+      SpanData.merge+        (SpanData.objectAnnotation "nested2"+          [ SpanData.simpleAnnotation "key" (2 :: Int) ]) $+        SpanData.merge+          (SpanData.objectAnnotation "nested1"+            [ SpanData.simpleAnnotation "key" (1 :: Int) ])+          SpanData.empty+  in+  TestCase $+    assertEqual "shouldMergeTwoAtDifferentPaths"+      (SpanData+        [ SpanData.objectAnnotation "nested1"+          [ SpanData.simpleAnnotation "key" (1 :: Int) ]+        , SpanData.objectAnnotation "nested2"+          [ SpanData.simpleAnnotation "key" (2 :: Int) ]+        ]+      )+      spanData+++shouldMergeListValues :: Test+shouldMergeListValues =+  let+    spanData =+      SpanData.merge+        (SpanData.listAnnotation "list" ([ "three", "four" ] :: [String])) $+        SpanData.merge+          (SpanData.listAnnotation "list" ([ "one", "two" ] :: [String]))+          SpanData.empty+  in+  TestCase $+    assertEqual "shouldMergeListValues"+      (SpanData+        [ SpanData.listAnnotation "list" (["one", "two", "three", "four"] :: [String]) ]+      )+      spanData+

@@ -0,0 +1,391 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Instana.SDK.SpanTest (allTests) where+++import           Test.HUnit++import qualified Instana.SDK.Internal.Id     as Id+import           Instana.SDK.Span.EntrySpan  (EntrySpan (RootEntrySpan))+import           Instana.SDK.Span.RootEntry  (RootEntry (RootEntry))+import qualified Instana.SDK.Span.RootEntry  as RootEntry+import qualified Instana.SDK.Span.SimpleSpan as SimpleSpan+import           Instana.SDK.Span.Span       (Span (..), SpanKind (..))+import qualified Instana.SDK.Span.Span       as Span+import           Instana.SDK.Span.SpanData   (SpanData (SpanData))+import qualified Instana.SDK.Span.SpanData   as SpanData+import           Instana.SDK.Span.SpanType   (RegisteredSpanType (HaskellWaiServer),+                                              SpanType (RegisteredSpan, SdkSpan))+++allTests :: Test+allTests =+  TestList+    [ TestLabel "shouldAddStringNotNested" shouldAddStringNotNested+    , TestLabel "shouldAddStringNested" shouldAddStringNested+    , TestLabel "shouldAddStringDeeplyNested" shouldAddStringDeeplyNested+    , TestLabel "shouldAddIntDeeplyNested" shouldAddIntDeeplyNested+    , TestLabel "shouldAddDoubleDeeplyNested" shouldAddDoubleDeeplyNested+    , TestLabel "shouldAddBooleanDeeplyNested" shouldAddBooleanDeeplyNested+    , TestLabel "shouldAddTwoAtDifferentPaths" shouldAddTwoAtDifferentPaths+    , TestLabel "shouldAddTwoAtSamePath" shouldAddTwoAtSamePath+    , TestLabel "shouldAddTwoAtSameNestedPath" shouldAddTwoAtSameNestedPath+    , TestLabel "shouldAddMultipleRegistered" shouldAddMultipleRegistered+    , TestLabel "shouldMergeListValues" shouldMergeListValues+    , TestLabel "shouldWrapAnnotationsInSdkCustomTagsForSdkSpans" shouldWrapAnnotationsInSdkCustomTagsForSdkSpans+    , TestLabel "shouldConvertToSimpleSpanFormat" shouldConvertToSimpleSpanFormat+    ]+++shouldAddStringNotNested :: Test+shouldAddStringNotNested =+  let+    span_ = Span.addAnnotationAt "path" ("value" :: String) $ registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddStringNotNested"+      (SpanData [+        SpanData.simpleAnnotation "path" ("value" :: String)+      ])+      spanData+++shouldAddStringNested :: Test+shouldAddStringNested =+  let+    span_ =+      Span.addAnnotationAt+        "nested.path"+        ("value" :: String) $+          registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddStringNested"+      (SpanData [+        SpanData.objectAnnotation "nested" [+          SpanData.simpleAnnotation "path" ("value" :: String)+        ]+      ])+      spanData+++shouldAddStringDeeplyNested :: Test+shouldAddStringDeeplyNested =+  let+    span_ =+      Span.addAnnotationAt+        "really.deeply.nested.path"+        ("deeplyNestedValue" :: String)+        registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddStringDeeplyNested"+      (SpanData [+        SpanData.objectAnnotation "really" [+          SpanData.objectAnnotation "deeply" [+            SpanData.objectAnnotation "nested" [+              SpanData.simpleAnnotation "path" ("deeplyNestedValue" :: String)+            ]+          ]+        ]+      ])+      spanData+++shouldAddIntDeeplyNested :: Test+shouldAddIntDeeplyNested =+  let+    span_ =+      Span.addAnnotationAt+        "really.deeply.nested.path"+        (42 :: Int) $+          registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddIntDeeplyNested"+      (SpanData [+        SpanData.objectAnnotation "really" [+          SpanData.objectAnnotation "deeply" [+            SpanData.objectAnnotation "nested" [+              SpanData.simpleAnnotation "path" (42 :: Int)+            ]+          ]+        ]+      ])+      spanData+++shouldAddDoubleDeeplyNested :: Test+shouldAddDoubleDeeplyNested =+  let+    span_ =+      Span.addAnnotationAt+        "really.deeply.nested.path"+        (28.08 :: Double) $+          registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddDoubleDeeplyNested"+      (SpanData [+        SpanData.objectAnnotation "really" [+          SpanData.objectAnnotation "deeply" [+            SpanData.objectAnnotation "nested" [+              SpanData.simpleAnnotation "path" (28.08 :: Double)+            ]+          ]+        ]+      ])+      spanData+++shouldAddBooleanDeeplyNested :: Test+shouldAddBooleanDeeplyNested =+  let+    span_ = Span.addAnnotationAt "really.deeply.nested.path" True $ registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddBooleanDeeplyNested"+      (SpanData [+        SpanData.objectAnnotation "really" [+          SpanData.objectAnnotation "deeply" [+            SpanData.objectAnnotation "nested" [+              SpanData.simpleAnnotation "path" True+            ]+          ]+        ]+      ])+      spanData+++shouldAddTwoAtDifferentPaths :: Test+shouldAddTwoAtDifferentPaths =+  let+    span_ =+      Span.addAnnotationAt "nested2.key" (2 :: Int) $+      Span.addAnnotationAt "nested1.key" (1 :: Int) $+      registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddTwoAtDifferentPaths"+      (SpanData+        [ SpanData.objectAnnotation "nested1"+          [ SpanData.simpleAnnotation "key" (1 :: Int) ]+        , SpanData.objectAnnotation "nested2"+          [ SpanData.simpleAnnotation "key" (2 :: Int) ]+        ]+      )+      spanData+++shouldAddTwoAtSamePath :: Test+shouldAddTwoAtSamePath =+  let+    span_ =+      Span.addAnnotationAt "nested.key2" (2 :: Int) $+      Span.addAnnotationAt "nested.key1" (1 :: Int) $+      registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddTwoAtSamePath"+      (SpanData+        [ SpanData.objectAnnotation "nested"+          [ SpanData.simpleAnnotation "key1" (1 :: Int)+          , SpanData.simpleAnnotation "key2" (2 :: Int)+          ]+        ]+      )+      spanData+++shouldAddTwoAtSameNestedPath :: Test+shouldAddTwoAtSameNestedPath =+  let+    span_ =+      Span.addAnnotationAt "nested.deeper.key2" (2 :: Int) $+      Span.addAnnotationAt "nested.deeper.key1" (1 :: Int) $+      registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddTwoAtSameNestedPath"+      (SpanData+        [ SpanData.objectAnnotation "nested"+          [ SpanData.objectAnnotation "deeper"+            [ SpanData.simpleAnnotation "key1" (1 :: Int)+            , SpanData.simpleAnnotation "key2" (2 :: Int)+            ]+          ]+        ]+      )+      spanData+++shouldAddMultipleRegistered :: Test+shouldAddMultipleRegistered =+  let+    span_ =+      Span.addAnnotationAt "nested.key3" (12.07 :: Double) $+      Span.addAnnotationAt "nested.key2" (2 :: Int) $+      Span.addAnnotationAt "nested.key1" ("value.n.1" :: String) $+      Span.addAnnotationAt "list" (["one", "two", "three"] :: [String]) $+      Span.addAnnotationAt "key3" (16.04 :: Double) $+      Span.addAnnotationAt "key2" (13 :: Int) $+      Span.addAnnotationAt "key1" ("value1" :: String) $+      registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldAddMultipleRegistered"+      (SpanData+        [ SpanData.simpleAnnotation "key1" ("value1" :: String)+        , SpanData.simpleAnnotation "key2" (13 :: Int)+        , SpanData.simpleAnnotation "key3" (16.04 :: Double)+        , SpanData.simpleAnnotation "list" (["one", "two", "three"] :: [String])+        , SpanData.objectAnnotation "nested"+          [ SpanData.simpleAnnotation "key1" ("value.n.1" :: String)+          , SpanData.simpleAnnotation "key2" (2 :: Int)+          , SpanData.simpleAnnotation "key3" (12.07 :: Double)+          ]+        ]+      )+      spanData+++shouldMergeListValues :: Test+shouldMergeListValues =+  let+    span_ =+      Span.addAnnotationValueAt "list"+        (SpanData.listValue (["three", "four"] :: [String])) $+          Span.addAnnotationValueAt "list"+            (SpanData.listValue (["one", "two"] :: [String])) $+              registeredEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldMergeListValues"+      (SpanData+        [ SpanData.listAnnotation+            "list"+            (["one", "two", "three", "four"] :: [String])+        ]+      )+      spanData+++shouldWrapAnnotationsInSdkCustomTagsForSdkSpans :: Test+shouldWrapAnnotationsInSdkCustomTagsForSdkSpans =+  let+    span_ =+      Span.addAnnotationAt "nested.key3" (12.07 :: Double) $+      Span.addAnnotationAt "nested.key2" (2 :: Int) $+      Span.addAnnotationAt "nested.key1" ("value.n.1" :: String) $+      Span.addAnnotationAt "key3" (16.04 :: Double) $+      Span.addAnnotationAt "key2" (13 :: Int) $+      Span.addAnnotationAt "key1" ("value1" :: String) $+      sdkEntrySpan+    spanData = Span.spanData span_+  in+  TestCase $+    assertEqual "shouldWrapAnnotationsInSdkCustomTagsForSdkSpans"+      (SpanData+        [ SpanData.objectAnnotation "sdk"+          [ SpanData.objectAnnotation "custom"+            [ SpanData.objectAnnotation "tags"+              [ SpanData.simpleAnnotation "key1" ("value1" :: String)+              , SpanData.simpleAnnotation "key2" (13 :: Int)+              , SpanData.simpleAnnotation "key3" (16.04 :: Double)+              , SpanData.objectAnnotation "nested"+                [ SpanData.simpleAnnotation "key1" ("value.n.1" :: String)+                , SpanData.simpleAnnotation "key2" (2 :: Int)+                , SpanData.simpleAnnotation "key3" (12.07 :: Double)+                ]+              ]+            ]+          ]+        ]+      )+      spanData+++shouldConvertToSimpleSpanFormat :: Test+shouldConvertToSimpleSpanFormat =+  let+    span_ =+      Span.addAnnotationAt "really.deeply.nested.path" True registeredEntrySpan+    simple = SimpleSpan.convert span_+    traceId = SimpleSpan.traceId simple+    spanId = SimpleSpan.spanId simple+    parentId = SimpleSpan.parentId simple+    spanName = SimpleSpan.spanName simple+    timestamp = SimpleSpan.timestamp simple+    kind = SimpleSpan.kind simple+    errorCount = SimpleSpan.errorCount simple+    spanData = SimpleSpan.spanData simple+  in+  TestCase $ do+    assertEqual "traceId" "traceId" traceId+    assertEqual "spanId" "traceId" spanId+    assertEqual "parentId" Nothing parentId+    assertEqual "spanName" "haskell.wai.server" spanName+    assertEqual "timestamp" 1514761200000 timestamp+    assertEqual "kind" EntryKind kind+    assertEqual "errorCount" 0 errorCount+    assertEqual+      "spanData"+      (SpanData+        [ SpanData.objectAnnotation "really" [+            SpanData.objectAnnotation"deeply" [+              SpanData.objectAnnotation "nested" [+                SpanData.simpleAnnotation "path" True+              ]+            ]+          ]+        ]+      )+      spanData+++registeredEntrySpan :: Span+registeredEntrySpan =+  Entry $+    RootEntrySpan $+      RootEntry+        { RootEntry.spanAndTraceId  = Id.fromString "traceId"+        , RootEntry.spanType        = RegisteredSpan HaskellWaiServer+        , RootEntry.timestamp       = 1514761200000+        , RootEntry.errorCount      = 0+        , RootEntry.serviceName     = Nothing+        , RootEntry.synthetic       = False+        , RootEntry.correlationType = Nothing+        , RootEntry.correlationId   = Nothing+        , RootEntry.spanData        = SpanData.empty+        , RootEntry.w3cTraceContext = Nothing+        }+++sdkEntrySpan :: Span+sdkEntrySpan =+  Entry $+    RootEntrySpan $+      RootEntry+        { RootEntry.spanAndTraceId  = Id.fromString "traceId"+        , RootEntry.spanType        = SdkSpan "test.entry"+        , RootEntry.timestamp       = 1514761200000+        , RootEntry.errorCount      = 0+        , RootEntry.serviceName     = Nothing+        , RootEntry.synthetic       = False+        , RootEntry.correlationType = Nothing+        , RootEntry.correlationId   = Nothing+        , RootEntry.spanData        = SpanData.empty+        , RootEntry.w3cTraceContext = Nothing+        }+

@@ -10,8 +10,9 @@ import qualified Instana.SDK.Internal.SecretsTest                   as SecretsTest import qualified Instana.SDK.Internal.ServerTimingTest              as ServerTimingTest import qualified Instana.SDK.Internal.SpanStackTest                 as SpanStackTest-import qualified Instana.SDK.Internal.SpanTest                      as SpanTest import qualified Instana.SDK.Internal.W3CTraceContextTest           as W3CTraceContextTest+import qualified Instana.SDK.SpanDataTest                           as SpanDataTest+import qualified Instana.SDK.SpanTest                               as SpanTest import qualified Instana.SDK.TracingHeadersTest                     as TracingHeadersTest  import           Test.HUnit@@ -35,6 +36,7 @@     , ServerTimingTest.allTests     , SpanStackTest.allTests     , SpanTest.allTests+    , SpanDataTest.allTests     , TracingHeadersTest.allTests     , W3CTraceContextTest.allTests     ]