Rts.hs

-- | 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 = do
  store <- liftIO Ekg.newStore
  liftIO $ Ekg.registerGcMetrics store

  void $ Immortal.create $ \_ -> do
    sample <- liftIO $ Ekg.sampleAll store
    traverse_ (uncurry flushEkgSample) $ HashMap.toList sample

    let seconds n = n * 1000000
    threadDelay $ seconds 1

flushEkgSample
  :: ( MonadUnliftIO m
     , MonadReader env m
     , HasDogStatsClient env
     , HasDogStatsTags env
     )
  => Text
  -> Ekg.Value
  -> m ()
flushEkgSample name = \case
  Ekg.Counter n -> Datadog.counter name [] $ fromIntegral n
  Ekg.Gauge n -> Datadog.gauge name [] $ fromIntegral n
  Ekg.Distribution d -> do
    Datadog.gauge (name <> "." <> "mean") [] $ Ekg.mean d
    Datadog.gauge (name <> "." <> "variance") [] $ Ekg.variance d
    Datadog.gauge (name <> "." <> "sum") [] $ Ekg.sum d
    Datadog.gauge (name <> "." <> "min") [] $ Ekg.min d
    Datadog.gauge (name <> "." <> "max") [] $ Ekg.max d
    Datadog.counter (name <> "." <> "count") [] $ fromIntegral $ Ekg.count d
  Ekg.Label _ -> pure ()