1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-22 23:11:41 +03:00
graphql-engine/server/src-lib/Hasura/Backends/MSSQL/Connection.hs

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

273 lines
8.2 KiB
Haskell
Raw Normal View History

{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | MSSQL Connection
--
-- This module handles the connection against an MS SQL Server.
-- It defines the connection string, connection pool, default settings,
-- and conversion functions between MSSQL and graphql-engine.
module Hasura.Backends.MSSQL.Connection
( MSSQLConnConfiguration (MSSQLConnConfiguration),
MSSQLSourceConfig (MSSQLSourceConfig, _mscExecCtx),
MSSQLConnectionInfo (..),
MSSQLPoolSettings (..),
MSSQLExecCtx (..),
MonadMSSQLTx (..),
createMSSQLPool,
getEnv,
odbcValueToJValue,
mkMSSQLExecCtx,
mkMSSQLAnyQueryTx,
runMSSQLSourceReadTx,
runMSSQLSourceWriteTx,
)
where
server: polymorphic codec for metadata sources This PR expands the OpenAPI specification generated for metadata to include separate definitions for `SourceMetadata` for each native database type, and for DataConnector. For the most part the changes add `HasCodec` implementations, and don't modify existing code otherwise. The generated OpenAPI spec can be used to generate TypeScript definitions that distinguish different source metadata types based on the value of the `kind` properly. There is a problem: because the specified `kind` value for a data connector source is any string, when TypeScript gets a source with a `kind` value of, say, `"postgres"`, it cannot unambiguously determine whether the source is postgres, or a data connector. For example, ```ts function consumeSourceMetadata(source: SourceMetadata) { if (source.kind === "postgres" || source.kind === "pg") { // At this point TypeScript infers that `source` is either an instance // of `PostgresSourceMetadata`, or `DataconnectorSourceMetadata`. It // can't narrow further. source } if (source.kind === "something else") { // TypeScript infers that this `source` must be an instance of // `DataconnectorSourceMetadata` because `source.kind` does not match // any of the other options. source } } ``` The simplest way I can think of to fix this would be to add a boolean property to the `SourceMetadata` type along the lines of `isNative` or `isDataConnector`. This could be a field that only exists in serialized data, like the metadata version field. The combination of one of the native database names for `kind`, and a true value for `isNative` would be enough for TypeScript to unambiguously distinguish the source kinds. But note that in the current state TypeScript is able to reference the short `"pg"` name correctly! ~~Tests are not passing yet due to some discrepancies in DTO serialization vs existing Metadata serialization. I'm working on that.~~ The placeholders that I used for table and function metadata are not compatible with the ordered JSON serialization in use. I think the best solution is to write compatible codecs for those types in another PR. For now I have disabled some DTO tests for this PR. Here are the generated [OpenAPI spec](https://github.com/hasura/graphql-engine-mono/files/9397333/openapi.tar.gz) based on these changes, and the generated [TypeScript client code](https://github.com/hasura/graphql-engine-mono/files/9397339/client-typescript.tar.gz) based on that spec. Ticket: [MM-66](https://hasurahq.atlassian.net/browse/MM-66) PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5582 GitOrigin-RevId: e1446191c6c832879db04f129daa397a3be03f62
2022-08-25 21:34:44 +03:00
import Autodocodec (HasCodec (codec), named)
import Control.Monad.Morph (hoist)
server/mssql: add cascade to mssql_run_sql <!-- Thank you for ss in the Title above ^ --> ## Description <!-- Please fill thier. --> <!-- Describe the changes from a user's perspective --> We don't have dependency reporting mechanism for `mssql_run_sql` API i.e when a database object (table, column etc.) is dropped through the API we should raise an exception if any dependencies (relationships, permissions etc.) with the database object exists in the metadata. This PR addresses the above mentioned problem by -> Integrating transaction to the API to rollback the SQL query execution if dependencies exists and exception is thrown -> Accepting `cascade` optional field in the API payload to drop the dependencies, if any -> Accepting `check_metadata_consistency` optional field to bypass (if value set to `false`) the dependency check ### Related Issues <!-- Please make surt title --> <!-- Add the issue number below (e.g. #234) --> Close #1853 ### Solution and Design <!-- How is this iss --> <!-- It's better if we elaborate --> The design/solution follows the `run_sql` API implementation for Postgres backend. ### Steps to test and verify <!-- If this is a fehis is a bug-fix, how do we verify the fix? --> - Create author - article tables and track them - Defined object and array relationships - Try to drop the article table without cascade or cascade set to `false` - The server should raise the relationship dependency exists exception ## Changelog - ✅ `CHANGELOG.md` is updated with user-facing content relevant to this PR. If no changelog is required, then add the `no-changelog-required` label. ## Affected components <!-- Remove non-affected components from the list --> - ✅ Server - ❎ Console - ❎ CLI - ❎ Docs - ❎ Community Content - ❎ Build System - ✅ Tests - ❎ Other (list it) PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2636 GitOrigin-RevId: 0ab152295394056c4ca6f02923142a1658ad25dc
2021-10-22 17:49:15 +03:00
import Control.Monad.Trans.Control
import Data.Aeson
import Data.Aeson qualified as J
import Data.Aeson.TH
import Data.Environment qualified as Env
import Data.Text (pack, unpack)
import Data.Time (localTimeToUTC)
import Database.MSSQL.Pool qualified as MSPool
import Database.MSSQL.Transaction qualified as MSTx
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.SQL.Error
import Hasura.Base.Error
import Hasura.Incremental (Cacheable (..))
server: polymorphic codec for metadata sources This PR expands the OpenAPI specification generated for metadata to include separate definitions for `SourceMetadata` for each native database type, and for DataConnector. For the most part the changes add `HasCodec` implementations, and don't modify existing code otherwise. The generated OpenAPI spec can be used to generate TypeScript definitions that distinguish different source metadata types based on the value of the `kind` properly. There is a problem: because the specified `kind` value for a data connector source is any string, when TypeScript gets a source with a `kind` value of, say, `"postgres"`, it cannot unambiguously determine whether the source is postgres, or a data connector. For example, ```ts function consumeSourceMetadata(source: SourceMetadata) { if (source.kind === "postgres" || source.kind === "pg") { // At this point TypeScript infers that `source` is either an instance // of `PostgresSourceMetadata`, or `DataconnectorSourceMetadata`. It // can't narrow further. source } if (source.kind === "something else") { // TypeScript infers that this `source` must be an instance of // `DataconnectorSourceMetadata` because `source.kind` does not match // any of the other options. source } } ``` The simplest way I can think of to fix this would be to add a boolean property to the `SourceMetadata` type along the lines of `isNative` or `isDataConnector`. This could be a field that only exists in serialized data, like the metadata version field. The combination of one of the native database names for `kind`, and a true value for `isNative` would be enough for TypeScript to unambiguously distinguish the source kinds. But note that in the current state TypeScript is able to reference the short `"pg"` name correctly! ~~Tests are not passing yet due to some discrepancies in DTO serialization vs existing Metadata serialization. I'm working on that.~~ The placeholders that I used for table and function metadata are not compatible with the ordered JSON serialization in use. I think the best solution is to write compatible codecs for those types in another PR. For now I have disabled some DTO tests for this PR. Here are the generated [OpenAPI spec](https://github.com/hasura/graphql-engine-mono/files/9397333/openapi.tar.gz) based on these changes, and the generated [TypeScript client code](https://github.com/hasura/graphql-engine-mono/files/9397339/client-typescript.tar.gz) based on that spec. Ticket: [MM-66](https://hasurahq.atlassian.net/browse/MM-66) PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5582 GitOrigin-RevId: e1446191c6c832879db04f129daa397a3be03f62
2022-08-25 21:34:44 +03:00
import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
import Hasura.Prelude
class MonadError QErr m => MonadMSSQLTx m where
liftMSSQLTx :: MSTx.TxE QErr a -> m a
instance MonadMSSQLTx m => MonadMSSQLTx (ReaderT s m) where
liftMSSQLTx = lift . liftMSSQLTx
instance MonadMSSQLTx m => MonadMSSQLTx (StateT s m) where
liftMSSQLTx = lift . liftMSSQLTx
instance (Monoid w, MonadMSSQLTx m) => MonadMSSQLTx (WriterT w m) where
liftMSSQLTx = lift . liftMSSQLTx
instance MonadIO m => MonadMSSQLTx (MSTx.TxET QErr m) where
liftMSSQLTx = hoist liftIO
-- | ODBC connection string for MSSQL server
newtype MSSQLConnectionString = MSSQLConnectionString {unMSSQLConnectionString :: Text}
deriving (Show, Eq, ToJSON, FromJSON, Cacheable, Hashable, NFData)
-- * Orphan instances
instance Cacheable MSPool.ConnectionString
instance Hashable MSPool.ConnectionString
instance NFData MSPool.ConnectionString
data InputConnectionString
= RawString MSPool.ConnectionString
| FromEnvironment Text
deriving stock (Show, Eq, Generic)
instance Cacheable InputConnectionString
instance Hashable InputConnectionString
instance NFData InputConnectionString
instance ToJSON InputConnectionString where
toJSON =
\case
(RawString m) -> toJSON m
(FromEnvironment wEnv) -> object ["from_env" .= wEnv]
instance FromJSON InputConnectionString where
parseJSON =
\case
(Object o) -> FromEnvironment <$> o .: "from_env"
s@(String _) -> RawString <$> parseJSON s
_ -> fail "one of string or object must be provided"
data MSSQLPoolSettings = MSSQLPoolSettings
{ _mpsMaxConnections :: Int,
_mpsIdleTimeout :: Int
}
deriving (Show, Eq, Generic)
instance Cacheable MSSQLPoolSettings
instance Hashable MSSQLPoolSettings
instance NFData MSSQLPoolSettings
$(deriveToJSON hasuraJSON ''MSSQLPoolSettings)
instance FromJSON MSSQLPoolSettings where
parseJSON = withObject "MSSQL pool settings" $ \o ->
MSSQLPoolSettings
<$> o .:? "max_connections" .!= _mpsMaxConnections defaultMSSQLPoolSettings
<*> o .:? "idle_timeout" .!= _mpsIdleTimeout defaultMSSQLPoolSettings
defaultMSSQLPoolSettings :: MSSQLPoolSettings
defaultMSSQLPoolSettings =
MSSQLPoolSettings
{ _mpsMaxConnections = 50,
_mpsIdleTimeout = 5
}
data MSSQLConnectionInfo = MSSQLConnectionInfo
{ _mciConnectionString :: InputConnectionString,
_mciPoolSettings :: MSSQLPoolSettings
}
deriving (Show, Eq, Generic)
instance Cacheable MSSQLConnectionInfo
instance Hashable MSSQLConnectionInfo
instance NFData MSSQLConnectionInfo
$(deriveToJSON hasuraJSON ''MSSQLConnectionInfo)
instance FromJSON MSSQLConnectionInfo where
parseJSON = withObject "Object" $ \o ->
MSSQLConnectionInfo
<$> ((o .: "database_url") <|> (o .: "connection_string"))
<*> o .:? "pool_settings" .!= defaultMSSQLPoolSettings
data MSSQLConnConfiguration = MSSQLConnConfiguration
{ _mccConnectionInfo :: MSSQLConnectionInfo,
_mccReadReplicas :: Maybe (NonEmpty MSSQLConnectionInfo)
}
deriving (Show, Eq, Generic)
instance Cacheable MSSQLConnConfiguration
instance Hashable MSSQLConnConfiguration
instance NFData MSSQLConnConfiguration
$(deriveJSON hasuraJSON {omitNothingFields = True} ''MSSQLConnConfiguration)
server: polymorphic codec for metadata sources This PR expands the OpenAPI specification generated for metadata to include separate definitions for `SourceMetadata` for each native database type, and for DataConnector. For the most part the changes add `HasCodec` implementations, and don't modify existing code otherwise. The generated OpenAPI spec can be used to generate TypeScript definitions that distinguish different source metadata types based on the value of the `kind` properly. There is a problem: because the specified `kind` value for a data connector source is any string, when TypeScript gets a source with a `kind` value of, say, `"postgres"`, it cannot unambiguously determine whether the source is postgres, or a data connector. For example, ```ts function consumeSourceMetadata(source: SourceMetadata) { if (source.kind === "postgres" || source.kind === "pg") { // At this point TypeScript infers that `source` is either an instance // of `PostgresSourceMetadata`, or `DataconnectorSourceMetadata`. It // can't narrow further. source } if (source.kind === "something else") { // TypeScript infers that this `source` must be an instance of // `DataconnectorSourceMetadata` because `source.kind` does not match // any of the other options. source } } ``` The simplest way I can think of to fix this would be to add a boolean property to the `SourceMetadata` type along the lines of `isNative` or `isDataConnector`. This could be a field that only exists in serialized data, like the metadata version field. The combination of one of the native database names for `kind`, and a true value for `isNative` would be enough for TypeScript to unambiguously distinguish the source kinds. But note that in the current state TypeScript is able to reference the short `"pg"` name correctly! ~~Tests are not passing yet due to some discrepancies in DTO serialization vs existing Metadata serialization. I'm working on that.~~ The placeholders that I used for table and function metadata are not compatible with the ordered JSON serialization in use. I think the best solution is to write compatible codecs for those types in another PR. For now I have disabled some DTO tests for this PR. Here are the generated [OpenAPI spec](https://github.com/hasura/graphql-engine-mono/files/9397333/openapi.tar.gz) based on these changes, and the generated [TypeScript client code](https://github.com/hasura/graphql-engine-mono/files/9397339/client-typescript.tar.gz) based on that spec. Ticket: [MM-66](https://hasurahq.atlassian.net/browse/MM-66) PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5582 GitOrigin-RevId: e1446191c6c832879db04f129daa397a3be03f62
2022-08-25 21:34:44 +03:00
-- TODO: Write a proper codec, and use it to derive FromJSON and ToJSON
-- instances.
instance HasCodec MSSQLConnConfiguration where
codec = named "MSSQLConnConfiguration" $ placeholderCodecViaJSON
createMSSQLPool ::
MonadIO m =>
QErrM m =>
MSSQLConnectionInfo ->
Env.Environment ->
m (MSPool.ConnectionString, MSPool.MSSQLPool)
createMSSQLPool (MSSQLConnectionInfo iConnString MSSQLPoolSettings {..}) env = do
connString <- resolveInputConnectionString env iConnString
let connOptions =
MSPool.ConnectionOptions
{ _coConnections = _mpsMaxConnections,
_coStripes = 1,
_coIdleTime = fromIntegral _mpsIdleTimeout
}
pool <- liftIO $ MSPool.initMSSQLPool connString connOptions
pure (connString, pool)
resolveInputConnectionString ::
QErrM m =>
Env.Environment ->
InputConnectionString ->
m MSPool.ConnectionString
resolveInputConnectionString env =
\case
(RawString cs) -> pure cs
(FromEnvironment envVar) -> MSPool.ConnectionString <$> getEnv env envVar
getEnv :: QErrM m => Env.Environment -> Text -> m Text
getEnv env k = do
let mEnv = Env.lookupEnv env (unpack k)
case mEnv of
Nothing -> throw400 NotFound $ "environment variable '" <> k <> "' not set"
Just envVal -> return (pack envVal)
type MSSQLRunTx =
forall m a. (MonadIO m, MonadBaseControl IO m) => MSTx.TxET QErr m a -> ExceptT QErr m a
-- | Execution Context required to execute MSSQL transactions
data MSSQLExecCtx = MSSQLExecCtx
{ -- | A function that runs read-only queries
mssqlRunReadOnly :: MSSQLRunTx,
-- | A function that runs read-write queries; run in a transaction
mssqlRunReadWrite :: MSSQLRunTx,
-- | Destroys connection pools
mssqlDestroyConn :: IO ()
}
-- | Creates a MSSQL execution context for a single primary pool
mkMSSQLExecCtx :: MSPool.MSSQLPool -> MSSQLExecCtx
mkMSSQLExecCtx pool =
MSSQLExecCtx
{ mssqlRunReadOnly = \tx -> MSTx.runTxE defaultMSSQLTxErrorHandler tx pool,
mssqlRunReadWrite = \tx -> MSTx.runTxE defaultMSSQLTxErrorHandler tx pool,
mssqlDestroyConn = MSPool.drainMSSQLPool pool
}
-- | Run any query discarding its results
mkMSSQLAnyQueryTx :: ODBC.Query -> MSTx.TxET QErr IO ()
mkMSSQLAnyQueryTx q = do
_discard :: [[ODBC.Value]] <- MSTx.multiRowQueryE defaultMSSQLTxErrorHandler q
pure ()
data MSSQLSourceConfig = MSSQLSourceConfig
{ _mscConnectionString :: MSPool.ConnectionString,
_mscExecCtx :: MSSQLExecCtx
}
deriving (Generic)
instance Show MSSQLSourceConfig where
show = show . _mscConnectionString
instance Eq MSSQLSourceConfig where
MSSQLSourceConfig connStr1 _ == MSSQLSourceConfig connStr2 _ =
connStr1 == connStr2
instance Cacheable MSSQLSourceConfig where
unchanged _ = (==)
instance ToJSON MSSQLSourceConfig where
toJSON = toJSON . _mscConnectionString
odbcValueToJValue :: ODBC.Value -> J.Value
odbcValueToJValue = \case
ODBC.TextValue t -> J.String t
ODBC.ByteStringValue b -> J.String $ bsToTxt b
ODBC.BinaryValue b -> J.String $ bsToTxt $ ODBC.unBinary b
ODBC.BoolValue b -> J.Bool b
ODBC.DoubleValue d -> J.toJSON d
ODBC.FloatValue f -> J.toJSON f
ODBC.IntValue i -> J.toJSON i
ODBC.ByteValue b -> J.toJSON b
ODBC.DayValue d -> J.toJSON d
ODBC.TimeOfDayValue td -> J.toJSON td
ODBC.LocalTimeValue l -> J.toJSON l
ODBC.NullValue -> J.Null
ODBC.ZonedTimeValue lt tz -> J.toJSON (localTimeToUTC tz lt)
runMSSQLSourceReadTx ::
(MonadIO m, MonadBaseControl IO m) =>
MSSQLSourceConfig ->
MSTx.TxET QErr m a ->
m (Either QErr a)
runMSSQLSourceReadTx msc =
runExceptT . mssqlRunReadOnly (_mscExecCtx msc)
runMSSQLSourceWriteTx ::
(MonadIO m, MonadBaseControl IO m) =>
MSSQLSourceConfig ->
MSTx.TxET QErr m a ->
m (Either QErr a)
runMSSQLSourceWriteTx msc =
runExceptT . mssqlRunReadWrite (_mscExecCtx msc)