{-# LANGUAGE DeriveGeneric #-}
module Instana.SDK.Internal.Context
( AgentConnection(..)
, InternalContext(..)
, ConnectionState(..)
, isAgentConnectionEstablished
, mkAgentReadyState
, readAgentUuid
, readPid
, whenConnected
) where
import Control.Concurrent (ThreadId)
import Control.Concurrent.STM (STM)
import qualified Control.Concurrent.STM as STM
import Data.Map.Strict (Map)
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.FullSpan (FullSpan)
import Instana.SDK.Internal.Metrics.Sample (TimedSample)
import Instana.SDK.Internal.SpanStack (SpanStack)
data ConnectionState =
Unconnected
| AgentHostLookup
| Unannounced (String, Int)
| Announced (String, Int)
| AgentReady Ready
deriving (Eq, Show, Generic)
data Ready =
Ready
{ connection :: AgentConnection
, metrics :: Metrics.Store
} deriving (Generic)
instance Eq Ready where
r1 == r2 =
connection r1 == connection r2
instance Show Ready where
show r =
show $ connection r
data AgentConnection =
AgentConnection
{
agentHost :: String
, agentPort :: Int
, pid :: String
, agentUuid :: Text
}
deriving (Eq, Show, Generic)
mkAgentReadyState ::
(String, Int)
-> AnnounceResponse
-> Metrics.Store
-> ConnectionState
mkAgentReadyState (host_, port_) announceResponse metricsStore =
let
agentConnection = AgentConnection
{ agentHost = host_
, agentPort = port_
, pid = show $ AnnounceResponse.pid announceResponse
, agentUuid = AnnounceResponse.agentUuid announceResponse
}
in
AgentReady $
Ready
{ connection = agentConnection
, metrics = metricsStore
}
data InternalContext = InternalContext
{ config :: FinalConfig
, sdkStartTime :: Int
, httpManager :: HttpClient.Manager
, commandQueue :: STM.TQueue Command
, spanQueue :: STM.TVar (Seq FullSpan)
, connectionState :: STM.TVar ConnectionState
, fileDescriptor :: STM.TVar (Maybe CTypes.CInt)
, currentSpans :: STM.TVar (Map ThreadId SpanStack)
, previousMetricsSample :: STM.TVar TimedSample
}
instance Show InternalContext where
show context = show (config context)
isAgentConnectionEstablishedSTM :: InternalContext -> STM Bool
isAgentConnectionEstablishedSTM context = do
state <- STM.readTVar $ connectionState context
return $
case state of
AgentReady _ -> True
_ -> False
isAgentConnectionEstablished :: InternalContext -> IO Bool
isAgentConnectionEstablished context =
STM.atomically $ isAgentConnectionEstablishedSTM context
readAgentUuidSTM :: InternalContext -> STM (Maybe Text)
readAgentUuidSTM context = do
state <- STM.readTVar $ connectionState context
return $ mapConnectionState agentUuid state
readAgentUuid :: InternalContext -> IO (Maybe Text)
readAgentUuid context =
STM.atomically $ readAgentUuidSTM context
readPidSTM :: InternalContext -> STM (Maybe String)
readPidSTM context = do
state <- STM.readTVar $ connectionState context
return $ mapConnectionState pid state
readPid :: InternalContext -> IO (Maybe String)
readPid context =
STM.atomically $ readPidSTM context
mapConnectionState :: (AgentConnection -> a) -> ConnectionState -> Maybe a
mapConnectionState fn state =
case state of
AgentReady (Ready agentConnection _) ->
Just $ fn agentConnection
_ ->
Nothing
whenConnected ::
InternalContext
-> (AgentConnection -> Metrics.Store -> IO ())
-> IO ()
whenConnected context action = do
state <- STM.atomically $ STM.readTVar $ connectionState context
whenConnectedState
state
(\(Ready agentConnection metricsStore) ->
action agentConnection metricsStore
)
whenConnectedState :: ConnectionState -> (Ready -> IO ()) -> IO ()
whenConnectedState state action = do
case state of
Unconnected ->
return ()
AgentHostLookup ->
return ()
Unannounced _ ->
return ()
Announced _ ->
return ()
AgentReady ready -> do
action ready