{-# LANGUAGE ViewPatterns #-}

-- | The RQL query ('/v2/query')
module Hasura.Server.API.V2Query
  ( RQLQuery,
    queryModifiesSchema,
    runQuery,
  )
where

import Control.Concurrent.Async.Lifted (mapConcurrently)
import Control.Lens (preview, _Right)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Text qualified as T
import GHC.Generics.Extended (constrName)
import Hasura.App.State
import Hasura.Backends.BigQuery.DDL.RunSQL qualified as BigQuery
import Hasura.Backends.DataConnector.Adapter.RunSQL qualified as DataConnector
import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName, mkDataConnectorName)
import Hasura.Backends.MSSQL.DDL.RunSQL qualified as MSSQL
import Hasura.Backends.Postgres.DDL.RunSQL qualified as Postgres
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.Cache.Config
import Hasura.RQL.DML.Count
import Hasura.RQL.DML.Delete
import Hasura.RQL.DML.Insert
import Hasura.RQL.DML.Select
import Hasura.RQL.DML.Types
  ( CountQuery,
    DeleteQuery,
    InsertQuery,
    SelectQuery,
    UpdateQuery,
  )
import Hasura.RQL.DML.Update
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.SchemaCache (MetadataWithResourceVersion (MetadataWithResourceVersion), SchemaCache (scInconsistentObjs))
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.Source
import Hasura.Server.Types
import Hasura.Services
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as GQL

data RQLQuery
  = RQInsert !InsertQuery
  | RQSelect !SelectQuery
  | RQUpdate !UpdateQuery
  | RQDelete !DeleteQuery
  | RQCount !CountQuery
  | RQRunSql !Postgres.RunSQL
  | RQMssqlRunSql !MSSQL.MSSQLRunSQL
  | RQCitusRunSql !Postgres.RunSQL
  | RQCockroachRunSql !Postgres.RunSQL
  | RQBigqueryRunSql !BigQuery.BigQueryRunSQL
  | RQDataConnectorRunSql !DataConnectorName !DataConnector.DataConnectorRunSQL
  | RQBigqueryDatabaseInspection !BigQuery.BigQueryRunSQL
  | RQBulk ![RQLQuery]
  | -- | A variant of 'RQBulk' that runs a bulk of read-only queries concurrently.
    --   Asserts that queries on this lists are not modifying the schema.
    --
    --   This is mainly used by the graphql-engine console.
    RQConcurrentBulk [RQLQuery]
  deriving ((forall x. RQLQuery -> Rep RQLQuery x)
-> (forall x. Rep RQLQuery x -> RQLQuery) -> Generic RQLQuery
forall x. Rep RQLQuery x -> RQLQuery
forall x. RQLQuery -> Rep RQLQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RQLQuery -> Rep RQLQuery x
from :: forall x. RQLQuery -> Rep RQLQuery x
$cto :: forall x. Rep RQLQuery x -> RQLQuery
to :: forall x. Rep RQLQuery x -> RQLQuery
Generic)

-- | This instance has been written by hand so that "wildcard" prefixes of _run_sql can be delegated to data connectors.
instance FromJSON RQLQuery where
  parseJSON :: Value -> Parser RQLQuery
parseJSON = String -> (Object -> Parser RQLQuery) -> Value -> Parser RQLQuery
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RQLQuery" \Object
o -> do
    Text
t <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    let args :: forall a. (FromJSON a) => Parser a
        args :: forall a. FromJSON a => Parser a
args = Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"args"
        dcNameFromRunSql :: Text -> Maybe DataConnectorName
dcNameFromRunSql = Text -> Text -> Maybe Text
T.stripSuffix Text
"_run_sql" (Text -> Maybe Text)
-> (Text -> Maybe DataConnectorName)
-> Text
-> Maybe DataConnectorName
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Maybe Name
GQL.mkName (Text -> Maybe Name)
-> (Name -> Maybe DataConnectorName)
-> Text
-> Maybe DataConnectorName
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Getting
  (First DataConnectorName)
  (Either String DataConnectorName)
  DataConnectorName
-> Either String DataConnectorName -> Maybe DataConnectorName
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First DataConnectorName)
  (Either String DataConnectorName)
  DataConnectorName
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right (Either String DataConnectorName -> Maybe DataConnectorName)
-> (Name -> Either String DataConnectorName)
-> Name
-> Maybe DataConnectorName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Either String DataConnectorName
mkDataConnectorName
    case Text
t of
      Text
"insert" -> InsertQuery -> RQLQuery
RQInsert (InsertQuery -> RQLQuery) -> Parser InsertQuery -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InsertQuery
forall a. FromJSON a => Parser a
args
      Text
"select" -> SelectQuery -> RQLQuery
RQSelect (SelectQuery -> RQLQuery) -> Parser SelectQuery -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SelectQuery
forall a. FromJSON a => Parser a
args
      Text
"update" -> UpdateQuery -> RQLQuery
RQUpdate (UpdateQuery -> RQLQuery) -> Parser UpdateQuery -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UpdateQuery
forall a. FromJSON a => Parser a
args
      Text
"delete" -> DeleteQuery -> RQLQuery
RQDelete (DeleteQuery -> RQLQuery) -> Parser DeleteQuery -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DeleteQuery
forall a. FromJSON a => Parser a
args
      Text
"count" -> CountQuery -> RQLQuery
RQCount (CountQuery -> RQLQuery) -> Parser CountQuery -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CountQuery
forall a. FromJSON a => Parser a
args
      -- Optionally, we can specify a `pg_` prefix. This primarily makes some
      -- string interpolation easier in the cross-backend tests.
      Text
"run_sql" -> RunSQL -> RQLQuery
RQRunSql (RunSQL -> RQLQuery) -> Parser RunSQL -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RunSQL
forall a. FromJSON a => Parser a
args
      Text
"pg_run_sql" -> RunSQL -> RQLQuery
RQRunSql (RunSQL -> RQLQuery) -> Parser RunSQL -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RunSQL
forall a. FromJSON a => Parser a
args
      Text
"mssql_run_sql" -> MSSQLRunSQL -> RQLQuery
RQMssqlRunSql (MSSQLRunSQL -> RQLQuery) -> Parser MSSQLRunSQL -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MSSQLRunSQL
forall a. FromJSON a => Parser a
args
      Text
"citus_run_sql" -> RunSQL -> RQLQuery
RQCitusRunSql (RunSQL -> RQLQuery) -> Parser RunSQL -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RunSQL
forall a. FromJSON a => Parser a
args
      Text
"cockroach_run_sql" -> RunSQL -> RQLQuery
RQCockroachRunSql (RunSQL -> RQLQuery) -> Parser RunSQL -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RunSQL
forall a. FromJSON a => Parser a
args
      Text
"bigquery_run_sql" -> BigQueryRunSQL -> RQLQuery
RQBigqueryRunSql (BigQueryRunSQL -> RQLQuery)
-> Parser BigQueryRunSQL -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BigQueryRunSQL
forall a. FromJSON a => Parser a
args
      (Text -> Maybe DataConnectorName
dcNameFromRunSql -> Just DataConnectorName
t') -> DataConnectorName -> DataConnectorRunSQL -> RQLQuery
RQDataConnectorRunSql DataConnectorName
t' (DataConnectorRunSQL -> RQLQuery)
-> Parser DataConnectorRunSQL -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DataConnectorRunSQL
forall a. FromJSON a => Parser a
args
      Text
"bigquery_database_inspection" -> BigQueryRunSQL -> RQLQuery
RQBigqueryDatabaseInspection (BigQueryRunSQL -> RQLQuery)
-> Parser BigQueryRunSQL -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BigQueryRunSQL
forall a. FromJSON a => Parser a
args
      Text
"bulk" -> [RQLQuery] -> RQLQuery
RQBulk ([RQLQuery] -> RQLQuery) -> Parser [RQLQuery] -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [RQLQuery]
forall a. FromJSON a => Parser a
args
      Text
"concurrent_bulk" -> [RQLQuery] -> RQLQuery
RQConcurrentBulk ([RQLQuery] -> RQLQuery) -> Parser [RQLQuery] -> Parser RQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [RQLQuery]
forall a. FromJSON a => Parser a
args
      Text
_ -> String -> Parser RQLQuery
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser RQLQuery) -> String -> Parser RQLQuery
forall a b. (a -> b) -> a -> b
$ String
"Unrecognised RQLQuery type: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

runQuery ::
  ( MonadIO m,
    MonadBaseControl IO m,
    MonadError QErr m,
    HasAppEnv m,
    HasCacheStaticConfig m,
    Tracing.MonadTrace m,
    MonadMetadataStorage m,
    MonadResolveSource m,
    MonadQueryTags m,
    ProvidesHasuraServices m,
    UserInfoM m
  ) =>
  AppContext ->
  RebuildableSchemaCache ->
  RQLQuery ->
  m (EncJSON, RebuildableSchemaCache)
runQuery :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m, HasAppEnv m,
 HasCacheStaticConfig m, MonadTrace m, MonadMetadataStorage m,
 MonadResolveSource m, MonadQueryTags m, ProvidesHasuraServices m,
 UserInfoM m) =>
AppContext
-> RebuildableSchemaCache
-> RQLQuery
-> m (EncJSON, RebuildableSchemaCache)
runQuery AppContext
appContext RebuildableSchemaCache
schemaCache RQLQuery
rqlQuery = do
  AppEnv {Int
Maybe Text
Maybe PGPool
Maybe (CredentialCache AgentLicenseKey)
SamplingPolicy
HostPreference
Manager
TxIsolation
ConnParams
PGPool
Refined NonNegative Seconds
TMVar MetadataResourceVersion
ConnectionOptions
CheckFeatureFlag
ServerMetrics
EventingMode
ReadOnlyMode
MaintenanceMode ()
InstanceId
PrometheusMetrics
ShutdownLatch
LoggingSettings
LockedEventsCtx
WSConnectionInitTimeout
KeepAliveDelay
OptionalInterval
Port
SubscriptionsState
Loggers
appEnvPort :: Port
appEnvHost :: HostPreference
appEnvMetadataDbPool :: PGPool
appEnvIntrospectionDbPool :: Maybe PGPool
appEnvManager :: Manager
appEnvLoggers :: Loggers
appEnvMetadataVersionRef :: TMVar MetadataResourceVersion
appEnvInstanceId :: InstanceId
appEnvEnableMaintenanceMode :: MaintenanceMode ()
appEnvLoggingSettings :: LoggingSettings
appEnvEventingMode :: EventingMode
appEnvEnableReadOnlyMode :: ReadOnlyMode
appEnvServerMetrics :: ServerMetrics
appEnvShutdownLatch :: ShutdownLatch
appEnvMetaVersionRef :: TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: PrometheusMetrics
appEnvTraceSamplingPolicy :: SamplingPolicy
appEnvSubscriptionState :: SubscriptionsState
appEnvLockedEventsCtx :: LockedEventsCtx
appEnvConnParams :: ConnParams
appEnvTxIso :: TxIsolation
appEnvConsoleAssetsDir :: Maybe Text
appEnvConsoleSentryDsn :: Maybe Text
appEnvConnectionOptions :: ConnectionOptions
appEnvWebSocketKeepAlive :: KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: Refined NonNegative Seconds
appEnvSchemaPollInterval :: OptionalInterval
appEnvCheckFeatureFlag :: CheckFeatureFlag
appEnvLicenseKeyCache :: Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: Int
appEnvPort :: AppEnv -> Port
appEnvHost :: AppEnv -> HostPreference
appEnvMetadataDbPool :: AppEnv -> PGPool
appEnvIntrospectionDbPool :: AppEnv -> Maybe PGPool
appEnvManager :: AppEnv -> Manager
appEnvLoggers :: AppEnv -> Loggers
appEnvMetadataVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvInstanceId :: AppEnv -> InstanceId
appEnvEnableMaintenanceMode :: AppEnv -> MaintenanceMode ()
appEnvLoggingSettings :: AppEnv -> LoggingSettings
appEnvEventingMode :: AppEnv -> EventingMode
appEnvEnableReadOnlyMode :: AppEnv -> ReadOnlyMode
appEnvServerMetrics :: AppEnv -> ServerMetrics
appEnvShutdownLatch :: AppEnv -> ShutdownLatch
appEnvMetaVersionRef :: AppEnv -> TMVar MetadataResourceVersion
appEnvPrometheusMetrics :: AppEnv -> PrometheusMetrics
appEnvTraceSamplingPolicy :: AppEnv -> SamplingPolicy
appEnvSubscriptionState :: AppEnv -> SubscriptionsState
appEnvLockedEventsCtx :: AppEnv -> LockedEventsCtx
appEnvConnParams :: AppEnv -> ConnParams
appEnvTxIso :: AppEnv -> TxIsolation
appEnvConsoleAssetsDir :: AppEnv -> Maybe Text
appEnvConsoleSentryDsn :: AppEnv -> Maybe Text
appEnvConnectionOptions :: AppEnv -> ConnectionOptions
appEnvWebSocketKeepAlive :: AppEnv -> KeepAliveDelay
appEnvWebSocketConnectionInitTimeout :: AppEnv -> WSConnectionInitTimeout
appEnvGracefulShutdownTimeout :: AppEnv -> Refined NonNegative Seconds
appEnvSchemaPollInterval :: AppEnv -> OptionalInterval
appEnvCheckFeatureFlag :: AppEnv -> CheckFeatureFlag
appEnvLicenseKeyCache :: AppEnv -> Maybe (CredentialCache AgentLicenseKey)
appEnvMaxTotalHeaderLength :: AppEnv -> Int
..} <- m AppEnv
forall (m :: * -> *). HasAppEnv m => m AppEnv
askAppEnv
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ReadOnlyMode
appEnvEnableReadOnlyMode ReadOnlyMode -> ReadOnlyMode -> Bool
forall a. Eq a => a -> a -> Bool
== ReadOnlyMode
ReadOnlyModeEnabled) Bool -> Bool -> Bool
&& RQLQuery -> Bool
queryModifiesUserDB RQLQuery
rqlQuery)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Cannot run write queries when read-only mode is enabled"

  let dynamicConfig :: CacheDynamicConfig
dynamicConfig = AppContext -> CacheDynamicConfig
buildCacheDynamicConfig AppContext
appContext
  MetadataWithResourceVersion Metadata
metadata MetadataResourceVersion
currentResourceVersion <- Text
-> m MetadataWithResourceVersion -> m MetadataWithResourceVersion
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"fetchMetadata" (m MetadataWithResourceVersion -> m MetadataWithResourceVersion)
-> m MetadataWithResourceVersion -> m MetadataWithResourceVersion
forall a b. (a -> b) -> a -> b
$ m (Either QErr MetadataWithResourceVersion)
-> m MetadataWithResourceVersion
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM m (Either QErr MetadataWithResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
m (Either QErr MetadataWithResourceVersion)
fetchMetadata
  ((EncJSON
result, Metadata
updatedMetadata), RebuildableSchemaCache
modSchemaCache, CacheInvalidations
invalidations, SourcesIntrospectionStatus
sourcesIntrospection, SchemaRegistryAction
schemaRegistryAction) <-
    SQLGenCtx -> RQLQuery -> MetadataT (CacheRWT m) EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m, UserInfoM m,
 CacheRWM m, MonadTrace m, MetadataM m, MonadQueryTags m) =>
SQLGenCtx -> RQLQuery -> m EncJSON
runQueryM (AppContext -> SQLGenCtx
acSQLGenCtx AppContext
appContext) RQLQuery
rqlQuery
      -- We can use defaults here unconditionally, since there is no MD export function in V2Query
      MetadataT (CacheRWT m) EncJSON
-> (MetadataT (CacheRWT m) EncJSON
    -> CacheRWT m (EncJSON, Metadata))
-> CacheRWT m (EncJSON, Metadata)
forall a b. a -> (a -> b) -> b
& Metadata
-> MetadataDefaults
-> MetadataT (CacheRWT m) EncJSON
-> CacheRWT m (EncJSON, Metadata)
forall (m :: * -> *) a.
Metadata -> MetadataDefaults -> MetadataT m a -> m (a, Metadata)
runMetadataT Metadata
metadata (AppContext -> MetadataDefaults
acMetadataDefaults AppContext
appContext)
      CacheRWT m (EncJSON, Metadata)
-> (CacheRWT m (EncJSON, Metadata)
    -> m ((EncJSON, Metadata), RebuildableSchemaCache,
          CacheInvalidations, SourcesIntrospectionStatus,
          SchemaRegistryAction))
-> m ((EncJSON, Metadata), RebuildableSchemaCache,
      CacheInvalidations, SourcesIntrospectionStatus,
      SchemaRegistryAction)
forall a b. a -> (a -> b) -> b
& CacheDynamicConfig
-> RebuildableSchemaCache
-> CacheRWT m (EncJSON, Metadata)
-> m ((EncJSON, Metadata), RebuildableSchemaCache,
      CacheInvalidations, SourcesIntrospectionStatus,
      SchemaRegistryAction)
forall (m :: * -> *) a.
Monad m =>
CacheDynamicConfig
-> RebuildableSchemaCache
-> CacheRWT m a
-> m (a, RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
runCacheRWT CacheDynamicConfig
dynamicConfig RebuildableSchemaCache
schemaCache
  if RQLQuery -> Bool
queryModifiesSchema RQLQuery
rqlQuery
    then case MaintenanceMode ()
appEnvEnableMaintenanceMode of
      MaintenanceMode ()
MaintenanceModeDisabled -> do
        -- set modified metadata in storage
        MetadataResourceVersion
newResourceVersion <-
          Text -> m MetadataResourceVersion -> m MetadataResourceVersion
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"setMetadata"
            (m MetadataResourceVersion -> m MetadataResourceVersion)
-> m MetadataResourceVersion -> m MetadataResourceVersion
forall a b. (a -> b) -> a -> b
$ m (Either QErr MetadataResourceVersion)
-> m MetadataResourceVersion
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM
            (m (Either QErr MetadataResourceVersion)
 -> m MetadataResourceVersion)
-> m (Either QErr MetadataResourceVersion)
-> m MetadataResourceVersion
forall a b. (a -> b) -> a -> b
$ MetadataResourceVersion
-> Metadata -> m (Either QErr MetadataResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> Metadata -> m (Either QErr MetadataResourceVersion)
setMetadata MetadataResourceVersion
currentResourceVersion Metadata
updatedMetadata

        (()
_, RebuildableSchemaCache
modSchemaCache', CacheInvalidations
_, SourcesIntrospectionStatus
_, SchemaRegistryAction
_) <-
          Text
-> m ((), RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
-> m ((), RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"setMetadataResourceVersionInSchemaCache"
            (m ((), RebuildableSchemaCache, CacheInvalidations,
    SourcesIntrospectionStatus, SchemaRegistryAction)
 -> m ((), RebuildableSchemaCache, CacheInvalidations,
       SourcesIntrospectionStatus, SchemaRegistryAction))
-> m ((), RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
-> m ((), RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
forall a b. (a -> b) -> a -> b
$ MetadataResourceVersion -> CacheRWT m ()
forall (m :: * -> *). CacheRWM m => MetadataResourceVersion -> m ()
setMetadataResourceVersionInSchemaCache MetadataResourceVersion
newResourceVersion
            CacheRWT m ()
-> (CacheRWT m ()
    -> m ((), RebuildableSchemaCache, CacheInvalidations,
          SourcesIntrospectionStatus, SchemaRegistryAction))
-> m ((), RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
forall a b. a -> (a -> b) -> b
& CacheDynamicConfig
-> RebuildableSchemaCache
-> CacheRWT m ()
-> m ((), RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
forall (m :: * -> *) a.
Monad m =>
CacheDynamicConfig
-> RebuildableSchemaCache
-> CacheRWT m a
-> m (a, RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
runCacheRWT CacheDynamicConfig
dynamicConfig RebuildableSchemaCache
modSchemaCache

        -- save sources introspection to stored-introspection DB
        Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"storeSourcesIntrospection"
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> SourcesIntrospectionStatus -> MetadataResourceVersion -> m ()
forall (m :: * -> *).
(MonadIO m, MonadMetadataStorage m) =>
Logger Hasura
-> SourcesIntrospectionStatus -> MetadataResourceVersion -> m ()
saveSourcesIntrospection (Loggers -> Logger Hasura
_lsLogger Loggers
appEnvLoggers) SourcesIntrospectionStatus
sourcesIntrospection MetadataResourceVersion
newResourceVersion

        -- run schema registry action
        Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"runSchemaRegistryAction"
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ SchemaRegistryAction
-> ((MetadataResourceVersion
     -> [InconsistentMetadata] -> Metadata -> IO ())
    -> m ())
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ SchemaRegistryAction
schemaRegistryAction
          (((MetadataResourceVersion
   -> [InconsistentMetadata] -> Metadata -> IO ())
  -> m ())
 -> m ())
-> ((MetadataResourceVersion
     -> [InconsistentMetadata] -> Metadata -> IO ())
    -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \MetadataResourceVersion
-> [InconsistentMetadata] -> Metadata -> IO ()
action -> do
            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataResourceVersion
-> [InconsistentMetadata] -> Metadata -> IO ()
action MetadataResourceVersion
newResourceVersion (SchemaCache -> [InconsistentMetadata]
scInconsistentObjs (RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache RebuildableSchemaCache
modSchemaCache')) Metadata
updatedMetadata

        -- notify schema cache sync
        Text -> m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"notifySchemaCacheSync"
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM
          (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> m (Either QErr ())
notifySchemaCacheSync MetadataResourceVersion
newResourceVersion InstanceId
appEnvInstanceId CacheInvalidations
invalidations

        (EncJSON, RebuildableSchemaCache)
-> m (EncJSON, RebuildableSchemaCache)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON
result, RebuildableSchemaCache
modSchemaCache')
      MaintenanceModeEnabled () ->
        Text -> m (EncJSON, RebuildableSchemaCache)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"metadata cannot be modified in maintenance mode"
    else (EncJSON, RebuildableSchemaCache)
-> m (EncJSON, RebuildableSchemaCache)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON
result, RebuildableSchemaCache
modSchemaCache)

queryModifiesSchema :: RQLQuery -> Bool
queryModifiesSchema :: RQLQuery -> Bool
queryModifiesSchema = \case
  RQInsert InsertQuery
_ -> Bool
False
  RQSelect SelectQuery
_ -> Bool
False
  RQUpdate UpdateQuery
_ -> Bool
False
  RQDelete DeleteQuery
_ -> Bool
False
  RQCount CountQuery
_ -> Bool
False
  RQRunSql RunSQL
q -> RunSQL -> Bool
Postgres.isSchemaCacheBuildRequiredRunSQL RunSQL
q
  RQCitusRunSql RunSQL
q -> RunSQL -> Bool
Postgres.isSchemaCacheBuildRequiredRunSQL RunSQL
q
  RQCockroachRunSql RunSQL
q -> RunSQL -> Bool
Postgres.isSchemaCacheBuildRequiredRunSQL RunSQL
q
  RQMssqlRunSql MSSQLRunSQL
q -> MSSQLRunSQL -> Bool
MSSQL.isSchemaCacheBuildRequiredRunSQL MSSQLRunSQL
q
  RQBigqueryRunSql BigQueryRunSQL
_ -> Bool
False
  RQDataConnectorRunSql DataConnectorName
_ DataConnectorRunSQL
_ -> Bool
False
  RQBigqueryDatabaseInspection BigQueryRunSQL
_ -> Bool
False
  RQBulk [RQLQuery]
l -> (RQLQuery -> Bool) -> [RQLQuery] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RQLQuery -> Bool
queryModifiesSchema [RQLQuery]
l
  RQConcurrentBulk [RQLQuery]
l -> (RQLQuery -> Bool) -> [RQLQuery] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RQLQuery -> Bool
queryModifiesSchema [RQLQuery]
l

runQueryM ::
  ( MonadError QErr m,
    MonadIO m,
    MonadBaseControl IO m,
    UserInfoM m,
    CacheRWM m,
    Tracing.MonadTrace m,
    MetadataM m,
    MonadQueryTags m
  ) =>
  SQLGenCtx ->
  RQLQuery ->
  m EncJSON
runQueryM :: forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m, UserInfoM m,
 CacheRWM m, MonadTrace m, MetadataM m, MonadQueryTags m) =>
SQLGenCtx -> RQLQuery -> m EncJSON
runQueryM SQLGenCtx
sqlGen RQLQuery
rq = Text -> m EncJSON -> m EncJSON
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ RQLQuery -> String
forall a. (HasConstructor (Rep a), Generic a) => a -> String
constrName RQLQuery
rq) (m EncJSON -> m EncJSON) -> m EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ case RQLQuery
rq of
  RQInsert InsertQuery
q -> SQLGenCtx -> InsertQuery -> m EncJSON
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, MonadIO m, MonadTrace m,
 MonadBaseControl IO m, MetadataM m) =>
SQLGenCtx -> InsertQuery -> m EncJSON
runInsert SQLGenCtx
sqlGen InsertQuery
q
  RQSelect SelectQuery
q -> SQLGenCtx -> SelectQuery -> m EncJSON
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, MonadIO m, MonadBaseControl IO m,
 MonadTrace m, MetadataM m) =>
SQLGenCtx -> SelectQuery -> m EncJSON
runSelect SQLGenCtx
sqlGen SelectQuery
q
  RQUpdate UpdateQuery
q -> SQLGenCtx -> UpdateQuery -> m EncJSON
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, MonadBaseControl IO m, MonadIO m,
 MonadTrace m, MetadataM m) =>
SQLGenCtx -> UpdateQuery -> m EncJSON
runUpdate SQLGenCtx
sqlGen UpdateQuery
q
  RQDelete DeleteQuery
q -> SQLGenCtx -> DeleteQuery -> m EncJSON
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, MonadIO m, MonadTrace m,
 MonadBaseControl IO m, MetadataM m) =>
SQLGenCtx -> DeleteQuery -> m EncJSON
runDelete SQLGenCtx
sqlGen DeleteQuery
q
  RQCount CountQuery
q -> CountQuery -> m EncJSON
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, MonadIO m, MonadBaseControl IO m,
 MonadTrace m, MetadataM m) =>
CountQuery -> m EncJSON
runCount CountQuery
q
  RQRunSql RunSQL
q -> forall (pgKind :: PostgresKind) (m :: * -> *).
(BackendMetadata ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 FetchTableMetadata pgKind, FetchFunctionMetadata pgKind,
 CacheRWM m, MetadataM m, MonadBaseControl IO m, MonadError QErr m,
 MonadIO m, MonadTrace m, UserInfoM m) =>
SQLGenCtx -> RunSQL -> m EncJSON
Postgres.runRunSQL @'Vanilla SQLGenCtx
sqlGen RunSQL
q
  RQMssqlRunSql MSSQLRunSQL
q -> MSSQLRunSQL -> m EncJSON
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, CacheRWM m, MonadError QErr m,
 MetadataM m) =>
MSSQLRunSQL -> m EncJSON
MSSQL.runSQL MSSQLRunSQL
q
  RQCitusRunSql RunSQL
q -> forall (pgKind :: PostgresKind) (m :: * -> *).
(BackendMetadata ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 FetchTableMetadata pgKind, FetchFunctionMetadata pgKind,
 CacheRWM m, MetadataM m, MonadBaseControl IO m, MonadError QErr m,
 MonadIO m, MonadTrace m, UserInfoM m) =>
SQLGenCtx -> RunSQL -> m EncJSON
Postgres.runRunSQL @'Citus SQLGenCtx
sqlGen RunSQL
q
  RQCockroachRunSql RunSQL
q -> forall (pgKind :: PostgresKind) (m :: * -> *).
(BackendMetadata ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 FetchTableMetadata pgKind, FetchFunctionMetadata pgKind,
 CacheRWM m, MetadataM m, MonadBaseControl IO m, MonadError QErr m,
 MonadIO m, MonadTrace m, UserInfoM m) =>
SQLGenCtx -> RunSQL -> m EncJSON
Postgres.runRunSQL @'Cockroach SQLGenCtx
sqlGen RunSQL
q
  RQBigqueryRunSql BigQueryRunSQL
q -> BigQueryRunSQL -> m EncJSON
forall (m :: * -> *).
(MonadIO m, CacheRWM m, MonadError QErr m, MetadataM m) =>
BigQueryRunSQL -> m EncJSON
BigQuery.runSQL BigQueryRunSQL
q
  RQDataConnectorRunSql DataConnectorName
t DataConnectorRunSQL
q -> DataConnectorName -> DataConnectorRunSQL -> m EncJSON
forall (m :: * -> *).
(MonadIO m, CacheRWM m, MonadError QErr m, MetadataM m) =>
DataConnectorName -> DataConnectorRunSQL -> m EncJSON
DataConnector.runSQL DataConnectorName
t DataConnectorRunSQL
q
  RQBigqueryDatabaseInspection BigQueryRunSQL
q -> BigQueryRunSQL -> m EncJSON
forall (m :: * -> *).
(MonadIO m, CacheRWM m, MonadError QErr m, MetadataM m) =>
BigQueryRunSQL -> m EncJSON
BigQuery.runDatabaseInspection BigQueryRunSQL
q
  RQBulk [RQLQuery]
l -> [EncJSON] -> EncJSON
encJFromList ([EncJSON] -> EncJSON) -> m [EncJSON] -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RQLQuery -> m EncJSON) -> [RQLQuery] -> m [EncJSON]
forall (m :: * -> *) a b. QErrM m => (a -> m b) -> [a] -> m [b]
indexedMapM (SQLGenCtx -> RQLQuery -> m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m, UserInfoM m,
 CacheRWM m, MonadTrace m, MetadataM m, MonadQueryTags m) =>
SQLGenCtx -> RQLQuery -> m EncJSON
runQueryM SQLGenCtx
sqlGen) [RQLQuery]
l
  RQConcurrentBulk [RQLQuery]
l -> do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RQLQuery -> Bool
queryModifiesSchema RQLQuery
rq)
      (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"Only read-only queries are allowed in a concurrent_bulk"
    [EncJSON] -> EncJSON
encJFromList ([EncJSON] -> EncJSON) -> m [EncJSON] -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RQLQuery -> m EncJSON) -> [RQLQuery] -> m [EncJSON]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadBaseControl IO m) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently (SQLGenCtx -> RQLQuery -> m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m, UserInfoM m,
 CacheRWM m, MonadTrace m, MetadataM m, MonadQueryTags m) =>
SQLGenCtx -> RQLQuery -> m EncJSON
runQueryM SQLGenCtx
sqlGen) [RQLQuery]
l

queryModifiesUserDB :: RQLQuery -> Bool
queryModifiesUserDB :: RQLQuery -> Bool
queryModifiesUserDB = \case
  RQInsert InsertQuery
_ -> Bool
True
  RQSelect SelectQuery
_ -> Bool
False
  RQUpdate UpdateQuery
_ -> Bool
True
  RQDelete DeleteQuery
_ -> Bool
True
  RQCount CountQuery
_ -> Bool
False
  RQRunSql RunSQL
runsql -> Bool -> Bool
not (RunSQL -> Bool
Postgres.isReadOnly RunSQL
runsql)
  RQCitusRunSql RunSQL
runsql -> Bool -> Bool
not (RunSQL -> Bool
Postgres.isReadOnly RunSQL
runsql)
  RQCockroachRunSql RunSQL
runsql -> Bool -> Bool
not (RunSQL -> Bool
Postgres.isReadOnly RunSQL
runsql)
  RQMssqlRunSql MSSQLRunSQL
_ -> Bool
True
  RQBigqueryRunSql BigQueryRunSQL
_ -> Bool
True
  RQDataConnectorRunSql DataConnectorName
_ DataConnectorRunSQL
_ -> Bool
True
  RQBigqueryDatabaseInspection BigQueryRunSQL
_ -> Bool
False
  RQBulk [RQLQuery]
q -> (RQLQuery -> Bool) -> [RQLQuery] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RQLQuery -> Bool
queryModifiesUserDB [RQLQuery]
q
  RQConcurrentBulk [RQLQuery]
_ -> Bool
False