{-# LANGUAGE TemplateHaskell #-}

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

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Environment qualified as Env
import Data.Text qualified as T
import GHC.Generics.Extended (constrName)
import Hasura.Backends.BigQuery.DDL.RunSQL qualified as BigQuery
import Hasura.Backends.MSSQL.DDL.RunSQL qualified as MSSQL
import Hasura.Backends.MySQL.SQL qualified as MySQL
import Hasura.Backends.Postgres.DDL.RunSQL qualified as Postgres
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Execute.Backend
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.RQL.DDL.Schema
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
import Hasura.RQL.DML.Update
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Run
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.Source
import Hasura.SQL.Backend
import Hasura.Server.Types
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Network.HTTP.Client qualified as HTTP

data RQLQuery
  = RQInsert !InsertQuery
  | RQSelect !SelectQuery
  | RQUpdate !UpdateQuery
  | RQDelete !DeleteQuery
  | RQCount !CountQuery
  | RQRunSql !Postgres.RunSQL
  | RQMssqlRunSql !MSSQL.MSSQLRunSQL
  | RQCitusRunSql !Postgres.RunSQL
  | RQCockroachRunSql !Postgres.RunSQL
  | RQMysqlRunSql !MySQL.RunSQL
  | RQBigqueryRunSql !BigQuery.BigQueryRunSQL
  | RQBigqueryDatabaseInspection !BigQuery.BigQueryRunSQL
  | RQBulk ![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
$cto :: forall x. Rep RQLQuery x -> RQLQuery
$cfrom :: forall x. RQLQuery -> Rep RQLQuery x
Generic)

$( deriveFromJSON
     defaultOptions
       { constructorTagModifier = snakeCase . drop 2,
         sumEncoding = TaggedObject "type" "args"
       }
     ''RQLQuery
 )

runQuery ::
  ( MonadIO m,
    MonadBaseControl IO m,
    Tracing.MonadTrace m,
    MonadMetadataStorage m,
    MonadResolveSource m,
    MonadQueryTags m
  ) =>
  Env.Environment ->
  InstanceId ->
  UserInfo ->
  RebuildableSchemaCache ->
  HTTP.Manager ->
  ServerConfigCtx ->
  RQLQuery ->
  m (EncJSON, RebuildableSchemaCache)
runQuery :: Environment
-> InstanceId
-> UserInfo
-> RebuildableSchemaCache
-> Manager
-> ServerConfigCtx
-> RQLQuery
-> m (EncJSON, RebuildableSchemaCache)
runQuery Environment
env InstanceId
instanceId UserInfo
userInfo RebuildableSchemaCache
schemaCache Manager
httpManager ServerConfigCtx
serverConfigCtx RQLQuery
rqlQuery = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ServerConfigCtx -> ReadOnlyMode
_sccReadOnlyMode ServerConfigCtx
serverConfigCtx 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"

  (Metadata
metadata, MetadataResourceVersion
currentResourceVersion) <- Text
-> m (Metadata, MetadataResourceVersion)
-> m (Metadata, MetadataResourceVersion)
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
Tracing.trace Text
"fetchMetadata" m (Metadata, MetadataResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
m (Metadata, MetadataResourceVersion)
fetchMetadata
  (EncJSON, RebuildableSchemaCache, CacheInvalidations, Metadata)
result <-
    Environment -> RQLQuery -> MetadataT (CacheRWT (RunT m)) EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m, UserInfoM m,
 CacheRWM m, HasServerConfigCtx m, MonadTrace m, MetadataM m,
 MonadQueryTags m) =>
Environment -> RQLQuery -> m EncJSON
runQueryM Environment
env RQLQuery
rqlQuery MetadataT (CacheRWT (RunT m)) EncJSON
-> (MetadataT (CacheRWT (RunT m)) EncJSON
    -> m (EncJSON, RebuildableSchemaCache, CacheInvalidations,
          Metadata))
-> m (EncJSON, RebuildableSchemaCache, CacheInvalidations,
      Metadata)
forall a b. a -> (a -> b) -> b
& \MetadataT (CacheRWT (RunT m)) EncJSON
x -> do
      ((EncJSON
js, Metadata
meta), RebuildableSchemaCache
rsc, CacheInvalidations
ci) <-
        MetadataT (CacheRWT (RunT m)) EncJSON
x MetadataT (CacheRWT (RunT m)) EncJSON
-> (MetadataT (CacheRWT (RunT m)) EncJSON
    -> CacheRWT (RunT m) (EncJSON, Metadata))
-> CacheRWT (RunT m) (EncJSON, Metadata)
forall a b. a -> (a -> b) -> b
& Metadata
-> MetadataT (CacheRWT (RunT m)) EncJSON
-> CacheRWT (RunT m) (EncJSON, Metadata)
forall (m :: * -> *) a.
Metadata -> MetadataT m a -> m (a, Metadata)
runMetadataT Metadata
metadata
          CacheRWT (RunT m) (EncJSON, Metadata)
-> (CacheRWT (RunT m) (EncJSON, Metadata)
    -> RunT
         m
         ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations))
-> RunT
     m ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
forall a b. a -> (a -> b) -> b
& RebuildableSchemaCache
-> CacheRWT (RunT m) (EncJSON, Metadata)
-> RunT
     m ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
forall (m :: * -> *) a.
Functor m =>
RebuildableSchemaCache
-> CacheRWT m a
-> m (a, RebuildableSchemaCache, CacheInvalidations)
runCacheRWT RebuildableSchemaCache
schemaCache
          RunT
  m ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
-> (RunT
      m ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
    -> ExceptT
         QErr
         m
         ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations))
-> ExceptT
     QErr
     m
     ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
forall a b. a -> (a -> b) -> b
& RunCtx
-> RunT
     m ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
-> ExceptT
     QErr
     m
     ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
forall (m :: * -> *) a. RunCtx -> RunT m a -> ExceptT QErr m a
peelRun RunCtx
runCtx
          ExceptT
  QErr
  m
  ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
-> (ExceptT
      QErr
      m
      ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
    -> m (Either
            QErr
            ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)))
-> m (Either
        QErr
        ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations))
forall a b. a -> (a -> b) -> b
& ExceptT
  QErr
  m
  ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations)
-> m (Either
        QErr
        ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
          m (Either
     QErr
     ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations))
-> (m (Either
         QErr
         ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations))
    -> m ((EncJSON, Metadata), RebuildableSchemaCache,
          CacheInvalidations))
-> m ((EncJSON, Metadata), RebuildableSchemaCache,
      CacheInvalidations)
forall a b. a -> (a -> b) -> b
& m (Either
     QErr
     ((EncJSON, Metadata), RebuildableSchemaCache, CacheInvalidations))
-> m ((EncJSON, Metadata), RebuildableSchemaCache,
      CacheInvalidations)
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM
      (EncJSON, RebuildableSchemaCache, CacheInvalidations, Metadata)
-> m (EncJSON, RebuildableSchemaCache, CacheInvalidations,
      Metadata)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON
js, RebuildableSchemaCache
rsc, CacheInvalidations
ci, Metadata
meta)
  MetadataResourceVersion
-> (EncJSON, RebuildableSchemaCache, CacheInvalidations, Metadata)
-> m (EncJSON, RebuildableSchemaCache)
withReload MetadataResourceVersion
currentResourceVersion (EncJSON, RebuildableSchemaCache, CacheInvalidations, Metadata)
result
  where
    runCtx :: RunCtx
runCtx = UserInfo -> Manager -> ServerConfigCtx -> RunCtx
RunCtx UserInfo
userInfo Manager
httpManager ServerConfigCtx
serverConfigCtx

    withReload :: MetadataResourceVersion
-> (EncJSON, RebuildableSchemaCache, CacheInvalidations, Metadata)
-> m (EncJSON, RebuildableSchemaCache)
withReload MetadataResourceVersion
currentResourceVersion (EncJSON
result, RebuildableSchemaCache
updatedCache, CacheInvalidations
invalidations, Metadata
updatedMetadata) = do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RQLQuery -> Bool
queryModifiesSchema RQLQuery
rqlQuery) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        case ServerConfigCtx -> MaintenanceMode ()
_sccMaintenanceMode ServerConfigCtx
serverConfigCtx of
          MaintenanceMode ()
MaintenanceModeDisabled -> do
            -- set modified metadata in storage
            MetadataResourceVersion
newResourceVersion <-
              Text -> m MetadataResourceVersion -> m MetadataResourceVersion
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
Tracing.trace Text
"setMetadata" (m MetadataResourceVersion -> m MetadataResourceVersion)
-> m MetadataResourceVersion -> m MetadataResourceVersion
forall a b. (a -> b) -> a -> b
$
                MetadataResourceVersion -> Metadata -> m MetadataResourceVersion
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion -> Metadata -> m MetadataResourceVersion
setMetadata MetadataResourceVersion
currentResourceVersion Metadata
updatedMetadata
            -- notify schema cache sync
            Text -> m () -> m ()
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
Tracing.trace Text
"notifySchemaCacheSync" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
              MetadataResourceVersion -> InstanceId -> CacheInvalidations -> m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion -> InstanceId -> CacheInvalidations -> m ()
notifySchemaCacheSync MetadataResourceVersion
newResourceVersion InstanceId
instanceId CacheInvalidations
invalidations
          MaintenanceModeEnabled () ->
            Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"metadata cannot be modified in maintenance mode"
      (EncJSON, RebuildableSchemaCache)
-> m (EncJSON, RebuildableSchemaCache)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON
result, RebuildableSchemaCache
updatedCache)

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
  RQMysqlRunSql RunSQL
_ -> Bool
False
  RQBigqueryRunSql BigQueryRunSQL
_ -> 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

runQueryM ::
  ( MonadError QErr m,
    MonadIO m,
    MonadBaseControl IO m,
    UserInfoM m,
    CacheRWM m,
    HasServerConfigCtx m,
    Tracing.MonadTrace m,
    MetadataM m,
    MonadQueryTags m
  ) =>
  Env.Environment ->
  RQLQuery ->
  m EncJSON
runQueryM :: Environment -> RQLQuery -> m EncJSON
runQueryM Environment
env RQLQuery
rq = Text -> m EncJSON -> m EncJSON
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
Tracing.trace (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 -> InsertQuery -> m EncJSON
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, HasServerConfigCtx m, MonadIO m,
 MonadTrace m, MonadBaseControl IO m, MetadataM m) =>
InsertQuery -> m EncJSON
runInsert InsertQuery
q
  RQSelect SelectQuery
q -> SelectQuery -> m EncJSON
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, HasServerConfigCtx m, MonadIO m,
 MonadBaseControl IO m, MonadTrace m, MetadataM m) =>
SelectQuery -> m EncJSON
runSelect SelectQuery
q
  RQUpdate UpdateQuery
q -> UpdateQuery -> m EncJSON
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, HasServerConfigCtx m,
 MonadBaseControl IO m, MonadIO m, MonadTrace m, MetadataM m) =>
UpdateQuery -> m EncJSON
runUpdate UpdateQuery
q
  RQDelete DeleteQuery
q -> DeleteQuery -> m EncJSON
forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRM m, HasServerConfigCtx m, MonadIO m,
 MonadTrace m, MonadBaseControl IO m, MetadataM m) =>
DeleteQuery -> m EncJSON
runDelete 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 -> RunSQL -> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(BackendMetadata ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 FetchTableMetadata pgKind, FetchFunctionMetadata pgKind,
 CacheRWM m, HasServerConfigCtx m, MetadataM m,
 MonadBaseControl IO m, MonadError QErr m, MonadIO m, MonadTrace m,
 UserInfoM m) =>
RunSQL -> m EncJSON
Postgres.runRunSQL @'Vanilla 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
  RQMysqlRunSql RunSQL
q -> RunSQL -> m EncJSON
forall (m :: * -> *).
(MonadIO m, CacheRWM m, MonadError QErr m, MetadataM m) =>
RunSQL -> m EncJSON
MySQL.runSQL RunSQL
q
  RQCitusRunSql RunSQL
q -> RunSQL -> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(BackendMetadata ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 FetchTableMetadata pgKind, FetchFunctionMetadata pgKind,
 CacheRWM m, HasServerConfigCtx m, MetadataM m,
 MonadBaseControl IO m, MonadError QErr m, MonadIO m, MonadTrace m,
 UserInfoM m) =>
RunSQL -> m EncJSON
Postgres.runRunSQL @'Citus RunSQL
q
  RQCockroachRunSql RunSQL
q -> RunSQL -> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(BackendMetadata ('Postgres pgKind), ToMetadataFetchQuery pgKind,
 FetchTableMetadata pgKind, FetchFunctionMetadata pgKind,
 CacheRWM m, HasServerConfigCtx m, MetadataM m,
 MonadBaseControl IO m, MonadError QErr m, MonadIO m, MonadTrace m,
 UserInfoM m) =>
RunSQL -> m EncJSON
Postgres.runRunSQL @'Cockroach 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
  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 (Environment -> RQLQuery -> m EncJSON
forall (m :: * -> *).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m, UserInfoM m,
 CacheRWM m, HasServerConfigCtx m, MonadTrace m, MetadataM m,
 MonadQueryTags m) =>
Environment -> RQLQuery -> m EncJSON
runQueryM Environment
env) [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
_ -> Bool
True
  RQCitusRunSql RunSQL
_ -> Bool
True
  RQCockroachRunSql RunSQL
_ -> Bool
True
  RQMssqlRunSql MSSQLRunSQL
_ -> Bool
True
  RQMysqlRunSql RunSQL
_ -> Bool
True
  RQBigqueryRunSql BigQueryRunSQL
_ -> 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