{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : Instana.SDK.Internal.AgentConnection.AgentHostLookup
Description : Handles the agent host lookup phase for establishing the
connection to the agent.
-}
module Instana.SDK.Internal.AgentConnection.AgentHostLookup
    ( lookupAgentHost
    ) where


import qualified Control.Concurrent.STM                                as STM
import           Control.Exception                                     (SomeException,
                                                                        catch)
import qualified Network.HTTP.Client                                   as HTTP
import qualified Network.HTTP.Types.Status                             as Status
import           System.Log.Logger                                     (debugM)

import qualified Instana.SDK.Internal.AgentConnection.Announce         as Announce
import           Instana.SDK.Internal.AgentConnection.DefaultGatewayIp (extractDefaultGatewayIp)
import           Instana.SDK.Internal.AgentConnection.ProcessInfo      (ProcessInfo)
import qualified Instana.SDK.Internal.Config                           as InternalConfig
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.Retry                            as Retry
import qualified Instana.SDK.Internal.URL                              as URL


type SuccessfullHost = (String, Int)


-- |Starts the agent host lookup phase.
lookupAgentHost ::
  InternalContext
  -> ProcessInfo
  -> IO ()
lookupAgentHost :: InternalContext -> ProcessInfo -> IO ()
lookupAgentHost context :: InternalContext
context processInfo :: ProcessInfo
processInfo = do
  String -> String -> IO ()
debugM String
instanaLogger "Starting agent host lookup."
  Either String SuccessfullHost
result <-
    RetryPolicyM IO
-> IO (Either String SuccessfullHost)
-> IO (Either String SuccessfullHost)
forall a.
Show a =>
RetryPolicyM IO -> IO (Either String a) -> IO (Either String a)
Retry.retryUntilRight
      RetryPolicyM IO
Retry.agentHostLookupRetryPolicy
      (InternalContext -> IO (Either String SuccessfullHost)
tryAll InternalContext
context)
  case Either String SuccessfullHost
result of
    Right successfulHost :: SuccessfullHost
successfulHost -> do
      String -> String -> IO ()
debugM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        "Found an agent to connect to: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SuccessfullHost -> String
forall a. Show a => a -> String
show SuccessfullHost
successfulHost String -> String -> String
forall a. [a] -> [a] -> [a]
++
        ", starting sensor-agent handshake."
      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)
          (SuccessfullHost -> ConnectionState
Unannounced SuccessfullHost
successfulHost)

      -- transition to next phase of sensor-agent handshake
      InternalContext -> ProcessInfo -> IO ()
Announce.announce InternalContext
context ProcessInfo
processInfo
    Left _ -> do
      -- Actually, this line should never be reached, as the agent host lookup
      -- is retried indefinitely.
      String -> String -> IO ()
debugM String
instanaLogger "Could not find an agent to connect to."
      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


tryAll :: InternalContext -> IO (Either String SuccessfullHost)
tryAll :: InternalContext -> IO (Either String SuccessfullHost)
tryAll context :: InternalContext
context = do
  Either String SuccessfullHost
resultConfiguredHost <- InternalContext -> IO (Either String SuccessfullHost)
tryConfiguredHost InternalContext
context
  case Either String SuccessfullHost
resultConfiguredHost of
    Right _ ->
      Either String SuccessfullHost -> IO (Either String SuccessfullHost)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String SuccessfullHost
resultConfiguredHost
    Left errc :: String
errc -> do
      String -> String -> IO ()
debugM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
errc String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", trying default gateway next."
      Either String SuccessfullHost
resultDefaultGateway <- InternalContext -> IO (Either String SuccessfullHost)
tryDefaultGateway InternalContext
context
      case Either String SuccessfullHost
resultDefaultGateway of
        Right _ ->
          Either String SuccessfullHost -> IO (Either String SuccessfullHost)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String SuccessfullHost
resultDefaultGateway
        Left errdg :: String
errdg -> do
          String -> String -> IO ()
debugM String
instanaLogger String
errdg
          Either String SuccessfullHost -> IO (Either String SuccessfullHost)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String SuccessfullHost
resultDefaultGateway


tryConfiguredHost :: InternalContext -> IO (Either String SuccessfullHost)
tryConfiguredHost :: InternalContext -> IO (Either String SuccessfullHost)
tryConfiguredHost context :: InternalContext
context = do
  let
    config :: FinalConfig
config = InternalContext -> FinalConfig
InternalContext.config InternalContext
context
    host :: String
host = FinalConfig -> String
InternalConfig.agentHost FinalConfig
config
    port :: Int
port = FinalConfig -> Int
InternalConfig.agentPort FinalConfig
config
  InternalContext
-> String -> Int -> IO (Either String SuccessfullHost)
tryHost InternalContext
context String
host Int
port


tryDefaultGateway :: InternalContext -> IO (Either String SuccessfullHost)
tryDefaultGateway :: InternalContext -> IO (Either String SuccessfullHost)
tryDefaultGateway context :: InternalContext
context = do
  let
    config :: FinalConfig
config = InternalContext -> FinalConfig
InternalContext.config InternalContext
context
    port :: Int
port = FinalConfig -> Int
InternalConfig.agentPort FinalConfig
config
  Either String String
defaultGateway <- IO (Either String String)
readDefaultGateway
  case Either String String
defaultGateway of
    Right gatewayHost :: String
gatewayHost ->
      InternalContext
-> String -> Int -> IO (Either String SuccessfullHost)
tryHost InternalContext
context String
gatewayHost Int
port
    Left err :: String
err ->
      Either String SuccessfullHost -> IO (Either String SuccessfullHost)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String SuccessfullHost
 -> IO (Either String SuccessfullHost))
-> Either String SuccessfullHost
-> IO (Either String SuccessfullHost)
forall a b. (a -> b) -> a -> b
$ String -> Either String SuccessfullHost
forall a b. a -> Either a b
Left String
err


tryHost ::
  InternalContext
  -> String
  -> Int
  -> IO (Either String SuccessfullHost)
tryHost :: InternalContext
-> String -> Int -> IO (Either String SuccessfullHost)
tryHost context :: InternalContext
context host :: String
host port :: Int
port = do
  let
    manager :: Manager
manager = InternalContext -> Manager
InternalContext.httpManager InternalContext
context
    agentRootUrl :: URL
agentRootUrl = String -> Int -> String -> URL
URL.mkHttp String
host Int
port ""
  String -> String -> IO ()
debugM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Trying to reach agent at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ URL -> String
forall a. Show a => a -> String
show URL
agentRootUrl
  Request
agentRootRequest <- 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
agentRootUrl
  let
    agentRootAction :: IO (Response ByteString)
agentRootAction = Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
agentRootRequest Manager
manager
  IO (Either String SuccessfullHost)
-> (SomeException -> IO (Either String SuccessfullHost))
-> IO (Either String SuccessfullHost)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
    (do
      Response ByteString
response <- IO (Response ByteString)
agentRootAction
      let
        httpStatus :: Int
httpStatus = Status -> Int
Status.statusCode (Status -> Int) -> Status -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Status
forall body. Response body -> Status
HTTP.responseStatus Response ByteString
response
      if Int
httpStatus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 200 Bool -> Bool -> Bool
&& Int
httpStatus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 300
      then do
        Either String SuccessfullHost -> IO (Either String SuccessfullHost)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String SuccessfullHost
 -> IO (Either String SuccessfullHost))
-> Either String SuccessfullHost
-> IO (Either String SuccessfullHost)
forall a b. (a -> b) -> a -> b
$ SuccessfullHost -> Either String SuccessfullHost
forall a b. b -> Either a b
Right (String
host, Int
port)
      else do
        Either String SuccessfullHost -> IO (Either String SuccessfullHost)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String SuccessfullHost
 -> IO (Either String SuccessfullHost))
-> Either String SuccessfullHost
-> IO (Either String SuccessfullHost)
forall a b. (a -> b) -> a -> b
$ String -> Either String SuccessfullHost
forall a b. a -> Either a b
Left (String -> Either String SuccessfullHost)
-> String -> Either String SuccessfullHost
forall a b. (a -> b) -> a -> b
$
          "Host at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ URL -> String
forall a. Show a => a -> String
show URL
agentRootUrl String -> String -> String
forall a. [a] -> [a] -> [a]
++ " did not respond with " String -> String -> String
forall a. [a] -> [a] -> [a]
++
          "expected HTTP status but with: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
httpStatus
    )
    (\e :: SomeException
e -> do
      let
        SomeException
_ = (SomeException
e :: SomeException)
      Either String SuccessfullHost -> IO (Either String SuccessfullHost)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String SuccessfullHost
 -> IO (Either String SuccessfullHost))
-> Either String SuccessfullHost
-> IO (Either String SuccessfullHost)
forall a b. (a -> b) -> a -> b
$ String -> Either String SuccessfullHost
forall a b. a -> Either a b
Left (String -> Either String SuccessfullHost)
-> String -> Either String SuccessfullHost
forall a b. (a -> b) -> a -> b
$
        "Could not reach agent at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ URL -> String
forall a. Show a => a -> String
show URL
agentRootUrl
    )


readDefaultGateway :: IO (Either String String)
readDefaultGateway :: IO (Either String String)
readDefaultGateway = do
  let
    routeFilePath :: String
routeFilePath = "/proc/self/net/route"
  IO (Either String String)
-> (SomeException -> IO (Either String String))
-> IO (Either String String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
    ( do
        String
routeFileContent <- String -> IO String
readFile String
routeFilePath
        let
          defaultGatewayIpM :: Maybe String
defaultGatewayIpM = String -> Maybe String
extractDefaultGatewayIp String
routeFileContent
        case Maybe String
defaultGatewayIpM of
          Just defaultGatewayIp :: String
defaultGatewayIp -> do
            String -> String -> IO ()
debugM String
instanaLogger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
              "Determined default gateway IP: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
defaultGatewayIp
            Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right String
defaultGatewayIp
          Nothing ->
            Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$
              String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$
                "Failed to parse default gateway IP from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
routeFilePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "."
    )
    (\(SomeException
e :: SomeException) -> do
      Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$
        String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$
          "Failed to read " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
routeFilePath String -> String -> String
forall a. [a] -> [a] -> [a]
++
          " to determine the default gateway IP: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
          SomeException -> String
forall a. Show a => a -> String
show SomeException
e
    )