packages feed

instana-haskell-trace-sdk 0.1.0.0 → 0.2.0.0

raw patch · 33 files changed

+765/−135 lines, 33 filesnew-component:exe:instana-haskell-test-wai-with-middleware-server

Files

README.md view
@@ -10,14 +10,17 @@ What The Haskell Trace SDK Is And What It Is Not ------------------------------------------------ -The Instana Haskell Trace SDK does not support automatic instrumentation/tracing in the way we support it in most other languages. Instead, the SDK enables you to create spans manually, much like the [Instana Trace SDK for Java](https://docs.instana.io/core_concepts/tracing/java_trace_sdk/) does. Besides offering a convenient API to create spans, the Haskell Trace SDK also takes care of establishing a connection to the Instana Agent and sending spans to the agent in an efficient way, that does not impede the performance of your production code.+The Instana Haskell Trace SDK does not support automatic instrumentation/tracing in the way we support it in most other languages. Instead, the SDK enables you to create spans manually, much like the [Instana Trace SDK for Java](https://docs.instana.io/core_concepts/tracing/java_trace_sdk/) does. Besides offering a convenient API to create spans, the Haskell Trace SDK also takes care of establishing a connection to the Instana Agent and sending spans to the agent in an efficient way, that does not impede the performance of your production code. Last but not least, it collects runtime metrics and reports them to Instana.  Installation ------------ -**NOTE: Currently, the `instana-haskell-trace-sdk` has not been published on Hackage yet, so adding it to your dependencies will not work yet. It will be published soon. Stay tuned!**+To use the Instana Haskell Trace SDK in your application, add `instana-haskell-trace-sdk` to your dependencies (for example to the `build-depends` section of your cabal file). If you are using [stack](https://docs.haskellstack.org/en/stable/README/) you might need to add the SDK (with the version number you want to use) to the `extra-deps` section in your `stack.yaml` file: -<s>To use the Instana Haskell Trace SDK in your application, add `instana-haskell-trace-sdk` to your dependencies (for example to the `build-depends` section of your cabal file).</s>+```+extra-deps:+- instana-haskell-trace-sdk-0.2.0.0+```  Usage -----@@ -39,7 +42,7 @@   -- ... initialize more things ``` -The value `instana :: Instana.SDK.SDK.InstanaContext` that is returned by `InstanaSDK.initInstana` is required for all further calls, that is, for creating spans that will be send to the agent. The SDK will try to connect to an agent (asynchronous, in a a separate thread) as soon as it receives the `initInstana` call.+The value `instana :: Instana.SDK.InstanaContext` that is returned by `InstanaSDK.initInstana` is required for all further calls, that is, for creating spans that will be send to the agent. The SDK will try to connect to an agent (asynchronous, in a a separate thread) as soon as it receives the `initInstana` call.  The SDK can be configured via environment variables or directly in the code by passing configuration parameters to the initialization function, or both. @@ -109,19 +112,34 @@  ### Creating Spans +#### Trace HTTP Entries Automatically++You can let the SDK automatically create entry spans for all incoming HTTP requests in a WAI application by using it as a WAI middleware plug-in. Note that exit spans still need to be created manually via the withExit or startExit/stopExit functions (see below).++```+import qualified Instana.Wai.Middleware.Entry as InstanaWaiMiddleware++main = do+  Warp.run 3000 $ InstanaWaiMiddleware.traceHttpEntries instana $ app+```+ #### Bracket Style (High Level API)  All functions starting with `with` accept (among other parameters) an IO action. The SDK will start a span before, then execute the given IO action and complete the span afterwards. Using this style is recommended over the low level API that requires you to start and complete spans yourself.  * `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.+* `withHttpEntry`: A convenience function that examines an HTTP request for Instana tracing headers and creates an entry span. * `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.  #### Low Level API/Explicit Start And Complete  * `startRootEntry`: Starts an entry span that is the beginning of a trace (has no parent span). You will need to call `completeEntry` at some point. * `startEntry`: Starts an entry span. You will need to call `completeEntry` at some point.+* `startHttpEntry`: Starts an entry span for an incoming HTTP request. * `startExit`: Starts an exit span. You need to call `completeExit`/`completeExitWithData` at some point with the partial exit span value that is returned by this function.+* `startHttpExit`: Starts an exit span for an outgoing HTTP request. * `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.
instana-haskell-trace-sdk.cabal view
@@ -1,5 +1,5 @@ name:           instana-haskell-trace-sdk-version:        0.1.0.0+version:        0.2.0.0 synopsis:       SDK for adding custom Instana tracing support to Haskell applications. description:    Please also see the README on Github at <https://github.com/instana/haskell-trace-sdk#readme> homepage:       https://www.instana.com/@@ -73,6 +73,7 @@       Instana.SDK.Span.RootEntry       Instana.SDK.Span.Span       Instana.SDK.TracingHeaders+      Instana.Wai.Middleware.Entry   other-modules:       Instana.SDK.Internal.AgentConnection.AgentHostLookup       Instana.SDK.Internal.AgentConnection.AgentReady@@ -99,6 +100,7 @@       Instana.SDK.Internal.URL       Instana.SDK.Internal.Util       Instana.SDK.Internal.Worker+      Instana.Wai.Middleware.Entry.Internal       Paths_instana_haskell_trace_sdk   default-language: Haskell2010 @@ -258,6 +260,7 @@     , Instana.SDK.IntegrationTest.HUnitExtra     , Instana.SDK.IntegrationTest.HttpHelper     , Instana.SDK.IntegrationTest.HttpTracing+    , Instana.SDK.IntegrationTest.Logging     , Instana.SDK.IntegrationTest.LowLevelApi     , Instana.SDK.IntegrationTest.Metrics     , Instana.SDK.IntegrationTest.Runner@@ -265,6 +268,7 @@     , Instana.SDK.IntegrationTest.TestHelper     , Instana.SDK.IntegrationTest.TestSuites     , Instana.SDK.IntegrationTest.Util+    , Instana.SDK.IntegrationTest.WaiMiddleware   default-language: Haskell2010  @@ -272,6 +276,31 @@   main-is: Main.hs   hs-source-dirs:       test/apps/wai+  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+    , hslogger+    , http-client+    , http-types+    , instana-haskell-trace-sdk+    , text+    , unix+    , wai+    , warp+  default-language: Haskell2010++executable instana-haskell-test-wai-with-middleware-server+  main-is: Main.hs+  hs-source-dirs:+      test/apps/wai-with-middleware   if flag(dev)     ghc-options:       -Wall -Werror -threaded -rtsopts "-with-rtsopts=-T -N "
src/Instana/SDK/Config.hs view
@@ -19,7 +19,7 @@ import           GHC.Generics  -{-| Configuration for a the Instana SDK. Please use the 'defaultConfig'+{-| Configuration for the Instana SDK. Please use the 'defaultConfig' function and then modify individual settings via record syntax For more information, see <http://www.yesodweb.com/book/settings-types>. -}
src/Instana/SDK/Internal/AgentConnection/AgentHostLookup.hs view
@@ -118,6 +118,7 @@     expectedServerHeader = InternalConfig.agentName config     manager = InternalContext.httpManager context     agentRootUrl = URL.mkHttp host port ""+  debugM instanaLogger $ "Trying to reach agent at " ++ show agentRootUrl   agentRootRequest <- HTTP.parseUrlThrow $ show agentRootUrl   let     agentRootAction = HTTP.httpLbs agentRootRequest manager
src/Instana/SDK/Internal/AgentConnection/SchedFile.hs view
@@ -14,6 +14,7 @@ import qualified Text.Regex.TDFA.String    as RegexString  +-- |Parses a /proc/{pid}/sched file to get the PID in the parent namespace. parsePidFromSchedFile :: String -> Maybe String parsePidFromSchedFile schedFileContent =   let
src/Instana/SDK/Internal/FullSpan.hs view
@@ -120,26 +120,26 @@       , "data"  .= spanData s       , "f"     .= From p       -- TODO - missing attributes:-      -- * data.service - should have dedicated functionality to be set (for SDK+      -- - data.service - should have dedicated functionality to be set (for SDK       --   spans)-      -- * For SDK spans: Everything should be in data.sdk, structure is described in+      -- - For SDK spans: Everything should be in data.sdk, structure is described in       --   https://github.com/instana/technical-documentation/blob/master/tracing/format.md#json-format-for-sdk-spans-      -- * e: [{ # events that happened during this span, seems to be used mostly by EUM??+      -- - e: [{ # events that happened during this span, seems to be used mostly by EUM??       --     t: <long> # timestamp of this event relative to start (0 .. d)       --     v: <String> # type of this annotation (ttfb, dom-ready, etc)       --   }],-      -- * f.h: AgentId/HostID (optional), specified in the language announce response body.+      -- - f.h: AgentId/HostID (optional), specified in the language announce response body.       --   },-      -- * b: { # batching data+      -- - b: { # batching data       --     s: <long> # size; amount of batched spans       --     d: <long> # duration in ms; more realistic time of time consumed by individual batched spans. (optional, regular duration taken if absent)       --   },-      -- * stack: [{ # stack trace+      -- - stack: [{ # stack trace       --     c: <String> # Class name       --     m: <String> # Method name       --     n: <String> # Line number       --     f: <String> # File name (optional in Java)       --   }],-      -- * deferred: <boolean> # whether the span is deferred (optional), ??+      -- - deferred: <boolean> # whether the span is deferred (optional), ??       ]
src/Instana/SDK/Internal/Metrics/Collector.hs view
@@ -24,6 +24,9 @@ import           Instana.SDK.Internal.Util                        ((|>))  +{-| Creates the ekg metric store and registers all relevant metrics for regular+collection.+-} registerMetrics :: String -> ProcessInfo -> Int -> IO Metrics.Store registerMetrics translatedPid processInfo sdkStartTime = do   -- registerMetrics is executed once more after each connection loss/reconnect.@@ -44,10 +47,14 @@   return instanaMetricsStore  +{-| Collects the current value for all registered metrics.+-} sampleAll :: Metrics.Store -> IO Metrics.Sample sampleAll = Metrics.sampleAll  +{-| Registers custom metrics (not included in the ekg default metrics).+-} registerCustomMetrics ::   Metrics.Store   -> String
src/Instana/SDK/Internal/Metrics/Compression.hs view
@@ -29,6 +29,8 @@      dummyValue = IntegralValue 0  +-- |Removes metric values that are identical in the both samples, also removes+-- original values for which deltas have been computed. compressSample :: InstanaSample -> InstanaSample -> InstanaSample compressSample previous next =   let
src/Instana/SDK/Internal/Metrics/Deltas.hs view
@@ -19,6 +19,8 @@ import qualified Instana.SDK.Internal.Metrics.Sample as Sample  +-- |All metric keys from ekg-core that are eligible for being turned into deltas+-- (difference in value/second since the last metric collection). deltaKeyList :: [Text] deltaKeyList =   [ "rts.gc.bytes_allocated"@@ -37,6 +39,7 @@   ]  +-- |Calculates deltas and adds them to the sample. enrichWithDeltas :: TimedSample -> TimedSample -> TimedSample enrichWithDeltas previousSample currentSample =   let
src/Instana/SDK/Internal/Metrics/Sample.hs view
@@ -32,25 +32,28 @@ import qualified System.Metrics      as Metrics  +-- |A collection of metric values. type InstanaSample = HashMap Text InstanaMetricValue  +-- |A single metric value. data InstanaMetricValue =+  -- |A string metric value.     StringValue     Text+  -- |An integral metric value.   | IntegralValue   Int+  -- |A fractional metric value.   | FractionalValue Double   deriving (Eq, Generic, Show)  --- instance A.ToJSON InstanaMetricValue where---   toJSON = encodeValue--+-- |Converts an ekg-core sample into an Instana sample. ekgSampleToInstanaSample :: Metrics.Sample -> InstanaSample ekgSampleToInstanaSample =   HashMap.map ekgValueToInstanaValue  +-- |Converts an ekg-core metric value into an Instana metric value. ekgValueToInstanaValue :: Metrics.Value -> InstanaMetricValue ekgValueToInstanaValue ekgValue =   case ekgValue of@@ -72,6 +75,7 @@     } deriving (Eq, Generic, Show)  +-- |Creates an empty sample with a timestamp. empty :: Int -> TimedSample empty t =   TimedSample {@@ -81,6 +85,7 @@   }  +-- |Creates a sample with a timestamp. mkTimedSample :: InstanaSample -> Int -> TimedSample mkTimedSample sampledMetrics t =   TimedSample {@@ -90,20 +95,24 @@   }  +-- |Creates a sample with a timestamp from an ekg-core sample. timedSampleFromEkgSample :: Metrics.Sample -> Int -> TimedSample timedSampleFromEkgSample sampledMetrics =   mkTimedSample (ekgSampleToInstanaSample sampledMetrics)  +-- |Marks the sample for a reset on the next metric collection tick. markForReset :: TimedSample -> TimedSample markForReset timedSample =   timedSample { resetNext = True }  +-- |Checks if the sample is marked for reset. isMarkedForReset :: TimedSample -> Bool isMarkedForReset = resetNext  +-- |Encodes a sample to JSON. encodeSample :: InstanaSample -> A.Value encodeSample metrics =     buildOne metrics $ A.emptyObject@@ -138,19 +147,22 @@         A.Null     -> "Null"  --- | Encodes a single metric value to JSON+-- |Encodes a single metric value to JSON encodeValue :: InstanaMetricValue -> A.Value encodeValue (IntegralValue   n) = Aeson.toJSON n encodeValue (FractionalValue f) = Aeson.toJSON f encodeValue (StringValue     s) = Aeson.toJSON s  +-- |A type wrapper to convert a sample to JSON. newtype SampleJson = SampleJson InstanaSample     deriving Show  instance A.ToJSON SampleJson where     toJSON (SampleJson s) = encodeSample s ++-- |A type wrapper to convert a metric value to JSON. newtype ValueJson = ValueJson InstanaMetricValue     deriving Show
src/Instana/SDK/Internal/Secrets.hs view
@@ -29,6 +29,7 @@ import           Instana.SDK.Internal.Util ((|>))  +-- |The available secret matcher modes. data MatcherMode =     Equals   | EqualsIgnoreCase@@ -54,6 +55,7 @@           fail $ "unknown secrets matcher mode: " ++ (T.unpack matcherModeText)  +-- |Secrets matcher for each mode. data SecretsMatcher =     EqualsMatcher [Text]   | EqualsIgnoreCaseMatcher [Text]@@ -110,11 +112,13 @@           return $ NoneMatcher  +-- |The default matcher. defaultSecretsMatcher :: SecretsMatcher defaultSecretsMatcher =   ContainsIgnoreCaseMatcher ["key", "pass", "secret"]  +-- |Returns true if and only if the given text matches the given matcher. isSecret :: SecretsMatcher -> Text -> Bool isSecret (EqualsMatcher secretsList) potentialSecret =   elem potentialSecret secretsList
src/Instana/SDK/Internal/SpanStack.hs view
@@ -18,6 +18,14 @@   , suppress   ) where +import           GHC.Generics++import           Instana.SDK.Internal.Util  ((|>))+import           Instana.SDK.Span.EntrySpan (EntrySpan)+import           Instana.SDK.Span.ExitSpan  (ExitSpan)+import           Instana.SDK.Span.Span      (Span (..), SpanKind (..))++-- -- Implementation Note -- =================== --@@ -36,14 +44,6 @@ -- * no current span, currently not tracing -- * an active entry span but not exit -- * a non-active entry and an active exit---import           GHC.Generics--import           Instana.SDK.Internal.Util  ((|>))-import           Instana.SDK.Span.EntrySpan (EntrySpan)-import           Instana.SDK.Span.ExitSpan  (ExitSpan)-import           Instana.SDK.Span.Span      (Span (..), SpanKind (..))   {-|The stack of currently open spans in one thread.
src/Instana/SDK/Internal/Util.hs view
@@ -7,6 +7,7 @@   ) where  +-- |Elm-style function application. (|>) :: a -> (a -> b) -> b (|>) =   flip ($)
src/Instana/SDK/SDK.hs view
@@ -4,9 +4,9 @@ Description : The main API of the Instana Haskell Trace SDK.  Instana.SDK.SDK is the main API of the Instana Haskell Trace SDK. Use one of-initInstana, initConfiguredInstana, withInstana, or withConfiguredInstana to get-an InstanaContext. Then use the context with any of the withRootEntry,-withEntry, withExit functions for tracing.+'initInstana', 'initConfiguredInstana', 'withInstana', or+'withConfiguredInstana' to get an InstanaContext. Then use the context with any+of the 'withRootEntry', 'withEntry', 'withExit' functions for tracing. -} module Instana.SDK.SDK     ( Config@@ -247,11 +247,11 @@   MonadIO m =>   InstanaContext   -> Wai.Request-  -> Text   -> m a   -> m a-withHttpEntry context request spanName io = do+withHttpEntry context request io = do   let+    spanName = "haskell.wai.server"     tracingHeaders = readHttpTracingHeaders request     traceId = TracingHeaders.traceId tracingHeaders     spanId = TracingHeaders.spanId tracingHeaders@@ -425,10 +425,10 @@   MonadIO m =>   InstanaContext   -> Wai.Request-  -> Text   -> m ()-startHttpEntry context request spanName = do+startHttpEntry context request = do   let+    spanName = "haskell.wai.server"     tracingHeaders = readHttpTracingHeaders request     traceId = TracingHeaders.traceId tracingHeaders     spanId = TracingHeaders.spanId tracingHeaders
src/Instana/SDK/Span/Span.hs view
@@ -35,6 +35,7 @@ import qualified Instana.SDK.Span.ExitSpan  as ExitSpan  +-- |The span kind (entry, exit or intermediate). data SpanKind =     -- |The monitored componenent receives a call.     EntryKind@@ -46,6 +47,7 @@   deriving (Eq, Generic, Show)  +-- |A span. data Span =     Entry EntrySpan   | Exit ExitSpan
src/Instana/SDK/TracingHeaders.hs view
@@ -20,18 +20,22 @@ import qualified Network.HTTP.Types.Header as HTTPHeader  +-- |X-INSTANA-T traceIdHeaderName :: HTTPHeader.HeaderName traceIdHeaderName = "X-INSTANA-T"  +-- |X-INSTANA-S spanIdHeaderName :: HTTPHeader.HeaderName spanIdHeaderName = "X-INSTANA-S"  +-- |X-INSTANA-L levelHeaderName :: HTTPHeader.HeaderName levelHeaderName = "X-INSTANA-L"  +-- |Tracing level. data TracingLevel =     -- |Record calls.     Trace@@ -40,16 +44,19 @@   deriving (Eq, Generic, Show)  +-- |Converts a string into the tracing level. stringToTracingLevel :: String -> TracingLevel stringToTracingLevel s =   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  +-- |Converts tracing level into a string. tracingLevelToString :: TracingLevel -> String tracingLevelToString l =   case l of
+ src/Instana/Wai/Middleware/Entry.hs view
@@ -0,0 +1,22 @@+{-|+Module      : Instana.Wai.Middleware.Entry+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+withExit or startExit/stopExit functions.++== Example++@+main = do+  Warp.run 3000 $ InstanaWaiMiddleware.traceHttpEntries instana $ app+@+-}+module Instana.Wai.Middleware.Entry+  ( module Instana.Wai.Middleware.Entry.Internal+  ) where+++import           Instana.Wai.Middleware.Entry.Internal (traceHttpEntries)+
+ src/Instana/Wai/Middleware/Entry/Internal.hs view
@@ -0,0 +1,23 @@+{-|+Module      : Instana.Wai.Middleware.Entry.Internal+Description : Internals of the WAI Instana Tracing Middleware++Automatically creates entry spans for all incoming HTTP requests in a WAI+application.+-}+module Instana.Wai.Middleware.Entry.Internal+  ( traceHttpEntries+  ) where+++import           Network.Wai     (Application)++import           Instana.SDK.SDK (InstanaContext, withHttpEntry)+++-- |Run the tracing middleware given an initialized Instana SDK context.+traceHttpEntries :: InstanaContext -> Application -> Application+traceHttpEntries instana app request respond = do+  withHttpEntry instana request $+    app request respond+
test/agent-stub/Instana/SDK/AgentStub/Logging.hs view
@@ -4,6 +4,7 @@   ) where  +import           System.Environment        (lookupEnv) import           System.IO                 (Handle, stdout) import           System.Log.Formatter import           System.Log.Handler        (setFormatter)@@ -18,12 +19,14 @@ agentStubLogger = "AgentStub"  -logLevel :: Priority-logLevel = INFO-- initLogging :: IO () initLogging = do+  logLevelEnvVar <- lookupEnv "LOG_LEVEL"+  let+    logLevel =+      case logLevelEnvVar of+        Just "DEBUG" -> DEBUG+        _            -> INFO   updateGlobalLogger agentStubLogger $ setLevel logLevel   updateGlobalLogger rootLoggerName $ setLevel logLevel   agentStubFileHandler <- fileHandler "agent-stub.log" logLevel
+ test/apps/wai-with-middleware/Main.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where+++import           Control.Concurrent           (threadDelay)+import           Control.Monad.IO.Class       (liftIO)+import qualified Data.Binary.Builder          as Builder+import qualified Data.ByteString.Lazy.Char8   as LBSC8+import           Instana.SDK.SDK              (InstanaContext)+import qualified Instana.SDK.SDK              as InstanaSDK+import qualified Instana.Wai.Middleware.Entry as InstanaWaiMiddleware+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 = "WaiWithMiddleware"+++application :: InstanaContext -> HTTP.Manager -> CPid -> Wai.Application+application instana httpManager pid request respond = do+  let+    route = Wai.pathInfo request+    method = Wai.requestMethod request+  case (method, route) of+    (_, []) ->+      root respond+    (_, ["ping"]) ->+      ping respond pid+    ("GET", ["api"]) ->+      apiUnderTest instana httpManager request respond+    ("POST", ["shutdown"]) ->+      shutDown respond+    _ ->+      respond404 respond+++root ::+  (Wai.Response -> IO Wai.ResponseReceived)+  -> IO Wai.ResponseReceived+root respond =+  respondWithPlainText+    respond+    "Instana Haskell Trace SDK Integration Test Wai Dummy App"+++ping ::+  (Wai.Response -> IO Wai.ResponseReceived)+  -> CPid+  -> IO Wai.ResponseReceived+ping respond pid = do+  respond $+    Wai.responseLBS HTTPTypes.status200 [] $ LBSC8.pack $ show pid+++apiUnderTest ::+  InstanaContext+  -> HTTP.Manager+  -> Wai.Request+  -> (Wai.Response -> IO Wai.ResponseReceived)+  -> IO Wai.ResponseReceived+apiUnderTest instana httpManager _ respond = do+  requestOut <-+    HTTP.parseUrlThrow $+      "http://127.0.0.1:1302/?some=query&parameters=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\"}"+++shutDown ::+  (Wai.Response -> IO Wai.ResponseReceived)+  -> IO Wai.ResponseReceived+shutDown respond = do+  liftIO $ infoM appLogger $ "Wai/Warp app (/w middleware) 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+  httpManager <- initHttpManager+  let+    config = InstanaSDK.defaultConfig { InstanaSDK.agentPort = Just 1302 }+  InstanaSDK.withConfiguredInstana config $ runApp httpManager+++runApp :: HTTP.Manager -> InstanaContext -> IO ()+runApp httpManager instana = do+  pid <- Posix.getProcessID+  let+    host = "127.0.0.1"+    port = (1207 :: Int)+    warpSettings =+      ((Warp.setPort 1207) . (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+  Warp.runSettings warpSettings $ appWithMiddleware+++initLogging :: IO ()+initLogging = do+  logLevelEnvVar <- lookupEnv "APP_LOG_LEVEL"+  let+    logLevel =+      case logLevelEnvVar of+        Just "DEBUG" -> DEBUG+        _            -> INFO+  updateGlobalLogger appLogger $ setLevel logLevel+  appFileHandler <- fileHandler "wai-warp-app-with-middleware.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+      }+
test/apps/wai/Main.hs view
@@ -19,6 +19,7 @@ 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@@ -266,7 +267,7 @@   -> (Wai.Response -> IO Wai.ResponseReceived)   -> IO Wai.ResponseReceived httpBracketApi instana httpManager requestIn respond =-  InstanaSDK.withHttpEntry instana requestIn "haskell.wai.server" $ do+  InstanaSDK.withHttpEntry instana requestIn $ do     requestOut <-       HTTP.parseUrlThrow $         "http://127.0.0.1:1302/?some=query&parameters=2&pass=secret"@@ -291,7 +292,7 @@   -> (Wai.Response -> IO Wai.ResponseReceived)   -> IO Wai.ResponseReceived httpLowLevelApi instana httpManager requestIn respond = do-  InstanaSDK.startHttpEntry instana requestIn "haskell.wai.server"+  InstanaSDK.startHttpEntry instana requestIn   requestOut <-     HTTP.parseUrlThrow $       "http://127.0.0.1:1302/?some=query&parameters=2&pass=secret"@@ -384,9 +385,15 @@  initLogging :: IO () initLogging = do-  updateGlobalLogger appLogger $ setLevel INFO-  appFileHandler <- fileHandler "wai-warp-app.log" INFO-  appStreamHandler <- streamHandler stdout INFO+  logLevelEnvVar <- lookupEnv "APP_LOG_LEVEL"+  let+    logLevel =+      case logLevelEnvVar of+        Just "DEBUG" -> DEBUG+        _            -> INFO+  updateGlobalLogger appLogger $ setLevel logLevel+  appFileHandler <- fileHandler "wai-warp-app.log" logLevel+  appStreamHandler <- streamHandler stdout logLevel   let     formattedAppFileHandler = withFormatter appFileHandler     formattedAppStreamHandler = withFormatter appStreamHandler
test/integration/Instana/SDK/IntegrationTest/Connection.hs view
@@ -42,9 +42,12 @@     threadDelay $ 2000 * 1000      -- 1500 ms: agent stub will switch into "connection loss simulation" mode-    --          (that is, spans will be rejected)+    --          (that is, spans and entity data will be rejected) -    -- 2000 ms: send span 2, 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+    -- connection. Otherwise this span will trigger a reconnection (but get lost+    -- in the process).     recordSpan "haskell.dummy.connectionloss.entry-2"     threadDelay $ 2000 * 1000 @@ -71,12 +74,6 @@             TestHelper.getSpanByName               "haskell.dummy.connectionloss.entry-1"               spans-          -- What about entry-2? Do we expect it to have been buffered and-          -- resend? Do we expect it to be dropped? Right now, it is dropped.-          maybeSpan2 =-            TestHelper.getSpanByName-              "haskell.dummy.connectionloss.entry-2"-              spans           maybeSpan3 =             TestHelper.getSpanByName               "haskell.dummy.connectionloss.entry-3"@@ -85,12 +82,10 @@         then           failIO "expected span before connection loss has not been recorded"         else-          if isNothing maybeSpan3-          then-            failIO "expected span after connection loss has not been recorded"-          else-            return $ TestCase $-              assertBool "expected span 2 to be dropped" (isNothing maybeSpan2)+          return $ TestCase $+            assertBool+              "expected span after connection loss has not been recorded"+              (isJust maybeSpan3)   recordSpan :: String -> IO ()
test/integration/Instana/SDK/IntegrationTest/HUnitExtra.hs view
@@ -8,10 +8,13 @@   ) where  -import qualified Data.List  as List+import qualified Data.List                           as List+import           System.Log.Logger                   (infoM) import           Test.HUnit +import           Instana.SDK.IntegrationTest.Logging (testLogger) + failIO :: String -> IO Test failIO message =   return $ TestCase $ assertFailure message@@ -35,7 +38,7 @@  skip :: String -> IO Test -> IO Test skip label _ = do-  putStrLn $ "Skipped: " ++ label+  infoM testLogger $ "Skipped: " ++ label   return $ TestLabel label $ TestList []
test/integration/Instana/SDK/IntegrationTest/HttpHelper.hs view
@@ -33,9 +33,40 @@ retryDelay = 100 * 1000  --- 5 seconds+-- Time to wait for a particular HTTP response: 7.5 seconds.+--+-- We need > 5 seconds, in particular on Travis. Reason:+-- 1) The agent stub and the app under test are started more or less+--    simultaneously+-- 2) The agent stub might not yet be up when the Instana SDK in the app under+--    test starts to look for an agent (which is a perfectly normal situation+--    and should shouldn't not be a problem as the SDK will retry with to find+--    an agent to connect to with fibonacci backoff).+-- 3) When this happens, the first attempt to talk to 127.0.0.1:1302 fails.+-- 4) Next, the SDK attempts to talk to an agent over the default gateway.+-- 5) This never happens locally (at least not on MacOS), as there is no+--    /sbin/ip executable present+-- 6) On Travis (or more generally on most Linux systems), the SDK actually+--    tries the default gateway because that executable _is_ present. It will+--    also find a default gateway (let's say, for example, 10.20.0.1).+-- 7) That host is reachable so an HTTP request to 10.20.0.1:1302 is attempted+--    (1302 is the configured agent port in the integration tests).+-- 8) If something exists at 10.20.0.1:1302 it never sends a response. Or there+--    is nothing there but somehow the request does not fail immediately.+--    Either way, trying this HTTP request eats up around 5 seconds. Why 5+--    seconds? 5 seconds is:+--    a) the timeout the SDK sets itself (see Instana/SDK/SDK.hs, value for+--       HTTP.managerResponseTimeout),+--    b) also the standard HTTP client timeout (see+--    https://hackage.haskell.org/package/http-client-0.1.0.0/docs/Network-HTTP-Client-Manager.html - managerResponseTimeout).+-- 9) When the HTTP client timeout is up and the HTTP call to 10.20.0.1 has+--    finally failed, the SDK realizes it can't talk to the default gateway. It+--    would probably try the configured host (127.0.0.1:1302) again soon, and+--    then find the agent stub there, unless this timeout here kicks in earlier.+--+-- Thus, we need more than 5 seconds. maxRetryDelay :: Int-maxRetryDelay = 5 * 1000 * 1000+maxRetryDelay = 7500 * 1000   agentStubHost :: String
test/integration/Instana/SDK/IntegrationTest/HttpTracing.hs view
@@ -91,7 +91,7 @@     from = Just $ From pid   spansResults <-     TestHelper.waitForSpansMatching-      [ "haskell.wai.server" , "haskell.http.client" ]+      [ "haskell.wai.server", "haskell.http.client" ]   case spansResults of     Left failure ->       failIO $ "Could not load recorded spans from agent stub: " ++ failure
+ test/integration/Instana/SDK/IntegrationTest/Logging.hs view
@@ -0,0 +1,48 @@+module Instana.SDK.IntegrationTest.Logging+  ( testLogger+  , initLogging+  ) where+++import           System.Environment        (lookupEnv)+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)+++testLogger :: String+testLogger = "IntegrationTest"+++initLogging :: IO ()+initLogging = do+  logLevelEnvVar <- lookupEnv "LOG_LEVEL"+  let+    logLevel =+      case logLevelEnvVar of+        Just "DEBUG" -> DEBUG+        _            -> INFO+  updateGlobalLogger testLogger $ setLevel logLevel+  updateGlobalLogger rootLoggerName $ setLevel logLevel+  testFileHandler <- fileHandler "integration-test.log" logLevel+  testStreamHandler <- streamHandler stdout logLevel+  let+    formattedAgentStubFileHandler = withFormatter testFileHandler+    formattedAgentStubStreamHandler = withFormatter testStreamHandler+  updateGlobalLogger testLogger $+    setHandlers [ formattedAgentStubFileHandler ]+  updateGlobalLogger rootLoggerName $+    setHandlers [ formattedAgentStubStreamHandler ]+++withFormatter :: GenericHandler Handle -> GenericHandler Handle+withFormatter handler = setFormatter handler formatter+    where+      timeFormat = "%F %H:%M:%S.%4q %z"+      formatter = tfLogFormatter timeFormat "$time $msg"+
test/integration/Instana/SDK/IntegrationTest/Metrics.hs view
@@ -51,7 +51,7 @@               (EntityDataRequest.arguments entityData)           , assertLabelIs               "sensorVersion"-              "0.1.0.0"+              "0.2.0.0"               (EntityDataRequest.sensorVersion entityData)           , assertCounterSatisfies               "startTime"
test/integration/Instana/SDK/IntegrationTest/Runner.hs view
@@ -6,17 +6,19 @@ import           Data.List                              as List import qualified Data.Maybe                             as Maybe import qualified Network.HTTP.Client                    as HTTP+import           System.Environment                     (lookupEnv) import           System.Exit                            as Exit+import           System.Log.Logger                      (infoM) import           System.Process                         as Process import           Test.HUnit  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 (..),                                                          Suite) import qualified Instana.SDK.IntegrationTest.Suite      as Suite import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper-import           Instana.SDK.IntegrationTest.Util       (putStrFlush)   {-| Runs a collection of test suites.@@ -34,13 +36,13 @@       else         (List.map runConditionalSuite allSuites, 0)   if not (null exlusiveSuites) then-    putStrLn $-      "\n\nRunning only " +++    infoM testLogger  $+      "Running only " ++       show (List.length exlusiveSuites) ++       " suite(s) marked as exclusive, ignoring all others."   else-    putStrLn $-      "\n\nRunning " ++ show (List.length allSuites) ++ " test suite(s)."+    infoM testLogger $+      "Running " ++ show (List.length allSuites) ++ " test suite(s)."   results <- sequence actions   let     mergedResults = mergeCounts results@@ -48,7 +50,7 @@     triedCount = tried mergedResults     errCount = errors mergedResults     failCount = failures mergedResults-  putStrLn $+  infoM testLogger $     "SUMMARY: Cases: " ++ show caseCount ++     "  Tried: " ++ show triedCount ++     "  Errors: " ++ show errCount ++@@ -59,7 +61,7 @@     Exit.die "😱 There have been errors! 😱"   else if failCount > 0 then     Exit.die "😭 There have been test failures. 😭"-  else putStrLn "🎉 All tests have passed. 🎉"+  else infoM testLogger "🎉 All tests have passed. 🎉"   return mergedResults  @@ -82,51 +84,37 @@ runSuite suite = do   let     suiteLabel = Suite.label suite-  putStrFlush $ "\nExecuting test suite: " ++ suiteLabel ++ "\n\n"+  infoM testLogger $ "Executing test suite: " ++ suiteLabel +  logLevelEnvVar <- lookupEnv logLevelKey   let     options = Suite.options suite-    customAgentName = Suite.customAgentName options+    logLevel = Maybe.fromMaybe "INFO" logLevelEnvVar     agentStubCommand =-      (if Suite.usePidTranslation options-        then "SIMULATE_PID_TRANSLATION=true "-        else ""-      ) ++-      (if Maybe.isJust customAgentName-        then-          let-            Just agentName = customAgentName-          in-          "AGENT_NAME=\"" ++ agentName ++ "\" "-        else ""-      ) ++-      (if Suite.startupDelay options-        then "STARTUP_DELAY=2500 "-        else ""-      ) ++-      (if Suite.simulateConnectionLoss options-        then "SIMULATE_CONNECTION_LOSS=true "-        else ""-      )-      ++ "stack exec instana-haskell-agent-stub"-+      buildCommand+        [ ("SIMULATE_PID_TRANSLATION",+             booleanEnv $ Suite.usePidTranslation options)+        , ("AGENT_NAME", Suite.customAgentName options)+        , ("STARTUP_DELAY",+            (if Suite.startupDelay options then Just "2500" else Nothing))+        , ("SIMULATE_CONNECTION_LOSS",+             booleanEnv $ Suite.simulateConnectionLoss options)+        , ("LOG_LEVEL", Just logLevel)+        ]+        "stack exec instana-haskell-agent-stub"     appCommand =-      (if Maybe.isJust customAgentName-        then-          let-            Just agentName = customAgentName-          in-           "INSTANA_AGENT_NAME=\"" ++ agentName ++ "\" "-        else ""-      ) ++-      "INSTANA_LOG_LEVEL=INFO " ++-      "stack exec instana-haskell-test-wai-server"+      buildCommand+        [ ("APP_LOG_LEVEL", Just logLevel)+        , ("INSTANA_AGENT_NAME", Suite.customAgentName options)+        , ("INSTANA_LOG_LEVEL", Just logLevel)+        ]+        "stack exec " ++ Suite.appUnderTest options -  putStrLn $ "Running: " ++ agentStubCommand+  infoM testLogger $ "Running: " ++ agentStubCommand   Process.withCreateProcess     (Process.shell agentStubCommand)     (\_ _ _ _ -> do-      putStrLn $ "Running: " ++ appCommand+      infoM testLogger $ "Running: " ++ appCommand       Process.withCreateProcess         (Process.shell appCommand)         (\_ _ _ _ -> runTests suite)@@ -135,15 +123,15 @@  runTests :: Suite -> IO Counts runTests suite = do-  putStrFlush "⏱  waiting for agent stub to come up"+  infoM testLogger "⏱  waiting for agent stub to come up"   _ <- HttpHelper.retryRequestRecovering TestHelper.pingAgentStub-  putStrLn "\n✅ agent stub is up"-  putStrFlush "⏱  waiting for app to come up"+  infoM testLogger "✅ agent stub is up"+  infoM testLogger "⏱  waiting for app to come up"   appPingResponse <- HttpHelper.retryRequestRecovering TestHelper.pingApp   let     appPingBody = HTTP.responseBody appPingResponse     appPid = (read (LBSC8.unpack appPingBody) :: Int)-  putStrLn $ "\n✅ app is up, PID is " ++ (show appPid)+  infoM testLogger $ "✅ app is up, PID is " ++ (show appPid)   results <-     waitForAgentConnectionAndRun suite appPid   -- The withProcess calls that starts the agent stub and the external app@@ -205,4 +193,33 @@   -- sequence all tests into one action   tests <- sequence testsWithReset   return $ TestLabel label $ TestList tests+++buildCommand :: [(String, Maybe String)] -> String -> String+buildCommand envVars command =+  let+    envVarsString =+      foldl+        (\cmd (key, var) ->+          case var of+            Just v  -> cmd ++ " " ++ key ++ "=\"" ++ v ++ "\""+            Nothing -> cmd+        )+        ""+        envVars+  in+    if null envVarsString then+      command+    else+      envVarsString ++ " " ++ command+++booleanEnv :: Bool -> Maybe String+booleanEnv b =+  if b then Just "true" else Nothing+++-- |Environment variable for the log level+logLevelKey :: String+logLevelKey = "TEST_LOG_LEVEL"
test/integration/Instana/SDK/IntegrationTest/Suite.hs view
@@ -30,6 +30,7 @@     , customAgentName        :: Maybe String     , startupDelay           :: Bool     , simulateConnectionLoss :: Bool+    , appUnderTest           :: String     }  @@ -40,6 +41,7 @@     , customAgentName        = Nothing     , startupDelay           = False     , simulateConnectionLoss = False+    , appUnderTest           = "instana-haskell-test-wai-server"     }
test/integration/Instana/SDK/IntegrationTest/TestHelper.hs view
@@ -25,6 +25,7 @@ import           Data.Text                               (Text) import qualified Data.Text                               as T import qualified Network.HTTP.Client                     as HTTP+import           System.Log.Logger                       (infoM)  import           Instana.SDK.AgentStub.DiscoveryRequest  (DiscoveryRequest) import qualified Instana.SDK.AgentStub.DiscoveryRequest  as DiscoveryRequest@@ -33,7 +34,8 @@ import           Instana.SDK.AgentStub.TraceRequest      (Span) import qualified Instana.SDK.AgentStub.TraceRequest      as TraceRequest import qualified Instana.SDK.IntegrationTest.HttpHelper  as HttpHelper-import           Instana.SDK.IntegrationTest.Util        (putStrFlush, (|>))+import           Instana.SDK.IntegrationTest.Logging     (testLogger)+import           Instana.SDK.IntegrationTest.Util        ((|>))   withSpanCreation ::@@ -54,7 +56,7 @@  pingApp :: IO (HTTP.Response LBS.ByteString) pingApp = do-  HttpHelper.doAppRequest "ping" "GET" []+  HttpHelper.doAppRequest "ping" "GET" [("X-INSTANA-L", "0")]   shutDownAgentStub :: IO ()@@ -73,7 +75,7 @@ shutDownApp :: IO () shutDownApp = do   catch-    ( HttpHelper.doAppRequest "shutdown" "POST" []+    ( HttpHelper.doAppRequest "shutdown" "POST" [("X-INSTANA-L", "0")]       >> return ()     )     -- Ignore all exceptions for the shutdown request. Either the app has@@ -100,7 +102,7 @@   discoveryWithPid <- waitForDiscoveryWithPid pid   case discoveryWithPid of     Left message1 -> do-      putStrLn $+      infoM testLogger $         "❗️ Could not establish agent connection " ++         "(discovery failed): " ++ message1       return $ Left $@@ -110,28 +112,28 @@       agentReady <- waitForAgentReadyWithPid pid       case agentReady of         Left message2 -> do-          putStrLn $+          infoM testLogger $             "❗️ Could not establish agent connection " ++             "(agent ready failed): " ++ message2           return $ Left $             "Could not establish agent connection " ++             "(agent ready failed): " ++ message2         Right _ -> do-          putStrLn $ "\n✅ agent connection has been established"+          infoM testLogger $ "✅ agent connection has been established"           return discoveryWithPid   waitForDiscoveryWithPid :: String -> IO (Either String (DiscoveryRequest, String)) waitForDiscoveryWithPid pidStr = do-  putStrFlush $ "⏱  waiting for discovery request for pid " ++ pidStr+  infoM testLogger $ "⏱  waiting for discovery request for pid " ++ pidStr   discoveries <-     HttpHelper.retryRequest (containsDiscoveryWithPid pidStr) getDiscoveries   case discoveries of     Left message -> do-      putStrLn $ "\n❗️ recorded discovery request could not be obtained"+      infoM testLogger $ "❗️ recorded discovery request could not be obtained"       return $ Left message     Right ds -> do-      putStrLn "\n✅ recorded discovery request obtained"+      infoM testLogger "✅ recorded discovery request obtained"       return $ Right $ (head ds, pidStr)  @@ -155,17 +157,17 @@  waitForAgentReadyWithPid :: String -> IO (Either String ()) waitForAgentReadyWithPid pidStr = do-  putStrFlush $ "⏱  waiting for agent ready request for pid " ++ pidStr+  infoM testLogger $ "⏱  waiting for agent ready request for pid " ++ pidStr   agentReadyPids <-     HttpHelper.retryRequest       (containsAgentReadyWithPid pidStr)       getAgentReadyPids   case agentReadyPids of     Left message -> do-      putStrLn $ "\n❗️ recorded agent ready request could not be obtained"+      infoM testLogger $ "❗️ recorded agent ready request could not be obtained"       return $ Left message     Right _ -> do-      putStrLn $ "\n✅ recorded agent ready request obtained"+      infoM testLogger $ "✅ recorded agent ready request obtained"       return $ Right ()  @@ -189,7 +191,7 @@  waitForEntityDataWithPid :: String -> IO (Either String [EntityDataRequest]) waitForEntityDataWithPid pidStr = do-  putStrFlush $+  infoM testLogger $     "⏱  waiting for entity data for pid " ++ pidStr ++ " to be collected"   entityDataRequests <-     HttpHelper.retryRequest@@ -197,10 +199,10 @@       getEntityDataRequests   case entityDataRequests of     Left message -> do-      putStrLn $ "\n❗️ recorded entity data request(s) could not be obtained"+      infoM testLogger $ "❗️ recorded entity data request(s) could not be obtained"       return $ Left message     Right _ -> do-      putStrLn $ "\n✅ recorded entity data request(s) have been obtained"+      infoM testLogger $ "✅ recorded entity data request(s) have been obtained"       return entityDataRequests  @@ -230,9 +232,9 @@  waitForSpansMatching :: [Text] -> IO (Either String [Span]) waitForSpansMatching expectedNames = do-  putStrFlush "⏱  waiting for spans to be processed"+  infoM testLogger "⏱  waiting for spans to be processed"   spans <- HttpHelper.retryRequest (hasMatchingSpans expectedNames) getSpans-  putStrLn "\n✅ spans have been processed"+  infoM testLogger "✅ spans have been processed"   return spans
test/integration/Instana/SDK/IntegrationTest/TestSuites.hs view
@@ -1,14 +1,15 @@ module Instana.SDK.IntegrationTest.TestSuites (allSuites) where  -import qualified Instana.SDK.IntegrationTest.BracketApi  as BracketApi-import qualified Instana.SDK.IntegrationTest.Connection  as Connection-import qualified Instana.SDK.IntegrationTest.HttpTracing as HttpTracing-import qualified Instana.SDK.IntegrationTest.LowLevelApi as LowLevelApi-import qualified Instana.SDK.IntegrationTest.Metrics     as Metrics-import           Instana.SDK.IntegrationTest.Suite       (ConditionalSuite (..),-                                                          Suite (..))-import qualified Instana.SDK.IntegrationTest.Suite       as Suite+import qualified Instana.SDK.IntegrationTest.BracketApi    as BracketApi+import qualified Instana.SDK.IntegrationTest.Connection    as Connection+import qualified Instana.SDK.IntegrationTest.HttpTracing   as HttpTracing+import qualified Instana.SDK.IntegrationTest.LowLevelApi   as LowLevelApi+import qualified Instana.SDK.IntegrationTest.Metrics       as Metrics+import           Instana.SDK.IntegrationTest.Suite         (ConditionalSuite (..),+                                                            Suite (..))+import qualified Instana.SDK.IntegrationTest.Suite         as Suite+import qualified Instana.SDK.IntegrationTest.WaiMiddleware as WaiMiddleware   allSuites :: [ConditionalSuite]@@ -21,6 +22,7 @@   , testPidTranslation   , testCustomAgentName   , testHttpTracing+  , testWaiMiddleware   , testMetrics   ] @@ -127,6 +129,24 @@         , HttpTracing.shouldSuppressWithLowLevelApi         ])       , Suite.options = Suite.defaultOptions+      }+++testWaiMiddleware :: ConditionalSuite+testWaiMiddleware =+  Run $+    Suite+      { Suite.label = "WAI Middleware"+      , Suite.tests = (\pid -> [+          WaiMiddleware.shouldCreateRootEntry pid+        , WaiMiddleware.shouldCreateNonRootEntry pid+        , WaiMiddleware.shouldSuppress+        ])+      , Suite.options =+          Suite.defaultOptions {+            Suite.appUnderTest =+              "instana-haskell-test-wai-with-middleware-server"+          }       }
+ test/integration/Instana/SDK/IntegrationTest/WaiMiddleware.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE OverloadedStrings #-}+module Instana.SDK.IntegrationTest.WaiMiddleware+  ( shouldCreateRootEntry+  , shouldCreateNonRootEntry+  , shouldSuppress+  ) where+++import           Control.Concurrent                     (threadDelay)+import           Data.Aeson                             ((.=))+import qualified Data.Aeson                             as Aeson+import qualified Data.ByteString.Lazy.Char8             as LBSC8+import qualified Data.List                              as List+import           Data.Maybe                             (isNothing)+import           Instana.SDK.AgentStub.TraceRequest     (From (..), Span)+import qualified Instana.SDK.AgentStub.TraceRequest     as TraceRequest+import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper+import           Instana.SDK.IntegrationTest.HUnitExtra (applyLabel, applyLabel,+                                                         assertAllIO, failIO)+import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper+import qualified Network.HTTP.Client                    as HTTP+import           Network.HTTP.Types                     (Header)+import           Test.HUnit+++shouldCreateRootEntry :: String -> IO Test+shouldCreateRootEntry pid =+  applyLabel "shouldCreateRootEntry" $+    runMiddlewareTest pid [] (applyConcat [rootEntryAsserts, asserts])+++shouldCreateNonRootEntry :: String -> IO Test+shouldCreateNonRootEntry pid =+  applyLabel "shouldCreateNonRootEntry" $ do+    runMiddlewareTest+      pid+      [ ("X-INSTANA-T", "test-trace-id")+      , ("X-INSTANA-S", "test-span-id")+      ]+      (applyConcat [nonRootEntryAsserts, asserts])+++shouldSuppress :: IO Test+shouldSuppress =+  applyLabel "shouldSuppress" $ do+    runSuppressedTest "api"+++runMiddlewareTest :: String -> [Header] -> (Span -> [Assertion]) -> IO Test+runMiddlewareTest pid headers extraAsserts =+  runTest pid "api?some=query&parameters=1" headers extraAsserts+++runTest :: String -> String -> [Header] -> (Span -> [Assertion]) -> IO Test+runTest pid urlPath headers extraAsserts = do+  response <-+    HttpHelper.doAppRequest urlPath "GET" headers+  let+    result = LBSC8.unpack $ HTTP.responseBody response+    from = Just $ From pid+  spansResults <-+    TestHelper.waitForSpansMatching+      [ "haskell.wai.server", "haskell.http.client" ]+  case spansResults of+    Left failure ->+      failIO $ "Could not load recorded spans from agent stub: " ++ failure+    Right spans -> do+      let+        maybeEntrySpan =+          TestHelper.getSpanByName "haskell.wai.server" spans+        maybeExitSpan = TestHelper.getSpanByName "haskell.http.client" spans+      if isNothing maybeEntrySpan || isNothing maybeExitSpan+        then+          failIO "expected spans have not been recorded"+        else do+          let+            Just entrySpan = maybeEntrySpan+            Just exitSpan = maybeExitSpan+          assertAllIO $+            (commonAsserts entrySpan exitSpan result from) +++            (extraAsserts entrySpan)+++runSuppressedTest :: String -> IO Test+runSuppressedTest urlPath = do+  response <-+    HttpHelper.doAppRequest urlPath "GET" [("X-INSTANA-L", "0")]+  let+    result = LBSC8.unpack $ HTTP.responseBody response+  -- wait a second, then check that no spans have been recorded+  threadDelay $ 10 * 1000+  spansResults <-+    TestHelper.waitForSpansMatching []+  case spansResults of+    Left failure ->+      failIO $ "Could not load recorded spans from agent stub: " ++ failure+    Right spans -> do+      if not (null spans)+        then+          failIO "spans have been recorded although they should have not"   else+          assertAllIO+            [ assertEqual "result" "{\"response\": \"ok\"}" result+            ]+++rootEntryAsserts :: Span -> [Assertion]+rootEntryAsserts entrySpan =+  [ assertEqual "root.traceId = root.spanId"+      (TraceRequest.t entrySpan)+      (TraceRequest.s entrySpan)+  , assertBool "root parent Id" $+      isNothing $ TraceRequest.p entrySpan+  ]+++nonRootEntryAsserts :: Span -> [Assertion]+nonRootEntryAsserts entrySpan =+  [ assertEqual "root.traceId"+      "test-trace-id"+      (TraceRequest.t entrySpan)+  , assertBool "root.spanId" $+      "test-trace-id" /= (TraceRequest.s entrySpan)+  , assertEqual "root parent Id"+      (Just $ "test-span-id")+      (TraceRequest.p entrySpan)+  ]+++commonAsserts :: Span -> Span -> String -> Maybe From -> [Assertion]+commonAsserts entrySpan exitSpan result from =+  [ assertEqual "result" "{\"response\": \"ok\"}" result+  , assertEqual "trace ID is consistent"+      (TraceRequest.t exitSpan)+      (TraceRequest.t entrySpan)+  , assertEqual "exit parent ID"+      (Just $ TraceRequest.s entrySpan)+      (TraceRequest.p exitSpan)+  , assertBool "entry timestamp" $ TraceRequest.ts entrySpan > 0+  , assertBool "entry duration" $ TraceRequest.d entrySpan > 0+  , assertEqual "entry kind" 1 (TraceRequest.k entrySpan)+  , assertEqual "entry error" 0 (TraceRequest.ec entrySpan)+  , assertEqual "entry from" from $ TraceRequest.f entrySpan+  , assertBool "exit timestamp" $ TraceRequest.ts exitSpan > 0+  , assertBool "exit duration" $ TraceRequest.d exitSpan > 0+  , assertEqual "exit kind" 2 (TraceRequest.k exitSpan)+  , assertEqual "exit error" 0 (TraceRequest.ec exitSpan)+  , assertEqual "exit from" from $ TraceRequest.f exitSpan+  , assertEqual "exit data"+    ( Aeson.object+      [ "http" .= (Aeson.object+          [ "method" .= ("GET" :: String)+          , "url"    .= ("http://127.0.0.1:1302/" :: String)+          , "params" .= ("some=query&parameters=2" :: String)+          , "status" .= (200 :: Int)+          ]+        )+      ]+    )+    (TraceRequest.spanData exitSpan)+  ]+++asserts :: Span -> [Assertion]+asserts entrySpan =+  [ assertEqual "entry data"+    ( Aeson.object+      [ "http"       .= (Aeson.object+          [ "method" .= ("GET" :: String)+          , "host"   .= ("127.0.0.1:1207" :: String)+          , "url"    .= ("/api" :: String)+          , "params" .= ("some=query&parameters=1" :: String)+          ]+        )+      ]+    )+    (TraceRequest.spanData entrySpan)+  ]+++applyConcat :: [a -> [b]] -> a -> [b]+applyConcat functions a =+  concat $ List.map ($ a) functions+
test/integration/Main.hs view
@@ -3,11 +3,13 @@  import           Test.HUnit +import qualified Instana.SDK.IntegrationTest.Logging    as Logging import qualified Instana.SDK.IntegrationTest.Runner     as TestRunner import qualified Instana.SDK.IntegrationTest.TestSuites as TestSuites   main :: IO Counts-main =+main = do+  Logging.initLogging   TestRunner.runSuites TestSuites.allSuites