module Hasura.RQL.DDL.Action
  ( CreateAction (..),
    runCreateAction,
    resolveAction,
    UpdateAction,
    runUpdateAction,
    DropAction,
    runDropAction,
    dropActionInMetadata,
    CreateActionPermission (..),
    runCreateActionPermission,
    DropActionPermission,
    runDropActionPermission,
    dropActionPermissionInMetadata,
  )
where

import Control.Lens ((.~), (^.))
import Data.Aeson qualified as J
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.List.NonEmpty qualified as NEList
import Data.Text.Extended
import Data.URL.Template (printTemplate)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.RQL.DDL.CustomTypes (ScalarParsingMap (..), lookupBackendScalar)
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Roles (RoleName)
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.SQL.BackendMap (BackendMap)
import Language.GraphQL.Draft.Syntax qualified as G

getActionInfo ::
  (QErrM m, CacheRM m) =>
  ActionName ->
  m ActionInfo
getActionInfo :: forall (m :: * -> *).
(QErrM m, CacheRM m) =>
ActionName -> m ActionInfo
getActionInfo ActionName
actionName = do
  ActionCache
actionMap <- SchemaCache -> ActionCache
scActions (SchemaCache -> ActionCache) -> m SchemaCache -> m ActionCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  Maybe ActionInfo -> m ActionInfo -> m ActionInfo
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (ActionName -> ActionCache -> Maybe ActionInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ActionName
actionName ActionCache
actionMap)
    (m ActionInfo -> m ActionInfo) -> m ActionInfo -> m ActionInfo
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ActionInfo
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m ActionInfo) -> Text -> m ActionInfo
forall a b. (a -> b) -> a -> b
$ Text
"action with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ActionName
actionName
    ActionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"

data CreateAction = CreateAction
  { CreateAction -> ActionName
_caName :: ActionName,
    CreateAction -> ActionDefinitionInput
_caDefinition :: ActionDefinitionInput,
    CreateAction -> Maybe Text
_caComment :: Maybe Text
  }
  deriving stock ((forall x. CreateAction -> Rep CreateAction x)
-> (forall x. Rep CreateAction x -> CreateAction)
-> Generic CreateAction
forall x. Rep CreateAction x -> CreateAction
forall x. CreateAction -> Rep CreateAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateAction -> Rep CreateAction x
from :: forall x. CreateAction -> Rep CreateAction x
$cto :: forall x. Rep CreateAction x -> CreateAction
to :: forall x. Rep CreateAction x -> CreateAction
Generic)

instance J.FromJSON CreateAction where
  parseJSON :: Value -> Parser CreateAction
parseJSON = Options -> Value -> Parser CreateAction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON

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

runCreateAction ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  CreateAction ->
  m EncJSON
runCreateAction :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
CreateAction -> m EncJSON
runCreateAction CreateAction
createAction = do
  -- check if action with same name exists already
  ActionCache
actionMap <- SchemaCache -> ActionCache
scActions (SchemaCache -> ActionCache) -> m SchemaCache -> m ActionCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  Maybe ActionInfo -> (ActionInfo -> m Any) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (ActionName -> ActionCache -> Maybe ActionInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ActionName
actionName ActionCache
actionMap)
    ((ActionInfo -> m Any) -> m ()) -> (ActionInfo -> m Any) -> m ()
forall a b. (a -> b) -> a -> b
$ m Any -> ActionInfo -> m Any
forall a b. a -> b -> a
const
    (m Any -> ActionInfo -> m Any) -> m Any -> ActionInfo -> m Any
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m Any
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists
    (Text -> m Any) -> Text -> m Any
forall a b. (a -> b) -> a -> b
$ Text
"action with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ActionName
actionName
    ActionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" already exists"
  let metadata :: ActionMetadata
metadata =
        ActionName
-> Maybe Text
-> ActionDefinitionInput
-> [ActionPermissionMetadata]
-> ActionMetadata
ActionMetadata
          ActionName
actionName
          (CreateAction -> Maybe Text
_caComment CreateAction
createAction)
          (CreateAction -> ActionDefinitionInput
_caDefinition CreateAction
createAction)
          []
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (ActionName -> MetadataObjId
MOAction ActionName
actionName)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Actions -> Identity Actions) -> Metadata -> Identity Metadata
Lens' Metadata Actions
metaActions
    ((Actions -> Identity Actions) -> Metadata -> Identity Metadata)
-> (Actions -> Actions) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ActionName -> ActionMetadata -> Actions -> Actions
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert ActionName
actionName ActionMetadata
metadata
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    actionName :: ActionName
actionName = CreateAction -> ActionName
_caName CreateAction
createAction

{- Note [Postgres scalars in action input arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's very comfortable to be able to reference Postgres scalars in actions
input arguments. For example, see the following action mutation:

    extend type mutation_root {
      create_user (
        name: String!
        created_at: timestamptz
      ): User
    }

The timestamptz is a Postgres scalar. We need to validate the presence of
timestamptz type in the Postgres database. So, the 'resolveAction' function
takes all Postgres scalar types as one of the inputs and returns the set of
referred scalars.
-}

resolveAction ::
  (QErrM m) =>
  Env.Environment ->
  AnnotatedCustomTypes ->
  ActionDefinitionInput ->
  BackendMap ScalarParsingMap -> -- See Note [Postgres scalars in custom types]
  m
    ( ResolvedActionDefinition,
      AnnotatedOutputType
    )
resolveAction :: forall (m :: * -> *).
QErrM m =>
Environment
-> AnnotatedCustomTypes
-> ActionDefinitionInput
-> BackendMap ScalarParsingMap
-> m (ResolvedActionDefinition, AnnotatedOutputType)
resolveAction Environment
env AnnotatedCustomTypes {HashMap Name AnnotatedObjectType
HashMap Name AnnotatedInputType
_actInputTypes :: HashMap Name AnnotatedInputType
_actObjectTypes :: HashMap Name AnnotatedObjectType
_actInputTypes :: AnnotatedCustomTypes -> HashMap Name AnnotatedInputType
_actObjectTypes :: AnnotatedCustomTypes -> HashMap Name AnnotatedObjectType
..} ActionDefinition {Bool
[HeaderConf]
[ArgumentDefinition GraphQLType]
Maybe RequestTransform
Maybe MetadataResponseTransform
Timeout
InputWebhook
GraphQLType
ActionType
_adArguments :: [ArgumentDefinition GraphQLType]
_adOutputType :: GraphQLType
_adType :: ActionType
_adHeaders :: [HeaderConf]
_adForwardClientHeaders :: Bool
_adTimeout :: Timeout
_adHandler :: InputWebhook
_adRequestTransform :: Maybe RequestTransform
_adResponseTransform :: Maybe MetadataResponseTransform
_adArguments :: forall arg webhook.
ActionDefinition arg webhook -> [ArgumentDefinition arg]
_adOutputType :: forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adType :: forall arg webhook. ActionDefinition arg webhook -> ActionType
_adHeaders :: forall arg webhook. ActionDefinition arg webhook -> [HeaderConf]
_adForwardClientHeaders :: forall arg webhook. ActionDefinition arg webhook -> Bool
_adTimeout :: forall arg webhook. ActionDefinition arg webhook -> Timeout
_adHandler :: forall arg webhook. ActionDefinition arg webhook -> webhook
_adRequestTransform :: forall arg webhook.
ActionDefinition arg webhook -> Maybe RequestTransform
_adResponseTransform :: forall arg webhook.
ActionDefinition arg webhook -> Maybe MetadataResponseTransform
..} BackendMap ScalarParsingMap
allScalars = do
  [ArgumentDefinition (GType, AnnotatedInputType)]
resolvedArguments <- [ArgumentDefinition GraphQLType]
-> (ArgumentDefinition GraphQLType
    -> m (ArgumentDefinition (GType, AnnotatedInputType)))
-> m [ArgumentDefinition (GType, AnnotatedInputType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ArgumentDefinition GraphQLType]
_adArguments ((ArgumentDefinition GraphQLType
  -> m (ArgumentDefinition (GType, AnnotatedInputType)))
 -> m [ArgumentDefinition (GType, AnnotatedInputType)])
-> (ArgumentDefinition GraphQLType
    -> m (ArgumentDefinition (GType, AnnotatedInputType)))
-> m [ArgumentDefinition (GType, AnnotatedInputType)]
forall a b. (a -> b) -> a -> b
$ \ArgumentDefinition GraphQLType
argumentDefinition -> do
    ArgumentDefinition GraphQLType
-> (GraphQLType -> m (GType, AnnotatedInputType))
-> m (ArgumentDefinition (GType, AnnotatedInputType))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ArgumentDefinition GraphQLType
argumentDefinition ((GraphQLType -> m (GType, AnnotatedInputType))
 -> m (ArgumentDefinition (GType, AnnotatedInputType)))
-> (GraphQLType -> m (GType, AnnotatedInputType))
-> m (ArgumentDefinition (GType, AnnotatedInputType))
forall a b. (a -> b) -> a -> b
$ \GraphQLType
argumentType -> do
      let gType :: GType
gType = GraphQLType -> GType
unGraphQLType GraphQLType
argumentType
          argumentBaseType :: Name
argumentBaseType = GType -> Name
G.getBaseType GType
gType
      (GType
gType,)
        (AnnotatedInputType -> (GType, AnnotatedInputType))
-> m AnnotatedInputType -> m (GType, AnnotatedInputType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if
          | Just AnnotatedScalarType
noCTScalar <- BackendMap ScalarParsingMap -> Name -> Maybe AnnotatedScalarType
lookupBackendScalar BackendMap ScalarParsingMap
allScalars Name
argumentBaseType ->
              AnnotatedInputType -> m AnnotatedInputType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedInputType -> m AnnotatedInputType)
-> AnnotatedInputType -> m AnnotatedInputType
forall a b. (a -> b) -> a -> b
$ AnnotatedScalarType -> AnnotatedInputType
NOCTScalar AnnotatedScalarType
noCTScalar
          | Just AnnotatedInputType
nonObjectType <- Name -> HashMap Name AnnotatedInputType -> Maybe AnnotatedInputType
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
argumentBaseType HashMap Name AnnotatedInputType
_actInputTypes ->
              AnnotatedInputType -> m AnnotatedInputType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnotatedInputType
nonObjectType
          | Bool
otherwise ->
              Code -> Text -> m AnnotatedInputType
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidParams
                (Text -> m AnnotatedInputType) -> Text -> m AnnotatedInputType
forall a b. (a -> b) -> a -> b
$ Text
"the type: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote Name
argumentBaseType
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not defined in custom types or it is not a scalar/enum/input_object"

  -- Check if the response type is an object
  let outputType :: GType
outputType = GraphQLType -> GType
unGraphQLType GraphQLType
_adOutputType
      outputBaseType :: Name
outputBaseType = GType -> Name
G.getBaseType GType
outputType
  AnnotatedOutputType
outputObject <- do
    AnnotatedOutputType
aot <-
      if
        | Just AnnotatedScalarType
aoTScalar <- BackendMap ScalarParsingMap -> Name -> Maybe AnnotatedScalarType
lookupBackendScalar BackendMap ScalarParsingMap
allScalars Name
outputBaseType ->
            AnnotatedOutputType -> m AnnotatedOutputType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedOutputType -> m AnnotatedOutputType)
-> AnnotatedOutputType -> m AnnotatedOutputType
forall a b. (a -> b) -> a -> b
$ AnnotatedScalarType -> AnnotatedOutputType
AOTScalar AnnotatedScalarType
aoTScalar
        | Just AnnotatedObjectType
objectType <- Name
-> HashMap Name AnnotatedObjectType -> Maybe AnnotatedObjectType
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
outputBaseType HashMap Name AnnotatedObjectType
_actObjectTypes ->
            AnnotatedOutputType -> m AnnotatedOutputType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedOutputType -> m AnnotatedOutputType)
-> AnnotatedOutputType -> m AnnotatedOutputType
forall a b. (a -> b) -> a -> b
$ AnnotatedObjectType -> AnnotatedOutputType
AOTObject AnnotatedObjectType
objectType
        | Just (NOCTScalar AnnotatedScalarType
s) <- Name -> HashMap Name AnnotatedInputType -> Maybe AnnotatedInputType
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
outputBaseType HashMap Name AnnotatedInputType
_actInputTypes ->
            AnnotatedOutputType -> m AnnotatedOutputType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedScalarType -> AnnotatedOutputType
AOTScalar AnnotatedScalarType
s)
        | Bool
otherwise ->
            Code -> Text -> m AnnotatedOutputType
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text
"the type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall t. ToTxt t => t -> Text
dquote Name
outputBaseType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not an object or scalar type defined in custom types")
    -- If the Action is sync:
    --      1. Check if the output type has only top level relations (if any)
    --   If the Action is async:
    --      1. Check that the output type has no relations if the output type contains nested objects
    -- These checks ensure that the SQL we generate for the join does not have to extract nested fields
    -- from the action webhook response.
    let ([ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
nestedObjects, [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
scalarOrEnumFields) = case AnnotatedOutputType
aot of
          AOTObject AnnotatedObjectType
aot' ->
            (ObjectFieldDefinition (GType, AnnotatedObjectFieldType) -> Bool)
-> NonEmpty
     (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
-> ([ObjectFieldDefinition (GType, AnnotatedObjectFieldType)],
    [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)])
forall a. (a -> Bool) -> NonEmpty a -> ([a], [a])
NEList.partition
              ( \ObjectFieldDefinition {Maybe Value
Maybe Description
(GType, AnnotatedObjectFieldType)
ObjectFieldName
_ofdName :: ObjectFieldName
_ofdArguments :: Maybe Value
_ofdDescription :: Maybe Description
_ofdType :: (GType, AnnotatedObjectFieldType)
_ofdName :: forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdArguments :: forall field. ObjectFieldDefinition field -> Maybe Value
_ofdDescription :: forall field. ObjectFieldDefinition field -> Maybe Description
_ofdType :: forall field. ObjectFieldDefinition field -> field
..} ->
                  case (GType, AnnotatedObjectFieldType) -> AnnotatedObjectFieldType
forall a b. (a, b) -> b
snd (GType, AnnotatedObjectFieldType)
_ofdType of
                    AOFTScalar AnnotatedScalarType
_ -> Bool
False
                    AOFTEnum EnumTypeDefinition
_ -> Bool
False
                    AOFTObject Name
_ -> Bool
True
              )
              (AnnotatedObjectType
-> NonEmpty
     (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
_aotFields AnnotatedObjectType
aot')
          AOTScalar AnnotatedScalarType
_ -> ([], [])
        scalarOrEnumFieldNames :: [Name]
scalarOrEnumFieldNames = (ObjectFieldDefinition (GType, AnnotatedObjectFieldType) -> Name)
-> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
-> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ObjectFieldDefinition {Maybe Value
Maybe Description
(GType, AnnotatedObjectFieldType)
ObjectFieldName
_ofdName :: forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdArguments :: forall field. ObjectFieldDefinition field -> Maybe Value
_ofdDescription :: forall field. ObjectFieldDefinition field -> Maybe Description
_ofdType :: forall field. ObjectFieldDefinition field -> field
_ofdName :: ObjectFieldName
_ofdArguments :: Maybe Value
_ofdDescription :: Maybe Description
_ofdType :: (GType, AnnotatedObjectFieldType)
..} -> ObjectFieldName -> Name
unObjectFieldName ObjectFieldName
_ofdName) [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
scalarOrEnumFields
        validateSyncAction :: m ()
validateSyncAction = case AnnotatedOutputType
aot of
          AOTObject AnnotatedObjectType
aot' -> do
            let relationshipsWithNonTopLevelFields :: [AnnotatedTypeRelationship]
relationshipsWithNonTopLevelFields =
                  (AnnotatedTypeRelationship -> Bool)
-> [AnnotatedTypeRelationship] -> [AnnotatedTypeRelationship]
forall a. (a -> Bool) -> [a] -> [a]
filter
                    ( \AnnotatedTypeRelationship {HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
SourceName
RelType
SourceConfig ('Postgres 'Vanilla)
TableName ('Postgres 'Vanilla)
RelationshipName
_atrName :: RelationshipName
_atrType :: RelType
_atrSource :: SourceName
_atrSourceConfig :: SourceConfig ('Postgres 'Vanilla)
_atrTableName :: TableName ('Postgres 'Vanilla)
_atrFieldMapping :: HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrName :: AnnotatedTypeRelationship -> RelationshipName
_atrType :: AnnotatedTypeRelationship -> RelType
_atrSource :: AnnotatedTypeRelationship -> SourceName
_atrSourceConfig :: AnnotatedTypeRelationship -> SourceConfig ('Postgres 'Vanilla)
_atrTableName :: AnnotatedTypeRelationship -> TableName ('Postgres 'Vanilla)
_atrFieldMapping :: AnnotatedTypeRelationship
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
..} ->
                        let objsInRel :: [Name]
objsInRel = ObjectFieldName -> Name
unObjectFieldName (ObjectFieldName -> Name) -> [ObjectFieldName] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
-> [ObjectFieldName]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrFieldMapping
                         in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
scalarOrEnumFieldNames) [Name]
objsInRel
                    )
                    (AnnotatedObjectType -> [AnnotatedTypeRelationship]
_aotRelationships AnnotatedObjectType
aot')
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AnnotatedTypeRelationship] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnnotatedTypeRelationship]
relationshipsWithNonTopLevelFields)
              (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintError
              (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Relationships cannot be defined with nested object fields: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated (RelationshipName -> Text
forall t. ToTxt t => t -> Text
dquote (RelationshipName -> Text)
-> (AnnotatedTypeRelationship -> RelationshipName)
-> AnnotatedTypeRelationship
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedTypeRelationship -> RelationshipName
_atrName (AnnotatedTypeRelationship -> Text)
-> [AnnotatedTypeRelationship] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AnnotatedTypeRelationship]
relationshipsWithNonTopLevelFields)
          AOTScalar AnnotatedScalarType
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    case ActionType
_adType of
      ActionType
ActionQuery -> m ()
validateSyncAction
      ActionMutation ActionMutationKind
ActionSynchronous -> m ()
validateSyncAction
      ActionMutation ActionMutationKind
ActionAsynchronous -> case AnnotatedOutputType
aot of
        AOTScalar AnnotatedScalarType
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        AOTObject AnnotatedObjectType
aot' ->
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AnnotatedTypeRelationship] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AnnotatedObjectType -> [AnnotatedTypeRelationship]
_aotRelationships AnnotatedObjectType
aot') Bool -> Bool -> Bool
|| [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
nestedObjects)
            (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintError
            (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Async action relations cannot be used with object fields: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated (ObjectFieldName -> Text
forall t. ToTxt t => t -> Text
dquote (ObjectFieldName -> Text)
-> (ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
    -> ObjectFieldName)
-> ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectFieldDefinition (GType, AnnotatedObjectFieldType)
-> ObjectFieldName
forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdName (ObjectFieldDefinition (GType, AnnotatedObjectFieldType) -> Text)
-> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
-> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)]
nestedObjects)
    AnnotatedOutputType -> m AnnotatedOutputType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnotatedOutputType
aot
  ResolvedWebhook
resolvedWebhook <- Environment -> InputWebhook -> m ResolvedWebhook
forall (m :: * -> *).
QErrM m =>
Environment -> InputWebhook -> m ResolvedWebhook
resolveWebhook Environment
env InputWebhook
_adHandler
  let webhookEnvRecord :: EnvRecord ResolvedWebhook
webhookEnvRecord = Text -> ResolvedWebhook -> EnvRecord ResolvedWebhook
forall a. Text -> a -> EnvRecord a
EnvRecord (Template -> Text
printTemplate (Template -> Text) -> Template -> Text
forall a b. (a -> b) -> a -> b
$ InputWebhook -> Template
unInputWebhook InputWebhook
_adHandler) ResolvedWebhook
resolvedWebhook
  (ResolvedActionDefinition, AnnotatedOutputType)
-> m (ResolvedActionDefinition, AnnotatedOutputType)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( [ArgumentDefinition (GType, AnnotatedInputType)]
-> GraphQLType
-> ActionType
-> [HeaderConf]
-> Bool
-> Timeout
-> EnvRecord ResolvedWebhook
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> ResolvedActionDefinition
forall arg webhook.
[ArgumentDefinition arg]
-> GraphQLType
-> ActionType
-> [HeaderConf]
-> Bool
-> Timeout
-> webhook
-> Maybe RequestTransform
-> Maybe MetadataResponseTransform
-> ActionDefinition arg webhook
ActionDefinition
        [ArgumentDefinition (GType, AnnotatedInputType)]
resolvedArguments
        GraphQLType
_adOutputType
        ActionType
_adType
        [HeaderConf]
_adHeaders
        Bool
_adForwardClientHeaders
        Timeout
_adTimeout
        EnvRecord ResolvedWebhook
webhookEnvRecord
        Maybe RequestTransform
_adRequestTransform
        Maybe MetadataResponseTransform
_adResponseTransform,
      AnnotatedOutputType
outputObject
    )

data UpdateAction = UpdateAction
  { UpdateAction -> ActionName
_uaName :: ActionName,
    UpdateAction -> ActionDefinitionInput
_uaDefinition :: ActionDefinitionInput,
    UpdateAction -> Maybe Text
_uaComment :: Maybe Text
  }
  deriving stock ((forall x. UpdateAction -> Rep UpdateAction x)
-> (forall x. Rep UpdateAction x -> UpdateAction)
-> Generic UpdateAction
forall x. Rep UpdateAction x -> UpdateAction
forall x. UpdateAction -> Rep UpdateAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateAction -> Rep UpdateAction x
from :: forall x. UpdateAction -> Rep UpdateAction x
$cto :: forall x. Rep UpdateAction x -> UpdateAction
to :: forall x. Rep UpdateAction x -> UpdateAction
Generic)

instance J.FromJSON UpdateAction where
  parseJSON :: Value -> Parser UpdateAction
parseJSON = Options -> Value -> Parser UpdateAction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON

runUpdateAction ::
  forall m.
  (QErrM m, CacheRWM m, MetadataM m) =>
  UpdateAction ->
  m EncJSON
runUpdateAction :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
UpdateAction -> m EncJSON
runUpdateAction (UpdateAction ActionName
actionName ActionDefinitionInput
actionDefinition Maybe Text
actionComment) = do
  SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  let actionsMap :: ActionCache
actionsMap = SchemaCache -> ActionCache
scActions SchemaCache
sc
  m ActionInfo -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (m ActionInfo -> m ()) -> m ActionInfo -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe ActionInfo -> m ActionInfo -> m ActionInfo
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (ActionName -> ActionCache -> Maybe ActionInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ActionName
actionName ActionCache
actionsMap)
    (m ActionInfo -> m ActionInfo) -> m ActionInfo -> m ActionInfo
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ActionInfo
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m ActionInfo) -> Text -> m ActionInfo
forall a b. (a -> b) -> a -> b
$ Text
"action with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ActionName
actionName
    ActionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (ActionName -> MetadataObjId
MOAction ActionName
actionName) (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ ActionDefinitionInput -> Maybe Text -> MetadataModifier
updateActionMetadataModifier ActionDefinitionInput
actionDefinition Maybe Text
actionComment
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    updateActionMetadataModifier :: ActionDefinitionInput -> Maybe Text -> MetadataModifier
    updateActionMetadataModifier :: ActionDefinitionInput -> Maybe Text -> MetadataModifier
updateActionMetadataModifier ActionDefinitionInput
def Maybe Text
comment =
      (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
        ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ ((Actions -> Identity Actions) -> Metadata -> Identity Metadata
Lens' Metadata Actions
metaActions ((Actions -> Identity Actions) -> Metadata -> Identity Metadata)
-> ((ActionDefinitionInput -> Identity ActionDefinitionInput)
    -> Actions -> Identity Actions)
-> (ActionDefinitionInput -> Identity ActionDefinitionInput)
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Actions -> Traversal' Actions (IxValue Actions)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Actions
ActionName
actionName ((ActionMetadata -> Identity ActionMetadata)
 -> Actions -> Identity Actions)
-> ((ActionDefinitionInput -> Identity ActionDefinitionInput)
    -> ActionMetadata -> Identity ActionMetadata)
-> (ActionDefinitionInput -> Identity ActionDefinitionInput)
-> Actions
-> Identity Actions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActionDefinitionInput -> Identity ActionDefinitionInput)
-> ActionMetadata -> Identity ActionMetadata
Lens' ActionMetadata ActionDefinitionInput
amDefinition ((ActionDefinitionInput -> Identity ActionDefinitionInput)
 -> Metadata -> Identity Metadata)
-> ActionDefinitionInput -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ActionDefinitionInput
def)
        (Metadata -> Metadata)
-> (Metadata -> Metadata) -> Metadata -> Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Actions -> Identity Actions) -> Metadata -> Identity Metadata
Lens' Metadata Actions
metaActions ((Actions -> Identity Actions) -> Metadata -> Identity Metadata)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Actions -> Identity Actions)
-> (Maybe Text -> Identity (Maybe Text))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Actions -> Traversal' Actions (IxValue Actions)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Actions
ActionName
actionName ((ActionMetadata -> Identity ActionMetadata)
 -> Actions -> Identity Actions)
-> ((Maybe Text -> Identity (Maybe Text))
    -> ActionMetadata -> Identity ActionMetadata)
-> (Maybe Text -> Identity (Maybe Text))
-> Actions
-> Identity Actions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> ActionMetadata -> Identity ActionMetadata
Lens' ActionMetadata (Maybe Text)
amComment ((Maybe Text -> Identity (Maybe Text))
 -> Metadata -> Identity Metadata)
-> Maybe Text -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
comment)

newtype ClearActionData = ClearActionData {ClearActionData -> Bool
unClearActionData :: Bool}
  deriving (Int -> ClearActionData -> ShowS
[ClearActionData] -> ShowS
ClearActionData -> String
(Int -> ClearActionData -> ShowS)
-> (ClearActionData -> String)
-> ([ClearActionData] -> ShowS)
-> Show ClearActionData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClearActionData -> ShowS
showsPrec :: Int -> ClearActionData -> ShowS
$cshow :: ClearActionData -> String
show :: ClearActionData -> String
$cshowList :: [ClearActionData] -> ShowS
showList :: [ClearActionData] -> ShowS
Show, ClearActionData -> ClearActionData -> Bool
(ClearActionData -> ClearActionData -> Bool)
-> (ClearActionData -> ClearActionData -> Bool)
-> Eq ClearActionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClearActionData -> ClearActionData -> Bool
== :: ClearActionData -> ClearActionData -> Bool
$c/= :: ClearActionData -> ClearActionData -> Bool
/= :: ClearActionData -> ClearActionData -> Bool
Eq, Value -> Parser [ClearActionData]
Value -> Parser ClearActionData
(Value -> Parser ClearActionData)
-> (Value -> Parser [ClearActionData]) -> FromJSON ClearActionData
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ClearActionData
parseJSON :: Value -> Parser ClearActionData
$cparseJSONList :: Value -> Parser [ClearActionData]
parseJSONList :: Value -> Parser [ClearActionData]
J.FromJSON, [ClearActionData] -> Value
[ClearActionData] -> Encoding
ClearActionData -> Value
ClearActionData -> Encoding
(ClearActionData -> Value)
-> (ClearActionData -> Encoding)
-> ([ClearActionData] -> Value)
-> ([ClearActionData] -> Encoding)
-> ToJSON ClearActionData
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ClearActionData -> Value
toJSON :: ClearActionData -> Value
$ctoEncoding :: ClearActionData -> Encoding
toEncoding :: ClearActionData -> Encoding
$ctoJSONList :: [ClearActionData] -> Value
toJSONList :: [ClearActionData] -> Value
$ctoEncodingList :: [ClearActionData] -> Encoding
toEncodingList :: [ClearActionData] -> Encoding
J.ToJSON)

shouldClearActionData :: ClearActionData -> Bool
shouldClearActionData :: ClearActionData -> Bool
shouldClearActionData = ClearActionData -> Bool
unClearActionData

defaultClearActionData :: ClearActionData
defaultClearActionData :: ClearActionData
defaultClearActionData = Bool -> ClearActionData
ClearActionData Bool
True

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

instance J.FromJSON DropAction where
  parseJSON :: Value -> Parser DropAction
parseJSON = Options -> Value -> Parser DropAction
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON

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

runDropAction ::
  ( MonadError QErr m,
    CacheRWM m,
    MetadataM m,
    MonadMetadataStorage m
  ) =>
  DropAction ->
  m EncJSON
runDropAction :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m,
 MonadMetadataStorage m) =>
DropAction -> m EncJSON
runDropAction (DropAction ActionName
actionName Maybe ClearActionData
clearDataM) = do
  m ActionInfo -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ActionInfo -> m ()) -> m ActionInfo -> m ()
forall a b. (a -> b) -> a -> b
$ ActionName -> m ActionInfo
forall (m :: * -> *).
(QErrM m, CacheRM m) =>
ActionName -> m ActionInfo
getActionInfo ActionName
actionName
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ ActionName -> MetadataModifier
dropActionInMetadata ActionName
actionName
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClearActionData -> Bool
shouldClearActionData ClearActionData
clearData) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$ ActionName -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName -> m (Either QErr ())
deleteActionData ActionName
actionName
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg
  where
    -- When clearData is not present we assume that
    -- the data needs to be retained
    clearData :: ClearActionData
clearData = ClearActionData -> Maybe ClearActionData -> ClearActionData
forall a. a -> Maybe a -> a
fromMaybe ClearActionData
defaultClearActionData Maybe ClearActionData
clearDataM

dropActionInMetadata :: ActionName -> MetadataModifier
dropActionInMetadata :: ActionName -> MetadataModifier
dropActionInMetadata ActionName
name =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Actions -> Identity Actions) -> Metadata -> Identity Metadata
Lens' Metadata Actions
metaActions ((Actions -> Identity Actions) -> Metadata -> Identity Metadata)
-> (Actions -> Actions) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ActionName -> Actions -> Actions
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete ActionName
name

newtype ActionMetadataField = ActionMetadataField {ActionMetadataField -> Text
unActionMetadataField :: Text}
  deriving (Int -> ActionMetadataField -> ShowS
[ActionMetadataField] -> ShowS
ActionMetadataField -> String
(Int -> ActionMetadataField -> ShowS)
-> (ActionMetadataField -> String)
-> ([ActionMetadataField] -> ShowS)
-> Show ActionMetadataField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionMetadataField -> ShowS
showsPrec :: Int -> ActionMetadataField -> ShowS
$cshow :: ActionMetadataField -> String
show :: ActionMetadataField -> String
$cshowList :: [ActionMetadataField] -> ShowS
showList :: [ActionMetadataField] -> ShowS
Show, ActionMetadataField -> ActionMetadataField -> Bool
(ActionMetadataField -> ActionMetadataField -> Bool)
-> (ActionMetadataField -> ActionMetadataField -> Bool)
-> Eq ActionMetadataField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionMetadataField -> ActionMetadataField -> Bool
== :: ActionMetadataField -> ActionMetadataField -> Bool
$c/= :: ActionMetadataField -> ActionMetadataField -> Bool
/= :: ActionMetadataField -> ActionMetadataField -> Bool
Eq, Value -> Parser [ActionMetadataField]
Value -> Parser ActionMetadataField
(Value -> Parser ActionMetadataField)
-> (Value -> Parser [ActionMetadataField])
-> FromJSON ActionMetadataField
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ActionMetadataField
parseJSON :: Value -> Parser ActionMetadataField
$cparseJSONList :: Value -> Parser [ActionMetadataField]
parseJSONList :: Value -> Parser [ActionMetadataField]
J.FromJSON, [ActionMetadataField] -> Value
[ActionMetadataField] -> Encoding
ActionMetadataField -> Value
ActionMetadataField -> Encoding
(ActionMetadataField -> Value)
-> (ActionMetadataField -> Encoding)
-> ([ActionMetadataField] -> Value)
-> ([ActionMetadataField] -> Encoding)
-> ToJSON ActionMetadataField
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ActionMetadataField -> Value
toJSON :: ActionMetadataField -> Value
$ctoEncoding :: ActionMetadataField -> Encoding
toEncoding :: ActionMetadataField -> Encoding
$ctoJSONList :: [ActionMetadataField] -> Value
toJSONList :: [ActionMetadataField] -> Value
$ctoEncodingList :: [ActionMetadataField] -> Encoding
toEncodingList :: [ActionMetadataField] -> Encoding
J.ToJSON)

doesActionPermissionExist :: Metadata -> ActionName -> RoleName -> Bool
doesActionPermissionExist :: Metadata -> ActionName -> RoleName -> Bool
doesActionPermissionExist Metadata
metadata ActionName
actionName RoleName
roleName =
  (ActionPermissionMetadata -> Bool)
-> [ActionPermissionMetadata] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
roleName) (RoleName -> Bool)
-> (ActionPermissionMetadata -> RoleName)
-> ActionPermissionMetadata
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionPermissionMetadata -> RoleName
_apmRole) ([ActionPermissionMetadata] -> Bool)
-> [ActionPermissionMetadata] -> Bool
forall a b. (a -> b) -> a -> b
$ Metadata
metadata Metadata
-> Getting
     [ActionPermissionMetadata] Metadata [ActionPermissionMetadata]
-> [ActionPermissionMetadata]
forall s a. s -> Getting a s a -> a
^. ((Actions -> Const [ActionPermissionMetadata] Actions)
-> Metadata -> Const [ActionPermissionMetadata] Metadata
Lens' Metadata Actions
metaActions ((Actions -> Const [ActionPermissionMetadata] Actions)
 -> Metadata -> Const [ActionPermissionMetadata] Metadata)
-> (([ActionPermissionMetadata]
     -> Const [ActionPermissionMetadata] [ActionPermissionMetadata])
    -> Actions -> Const [ActionPermissionMetadata] Actions)
-> Getting
     [ActionPermissionMetadata] Metadata [ActionPermissionMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Actions -> Traversal' Actions (IxValue Actions)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Actions
ActionName
actionName ((ActionMetadata
  -> Const [ActionPermissionMetadata] ActionMetadata)
 -> Actions -> Const [ActionPermissionMetadata] Actions)
-> (([ActionPermissionMetadata]
     -> Const [ActionPermissionMetadata] [ActionPermissionMetadata])
    -> ActionMetadata
    -> Const [ActionPermissionMetadata] ActionMetadata)
-> ([ActionPermissionMetadata]
    -> Const [ActionPermissionMetadata] [ActionPermissionMetadata])
-> Actions
-> Const [ActionPermissionMetadata] Actions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ActionPermissionMetadata]
 -> Const [ActionPermissionMetadata] [ActionPermissionMetadata])
-> ActionMetadata
-> Const [ActionPermissionMetadata] ActionMetadata
Lens' ActionMetadata [ActionPermissionMetadata]
amPermissions)

data CreateActionPermission = CreateActionPermission
  { CreateActionPermission -> ActionName
_capAction :: ActionName,
    CreateActionPermission -> RoleName
_capRole :: RoleName,
    CreateActionPermission -> Maybe Value
_capDefinition :: Maybe J.Value,
    CreateActionPermission -> Maybe Text
_capComment :: Maybe Text
  }
  deriving stock ((forall x. CreateActionPermission -> Rep CreateActionPermission x)
-> (forall x.
    Rep CreateActionPermission x -> CreateActionPermission)
-> Generic CreateActionPermission
forall x. Rep CreateActionPermission x -> CreateActionPermission
forall x. CreateActionPermission -> Rep CreateActionPermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateActionPermission -> Rep CreateActionPermission x
from :: forall x. CreateActionPermission -> Rep CreateActionPermission x
$cto :: forall x. Rep CreateActionPermission x -> CreateActionPermission
to :: forall x. Rep CreateActionPermission x -> CreateActionPermission
Generic)

instance J.FromJSON CreateActionPermission where
  parseJSON :: Value -> Parser CreateActionPermission
parseJSON = Options -> Value -> Parser CreateActionPermission
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON

runCreateActionPermission ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  CreateActionPermission ->
  m EncJSON
runCreateActionPermission :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
CreateActionPermission -> m EncJSON
runCreateActionPermission CreateActionPermission
createActionPermission = do
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Metadata -> ActionName -> RoleName -> Bool
doesActionPermissionExist Metadata
metadata ActionName
actionName RoleName
roleName)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"permission for role "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName
    RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is already defined on "
    Text -> ActionName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> ActionName
actionName
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (ActionName -> RoleName -> MetadataObjId
MOActionPermission ActionName
actionName RoleName
roleName)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Actions -> Identity Actions) -> Metadata -> Identity Metadata
Lens' Metadata Actions
metaActions
    ((Actions -> Identity Actions) -> Metadata -> Identity Metadata)
-> (([ActionPermissionMetadata]
     -> Identity [ActionPermissionMetadata])
    -> Actions -> Identity Actions)
-> ([ActionPermissionMetadata]
    -> Identity [ActionPermissionMetadata])
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Actions -> Traversal' Actions (IxValue Actions)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Actions
ActionName
actionName
    ((ActionMetadata -> Identity ActionMetadata)
 -> Actions -> Identity Actions)
-> (([ActionPermissionMetadata]
     -> Identity [ActionPermissionMetadata])
    -> ActionMetadata -> Identity ActionMetadata)
-> ([ActionPermissionMetadata]
    -> Identity [ActionPermissionMetadata])
-> Actions
-> Identity Actions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ActionPermissionMetadata] -> Identity [ActionPermissionMetadata])
-> ActionMetadata -> Identity ActionMetadata
Lens' ActionMetadata [ActionPermissionMetadata]
amPermissions
    (([ActionPermissionMetadata]
  -> Identity [ActionPermissionMetadata])
 -> Metadata -> Identity Metadata)
-> ([ActionPermissionMetadata] -> [ActionPermissionMetadata])
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (:) (RoleName -> Maybe Text -> ActionPermissionMetadata
ActionPermissionMetadata RoleName
roleName Maybe Text
comment)
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    CreateActionPermission ActionName
actionName RoleName
roleName Maybe Value
_ Maybe Text
comment = CreateActionPermission
createActionPermission

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

instance J.FromJSON DropActionPermission where
  parseJSON :: Value -> Parser DropActionPermission
parseJSON = Options -> Value -> Parser DropActionPermission
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
J.genericParseJSON Options
hasuraJSON

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

runDropActionPermission ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  DropActionPermission ->
  m EncJSON
runDropActionPermission :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
DropActionPermission -> m EncJSON
runDropActionPermission DropActionPermission
dropActionPermission = do
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Metadata -> ActionName -> RoleName -> Bool
doesActionPermissionExist Metadata
metadata ActionName
actionName RoleName
roleName)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"permission for role: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName
    RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not defined on "
    Text -> ActionName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> ActionName
actionName
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (ActionName -> RoleName -> MetadataObjId
MOActionPermission ActionName
actionName RoleName
roleName)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ ActionName -> RoleName -> MetadataModifier
dropActionPermissionInMetadata ActionName
actionName RoleName
roleName
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg
  where
    actionName :: ActionName
actionName = DropActionPermission -> ActionName
_dapAction DropActionPermission
dropActionPermission
    roleName :: RoleName
roleName = DropActionPermission -> RoleName
_dapRole DropActionPermission
dropActionPermission

dropActionPermissionInMetadata :: ActionName -> RoleName -> MetadataModifier
dropActionPermissionInMetadata :: ActionName -> RoleName -> MetadataModifier
dropActionPermissionInMetadata ActionName
name RoleName
role =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Actions -> Identity Actions) -> Metadata -> Identity Metadata
Lens' Metadata Actions
metaActions
    ((Actions -> Identity Actions) -> Metadata -> Identity Metadata)
-> (([ActionPermissionMetadata]
     -> Identity [ActionPermissionMetadata])
    -> Actions -> Identity Actions)
-> ([ActionPermissionMetadata]
    -> Identity [ActionPermissionMetadata])
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Actions -> Traversal' Actions (IxValue Actions)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Actions
ActionName
name
    ((ActionMetadata -> Identity ActionMetadata)
 -> Actions -> Identity Actions)
-> (([ActionPermissionMetadata]
     -> Identity [ActionPermissionMetadata])
    -> ActionMetadata -> Identity ActionMetadata)
-> ([ActionPermissionMetadata]
    -> Identity [ActionPermissionMetadata])
-> Actions
-> Identity Actions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ActionPermissionMetadata] -> Identity [ActionPermissionMetadata])
-> ActionMetadata -> Identity ActionMetadata
Lens' ActionMetadata [ActionPermissionMetadata]
amPermissions
    (([ActionPermissionMetadata]
  -> Identity [ActionPermissionMetadata])
 -> Metadata -> Identity Metadata)
-> ([ActionPermissionMetadata] -> [ActionPermissionMetadata])
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (ActionPermissionMetadata -> Bool)
-> [ActionPermissionMetadata] -> [ActionPermissionMetadata]
forall a. (a -> Bool) -> [a] -> [a]
filter (RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
(/=) RoleName
role (RoleName -> Bool)
-> (ActionPermissionMetadata -> RoleName)
-> ActionPermissionMetadata
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionPermissionMetadata -> RoleName
_apmRole)