{-# LANGUAGE DeriveGeneric #-}
{-|
Module      : Instana.SDK.Span.NonRootEntry
Description : An entry span that is not the root of a trace
-}
module Instana.SDK.Span.NonRootEntry
  ( NonRootEntry(..)
  , addAnnotation
  , addToErrorCount
  , setServiceName
  , setSynthetic
  , setTpFlag
  , setW3cTraceContext
  , spanName
  ) where


import           Data.Text                            (Text)
import           GHC.Generics

import           Instana.SDK.Internal.Id              (Id)
import           Instana.SDK.Internal.W3CTraceContext (W3CTraceContext)
import           Instana.SDK.Span.SpanData            (Annotation, SpanData)
import qualified Instana.SDK.Span.SpanData            as SpanData
import           Instana.SDK.Span.SpanType            (SpanType)
import qualified Instana.SDK.Span.SpanType            as SpanType


-- |An entry span that is not the root span of a trace.
data NonRootEntry =
  NonRootEntry
    {
      -- |The trace ID
      NonRootEntry -> Id
traceId         :: Id
      -- |The span ID
    , NonRootEntry -> Id
spanId          :: Id
      -- |The ID of the parent span
    , NonRootEntry -> Id
parentId        :: Id
      -- |The type of the span (SDK span or registerd span)
    , NonRootEntry -> SpanType
spanType        :: SpanType
      -- |The time the span started
    , NonRootEntry -> Int
timestamp       :: Int
      -- |The number of errors that occured during processing
    , NonRootEntry -> Int
errorCount      :: Int
      -- |An attribute for overriding the name of the service in Instana
    , NonRootEntry -> Maybe Text
serviceName     :: Maybe Text
      -- |A flag indicating that this span represents a synthetic call
    , NonRootEntry -> Bool
synthetic       :: Bool
      -- |Additional data for the span.
    , NonRootEntry -> SpanData
spanData        :: SpanData
      -- |The W3C Trace Context. An entry span only has an associated W3C trace
      -- context, if W3C trace context headers have been received.
    , NonRootEntry -> Maybe W3CTraceContext
w3cTraceContext :: Maybe W3CTraceContext
      -- |The span.tp flag. A span with span.tp = True has inherited the
      -- trace ID/parent ID from W3C trace context instead of Instana headers.
    , NonRootEntry -> Bool
tpFlag          :: Bool
    } deriving (NonRootEntry -> NonRootEntry -> Bool
(NonRootEntry -> NonRootEntry -> Bool)
-> (NonRootEntry -> NonRootEntry -> Bool) -> Eq NonRootEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonRootEntry -> NonRootEntry -> Bool
$c/= :: NonRootEntry -> NonRootEntry -> Bool
== :: NonRootEntry -> NonRootEntry -> Bool
$c== :: NonRootEntry -> NonRootEntry -> Bool
Eq, (forall x. NonRootEntry -> Rep NonRootEntry x)
-> (forall x. Rep NonRootEntry x -> NonRootEntry)
-> Generic NonRootEntry
forall x. Rep NonRootEntry x -> NonRootEntry
forall x. NonRootEntry -> Rep NonRootEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonRootEntry x -> NonRootEntry
$cfrom :: forall x. NonRootEntry -> Rep NonRootEntry x
Generic, Int -> NonRootEntry -> ShowS
[NonRootEntry] -> ShowS
NonRootEntry -> String
(Int -> NonRootEntry -> ShowS)
-> (NonRootEntry -> String)
-> ([NonRootEntry] -> ShowS)
-> Show NonRootEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonRootEntry] -> ShowS
$cshowList :: [NonRootEntry] -> ShowS
show :: NonRootEntry -> String
$cshow :: NonRootEntry -> String
showsPrec :: Int -> NonRootEntry -> ShowS
$cshowsPrec :: Int -> NonRootEntry -> ShowS
Show)


-- |The span name/type, e.g. a short string like "haskell.wai.server",
-- "haskell.http.client". For SDK spans this is always "sdk", the actual
-- name is then in span.data.sdk.name.
spanName :: NonRootEntry -> Text
spanName :: NonRootEntry -> Text
spanName = SpanType -> Text
SpanType.spanName (SpanType -> Text)
-> (NonRootEntry -> SpanType) -> NonRootEntry -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonRootEntry -> SpanType
spanType


-- |Add to the error count.
addToErrorCount :: Int -> NonRootEntry -> NonRootEntry
addToErrorCount :: Int -> NonRootEntry -> NonRootEntry
addToErrorCount increment :: Int
increment nonRootEntry :: NonRootEntry
nonRootEntry =
  let
    ec :: Int
ec = NonRootEntry -> Int
errorCount NonRootEntry
nonRootEntry
  in
  NonRootEntry
nonRootEntry { errorCount :: Int
errorCount = Int
ec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
increment }


-- |Override the name of the service for the associated call in Instana.
setServiceName :: Text -> NonRootEntry -> NonRootEntry
setServiceName :: Text -> NonRootEntry -> NonRootEntry
setServiceName serviceName_ :: Text
serviceName_ nonRootEntry :: NonRootEntry
nonRootEntry =
  NonRootEntry
nonRootEntry { serviceName :: Maybe Text
serviceName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
serviceName_ }


-- |Attaches a W3C trace context to the span.
setW3cTraceContext :: W3CTraceContext -> NonRootEntry -> NonRootEntry
setW3cTraceContext :: W3CTraceContext -> NonRootEntry -> NonRootEntry
setW3cTraceContext w3cTraceContext_ :: W3CTraceContext
w3cTraceContext_ nonRootEntry :: NonRootEntry
nonRootEntry =
  NonRootEntry
nonRootEntry { w3cTraceContext :: Maybe W3CTraceContext
w3cTraceContext = W3CTraceContext -> Maybe W3CTraceContext
forall a. a -> Maybe a
Just W3CTraceContext
w3cTraceContext_ }


-- |Set the span.tp flag. A span with span.tp = True has inherited the trace ID/
-- parent ID from W3C trace context instead of Instana headers.
setTpFlag :: NonRootEntry -> NonRootEntry
setTpFlag :: NonRootEntry -> NonRootEntry
setTpFlag nonRootEntry :: NonRootEntry
nonRootEntry =
  NonRootEntry
nonRootEntry { tpFlag :: Bool
tpFlag = Bool
True }


-- |Set the synthetic flag.
setSynthetic :: Bool -> NonRootEntry -> NonRootEntry
setSynthetic :: Bool -> NonRootEntry -> NonRootEntry
setSynthetic synthetic_ :: Bool
synthetic_ nonRootEntry :: NonRootEntry
nonRootEntry =
  NonRootEntry
nonRootEntry { synthetic :: Bool
synthetic = Bool
synthetic_ }


-- |Add an annotation to the span's data section. For SDK spans, the annotation
-- is added to span.data.sdk.custom.tags, for registered spans it is added
-- directly to span.data.
addAnnotation :: Annotation -> NonRootEntry -> NonRootEntry
addAnnotation :: Annotation -> NonRootEntry -> NonRootEntry
addAnnotation annotation :: Annotation
annotation nonRootEntry :: NonRootEntry
nonRootEntry =
  NonRootEntry
nonRootEntry { spanData :: SpanData
spanData = Annotation -> SpanData -> SpanData
SpanData.merge Annotation
annotation (SpanData -> SpanData) -> SpanData -> SpanData
forall a b. (a -> b) -> a -> b
$ NonRootEntry -> SpanData
spanData NonRootEntry
nonRootEntry }