mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 18:42:30 +03:00
3c3ed55914
This PR makes a bunch of schema generation code in Hasura.GraphQL.Schema backend-agnostic, by moving the backend-specific parts into a new BackendSchema type class. This way, the schema generation code can be reused for other backends, simply by implementing new instances of the BackendSchema type class. This work is now in a state where the schema generators are sufficiently generic to accept the implementation of a new backend. That means that we can start exposing MS SQL schema. Execution is not implemented yet, of course. The branch currently does not support computed fields or Relay. This is, in a sense, intentional: computed field support is normally baked into the schema generation (through the fieldSelection schema generator), and so this branch shows a programming technique that allows us to expose certain GraphQL schema depending on backend support. We can write support for computed fields and Relay at a later stage. Co-authored-by: Antoine Leblanc <antoine@hasura.io> GitOrigin-RevId: df369fc3d189cbda1b931d31678e9450a6601314
299 lines
12 KiB
Haskell
299 lines
12 KiB
Haskell
{- |
|
|
Description: Add/Drop computed fields in metadata
|
|
-}
|
|
module Hasura.RQL.DDL.ComputedField
|
|
( AddComputedField(..)
|
|
, ComputedFieldDefinition(..)
|
|
, runAddComputedField
|
|
, addComputedFieldP2Setup
|
|
, addComputedFieldToCatalog
|
|
, DropComputedField
|
|
, dropComputedFieldFromCatalog
|
|
, runDropComputedField
|
|
) where
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Control.Monad.Validate as MV
|
|
import qualified Data.HashSet as S
|
|
import qualified Data.Sequence as Seq
|
|
import qualified Database.PG.Query as Q
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
import Data.Aeson
|
|
import Data.Aeson.Casing
|
|
import Data.Aeson.TH
|
|
import Data.Text.Extended
|
|
|
|
import Hasura.Backends.Postgres.SQL.Types
|
|
import Hasura.EncJSON
|
|
import Hasura.Incremental (Cacheable)
|
|
import Hasura.RQL.DDL.Deps
|
|
import Hasura.RQL.DDL.Permission.Internal
|
|
import Hasura.RQL.DDL.Schema.Function (mkFunctionArgs)
|
|
import Hasura.RQL.Types
|
|
import Hasura.SQL.Types
|
|
import Hasura.Server.Utils (makeReasonMessage)
|
|
|
|
|
|
data AddComputedField
|
|
= AddComputedField
|
|
{ _afcTable :: !QualifiedTable
|
|
, _afcName :: !ComputedFieldName
|
|
, _afcDefinition :: !ComputedFieldDefinition
|
|
, _afcComment :: !(Maybe Text)
|
|
} deriving (Show, Eq, Generic)
|
|
instance NFData AddComputedField
|
|
instance Cacheable AddComputedField
|
|
$(deriveJSON (aesonDrop 4 snakeCase) ''AddComputedField)
|
|
|
|
runAddComputedField :: (MonadTx m, CacheRWM m) => AddComputedField -> m EncJSON
|
|
runAddComputedField q = do
|
|
withPathK "table" $ askTabInfo (_afcTable q)
|
|
addComputedFieldToCatalog q
|
|
buildSchemaCacheFor $ MOTableObj (_afcTable q) (MTOComputedField $ _afcName q)
|
|
pure successMsg
|
|
|
|
data ComputedFieldValidateError
|
|
= CFVENotValidGraphQLName !ComputedFieldName
|
|
| CFVEInvalidTableArgument !InvalidTableArgument
|
|
| CFVEInvalidSessionArgument !InvalidSessionArgument
|
|
| CFVENotBaseReturnType !PGScalarType
|
|
| CFVEReturnTableNotFound !QualifiedTable
|
|
| CFVENoInputArguments
|
|
| CFVEFunctionVolatile
|
|
deriving (Show, Eq)
|
|
|
|
data InvalidTableArgument
|
|
= ITANotFound !FunctionArgName
|
|
| ITANotComposite !FunctionTableArgument
|
|
| ITANotTable !QualifiedTable !FunctionTableArgument
|
|
deriving (Show, Eq)
|
|
|
|
data InvalidSessionArgument
|
|
= ISANotFound !FunctionArgName
|
|
| ISANotJSON !FunctionSessionArgument
|
|
deriving (Show, Eq)
|
|
|
|
showError :: QualifiedFunction -> ComputedFieldValidateError -> Text
|
|
showError qf = \case
|
|
CFVENotValidGraphQLName computedField ->
|
|
computedField <<> " is not valid GraphQL name"
|
|
CFVEInvalidTableArgument (ITANotFound argName) ->
|
|
argName <<> " is not an input argument of the function " <>> qf
|
|
CFVEInvalidTableArgument (ITANotComposite functionArg) ->
|
|
showFunctionTableArgument functionArg <> " is not COMPOSITE type"
|
|
CFVEInvalidTableArgument (ITANotTable ty functionArg) ->
|
|
showFunctionTableArgument functionArg <> " of type " <> ty
|
|
<<> " is not the table to which the computed field is being added"
|
|
CFVEInvalidSessionArgument (ISANotFound argName) ->
|
|
argName <<> " is not an input argument of the function " <>> qf
|
|
CFVEInvalidSessionArgument (ISANotJSON functionArg) ->
|
|
showFunctionSessionArgument functionArg <> " is not of type JSON"
|
|
CFVENotBaseReturnType scalarType ->
|
|
"the function " <> qf <<> " returning type " <> toSQLTxt scalarType
|
|
<> " is not a BASE type"
|
|
CFVEReturnTableNotFound table ->
|
|
"the function " <> qf <<> " returning set of table " <> table
|
|
<<> " is not tracked or not found in database"
|
|
CFVENoInputArguments ->
|
|
"the function " <> qf <<> " has no input arguments"
|
|
CFVEFunctionVolatile ->
|
|
"the function " <> qf <<> " is of type VOLATILE; cannot be added as a computed field"
|
|
where
|
|
showFunctionTableArgument = \case
|
|
FTAFirst -> "first argument of the function " <>> qf
|
|
FTANamed argName _ -> argName <<> " argument of the function " <>> qf
|
|
showFunctionSessionArgument = \case
|
|
FunctionSessionArgument argName _ -> argName <<> " argument of the function " <>> qf
|
|
|
|
addComputedFieldP2Setup
|
|
:: (QErrM m)
|
|
=> S.HashSet QualifiedTable
|
|
-- ^ the set of all tracked tables
|
|
-> QualifiedTable
|
|
-> ComputedFieldName
|
|
-> ComputedFieldDefinition
|
|
-> RawFunctionInfo
|
|
-> Maybe Text
|
|
-> m (ComputedFieldInfo 'Postgres)
|
|
addComputedFieldP2Setup trackedTables table computedField definition rawFunctionInfo comment =
|
|
either (throw400 NotSupported . showErrors) pure =<< MV.runValidateT mkComputedFieldInfo
|
|
where
|
|
inputArgNames = rfiInputArgNames rawFunctionInfo
|
|
ComputedFieldDefinition function maybeTableArg maybeSessionArg = definition
|
|
functionReturnType = QualifiedPGType (rfiReturnTypeSchema rawFunctionInfo)
|
|
(rfiReturnTypeName rawFunctionInfo)
|
|
(rfiReturnTypeType rawFunctionInfo)
|
|
|
|
computedFieldGraphQLName = G.mkName $ computedFieldNameToText computedField
|
|
|
|
mkComputedFieldInfo :: (MV.MonadValidate [ComputedFieldValidateError] m)
|
|
=> m (ComputedFieldInfo 'Postgres)
|
|
mkComputedFieldInfo = do
|
|
-- Check if computed field name is a valid GraphQL name
|
|
unless (isJust computedFieldGraphQLName) $
|
|
MV.dispute $ pure $ CFVENotValidGraphQLName computedField
|
|
|
|
-- Check if function is VOLATILE
|
|
when (rfiFunctionType rawFunctionInfo == FTVOLATILE) $
|
|
MV.dispute $ pure CFVEFunctionVolatile
|
|
|
|
-- Validate and resolve return type
|
|
returnType <-
|
|
if rfiReturnsTable rawFunctionInfo then do
|
|
let returnTable = typeToTable functionReturnType
|
|
unless (returnTable `S.member` trackedTables) $ MV.dispute $ pure $
|
|
CFVEReturnTableNotFound returnTable
|
|
pure $ CFRSetofTable returnTable
|
|
else do
|
|
let scalarType = _qptName functionReturnType
|
|
unless (isBaseType functionReturnType) $ MV.dispute $ pure $
|
|
CFVENotBaseReturnType scalarType
|
|
pure $ CFRScalar scalarType
|
|
|
|
-- Validate and resolve table argument
|
|
let inputArgs = mkFunctionArgs (rfiDefaultArgs rawFunctionInfo)
|
|
(rfiInputArgTypes rawFunctionInfo) inputArgNames
|
|
tableArgument <- case maybeTableArg of
|
|
Just argName ->
|
|
case findWithIndex ((Just argName ==) . faName) inputArgs of
|
|
Just (tableArg, index) -> do
|
|
let functionTableArg = FTANamed argName index
|
|
validateTableArgumentType functionTableArg $ faType tableArg
|
|
pure functionTableArg
|
|
Nothing ->
|
|
MV.refute $ pure $ CFVEInvalidTableArgument $ ITANotFound argName
|
|
Nothing -> do
|
|
case inputArgs of
|
|
[] -> MV.dispute $ pure CFVENoInputArguments
|
|
(firstArg:_) ->
|
|
validateTableArgumentType FTAFirst $ faType firstArg
|
|
pure FTAFirst
|
|
|
|
maybePGSessionArg <- sequence $ do
|
|
argName <- maybeSessionArg
|
|
return $ case findWithIndex ((Just argName ==) . faName) inputArgs of
|
|
Just (sessionArg, index) -> do
|
|
let functionSessionArg = FunctionSessionArgument argName index
|
|
validateSessionArgumentType functionSessionArg $ faType sessionArg
|
|
pure functionSessionArg
|
|
Nothing ->
|
|
MV.refute $ pure $ CFVEInvalidSessionArgument $ ISANotFound argName
|
|
|
|
|
|
let inputArgSeq = Seq.fromList $ dropTableAndSessionArgument tableArgument
|
|
maybePGSessionArg inputArgs
|
|
computedFieldFunction =
|
|
ComputedFieldFunction function inputArgSeq tableArgument maybePGSessionArg $
|
|
rfiDescription rawFunctionInfo
|
|
|
|
pure $ ComputedFieldInfo () computedField computedFieldFunction returnType comment
|
|
|
|
validateTableArgumentType :: (MV.MonadValidate [ComputedFieldValidateError] m)
|
|
=> FunctionTableArgument
|
|
-> QualifiedPGType
|
|
-> m ()
|
|
validateTableArgumentType tableArg qpt = do
|
|
when (_qptType qpt /= PGKindComposite) $
|
|
MV.dispute $ pure $ CFVEInvalidTableArgument $ ITANotComposite tableArg
|
|
let typeTable = typeToTable qpt
|
|
unless (table == typeTable) $
|
|
MV.dispute $ pure $ CFVEInvalidTableArgument $ ITANotTable typeTable tableArg
|
|
|
|
validateSessionArgumentType :: (MV.MonadValidate [ComputedFieldValidateError] m)
|
|
=> FunctionSessionArgument
|
|
-> QualifiedPGType
|
|
-> m ()
|
|
validateSessionArgumentType sessionArg qpt = do
|
|
unless (isJSONType $ _qptName qpt) $
|
|
MV.dispute $ pure $ CFVEInvalidSessionArgument $ ISANotJSON sessionArg
|
|
|
|
showErrors :: [ComputedFieldValidateError] -> Text
|
|
showErrors allErrors =
|
|
"the computed field " <> computedField <<> " cannot be added to table "
|
|
<> table <<> " " <> reasonMessage
|
|
where
|
|
reasonMessage = makeReasonMessage allErrors (showError function)
|
|
|
|
dropTableAndSessionArgument :: FunctionTableArgument
|
|
-> Maybe FunctionSessionArgument -> [FunctionArg]
|
|
-> [FunctionArg]
|
|
dropTableAndSessionArgument tableArg sessionArg inputArgs =
|
|
let withoutTable = case tableArg of
|
|
FTAFirst -> tail inputArgs
|
|
FTANamed argName _ ->
|
|
filter ((/=) (Just argName) . faName) inputArgs
|
|
alsoWithoutSession = case sessionArg of
|
|
Nothing -> withoutTable
|
|
Just (FunctionSessionArgument name _) ->
|
|
filter ((/=) (Just name) . faName) withoutTable
|
|
in alsoWithoutSession
|
|
|
|
|
|
addComputedFieldToCatalog
|
|
:: MonadTx m
|
|
=> AddComputedField -> m ()
|
|
addComputedFieldToCatalog q =
|
|
liftTx $ Q.withQE defaultTxErrorHandler
|
|
[Q.sql|
|
|
INSERT INTO hdb_catalog.hdb_computed_field
|
|
(table_schema, table_name, computed_field_name, definition, comment)
|
|
VALUES ($1, $2, $3, $4, $5)
|
|
|] (schemaName, tableName, computedField, Q.AltJ definition, comment) True
|
|
where
|
|
QualifiedObject schemaName tableName = table
|
|
AddComputedField table computedField definition comment = q
|
|
|
|
data DropComputedField
|
|
= DropComputedField
|
|
{ _dccTable :: !QualifiedTable
|
|
, _dccName :: !ComputedFieldName
|
|
, _dccCascade :: !Bool
|
|
} deriving (Show, Eq)
|
|
$(deriveToJSON (aesonDrop 4 snakeCase) ''DropComputedField)
|
|
|
|
instance FromJSON DropComputedField where
|
|
parseJSON = withObject "Object" $ \o ->
|
|
DropComputedField
|
|
<$> o .: "table"
|
|
<*> o .: "name"
|
|
<*> o .:? "cascade" .!= False
|
|
|
|
runDropComputedField
|
|
:: (MonadTx m, CacheRWM m)
|
|
=> DropComputedField -> m EncJSON
|
|
runDropComputedField (DropComputedField table computedField cascade) = do
|
|
-- Validation
|
|
fields <- withPathK "table" $ _tciFieldInfoMap <$> askTableCoreInfo table
|
|
void $ withPathK "name" $ askComputedFieldInfo fields computedField
|
|
|
|
-- Dependencies check
|
|
sc <- askSchemaCache
|
|
let deps = getDependentObjs sc $ SOTableObj table $ TOComputedField computedField
|
|
when (not cascade && not (null deps)) $ reportDeps deps
|
|
|
|
withNewInconsistentObjsCheck do
|
|
mapM_ purgeComputedFieldDependency deps
|
|
dropComputedFieldFromCatalog table computedField
|
|
buildSchemaCache
|
|
pure successMsg
|
|
where
|
|
purgeComputedFieldDependency = \case
|
|
SOTableObj qt (TOPerm roleName permType) | qt == table ->
|
|
liftTx $ dropPermFromCatalog qt roleName permType
|
|
d -> throw500 $ "unexpected dependency for computed field "
|
|
<> computedField <<> "; " <> reportSchemaObj d
|
|
|
|
dropComputedFieldFromCatalog
|
|
:: MonadTx m
|
|
=> QualifiedTable -> ComputedFieldName -> m ()
|
|
dropComputedFieldFromCatalog (QualifiedObject schema table) computedField =
|
|
liftTx $ Q.withQE defaultTxErrorHandler
|
|
[Q.sql|
|
|
DELETE FROM hdb_catalog.hdb_computed_field
|
|
WHERE table_schema = $1
|
|
AND table_name = $2
|
|
AND computed_field_name = $3
|
|
|] (schema, table, computedField) True
|