{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | `FromJSON` instances for API.Metadata. Kept separately to discourage
-- becoming a dumping ground for orphan instances
module Hasura.Server.API.Metadata.Instances () where

import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.Types qualified as A
import Data.Text qualified as T
import Data.Text.Extended qualified as T
import Hasura.Prelude hiding (first)
import Hasura.RQL.Types.BackendType
import Hasura.SQL.AnyBackend
import Hasura.Server.API.Backend
import Hasura.Server.API.Instances ()
import Hasura.Server.API.Metadata.Types
import Hasura.Server.Utils (APIVersion (..))

-- | Note! You're seeing some orphan instances for `FromJSON` for types in
-- `Metadata.Types`. This is because we need to use `dispatchAnyBackend`.
-- Keeping these here avoids us needing an hs-boot file and a load of cyclical
-- hell.
instance FromJSON RQLMetadataV1 where
  parseJSON :: Value -> Parser RQLMetadataV1
parseJSON = String
-> (Object -> Parser RQLMetadataV1)
-> Value
-> Parser RQLMetadataV1
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RQLMetadataV1" \Object
o -> do
    Text
queryType <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    let args :: forall a. (FromJSON a) => A.Parser a
        args :: forall a. FromJSON a => Parser a
args = Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"args"
    case Text
queryType of
      -- backend agnostic
      Text
"rename_source" -> RenameSource -> RQLMetadataV1
RMRenameSource (RenameSource -> RQLMetadataV1)
-> Parser RenameSource -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RenameSource
forall a. FromJSON a => Parser a
args
      Text
"add_remote_schema" -> AddRemoteSchemaQuery -> RQLMetadataV1
RMAddRemoteSchema (AddRemoteSchemaQuery -> RQLMetadataV1)
-> Parser AddRemoteSchemaQuery -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AddRemoteSchemaQuery
forall a. FromJSON a => Parser a
args
      Text
"update_remote_schema" -> AddRemoteSchemaQuery -> RQLMetadataV1
RMUpdateRemoteSchema (AddRemoteSchemaQuery -> RQLMetadataV1)
-> Parser AddRemoteSchemaQuery -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AddRemoteSchemaQuery
forall a. FromJSON a => Parser a
args
      Text
"remove_remote_schema" -> RemoteSchemaNameQuery -> RQLMetadataV1
RMRemoveRemoteSchema (RemoteSchemaNameQuery -> RQLMetadataV1)
-> Parser RemoteSchemaNameQuery -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RemoteSchemaNameQuery
forall a. FromJSON a => Parser a
args
      Text
"reload_remote_schema" -> RemoteSchemaNameQuery -> RQLMetadataV1
RMReloadRemoteSchema (RemoteSchemaNameQuery -> RQLMetadataV1)
-> Parser RemoteSchemaNameQuery -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RemoteSchemaNameQuery
forall a. FromJSON a => Parser a
args
      Text
"introspect_remote_schema" -> RemoteSchemaNameQuery -> RQLMetadataV1
RMIntrospectRemoteSchema (RemoteSchemaNameQuery -> RQLMetadataV1)
-> Parser RemoteSchemaNameQuery -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RemoteSchemaNameQuery
forall a. FromJSON a => Parser a
args
      Text
"add_remote_schema_permissions" -> AddRemoteSchemaPermission -> RQLMetadataV1
RMAddRemoteSchemaPermissions (AddRemoteSchemaPermission -> RQLMetadataV1)
-> Parser AddRemoteSchemaPermission -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AddRemoteSchemaPermission
forall a. FromJSON a => Parser a
args
      Text
"drop_remote_schema_permissions" -> DropRemoteSchemaPermissions -> RQLMetadataV1
RMDropRemoteSchemaPermissions (DropRemoteSchemaPermissions -> RQLMetadataV1)
-> Parser DropRemoteSchemaPermissions -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropRemoteSchemaPermissions
forall a. FromJSON a => Parser a
args
      Text
"create_remote_schema_remote_relationship" -> CreateRemoteSchemaRemoteRelationship -> RQLMetadataV1
RMCreateRemoteSchemaRemoteRelationship (CreateRemoteSchemaRemoteRelationship -> RQLMetadataV1)
-> Parser CreateRemoteSchemaRemoteRelationship
-> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CreateRemoteSchemaRemoteRelationship
forall a. FromJSON a => Parser a
args
      Text
"update_remote_schema_remote_relationship" -> CreateRemoteSchemaRemoteRelationship -> RQLMetadataV1
RMUpdateRemoteSchemaRemoteRelationship (CreateRemoteSchemaRemoteRelationship -> RQLMetadataV1)
-> Parser CreateRemoteSchemaRemoteRelationship
-> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CreateRemoteSchemaRemoteRelationship
forall a. FromJSON a => Parser a
args
      Text
"delete_remote_schema_remote_relationship" -> DeleteRemoteSchemaRemoteRelationship -> RQLMetadataV1
RMDeleteRemoteSchemaRemoteRelationship (DeleteRemoteSchemaRemoteRelationship -> RQLMetadataV1)
-> Parser DeleteRemoteSchemaRemoteRelationship
-> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DeleteRemoteSchemaRemoteRelationship
forall a. FromJSON a => Parser a
args
      Text
"cleanup_event_trigger_logs" -> TriggerLogCleanupConfig -> RQLMetadataV1
RMCleanupEventTriggerLog (TriggerLogCleanupConfig -> RQLMetadataV1)
-> Parser TriggerLogCleanupConfig -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TriggerLogCleanupConfig
forall a. FromJSON a => Parser a
args
      Text
"resume_event_trigger_cleanups" -> TriggerLogCleanupToggleConfig -> RQLMetadataV1
RMResumeEventTriggerCleanup (TriggerLogCleanupToggleConfig -> RQLMetadataV1)
-> Parser TriggerLogCleanupToggleConfig -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TriggerLogCleanupToggleConfig
forall a. FromJSON a => Parser a
args
      Text
"pause_event_trigger_cleanups" -> TriggerLogCleanupToggleConfig -> RQLMetadataV1
RMPauseEventTriggerCleanup (TriggerLogCleanupToggleConfig -> RQLMetadataV1)
-> Parser TriggerLogCleanupToggleConfig -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TriggerLogCleanupToggleConfig
forall a. FromJSON a => Parser a
args
      Text
"create_cron_trigger" -> Unvalidated CreateCronTrigger -> RQLMetadataV1
RMCreateCronTrigger (Unvalidated CreateCronTrigger -> RQLMetadataV1)
-> Parser (Unvalidated CreateCronTrigger) -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Unvalidated CreateCronTrigger)
forall a. FromJSON a => Parser a
args
      Text
"delete_cron_trigger" -> ScheduledTriggerName -> RQLMetadataV1
RMDeleteCronTrigger (ScheduledTriggerName -> RQLMetadataV1)
-> Parser ScheduledTriggerName -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ScheduledTriggerName
forall a. FromJSON a => Parser a
args
      Text
"create_scheduled_event" -> CreateScheduledEvent -> RQLMetadataV1
RMCreateScheduledEvent (CreateScheduledEvent -> RQLMetadataV1)
-> Parser CreateScheduledEvent -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CreateScheduledEvent
forall a. FromJSON a => Parser a
args
      Text
"delete_scheduled_event" -> DeleteScheduledEvent -> RQLMetadataV1
RMDeleteScheduledEvent (DeleteScheduledEvent -> RQLMetadataV1)
-> Parser DeleteScheduledEvent -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DeleteScheduledEvent
forall a. FromJSON a => Parser a
args
      Text
"get_scheduled_events" -> GetScheduledEvents -> RQLMetadataV1
RMGetScheduledEvents (GetScheduledEvents -> RQLMetadataV1)
-> Parser GetScheduledEvents -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GetScheduledEvents
forall a. FromJSON a => Parser a
args
      Text
"get_scheduled_event_invocations" -> GetScheduledEventInvocations -> RQLMetadataV1
RMGetScheduledEventInvocations (GetScheduledEventInvocations -> RQLMetadataV1)
-> Parser GetScheduledEventInvocations -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GetScheduledEventInvocations
forall a. FromJSON a => Parser a
args
      Text
"get_cron_triggers" -> RQLMetadataV1 -> Parser RQLMetadataV1
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RQLMetadataV1
RMGetCronTriggers
      Text
"create_action" -> Unvalidated CreateAction -> RQLMetadataV1
RMCreateAction (Unvalidated CreateAction -> RQLMetadataV1)
-> Parser (Unvalidated CreateAction) -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Unvalidated CreateAction)
forall a. FromJSON a => Parser a
args
      Text
"drop_action" -> DropAction -> RQLMetadataV1
RMDropAction (DropAction -> RQLMetadataV1)
-> Parser DropAction -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropAction
forall a. FromJSON a => Parser a
args
      Text
"update_action" -> Unvalidated UpdateAction -> RQLMetadataV1
RMUpdateAction (Unvalidated UpdateAction -> RQLMetadataV1)
-> Parser (Unvalidated UpdateAction) -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Unvalidated UpdateAction)
forall a. FromJSON a => Parser a
args
      Text
"create_action_permission" -> CreateActionPermission -> RQLMetadataV1
RMCreateActionPermission (CreateActionPermission -> RQLMetadataV1)
-> Parser CreateActionPermission -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CreateActionPermission
forall a. FromJSON a => Parser a
args
      Text
"drop_action_permission" -> DropActionPermission -> RQLMetadataV1
RMDropActionPermission (DropActionPermission -> RQLMetadataV1)
-> Parser DropActionPermission -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropActionPermission
forall a. FromJSON a => Parser a
args
      Text
"create_query_collection" -> CreateCollection -> RQLMetadataV1
RMCreateQueryCollection (CreateCollection -> RQLMetadataV1)
-> Parser CreateCollection -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CreateCollection
forall a. FromJSON a => Parser a
args
      Text
"rename_query_collection" -> RenameCollection -> RQLMetadataV1
RMRenameQueryCollection (RenameCollection -> RQLMetadataV1)
-> Parser RenameCollection -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RenameCollection
forall a. FromJSON a => Parser a
args
      Text
"drop_query_collection" -> DropCollection -> RQLMetadataV1
RMDropQueryCollection (DropCollection -> RQLMetadataV1)
-> Parser DropCollection -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropCollection
forall a. FromJSON a => Parser a
args
      Text
"add_query_to_collection" -> AddQueryToCollection -> RQLMetadataV1
RMAddQueryToCollection (AddQueryToCollection -> RQLMetadataV1)
-> Parser AddQueryToCollection -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AddQueryToCollection
forall a. FromJSON a => Parser a
args
      Text
"drop_query_from_collection" -> DropQueryFromCollection -> RQLMetadataV1
RMDropQueryFromCollection (DropQueryFromCollection -> RQLMetadataV1)
-> Parser DropQueryFromCollection -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropQueryFromCollection
forall a. FromJSON a => Parser a
args
      Text
"add_collection_to_allowlist" -> AllowlistEntry -> RQLMetadataV1
RMAddCollectionToAllowlist (AllowlistEntry -> RQLMetadataV1)
-> Parser AllowlistEntry -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AllowlistEntry
forall a. FromJSON a => Parser a
args
      Text
"drop_collection_from_allowlist" -> DropCollectionFromAllowlist -> RQLMetadataV1
RMDropCollectionFromAllowlist (DropCollectionFromAllowlist -> RQLMetadataV1)
-> Parser DropCollectionFromAllowlist -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropCollectionFromAllowlist
forall a. FromJSON a => Parser a
args
      Text
"update_scope_of_collection_in_allowlist" -> UpdateScopeOfCollectionInAllowlist -> RQLMetadataV1
RMUpdateScopeOfCollectionInAllowlist (UpdateScopeOfCollectionInAllowlist -> RQLMetadataV1)
-> Parser UpdateScopeOfCollectionInAllowlist
-> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UpdateScopeOfCollectionInAllowlist
forall a. FromJSON a => Parser a
args
      Text
"create_rest_endpoint" -> CreateEndpoint -> RQLMetadataV1
RMCreateRestEndpoint (CreateEndpoint -> RQLMetadataV1)
-> Parser CreateEndpoint -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CreateEndpoint
forall a. FromJSON a => Parser a
args
      Text
"drop_rest_endpoint" -> DropEndpoint -> RQLMetadataV1
RMDropRestEndpoint (DropEndpoint -> RQLMetadataV1)
-> Parser DropEndpoint -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropEndpoint
forall a. FromJSON a => Parser a
args
      Text
"dc_add_agent" -> DCAddAgent -> RQLMetadataV1
RMDCAddAgent (DCAddAgent -> RQLMetadataV1)
-> Parser DCAddAgent -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DCAddAgent
forall a. FromJSON a => Parser a
args
      Text
"dc_delete_agent" -> DCDeleteAgent -> RQLMetadataV1
RMDCDeleteAgent (DCDeleteAgent -> RQLMetadataV1)
-> Parser DCDeleteAgent -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DCDeleteAgent
forall a. FromJSON a => Parser a
args
      Text
"list_source_kinds" -> ListSourceKinds -> RQLMetadataV1
RMListSourceKinds (ListSourceKinds -> RQLMetadataV1)
-> Parser ListSourceKinds -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListSourceKinds
forall a. FromJSON a => Parser a
args
      Text
"get_source_kind_capabilities" -> GetSourceKindCapabilities -> RQLMetadataV1
RMGetSourceKindCapabilities (GetSourceKindCapabilities -> RQLMetadataV1)
-> Parser GetSourceKindCapabilities -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GetSourceKindCapabilities
forall a. FromJSON a => Parser a
args
      Text
"get_table_info" -> GetTableInfo_ -> RQLMetadataV1
RMGetTableInfo_ (GetTableInfo_ -> RQLMetadataV1)
-> Parser GetTableInfo_ -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GetTableInfo_
forall a. FromJSON a => Parser a
args
      Text
"set_custom_types" -> CustomTypes -> RQLMetadataV1
RMSetCustomTypes (CustomTypes -> RQLMetadataV1)
-> Parser CustomTypes -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CustomTypes
forall a. FromJSON a => Parser a
args
      Text
"set_api_limits" -> ApiLimit -> RQLMetadataV1
RMSetApiLimits (ApiLimit -> RQLMetadataV1)
-> Parser ApiLimit -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ApiLimit
forall a. FromJSON a => Parser a
args
      Text
"remove_api_limits" -> RQLMetadataV1 -> Parser RQLMetadataV1
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RQLMetadataV1
RMRemoveApiLimits
      Text
"set_metrics_config" -> MetricsConfig -> RQLMetadataV1
RMSetMetricsConfig (MetricsConfig -> RQLMetadataV1)
-> Parser MetricsConfig -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MetricsConfig
forall a. FromJSON a => Parser a
args
      Text
"remove_metrics_config" -> RQLMetadataV1 -> Parser RQLMetadataV1
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RQLMetadataV1
RMRemoveMetricsConfig
      Text
"add_inherited_role" -> InheritedRole -> RQLMetadataV1
RMAddInheritedRole (InheritedRole -> RQLMetadataV1)
-> Parser InheritedRole -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InheritedRole
forall a. FromJSON a => Parser a
args
      Text
"drop_inherited_role" -> DropInheritedRole -> RQLMetadataV1
RMDropInheritedRole (DropInheritedRole -> RQLMetadataV1)
-> Parser DropInheritedRole -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropInheritedRole
forall a. FromJSON a => Parser a
args
      Text
"replace_metadata" -> ReplaceMetadata -> RQLMetadataV1
RMReplaceMetadata (ReplaceMetadata -> RQLMetadataV1)
-> Parser ReplaceMetadata -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ReplaceMetadata
forall a. FromJSON a => Parser a
args
      Text
"export_metadata" -> ExportMetadata -> RQLMetadataV1
RMExportMetadata (ExportMetadata -> RQLMetadataV1)
-> Parser ExportMetadata -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExportMetadata
forall a. FromJSON a => Parser a
args
      Text
"clear_metadata" -> ClearMetadata -> RQLMetadataV1
RMClearMetadata (ClearMetadata -> RQLMetadataV1)
-> Parser ClearMetadata -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ClearMetadata
forall a. FromJSON a => Parser a
args
      Text
"reload_metadata" -> ReloadMetadata -> RQLMetadataV1
RMReloadMetadata (ReloadMetadata -> RQLMetadataV1)
-> Parser ReloadMetadata -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ReloadMetadata
forall a. FromJSON a => Parser a
args
      Text
"get_inconsistent_metadata" -> GetInconsistentMetadata -> RQLMetadataV1
RMGetInconsistentMetadata (GetInconsistentMetadata -> RQLMetadataV1)
-> Parser GetInconsistentMetadata -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GetInconsistentMetadata
forall a. FromJSON a => Parser a
args
      Text
"drop_inconsistent_metadata" -> DropInconsistentMetadata -> RQLMetadataV1
RMDropInconsistentMetadata (DropInconsistentMetadata -> RQLMetadataV1)
-> Parser DropInconsistentMetadata -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropInconsistentMetadata
forall a. FromJSON a => Parser a
args
      Text
"add_host_to_tls_allowlist" -> AddHostToTLSAllowlist -> RQLMetadataV1
RMAddHostToTLSAllowlist (AddHostToTLSAllowlist -> RQLMetadataV1)
-> Parser AddHostToTLSAllowlist -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AddHostToTLSAllowlist
forall a. FromJSON a => Parser a
args
      Text
"drop_host_from_tls_allowlist" -> DropHostFromTLSAllowlist -> RQLMetadataV1
RMDropHostFromTLSAllowlist (DropHostFromTLSAllowlist -> RQLMetadataV1)
-> Parser DropHostFromTLSAllowlist -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DropHostFromTLSAllowlist
forall a. FromJSON a => Parser a
args
      Text
"dump_internal_state" -> DumpInternalState -> RQLMetadataV1
RMDumpInternalState (DumpInternalState -> RQLMetadataV1)
-> Parser DumpInternalState -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DumpInternalState
forall a. FromJSON a => Parser a
args
      Text
"get_catalog_state" -> GetCatalogState -> RQLMetadataV1
RMGetCatalogState (GetCatalogState -> RQLMetadataV1)
-> Parser GetCatalogState -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GetCatalogState
forall a. FromJSON a => Parser a
args
      Text
"set_catalog_state" -> SetCatalogState -> RQLMetadataV1
RMSetCatalogState (SetCatalogState -> RQLMetadataV1)
-> Parser SetCatalogState -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SetCatalogState
forall a. FromJSON a => Parser a
args
      Text
"set_graphql_schema_introspection_options" -> SetGraphqlIntrospectionOptions -> RQLMetadataV1
RMSetGraphqlSchemaIntrospectionOptions (SetGraphqlIntrospectionOptions -> RQLMetadataV1)
-> Parser SetGraphqlIntrospectionOptions -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SetGraphqlIntrospectionOptions
forall a. FromJSON a => Parser a
args
      Text
"test_webhook_transform" -> Unvalidated TestWebhookTransform -> RQLMetadataV1
RMTestWebhookTransform (Unvalidated TestWebhookTransform -> RQLMetadataV1)
-> Parser (Unvalidated TestWebhookTransform)
-> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Unvalidated TestWebhookTransform)
forall a. FromJSON a => Parser a
args
      Text
"set_query_tags" -> SetQueryTagsConfig -> RQLMetadataV1
RMSetQueryTagsConfig (SetQueryTagsConfig -> RQLMetadataV1)
-> Parser SetQueryTagsConfig -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SetQueryTagsConfig
forall a. FromJSON a => Parser a
args
      Text
"set_opentelemetry_config" -> OpenTelemetryConfig -> RQLMetadataV1
RMSetOpenTelemetryConfig (OpenTelemetryConfig -> RQLMetadataV1)
-> Parser OpenTelemetryConfig -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OpenTelemetryConfig
forall a. FromJSON a => Parser a
args
      Text
"set_opentelemetry_status" -> OtelStatus -> RQLMetadataV1
RMSetOpenTelemetryStatus (OtelStatus -> RQLMetadataV1)
-> Parser OtelStatus -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OtelStatus
forall a. FromJSON a => Parser a
args
      Text
"bulk" -> [RQLMetadataRequest] -> RQLMetadataV1
RMBulk ([RQLMetadataRequest] -> RQLMetadataV1)
-> Parser [RQLMetadataRequest] -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [RQLMetadataRequest]
forall a. FromJSON a => Parser a
args
      Text
"bulk_keep_going" -> [RQLMetadataRequest] -> RQLMetadataV1
RMBulkKeepGoing ([RQLMetadataRequest] -> RQLMetadataV1)
-> Parser [RQLMetadataRequest] -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [RQLMetadataRequest]
forall a. FromJSON a => Parser a
args
      Text
"bulk_atomic" -> [RQLMetadataRequest] -> RQLMetadataV1
RMBulkAtomic ([RQLMetadataRequest] -> RQLMetadataV1)
-> Parser [RQLMetadataRequest] -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [RQLMetadataRequest]
forall a. FromJSON a => Parser a
args
      -- Backend prefixed metadata actions:
      Text
_ -> do
        -- 1) Parse the backend source kind and metadata command:
        (AnyBackend BackendSourceKind
backendSourceKind, Text
cmd) <- Text -> Parser (AnyBackend BackendSourceKind, Text)
forall (m :: * -> *).
MonadFail m =>
Text -> m (AnyBackend BackendSourceKind, Text)
parseQueryType Text
queryType
        forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
dispatchAnyBackend @BackendAPI AnyBackend BackendSourceKind
backendSourceKind \(BackendSourceKind b
backendSourceKind' :: BackendSourceKind b) -> do
          -- 2) Parse the args field:
          Value
argValue <- Parser Value
forall a. FromJSON a => Parser a
args
          -- 2) Attempt to run all the backend specific command parsers against the source kind, cmd, and arg:
          -- NOTE: If parsers succeed then this will pick out the first successful one.
          Maybe RQLMetadataV1
command <- [Maybe RQLMetadataV1] -> Maybe RQLMetadataV1
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice ([Maybe RQLMetadataV1] -> Maybe RQLMetadataV1)
-> Parser [Maybe RQLMetadataV1] -> Parser (Maybe RQLMetadataV1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser (Maybe RQLMetadataV1)] -> Parser [Maybe RQLMetadataV1]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [CommandParser b
p BackendSourceKind b
backendSourceKind' Text
cmd Value
argValue | CommandParser b
p <- forall (b :: BackendType). BackendAPI b => [CommandParser b]
metadataV1CommandParsers @b]
          Maybe RQLMetadataV1 -> Parser RQLMetadataV1 -> Parser RQLMetadataV1
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe RQLMetadataV1
command
            (Parser RQLMetadataV1 -> Parser RQLMetadataV1)
-> Parser RQLMetadataV1 -> Parser RQLMetadataV1
forall a b. (a -> b) -> a -> b
$ String -> Parser RQLMetadataV1
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            (String -> Parser RQLMetadataV1) -> String -> Parser RQLMetadataV1
forall a b. (a -> b) -> a -> b
$ String
"unknown metadata command \""
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
cmd
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" for backend "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (BackendSourceKind b -> Text
forall a. ToTxt a => a -> Text
T.toTxt BackendSourceKind b
backendSourceKind')

instance FromJSON RQLMetadataV2 where
  parseJSON :: Value -> Parser RQLMetadataV2
parseJSON =
    Options -> Value -> Parser RQLMetadataV2
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      (Options -> Value -> Parser RQLMetadataV2)
-> Options -> Value -> Parser RQLMetadataV2
forall a b. (a -> b) -> a -> b
$ Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
snakeCase (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4,
          sumEncoding :: SumEncoding
sumEncoding = String -> String -> SumEncoding
TaggedObject String
"type" String
"args"
        }

instance FromJSON RQLMetadataRequest where
  parseJSON :: Value -> Parser RQLMetadataRequest
parseJSON = String
-> (Object -> Parser RQLMetadataRequest)
-> Value
-> Parser RQLMetadataRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RQLMetadataRequest" ((Object -> Parser RQLMetadataRequest)
 -> Value -> Parser RQLMetadataRequest)
-> (Object -> Parser RQLMetadataRequest)
-> Value
-> Parser RQLMetadataRequest
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    APIVersion
version <- Object
o Object -> Key -> Parser (Maybe APIVersion)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version" Parser (Maybe APIVersion) -> APIVersion -> Parser APIVersion
forall a. Parser (Maybe a) -> a -> Parser a
.!= APIVersion
VIVersion1
    let val :: Value
val = Object -> Value
Object Object
o
    case APIVersion
version of
      APIVersion
VIVersion1 -> RQLMetadataV1 -> RQLMetadataRequest
RMV1 (RQLMetadataV1 -> RQLMetadataRequest)
-> Parser RQLMetadataV1 -> Parser RQLMetadataRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser RQLMetadataV1
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      APIVersion
VIVersion2 -> RQLMetadataV2 -> RQLMetadataRequest
RMV2 (RQLMetadataV2 -> RQLMetadataRequest)
-> Parser RQLMetadataV2 -> Parser RQLMetadataRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser RQLMetadataV2
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val

-- | end of orphan instances

-- | Parse the Metadata API action type returning a tuple of the
-- 'BackendSourceKind' and the action suffix.
--
-- For example: @"pg_add_source"@ parses as @(PostgresVanillaValue, "add_source")@
parseQueryType :: (MonadFail m) => Text -> m (AnyBackend BackendSourceKind, Text)
parseQueryType :: forall (m :: * -> *).
MonadFail m =>
Text -> m (AnyBackend BackendSourceKind, Text)
parseQueryType Text
queryType =
  let (Text
prefix, Int -> Text -> Text
T.drop Int
1 -> Text
cmd) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"_" Text
queryType
   in (,Text
cmd)
        (AnyBackend BackendSourceKind
 -> (AnyBackend BackendSourceKind, Text))
-> m (AnyBackend BackendSourceKind)
-> m (AnyBackend BackendSourceKind, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (AnyBackend BackendSourceKind)
backendSourceKindFromText Text
prefix
        Maybe (AnyBackend BackendSourceKind)
-> m (AnyBackend BackendSourceKind)
-> m (AnyBackend BackendSourceKind)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` String -> m (AnyBackend BackendSourceKind)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
          ( String
"unknown metadata command \""
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
queryType
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\"; \""
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
prefix
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" was not recognized as a valid backend name"
          )