{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Instana.SDK.TracingHeaders
( TracingHeaders(..)
, TracingLevel(..)
, levelHeaderName
, parseXInstanaL
, readHttpTracingHeaders
, spanIdHeaderName
, stringToTracingLevel
, syntheticHeaderName
, traceIdHeaderName
, traceparentHeaderName
, tracestateHeaderName
, tracingLevelToString
) where
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.List as List
import GHC.Generics
import qualified Network.HTTP.Types.Header as HTTPHeader
import qualified Network.Wai as Wai
import Text.Regex.PCRE ((=~))
import Instana.SDK.Internal.Util ((|>))
traceIdHeaderName :: HTTPHeader.HeaderName
= "X-INSTANA-T"
spanIdHeaderName :: HTTPHeader.HeaderName
= "X-INSTANA-S"
levelHeaderName :: HTTPHeader.HeaderName
= "X-INSTANA-L"
syntheticHeaderName :: HTTPHeader.HeaderName
= "X-INSTANA-SYNTHETIC"
traceparentHeaderName :: HTTPHeader.HeaderName
= "traceparent"
tracestateHeaderName :: HTTPHeader.HeaderName
= "tracestate"
data TracingLevel =
Trace
| 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)
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
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 =
"^\\s*([01])\\s*(?:,\\s*correlationType\\s*=\\s*([^ ;]*)\\s*;\\s*correlationId\\s*=\\s*([^ ;]*)\\s*)?$"
tracingLevelToString :: TracingLevel -> String
tracingLevelToString :: TracingLevel -> String
tracingLevelToString l :: TracingLevel
l =
case TracingLevel
l of
Trace -> "1"
Suppress -> "0"
data =
{
TracingHeaders -> Maybe String
traceId :: Maybe String
, TracingHeaders -> Maybe String
spanId :: Maybe String
, TracingHeaders -> TracingLevel
level :: TracingLevel
, TracingHeaders -> Maybe String
correlationType :: Maybe String
, TracingHeaders -> Maybe String
correlationId :: Maybe String
, TracingHeaders -> Bool
synthetic :: Bool
, TracingHeaders -> Maybe String
traceparent :: Maybe String
, TracingHeaders -> Maybe String
tracestate :: Maybe String
} 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)
readHttpTracingHeaders :: Wai.Request -> TracingHeaders
request :: Request
request =
let
headers :: RequestHeaders
headers = Request -> RequestHeaders
Wai.requestHeaders Request
request
tId :: Maybe String
tId =
RequestHeaders
headers
RequestHeaders
-> (RequestHeaders -> Maybe ByteString) -> Maybe ByteString
forall a b. a -> (a -> b) -> b
|> HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup HeaderName
traceIdHeaderName
Maybe ByteString
-> (Maybe ByteString -> Maybe String) -> Maybe String
forall a b. a -> (a -> b) -> b
|> (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) ByteString -> String
BSC8.unpack
sId :: Maybe String
sId =
RequestHeaders
headers
RequestHeaders
-> (RequestHeaders -> Maybe ByteString) -> Maybe ByteString
forall a b. a -> (a -> b) -> b
|> HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup HeaderName
spanIdHeaderName
Maybe ByteString
-> (Maybe ByteString -> Maybe String) -> Maybe String
forall a b. a -> (a -> b) -> b
|> (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) ByteString -> String
BSC8.unpack
xInstanaLValue :: Maybe String
xInstanaLValue =
RequestHeaders
headers
RequestHeaders
-> (RequestHeaders -> Maybe ByteString) -> Maybe ByteString
forall a b. a -> (a -> b) -> b
|> HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup HeaderName
levelHeaderName
Maybe ByteString
-> (Maybe ByteString -> Maybe String) -> Maybe String
forall a b. a -> (a -> b) -> b
|> (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) ByteString -> String
BSC8.unpack
(lvl :: TracingLevel
lvl, crtp :: Maybe String
crtp, crid :: Maybe String
crid) =
Maybe String -> (TracingLevel, Maybe String, Maybe String)
parseXInstanaL Maybe String
xInstanaLValue
sy :: Maybe String
sy =
RequestHeaders
headers
RequestHeaders
-> (RequestHeaders -> Maybe ByteString) -> Maybe ByteString
forall a b. a -> (a -> b) -> b
|> HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup HeaderName
syntheticHeaderName
Maybe ByteString
-> (Maybe ByteString -> Maybe String) -> Maybe String
forall a b. a -> (a -> b) -> b
|> (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) ByteString -> String
BSC8.unpack
tp :: Maybe String
tp =
RequestHeaders
headers
RequestHeaders
-> (RequestHeaders -> Maybe ByteString) -> Maybe ByteString
forall a b. a -> (a -> b) -> b
|> HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup HeaderName
traceparentHeaderName
Maybe ByteString
-> (Maybe ByteString -> Maybe String) -> Maybe String
forall a b. a -> (a -> b) -> b
|> (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) ByteString -> String
BSC8.unpack
ts :: Maybe String
ts =
RequestHeaders
headers
RequestHeaders
-> (RequestHeaders -> Maybe ByteString) -> Maybe ByteString
forall a b. a -> (a -> b) -> b
|> HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup HeaderName
tracestateHeaderName
Maybe ByteString
-> (Maybe ByteString -> Maybe String) -> Maybe String
forall a b. a -> (a -> b) -> b
|> (ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) ByteString -> String
BSC8.unpack
in
TracingHeaders :: Maybe String
-> Maybe String
-> TracingLevel
-> Maybe String
-> Maybe String
-> Bool
-> Maybe String
-> Maybe String
-> TracingHeaders
TracingHeaders
{ traceId :: Maybe String
traceId = Maybe String
tId
, spanId :: Maybe String
spanId = Maybe String
sId
, level :: TracingLevel
level = TracingLevel
lvl
, correlationType :: Maybe String
correlationType = Maybe String
crtp
, correlationId :: Maybe String
correlationId = Maybe String
crid
, synthetic :: Bool
synthetic = Maybe String
sy Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> Maybe String
forall a. a -> Maybe a
Just "1")
, traceparent :: Maybe String
traceparent = Maybe String
tp
, tracestate :: Maybe String
tracestate = Maybe String
ts
}