{-# 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 J
import Data.ByteString.Lazy qualified as BL
import Data.HashMap.Strict qualified as HashMap
import Data.Int (Int64)
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 Data.Text.Extended (toTxt)
import Hasura.App.State qualified as State
import Hasura.HTTP
import Hasura.Logging
import Hasura.LogicalModel.Cache (LogicalModelInfo)
import Hasura.NativeQuery.Cache (NativeQueryInfo (_nqiArguments))
import Hasura.Prelude
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.BackendTag
import Hasura.RQL.Types.BackendType (BackendType, backendTypeFromBackendSourceKind)
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.Roles (RoleName)
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.SQL.AnyBackend qualified as Any
import Hasura.Server.AppStateRef qualified as HGE
import Hasura.Server.Init.Config
import Hasura.Server.ResourceChecker
import Hasura.Server.Telemetry.Counters (dumpServiceTimingMetrics)
import Hasura.Server.Telemetry.Types
import Hasura.Server.Types
import Hasura.Server.Version
import Hasura.StoredProcedure.Cache (StoredProcedureInfo (_spiArguments))
import Hasura.Table.Cache
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
$cshowsPrec :: Int -> TelemetryLog -> ShowS
showsPrec :: Int -> TelemetryLog -> ShowS
$cshow :: TelemetryLog -> String
show :: TelemetryLog -> String
$cshowList :: [TelemetryLog] -> ShowS
showList :: [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
$cshowsPrec :: Int -> TelemetryHttpError -> ShowS
showsPrec :: Int -> TelemetryHttpError -> ShowS
$cshow :: TelemetryHttpError -> String
show :: TelemetryHttpError -> String
$cshowList :: [TelemetryHttpError] -> ShowS
showList :: [TelemetryHttpError] -> ShowS
Show)

instance J.ToJSON TelemetryLog where
  toJSON :: TelemetryLog -> Value
toJSON TelemetryLog
tl =
    [Pair] -> Value
J.object
      [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= TelemetryLog -> Text
_tlType TelemetryLog
tl,
        Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= TelemetryLog -> Text
_tlMessage TelemetryLog
tl,
        Key
"http_error" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (TelemetryHttpError -> Value
forall a. ToJSON a => a -> Value
J.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 J.ToJSON TelemetryHttpError where
  toJSON :: TelemetryHttpError -> Value
toJSON TelemetryHttpError
tlhe =
    [Pair] -> Value
J.object
      [ Key
"status_code" Key -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (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
forall v. ToJSON v => Key -> v -> Pair
J..= TelemetryHttpError -> Text
tlheUrl TelemetryHttpError
tlhe,
        Key
"response" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= TelemetryHttpError -> Maybe Text
tlheResponse TelemetryHttpError
tlhe,
        Key
"http_exception" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (HttpException -> Value
forall a. ToJSON a => a -> Value
J.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
J.toJSON TelemetryLog
tl)

newtype ServerTelemetryRow = ServerTelemetryRow
  { ServerTelemetryRow -> ServerTelemetry
_strServerMetrics :: ServerTelemetry
  }
  deriving ((forall x. ServerTelemetryRow -> Rep ServerTelemetryRow x)
-> (forall x. Rep ServerTelemetryRow x -> ServerTelemetryRow)
-> Generic ServerTelemetryRow
forall x. Rep ServerTelemetryRow x -> ServerTelemetryRow
forall x. ServerTelemetryRow -> Rep ServerTelemetryRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerTelemetryRow -> Rep ServerTelemetryRow x
from :: forall x. ServerTelemetryRow -> Rep ServerTelemetryRow x
$cto :: forall x. Rep ServerTelemetryRow x -> ServerTelemetryRow
to :: forall x. Rep ServerTelemetryRow x -> ServerTelemetryRow
Generic)

data ServerTelemetry = ServerTelemetry
  { ServerTelemetry -> Maybe Int
_stResourceCpu :: Maybe Int,
    ServerTelemetry -> Maybe Int64
_stResourceMemory :: Maybe Int64,
    ServerTelemetry -> Maybe ResourceCheckerError
_stResourceCheckerErrorCode :: Maybe ResourceCheckerError
  }
  deriving ((forall x. ServerTelemetry -> Rep ServerTelemetry x)
-> (forall x. Rep ServerTelemetry x -> ServerTelemetry)
-> Generic ServerTelemetry
forall x. Rep ServerTelemetry x -> ServerTelemetry
forall x. ServerTelemetry -> Rep ServerTelemetry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerTelemetry -> Rep ServerTelemetry x
from :: forall x. ServerTelemetry -> Rep ServerTelemetry x
$cto :: forall x. Rep ServerTelemetry x -> ServerTelemetry
to :: forall x. Rep ServerTelemetry x -> ServerTelemetry
Generic)

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

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

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 (f :: * -> *).
Functor f =>
(Status -> f Status) -> Response body -> f (Response body)
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 (f :: * -> *).
Functor f =>
(body0 -> f body1) -> Response body0 -> f (Response 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 ::
  forall m impl.
  ( MonadIO m,
    State.HasAppEnv m
  ) =>
  Logger Hasura ->
  -- | an action that always returns the latest schema cache ref
  HGE.AppStateRef impl ->
  MetadataDbId ->
  PGVersion ->
  ComputeResourcesResponse ->
  m Void
runTelemetry :: forall (m :: * -> *) impl.
(MonadIO m, HasAppEnv m) =>
Logger Hasura
-> AppStateRef impl
-> MetadataDbId
-> PGVersion
-> ComputeResourcesResponse
-> m Void
runTelemetry (Logger forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger) AppStateRef impl
appStateRef MetadataDbId
metadataDbUid PGVersion
pgVersion ComputeResourcesResponse
computeResources = do
  State.AppEnv {Int
Maybe Text
Maybe PGPool
Maybe (CredentialCache AgentLicenseKey)
SamplingPolicy
HostPreference
Manager
TxIsolation
ConnParams
PGPool
Refined NonNegative Seconds
TMVar MetadataResourceVersion
ConnectionOptions
CheckFeatureFlag
ServerMetrics
EventingMode
ReadOnlyMode
MaintenanceMode ()
InstanceId
PrometheusMetrics
ShutdownLatch
LoggingSettings
LockedEventsCtx
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
SubscriptionsState
Loggers
appEnvPort :: Port
appEnvHost :: HostPreference
appEnvMetadataDbPool :: PGPool
appEnvIntrospectionDbPool :: Maybe PGPool
appEnvManager :: Manager
appEnvLoggers :: Loggers
appEnvMetadataVersionRef :: TMVar MetadataResourceVersion
appEnvInstanceId :: InstanceId
appEnvEnableMaintenanceMode :: MaintenanceMode ()
appEnvLoggingSettings :: LoggingSettings
appEnvEventingMode :: EventingMode
appEnvEnableReadOnlyMode :: ReadOnlyMode
appEnvServerMetrics :: ServerMetrics
appEnvShutdownLatch :: ShutdownLatch
appEnvMetaVersionRef :: TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: PrometheusMetrics
appEnvTraceSamplingPolicy :: SamplingPolicy
appEnvSubscriptionState :: SubscriptionsState
appEnvLockedEventsCtx :: LockedEventsCtx
appEnvConnParams :: ConnParams
appEnvTxIso :: TxIsolation
appEnvConsoleAssetsDir :: Maybe Text
appEnvConsoleSentryDsn :: Maybe Text
appEnvConnectionOptions :: ConnectionOptions
appEnvWebSocketKeepAlive :: KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: Refined NonNegative Seconds
appEnvSchemaPollInterval :: OptionalInterval
appEnvCheckFeatureFlag :: CheckFeatureFlag
appEnvLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: Int
appEnvPort :: AppEnv -> Port
appEnvHost :: AppEnv -> HostPreference
appEnvMetadataDbPool :: AppEnv -> PGPool
appEnvIntrospectionDbPool :: AppEnv -> Maybe PGPool
appEnvManager :: AppEnv -> Manager
appEnvLoggers :: AppEnv -> Loggers
appEnvMetadataVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvInstanceId :: AppEnv -> InstanceId
appEnvEnableMaintenanceMode :: AppEnv -> MaintenanceMode ()
appEnvLoggingSettings :: AppEnv -> LoggingSettings
appEnvEventingMode :: AppEnv -> EventingMode
appEnvEnableReadOnlyMode :: AppEnv -> ReadOnlyMode
appEnvServerMetrics :: AppEnv -> ServerMetrics
appEnvShutdownLatch :: AppEnv -> ShutdownLatch
appEnvMetaVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: AppEnv -> PrometheusMetrics
appEnvTraceSamplingPolicy :: AppEnv -> SamplingPolicy
appEnvSubscriptionState :: AppEnv -> SubscriptionsState
appEnvLockedEventsCtx :: AppEnv -> LockedEventsCtx
appEnvConnParams :: AppEnv -> ConnParams
appEnvTxIso :: AppEnv -> TxIsolation
appEnvConsoleAssetsDir :: AppEnv -> Maybe Text
appEnvConsoleSentryDsn :: AppEnv -> Maybe Text
appEnvConnectionOptions :: AppEnv -> ConnectionOptions
appEnvWebSocketKeepAlive :: AppEnv -> KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: AppEnv -> WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: AppEnv -> Refined NonNegative Seconds
appEnvSchemaPollInterval :: AppEnv -> OptionalInterval
appEnvCheckFeatureFlag :: AppEnv -> CheckFeatureFlag
appEnvLicenseKeyCache :: AppEnv -> Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: AppEnv -> Int
..} <- m AppEnv
forall (m :: * -> *). HasAppEnv m => m AppEnv
State.askAppEnv
  let options :: Options
options = Manager -> [Header] -> Options
wreqOptions Manager
appEnvManager []
  m () -> m Void
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m Void) -> m () -> m Void
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
$ do
    TelemetryStatus
telemetryStatus <- AppContext -> TelemetryStatus
State.acEnableTelemetry (AppContext -> TelemetryStatus)
-> IO AppContext -> IO TelemetryStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
HGE.getAppContext AppStateRef impl
appStateRef
    case TelemetryStatus
telemetryStatus of
      TelemetryStatus
TelemetryEnabled -> do
        SchemaCache
schemaCache <- AppStateRef impl -> IO SchemaCache
forall impl. AppStateRef impl -> IO SchemaCache
HGE.getSchemaCache AppStateRef impl
appStateRef
        ServiceTimingMetrics
serviceTimings <- IO ServiceTimingMetrics
forall (m :: * -> *). MonadIO m => m ServiceTimingMetrics
dumpServiceTimingMetrics
        HashSet ExperimentalFeature
experimentalFeatures <- AppContext -> HashSet ExperimentalFeature
State.acExperimentalFeatures (AppContext -> HashSet ExperimentalFeature)
-> IO AppContext -> IO (HashSet ExperimentalFeature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppStateRef impl -> IO AppContext
forall impl. AppStateRef impl -> IO AppContext
HGE.getAppContext AppStateRef impl
appStateRef
        Maybe CI
ci <- IO (Maybe CI)
CI.getCI
        -- Creates a telemetry payload for a specific backend.
        let telemetryForSource :: forall (b :: BackendType). SourceInfo b -> TelemetryPayload
            telemetryForSource :: forall (b :: BackendType). SourceInfo b -> TelemetryPayload
telemetryForSource =
              MetadataDbId
-> InstanceId
-> Version
-> PGVersion
-> Maybe CI
-> ServiceTimingMetrics
-> RemoteSchemaMap
-> ActionCache
-> HashSet ExperimentalFeature
-> SourceInfo b
-> TelemetryPayload
forall (b :: BackendType).
MetadataDbId
-> InstanceId
-> Version
-> PGVersion
-> Maybe CI
-> ServiceTimingMetrics
-> RemoteSchemaMap
-> ActionCache
-> HashSet ExperimentalFeature
-> SourceInfo b
-> TelemetryPayload
mkTelemetryPayload
                MetadataDbId
metadataDbUid
                InstanceId
appEnvInstanceId
                Version
currentVersion
                PGVersion
pgVersion
                Maybe CI
ci
                ServiceTimingMetrics
serviceTimings
                (SchemaCache -> RemoteSchemaMap
scRemoteSchemas SchemaCache
schemaCache)
                (SchemaCache -> ActionCache
scActions SchemaCache
schemaCache)
                HashSet ExperimentalFeature
experimentalFeatures
            telemetries :: [TelemetryPayload]
telemetries =
              (AnyBackend SourceInfo -> TelemetryPayload)
-> [AnyBackend SourceInfo] -> [TelemetryPayload]
forall a b. (a -> b) -> [a] -> [b]
map
                (\AnyBackend SourceInfo
sourceinfo -> (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 SourceInfo b -> TelemetryPayload
forall (b :: BackendType).
HasTag b =>
SourceInfo b -> TelemetryPayload
forall (b :: BackendType). SourceInfo b -> TelemetryPayload
telemetryForSource)
                (HashMap SourceName (AnyBackend SourceInfo)
-> [AnyBackend SourceInfo]
forall k v. HashMap k v -> [v]
HashMap.elems (SchemaCache -> HashMap SourceName (AnyBackend SourceInfo)
scSources SchemaCache
schemaCache))
            payloads :: [ByteString]
payloads = TelemetryPayload -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode (TelemetryPayload -> ByteString)
-> [TelemetryPayload] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TelemetryPayload]
telemetries

            serverTelemetry :: ByteString
serverTelemetry =
              ServerTelemetryRow -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode
                (ServerTelemetryRow -> ByteString)
-> ServerTelemetryRow -> ByteString
forall a b. (a -> b) -> a -> b
$ ServerTelemetry -> ServerTelemetryRow
ServerTelemetryRow
                (ServerTelemetry -> ServerTelemetryRow)
-> ServerTelemetry -> ServerTelemetryRow
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Maybe Int64 -> Maybe ResourceCheckerError -> ServerTelemetry
ServerTelemetry
                  (ComputeResourcesResponse -> Maybe Int
_rcrCpu ComputeResourcesResponse
computeResources)
                  (ComputeResourcesResponse -> Maybe Int64
_rcrMemory ComputeResourcesResponse
computeResources)
                  (ComputeResourcesResponse -> Maybe ResourceCheckerError
_rcrErrorCode ComputeResourcesResponse
computeResources)

        [ByteString] -> (ByteString -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (ByteString
serverTelemetry ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [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
      TelemetryStatus
TelemetryDisabled -> DiffTime -> IO ()
C.sleep (DiffTime -> IO ()) -> DiffTime -> IO ()
forall a b. (a -> b) -> a -> b
$ Seconds -> DiffTime
seconds Seconds
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 (f :: * -> *).
Functor f =>
(Status -> f Status) -> Response body -> f (Response body)
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 (f :: * -> *).
Functor f =>
(body0 -> f body1) -> Response body0 -> f (Response 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).
  MetadataDbId ->
  InstanceId ->
  Version ->
  PGVersion ->
  Maybe CI.CI ->
  ServiceTimingMetrics ->
  RemoteSchemaMap ->
  ActionCache ->
  HashSet ExperimentalFeature ->
  SourceInfo b ->
  TelemetryPayload
mkTelemetryPayload :: forall (b :: BackendType).
MetadataDbId
-> InstanceId
-> Version
-> PGVersion
-> Maybe CI
-> ServiceTimingMetrics
-> RemoteSchemaMap
-> ActionCache
-> HashSet ExperimentalFeature
-> SourceInfo b
-> TelemetryPayload
mkTelemetryPayload MetadataDbId
metadataDbId InstanceId
instanceId Version
version PGVersion
pgVersion Maybe CI
ci ServiceTimingMetrics
serviceTimings RemoteSchemaMap
remoteSchemaMap ActionCache
actionCache HashSet ExperimentalFeature
experimentalFeatures SourceInfo b
sourceInfo =
  let topic :: Topic
topic = Version -> Topic
versionToTopic Version
version
      sourceMetadata :: SourceMetadata
sourceMetadata =
        SourceMetadata
          { _smDbUid :: Maybe DbUid
_smDbUid = DbUid -> Maybe DbUid
forall a. a -> Maybe a
forDefaultSource (MetadataDbId -> DbUid
mdDbIdToDbUid MetadataDbId
metadataDbId),
            _smBackendType :: BackendType
_smBackendType = BackendSourceKind b -> BackendType
forall (b :: BackendType). BackendSourceKind b -> BackendType
backendTypeFromBackendSourceKind (BackendSourceKind b -> BackendType)
-> BackendSourceKind b -> BackendType
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> BackendSourceKind b
forall (b :: BackendType). SourceInfo b -> BackendSourceKind b
_siSourceKind SourceInfo b
sourceInfo,
            _smDbKind :: Text
_smDbKind = BackendSourceKind b -> Text
forall a. ToTxt a => a -> Text
toTxt (SourceInfo b -> BackendSourceKind b
forall (b :: BackendType). SourceInfo b -> BackendSourceKind b
_siSourceKind SourceInfo b
sourceInfo),
            _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 :: forall a. 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
-> HashSet ExperimentalFeature
-> HasuraTelemetry
HasuraTelemetry MetadataDbId
metadataDbId InstanceId
instanceId Version
version Maybe CI
ci SourceMetadata
sourceMetadata Metrics
metrics HashSet ExperimentalFeature
experimentalFeatures
   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 :: forall (b :: BackendType).
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]
HashMap.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
HashMap.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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RelInfo b]
manualRels) ([RelInfo b] -> Int
forall a. [a] -> 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]
HashMap.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
HashMap.map TableInfo b -> [(RoleName, RolePermInfo b)]
permsOfTbl HashMap (TableName b) (TableInfo b)
sourceTableCache
      _pmRoles :: Int
_pmRoles = [RoleName] -> Int
forall a. [a] -> 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
_pmRoles :: Int
_pmInsert :: Int
_pmSelect :: Int
_pmUpdate :: Int
_pmDelete :: Int
_pmSelect :: Int
_pmInsert :: Int
_pmUpdate :: Int
_pmDelete :: Int
_pmRoles :: Int
..}
      _mtEventTriggers :: Int
_mtEventTriggers =
        HashMap (TableName b) (HashMap TriggerName (EventTriggerInfo b))
-> Int
forall k v. HashMap k v -> Int
HashMap.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
HashMap.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
HashMap.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
HashMap.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
HashMap.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
HashMap.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
HashMap.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
      _mtNativeQueries :: NativeQueriesMetrics
_mtNativeQueries = [NativeQueryInfo b] -> NativeQueriesMetrics
countNativeQueries (HashMap NativeQueryName (NativeQueryInfo b) -> [NativeQueryInfo b]
forall k v. HashMap k v -> [v]
HashMap.elems (HashMap NativeQueryName (NativeQueryInfo b)
 -> [NativeQueryInfo b])
-> HashMap NativeQueryName (NativeQueryInfo b)
-> [NativeQueryInfo b]
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> HashMap NativeQueryName (NativeQueryInfo b)
forall (b :: BackendType). SourceInfo b -> NativeQueryCache b
_siNativeQueries SourceInfo b
sourceInfo)
      _mtStoredProcedures :: StoredProceduresMetrics
_mtStoredProcedures = [StoredProcedureInfo b] -> StoredProceduresMetrics
countStoredProcedures (HashMap (FunctionName b) (StoredProcedureInfo b)
-> [StoredProcedureInfo b]
forall k v. HashMap k v -> [v]
HashMap.elems (HashMap (FunctionName b) (StoredProcedureInfo b)
 -> [StoredProcedureInfo b])
-> HashMap (FunctionName b) (StoredProcedureInfo b)
-> [StoredProcedureInfo b]
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> HashMap (FunctionName b) (StoredProcedureInfo b)
forall (b :: BackendType). SourceInfo b -> StoredProcedureCache b
_siStoredProcedures SourceInfo b
sourceInfo)
      _mtLogicalModels :: LogicalModelsMetrics
_mtLogicalModels = [LogicalModelInfo b] -> LogicalModelsMetrics
countLogicalModels (HashMap LogicalModelName (LogicalModelInfo b)
-> [LogicalModelInfo b]
forall k v. HashMap k v -> [v]
HashMap.elems (HashMap LogicalModelName (LogicalModelInfo b)
 -> [LogicalModelInfo b])
-> HashMap LogicalModelName (LogicalModelInfo b)
-> [LogicalModelInfo b]
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> HashMap LogicalModelName (LogicalModelInfo b)
forall (b :: BackendType). SourceInfo b -> LogicalModelCache b
_siLogicalModels SourceInfo b
sourceInfo)
   in Metrics {Int
Maybe Int
Maybe ServiceTimingMetrics
Maybe ActionMetric
LogicalModelsMetrics
StoredProceduresMetrics
NativeQueriesMetrics
PermissionMetric
RelationshipMetric
_mtServiceTimings :: Maybe ServiceTimingMetrics
_mtTables :: Int
_mtViews :: Int
_mtEnumTables :: Int
_mtRelationships :: RelationshipMetric
_mtPermissions :: PermissionMetric
_mtEventTriggers :: Int
_mtRemoteSchemas :: Maybe Int
_mtFunctions :: Int
_mtActions :: Maybe ActionMetric
_mtNativeQueries :: NativeQueriesMetrics
_mtStoredProcedures :: StoredProceduresMetrics
_mtLogicalModels :: LogicalModelsMetrics
_mtTables :: Int
_mtViews :: Int
_mtEnumTables :: Int
_mtRelationships :: RelationshipMetric
_mtPermissions :: PermissionMetric
_mtEventTriggers :: Int
_mtFunctions :: Int
_mtRemoteSchemas :: Maybe Int
_mtServiceTimings :: Maybe ServiceTimingMetrics
_mtActions :: Maybe ActionMetric
_mtNativeQueries :: NativeQueriesMetrics
_mtStoredProcedures :: StoredProceduresMetrics
_mtLogicalModels :: LogicalModelsMetrics
..}
  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 a. [a] -> 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]
HashMap.elems HashMap (TableName b) (TableInfo b)
sourceTableCache

    calcPerms :: (RolePermInfo b -> Maybe a) -> [RolePermInfo b] -> Int
    calcPerms :: forall a. (RolePermInfo b -> Maybe a) -> [RolePermInfo b] -> Int
calcPerms RolePermInfo b -> Maybe a
fn [RolePermInfo b]
perms = [a] -> Int
forall a. [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 a b. (a -> Maybe b) -> [a] -> [b]
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)]
HashMap.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

    countLogicalModels :: [LogicalModelInfo b] -> LogicalModelsMetrics
    countLogicalModels :: [LogicalModelInfo b] -> LogicalModelsMetrics
countLogicalModels =
      (LogicalModelInfo b -> LogicalModelsMetrics)
-> [LogicalModelInfo b] -> LogicalModelsMetrics
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        (\LogicalModelInfo b
_ -> LogicalModelsMetrics
forall a. Monoid a => a
mempty {_lmmCount :: Int
_lmmCount = Int
1})

    countNativeQueries :: [NativeQueryInfo b] -> NativeQueriesMetrics
    countNativeQueries :: [NativeQueryInfo b] -> NativeQueriesMetrics
countNativeQueries =
      (NativeQueryInfo b -> NativeQueriesMetrics)
-> [NativeQueryInfo b] -> NativeQueriesMetrics
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        ( \NativeQueryInfo b
nativeQuery ->
            if HashMap ArgumentName (NullableScalarType b) -> Bool
forall a. HashMap ArgumentName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (NativeQueryInfo b -> HashMap ArgumentName (NullableScalarType b)
forall (b :: BackendType).
NativeQueryInfo b -> HashMap ArgumentName (NullableScalarType b)
_nqiArguments NativeQueryInfo b
nativeQuery)
              then NativeQueriesMetrics
forall a. Monoid a => a
mempty {_nqmWithoutParameters :: Int
_nqmWithoutParameters = Int
1}
              else NativeQueriesMetrics
forall a. Monoid a => a
mempty {_nqmWithParameters :: Int
_nqmWithParameters = Int
1}
        )

    countStoredProcedures :: [StoredProcedureInfo b] -> StoredProceduresMetrics
    countStoredProcedures :: [StoredProcedureInfo b] -> StoredProceduresMetrics
countStoredProcedures =
      (StoredProcedureInfo b -> StoredProceduresMetrics)
-> [StoredProcedureInfo b] -> StoredProceduresMetrics
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        ( \StoredProcedureInfo b
storedProcedure ->
            if HashMap ArgumentName (NullableScalarType b) -> Bool
forall a. HashMap ArgumentName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (StoredProcedureInfo b
-> HashMap ArgumentName (NullableScalarType b)
forall (b :: BackendType).
StoredProcedureInfo b
-> HashMap ArgumentName (NullableScalarType b)
_spiArguments StoredProcedureInfo b
storedProcedure)
              then StoredProceduresMetrics
forall a. Monoid a => a
mempty {_spmWithoutParameters :: Int
_spmWithoutParameters = Int
1}
              else StoredProceduresMetrics
forall a. Monoid a => a
mempty {_spmWithParameters :: Int
_spmWithParameters = Int
1}
        )

-- | 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]
HashMap.elems ActionCache
actionCache
    syncActionsLen :: Int
syncActionsLen = [ActionInfo] -> Int
forall a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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"