module Hasura.Server.Metrics
  ( ServerMetricsSpec (..),
    ServerMetrics (..),
    createServerMetrics,
  )
where

import Data.Kind (Type)
import GHC.TypeLits (Symbol)
import Hasura.Prelude
import System.Metrics
import System.Metrics.Distribution (Distribution)
import System.Metrics.Gauge (Gauge)

-- | A specification of the metrics tracked by the server.
--
-- The use of the "unit" type () for the "tag structure" type parameter of a
-- metric indicates that we prohibit that metric from being annotated with
-- tags.
data
  ServerMetricsSpec ::
    Symbol -> -- Metric name
    MetricType -> -- Metric type, e.g. Counter, Gauge
    Type -> -- Tag structure
    Type
  where
  -- | Current Number of active Warp threads
  WarpThreads ::
    ServerMetricsSpec
      "warp_threads"
      'GaugeType
      ()
  -- | Current number of active websocket connections
  WebsocketConnections ::
    ServerMetricsSpec
      "websocket_connections"
      'GaugeType
      ()
  -- | Current number of active subscriptions
  ActiveSubscriptions ::
    ServerMetricsSpec
      "active_subscriptions"
      'GaugeType
      ()
  -- | Total Number of events fetched from last 'Event Trigger Fetch'
  NumEventsFetchedPerBatch ::
    ServerMetricsSpec
      "events_fetched_per_batch"
      'DistributionType
      ()
  -- | Current number of Event trigger's HTTP workers in process
  NumEventHTTPWorkers ::
    ServerMetricsSpec
      "num_event_trigger_http_workers"
      'GaugeType
      ()
  -- | Time (in seconds) between the 'Event Trigger Fetch' from DB and the
  -- processing of the event
  EventQueueTime ::
    ServerMetricsSpec
      "event_queue_time"
      'DistributionType
      ()
  -- | The current schema cache metadata resource version
  SchemaCacheMetadataResourceVersion ::
    ServerMetricsSpec
      "schema_cache_metadata_resource_version"
      'GaugeType
      ()
  -- | Current number active live queries
  ActiveLiveQueries ::
    ServerMetricsSpec
      "active_livequeries"
      'GaugeType
      ()
  -- | Current number of streaming subscriptions
  ActiveStreaming ::
    ServerMetricsSpec
      "active_streaming_subscriptions"
      'GaugeType
      ()

-- | Mutable references for the server metrics. See `ServerMetricsSpec` for a
-- description of each metric.
data ServerMetrics = ServerMetrics
  { ServerMetrics -> Gauge
smWarpThreads :: !Gauge,
    ServerMetrics -> Gauge
smWebsocketConnections :: !Gauge,
    ServerMetrics -> Gauge
smActiveSubscriptions :: !Gauge,
    ServerMetrics -> Distribution
smNumEventsFetchedPerBatch :: !Distribution,
    ServerMetrics -> Gauge
smNumEventHTTPWorkers :: !Gauge,
    ServerMetrics -> Distribution
smEventQueueTime :: !Distribution,
    ServerMetrics -> Gauge
smSchemaCacheMetadataResourceVersion :: !Gauge,
    ServerMetrics -> Gauge
smActiveLiveQueries :: !Gauge,
    ServerMetrics -> Gauge
smActiveStreamingSubscriptions :: !Gauge
  }

createServerMetrics :: Store ServerMetricsSpec -> IO ServerMetrics
createServerMetrics :: Store ServerMetricsSpec -> IO ServerMetrics
createServerMetrics Store ServerMetricsSpec
store = do
  Gauge
smWarpThreads <- ServerMetricsSpec "warp_threads" 'GaugeType ()
-> () -> Store ServerMetricsSpec -> IO Gauge
forall (metrics :: Symbol -> MetricType -> * -> *) (name :: Symbol)
       tags.
(KnownSymbol name, ToTags tags) =>
metrics name 'GaugeType tags -> tags -> Store metrics -> IO Gauge
createGauge ServerMetricsSpec "warp_threads" 'GaugeType ()
WarpThreads () Store ServerMetricsSpec
store
  Gauge
smWebsocketConnections <- ServerMetricsSpec "websocket_connections" 'GaugeType ()
-> () -> Store ServerMetricsSpec -> IO Gauge
forall (metrics :: Symbol -> MetricType -> * -> *) (name :: Symbol)
       tags.
(KnownSymbol name, ToTags tags) =>
metrics name 'GaugeType tags -> tags -> Store metrics -> IO Gauge
createGauge ServerMetricsSpec "websocket_connections" 'GaugeType ()
WebsocketConnections () Store ServerMetricsSpec
store
  Gauge
smActiveSubscriptions <- ServerMetricsSpec "active_subscriptions" 'GaugeType ()
-> () -> Store ServerMetricsSpec -> IO Gauge
forall (metrics :: Symbol -> MetricType -> * -> *) (name :: Symbol)
       tags.
(KnownSymbol name, ToTags tags) =>
metrics name 'GaugeType tags -> tags -> Store metrics -> IO Gauge
createGauge ServerMetricsSpec "active_subscriptions" 'GaugeType ()
ActiveSubscriptions () Store ServerMetricsSpec
store
  Distribution
smNumEventsFetchedPerBatch <- ServerMetricsSpec "events_fetched_per_batch" 'DistributionType ()
-> () -> Store ServerMetricsSpec -> IO Distribution
forall (metrics :: Symbol -> MetricType -> * -> *) (name :: Symbol)
       tags.
(KnownSymbol name, ToTags tags) =>
metrics name 'DistributionType tags
-> tags -> Store metrics -> IO Distribution
createDistribution ServerMetricsSpec "events_fetched_per_batch" 'DistributionType ()
NumEventsFetchedPerBatch () Store ServerMetricsSpec
store
  Gauge
smNumEventHTTPWorkers <- ServerMetricsSpec "num_event_trigger_http_workers" 'GaugeType ()
-> () -> Store ServerMetricsSpec -> IO Gauge
forall (metrics :: Symbol -> MetricType -> * -> *) (name :: Symbol)
       tags.
(KnownSymbol name, ToTags tags) =>
metrics name 'GaugeType tags -> tags -> Store metrics -> IO Gauge
createGauge ServerMetricsSpec "num_event_trigger_http_workers" 'GaugeType ()
NumEventHTTPWorkers () Store ServerMetricsSpec
store
  Distribution
smEventQueueTime <- ServerMetricsSpec "event_queue_time" 'DistributionType ()
-> () -> Store ServerMetricsSpec -> IO Distribution
forall (metrics :: Symbol -> MetricType -> * -> *) (name :: Symbol)
       tags.
(KnownSymbol name, ToTags tags) =>
metrics name 'DistributionType tags
-> tags -> Store metrics -> IO Distribution
createDistribution ServerMetricsSpec "event_queue_time" 'DistributionType ()
EventQueueTime () Store ServerMetricsSpec
store
  Gauge
smSchemaCacheMetadataResourceVersion <- ServerMetricsSpec
  "schema_cache_metadata_resource_version" 'GaugeType ()
-> () -> Store ServerMetricsSpec -> IO Gauge
forall (metrics :: Symbol -> MetricType -> * -> *) (name :: Symbol)
       tags.
(KnownSymbol name, ToTags tags) =>
metrics name 'GaugeType tags -> tags -> Store metrics -> IO Gauge
createGauge ServerMetricsSpec
  "schema_cache_metadata_resource_version" 'GaugeType ()
SchemaCacheMetadataResourceVersion () Store ServerMetricsSpec
store
  Gauge
smActiveLiveQueries <- ServerMetricsSpec "active_livequeries" 'GaugeType ()
-> () -> Store ServerMetricsSpec -> IO Gauge
forall (metrics :: Symbol -> MetricType -> * -> *) (name :: Symbol)
       tags.
(KnownSymbol name, ToTags tags) =>
metrics name 'GaugeType tags -> tags -> Store metrics -> IO Gauge
createGauge ServerMetricsSpec "active_livequeries" 'GaugeType ()
ActiveLiveQueries () Store ServerMetricsSpec
store
  Gauge
smActiveStreamingSubscriptions <- ServerMetricsSpec "active_streaming_subscriptions" 'GaugeType ()
-> () -> Store ServerMetricsSpec -> IO Gauge
forall (metrics :: Symbol -> MetricType -> * -> *) (name :: Symbol)
       tags.
(KnownSymbol name, ToTags tags) =>
metrics name 'GaugeType tags -> tags -> Store metrics -> IO Gauge
createGauge ServerMetricsSpec "active_streaming_subscriptions" 'GaugeType ()
ActiveStreaming () Store ServerMetricsSpec
store
  ServerMetrics -> IO ServerMetrics
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerMetrics :: Gauge
-> Gauge
-> Gauge
-> Distribution
-> Gauge
-> Distribution
-> Gauge
-> Gauge
-> Gauge
-> ServerMetrics
ServerMetrics {Distribution
Gauge
smActiveStreamingSubscriptions :: Gauge
smActiveLiveQueries :: Gauge
smSchemaCacheMetadataResourceVersion :: Gauge
smEventQueueTime :: Distribution
smNumEventHTTPWorkers :: Gauge
smNumEventsFetchedPerBatch :: Distribution
smActiveSubscriptions :: Gauge
smWebsocketConnections :: Gauge
smWarpThreads :: Gauge
smActiveStreamingSubscriptions :: Gauge
smActiveLiveQueries :: Gauge
smSchemaCacheMetadataResourceVersion :: Gauge
smEventQueueTime :: Distribution
smNumEventHTTPWorkers :: Gauge
smNumEventsFetchedPerBatch :: Distribution
smActiveSubscriptions :: Gauge
smWebsocketConnections :: Gauge
smWarpThreads :: Gauge
..}