diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/instana-haskell-trace-sdk.cabal b/instana-haskell-trace-sdk.cabal --- a/instana-haskell-trace-sdk.cabal +++ b/instana-haskell-trace-sdk.cabal @@ -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 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 diff --git a/src/Instana/SDK/Internal/AgentConnection/Json/AnnounceResponse.hs b/src/Instana/SDK/Internal/AgentConnection/Json/AnnounceResponse.hs --- a/src/Instana/SDK/Internal/AgentConnection/Json/AnnounceResponse.hs +++ b/src/Instana/SDK/Internal/AgentConnection/Json/AnnounceResponse.hs @@ -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 diff --git a/src/Instana/SDK/Internal/Context.hs b/src/Instana/SDK/Internal/Context.hs --- a/src/Instana/SDK/Internal/Context.hs +++ b/src/Instana/SDK/Internal/Context.hs @@ -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 diff --git a/src/Instana/SDK/Internal/WireSpan.hs b/src/Instana/SDK/Internal/WireSpan.hs --- a/src/Instana/SDK/Internal/WireSpan.hs +++ b/src/Instana/SDK/Internal/WireSpan.hs @@ -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 diff --git a/src/Instana/SDK/SDK.hs b/src/Instana/SDK/SDK.hs --- a/src/Instana/SDK/SDK.hs +++ b/src/Instana/SDK/SDK.hs @@ -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, "") + 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 diff --git a/src/Instana/SDK/Span/EntrySpan.hs b/src/Instana/SDK/Span/EntrySpan.hs --- a/src/Instana/SDK/Span/EntrySpan.hs +++ b/src/Instana/SDK/Span/EntrySpan.hs @@ -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 diff --git a/src/Instana/SDK/Span/ExitSpan.hs b/src/Instana/SDK/Span/ExitSpan.hs --- a/src/Instana/SDK/Span/ExitSpan.hs +++ b/src/Instana/SDK/Span/ExitSpan.hs @@ -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 } diff --git a/src/Instana/SDK/Span/NonRootEntry.hs b/src/Instana/SDK/Span/NonRootEntry.hs --- a/src/Instana/SDK/Span/NonRootEntry.hs +++ b/src/Instana/SDK/Span/NonRootEntry.hs @@ -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 } diff --git a/src/Instana/SDK/Span/RootEntry.hs b/src/Instana/SDK/Span/RootEntry.hs --- a/src/Instana/SDK/Span/RootEntry.hs +++ b/src/Instana/SDK/Span/RootEntry.hs @@ -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 } diff --git a/src/Instana/SDK/Span/SimpleSpan.hs b/src/Instana/SDK/Span/SimpleSpan.hs --- a/src/Instana/SDK/Span/SimpleSpan.hs +++ b/src/Instana/SDK/Span/SimpleSpan.hs @@ -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) diff --git a/src/Instana/SDK/Span/Span.hs b/src/Instana/SDK/Span/Span.hs --- a/src/Instana/SDK/Span/Span.hs +++ b/src/Instana/SDK/Span/Span.hs @@ -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 + ] + ] diff --git a/src/Instana/SDK/Span/SpanData.hs b/src/Instana/SDK/Span/SpanData.hs new file mode 100644 --- /dev/null +++ b/src/Instana/SDK/Span/SpanData.hs @@ -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 + diff --git a/src/Instana/SDK/Span/SpanType.hs b/src/Instana/SDK/Span/SpanType.hs --- a/src/Instana/SDK/Span/SpanType.hs +++ b/src/Instana/SDK/Span/SpanType.hs @@ -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 [] diff --git a/test/agent-stub/Instana/SDK/AgentStub/Config.hs b/test/agent-stub/Instana/SDK/AgentStub/Config.hs --- a/test/agent-stub/Instana/SDK/AgentStub/Config.hs +++ b/test/agent-stub/Instana/SDK/AgentStub/Config.hs @@ -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 diff --git a/test/agent-stub/Instana/SDK/AgentStub/Server.hs b/test/agent-stub/Instana/SDK/AgentStub/Server.hs --- a/test/agent-stub/Instana/SDK/AgentStub/Server.hs +++ b/test/agent-stub/Instana/SDK/AgentStub/Server.hs @@ -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" } diff --git a/test/apps/downstream-target/Main.hs b/test/apps/downstream-target/Main.hs --- a/test/apps/downstream-target/Main.hs +++ b/test/apps/downstream-target/Main.hs @@ -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 diff --git a/test/apps/wai-with-middleware/Main.hs b/test/apps/wai-with-middleware/Main.hs --- a/test/apps/wai-with-middleware/Main.hs +++ b/test/apps/wai-with-middleware/Main.hs @@ -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¶meters=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¶meters=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 :: diff --git a/test/apps/wai/Main.hs b/test/apps/wai/Main.hs --- a/test/apps/wai/Main.hs +++ b/test/apps/wai/Main.hs @@ -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¶meters=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¶meters=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 :: diff --git a/test/integration/Instana/SDK/IntegrationTest/CustomSecrets.hs b/test/integration/Instana/SDK/IntegrationTest/CustomSecrets.hs new file mode 100644 --- /dev/null +++ b/test/integration/Instana/SDK/IntegrationTest/CustomSecrets.hs @@ -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=&" + -- 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=&" + -- 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¶meters=2&pass=secret" :: String) + , "status" .= (200 :: Int) + ] + ) + ] + ) + (TraceRequest.spanData exitSpan) + ] + diff --git a/test/integration/Instana/SDK/IntegrationTest/ExtraHttpHeaders.hs b/test/integration/Instana/SDK/IntegrationTest/ExtraHttpHeaders.hs new file mode 100644 --- /dev/null +++ b/test/integration/Instana/SDK/IntegrationTest/ExtraHttpHeaders.hs @@ -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¶meters=2&pass=" :: 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) + ] + diff --git a/test/integration/Instana/SDK/IntegrationTest/HUnitExtra.hs b/test/integration/Instana/SDK/IntegrationTest/HUnitExtra.hs --- a/test/integration/Instana/SDK/IntegrationTest/HUnitExtra.hs +++ b/test/integration/Instana/SDK/IntegrationTest/HUnitExtra.hs @@ -35,6 +35,7 @@ applyLabel :: String -> IO Test -> IO Test applyLabel label testIO = do + infoM testLogger $ "Running: " ++ label t <- testIO return $ TestLabel label t diff --git a/test/integration/Instana/SDK/IntegrationTest/HttpTracing.hs b/test/integration/Instana/SDK/IntegrationTest/HttpTracing.hs --- a/test/integration/Instana/SDK/IntegrationTest/HttpTracing.hs +++ b/test/integration/Instana/SDK/IntegrationTest/HttpTracing.hs @@ -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¶meters=1" headers extraAsserts +runBracketTest pid headers extraAssertsForEntrySpan = + runTest pid "http/bracket/api?some=query¶meters=1" headers extraAssertsForEntrySpan runLowLevelTest :: String -> [Header] -> (Span -> [Assertion]) -> IO Test -runLowLevelTest pid headers extraAsserts = - runTest pid "http/low/level/api?some=query¶meters=2" headers extraAsserts +runLowLevelTest pid headers extraAssertsForEntrySpan = + runTest pid "http/low/level/api?some=query¶meters=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¶meters=2&pass=" :: 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¶meters=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=&MYPASSWORD=&another-query-param=zzz1&secret=" :: String) + , "status" .= (200 :: Int) + ] + ) + ] + ) + (TraceRequest.spanData entrySpan) ] diff --git a/test/integration/Instana/SDK/IntegrationTest/Metrics.hs b/test/integration/Instana/SDK/IntegrationTest/Metrics.hs --- a/test/integration/Instana/SDK/IntegrationTest/Metrics.hs +++ b/test/integration/Instana/SDK/IntegrationTest/Metrics.hs @@ -51,7 +51,7 @@ (EntityDataRequest.arguments entityData) , assertLabelIs "sensorVersion" - "0.7.1.0" + "0.8.0.0" (EntityDataRequest.sensorVersion entityData) , assertCounterSatisfies "startTime" diff --git a/test/integration/Instana/SDK/IntegrationTest/Runner.hs b/test/integration/Instana/SDK/IntegrationTest/Runner.hs --- a/test/integration/Instana/SDK/IntegrationTest/Runner.hs +++ b/test/integration/Instana/SDK/IntegrationTest/Runner.hs @@ -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" diff --git a/test/integration/Instana/SDK/IntegrationTest/SpecCompliance.hs b/test/integration/Instana/SDK/IntegrationTest/SpecCompliance.hs --- a/test/integration/Instana/SDK/IntegrationTest/SpecCompliance.hs +++ b/test/integration/Instana/SDK/IntegrationTest/SpecCompliance.hs @@ -680,7 +680,7 @@ [ "http" .= (Aeson.object [ "method" .= ("GET" :: String) , "url" .= ("http://127.0.0.1:1208/echo" :: String) - , "params" .= ("some=query¶meters=2" :: String) + , "params" .= ("some=query¶meters=2&pass=" :: String) , "status" .= (200 :: Int) ] ) diff --git a/test/integration/Instana/SDK/IntegrationTest/Suite.hs b/test/integration/Instana/SDK/IntegrationTest/Suite.hs --- a/test/integration/Instana/SDK/IntegrationTest/Suite.hs +++ b/test/integration/Instana/SDK/IntegrationTest/Suite.hs @@ -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 diff --git a/test/integration/Instana/SDK/IntegrationTest/TestSuites.hs b/test/integration/Instana/SDK/IntegrationTest/TestSuites.hs --- a/test/integration/Instana/SDK/IntegrationTest/TestSuites.hs +++ b/test/integration/Instana/SDK/IntegrationTest/TestSuites.hs @@ -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 diff --git a/test/integration/Instana/SDK/IntegrationTest/WaiMiddleware.hs b/test/integration/Instana/SDK/IntegrationTest/WaiMiddleware.hs --- a/test/integration/Instana/SDK/IntegrationTest/WaiMiddleware.hs +++ b/test/integration/Instana/SDK/IntegrationTest/WaiMiddleware.hs @@ -239,7 +239,7 @@ [ "http" .= (Aeson.object [ "method" .= ("GET" :: String) , "url" .= ("http://127.0.0.1:1208/echo" :: String) - , "params" .= ("some=query¶meters=2" :: String) + , "params" .= ("some=query¶meters=2&pass=" :: String) , "status" .= (200 :: Int) ] ) diff --git a/test/shared/Instana/SDK/AgentStub/DiscoveryResponse.hs b/test/shared/Instana/SDK/AgentStub/DiscoveryResponse.hs --- a/test/shared/Instana/SDK/AgentStub/DiscoveryResponse.hs +++ b/test/shared/Instana/SDK/AgentStub/DiscoveryResponse.hs @@ -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 diff --git a/test/unit/Instana/SDK/Internal/SpanStackTest.hs b/test/unit/Instana/SDK/Internal/SpanStackTest.hs --- a/test/unit/Instana/SDK/Internal/SpanStackTest.hs +++ b/test/unit/Instana/SDK/Internal/SpanStackTest.hs @@ -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 diff --git a/test/unit/Instana/SDK/Internal/SpanTest.hs b/test/unit/Instana/SDK/Internal/SpanTest.hs deleted file mode 100644 --- a/test/unit/Instana/SDK/Internal/SpanTest.hs +++ /dev/null @@ -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 [] - diff --git a/test/unit/Instana/SDK/SpanDataTest.hs b/test/unit/Instana/SDK/SpanDataTest.hs new file mode 100644 --- /dev/null +++ b/test/unit/Instana/SDK/SpanDataTest.hs @@ -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 + diff --git a/test/unit/Instana/SDK/SpanTest.hs b/test/unit/Instana/SDK/SpanTest.hs new file mode 100644 --- /dev/null +++ b/test/unit/Instana/SDK/SpanTest.hs @@ -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 + } + diff --git a/test/unit/Main.hs b/test/unit/Main.hs --- a/test/unit/Main.hs +++ b/test/unit/Main.hs @@ -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 ]