{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Instana.SDK.TracingHeaders
Description : A set of tracing headers
-}
module Instana.SDK.TracingHeaders
  ( TracingHeaders(..)
  , TracingLevel(..)
  , levelHeaderName
  , parseXInstanaL
  , spanIdHeaderName
  , stringToTracingLevel
  , syntheticHeaderName
  , traceIdHeaderName
  , tracingLevelToString
  ) where


import           GHC.Generics
import qualified Network.HTTP.Types.Header as HTTPHeader
import           Text.Regex.PCRE           ((=~))


-- |X-INSTANA-T
traceIdHeaderName :: HTTPHeader.HeaderName
traceIdHeaderName :: HeaderName
traceIdHeaderName = "X-INSTANA-T"


-- |X-INSTANA-S
spanIdHeaderName :: HTTPHeader.HeaderName
spanIdHeaderName :: HeaderName
spanIdHeaderName = "X-INSTANA-S"


-- |X-INSTANA-L
levelHeaderName :: HTTPHeader.HeaderName
levelHeaderName :: HeaderName
levelHeaderName = "X-INSTANA-L"


-- |X-INSTANA-SYNTHETIC
syntheticHeaderName :: HTTPHeader.HeaderName
syntheticHeaderName :: HeaderName
syntheticHeaderName = "X-INSTANA-SYNTHETIC"


-- |Tracing level.
data TracingLevel =
    -- |Record calls.
    Trace
    -- |Don't record calls.
  | Suppress
  deriving (TracingLevel -> TracingLevel -> Bool
(TracingLevel -> TracingLevel -> Bool)
-> (TracingLevel -> TracingLevel -> Bool) -> Eq TracingLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TracingLevel -> TracingLevel -> Bool
$c/= :: TracingLevel -> TracingLevel -> Bool
== :: TracingLevel -> TracingLevel -> Bool
$c== :: TracingLevel -> TracingLevel -> Bool
Eq, (forall x. TracingLevel -> Rep TracingLevel x)
-> (forall x. Rep TracingLevel x -> TracingLevel)
-> Generic TracingLevel
forall x. Rep TracingLevel x -> TracingLevel
forall x. TracingLevel -> Rep TracingLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TracingLevel x -> TracingLevel
$cfrom :: forall x. TracingLevel -> Rep TracingLevel x
Generic, Int -> TracingLevel -> ShowS
[TracingLevel] -> ShowS
TracingLevel -> String
(Int -> TracingLevel -> ShowS)
-> (TracingLevel -> String)
-> ([TracingLevel] -> ShowS)
-> Show TracingLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TracingLevel] -> ShowS
$cshowList :: [TracingLevel] -> ShowS
show :: TracingLevel -> String
$cshow :: TracingLevel -> String
showsPrec :: Int -> TracingLevel -> ShowS
$cshowsPrec :: Int -> TracingLevel -> ShowS
Show)


-- |Converts a string into the tracing level.
stringToTracingLevel :: String -> TracingLevel
stringToTracingLevel :: String -> TracingLevel
stringToTracingLevel s :: String
s =
  if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "0" then TracingLevel
Suppress else TracingLevel
Trace


-- |Parses the X-INSTANA-L value to determine the tracing level, and optionally
-- the correlation type and correlation ID.
parseXInstanaL :: Maybe String -> (TracingLevel, Maybe String, Maybe String)
parseXInstanaL :: Maybe String -> (TracingLevel, Maybe String, Maybe String)
parseXInstanaL xInstanaLValueMaybe :: Maybe String
xInstanaLValueMaybe =
  case Maybe String
xInstanaLValueMaybe of
  Nothing ->
    (TracingLevel
Trace, Maybe String
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
  Just xInstanaLValue :: String
xInstanaLValue ->
    let
      (_, _, _, groups :: [String]
groups) =
        String
xInstanaLValue String -> String -> (String, String, String, [String])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
xInstanaLRegex :: (String, String, String, [String])
    in
    case [String]
groups of
      [] ->
        (TracingLevel
Trace, Maybe String
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
      ["", "", ""] ->
        (TracingLevel
Trace, Maybe String
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
      ["0", _, _] ->
        (TracingLevel
Suppress, Maybe String
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
      ["1", "", ""] ->
        (TracingLevel
Trace, Maybe String
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)
      ["1", _correlationType :: String
_correlationType, _correlationId :: String
_correlationId] ->
        (TracingLevel
Trace, String -> Maybe String
forall a. a -> Maybe a
Just String
_correlationType, String -> Maybe String
forall a. a -> Maybe a
Just String
_correlationId)
      _ ->
        (TracingLevel
Trace, Maybe String
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing)


xInstanaLRegex :: String
xInstanaLRegex :: String
xInstanaLRegex =
  -- example "1,correlationType=web;correlationId=1234567890abcdef"
  "^\\s*([01])\\s*(?:,\\s*correlationType\\s*=\\s*([^ ;]*)\\s*;\\s*correlationId\\s*=\\s*([^ ;]*)\\s*)?$"


-- |Converts tracing level into a string.
tracingLevelToString :: TracingLevel -> String
tracingLevelToString :: TracingLevel -> String
tracingLevelToString l :: TracingLevel
l =
  case TracingLevel
l of
    Trace    -> "1"
    Suppress -> "0"


-- |A set of tracing headers.
data TracingHeaders  =
  TracingHeaders
    {
      -- |the trace ID
      TracingHeaders -> Maybe String
traceId         :: Maybe String
      -- |the span ID
    , TracingHeaders -> Maybe String
spanId          :: Maybe String
      -- |the tracing level (on/off)
    , TracingHeaders -> TracingLevel
level           :: TracingLevel
      -- |eum correlation type
    , TracingHeaders -> Maybe String
correlationType :: Maybe String
      -- |eum correlation ID
    , TracingHeaders -> Maybe String
correlationId   :: Maybe String
      -- |synthetic flag
    , TracingHeaders -> Bool
synthetic       :: Bool
    } deriving (TracingHeaders -> TracingHeaders -> Bool
(TracingHeaders -> TracingHeaders -> Bool)
-> (TracingHeaders -> TracingHeaders -> Bool) -> Eq TracingHeaders
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TracingHeaders -> TracingHeaders -> Bool
$c/= :: TracingHeaders -> TracingHeaders -> Bool
== :: TracingHeaders -> TracingHeaders -> Bool
$c== :: TracingHeaders -> TracingHeaders -> Bool
Eq, (forall x. TracingHeaders -> Rep TracingHeaders x)
-> (forall x. Rep TracingHeaders x -> TracingHeaders)
-> Generic TracingHeaders
forall x. Rep TracingHeaders x -> TracingHeaders
forall x. TracingHeaders -> Rep TracingHeaders x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TracingHeaders x -> TracingHeaders
$cfrom :: forall x. TracingHeaders -> Rep TracingHeaders x
Generic, Int -> TracingHeaders -> ShowS
[TracingHeaders] -> ShowS
TracingHeaders -> String
(Int -> TracingHeaders -> ShowS)
-> (TracingHeaders -> String)
-> ([TracingHeaders] -> ShowS)
-> Show TracingHeaders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TracingHeaders] -> ShowS
$cshowList :: [TracingHeaders] -> ShowS
show :: TracingHeaders -> String
$cshow :: TracingHeaders -> String
showsPrec :: Int -> TracingHeaders -> ShowS
$cshowsPrec :: Int -> TracingHeaders -> ShowS
Show)