{-# LANGUAGE OverloadedStrings #-}
module Instana.SDK.Internal.ServerTiming
( addTraceIdToServerTiming
) where
import qualified Data.ByteString.Char8 as BSC8
import qualified Network.HTTP.Types as HTTPTypes
import Text.Regex (Regex)
import qualified Text.Regex as Regex
import Instana.SDK.Internal.Id (Id)
import qualified Instana.SDK.Internal.Id as Id
addTraceIdToServerTiming ::
Id
-> HTTPTypes.ResponseHeaders
-> HTTPTypes.ResponseHeaders
addTraceIdToServerTiming :: Id -> ResponseHeaders -> ResponseHeaders
addTraceIdToServerTiming traceId :: Id
traceId headers :: ResponseHeaders
headers =
let
existingValue :: Maybe ByteString
existingValue = HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "Server-Timing" ResponseHeaders
headers
result :: ResponseHeaders
result =
case Maybe ByteString
existingValue of
Nothing ->
Id -> ResponseHeaders -> ResponseHeaders
addServerTimingHeader Id
traceId ResponseHeaders
headers
Just existingMetrics :: ByteString
existingMetrics ->
Id -> ByteString -> ResponseHeaders -> ResponseHeaders
appendInTIdToServerTimingHeader Id
traceId ByteString
existingMetrics ResponseHeaders
headers
in
ResponseHeaders
result
addServerTimingHeader ::
Id
-> HTTPTypes.ResponseHeaders
-> HTTPTypes.ResponseHeaders
traceId :: Id
traceId headers :: ResponseHeaders
headers =
let
newValue :: ByteString
newValue = (String -> ByteString
BSC8.pack "intid;desc=") ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Id -> ByteString
Id.toByteString Id
traceId
in
ResponseHeaders
headers ResponseHeaders -> ResponseHeaders -> ResponseHeaders
forall a. [a] -> [a] -> [a]
++ [("Server-Timing", ByteString
newValue)]
appendInTIdToServerTimingHeader ::
Id
-> BSC8.ByteString
-> HTTPTypes.ResponseHeaders
-> HTTPTypes.ResponseHeaders
traceId :: Id
traceId existingMetrics :: ByteString
existingMetrics headers :: ResponseHeaders
headers =
if (ByteString -> ByteString -> Bool
BSC8.isInfixOf "intid;desc=" ByteString
existingMetrics)
then
Id -> ByteString -> ResponseHeaders -> ResponseHeaders
replaceExistingInTIdMetric Id
traceId ByteString
existingMetrics ResponseHeaders
headers
else
Id -> ByteString -> ResponseHeaders -> ResponseHeaders
appendInTIdMetricAtEnd Id
traceId ByteString
existingMetrics ResponseHeaders
headers
appendInTIdMetricAtEnd ::
Id
-> BSC8.ByteString
-> HTTPTypes.ResponseHeaders
-> HTTPTypes.ResponseHeaders
appendInTIdMetricAtEnd :: Id -> ByteString -> ResponseHeaders -> ResponseHeaders
appendInTIdMetricAtEnd traceId :: Id
traceId existingMetrics :: ByteString
existingMetrics headers :: ResponseHeaders
headers =
let
newServerTimingValue :: ByteString
newServerTimingValue =
ByteString
existingMetrics ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
(String -> ByteString
BSC8.pack ", intid;desc=") ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
Id -> ByteString
Id.toByteString Id
traceId
headersWithoutServerTiming :: ResponseHeaders
headersWithoutServerTiming =
((HeaderName, ByteString) -> Bool)
-> ResponseHeaders -> ResponseHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\(k :: HeaderName
k, _) -> HeaderName
k HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= "Server-Timing") ResponseHeaders
headers
in
ResponseHeaders
headersWithoutServerTiming ResponseHeaders -> ResponseHeaders -> ResponseHeaders
forall a. [a] -> [a] -> [a]
++ [("Server-Timing", ByteString
newServerTimingValue)]
replaceExistingInTIdMetric ::
Id
-> BSC8.ByteString
-> HTTPTypes.ResponseHeaders
-> HTTPTypes.ResponseHeaders
replaceExistingInTIdMetric :: Id -> ByteString -> ResponseHeaders -> ResponseHeaders
replaceExistingInTIdMetric traceId :: Id
traceId existingMetrics :: ByteString
existingMetrics headers :: ResponseHeaders
headers =
let
current :: String
current = ByteString -> String
BSC8.unpack ByteString
existingMetrics
replaced :: String
replaced =
Regex -> String -> String -> String
Regex.subRegex
Regex
replaceExistingRegex
String
current
("intid;desc=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Id -> String
Id.toString Id
traceId)
newServerTimingValue :: ByteString
newServerTimingValue = String -> ByteString
BSC8.pack String
replaced
headersWithoutServerTiming :: ResponseHeaders
headersWithoutServerTiming =
((HeaderName, ByteString) -> Bool)
-> ResponseHeaders -> ResponseHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\(k :: HeaderName
k, _) -> HeaderName
k HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= "Server-Timing") ResponseHeaders
headers
in
ResponseHeaders
headersWithoutServerTiming ResponseHeaders -> ResponseHeaders -> ResponseHeaders
forall a. [a] -> [a] -> [a]
++ [("Server-Timing", ByteString
newServerTimingValue)]
replaceExistingRegex :: Regex
replaceExistingRegex :: Regex
replaceExistingRegex =
String -> Regex
Regex.mkRegex "intid;desc=[^,]*"