{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
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)
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)
InternalContext -> ProcessInfo -> IO ()
Announce.announce InternalContext
context ProcessInfo
processInfo
Left _ -> do
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
)