diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,59 @@
+# Changelog for instana-haskell-trace-sdk
+
+## 0.6.0.0
+- Fix: Pass span ID of exit span downstream with X-INSTANA-S instead of the entry span's span ID.
+- Fix: Capture HTTP status code in `withHttpEntry` (formely `withCorrelatedHttpEntry`).
+- Breaking: Rename `Instana.SDK.SDK.withCorrelatedHttpEntry` to `withHttpEntry`. The motivation is that this function should be used by client code in almost all cases, so its name should suggest itself as the obvious choice for tracing HTTP entry spans.
+- Breaking: Rename `Instana.SDK.SDK.withHttpEntry` to `withHttpEntry_`. See above.
+- Breaking: Rename `Instana.SDK.SDK.currentTraceId` (with return type `Instana.SDK.Internal.Id.Id`) to `currentTraceIdInternal`. The function `Instana.SDK.SDK.currentTraceId` returns type `String` now.
+- Provide `Instana.SDK.SDK.postProcessHttpRespons` for cases where `withHttpEntry_` needs to be used instead of `withHttpEntry`.
+- Provide new convenience accessors `Instana.SDK.SDK`:
+ - `currentSpan` (provides the currently active span in a simplified format),
+ - `currentTraceId` (provides the trace ID of the currently active trace),
+ - `currentSpanId` (provides the span ID of the currently active span), and
+ - `currentParentId` (provides the parent ID of the currently active span).
+- Remove deprecated attribute `span.ta`.
+
+## 0.5.0.1
+- No changes, only documentation updates.
+
+## 0.5.0.0
+- 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`.
+
+## 0.3.0.0
+- Honor the environment variable `INSTANA_SERVICE_NAME` to override the default service name in Instana.
+- Add a configuration option for overriding the default service name in Instana.
+- Add `InstanaSDK.setServiceName` to override the default service name in Instana on a per-call basis.
+- Fix: Send correct SDK spans. This is a breaking change. Several functions were renamed or have changed their signature.
+In detail:
+
+ - Use `InstanaSDK.addTag` instead of `InstanaSDK.addData` (for SDK
+ spans).
+ - Use `InstanaSDK.addTagAt` instead of `InstanaSDK.addDataAt` (for SDK spans).
+ - For registered spans, replace `InstanaSDK.addData` and `InstanaSDK.addDataAt` with `InstanaSDK.addRegisteredData` and `InstanaSDK.addRegisteredDataAt`. Note that you should probably not create registered spans, but only use SDK spans.
+ - Usages like `startEntry "some.span.name"` or `withEntry "some.span.name"` (that is, the span name is passed directly as a literal) will simply continue to work as expected but will require `OverloadedStrings` to be active.
+ - Usages where the span name is stored in a `Data.Text` value first and then passed to `startEntry`/`withEntry`/etc. will break. You can fix those by importing
+```
+import qualified Instana.SDK.Span.SpanType as SpanType
+```
+and then wrapping the span name in `SpanType.SdkSpan`. For example:
+```
+spanName = T.pack "some.span.name"
+InstanaSDK.withRootEntry instana spanName ...
+```
+becomes:
+```
+spanType = SpanType.SdkSpan $ T.pack "some.span.name"
+InstanaSDK.withRootEntry instana spanType ...
+```
+
+## 0.2.0.0
+- Add WAI middleware plug-in to trace HTTP entries automatically.
+
+## 0.1.0.0
+- Initial release
+
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -59,7 +59,7 @@
Publishing a New Release
------------------------
-* Make sure ChangeLog.md has an entry for the upcoming release.
+* Make sure CHANGELOG.md has an entry for the upcoming release.
* Bump the version in:
* `README.md` (installation instructions/extra-deps)
* `instana-haskell-trace-sdk.cabal`
diff --git a/ChangeLog.md b/ChangeLog.md
deleted file mode 100644
--- a/ChangeLog.md
+++ /dev/null
@@ -1,42 +0,0 @@
-# Changelog for instana-haskell-trace-sdk
-
-## 0.5.0.0
-- 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`.
-
-## 0.3.0.0
-- Honor the environment variable `INSTANA_SERVICE_NAME` to override the default service name in Instana.
-- Add a configuration option for overriding the default service name in Instana.
-- Add `InstanaSDK.setServiceName` to override the default service name in Instana on a per-call basis.
-- Fix: Send correct SDK spans. This is a breaking change. Several functions were renamed or have changed their signature.
-In detail:
-
- - Use `InstanaSDK.addTag` instead of `InstanaSDK.addData` (for SDK
- spans).
- - Use `InstanaSDK.addTagAt` instead of `InstanaSDK.addDataAt` (for SDK spans).
- - For registered spans, replace `InstanaSDK.addData` and `InstanaSDK.addDataAt` with `InstanaSDK.addRegisteredData` and `InstanaSDK.addRegisteredDataAt`. Note that you should probably not create registered spans, but only use SDK spans.
- - Usages like `startEntry "some.span.name"` or `withEntry "some.span.name"` (that is, the span name is passed directly as a literal) will simply continue to work as expected but will require `OverloadedStrings` to be active.
- - Usages where the span name is stored in a `Data.Text` value first and then passed to `startEntry`/`withEntry`/etc. will break. You can fix those by importing
-```
-import qualified Instana.SDK.Span.SpanType as SpanType
-```
-and then wrapping the span name in `SpanType.SdkSpan`. For example:
-```
-spanName = T.pack "some.span.name"
-InstanaSDK.withRootEntry instana spanName ...
-```
-becomes:
-```
-spanType = SpanType.SdkSpan $ T.pack "some.span.name"
-InstanaSDK.withRootEntry instana spanType ...
-```
-
-## 0.2.0.0
-- Add WAI middleware plug-in to trace HTTP entries automatically.
-
-## 0.1.0.0
-- Initial release
-
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -20,7 +20,7 @@
```
extra-deps:
-- instana-haskell-trace-sdk-0.5.0.1
+- instana-haskell-trace-sdk-0.6.0.0
```
Depending on the stack resolver you use, you might also need to add `aeson-extra` to your extra-deps:
@@ -32,6 +32,8 @@
Usage
-----
+Example app: Take a look at the [Monad Shop](https://github.com/instana/monad-shop) To see the Instana Haskell Trace SDK in action.
+
### Initialization
Before using the SDK, you need to initialize it once, usually during application startup.
@@ -140,11 +142,11 @@
* `withRootEntry`: Creates an entry span that is the root of a trace (it has no parent span).
* `withEntry`: Creates an entry span that has a parent span.
-* `withCorrelatedHttpEntry`: A convenience function that examines an incoming HTTP request for Instana tracing headers and creates an entry span. It will automatically add the correct metadata to the span. 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`. You do not need to handle incoming HTTP requests at all when using the Instana WAI middleware plug-in (see above).
-* `withHttpEntry`: A convenience function that examines an incoming HTTP request for Instana tracing headers and creates an entry span. It will automatically add the correct metadata to the span. 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. You do not need to handle incoming HTTP requests at all when using the Instana WAI middleware plug-in (see above).
+* `withHttpEntry`: A convenience function that examines an incoming HTTP request for Instana tracing headers and creates an entry span. It will automatically add the correct metadata to the span. Note that you do not need to handle incoming HTTP requests at all when using the Instana WAI middleware plug-in (see above).
+* `withHttpEntry_`: A variant of `withHttpEntry` with a more general type signature, but less features. It will automatically continue the trace from incoming headers just like `withHttpEntry` does, but it will not capture the status code of the HTTP response or add the response header for website monitoring back end correlation (Server-Timing). It is recommended to use `withHttpEntry` instead of this function, if possible. Alternatively, you can also call `postProcessHttpResponse` inside the `withHttpEntry_` block to cover the two missing features mentioned above. Note that you do not need to handle incoming HTTP requests at all when using the Instana WAI middleware plug-in.
* `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. It will also add HTTP headers to the request to propagate the trace context downstream.
-* `addWebsiteMonitoringBackEndCorrelation`: Adds an additional HTTP response header (`Server-Timing`) to the given HTTP response. This header enables website monitoring back end correlation. In case the response 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.
+* `postProcessHttpResponse`: Processes the response of an HTTP entry. 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`. This function accomplishes two things: It captures the HTTP status code from the response and adds it as an annotation to the currently active span. It also adds an additional HTTP response header (Server-Timing) to the given HTTP response that enables website monitoring back end correlation. Client code should rarely have the need to call this directly. Instead, capture incoming HTTP requests with `withHttpEntry`, which does both of these things automatically.
#### Low Level API/Explicit Start And Complete
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.5.0.1
+version: 0.6.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/
@@ -12,12 +12,13 @@
license-file: LICENSE
build-type: Simple
stability: experimental
-cabal-version: >= 1.10
+cabal-version: 2.0
extra-source-files:
- ChangeLog.md
+ CHANGELOG.md
README.md
CONTRIBUTING.md
+ LICENSE
source-repository head
type: git
@@ -73,6 +74,7 @@
Instana.SDK.Span.ExitSpan
Instana.SDK.Span.NonRootEntry
Instana.SDK.Span.RootEntry
+ Instana.SDK.Span.SimpleSpan
Instana.SDK.Span.Span
Instana.SDK.Span.SpanType
Instana.SDK.TracingHeaders
@@ -106,10 +108,13 @@
Instana.SDK.Internal.Worker
Instana.Wai.Middleware.Entry.Internal
Paths_instana_haskell_trace_sdk
+ autogen-modules:
+ Paths_instana_haskell_trace_sdk
default-language: Haskell2010
executable instana-haskell-example-exe
+ -- scope: private
main-is: Main.hs
hs-source-dirs:
example-app
@@ -184,6 +189,7 @@
Instana.SDK.Internal.Secrets
Instana.SDK.Internal.SpanStack
Instana.SDK.Internal.ServerTiming
+ Instana.SDK.Span.SimpleSpan
Instana.SDK.Span.Span
Instana.SDK.TracingHeaders
-- dependencies of modules under test
@@ -198,6 +204,7 @@
executable instana-haskell-agent-stub
+ -- scope: private
main-is: Main.hs
hs-source-dirs:
test/agent-stub, test/shared
@@ -286,6 +293,7 @@
executable instana-haskell-test-wai-server
+ -- scope: private
main-is: Main.hs
hs-source-dirs:
test/apps/wai
@@ -311,6 +319,7 @@
default-language: Haskell2010
executable instana-haskell-test-wai-with-middleware-server
+ -- scope: private
main-is: Main.hs
hs-source-dirs:
test/apps/wai-with-middleware
@@ -330,6 +339,32 @@
, http-types
, instana-haskell-trace-sdk
, text
+ , unix
+ , wai
+ , warp
+ default-language: Haskell2010
+
+executable downstream-target
+ -- scope: private
+ main-is: Main.hs
+ hs-source-dirs:
+ test/apps/downstream-target
+ if flag(dev)
+ ghc-options:
+ -Wall -Werror -threaded -rtsopts "-with-rtsopts=-T -N "
+ else
+ ghc-options:
+ -Wall -threaded -rtsopts "-with-rtsopts=-T -N "
+ build-depends:
+ base >=4.7 && <5
+ , aeson
+ , binary
+ , bytestring
+ , case-insensitive
+ , containers
+ , hslogger
+ , http-client
+ , http-types
, unix
, wai
, warp
diff --git a/src/Instana/SDK/Internal/AgentConnection/AgentReady.hs b/src/Instana/SDK/Internal/AgentConnection/AgentReady.hs
--- a/src/Instana/SDK/Internal/AgentConnection/AgentReady.hs
+++ b/src/Instana/SDK/Internal/AgentConnection/AgentReady.hs
@@ -131,8 +131,7 @@
STM.atomically $
STM.writeTVar (InternalContext.connectionState context) state
infoM instanaLogger $
- "🎉 agent connection established for process " ++ pidTranslationStr ++
- " 🎉"
+ "Agent connection established for process " ++ pidTranslationStr
return ()
else do
warningM instanaLogger $
diff --git a/src/Instana/SDK/Internal/AgentConnection/ConnectLoop.hs b/src/Instana/SDK/Internal/AgentConnection/ConnectLoop.hs
--- a/src/Instana/SDK/Internal/AgentConnection/ConnectLoop.hs
+++ b/src/Instana/SDK/Internal/AgentConnection/ConnectLoop.hs
@@ -112,6 +112,10 @@
establishAgentConnection context processInfo = do
currentState <- STM.atomically $
STM.readTVar (InternalContext.connectionState context)
+
+ -- debugM instanaLogger $
+ -- "Checking agent connection, current state is " ++ show currentState
+
-- Do nothing if a connection attempt is already in progress or connection has
-- already been established.
if currentState /= Unconnected
@@ -121,7 +125,8 @@
STM.atomically $ STM.writeTVar
(InternalContext.connectionState context)
AgentHostLookup
- debugM instanaLogger $ "agent connection is not up, attempting reconnect"
+ debugM instanaLogger $
+ "Agent connection is not up, attempting (re)connect"
-- Initial status: Unconnected
-- step 1: do agent host looup (retry forever until an agent has
-- been found)
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
@@ -23,6 +23,7 @@
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser)
import qualified Data.ByteString.Char8 as BSC8
+import qualified Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics
@@ -53,6 +54,10 @@
Aeson.String . toText
+instance Data.String.IsString Id where
+ fromString = fromString
+
+
appendAsHex :: Int -> String -> Int -> String
appendAsHex noOfComponents accumulator intValue =
appendPaddedHex accumulator intValue
@@ -90,11 +95,6 @@
floor $ logBase (2 :: Double) $ fromIntegral (maxBound :: Int)
--- |Converts a string into an ID.
-fromString :: String -> Id
-fromString = IdString
-
-
-- |Converts an ID into a String
toString :: Id -> String
toString theId =
@@ -109,6 +109,10 @@
(reverse intComponents)
IdString string ->
string
+
+--- |Converts a string into an ID.
+fromString :: String -> Id
+fromString = IdString
-- |Converts an ID into a Text
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
@@ -136,7 +136,6 @@
, "p" .= parentId span_
, "n" .= spanName span_
, "ts" .= timestamp span_
- , "ta" .= ("haskell" :: String)
, "d" .= duration span_
, "k" .= kind span_
, "ec" .= errorCount span_
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
@@ -306,7 +306,11 @@
_ ->
0
if statusCode == 404
- then
+ then do
+ warningM instanaLogger $
+ "Received HTTP 404 when sending spans to " ++
+ show traceEndpointUrl ++
+ ", resetting connection state to unconnected."
resetToUnconnected context
else do
debugM instanaLogger $ show e
@@ -430,7 +434,11 @@
_ ->
0
if statusCode == 404
- then
+ then do
+ warningM instanaLogger $
+ "Received HTTP 404 when sending metrics to " ++
+ show metricsEndpointUrl ++
+ ", resetting connection state to unconnected."
resetToUnconnected context
else do
debugM instanaLogger $ show e
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
@@ -20,16 +20,23 @@
, addWebsiteMonitoringBackEndCorrelation
, agentHost
, agentPort
+ , captureHttpStatus
, completeEntry
, completeExit
+ , currentSpan
+ , currentParentId
+ , currentSpanId
, currentTraceId
+ , currentTraceIdInternal
, defaultConfig
, forceTransmissionAfter
, forceTransmissionStartingAt
, incrementErrorCount
, initConfiguredInstana
, initInstana
+ , isConnected
, maxBufferedSpans
+ , postProcessHttpResponse
, readHttpTracingHeaders
, serviceName
, setCorrelationId
@@ -41,10 +48,10 @@
, startHttpExit
, startRootEntry
, withConfiguredInstana
- , withCorrelatedHttpEntry
, withEntry
, withExit
, withHttpEntry
+ , withHttpEntry_
, withHttpExit
, withInstana
, withRootEntry
@@ -55,7 +62,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 (join, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Aeson (Value, (.=))
import qualified Data.Aeson as Aeson
@@ -93,13 +100,14 @@
import Instana.SDK.Internal.Util ((|>))
import qualified Instana.SDK.Internal.Worker as Worker
import Instana.SDK.Span.EntrySpan (EntrySpan (..))
-import qualified Instana.SDK.Span.EntrySpan as EntrySpan
import Instana.SDK.Span.ExitSpan (ExitSpan (ExitSpan))
import qualified Instana.SDK.Span.ExitSpan as ExitSpan
import Instana.SDK.Span.NonRootEntry (NonRootEntry (NonRootEntry))
import qualified Instana.SDK.Span.NonRootEntry as NonRootEntry
import Instana.SDK.Span.RootEntry (RootEntry (RootEntry))
import qualified Instana.SDK.Span.RootEntry as RootEntry
+import Instana.SDK.Span.SimpleSpan (SimpleSpan)
+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.SpanType (SpanType (RegisteredSpan))
@@ -222,8 +230,7 @@
-- |Wraps an IO action in 'startRootEntry' and 'completeEntry'. For incoming
--- HTTP requests, prefer 'withCorrelatedHttpEntry' or 'withHttpEntry'
--- instead.
+-- HTTP requests, prefer 'withHttpEntry' instead.
withRootEntry ::
MonadIO m =>
InstanaContext
@@ -238,8 +245,7 @@
-- |Wraps an IO action in 'startEntry' and 'completeEntry'. For incoming HTTP
--- requests, prefer 'withCorrelatedHttpEntry' or 'withHttpEntry'
--- instead.
+-- requests, prefer 'withHttpEntry' instead.
withEntry ::
MonadIO m =>
InstanaContext
@@ -259,13 +265,14 @@
-- 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.
+-- 'completeEntry', depending on the presence or absence of these headers. It
+-- will also capture the response HTTP status (and set the span's error count
+-- if it is 5xx). Finally, it will 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.)
--
--- 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.
+-- This function should be preferred over 'withHttpEntry_'.
--
-- You do not need to handle incoming HTTP requests at all when using the
-- Instana WAI middleware plug-in.
@@ -273,9 +280,36 @@
MonadIO m =>
InstanaContext
-> Wai.Request
+ -> m Wai.Response
+ -> m Wai.Response
+withHttpEntry
+ context
+ request
+ io = do
+ response <- withHttpEntry_ context request $ do
+ io >>= postProcessHttpResponse context
+ return response
+
+
+-- |A variant of 'withHttpEntry' with a more general type signature, but less
+-- features. It will automatically continue the trace from incoming headers just
+-- like withHttpEntry does, but it will not capture the status code of the HTTP
+-- response or add the response header for website monitoring back end
+-- correlation (Server-Timing).
+--
+-- It is recommended to use 'withHttpEntry' instead of this function, if
+-- possible. Alternatively, you can also call 'postProcessHttpResponse' inside
+-- the 'withHttpEntry_' block to cover the two missing features mentioned above.
+--
+-- Note that you do not need to handle incoming HTTP requests at all when using
+-- the Instana WAI middleware plug-in.
+withHttpEntry_ ::
+ MonadIO m =>
+ InstanaContext
+ -> Wai.Request
-> m a
-> m a
-withHttpEntry context request io = do
+withHttpEntry_ context request io = do
let
spanType = (RegisteredSpan SpanType.HaskellWaiServer)
tracingHeaders = readHttpTracingHeaders request
@@ -308,34 +342,6 @@
io
--- |A convenience function that examines the given incoming HTTP 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'.
---
--- You do not need to handle incoming HTTP requests at all when using the
--- Instana WAI middleware plug-in.
-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
@@ -542,31 +548,114 @@
)
+-- |Processes the response of an HTTP entry. 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'.
+--
+-- This function accomplishes two things:
+-- * It captures the HTTP status code from the response and adds it as an
+-- annotation to the currently active span.
+-- * It 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
+-- existing Server-Timing list.
+--
+-- Client code should rarely have the need to call this directly. Instead,
+-- capture incoming HTTP requests with 'withHttpEntry', which does
+-- both of these things automatically.
+postProcessHttpResponse ::
+ MonadIO m =>
+ InstanaContext
+ -> Wai.Response
+ -> m Wai.Response
+postProcessHttpResponse context response = do
+ liftIO $ do
+ response' <- captureHttpStatusUnlifted context response
+ addWebsiteMonitoringBackEndCorrelationUnlifted context response'
+
+
+-- |Captures the status code of the HTTP response and adds it to the currently
+-- active span. If the status code is >= 500, the status message is also
+-- captured. 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
+-- status code automatically and also adds the Server-Timing header for back end
+-- web site monitoring correlation. When not using 'withHttpEntry', the function
+-- 'postProcessHttpResponse' should be preferred over this function, because it
+-- does both (capture the status code and add the Server-Timing header).
+captureHttpStatus ::
+ MonadIO m =>
+ InstanaContext
+ -> Wai.Response
+ -> m Wai.Response
+captureHttpStatus context response = do
+ liftIO $ captureHttpStatusUnlifted context response
+
+
+-- |Captures the status code of the HTTP response and adds it to the currently
+-- active span. If the status code is >= 500, the status message is also
+-- captured.
+captureHttpStatusUnlifted ::
+ InstanaContext
+ -> Wai.Response
+ -> IO Wai.Response
+captureHttpStatusUnlifted context response = do
+ let
+ (HTTPTypes.Status statusCode statusMessage) =
+ Wai.responseStatus response
+ addRegisteredDataAt context "http.status" statusCode
+ when
+ (statusCode >= 500 )
+ (addRegisteredDataAt context "http.message" $
+ BSC8.unpack statusMessage
+ )
+ return response
+
+
-- |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
--- existing Server-Timing list.
+-- existing Server-Timing list. 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 'withCorrelatedHttpEntry', which adds the
--- response header automatically.
+-- capture incoming HTTP requests with 'withHttpEntry', which adds the
+-- response header automatically and also captures the HTTP status code of the
+-- response. When not using 'withHttpEntry', the function
+-- 'postProcessHttpResponse' should be preferred over this function, because
+-- it does both (capture the status code and add the Server-Timing header).
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
+ liftIO $ addWebsiteMonitoringBackEndCorrelationUnlifted context response
+-- |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
+-- existing Server-Timing list.
+addWebsiteMonitoringBackEndCorrelationUnlifted ::
+ InstanaContext
+ -> Wai.Response
+ -> IO Wai.Response
+addWebsiteMonitoringBackEndCorrelationUnlifted context response = do
+ traceIdMaybe <- currentTraceIdInternal context
+ case traceIdMaybe of
+ Nothing -> return response
+ Just traceId ->
+ return $
+ Wai.mapResponseHeaders
+ (ServerTiming.addTraceIdToServerTiming traceId)
+ response
+
+
-- |Creates a preliminary/incomplete exit span, which should later be completed
-- with 'completeExit'.
startExit ::
@@ -633,11 +722,10 @@
-> HTTP.Request
-> m HTTP.Request
startHttpExit context request = do
- request' <- addHttpTracingHeaders context request
let
- originalCheckResponse = HTTP.checkResponse request'
- request'' =
- request'
+ originalCheckResponse = HTTP.checkResponse request
+ request' =
+ request
{ HTTP.checkResponse = (\req res -> do
let
status =
@@ -661,6 +749,7 @@
url = protocol ++ host ++ port ++ path
startExit context (RegisteredSpan SpanType.HaskellHttpClient)
+ request'' <- addHttpTracingHeaders context request'
addRegisteredData
context
(Aeson.object [ "http" .=
@@ -914,27 +1003,42 @@
addHttpTracingHeaders context request =
liftIO $ do
suppressed <- isSuppressed context
- entrySpan <- peekSpan context
+ traceId <- currentTraceIdInternal context
+ spanId <- currentSpanIdInternal context
let
originalHeaders = HTTP.requestHeaders request
updatedRequest =
- case (entrySpan, suppressed) of
- (_, True) ->
+ case (traceId, spanId, suppressed) of
+ (_, _, True) ->
request {
HTTP.requestHeaders =
((TracingHeaders.levelHeaderName, "0") : originalHeaders)
}
- (Just (Entry currentEntrySpan), _) ->
+ (Just tId, Just sId, False) ->
request {
HTTP.requestHeaders =
(originalHeaders ++
- [ (TracingHeaders.traceIdHeaderName, Id.toByteString $
- EntrySpan.traceId currentEntrySpan)
- , (TracingHeaders.spanIdHeaderName, Id.toByteString $
- EntrySpan.spanId currentEntrySpan)
+ [ (TracingHeaders.traceIdHeaderName, Id.toByteString tId)
+ , (TracingHeaders.spanIdHeaderName, Id.toByteString sId)
]
)
}
+ (Just tId, Nothing, False) ->
+ request {
+ HTTP.requestHeaders =
+ (originalHeaders ++
+ [ (TracingHeaders.traceIdHeaderName, Id.toByteString tId)
+ ]
+ )
+ }
+ (Nothing, Just sId, False) ->
+ request {
+ HTTP.requestHeaders =
+ (originalHeaders ++
+ [ (TracingHeaders.spanIdHeaderName, Id.toByteString sId)
+ ]
+ )
+ }
_ ->
request
return updatedRequest
@@ -1013,11 +1117,59 @@
return $ join spanMaybe
--- |Retrieves the trace ID the current thread.
-currentTraceId :: InstanaContext -> IO (Maybe Id)
+-- |Checks whether the SDK has a connection to an Instana agent.
+isConnected :: InstanaContext -> IO Bool
+isConnected =
+ InternalContext.isAgentConnectionEstablished
+
+
+-- |Provides the currently active span in a simple format fit for external use.
+currentSpan :: InstanaContext -> IO (Maybe SimpleSpan)
+currentSpan context = do
+ span_ <- peekSpan context
+ return $ SimpleSpan.convert <$> span_
+
+
+-- |Retrieves the trace ID of the currently active trace in the current thread.
+currentTraceId :: InstanaContext -> IO (Maybe String)
currentTraceId context = do
+ traceIdMaybe <- currentTraceIdInternal context
+ return $ Id.toString <$> traceIdMaybe
+
+
+-- |Retrieves the trace ID of the currently active trace in the current thread.
+currentTraceIdInternal :: InstanaContext -> IO (Maybe Id)
+currentTraceIdInternal context = do
traceIdMaybe <- readFromSpanStack context SpanStack.readTraceId
return $ join traceIdMaybe
+
+
+-- |Retrieves the span ID of the currently active span in the current thread.
+currentSpanId :: InstanaContext -> IO (Maybe String)
+currentSpanId context = do
+ spanIdMaybe <- currentSpanIdInternal context
+ return $ Id.toString <$> spanIdMaybe
+
+
+-- |Retrieves the span ID of the currently active span in the current thread.
+currentSpanIdInternal :: InstanaContext -> IO (Maybe Id)
+currentSpanIdInternal context = do
+ span_ <- peekSpan context
+ return $ Span.spanId <$> span_
+
+
+-- |Retrieves the parent ID of the currently active span in the current thread.
+currentParentId :: InstanaContext -> IO (Maybe String)
+currentParentId context = do
+ parentIdMaybe <- currentParentIdInternal context
+ return $ Id.toString <$> parentIdMaybe
+
+
+-- |Retrieves the parent ID of the currently active span in the current thread.
+currentParentIdInternal :: InstanaContext -> IO (Maybe Id)
+currentParentIdInternal context = do
+ span_ <- peekSpan context
+ return $ join $ Span.parentId <$> span_
-- |Checks if tracing is suppressed for the current thread.
diff --git a/src/Instana/SDK/Span/SimpleSpan.hs b/src/Instana/SDK/Span/SimpleSpan.hs
new file mode 100644
--- /dev/null
+++ b/src/Instana/SDK/Span/SimpleSpan.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Instana.SDK.Span.SimpleSpan
+Description : A representation for spans for external use.
+-}
+module Instana.SDK.Span.SimpleSpan
+ ( SimpleSpan(..)
+ , convert
+ ) where
+
+
+import qualified Data.Aeson as Aeson
+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
+
+
+-- |A representation of the span fit for external use by clients of the SDK.
+data SimpleSpan = SimpleSpan
+ { traceId :: String
+ , spanId :: String
+ , parentId :: Maybe String
+ , spanName :: String
+ , timestamp :: Int
+ , kind :: SpanKind
+ , errorCount :: Int
+ , spanData :: Aeson.Value
+ } deriving (Eq, Generic, Show)
+
+
+-- |Converts the internal span datastructure into the simplified format.
+convert :: Span -> SimpleSpan
+convert span_ =
+ SimpleSpan
+ { traceId = Id.toString $ Span.traceId span_
+ , spanId = Id.toString $ Span.spanId span_
+ , parentId = Id.toString <$> Span.parentId span_
+ , spanName = T.unpack $ Span.spanName span_
+ , timestamp = Span.timestamp span_
+ , kind = Span.spanKind span_
+ , errorCount = Span.errorCount span_
+ , spanData = Span.spanData span_
+ }
+
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,10 @@
) where
-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 Network.Wai (Middleware)
-import Instana.SDK.SDK (InstanaContext,
- currentTraceId,
- withHttpEntry)
+import Instana.SDK.SDK (InstanaContext, postProcessHttpResponse,
+ withHttpEntry_)
{-| Run the tracing middleware given an initialized Instana SDK context. The
@@ -27,15 +23,8 @@
-}
traceHttpEntries :: InstanaContext -> Middleware
traceHttpEntries instana app request respond = do
- withHttpEntry instana request $ do
- traceIdMaybe <- currentTraceId instana
- case traceIdMaybe of
- Just traceId ->
- app request $ respond . addHeader traceId
- Nothing ->
- app request respond
-
+ withHttpEntry_ instana request $ do
+ app request $ \response -> do
+ response' <- postProcessHttpResponse instana response
+ respond $ response'
-addHeader :: Id -> Response -> Response
-addHeader traceId =
- Wai.mapResponseHeaders $ ServerTiming.addTraceIdToServerTiming traceId
diff --git a/test/agent-stub/Instana/SDK/AgentStub/Util.hs b/test/agent-stub/Instana/SDK/AgentStub/Util.hs
--- a/test/agent-stub/Instana/SDK/AgentStub/Util.hs
+++ b/test/agent-stub/Instana/SDK/AgentStub/Util.hs
@@ -23,5 +23,5 @@
-- Simulate connection loss after from 1500ms after server startup until
-- 3500ms seconds after startup.
Config.simulateConnectionLoss config &&
- (now > startupTime + 1500 && now < startupTime + 3500)
+ (now > startupTime + 3000 && now < startupTime + 6000)
diff --git a/test/apps/downstream-target/Main.hs b/test/apps/downstream-target/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/apps/downstream-target/Main.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Aeson as Aeson
+import qualified Data.Binary.Builder as Builder
+import qualified Data.ByteString.Char8 as BSC8
+import qualified Data.ByteString.Lazy.Char8 as LBSC8
+import qualified Data.CaseInsensitive as CaseInsensitive
+import qualified Data.Map as Map
+import qualified Network.HTTP.Client as HTTP
+import qualified Network.HTTP.Types as HTTPTypes
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Handler.Warp as Warp
+import System.Environment (lookupEnv)
+import qualified System.Exit as Exit
+import System.IO (Handle, stdout)
+import System.Log.Formatter
+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 qualified System.Posix.Process as Posix
+import System.Posix.Types (CPid)
+
+
+appLogger :: String
+appLogger = "DownstreamTarget"
+
+
+application :: CPid -> Wai.Application
+application pid request respond = do
+ let
+ route = Wai.pathInfo request
+ method = Wai.requestMethod request
+ case (method, route) of
+ (_, []) ->
+ root respond
+ (_, ["ping"]) ->
+ ping respond pid
+ (_, ["echo"]) ->
+ echoHeaders request respond
+ ("POST", ["shutdown"]) ->
+ shutDown respond
+ _ ->
+ respond404 respond
+
+
+root ::
+ (Wai.Response -> IO Wai.ResponseReceived)
+ -> IO Wai.ResponseReceived
+root respond =
+ respondWithPlainText
+ respond
+ "Downstream Target"
+
+
+ping ::
+ (Wai.Response -> IO Wai.ResponseReceived)
+ -> CPid
+ -> IO Wai.ResponseReceived
+ping respond pid = do
+ respond $
+ Wai.responseLBS HTTPTypes.status200 [] $ LBSC8.pack $ show pid
+
+
+echoHeaders ::
+ Wai.Request
+ -> (Wai.Response -> IO Wai.ResponseReceived)
+ -> IO Wai.ResponseReceived
+echoHeaders request respond = do
+ let
+ headers :: [(HTTPTypes.HeaderName, BSC8.ByteString)]
+ headers = Wai.requestHeaders request
+ mapped :: [(String, String)]
+ mapped =
+ map (
+ \(headerName, value) ->
+ (
+ BSC8.unpack $ CaseInsensitive.original headerName,
+ BSC8.unpack value
+ )
+ ) headers
+ encodedHeaders = Aeson.encode $ Map.fromList mapped
+ respond $
+ Wai.responseLBS
+ HTTPTypes.status200
+ [("Content-Type", "application/json; charset=UTF-8")]
+ encodedHeaders
+
+
+shutDown ::
+ (Wai.Response -> IO Wai.ResponseReceived)
+ -> IO Wai.ResponseReceived
+shutDown respond = do
+ liftIO $ infoM appLogger $ "Downstream target app shutdown requested"
+ _ <-liftIO $ Posix.exitImmediately Exit.ExitSuccess
+ respond $
+ Wai.responseBuilder HTTPTypes.status204 [] Builder.empty
+
+
+respondWithPlainText ::
+ (Wai.Response -> IO Wai.ResponseReceived)
+ -> String
+ -> IO Wai.ResponseReceived
+respondWithPlainText respond content =
+ respond $
+ Wai.responseLBS
+ HTTPTypes.status200
+ [("Content-Type", "text/plain")]
+ (LBSC8.pack content)
+
+
+respond404 ::
+ (Wai.Response -> IO Wai.ResponseReceived)
+ -> IO Wai.ResponseReceived
+respond404 respond =
+ respond $
+ Wai.responseLBS HTTPTypes.status404 [] "not found"
+
+
+main :: IO ()
+main = do
+ initLogging
+ runApp
+
+
+runApp :: IO ()
+runApp = do
+ pid <- Posix.getProcessID
+ let
+ host = "127.0.0.1"
+ port = (1208 :: Int)
+ warpSettings =
+ ((Warp.setPort port) . (Warp.setHost "127.0.0.1")) Warp.defaultSettings
+ infoM appLogger $
+ "Starting downstream target app at " ++ host ++ ":" ++ show port ++
+ " (PID: " ++ show pid ++ ")."
+ Warp.runSettings warpSettings $ application pid
+
+
+initLogging :: IO ()
+initLogging = do
+ logLevelEnvVar <- lookupEnv "APP_LOG_LEVEL"
+ let
+ logLevel =
+ case logLevelEnvVar of
+ Just "DEBUG" -> DEBUG
+ _ -> INFO
+ updateGlobalLogger appLogger $ setLevel logLevel
+ appFileHandler <- fileHandler "downstream-target.log" logLevel
+ appStreamHandler <- streamHandler stdout logLevel
+ let
+ formattedAppFileHandler = withFormatter appFileHandler
+ formattedAppStreamHandler = withFormatter appStreamHandler
+ updateGlobalLogger appLogger $
+ setHandlers [ formattedAppFileHandler ]
+ updateGlobalLogger rootLoggerName $
+ setHandlers [ formattedAppStreamHandler ]
+
+
+withFormatter :: GenericHandler Handle -> GenericHandler Handle
+withFormatter handler = setFormatter handler formatter
+ where
+ timeFormat = "%F %H:%M:%S.%4q %z"
+ formatter = tfLogFormatter timeFormat "{$time $loggername $pid $prio} $msg"
+
+
+initHttpManager :: IO HTTP.Manager
+initHttpManager =
+ HTTP.newManager $
+ HTTP.defaultManagerSettings
+ { HTTP.managerConnCount = 5
+ , HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro $ 5000 * 1000
+ }
+
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
@@ -75,21 +75,22 @@
-> (Wai.Response -> IO Wai.ResponseReceived)
-> IO Wai.ResponseReceived
apiUnderTest instana httpManager _ respond = do
- requestOut <-
+ downstreamRequest <-
HTTP.parseUrlThrow $
- "http://127.0.0.1:1302/?some=query¶meters=2&pass=secret"
- _ <- InstanaSDK.withHttpExit
+ "http://127.0.0.1:1208/echo?some=query¶meters=2&pass=secret"
+ downstreamResponse <- InstanaSDK.withHttpExit
instana
- requestOut
+ downstreamRequest
(\req -> do
- _ <- HTTP.httpLbs req httpManager
+ dowstreamRequest' <- HTTP.httpLbs req httpManager
threadDelay $ 1000 -- make sure there is a duration > 0
+ return dowstreamRequest'
)
respond $
- Wai.responseBuilder
+ Wai.responseLBS
HTTPTypes.status200
[("Content-Type", "application/json; charset=UTF-8")]
- "{\"response\": \"ok\"}"
+ (HTTP.responseBody downstreamResponse)
shutDown ::
@@ -138,13 +139,13 @@
host = "127.0.0.1"
port = (1207 :: Int)
warpSettings =
- ((Warp.setPort 1207) . (Warp.setHost "127.0.0.1")) Warp.defaultSettings
+ ((Warp.setPort port) . (Warp.setHost "127.0.0.1")) Warp.defaultSettings
infoM appLogger $
"Starting Wai/Warp app (/w middleware) at " ++ host ++ ":" ++ show port ++
" (PID: " ++ show pid ++ ")."
let
app = application instana httpManager pid
- appWithMiddleware = InstanaWaiMiddleware.traceHttpEntries instana $ app
+ appWithMiddleware = InstanaWaiMiddleware.traceHttpEntries instana app
Warp.runSettings warpSettings $ appWithMiddleware
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
@@ -328,22 +328,23 @@
-> IO Wai.ResponseReceived
httpBracketApi instana httpManager requestIn respond = do
response <- do
- InstanaSDK.withCorrelatedHttpEntry instana requestIn $ do
- requestOut <-
+ InstanaSDK.withHttpEntry instana requestIn $ do
+ downstreamRequest <-
HTTP.parseUrlThrow $
- "http://127.0.0.1:1302/?some=query¶meters=2&pass=secret"
- _ <- InstanaSDK.withHttpExit
+ "http://127.0.0.1:1208/echo?some=query¶meters=2&pass=secret"
+ downstreamResponse <- InstanaSDK.withHttpExit
instana
- requestOut
+ downstreamRequest
(\req -> do
- _ <- HTTP.httpLbs req httpManager
+ downstreamRespone' <- HTTP.httpLbs req httpManager
threadDelay $ 1000 -- make sure there is a duration > 0
+ return downstreamRespone'
)
return $
- Wai.responseBuilder
+ Wai.responseLBS
HTTPTypes.status200
[("Content-Type", "application/json; charset=UTF-8")]
- "{\"response\": \"ok\"}"
+ (HTTP.responseBody downstreamResponse)
respond response
@@ -355,20 +356,21 @@
-> IO Wai.ResponseReceived
httpLowLevelApi instana httpManager requestIn respond = do
InstanaSDK.startHttpEntry instana requestIn
- requestOut <-
+ downstreamRequest <-
HTTP.parseUrlThrow $
- "http://127.0.0.1:1302/?some=query¶meters=2&pass=secret"
- requestOut' <- InstanaSDK.startHttpExit instana requestOut
- _ <- HTTP.httpLbs requestOut' httpManager
+ "http://127.0.0.1:1208/echo?some=query¶meters=2&pass=secret"
+ downstreamRequest' <- InstanaSDK.startHttpExit instana downstreamRequest
+ downstreamResponse <- HTTP.httpLbs downstreamRequest' httpManager
threadDelay $ 1000 -- make sure there is a duration > 0
InstanaSDK.completeExit instana
let
response =
- Wai.responseBuilder
+ Wai.responseLBS
HTTPTypes.status200
[("Content-Type", "application/json; charset=UTF-8")]
- "{\"response\": \"ok\"}"
- response' <- InstanaSDK.addWebsiteMonitoringBackEndCorrelation instana response
+ (HTTP.responseBody downstreamResponse)
+ response' <-
+ InstanaSDK.postProcessHttpResponse instana response
result <- respond response'
InstanaSDK.completeEntry instana
return result
@@ -441,7 +443,7 @@
host = "127.0.0.1"
port = (1207 :: Int)
warpSettings =
- ((Warp.setPort 1207) . (Warp.setHost "127.0.0.1")) Warp.defaultSettings
+ ((Warp.setPort port) . (Warp.setHost "127.0.0.1")) Warp.defaultSettings
infoM appLogger $
"Starting Wai/Warp app at " ++ host ++ ":" ++ show port ++
" (PID: " ++ show pid ++ ")."
diff --git a/test/integration/Instana/SDK/IntegrationTest/BracketApi.hs b/test/integration/Instana/SDK/IntegrationTest/BracketApi.hs
--- a/test/integration/Instana/SDK/IntegrationTest/BracketApi.hs
+++ b/test/integration/Instana/SDK/IntegrationTest/BracketApi.hs
@@ -19,6 +19,7 @@
import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper
import Instana.SDK.IntegrationTest.HUnitExtra (applyLabel,
assertAllIO, failIO)
+import qualified Instana.SDK.IntegrationTest.Suite as Suite
import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper
@@ -76,7 +77,8 @@
createRootEntry :: IO String
createRootEntry = do
- response <- HttpHelper.doAppRequest "bracket/api/root" "POST" []
+ response <-
+ HttpHelper.doAppRequest Suite.testServer "bracket/api/root" "POST" []
return $ LBSC8.unpack $ HTTP.responseBody response
@@ -135,7 +137,8 @@
createNonRootEntry :: IO String
createNonRootEntry = do
- response <- HttpHelper.doAppRequest "bracket/api/non-root" "POST" []
+ response <-
+ HttpHelper.doAppRequest Suite.testServer "bracket/api/non-root" "POST" []
return $ LBSC8.unpack $ HTTP.responseBody response
@@ -236,7 +239,8 @@
createSpansWithTags :: IO String
createSpansWithTags = do
- response <- HttpHelper.doAppRequest "bracket/api/with-tags" "POST" []
+ response <-
+ HttpHelper.doAppRequest Suite.testServer "bracket/api/with-tags" "POST" []
return $ LBSC8.unpack $ HTTP.responseBody response
@@ -314,6 +318,11 @@
createSpansWithServiceName :: IO String
createSpansWithServiceName = do
- response <- HttpHelper.doAppRequest "bracket/api/with-service-name" "POST" []
+ response <-
+ HttpHelper.doAppRequest
+ Suite.testServer
+ "bracket/api/with-service-name"
+ "POST"
+ []
return $ LBSC8.unpack $ HTTP.responseBody response
diff --git a/test/integration/Instana/SDK/IntegrationTest/Connection.hs b/test/integration/Instana/SDK/IntegrationTest/Connection.hs
--- a/test/integration/Instana/SDK/IntegrationTest/Connection.hs
+++ b/test/integration/Instana/SDK/IntegrationTest/Connection.hs
@@ -16,6 +16,7 @@
import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper
import Instana.SDK.IntegrationTest.HUnitExtra (applyLabel,
assertAllIO, failIO)
+import qualified Instana.SDK.IntegrationTest.Suite as Suite
import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper
@@ -36,26 +37,30 @@
shouldReestablishLostConnection _ =
applyLabel "shouldReestablishLostConnection" $ do
- -- 0 ms: send span 1
+ -- In this test scenario, the agent is instructed to no accept any data in
+ -- the timespan from after 3000 ms after start until 6000 ms after start.
+
+ -- ~0 ms: send span 1
recordSpan "haskell.dummy.connectionloss.entry-1"
- threadDelay $ 2000 * 1000
+ threadDelay $ 3500 * 1000
- -- 1500 ms: agent stub will switch into "connection loss simulation" mode
+ -- 3000 ms: agent stub will switch into "connection loss simulation" mode
-- (that is, spans and entity data will be rejected)
- -- 2000 ms: send span 2, will be rejected, unless an entity data request
- -- happened since 1500 ms and already triggered the reestablishing of the
+ -- 3500 ms: send span 2, will be rejected, unless an entity data request
+ -- happened since 3000 ms and already triggered the reestablishing of the
-- connection. Otherwise this span will trigger a reconnection (but get lost
-- in the process).
+ -- 4500 ms: span 2 will be send latest (force transmission every second)
recordSpan "haskell.dummy.connectionloss.entry-2"
- threadDelay $ 2000 * 1000
- -- 3000 ms: span 2 will be send latest (force transmission every second)
+ threadDelay $ 4500 * 1000
- -- 3500 ms: agent stub will switch off "connection loss simulation" mode
+ -- 6000 ms: agent stub will switch off "connection loss simulation" mode
- -- 4000 ms: send span 3
+ -- 8000 ms: send span 3
recordSpan "haskell.dummy.connectionloss.entry-3"
+
-- wait for span 3 to arrive, check that 1 and 3 have been received
spansResult <- TestHelper.waitForSdkSpansMatching
@@ -91,6 +96,7 @@
recordSpan spanName = do
_ <-
HttpHelper.doAppRequest
+ Suite.testServer
("single?spanName=" ++ spanName)
"POST"
[]
diff --git a/test/integration/Instana/SDK/IntegrationTest/HttpHelper.hs b/test/integration/Instana/SDK/IntegrationTest/HttpHelper.hs
--- a/test/integration/Instana/SDK/IntegrationTest/HttpHelper.hs
+++ b/test/integration/Instana/SDK/IntegrationTest/HttpHelper.hs
@@ -16,16 +16,17 @@
) where
-import Control.Monad.Catch (Handler)
-import qualified Control.Retry as Retry
-import qualified Data.Aeson as Aeson
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Lazy as LBS
-import qualified Network.HTTP.Client as HTTP
-import Network.HTTP.Types.Header (Header, HeaderName)
-import Network.HTTP.Types.Method (Method)
+import Control.Monad.Catch (Handler)
+import qualified Control.Retry as Retry
+import qualified Data.Aeson as Aeson
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LBS
+import qualified Network.HTTP.Client as HTTP
+import Network.HTTP.Types.Header (Header, HeaderName)
+import Network.HTTP.Types.Method (Method)
-import Instana.SDK.IntegrationTest.Util (putStrFlush)
+import qualified Instana.SDK.IntegrationTest.Suite as Suite
+import Instana.SDK.IntegrationTest.Util (putStrFlush)
-- 100 milliseconds
@@ -91,18 +92,9 @@
appHost = "127.0.0.1"
-appPort :: Int
-appPort = 1207
-
-
-appBaseUrl :: String
-appBaseUrl =
- "http://" ++ appHost ++ ":" ++ (show appPort) ++ "/"
-
-
-appUrl :: String -> String
-appUrl path =
- appBaseUrl ++ path
+appUrl :: Int -> String -> String
+appUrl port path =
+ "http://" ++ appHost ++ ":" ++ (show port) ++ "/" ++ path
defaultHeaders :: [(HeaderName, ByteString)]
@@ -123,12 +115,13 @@
requestAppAndParse ::
Aeson.FromJSON a =>
- String
+ Suite.AppUnderTest
+ -> String
-> ByteString
-> [Header]
-> IO (Either String a)
-requestAppAndParse path method headers =
- requestAndParse path method headers appUrl
+requestAppAndParse appUnderTest path method headers =
+ requestAndParse path method headers (appUrl $ Suite.port appUnderTest)
doAgentStubRequest ::
@@ -140,12 +133,13 @@
doAppRequest ::
- String
+ Suite.AppUnderTest
+ -> String
-> Method
-> [Header]
-> IO (HTTP.Response LBS.ByteString)
-doAppRequest path method headers =
- doRequest path method headers appUrl
+doAppRequest appUnderTest path method headers =
+ doRequest path method headers (appUrl $ Suite.port appUnderTest)
requestAndParse ::
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
@@ -16,6 +16,7 @@
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.ByteString.Lazy.Char8 as LBSC8
+import Data.List (isInfixOf)
import qualified Data.List as List
import Data.Maybe (isNothing, listToMaybe)
import Instana.SDK.AgentStub.TraceRequest (From (..), Span)
@@ -23,6 +24,7 @@
import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper
import Instana.SDK.IntegrationTest.HUnitExtra (applyLabel, applyLabel,
assertAllIO, failIO)
+import qualified Instana.SDK.IntegrationTest.Suite as Suite
import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Types (Header)
@@ -113,9 +115,9 @@
runTest :: String -> String -> [Header] -> (Span -> [Assertion]) -> IO Test
runTest pid urlPath headers extraAsserts = do
response <-
- HttpHelper.doAppRequest urlPath "GET" headers
+ HttpHelper.doAppRequest Suite.testServer urlPath "GET" headers
let
- result = LBSC8.unpack $ HTTP.responseBody response
+ responseBody = 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)
@@ -146,16 +148,20 @@
Just entrySpan = maybeEntrySpan
Just exitSpan = maybeExitSpan
assertAllIO $
- (commonAsserts entrySpan exitSpan result from serverTimingValue) ++
+ (commonAsserts entrySpan exitSpan responseBody from serverTimingValue) ++
(extraAsserts entrySpan)
runSuppressedTest :: String -> IO Test
runSuppressedTest urlPath = do
response <-
- HttpHelper.doAppRequest urlPath "GET" [("X-INSTANA-L", "0")]
+ HttpHelper.doAppRequest
+ Suite.testServer
+ urlPath
+ "GET"
+ [("X-INSTANA-L", "0")]
let
- result = LBSC8.unpack $ HTTP.responseBody response
+ responseBody = LBSC8.unpack $ HTTP.responseBody response
-- wait a second, then check that no spans have been recorded
threadDelay $ 10 * 1000
spansResults <-
@@ -168,7 +174,15 @@
then
failIO "spans have been recorded although they should have not" else
assertAllIO
- [ assertEqual "result" "{\"response\": \"ok\"}" result
+ [ assertBool
+ "downstream X-INSTANA-L"
+ (isInfixOf "\"X-INSTANA-L\":\"0\"" responseBody)
+ , assertBool
+ "no downstream X-INSTANA-T"
+ (not $ isInfixOf "X-INSTANA-T" responseBody)
+ , assertBool
+ "no downstream X-INSTANA-S"
+ (not $ isInfixOf "X-INSTANA-S" responseBody)
]
@@ -202,9 +216,8 @@
-> Maybe From
-> Maybe String
-> [Assertion]
-commonAsserts entrySpan exitSpan result from serverTimingValue =
- [ assertEqual "result" "{\"response\": \"ok\"}" result
- , assertEqual "trace ID is consistent"
+commonAsserts entrySpan exitSpan responseBody from serverTimingValue =
+ [ assertEqual "trace ID is consistent"
(TraceRequest.t exitSpan)
(TraceRequest.t entrySpan)
, assertEqual "Server-Timing header with trace ID is present"
@@ -213,6 +226,23 @@
, assertEqual "exit parent ID"
(Just $ TraceRequest.s entrySpan)
(TraceRequest.p exitSpan)
+ , assertBool
+ ("wrong downstream X-INSTANA-T: " ++ responseBody ++
+ ", expected " ++ TraceRequest.t entrySpan)
+ (isInfixOf
+ ("\"X-INSTANA-T\":\"" ++ (TraceRequest.t entrySpan) ++ "\"")
+ responseBody
+ )
+ , assertBool
+ ("wrong downstream X-INSTANA-S: " ++ responseBody ++
+ ", expected " ++ TraceRequest.s exitSpan)
+ (isInfixOf
+ ("\"X-INSTANA-S\":\"" ++ (TraceRequest.s exitSpan) ++ "\"")
+ responseBody
+ )
+ , assertBool
+ "no downstream X-INSTANA-L"
+ (not $ isInfixOf "X-INSTANA-L" responseBody)
, assertBool "entry timestamp" $ TraceRequest.ts entrySpan > 0
, assertBool "entry duration" $ TraceRequest.d entrySpan > 0
, assertEqual "entry kind" 1 (TraceRequest.k entrySpan)
@@ -227,7 +257,7 @@
( Aeson.object
[ "http" .= (Aeson.object
[ "method" .= ("GET" :: String)
- , "url" .= ("http://127.0.0.1:1302/" :: String)
+ , "url" .= ("http://127.0.0.1:1208/echo" :: String)
, "params" .= ("some=query¶meters=2" :: String)
, "status" .= (200 :: Int)
]
@@ -258,6 +288,7 @@
, "host" .= ("127.0.0.1:1207" :: String)
, "url" .= ("/http/bracket/api" :: String)
, "params" .= ("some=query¶meters=1" :: String)
+ , "status" .= (200 :: Int)
]
)
]
@@ -275,6 +306,7 @@
, "host" .= ("127.0.0.1:1207" :: String)
, "url" .= ("/http/low/level/api" :: String)
, "params" .= ("some=query¶meters=2" :: String)
+ , "status" .= (200 :: Int)
]
)
]
diff --git a/test/integration/Instana/SDK/IntegrationTest/LowLevelApi.hs b/test/integration/Instana/SDK/IntegrationTest/LowLevelApi.hs
--- a/test/integration/Instana/SDK/IntegrationTest/LowLevelApi.hs
+++ b/test/integration/Instana/SDK/IntegrationTest/LowLevelApi.hs
@@ -18,6 +18,7 @@
import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper
import Instana.SDK.IntegrationTest.HUnitExtra (applyLabel,
assertAllIO, failIO)
+import qualified Instana.SDK.IntegrationTest.Suite as Suite
import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper
@@ -79,7 +80,9 @@
createRootEntry :: IO String
createRootEntry = do
- response <- HttpHelper.doAppRequest "low/level/api/root" "POST" []
+ response <-
+ HttpHelper.doAppRequest
+ Suite.testServer "low/level/api/root" "POST" []
return $ LBSC8.unpack $ HTTP.responseBody response
@@ -139,7 +142,8 @@
createNonRootEntry :: IO String
createNonRootEntry = do
- response <- HttpHelper.doAppRequest "low/level/api/non-root" "POST" []
+ response <-
+ HttpHelper.doAppRequest Suite.testServer "low/level/api/non-root" "POST" []
return $ LBSC8.unpack $ HTTP.responseBody response
@@ -243,6 +247,7 @@
createSpansWithTags :: IO String
createSpansWithTags = do
- response <- HttpHelper.doAppRequest "low/level/api/with-tags" "POST" []
+ response <-
+ HttpHelper.doAppRequest Suite.testServer "low/level/api/with-tags" "POST" []
return $ LBSC8.unpack $ HTTP.responseBody response
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.5.0.1"
+ "0.6.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
@@ -15,7 +15,8 @@
import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper
import Instana.SDK.IntegrationTest.HUnitExtra (mergeCounts)
import Instana.SDK.IntegrationTest.Logging (testLogger)
-import Instana.SDK.IntegrationTest.Suite (ConditionalSuite (..),
+import Instana.SDK.IntegrationTest.Suite (AppUnderTest,
+ ConditionalSuite (..),
Suite)
import qualified Instana.SDK.IntegrationTest.Suite as Suite
import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper
@@ -101,22 +102,37 @@
, ("LOG_LEVEL", Just logLevel)
]
"stack exec instana-haskell-agent-stub"
- appCommand =
- buildCommand
- [ ("APP_LOG_LEVEL", Just logLevel)
- , ("INSTANA_SERVICE_NAME", Suite.customServiceName options)
- , ("INSTANA_LOG_LEVEL", Just logLevel)
- ]
- "stack exec " ++ Suite.appUnderTest options
+ appCommands =
+ map
+ (\appUnderTest ->
+ buildCommand
+ [ ("APP_LOG_LEVEL", Just logLevel)
+ , ("INSTANA_SERVICE_NAME", Suite.customServiceName options)
+ , ("INSTANA_LOG_LEVEL", Just logLevel)
+ ]
+ "stack exec " ++ (Suite.executable appUnderTest)
+ )
+ (Suite.appsUnderTest options)
+ startAllApplicationsUnderTest =
+ sequence $
+ map
+ (\cmd -> do
+ infoM testLogger $ "Running: " ++ cmd
+ -- We should rather use withCreateProcess instead of createProcess
+ -- for the apps under test, too - like for the agentStubCommand, see
+ -- below. But how to do that in a loop for an arbitrary
+ -- number of processes?
+ Process.createProcess $ Process.shell cmd
+ )
+ appCommands
+
infoM testLogger $ "Running: " ++ agentStubCommand
Process.withCreateProcess
(Process.shell agentStubCommand)
(\_ _ _ _ -> do
- infoM testLogger $ "Running: " ++ appCommand
- Process.withCreateProcess
- (Process.shell appCommand)
- (\_ _ _ _ -> runTests suite)
+ _ <- startAllApplicationsUnderTest
+ runTests suite
)
@@ -125,12 +141,17 @@
infoM testLogger "⏱ waiting for agent stub to come up"
_ <- HttpHelper.retryRequestRecovering TestHelper.pingAgentStub
infoM testLogger "✅ agent stub is up"
- infoM testLogger "⏱ waiting for app to come up"
- appPingResponse <- HttpHelper.retryRequestRecovering TestHelper.pingApp
+ appsWithPids <-
+ sequence $ map pingApp (Suite.appsUnderTest $ Suite.options suite)
+
+ -- We currently assume that there is exactly one app under test that also
+ -- connects to the agent.
let
- appPingBody = HTTP.responseBody appPingResponse
- appPid = (read (LBSC8.unpack appPingBody) :: Int)
- infoM testLogger $ "✅ app is up, PID is " ++ (show appPid)
+ appPid =
+ snd $
+ head $
+ filter (\(app, _) -> Suite.connectsToAgent app) appsWithPids
+
results <-
waitForAgentConnectionAndRun suite appPid
-- The withProcess calls that starts the agent stub and the external app
@@ -145,8 +166,23 @@
-- sure the process instances get shut down, we send an extra HTTP request to
-- ask the processes to terminate themselves.
_ <- TestHelper.shutDownAgentStub
- _ <- TestHelper.shutDownApp
+ _ <- TestHelper.shutDownApps (Suite.appsUnderTest $ Suite.options suite)
return results
+
+
+pingApp :: AppUnderTest -> IO (AppUnderTest, Int)
+pingApp appUnderTest = do
+ infoM testLogger $
+ "⏱ waiting for app " ++ Suite.executable appUnderTest ++ " to come up"
+ appPingResponse <-
+ HttpHelper.retryRequestRecovering $ TestHelper.pingApp appUnderTest
+ let
+ appPingBody = HTTP.responseBody appPingResponse
+ appPid = (read (LBSC8.unpack appPingBody) :: Int)
+ infoM testLogger $
+ "✅ app " ++ Suite.executable appUnderTest ++
+ " is up, PID is " ++ (show appPid)
+ return (appUnderTest, appPid)
-- |Waits for the app under test to establish a connection to the agent, then
diff --git a/test/integration/Instana/SDK/IntegrationTest/ServiceName.hs b/test/integration/Instana/SDK/IntegrationTest/ServiceName.hs
--- a/test/integration/Instana/SDK/IntegrationTest/ServiceName.hs
+++ b/test/integration/Instana/SDK/IntegrationTest/ServiceName.hs
@@ -16,6 +16,7 @@
import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper
import Instana.SDK.IntegrationTest.HUnitExtra (applyLabel,
assertAllIO, failIO)
+import qualified Instana.SDK.IntegrationTest.Suite as Suite
import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper
@@ -97,6 +98,7 @@
createSpansWithServiceName = do
response <-
HttpHelper.doAppRequest
+ Suite.testServer
"bracket/api/with-service-name-exit-only"
"POST"
[]
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
@@ -1,9 +1,13 @@
module Instana.SDK.IntegrationTest.Suite
- ( ConditionalSuite(..)
+ ( AppUnderTest(..)
+ , ConditionalSuite(..)
, Suite(..)
, SuiteOptions(..)
, defaultOptions
+ , downstreamTarget
, isExclusive
+ , testServer
+ , testServerWithMiddleware
, withConnectionLoss
, withCustomServiceName
, withPidTranslation
@@ -29,19 +33,55 @@
{ usePidTranslation :: Bool
, startupDelay :: Bool
, simulateConnectionLoss :: Bool
- , appUnderTest :: String
, customServiceName :: Maybe String
+ , appsUnderTest :: [AppUnderTest]
}
+-- |Describes options for running a test suite.
+data AppUnderTest =
+ AppUnderTest
+ { executable :: String
+ , port :: Int
+ , connectsToAgent :: Bool
+ }
+
+
defaultOptions :: SuiteOptions
defaultOptions =
SuiteOptions
{ usePidTranslation = False
, startupDelay = False
, simulateConnectionLoss = False
- , appUnderTest = "instana-haskell-test-wai-server"
+ , appsUnderTest = [testServer]
, customServiceName = Nothing
+ }
+
+
+testServer :: AppUnderTest
+testServer =
+ AppUnderTest
+ { executable = "instana-haskell-test-wai-server"
+ , port = 1207
+ , connectsToAgent = True
+ }
+
+
+testServerWithMiddleware :: AppUnderTest
+testServerWithMiddleware =
+ AppUnderTest
+ { executable = "instana-haskell-test-wai-with-middleware-server"
+ , port = 1207
+ , connectsToAgent = True
+ }
+
+
+downstreamTarget :: AppUnderTest
+downstreamTarget =
+ AppUnderTest
+ { executable = "downstream-target"
+ , port = 1208
+ , connectsToAgent = True
}
diff --git a/test/integration/Instana/SDK/IntegrationTest/TestHelper.hs b/test/integration/Instana/SDK/IntegrationTest/TestHelper.hs
--- a/test/integration/Instana/SDK/IntegrationTest/TestHelper.hs
+++ b/test/integration/Instana/SDK/IntegrationTest/TestHelper.hs
@@ -10,7 +10,7 @@
, resetDiscoveries
, resetSpans
, shutDownAgentStub
- , shutDownApp
+ , shutDownApps
, waitForEntityDataWithPid
, waitForExternalAgentConnection
, waitForDiscoveryWithPid
@@ -38,6 +38,7 @@
import qualified Instana.SDK.AgentStub.TraceRequest as TraceRequest
import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper
import Instana.SDK.IntegrationTest.Logging (testLogger)
+import Instana.SDK.IntegrationTest.Suite (AppUnderTest)
import Instana.SDK.IntegrationTest.Util ((|>))
@@ -57,9 +58,9 @@
HttpHelper.doAgentStubRequest "stub/ping" "GET"
-pingApp :: IO (HTTP.Response LBS.ByteString)
-pingApp = do
- HttpHelper.doAppRequest "ping" "GET" [("X-INSTANA-L", "0")]
+pingApp :: AppUnderTest -> IO (HTTP.Response LBS.ByteString)
+pingApp appUnderTest = do
+ HttpHelper.doAppRequest appUnderTest "ping" "GET" [("X-INSTANA-L", "0")]
shutDownAgentStub :: IO ()
@@ -75,17 +76,25 @@
(\ (_ :: HTTP.HttpException) -> return ())
-shutDownApp :: IO ()
-shutDownApp = do
- catch
- ( HttpHelper.doAppRequest "shutdown" "POST" [("X-INSTANA-L", "0")]
- >> return ()
- )
- -- Ignore all exceptions for the shutdown request. Either the app has
- -- already been shut down (so the request results in a network error) or, if
- -- it is successfull, it results in an HTTP 500 because the app process
- -- terminates before responding.
- (\ (_ :: HTTP.HttpException) -> return ())
+shutDownApps :: [AppUnderTest] -> IO ()
+shutDownApps appsUnderTest = do
+ sequence_ $ map shutDownOneApp appsUnderTest
+ where
+ shutDownOneApp :: AppUnderTest -> IO ()
+ shutDownOneApp appUnderTest =
+ catch
+ ( HttpHelper.doAppRequest
+ appUnderTest
+ "shutdown"
+ "POST"
+ [("X-INSTANA-L", "0")]
+ >> return ()
+ )
+ -- Ignore all exceptions for the shutdown request. Either the app has
+ -- already been shut down (so the request results in a network error) or, if
+ -- it is successfull, it results in an HTTP 500 because the app process
+ -- terminates before responding.
+ (\ (_ :: HTTP.HttpException) -> return ())
waitForExternalAgentConnection :: Bool -> Int -> IO (Either String (DiscoveryRequest, String))
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
@@ -132,7 +132,12 @@
, HttpTracing.shouldCreateNonRootEntryWithLowLevelApi pid
, HttpTracing.shouldSuppressWithLowLevelApi
])
- , Suite.options = Suite.defaultOptions
+ , Suite.options = Suite.defaultOptions {
+ Suite.appsUnderTest =
+ [ Suite.testServer
+ , Suite.downstreamTarget
+ ]
+ }
}
@@ -147,10 +152,11 @@
, WaiMiddleware.shouldAddWebsiteMonitoringCorrelation pid
, WaiMiddleware.shouldSuppress
])
- , Suite.options =
- Suite.defaultOptions {
- Suite.appUnderTest =
- "instana-haskell-test-wai-with-middleware-server"
+ , Suite.options = Suite.defaultOptions {
+ Suite.appsUnderTest =
+ [ Suite.testServerWithMiddleware
+ , 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
@@ -12,6 +12,7 @@
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.ByteString.Lazy.Char8 as LBSC8
+import Data.List (isInfixOf)
import qualified Data.List as List
import Data.Maybe (isNothing, listToMaybe)
import Instana.SDK.AgentStub.TraceRequest (From (..), Span)
@@ -19,6 +20,7 @@
import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper
import Instana.SDK.IntegrationTest.HUnitExtra (applyLabel, applyLabel,
assertAllIO, failIO)
+import qualified Instana.SDK.IntegrationTest.Suite as Suite
import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper
import qualified Network.HTTP.Client as HTTP
import Network.HTTP.Types (Header)
@@ -66,9 +68,9 @@
runTest :: String -> String -> [Header] -> (Span -> [Assertion]) -> IO Test
runTest pid urlPath headers extraAsserts = do
response <-
- HttpHelper.doAppRequest urlPath "GET" headers
+ HttpHelper.doAppRequest Suite.testServerWithMiddleware urlPath "GET" headers
let
- result = LBSC8.unpack $ HTTP.responseBody response
+ responseBody = 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)
@@ -99,16 +101,20 @@
Just entrySpan = maybeEntrySpan
Just exitSpan = maybeExitSpan
assertAllIO $
- (commonAsserts entrySpan exitSpan result from serverTimingValue) ++
+ (commonAsserts entrySpan exitSpan responseBody from serverTimingValue) ++
(extraAsserts entrySpan)
runSuppressedTest :: String -> IO Test
runSuppressedTest urlPath = do
response <-
- HttpHelper.doAppRequest urlPath "GET" [("X-INSTANA-L", "0")]
+ HttpHelper.doAppRequest
+ Suite.testServerWithMiddleware
+ urlPath
+ "GET"
+ [("X-INSTANA-L", "0")]
let
- result = LBSC8.unpack $ HTTP.responseBody response
+ responseBody = LBSC8.unpack $ HTTP.responseBody response
-- wait a second, then check that no spans have been recorded
threadDelay $ 10 * 1000
spansResults <-
@@ -121,7 +127,15 @@
then
failIO "spans have been recorded although they should have not" else
assertAllIO
- [ assertEqual "result" "{\"response\": \"ok\"}" result
+ [ assertBool
+ "downstream X-INSTANA-L"
+ (isInfixOf "\"X-INSTANA-L\":\"0\"" responseBody)
+ , assertBool
+ "no downstream X-INSTANA-T"
+ (not $ isInfixOf "X-INSTANA-T" responseBody)
+ , assertBool
+ "no downstream X-INSTANA-S"
+ (not $ isInfixOf "X-INSTANA-S" responseBody)
]
@@ -155,17 +169,30 @@
-> 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"
+commonAsserts entrySpan exitSpan responseBody from serverTimingValue =
+ [ 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)
+ , assertBool
+ ("wrong downstream X-INSTANA-T: " ++ responseBody ++
+ ", expected " ++ TraceRequest.t entrySpan)
+ (isInfixOf
+ ("\"X-INSTANA-T\":\"" ++ (TraceRequest.t entrySpan) ++ "\"")
+ responseBody
+ )
+ , assertBool
+ ("wrong downstream X-INSTANA-S: " ++ responseBody ++
+ ", expected " ++ TraceRequest.s exitSpan)
+ (isInfixOf
+ ("\"X-INSTANA-S\":\"" ++ (TraceRequest.s exitSpan) ++ "\"")
+ responseBody
+ )
+ , assertBool
+ "no downstream X-INSTANA-L"
+ (not $ isInfixOf "X-INSTANA-L" responseBody)
, assertBool "entry timestamp" $ TraceRequest.ts entrySpan > 0
, assertBool "entry duration" $ TraceRequest.d entrySpan > 0
, assertEqual "entry kind" 1 (TraceRequest.k entrySpan)
@@ -180,7 +207,7 @@
( Aeson.object
[ "http" .= (Aeson.object
[ "method" .= ("GET" :: String)
- , "url" .= ("http://127.0.0.1:1302/" :: String)
+ , "url" .= ("http://127.0.0.1:1208/echo" :: String)
, "params" .= ("some=query¶meters=2" :: String)
, "status" .= (200 :: Int)
]
@@ -200,6 +227,7 @@
, "host" .= ("127.0.0.1:1207" :: String)
, "url" .= ("/api" :: String)
, "params" .= ("some=query¶meters=1" :: String)
+ , "status" .= (200 :: Int)
]
)
]
diff --git a/test/unit/Instana/SDK/Internal/IdTest.hs b/test/unit/Instana/SDK/Internal/IdTest.hs
--- a/test/unit/Instana/SDK/Internal/IdTest.hs
+++ b/test/unit/Instana/SDK/Internal/IdTest.hs
@@ -1,9 +1,10 @@
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Instana.SDK.Internal.IdTest (allTests) where
import qualified Data.Aeson as Aeson
-import qualified Data.ByteString.Lazy.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as LBSC8
import Test.HUnit
import Instana.SDK.Internal.Id (Id)
@@ -13,7 +14,13 @@
allTests :: Test
allTests =
TestList
- [ TestLabel "shouldEncodeIntComponents" shouldEncodeIntComponents
+ [ TestLabel
+ "shouldConvertIntComponentsToString"
+ shouldConvertIntComponentsToString
+ , TestLabel "shouldEncodeIntComponents" shouldEncodeIntComponents
+ , TestLabel
+ "shouldConvertIntComponentsToString2"
+ shouldConvertIntComponentsToString2
, TestLabel "shouldEncodeIntComponents2" shouldEncodeIntComponents2
, TestLabel "shouldEncodeStringId" shouldEncodeStringId
, TestLabel "shouldDecodeStringId " shouldDecodeStringId
@@ -21,24 +28,43 @@
]
+shouldConvertIntComponentsToString :: Test
+shouldConvertIntComponentsToString =
+ let
+ asString = Id.toString $ Id.createFromIntsForTest [12345, 67890]
+ in
+ TestCase $
+ assertEqual "as string" "0000303900010932" asString
+
+
shouldEncodeIntComponents :: Test
shouldEncodeIntComponents =
let
idFromInts = Id.createFromIntsForTest [12345, 67890]
- encoded = BS.unpack . Aeson.encode $ idFromInts
+ encoded = LBSC8.unpack . Aeson.encode $ idFromInts
in
TestCase $
- assertEqual "encoded" "\"0000303900010932\"" encoded
+ assertEqual "as string" "\"0000303900010932\"" encoded
-shouldEncodeIntComponents2 :: Test
-shouldEncodeIntComponents2 =
+shouldConvertIntComponentsToString2 :: Test
+shouldConvertIntComponentsToString2 =
let
-- minimum for Int type as per
-- http://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Int.html
-- is from -2^29 to 29-1 -> -536870912 to 536870911
+ asString =
+ Id.toString $ Id.createFromIntsForTest [-536870912, 536870911]
+ in
+ TestCase $
+ assertEqual "as string" "200000001fffffff" asString
+
+
+shouldEncodeIntComponents2 :: Test
+shouldEncodeIntComponents2 =
+ let
idFromInts = Id.createFromIntsForTest [-536870912, 536870911]
- encoded = BS.unpack . Aeson.encode $ idFromInts
+ encoded = LBSC8.unpack . Aeson.encode $ idFromInts
in
TestCase $
assertEqual "encoded" "\"200000001fffffff\"" encoded
@@ -47,8 +73,8 @@
shouldEncodeStringId :: Test
shouldEncodeStringId =
let
- idFromString = Id.fromString "some string"
- encoded = BS.unpack . Aeson.encode $ idFromString
+ idFromString = ("some string" :: Id)
+ encoded = LBSC8.unpack . Aeson.encode $ idFromString
in
TestCase $
assertEqual "encoded" "\"some string\"" encoded
@@ -57,8 +83,8 @@
shouldDecodeStringId :: Test
shouldDecodeStringId =
let
- expected = Id.fromString "some string"
- maybeId = Aeson.decode (BS.pack "\"some string\"") :: Maybe Id
+ expected = ("some string" :: Id)
+ maybeId = Aeson.decode (LBSC8.pack "\"some string\"") :: Maybe Id
Just decoded = maybeId
in
TestCase $ assertEqual "decoded" expected decoded
@@ -70,7 +96,7 @@
do
generated <- Id.generate
let
- encoded = BS.unpack . Aeson.encode $ generated
+ encoded = LBSC8.unpack . Aeson.encode $ generated
-- every encoded ID must be 16 chars wide + 2 chars for leading and
-- trailing "
assertEqual "generated" 18 (length encoded)
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
@@ -3,16 +3,17 @@
module Instana.SDK.Internal.SpanTest (allTests) where
-import Data.Aeson (Value, (.=))
-import qualified Data.Aeson as Aeson
+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 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.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
@@ -26,6 +27,7 @@
, TestLabel "shouldAddBooleanDeeplyNested" shouldAddBooleanDeeplyNested
, TestLabel "shouldAddMultipleRegistered" shouldAddMultipleRegistered
, TestLabel "shouldAddMultipleTags" shouldAddMultipleTags
+ , TestLabel "shouldConvertToSimpleSpanFormat" shouldConvertToSimpleSpanFormat
]
@@ -216,6 +218,43 @@
])
]
)
+ 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