2022-03-16 03:39:21 +03:00
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
|
2022-01-03 20:16:24 +03:00
|
|
|
-- | Metadata related types, functions and helpers.
|
2022-01-11 01:54:51 +03:00
|
|
|
--
|
|
|
|
-- Provides a single function which loads the MSSQL database metadata.
|
2022-04-21 10:19:37 +03:00
|
|
|
-- See the file at src-rsr/mssql/mssql_table_metadata.sql for the SQL we use to build
|
2022-01-11 01:54:51 +03:00
|
|
|
-- this metadata.
|
|
|
|
-- See 'Hasura.RQL.Types.Table.DBTableMetadata' for the Haskell type we use forall
|
|
|
|
-- storing this metadata.
|
2021-02-23 20:37:27 +03:00
|
|
|
module Hasura.Backends.MSSQL.Meta
|
2021-02-24 15:52:21 +03:00
|
|
|
( loadDBMetadata,
|
2021-02-23 20:37:27 +03:00
|
|
|
)
|
|
|
|
where
|
2021-09-24 01:56:37 +03:00
|
|
|
|
2021-02-23 20:37:27 +03:00
|
|
|
import Data.Aeson as Aeson
|
2021-06-18 19:59:25 +03:00
|
|
|
import Data.ByteString.UTF8 qualified as BSUTF8
|
|
|
|
import Data.FileEmbed (embedFile, makeRelativeToProject)
|
2023-04-26 18:42:13 +03:00
|
|
|
import Data.HashMap.Strict qualified as HashMap
|
2022-05-10 18:43:24 +03:00
|
|
|
import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
|
2021-02-23 20:37:27 +03:00
|
|
|
import Data.HashSet qualified as HS
|
2021-03-16 20:35:35 +03:00
|
|
|
import Data.String
|
2021-02-25 21:15:55 +03:00
|
|
|
import Data.Text qualified as T
|
2021-02-23 20:37:27 +03:00
|
|
|
import Data.Text.Encoding qualified as T
|
2021-10-22 17:49:15 +03:00
|
|
|
import Database.MSSQL.Transaction qualified as Tx
|
2021-06-18 19:59:25 +03:00
|
|
|
import Database.ODBC.SQLServer qualified as ODBC
|
2021-02-23 20:37:27 +03:00
|
|
|
import Hasura.Backends.MSSQL.Instances.Types ()
|
2022-02-07 17:11:49 +03:00
|
|
|
import Hasura.Backends.MSSQL.SQL.Error
|
2021-11-26 16:47:12 +03:00
|
|
|
import Hasura.Backends.MSSQL.Types.Internal
|
2021-05-11 18:18:31 +03:00
|
|
|
import Hasura.Base.Error
|
2021-02-23 20:37:27 +03:00
|
|
|
import Hasura.Prelude
|
2023-04-24 21:35:48 +03:00
|
|
|
import Hasura.RQL.Types.BackendType
|
2021-02-23 20:37:27 +03:00
|
|
|
import Hasura.RQL.Types.Column
|
|
|
|
import Hasura.RQL.Types.Common (OID (..))
|
|
|
|
import Hasura.RQL.Types.Table
|
2021-06-15 18:05:41 +03:00
|
|
|
|
2021-02-23 20:37:27 +03:00
|
|
|
--------------------------------------------------------------------------------
|
2022-01-03 20:16:24 +03:00
|
|
|
|
|
|
|
-- * Loader
|
2021-02-23 20:37:27 +03:00
|
|
|
|
2021-10-22 17:49:15 +03:00
|
|
|
loadDBMetadata :: (MonadIO m) => Tx.TxET QErr m (DBTablesMetadata 'MSSQL)
|
|
|
|
loadDBMetadata = do
|
2022-04-21 10:19:37 +03:00
|
|
|
let queryBytes = $(makeRelativeToProject "src-rsr/mssql/mssql_table_metadata.sql" >>= embedFile)
|
2021-06-18 19:59:25 +03:00
|
|
|
odbcQuery :: ODBC.Query = fromString . BSUTF8.toString $ queryBytes
|
2022-02-07 17:11:49 +03:00
|
|
|
sysTablesText <- runIdentity <$> Tx.singleRowQueryE defaultMSSQLTxErrorHandler odbcQuery
|
2021-02-25 21:15:55 +03:00
|
|
|
case Aeson.eitherDecodeStrict (T.encodeUtf8 sysTablesText) of
|
|
|
|
Left e -> throw500 $ T.pack $ "error loading sql server database schema: " <> e
|
2023-04-26 18:42:13 +03:00
|
|
|
Right sysTables -> pure $ HashMap.fromList $ map transformTable sysTables
|
2021-02-23 20:37:27 +03:00
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2022-01-03 20:16:24 +03:00
|
|
|
|
|
|
|
-- * Local types
|
2021-02-23 20:37:27 +03:00
|
|
|
|
|
|
|
data SysTable = SysTable
|
|
|
|
{ staName :: Text,
|
|
|
|
staObjectId :: Int,
|
|
|
|
staJoinedSysColumn :: [SysColumn],
|
2021-10-01 15:52:19 +03:00
|
|
|
staJoinedSysSchema :: SysSchema,
|
|
|
|
staJoinedSysPrimaryKey :: Maybe SysPrimaryKey
|
2021-02-23 20:37:27 +03:00
|
|
|
}
|
|
|
|
deriving (Show, Generic)
|
|
|
|
|
2021-05-21 05:46:58 +03:00
|
|
|
instance FromJSON SysTable where
|
2021-02-23 20:37:27 +03:00
|
|
|
parseJSON = genericParseJSON hasuraJSON
|
|
|
|
|
2021-10-01 15:52:19 +03:00
|
|
|
newtype SysPrimaryKeyColumn = SysPrimaryKeyColumn
|
|
|
|
{spkcName :: Text}
|
|
|
|
deriving (Show, Generic)
|
|
|
|
|
|
|
|
instance FromJSON SysPrimaryKeyColumn where
|
|
|
|
parseJSON = genericParseJSON hasuraJSON
|
|
|
|
|
|
|
|
data SysPrimaryKey = SysPrimaryKey
|
|
|
|
{ spkName :: Text,
|
|
|
|
spkIndexId :: Int,
|
|
|
|
spkColumns :: NESeq SysPrimaryKeyColumn
|
|
|
|
}
|
|
|
|
deriving (Show, Generic)
|
|
|
|
|
|
|
|
instance FromJSON SysPrimaryKey where
|
|
|
|
parseJSON = genericParseJSON hasuraJSON
|
|
|
|
|
2021-02-23 20:37:27 +03:00
|
|
|
data SysSchema = SysSchema
|
|
|
|
{ ssName :: Text,
|
|
|
|
ssSchemaId :: Int
|
|
|
|
}
|
|
|
|
deriving (Show, Generic)
|
|
|
|
|
2021-05-21 05:46:58 +03:00
|
|
|
instance FromJSON SysSchema where
|
2021-02-23 20:37:27 +03:00
|
|
|
parseJSON = genericParseJSON hasuraJSON
|
|
|
|
|
|
|
|
data SysColumn = SysColumn
|
|
|
|
{ scName :: Text,
|
|
|
|
scColumnId :: Int,
|
|
|
|
scUserTypeId :: Int,
|
|
|
|
scIsNullable :: Bool,
|
2021-09-17 12:02:06 +03:00
|
|
|
scIsIdentity :: Bool,
|
2022-02-03 17:14:33 +03:00
|
|
|
scIsComputed :: Bool,
|
2021-02-23 20:37:27 +03:00
|
|
|
scJoinedSysType :: SysType,
|
|
|
|
scJoinedForeignKeyColumns :: [SysForeignKeyColumn]
|
|
|
|
}
|
|
|
|
deriving (Show, Generic)
|
2021-09-24 01:56:37 +03:00
|
|
|
|
2021-02-23 20:37:27 +03:00
|
|
|
instance FromJSON SysColumn where
|
|
|
|
parseJSON = genericParseJSON hasuraJSON
|
|
|
|
|
|
|
|
data SysType = SysType
|
|
|
|
{ styName :: Text,
|
|
|
|
stySchemaId :: Int,
|
|
|
|
styUserTypeId :: Int
|
|
|
|
}
|
|
|
|
deriving (Show, Generic)
|
|
|
|
|
2021-05-21 05:46:58 +03:00
|
|
|
instance FromJSON SysType where
|
2021-02-23 20:37:27 +03:00
|
|
|
parseJSON = genericParseJSON hasuraJSON
|
|
|
|
|
|
|
|
data SysForeignKeyColumn = SysForeignKeyColumn
|
|
|
|
{ sfkcConstraintObjectId :: Int,
|
|
|
|
sfkcConstraintColumnId :: Int,
|
|
|
|
sfkcParentObjectId :: Int,
|
|
|
|
sfkcParentColumnId :: Int,
|
|
|
|
sfkcReferencedObjectId :: Int,
|
|
|
|
sfkcReferencedColumnId :: Int,
|
|
|
|
sfkcJoinedReferencedTableName :: Text,
|
|
|
|
sfkcJoinedReferencedColumnName :: Text,
|
|
|
|
sfkcJoinedReferencedSysSchema :: SysSchema
|
|
|
|
}
|
|
|
|
deriving (Show, Generic)
|
|
|
|
|
2021-05-21 05:46:58 +03:00
|
|
|
instance FromJSON SysForeignKeyColumn where
|
2021-02-23 20:37:27 +03:00
|
|
|
parseJSON = genericParseJSON hasuraJSON
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2022-01-03 20:16:24 +03:00
|
|
|
|
|
|
|
-- * Transform
|
2021-02-23 20:37:27 +03:00
|
|
|
|
|
|
|
transformTable :: SysTable -> (TableName, DBTableMetadata 'MSSQL)
|
|
|
|
transformTable tableInfo =
|
2022-02-24 11:13:19 +03:00
|
|
|
let schemaName = SchemaName $ ssName $ staJoinedSysSchema tableInfo
|
2021-03-31 16:48:36 +03:00
|
|
|
tableName = TableName (staName tableInfo) schemaName
|
|
|
|
tableOID = OID $ staObjectId tableInfo
|
2021-03-05 13:52:40 +03:00
|
|
|
(columns, foreignKeys) = unzip $ transformColumn <$> staJoinedSysColumn tableInfo
|
2021-03-31 16:48:36 +03:00
|
|
|
foreignKeysMetadata = HS.fromList $ map ForeignKeyMetadata $ coalesceKeys $ concat foreignKeys
|
2021-10-01 15:52:19 +03:00
|
|
|
primaryKey = transformPrimaryKey <$> staJoinedSysPrimaryKey tableInfo
|
2021-09-17 12:02:06 +03:00
|
|
|
identityColumns =
|
|
|
|
map (ColumnName . scName) $
|
|
|
|
filter scIsIdentity $
|
|
|
|
staJoinedSysColumn tableInfo
|
2021-02-23 20:37:27 +03:00
|
|
|
in ( tableName,
|
|
|
|
DBTableMetadata
|
|
|
|
tableOID
|
|
|
|
columns
|
2021-10-01 15:52:19 +03:00
|
|
|
primaryKey
|
2021-02-23 20:37:27 +03:00
|
|
|
HS.empty -- no unique constraints?
|
2021-03-31 16:48:36 +03:00
|
|
|
foreignKeysMetadata
|
2021-02-23 20:37:27 +03:00
|
|
|
Nothing -- no views, only tables
|
|
|
|
Nothing -- no description
|
2021-09-17 12:02:06 +03:00
|
|
|
identityColumns
|
2023-04-11 04:29:05 +03:00
|
|
|
mempty
|
2021-02-23 20:37:27 +03:00
|
|
|
)
|
2021-09-24 01:56:37 +03:00
|
|
|
|
2021-02-23 20:37:27 +03:00
|
|
|
transformColumn ::
|
|
|
|
SysColumn ->
|
|
|
|
(RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])
|
2022-06-08 02:24:42 +03:00
|
|
|
transformColumn sysCol =
|
|
|
|
let rciName = ColumnName $ scName sysCol
|
|
|
|
rciPosition = scColumnId sysCol
|
2021-09-24 01:56:37 +03:00
|
|
|
|
2022-06-08 02:24:42 +03:00
|
|
|
rciIsNullable = scIsNullable sysCol
|
2022-01-19 11:37:50 +03:00
|
|
|
rciDescription = Nothing
|
2022-06-08 02:24:42 +03:00
|
|
|
rciType = parseScalarType $ styName $ scJoinedSysType sysCol
|
2021-02-23 20:37:27 +03:00
|
|
|
foreignKeys =
|
2022-06-08 02:24:42 +03:00
|
|
|
scJoinedForeignKeyColumns sysCol <&> \foreignKeyColumn ->
|
An `ErrorMessage` type, to encapsulate.
This introduces an `ErrorMessage` newtype which wraps `Text` in a manner which is designed to be easy to construct, and difficult to deconstruct.
It provides functionality similar to `Data.Text.Extended`, but designed _only_ for error messages. Error messages are constructed through `fromString`, concatenation, or the `toErrorValue` function, which is designed to be overridden for all meaningful domain types that might show up in an error message. Notably, there are not and should never be instances of `ToErrorValue` for `String`, `Text`, `Int`, etc. This is so that we correctly represent the value in a way that is specific to its type. For example, all `Name` values (from the _graphql-parser-hs_ library) are single-quoted now; no exceptions.
I have mostly had to add `instance ToErrorValue` for various backend types (and also add newtypes where necessary). Some of these are not strictly necessary for this changeset, as I had bigger aspirations when I started. These aspirations have been tempered by trying and failing twice.
As such, in this changeset, I have started by introducing this type to the `parseError` and `parseErrorWith` functions. In the future, I would like to extend this to the `QErr` record and the various `throwError` functions, but this is a much larger task and should probably be done in stages.
For now, `toErrorMessage` and `fromErrorMessage` are provided for conversion to and from `Text`, but the intent is to stop exporting these once all error messages are converted to the new type.
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5018
GitOrigin-RevId: 84b37e238992e4312255a87ca44f41af65e2d89a
2022-07-18 23:26:01 +03:00
|
|
|
let _fkConstraint = Constraint (ConstraintName "fk_mssql") $ OID $ sfkcConstraintObjectId foreignKeyColumn
|
2021-02-23 20:37:27 +03:00
|
|
|
|
2022-02-24 11:13:19 +03:00
|
|
|
schemaName = SchemaName $ ssName $ sfkcJoinedReferencedSysSchema foreignKeyColumn
|
2021-02-23 20:37:27 +03:00
|
|
|
_fkForeignTable = TableName (sfkcJoinedReferencedTableName foreignKeyColumn) schemaName
|
2022-05-10 18:43:24 +03:00
|
|
|
_fkColumnMapping = NEHashMap.singleton rciName $ ColumnName $ sfkcJoinedReferencedColumnName foreignKeyColumn
|
2021-02-23 20:37:27 +03:00
|
|
|
in ForeignKey {..}
|
2021-12-01 14:33:14 +03:00
|
|
|
|
2022-06-08 02:24:42 +03:00
|
|
|
colIsImmutable = scIsComputed sysCol || scIsIdentity sysCol
|
2022-02-03 17:14:33 +03:00
|
|
|
rciMutability = ColumnMutability {_cmIsInsertable = not colIsImmutable, _cmIsUpdatable = not colIsImmutable}
|
2021-02-23 20:37:27 +03:00
|
|
|
in (RawColumnInfo {..}, foreignKeys)
|
|
|
|
|
2021-10-01 15:52:19 +03:00
|
|
|
transformPrimaryKey :: SysPrimaryKey -> PrimaryKey 'MSSQL (Column 'MSSQL)
|
|
|
|
transformPrimaryKey (SysPrimaryKey {..}) =
|
An `ErrorMessage` type, to encapsulate.
This introduces an `ErrorMessage` newtype which wraps `Text` in a manner which is designed to be easy to construct, and difficult to deconstruct.
It provides functionality similar to `Data.Text.Extended`, but designed _only_ for error messages. Error messages are constructed through `fromString`, concatenation, or the `toErrorValue` function, which is designed to be overridden for all meaningful domain types that might show up in an error message. Notably, there are not and should never be instances of `ToErrorValue` for `String`, `Text`, `Int`, etc. This is so that we correctly represent the value in a way that is specific to its type. For example, all `Name` values (from the _graphql-parser-hs_ library) are single-quoted now; no exceptions.
I have mostly had to add `instance ToErrorValue` for various backend types (and also add newtypes where necessary). Some of these are not strictly necessary for this changeset, as I had bigger aspirations when I started. These aspirations have been tempered by trying and failing twice.
As such, in this changeset, I have started by introducing this type to the `parseError` and `parseErrorWith` functions. In the future, I would like to extend this to the `QErr` record and the various `throwError` functions, but this is a much larger task and should probably be done in stages.
For now, `toErrorMessage` and `fromErrorMessage` are provided for conversion to and from `Text`, but the intent is to stop exporting these once all error messages are converted to the new type.
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5018
GitOrigin-RevId: 84b37e238992e4312255a87ca44f41af65e2d89a
2022-07-18 23:26:01 +03:00
|
|
|
let constraint = Constraint (ConstraintName spkName) $ OID spkIndexId
|
2021-10-01 15:52:19 +03:00
|
|
|
columns = (ColumnName . spkcName) <$> spkColumns
|
|
|
|
in PrimaryKey constraint columns
|
|
|
|
|
2021-02-23 20:37:27 +03:00
|
|
|
--------------------------------------------------------------------------------
|
2022-01-03 20:16:24 +03:00
|
|
|
|
|
|
|
-- * Helpers
|
2021-02-23 20:37:27 +03:00
|
|
|
|
2021-03-31 16:48:36 +03:00
|
|
|
coalesceKeys :: [ForeignKey 'MSSQL] -> [ForeignKey 'MSSQL]
|
2023-04-26 18:42:13 +03:00
|
|
|
coalesceKeys = HashMap.elems . foldl' coalesce HashMap.empty
|
2021-03-31 16:48:36 +03:00
|
|
|
where
|
2023-04-26 18:42:13 +03:00
|
|
|
coalesce mapping fk@(ForeignKey constraint tableName _) = HashMap.insertWith combine (constraint, tableName) fk mapping
|
2022-05-10 18:43:24 +03:00
|
|
|
combine oldFK newFK = oldFK {_fkColumnMapping = (NEHashMap.union `on` _fkColumnMapping) oldFK newFK}
|