mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 09:51:59 +03:00
280 lines
9.5 KiB
Haskell
280 lines
9.5 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
module Hasura.RQL.DDL.Action
|
|
( CreateAction
|
|
, runCreateAction
|
|
, persistCreateAction
|
|
, resolveAction
|
|
|
|
, UpdateAction
|
|
, runUpdateAction
|
|
|
|
, DropAction
|
|
, runDropAction
|
|
, deleteActionFromCatalog
|
|
|
|
, fetchActions
|
|
|
|
, CreateActionPermission
|
|
, runCreateActionPermission
|
|
, persistCreateActionPermission
|
|
|
|
, DropActionPermission
|
|
, runDropActionPermission
|
|
, deleteActionPermissionFromCatalog
|
|
) where
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Aeson.Casing as J
|
|
import qualified Data.Aeson.TH as J
|
|
import qualified Data.Environment as Env
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Database.PG.Query as Q
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
import Language.Haskell.TH.Syntax (Lift)
|
|
|
|
import Data.Text.Extended
|
|
import Hasura.EncJSON
|
|
import Hasura.GraphQL.Utils
|
|
import Hasura.RQL.DDL.CustomTypes (lookupPGScalar)
|
|
import Hasura.RQL.Types
|
|
import Hasura.SQL.Types
|
|
import Hasura.Session
|
|
|
|
|
|
getActionInfo
|
|
:: (QErrM m, CacheRM m)
|
|
=> ActionName -> m ActionInfo
|
|
getActionInfo actionName = do
|
|
actionMap <- scActions <$> askSchemaCache
|
|
case Map.lookup actionName actionMap of
|
|
Just actionInfo -> return actionInfo
|
|
Nothing ->
|
|
throw400 NotExists $
|
|
"action with name " <> actionName <<> " does not exist"
|
|
|
|
runCreateAction
|
|
:: (QErrM m , CacheRWM m, MonadTx m)
|
|
=> CreateAction -> m EncJSON
|
|
runCreateAction createAction = do
|
|
-- check if action with same name exists already
|
|
actionMap <- scActions <$> askSchemaCache
|
|
void $ onJust (Map.lookup actionName actionMap) $ const $
|
|
throw400 AlreadyExists $
|
|
"action with name " <> actionName <<> " already exists"
|
|
persistCreateAction createAction
|
|
buildSchemaCacheFor $ MOAction actionName
|
|
pure successMsg
|
|
where
|
|
actionName = _caName createAction
|
|
|
|
persistCreateAction :: (MonadTx m) => CreateAction -> m ()
|
|
persistCreateAction (CreateAction actionName actionDefinition comment) = do
|
|
liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql|
|
|
INSERT into hdb_catalog.hdb_action
|
|
(action_name, action_defn, comment)
|
|
VALUES ($1, $2, $3)
|
|
|] (actionName, Q.AltJ actionDefinition, comment) True
|
|
|
|
{-| 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
|
|
-> HashSet PGScalarType -- See Note [Postgres scalars in custom types]
|
|
-> m ( ResolvedActionDefinition
|
|
, AnnotatedObjectType
|
|
)
|
|
resolveAction env AnnotatedCustomTypes{..} ActionDefinition{..} allPGScalars = do
|
|
resolvedArguments <- forM _adArguments $ \argumentDefinition -> do
|
|
forM argumentDefinition $ \argumentType -> do
|
|
let gType = unGraphQLType argumentType
|
|
argumentBaseType = G.getBaseType gType
|
|
(gType,) <$>
|
|
if | Just pgScalar <- lookupPGScalar allPGScalars argumentBaseType ->
|
|
pure $ NOCTScalar $ ASTReusedPgScalar argumentBaseType pgScalar
|
|
| Just nonObjectType <- Map.lookup argumentBaseType _actNonObjects ->
|
|
pure nonObjectType
|
|
| otherwise ->
|
|
throw400 InvalidParams $
|
|
"the type: " <> showName argumentBaseType
|
|
<> " 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 = unGraphQLType _adOutputType
|
|
outputBaseType = G.getBaseType outputType
|
|
outputObject <- onNothing (Map.lookup outputBaseType _actObjects) $
|
|
throw400 NotExists $ "the type: " <> showName outputBaseType
|
|
<> " is not an object type defined in custom types"
|
|
resolvedWebhook <- resolveWebhook env _adHandler
|
|
pure ( ActionDefinition resolvedArguments _adOutputType _adType
|
|
_adHeaders _adForwardClientHeaders _adTimeout resolvedWebhook
|
|
, outputObject
|
|
)
|
|
|
|
runUpdateAction
|
|
:: forall m. ( QErrM m , CacheRWM m, MonadTx m)
|
|
=> UpdateAction -> m EncJSON
|
|
runUpdateAction (UpdateAction actionName actionDefinition) = do
|
|
sc <- askSchemaCache
|
|
let actionsMap = scActions sc
|
|
void $ onNothing (Map.lookup actionName actionsMap) $
|
|
throw400 NotExists $ "action with name " <> actionName <<> " not exists"
|
|
updateActionInCatalog
|
|
buildSchemaCacheFor $ MOAction actionName
|
|
pure successMsg
|
|
where
|
|
updateActionInCatalog :: m ()
|
|
updateActionInCatalog =
|
|
liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql|
|
|
UPDATE hdb_catalog.hdb_action
|
|
SET action_defn = $2
|
|
WHERE action_name = $1
|
|
|] (actionName, Q.AltJ actionDefinition) True
|
|
|
|
newtype ClearActionData
|
|
= ClearActionData { unClearActionData :: Bool }
|
|
deriving (Show, Eq, Lift, J.FromJSON, J.ToJSON)
|
|
|
|
shouldClearActionData :: ClearActionData -> Bool
|
|
shouldClearActionData = unClearActionData
|
|
|
|
defaultClearActionData :: ClearActionData
|
|
defaultClearActionData = ClearActionData True
|
|
|
|
data DropAction
|
|
= DropAction
|
|
{ _daName :: !ActionName
|
|
, _daClearData :: !(Maybe ClearActionData)
|
|
} deriving (Show, Eq, Lift)
|
|
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''DropAction)
|
|
|
|
runDropAction
|
|
:: (QErrM m, CacheRWM m, MonadTx m)
|
|
=> DropAction -> m EncJSON
|
|
runDropAction (DropAction actionName clearDataM)= do
|
|
void $ getActionInfo actionName
|
|
liftTx $ do
|
|
deleteActionPermissionsFromCatalog
|
|
deleteActionFromCatalog actionName clearDataM
|
|
buildSchemaCacheStrict
|
|
return successMsg
|
|
where
|
|
deleteActionPermissionsFromCatalog =
|
|
Q.unitQE defaultTxErrorHandler [Q.sql|
|
|
DELETE FROM hdb_catalog.hdb_action_permission
|
|
WHERE action_name = $1
|
|
|] (Identity actionName) True
|
|
|
|
deleteActionFromCatalog
|
|
:: ActionName
|
|
-> Maybe ClearActionData
|
|
-> Q.TxE QErr ()
|
|
deleteActionFromCatalog actionName clearDataM = do
|
|
Q.unitQE defaultTxErrorHandler [Q.sql|
|
|
DELETE FROM hdb_catalog.hdb_action
|
|
WHERE action_name = $1
|
|
|] (Identity actionName) True
|
|
when (shouldClearActionData clearData) $
|
|
clearActionDataFromCatalog actionName
|
|
where
|
|
-- When clearData is not present we assume that
|
|
-- the data needs to be retained
|
|
clearData = fromMaybe defaultClearActionData clearDataM
|
|
|
|
clearActionDataFromCatalog :: ActionName -> Q.TxE QErr ()
|
|
clearActionDataFromCatalog actionName =
|
|
Q.unitQE defaultTxErrorHandler [Q.sql|
|
|
DELETE FROM hdb_catalog.hdb_action_log
|
|
WHERE action_name = $1
|
|
|] (Identity actionName) True
|
|
|
|
fetchActions :: Q.TxE QErr [CreateAction]
|
|
fetchActions =
|
|
map fromRow <$> Q.listQE defaultTxErrorHandler
|
|
[Q.sql|
|
|
SELECT action_name, action_defn, comment
|
|
FROM hdb_catalog.hdb_action
|
|
ORDER BY action_name ASC
|
|
|] () True
|
|
where
|
|
fromRow (actionName, Q.AltJ definition, comment) =
|
|
CreateAction actionName definition comment
|
|
|
|
newtype ActionMetadataField
|
|
= ActionMetadataField { unActionMetadataField :: Text }
|
|
deriving (Show, Eq, J.FromJSON, J.ToJSON)
|
|
|
|
runCreateActionPermission
|
|
:: (QErrM m , CacheRWM m, MonadTx m)
|
|
=> CreateActionPermission -> m EncJSON
|
|
runCreateActionPermission createActionPermission = do
|
|
actionInfo <- getActionInfo actionName
|
|
void $ onJust (Map.lookup roleName $ _aiPermissions actionInfo) $ const $
|
|
throw400 AlreadyExists $ "permission for role " <> roleName
|
|
<<> " is already defined on " <>> actionName
|
|
persistCreateActionPermission createActionPermission
|
|
buildSchemaCacheFor $ MOActionPermission actionName roleName
|
|
pure successMsg
|
|
where
|
|
actionName = _capAction createActionPermission
|
|
roleName = _capRole createActionPermission
|
|
|
|
persistCreateActionPermission :: (MonadTx m) => CreateActionPermission -> m ()
|
|
persistCreateActionPermission CreateActionPermission{..}= do
|
|
liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql|
|
|
INSERT into hdb_catalog.hdb_action_permission
|
|
(action_name, role_name, comment)
|
|
VALUES ($1, $2, $3)
|
|
|] (_capAction, _capRole, _capComment) True
|
|
|
|
data DropActionPermission
|
|
= DropActionPermission
|
|
{ _dapAction :: !ActionName
|
|
, _dapRole :: !RoleName
|
|
} deriving (Show, Eq, Lift)
|
|
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''DropActionPermission)
|
|
|
|
runDropActionPermission
|
|
:: (QErrM m, CacheRWM m, MonadTx m)
|
|
=> DropActionPermission -> m EncJSON
|
|
runDropActionPermission dropActionPermission = do
|
|
actionInfo <- getActionInfo actionName
|
|
void $ onNothing (Map.lookup roleName $ _aiPermissions actionInfo) $
|
|
throw400 NotExists $
|
|
"permission for role: " <> roleName <<> " is not defined on " <>> actionName
|
|
liftTx $ deleteActionPermissionFromCatalog actionName roleName
|
|
buildSchemaCacheFor $ MOActionPermission actionName roleName
|
|
return successMsg
|
|
where
|
|
actionName = _dapAction dropActionPermission
|
|
roleName = _dapRole dropActionPermission
|
|
|
|
deleteActionPermissionFromCatalog :: ActionName -> RoleName -> Q.TxE QErr ()
|
|
deleteActionPermissionFromCatalog actionName role =
|
|
Q.unitQE defaultTxErrorHandler [Q.sql|
|
|
DELETE FROM hdb_catalog.hdb_action_permission
|
|
WHERE action_name = $1
|
|
AND role_name = $2
|
|
|] (actionName, role) True
|