-- | RTS statistics sent to Datadog
module Freckle.App.Datadog.Rts
  ( forkRtsStatPolling
  ) where

import Freckle.App.Prelude

import qualified Control.Immortal as Immortal
import qualified Data.HashMap.Strict as HashMap
import Freckle.App.Datadog (HasDogStatsClient, HasDogStatsTags)
import qualified Freckle.App.Datadog as Datadog
import qualified System.Metrics as Ekg
import qualified System.Metrics.Distribution.Internal as Ekg
import UnliftIO.Concurrent (threadDelay)

-- | Initialize a thread to poll RTS stats
--
-- Stats are collected via `ekg-core` and 'System.Metrics.registerGcMetrics'
--
forkRtsStatPolling
  :: ( MonadUnliftIO m
     , MonadReader env m
     , HasDogStatsClient env
     , HasDogStatsTags env
     )
  => m ()
forkRtsStatPolling :: m ()
forkRtsStatPolling = do
  Store
store <- IO Store -> m Store
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Store
Ekg.newStore
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Store -> IO ()
Ekg.registerGcMetrics Store
store

  m Thread -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Thread -> m ()) -> m Thread -> m ()
forall a b. (a -> b) -> a -> b
$ (Thread -> m ()) -> m Thread
forall (m :: * -> *).
MonadUnliftIO m =>
(Thread -> m ()) -> m Thread
Immortal.create ((Thread -> m ()) -> m Thread) -> (Thread -> m ()) -> m Thread
forall a b. (a -> b) -> a -> b
$ \Thread
_ -> do
    Sample
sample <- IO Sample -> m Sample
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sample -> m Sample) -> IO Sample -> m Sample
forall a b. (a -> b) -> a -> b
$ Store -> IO Sample
Ekg.sampleAll Store
store
    ((Text, Value) -> m ()) -> [(Text, Value)] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Text -> Value -> m ()) -> (Text, Value) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> Value -> m ()
flushEkgSample) ([(Text, Value)] -> m ()) -> [(Text, Value)] -> m ()
forall a b. (a -> b) -> a -> b
$ Sample -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList Sample
sample

    let seconds :: a -> a
seconds a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000
    Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
seconds Int
1

flushEkgSample
  :: ( MonadUnliftIO m
     , MonadReader env m
     , HasDogStatsClient env
     , HasDogStatsTags env
     )
  => Text
  -> Ekg.Value
  -> m ()
flushEkgSample :: Text -> Value -> m ()
flushEkgSample Text
name = \case
  Ekg.Counter Int64
n -> Text -> [(Text, Text)] -> Int -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> [(Text, Text)] -> Int -> m ()
Datadog.counter Text
name [] (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
  Ekg.Gauge Int64
n -> Text -> [(Text, Text)] -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> [(Text, Text)] -> Double -> m ()
Datadog.gauge Text
name [] (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
  Ekg.Distribution Stats
d -> do
    Text -> [(Text, Text)] -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> [(Text, Text)] -> Double -> m ()
Datadog.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"mean") [] (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.mean Stats
d
    Text -> [(Text, Text)] -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> [(Text, Text)] -> Double -> m ()
Datadog.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"variance") [] (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.variance Stats
d
    Text -> [(Text, Text)] -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> [(Text, Text)] -> Double -> m ()
Datadog.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"sum") [] (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.sum Stats
d
    Text -> [(Text, Text)] -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> [(Text, Text)] -> Double -> m ()
Datadog.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"min") [] (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.min Stats
d
    Text -> [(Text, Text)] -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> [(Text, Text)] -> Double -> m ()
Datadog.gauge (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"max") [] (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Stats -> Double
Ekg.max Stats
d
    Text -> [(Text, Text)] -> Int -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> [(Text, Text)] -> Int -> m ()
Datadog.counter (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"count") [] (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Stats -> Int64
Ekg.count Stats
d
  Ekg.Label Text
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()