mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-19 13:31:43 +03:00
647231b685
Manually enables: * EmptyCase * ExistentialQuantification * QuantifiedConstraints * QuasiQuotes * TemplateHaskell * TypeFamilyDependencies ...in the following components: * 'graphql-engine' library * 'graphql-engine' 'src-test' * 'graphql-engine' 'tests/integration' * 'graphql-engine' tests-hspec' Additionally, performs some light refactoring and documentation. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3991 GitOrigin-RevId: 514477d3466b01f60eca8935d0fef60dd0756838
221 lines
8.2 KiB
Haskell
221 lines
8.2 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Hasura.Backends.MySQL.Meta
|
|
( getMetadata,
|
|
)
|
|
where
|
|
|
|
import Control.Exception (throw)
|
|
import Data.ByteString.Char8 qualified as B8
|
|
import Data.FileEmbed (embedFile, makeRelativeToProject)
|
|
import Data.HashMap.Strict qualified as HM
|
|
import Data.HashSet qualified as HS
|
|
import Data.Sequence.NonEmpty qualified as SNE
|
|
import Data.String (fromString)
|
|
import Database.MySQL.Base (Connection)
|
|
import Database.MySQL.Base.Types (Field (..))
|
|
import Database.MySQL.Simple (Only (Only), query)
|
|
import Database.MySQL.Simple.QueryResults (QueryResults (..), convertError)
|
|
import Database.MySQL.Simple.Result (Result, ResultError (..), convert)
|
|
import Hasura.Backends.MySQL.Instances.Types ()
|
|
import Hasura.Backends.MySQL.Types
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types.Column
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RQL.Types.Table
|
|
import Hasura.SQL.Backend
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
getMetadata :: ConnSourceConfig -> Connection -> IO (DBTablesMetadata 'MySQL)
|
|
getMetadata ConnSourceConfig {_cscDatabase} scConnection = do
|
|
let sql = $(makeRelativeToProject "src-rsr/mysql_table_metadata.sql" >>= embedFile)
|
|
results :: [InformationSchema] <- query scConnection (fromString . B8.unpack $ sql) (Only _cscDatabase)
|
|
pure (mkMetadata results)
|
|
|
|
mkMetadata :: [InformationSchema] -> DBTablesMetadata 'MySQL
|
|
mkMetadata = foldr mergeMetadata HM.empty
|
|
|
|
mergeMetadata :: InformationSchema -> DBTablesMetadata 'MySQL -> DBTablesMetadata 'MySQL
|
|
mergeMetadata InformationSchema {..} =
|
|
HM.insertWith
|
|
mergeDBTableMetadata
|
|
(TableName {name = isTableName, schema = pure isTableSchema})
|
|
$ DBTableMetadata
|
|
{ _ptmiOid = OID 0,
|
|
_ptmiColumns =
|
|
[ RawColumnInfo
|
|
{ rciName = Column isColumnName,
|
|
rciPosition = fromIntegral isOrdinalPosition,
|
|
rciType = parseMySQLScalarType isColumnType, -- TODO: This needs to become more precise by considering Field length and character-set
|
|
rciIsNullable = isIsNullable == "YES", -- ref: https://dev.mysql.com/doc/refman/8.0/en/information-schema-columns-table.html
|
|
rciDescription = Just $ G.Description isColumnComment,
|
|
rciMutability = ColumnMutability {_cmIsInsertable = True, _cmIsUpdatable = True}
|
|
}
|
|
],
|
|
_ptmiPrimaryKey =
|
|
if isColumnKey == PRI
|
|
then
|
|
Just $
|
|
PrimaryKey
|
|
( Constraint
|
|
(ConstraintName $ fromMaybe "" isConstraintName)
|
|
(OID $ fromIntegral $ fromMaybe 0 isConstraintOrdinalPosition)
|
|
)
|
|
(SNE.singleton (Column isColumnName))
|
|
else Nothing,
|
|
_ptmiUniqueConstraints =
|
|
if isColumnKey == UNI
|
|
then
|
|
HS.singleton
|
|
( Constraint
|
|
(ConstraintName $ fromMaybe "" isConstraintName)
|
|
(OID $ fromIntegral $ fromMaybe 0 isConstraintOrdinalPosition)
|
|
)
|
|
else HS.empty,
|
|
_ptmiForeignKeys =
|
|
if isColumnKey == MUL
|
|
then
|
|
HS.singleton
|
|
( ForeignKeyMetadata
|
|
( ForeignKey
|
|
( Constraint
|
|
(ConstraintName $ fromMaybe "" isConstraintName)
|
|
(OID $ fromIntegral $ fromMaybe 0 isConstraintOrdinalPosition)
|
|
)
|
|
( TableName
|
|
{ name = (fromMaybe "" isReferencedTableName),
|
|
schema = isReferencedTableSchema
|
|
}
|
|
)
|
|
( HM.singleton
|
|
(Column isColumnName)
|
|
(Column $ fromMaybe "" isReferencedColumnName)
|
|
)
|
|
)
|
|
)
|
|
else HS.empty,
|
|
_ptmiViewInfo = Nothing,
|
|
_ptmiDescription = Nothing,
|
|
_ptmiExtraTableMetadata = ()
|
|
}
|
|
|
|
mergeDBTableMetadata :: DBTableMetadata 'MySQL -> DBTableMetadata 'MySQL -> DBTableMetadata 'MySQL
|
|
mergeDBTableMetadata new existing =
|
|
DBTableMetadata
|
|
{ _ptmiOid = OID 0,
|
|
_ptmiColumns = _ptmiColumns existing <> _ptmiColumns new,
|
|
_ptmiPrimaryKey = _ptmiPrimaryKey existing <|> _ptmiPrimaryKey new, -- Only one column can be a PRIMARY KEY, so this is just a courtesy choice.
|
|
_ptmiUniqueConstraints = _ptmiUniqueConstraints existing <> _ptmiUniqueConstraints new, -- union
|
|
_ptmiForeignKeys = _ptmiForeignKeys existing <> _ptmiForeignKeys new, -- union
|
|
_ptmiViewInfo = _ptmiViewInfo existing <|> _ptmiViewInfo new,
|
|
_ptmiDescription = _ptmiDescription existing <|> _ptmiDescription new,
|
|
_ptmiExtraTableMetadata = ()
|
|
}
|
|
|
|
data InformationSchema = InformationSchema
|
|
{ isTableSchema :: !Text,
|
|
isTableName :: !Text,
|
|
isColumnName :: !Text,
|
|
isOrdinalPosition :: !Word,
|
|
isColumnDefault :: !(Maybe Text),
|
|
isIsNullable :: !Text,
|
|
isDataType :: !(Maybe Text),
|
|
isColumnType :: !Text,
|
|
isColumnKey :: !InformationSchemaColumnKey,
|
|
isColumnComment :: !Text,
|
|
isConstraintName :: !(Maybe Text),
|
|
isConstraintOrdinalPosition :: !(Maybe Word),
|
|
isPositionInUniqueConstraint :: !(Maybe Word),
|
|
isReferencedTableSchema :: !(Maybe Text),
|
|
isReferencedTableName :: !(Maybe Text),
|
|
isReferencedColumnName :: !(Maybe Text)
|
|
}
|
|
deriving (Show, Eq, Generic)
|
|
|
|
instance QueryResults InformationSchema where
|
|
convertResults
|
|
[ fisTableSchema,
|
|
fisTableName,
|
|
fisColumnName,
|
|
fisOrdinalPosition,
|
|
fisColumnDefault,
|
|
fisIsNullable,
|
|
fisDataType,
|
|
fisColumnType,
|
|
fisColumnKey,
|
|
fisColumnComment,
|
|
fisConstraintName,
|
|
fisConstraintOrdinalPosition,
|
|
fisPositionInUniqueConstraint,
|
|
fisReferencedTableSchema,
|
|
fisReferencedTableName,
|
|
fisReferencedColumnName
|
|
]
|
|
[ visTableSchema,
|
|
visTableName,
|
|
visColumnName,
|
|
visOrdinalPosition,
|
|
visColumnDefault,
|
|
visIsNullable,
|
|
visDataType,
|
|
visColumnType,
|
|
visColumnKey,
|
|
visColumnComment,
|
|
visConstraintName,
|
|
visConstraintOrdinalPosition,
|
|
visPositionInUniqueConstraint,
|
|
visReferencedTableSchema,
|
|
visReferencedTableName,
|
|
visReferencedColumnName
|
|
] =
|
|
InformationSchema
|
|
(convert fisTableSchema visTableSchema)
|
|
(convert fisTableName visTableName)
|
|
(convert fisColumnName visColumnName)
|
|
(convert fisOrdinalPosition visOrdinalPosition)
|
|
(convert fisColumnDefault visColumnDefault)
|
|
(convert fisIsNullable visIsNullable)
|
|
(convert fisDataType visDataType)
|
|
(convert fisColumnType visColumnType)
|
|
(convert fisColumnKey visColumnKey)
|
|
(convert fisColumnComment visColumnComment)
|
|
(convert fisConstraintName visConstraintName)
|
|
(convert fisConstraintOrdinalPosition visConstraintOrdinalPosition)
|
|
(convert fisPositionInUniqueConstraint visPositionInUniqueConstraint)
|
|
(convert fisReferencedTableSchema visReferencedTableSchema)
|
|
(convert fisReferencedTableName visReferencedTableName)
|
|
(convert fisReferencedColumnName visReferencedColumnName)
|
|
convertResults fs vs = convertError fs vs 16
|
|
|
|
data InformationSchemaColumnKey
|
|
= PRI
|
|
| UNI
|
|
| MUL
|
|
| -- | This field isn't NULLable and uses empty strings, by the looks of it.
|
|
BLANK
|
|
deriving (Show, Read, Eq, Generic)
|
|
|
|
instance Result InformationSchemaColumnKey where
|
|
convert f mbs =
|
|
case mbs of
|
|
Nothing ->
|
|
throw $
|
|
UnexpectedNull
|
|
(show $ fieldType f)
|
|
"InformationSchemaColumnKey"
|
|
(B8.unpack $ fieldName f)
|
|
"COLUMN_KEY in INFORMATION_SCHEMA cannot be NULL"
|
|
Just bs -> case bs of
|
|
-- Could have used 'readMaybe' here, but we need the specific errors.
|
|
"PRI" -> PRI -- primary key
|
|
"UNI" -> UNI -- unique key
|
|
"MUL" -> MUL -- foreign key (`MUL`tiple allowed, non-unique key)
|
|
"" -> BLANK
|
|
x ->
|
|
throw $
|
|
ConversionFailed
|
|
(show $ fieldType f)
|
|
"InformationSchemaColumnKey"
|
|
(B8.unpack $ fieldName f)
|
|
("COLUMN_KEY in INFORMATION_SCHEMA has value extraneous to the expected ENUM: " <> B8.unpack x)
|