{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Instana.SDK.Internal.Metrics.Collector
Description : Initializes the collection of metrics and samples them at
              regular intervals.
-}
module Instana.SDK.Internal.Metrics.Collector
  ( registerMetrics
  , sampleAll
  ) where


import qualified Data.List                                        as List
import           Data.Text                                        (Text)
import qualified Data.Text                                        as T
import           Data.Time.Clock.POSIX                            (getPOSIXTime)
import qualified Data.Version                                     as Version
import           Paths_instana_haskell_trace_sdk                  (version)
import qualified System.Metrics                                   as Metrics
import qualified System.SysInfo                                   as SysInfo

import           Instana.SDK.Internal.AgentConnection.ProcessInfo (ProcessInfo)
import qualified Instana.SDK.Internal.AgentConnection.ProcessInfo as ProcessInfo
import           Instana.SDK.Internal.Util                        ((|>))


{-| Creates the ekg metric store and registers all relevant metrics for regular
collection.
-}
registerMetrics :: String -> ProcessInfo -> Int -> IO Metrics.Store
registerMetrics :: String -> ProcessInfo -> Int -> IO Store
registerMetrics translatedPid :: String
translatedPid processInfo :: ProcessInfo
processInfo sdkStartTime :: Int
sdkStartTime = do
  -- registerMetrics is executed once more after each connection loss/reconnect.
  -- It should not be an actual problem, as the previous metrics store should
  -- have been garbage collected.

  Store
instanaMetricsStore <- IO Store
Metrics.newStore

  -- register Instana specific metrics (mostly snapshot data)
  Store -> String -> ProcessInfo -> Int -> IO ()
registerCustomMetrics
    Store
instanaMetricsStore
    String
translatedPid
    ProcessInfo
processInfo
    Int
sdkStartTime

  -- register all predefined GC metrics provided by ekg
  Store -> IO ()
Metrics.registerGcMetrics Store
instanaMetricsStore
  Store -> IO Store
forall (m :: * -> *) a. Monad m => a -> m a
return Store
instanaMetricsStore


{-| Collects the current value for all registered metrics.
-}
sampleAll :: Metrics.Store -> IO Metrics.Sample
sampleAll :: Store -> IO Sample
sampleAll = Store -> IO Sample
Metrics.sampleAll


{-| Registers custom metrics (not included in the ekg default metrics).
-}
registerCustomMetrics ::
  Metrics.Store
  -> String
  -> ProcessInfo
  -> Int
  -> IO ()
registerCustomMetrics :: Store -> String -> ProcessInfo -> Int -> IO ()
registerCustomMetrics
    instanaMetricsStore :: Store
instanaMetricsStore
    translatedPid :: String
translatedPid
    processInfo :: ProcessInfo
processInfo
    sdkStartTime :: Int
sdkStartTime = do
  Int
startTime <- Int -> IO Int
calcStartTime Int
sdkStartTime
  Store -> Text -> String -> IO ()
registerConstantLabelMetric
    Store
instanaMetricsStore
    "pid"
    String
translatedPid
  Store -> Text -> String -> IO ()
registerConstantLabelMetric
    Store
instanaMetricsStore
    "programName"
    (ProcessInfo -> String
ProcessInfo.programName ProcessInfo
processInfo)
  Store -> Text -> String -> IO ()
registerConstantLabelMetric
    Store
instanaMetricsStore
    "executablePath"
    (ProcessInfo -> String
ProcessInfo.executablePath ProcessInfo
processInfo)
  Store -> Text -> String -> IO ()
registerConstantLabelMetric
    Store
instanaMetricsStore
    "arguments"
    (ProcessInfo -> [String]
ProcessInfo.arguments ProcessInfo
processInfo [String] -> ([String] -> String) -> String
forall a b. a -> (a -> b) -> b
|> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate " ")
  Store -> Text -> String -> IO ()
registerConstantLabelMetric
    Store
instanaMetricsStore
    "sensorVersion"
    (Version -> String
Version.showVersion Version
version)
  Store -> Text -> Int -> IO ()
registerConstantCounterMetric
    Store
instanaMetricsStore
    "startTime"
    Int
startTime


calcStartTime :: Int -> IO Int
calcStartTime :: Int -> IO Int
calcStartTime sdkStartTime :: Int
sdkStartTime = do
  Either Errno SysInfo
sysInfoOrError <- IO (Either Errno SysInfo)
SysInfo.sysInfo
  Int
now <- POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int) -> (POSIXTime -> POSIXTime) -> POSIXTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* 1000) (POSIXTime -> Int) -> IO POSIXTime -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime
  case Either Errno SysInfo
sysInfoOrError of
    Right sysInfo :: SysInfo
sysInfo -> do
      Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
now Int -> Int -> Int
forall a. Num a => a -> a -> a
- (CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLong -> Int) -> CLong -> Int
forall a b. (a -> b) -> a -> b
$ SysInfo -> CLong
SysInfo.uptime SysInfo
sysInfo)
    Left _ ->
      -- System.SysInfo is not available on non-Linux systems, we use the time
      -- when the SDK has been initialized as a fallback.
      Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
sdkStartTime


registerConstantLabelMetric :: Metrics.Store -> Text -> String -> IO ()
registerConstantLabelMetric :: Store -> Text -> String -> IO ()
registerConstantLabelMetric instanaMetricsStore :: Store
instanaMetricsStore label :: Text
label value :: String
value = do
  Text -> IO Text -> Store -> IO ()
Metrics.registerLabel Text
label (Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
value) Store
instanaMetricsStore


registerConstantCounterMetric :: Metrics.Store -> Text -> Int -> IO ()
registerConstantCounterMetric :: Store -> Text -> Int -> IO ()
registerConstantCounterMetric instanaMetricsStore :: Store
instanaMetricsStore label :: Text
label value :: Int
value = do
  Text -> IO Int64 -> Store -> IO ()
Metrics.registerCounter
    Text
label
    (Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> IO Int64) -> Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value)
    Store
instanaMetricsStore