graphql-engine/server/src-lib/Hasura/Backends/MySQL/Meta.hs

module Hasura.Backends.MySQL.Meta (getMetadata) where

import           Control.Exception                     (throw)
import qualified Data.ByteString.Char8                 as B8
import           Data.FileEmbed                        (embedFile, makeRelativeToProject)
import qualified Data.HashMap.Strict                   as HM
import qualified Data.HashSet                          as HS
import qualified Data.Sequence.NonEmpty                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 qualified Language.GraphQL.Draft.Syntax         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 isTableName isTableSchema) $
    DBTableMetadata
      { _ptmiOid = OID 0
      , _ptmiColumns =
          [ RawColumnInfo
              { prciName = Column isColumnName
              , prciPosition = fromIntegral isOrdinalPosition
              , prciType = parseMySQLScalarType isColumnType -- TODO: This needs to become more precise by considering Field length and character-set
              , prciIsNullable = isIsNullable == "YES" -- ref: https://dev.mysql.com/doc/refman/8.0/en/information-schema-columns-table.html
              , prciIsIdentity = notIdentityColumn -- TODO: The identity-ness of column is not explicitly available in MySQL INFORMATION_SCHEMA.COLUMNS table.
                                                   --       Determine this value from 'EXTRA' field. Till then we assume it as not identity.
                                                   -- issue: https://github.com/hasura/graphql-engine/issues/7450
              , prciDescription = Just $ G.Description isColumnComment
              }
          ]
      , _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
                       (fromMaybe "" isReferencedTableName)
                       (fromMaybe "" 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
  -- ^ 'convertError' takes the number of expected columns for conversion as its third argument


data InformationSchemaColumnKey
  = PRI
  | UNI
  | MUL
  | BLANK -- ^ This field isn't NULLable and uses empty strings, by the looks of it.
    deriving (Show, Read, Eq, Generic)
instance Result InformationSchemaColumnKey where
  -- | ref: https://hackage.haskell.org/package/mysql-simple-0.4.5/docs/Database-MySQL-Simple-Result.html#v:convert
  -- specifies that the function is expected to throw a 'Database.MySQL.Simple.Result.ResultError'
  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)