-- | Mutable references for Prometheus metrics.
--
-- These metrics are independent from the metrics in "Hasura.Server.Metrics".
module Hasura.Server.Prometheus
  ( PrometheusMetrics (..),
    GraphQLRequestMetrics (..),
    EventTriggerMetrics (..),
    makeDummyPrometheusMetrics,
    ConnectionsGauge,
    Connections (..),
    newConnectionsGauge,
    readConnectionsGauge,
    incWarpThreads,
    decWarpThreads,
    incWebsocketConnections,
    decWebsocketConnections,
  )
where

import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
import Data.Int (Int64)
import Hasura.Prelude
import System.Metrics.Prometheus.Counter (Counter)
import System.Metrics.Prometheus.Counter qualified as Counter
import System.Metrics.Prometheus.Gauge (Gauge)
import System.Metrics.Prometheus.Gauge qualified as Gauge
import System.Metrics.Prometheus.Histogram (Histogram)
import System.Metrics.Prometheus.Histogram qualified as Histogram

--------------------------------------------------------------------------------

-- | Mutable references for Prometheus metrics.
data PrometheusMetrics = PrometheusMetrics
  { PrometheusMetrics -> ConnectionsGauge
pmConnections :: ConnectionsGauge,
    PrometheusMetrics -> Gauge
pmActiveSubscriptions :: Gauge,
    PrometheusMetrics -> GraphQLRequestMetrics
pmGraphQLRequestMetrics :: GraphQLRequestMetrics,
    PrometheusMetrics -> EventTriggerMetrics
pmEventTriggerMetrics :: EventTriggerMetrics
  }

data GraphQLRequestMetrics = GraphQLRequestMetrics
  { GraphQLRequestMetrics -> Counter
gqlRequestsQuerySuccess :: Counter,
    GraphQLRequestMetrics -> Counter
gqlRequestsQueryFailure :: Counter,
    GraphQLRequestMetrics -> Counter
gqlRequestsMutationSuccess :: Counter,
    GraphQLRequestMetrics -> Counter
gqlRequestsMutationFailure :: Counter,
    GraphQLRequestMetrics -> Counter
gqlRequestsUnknownFailure :: Counter,
    GraphQLRequestMetrics -> Histogram
gqlExecutionTimeSecondsQuery :: Histogram,
    GraphQLRequestMetrics -> Histogram
gqlExecutionTimeSecondsMutation :: Histogram
  }

data EventTriggerMetrics = EventTriggerMetrics
  { EventTriggerMetrics -> Gauge
eventTriggerHTTPWorkers :: Gauge,
    EventTriggerMetrics -> Histogram
eventQueueTimeSeconds :: Histogram
  }

-- | Create dummy mutable references without associating them to a metrics
-- store.
makeDummyPrometheusMetrics :: IO PrometheusMetrics
makeDummyPrometheusMetrics :: IO PrometheusMetrics
makeDummyPrometheusMetrics = do
  ConnectionsGauge
pmConnections <- IO ConnectionsGauge
newConnectionsGauge
  Gauge
pmActiveSubscriptions <- IO Gauge
Gauge.new
  GraphQLRequestMetrics
pmGraphQLRequestMetrics <- IO GraphQLRequestMetrics
makeDummyGraphQLRequestMetrics
  EventTriggerMetrics
pmEventTriggerMetrics <- IO EventTriggerMetrics
makeDummyEventTriggerMetrics
  PrometheusMetrics -> IO PrometheusMetrics
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrometheusMetrics :: ConnectionsGauge
-> Gauge
-> GraphQLRequestMetrics
-> EventTriggerMetrics
-> PrometheusMetrics
PrometheusMetrics {Gauge
ConnectionsGauge
EventTriggerMetrics
GraphQLRequestMetrics
pmEventTriggerMetrics :: EventTriggerMetrics
pmGraphQLRequestMetrics :: GraphQLRequestMetrics
pmActiveSubscriptions :: Gauge
pmConnections :: ConnectionsGauge
pmEventTriggerMetrics :: EventTriggerMetrics
pmGraphQLRequestMetrics :: GraphQLRequestMetrics
pmActiveSubscriptions :: Gauge
pmConnections :: ConnectionsGauge
..}

makeDummyGraphQLRequestMetrics :: IO GraphQLRequestMetrics
makeDummyGraphQLRequestMetrics :: IO GraphQLRequestMetrics
makeDummyGraphQLRequestMetrics = do
  Counter
gqlRequestsQuerySuccess <- IO Counter
Counter.new
  Counter
gqlRequestsQueryFailure <- IO Counter
Counter.new
  Counter
gqlRequestsMutationSuccess <- IO Counter
Counter.new
  Counter
gqlRequestsMutationFailure <- IO Counter
Counter.new
  Counter
gqlRequestsUnknownFailure <- IO Counter
Counter.new
  Histogram
gqlExecutionTimeSecondsQuery <- [UpperBound] -> IO Histogram
Histogram.new []
  Histogram
gqlExecutionTimeSecondsMutation <- [UpperBound] -> IO Histogram
Histogram.new []
  GraphQLRequestMetrics -> IO GraphQLRequestMetrics
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphQLRequestMetrics :: Counter
-> Counter
-> Counter
-> Counter
-> Counter
-> Histogram
-> Histogram
-> GraphQLRequestMetrics
GraphQLRequestMetrics {Counter
Histogram
gqlExecutionTimeSecondsMutation :: Histogram
gqlExecutionTimeSecondsQuery :: Histogram
gqlRequestsUnknownFailure :: Counter
gqlRequestsMutationFailure :: Counter
gqlRequestsMutationSuccess :: Counter
gqlRequestsQueryFailure :: Counter
gqlRequestsQuerySuccess :: Counter
gqlExecutionTimeSecondsMutation :: Histogram
gqlExecutionTimeSecondsQuery :: Histogram
gqlRequestsUnknownFailure :: Counter
gqlRequestsMutationFailure :: Counter
gqlRequestsMutationSuccess :: Counter
gqlRequestsQueryFailure :: Counter
gqlRequestsQuerySuccess :: Counter
..}

makeDummyEventTriggerMetrics :: IO EventTriggerMetrics
makeDummyEventTriggerMetrics :: IO EventTriggerMetrics
makeDummyEventTriggerMetrics = do
  Gauge
eventTriggerHTTPWorkers <- IO Gauge
Gauge.new
  Histogram
eventQueueTimeSeconds <- [UpperBound] -> IO Histogram
Histogram.new []
  EventTriggerMetrics -> IO EventTriggerMetrics
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventTriggerMetrics :: Gauge -> Histogram -> EventTriggerMetrics
EventTriggerMetrics {Gauge
Histogram
eventQueueTimeSeconds :: Histogram
eventTriggerHTTPWorkers :: Gauge
eventQueueTimeSeconds :: Histogram
eventTriggerHTTPWorkers :: Gauge
..}

--------------------------------------------------------------------------------

-- | A mutable reference for atomically sampling the number of websocket
-- connections and number of threads forked by the warp webserver.
--
-- Because we derive the number of (non-websocket) HTTP connections by the
-- difference of these two metrics, we must sample them simultaneously,
-- otherwise we might report a negative number of HTTP connections.
newtype ConnectionsGauge = ConnectionsGauge (IORef Connections)

data Connections = Connections
  { Connections -> Int64
connWarpThreads :: Int64,
    Connections -> Int64
connWebsockets :: Int64
  }

newConnectionsGauge :: IO ConnectionsGauge
newConnectionsGauge :: IO ConnectionsGauge
newConnectionsGauge =
  IORef Connections -> ConnectionsGauge
ConnectionsGauge
    (IORef Connections -> ConnectionsGauge)
-> IO (IORef Connections) -> IO ConnectionsGauge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connections -> IO (IORef Connections)
forall a. a -> IO (IORef a)
newIORef Connections :: Int64 -> Int64 -> Connections
Connections {connWarpThreads :: Int64
connWarpThreads = Int64
0, connWebsockets :: Int64
connWebsockets = Int64
0}

readConnectionsGauge :: ConnectionsGauge -> IO Connections
readConnectionsGauge :: ConnectionsGauge -> IO Connections
readConnectionsGauge (ConnectionsGauge IORef Connections
ref) = IORef Connections -> IO Connections
forall a. IORef a -> IO a
readIORef IORef Connections
ref

incWarpThreads :: ConnectionsGauge -> IO ()
incWarpThreads :: ConnectionsGauge -> IO ()
incWarpThreads =
  (Connections -> Connections) -> ConnectionsGauge -> IO ()
modifyConnectionsGauge ((Connections -> Connections) -> ConnectionsGauge -> IO ())
-> (Connections -> Connections) -> ConnectionsGauge -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connections
connections ->
    Connections
connections {connWarpThreads :: Int64
connWarpThreads = Connections -> Int64
connWarpThreads Connections
connections Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1}

decWarpThreads :: ConnectionsGauge -> IO ()
decWarpThreads :: ConnectionsGauge -> IO ()
decWarpThreads =
  (Connections -> Connections) -> ConnectionsGauge -> IO ()
modifyConnectionsGauge ((Connections -> Connections) -> ConnectionsGauge -> IO ())
-> (Connections -> Connections) -> ConnectionsGauge -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connections
connections ->
    Connections
connections {connWarpThreads :: Int64
connWarpThreads = Connections -> Int64
connWarpThreads Connections
connections Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1}

incWebsocketConnections :: ConnectionsGauge -> IO ()
incWebsocketConnections :: ConnectionsGauge -> IO ()
incWebsocketConnections =
  (Connections -> Connections) -> ConnectionsGauge -> IO ()
modifyConnectionsGauge ((Connections -> Connections) -> ConnectionsGauge -> IO ())
-> (Connections -> Connections) -> ConnectionsGauge -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connections
connections ->
    Connections
connections {connWebsockets :: Int64
connWebsockets = Connections -> Int64
connWebsockets Connections
connections Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1}

decWebsocketConnections :: ConnectionsGauge -> IO ()
decWebsocketConnections :: ConnectionsGauge -> IO ()
decWebsocketConnections =
  (Connections -> Connections) -> ConnectionsGauge -> IO ()
modifyConnectionsGauge ((Connections -> Connections) -> ConnectionsGauge -> IO ())
-> (Connections -> Connections) -> ConnectionsGauge -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connections
connections ->
    Connections
connections {connWebsockets :: Int64
connWebsockets = Connections -> Int64
connWebsockets Connections
connections Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1}

modifyConnectionsGauge ::
  (Connections -> Connections) -> ConnectionsGauge -> IO ()
modifyConnectionsGauge :: (Connections -> Connections) -> ConnectionsGauge -> IO ()
modifyConnectionsGauge Connections -> Connections
f (ConnectionsGauge IORef Connections
ref) =
  IORef Connections -> (Connections -> (Connections, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Connections
ref ((Connections -> (Connections, ())) -> IO ())
-> (Connections -> (Connections, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connections
connections -> (Connections -> Connections
f Connections
connections, ())