{-# LANGUAGE TemplateHaskell #-}

-- | Telemetry types
--
-- Define anonymized metrics regarding usage of various features of Hasura.
module Hasura.Server.Telemetry.Types
  ( -- * Metrics
    RelationshipMetric (..),
    PermissionMetric (..),
    ActionMetric (..),
    NativeQueriesMetrics (..),
    StoredProceduresMetrics (..),
    LogicalModelsMetrics (..),
    Metrics (..),
    SourceMetadata (..),
    HasuraTelemetry (..),
    TelemetryPayload (..),
    Topic (..),

    -- * Counters

    -- ** Local metric recording
    RequestDimensions (..),
    RequestTimings (..),

    -- *** Dimensions
    QueryType (..),
    Locality (..),
    Transport (..),

    -- ** Metric upload
    ServiceTimingMetrics (..),
    ServiceTimingMetric (..),
    RunningTimeBucket (..),
    RequestTimingsCount (..),
  )
where

import CI qualified
import Data.Aeson qualified as J
import Data.Monoid (Sum (..))
import Hasura.Prelude
import Hasura.RQL.Types.BackendType (BackendType)
import Hasura.RQL.Types.Metadata.Instances ()
import Hasura.Server.Telemetry.Counters
import Hasura.Server.Types
import Hasura.Server.Version

data RelationshipMetric = RelationshipMetric
  { RelationshipMetric -> Int
_rmManual :: Int,
    RelationshipMetric -> Int
_rmAuto :: Int
  }
  deriving (Int -> RelationshipMetric -> ShowS
[RelationshipMetric] -> ShowS
RelationshipMetric -> String
(Int -> RelationshipMetric -> ShowS)
-> (RelationshipMetric -> String)
-> ([RelationshipMetric] -> ShowS)
-> Show RelationshipMetric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelationshipMetric -> ShowS
showsPrec :: Int -> RelationshipMetric -> ShowS
$cshow :: RelationshipMetric -> String
show :: RelationshipMetric -> String
$cshowList :: [RelationshipMetric] -> ShowS
showList :: [RelationshipMetric] -> ShowS
Show, RelationshipMetric -> RelationshipMetric -> Bool
(RelationshipMetric -> RelationshipMetric -> Bool)
-> (RelationshipMetric -> RelationshipMetric -> Bool)
-> Eq RelationshipMetric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelationshipMetric -> RelationshipMetric -> Bool
== :: RelationshipMetric -> RelationshipMetric -> Bool
$c/= :: RelationshipMetric -> RelationshipMetric -> Bool
/= :: RelationshipMetric -> RelationshipMetric -> Bool
Eq, (forall x. RelationshipMetric -> Rep RelationshipMetric x)
-> (forall x. Rep RelationshipMetric x -> RelationshipMetric)
-> Generic RelationshipMetric
forall x. Rep RelationshipMetric x -> RelationshipMetric
forall x. RelationshipMetric -> Rep RelationshipMetric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RelationshipMetric -> Rep RelationshipMetric x
from :: forall x. RelationshipMetric -> Rep RelationshipMetric x
$cto :: forall x. Rep RelationshipMetric x -> RelationshipMetric
to :: forall x. Rep RelationshipMetric x -> RelationshipMetric
Generic)

instance J.ToJSON RelationshipMetric where
  toJSON :: RelationshipMetric -> Value
toJSON = Options -> RelationshipMetric -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: RelationshipMetric -> Encoding
toEncoding = Options -> RelationshipMetric -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

data PermissionMetric = PermissionMetric
  { PermissionMetric -> Int
_pmSelect :: Int,
    PermissionMetric -> Int
_pmInsert :: Int,
    PermissionMetric -> Int
_pmUpdate :: Int,
    PermissionMetric -> Int
_pmDelete :: Int,
    PermissionMetric -> Int
_pmRoles :: Int
  }
  deriving (Int -> PermissionMetric -> ShowS
[PermissionMetric] -> ShowS
PermissionMetric -> String
(Int -> PermissionMetric -> ShowS)
-> (PermissionMetric -> String)
-> ([PermissionMetric] -> ShowS)
-> Show PermissionMetric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PermissionMetric -> ShowS
showsPrec :: Int -> PermissionMetric -> ShowS
$cshow :: PermissionMetric -> String
show :: PermissionMetric -> String
$cshowList :: [PermissionMetric] -> ShowS
showList :: [PermissionMetric] -> ShowS
Show, PermissionMetric -> PermissionMetric -> Bool
(PermissionMetric -> PermissionMetric -> Bool)
-> (PermissionMetric -> PermissionMetric -> Bool)
-> Eq PermissionMetric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PermissionMetric -> PermissionMetric -> Bool
== :: PermissionMetric -> PermissionMetric -> Bool
$c/= :: PermissionMetric -> PermissionMetric -> Bool
/= :: PermissionMetric -> PermissionMetric -> Bool
Eq, (forall x. PermissionMetric -> Rep PermissionMetric x)
-> (forall x. Rep PermissionMetric x -> PermissionMetric)
-> Generic PermissionMetric
forall x. Rep PermissionMetric x -> PermissionMetric
forall x. PermissionMetric -> Rep PermissionMetric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PermissionMetric -> Rep PermissionMetric x
from :: forall x. PermissionMetric -> Rep PermissionMetric x
$cto :: forall x. Rep PermissionMetric x -> PermissionMetric
to :: forall x. Rep PermissionMetric x -> PermissionMetric
Generic)

instance J.ToJSON PermissionMetric where
  toJSON :: PermissionMetric -> Value
toJSON = Options -> PermissionMetric -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: PermissionMetric -> Encoding
toEncoding = Options -> PermissionMetric -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

data ActionMetric = ActionMetric
  { ActionMetric -> Int
_amSynchronous :: Int,
    ActionMetric -> Int
_amAsynchronous :: Int,
    ActionMetric -> Int
_amQueryActions :: Int,
    ActionMetric -> Int
_amTypeRelationships :: Int,
    ActionMetric -> Int
_amCustomTypes :: Int
  }
  deriving (Int -> ActionMetric -> ShowS
[ActionMetric] -> ShowS
ActionMetric -> String
(Int -> ActionMetric -> ShowS)
-> (ActionMetric -> String)
-> ([ActionMetric] -> ShowS)
-> Show ActionMetric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionMetric -> ShowS
showsPrec :: Int -> ActionMetric -> ShowS
$cshow :: ActionMetric -> String
show :: ActionMetric -> String
$cshowList :: [ActionMetric] -> ShowS
showList :: [ActionMetric] -> ShowS
Show, ActionMetric -> ActionMetric -> Bool
(ActionMetric -> ActionMetric -> Bool)
-> (ActionMetric -> ActionMetric -> Bool) -> Eq ActionMetric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionMetric -> ActionMetric -> Bool
== :: ActionMetric -> ActionMetric -> Bool
$c/= :: ActionMetric -> ActionMetric -> Bool
/= :: ActionMetric -> ActionMetric -> Bool
Eq, (forall x. ActionMetric -> Rep ActionMetric x)
-> (forall x. Rep ActionMetric x -> ActionMetric)
-> Generic ActionMetric
forall x. Rep ActionMetric x -> ActionMetric
forall x. ActionMetric -> Rep ActionMetric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ActionMetric -> Rep ActionMetric x
from :: forall x. ActionMetric -> Rep ActionMetric x
$cto :: forall x. Rep ActionMetric x -> ActionMetric
to :: forall x. Rep ActionMetric x -> ActionMetric
Generic)

instance J.ToJSON ActionMetric where
  toJSON :: ActionMetric -> Value
toJSON = Options -> ActionMetric -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: ActionMetric -> Encoding
toEncoding = Options -> ActionMetric -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

data NativeQueriesMetrics = NativeQueriesMetrics
  { NativeQueriesMetrics -> Int
_nqmWithParameters :: Int,
    NativeQueriesMetrics -> Int
_nqmWithoutParameters :: Int
  }
  deriving (Int -> NativeQueriesMetrics -> ShowS
[NativeQueriesMetrics] -> ShowS
NativeQueriesMetrics -> String
(Int -> NativeQueriesMetrics -> ShowS)
-> (NativeQueriesMetrics -> String)
-> ([NativeQueriesMetrics] -> ShowS)
-> Show NativeQueriesMetrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NativeQueriesMetrics -> ShowS
showsPrec :: Int -> NativeQueriesMetrics -> ShowS
$cshow :: NativeQueriesMetrics -> String
show :: NativeQueriesMetrics -> String
$cshowList :: [NativeQueriesMetrics] -> ShowS
showList :: [NativeQueriesMetrics] -> ShowS
Show, NativeQueriesMetrics -> NativeQueriesMetrics -> Bool
(NativeQueriesMetrics -> NativeQueriesMetrics -> Bool)
-> (NativeQueriesMetrics -> NativeQueriesMetrics -> Bool)
-> Eq NativeQueriesMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NativeQueriesMetrics -> NativeQueriesMetrics -> Bool
== :: NativeQueriesMetrics -> NativeQueriesMetrics -> Bool
$c/= :: NativeQueriesMetrics -> NativeQueriesMetrics -> Bool
/= :: NativeQueriesMetrics -> NativeQueriesMetrics -> Bool
Eq, (forall x. NativeQueriesMetrics -> Rep NativeQueriesMetrics x)
-> (forall x. Rep NativeQueriesMetrics x -> NativeQueriesMetrics)
-> Generic NativeQueriesMetrics
forall x. Rep NativeQueriesMetrics x -> NativeQueriesMetrics
forall x. NativeQueriesMetrics -> Rep NativeQueriesMetrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NativeQueriesMetrics -> Rep NativeQueriesMetrics x
from :: forall x. NativeQueriesMetrics -> Rep NativeQueriesMetrics x
$cto :: forall x. Rep NativeQueriesMetrics x -> NativeQueriesMetrics
to :: forall x. Rep NativeQueriesMetrics x -> NativeQueriesMetrics
Generic)

instance Semigroup NativeQueriesMetrics where
  NativeQueriesMetrics
a <> :: NativeQueriesMetrics
-> NativeQueriesMetrics -> NativeQueriesMetrics
<> NativeQueriesMetrics
b =
    Int -> Int -> NativeQueriesMetrics
NativeQueriesMetrics
      (NativeQueriesMetrics -> Int
_nqmWithParameters NativeQueriesMetrics
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ NativeQueriesMetrics -> Int
_nqmWithParameters NativeQueriesMetrics
b)
      (NativeQueriesMetrics -> Int
_nqmWithoutParameters NativeQueriesMetrics
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ NativeQueriesMetrics -> Int
_nqmWithoutParameters NativeQueriesMetrics
b)

instance Monoid NativeQueriesMetrics where
  mempty :: NativeQueriesMetrics
mempty = Int -> Int -> NativeQueriesMetrics
NativeQueriesMetrics Int
0 Int
0

instance J.ToJSON NativeQueriesMetrics where
  toJSON :: NativeQueriesMetrics -> Value
toJSON = Options -> NativeQueriesMetrics -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: NativeQueriesMetrics -> Encoding
toEncoding = Options -> NativeQueriesMetrics -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

data StoredProceduresMetrics = StoredProceduresMetrics
  { StoredProceduresMetrics -> Int
_spmWithParameters :: Int,
    StoredProceduresMetrics -> Int
_spmWithoutParameters :: Int
  }
  deriving (Int -> StoredProceduresMetrics -> ShowS
[StoredProceduresMetrics] -> ShowS
StoredProceduresMetrics -> String
(Int -> StoredProceduresMetrics -> ShowS)
-> (StoredProceduresMetrics -> String)
-> ([StoredProceduresMetrics] -> ShowS)
-> Show StoredProceduresMetrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoredProceduresMetrics -> ShowS
showsPrec :: Int -> StoredProceduresMetrics -> ShowS
$cshow :: StoredProceduresMetrics -> String
show :: StoredProceduresMetrics -> String
$cshowList :: [StoredProceduresMetrics] -> ShowS
showList :: [StoredProceduresMetrics] -> ShowS
Show, StoredProceduresMetrics -> StoredProceduresMetrics -> Bool
(StoredProceduresMetrics -> StoredProceduresMetrics -> Bool)
-> (StoredProceduresMetrics -> StoredProceduresMetrics -> Bool)
-> Eq StoredProceduresMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoredProceduresMetrics -> StoredProceduresMetrics -> Bool
== :: StoredProceduresMetrics -> StoredProceduresMetrics -> Bool
$c/= :: StoredProceduresMetrics -> StoredProceduresMetrics -> Bool
/= :: StoredProceduresMetrics -> StoredProceduresMetrics -> Bool
Eq, (forall x.
 StoredProceduresMetrics -> Rep StoredProceduresMetrics x)
-> (forall x.
    Rep StoredProceduresMetrics x -> StoredProceduresMetrics)
-> Generic StoredProceduresMetrics
forall x. Rep StoredProceduresMetrics x -> StoredProceduresMetrics
forall x. StoredProceduresMetrics -> Rep StoredProceduresMetrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoredProceduresMetrics -> Rep StoredProceduresMetrics x
from :: forall x. StoredProceduresMetrics -> Rep StoredProceduresMetrics x
$cto :: forall x. Rep StoredProceduresMetrics x -> StoredProceduresMetrics
to :: forall x. Rep StoredProceduresMetrics x -> StoredProceduresMetrics
Generic)

instance Semigroup StoredProceduresMetrics where
  StoredProceduresMetrics
a <> :: StoredProceduresMetrics
-> StoredProceduresMetrics -> StoredProceduresMetrics
<> StoredProceduresMetrics
b =
    Int -> Int -> StoredProceduresMetrics
StoredProceduresMetrics
      (StoredProceduresMetrics -> Int
_spmWithParameters StoredProceduresMetrics
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ StoredProceduresMetrics -> Int
_spmWithParameters StoredProceduresMetrics
b)
      (StoredProceduresMetrics -> Int
_spmWithoutParameters StoredProceduresMetrics
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ StoredProceduresMetrics -> Int
_spmWithoutParameters StoredProceduresMetrics
b)

instance Monoid StoredProceduresMetrics where
  mempty :: StoredProceduresMetrics
mempty = Int -> Int -> StoredProceduresMetrics
StoredProceduresMetrics Int
0 Int
0

instance J.ToJSON StoredProceduresMetrics where
  toJSON :: StoredProceduresMetrics -> Value
toJSON = Options -> StoredProceduresMetrics -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: StoredProceduresMetrics -> Encoding
toEncoding = Options -> StoredProceduresMetrics -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

newtype LogicalModelsMetrics = LogicalModelsMetrics
  { LogicalModelsMetrics -> Int
_lmmCount :: Int
  }
  deriving (Int -> LogicalModelsMetrics -> ShowS
[LogicalModelsMetrics] -> ShowS
LogicalModelsMetrics -> String
(Int -> LogicalModelsMetrics -> ShowS)
-> (LogicalModelsMetrics -> String)
-> ([LogicalModelsMetrics] -> ShowS)
-> Show LogicalModelsMetrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogicalModelsMetrics -> ShowS
showsPrec :: Int -> LogicalModelsMetrics -> ShowS
$cshow :: LogicalModelsMetrics -> String
show :: LogicalModelsMetrics -> String
$cshowList :: [LogicalModelsMetrics] -> ShowS
showList :: [LogicalModelsMetrics] -> ShowS
Show, LogicalModelsMetrics -> LogicalModelsMetrics -> Bool
(LogicalModelsMetrics -> LogicalModelsMetrics -> Bool)
-> (LogicalModelsMetrics -> LogicalModelsMetrics -> Bool)
-> Eq LogicalModelsMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogicalModelsMetrics -> LogicalModelsMetrics -> Bool
== :: LogicalModelsMetrics -> LogicalModelsMetrics -> Bool
$c/= :: LogicalModelsMetrics -> LogicalModelsMetrics -> Bool
/= :: LogicalModelsMetrics -> LogicalModelsMetrics -> Bool
Eq, (forall x. LogicalModelsMetrics -> Rep LogicalModelsMetrics x)
-> (forall x. Rep LogicalModelsMetrics x -> LogicalModelsMetrics)
-> Generic LogicalModelsMetrics
forall x. Rep LogicalModelsMetrics x -> LogicalModelsMetrics
forall x. LogicalModelsMetrics -> Rep LogicalModelsMetrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LogicalModelsMetrics -> Rep LogicalModelsMetrics x
from :: forall x. LogicalModelsMetrics -> Rep LogicalModelsMetrics x
$cto :: forall x. Rep LogicalModelsMetrics x -> LogicalModelsMetrics
to :: forall x. Rep LogicalModelsMetrics x -> LogicalModelsMetrics
Generic)
  deriving (NonEmpty LogicalModelsMetrics -> LogicalModelsMetrics
LogicalModelsMetrics
-> LogicalModelsMetrics -> LogicalModelsMetrics
(LogicalModelsMetrics
 -> LogicalModelsMetrics -> LogicalModelsMetrics)
-> (NonEmpty LogicalModelsMetrics -> LogicalModelsMetrics)
-> (forall b.
    Integral b =>
    b -> LogicalModelsMetrics -> LogicalModelsMetrics)
-> Semigroup LogicalModelsMetrics
forall b.
Integral b =>
b -> LogicalModelsMetrics -> LogicalModelsMetrics
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: LogicalModelsMetrics
-> LogicalModelsMetrics -> LogicalModelsMetrics
<> :: LogicalModelsMetrics
-> LogicalModelsMetrics -> LogicalModelsMetrics
$csconcat :: NonEmpty LogicalModelsMetrics -> LogicalModelsMetrics
sconcat :: NonEmpty LogicalModelsMetrics -> LogicalModelsMetrics
$cstimes :: forall b.
Integral b =>
b -> LogicalModelsMetrics -> LogicalModelsMetrics
stimes :: forall b.
Integral b =>
b -> LogicalModelsMetrics -> LogicalModelsMetrics
Semigroup, Semigroup LogicalModelsMetrics
LogicalModelsMetrics
Semigroup LogicalModelsMetrics
-> LogicalModelsMetrics
-> (LogicalModelsMetrics
    -> LogicalModelsMetrics -> LogicalModelsMetrics)
-> ([LogicalModelsMetrics] -> LogicalModelsMetrics)
-> Monoid LogicalModelsMetrics
[LogicalModelsMetrics] -> LogicalModelsMetrics
LogicalModelsMetrics
-> LogicalModelsMetrics -> LogicalModelsMetrics
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: LogicalModelsMetrics
mempty :: LogicalModelsMetrics
$cmappend :: LogicalModelsMetrics
-> LogicalModelsMetrics -> LogicalModelsMetrics
mappend :: LogicalModelsMetrics
-> LogicalModelsMetrics -> LogicalModelsMetrics
$cmconcat :: [LogicalModelsMetrics] -> LogicalModelsMetrics
mconcat :: [LogicalModelsMetrics] -> LogicalModelsMetrics
Monoid) via Sum Int

instance J.ToJSON LogicalModelsMetrics where
  toJSON :: LogicalModelsMetrics -> Value
toJSON = Options -> LogicalModelsMetrics -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: LogicalModelsMetrics -> Encoding
toEncoding = Options -> LogicalModelsMetrics -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

data Metrics = Metrics
  { Metrics -> Int
_mtTables :: Int,
    Metrics -> Int
_mtViews :: Int,
    Metrics -> Int
_mtEnumTables :: Int,
    Metrics -> RelationshipMetric
_mtRelationships :: RelationshipMetric,
    Metrics -> PermissionMetric
_mtPermissions :: PermissionMetric,
    Metrics -> Int
_mtEventTriggers :: Int,
    Metrics -> Int
_mtFunctions :: Int,
    Metrics -> Maybe Int
_mtRemoteSchemas :: Maybe Int,
    Metrics -> Maybe ServiceTimingMetrics
_mtServiceTimings :: Maybe ServiceTimingMetrics,
    Metrics -> Maybe ActionMetric
_mtActions :: Maybe ActionMetric,
    Metrics -> NativeQueriesMetrics
_mtNativeQueries :: NativeQueriesMetrics,
    Metrics -> StoredProceduresMetrics
_mtStoredProcedures :: StoredProceduresMetrics,
    Metrics -> LogicalModelsMetrics
_mtLogicalModels :: LogicalModelsMetrics
  }
  deriving (Int -> Metrics -> ShowS
[Metrics] -> ShowS
Metrics -> String
(Int -> Metrics -> ShowS)
-> (Metrics -> String) -> ([Metrics] -> ShowS) -> Show Metrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metrics -> ShowS
showsPrec :: Int -> Metrics -> ShowS
$cshow :: Metrics -> String
show :: Metrics -> String
$cshowList :: [Metrics] -> ShowS
showList :: [Metrics] -> ShowS
Show, Metrics -> Metrics -> Bool
(Metrics -> Metrics -> Bool)
-> (Metrics -> Metrics -> Bool) -> Eq Metrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metrics -> Metrics -> Bool
== :: Metrics -> Metrics -> Bool
$c/= :: Metrics -> Metrics -> Bool
/= :: Metrics -> Metrics -> Bool
Eq, (forall x. Metrics -> Rep Metrics x)
-> (forall x. Rep Metrics x -> Metrics) -> Generic Metrics
forall x. Rep Metrics x -> Metrics
forall x. Metrics -> Rep Metrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Metrics -> Rep Metrics x
from :: forall x. Metrics -> Rep Metrics x
$cto :: forall x. Rep Metrics x -> Metrics
to :: forall x. Rep Metrics x -> Metrics
Generic)

instance J.ToJSON Metrics where
  toJSON :: Metrics -> Value
toJSON = Options -> Metrics -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: Metrics -> Encoding
toEncoding = Options -> Metrics -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

data SourceMetadata = SourceMetadata
  { SourceMetadata -> Maybe DbUid
_smDbUid :: Maybe DbUid,
    SourceMetadata -> BackendType
_smBackendType :: BackendType,
    SourceMetadata -> Text
_smDbKind :: Text,
    SourceMetadata -> Maybe DbVersion
_smDbVersion :: Maybe DbVersion
  }
  deriving (Int -> SourceMetadata -> ShowS
[SourceMetadata] -> ShowS
SourceMetadata -> String
(Int -> SourceMetadata -> ShowS)
-> (SourceMetadata -> String)
-> ([SourceMetadata] -> ShowS)
-> Show SourceMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceMetadata -> ShowS
showsPrec :: Int -> SourceMetadata -> ShowS
$cshow :: SourceMetadata -> String
show :: SourceMetadata -> String
$cshowList :: [SourceMetadata] -> ShowS
showList :: [SourceMetadata] -> ShowS
Show, SourceMetadata -> SourceMetadata -> Bool
(SourceMetadata -> SourceMetadata -> Bool)
-> (SourceMetadata -> SourceMetadata -> Bool) -> Eq SourceMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceMetadata -> SourceMetadata -> Bool
== :: SourceMetadata -> SourceMetadata -> Bool
$c/= :: SourceMetadata -> SourceMetadata -> Bool
/= :: SourceMetadata -> SourceMetadata -> Bool
Eq, (forall x. SourceMetadata -> Rep SourceMetadata x)
-> (forall x. Rep SourceMetadata x -> SourceMetadata)
-> Generic SourceMetadata
forall x. Rep SourceMetadata x -> SourceMetadata
forall x. SourceMetadata -> Rep SourceMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SourceMetadata -> Rep SourceMetadata x
from :: forall x. SourceMetadata -> Rep SourceMetadata x
$cto :: forall x. Rep SourceMetadata x -> SourceMetadata
to :: forall x. Rep SourceMetadata x -> SourceMetadata
Generic)

instance J.ToJSON SourceMetadata where
  toJSON :: SourceMetadata -> Value
toJSON = Options -> SourceMetadata -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: SourceMetadata -> Encoding
toEncoding = Options -> SourceMetadata -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

data HasuraTelemetry = HasuraTelemetry
  { HasuraTelemetry -> MetadataDbId
_htMetadataDbUid :: MetadataDbId,
    HasuraTelemetry -> InstanceId
_htInstanceUid :: InstanceId,
    HasuraTelemetry -> Version
_htHasuraVersion :: Version,
    HasuraTelemetry -> Maybe CI
_htCi :: Maybe CI.CI,
    HasuraTelemetry -> SourceMetadata
_htSourceMetadata :: SourceMetadata,
    HasuraTelemetry -> Metrics
_htMetrics :: Metrics,
    HasuraTelemetry -> HashSet ExperimentalFeature
_htExperimentalFeatures :: HashSet ExperimentalFeature
  }
  deriving (Int -> HasuraTelemetry -> ShowS
[HasuraTelemetry] -> ShowS
HasuraTelemetry -> String
(Int -> HasuraTelemetry -> ShowS)
-> (HasuraTelemetry -> String)
-> ([HasuraTelemetry] -> ShowS)
-> Show HasuraTelemetry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HasuraTelemetry -> ShowS
showsPrec :: Int -> HasuraTelemetry -> ShowS
$cshow :: HasuraTelemetry -> String
show :: HasuraTelemetry -> String
$cshowList :: [HasuraTelemetry] -> ShowS
showList :: [HasuraTelemetry] -> ShowS
Show, (forall x. HasuraTelemetry -> Rep HasuraTelemetry x)
-> (forall x. Rep HasuraTelemetry x -> HasuraTelemetry)
-> Generic HasuraTelemetry
forall x. Rep HasuraTelemetry x -> HasuraTelemetry
forall x. HasuraTelemetry -> Rep HasuraTelemetry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HasuraTelemetry -> Rep HasuraTelemetry x
from :: forall x. HasuraTelemetry -> Rep HasuraTelemetry x
$cto :: forall x. Rep HasuraTelemetry x -> HasuraTelemetry
to :: forall x. Rep HasuraTelemetry x -> HasuraTelemetry
Generic)

instance J.ToJSON HasuraTelemetry where
  toJSON :: HasuraTelemetry -> Value
toJSON = Options -> HasuraTelemetry -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: HasuraTelemetry -> Encoding
toEncoding = Options -> HasuraTelemetry -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON

-- | The telemetry table to which we'll add telemetry.
newtype Topic = Topic {Topic -> Text
getTopic :: Text}
  deriving (Int -> Topic -> ShowS
[Topic] -> ShowS
Topic -> String
(Int -> Topic -> ShowS)
-> (Topic -> String) -> ([Topic] -> ShowS) -> Show Topic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Topic -> ShowS
showsPrec :: Int -> Topic -> ShowS
$cshow :: Topic -> String
show :: Topic -> String
$cshowList :: [Topic] -> ShowS
showList :: [Topic] -> ShowS
Show, Topic -> Topic -> Bool
(Topic -> Topic -> Bool) -> (Topic -> Topic -> Bool) -> Eq Topic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Topic -> Topic -> Bool
== :: Topic -> Topic -> Bool
$c/= :: Topic -> Topic -> Bool
/= :: Topic -> Topic -> Bool
Eq, [Topic] -> Value
[Topic] -> Encoding
Topic -> Value
Topic -> Encoding
(Topic -> Value)
-> (Topic -> Encoding)
-> ([Topic] -> Value)
-> ([Topic] -> Encoding)
-> ToJSON Topic
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Topic -> Value
toJSON :: Topic -> Value
$ctoEncoding :: Topic -> Encoding
toEncoding :: Topic -> Encoding
$ctoJSONList :: [Topic] -> Value
toJSONList :: [Topic] -> Value
$ctoEncodingList :: [Topic] -> Encoding
toEncodingList :: [Topic] -> Encoding
J.ToJSON, Value -> Parser [Topic]
Value -> Parser Topic
(Value -> Parser Topic)
-> (Value -> Parser [Topic]) -> FromJSON Topic
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Topic
parseJSON :: Value -> Parser Topic
$cparseJSONList :: Value -> Parser [Topic]
parseJSONList :: Value -> Parser [Topic]
J.FromJSON)

data TelemetryPayload = TelemetryPayload
  { TelemetryPayload -> Topic
_tpTopic :: Topic,
    TelemetryPayload -> HasuraTelemetry
_tpData :: HasuraTelemetry
  }
  deriving (Int -> TelemetryPayload -> ShowS
[TelemetryPayload] -> ShowS
TelemetryPayload -> String
(Int -> TelemetryPayload -> ShowS)
-> (TelemetryPayload -> String)
-> ([TelemetryPayload] -> ShowS)
-> Show TelemetryPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TelemetryPayload -> ShowS
showsPrec :: Int -> TelemetryPayload -> ShowS
$cshow :: TelemetryPayload -> String
show :: TelemetryPayload -> String
$cshowList :: [TelemetryPayload] -> ShowS
showList :: [TelemetryPayload] -> ShowS
Show, (forall x. TelemetryPayload -> Rep TelemetryPayload x)
-> (forall x. Rep TelemetryPayload x -> TelemetryPayload)
-> Generic TelemetryPayload
forall x. Rep TelemetryPayload x -> TelemetryPayload
forall x. TelemetryPayload -> Rep TelemetryPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TelemetryPayload -> Rep TelemetryPayload x
from :: forall x. TelemetryPayload -> Rep TelemetryPayload x
$cto :: forall x. Rep TelemetryPayload x -> TelemetryPayload
to :: forall x. Rep TelemetryPayload x -> TelemetryPayload
Generic)

instance J.ToJSON TelemetryPayload where
  toJSON :: TelemetryPayload -> Value
toJSON = Options -> TelemetryPayload -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
J.genericToJSON Options
hasuraJSON
  toEncoding :: TelemetryPayload -> Encoding
toEncoding = Options -> TelemetryPayload -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
J.genericToEncoding Options
hasuraJSON