{-# LANGUAGE DeriveAnyClass #-}

-- | Mutable references for Prometheus metrics.
--
-- These metrics are independent from the metrics in "Hasura.Server.Metrics".
module Hasura.Server.Prometheus
  ( PrometheusMetrics (..),
    GraphQLRequestMetrics (..),
    EventTriggerMetrics (..),
    CacheRequestMetrics (..),
    makeDummyPrometheusMetrics,
    ConnectionsGauge,
    Connections (..),
    newConnectionsGauge,
    readConnectionsGauge,
    incWarpThreads,
    decWarpThreads,
    incWebsocketConnections,
    decWebsocketConnections,
    ScheduledTriggerMetrics (..),
    SubscriptionMetrics (..),
    DynamicEventTriggerLabel (..),
    ResponseStatus (..),
    responseStatusToLabelValue,
    EventStatusLabel (..),
    eventSuccessLabel,
    eventFailedLabel,
    EventStatusWithTriggerLabel (..),
    GranularPrometheusMetricsState (..),
    observeHistogramWithLabel,
    SubscriptionKindLabel (..),
    SubscriptionLabel (..),
    DynamicSubscriptionLabel (..),
    streamingSubscriptionLabel,
    liveQuerySubscriptionLabel,
    recordMetricWithLabel,
    recordSubcriptionMetric,
  )
where

import Data.HashMap.Internal.Strict qualified as Map
import Data.HashMap.Strict qualified as HashMap
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
import Data.Int (Int64)
import Hasura.GraphQL.ParameterizedQueryHash
import Hasura.GraphQL.Transport.HTTP.Protocol (OperationName (..))
import Hasura.Prelude
import Hasura.RQL.Types.Common (SourceName, sourceNameToText)
import Hasura.RQL.Types.EventTrigger (TriggerName, triggerNameToTxt)
import Hasura.Server.Types (GranularPrometheusMetricsState (..))
import Language.GraphQL.Draft.Syntax qualified as G
import System.Metrics.Prometheus (ToLabels (..))
import System.Metrics.Prometheus.Counter (Counter)
import System.Metrics.Prometheus.Counter qualified as Counter
import System.Metrics.Prometheus.CounterVector (CounterVector)
import System.Metrics.Prometheus.CounterVector qualified as CounterVector
import System.Metrics.Prometheus.Gauge (Gauge)
import System.Metrics.Prometheus.Gauge qualified as Gauge
import System.Metrics.Prometheus.GaugeVector qualified as GaugeVector
import System.Metrics.Prometheus.Histogram (Histogram)
import System.Metrics.Prometheus.Histogram qualified as Histogram
import System.Metrics.Prometheus.HistogramVector (HistogramVector)
import System.Metrics.Prometheus.HistogramVector qualified as HistogramVector

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

-- | Mutable references for Prometheus metrics.
data PrometheusMetrics = PrometheusMetrics
  { PrometheusMetrics -> ConnectionsGauge
pmConnections :: ConnectionsGauge,
    PrometheusMetrics -> GraphQLRequestMetrics
pmGraphQLRequestMetrics :: GraphQLRequestMetrics,
    PrometheusMetrics -> EventTriggerMetrics
pmEventTriggerMetrics :: EventTriggerMetrics,
    PrometheusMetrics -> Counter
pmWebSocketBytesReceived :: Counter,
    PrometheusMetrics -> Counter
pmWebSocketBytesSent :: Counter,
    PrometheusMetrics -> Counter
pmActionBytesReceived :: Counter,
    PrometheusMetrics -> Counter
pmActionBytesSent :: Counter,
    PrometheusMetrics -> ScheduledTriggerMetrics
pmScheduledTriggerMetrics :: ScheduledTriggerMetrics,
    PrometheusMetrics -> SubscriptionMetrics
pmSubscriptionMetrics :: SubscriptionMetrics,
    PrometheusMetrics -> Histogram
pmWebsocketMsgQueueTimeSeconds :: Histogram,
    PrometheusMetrics -> CacheRequestMetrics
pmCacheRequestMetrics :: CacheRequestMetrics
  }

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

data EventTriggerMetrics = EventTriggerMetrics
  { EventTriggerMetrics -> Gauge
eventTriggerHTTPWorkers :: Gauge,
    EventTriggerMetrics -> Gauge
eventsFetchedPerBatch :: Gauge,
    EventTriggerMetrics
-> HistogramVector (Maybe DynamicEventTriggerLabel)
eventQueueTimeSeconds :: HistogramVector (Maybe DynamicEventTriggerLabel),
    EventTriggerMetrics -> Histogram
eventsFetchTimePerBatch :: Histogram,
    EventTriggerMetrics
-> HistogramVector (Maybe DynamicEventTriggerLabel)
eventWebhookProcessingTime :: HistogramVector (Maybe DynamicEventTriggerLabel),
    EventTriggerMetrics
-> HistogramVector (Maybe DynamicEventTriggerLabel)
eventProcessingTime :: HistogramVector (Maybe DynamicEventTriggerLabel),
    EventTriggerMetrics -> Counter
eventTriggerBytesReceived :: Counter,
    EventTriggerMetrics -> Counter
eventTriggerBytesSent :: Counter,
    EventTriggerMetrics -> CounterVector EventStatusWithTriggerLabel
eventProcessedTotal :: CounterVector EventStatusWithTriggerLabel,
    EventTriggerMetrics -> CounterVector EventStatusWithTriggerLabel
eventInvocationTotal :: CounterVector EventStatusWithTriggerLabel
  }

data ScheduledTriggerMetrics = ScheduledTriggerMetrics
  { ScheduledTriggerMetrics -> Counter
stmScheduledTriggerBytesReceived :: Counter,
    ScheduledTriggerMetrics -> Counter
stmScheduledTriggerBytesSent :: Counter,
    ScheduledTriggerMetrics -> Counter
stmCronEventsInvocationTotalSuccess :: Counter,
    ScheduledTriggerMetrics -> Counter
stmCronEventsInvocationTotalFailure :: Counter,
    ScheduledTriggerMetrics -> Counter
stmOneOffEventsInvocationTotalSuccess :: Counter,
    ScheduledTriggerMetrics -> Counter
stmOneOffEventsInvocationTotalFailure :: Counter,
    ScheduledTriggerMetrics -> Counter
stmCronEventsProcessedTotalSuccess :: Counter,
    ScheduledTriggerMetrics -> Counter
stmCronEventsProcessedTotalFailure :: Counter,
    ScheduledTriggerMetrics -> Counter
stmOneOffEventsProcessedTotalSuccess :: Counter,
    ScheduledTriggerMetrics -> Counter
stmOneOffEventsProcessedTotalFailure :: Counter
  }

data SubscriptionMetrics = SubscriptionMetrics
  { SubscriptionMetrics -> Gauge
submActiveLiveQueryPollers :: Gauge,
    SubscriptionMetrics -> Gauge
submActiveStreamingPollers :: Gauge,
    SubscriptionMetrics -> Gauge
submActiveLiveQueryPollersInError :: Gauge,
    SubscriptionMetrics -> Gauge
submActiveStreamingPollersInError :: Gauge,
    SubscriptionMetrics -> HistogramVector SubscriptionLabel
submTotalTime :: HistogramVector.HistogramVector SubscriptionLabel,
    SubscriptionMetrics -> HistogramVector SubscriptionLabel
submDBExecTotalTime :: HistogramVector.HistogramVector SubscriptionLabel,
    SubscriptionMetrics -> GaugeVector SubscriptionLabel
submActiveSubscriptions :: GaugeVector.GaugeVector SubscriptionLabel
  }

data CacheRequestMetrics = CacheRequestMetrics
  { CacheRequestMetrics -> Counter
crmCacheHits :: Counter,
    CacheRequestMetrics -> Counter
crmCacheMisses :: Counter
  }

-- | Create dummy mutable references without associating them to a metrics
-- store.
makeDummyPrometheusMetrics :: IO PrometheusMetrics
makeDummyPrometheusMetrics :: IO PrometheusMetrics
makeDummyPrometheusMetrics = do
  ConnectionsGauge
pmConnections <- IO ConnectionsGauge
newConnectionsGauge
  GraphQLRequestMetrics
pmGraphQLRequestMetrics <- IO GraphQLRequestMetrics
makeDummyGraphQLRequestMetrics
  EventTriggerMetrics
pmEventTriggerMetrics <- IO EventTriggerMetrics
makeDummyEventTriggerMetrics
  Counter
pmWebSocketBytesReceived <- IO Counter
Counter.new
  Counter
pmWebSocketBytesSent <- IO Counter
Counter.new
  Counter
pmActionBytesReceived <- IO Counter
Counter.new
  Counter
pmActionBytesSent <- IO Counter
Counter.new
  ScheduledTriggerMetrics
pmScheduledTriggerMetrics <- IO ScheduledTriggerMetrics
makeDummyScheduledTriggerMetrics
  SubscriptionMetrics
pmSubscriptionMetrics <- IO SubscriptionMetrics
makeDummySubscriptionMetrics
  Histogram
pmWebsocketMsgQueueTimeSeconds <- [UpperBound] -> IO Histogram
Histogram.new []
  CacheRequestMetrics
pmCacheRequestMetrics <- IO CacheRequestMetrics
makeDummyCacheRequestMetrics
  PrometheusMetrics -> IO PrometheusMetrics
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrometheusMetrics {Counter
Histogram
ConnectionsGauge
CacheRequestMetrics
SubscriptionMetrics
ScheduledTriggerMetrics
EventTriggerMetrics
GraphQLRequestMetrics
pmConnections :: ConnectionsGauge
pmGraphQLRequestMetrics :: GraphQLRequestMetrics
pmEventTriggerMetrics :: EventTriggerMetrics
pmWebSocketBytesReceived :: Counter
pmWebSocketBytesSent :: Counter
pmActionBytesReceived :: Counter
pmActionBytesSent :: Counter
pmScheduledTriggerMetrics :: ScheduledTriggerMetrics
pmSubscriptionMetrics :: SubscriptionMetrics
pmWebsocketMsgQueueTimeSeconds :: Histogram
pmCacheRequestMetrics :: CacheRequestMetrics
pmConnections :: ConnectionsGauge
pmGraphQLRequestMetrics :: GraphQLRequestMetrics
pmEventTriggerMetrics :: EventTriggerMetrics
pmWebSocketBytesReceived :: Counter
pmWebSocketBytesSent :: Counter
pmActionBytesReceived :: Counter
pmActionBytesSent :: Counter
pmScheduledTriggerMetrics :: ScheduledTriggerMetrics
pmSubscriptionMetrics :: SubscriptionMetrics
pmWebsocketMsgQueueTimeSeconds :: Histogram
pmCacheRequestMetrics :: CacheRequestMetrics
..}

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
gqlRequestsSubscriptionSuccess <- IO Counter
Counter.new
  Counter
gqlRequestsSubscriptionFailure <- 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphQLRequestMetrics {Counter
Histogram
gqlRequestsQuerySuccess :: Counter
gqlRequestsQueryFailure :: Counter
gqlRequestsMutationSuccess :: Counter
gqlRequestsMutationFailure :: Counter
gqlRequestsSubscriptionSuccess :: Counter
gqlRequestsSubscriptionFailure :: Counter
gqlRequestsUnknownFailure :: Counter
gqlExecutionTimeSecondsQuery :: Histogram
gqlExecutionTimeSecondsMutation :: Histogram
gqlRequestsQuerySuccess :: Counter
gqlRequestsQueryFailure :: Counter
gqlRequestsMutationSuccess :: Counter
gqlRequestsMutationFailure :: Counter
gqlRequestsSubscriptionSuccess :: Counter
gqlRequestsSubscriptionFailure :: Counter
gqlRequestsUnknownFailure :: Counter
gqlExecutionTimeSecondsQuery :: Histogram
gqlExecutionTimeSecondsMutation :: Histogram
..}

makeDummyEventTriggerMetrics :: IO EventTriggerMetrics
makeDummyEventTriggerMetrics :: IO EventTriggerMetrics
makeDummyEventTriggerMetrics = do
  Gauge
eventTriggerHTTPWorkers <- IO Gauge
Gauge.new
  Gauge
eventsFetchedPerBatch <- IO Gauge
Gauge.new
  HistogramVector (Maybe DynamicEventTriggerLabel)
eventQueueTimeSeconds <- [UpperBound]
-> IO (HistogramVector (Maybe DynamicEventTriggerLabel))
forall label.
Ord label =>
[UpperBound] -> IO (HistogramVector label)
HistogramVector.new []
  Histogram
eventsFetchTimePerBatch <- [UpperBound] -> IO Histogram
Histogram.new []
  HistogramVector (Maybe DynamicEventTriggerLabel)
eventWebhookProcessingTime <- [UpperBound]
-> IO (HistogramVector (Maybe DynamicEventTriggerLabel))
forall label.
Ord label =>
[UpperBound] -> IO (HistogramVector label)
HistogramVector.new []
  HistogramVector (Maybe DynamicEventTriggerLabel)
eventProcessingTime <- [UpperBound]
-> IO (HistogramVector (Maybe DynamicEventTriggerLabel))
forall label.
Ord label =>
[UpperBound] -> IO (HistogramVector label)
HistogramVector.new []
  Counter
eventTriggerBytesReceived <- IO Counter
Counter.new
  Counter
eventTriggerBytesSent <- IO Counter
Counter.new
  CounterVector EventStatusWithTriggerLabel
eventProcessedTotal <- IO (CounterVector EventStatusWithTriggerLabel)
forall label. Ord label => IO (CounterVector label)
CounterVector.new
  CounterVector EventStatusWithTriggerLabel
eventInvocationTotal <- IO (CounterVector EventStatusWithTriggerLabel)
forall label. Ord label => IO (CounterVector label)
CounterVector.new
  EventTriggerMetrics -> IO EventTriggerMetrics
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventTriggerMetrics {Counter
Gauge
Histogram
CounterVector EventStatusWithTriggerLabel
HistogramVector (Maybe DynamicEventTriggerLabel)
eventTriggerHTTPWorkers :: Gauge
eventsFetchedPerBatch :: Gauge
eventQueueTimeSeconds :: HistogramVector (Maybe DynamicEventTriggerLabel)
eventsFetchTimePerBatch :: Histogram
eventWebhookProcessingTime :: HistogramVector (Maybe DynamicEventTriggerLabel)
eventProcessingTime :: HistogramVector (Maybe DynamicEventTriggerLabel)
eventTriggerBytesReceived :: Counter
eventTriggerBytesSent :: Counter
eventProcessedTotal :: CounterVector EventStatusWithTriggerLabel
eventInvocationTotal :: CounterVector EventStatusWithTriggerLabel
eventTriggerHTTPWorkers :: Gauge
eventsFetchedPerBatch :: Gauge
eventQueueTimeSeconds :: HistogramVector (Maybe DynamicEventTriggerLabel)
eventsFetchTimePerBatch :: Histogram
eventWebhookProcessingTime :: HistogramVector (Maybe DynamicEventTriggerLabel)
eventProcessingTime :: HistogramVector (Maybe DynamicEventTriggerLabel)
eventTriggerBytesReceived :: Counter
eventTriggerBytesSent :: Counter
eventProcessedTotal :: CounterVector EventStatusWithTriggerLabel
eventInvocationTotal :: CounterVector EventStatusWithTriggerLabel
..}

makeDummyScheduledTriggerMetrics :: IO ScheduledTriggerMetrics
makeDummyScheduledTriggerMetrics :: IO ScheduledTriggerMetrics
makeDummyScheduledTriggerMetrics = do
  Counter
stmScheduledTriggerBytesReceived <- IO Counter
Counter.new
  Counter
stmScheduledTriggerBytesSent <- IO Counter
Counter.new
  Counter
stmCronEventsInvocationTotalSuccess <- IO Counter
Counter.new
  Counter
stmCronEventsInvocationTotalFailure <- IO Counter
Counter.new
  Counter
stmOneOffEventsInvocationTotalSuccess <- IO Counter
Counter.new
  Counter
stmOneOffEventsInvocationTotalFailure <- IO Counter
Counter.new
  Counter
stmCronEventsProcessedTotalSuccess <- IO Counter
Counter.new
  Counter
stmCronEventsProcessedTotalFailure <- IO Counter
Counter.new
  Counter
stmOneOffEventsProcessedTotalSuccess <- IO Counter
Counter.new
  Counter
stmOneOffEventsProcessedTotalFailure <- IO Counter
Counter.new
  ScheduledTriggerMetrics -> IO ScheduledTriggerMetrics
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScheduledTriggerMetrics {Counter
stmScheduledTriggerBytesReceived :: Counter
stmScheduledTriggerBytesSent :: Counter
stmCronEventsInvocationTotalSuccess :: Counter
stmCronEventsInvocationTotalFailure :: Counter
stmOneOffEventsInvocationTotalSuccess :: Counter
stmOneOffEventsInvocationTotalFailure :: Counter
stmCronEventsProcessedTotalSuccess :: Counter
stmCronEventsProcessedTotalFailure :: Counter
stmOneOffEventsProcessedTotalSuccess :: Counter
stmOneOffEventsProcessedTotalFailure :: Counter
stmScheduledTriggerBytesReceived :: Counter
stmScheduledTriggerBytesSent :: Counter
stmCronEventsInvocationTotalSuccess :: Counter
stmCronEventsInvocationTotalFailure :: Counter
stmOneOffEventsInvocationTotalSuccess :: Counter
stmOneOffEventsInvocationTotalFailure :: Counter
stmCronEventsProcessedTotalSuccess :: Counter
stmCronEventsProcessedTotalFailure :: Counter
stmOneOffEventsProcessedTotalSuccess :: Counter
stmOneOffEventsProcessedTotalFailure :: Counter
..}

makeDummySubscriptionMetrics :: IO SubscriptionMetrics
makeDummySubscriptionMetrics :: IO SubscriptionMetrics
makeDummySubscriptionMetrics = do
  Gauge
submActiveLiveQueryPollers <- IO Gauge
Gauge.new
  Gauge
submActiveStreamingPollers <- IO Gauge
Gauge.new
  Gauge
submActiveLiveQueryPollersInError <- IO Gauge
Gauge.new
  Gauge
submActiveStreamingPollersInError <- IO Gauge
Gauge.new
  HistogramVector SubscriptionLabel
submTotalTime <- [UpperBound] -> IO (HistogramVector SubscriptionLabel)
forall label.
Ord label =>
[UpperBound] -> IO (HistogramVector label)
HistogramVector.new []
  HistogramVector SubscriptionLabel
submDBExecTotalTime <- [UpperBound] -> IO (HistogramVector SubscriptionLabel)
forall label.
Ord label =>
[UpperBound] -> IO (HistogramVector label)
HistogramVector.new []
  GaugeVector SubscriptionLabel
submActiveSubscriptions <- IO (GaugeVector SubscriptionLabel)
forall label. Ord label => IO (GaugeVector label)
GaugeVector.new
  SubscriptionMetrics -> IO SubscriptionMetrics
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubscriptionMetrics {Gauge
GaugeVector SubscriptionLabel
HistogramVector SubscriptionLabel
submActiveLiveQueryPollers :: Gauge
submActiveStreamingPollers :: Gauge
submActiveLiveQueryPollersInError :: Gauge
submActiveStreamingPollersInError :: Gauge
submTotalTime :: HistogramVector SubscriptionLabel
submDBExecTotalTime :: HistogramVector SubscriptionLabel
submActiveSubscriptions :: GaugeVector SubscriptionLabel
submActiveLiveQueryPollers :: Gauge
submActiveStreamingPollers :: Gauge
submActiveLiveQueryPollersInError :: Gauge
submActiveStreamingPollersInError :: Gauge
submTotalTime :: HistogramVector SubscriptionLabel
submDBExecTotalTime :: HistogramVector SubscriptionLabel
submActiveSubscriptions :: GaugeVector SubscriptionLabel
..}

makeDummyCacheRequestMetrics :: IO CacheRequestMetrics
makeDummyCacheRequestMetrics :: IO CacheRequestMetrics
makeDummyCacheRequestMetrics = do
  Counter
crmCacheHits <- IO Counter
Counter.new
  Counter
crmCacheMisses <- IO Counter
Counter.new
  CacheRequestMetrics -> IO CacheRequestMetrics
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CacheRequestMetrics {Counter
crmCacheHits :: Counter
crmCacheMisses :: Counter
crmCacheHits :: Counter
crmCacheMisses :: Counter
..}

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

-- | 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 {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, ())

data DynamicEventTriggerLabel = DynamicEventTriggerLabel
  { DynamicEventTriggerLabel -> TriggerName
_detlTriggerName :: TriggerName,
    DynamicEventTriggerLabel -> SourceName
_detlSourceName :: SourceName
  }
  deriving (Eq DynamicEventTriggerLabel
Eq DynamicEventTriggerLabel
-> (DynamicEventTriggerLabel
    -> DynamicEventTriggerLabel -> Ordering)
-> (DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool)
-> (DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool)
-> (DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool)
-> (DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool)
-> (DynamicEventTriggerLabel
    -> DynamicEventTriggerLabel -> DynamicEventTriggerLabel)
-> (DynamicEventTriggerLabel
    -> DynamicEventTriggerLabel -> DynamicEventTriggerLabel)
-> Ord DynamicEventTriggerLabel
DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Ordering
DynamicEventTriggerLabel
-> DynamicEventTriggerLabel -> DynamicEventTriggerLabel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Ordering
compare :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Ordering
$c< :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
< :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
$c<= :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
<= :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
$c> :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
> :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
$c>= :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
>= :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
$cmax :: DynamicEventTriggerLabel
-> DynamicEventTriggerLabel -> DynamicEventTriggerLabel
max :: DynamicEventTriggerLabel
-> DynamicEventTriggerLabel -> DynamicEventTriggerLabel
$cmin :: DynamicEventTriggerLabel
-> DynamicEventTriggerLabel -> DynamicEventTriggerLabel
min :: DynamicEventTriggerLabel
-> DynamicEventTriggerLabel -> DynamicEventTriggerLabel
Ord, DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
(DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool)
-> (DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool)
-> Eq DynamicEventTriggerLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
== :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
$c/= :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
/= :: DynamicEventTriggerLabel -> DynamicEventTriggerLabel -> Bool
Eq)

instance ToLabels (Maybe DynamicEventTriggerLabel) where
  toLabels :: Maybe DynamicEventTriggerLabel -> HashMap Text Text
toLabels Maybe DynamicEventTriggerLabel
Nothing = HashMap Text Text
forall k v. HashMap k v
Map.empty
  toLabels (Just (DynamicEventTriggerLabel TriggerName
triggerName SourceName
sourceName)) = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Text, Text)] -> HashMap Text Text)
-> [(Text, Text)] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ [(Text
"trigger_name", TriggerName -> Text
triggerNameToTxt TriggerName
triggerName), (Text
"source_name", SourceName -> Text
sourceNameToText SourceName
sourceName)]

data ResponseStatus = Success | Failed

-- TODO: Make this a method of a new typeclass of the metrics library
responseStatusToLabelValue :: ResponseStatus -> Text
responseStatusToLabelValue :: ResponseStatus -> Text
responseStatusToLabelValue = \case
  ResponseStatus
Success -> Text
"success"
  ResponseStatus
Failed -> Text
"failed"

newtype EventStatusLabel = EventStatusLabel
  { EventStatusLabel -> Text
status :: Text
  }
  deriving stock ((forall x. EventStatusLabel -> Rep EventStatusLabel x)
-> (forall x. Rep EventStatusLabel x -> EventStatusLabel)
-> Generic EventStatusLabel
forall x. Rep EventStatusLabel x -> EventStatusLabel
forall x. EventStatusLabel -> Rep EventStatusLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EventStatusLabel -> Rep EventStatusLabel x
from :: forall x. EventStatusLabel -> Rep EventStatusLabel x
$cto :: forall x. Rep EventStatusLabel x -> EventStatusLabel
to :: forall x. Rep EventStatusLabel x -> EventStatusLabel
Generic, Eq EventStatusLabel
Eq EventStatusLabel
-> (EventStatusLabel -> EventStatusLabel -> Ordering)
-> (EventStatusLabel -> EventStatusLabel -> Bool)
-> (EventStatusLabel -> EventStatusLabel -> Bool)
-> (EventStatusLabel -> EventStatusLabel -> Bool)
-> (EventStatusLabel -> EventStatusLabel -> Bool)
-> (EventStatusLabel -> EventStatusLabel -> EventStatusLabel)
-> (EventStatusLabel -> EventStatusLabel -> EventStatusLabel)
-> Ord EventStatusLabel
EventStatusLabel -> EventStatusLabel -> Bool
EventStatusLabel -> EventStatusLabel -> Ordering
EventStatusLabel -> EventStatusLabel -> EventStatusLabel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventStatusLabel -> EventStatusLabel -> Ordering
compare :: EventStatusLabel -> EventStatusLabel -> Ordering
$c< :: EventStatusLabel -> EventStatusLabel -> Bool
< :: EventStatusLabel -> EventStatusLabel -> Bool
$c<= :: EventStatusLabel -> EventStatusLabel -> Bool
<= :: EventStatusLabel -> EventStatusLabel -> Bool
$c> :: EventStatusLabel -> EventStatusLabel -> Bool
> :: EventStatusLabel -> EventStatusLabel -> Bool
$c>= :: EventStatusLabel -> EventStatusLabel -> Bool
>= :: EventStatusLabel -> EventStatusLabel -> Bool
$cmax :: EventStatusLabel -> EventStatusLabel -> EventStatusLabel
max :: EventStatusLabel -> EventStatusLabel -> EventStatusLabel
$cmin :: EventStatusLabel -> EventStatusLabel -> EventStatusLabel
min :: EventStatusLabel -> EventStatusLabel -> EventStatusLabel
Ord, EventStatusLabel -> EventStatusLabel -> Bool
(EventStatusLabel -> EventStatusLabel -> Bool)
-> (EventStatusLabel -> EventStatusLabel -> Bool)
-> Eq EventStatusLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventStatusLabel -> EventStatusLabel -> Bool
== :: EventStatusLabel -> EventStatusLabel -> Bool
$c/= :: EventStatusLabel -> EventStatusLabel -> Bool
/= :: EventStatusLabel -> EventStatusLabel -> Bool
Eq)
  deriving anyclass (EventStatusLabel -> HashMap Text Text
(EventStatusLabel -> HashMap Text Text)
-> ToLabels EventStatusLabel
forall a. (a -> HashMap Text Text) -> ToLabels a
$ctoLabels :: EventStatusLabel -> HashMap Text Text
toLabels :: EventStatusLabel -> HashMap Text Text
ToLabels)

eventSuccessLabel :: EventStatusLabel
eventSuccessLabel :: EventStatusLabel
eventSuccessLabel = Text -> EventStatusLabel
EventStatusLabel (Text -> EventStatusLabel) -> Text -> EventStatusLabel
forall a b. (a -> b) -> a -> b
$ ResponseStatus -> Text
responseStatusToLabelValue ResponseStatus
Success

eventFailedLabel :: EventStatusLabel
eventFailedLabel :: EventStatusLabel
eventFailedLabel = Text -> EventStatusLabel
EventStatusLabel (Text -> EventStatusLabel) -> Text -> EventStatusLabel
forall a b. (a -> b) -> a -> b
$ ResponseStatus -> Text
responseStatusToLabelValue ResponseStatus
Failed

data EventStatusWithTriggerLabel = EventStatusWithTriggerLabel
  { EventStatusWithTriggerLabel -> EventStatusLabel
_eswtlStatus :: EventStatusLabel,
    EventStatusWithTriggerLabel -> Maybe DynamicEventTriggerLabel
_eswtlDynamicLabels :: Maybe DynamicEventTriggerLabel
  }
  deriving stock ((forall x.
 EventStatusWithTriggerLabel -> Rep EventStatusWithTriggerLabel x)
-> (forall x.
    Rep EventStatusWithTriggerLabel x -> EventStatusWithTriggerLabel)
-> Generic EventStatusWithTriggerLabel
forall x.
Rep EventStatusWithTriggerLabel x -> EventStatusWithTriggerLabel
forall x.
EventStatusWithTriggerLabel -> Rep EventStatusWithTriggerLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
EventStatusWithTriggerLabel -> Rep EventStatusWithTriggerLabel x
from :: forall x.
EventStatusWithTriggerLabel -> Rep EventStatusWithTriggerLabel x
$cto :: forall x.
Rep EventStatusWithTriggerLabel x -> EventStatusWithTriggerLabel
to :: forall x.
Rep EventStatusWithTriggerLabel x -> EventStatusWithTriggerLabel
Generic, Eq EventStatusWithTriggerLabel
Eq EventStatusWithTriggerLabel
-> (EventStatusWithTriggerLabel
    -> EventStatusWithTriggerLabel -> Ordering)
-> (EventStatusWithTriggerLabel
    -> EventStatusWithTriggerLabel -> Bool)
-> (EventStatusWithTriggerLabel
    -> EventStatusWithTriggerLabel -> Bool)
-> (EventStatusWithTriggerLabel
    -> EventStatusWithTriggerLabel -> Bool)
-> (EventStatusWithTriggerLabel
    -> EventStatusWithTriggerLabel -> Bool)
-> (EventStatusWithTriggerLabel
    -> EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel)
-> (EventStatusWithTriggerLabel
    -> EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel)
-> Ord EventStatusWithTriggerLabel
EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
EventStatusWithTriggerLabel
-> EventStatusWithTriggerLabel -> Ordering
EventStatusWithTriggerLabel
-> EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventStatusWithTriggerLabel
-> EventStatusWithTriggerLabel -> Ordering
compare :: EventStatusWithTriggerLabel
-> EventStatusWithTriggerLabel -> Ordering
$c< :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
< :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
$c<= :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
<= :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
$c> :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
> :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
$c>= :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
>= :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
$cmax :: EventStatusWithTriggerLabel
-> EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel
max :: EventStatusWithTriggerLabel
-> EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel
$cmin :: EventStatusWithTriggerLabel
-> EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel
min :: EventStatusWithTriggerLabel
-> EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel
Ord, EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
(EventStatusWithTriggerLabel
 -> EventStatusWithTriggerLabel -> Bool)
-> (EventStatusWithTriggerLabel
    -> EventStatusWithTriggerLabel -> Bool)
-> Eq EventStatusWithTriggerLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
== :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
$c/= :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
/= :: EventStatusWithTriggerLabel -> EventStatusWithTriggerLabel -> Bool
Eq)

instance ToLabels (EventStatusWithTriggerLabel) where
  toLabels :: EventStatusWithTriggerLabel -> HashMap Text Text
toLabels (EventStatusWithTriggerLabel EventStatusLabel
esl Maybe DynamicEventTriggerLabel
tl) = ([(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, Text)] -> HashMap Text Text)
-> [(Text, Text)] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ [(Text
"status", EventStatusLabel -> Text
status EventStatusLabel
esl)]) HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall a. Semigroup a => a -> a -> a
<> Maybe DynamicEventTriggerLabel -> HashMap Text Text
forall a. ToLabels a => a -> HashMap Text Text
toLabels Maybe DynamicEventTriggerLabel
tl

data SubscriptionKindLabel = SubscriptionKindLabel
  { SubscriptionKindLabel -> Text
subscription_kind :: Text
  }
  deriving stock ((forall x. SubscriptionKindLabel -> Rep SubscriptionKindLabel x)
-> (forall x. Rep SubscriptionKindLabel x -> SubscriptionKindLabel)
-> Generic SubscriptionKindLabel
forall x. Rep SubscriptionKindLabel x -> SubscriptionKindLabel
forall x. SubscriptionKindLabel -> Rep SubscriptionKindLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubscriptionKindLabel -> Rep SubscriptionKindLabel x
from :: forall x. SubscriptionKindLabel -> Rep SubscriptionKindLabel x
$cto :: forall x. Rep SubscriptionKindLabel x -> SubscriptionKindLabel
to :: forall x. Rep SubscriptionKindLabel x -> SubscriptionKindLabel
Generic, Eq SubscriptionKindLabel
Eq SubscriptionKindLabel
-> (SubscriptionKindLabel -> SubscriptionKindLabel -> Ordering)
-> (SubscriptionKindLabel -> SubscriptionKindLabel -> Bool)
-> (SubscriptionKindLabel -> SubscriptionKindLabel -> Bool)
-> (SubscriptionKindLabel -> SubscriptionKindLabel -> Bool)
-> (SubscriptionKindLabel -> SubscriptionKindLabel -> Bool)
-> (SubscriptionKindLabel
    -> SubscriptionKindLabel -> SubscriptionKindLabel)
-> (SubscriptionKindLabel
    -> SubscriptionKindLabel -> SubscriptionKindLabel)
-> Ord SubscriptionKindLabel
SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
SubscriptionKindLabel -> SubscriptionKindLabel -> Ordering
SubscriptionKindLabel
-> SubscriptionKindLabel -> SubscriptionKindLabel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SubscriptionKindLabel -> SubscriptionKindLabel -> Ordering
compare :: SubscriptionKindLabel -> SubscriptionKindLabel -> Ordering
$c< :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
< :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
$c<= :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
<= :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
$c> :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
> :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
$c>= :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
>= :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
$cmax :: SubscriptionKindLabel
-> SubscriptionKindLabel -> SubscriptionKindLabel
max :: SubscriptionKindLabel
-> SubscriptionKindLabel -> SubscriptionKindLabel
$cmin :: SubscriptionKindLabel
-> SubscriptionKindLabel -> SubscriptionKindLabel
min :: SubscriptionKindLabel
-> SubscriptionKindLabel -> SubscriptionKindLabel
Ord, SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
(SubscriptionKindLabel -> SubscriptionKindLabel -> Bool)
-> (SubscriptionKindLabel -> SubscriptionKindLabel -> Bool)
-> Eq SubscriptionKindLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
== :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
$c/= :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
/= :: SubscriptionKindLabel -> SubscriptionKindLabel -> Bool
Eq)
  deriving anyclass (SubscriptionKindLabel -> HashMap Text Text
(SubscriptionKindLabel -> HashMap Text Text)
-> ToLabels SubscriptionKindLabel
forall a. (a -> HashMap Text Text) -> ToLabels a
$ctoLabels :: SubscriptionKindLabel -> HashMap Text Text
toLabels :: SubscriptionKindLabel -> HashMap Text Text
ToLabels)

streamingSubscriptionLabel :: SubscriptionKindLabel
streamingSubscriptionLabel :: SubscriptionKindLabel
streamingSubscriptionLabel = Text -> SubscriptionKindLabel
SubscriptionKindLabel Text
"streaming"

liveQuerySubscriptionLabel :: SubscriptionKindLabel
liveQuerySubscriptionLabel :: SubscriptionKindLabel
liveQuerySubscriptionLabel = Text -> SubscriptionKindLabel
SubscriptionKindLabel Text
"live-query"

data DynamicSubscriptionLabel = DynamicSubscriptionLabel
  { DynamicSubscriptionLabel -> ParameterizedQueryHash
_dslParamQueryHash :: ParameterizedQueryHash,
    DynamicSubscriptionLabel -> Maybe OperationName
_dslOperationName :: Maybe OperationName
  }
  deriving stock ((forall x.
 DynamicSubscriptionLabel -> Rep DynamicSubscriptionLabel x)
-> (forall x.
    Rep DynamicSubscriptionLabel x -> DynamicSubscriptionLabel)
-> Generic DynamicSubscriptionLabel
forall x.
Rep DynamicSubscriptionLabel x -> DynamicSubscriptionLabel
forall x.
DynamicSubscriptionLabel -> Rep DynamicSubscriptionLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
DynamicSubscriptionLabel -> Rep DynamicSubscriptionLabel x
from :: forall x.
DynamicSubscriptionLabel -> Rep DynamicSubscriptionLabel x
$cto :: forall x.
Rep DynamicSubscriptionLabel x -> DynamicSubscriptionLabel
to :: forall x.
Rep DynamicSubscriptionLabel x -> DynamicSubscriptionLabel
Generic, Eq DynamicSubscriptionLabel
Eq DynamicSubscriptionLabel
-> (DynamicSubscriptionLabel
    -> DynamicSubscriptionLabel -> Ordering)
-> (DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool)
-> (DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool)
-> (DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool)
-> (DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool)
-> (DynamicSubscriptionLabel
    -> DynamicSubscriptionLabel -> DynamicSubscriptionLabel)
-> (DynamicSubscriptionLabel
    -> DynamicSubscriptionLabel -> DynamicSubscriptionLabel)
-> Ord DynamicSubscriptionLabel
DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Ordering
DynamicSubscriptionLabel
-> DynamicSubscriptionLabel -> DynamicSubscriptionLabel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Ordering
compare :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Ordering
$c< :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
< :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
$c<= :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
<= :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
$c> :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
> :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
$c>= :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
>= :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
$cmax :: DynamicSubscriptionLabel
-> DynamicSubscriptionLabel -> DynamicSubscriptionLabel
max :: DynamicSubscriptionLabel
-> DynamicSubscriptionLabel -> DynamicSubscriptionLabel
$cmin :: DynamicSubscriptionLabel
-> DynamicSubscriptionLabel -> DynamicSubscriptionLabel
min :: DynamicSubscriptionLabel
-> DynamicSubscriptionLabel -> DynamicSubscriptionLabel
Ord, DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
(DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool)
-> (DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool)
-> Eq DynamicSubscriptionLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
== :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
$c/= :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
/= :: DynamicSubscriptionLabel -> DynamicSubscriptionLabel -> Bool
Eq)

instance ToLabels DynamicSubscriptionLabel where
  toLabels :: DynamicSubscriptionLabel -> HashMap Text Text
toLabels (DynamicSubscriptionLabel ParameterizedQueryHash
hash Maybe OperationName
opName) =
    [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList
      ([(Text, Text)] -> HashMap Text Text)
-> [(Text, Text)] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ [(Text
"parameterized_query_hash", ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ParameterizedQueryHash -> ByteString
unParamQueryHash ParameterizedQueryHash
hash)]
      [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
-> (OperationName -> [(Text, Text)])
-> Maybe OperationName
-> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\OperationName
op -> [(Text
"operation_name", Name -> Text
G.unName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ OperationName -> Name
_unOperationName OperationName
op)]) Maybe OperationName
opName

data SubscriptionLabel = SubscriptionLabel
  { SubscriptionLabel -> SubscriptionKindLabel
_slKind :: SubscriptionKindLabel,
    SubscriptionLabel -> Maybe DynamicSubscriptionLabel
_slDynamicLabels :: Maybe DynamicSubscriptionLabel
  }
  deriving stock ((forall x. SubscriptionLabel -> Rep SubscriptionLabel x)
-> (forall x. Rep SubscriptionLabel x -> SubscriptionLabel)
-> Generic SubscriptionLabel
forall x. Rep SubscriptionLabel x -> SubscriptionLabel
forall x. SubscriptionLabel -> Rep SubscriptionLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SubscriptionLabel -> Rep SubscriptionLabel x
from :: forall x. SubscriptionLabel -> Rep SubscriptionLabel x
$cto :: forall x. Rep SubscriptionLabel x -> SubscriptionLabel
to :: forall x. Rep SubscriptionLabel x -> SubscriptionLabel
Generic, Eq SubscriptionLabel
Eq SubscriptionLabel
-> (SubscriptionLabel -> SubscriptionLabel -> Ordering)
-> (SubscriptionLabel -> SubscriptionLabel -> Bool)
-> (SubscriptionLabel -> SubscriptionLabel -> Bool)
-> (SubscriptionLabel -> SubscriptionLabel -> Bool)
-> (SubscriptionLabel -> SubscriptionLabel -> Bool)
-> (SubscriptionLabel -> SubscriptionLabel -> SubscriptionLabel)
-> (SubscriptionLabel -> SubscriptionLabel -> SubscriptionLabel)
-> Ord SubscriptionLabel
SubscriptionLabel -> SubscriptionLabel -> Bool
SubscriptionLabel -> SubscriptionLabel -> Ordering
SubscriptionLabel -> SubscriptionLabel -> SubscriptionLabel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SubscriptionLabel -> SubscriptionLabel -> Ordering
compare :: SubscriptionLabel -> SubscriptionLabel -> Ordering
$c< :: SubscriptionLabel -> SubscriptionLabel -> Bool
< :: SubscriptionLabel -> SubscriptionLabel -> Bool
$c<= :: SubscriptionLabel -> SubscriptionLabel -> Bool
<= :: SubscriptionLabel -> SubscriptionLabel -> Bool
$c> :: SubscriptionLabel -> SubscriptionLabel -> Bool
> :: SubscriptionLabel -> SubscriptionLabel -> Bool
$c>= :: SubscriptionLabel -> SubscriptionLabel -> Bool
>= :: SubscriptionLabel -> SubscriptionLabel -> Bool
$cmax :: SubscriptionLabel -> SubscriptionLabel -> SubscriptionLabel
max :: SubscriptionLabel -> SubscriptionLabel -> SubscriptionLabel
$cmin :: SubscriptionLabel -> SubscriptionLabel -> SubscriptionLabel
min :: SubscriptionLabel -> SubscriptionLabel -> SubscriptionLabel
Ord, SubscriptionLabel -> SubscriptionLabel -> Bool
(SubscriptionLabel -> SubscriptionLabel -> Bool)
-> (SubscriptionLabel -> SubscriptionLabel -> Bool)
-> Eq SubscriptionLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubscriptionLabel -> SubscriptionLabel -> Bool
== :: SubscriptionLabel -> SubscriptionLabel -> Bool
$c/= :: SubscriptionLabel -> SubscriptionLabel -> Bool
/= :: SubscriptionLabel -> SubscriptionLabel -> Bool
Eq)

instance ToLabels SubscriptionLabel where
  toLabels :: SubscriptionLabel -> HashMap Text Text
toLabels (SubscriptionLabel SubscriptionKindLabel
kind Maybe DynamicSubscriptionLabel
Nothing) = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Text, Text)] -> HashMap Text Text)
-> [(Text, Text)] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ [(Text
"subscription_kind", SubscriptionKindLabel -> Text
subscription_kind SubscriptionKindLabel
kind)]
  toLabels (SubscriptionLabel SubscriptionKindLabel
kind (Just DynamicSubscriptionLabel
dl)) = ([(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Text, Text)] -> HashMap Text Text)
-> [(Text, Text)] -> HashMap Text Text
forall a b. (a -> b) -> a -> b
$ [(Text
"subscription_kind", SubscriptionKindLabel -> Text
subscription_kind SubscriptionKindLabel
kind)]) HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall a. Semigroup a => a -> a -> a
<> DynamicSubscriptionLabel -> HashMap Text Text
forall a. ToLabels a => a -> HashMap Text Text
toLabels DynamicSubscriptionLabel
dl

-- | Record metrics with dynamic label
recordMetricWithLabel ::
  (MonadIO m) =>
  (IO GranularPrometheusMetricsState) ->
  -- should the metric be observed without a label when granularMetricsState is OFF
  Bool ->
  -- the action to perform when granularMetricsState is ON
  IO () ->
  -- the action to perform when granularMetricsState is OFF
  IO () ->
  m ()
recordMetricWithLabel :: forall (m :: * -> *).
MonadIO m =>
IO GranularPrometheusMetricsState -> Bool -> IO () -> IO () -> m ()
recordMetricWithLabel IO GranularPrometheusMetricsState
getMetricState Bool
alwaysObserve IO ()
metricActionWithLabel IO ()
metricActionWithoutLabel = do
  GranularPrometheusMetricsState
metricState <- IO GranularPrometheusMetricsState
-> m GranularPrometheusMetricsState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GranularPrometheusMetricsState
 -> m GranularPrometheusMetricsState)
-> IO GranularPrometheusMetricsState
-> m GranularPrometheusMetricsState
forall a b. (a -> b) -> a -> b
$ IO GranularPrometheusMetricsState
getMetricState
  case GranularPrometheusMetricsState
metricState of
    GranularPrometheusMetricsState
GranularMetricsOn -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO ()
metricActionWithLabel
    -- Some metrics do not make sense without a dynamic label, hence only record the
    -- metric when alwaysObserve is set to true else do not record the metric
    GranularPrometheusMetricsState
GranularMetricsOff -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alwaysObserve
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO ()
metricActionWithoutLabel

-- | Observe a histogram metric with a label.
--
-- If the granularity is set to 'GranularMetricsOn', the label will be
-- included in the metric. Otherwise, the label will be set to `Nothing`
observeHistogramWithLabel ::
  (Ord l, MonadIO m) =>
  (IO GranularPrometheusMetricsState) ->
  -- should the metric be observed without a label when granularMetricsState is OFF
  Bool ->
  HistogramVector (Maybe l) ->
  l ->
  Double ->
  m ()
observeHistogramWithLabel :: forall l (m :: * -> *).
(Ord l, MonadIO m) =>
IO GranularPrometheusMetricsState
-> Bool -> HistogramVector (Maybe l) -> l -> UpperBound -> m ()
observeHistogramWithLabel IO GranularPrometheusMetricsState
getMetricState Bool
alwaysObserve HistogramVector (Maybe l)
histogramVector l
label UpperBound
value = do
  IO GranularPrometheusMetricsState -> Bool -> IO () -> IO () -> m ()
forall (m :: * -> *).
MonadIO m =>
IO GranularPrometheusMetricsState -> Bool -> IO () -> IO () -> m ()
recordMetricWithLabel
    IO GranularPrometheusMetricsState
getMetricState
    Bool
alwaysObserve
    (IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HistogramVector (Maybe l) -> Maybe l -> UpperBound -> IO ()
forall label.
Ord label =>
HistogramVector label -> label -> UpperBound -> IO ()
HistogramVector.observe HistogramVector (Maybe l)
histogramVector (l -> Maybe l
forall a. a -> Maybe a
Just l
label) UpperBound
value)
    (IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HistogramVector (Maybe l) -> Maybe l -> UpperBound -> IO ()
forall label.
Ord label =>
HistogramVector label -> label -> UpperBound -> IO ()
HistogramVector.observe HistogramVector (Maybe l)
histogramVector Maybe l
forall a. Maybe a
Nothing UpperBound
value)

-- | Record a subscription metric for all the operation names present in the subscription.
-- Use this when you want to update the same value of the metric for all the operation names.
recordSubcriptionMetric ::
  (MonadIO m) =>
  (IO GranularPrometheusMetricsState) ->
  -- should the metric be observed without a label when granularMetricsState is OFF
  Bool ->
  HashMap (Maybe OperationName) Int ->
  ParameterizedQueryHash ->
  SubscriptionKindLabel ->
  -- the mertic action to perform
  (SubscriptionLabel -> IO ()) ->
  m ()
recordSubcriptionMetric :: forall (m :: * -> *).
MonadIO m =>
IO GranularPrometheusMetricsState
-> Bool
-> HashMap (Maybe OperationName) Int
-> ParameterizedQueryHash
-> SubscriptionKindLabel
-> (SubscriptionLabel -> IO ())
-> m ()
recordSubcriptionMetric IO GranularPrometheusMetricsState
getMetricState Bool
alwaysObserve HashMap (Maybe OperationName) Int
operationNamesMap ParameterizedQueryHash
parameterizedQueryHash SubscriptionKindLabel
subscriptionKind SubscriptionLabel -> IO ()
metricAction = do
  -- if no operation names are present, then emit metric with only param query hash as dynamic label
  if (HashMap (Maybe OperationName) Int -> Bool
forall a. HashMap (Maybe OperationName) a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap (Maybe OperationName) Int
operationNamesMap)
    then do
      let promMetricGranularLabel :: SubscriptionLabel
promMetricGranularLabel = SubscriptionKindLabel
-> Maybe DynamicSubscriptionLabel -> SubscriptionLabel
SubscriptionLabel SubscriptionKindLabel
subscriptionKind (DynamicSubscriptionLabel -> Maybe DynamicSubscriptionLabel
forall a. a -> Maybe a
Just (DynamicSubscriptionLabel -> Maybe DynamicSubscriptionLabel)
-> DynamicSubscriptionLabel -> Maybe DynamicSubscriptionLabel
forall a b. (a -> b) -> a -> b
$ ParameterizedQueryHash
-> Maybe OperationName -> DynamicSubscriptionLabel
DynamicSubscriptionLabel ParameterizedQueryHash
parameterizedQueryHash Maybe OperationName
forall a. Maybe a
Nothing)
          promMetricLabel :: SubscriptionLabel
promMetricLabel = SubscriptionKindLabel
-> Maybe DynamicSubscriptionLabel -> SubscriptionLabel
SubscriptionLabel SubscriptionKindLabel
subscriptionKind Maybe DynamicSubscriptionLabel
forall a. Maybe a
Nothing
      IO GranularPrometheusMetricsState -> Bool -> IO () -> IO () -> m ()
forall (m :: * -> *).
MonadIO m =>
IO GranularPrometheusMetricsState -> Bool -> IO () -> IO () -> m ()
recordMetricWithLabel
        IO GranularPrometheusMetricsState
getMetricState
        Bool
alwaysObserve
        (SubscriptionLabel -> IO ()
metricAction SubscriptionLabel
promMetricGranularLabel)
        (SubscriptionLabel -> IO ()
metricAction SubscriptionLabel
promMetricLabel)
    else -- if operationNames are present, then emit the same metric for all the operation names
    do
      let operationNames :: [Maybe OperationName]
operationNames = HashMap (Maybe OperationName) Int -> [Maybe OperationName]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap (Maybe OperationName) Int
operationNamesMap
      [Maybe OperationName] -> (Maybe OperationName -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Maybe OperationName]
operationNames ((Maybe OperationName -> m ()) -> m ())
-> (Maybe OperationName -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Maybe OperationName
opName -> do
        let promMetricGranularLabel :: SubscriptionLabel
promMetricGranularLabel = SubscriptionKindLabel
-> Maybe DynamicSubscriptionLabel -> SubscriptionLabel
SubscriptionLabel SubscriptionKindLabel
subscriptionKind (DynamicSubscriptionLabel -> Maybe DynamicSubscriptionLabel
forall a. a -> Maybe a
Just (DynamicSubscriptionLabel -> Maybe DynamicSubscriptionLabel)
-> DynamicSubscriptionLabel -> Maybe DynamicSubscriptionLabel
forall a b. (a -> b) -> a -> b
$ ParameterizedQueryHash
-> Maybe OperationName -> DynamicSubscriptionLabel
DynamicSubscriptionLabel ParameterizedQueryHash
parameterizedQueryHash Maybe OperationName
opName)
            promMetricLabel :: SubscriptionLabel
promMetricLabel = SubscriptionKindLabel
-> Maybe DynamicSubscriptionLabel -> SubscriptionLabel
SubscriptionLabel SubscriptionKindLabel
subscriptionKind Maybe DynamicSubscriptionLabel
forall a. Maybe a
Nothing
        IO GranularPrometheusMetricsState -> Bool -> IO () -> IO () -> m ()
forall (m :: * -> *).
MonadIO m =>
IO GranularPrometheusMetricsState -> Bool -> IO () -> IO () -> m ()
recordMetricWithLabel
          IO GranularPrometheusMetricsState
getMetricState
          Bool
alwaysObserve
          (SubscriptionLabel -> IO ()
metricAction SubscriptionLabel
promMetricGranularLabel)
          (SubscriptionLabel -> IO ()
metricAction SubscriptionLabel
promMetricLabel)