mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
da8f6981d4
Fixes https://github.com/hasura/graphql-engine-mono/issues/712 Main point of interest: the `Hasura.SQL.Backend` module. This PR creates an `Exists` type indexed by indexed type and packed constraint while hiding all of its complexity by not exporting the constructor. Existential constructors/types which are no longer (directly) existential: - [X] BackendSourceInfo :: BackendSourceInfo - [x] BackendSourceMetadata :: BackendSourceMetadata - [x] MOSourceObjId :: MetadatObjId - [x] SOSourceObj :: SchemaObjId - [x] RFDB :: RootField - [x] LQP :: LiveQueryPlan - [x] ExecutionStep :: ExecStepDB This PR also removes ALL usages of `Typeable.cast` from our codebase. We still need to derive `Typeable` in a few places in order to be able to derive `Data` in one place. I have not dug deeper to see why this is needed. GitOrigin-RevId: bb47e957192e4bb0af4c4116aee7bb92f7983445
64 lines
2.5 KiB
Haskell
64 lines
2.5 KiB
Haskell
module Hasura.RQL.DDL.Schema.Common where
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.HashMap.Strict as HM
|
|
import qualified Database.PG.Query as Q
|
|
|
|
import qualified Hasura.SQL.AnyBackend as AB
|
|
|
|
import Hasura.Backends.Postgres.SQL.Types
|
|
import Hasura.RQL.DDL.ComputedField
|
|
import Hasura.RQL.DDL.EventTrigger
|
|
import Hasura.RQL.DDL.Permission
|
|
import Hasura.RQL.DDL.Relationship
|
|
import Hasura.RQL.DDL.RemoteRelationship
|
|
import Hasura.RQL.DDL.Schema.Function
|
|
import Hasura.RQL.Types
|
|
|
|
|
|
purgeDependentObject
|
|
:: forall b m
|
|
. (MonadError QErr m, BackendMetadata b)
|
|
=> SourceName -> SourceObjId b -> m MetadataModifier
|
|
purgeDependentObject source sourceObjId = case sourceObjId of
|
|
SOITableObj tn tableObj -> pure $ MetadataModifier $
|
|
tableMetadataSetter source tn %~ case tableObj of
|
|
TOPerm rn pt -> dropPermissionInMetadata rn pt
|
|
TORel rn -> dropRelationshipInMetadata rn
|
|
TOTrigger trn -> dropEventTriggerInMetadata trn
|
|
TOComputedField ccn -> dropComputedFieldInMetadata ccn
|
|
TORemoteRel rrn -> dropRemoteRelationshipInMetadata rrn
|
|
_ -> id
|
|
SOIFunction qf -> pure $ dropFunctionInMetadata source qf
|
|
_ ->
|
|
throw500
|
|
$ "unexpected dependent object: "
|
|
<> reportSchemaObj (SOSourceObj source $ AB.mkAnyBackend sourceObjId)
|
|
|
|
-- | Fetch Postgres metadata of all user tables
|
|
fetchTableMetadata :: (MonadTx m) => m (DBTablesMetadata 'Postgres)
|
|
fetchTableMetadata = do
|
|
results <- liftTx $ Q.withQE defaultTxErrorHandler
|
|
$(Q.sqlFromFile "src-rsr/pg_table_metadata.sql") () True
|
|
pure $ HM.fromList $ flip map results $
|
|
\(schema, table, Q.AltJ info) -> (QualifiedObject schema table, info)
|
|
|
|
-- | Fetch Postgres metadata for all user functions
|
|
fetchFunctionMetadata :: (MonadTx m) => m (DBFunctionsMetadata 'Postgres)
|
|
fetchFunctionMetadata = do
|
|
results <- liftTx $ Q.withQE defaultTxErrorHandler
|
|
$(Q.sqlFromFile "src-rsr/pg_function_metadata.sql") () True
|
|
pure $ HM.fromList $ flip map results $
|
|
\(schema, table, Q.AltJ infos) -> (QualifiedObject schema table, infos)
|
|
|
|
-- | Fetch all scalar types from Postgres
|
|
fetchPgScalars :: MonadTx m => m (HashSet PGScalarType)
|
|
fetchPgScalars =
|
|
liftTx $ Q.getAltJ . runIdentity . Q.getRow
|
|
<$> Q.withQE defaultTxErrorHandler
|
|
[Q.sql|
|
|
SELECT coalesce(json_agg(typname), '[]')
|
|
FROM pg_catalog.pg_type where typtype = 'b'
|
|
|] () True
|