mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 04:24:35 +03:00
04d8f068b6
### Description As part of the cache building process, we create / update / migrate the catalog that each DB uses as a place to store event trigger information. The function that decides how this should be done was doing an explicit `case ... of` on the backend tag, instead of delegating to one of the backend classes. The downsides of this is that: - it adds a "friction point" where the backend matters in the core of the engine, which is otherwise written to be almost entirely backend-agnostic - it creates imports from deep in the engine to the `Backends`, which we try to restrict to a very small set of clearly identified files (the `Instances` files) - it is currently implemented using a "catch all" default case, which might not always be correct for new backends This PR makes the catalog updating process a part of `BackendMetadata`, and cleans the corresponding schema cache code. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4457 GitOrigin-RevId: 592f0eaa97a7c38f4e6d4400e1d2353aab12c97e
171 lines
6.0 KiB
Haskell
171 lines
6.0 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
-- | MSSQL Source
|
|
--
|
|
-- Implements the Source related methods of the
|
|
-- 'Hasura.RQL.Types.Metadata.Backend.BackendMetadata' type class
|
|
-- for the MSSQL backend, which provides an interface for identifying the
|
|
-- MSSQL database instance (source) and manipulate it.
|
|
--
|
|
-- The actual instance is defined in "Hasura.Backends.MSSQL.Instances.Metadata".
|
|
module Hasura.Backends.MSSQL.DDL.Source
|
|
( resolveSourceConfig,
|
|
resolveDatabaseMetadata,
|
|
postDropSourceHook,
|
|
prepareCatalog,
|
|
)
|
|
where
|
|
|
|
import Control.Monad.Trans.Control (MonadBaseControl)
|
|
import Data.Environment qualified as Env
|
|
import Data.FileEmbed (makeRelativeToProject)
|
|
import Database.MSSQL.Transaction
|
|
import Database.MSSQL.Transaction qualified as Tx
|
|
import Database.ODBC.SQLServer
|
|
import Database.ODBC.TH qualified as ODBC
|
|
import Hasura.Backends.MSSQL.Connection
|
|
import Hasura.Backends.MSSQL.DDL.EventTrigger
|
|
import Hasura.Backends.MSSQL.DDL.Source.Version
|
|
import Hasura.Backends.MSSQL.Meta
|
|
import Hasura.Backends.MSSQL.SQL.Error qualified as HGE
|
|
import Hasura.Backends.MSSQL.Types
|
|
import Hasura.Base.Error
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types.Backend (BackendConfig)
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RQL.Types.EventTrigger (RecreateEventTriggers (..))
|
|
import Hasura.RQL.Types.Source
|
|
import Hasura.RQL.Types.SourceCustomization
|
|
import Hasura.SQL.Backend
|
|
import Language.Haskell.TH.Lib qualified as TH
|
|
import Language.Haskell.TH.Syntax qualified as TH
|
|
import Text.Shakespeare.Text qualified as ST
|
|
|
|
resolveSourceConfig ::
|
|
(MonadIO m, MonadResolveSource m) =>
|
|
SourceName ->
|
|
MSSQLConnConfiguration ->
|
|
BackendSourceKind 'MSSQL ->
|
|
BackendConfig 'MSSQL ->
|
|
Env.Environment ->
|
|
m (Either QErr MSSQLSourceConfig)
|
|
resolveSourceConfig name config _backendKind _backendConfig _env = runExceptT do
|
|
sourceResolver <- getMSSQLSourceResolver
|
|
liftEitherM $ liftIO $ sourceResolver name config
|
|
|
|
resolveDatabaseMetadata ::
|
|
(MonadIO m, MonadBaseControl IO m) =>
|
|
MSSQLSourceConfig ->
|
|
SourceTypeCustomization ->
|
|
m (Either QErr (ResolvedSource 'MSSQL))
|
|
resolveDatabaseMetadata config customization = runExceptT do
|
|
dbTablesMetadata <- mssqlRunReadOnly mssqlExecCtx $ loadDBMetadata
|
|
pure $ ResolvedSource config customization dbTablesMetadata mempty mempty
|
|
where
|
|
MSSQLSourceConfig _connString mssqlExecCtx = config
|
|
|
|
postDropSourceHook ::
|
|
(MonadIO m, MonadBaseControl IO m) =>
|
|
MSSQLSourceConfig ->
|
|
m ()
|
|
postDropSourceHook (MSSQLSourceConfig _ mssqlExecCtx) = do
|
|
_ <- runExceptT $ mssqlRunReadWrite mssqlExecCtx dropSourceCatalog
|
|
-- Close the connection
|
|
liftIO $ mssqlDestroyConn mssqlExecCtx
|
|
|
|
doesSchemaExist :: MonadMSSQLTx m => SchemaName -> m Bool
|
|
doesSchemaExist (SchemaName schemaName) = do
|
|
liftMSSQLTx $
|
|
Tx.singleRowQueryE
|
|
HGE.defaultMSSQLTxErrorHandler
|
|
[ODBC.sql|
|
|
SELECT CAST (
|
|
CASE
|
|
WHEN EXISTS( SELECT 1 FROM sys.schemas WHERE name = $schemaName )
|
|
THEN 1
|
|
ELSE 0
|
|
END
|
|
AS BIT)
|
|
|]
|
|
|
|
doesTableExist :: MonadMSSQLTx m => TableName -> m Bool
|
|
doesTableExist tableName = do
|
|
liftMSSQLTx $
|
|
Tx.singleRowQueryE
|
|
HGE.defaultMSSQLTxErrorHandler
|
|
[ODBC.sql|
|
|
SELECT CAST (
|
|
CASE
|
|
WHEN (Select OBJECT_ID($qualifiedTable)) IS NOT NULL
|
|
THEN 1
|
|
ELSE 0
|
|
END
|
|
AS BIT)
|
|
|]
|
|
where
|
|
qualifiedTable = qualifyTableName tableName
|
|
|
|
-- | Initialise catalog tables for a source, including those required by the event delivery subsystem.
|
|
prepareCatalog ::
|
|
(MonadIO m, MonadBaseControl IO m) =>
|
|
MSSQLSourceConfig ->
|
|
ExceptT QErr m RecreateEventTriggers
|
|
prepareCatalog sourceConfig = mssqlRunReadWrite (_mscExecCtx sourceConfig) do
|
|
hdbCatalogExist <- doesSchemaExist "hdb_catalog"
|
|
eventLogTableExist <- doesTableExist $ TableName "event_log" "hdb_catalog"
|
|
sourceVersionTableExist <- doesTableExist $ TableName "hdb_source_catalog_version" "hdb_catalog"
|
|
if
|
|
-- Fresh database
|
|
| not hdbCatalogExist -> liftMSSQLTx do
|
|
unitQueryE HGE.defaultMSSQLTxErrorHandler "CREATE SCHEMA hdb_catalog"
|
|
initSourceCatalog
|
|
return RETDoNothing
|
|
-- Only 'hdb_catalog' schema defined
|
|
| not sourceVersionTableExist && not eventLogTableExist -> do
|
|
liftMSSQLTx initSourceCatalog
|
|
return RETDoNothing
|
|
| otherwise -> migrateSourceCatalog
|
|
where
|
|
initSourceCatalog = do
|
|
unitQueryE HGE.defaultMSSQLTxErrorHandler $(makeRelativeToProject "src-rsr/mssql/init_mssql_source.sql" >>= ODBC.sqlFile)
|
|
setSourceCatalogVersion latestSourceCatalogVersion
|
|
|
|
dropSourceCatalog :: MonadMSSQLTx m => m ()
|
|
dropSourceCatalog = do
|
|
let sql = $(makeRelativeToProject "src-rsr/mssql/drop_mssql_source.sql" >>= ODBC.sqlFile)
|
|
liftMSSQLTx $ unitQueryE HGE.defaultMSSQLTxErrorHandler sql
|
|
|
|
migrateSourceCatalog :: MonadMSSQLTx m => m RecreateEventTriggers
|
|
migrateSourceCatalog =
|
|
getSourceCatalogVersion >>= migrateSourceCatalogFrom
|
|
|
|
migrateSourceCatalogFrom :: MonadMSSQLTx m => Int -> m RecreateEventTriggers
|
|
migrateSourceCatalogFrom prevVersion
|
|
| prevVersion == latestSourceCatalogVersion = pure RETDoNothing
|
|
| [] <- neededMigrations =
|
|
throw400 NotSupported $
|
|
"Expected source catalog version <= "
|
|
<> latestSourceCatalogVersionText
|
|
<> ", but the current version is "
|
|
<> (tshow prevVersion)
|
|
| otherwise = do
|
|
liftMSSQLTx $ traverse_ snd neededMigrations
|
|
setSourceCatalogVersion latestSourceCatalogVersion
|
|
pure RETRecreate
|
|
where
|
|
neededMigrations =
|
|
dropWhile ((/= prevVersion) . fst) sourceMigrations
|
|
|
|
sourceMigrations :: [(Int, TxE QErr ())]
|
|
sourceMigrations =
|
|
$( let migrationFromFile from =
|
|
let to = from + 1
|
|
path = "src-rsr/mssql_source_migrations/" <> show from <> "_to_" <> show to <> ".sql"
|
|
in [|multiRowQueryE defaultTxErrorHandler $(makeRelativeToProject path >>= ST.stextFile)|]
|
|
|
|
migrationsFromFile = map $ \(from :: Int) ->
|
|
[|($(TH.lift $ from), $(migrationFromFile from))|]
|
|
in TH.listE $ migrationsFromFile [1 .. (latestSourceCatalogVersion - 1)]
|
|
)
|