{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.DDL.Action
  ( CreateAction (..),
    runCreateAction,
    resolveAction,
    UpdateAction,
    runUpdateAction,
    DropAction,
    runDropAction,
    dropActionInMetadata,
    CreateActionPermission (..),
    runCreateActionPermission,
    DropActionPermission,
    runDropActionPermission,
    dropActionPermissionInMetadata,
    caName,
    caDefinition,
    caComment,
    uaName,
    uaDefinition,
    uaComment,
  )
where

import Control.Lens (makeLenses, (.~), (^.))
import Data.Aeson qualified as J
import Data.Aeson.TH qualified as J
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.List.NonEmpty qualified as NEList
import Data.Text.Extended
import Data.URL.Template (printURLTemplate)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.RQL.DDL.CustomTypes (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.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.Source
import Hasura.SQL.BackendMap (BackendMap)
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G

getActionInfo ::
  (QErrM m, CacheRM m) =>
  ActionName ->
  m ActionInfo
getActionInfo :: 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
Map.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
  }

$(makeLenses ''CreateAction)

$(J.deriveJSON hasuraJSON ''CreateAction)

runCreateAction ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  CreateAction ->
  m EncJSON
runCreateAction :: 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
  m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Maybe ActionInfo -> (ActionInfo -> m ()) -> m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
onJust (ActionName -> ActionCache -> Maybe ActionInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup ActionName
actionName ActionCache
actionMap) ((ActionInfo -> m ()) -> m ()) -> (ActionInfo -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
      m () -> ActionInfo -> m ()
forall a b. a -> b -> a
const (m () -> ActionInfo -> m ()) -> m () -> ActionInfo -> 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
"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
OMap.insert ActionName
actionName ActionMetadata
metadata
  EncJSON -> m EncJSON
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 ScalarMap -> -- See Note [Postgres scalars in custom types]
  m
    ( ResolvedActionDefinition,
      AnnotatedOutputType
    )
resolveAction :: Environment
-> AnnotatedCustomTypes
-> ActionDefinitionInput
-> BackendMap ScalarMap
-> m (ResolvedActionDefinition, AnnotatedOutputType)
resolveAction Environment
env AnnotatedCustomTypes {HashMap Name AnnotatedObjectType
HashMap Name AnnotatedInputType
_actObjectTypes :: AnnotatedCustomTypes -> HashMap Name AnnotatedObjectType
_actInputTypes :: AnnotatedCustomTypes -> HashMap Name AnnotatedInputType
_actObjectTypes :: HashMap Name AnnotatedObjectType
_actInputTypes :: HashMap Name AnnotatedInputType
..} ActionDefinition {Bool
[HeaderConf]
[ArgumentDefinition GraphQLType]
Maybe MetadataResponseTransform
Maybe RequestTransform
Timeout
InputWebhook
GraphQLType
ActionType
_adResponseTransform :: forall arg webhook.
ActionDefinition arg webhook -> Maybe MetadataResponseTransform
_adRequestTransform :: forall arg webhook.
ActionDefinition arg webhook -> Maybe RequestTransform
_adHandler :: forall arg webhook. ActionDefinition arg webhook -> webhook
_adTimeout :: forall arg webhook. ActionDefinition arg webhook -> Timeout
_adForwardClientHeaders :: forall arg webhook. ActionDefinition arg webhook -> Bool
_adHeaders :: forall arg webhook. ActionDefinition arg webhook -> [HeaderConf]
_adType :: forall arg webhook. ActionDefinition arg webhook -> ActionType
_adOutputType :: forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adArguments :: forall arg webhook.
ActionDefinition arg webhook -> [ArgumentDefinition arg]
_adResponseTransform :: Maybe MetadataResponseTransform
_adRequestTransform :: Maybe RequestTransform
_adHandler :: InputWebhook
_adTimeout :: Timeout
_adForwardClientHeaders :: Bool
_adHeaders :: [HeaderConf]
_adType :: ActionType
_adOutputType :: GraphQLType
_adArguments :: [ArgumentDefinition GraphQLType]
..} BackendMap ScalarMap
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 ScalarMap -> Name -> Maybe AnnotatedScalarType
lookupBackendScalar BackendMap ScalarMap
allScalars Name
argumentBaseType ->
              AnnotatedInputType -> m AnnotatedInputType
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
Map.lookup Name
argumentBaseType HashMap Name AnnotatedInputType
_actInputTypes ->
              AnnotatedInputType -> m AnnotatedInputType
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 ScalarMap -> Name -> Maybe AnnotatedScalarType
lookupBackendScalar BackendMap ScalarMap
allScalars Name
outputBaseType ->
            AnnotatedOutputType -> m AnnotatedOutputType
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
Map.lookup Name
outputBaseType HashMap Name AnnotatedObjectType
_actObjectTypes ->
            AnnotatedOutputType -> m AnnotatedOutputType
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
Map.lookup Name
outputBaseType HashMap Name AnnotatedInputType
_actInputTypes ->
            AnnotatedOutputType -> m AnnotatedOutputType
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
_ofdType :: forall field. ObjectFieldDefinition field -> field
_ofdDescription :: forall field. ObjectFieldDefinition field -> Maybe Description
_ofdArguments :: forall field. ObjectFieldDefinition field -> Maybe Value
_ofdName :: forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdType :: (GType, AnnotatedObjectFieldType)
_ofdDescription :: Maybe Description
_ofdArguments :: Maybe Value
_ofdName :: ObjectFieldName
..} ->
                  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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ObjectFieldDefinition {Maybe Value
Maybe Description
(GType, AnnotatedObjectFieldType)
ObjectFieldName
_ofdType :: (GType, AnnotatedObjectFieldType)
_ofdDescription :: Maybe Description
_ofdArguments :: Maybe Value
_ofdName :: ObjectFieldName
_ofdType :: forall field. ObjectFieldDefinition field -> field
_ofdDescription :: forall field. ObjectFieldDefinition field -> Maybe Description
_ofdArguments :: forall field. ObjectFieldDefinition field -> Maybe Value
_ofdName :: forall field. ObjectFieldDefinition field -> ObjectFieldName
..} -> 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)
SourceTypeCustomization
TableInfo ('Postgres 'Vanilla)
RelationshipName
_atrFieldMapping :: AnnotatedTypeRelationship
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrTableInfo :: AnnotatedTypeRelationship -> TableInfo ('Postgres 'Vanilla)
_atrSourceCustomization :: AnnotatedTypeRelationship -> SourceTypeCustomization
_atrSourceConfig :: AnnotatedTypeRelationship -> SourceConfig ('Postgres 'Vanilla)
_atrSource :: AnnotatedTypeRelationship -> SourceName
_atrType :: AnnotatedTypeRelationship -> RelType
_atrName :: AnnotatedTypeRelationship -> RelationshipName
_atrFieldMapping :: HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrTableInfo :: TableInfo ('Postgres 'Vanilla)
_atrSourceCustomization :: SourceTypeCustomization
_atrSourceConfig :: SourceConfig ('Postgres 'Vanilla)
_atrSource :: SourceName
_atrType :: RelType
_atrName :: RelationshipName
..} ->
                        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]
Map.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 (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 (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 (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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
null (AnnotatedObjectType -> [AnnotatedTypeRelationship]
_aotRelationships AnnotatedObjectType
aot') Bool -> Bool -> Bool
|| [ObjectFieldDefinition (GType, AnnotatedObjectFieldType)] -> 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 (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 (URLTemplate -> Text
printURLTemplate (URLTemplate -> Text) -> URLTemplate -> Text
forall a b. (a -> b) -> a -> b
$ InputWebhook -> URLTemplate
unInputWebhook InputWebhook
_adHandler) ResolvedWebhook
resolvedWebhook
  (ResolvedActionDefinition, AnnotatedOutputType)
-> m (ResolvedActionDefinition, AnnotatedOutputType)
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
  }

$(makeLenses ''UpdateAction)
$(J.deriveFromJSON hasuraJSON ''UpdateAction)

runUpdateAction ::
  forall m.
  (QErrM m, CacheRWM m, MetadataM m) =>
  UpdateAction ->
  m EncJSON
runUpdateAction :: 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
Map.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 (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
showList :: [ClearActionData] -> ShowS
$cshowList :: [ClearActionData] -> ShowS
show :: ClearActionData -> String
$cshow :: ClearActionData -> String
showsPrec :: Int -> ClearActionData -> ShowS
$cshowsPrec :: Int -> ClearActionData -> ShowS
Show, ClearActionData -> ClearActionData -> Bool
(ClearActionData -> ClearActionData -> Bool)
-> (ClearActionData -> ClearActionData -> Bool)
-> Eq ClearActionData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClearActionData -> ClearActionData -> Bool
$c/= :: ClearActionData -> ClearActionData -> Bool
== :: ClearActionData -> ClearActionData -> Bool
$c== :: 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
parseJSONList :: Value -> Parser [ClearActionData]
$cparseJSONList :: Value -> Parser [ClearActionData]
parseJSON :: Value -> Parser ClearActionData
$cparseJSON :: 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
toEncodingList :: [ClearActionData] -> Encoding
$ctoEncodingList :: [ClearActionData] -> Encoding
toJSONList :: [ClearActionData] -> Value
$ctoJSONList :: [ClearActionData] -> Value
toEncoding :: ClearActionData -> Encoding
$ctoEncoding :: ClearActionData -> Encoding
toJSON :: ClearActionData -> Value
$ctoJSON :: ClearActionData -> Value
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
showList :: [DropAction] -> ShowS
$cshowList :: [DropAction] -> ShowS
show :: DropAction -> String
$cshow :: DropAction -> String
showsPrec :: Int -> DropAction -> ShowS
$cshowsPrec :: Int -> DropAction -> ShowS
Show, DropAction -> DropAction -> Bool
(DropAction -> DropAction -> Bool)
-> (DropAction -> DropAction -> Bool) -> Eq DropAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DropAction -> DropAction -> Bool
$c/= :: DropAction -> DropAction -> Bool
== :: DropAction -> DropAction -> Bool
$c== :: DropAction -> DropAction -> Bool
Eq)

$(J.deriveJSON hasuraJSON ''DropAction)

runDropAction ::
  ( CacheRWM m,
    MetadataM m,
    MonadMetadataStorageQueryAPI m
  ) =>
  DropAction ->
  m EncJSON
runDropAction :: 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
$ ActionName -> m ()
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
ActionName -> m ()
deleteActionData ActionName
actionName
  EncJSON -> m EncJSON
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
OMap.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
showList :: [ActionMetadataField] -> ShowS
$cshowList :: [ActionMetadataField] -> ShowS
show :: ActionMetadataField -> String
$cshow :: ActionMetadataField -> String
showsPrec :: Int -> ActionMetadataField -> ShowS
$cshowsPrec :: Int -> ActionMetadataField -> ShowS
Show, ActionMetadataField -> ActionMetadataField -> Bool
(ActionMetadataField -> ActionMetadataField -> Bool)
-> (ActionMetadataField -> ActionMetadataField -> Bool)
-> Eq ActionMetadataField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionMetadataField -> ActionMetadataField -> Bool
$c/= :: ActionMetadataField -> ActionMetadataField -> Bool
== :: ActionMetadataField -> ActionMetadataField -> Bool
$c== :: 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
parseJSONList :: Value -> Parser [ActionMetadataField]
$cparseJSONList :: Value -> Parser [ActionMetadataField]
parseJSON :: Value -> Parser ActionMetadataField
$cparseJSON :: 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
toEncodingList :: [ActionMetadataField] -> Encoding
$ctoEncodingList :: [ActionMetadataField] -> Encoding
toJSONList :: [ActionMetadataField] -> Value
$ctoJSONList :: [ActionMetadataField] -> Value
toEncoding :: ActionMetadataField -> Encoding
$ctoEncoding :: ActionMetadataField -> Encoding
toJSON :: ActionMetadataField -> Value
$ctoJSON :: ActionMetadataField -> Value
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
  }

$(J.deriveFromJSON hasuraJSON ''CreateActionPermission)

runCreateActionPermission ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  CreateActionPermission ->
  m EncJSON
runCreateActionPermission :: 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 (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
showList :: [DropActionPermission] -> ShowS
$cshowList :: [DropActionPermission] -> ShowS
show :: DropActionPermission -> String
$cshow :: DropActionPermission -> String
showsPrec :: Int -> DropActionPermission -> ShowS
$cshowsPrec :: Int -> DropActionPermission -> ShowS
Show, DropActionPermission -> DropActionPermission -> Bool
(DropActionPermission -> DropActionPermission -> Bool)
-> (DropActionPermission -> DropActionPermission -> Bool)
-> Eq DropActionPermission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DropActionPermission -> DropActionPermission -> Bool
$c/= :: DropActionPermission -> DropActionPermission -> Bool
== :: DropActionPermission -> DropActionPermission -> Bool
$c== :: DropActionPermission -> DropActionPermission -> Bool
Eq)

$(J.deriveJSON hasuraJSON ''DropActionPermission)

runDropActionPermission ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  DropActionPermission ->
  m EncJSON
runDropActionPermission :: 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 (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)