{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Instana.SDK.Internal.AgentConnection.AgentReady
Description : Handles the agent ready phase for establishing the connection to
the agent.
-}
module Instana.SDK.Internal.AgentConnection.AgentReady
    ( waitUntilAgentIsReadyToAcceptData
    ) where


import qualified Control.Concurrent.STM                                     as STM
import           Control.Exception                                          (SomeException,
                                                                             catch)
import           Data.ByteString.Lazy                                       (ByteString)
import qualified Network.HTTP.Client                                        as HTTP
import           System.Log.Logger                                          (debugM,
                                                                             infoM,
                                                                             warningM)

import           Instana.SDK.Internal.AgentConnection.Json.AnnounceResponse (AnnounceResponse)
import qualified Instana.SDK.Internal.AgentConnection.Json.AnnounceResponse as AnnounceResponse
import           Instana.SDK.Internal.AgentConnection.Json.Util             (emptyResponseDecoder)
import           Instana.SDK.Internal.AgentConnection.Paths                 (haskellEntityDataPathPrefix)
import           Instana.SDK.Internal.AgentConnection.ProcessInfo           (ProcessInfo)
import           Instana.SDK.Internal.Context                               (ConnectionState (..),
                                                                             InternalContext)
import qualified Instana.SDK.Internal.Context                               as InternalContext
import           Instana.SDK.Internal.Logging                               (instanaLogger)
import qualified Instana.SDK.Internal.Metrics.Collector                     as MetricsCollector
import qualified Instana.SDK.Internal.Retry                                 as Retry
import qualified Instana.SDK.Internal.URL                                   as URL


-- |Starts the connection establishment phase where we wait for the agent to
-- signal that it is ready to accept data.
waitUntilAgentIsReadyToAcceptData ::
  InternalContext
  -> String
  -> ProcessInfo
  -> AnnounceResponse
  -> IO ()
waitUntilAgentIsReadyToAcceptData :: InternalContext
-> String -> ProcessInfo -> AnnounceResponse -> IO ()
waitUntilAgentIsReadyToAcceptData
    context :: InternalContext
context
    originalPidStr :: String
originalPidStr
    processInfo :: ProcessInfo
processInfo
    announceResponse :: AnnounceResponse
announceResponse = do
  String -> String -> IO ()
debugM String
instanaLogger "Waiting until the agent is ready to accept data."
  ConnectionState
connectionState <-
      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
InternalContext.connectionState InternalContext
context
  case ConnectionState
connectionState of
    Announced hostAndPort :: (String, Int)
hostAndPort ->
      InternalContext
-> (String, Int)
-> String
-> ProcessInfo
-> AnnounceResponse
-> IO ()
waitForAgent
        InternalContext
context
        (String, Int)
hostAndPort
        String
originalPidStr
        ProcessInfo
processInfo
        AnnounceResponse
announceResponse
    _ -> do
      String -> String -> IO ()
warningM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        "Reached illegal state in agent ready, announce did not " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        "yield a host and port. Connection state is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConnectionState -> String
forall a. Show a => a -> String
show ConnectionState
connectionState String -> String -> String
forall a. [a] -> [a] -> [a]
++
        ". Will retry later."
      STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar ConnectionState -> ConnectionState -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar
        (InternalContext -> TVar ConnectionState
InternalContext.connectionState InternalContext
context)
        ConnectionState
Unconnected
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


waitForAgent ::
  InternalContext
  -> (String, Int)
  -> String
  -> ProcessInfo
  -> AnnounceResponse
  -> IO ()
waitForAgent :: InternalContext
-> (String, Int)
-> String
-> ProcessInfo
-> AnnounceResponse
-> IO ()
waitForAgent
    context :: InternalContext
context
    (host :: String
host, port :: Int
port)
    originalPidStr :: String
originalPidStr
    processInfo :: ProcessInfo
processInfo
    announceResponse :: AnnounceResponse
announceResponse = do
  let
    translatedPidStr :: String
translatedPidStr = 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
    pidTranslationStr :: String
pidTranslationStr =
      if String
translatedPidStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
originalPidStr
      then String
translatedPidStr
      else "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
originalPidStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ " => " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
translatedPidStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
    acceptDataUrl :: URL
acceptDataUrl =
      String -> Int -> String -> URL
URL.mkHttp String
host Int
port (String
haskellEntityDataPathPrefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
translatedPidStr)
  Request
agentReadyRequestBase <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseUrlThrow (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ URL -> String
forall a. Show a => a -> String
show URL
acceptDataUrl
  let
    acceptDataRequest :: Request
acceptDataRequest = Request
agentReadyRequestBase
       { method :: Method
HTTP.method = "HEAD"
       , requestHeaders :: RequestHeaders
HTTP.requestHeaders =
         [ ("Accept", "application/json")
         , ("Content-Type", "application/json; charset=UTF-8'")
         ]
       }
    manager :: Manager
manager = InternalContext -> Manager
InternalContext.httpManager InternalContext
context
    acceptDataRequestAction :: IO (HTTP.Response ByteString)
    acceptDataRequestAction :: IO (Response ByteString)
acceptDataRequestAction = Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
acceptDataRequest Manager
manager

  Bool
success <-
    IO Bool -> (SomeException -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
      (RetryPolicyM IO
-> (Response ByteString -> IO Bool)
-> IO (Response ByteString)
-> IO Bool
forall a.
RetryPolicyM IO
-> (Response ByteString -> IO a)
-> IO (Response ByteString)
-> IO a
Retry.retryRequest
        RetryPolicyM IO
Retry.acceptDataRetryPolicy
        Response ByteString -> IO Bool
emptyResponseDecoder
        IO (Response ByteString)
acceptDataRequestAction
      )
      (\e :: SomeException
e -> do
        String -> String -> IO ()
warningM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException)
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      )
    -- if 200 <= statusCode <= 299 then we assume everything is sweet and we
    -- transition to next state

  if Bool
success
    then do
      Store
metricsStore <-
        String -> ProcessInfo -> Int -> IO Store
MetricsCollector.registerMetrics
          String
translatedPidStr
          ProcessInfo
processInfo
          (InternalContext -> Int
InternalContext.sdkStartTime InternalContext
context)
      let
         state :: ConnectionState
state =
           (String, Int) -> AnnounceResponse -> Store -> ConnectionState
InternalContext.mkAgentReadyState
             (String
host, Int
port)
             AnnounceResponse
announceResponse
             Store
metricsStore
      STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TVar ConnectionState -> ConnectionState -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar (InternalContext -> TVar ConnectionState
InternalContext.connectionState InternalContext
context) ConnectionState
state
      String -> String -> IO ()
infoM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        "Agent connection established for process " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pidTranslationStr
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else do
    String -> String -> IO ()
warningM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      "Could not establish agent connection for process " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
pidTranslationStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (waiting for agent ready state failed), will " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      "retry later."
    STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar ConnectionState -> ConnectionState -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar
      (InternalContext -> TVar ConnectionState
InternalContext.connectionState InternalContext
context)
      ConnectionState
Unconnected