{-# LANGUAGE ScopedTypeVariables #-}

-- |
--  Send anonymized metrics to the telemetry server regarding usage of various
--  features of Hasura.
--
-- The general workflow for telemetry is as follows:
--
-- 1. We generate metrics for each backend in the graphql-engine code and send it to 'telemetryUrl'.
--    The relevant types can be found in "Hasura.Server.Telemetry.Types".
-- 2. The 'telemetryUrl' endpoint is handled by code in:
--    <https://github.com/hasura/hasura-analytics/tree/hge-upgrade>, specifically
--    <manager/main.go> and <manager/analytics.go>.
--    This server endpoint receives the telemetry payload and sends it to another graphql-engine
--    which runs locally and is backed by a postgres database.
--    The database schema for the telemetry endpoint can also be found in the same repo under <hge/migrations/>.
-- 3. The information from the postgres db can be viewed in Metabase:
--    <https://metabase.telemetry.hasura.io/browse/2/schema/public>.
--
-- For more information about telemetry in general, visit the user-facing docs on the topic:
-- <https://hasura.io/docs/latest/graphql/core/guides/telemetry>.
module Hasura.Server.Telemetry
  ( runTelemetry,
    mkTelemetryLog,
  )
where

import CI qualified
import Control.Concurrent.Extended qualified as C
import Control.Exception (try)
import Control.Lens
import Data.Aeson qualified as A
import Data.ByteString.Lazy qualified as BL
import Data.HashMap.Strict qualified as HM
import Data.HashMap.Strict qualified as Map
import Data.List qualified as L
import Data.List.Extended qualified as L
import Data.Text qualified as T
import Data.Text.Conversions (UTF8 (..), decodeText)
import Hasura.HTTP
import Hasura.Logging
import Hasura.Prelude
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Metadata.Instances ()
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as Any
import Hasura.SQL.Backend (BackendType)
import Hasura.SQL.Tag
import Hasura.Server.Telemetry.Counters (dumpServiceTimingMetrics)
import Hasura.Server.Telemetry.Types
import Hasura.Server.Types
import Hasura.Server.Version
import Hasura.Session
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Types qualified as HTTP
import Network.Wreq qualified as Wreq

-- * Logging and error handling

-- | Logging related
data TelemetryLog = TelemetryLog
  { TelemetryLog -> LogLevel
_tlLogLevel :: !LogLevel,
    TelemetryLog -> Text
_tlType :: !Text,
    TelemetryLog -> Text
_tlMessage :: !Text,
    TelemetryLog -> Maybe TelemetryHttpError
_tlHttpError :: !(Maybe TelemetryHttpError)
  }
  deriving (Int -> TelemetryLog -> ShowS
[TelemetryLog] -> ShowS
TelemetryLog -> String
(Int -> TelemetryLog -> ShowS)
-> (TelemetryLog -> String)
-> ([TelemetryLog] -> ShowS)
-> Show TelemetryLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TelemetryLog] -> ShowS
$cshowList :: [TelemetryLog] -> ShowS
show :: TelemetryLog -> String
$cshow :: TelemetryLog -> String
showsPrec :: Int -> TelemetryLog -> ShowS
$cshowsPrec :: Int -> TelemetryLog -> ShowS
Show)

data TelemetryHttpError = TelemetryHttpError
  { TelemetryHttpError -> Maybe Status
tlheStatus :: !(Maybe HTTP.Status),
    TelemetryHttpError -> Text
tlheUrl :: !Text,
    TelemetryHttpError -> Maybe HttpException
tlheHttpException :: !(Maybe HttpException),
    TelemetryHttpError -> Maybe Text
tlheResponse :: !(Maybe Text)
  }
  deriving (Int -> TelemetryHttpError -> ShowS
[TelemetryHttpError] -> ShowS
TelemetryHttpError -> String
(Int -> TelemetryHttpError -> ShowS)
-> (TelemetryHttpError -> String)
-> ([TelemetryHttpError] -> ShowS)
-> Show TelemetryHttpError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TelemetryHttpError] -> ShowS
$cshowList :: [TelemetryHttpError] -> ShowS
show :: TelemetryHttpError -> String
$cshow :: TelemetryHttpError -> String
showsPrec :: Int -> TelemetryHttpError -> ShowS
$cshowsPrec :: Int -> TelemetryHttpError -> ShowS
Show)

instance A.ToJSON TelemetryLog where
  toJSON :: TelemetryLog -> Value
toJSON TelemetryLog
tl =
    [Pair] -> Value
A.object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= TelemetryLog -> Text
_tlType TelemetryLog
tl,
        Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= TelemetryLog -> Text
_tlMessage TelemetryLog
tl,
        Key
"http_error" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (TelemetryHttpError -> Value
forall a. ToJSON a => a -> Value
A.toJSON (TelemetryHttpError -> Value)
-> Maybe TelemetryHttpError -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TelemetryLog -> Maybe TelemetryHttpError
_tlHttpError TelemetryLog
tl)
      ]

instance A.ToJSON TelemetryHttpError where
  toJSON :: TelemetryHttpError -> Value
toJSON TelemetryHttpError
tlhe =
    [Pair] -> Value
A.object
      [ Key
"status_code" Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (Status -> Int
HTTP.statusCode (Status -> Int) -> Maybe Status -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TelemetryHttpError -> Maybe Status
tlheStatus TelemetryHttpError
tlhe),
        Key
"url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= TelemetryHttpError -> Text
tlheUrl TelemetryHttpError
tlhe,
        Key
"response" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= TelemetryHttpError -> Maybe Text
tlheResponse TelemetryHttpError
tlhe,
        Key
"http_exception" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (HttpException -> Value
forall a. ToJSON a => a -> Value
A.toJSON (HttpException -> Value) -> Maybe HttpException -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TelemetryHttpError -> Maybe HttpException
tlheHttpException TelemetryHttpError
tlhe)
      ]

instance ToEngineLog TelemetryLog Hasura where
  toEngineLog :: TelemetryLog -> (LogLevel, EngineLogType Hasura, Value)
toEngineLog TelemetryLog
tl = (TelemetryLog -> LogLevel
_tlLogLevel TelemetryLog
tl, InternalLogTypes -> EngineLogType Hasura
ELTInternal InternalLogTypes
ILTTelemetry, TelemetryLog -> Value
forall a. ToJSON a => a -> Value
A.toJSON TelemetryLog
tl)

mkHttpError ::
  Text ->
  Maybe (Wreq.Response BL.ByteString) ->
  Maybe HttpException ->
  TelemetryHttpError
mkHttpError :: Text
-> Maybe (Response ByteString)
-> Maybe HttpException
-> TelemetryHttpError
mkHttpError Text
url Maybe (Response ByteString)
mResp Maybe HttpException
httpEx =
  case Maybe (Response ByteString)
mResp of
    Maybe (Response ByteString)
Nothing -> Maybe Status
-> Text -> Maybe HttpException -> Maybe Text -> TelemetryHttpError
TelemetryHttpError Maybe Status
forall a. Maybe a
Nothing Text
url Maybe HttpException
httpEx Maybe Text
forall a. Maybe a
Nothing
    Just Response ByteString
resp ->
      let status :: Status
status = Response ByteString
resp Response ByteString
-> Getting Status (Response ByteString) Status -> Status
forall s a. s -> Getting a s a -> a
^. Getting Status (Response ByteString) Status
forall body. Lens' (Response body) Status
Wreq.responseStatus
          body :: Maybe Text
body = UTF8 ByteString -> Maybe Text
forall (f :: * -> *) a. DecodeText f a => a -> f Text
decodeText (UTF8 ByteString -> Maybe Text) -> UTF8 ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ByteString -> UTF8 ByteString
forall a. a -> UTF8 a
UTF8 (Response ByteString
resp Response ByteString
-> Getting ByteString (Response ByteString) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody)
       in Maybe Status
-> Text -> Maybe HttpException -> Maybe Text -> TelemetryHttpError
TelemetryHttpError (Status -> Maybe Status
forall a. a -> Maybe a
Just Status
status) Text
url Maybe HttpException
httpEx Maybe Text
body

mkTelemetryLog :: Text -> Text -> Maybe TelemetryHttpError -> TelemetryLog
mkTelemetryLog :: Text -> Text -> Maybe TelemetryHttpError -> TelemetryLog
mkTelemetryLog = LogLevel
-> Text -> Text -> Maybe TelemetryHttpError -> TelemetryLog
TelemetryLog LogLevel
LevelInfo

-- * Endpoint

telemetryUrl :: Text
telemetryUrl :: Text
telemetryUrl = Text
"https://telemetry.hasura.io/v1/http"

-- * Execution

-- | An infinite loop that sends updated telemetry data ('Metrics') every 24
-- hours. The send time depends on when the server was started and will
-- naturally drift.
runTelemetry ::
  Logger Hasura ->
  HTTP.Manager ->
  -- | an action that always returns the latest schema cache
  IO SchemaCache ->
  MetadataDbId ->
  InstanceId ->
  PGVersion ->
  IO void
runTelemetry :: Logger Hasura
-> Manager
-> IO SchemaCache
-> MetadataDbId
-> InstanceId
-> PGVersion
-> IO void
runTelemetry (Logger forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger) Manager
manager IO SchemaCache
getSchemaCache MetadataDbId
metadataDbUid InstanceId
instanceId PGVersion
pgVersion = do
  let options :: Options
options = Manager -> [Header] -> Options
wreqOptions Manager
manager []
  IO () -> IO void
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO void) -> IO () -> IO void
forall a b. (a -> b) -> a -> b
$ do
    SchemaCache
schemaCache <- IO SchemaCache
getSchemaCache
    ServiceTimingMetrics
serviceTimings <- IO ServiceTimingMetrics
forall (m :: * -> *). MonadIO m => m ServiceTimingMetrics
dumpServiceTimingMetrics
    Maybe CI
ci <- IO (Maybe CI)
CI.getCI

    -- Creates a telemetry payload for a specific backend.
    let telemetryForSource :: forall (b :: BackendType). HasTag b => SourceInfo b -> TelemetryPayload
        telemetryForSource :: SourceInfo b -> TelemetryPayload
telemetryForSource =
          MetadataDbId
-> InstanceId
-> Version
-> PGVersion
-> Maybe CI
-> ServiceTimingMetrics
-> RemoteSchemaMap
-> ActionCache
-> SourceInfo b
-> TelemetryPayload
forall (b :: BackendType).
HasTag b =>
MetadataDbId
-> InstanceId
-> Version
-> PGVersion
-> Maybe CI
-> ServiceTimingMetrics
-> RemoteSchemaMap
-> ActionCache
-> SourceInfo b
-> TelemetryPayload
mkTelemetryPayload
            MetadataDbId
metadataDbUid
            InstanceId
instanceId
            Version
currentVersion
            PGVersion
pgVersion
            Maybe CI
ci
            ServiceTimingMetrics
serviceTimings
            (SchemaCache -> RemoteSchemaMap
scRemoteSchemas SchemaCache
schemaCache)
            (SchemaCache -> ActionCache
scActions SchemaCache
schemaCache)
        telemetries :: [TelemetryPayload]
telemetries =
          (AnyBackend SourceInfo -> TelemetryPayload)
-> [AnyBackend SourceInfo] -> [TelemetryPayload]
forall a b. (a -> b) -> [a] -> [b]
map
            (\AnyBackend SourceInfo
sourceinfo -> (AnyBackend SourceInfo
-> (forall (b :: BackendType).
    HasTag b =>
    SourceInfo b -> TelemetryPayload)
-> TelemetryPayload
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
Any.dispatchAnyBackend @HasTag) AnyBackend SourceInfo
sourceinfo forall (b :: BackendType).
HasTag b =>
SourceInfo b -> TelemetryPayload
telemetryForSource)
            (HashMap SourceName (AnyBackend SourceInfo)
-> [AnyBackend SourceInfo]
forall k v. HashMap k v -> [v]
HM.elems (SchemaCache -> HashMap SourceName (AnyBackend SourceInfo)
scSources SchemaCache
schemaCache))
        payloads :: [ByteString]
payloads = TelemetryPayload -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (TelemetryPayload -> ByteString)
-> [TelemetryPayload] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TelemetryPayload]
telemetries

    [ByteString] -> (ByteString -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ByteString]
payloads ((ByteString -> IO ()) -> IO ()) -> (ByteString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ByteString
payload -> do
      UnstructuredLog -> IO ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger (UnstructuredLog -> IO ()) -> UnstructuredLog -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> UnstructuredLog
debugLBS (ByteString -> UnstructuredLog) -> ByteString -> UnstructuredLog
forall a b. (a -> b) -> a -> b
$ ByteString
"metrics_info: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
payload
      Either HttpException (Response ByteString)
resp <- IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Response ByteString)
 -> IO (Either HttpException (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Options -> String -> ByteString -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
Wreq.postWith Options
options (Text -> String
T.unpack Text
telemetryUrl) ByteString
payload
      (HttpException -> IO ())
-> (Response ByteString -> IO ())
-> Either HttpException (Response ByteString)
-> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HttpException -> IO ()
logHttpEx Response ByteString -> IO ()
handleHttpResp Either HttpException (Response ByteString)
resp
    DiffTime -> IO ()
C.sleep (DiffTime -> IO ()) -> DiffTime -> IO ()
forall a b. (a -> b) -> a -> b
$ Days -> DiffTime
days Days
1
  where
    logHttpEx :: HTTP.HttpException -> IO ()
    logHttpEx :: HttpException -> IO ()
logHttpEx HttpException
ex = do
      let httpErr :: Maybe TelemetryHttpError
httpErr = TelemetryHttpError -> Maybe TelemetryHttpError
forall a. a -> Maybe a
Just (TelemetryHttpError -> Maybe TelemetryHttpError)
-> TelemetryHttpError -> Maybe TelemetryHttpError
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe (Response ByteString)
-> Maybe HttpException
-> TelemetryHttpError
mkHttpError Text
telemetryUrl Maybe (Response ByteString)
forall a. Maybe a
Nothing (HttpException -> Maybe HttpException
forall a. a -> Maybe a
Just (HttpException -> Maybe HttpException)
-> HttpException -> Maybe HttpException
forall a b. (a -> b) -> a -> b
$ HttpException -> HttpException
HttpException HttpException
ex)
      TelemetryLog -> IO ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger (TelemetryLog -> IO ()) -> TelemetryLog -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe TelemetryHttpError -> TelemetryLog
mkTelemetryLog Text
"http_exception" Text
"http exception occurred" Maybe TelemetryHttpError
httpErr

    handleHttpResp :: Response ByteString -> IO ()
handleHttpResp Response ByteString
resp = do
      let statusCode :: Int
statusCode = Response ByteString
resp Response ByteString -> Getting Int (Response ByteString) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Status -> Const Int Status)
-> Response ByteString -> Const Int (Response ByteString)
forall body. Lens' (Response body) Status
Wreq.responseStatus ((Status -> Const Int Status)
 -> Response ByteString -> Const Int (Response ByteString))
-> ((Int -> Const Int Int) -> Status -> Const Int Status)
-> Getting Int (Response ByteString) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Status -> Const Int Status
Lens' Status Int
Wreq.statusCode
      UnstructuredLog -> IO ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger (UnstructuredLog -> IO ()) -> UnstructuredLog -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> UnstructuredLog
debugLBS (ByteString -> UnstructuredLog) -> ByteString -> UnstructuredLog
forall a b. (a -> b) -> a -> b
$ ByteString
"http_success: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Response ByteString
resp Response ByteString
-> Getting ByteString (Response ByteString) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
statusCode Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
200) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let httpErr :: Maybe TelemetryHttpError
httpErr = TelemetryHttpError -> Maybe TelemetryHttpError
forall a. a -> Maybe a
Just (TelemetryHttpError -> Maybe TelemetryHttpError)
-> TelemetryHttpError -> Maybe TelemetryHttpError
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe (Response ByteString)
-> Maybe HttpException
-> TelemetryHttpError
mkHttpError Text
telemetryUrl (Response ByteString -> Maybe (Response ByteString)
forall a. a -> Maybe a
Just Response ByteString
resp) Maybe HttpException
forall a. Maybe a
Nothing
        TelemetryLog -> IO ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger (TelemetryLog -> IO ()) -> TelemetryLog -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe TelemetryHttpError -> TelemetryLog
mkTelemetryLog Text
"http_error" Text
"failed to post telemetry" Maybe TelemetryHttpError
httpErr

-- * Generate metrics

-- | Generate a telemetry payload for a specific source by computing their
--   relevant metrics.
--   Additional information that may not be relevant to a particular source
--   such as service timing, remote schemas and actions, will be reported
--   only with the default source.
mkTelemetryPayload ::
  forall (b :: BackendType).
  HasTag b =>
  MetadataDbId ->
  InstanceId ->
  Version ->
  PGVersion ->
  Maybe CI.CI ->
  ServiceTimingMetrics ->
  RemoteSchemaMap ->
  ActionCache ->
  SourceInfo b ->
  TelemetryPayload
mkTelemetryPayload :: MetadataDbId
-> InstanceId
-> Version
-> PGVersion
-> Maybe CI
-> ServiceTimingMetrics
-> RemoteSchemaMap
-> ActionCache
-> SourceInfo b
-> TelemetryPayload
mkTelemetryPayload MetadataDbId
metadataDbId InstanceId
instanceId Version
version PGVersion
pgVersion Maybe CI
ci ServiceTimingMetrics
serviceTimings RemoteSchemaMap
remoteSchemaMap ActionCache
actionCache SourceInfo b
sourceInfo =
  let topic :: Topic
topic = Version -> Topic
versionToTopic Version
version
      sourceMetadata :: SourceMetadata
sourceMetadata =
        SourceMetadata :: Maybe DbUid -> BackendType -> Maybe DbVersion -> SourceMetadata
SourceMetadata
          { _smDbUid :: Maybe DbUid
_smDbUid = DbUid -> Maybe DbUid
forall a. a -> Maybe a
forDefaultSource (MetadataDbId -> DbUid
mdDbIdToDbUid MetadataDbId
metadataDbId),
            _smDbKind :: BackendType
_smDbKind = BackendTag b -> BackendType
forall (b :: BackendType). BackendTag b -> BackendType
reify (BackendTag b -> BackendType) -> BackendTag b -> BackendType
forall a b. (a -> b) -> a -> b
$ HasTag b => BackendTag b
forall (b :: BackendType). HasTag b => BackendTag b
backendTag @b,
            _smDbVersion :: Maybe DbVersion
_smDbVersion = DbVersion -> Maybe DbVersion
forall a. a -> Maybe a
forDefaultSource (PGVersion -> DbVersion
pgToDbVersion PGVersion
pgVersion)
          }
      -- We use this function to attach additional information that is not associated
      -- with a particular source, such as service timing, remote schemas and actions.
      -- These will be reported only with the default source.
      forDefaultSource :: forall a. a -> Maybe a
      forDefaultSource :: a -> Maybe a
forDefaultSource =
        if SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo b
sourceInfo SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
== SourceName
SNDefault
          then a -> Maybe a
forall a. a -> Maybe a
Just
          else Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
      metrics :: Metrics
metrics =
        SourceInfo b
-> Maybe ServiceTimingMetrics
-> Maybe RemoteSchemaMap
-> Maybe ActionCache
-> Metrics
forall (b :: BackendType).
SourceInfo b
-> Maybe ServiceTimingMetrics
-> Maybe RemoteSchemaMap
-> Maybe ActionCache
-> Metrics
computeMetrics
          SourceInfo b
sourceInfo
          (ServiceTimingMetrics -> Maybe ServiceTimingMetrics
forall a. a -> Maybe a
forDefaultSource ServiceTimingMetrics
serviceTimings)
          (RemoteSchemaMap -> Maybe RemoteSchemaMap
forall a. a -> Maybe a
forDefaultSource RemoteSchemaMap
remoteSchemaMap)
          (ActionCache -> Maybe ActionCache
forall a. a -> Maybe a
forDefaultSource ActionCache
actionCache)
      telemetry :: HasuraTelemetry
telemetry =
        MetadataDbId
-> InstanceId
-> Version
-> Maybe CI
-> SourceMetadata
-> Metrics
-> HasuraTelemetry
HasuraTelemetry MetadataDbId
metadataDbId InstanceId
instanceId Version
version Maybe CI
ci SourceMetadata
sourceMetadata Metrics
metrics
   in Topic -> HasuraTelemetry -> TelemetryPayload
TelemetryPayload Topic
topic HasuraTelemetry
telemetry

-- | Compute the relevant metrics for a specific source.
computeMetrics ::
  forall (b :: BackendType).
  SourceInfo b ->
  Maybe ServiceTimingMetrics ->
  Maybe RemoteSchemaMap ->
  Maybe ActionCache ->
  Metrics
computeMetrics :: SourceInfo b
-> Maybe ServiceTimingMetrics
-> Maybe RemoteSchemaMap
-> Maybe ActionCache
-> Metrics
computeMetrics SourceInfo b
sourceInfo Maybe ServiceTimingMetrics
_mtServiceTimings Maybe RemoteSchemaMap
remoteSchemaMap Maybe ActionCache
actionCache =
  let _mtTables :: Int
_mtTables = (TableInfo b -> Bool) -> Int
countSourceTables (Maybe ViewInfo -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe ViewInfo -> Bool)
-> (TableInfo b -> Maybe ViewInfo) -> TableInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> Maybe ViewInfo
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe ViewInfo
_tciViewInfo (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> Maybe ViewInfo)
-> (TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> TableInfo b
-> Maybe ViewInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo)
      _mtViews :: Int
_mtViews = (TableInfo b -> Bool) -> Int
countSourceTables (Maybe ViewInfo -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ViewInfo -> Bool)
-> (TableInfo b -> Maybe ViewInfo) -> TableInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> Maybe ViewInfo
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe ViewInfo
_tciViewInfo (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> Maybe ViewInfo)
-> (TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> TableInfo b
-> Maybe ViewInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo)
      _mtEnumTables :: Int
_mtEnumTables = (TableInfo b -> Bool) -> Int
countSourceTables (Maybe EnumValues -> Bool
forall a. Maybe a -> Bool
isJust (Maybe EnumValues -> Bool)
-> (TableInfo b -> Maybe EnumValues) -> TableInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> Maybe EnumValues
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe EnumValues
_tciEnumValues (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> Maybe EnumValues)
-> (TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> TableInfo b
-> Maybe EnumValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo)
      allRels :: [RelInfo b]
allRels = [[RelInfo b]] -> [RelInfo b]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[RelInfo b]] -> [RelInfo b]) -> [[RelInfo b]] -> [RelInfo b]
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) [RelInfo b] -> [[RelInfo b]]
forall k v. HashMap k v -> [v]
Map.elems (HashMap (TableName b) [RelInfo b] -> [[RelInfo b]])
-> HashMap (TableName b) [RelInfo b] -> [[RelInfo b]]
forall a b. (a -> b) -> a -> b
$ (TableInfo b -> [RelInfo b])
-> HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) [RelInfo b]
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map (FieldInfoMap (FieldInfo b) -> [RelInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [RelInfo backend]
getRels (FieldInfoMap (FieldInfo b) -> [RelInfo b])
-> (TableInfo b -> FieldInfoMap (FieldInfo b))
-> TableInfo b
-> [RelInfo b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> FieldInfoMap (FieldInfo b))
-> (TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> TableInfo b
-> FieldInfoMap (FieldInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo) HashMap (TableName b) (TableInfo b)
sourceTableCache
      ([RelInfo b]
manualRels, [RelInfo b]
autoRels) = (RelInfo b -> Bool) -> [RelInfo b] -> ([RelInfo b], [RelInfo b])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition RelInfo b -> Bool
forall (b :: BackendType). RelInfo b -> Bool
riIsManual [RelInfo b]
allRels
      _mtRelationships :: RelationshipMetric
_mtRelationships = Int -> Int -> RelationshipMetric
RelationshipMetric ([RelInfo b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RelInfo b]
manualRels) ([RelInfo b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RelInfo b]
autoRels)
      rolePerms :: [(RoleName, RolePermInfo b)]
rolePerms = [[(RoleName, RolePermInfo b)]] -> [(RoleName, RolePermInfo b)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(RoleName, RolePermInfo b)]] -> [(RoleName, RolePermInfo b)])
-> [[(RoleName, RolePermInfo b)]] -> [(RoleName, RolePermInfo b)]
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) [(RoleName, RolePermInfo b)]
-> [[(RoleName, RolePermInfo b)]]
forall k v. HashMap k v -> [v]
Map.elems (HashMap (TableName b) [(RoleName, RolePermInfo b)]
 -> [[(RoleName, RolePermInfo b)]])
-> HashMap (TableName b) [(RoleName, RolePermInfo b)]
-> [[(RoleName, RolePermInfo b)]]
forall a b. (a -> b) -> a -> b
$ (TableInfo b -> [(RoleName, RolePermInfo b)])
-> HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) [(RoleName, RolePermInfo b)]
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map TableInfo b -> [(RoleName, RolePermInfo b)]
permsOfTbl HashMap (TableName b) (TableInfo b)
sourceTableCache
      _pmRoles :: Int
_pmRoles = [RoleName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([RoleName] -> Int) -> [RoleName] -> Int
forall a b. (a -> b) -> a -> b
$ [RoleName] -> [RoleName]
forall a. Ord a => [a] -> [a]
L.uniques ([RoleName] -> [RoleName]) -> [RoleName] -> [RoleName]
forall a b. (a -> b) -> a -> b
$ (RoleName, RolePermInfo b) -> RoleName
forall a b. (a, b) -> a
fst ((RoleName, RolePermInfo b) -> RoleName)
-> [(RoleName, RolePermInfo b)] -> [RoleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RoleName, RolePermInfo b)]
rolePerms
      allPerms :: [RolePermInfo b]
allPerms = (RoleName, RolePermInfo b) -> RolePermInfo b
forall a b. (a, b) -> b
snd ((RoleName, RolePermInfo b) -> RolePermInfo b)
-> [(RoleName, RolePermInfo b)] -> [RolePermInfo b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RoleName, RolePermInfo b)]
rolePerms
      _pmInsert :: Int
_pmInsert = (RolePermInfo b -> Maybe (InsPermInfo b))
-> [RolePermInfo b] -> Int
forall a. (RolePermInfo b -> Maybe a) -> [RolePermInfo b] -> Int
calcPerms RolePermInfo b -> Maybe (InsPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (InsPermInfo b)
_permIns [RolePermInfo b]
allPerms
      _pmSelect :: Int
_pmSelect = (RolePermInfo b -> Maybe (SelPermInfo b))
-> [RolePermInfo b] -> Int
forall a. (RolePermInfo b -> Maybe a) -> [RolePermInfo b] -> Int
calcPerms RolePermInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (SelPermInfo b)
_permSel [RolePermInfo b]
allPerms
      _pmUpdate :: Int
_pmUpdate = (RolePermInfo b -> Maybe (UpdPermInfo b))
-> [RolePermInfo b] -> Int
forall a. (RolePermInfo b -> Maybe a) -> [RolePermInfo b] -> Int
calcPerms RolePermInfo b -> Maybe (UpdPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (UpdPermInfo b)
_permUpd [RolePermInfo b]
allPerms
      _pmDelete :: Int
_pmDelete = (RolePermInfo b -> Maybe (DelPermInfo b))
-> [RolePermInfo b] -> Int
forall a. (RolePermInfo b -> Maybe a) -> [RolePermInfo b] -> Int
calcPerms RolePermInfo b -> Maybe (DelPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (DelPermInfo b)
_permDel [RolePermInfo b]
allPerms
      _mtPermissions :: PermissionMetric
_mtPermissions =
        PermissionMetric :: Int -> Int -> Int -> Int -> Int -> PermissionMetric
PermissionMetric {Int
_pmRoles :: Int
_pmDelete :: Int
_pmUpdate :: Int
_pmInsert :: Int
_pmSelect :: Int
_pmDelete :: Int
_pmUpdate :: Int
_pmSelect :: Int
_pmInsert :: Int
_pmRoles :: Int
..}
      _mtEventTriggers :: Int
_mtEventTriggers =
        HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
-> Int
forall k v. HashMap k v -> Int
Map.size (HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
 -> Int)
-> HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
-> Int
forall a b. (a -> b) -> a -> b
$
          (HashMap TriggerName (EventTriggerInfo b) -> Bool)
-> HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
-> HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (HashMap TriggerName (EventTriggerInfo b) -> Bool)
-> HashMap TriggerName (EventTriggerInfo b)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap TriggerName (EventTriggerInfo b) -> Bool
forall k v. HashMap k v -> Bool
Map.null) (HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
 -> HashMap
      (TableName b) (HashMap TriggerName (EventTriggerInfo b)))
-> HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
-> HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
forall a b. (a -> b) -> a -> b
$
            (TableInfo b -> HashMap TriggerName (EventTriggerInfo b))
-> HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map TableInfo b -> HashMap TriggerName (EventTriggerInfo b)
forall (b :: BackendType). TableInfo b -> EventTriggerInfoMap b
_tiEventTriggerInfoMap HashMap (TableName b) (TableInfo b)
sourceTableCache
      _mtRemoteSchemas :: Maybe Int
_mtRemoteSchemas = RemoteSchemaMap -> Int
forall k v. HashMap k v -> Int
Map.size (RemoteSchemaMap -> Int) -> Maybe RemoteSchemaMap -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RemoteSchemaMap
remoteSchemaMap
      _mtFunctions :: Int
_mtFunctions = HashMap (FunctionName b) (FunctionInfo b) -> Int
forall k v. HashMap k v -> Int
Map.size (HashMap (FunctionName b) (FunctionInfo b) -> Int)
-> HashMap (FunctionName b) (FunctionInfo b) -> Int
forall a b. (a -> b) -> a -> b
$ (FunctionInfo b -> Bool)
-> HashMap (FunctionName b) (FunctionInfo b)
-> HashMap (FunctionName b) (FunctionInfo b)
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (FunctionInfo b -> Bool) -> FunctionInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemDefined -> Bool
isSystemDefined (SystemDefined -> Bool)
-> (FunctionInfo b -> SystemDefined) -> FunctionInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionInfo b -> SystemDefined
forall (b :: BackendType). FunctionInfo b -> SystemDefined
_fiSystemDefined) HashMap (FunctionName b) (FunctionInfo b)
sourceFunctionCache
      _mtActions :: Maybe ActionMetric
_mtActions = ActionCache -> ActionMetric
computeActionsMetrics (ActionCache -> ActionMetric)
-> Maybe ActionCache -> Maybe ActionMetric
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ActionCache
actionCache
   in Metrics :: Int
-> Int
-> Int
-> RelationshipMetric
-> PermissionMetric
-> Int
-> Int
-> Maybe Int
-> Maybe ServiceTimingMetrics
-> Maybe ActionMetric
-> Metrics
Metrics {Int
Maybe Int
Maybe ServiceTimingMetrics
Maybe ActionMetric
RelationshipMetric
PermissionMetric
_mtActions :: Maybe ActionMetric
_mtServiceTimings :: Maybe ServiceTimingMetrics
_mtRemoteSchemas :: Maybe Int
_mtFunctions :: Int
_mtEventTriggers :: Int
_mtPermissions :: PermissionMetric
_mtRelationships :: RelationshipMetric
_mtEnumTables :: Int
_mtViews :: Int
_mtTables :: Int
_mtActions :: Maybe ActionMetric
_mtFunctions :: Int
_mtRemoteSchemas :: Maybe Int
_mtEventTriggers :: Int
_mtPermissions :: PermissionMetric
_mtRelationships :: RelationshipMetric
_mtEnumTables :: Int
_mtViews :: Int
_mtTables :: Int
_mtServiceTimings :: Maybe ServiceTimingMetrics
..}
  where
    sourceTableCache :: HashMap (TableName b) (TableInfo b)
sourceTableCache = SourceInfo b -> HashMap (TableName b) (TableInfo b)
forall (b :: BackendType). SourceInfo b -> TableCache b
_siTables SourceInfo b
sourceInfo
    sourceFunctionCache :: HashMap (FunctionName b) (FunctionInfo b)
sourceFunctionCache = SourceInfo b -> HashMap (FunctionName b) (FunctionInfo b)
forall (b :: BackendType). SourceInfo b -> FunctionCache b
_siFunctions SourceInfo b
sourceInfo
    countSourceTables :: (TableInfo b -> Bool) -> Int
countSourceTables TableInfo b -> Bool
predicate = [TableInfo b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TableInfo b] -> Int)
-> ([TableInfo b] -> [TableInfo b]) -> [TableInfo b] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableInfo b -> Bool) -> [TableInfo b] -> [TableInfo b]
forall a. (a -> Bool) -> [a] -> [a]
filter TableInfo b -> Bool
predicate ([TableInfo b] -> Int) -> [TableInfo b] -> Int
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) (TableInfo b) -> [TableInfo b]
forall k v. HashMap k v -> [v]
Map.elems HashMap (TableName b) (TableInfo b)
sourceTableCache

    calcPerms :: (RolePermInfo b -> Maybe a) -> [RolePermInfo b] -> Int
    calcPerms :: (RolePermInfo b -> Maybe a) -> [RolePermInfo b] -> Int
calcPerms RolePermInfo b -> Maybe a
fn [RolePermInfo b]
perms = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ (RolePermInfo b -> Maybe a) -> [RolePermInfo b] -> [a]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe RolePermInfo b -> Maybe a
fn [RolePermInfo b]
perms

    permsOfTbl :: TableInfo b -> [(RoleName, RolePermInfo b)]
    permsOfTbl :: TableInfo b -> [(RoleName, RolePermInfo b)]
permsOfTbl = HashMap RoleName (RolePermInfo b) -> [(RoleName, RolePermInfo b)]
forall k v. HashMap k v -> [(k, v)]
Map.toList (HashMap RoleName (RolePermInfo b) -> [(RoleName, RolePermInfo b)])
-> (TableInfo b -> HashMap RoleName (RolePermInfo b))
-> TableInfo b
-> [(RoleName, RolePermInfo b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo b -> HashMap RoleName (RolePermInfo b)
forall (b :: BackendType). TableInfo b -> RolePermInfoMap b
_tiRolePermInfoMap

-- | Compute the relevant metrics for actions from the action cache.
computeActionsMetrics :: ActionCache -> ActionMetric
computeActionsMetrics :: ActionCache -> ActionMetric
computeActionsMetrics ActionCache
actionCache =
  Int -> Int -> Int -> Int -> Int -> ActionMetric
ActionMetric Int
syncActionsLen Int
asyncActionsLen Int
queryActionsLen Int
typeRelationships Int
customTypesLen
  where
    actions :: [ActionInfo]
actions = ActionCache -> [ActionInfo]
forall k v. HashMap k v -> [v]
Map.elems ActionCache
actionCache
    syncActionsLen :: Int
syncActionsLen = [ActionInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ActionInfo] -> Int)
-> ([ActionInfo] -> [ActionInfo]) -> [ActionInfo] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActionInfo -> Bool) -> [ActionInfo] -> [ActionInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ActionType -> ActionType -> Bool
forall a. Eq a => a -> a -> Bool
== ActionMutationKind -> ActionType
ActionMutation ActionMutationKind
ActionSynchronous) (ActionType -> Bool)
-> (ActionInfo -> ActionType) -> ActionInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> ActionType
forall arg webhook. ActionDefinition arg webhook -> ActionType
_adType (ActionDefinition
   (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
 -> ActionType)
-> (ActionInfo
    -> ActionDefinition
         (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook))
-> ActionInfo
-> ActionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionInfo
-> ActionDefinition
     (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
_aiDefinition) ([ActionInfo] -> Int) -> [ActionInfo] -> Int
forall a b. (a -> b) -> a -> b
$ [ActionInfo]
actions
    asyncActionsLen :: Int
asyncActionsLen = [ActionInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ActionInfo] -> Int)
-> ([ActionInfo] -> [ActionInfo]) -> [ActionInfo] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActionInfo -> Bool) -> [ActionInfo] -> [ActionInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ActionType -> ActionType -> Bool
forall a. Eq a => a -> a -> Bool
== ActionMutationKind -> ActionType
ActionMutation ActionMutationKind
ActionAsynchronous) (ActionType -> Bool)
-> (ActionInfo -> ActionType) -> ActionInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> ActionType
forall arg webhook. ActionDefinition arg webhook -> ActionType
_adType (ActionDefinition
   (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
 -> ActionType)
-> (ActionInfo
    -> ActionDefinition
         (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook))
-> ActionInfo
-> ActionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionInfo
-> ActionDefinition
     (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
_aiDefinition) ([ActionInfo] -> Int) -> [ActionInfo] -> Int
forall a b. (a -> b) -> a -> b
$ [ActionInfo]
actions
    queryActionsLen :: Int
queryActionsLen = [ActionInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ActionInfo] -> Int)
-> ([ActionInfo] -> [ActionInfo]) -> [ActionInfo] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActionInfo -> Bool) -> [ActionInfo] -> [ActionInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ActionType -> ActionType -> Bool
forall a. Eq a => a -> a -> Bool
== ActionType
ActionQuery) (ActionType -> Bool)
-> (ActionInfo -> ActionType) -> ActionInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> ActionType
forall arg webhook. ActionDefinition arg webhook -> ActionType
_adType (ActionDefinition
   (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
 -> ActionType)
-> (ActionInfo
    -> ActionDefinition
         (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook))
-> ActionInfo
-> ActionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionInfo
-> ActionDefinition
     (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
_aiDefinition) ([ActionInfo] -> Int) -> [ActionInfo] -> Int
forall a b. (a -> b) -> a -> b
$ [ActionInfo]
actions

    outputTypesLen :: Int
outputTypesLen = [GraphQLType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([GraphQLType] -> Int)
-> ([ActionInfo] -> [GraphQLType]) -> [ActionInfo] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GraphQLType] -> [GraphQLType]
forall a. Eq a => [a] -> [a]
L.nub ([GraphQLType] -> [GraphQLType])
-> ([ActionInfo] -> [GraphQLType]) -> [ActionInfo] -> [GraphQLType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActionInfo -> GraphQLType) -> [ActionInfo] -> [GraphQLType]
forall a b. (a -> b) -> [a] -> [b]
map (ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> GraphQLType
forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adOutputType (ActionDefinition
   (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
 -> GraphQLType)
-> (ActionInfo
    -> ActionDefinition
         (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook))
-> ActionInfo
-> GraphQLType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionInfo
-> ActionDefinition
     (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
_aiDefinition) ([ActionInfo] -> Int) -> [ActionInfo] -> Int
forall a b. (a -> b) -> a -> b
$ [ActionInfo]
actions
    inputTypesLen :: Int
inputTypesLen = [(GType, AnnotatedInputType)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(GType, AnnotatedInputType)] -> Int)
-> ([ActionInfo] -> [(GType, AnnotatedInputType)])
-> [ActionInfo]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(GType, AnnotatedInputType)] -> [(GType, AnnotatedInputType)]
forall a. Eq a => [a] -> [a]
L.nub ([(GType, AnnotatedInputType)] -> [(GType, AnnotatedInputType)])
-> ([ActionInfo] -> [(GType, AnnotatedInputType)])
-> [ActionInfo]
-> [(GType, AnnotatedInputType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActionInfo -> [(GType, AnnotatedInputType)])
-> [ActionInfo] -> [(GType, AnnotatedInputType)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((ArgumentDefinition (GType, AnnotatedInputType)
 -> (GType, AnnotatedInputType))
-> [ArgumentDefinition (GType, AnnotatedInputType)]
-> [(GType, AnnotatedInputType)]
forall a b. (a -> b) -> [a] -> [b]
map ArgumentDefinition (GType, AnnotatedInputType)
-> (GType, AnnotatedInputType)
forall a. ArgumentDefinition a -> a
_argType ([ArgumentDefinition (GType, AnnotatedInputType)]
 -> [(GType, AnnotatedInputType)])
-> (ActionInfo -> [ArgumentDefinition (GType, AnnotatedInputType)])
-> ActionInfo
-> [(GType, AnnotatedInputType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionDefinition
  (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
-> [ArgumentDefinition (GType, AnnotatedInputType)]
forall arg webhook.
ActionDefinition arg webhook -> [ArgumentDefinition arg]
_adArguments (ActionDefinition
   (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
 -> [ArgumentDefinition (GType, AnnotatedInputType)])
-> (ActionInfo
    -> ActionDefinition
         (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook))
-> ActionInfo
-> [ArgumentDefinition (GType, AnnotatedInputType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionInfo
-> ActionDefinition
     (GType, AnnotatedInputType) (EnvRecord ResolvedWebhook)
_aiDefinition) ([ActionInfo] -> Int) -> [ActionInfo] -> Int
forall a b. (a -> b) -> a -> b
$ [ActionInfo]
actions
    customTypesLen :: Int
customTypesLen = Int
inputTypesLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outputTypesLen

    typeRelationships :: Int
typeRelationships =
      [RelationshipName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([RelationshipName] -> Int)
-> ([ActionInfo] -> [RelationshipName]) -> [ActionInfo] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelationshipName] -> [RelationshipName]
forall a. Eq a => [a] -> [a]
L.nub
        ([RelationshipName] -> [RelationshipName])
-> ([ActionInfo] -> [RelationshipName])
-> [ActionInfo]
-> [RelationshipName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActionInfo -> [RelationshipName])
-> [ActionInfo] -> [RelationshipName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          ( \ActionInfo
aInfo -> case ((GType, AnnotatedOutputType) -> AnnotatedOutputType
forall a b. (a, b) -> b
snd ((GType, AnnotatedOutputType) -> AnnotatedOutputType)
-> (ActionInfo -> (GType, AnnotatedOutputType))
-> ActionInfo
-> AnnotatedOutputType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionInfo -> (GType, AnnotatedOutputType)
_aiOutputType (ActionInfo -> AnnotatedOutputType)
-> ActionInfo -> AnnotatedOutputType
forall a b. (a -> b) -> a -> b
$ ActionInfo
aInfo) of
              AOTObject AnnotatedObjectType
aot -> (AnnotatedTypeRelationship -> RelationshipName)
-> [AnnotatedTypeRelationship] -> [RelationshipName]
forall a b. (a -> b) -> [a] -> [b]
map AnnotatedTypeRelationship -> RelationshipName
_atrName ([AnnotatedTypeRelationship] -> [RelationshipName])
-> [AnnotatedTypeRelationship] -> [RelationshipName]
forall a b. (a -> b) -> a -> b
$ AnnotatedObjectType -> [AnnotatedTypeRelationship]
_aotRelationships AnnotatedObjectType
aot
              AOTScalar AnnotatedScalarType
_ -> []
          )
        ([ActionInfo] -> Int) -> [ActionInfo] -> Int
forall a b. (a -> b) -> a -> b
$ [ActionInfo]
actions

-- | Decide which topic (telemetry table) we should use based on the version.
versionToTopic :: Version -> Topic
versionToTopic :: Version -> Topic
versionToTopic = \case
  VersionDev Text
_ -> Text -> Topic
Topic Text
"server_metrics_v2_test"
  VersionRelease Version
_ -> Text -> Topic
Topic Text
"server_metrics_v2"
  VersionCE Text
_ -> Text -> Topic
Topic Text
"server_metrics_v2"