-- | BackendAPI
--
-- This module defines the 'BackendAPI' class, alongside a few helpers. Its goal is to delegate to
-- backends the responsibility of creating the parsers for the metadata API. Each backend is expected
-- to provide a list of 'CommandParser', which in turn is a simple function from command name and
-- command arguments to a corresponding parser. Command parsers can easily be created using the
-- 'commandParser' function.
--
-- Furthermore, for each set of related features, such as table tracking commands, or permission
-- commands, a helper function is provided, that allows a backend to write its instance by simply
-- listing the set of features it supports.
module Hasura.Server.API.Backend
  ( BackendAPI (..),
    commandParser,
    eventTriggerCommands,
    functionCommands,
    functionPermissionsCommands,
    relationshipCommands,
    remoteRelationshipCommands,
    sourceCommands,
    tableCommands,
    tablePermissionsCommands,
    computedFieldCommands,
  )
where

import Data.Aeson ((<?>))
import Data.Aeson.Extended (FromJSONWithContext (..))
import Data.Aeson.Types (modifyFailure)
import Data.Aeson.Types qualified as J
import Data.Text qualified as T
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.SQL.AnyBackend
import Hasura.SQL.Backend
import {-# SOURCE #-} Hasura.Server.API.Metadata

-- API class

type CommandParser b = BackendSourceKind b -> Text -> J.Value -> J.Parser (Maybe RQLMetadataV1)

class BackendAPI (b :: BackendType) where
  metadataV1CommandParsers :: [CommandParser b]

-- helpers

commandParserWithExplicitParser ::
  -- | Explicit parsing function that also takes a BackendKind
  (BackendSourceKind b -> J.Value -> J.Parser a) ->
  -- | expected command name
  Text ->
  -- | corresponding parser
  (a -> RQLMetadataV1) ->
  CommandParser b
commandParserWithExplicitParser :: (BackendSourceKind b -> Value -> Parser a)
-> Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParserWithExplicitParser BackendSourceKind b -> Value -> Parser a
parseJSONWithBackendKind Text
expected a -> RQLMetadataV1
constructor BackendSourceKind b
backendKind Text
provided Value
arguments =
  -- We return a Maybe parser here if the command name doesn't match, as Aeson's alternative
  -- instance backtracks: if we used 'fail', we would not be able to distinguish between "this is
  -- the correct branch, the name matches, but the argument fails to parse, we must fail" and "this
  -- is not the command we were expecting here, it is fine to continue with another".
  Bool -> Parser RQLMetadataV1 -> Parser (Maybe RQLMetadataV1)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe (Text
expected Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
provided) (Parser RQLMetadataV1 -> Parser (Maybe RQLMetadataV1))
-> Parser RQLMetadataV1 -> Parser (Maybe RQLMetadataV1)
forall a b. (a -> b) -> a -> b
$
    (String -> String) -> Parser RQLMetadataV1 -> Parser RQLMetadataV1
forall a. (String -> String) -> Parser a -> Parser a
modifyFailure String -> String
withDetails (Parser RQLMetadataV1 -> Parser RQLMetadataV1)
-> Parser RQLMetadataV1 -> Parser RQLMetadataV1
forall a b. (a -> b) -> a -> b
$ a -> RQLMetadataV1
constructor (a -> RQLMetadataV1) -> Parser a -> Parser RQLMetadataV1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BackendSourceKind b -> Value -> Parser a
parseJSONWithBackendKind BackendSourceKind b
backendKind Value
arguments Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
J.Key Key
"args")
  where
    withDetails :: String -> String
withDetails String
internalErrorMessage =
      String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
        String
"\n"
        [ String
"Error when parsing command " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
expected String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".",
          String
"See our documentation at https://hasura.io/docs/latest/graphql/core/api-reference/metadata-api/index.html#metadata-apis.",
          String
"Internal error message: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
internalErrorMessage
        ]

commandParser ::
  J.FromJSON a =>
  -- | expected command name
  Text ->
  -- | corresponding parser
  (a -> RQLMetadataV1) ->
  CommandParser b
commandParser :: Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser = (BackendSourceKind b -> Value -> Parser a)
-> Text -> (a -> RQLMetadataV1) -> CommandParser b
forall (b :: BackendType) a.
(BackendSourceKind b -> Value -> Parser a)
-> Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParserWithExplicitParser ((Value -> Parser a) -> BackendSourceKind b -> Value -> Parser a
forall a b. a -> b -> a
const Value -> Parser a
forall a. FromJSON a => Value -> Parser a
J.parseJSON) -- Ignore the backend source kind and just parse using the FromJSON instance

commandParserWithBackendKind ::
  FromJSONWithContext (BackendSourceKind b) a =>
  -- | expected command name
  Text ->
  -- | corresponding parser
  (a -> RQLMetadataV1) ->
  CommandParser b
commandParserWithBackendKind :: Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParserWithBackendKind =
  (BackendSourceKind b -> Value -> Parser a)
-> Text -> (a -> RQLMetadataV1) -> CommandParser b
forall (b :: BackendType) a.
(BackendSourceKind b -> Value -> Parser a)
-> Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParserWithExplicitParser BackendSourceKind b -> Value -> Parser a
forall ctx a. FromJSONWithContext ctx a => ctx -> Value -> Parser a
parseJSONWithContext

sourceCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
sourceCommands :: [CommandParser b]
sourceCommands =
  [ Text -> (AddSource b -> RQLMetadataV1) -> CommandParser b
forall (b :: BackendType) a.
FromJSONWithContext (BackendSourceKind b) a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParserWithBackendKind Text
"add_source" ((AddSource b -> RQLMetadataV1) -> CommandParser b)
-> (AddSource b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend AddSource -> RQLMetadataV1
RMAddSource (AnyBackend AddSource -> RQLMetadataV1)
-> (AddSource b -> AnyBackend AddSource)
-> AddSource b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (DropSource -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"drop_source" ((DropSource -> RQLMetadataV1) -> CommandParser b)
-> (DropSource -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ DropSource -> RQLMetadataV1
RMDropSource,
    Text
-> (SetTableCustomization b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"set_table_customization" ((SetTableCustomization b -> RQLMetadataV1) -> CommandParser b)
-> (SetTableCustomization b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend SetTableCustomization -> RQLMetadataV1
RMSetTableCustomization (AnyBackend SetTableCustomization -> RQLMetadataV1)
-> (SetTableCustomization b -> AnyBackend SetTableCustomization)
-> SetTableCustomization b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text
-> (SetApolloFederationConfig b -> RQLMetadataV1)
-> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"set_apollo_federation_config" ((SetApolloFederationConfig b -> RQLMetadataV1) -> CommandParser b)
-> (SetApolloFederationConfig b -> RQLMetadataV1)
-> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend SetApolloFederationConfig -> RQLMetadataV1
RMSetApolloFederationConfig (AnyBackend SetApolloFederationConfig -> RQLMetadataV1)
-> (SetApolloFederationConfig b
    -> AnyBackend SetApolloFederationConfig)
-> SetApolloFederationConfig b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (UpdateSource b -> RQLMetadataV1) -> CommandParser b
forall (b :: BackendType) a.
FromJSONWithContext (BackendSourceKind b) a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParserWithBackendKind Text
"update_source" ((UpdateSource b -> RQLMetadataV1) -> CommandParser b)
-> (UpdateSource b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend UpdateSource -> RQLMetadataV1
RMUpdateSource (AnyBackend UpdateSource -> RQLMetadataV1)
-> (UpdateSource b -> AnyBackend UpdateSource)
-> UpdateSource b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b
  ]

tableCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
tableCommands :: [CommandParser b]
tableCommands =
  [ Text -> (TrackTableV2 b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"track_table" ((TrackTableV2 b -> RQLMetadataV1) -> CommandParser b)
-> (TrackTableV2 b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend TrackTableV2 -> RQLMetadataV1
RMTrackTable (AnyBackend TrackTableV2 -> RQLMetadataV1)
-> (TrackTableV2 b -> AnyBackend TrackTableV2)
-> TrackTableV2 b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (UntrackTable b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"untrack_table" ((UntrackTable b -> RQLMetadataV1) -> CommandParser b)
-> (UntrackTable b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend UntrackTable -> RQLMetadataV1
RMUntrackTable (AnyBackend UntrackTable -> RQLMetadataV1)
-> (UntrackTable b -> AnyBackend UntrackTable)
-> UntrackTable b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b
  ]

tablePermissionsCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
tablePermissionsCommands :: [CommandParser b]
tablePermissionsCommands =
  [ Text -> (CreatePerm InsPerm b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"create_insert_permission" ((CreatePerm InsPerm b -> RQLMetadataV1) -> CommandParser b)
-> (CreatePerm InsPerm b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend (CreatePerm InsPerm) -> RQLMetadataV1
RMCreateInsertPermission (AnyBackend (CreatePerm InsPerm) -> RQLMetadataV1)
-> (CreatePerm InsPerm b -> AnyBackend (CreatePerm InsPerm))
-> CreatePerm InsPerm b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (CreatePerm SelPerm b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"create_select_permission" ((CreatePerm SelPerm b -> RQLMetadataV1) -> CommandParser b)
-> (CreatePerm SelPerm b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend (CreatePerm SelPerm) -> RQLMetadataV1
RMCreateSelectPermission (AnyBackend (CreatePerm SelPerm) -> RQLMetadataV1)
-> (CreatePerm SelPerm b -> AnyBackend (CreatePerm SelPerm))
-> CreatePerm SelPerm b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (CreatePerm UpdPerm b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"create_update_permission" ((CreatePerm UpdPerm b -> RQLMetadataV1) -> CommandParser b)
-> (CreatePerm UpdPerm b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend (CreatePerm UpdPerm) -> RQLMetadataV1
RMCreateUpdatePermission (AnyBackend (CreatePerm UpdPerm) -> RQLMetadataV1)
-> (CreatePerm UpdPerm b -> AnyBackend (CreatePerm UpdPerm))
-> CreatePerm UpdPerm b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (CreatePerm DelPerm b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"create_delete_permission" ((CreatePerm DelPerm b -> RQLMetadataV1) -> CommandParser b)
-> (CreatePerm DelPerm b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend (CreatePerm DelPerm) -> RQLMetadataV1
RMCreateDeletePermission (AnyBackend (CreatePerm DelPerm) -> RQLMetadataV1)
-> (CreatePerm DelPerm b -> AnyBackend (CreatePerm DelPerm))
-> CreatePerm DelPerm b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (DropPerm b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"drop_insert_permission" ((DropPerm b -> RQLMetadataV1) -> CommandParser b)
-> (DropPerm b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend DropPerm -> RQLMetadataV1
RMDropInsertPermission (AnyBackend DropPerm -> RQLMetadataV1)
-> (DropPerm b -> AnyBackend DropPerm)
-> DropPerm b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (DropPerm b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"drop_select_permission" ((DropPerm b -> RQLMetadataV1) -> CommandParser b)
-> (DropPerm b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend DropPerm -> RQLMetadataV1
RMDropSelectPermission (AnyBackend DropPerm -> RQLMetadataV1)
-> (DropPerm b -> AnyBackend DropPerm)
-> DropPerm b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (DropPerm b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"drop_update_permission" ((DropPerm b -> RQLMetadataV1) -> CommandParser b)
-> (DropPerm b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend DropPerm -> RQLMetadataV1
RMDropUpdatePermission (AnyBackend DropPerm -> RQLMetadataV1)
-> (DropPerm b -> AnyBackend DropPerm)
-> DropPerm b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (DropPerm b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"drop_delete_permission" ((DropPerm b -> RQLMetadataV1) -> CommandParser b)
-> (DropPerm b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend DropPerm -> RQLMetadataV1
RMDropDeletePermission (AnyBackend DropPerm -> RQLMetadataV1)
-> (DropPerm b -> AnyBackend DropPerm)
-> DropPerm b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (SetPermComment b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"set_permission_comment" ((SetPermComment b -> RQLMetadataV1) -> CommandParser b)
-> (SetPermComment b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend SetPermComment -> RQLMetadataV1
RMSetPermissionComment (AnyBackend SetPermComment -> RQLMetadataV1)
-> (SetPermComment b -> AnyBackend SetPermComment)
-> SetPermComment b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b
  ]

functionCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
functionCommands :: [CommandParser b]
functionCommands =
  [ Text -> (TrackFunctionV2 b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"track_function" ((TrackFunctionV2 b -> RQLMetadataV1) -> CommandParser b)
-> (TrackFunctionV2 b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend TrackFunctionV2 -> RQLMetadataV1
RMTrackFunction (AnyBackend TrackFunctionV2 -> RQLMetadataV1)
-> (TrackFunctionV2 b -> AnyBackend TrackFunctionV2)
-> TrackFunctionV2 b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (UnTrackFunction b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"untrack_function" ((UnTrackFunction b -> RQLMetadataV1) -> CommandParser b)
-> (UnTrackFunction b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend UnTrackFunction -> RQLMetadataV1
RMUntrackFunction (AnyBackend UnTrackFunction -> RQLMetadataV1)
-> (UnTrackFunction b -> AnyBackend UnTrackFunction)
-> UnTrackFunction b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text
-> (SetFunctionCustomization b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"set_function_customization" ((SetFunctionCustomization b -> RQLMetadataV1) -> CommandParser b)
-> (SetFunctionCustomization b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend SetFunctionCustomization -> RQLMetadataV1
RMSetFunctionCustomization (AnyBackend SetFunctionCustomization -> RQLMetadataV1)
-> (SetFunctionCustomization b
    -> AnyBackend SetFunctionCustomization)
-> SetFunctionCustomization b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b
  ]

functionPermissionsCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
functionPermissionsCommands :: [CommandParser b]
functionPermissionsCommands =
  [ Text
-> (FunctionPermissionArgument b -> RQLMetadataV1)
-> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"create_function_permission" ((FunctionPermissionArgument b -> RQLMetadataV1)
 -> CommandParser b)
-> (FunctionPermissionArgument b -> RQLMetadataV1)
-> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend FunctionPermissionArgument -> RQLMetadataV1
RMCreateFunctionPermission (AnyBackend FunctionPermissionArgument -> RQLMetadataV1)
-> (FunctionPermissionArgument b
    -> AnyBackend FunctionPermissionArgument)
-> FunctionPermissionArgument b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text
-> (FunctionPermissionArgument b -> RQLMetadataV1)
-> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"drop_function_permission" ((FunctionPermissionArgument b -> RQLMetadataV1)
 -> CommandParser b)
-> (FunctionPermissionArgument b -> RQLMetadataV1)
-> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend FunctionPermissionArgument -> RQLMetadataV1
RMDropFunctionPermission (AnyBackend FunctionPermissionArgument -> RQLMetadataV1)
-> (FunctionPermissionArgument b
    -> AnyBackend FunctionPermissionArgument)
-> FunctionPermissionArgument b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b
  ]

relationshipCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
relationshipCommands :: [CommandParser b]
relationshipCommands =
  [ Text -> (CreateObjRel b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"create_object_relationship" ((CreateObjRel b -> RQLMetadataV1) -> CommandParser b)
-> (CreateObjRel b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend CreateObjRel -> RQLMetadataV1
RMCreateObjectRelationship (AnyBackend CreateObjRel -> RQLMetadataV1)
-> (CreateObjRel b -> AnyBackend CreateObjRel)
-> CreateObjRel b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (CreateArrRel b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"create_array_relationship" ((CreateArrRel b -> RQLMetadataV1) -> CommandParser b)
-> (CreateArrRel b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend CreateArrRel -> RQLMetadataV1
RMCreateArrayRelationship (AnyBackend CreateArrRel -> RQLMetadataV1)
-> (CreateArrRel b -> AnyBackend CreateArrRel)
-> CreateArrRel b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (SetRelComment b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"set_relationship_comment" ((SetRelComment b -> RQLMetadataV1) -> CommandParser b)
-> (SetRelComment b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend SetRelComment -> RQLMetadataV1
RMSetRelationshipComment (AnyBackend SetRelComment -> RQLMetadataV1)
-> (SetRelComment b -> AnyBackend SetRelComment)
-> SetRelComment b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (RenameRel b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"rename_relationship" ((RenameRel b -> RQLMetadataV1) -> CommandParser b)
-> (RenameRel b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend RenameRel -> RQLMetadataV1
RMRenameRelationship (AnyBackend RenameRel -> RQLMetadataV1)
-> (RenameRel b -> AnyBackend RenameRel)
-> RenameRel b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (DropRel b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"drop_relationship" ((DropRel b -> RQLMetadataV1) -> CommandParser b)
-> (DropRel b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend DropRel -> RQLMetadataV1
RMDropRelationship (AnyBackend DropRel -> RQLMetadataV1)
-> (DropRel b -> AnyBackend DropRel) -> DropRel b -> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b
  ]

remoteRelationshipCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
remoteRelationshipCommands :: [CommandParser b]
remoteRelationshipCommands =
  [ Text
-> (CreateFromSourceRelationship b -> RQLMetadataV1)
-> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"create_remote_relationship" ((CreateFromSourceRelationship b -> RQLMetadataV1)
 -> CommandParser b)
-> (CreateFromSourceRelationship b -> RQLMetadataV1)
-> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend CreateFromSourceRelationship -> RQLMetadataV1
RMCreateRemoteRelationship (AnyBackend CreateFromSourceRelationship -> RQLMetadataV1)
-> (CreateFromSourceRelationship b
    -> AnyBackend CreateFromSourceRelationship)
-> CreateFromSourceRelationship b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text
-> (CreateFromSourceRelationship b -> RQLMetadataV1)
-> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"update_remote_relationship" ((CreateFromSourceRelationship b -> RQLMetadataV1)
 -> CommandParser b)
-> (CreateFromSourceRelationship b -> RQLMetadataV1)
-> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend CreateFromSourceRelationship -> RQLMetadataV1
RMUpdateRemoteRelationship (AnyBackend CreateFromSourceRelationship -> RQLMetadataV1)
-> (CreateFromSourceRelationship b
    -> AnyBackend CreateFromSourceRelationship)
-> CreateFromSourceRelationship b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text
-> (DeleteFromSourceRelationship b -> RQLMetadataV1)
-> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"delete_remote_relationship" ((DeleteFromSourceRelationship b -> RQLMetadataV1)
 -> CommandParser b)
-> (DeleteFromSourceRelationship b -> RQLMetadataV1)
-> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend DeleteFromSourceRelationship -> RQLMetadataV1
RMDeleteRemoteRelationship (AnyBackend DeleteFromSourceRelationship -> RQLMetadataV1)
-> (DeleteFromSourceRelationship b
    -> AnyBackend DeleteFromSourceRelationship)
-> DeleteFromSourceRelationship b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b
  ]

eventTriggerCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
eventTriggerCommands :: [CommandParser b]
eventTriggerCommands =
  [ Text
-> (InvokeEventTriggerQuery b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"invoke_event_trigger" ((InvokeEventTriggerQuery b -> RQLMetadataV1) -> CommandParser b)
-> (InvokeEventTriggerQuery b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend InvokeEventTriggerQuery -> RQLMetadataV1
RMInvokeEventTrigger (AnyBackend InvokeEventTriggerQuery -> RQLMetadataV1)
-> (InvokeEventTriggerQuery b
    -> AnyBackend InvokeEventTriggerQuery)
-> InvokeEventTriggerQuery b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text
-> (Unvalidated1 CreateEventTriggerQuery b -> RQLMetadataV1)
-> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"create_event_trigger" ((Unvalidated1 CreateEventTriggerQuery b -> RQLMetadataV1)
 -> CommandParser b)
-> (Unvalidated1 CreateEventTriggerQuery b -> RQLMetadataV1)
-> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend (Unvalidated1 CreateEventTriggerQuery) -> RQLMetadataV1
RMCreateEventTrigger (AnyBackend (Unvalidated1 CreateEventTriggerQuery)
 -> RQLMetadataV1)
-> (Unvalidated1 CreateEventTriggerQuery b
    -> AnyBackend (Unvalidated1 CreateEventTriggerQuery))
-> Unvalidated1 CreateEventTriggerQuery b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text
-> (DeleteEventTriggerQuery b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"delete_event_trigger" ((DeleteEventTriggerQuery b -> RQLMetadataV1) -> CommandParser b)
-> (DeleteEventTriggerQuery b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend DeleteEventTriggerQuery -> RQLMetadataV1
RMDeleteEventTrigger (AnyBackend DeleteEventTriggerQuery -> RQLMetadataV1)
-> (DeleteEventTriggerQuery b
    -> AnyBackend DeleteEventTriggerQuery)
-> DeleteEventTriggerQuery b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (RedeliverEventQuery b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"redeliver_event" ((RedeliverEventQuery b -> RQLMetadataV1) -> CommandParser b)
-> (RedeliverEventQuery b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend RedeliverEventQuery -> RQLMetadataV1
RMRedeliverEvent (AnyBackend RedeliverEventQuery -> RQLMetadataV1)
-> (RedeliverEventQuery b -> AnyBackend RedeliverEventQuery)
-> RedeliverEventQuery b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b
  ]

computedFieldCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
computedFieldCommands :: [CommandParser b]
computedFieldCommands =
  [ Text -> (AddComputedField b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"add_computed_field" ((AddComputedField b -> RQLMetadataV1) -> CommandParser b)
-> (AddComputedField b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend AddComputedField -> RQLMetadataV1
RMAddComputedField (AnyBackend AddComputedField -> RQLMetadataV1)
-> (AddComputedField b -> AnyBackend AddComputedField)
-> AddComputedField b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b,
    Text -> (DropComputedField b -> RQLMetadataV1) -> CommandParser b
forall a (b :: BackendType).
FromJSON a =>
Text -> (a -> RQLMetadataV1) -> CommandParser b
commandParser Text
"drop_computed_field" ((DropComputedField b -> RQLMetadataV1) -> CommandParser b)
-> (DropComputedField b -> RQLMetadataV1) -> CommandParser b
forall a b. (a -> b) -> a -> b
$ AnyBackend DropComputedField -> RQLMetadataV1
RMDropComputedField (AnyBackend DropComputedField -> RQLMetadataV1)
-> (DropComputedField b -> AnyBackend DropComputedField)
-> DropComputedField b
-> RQLMetadataV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
mkAnyBackend @b
  ]