RTS.hs

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Effectful.OpenTelemetry.Metrics.RTS where

import Control.Monad.Extra (whenM)
import Data.Functor (void)
import Data.Text (Text)
import Effectful
import Effectful.Dispatch.Static (unsafeEff_)
import Effectful.OpenTelemetry.Metrics.Effect (Metrics)
import Effectful.OpenTelemetry.Metrics.Effect qualified as Metrics
import Effectful.OpenTelemetry.Metrics.Gauge qualified as Gauge
import Effectful.OpenTelemetry.Metrics.Instrument (Instrument)
import Effectful.OpenTelemetry.Metrics.Instrument qualified as Instrument
import Effectful.OpenTelemetry.Metrics.Measurement (Measurement, NumberDataPoint (..))
import Effectful.OpenTelemetry.Metrics.Metadata (Metadata (..))
import Effectful.OpenTelemetry.Metrics.Sum (Monotonicity (..))
import Effectful.OpenTelemetry.Metrics.Sum qualified as Sum
import Effectful.OpenTelemetry.Timestamp (Timestamp)
import Effectful.OpenTelemetry.Timestamp qualified as Timestamp
import GHC.Stats (GCDetails (..), RTSStats (..))
import GHC.Stats qualified as Stats
import Prelude

-- | An asynchronous multi-'Instrument' which reports RTS metrics.
--
-- WARNING: Sampling throws an error if RTS stats are not enabled.
-- See 'Stats.getRTSStatsEnabled' for details.
--
-- Counters:
--
-- [@rts.gcs@] @gcs@: Total number of GCs.
-- [@rts.major_gcs@] @major_gcs@: Total number of major (oldest generation)
--   GCs.
-- [@rts.allocated_bytes@] @allocated_bytes@: Total bytes allocated.
-- [@rts.cumulative_live_bytes@] @cumulative_live_bytes@: Sum of live bytes
--   across all major GCs. Divided by @major_gcs@ gives the average live
--   data over the lifetime of the program.
-- [@rts.copied_bytes@] @copied_bytes@: Sum of @copied_bytes@ across all GCs.
-- [@rts.par_copied_bytes@] @par_copied_bytes@: Sum of @copied_bytes@ across
--   all parallel GCs.
-- [@rts.cumulative_par_balanced_copied_bytes@]
--   @cumulative_par_balanced_copied_bytes@: Sum of @par_balanced_copied@
--   bytes across all parallel GCs. (@base >= 4.11@)
-- [@rts.init_cpu_ns@] @init_cpu_ns@: Total CPU time used by the init phase.
--   (@base >= 4.12@)
-- [@rts.init_elapsed_ns@] @init_elapsed_ns@: Total elapsed time used by the
--   init phase. (@base >= 4.12@)
-- [@rts.mutator_cpu_ns@] @mutator_cpu_ns@: Total CPU time used by the
--   mutator.
-- [@rts.mutator_elapsed_ns@] @mutator_elapsed_ns@: Total elapsed time used
--   by the mutator.
-- [@rts.gc_cpu_ns@] @gc_cpu_ns@: Total CPU time used by the GC.
-- [@rts.gc_elapsed_ns@] @gc_elapsed_ns@: Total elapsed time used by the GC.
-- [@rts.cpu_ns@] @cpu_ns@: Total CPU time (at the previous GC).
-- [@rts.elapsed_ns@] @elapsed_ns@: Total elapsed time (at the previous GC).
-- [@rts.nonmoving_gc_sync_cpu_ns@] @nonmoving_gc_sync_cpu_ns@: The total CPU
--   time used during the post-mark pause phase of the concurrent nonmoving
--   GC. (@base >= 4.15@)
-- [@rts.nonmoving_gc_sync_elapsed_ns@] @nonmoving_gc_sync_elapsed_ns@: The
--   total time elapsed during the post-mark pause phase of the concurrent
--   nonmoving GC. (@base >= 4.15@)
-- [@rts.nonmoving_gc_cpu_ns@] @nonmoving_gc_cpu_ns@: The total CPU time used
--   by the nonmoving GC. (@base >= 4.15@)
-- [@rts.nonmoving_gc_elapsed_ns@] @nonmoving_gc_elapsed_ns@: The total time
--   elapsed during which there is a nonmoving GC active. (@base >= 4.15@)
--
-- Gauges:
--
-- [@rts.gc.allocated_bytes@] @gcdetails_allocated_bytes@: Number of bytes
--   allocated since the previous GC.
-- [@rts.gc.live_bytes@] @gcdetails_live_bytes@: Total amount of live data
--   in the heap (includes large + compact data). Updated after every GC.
--   Data in uncollected generations (in minor GCs) are considered live.
-- [@rts.gc.large_objects_bytes@] @gcdetails_large_objects_bytes@: Total
--   amount of live data in large objects.
-- [@rts.gc.compact_bytes@] @gcdetails_compact_bytes@: Total amount of live
--   data in compact regions.
-- [@rts.gc.slop_bytes@] @gcdetails_slop_bytes@: Total amount of slop
--   (wasted memory).
-- [@rts.gc.mem_in_use_bytes@] @gcdetails_mem_in_use_bytes@: Total amount of
--   memory in use by the RTS.
-- [@rts.gc.copied_bytes@] @gcdetails_copied_bytes@: Total amount of data
--   copied during this GC.
-- [@rts.gc.par_balanced_copied_bytes@] @gcdetails_par_balanced_copied_bytes@:
--   In parallel GC, the amount of balanced data copied by all threads.
--   (@base >= 4.11@)
-- [@rts.gc.block_fragmentation_bytes@] @gcdetails_block_fragmentation_bytes@:
--   The amount of memory lost due to block fragmentation in bytes. Block
--   fragmentation is the difference between the amount of blocks retained
--   by the RTS and the blocks that are in use. This occurs when megablocks
--   are only sparsely used, eg, when data that cannot be moved retains a
--   megablock. (@base >= 4.18@)
-- [@rts.gc.threads@] @gcdetails_threads@: Number of threads used in this GC.
-- [@rts.max_live_bytes@] @max_live_bytes@: Maximum live data (including
--   large objects + compact regions) in the heap. Updated after a major GC.
-- [@rts.max_large_objects_bytes@] @max_large_objects_bytes@: Maximum live
--   data in large objects.
-- [@rts.max_compact_bytes@] @max_compact_bytes@: Maximum live data in
--   compact regions.
-- [@rts.max_slop_bytes@] @max_slop_bytes@: Maximum slop.
-- [@rts.max_mem_in_use_bytes@] @max_mem_in_use_bytes@: Maximum memory in
--   use by the RTS.
-- [@rts.nonmoving_gc_sync_max_elapsed_ns@]
--   @nonmoving_gc_sync_max_elapsed_ns@: The maximum elapsed length of any
--   post-mark pause phase of the concurrent nonmoving GC. (@base >= 4.15@)
-- [@rts.nonmoving_gc_max_elapsed_ns@] @nonmoving_gc_max_elapsed_ns@: The
--   maximum time elapsed during any nonmoving GC cycle. (@base >= 4.15@)
-- [@rts.gc.gen@] @gcdetails_gen@: The generation number of this GC.
-- [@rts.gc.sync_elapsed_ns@] @gcdetails_sync_elapsed_ns@: The time elapsed
--   during synchronisation before GC.
-- [@rts.gc.cpu_ns@] @gcdetails_cpu_ns@: The CPU time used during GC itself.
-- [@rts.gc.elapsed_ns@] @gcdetails_elapsed_ns@: The time elapsed during GC
--   itself.
newtype RTS = RTS {startTime :: Timestamp}

-- | Create a new 'RTS' and register it to be sampled and exported.
new :: (Metrics :> es) => Eff es RTS
new =
    Metrics.register =<< unsafeEff_ do
        startTime <- Timestamp.now
        pure RTS{..}

-- | Register 'RTS' metrics to be sampled and exported.
-- WARNING: Errors if RTS stats are not enabled. Use 'run' to suppress this error.
register :: (Metrics :> es) => Eff es ()
register = void new

-- | If RTS stats are enabled, register 'RTS' metrics to be sampled and exported.
-- Otherwise no-op.
-- See 'Stats.getRTSStatsEnabled' for details.
run :: (IOE :> es, Metrics :> es) => Eff es a -> Eff es a
run eff = do
    whenM (liftIO Stats.getRTSStatsEnabled) register
    eff

instance Instrument RTS where
    name _ = "rts"
    sample rts = do
        time <- Timestamp.now
        stats <- Stats.getRTSStats
        pure [(time, m) | m <- measurements rts time stats]

{- FOURMOLU_DISABLE -}
measurements :: RTS -> Timestamp -> RTSStats -> [Measurement]
measurements RTS{startTime} time rts =
    [ Sum.measurement Monotonic (metadata "{gc}" "Total number of GCs") "rts.gcs" (point rts.gcs)
    , Sum.measurement Monotonic (metadata "{gc}" "Total number of major (oldest generation) GCs") "rts.major_gcs" (point rts.major_gcs)
    , Sum.measurement Monotonic (metadata "By" "Total bytes allocated") "rts.allocated_bytes" (point rts.allocated_bytes)
    , Sum.measurement Monotonic (metadata "By" "Sum of live bytes across all major GCs") "rts.cumulative_live_bytes" (point rts.cumulative_live_bytes)
    , Sum.measurement Monotonic (metadata "By" "Sum of copied bytes across all GCs") "rts.copied_bytes" (point rts.copied_bytes)
    , Sum.measurement Monotonic (metadata "By" "Sum of copied bytes across all parallel GCs") "rts.par_copied_bytes" (point rts.par_copied_bytes)
#if MIN_VERSION_base(4,11,0)
    , Sum.measurement
        Monotonic
        (metadata "By" "Sum of balanced copied bytes across all parallel GCs")
        "rts.cumulative_par_balanced_copied_bytes"
        (point rts.cumulative_par_balanced_copied_bytes)
#endif
#if MIN_VERSION_base(4,12,0)
    , Sum.measurement Monotonic (metadata "ns" "Total CPU time used by the init phase") "rts.init_cpu_ns" (point rts.init_cpu_ns)
    , Sum.measurement Monotonic (metadata "ns" "Total elapsed time used by the init phase") "rts.init_elapsed_ns" (point rts.init_elapsed_ns)
#endif
    , Sum.measurement Monotonic (metadata "ns" "Total CPU time used by the mutator") "rts.mutator_cpu_ns" (point rts.mutator_cpu_ns)
    , Sum.measurement Monotonic (metadata "ns" "Total elapsed time used by the mutator") "rts.mutator_elapsed_ns" (point rts.mutator_elapsed_ns)
    , Sum.measurement Monotonic (metadata "ns" "Total CPU time used by the GC") "rts.gc_cpu_ns" (point rts.gc_cpu_ns)
    , Sum.measurement Monotonic (metadata "ns" "Total elapsed time used by the GC") "rts.gc_elapsed_ns" (point rts.gc_elapsed_ns)
    , Sum.measurement Monotonic (metadata "ns" "Total CPU time (at the previous GC)") "rts.cpu_ns" (point rts.cpu_ns)
    , Sum.measurement Monotonic (metadata "ns" "Total elapsed time (at the previous GC)") "rts.elapsed_ns" (point rts.elapsed_ns)
#if MIN_VERSION_base(4,15,0)
    , Sum.measurement
        Monotonic
        (metadata "ns" "CPU time used during the post-mark pause phase of the nonmoving GC")
        "rts.nonmoving_gc_sync_cpu_ns"
        (point rts.nonmoving_gc_sync_cpu_ns)
    , Sum.measurement
        Monotonic
        (metadata "ns" "Elapsed time during the post-mark pause phase of the nonmoving GC")
        "rts.nonmoving_gc_sync_elapsed_ns"
        (point rts.nonmoving_gc_sync_elapsed_ns)
    , Sum.measurement
        Monotonic
        (metadata "ns" "Total CPU time used by the nonmoving GC")
        "rts.nonmoving_gc_cpu_ns"
        (point rts.nonmoving_gc_cpu_ns)
    , Sum.measurement
        Monotonic
        (metadata "ns" "Total time elapsed during which the nonmoving GC is active")
        "rts.nonmoving_gc_elapsed_ns"
        (point rts.nonmoving_gc_elapsed_ns)
#endif
    , Gauge.measurement (metadata "By" "Bytes allocated since the previous GC") "rts.gc.allocated_bytes" (point rts.gc.gcdetails_allocated_bytes)
    , Gauge.measurement (metadata "By" "Total amount of live data in the heap") "rts.gc.live_bytes" (point rts.gc.gcdetails_live_bytes)
    , Gauge.measurement (metadata "By" "Total amount of live data in large objects") "rts.gc.large_objects_bytes" (point rts.gc.gcdetails_large_objects_bytes)
    , Gauge.measurement (metadata "By" "Total amount of live data in compact regions") "rts.gc.compact_bytes" (point rts.gc.gcdetails_compact_bytes)
    , Gauge.measurement (metadata "By" "Total amount of slop (wasted memory)") "rts.gc.slop_bytes" (point rts.gc.gcdetails_slop_bytes)
    , Gauge.measurement (metadata "By" "Total amount of memory in use by the RTS") "rts.gc.mem_in_use_bytes" (point rts.gc.gcdetails_mem_in_use_bytes)
    , Gauge.measurement (metadata "By" "Total amount of data copied during the most recent GC") "rts.gc.copied_bytes" (point rts.gc.gcdetails_copied_bytes)
#if MIN_VERSION_base(4,11,0)
    , Gauge.measurement
        (metadata "By" "Amount of balanced data copied by all threads in the most recent parallel GC")
        "rts.gc.par_balanced_copied_bytes"
        (point rts.gc.gcdetails_par_balanced_copied_bytes)
#endif
#if MIN_VERSION_base(4,18,0)
    , Gauge.measurement
        (metadata "By" "Memory lost due to block fragmentation in the most recent GC")
        "rts.gc.block_fragmentation_bytes"
        (point rts.gc.gcdetails_block_fragmentation_bytes)
#endif
    , Gauge.measurement (metadata "{thread}" "Number of threads used in the most recent GC") "rts.gc.threads" (point rts.gc.gcdetails_threads)
    , Gauge.measurement (metadata "By" "Maximum live data in the heap") "rts.max_live_bytes" (point rts.max_live_bytes)
    , Gauge.measurement (metadata "By" "Maximum live data in large objects") "rts.max_large_objects_bytes" (point rts.max_large_objects_bytes)
    , Gauge.measurement (metadata "By" "Maximum live data in compact regions") "rts.max_compact_bytes" (point rts.max_compact_bytes)
    , Gauge.measurement (metadata "By" "Maximum slop") "rts.max_slop_bytes" (point rts.max_slop_bytes)
    , Gauge.measurement (metadata "By" "Maximum memory in use by the RTS") "rts.max_mem_in_use_bytes" (point rts.max_mem_in_use_bytes)
#if MIN_VERSION_base(4,15,0)
    , Gauge.measurement
        (metadata "ns" "Maximum elapsed time of any post-mark pause phase of the nonmoving GC")
        "rts.nonmoving_gc_sync_max_elapsed_ns"
        (point rts.nonmoving_gc_sync_max_elapsed_ns)
    , Gauge.measurement
        (metadata "ns" "Maximum time elapsed during any nonmoving GC cycle")
        "rts.nonmoving_gc_max_elapsed_ns"
        (point rts.nonmoving_gc_max_elapsed_ns)
#endif
    , Gauge.measurement (metadata "1" "Generation number of the most recent GC") "rts.gc.gen" (point rts.gc.gcdetails_gen)
    , Gauge.measurement
        (metadata "ns" "Time elapsed during synchronisation before the most recent GC")
        "rts.gc.sync_elapsed_ns"
        (point rts.gc.gcdetails_sync_elapsed_ns)
    , Gauge.measurement (metadata "ns" "CPU time used during the most recent GC") "rts.gc.cpu_ns" (point rts.gc.gcdetails_cpu_ns)
    , Gauge.measurement (metadata "ns" "Time elapsed during the most recent GC") "rts.gc.elapsed_ns" (point rts.gc.gcdetails_elapsed_ns)
    ]
  where
    metadata :: Text -> Text -> Metadata
    metadata unit description = Metadata{attributes = mempty, description = Just description, unit = Just unit}

    point :: (Integral a) => a -> NumberDataPoint
    point (fromIntegral -> value) = NumberDataPoint{attributes = mempty, ..}
{- FOURMOLU_ENABLE -}