LowLevelApi.hs

{-# LANGUAGE OverloadedStrings #-}
module Instana.SDK.IntegrationTest.LowLevelApi
  ( shouldRecordSpans
  , shouldRecordNonRootEntry
  , shouldMergeData
  ) where


import           Data.Aeson                             ((.=))
import qualified Data.Aeson                             as Aeson
import           Data.ByteString.Lazy.Char8             as LBSC8
import           Data.Maybe                             (isNothing)
import qualified Network.HTTP.Client                    as HTTP
import           Test.HUnit

import           Instana.SDK.AgentStub.TraceRequest     (From (..))
import qualified Instana.SDK.AgentStub.TraceRequest     as TraceRequest
import qualified Instana.SDK.IntegrationTest.HttpHelper as HttpHelper
import           Instana.SDK.IntegrationTest.HUnitExtra (applyLabel,
                                                         assertAllIO, failIO)
import qualified Instana.SDK.IntegrationTest.TestHelper as TestHelper


shouldRecordSpans :: String -> IO Test
shouldRecordSpans pid =
  applyLabel "shouldRecordSpans" $ do
    let
      from = Just $ From pid
    (result, spansResults) <-
      TestHelper.withSpanCreation
        createRootEntry
        [ "haskell.dummy.root.entry"
        , "haskell.dummy.exit"
        ]
    case spansResults of
      Left failure ->
         failIO $ "Could not load recorded spans from agent stub: " ++ failure
      Right spans -> do
        let
          maybeRootEntrySpan =
            TestHelper.getSpanByName "haskell.dummy.root.entry" spans
          maybeExitSpan = TestHelper.getSpanByName "haskell.dummy.exit" spans
        if isNothing maybeRootEntrySpan || isNothing maybeExitSpan
          then
            failIO "expected spans have not been recorded"
          else do
            let
              Just rootEntrySpan = maybeRootEntrySpan
              Just exitSpan = maybeExitSpan
            assertAllIO
              [ assertEqual "result" "exit done" result
              , assertEqual
                  "trace ID is consistent"
                  (TraceRequest.t rootEntrySpan)
                  (TraceRequest.t exitSpan)
              , assertEqual
                  "root.traceId == root.spanId"
                  (TraceRequest.t rootEntrySpan)
                  (TraceRequest.s rootEntrySpan)
              , assertBool
                  "root has no parent ID" $
                    isNothing $ TraceRequest.p rootEntrySpan
              , assertEqual
                  "exit parent ID"
                  (Just $ TraceRequest.s rootEntrySpan)
                  (TraceRequest.p exitSpan)
              , assertBool "entry timespan" $ TraceRequest.ts rootEntrySpan > 0
              , assertBool "entry duration" $ TraceRequest.d rootEntrySpan > 0
              , assertEqual "entry kind" 1 (TraceRequest.k rootEntrySpan)
              , assertEqual "entry error" 0 (TraceRequest.ec rootEntrySpan)
              , assertEqual "entry from" from $ TraceRequest.f rootEntrySpan
              , assertBool "exit timespan" $ 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
              ]


createRootEntry :: IO String
createRootEntry = do
  response <- HttpHelper.doAppRequest "low/level/api/root" "POST" []
  return $ LBSC8.unpack $ HTTP.responseBody response


shouldRecordNonRootEntry :: String -> IO Test
shouldRecordNonRootEntry pid =
  applyLabel "shouldRecordNonRootEntry" $ do
    let
      from = Just $ From pid
    (result, spansResults) <-
      TestHelper.withSpanCreation
        createNonRootEntry
        [ "haskell.dummy.entry"
        , "haskell.dummy.exit"
        ]
    case spansResults of
      Left failure ->
        failIO $ "Could not load recorded spans from agent stub: " ++ failure
      Right spans -> do
        let
          maybeEntrySpan =
            TestHelper.getSpanByName "haskell.dummy.entry" spans
          maybeExitSpan = TestHelper.getSpanByName "haskell.dummy.exit" spans
        if isNothing maybeEntrySpan || isNothing maybeExitSpan
          then
            failIO "expected spans have not been recorded"
          else do
            let
              Just entrySpan = maybeEntrySpan
              Just exitSpan = maybeExitSpan
            assertAllIO
              [ assertEqual "result" "exit done" result
              , assertEqual "entry.traceId" "trace-id"
                  (TraceRequest.t entrySpan)
              , assertEqual "exit.traceId" "trace-id" (TraceRequest.t exitSpan)
              , assertBool "entry.spanId isn't trace ID" $
                  TraceRequest.s entrySpan /= "trace-id"
              , assertBool "entry.spanId isn't parent ID" $
                  TraceRequest.s entrySpan /= "parent-id"
              , assertEqual "entry.parentId"
                  (Just "parent-id")
                  (TraceRequest.p entrySpan)
              , assertEqual "exit.parentId"
                  (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
              ]


createNonRootEntry :: IO String
createNonRootEntry = do
  response <- HttpHelper.doAppRequest "low/level/api/non-root" "POST" []
  return $ LBSC8.unpack $ HTTP.responseBody response


shouldMergeData :: String -> IO Test
shouldMergeData pid =
  applyLabel "shouldMergeData" $ do
    let
      from = Just $ From pid
    (result, spansResults) <-
      TestHelper.withSpanCreation
        createSpansWithData
        [ "haskell.dummy.root.entry"
        , "haskell.dummy.exit"
        ]
    case spansResults of
      Left failure ->
        failIO $ "Could not load recorded spans from agent stub: " ++ failure
      Right spans -> do
        let
          maybeRootEntrySpan =
            TestHelper.getSpanByName "haskell.dummy.root.entry" spans
          maybeExitSpan = TestHelper.getSpanByName "haskell.dummy.exit" spans
        if isNothing maybeRootEntrySpan || isNothing maybeExitSpan
          then
            failIO "expected spans have not been recorded"
          else do
            let
              Just rootEntrySpan = maybeRootEntrySpan
              Just exitSpan = maybeExitSpan
            assertAllIO
              [ assertEqual "result" "exit done" result
              , assertEqual "trace ID is consistent"
                  (TraceRequest.t exitSpan)
                  (TraceRequest.t rootEntrySpan)
              , assertEqual "traceId == spanId"
                  (TraceRequest.s rootEntrySpan)
                  (TraceRequest.t rootEntrySpan)
              , assertBool "root entry parent" $
                  isNothing $ TraceRequest.p rootEntrySpan
              , assertEqual "exit parent"
                  (Just $ TraceRequest.s rootEntrySpan)
                  (TraceRequest.p exitSpan)
              , assertBool "entry timestamp" $ TraceRequest.ts rootEntrySpan > 0
              , assertBool "entry duration" $ TraceRequest.d rootEntrySpan > 0
              , assertEqual "entry kind" 1 (TraceRequest.k rootEntrySpan)
              , assertEqual "entry error" 1 (TraceRequest.ec rootEntrySpan)
              , assertEqual "entry from" from $ TraceRequest.f rootEntrySpan
              , assertEqual "entry data"
                ( Aeson.object
                  [ "data1"     .= ("value1" :: String)
                  , "data2"     .= (1302 :: Int)
                  , "startKind" .= ("entry" :: String)
                  , "data2"     .= (1302 :: Int)
                  , "data3"     .= ("value3" :: String)
                  , "nested"    .= (Aeson.object [
                      "entry" .= (Aeson.object [
                        "key" .= ("nested.entry.value" :: String)
                      ])
                    ])
                  , "endKind"   .= ("entry" :: String)
                  ]
                )
                (TraceRequest.spanData rootEntrySpan)
              , assertBool "exit timestamp" $ TraceRequest.ts exitSpan > 0
              , assertBool "exit duration" $ TraceRequest.d exitSpan > 0
              , assertEqual "exit kind" 2 (TraceRequest.k exitSpan)
              , assertEqual "exit error" 1 (TraceRequest.ec exitSpan)
              , assertEqual "exit from" from $ TraceRequest.f exitSpan
              , assertEqual "exit data"
                ( Aeson.object
                  [ "data1"     .= ("value1" :: String)
                  , "data2"     .= (1302 :: Int)
                  , "startKind" .= ("exit" :: String)
                  , "data2"     .= (1302 :: Int)
                  , "data3"     .= ("value3" :: String)
                  , "nested"    .= (Aeson.object [
                      "exit" .= (Aeson.object [
                        "key" .= ("nested.exit.value" :: String)
                      ])
                    ])
                  , "endKind"   .= ("exit" :: String)
                  ]
                )
                (TraceRequest.spanData exitSpan)
              ]


createSpansWithData :: IO String
createSpansWithData = do
  response <- HttpHelper.doAppRequest "low/level/api/with-data" "POST" []
  return $ LBSC8.unpack $ HTTP.responseBody response