1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-17 04:24:35 +03:00
graphql-engine/server/src-lib/Hasura/Backends/MSSQL/DDL/Source.hs
Antoine Leblanc 04d8f068b6 Remove explicit case on the backend tag in Cache
### 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
2022-05-05 13:44:56 +00:00

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)]
)