mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
9ef603360c
Co-authored-by: Vamshi Surabhi <vamshi@hasura.io> Co-authored-by: Vladimir Ciobanu <admin@cvlad.info> Co-authored-by: Antoine Leblanc <antoine@hasura.io> Co-authored-by: Stylish Haskell Bot <stylish-haskell@users.noreply.github.com> GitOrigin-RevId: 9d631878037637f3ed2994b5d0525efd978f7b8f
117 lines
4.6 KiB
Haskell
117 lines
4.6 KiB
Haskell
module Hasura.Backends.Postgres.DDL.Source
|
|
(resolveSource)
|
|
where
|
|
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Database.PG.Query as Q
|
|
|
|
import Control.Lens hiding (from, index, op, (.=))
|
|
import Control.Monad.Trans.Control (MonadBaseControl)
|
|
|
|
import Hasura.Backends.Postgres.Connection
|
|
import Hasura.Backends.Postgres.SQL.Types
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RQL.Types.Error
|
|
import Hasura.RQL.Types.Function
|
|
import Hasura.RQL.Types.Source
|
|
import Hasura.RQL.Types.Table
|
|
import Hasura.SQL.Backend
|
|
|
|
resolveSource
|
|
:: (MonadIO m, MonadBaseControl IO m, MonadResolveSource m)
|
|
=> SourceName -> PostgresConnConfiguration -> m (Either QErr (ResolvedSource 'Postgres))
|
|
resolveSource name config = runExceptT do
|
|
sourceResolver <- getSourceResolver
|
|
sourceConfig <- liftEitherM $ liftIO $ sourceResolver name config
|
|
|
|
(tablesMeta, functionsMeta, pgScalars) <- runLazyTx (_pscExecCtx sourceConfig) Q.ReadWrite $ do
|
|
initSource
|
|
tablesMeta <- fetchTableMetadata
|
|
functionsMeta <- fetchFunctionMetadata
|
|
pgScalars <- fetchPgScalars
|
|
pure (tablesMeta, functionsMeta, pgScalars)
|
|
pure $ ResolvedSource sourceConfig tablesMeta functionsMeta pgScalars
|
|
|
|
initSource :: MonadTx m => m ()
|
|
initSource = do
|
|
hdbCatalogExist <- doesSchemaExist "hdb_catalog"
|
|
eventLogTableExist <- doesTableExist "hdb_catalog" "event_log"
|
|
sourceVersionTableExist <- doesTableExist "hdb_catalog" "hdb_source_catalog_version"
|
|
-- Fresh database
|
|
if | not hdbCatalogExist -> liftTx do
|
|
Q.unitQE defaultTxErrorHandler "CREATE SCHEMA hdb_catalog" () False
|
|
enablePgcryptoExtension
|
|
initPgSourceCatalog
|
|
-- Only 'hdb_catalog' schema defined
|
|
| not sourceVersionTableExist && not eventLogTableExist ->
|
|
liftTx initPgSourceCatalog
|
|
-- Source is initialised by pre multisource support servers
|
|
| not sourceVersionTableExist && eventLogTableExist ->
|
|
liftTx createVersionTable
|
|
| otherwise -> migrateSourceCatalog
|
|
where
|
|
initPgSourceCatalog = do
|
|
() <- Q.multiQE defaultTxErrorHandler $(Q.sqlFromFile "src-rsr/init_pg_source.sql")
|
|
setSourceCatalogVersion
|
|
|
|
createVersionTable = do
|
|
() <- Q.multiQE defaultTxErrorHandler
|
|
[Q.sql|
|
|
CREATE TABLE hdb_catalog.hdb_source_catalog_version(
|
|
version TEXT NOT NULL,
|
|
upgraded_on TIMESTAMPTZ NOT NULL
|
|
);
|
|
|
|
CREATE UNIQUE INDEX hdb_source_catalog_version_one_row
|
|
ON hdb_catalog.hdb_source_catalog_version((version IS NOT NULL));
|
|
|]
|
|
setSourceCatalogVersion
|
|
|
|
migrateSourceCatalog = do
|
|
version <- getSourceCatalogVersion
|
|
case version of
|
|
"1" -> pure ()
|
|
_ -> throw500 $ "unexpected source catalog version: " <> version
|
|
|
|
currentSourceCatalogVersion :: Text
|
|
currentSourceCatalogVersion = "1"
|
|
|
|
setSourceCatalogVersion :: MonadTx m => m ()
|
|
setSourceCatalogVersion = liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql|
|
|
INSERT INTO hdb_catalog.hdb_source_catalog_version(version, upgraded_on)
|
|
VALUES ($1, NOW())
|
|
ON CONFLICT ((version IS NOT NULL))
|
|
DO UPDATE SET version = $1, upgraded_on = NOW()
|
|
|] (Identity currentSourceCatalogVersion) False
|
|
|
|
getSourceCatalogVersion :: MonadTx m => m Text
|
|
getSourceCatalogVersion = liftTx $ runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler
|
|
[Q.sql| SELECT version FROM hdb_catalog.hdb_source_catalog_version |] () False
|
|
|
|
-- | 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 $ Map.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 $ Map.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
|