{-# LANGUAGE DeriveGeneric #-}
{-|
Module      : Instana.SDK.Internal.Context
Description : The Instana context holds everything that the SDK needs in terms of state.
-}
module Instana.SDK.Internal.Context
  ( AgentConnection(..)
  , InternalContext(..)
  , ConnectionState(..)
  , isAgentConnectionEstablished
  , mkAgentReadyState
  , readAgentUuid
  , readExtraHeaders
  , readSecretsMatcher
  , readPid
  , whenConnected
  ) where


import           Control.Concurrent                                         (ThreadId)
import           Control.Concurrent.STM                                     (STM)
import qualified Control.Concurrent.STM                                     as STM
import qualified Data.ByteString.Char8                                      as BSC8
import           Data.CaseInsensitive                                       (CI)
import qualified Data.CaseInsensitive                                       as CI
import           Data.Map.Strict                                            (Map)
import           Data.Maybe                                                 as Maybe
import           Data.Sequence                                              (Seq)
import           Data.Text                                                  (Text)
import qualified Foreign.C.Types                                            as CTypes
import           GHC.Generics
import           Network.HTTP.Client                                        as HttpClient
import qualified System.Metrics                                             as Metrics

import           Instana.SDK.Internal.AgentConnection.Json.AnnounceResponse (AnnounceResponse)
import qualified Instana.SDK.Internal.AgentConnection.Json.AnnounceResponse as AnnounceResponse
import           Instana.SDK.Internal.Command                               (Command)
import           Instana.SDK.Internal.Config                                (FinalConfig)
import           Instana.SDK.Internal.Metrics.Sample                        (TimedSample)
import           Instana.SDK.Internal.Secrets                               (SecretsMatcher)
import qualified Instana.SDK.Internal.Secrets                               as SecretsMatcher
import           Instana.SDK.Internal.SpanStack                             (SpanStack)
import           Instana.SDK.Internal.WireSpan                              (QueuedSpan)


-- |The current state of the connection to the agent.
data ConnectionState =
    -- |Connection handshake has not been started yet.
    Unconnected
    -- |Phase agent host lookup has been initiated.
  | AgentHostLookup
    -- |Agent host lookup is complete, the process has not been announced yet.
  | Unannounced (String, Int)
    -- |Announce was successful, waiting for the agent to signal readyness.
  | Announced (String, Int)
    -- |Agent has signaled that it is ready to accept data.
  | AgentReady Ready
  deriving (ConnectionState -> ConnectionState -> Bool
(ConnectionState -> ConnectionState -> Bool)
-> (ConnectionState -> ConnectionState -> Bool)
-> Eq ConnectionState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionState -> ConnectionState -> Bool
$c/= :: ConnectionState -> ConnectionState -> Bool
== :: ConnectionState -> ConnectionState -> Bool
$c== :: ConnectionState -> ConnectionState -> Bool
Eq, Int -> ConnectionState -> ShowS
[ConnectionState] -> ShowS
ConnectionState -> String
(Int -> ConnectionState -> ShowS)
-> (ConnectionState -> String)
-> ([ConnectionState] -> ShowS)
-> Show ConnectionState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionState] -> ShowS
$cshowList :: [ConnectionState] -> ShowS
show :: ConnectionState -> String
$cshow :: ConnectionState -> String
showsPrec :: Int -> ConnectionState -> ShowS
$cshowsPrec :: Int -> ConnectionState -> ShowS
Show, (forall x. ConnectionState -> Rep ConnectionState x)
-> (forall x. Rep ConnectionState x -> ConnectionState)
-> Generic ConnectionState
forall x. Rep ConnectionState x -> ConnectionState
forall x. ConnectionState -> Rep ConnectionState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConnectionState x -> ConnectionState
$cfrom :: forall x. ConnectionState -> Rep ConnectionState x
Generic)


-- |Data to hold after agent ready event.
data Ready =
  Ready
    { Ready -> AgentConnection
connection :: AgentConnection
    , Ready -> Store
metrics    :: Metrics.Store
    } deriving ((forall x. Ready -> Rep Ready x)
-> (forall x. Rep Ready x -> Ready) -> Generic Ready
forall x. Rep Ready x -> Ready
forall x. Ready -> Rep Ready x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ready x -> Ready
$cfrom :: forall x. Ready -> Rep Ready x
Generic)


instance Eq Ready where
  r1 :: Ready
r1 == :: Ready -> Ready -> Bool
== r2 :: Ready
r2 =
    Ready -> AgentConnection
connection Ready
r1 AgentConnection -> AgentConnection -> Bool
forall a. Eq a => a -> a -> Bool
== Ready -> AgentConnection
connection Ready
r2


instance Show Ready where
  show :: Ready -> String
show r :: Ready
r =
     AgentConnection -> String
forall a. Show a => a -> String
show (AgentConnection -> String) -> AgentConnection -> String
forall a b. (a -> b) -> a -> b
$ Ready -> AgentConnection
connection Ready
r


-- |Meta data about the connection to the agent.
data AgentConnection =
  AgentConnection
    {
      -- |the host of the agent we are connected to
      AgentConnection -> String
agentHost      :: String
      -- |the port of the agent we are connected to
    , AgentConnection -> Int
agentPort      :: Int
      -- |the PID of the monitored process
    , AgentConnection -> String
pid            :: String
      -- |the agent's UUID
    , AgentConnection -> Text
agentUuid      :: Text
      -- |the configured secrets matcher
    , AgentConnection -> SecretsMatcher
secretsMatcher :: SecretsMatcher
      -- |the configured list of HTTP headers to capture (or an empty list)
    , AgentConnection -> [CI ByteString]
extraHeaders   :: [CI BSC8.ByteString]
    }
  deriving (AgentConnection -> AgentConnection -> Bool
(AgentConnection -> AgentConnection -> Bool)
-> (AgentConnection -> AgentConnection -> Bool)
-> Eq AgentConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AgentConnection -> AgentConnection -> Bool
$c/= :: AgentConnection -> AgentConnection -> Bool
== :: AgentConnection -> AgentConnection -> Bool
$c== :: AgentConnection -> AgentConnection -> Bool
Eq, Int -> AgentConnection -> ShowS
[AgentConnection] -> ShowS
AgentConnection -> String
(Int -> AgentConnection -> ShowS)
-> (AgentConnection -> String)
-> ([AgentConnection] -> ShowS)
-> Show AgentConnection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AgentConnection] -> ShowS
$cshowList :: [AgentConnection] -> ShowS
show :: AgentConnection -> String
$cshow :: AgentConnection -> String
showsPrec :: Int -> AgentConnection -> ShowS
$cshowsPrec :: Int -> AgentConnection -> ShowS
Show, (forall x. AgentConnection -> Rep AgentConnection x)
-> (forall x. Rep AgentConnection x -> AgentConnection)
-> Generic AgentConnection
forall x. Rep AgentConnection x -> AgentConnection
forall x. AgentConnection -> Rep AgentConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AgentConnection x -> AgentConnection
$cfrom :: forall x. AgentConnection -> Rep AgentConnection x
Generic)


-- |Creates a "ready" connection state from an AnnounceResponse.
mkAgentReadyState ::
  (String, Int)
  -> AnnounceResponse
  -> Metrics.Store
  -> ConnectionState
mkAgentReadyState :: (String, Int) -> AnnounceResponse -> Store -> ConnectionState
mkAgentReadyState (host_ :: String
host_, port_ :: Int
port_) announceResponse :: AnnounceResponse
announceResponse metricsStore :: Store
metricsStore =
  let
    maybeTracingConfig :: Maybe TracingConfig
maybeTracingConfig = AnnounceResponse -> Maybe TracingConfig
AnnounceResponse.tracing AnnounceResponse
announceResponse
    maybeExtraHeaders :: Maybe (Maybe [String])
maybeExtraHeaders = TracingConfig -> Maybe [String]
AnnounceResponse.extraHttpHeaders (TracingConfig -> Maybe [String])
-> Maybe TracingConfig -> Maybe (Maybe [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TracingConfig
maybeTracingConfig
    maybeLegacyExtraHeaders :: Maybe [String]
maybeLegacyExtraHeaders = AnnounceResponse -> Maybe [String]
AnnounceResponse.extraHeaders AnnounceResponse
announceResponse
    extraHeadersList :: [String]
extraHeadersList =
      ([String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
Maybe.fromMaybe [] (Maybe [String] -> [String]) -> Maybe [String] -> [String]
forall a b. (a -> b) -> a -> b
$
        Maybe [String] -> Maybe (Maybe [String]) -> Maybe [String]
forall a. a -> Maybe a -> a
Maybe.fromMaybe
          -- Fall back to legacy extraHeaders if tracing.extra-http-headers is
          -- not present.
          Maybe [String]
maybeLegacyExtraHeaders
          -- Prefer the tracing.extra-http-headers over the legacy
          -- extraHeaders attribute.
          Maybe (Maybe [String])
maybeExtraHeaders)
    agentConnection :: AgentConnection
agentConnection = AgentConnection :: String
-> Int
-> String
-> Text
-> SecretsMatcher
-> [CI ByteString]
-> AgentConnection
AgentConnection
      { agentHost :: String
agentHost      = String
host_
      , agentPort :: Int
agentPort      = Int
port_
      , pid :: String
pid            = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ AnnounceResponse -> Int
AnnounceResponse.pid AnnounceResponse
announceResponse
      , agentUuid :: Text
agentUuid      = AnnounceResponse -> Text
AnnounceResponse.agentUuid AnnounceResponse
announceResponse
      , secretsMatcher :: SecretsMatcher
secretsMatcher = AnnounceResponse -> SecretsMatcher
AnnounceResponse.secrets AnnounceResponse
announceResponse
      , extraHeaders :: [CI ByteString]
extraHeaders   = (String -> CI ByteString) -> [String] -> [CI ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString)
-> (String -> ByteString) -> String -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSC8.pack) [String]
extraHeadersList
      }
  in
  Ready -> ConnectionState
AgentReady (Ready -> ConnectionState) -> Ready -> ConnectionState
forall a b. (a -> b) -> a -> b
$
    Ready :: AgentConnection -> Store -> Ready
Ready
      { connection :: AgentConnection
connection = AgentConnection
agentConnection
      , metrics :: Store
metrics    = Store
metricsStore
      }


{-| A container for all the things the Instana SDK needs to do its work.
-}
data InternalContext = InternalContext
  { InternalContext -> FinalConfig
config                :: FinalConfig
  , InternalContext -> Int
sdkStartTime          :: Int
  , InternalContext -> Manager
httpManager           :: HttpClient.Manager
  , InternalContext -> TQueue Command
commandQueue          :: STM.TQueue Command
  , InternalContext -> TVar (Seq QueuedSpan)
spanQueue             :: STM.TVar (Seq QueuedSpan)
  , InternalContext -> TVar ConnectionState
connectionState       :: STM.TVar ConnectionState
  , InternalContext -> TVar (Maybe CInt)
fileDescriptor        :: STM.TVar (Maybe CTypes.CInt)
  , InternalContext -> TVar (Map ThreadId SpanStack)
currentSpans          :: STM.TVar (Map ThreadId SpanStack)
  , InternalContext -> TVar TimedSample
previousMetricsSample :: STM.TVar TimedSample
  }


instance Show InternalContext where
  -- hide everything except for config when serializing context to string
  show :: InternalContext -> String
show context :: InternalContext
context = FinalConfig -> String
forall a. Show a => a -> String
show (InternalContext -> FinalConfig
config InternalContext
context)


isAgentConnectionEstablishedSTM :: InternalContext -> STM Bool
isAgentConnectionEstablishedSTM :: InternalContext -> STM Bool
isAgentConnectionEstablishedSTM context :: InternalContext
context = do
  ConnectionState
state <- TVar ConnectionState -> STM ConnectionState
forall a. TVar a -> STM a
STM.readTVar (TVar ConnectionState -> STM ConnectionState)
-> TVar ConnectionState -> STM ConnectionState
forall a b. (a -> b) -> a -> b
$ InternalContext -> TVar ConnectionState
connectionState InternalContext
context
  Bool -> STM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> STM Bool) -> Bool -> STM Bool
forall a b. (a -> b) -> a -> b
$
    case ConnectionState
state of
      AgentReady _ -> Bool
True
      _            -> Bool
False


-- |Checks if the connection to the agent has been established.
isAgentConnectionEstablished :: InternalContext -> IO Bool
isAgentConnectionEstablished :: InternalContext -> IO Bool
isAgentConnectionEstablished context :: InternalContext
context =
  STM Bool -> IO Bool
forall a. STM a -> IO a
STM.atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ InternalContext -> STM Bool
isAgentConnectionEstablishedSTM InternalContext
context


readAgentUuidSTM :: InternalContext -> STM (Maybe Text)
readAgentUuidSTM :: InternalContext -> STM (Maybe Text)
readAgentUuidSTM context :: InternalContext
context = do
  ConnectionState
state <- TVar ConnectionState -> STM ConnectionState
forall a. TVar a -> STM a
STM.readTVar (TVar ConnectionState -> STM ConnectionState)
-> TVar ConnectionState -> STM ConnectionState
forall a b. (a -> b) -> a -> b
$ InternalContext -> TVar ConnectionState
connectionState InternalContext
context
  Maybe Text -> STM (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> STM (Maybe Text)) -> Maybe Text -> STM (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (AgentConnection -> Text) -> ConnectionState -> Maybe Text
forall a. (AgentConnection -> a) -> ConnectionState -> Maybe a
mapConnectionState AgentConnection -> Text
agentUuid ConnectionState
state


-- |accessor for the agent UUID
readAgentUuid :: InternalContext -> IO (Maybe Text)
readAgentUuid :: InternalContext -> IO (Maybe Text)
readAgentUuid context :: InternalContext
context =
  STM (Maybe Text) -> IO (Maybe Text)
forall a. STM a -> IO a
STM.atomically (STM (Maybe Text) -> IO (Maybe Text))
-> STM (Maybe Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ InternalContext -> STM (Maybe Text)
readAgentUuidSTM InternalContext
context


readPidSTM :: InternalContext -> STM (Maybe String)
readPidSTM :: InternalContext -> STM (Maybe String)
readPidSTM context :: InternalContext
context = do
  ConnectionState
state <- TVar ConnectionState -> STM ConnectionState
forall a. TVar a -> STM a
STM.readTVar (TVar ConnectionState -> STM ConnectionState)
-> TVar ConnectionState -> STM ConnectionState
forall a b. (a -> b) -> a -> b
$ InternalContext -> TVar ConnectionState
connectionState InternalContext
context
  Maybe String -> STM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> STM (Maybe String))
-> Maybe String -> STM (Maybe String)
forall a b. (a -> b) -> a -> b
$ (AgentConnection -> String) -> ConnectionState -> Maybe String
forall a. (AgentConnection -> a) -> ConnectionState -> Maybe a
mapConnectionState AgentConnection -> String
pid ConnectionState
state


-- |accessor for the PID of the monitored process
readPid :: InternalContext -> IO (Maybe String)
readPid :: InternalContext -> IO (Maybe String)
readPid context :: InternalContext
context =
  STM (Maybe String) -> IO (Maybe String)
forall a. STM a -> IO a
STM.atomically (STM (Maybe String) -> IO (Maybe String))
-> STM (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ InternalContext -> STM (Maybe String)
readPidSTM InternalContext
context


readSecretsMatcherSTM :: InternalContext -> STM SecretsMatcher
readSecretsMatcherSTM :: InternalContext -> STM SecretsMatcher
readSecretsMatcherSTM context :: InternalContext
context = do
  ConnectionState
state <- TVar ConnectionState -> STM ConnectionState
forall a. TVar a -> STM a
STM.readTVar (TVar ConnectionState -> STM ConnectionState)
-> TVar ConnectionState -> STM ConnectionState
forall a b. (a -> b) -> a -> b
$ InternalContext -> TVar ConnectionState
connectionState InternalContext
context
  let
    secretsMacherMaybe :: Maybe SecretsMatcher
secretsMacherMaybe = (AgentConnection -> SecretsMatcher)
-> ConnectionState -> Maybe SecretsMatcher
forall a. (AgentConnection -> a) -> ConnectionState -> Maybe a
mapConnectionState AgentConnection -> SecretsMatcher
secretsMatcher ConnectionState
state
  SecretsMatcher -> STM SecretsMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (SecretsMatcher -> STM SecretsMatcher)
-> SecretsMatcher -> STM SecretsMatcher
forall a b. (a -> b) -> a -> b
$
    SecretsMatcher -> Maybe SecretsMatcher -> SecretsMatcher
forall a. a -> Maybe a -> a
Maybe.fromMaybe SecretsMatcher
SecretsMatcher.defaultSecretsMatcher Maybe SecretsMatcher
secretsMacherMaybe


-- |accessor for the secrets matching config
readSecretsMatcher :: InternalContext -> IO SecretsMatcher
readSecretsMatcher :: InternalContext -> IO SecretsMatcher
readSecretsMatcher context :: InternalContext
context =
  STM SecretsMatcher -> IO SecretsMatcher
forall a. STM a -> IO a
STM.atomically (STM SecretsMatcher -> IO SecretsMatcher)
-> STM SecretsMatcher -> IO SecretsMatcher
forall a b. (a -> b) -> a -> b
$ InternalContext -> STM SecretsMatcher
readSecretsMatcherSTM InternalContext
context


readExtraHeadersSTM :: InternalContext -> STM [CI BSC8.ByteString]
readExtraHeadersSTM :: InternalContext -> STM [CI ByteString]
readExtraHeadersSTM context :: InternalContext
context = do
  ConnectionState
state <- TVar ConnectionState -> STM ConnectionState
forall a. TVar a -> STM a
STM.readTVar (TVar ConnectionState -> STM ConnectionState)
-> TVar ConnectionState -> STM ConnectionState
forall a b. (a -> b) -> a -> b
$ InternalContext -> TVar ConnectionState
connectionState InternalContext
context
  let
    extraHeadersMaybe :: Maybe [CI ByteString]
extraHeadersMaybe = (AgentConnection -> [CI ByteString])
-> ConnectionState -> Maybe [CI ByteString]
forall a. (AgentConnection -> a) -> ConnectionState -> Maybe a
mapConnectionState AgentConnection -> [CI ByteString]
extraHeaders ConnectionState
state
  [CI ByteString] -> STM [CI ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CI ByteString] -> STM [CI ByteString])
-> [CI ByteString] -> STM [CI ByteString]
forall a b. (a -> b) -> a -> b
$
    [CI ByteString] -> Maybe [CI ByteString] -> [CI ByteString]
forall a. a -> Maybe a -> a
Maybe.fromMaybe [] Maybe [CI ByteString]
extraHeadersMaybe


-- |accessor for the extra http headers config
readExtraHeaders :: InternalContext -> IO [CI BSC8.ByteString]
readExtraHeaders :: InternalContext -> IO [CI ByteString]
readExtraHeaders context :: InternalContext
context =
  STM [CI ByteString] -> IO [CI ByteString]
forall a. STM a -> IO a
STM.atomically (STM [CI ByteString] -> IO [CI ByteString])
-> STM [CI ByteString] -> IO [CI ByteString]
forall a b. (a -> b) -> a -> b
$ InternalContext -> STM [CI ByteString]
readExtraHeadersSTM InternalContext
context


mapConnectionState :: (AgentConnection -> a) -> ConnectionState -> Maybe a
mapConnectionState :: (AgentConnection -> a) -> ConnectionState -> Maybe a
mapConnectionState fn :: AgentConnection -> a
fn state :: ConnectionState
state =
  case ConnectionState
state of
    AgentReady (Ready agentConnection :: AgentConnection
agentConnection _) ->
      a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ AgentConnection -> a
fn AgentConnection
agentConnection
    _ ->
      Maybe a
forall a. Maybe a
Nothing


-- |Executes an IO action only when the connection to the agent has been
-- established. The action receives the agent host/port, PID, the agent UUID and
-- the internal metrics store as parameters (basically everything that is only
-- available with an established agent connection).
whenConnected ::
  InternalContext
  -> (AgentConnection -> Metrics.Store -> IO ())
  -> IO ()
whenConnected :: InternalContext -> (AgentConnection -> Store -> IO ()) -> IO ()
whenConnected context :: InternalContext
context action :: AgentConnection -> Store -> IO ()
action = do
  ConnectionState
state <- STM ConnectionState -> IO ConnectionState
forall a. STM a -> IO a
STM.atomically (STM ConnectionState -> IO ConnectionState)
-> STM ConnectionState -> IO ConnectionState
forall a b. (a -> b) -> a -> b
$ TVar ConnectionState -> STM ConnectionState
forall a. TVar a -> STM a
STM.readTVar (TVar ConnectionState -> STM ConnectionState)
-> TVar ConnectionState -> STM ConnectionState
forall a b. (a -> b) -> a -> b
$ InternalContext -> TVar ConnectionState
connectionState InternalContext
context
  ConnectionState -> (Ready -> IO ()) -> IO ()
whenConnectedState
    ConnectionState
state
    (\(Ready agentConnection :: AgentConnection
agentConnection metricsStore :: Store
metricsStore) ->
      AgentConnection -> Store -> IO ()
action AgentConnection
agentConnection Store
metricsStore
    )


whenConnectedState :: ConnectionState -> (Ready -> IO ()) -> IO ()
whenConnectedState :: ConnectionState -> (Ready -> IO ()) -> IO ()
whenConnectedState state :: ConnectionState
state action :: Ready -> IO ()
action = do
  case ConnectionState
state of
    Unconnected ->
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    AgentHostLookup ->
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Unannounced _ ->
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Announced _ ->
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    AgentReady ready :: Ready
ready -> do
      Ready -> IO ()
action Ready
ready