{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ViewPatterns #-}

module Hasura.Backends.MSSQL.Schema.Introspection
  ( listAllTables,
  )
where

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.String.Interpolate (i)
import Database.MSSQL.Transaction (multiRowQueryE)
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.Connection (runMSSQLSourceWriteTx)
import Hasura.Backends.MSSQL.SQL.Error (defaultMSSQLTxErrorHandler)
import Hasura.Backends.MSSQL.Types (SchemaName (..), TableName (..))
import Hasura.Base.Error (QErr, prefixQErr)
import Hasura.Prelude
import Hasura.RQL.Types.BackendType (BackendType (MSSQL))
import Hasura.RQL.Types.Common (SourceName)
import Hasura.RQL.Types.Metadata (MetadataM)
import Hasura.RQL.Types.SchemaCache (CacheRM, askSourceConfig)

-- | List all tables, tracked or untracked, on a given data source.
listAllTables :: (CacheRM m, MetadataM m, MonadBaseControl IO m, MonadError QErr m, MonadIO m) => SourceName -> m [TableName]
listAllTables :: forall (m :: * -> *).
(CacheRM m, MetadataM m, MonadBaseControl IO m, MonadError QErr m,
 MonadIO m) =>
SourceName -> m [TableName]
listAllTables SourceName
sourceName = do
  MSSQLSourceConfig
sourceConfig <- forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @'MSSQL SourceName
sourceName

  let listAllTablesSql :: ODBC.Query
      listAllTablesSql :: Query
listAllTablesSql =
        [i|
          select table_name, table_schema
          from information_schema.tables
          where table_schema not in (
            'guest', 'INFORMATION_SCHEMA', 'sys', 'db_owner', 'db_securityadmin', 'db_accessadmin', 'db_backupoperator', 'db_ddladmin', 'db_datawriter', 'db_datareader', 'db_denydatawriter', 'db_denydatareader', 'hdb_catalog'
          );
        |]

  [(Text, Text)]
results :: [(Text, Text)] <-
    MSSQLSourceConfig
-> TxET QErr m [(Text, Text)] -> m (Either QErr [(Text, Text)])
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
MSSQLSourceConfig -> TxET QErr m a -> m (Either QErr a)
runMSSQLSourceWriteTx MSSQLSourceConfig
sourceConfig ((MSSQLTxError -> QErr) -> Query -> TxET QErr m [(Text, Text)]
forall (m :: * -> *) a e.
(MonadIO m, FromRow a) =>
(MSSQLTxError -> e) -> Query -> TxET e m [a]
multiRowQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler Query
listAllTablesSql)
      m (Either QErr [(Text, Text)])
-> (QErr -> m [(Text, Text)]) -> m [(Text, Text)]
forall (m :: * -> *) e a.
Monad m =>
m (Either e a) -> (e -> m a) -> m a
`onLeftM` \QErr
err -> QErr -> m [(Text, Text)]
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> QErr -> QErr
prefixQErr Text
"failed to fetch source tables: " QErr
err)

  [TableName] -> m [TableName]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TableName {Text
SchemaName
tableName :: Text
tableSchema :: SchemaName
$sel:tableName:TableName :: Text
$sel:tableSchema:TableName :: SchemaName
..} | (Text
tableName, Text -> SchemaName
SchemaName -> SchemaName
tableSchema) <- [(Text, Text)]
results]