diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -67,7 +67,7 @@ * `test/integration/Instana/SDK/IntegrationTest/Metrics.hs` (assertion for `sensorVersion`) * Commit and push this change with a commit comment like `chore: version a.b.c.d` * Build the package with stack and upload it to Hackage: - * `stack haddock && stack sdist && stack upload --no-signature .` + * `stack haddock && stack sdist && stack upload .` Actually, the Hackage server should build the haddock docs after the package has been uploaded and add it to the package version. You can check if this has worked - if the individual modules on are links to the documentation, it worked. Legend has it that this takes a few minutes - you could theoretically wait to see if the docs show up. Most of the times this does not actually work for reasons unknown. In these cases you can build the docs manually in the format Hackage expects and upload them for an already published package version by running ``` diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for instana-haskell-trace-sdk +## Unreleased +- Add support for website monitoring back end correlation via Server-Timing. +- Add support for website monitoring back end correlation via X-INSTANA-L/correlationType/correlationId. + ## 0.4.0.0 - Accomodate for breaking changes in `network-3.0.0.0`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,6 @@ -# Instana Haskell Trace SDK   [![Build Status](https://travis-ci.org/instana/haskell-trace-sdk.svg?branch=main)](https://travis-ci.org/instana/haskell-trace-sdk) +# Instana Haskell Trace SDK   [![Build Status](https://circleci.com/gh/instana/haskell-trace-sdk.svg?style=svg)](https://circleci.com/gh/instana/haskell-trace-sdk) + Monitor your Haskell application with [Instana](https://www.instana.com/)! 🎉 Disclaimer @@ -19,7 +20,7 @@ ``` extra-deps: -- instana-haskell-trace-sdk-0.4.0.0 +- instana-haskell-trace-sdk-0.5.0.0 ``` Depending on the stack resolver you use, you might also need to add `aeson-extra` to your extra-deps: @@ -139,7 +140,7 @@ * `withEntry`: Creates an entry span that has a parent span. * `withHttpEntry`: A convenience function that examines an HTTP request for Instana tracing headers and creates an entry span. It will automatically add the correct metadata to the span. You do not need to handle incoming HTTP requests at all when using the Instana WAI middleware plug-in (see above). * `withExit`: Creates an exit span. This can only be called inside a `withRootEntry` or an `withEntry` call, as an exit span needs an entry span as its parent. -* `withHttpExit`: Creates an exit span for a given HTTP client request. It will automatically add the correct metadata to the span so it should be preferred to `withExit` when tracing outgoing HTTP requests. +* `withHttpExit`: Creates an exit span for a given HTTP client request. It will automatically add the correct metadata to the span so it should be preferred to `withExit` when tracing outgoing HTTP requests. It will also add HTTP headers to the request to propagate the trace context downstream. #### Low Level API/Explicit Start And Complete @@ -147,7 +148,7 @@ * `startEntry`: Starts an entry span. You will need to call `completeEntry` at some point. * `startHttpEntry`: Starts an entry span for an incoming HTTP request. It will automatically add the correct metadata to the span. You do not need to handle incoming HTTP requests at all when using the WAI middleware plug-in (see above). You will need to call `completeEntry` at some point. * `startExit`: Starts an exit span. You will need to call `completeExit` at some point. -* `startHttpExit`: Starts an exit span for an outgoing HTTP request. It will automatically add the correct metadata to the span so it should be preferred to `startExit` when tracing outgoing HTTP requests. You will need to call `completeExit` at some point. +* `startHttpExit`: Starts an exit span for an outgoing HTTP request. It will automatically add the correct metadata to the span so it should be preferred to `startExit` when tracing outgoing HTTP requests. It will also add HTTP headers to the request to propagate the trace context downstream. You will need to call `completeExit` at some point. * `completeEntry`: Finalizes an entry span. This will put the span into the SDK's span buffer for transmission to the Instana agent. * `completeExit`: Finalizes an exit span. This will put the span into the SDK's span buffer for transmission to the Instana agent. 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.4.0.0 +version: 0.5.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/ @@ -48,6 +48,8 @@ , process , random , regex-base + , regex-compat + , regex-pcre , regex-tdfa , retry , scientific @@ -98,6 +100,7 @@ Instana.SDK.Internal.Retry Instana.SDK.Internal.Secrets Instana.SDK.Internal.SpanStack + Instana.SDK.Internal.ServerTiming Instana.SDK.Internal.URL Instana.SDK.Internal.Util Instana.SDK.Internal.Worker @@ -142,15 +145,18 @@ -Wall -threaded -rtsopts -with-rtsopts=-N -Wno-missing-home-modules build-depends: base >=4.7 && <5 - , bytestring + , HUnit , aeson , aeson-extra + , bytestring , directory , ekg-core - , HUnit + , http-types , hslogger , random , regex-base + , regex-compat + , regex-pcre , regex-tdfa , scientific , text @@ -164,8 +170,10 @@ Instana.SDK.Internal.Metrics.CompressionTest Instana.SDK.Internal.Metrics.DeltasTest Instana.SDK.Internal.SecretsTest + Instana.SDK.Internal.ServerTimingTest Instana.SDK.Internal.SpanStackTest Instana.SDK.Internal.SpanTest + Instana.SDK.TracingHeadersTest -- modules under test Instana.SDK.Internal.Config Instana.SDK.Internal.AgentConnection.SchedFile @@ -175,7 +183,9 @@ Instana.SDK.Internal.Metrics.Deltas Instana.SDK.Internal.Secrets Instana.SDK.Internal.SpanStack + Instana.SDK.Internal.ServerTiming Instana.SDK.Span.Span + Instana.SDK.TracingHeaders -- dependencies of modules under test Instana.SDK.Config Instana.SDK.Internal.Metrics.Sample diff --git a/src/Instana/SDK/Internal/Id.hs b/src/Instana/SDK/Internal/Id.hs --- a/src/Instana/SDK/Internal/Id.hs +++ b/src/Instana/SDK/Internal/Id.hs @@ -10,6 +10,7 @@ , generate , fromString , toByteString + , toString , toText -- exposed for testing purposes , createFromIntsForTest diff --git a/src/Instana/SDK/Internal/ServerTiming.hs b/src/Instana/SDK/Internal/ServerTiming.hs new file mode 100644 --- /dev/null +++ b/src/Instana/SDK/Internal/ServerTiming.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Instana.SDK.Internal.ServerTiming +Description : Add/update the Server-Timing header +-} +module Instana.SDK.Internal.ServerTiming + ( addTraceIdToServerTiming + ) where + + +import qualified Data.ByteString.Char8 as BSC8 +import qualified Network.HTTP.Types as HTTPTypes +import Text.Regex (Regex) +import qualified Text.Regex as Regex + +import Instana.SDK.Internal.Id (Id) +import qualified Instana.SDK.Internal.Id as Id + + +addTraceIdToServerTiming :: + Id + -> HTTPTypes.ResponseHeaders + -> HTTPTypes.ResponseHeaders +addTraceIdToServerTiming traceId headers = + let + existingValue = lookup "Server-Timing" headers + result = + case existingValue of + Nothing -> + addServerTimingHeader traceId headers + Just existingMetrics -> + appendInTIdToServerTimingHeader traceId existingMetrics headers + in + result + + +addServerTimingHeader :: + Id + -> HTTPTypes.ResponseHeaders + -> HTTPTypes.ResponseHeaders +addServerTimingHeader traceId headers = + let + newValue = (BSC8.pack "intid;desc=") <> Id.toByteString traceId + in + headers ++ [("Server-Timing", newValue)] + + +appendInTIdToServerTimingHeader :: + Id + -> BSC8.ByteString + -> HTTPTypes.ResponseHeaders + -> HTTPTypes.ResponseHeaders +appendInTIdToServerTimingHeader traceId existingMetrics headers = + if (BSC8.isInfixOf "intid;desc=" existingMetrics) + then + replaceExistingInTIdMetric traceId existingMetrics headers + else + appendInTIdMetricAtEnd traceId existingMetrics headers + + +appendInTIdMetricAtEnd :: + Id + -> BSC8.ByteString + -> HTTPTypes.ResponseHeaders + -> HTTPTypes.ResponseHeaders +appendInTIdMetricAtEnd traceId existingMetrics headers = + let + newServerTimingValue = + existingMetrics <> + (BSC8.pack ", intid;desc=") <> + Id.toByteString traceId + headersWithoutServerTiming = + filter (\(k, _) -> k /= "Server-Timing") headers + in + headersWithoutServerTiming ++ [("Server-Timing", newServerTimingValue)] + + +replaceExistingInTIdMetric :: + Id + -> BSC8.ByteString + -> HTTPTypes.ResponseHeaders + -> HTTPTypes.ResponseHeaders +replaceExistingInTIdMetric traceId existingMetrics headers = + let + current = BSC8.unpack existingMetrics + replaced = + Regex.subRegex + replaceExistingRegex + current + ("intid;desc=" ++ Id.toString traceId) + newServerTimingValue = BSC8.pack replaced + headersWithoutServerTiming = + filter (\(k, _) -> k /= "Server-Timing") headers + in + headersWithoutServerTiming ++ [("Server-Timing", newServerTimingValue)] + + +replaceExistingRegex :: Regex +replaceExistingRegex = + Regex.mkRegex "intid;desc=[^,]*" + diff --git a/src/Instana/SDK/Internal/SpanStack.hs b/src/Instana/SDK/Internal/SpanStack.hs --- a/src/Instana/SDK/Internal/SpanStack.hs +++ b/src/Instana/SDK/Internal/SpanStack.hs @@ -15,13 +15,16 @@ , popWhenMatches , push , pushSuppress + , readTraceId , suppress ) where import GHC.Generics +import Instana.SDK.Internal.Id (Id) import Instana.SDK.Internal.Util ((|>)) import Instana.SDK.Span.EntrySpan (EntrySpan) +import qualified Instana.SDK.Span.EntrySpan as EntrySpan import Instana.SDK.Span.ExitSpan (ExitSpan) import Instana.SDK.Span.Span (Span (..), SpanKind (..)) @@ -187,6 +190,19 @@ Just $ Entry entrySpan peek (EntryAndExit _ exitSpan) = Just $ Exit exitSpan + + +{-|Reads the trace ID from the entry span of the stack, if any. +-} +readTraceId :: SpanStack -> Maybe Id +readTraceId None = + Nothing +readTraceId Suppressed = + Nothing +readTraceId (EntryOnly entrySpan) = + Just $ EntrySpan.traceId entrySpan +readTraceId (EntryAndExit entrySpan _) = + Just $ EntrySpan.traceId entrySpan {-|Modifies the top element in place by applying the given function to it. This 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 @@ -88,16 +88,18 @@ -- this type are stored in the spanQueue in Instana.SDK.Internal.Context after -- they have been completed. data QueuedSpan = QueuedSpan - { traceId :: Id - , spanId :: Id - , parentId :: Maybe Id - , spanName :: Text - , timestamp :: Int - , duration :: Int - , kind :: SpanKind - , errorCount :: Int - , serviceName :: Maybe Text - , spanData :: Value + { traceId :: Id + , spanId :: Id + , parentId :: Maybe Id + , spanName :: Text + , timestamp :: Int + , duration :: Int + , kind :: SpanKind + , errorCount :: Int + , serviceName :: Maybe Text + , correlationType :: Maybe Text + , correlationId :: Maybe Text + , spanData :: Value } deriving (Eq, Generic, Show) @@ -138,6 +140,8 @@ , "d" .= duration span_ , "k" .= kind span_ , "ec" .= errorCount span_ + , "crtp" .= correlationType span_ + , "crid" .= correlationId span_ , "data" .= spanData_ , "f" .= From pid_ agentUuid_ ] diff --git a/src/Instana/SDK/Internal/Worker.hs b/src/Instana/SDK/Internal/Worker.hs --- a/src/Instana/SDK/Internal/Worker.hs +++ b/src/Instana/SDK/Internal/Worker.hs @@ -128,16 +128,18 @@ queueSpan context QueuedSpan - { WireSpan.traceId = EntrySpan.traceId entrySpan - , WireSpan.spanId = EntrySpan.spanId entrySpan - , WireSpan.parentId = EntrySpan.parentId entrySpan - , WireSpan.spanName = EntrySpan.spanName entrySpan - , WireSpan.timestamp = timestamp - , WireSpan.duration = now - timestamp - , WireSpan.kind = Entry - , WireSpan.errorCount = EntrySpan.errorCount entrySpan - , WireSpan.serviceName = EntrySpan.serviceName entrySpan - , WireSpan.spanData = EntrySpan.spanData entrySpan + { WireSpan.traceId = EntrySpan.traceId entrySpan + , WireSpan.spanId = EntrySpan.spanId entrySpan + , WireSpan.parentId = EntrySpan.parentId entrySpan + , WireSpan.spanName = EntrySpan.spanName entrySpan + , WireSpan.timestamp = timestamp + , WireSpan.duration = now - timestamp + , WireSpan.kind = Entry + , WireSpan.errorCount = EntrySpan.errorCount entrySpan + , WireSpan.serviceName = EntrySpan.serviceName entrySpan + , WireSpan.correlationType = EntrySpan.correlationType entrySpan + , WireSpan.correlationId = EntrySpan.correlationId entrySpan + , WireSpan.spanData = EntrySpan.spanData entrySpan } @@ -149,16 +151,18 @@ queueSpan context QueuedSpan - { WireSpan.traceId = EntrySpan.traceId parentSpan - , WireSpan.spanId = ExitSpan.spanId exitSpan - , WireSpan.parentId = Just $ EntrySpan.spanId parentSpan - , WireSpan.spanName = ExitSpan.spanName exitSpan - , WireSpan.timestamp = ExitSpan.timestamp exitSpan - , WireSpan.duration = now - ExitSpan.timestamp exitSpan - , WireSpan.kind = Exit - , WireSpan.errorCount = ExitSpan.errorCount exitSpan - , WireSpan.serviceName = ExitSpan.serviceName exitSpan - , WireSpan.spanData = ExitSpan.spanData exitSpan + { WireSpan.traceId = EntrySpan.traceId parentSpan + , WireSpan.spanId = ExitSpan.spanId exitSpan + , WireSpan.parentId = Just $ EntrySpan.spanId parentSpan + , WireSpan.spanName = ExitSpan.spanName exitSpan + , WireSpan.timestamp = ExitSpan.timestamp exitSpan + , WireSpan.duration = now - ExitSpan.timestamp exitSpan + , WireSpan.kind = Exit + , WireSpan.errorCount = ExitSpan.errorCount exitSpan + , WireSpan.serviceName = ExitSpan.serviceName exitSpan + , WireSpan.correlationType = Nothing + , WireSpan.correlationId = Nothing + , WireSpan.spanData = ExitSpan.spanData exitSpan } 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,16 +11,18 @@ module Instana.SDK.SDK ( Config , InstanaContext + , addHttpTracingHeaders , addRegisteredData , addRegisteredDataAt - , addHttpTracingHeaders , addTag , addTagAt , addToErrorCount + , addWebsiteMonitoringBackEndCorrelation , agentHost , agentPort , completeEntry , completeExit + , currentTraceId , defaultConfig , forceTransmissionAfter , forceTransmissionStartingAt @@ -30,6 +32,8 @@ , maxBufferedSpans , readHttpTracingHeaders , serviceName + , setCorrelationId + , setCorrelationType , setServiceName , startEntry , startExit @@ -37,6 +41,7 @@ , startHttpExit , startRootEntry , withConfiguredInstana + , withCorrelatedHttpEntry , withEntry , withExit , withHttpEntry @@ -50,6 +55,7 @@ import qualified Control.Concurrent as Concurrent import Control.Concurrent.STM (STM) import qualified Control.Concurrent.STM as STM +import Control.Monad (join) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson (Value, (.=)) import qualified Data.Aeson as Aeson @@ -75,11 +81,13 @@ import qualified Instana.SDK.Internal.Config as InternalConfig import Instana.SDK.Internal.Context (ConnectionState (..), InternalContext (InternalContext)) import qualified Instana.SDK.Internal.Context as InternalContext +import Instana.SDK.Internal.Id (Id) import qualified Instana.SDK.Internal.Id as Id import Instana.SDK.Internal.Logging (instanaLogger) import qualified Instana.SDK.Internal.Logging as Logging import qualified Instana.SDK.Internal.Metrics.Sample as Sample import qualified Instana.SDK.Internal.Secrets as Secrets +import qualified Instana.SDK.Internal.ServerTiming as ServerTiming import Instana.SDK.Internal.SpanStack (SpanStack) import qualified Instana.SDK.Internal.SpanStack as SpanStack import Instana.SDK.Internal.Util ((|>)) @@ -213,7 +221,9 @@ return context --- |Wraps an IO action in 'startRootEntry' and 'completeEntry'. +-- |Wraps an IO action in 'startRootEntry' and 'completeEntry'. For incoming +-- HTTP requests, prefer 'withCorrelatedHttpEntry' or 'withHttpEntry' +-- instead. withRootEntry :: MonadIO m => InstanaContext @@ -227,7 +237,9 @@ return result --- |Wraps an IO action in 'startEntry' and 'completeEntry'. +-- |Wraps an IO action in 'startEntry' and 'completeEntry'. For incoming HTTP +-- requests, prefer 'withCorrelatedHttpEntry' or 'withHttpEntry' +-- instead. withEntry :: MonadIO m => InstanaContext @@ -247,6 +259,12 @@ -- headers (https://docs.instana.io/core_concepts/tracing/#http-tracing-headers) -- and wraps the given IO action either in 'startRootEntry' or 'startEntry' and -- 'completeEntry', depending on the presence or absence of these headers. +-- +-- It is recommended to use 'withCorrelatedHttpEntry' instead of this +-- function to also automatically add the HTTP response header for website +-- monitoring back end correlation. Alternatively you can also call +-- 'addWebsiteMonitoringBackEndCorrelation' with the WAI Response value before +-- handing it off to WAI's 'respond' function. withHttpEntry :: MonadIO m => InstanaContext @@ -267,8 +285,10 @@ case (traceId, spanId) of (Just t, Just s) -> withEntry context t s spanType io' - _ -> - withRootEntry context spanType io' + _ -> do + withRootEntry context spanType $ + addCorrelationTypeAndIdToSpan context tracingHeaders io' + TracingHeaders.Suppress -> do liftIO $ pushSpan context @@ -284,6 +304,30 @@ io +-- |A convenience function that examines the given request for Instana tracing +-- headers (https://docs.instana.io/core_concepts/tracing/#http-tracing-headers) +-- and wraps the given IO action either in 'startRootEntry' or 'startEntry' and +-- 'completeEntry', depending on the presence or absence of these headers. It +-- will also add (or append to) the HTTP response header (Server-Timing) that is +-- used for website monitoring back end correlation. (The latter part is the +-- difference to 'withHttpEntry', plus the slightly different type signature.) +-- +-- This function should be preferred over 'withHttpEntry'. +withCorrelatedHttpEntry :: + MonadIO m => + InstanaContext + -> Wai.Request + -> m Wai.Response + -> m Wai.Response +withCorrelatedHttpEntry + context + request + io = do + response <- withHttpEntry context request $ do + io >>= addWebsiteMonitoringBackEndCorrelation context + return response + + -- |Takes an IO action and appends another side effecto to it that will add HTTP -- data from the given request to the current span. addDataFromRequest :: MonadIO m => InstanaContext -> Wai.Request -> m a -> m a @@ -318,6 +362,31 @@ ) +addCorrelationTypeAndIdToSpan :: + MonadIO m => + InstanaContext + -> TracingHeaders + -> m a + -> m a +addCorrelationTypeAndIdToSpan context tracingHeaders ioResult = do + let + correlationType = TracingHeaders.correlationType tracingHeaders + correlationId = TracingHeaders.correlationId tracingHeaders + case (correlationType, correlationId) of + (Nothing, Nothing) -> + ioResult + (Just crtp, Nothing) -> do + setCorrelationType context (T.pack crtp) + ioResult + (Nothing, Just crid) -> do + setCorrelationId context (T.pack crid) + ioResult + (Just crtp, Just crid) -> do + setCorrelationType context (T.pack crtp) + setCorrelationId context (T.pack crid) + ioResult + + -- |Wraps an IO action in 'startExit' and 'completeExit'. withExit :: MonadIO m => @@ -363,12 +432,14 @@ newSpan = RootEntrySpan $ RootEntry - { RootEntry.spanAndTraceId = traceId - , RootEntry.spanName = SpanType.spanName spanType - , RootEntry.timestamp = timestamp - , RootEntry.errorCount = 0 - , RootEntry.serviceName = Nothing - , RootEntry.spanData = SpanType.initialData EntryKind spanType + { RootEntry.spanAndTraceId = traceId + , RootEntry.spanName = SpanType.spanName spanType + , RootEntry.timestamp = timestamp + , RootEntry.errorCount = 0 + , RootEntry.serviceName = Nothing + , RootEntry.correlationType = Nothing + , RootEntry.correlationId = Nothing + , RootEntry.spanData = SpanType.initialData EntryKind spanType } pushSpan context @@ -448,6 +519,8 @@ _ -> do startRootEntry context spanType addHttpData context request + addCorrelationTypeAndIdToSpan context tracingHeaders $ return () + TracingHeaders.Suppress -> do liftIO $ pushSpan context @@ -461,6 +534,31 @@ ) +-- |Adds an additional HTTP response header (Server-Timing) to the given +-- response that enables website monitoring back end correlation. In case the +-- respons already has a Server-Timing header, a value is appended to the +-- existing Server-Timing list. +-- +-- Client code should rarely have the need to call this directly. Instead, +-- capture incoming HTTP requests with 'withCorrelatedHttpEntry', which adds the +-- response header automatically. +addWebsiteMonitoringBackEndCorrelation :: + MonadIO m => + InstanaContext + -> Wai.Response + -> m Wai.Response +addWebsiteMonitoringBackEndCorrelation context response = do + liftIO $ do + mt <- currentTraceId context + case mt of + Nothing -> return response + Just t -> + return $ + Wai.mapResponseHeaders + (ServerTiming.addTraceIdToServerTiming t) + response + + -- |Creates a preliminary/incomplete exit span, which should later be completed -- with 'completeExit'. startExit :: @@ -671,6 +769,22 @@ (\span_ -> Span.setServiceName serviceName_ span_) +-- |Set the website monitoring correlation type. This should only be set on +-- root entry spans. It will be silently ignored for other types of spans. +setCorrelationType :: MonadIO m => InstanaContext -> Text -> m () +setCorrelationType context correlationType_ = + liftIO $ modifyCurrentSpan context + (\span_ -> Span.setCorrelationType correlationType_ span_) + + +-- |Set the website monitoring correlation ID. This should only be set on +-- root entry spans. It will be silently ignored for other types of spans. +setCorrelationId :: MonadIO m => InstanaContext -> Text -> m () +setCorrelationId context correlationId_ = + liftIO $ modifyCurrentSpan context + (\span_ -> Span.setCorrelationId correlationId_ 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. @@ -765,15 +879,19 @@ headers |> List.lookup TracingHeaders.spanIdHeaderName |> (<$>) BSC8.unpack - level = + xInstanaLValue = headers |> List.lookup TracingHeaders.levelHeaderName |> (<$>) BSC8.unpack + (level, correlationType, correlationId) = + TracingHeaders.parseXInstanaL xInstanaLValue in TracingHeaders { TracingHeaders.traceId = traceId , TracingHeaders.spanId = spanId - , TracingHeaders.level = TracingHeaders.maybeStringToTracingLevel level + , TracingHeaders.level = level + , TracingHeaders.correlationType = correlationType + , TracingHeaders.correlationId = correlationId } @@ -883,41 +1001,46 @@ -- |Yields the currently active span without modifying the span stack. peekSpan :: InstanaContext -> IO (Maybe Span) peekSpan context = do - threadId <- Concurrent.myThreadId - STM.atomically $ peekSpanStm context threadId + spanMaybe <- readFromSpanStack context SpanStack.peek + return $ join spanMaybe --- |Yields the currently active span without modifying the span stack. -peekSpanStm :: InstanaContext -> ThreadId -> STM (Maybe Span) -peekSpanStm context threadId = do - currentSpansPerThread <- STM.readTVar $ InternalContext.currentSpans context - let - stack = Map.lookup threadId currentSpansPerThread - case stack of - Nothing -> - return Nothing - Just s -> - return $ SpanStack.peek s +-- |Retrieves the trace ID the current thread. +currentTraceId :: InstanaContext -> IO (Maybe Id) +currentTraceId context = do + traceIdMaybe <- readFromSpanStack context SpanStack.readTraceId + return $ join traceIdMaybe -- |Checks if tracing is suppressed for the current thread. isSuppressed :: InstanaContext -> IO Bool isSuppressed context = do + suppressedMaybe <- readFromSpanStack context SpanStack.isSuppressed + return $ Maybe.fromMaybe False suppressedMaybe + + +-- |Reads a value from the currently active span stack. +readFromSpanStack :: InstanaContext -> (SpanStack -> a) -> IO (Maybe a) +readFromSpanStack context accessor = do threadId <- Concurrent.myThreadId - STM.atomically $ isSuppressedStm context threadId + STM.atomically $ readFromSpanStackStm context threadId accessor --- |Checks if tracing is suppressed for the current thread. -isSuppressedStm :: InstanaContext -> ThreadId -> STM Bool -isSuppressedStm context threadId = do +-- |Reads a value from the currently active span stack in the given thread. +readFromSpanStackStm :: + InstanaContext + -> ThreadId + -> (SpanStack -> a) + -> STM (Maybe a) +readFromSpanStackStm context threadId accessor = do currentSpansPerThread <- STM.readTVar $ InternalContext.currentSpans context let - stack = Map.lookup threadId currentSpansPerThread - case stack of + maybeStack = Map.lookup threadId currentSpansPerThread + case maybeStack of Nothing -> - return False - Just s -> - return $ SpanStack.isSuppressed s + return Nothing + Just stack -> + return $ Just $ accessor stack -- |Applies the given function to the currently active span, replacing it in 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,17 +5,21 @@ -} module Instana.SDK.Span.EntrySpan ( EntrySpan(..) - , traceId - , spanId - , parentId - , spanName - , timestamp + , addData + , addToErrorCount + , correlationId + , correlationType , errorCount + , parentId , serviceName + , setCorrelationId + , setCorrelationType , setServiceName , spanData - , addData - , addToErrorCount + , spanId + , spanName + , timestamp + , traceId ) where @@ -111,6 +115,44 @@ RootEntrySpan $ RootEntry.setServiceName serviceName_ entry NonRootEntrySpan entry -> NonRootEntrySpan $ NonRootEntry.setServiceName serviceName_ entry + + +-- |The website monitoring correlation type. +correlationType :: EntrySpan -> Maybe Text +correlationType entrySpan = + case entrySpan of + RootEntrySpan entry -> RootEntry.correlationType entry + NonRootEntrySpan _ -> Nothing + + +-- |Set the website monitoring correlation type. This should only be set on +-- root entry spans. It will be silently ignored for other types of spans. +setCorrelationType :: Text -> EntrySpan -> EntrySpan +setCorrelationType correlationType_ entrySpan = + case entrySpan of + RootEntrySpan entry -> + RootEntrySpan $ RootEntry.setCorrelationType correlationType_ entry + NonRootEntrySpan _ -> + entrySpan + + +-- |The website monitoring correlation ID. +correlationId :: EntrySpan -> Maybe Text +correlationId entrySpan = + case entrySpan of + RootEntrySpan entry -> RootEntry.correlationId entry + NonRootEntrySpan _ -> Nothing + + +-- |Set the website monitoring correlation ID. This should only be set on +-- root entry spans. It will be silently ignored for other types of spans. +setCorrelationId :: Text -> EntrySpan -> EntrySpan +setCorrelationId correlationId_ entrySpan = + case entrySpan of + RootEntrySpan entry -> + RootEntrySpan $ RootEntry.setCorrelationId correlationId_ entry + NonRootEntrySpan _ -> + entrySpan -- |Optional additional span data. 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 @@ -10,6 +10,8 @@ , addData , addToErrorCount , setServiceName + , setCorrelationType + , setCorrelationId ) where @@ -26,20 +28,24 @@ RootEntry { -- |The trace ID and span ID (those are identical for root spans) - spanAndTraceId :: Id + 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 + , spanName :: Text -- |The time the span (and trace) started - , timestamp :: Int + , timestamp :: Int -- |The number of errors that occured during processing - , errorCount :: Int + , errorCount :: Int -- |An attribute for overriding the name of the service in Instana - , serviceName :: Maybe Text + , serviceName :: Maybe Text + -- |The website monitoring correlation type + , 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 + , spanData :: Value } deriving (Eq, Generic, Show) @@ -66,6 +72,18 @@ setServiceName :: Text -> RootEntry -> RootEntry setServiceName serviceName_ rootEntry = rootEntry { serviceName = Just serviceName_ } + + +-- |Set the website monitoring correlation type. +setCorrelationType :: Text -> RootEntry -> RootEntry +setCorrelationType correlationType_ rootEntry = + rootEntry { correlationType = Just correlationType_ } + + +-- |Set the website monitoring correlation ID. +setCorrelationId :: Text -> RootEntry -> RootEntry +setCorrelationId correlationId_ rootEntry = + rootEntry { correlationId = Just correlationId_ } -- |Add a value to the span's data section. 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,21 +7,25 @@ module Instana.SDK.Span.Span ( Span (Entry, Exit) , SpanKind (EntryKind, ExitKind, IntermediateKind) - , traceId - , spanId - , spanKind - , parentId - , spanName - , timestamp - , errorCount - , addToErrorCount - , serviceName - , setServiceName - , spanData , addRegisteredData , addRegisteredDataAt , addTag , addTagAt + , addToErrorCount + , correlationId + , correlationType + , errorCount + , parentId + , serviceName + , setCorrelationId + , setCorrelationType + , setServiceName + , spanData + , spanId + , spanKind + , spanName + , timestamp + , traceId ) where @@ -139,6 +143,44 @@ Entry $ EntrySpan.setServiceName serviceName_ entry Exit exit -> Exit $ ExitSpan.setServiceName serviceName_ exit + + +-- |The website monitoring correlation type. +correlationType :: Span -> Maybe Text +correlationType span_ = + case span_ of + Entry entry -> EntrySpan.correlationType entry + Exit _ -> Nothing + + +-- |Set the website monitoring correlation type. This should only be set on +-- root entry spans. It will be silently ignored for other types of spans. +setCorrelationType :: Text -> Span -> Span +setCorrelationType correlationType_ span_ = + case span_ of + Entry entry -> + Entry $ EntrySpan.setCorrelationType correlationType_ entry + Exit _ -> + span_ + + +-- |The website monitoring correlation ID. +correlationId :: Span -> Maybe Text +correlationId span_ = + case span_ of + Entry entry -> EntrySpan.correlationId entry + Exit _ -> Nothing + + +-- |Set the website monitoring correlation ID. This should only be set on +-- root entry spans. It will be silently ignored for other types of spans. +setCorrelationId :: Text -> Span -> Span +setCorrelationId correlationId_ span_ = + case span_ of + Entry entry -> + Entry $ EntrySpan.setCorrelationId correlationId_ entry + Exit _ -> + span_ -- |Optional additional span data. diff --git a/src/Instana/SDK/TracingHeaders.hs b/src/Instana/SDK/TracingHeaders.hs --- a/src/Instana/SDK/TracingHeaders.hs +++ b/src/Instana/SDK/TracingHeaders.hs @@ -8,7 +8,7 @@ ( TracingHeaders(..) , TracingLevel(..) , levelHeaderName - , maybeStringToTracingLevel + , parseXInstanaL , spanIdHeaderName , stringToTracingLevel , traceIdHeaderName @@ -18,6 +18,7 @@ import GHC.Generics import qualified Network.HTTP.Types.Header as HTTPHeader +import Text.Regex.PCRE ((=~)) -- |X-INSTANA-T @@ -50,12 +51,39 @@ if s == "0" then Suppress else Trace --- |Converts a string into the tracing level. -maybeStringToTracingLevel :: Maybe String -> TracingLevel -maybeStringToTracingLevel s = - if s == Just "0" then Suppress else Trace +-- |Parses the X-INSTANA-L value to determine the tracing level, and optionally +-- the correlation type and correlation ID. +parseXInstanaL :: Maybe String -> (TracingLevel, Maybe String, Maybe String) +parseXInstanaL xInstanaLValueMaybe = + case xInstanaLValueMaybe of + Nothing -> + (Trace, Nothing, Nothing) + Just xInstanaLValue -> + let + (_, _, _, groups) = + xInstanaLValue =~ xInstanaLRegex :: (String, String, String, [String]) + in + case groups of + [] -> + (Trace, Nothing, Nothing) + ["", "", ""] -> + (Trace, Nothing, Nothing) + ["0", _, _] -> + (Suppress, Nothing, Nothing) + ["1", "", ""] -> + (Trace, Nothing, Nothing) + ["1", _correlationType, _correlationId] -> + (Trace, Just _correlationType, Just _correlationId) + _ -> + (Trace, Nothing, Nothing) +xInstanaLRegex :: String +xInstanaLRegex = + -- example "1,correlationType=web;correlationId=1234567890abcdef" + "^\\s*([01])\\s*(?:,\\s*correlationType\\s*=\\s*([^ ;]*)\\s*;\\s*correlationId\\s*=\\s*([^ ;]*)\\s*)?$" + + -- |Converts tracing level into a string. tracingLevelToString :: TracingLevel -> String tracingLevelToString l = @@ -69,10 +97,14 @@ TracingHeaders { -- |the trace ID - traceId :: Maybe String + traceId :: Maybe String -- |the span ID - , spanId :: Maybe String + , spanId :: Maybe String -- |the tracing level (on/off) - , level :: TracingLevel + , level :: TracingLevel + -- |eum correlation type + , correlationType :: Maybe String + -- |eum correlation ID + , correlationId :: Maybe String } deriving (Eq, Generic, Show) diff --git a/src/Instana/Wai/Middleware/Entry.hs b/src/Instana/Wai/Middleware/Entry.hs --- a/src/Instana/Wai/Middleware/Entry.hs +++ b/src/Instana/Wai/Middleware/Entry.hs @@ -3,7 +3,10 @@ Description : WAI Instana Tracing Middleware Automatically creates entry spans for all incoming HTTP requests in a WAI -application. Note that exit spans still need to be created manually via the +application. It will also add (or append to) the HTTP respons header +(Server-Timing) that is used for website monitoring back end correlation. + +Note that exit spans still need to be created manually via the withExit or startExit/stopExit functions. == Example diff --git a/src/Instana/Wai/Middleware/Entry/Internal.hs b/src/Instana/Wai/Middleware/Entry/Internal.hs --- a/src/Instana/Wai/Middleware/Entry/Internal.hs +++ b/src/Instana/Wai/Middleware/Entry/Internal.hs @@ -10,14 +10,32 @@ ) where -import Network.Wai (Application) +import Instana.SDK.Internal.Id (Id) +import qualified Instana.SDK.Internal.ServerTiming as ServerTiming +import Network.Wai (Middleware, Response) +import qualified Network.Wai as Wai -import Instana.SDK.SDK (InstanaContext, withHttpEntry) +import Instana.SDK.SDK (InstanaContext, + currentTraceId, + withHttpEntry) --- |Run the tracing middleware given an initialized Instana SDK context. -traceHttpEntries :: InstanaContext -> Application -> Application +{-| Run the tracing middleware given an initialized Instana SDK context. The +middleware will create entry spans automatically. It will also add (or append +to) the HTTP respons header (Server-Timing) that is used for website monitoring +back end correlation. +-} +traceHttpEntries :: InstanaContext -> Middleware traceHttpEntries instana app request respond = do - withHttpEntry instana request $ - app request respond + withHttpEntry instana request $ do + traceIdMaybe <- currentTraceId instana + case traceIdMaybe of + Just traceId -> + app request $ respond . addHeader traceId + Nothing -> + app request respond + +addHeader :: Id -> Response -> Response +addHeader traceId = + Wai.mapResponseHeaders $ ServerTiming.addTraceIdToServerTiming traceId 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 @@ -326,23 +326,25 @@ -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived -httpBracketApi instana httpManager requestIn respond = - InstanaSDK.withHttpEntry instana requestIn $ do - requestOut <- - HTTP.parseUrlThrow $ - "http://127.0.0.1:1302/?some=query¶meters=2&pass=secret" - _ <- InstanaSDK.withHttpExit - instana - requestOut - (\req -> do - _ <- HTTP.httpLbs req httpManager - threadDelay $ 1000 -- make sure there is a duration > 0 - ) - respond $ - Wai.responseBuilder - HTTPTypes.status200 - [("Content-Type", "application/json; charset=UTF-8")] - "{\"response\": \"ok\"}" +httpBracketApi instana httpManager requestIn respond = do + response <- do + InstanaSDK.withCorrelatedHttpEntry instana requestIn $ do + requestOut <- + HTTP.parseUrlThrow $ + "http://127.0.0.1:1302/?some=query¶meters=2&pass=secret" + _ <- InstanaSDK.withHttpExit + instana + requestOut + (\req -> do + _ <- HTTP.httpLbs req httpManager + threadDelay $ 1000 -- make sure there is a duration > 0 + ) + return $ + Wai.responseBuilder + HTTPTypes.status200 + [("Content-Type", "application/json; charset=UTF-8")] + "{\"response\": \"ok\"}" + respond response httpLowLevelApi :: @@ -360,11 +362,14 @@ _ <- HTTP.httpLbs requestOut' httpManager threadDelay $ 1000 -- make sure there is a duration > 0 InstanaSDK.completeExit instana - result <- respond $ - Wai.responseBuilder - HTTPTypes.status200 - [("Content-Type", "application/json; charset=UTF-8")] - "{\"response\": \"ok\"}" + let + response = + Wai.responseBuilder + HTTPTypes.status200 + [("Content-Type", "application/json; charset=UTF-8")] + "{\"response\": \"ok\"}" + response' <- InstanaSDK.addWebsiteMonitoringBackEndCorrelation instana response + result <- respond response' InstanaSDK.completeEntry instana return result 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,9 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module Instana.SDK.IntegrationTest.HttpTracing ( shouldCreateRootEntryWithBracketApi + , shouldAddWebsiteMonitoringCorrelationWithBracketApi , shouldCreateNonRootEntryWithBracketApi , shouldSuppressWithBracketApi , shouldCreateRootEntryWithLowLevelApi + , shouldAddWebsiteMonitoringCorrelationWithLowLevelApi , shouldCreateNonRootEntryWithLowLevelApi , shouldSuppressWithLowLevelApi ) where @@ -12,9 +14,10 @@ import Control.Concurrent (threadDelay) import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Char8 as BSC8 import qualified Data.ByteString.Lazy.Char8 as LBSC8 import qualified Data.List as List -import Data.Maybe (isNothing) +import Data.Maybe (isNothing, listToMaybe) import Instana.SDK.AgentStub.TraceRequest (From (..), Span) import qualified Instana.SDK.AgentStub.TraceRequest as TraceRequest import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper @@ -23,15 +26,28 @@ import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper import qualified Network.HTTP.Client as HTTP import Network.HTTP.Types (Header) +import qualified Network.HTTP.Types.Header import Test.HUnit shouldCreateRootEntryWithBracketApi :: String -> IO Test shouldCreateRootEntryWithBracketApi pid = applyLabel "shouldCreateRootEntryWithBracketApi" $ - runBracketTest pid [] (applyConcat [rootEntryAsserts, bracketAsserts]) + runBracketTest + pid + [] + (applyConcat [rootEntryAsserts, bracketAsserts]) +shouldAddWebsiteMonitoringCorrelationWithBracketApi :: String -> IO Test +shouldAddWebsiteMonitoringCorrelationWithBracketApi pid = + applyLabel "shouldAddWebsiteMonitoringCorrelationWithBracketApi" $ + runBracketTest + pid + [("X-INSTANA-L", "1,correlationType=web;correlationId=1234567890abcdef")] + (applyConcat [rootEntryAsserts, bracketAsserts, correlationAsserts]) + + shouldCreateNonRootEntryWithBracketApi :: String -> IO Test shouldCreateNonRootEntryWithBracketApi pid = applyLabel "shouldCreateNonRootEntryWithBracketApi" $ do @@ -52,9 +68,21 @@ shouldCreateRootEntryWithLowLevelApi :: String -> IO Test shouldCreateRootEntryWithLowLevelApi pid = applyLabel "shouldCreateRootEntryWithLowLevelApi" $ - runLowLevelTest pid [] (applyConcat [rootEntryAsserts, lowLevelAsserts]) + runLowLevelTest + pid + [] + (applyConcat [rootEntryAsserts, lowLevelAsserts]) +shouldAddWebsiteMonitoringCorrelationWithLowLevelApi :: String -> IO Test +shouldAddWebsiteMonitoringCorrelationWithLowLevelApi pid = + applyLabel "shouldAddWebsiteMonitoringCorrelationWithLowLevelApi" $ + runLowLevelTest + pid + [("X-INSTANA-L", "1,correlationType=web;correlationId=1234567890abcdef")] + (applyConcat [rootEntryAsserts, lowLevelAsserts, correlationAsserts]) + + shouldCreateNonRootEntryWithLowLevelApi :: String -> IO Test shouldCreateNonRootEntryWithLowLevelApi pid = applyLabel "shouldCreateNonRootEntryWithLowLevelApi" $ do @@ -89,6 +117,15 @@ let result = LBSC8.unpack $ HTTP.responseBody response from = Just $ From pid "agent-stub-id" + responseHeaders = HTTP.responseHeaders response + serverTimingTuple :: Maybe (Network.HTTP.Types.Header.HeaderName, BSC8.ByteString) + serverTimingTuple = + listToMaybe $ + filter + (\ (headerName, _) -> headerName == "Server-Timing") + responseHeaders + serverTimingValue = BSC8.unpack <$> (snd <$> serverTimingTuple) + spansResults <- TestHelper.waitForRegisteredSpansMatching [ "haskell.wai.server", "haskell.http.client" ] @@ -109,7 +146,7 @@ Just entrySpan = maybeEntrySpan Just exitSpan = maybeExitSpan assertAllIO $ - (commonAsserts entrySpan exitSpan result from) ++ + (commonAsserts entrySpan exitSpan result from serverTimingValue) ++ (extraAsserts entrySpan) @@ -158,12 +195,21 @@ ] -commonAsserts :: Span -> Span -> String -> Maybe From -> [Assertion] -commonAsserts entrySpan exitSpan result from = +commonAsserts :: + Span + -> Span + -> String + -> Maybe From + -> Maybe String + -> [Assertion] +commonAsserts entrySpan exitSpan result from serverTimingValue = [ assertEqual "result" "{\"response\": \"ok\"}" result , assertEqual "trace ID is consistent" (TraceRequest.t exitSpan) (TraceRequest.t entrySpan) + , assertEqual "Server-Timing header with trace ID is present" + (Just $ "intid;desc=" ++ (TraceRequest.t entrySpan)) + (serverTimingValue) , assertEqual "exit parent ID" (Just $ TraceRequest.s entrySpan) (TraceRequest.p exitSpan) @@ -189,6 +235,17 @@ ] ) (TraceRequest.spanData exitSpan) + ] + + +correlationAsserts :: Span -> [Assertion] +correlationAsserts entrySpan = + [ assertEqual "entry correlation type" + (Just "web") + (TraceRequest.crtp entrySpan) + , assertEqual "entry correlation ID" + (Just "1234567890abcdef") + (TraceRequest.crid 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.4.0.0" + "0.5.0.0" (EntityDataRequest.sensorVersion entityData) , assertCounterSatisfies "startTime" 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 @@ -125,8 +125,10 @@ , Suite.tests = (\pid -> [ HttpTracing.shouldCreateRootEntryWithBracketApi pid , HttpTracing.shouldCreateNonRootEntryWithBracketApi pid + , HttpTracing.shouldAddWebsiteMonitoringCorrelationWithBracketApi pid , HttpTracing.shouldSuppressWithBracketApi , HttpTracing.shouldCreateRootEntryWithLowLevelApi pid + , HttpTracing.shouldAddWebsiteMonitoringCorrelationWithLowLevelApi pid , HttpTracing.shouldCreateNonRootEntryWithLowLevelApi pid , HttpTracing.shouldSuppressWithLowLevelApi ]) @@ -142,6 +144,7 @@ , Suite.tests = (\pid -> [ WaiMiddleware.shouldCreateRootEntry pid , WaiMiddleware.shouldCreateNonRootEntry pid + , WaiMiddleware.shouldAddWebsiteMonitoringCorrelation pid , WaiMiddleware.shouldSuppress ]) , Suite.options = 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 @@ -2,6 +2,7 @@ module Instana.SDK.IntegrationTest.WaiMiddleware ( shouldCreateRootEntry , shouldCreateNonRootEntry + , shouldAddWebsiteMonitoringCorrelation , shouldSuppress ) where @@ -9,9 +10,10 @@ import Control.Concurrent (threadDelay) import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Char8 as BSC8 import qualified Data.ByteString.Lazy.Char8 as LBSC8 import qualified Data.List as List -import Data.Maybe (isNothing) +import Data.Maybe (isNothing, listToMaybe) import Instana.SDK.AgentStub.TraceRequest (From (..), Span) import qualified Instana.SDK.AgentStub.TraceRequest as TraceRequest import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper @@ -20,6 +22,7 @@ import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper import qualified Network.HTTP.Client as HTTP import Network.HTTP.Types (Header) +import qualified Network.HTTP.Types.Header import Test.HUnit @@ -40,6 +43,15 @@ (applyConcat [nonRootEntryAsserts, asserts]) +shouldAddWebsiteMonitoringCorrelation :: String -> IO Test +shouldAddWebsiteMonitoringCorrelation pid = + applyLabel "shouldAddWebsiteMonitoringCorrelation" $ + runMiddlewareTest + pid + [("X-INSTANA-L", " 1 , correlationType = web ; correlationId = 1234567890abcdef ")] + (applyConcat [rootEntryAsserts, asserts, correlationAsserts]) + + shouldSuppress :: IO Test shouldSuppress = applyLabel "shouldSuppress" $ do @@ -58,6 +70,15 @@ let result = LBSC8.unpack $ HTTP.responseBody response from = Just $ From pid "agent-stub-id" + responseHeaders = HTTP.responseHeaders response + serverTimingTuple :: Maybe (Network.HTTP.Types.Header.HeaderName, BSC8.ByteString) + serverTimingTuple = + listToMaybe $ + filter + (\ (headerName, _) -> headerName == "Server-Timing") + responseHeaders + serverTimingValue = BSC8.unpack <$> (snd <$> serverTimingTuple) + spansResults <- TestHelper.waitForRegisteredSpansMatching [ "haskell.wai.server", "haskell.http.client" ] @@ -78,7 +99,7 @@ Just entrySpan = maybeEntrySpan Just exitSpan = maybeExitSpan assertAllIO $ - (commonAsserts entrySpan exitSpan result from) ++ + (commonAsserts entrySpan exitSpan result from serverTimingValue) ++ (extraAsserts entrySpan) @@ -127,12 +148,21 @@ ] -commonAsserts :: Span -> Span -> String -> Maybe From -> [Assertion] -commonAsserts entrySpan exitSpan result from = +commonAsserts :: + Span + -> Span + -> String + -> Maybe From + -> Maybe String + -> [Assertion] +commonAsserts entrySpan exitSpan result from serverTimingValue = [ assertEqual "result" "{\"response\": \"ok\"}" result , assertEqual "trace ID is consistent" (TraceRequest.t exitSpan) (TraceRequest.t entrySpan) + , assertEqual "Server-Timing header with trace ID is present" + (Just $ "intid;desc=" ++ (TraceRequest.t entrySpan)) + (serverTimingValue) , assertEqual "exit parent ID" (Just $ TraceRequest.s entrySpan) (TraceRequest.p exitSpan) @@ -175,6 +205,17 @@ ] ) (TraceRequest.spanData entrySpan) + ] + + +correlationAsserts :: Span -> [Assertion] +correlationAsserts entrySpan = + [ assertEqual "entry correlation type" + (Just "web") + (TraceRequest.crtp entrySpan) + , assertEqual "entry correlation ID" + (Just "1234567890abcdef") + (TraceRequest.crid entrySpan) ] diff --git a/test/shared/Instana/SDK/AgentStub/TraceRequest.hs b/test/shared/Instana/SDK/AgentStub/TraceRequest.hs --- a/test/shared/Instana/SDK/AgentStub/TraceRequest.hs +++ b/test/shared/Instana/SDK/AgentStub/TraceRequest.hs @@ -47,6 +47,8 @@ , d :: Int -- duration , k :: Int -- kind , ec :: Int -- errorCount + , crtp :: Maybe String -- correlation type + , crid :: Maybe String -- correlation id , spanData :: Aeson.Value -- spanData , f :: Maybe From -- from } deriving (Eq, Show, Generic) @@ -64,6 +66,8 @@ <*> decodedObject .: "d" <*> decodedObject .: "k" <*> decodedObject .: "ec" + <*> decodedObject .: "crtp" + <*> decodedObject .: "crid" <*> decodedObject .: "data" <*> decodedObject .: "f" @@ -78,6 +82,8 @@ , "d" .= d sp , "k" .= k sp , "ec" .= ec sp + , "crtp" .= crtp sp + , "crid" .= crid sp , "data" .= spanData sp , "f" .= f sp ] diff --git a/test/unit/Instana/SDK/Internal/ServerTimingTest.hs b/test/unit/Instana/SDK/Internal/ServerTimingTest.hs new file mode 100644 --- /dev/null +++ b/test/unit/Instana/SDK/Internal/ServerTimingTest.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Instana.SDK.Internal.ServerTimingTest (allTests) where + +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as BSC8 +import qualified Network.HTTP.Types as HTTP +import Test.HUnit + +import qualified Instana.SDK.Internal.Id as Id +import qualified Instana.SDK.Internal.ServerTiming as ServerTiming + + +allTests :: Test +allTests = + TestList + [ TestLabel "shouldAddToEmptyHeaders" shouldAddToEmptyHeaders + , TestLabel "shouldAddToNonEmptyHeaders" shouldAddToNonEmptyHeaders + , TestLabel + "shouldAppendToExistingServerTiming" + shouldAppendToExistingServerTiming + , TestLabel + "shouldAppendToExistingServerTimingAnotherHeaderPresent" + shouldAppendToExistingServerTimingAnotherHeaderPresent + , TestLabel + "shouldReplaceExistingInTIdAtStart" + shouldReplaceExistingInTIdAtStart + , TestLabel + "shouldReplaceExistingInTIdInTheMiddle" + shouldReplaceExistingInTIdInTheMiddle + , TestLabel + "shouldReplaceExistingInTIdAtTheEnd" + shouldReplaceExistingInTIdAtTheEnd + ] + + +shouldAddToEmptyHeaders :: Test +shouldAddToEmptyHeaders = + checkHeader + "add to empty headers" + "trace-id" + [] + (BSC8.pack "intid;desc=trace-id") + 1 + + +shouldAddToNonEmptyHeaders :: Test +shouldAddToNonEmptyHeaders = + checkHeader + "add to non empty headers without existing Server-Timing" + "trace-id" + [("Content-Type", "text/plain")] + (BSC8.pack "intid;desc=trace-id") + 2 + + +shouldAppendToExistingServerTiming :: Test +shouldAppendToExistingServerTiming = + checkHeader + "append to existing Server-Timing" + "trace-id" + [("Server-Timing", "foo;dur=23.2")] + (BSC8.pack "foo;dur=23.2, intid;desc=trace-id") + 1 + + +shouldAppendToExistingServerTimingAnotherHeaderPresent :: Test +shouldAppendToExistingServerTimingAnotherHeaderPresent = + checkHeader + "append to existing Server-Timing (with another header being present)" + "trace-id" + [("Content-Type", "text/plain"), ("Server-Timing", "foo;dur=23.2")] + (BSC8.pack "foo;dur=23.2, intid;desc=trace-id") + 2 + + +shouldReplaceExistingInTIdAtStart :: Test +shouldReplaceExistingInTIdAtStart = + checkHeader + "replace existing intid metric at the start of the Server-Timing value" + "trace-id" + [ + ("Server-Timing", "intid;desc=other-trace-id, foo;dur=23.2, bar;dur=1302"), + ("Content-Type", "text/plain") + ] + (BSC8.pack "intid;desc=trace-id, foo;dur=23.2, bar;dur=1302") + 2 + + +shouldReplaceExistingInTIdInTheMiddle :: Test +shouldReplaceExistingInTIdInTheMiddle = + checkHeader + "replace existing intid metric in the middle of the Server-Timing value" + "trace-id" + [ + ("Server-Timing", "foo;dur=23.2, intid;desc=other-trace-id, bar;dur=1302"), + ("Content-Type", "text/plain") + ] + (BSC8.pack "foo;dur=23.2, intid;desc=trace-id, bar;dur=1302") + 2 + + +shouldReplaceExistingInTIdAtTheEnd :: Test +shouldReplaceExistingInTIdAtTheEnd = + checkHeader + "replace existing intid metric at the end of the Server-Timing value" + "trace-id" + [ + ("Server-Timing", "foo;dur=23.2, bar;dur=1302, intid;desc=other-trace-id"), + ("Content-Type", "text/plain") + ] + (BSC8.pack "foo;dur=23.2, bar;dur=1302, intid;desc=trace-id") + 2 + + +checkHeader :: + String + -> String + -> HTTP.ResponseHeaders + -> ByteString + -> Int + -> Test +checkHeader label traceId originalHeaders expected numberOfExpectedHeaders = + let + resultingHeaders = + ServerTiming.addTraceIdToServerTiming + (Id.fromString traceId) + originalHeaders + actual = lookup "Server-Timing" resultingHeaders + justExpected = Just expected + in + TestCase $ do + assertEqual + label + justExpected + actual + assertEqual + label + numberOfExpectedHeaders + (length resultingHeaders) + 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 @@ -293,12 +293,14 @@ entrySpan = RootEntrySpan $ RootEntry - { RootEntry.spanAndTraceId = Id.fromString "traceId" - , RootEntry.spanName = "test.entry" - , RootEntry.timestamp = 1514761200000 - , RootEntry.errorCount = 0 - , RootEntry.serviceName = Nothing - , RootEntry.spanData = emptyValue + { RootEntry.spanAndTraceId = Id.fromString "traceId" + , RootEntry.spanName = "test.entry" + , RootEntry.timestamp = 1514761200000 + , RootEntry.errorCount = 0 + , RootEntry.serviceName = Nothing + , RootEntry.correlationType = Nothing + , RootEntry.correlationId = Nothing + , RootEntry.spanData = emptyValue } diff --git a/test/unit/Instana/SDK/Internal/SpanTest.hs b/test/unit/Instana/SDK/Internal/SpanTest.hs --- a/test/unit/Instana/SDK/Internal/SpanTest.hs +++ b/test/unit/Instana/SDK/Internal/SpanTest.hs @@ -224,12 +224,14 @@ Entry $ RootEntrySpan $ RootEntry - { RootEntry.spanAndTraceId = Id.fromString "traceId" - , RootEntry.spanName = "test.entry" - , RootEntry.timestamp = 1514761200000 - , RootEntry.serviceName = Nothing - , RootEntry.errorCount = 0 - , RootEntry.spanData = initialData + { RootEntry.spanAndTraceId = Id.fromString "traceId" + , RootEntry.spanName = "test.entry" + , RootEntry.timestamp = 1514761200000 + , RootEntry.errorCount = 0 + , RootEntry.serviceName = Nothing + , RootEntry.correlationType = Nothing + , RootEntry.correlationId = Nothing + , RootEntry.spanData = initialData } diff --git a/test/unit/Instana/SDK/TracingHeadersTest.hs b/test/unit/Instana/SDK/TracingHeadersTest.hs new file mode 100644 --- /dev/null +++ b/test/unit/Instana/SDK/TracingHeadersTest.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Instana.SDK.TracingHeadersTest (allTests) where + + +import Test.HUnit + +import Instana.SDK.TracingHeaders (TracingLevel (..)) +import qualified Instana.SDK.TracingHeaders as TracingHeaders + + +allTests :: Test +allTests = + TestList + [ TestLabel + "shouldParseNonExistingXInstanaL" + shouldParseNonExistingXInstanaL + , TestLabel "shouldParseXInstanaL1" shouldParseXInstanaL1 + , TestLabel "shouldParseXInstanaL1Untrimmed" shouldParseXInstanaL1Untrimmed + , TestLabel "shouldParseXInstanaL0" shouldParseXInstanaL0 + , TestLabel "shouldParseXInstanaL0Untrimmed" shouldParseXInstanaL0Untrimmed + , TestLabel + "shouldParseXInstanaL0AndIgnoreCorrelation" + shouldParseXInstanaL0AndIgnoreCorrelation + , TestLabel + "shouldParseXInstanaL1WithCorrelation" + shouldParseXInstanaL1WithCorrelation + , TestLabel + "shouldParseXInstanaL1WithOddlyFormattedCorrelation" + shouldParseXInstanaL1WithOddlyFormattedCorrelation + ] + + +shouldParseNonExistingXInstanaL :: Test +shouldParseNonExistingXInstanaL = + let + (level, correlationType, correlationId) = + TracingHeaders.parseXInstanaL Nothing + in + TestCase $ do + assertEqual "level" level Trace + assertEqual "correlation type" Nothing correlationType + assertEqual "correlation ID" Nothing correlationId + + +shouldParseXInstanaL1 :: Test +shouldParseXInstanaL1 = + let + (level, correlationType, correlationId) = + TracingHeaders.parseXInstanaL $ Just "1" + in + TestCase $ do + assertEqual "level" level Trace + assertEqual "correlation type" Nothing correlationType + assertEqual "correlation ID" Nothing correlationId + + +shouldParseXInstanaL1Untrimmed :: Test +shouldParseXInstanaL1Untrimmed = + let + (level, correlationType, correlationId) = + TracingHeaders.parseXInstanaL $ Just " 1 " + in + TestCase $ do + assertEqual "level" level Trace + assertEqual "correlation type" Nothing correlationType + assertEqual "correlation ID" Nothing correlationId + + +shouldParseXInstanaL0 :: Test +shouldParseXInstanaL0 = + let + (level, correlationType, correlationId) = + TracingHeaders.parseXInstanaL $ Just "0" + in + TestCase $ do + assertEqual "level" level Suppress + assertEqual "correlation type" Nothing correlationType + assertEqual "correlation ID" Nothing correlationId + + +shouldParseXInstanaL0Untrimmed :: Test +shouldParseXInstanaL0Untrimmed = + let + (level, correlationType, correlationId) = + TracingHeaders.parseXInstanaL $ Just " 0 " + in + TestCase $ do + assertEqual "level" level Suppress + assertEqual "correlation type" Nothing correlationType + assertEqual "correlation ID" Nothing correlationId + + +shouldParseXInstanaL0AndIgnoreCorrelation :: Test +shouldParseXInstanaL0AndIgnoreCorrelation = + let + (level, correlationType, correlationId) = + TracingHeaders.parseXInstanaL $ Just " 0 , correlationType=web; correlationId=1234567890abcdef" + in + TestCase $ do + assertEqual "level" level Suppress + assertEqual "correlation type" Nothing correlationType + assertEqual "correlation ID" Nothing correlationId + + +shouldParseXInstanaL1WithCorrelation :: Test +shouldParseXInstanaL1WithCorrelation = + let + (level, correlationType, correlationId) = + TracingHeaders.parseXInstanaL $ Just "1,correlationType=web;correlationId=1234567890abcdef" + in + TestCase $ do + assertEqual "level" level Trace + assertEqual "correlation type" (Just "web") correlationType + assertEqual "correlation ID" (Just "1234567890abcdef") correlationId + + +shouldParseXInstanaL1WithOddlyFormattedCorrelation :: Test +shouldParseXInstanaL1WithOddlyFormattedCorrelation = + let + (level, correlationType, correlationId) = + TracingHeaders.parseXInstanaL $ Just " 1 , correlationType = web ; correlationId = 1234567890abcdef" + in + TestCase $ do + assertEqual "level" level Trace + assertEqual "correlation type" (Just "web") correlationType + assertEqual "correlation ID" (Just "1234567890abcdef") correlationId + + diff --git a/test/unit/Main.hs b/test/unit/Main.hs --- a/test/unit/Main.hs +++ b/test/unit/Main.hs @@ -8,8 +8,10 @@ import qualified Instana.SDK.Internal.Metrics.CompressionTest as MetricsCompressionTest import qualified Instana.SDK.Internal.Metrics.DeltasTest as MetricsDeltasTest 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.TracingHeadersTest as TracingHeadersTest import Test.HUnit @@ -27,9 +29,11 @@ , LoggingTest.allTests , MetricsCompressionTest.allTests , MetricsDeltasTest.allTests + , SchedFileTest.allTests , SecretsTest.allTests - , SpanTest.allTests + , ServerTimingTest.allTests , SpanStackTest.allTests - , SchedFileTest.allTests + , SpanTest.allTests + , TracingHeadersTest.allTests ]