{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- | MSSQL DDL RunSQL
--
-- Provides primitives for running raw text SQL on MSSQL backends.
module Hasura.Backends.MSSQL.DDL.RunSQL
  ( runSQL,
    MSSQLRunSQL (..),
    isSchemaCacheBuildRequiredRunSQL,
  )
where

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Aeson qualified as J
import Data.HashMap.Strict qualified as M
import Data.HashSet qualified as HS
import Data.String (fromString)
import Data.Text qualified as T
import Database.MSSQL.Transaction qualified as Tx
import Database.ODBC.Internal qualified as ODBC
import Database.ODBC.SQLServer qualified as ODBC hiding (query)
import Hasura.Backends.MSSQL.Connection
import Hasura.Backends.MSSQL.Meta
import Hasura.Backends.MSSQL.SQL.Error
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.Diff
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata hiding (tmTable)
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.Server.Utils (quoteRegex)
import Text.Regex.TDFA qualified as TDFA

data MSSQLRunSQL = MSSQLRunSQL
  { MSSQLRunSQL -> Text
_mrsSql :: Text,
    MSSQLRunSQL -> SourceName
_mrsSource :: SourceName,
    MSSQLRunSQL -> Bool
_mrsCascade :: Bool,
    MSSQLRunSQL -> Maybe Bool
_mrsCheckMetadataConsistency :: Maybe Bool
  }
  deriving (Int -> MSSQLRunSQL -> ShowS
[MSSQLRunSQL] -> ShowS
MSSQLRunSQL -> String
(Int -> MSSQLRunSQL -> ShowS)
-> (MSSQLRunSQL -> String)
-> ([MSSQLRunSQL] -> ShowS)
-> Show MSSQLRunSQL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MSSQLRunSQL] -> ShowS
$cshowList :: [MSSQLRunSQL] -> ShowS
show :: MSSQLRunSQL -> String
$cshow :: MSSQLRunSQL -> String
showsPrec :: Int -> MSSQLRunSQL -> ShowS
$cshowsPrec :: Int -> MSSQLRunSQL -> ShowS
Show, MSSQLRunSQL -> MSSQLRunSQL -> Bool
(MSSQLRunSQL -> MSSQLRunSQL -> Bool)
-> (MSSQLRunSQL -> MSSQLRunSQL -> Bool) -> Eq MSSQLRunSQL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MSSQLRunSQL -> MSSQLRunSQL -> Bool
$c/= :: MSSQLRunSQL -> MSSQLRunSQL -> Bool
== :: MSSQLRunSQL -> MSSQLRunSQL -> Bool
$c== :: MSSQLRunSQL -> MSSQLRunSQL -> Bool
Eq)

instance J.FromJSON MSSQLRunSQL where
  parseJSON :: Value -> Parser MSSQLRunSQL
parseJSON = String
-> (Object -> Parser MSSQLRunSQL) -> Value -> Parser MSSQLRunSQL
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"MSSQLRunSQL" ((Object -> Parser MSSQLRunSQL) -> Value -> Parser MSSQLRunSQL)
-> (Object -> Parser MSSQLRunSQL) -> Value -> Parser MSSQLRunSQL
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
_mrsSql <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"sql"
    SourceName
_mrsSource <- Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
J..!= SourceName
defaultSource
    Bool
_mrsCascade <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"cascade" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
J..!= Bool
False
    Maybe Bool
_mrsCheckMetadataConsistency <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
J..:? Key
"check_metadata_consistency"
    MSSQLRunSQL -> Parser MSSQLRunSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure MSSQLRunSQL :: Text -> SourceName -> Bool -> Maybe Bool -> MSSQLRunSQL
MSSQLRunSQL {Bool
Maybe Bool
Text
SourceName
_mrsCheckMetadataConsistency :: Maybe Bool
_mrsCascade :: Bool
_mrsSource :: SourceName
_mrsSql :: Text
_mrsCheckMetadataConsistency :: Maybe Bool
_mrsCascade :: Bool
_mrsSource :: SourceName
_mrsSql :: Text
..}

instance J.ToJSON MSSQLRunSQL where
  toJSON :: MSSQLRunSQL -> Value
toJSON MSSQLRunSQL {Bool
Maybe Bool
Text
SourceName
_mrsCheckMetadataConsistency :: Maybe Bool
_mrsCascade :: Bool
_mrsSource :: SourceName
_mrsSql :: Text
_mrsCheckMetadataConsistency :: MSSQLRunSQL -> Maybe Bool
_mrsCascade :: MSSQLRunSQL -> Bool
_mrsSource :: MSSQLRunSQL -> SourceName
_mrsSql :: MSSQLRunSQL -> Text
..} =
    [Pair] -> Value
J.object
      [ Key
"sql" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Text
_mrsSql,
        Key
"source" Key -> SourceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= SourceName
_mrsSource,
        Key
"cascade" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Bool
_mrsCascade,
        Key
"check_metadata_consistency" Key -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Maybe Bool
_mrsCheckMetadataConsistency
      ]

runSQL ::
  forall m.
  (MonadIO m, MonadBaseControl IO m, CacheRWM m, MonadError QErr m, MetadataM m) =>
  MSSQLRunSQL ->
  m EncJSON
runSQL :: MSSQLRunSQL -> m EncJSON
runSQL mssqlRunSQL :: MSSQLRunSQL
mssqlRunSQL@MSSQLRunSQL {Bool
Maybe Bool
Text
SourceName
_mrsCheckMetadataConsistency :: Maybe Bool
_mrsCascade :: Bool
_mrsSource :: SourceName
_mrsSql :: Text
_mrsCheckMetadataConsistency :: MSSQLRunSQL -> Maybe Bool
_mrsCascade :: MSSQLRunSQL -> Bool
_mrsSource :: MSSQLRunSQL -> SourceName
_mrsSql :: MSSQLRunSQL -> Text
..} = do
  SourceInfo SourceName
_ TableCache 'MSSQL
tableCache FunctionCache 'MSSQL
_ SourceConfig 'MSSQL
sourceConfig Maybe QueryTagsConfig
_ SourceCustomization
_ <- SourceName -> m (SourceInfo 'MSSQL)
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MetadataM m, MonadError QErr m, Backend b) =>
SourceName -> m (SourceInfo b)
askSourceInfo @'MSSQL SourceName
_mrsSource
  [[(Column, Value)]]
results <-
    -- If the SQL modifies the schema of the database then check for any metadata changes
    if MSSQLRunSQL -> Bool
isSchemaCacheBuildRequiredRunSQL MSSQLRunSQL
mssqlRunSQL
      then do
        ([[(Column, Value)]]
results, MetadataModifier
metadataUpdater) <- SourceConfig 'MSSQL
-> TxET QErr m ([[(Column, Value)]], MetadataModifier)
-> m ([[(Column, Value)]], MetadataModifier)
forall a. SourceConfig 'MSSQL -> TxET QErr m a -> m a
runTx SourceConfig 'MSSQL
sourceConfig (TxET QErr m ([[(Column, Value)]], MetadataModifier)
 -> m ([[(Column, Value)]], MetadataModifier))
-> TxET QErr m ([[(Column, Value)]], MetadataModifier)
-> m ([[(Column, Value)]], MetadataModifier)
forall a b. (a -> b) -> a -> b
$ TableCache 'MSSQL
-> TxET QErr m ([[(Column, Value)]], MetadataModifier)
withMetadataCheck TableCache 'MSSQL
tableCache
        -- Build schema cache with updated metadata
        m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          CacheInvalidations -> MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
CacheInvalidations -> MetadataModifier -> m ()
buildSchemaCacheWithInvalidations CacheInvalidations
forall a. Monoid a => a
mempty {ciSources :: HashSet SourceName
ciSources = SourceName -> HashSet SourceName
forall a. Hashable a => a -> HashSet a
HS.singleton SourceName
_mrsSource} MetadataModifier
metadataUpdater
        [[(Column, Value)]] -> m [[(Column, Value)]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[(Column, Value)]]
results
      else SourceConfig 'MSSQL
-> TxET QErr m [[(Column, Value)]] -> m [[(Column, Value)]]
forall a. SourceConfig 'MSSQL -> TxET QErr m a -> m a
runTx SourceConfig 'MSSQL
sourceConfig TxET QErr m [[(Column, Value)]]
sqlQueryTx
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ RunSQLRes -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (RunSQLRes -> EncJSON) -> RunSQLRes -> EncJSON
forall a b. (a -> b) -> a -> b
$ [[(Column, Value)]] -> RunSQLRes
toResult [[(Column, Value)]]
results
  where
    runTx :: SourceConfig 'MSSQL -> Tx.TxET QErr m a -> m a
    runTx :: SourceConfig 'MSSQL -> TxET QErr m a -> m a
runTx SourceConfig 'MSSQL
sourceConfig =
      m (Either QErr a) -> m a
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr a) -> m a)
-> (TxET QErr m a -> m (Either QErr a)) -> TxET QErr m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSSQLSourceConfig -> TxET QErr m a -> m (Either QErr a)
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
MSSQLSourceConfig -> TxET QErr m a -> m (Either QErr a)
runMSSQLSourceWriteTx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig

    sqlQueryTx :: Tx.TxET QErr m [[(ODBC.Column, ODBC.Value)]]
    sqlQueryTx :: TxET QErr m [[(Column, Value)]]
sqlQueryTx =
      (MSSQLTxError -> QErr)
-> Text
-> (Text -> Query)
-> (Connection -> Text -> IO [[(Column, Value)]])
-> TxET QErr m [[(Column, Value)]]
forall (m :: * -> *) e query a.
MonadIO m =>
(MSSQLTxError -> e)
-> query
-> (query -> Query)
-> (Connection -> query -> IO a)
-> TxET e m a
Tx.buildGenericQueryTxE MSSQLTxError -> QErr
runSqlMSSQLTxErrorHandler Text
_mrsSql Text -> Query
textToODBCQuery Connection -> Text -> IO [[(Column, Value)]]
forall (m :: * -> *).
MonadIO m =>
Connection -> Text -> m [[(Column, Value)]]
ODBC.query
      where
        textToODBCQuery :: Text -> ODBC.Query
        textToODBCQuery :: Text -> Query
textToODBCQuery = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> (Text -> String) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

        runSqlMSSQLTxErrorHandler :: Tx.MSSQLTxError -> QErr
        runSqlMSSQLTxErrorHandler :: MSSQLTxError -> QErr
runSqlMSSQLTxErrorHandler =
          -- The SQL query is user provided. Capture all error classes as expected exceptions.
          (ErrorClass -> Bool) -> MSSQLTxError -> QErr
mkMSSQLTxErrorHandler (Bool -> ErrorClass -> Bool
forall a b. a -> b -> a
const Bool
True)

    withMetadataCheck ::
      TableCache 'MSSQL ->
      Tx.TxET QErr m ([[(ODBC.Column, ODBC.Value)]], MetadataModifier)
    withMetadataCheck :: TableCache 'MSSQL
-> TxET QErr m ([[(Column, Value)]], MetadataModifier)
withMetadataCheck TableCache 'MSSQL
tableCache = do
      [TableMeta 'MSSQL]
preActionTablesMeta <- DBTablesMetadata 'MSSQL -> [TableMeta 'MSSQL]
HashMap TableName (DBTableMetadata 'MSSQL) -> [TableMeta 'MSSQL]
toTableMeta (HashMap TableName (DBTableMetadata 'MSSQL) -> [TableMeta 'MSSQL])
-> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL))
-> TxET QErr m [TableMeta 'MSSQL]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL))
forall (m :: * -> *).
MonadIO m =>
TxET QErr m (DBTablesMetadata 'MSSQL)
loadDBMetadata
      [[(Column, Value)]]
results <- TxET QErr m [[(Column, Value)]]
sqlQueryTx
      [TableMeta 'MSSQL]
postActionTablesMeta <- DBTablesMetadata 'MSSQL -> [TableMeta 'MSSQL]
HashMap TableName (DBTableMetadata 'MSSQL) -> [TableMeta 'MSSQL]
toTableMeta (HashMap TableName (DBTableMetadata 'MSSQL) -> [TableMeta 'MSSQL])
-> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL))
-> TxET QErr m [TableMeta 'MSSQL]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxET QErr m (HashMap TableName (DBTableMetadata 'MSSQL))
forall (m :: * -> *).
MonadIO m =>
TxET QErr m (DBTablesMetadata 'MSSQL)
loadDBMetadata
      let trackedTablesMeta :: [TableMeta 'MSSQL]
trackedTablesMeta = (TableMeta 'MSSQL -> Bool)
-> [TableMeta 'MSSQL] -> [TableMeta 'MSSQL]
forall a. (a -> Bool) -> [a] -> [a]
filter ((TableName -> HashMap TableName (TableInfo 'MSSQL) -> Bool)
-> HashMap TableName (TableInfo 'MSSQL) -> TableName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip TableName -> HashMap TableName (TableInfo 'MSSQL) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
M.member TableCache 'MSSQL
HashMap TableName (TableInfo 'MSSQL)
tableCache (TableName -> Bool)
-> (TableMeta 'MSSQL -> TableName) -> TableMeta 'MSSQL -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableMeta 'MSSQL -> TableName
forall (b :: BackendType). TableMeta b -> TableName b
tmTable) [TableMeta 'MSSQL]
preActionTablesMeta
          tablesDiff :: TablesDiff 'MSSQL
tablesDiff = [TableMeta 'MSSQL] -> [TableMeta 'MSSQL] -> TablesDiff 'MSSQL
forall (b :: BackendType).
Backend b =>
[TableMeta b] -> [TableMeta b] -> TablesDiff b
getTablesDiff [TableMeta 'MSSQL]
trackedTablesMeta [TableMeta 'MSSQL]
postActionTablesMeta

      -- Get indirect dependencies
      [SchemaObjId]
indirectDeps <- SourceName -> TablesDiff 'MSSQL -> TxET QErr m [SchemaObjId]
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TablesDiff b -> m [SchemaObjId]
getIndirectDependenciesFromTableDiff SourceName
_mrsSource TablesDiff 'MSSQL
tablesDiff
      -- Report indirect dependencies, if any, when cascade is not set
      Bool -> TxET QErr m () -> TxET QErr m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SchemaObjId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SchemaObjId]
indirectDeps Bool -> Bool -> Bool
|| Bool
_mrsCascade) (TxET QErr m () -> TxET QErr m ())
-> TxET QErr m () -> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ [SchemaObjId] -> TxET QErr m ()
forall (m :: * -> *). MonadError QErr m => [SchemaObjId] -> m ()
reportDependentObjectsExist [SchemaObjId]
indirectDeps

      MetadataModifier
metadataUpdater <- WriterT MetadataModifier (TxET QErr m) ()
-> TxET QErr m MetadataModifier
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT MetadataModifier (TxET QErr m) ()
 -> TxET QErr m MetadataModifier)
-> WriterT MetadataModifier (TxET QErr m) ()
-> TxET QErr m MetadataModifier
forall a b. (a -> b) -> a -> b
$ do
        -- Purge all the indirect dependents from state
        [SchemaObjId]
-> (SchemaObjId -> WriterT MetadataModifier (TxET QErr m) ())
-> WriterT MetadataModifier (TxET QErr m) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [SchemaObjId]
indirectDeps \case
          SOSourceObj SourceName
sourceName AnyBackend SourceObjId
objectID -> do
            AnyBackend SourceObjId
-> (forall (b :: BackendType).
    BackendMetadata b =>
    SourceObjId b -> WriterT MetadataModifier (TxET QErr m) ())
-> WriterT MetadataModifier (TxET QErr m) ()
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @BackendMetadata AnyBackend SourceObjId
objectID ((forall (b :: BackendType).
  BackendMetadata b =>
  SourceObjId b -> WriterT MetadataModifier (TxET QErr m) ())
 -> WriterT MetadataModifier (TxET QErr m) ())
-> (forall (b :: BackendType).
    BackendMetadata b =>
    SourceObjId b -> WriterT MetadataModifier (TxET QErr m) ())
-> WriterT MetadataModifier (TxET QErr m) ()
forall a b. (a -> b) -> a -> b
$ SourceName
-> SourceObjId b
-> WriterT MetadataModifier (TxET QErr m) MetadataModifier
forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, Backend b) =>
SourceName -> SourceObjId b -> m MetadataModifier
purgeDependentObject SourceName
sourceName (SourceObjId b
 -> WriterT MetadataModifier (TxET QErr m) MetadataModifier)
-> (MetadataModifier -> WriterT MetadataModifier (TxET QErr m) ())
-> SourceObjId b
-> WriterT MetadataModifier (TxET QErr m) ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MetadataModifier -> WriterT MetadataModifier (TxET QErr m) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
          SchemaObjId
_ ->
            () -> WriterT MetadataModifier (TxET QErr m) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        SourceName
-> TableCache 'MSSQL
-> TablesDiff 'MSSQL
-> WriterT MetadataModifier (TxET QErr m) ()
forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRM m, MonadWriter MetadataModifier m,
 BackendMetadata b) =>
SourceName -> TableCache b -> TablesDiff b -> m ()
processTablesDiff SourceName
_mrsSource TableCache 'MSSQL
tableCache TablesDiff 'MSSQL
tablesDiff

      ([[(Column, Value)]], MetadataModifier)
-> TxET QErr m ([[(Column, Value)]], MetadataModifier)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[(Column, Value)]]
results, MetadataModifier
metadataUpdater)
      where
        toTableMeta :: DBTablesMetadata 'MSSQL -> [TableMeta 'MSSQL]
        toTableMeta :: DBTablesMetadata 'MSSQL -> [TableMeta 'MSSQL]
toTableMeta DBTablesMetadata 'MSSQL
dbTablesMeta =
          HashMap TableName (DBTableMetadata 'MSSQL)
-> [(TableName, DBTableMetadata 'MSSQL)]
forall k v. HashMap k v -> [(k, v)]
M.toList DBTablesMetadata 'MSSQL
HashMap TableName (DBTableMetadata 'MSSQL)
dbTablesMeta [(TableName, DBTableMetadata 'MSSQL)]
-> ((TableName, DBTableMetadata 'MSSQL) -> TableMeta 'MSSQL)
-> [TableMeta 'MSSQL]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(TableName
table, DBTableMetadata 'MSSQL
dbTableMeta) ->
            TableName 'MSSQL
-> DBTableMetadata 'MSSQL
-> [ComputedFieldMeta 'MSSQL]
-> TableMeta 'MSSQL
forall (b :: BackendType).
TableName b
-> DBTableMetadata b -> [ComputedFieldMeta b] -> TableMeta b
TableMeta TableName 'MSSQL
TableName
table DBTableMetadata 'MSSQL
dbTableMeta [] -- No computed fields

isSchemaCacheBuildRequiredRunSQL :: MSSQLRunSQL -> Bool
isSchemaCacheBuildRequiredRunSQL :: MSSQLRunSQL -> Bool
isSchemaCacheBuildRequiredRunSQL MSSQLRunSQL {Bool
Maybe Bool
Text
SourceName
_mrsCheckMetadataConsistency :: Maybe Bool
_mrsCascade :: Bool
_mrsSource :: SourceName
_mrsSql :: Text
_mrsCheckMetadataConsistency :: MSSQLRunSQL -> Maybe Bool
_mrsCascade :: MSSQLRunSQL -> Bool
_mrsSource :: MSSQLRunSQL -> SourceName
_mrsSql :: MSSQLRunSQL -> Text
..} =
  Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Text -> Bool
sqlContainsDDLKeyword Text
_mrsSql) Maybe Bool
_mrsCheckMetadataConsistency
  where
    sqlContainsDDLKeyword :: Text -> Bool
    sqlContainsDDLKeyword :: Text -> Bool
sqlContainsDDLKeyword =
      Regex -> Text -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
TDFA.match
        $$( quoteRegex
              TDFA.defaultCompOpt
                { TDFA.caseSensitive = False,
                  TDFA.multiline = True,
                  TDFA.lastStarGreedy = True
                }
              TDFA.defaultExecOpt
                { TDFA.captureGroups = False
                }
              "\\balter\\b|\\bdrop\\b|\\bsp_rename\\b"
          )

toResult :: [[(ODBC.Column, ODBC.Value)]] -> RunSQLRes
toResult :: [[(Column, Value)]] -> RunSQLRes
toResult [[(Column, Value)]]
result = case [[(Column, Value)]]
result of
  [] -> Text -> Value -> RunSQLRes
RunSQLRes Text
"CommandOk" Value
J.Null
  ([(Column, Value)]
firstRow : [[(Column, Value)]]
_) -> Text -> Value -> RunSQLRes
RunSQLRes Text
"TuplesOk" (Value -> RunSQLRes) -> Value -> RunSQLRes
forall a b. (a -> b) -> a -> b
$ [[Value]] -> Value
forall a. ToJSON a => a -> Value
J.toJSON ([[Value]] -> Value) -> [[Value]] -> Value
forall a b. (a -> b) -> a -> b
$ [(Column, Value)] -> [Value]
forall b. [(Column, b)] -> [Value]
toHeader [(Column, Value)]
firstRow [Value] -> [[Value]] -> [[Value]]
forall a. a -> [a] -> [a]
: [[(Column, Value)]] -> [[Value]]
forall a. [[(a, Value)]] -> [[Value]]
toRows [[(Column, Value)]]
result
  where
    toRows :: [[(a, Value)]] -> [[Value]]
toRows = ([(a, Value)] -> [Value]) -> [[(a, Value)]] -> [[Value]]
forall a b. (a -> b) -> [a] -> [b]
map (([(a, Value)] -> [Value]) -> [[(a, Value)]] -> [[Value]])
-> ([(a, Value)] -> [Value]) -> [[(a, Value)]] -> [[Value]]
forall a b. (a -> b) -> a -> b
$ ((a, Value) -> Value) -> [(a, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (((a, Value) -> Value) -> [(a, Value)] -> [Value])
-> ((a, Value) -> Value) -> [(a, Value)] -> [Value]
forall a b. (a -> b) -> a -> b
$ Value -> Value
odbcValueToJValue (Value -> Value) -> ((a, Value) -> Value) -> (a, Value) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Value) -> Value
forall a b. (a, b) -> b
snd
    toHeader :: [(Column, b)] -> [Value]
toHeader = ((Column, b) -> Value) -> [(Column, b)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (((Column, b) -> Value) -> [(Column, b)] -> [Value])
-> ((Column, b) -> Value) -> [(Column, b)] -> [Value]
forall a b. (a -> b) -> a -> b
$ Text -> Value
J.String (Text -> Value) -> ((Column, b) -> Text) -> (Column, b) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Text
ODBC.columnName (Column -> Text) -> ((Column, b) -> Column) -> (Column, b) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column, b) -> Column
forall a b. (a, b) -> a
fst