{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Instana.SDK.Internal.ServerTiming
Description : Add/update the Server-Timing header
-}
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
addServerTimingHeader :: Id -> ResponseHeaders -> ResponseHeaders
addServerTimingHeader 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
appendInTIdToServerTimingHeader :: Id -> ByteString -> ResponseHeaders -> ResponseHeaders
appendInTIdToServerTimingHeader 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=[^,]*"