graphql-engine/server/src-lib/Hasura/Backends/MSSQL/Meta.hs
Karthikeyan Chinnakonda bea650b3e0 server/mssql: source catalog initialization for event triggers (Incremental PR - I)
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2505
Co-authored-by: Naveen Naidu <30195193+Naveenaidu@users.noreply.github.com>
GitOrigin-RevId: 56681f90cfbfcf2f99c27f08c01d32790bd03c4d
2022-02-24 08:14:10 +00:00

223 lines
7.3 KiB
Haskell

-- | Metadata related types, functions and helpers.
--
-- Provides a single function which loads the MSSQL database metadata.
-- See the file at src-rsr/mssql_table_metadata.sql for the SQL we use to build
-- this metadata.
-- See 'Hasura.RQL.Types.Table.DBTableMetadata' for the Haskell type we use forall
-- storing this metadata.
module Hasura.Backends.MSSQL.Meta
( loadDBMetadata,
)
where
import Data.Aeson as Aeson
import Data.ByteString.UTF8 qualified as BSUTF8
import Data.FileEmbed (embedFile, makeRelativeToProject)
import Data.HashMap.Strict qualified as HM
import Data.HashSet qualified as HS
import Data.String
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Database.MSSQL.Transaction qualified as Tx
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.Instances.Types ()
import Hasura.Backends.MSSQL.SQL.Error
import Hasura.Backends.MSSQL.Types.Internal
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common (OID (..))
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
--------------------------------------------------------------------------------
-- * Loader
loadDBMetadata :: (MonadIO m) => Tx.TxET QErr m (DBTablesMetadata 'MSSQL)
loadDBMetadata = do
let queryBytes = $(makeRelativeToProject "src-rsr/mssql_table_metadata.sql" >>= embedFile)
odbcQuery :: ODBC.Query = fromString . BSUTF8.toString $ queryBytes
sysTablesText <- runIdentity <$> Tx.singleRowQueryE defaultMSSQLTxErrorHandler odbcQuery
case Aeson.eitherDecodeStrict (T.encodeUtf8 sysTablesText) of
Left e -> throw500 $ T.pack $ "error loading sql server database schema: " <> e
Right sysTables -> pure $ HM.fromList $ map transformTable sysTables
--------------------------------------------------------------------------------
-- * Local types
data SysTable = SysTable
{ staName :: Text,
staObjectId :: Int,
staJoinedSysColumn :: [SysColumn],
staJoinedSysSchema :: SysSchema,
staJoinedSysPrimaryKey :: Maybe SysPrimaryKey
}
deriving (Show, Generic)
instance FromJSON SysTable where
parseJSON = genericParseJSON hasuraJSON
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
data SysSchema = SysSchema
{ ssName :: Text,
ssSchemaId :: Int
}
deriving (Show, Generic)
instance FromJSON SysSchema where
parseJSON = genericParseJSON hasuraJSON
data SysColumn = SysColumn
{ scName :: Text,
scColumnId :: Int,
scUserTypeId :: Int,
scIsNullable :: Bool,
scIsIdentity :: Bool,
scIsComputed :: Bool,
scJoinedSysType :: SysType,
scJoinedForeignKeyColumns :: [SysForeignKeyColumn]
}
deriving (Show, Generic)
instance FromJSON SysColumn where
parseJSON = genericParseJSON hasuraJSON
data SysType = SysType
{ styName :: Text,
stySchemaId :: Int,
styUserTypeId :: Int
}
deriving (Show, Generic)
instance FromJSON SysType where
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)
instance FromJSON SysForeignKeyColumn where
parseJSON = genericParseJSON hasuraJSON
--------------------------------------------------------------------------------
-- * Transform
transformTable :: SysTable -> (TableName, DBTableMetadata 'MSSQL)
transformTable tableInfo =
let schemaName = SchemaName $ ssName $ staJoinedSysSchema tableInfo
tableName = TableName (staName tableInfo) schemaName
tableOID = OID $ staObjectId tableInfo
(columns, foreignKeys) = unzip $ transformColumn <$> staJoinedSysColumn tableInfo
foreignKeysMetadata = HS.fromList $ map ForeignKeyMetadata $ coalesceKeys $ concat foreignKeys
primaryKey = transformPrimaryKey <$> staJoinedSysPrimaryKey tableInfo
identityColumns =
map (ColumnName . scName) $
filter scIsIdentity $ staJoinedSysColumn tableInfo
in ( tableName,
DBTableMetadata
tableOID
columns
primaryKey
HS.empty -- no unique constraints?
foreignKeysMetadata
Nothing -- no views, only tables
Nothing -- no description
identityColumns
)
transformColumn ::
SysColumn ->
(RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])
transformColumn columnInfo =
let rciName = ColumnName $ scName columnInfo
rciPosition = scColumnId columnInfo
rciIsNullable = scIsNullable columnInfo
rciDescription = Nothing
rciType = parseScalarType $ styName $ scJoinedSysType columnInfo
foreignKeys =
scJoinedForeignKeyColumns columnInfo <&> \foreignKeyColumn ->
let _fkConstraint = Constraint "fk_mssql" $ OID $ sfkcConstraintObjectId foreignKeyColumn
schemaName = SchemaName $ ssName $ sfkcJoinedReferencedSysSchema foreignKeyColumn
_fkForeignTable = TableName (sfkcJoinedReferencedTableName foreignKeyColumn) schemaName
_fkColumnMapping = HM.singleton rciName $ ColumnName $ sfkcJoinedReferencedColumnName foreignKeyColumn
in ForeignKey {..}
colIsImmutable = scIsComputed columnInfo || scIsIdentity columnInfo
rciMutability = ColumnMutability {_cmIsInsertable = not colIsImmutable, _cmIsUpdatable = not colIsImmutable}
in (RawColumnInfo {..}, foreignKeys)
transformPrimaryKey :: SysPrimaryKey -> PrimaryKey 'MSSQL (Column 'MSSQL)
transformPrimaryKey (SysPrimaryKey {..}) =
let constraint = Constraint spkName $ OID spkIndexId
columns = (ColumnName . spkcName) <$> spkColumns
in PrimaryKey constraint columns
--------------------------------------------------------------------------------
-- * Helpers
coalesceKeys :: [ForeignKey 'MSSQL] -> [ForeignKey 'MSSQL]
coalesceKeys = HM.elems . foldl' coalesce HM.empty
where
coalesce mapping fk@(ForeignKey constraint tableName _) = HM.insertWith combine (constraint, tableName) fk mapping
combine oldFK newFK = oldFK {_fkColumnMapping = (HM.union `on` _fkColumnMapping) oldFK newFK}
parseScalarType :: Text -> ScalarType
parseScalarType = \case
"char" -> CharType
"numeric" -> NumericType
"decimal" -> DecimalType
"money" -> DecimalType
"smallmoney" -> DecimalType
"int" -> IntegerType
"smallint" -> SmallintType
"float" -> FloatType
"real" -> RealType
"date" -> DateType
"time" -> Ss_time2Type
"varchar" -> VarcharType
"nchar" -> WcharType
"nvarchar" -> WvarcharType
"ntext" -> WtextType
"timestamp" -> TimestampType
"text" -> TextType
"binary" -> BinaryType
"bigint" -> BigintType
"tinyint" -> TinyintType
"varbinary" -> VarbinaryType
"bit" -> BitType
"uniqueidentifier" -> GuidType
"geography" -> GeographyType
"geometry" -> GeometryType
t -> UnknownType t