2020-11-18 21:04:57 +03:00
|
|
|
module Hasura.GraphQL.Execute.Common
|
|
|
|
where
|
|
|
|
|
|
|
|
-- Code shared between Hasura.GraphQL.Execute.Query and .Mutation
|
|
|
|
|
|
|
|
import Hasura.Prelude
|
|
|
|
|
2021-05-05 15:25:27 +03:00
|
|
|
import qualified Data.Aeson as J
|
2020-11-18 21:04:57 +03:00
|
|
|
import qualified Data.Environment as Env
|
|
|
|
import qualified Data.IntMap as IntMap
|
|
|
|
import qualified Database.PG.Query as Q
|
|
|
|
import qualified Network.HTTP.Client as HTTP
|
|
|
|
import qualified Network.HTTP.Types as HTTP
|
2021-05-05 15:25:27 +03:00
|
|
|
import qualified Network.Wai.Extended as Wai
|
2020-11-18 21:04:57 +03:00
|
|
|
|
|
|
|
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
|
|
|
import qualified Hasura.Backends.Postgres.Translate.Select as DS
|
|
|
|
import qualified Hasura.Tracing as Tracing
|
|
|
|
|
|
|
|
import Hasura.Backends.Postgres.Connection
|
|
|
|
import Hasura.Backends.Postgres.Execute.RemoteJoin
|
|
|
|
import Hasura.Backends.Postgres.Translate.Select (asSingleRowJsonResp)
|
|
|
|
import Hasura.EncJSON
|
|
|
|
import Hasura.GraphQL.Context
|
|
|
|
import Hasura.GraphQL.Execute.Prepare
|
2021-02-20 16:45:49 +03:00
|
|
|
import Hasura.GraphQL.Execute.RemoteJoin
|
2021-05-05 15:25:27 +03:00
|
|
|
import Hasura.GraphQL.Transport.HTTP.Protocol
|
|
|
|
import Hasura.Metadata.Class
|
2020-11-18 21:04:57 +03:00
|
|
|
import Hasura.RQL.Types
|
|
|
|
import Hasura.Server.Version (HasVersion)
|
|
|
|
import Hasura.Session
|
|
|
|
|
2021-02-12 06:04:09 +03:00
|
|
|
|
2021-04-22 00:44:37 +03:00
|
|
|
data PreparedSql pgKind
|
2020-11-18 21:04:57 +03:00
|
|
|
= PreparedSql
|
|
|
|
{ _psQuery :: !Q.Query
|
|
|
|
, _psPrepArgs :: !PrepArgMap
|
2021-04-22 00:44:37 +03:00
|
|
|
, _psRemoteJoins :: !(Maybe (RemoteJoins ('Postgres pgKind)))
|
2020-11-18 21:04:57 +03:00
|
|
|
}
|
|
|
|
|
2021-05-05 15:25:27 +03:00
|
|
|
-- | Typeclass representing safety checks (if any) that need to be performed
|
|
|
|
-- before a GraphQL query should be allowed to be executed. In OSS, the safety
|
|
|
|
-- check is to check in the query is in the allow list.
|
|
|
|
--
|
|
|
|
-- the `executeIntrospection` function has different implementations in OSS and
|
|
|
|
-- Pro. In Pro, the GraphQL schema introspection can be disabled for specified
|
|
|
|
-- roles and in OSS there is no restrictions.
|
|
|
|
--
|
|
|
|
-- | TODO (from master): Limitation: This parses the query, which is not ideal if we already
|
|
|
|
-- have the query cached. The parsing happens unnecessary. But getting this to
|
|
|
|
-- either return a plan or parse was tricky and complicated.
|
|
|
|
class Monad m => MonadGQLExecutionCheck m where
|
|
|
|
checkGQLExecution
|
|
|
|
:: UserInfo
|
|
|
|
-> ([HTTP.Header], Wai.IpAddress)
|
|
|
|
-> Bool
|
|
|
|
-- ^ allow list enabled?
|
|
|
|
-> SchemaCache
|
|
|
|
-- ^ needs allow list
|
|
|
|
-> GQLReqUnparsed
|
|
|
|
-- ^ the unparsed GraphQL query string (and related values)
|
|
|
|
-> m (Either QErr GQLReqParsed)
|
|
|
|
|
|
|
|
executeIntrospection
|
|
|
|
:: UserInfo
|
|
|
|
-> J.Value
|
|
|
|
-> SetGraphqlIntrospectionOptions
|
|
|
|
-> m (Either QErr ExecutionStep)
|
|
|
|
|
|
|
|
instance MonadGQLExecutionCheck m => MonadGQLExecutionCheck (ExceptT e m) where
|
|
|
|
checkGQLExecution ui det enableAL sc req =
|
|
|
|
lift $ checkGQLExecution ui det enableAL sc req
|
|
|
|
|
|
|
|
executeIntrospection userInfo introspectionQuery rolesDisabled =
|
|
|
|
lift $ executeIntrospection userInfo introspectionQuery rolesDisabled
|
|
|
|
|
|
|
|
instance MonadGQLExecutionCheck m => MonadGQLExecutionCheck (ReaderT r m) where
|
|
|
|
checkGQLExecution ui det enableAL sc req =
|
|
|
|
lift $ checkGQLExecution ui det enableAL sc req
|
|
|
|
|
|
|
|
executeIntrospection userInfo introspectionQuery rolesDisabled =
|
|
|
|
lift $ executeIntrospection userInfo introspectionQuery rolesDisabled
|
|
|
|
|
|
|
|
instance MonadGQLExecutionCheck m => MonadGQLExecutionCheck (Tracing.TraceT m) where
|
|
|
|
checkGQLExecution ui det enableAL sc req =
|
|
|
|
lift $ checkGQLExecution ui det enableAL sc req
|
|
|
|
|
|
|
|
executeIntrospection userInfo introspectionQuery rolesDisabled =
|
|
|
|
lift $ executeIntrospection userInfo introspectionQuery rolesDisabled
|
|
|
|
|
|
|
|
instance MonadGQLExecutionCheck m => MonadGQLExecutionCheck (MetadataStorageT m) where
|
|
|
|
checkGQLExecution ui det enableAL sc req =
|
|
|
|
lift $ checkGQLExecution ui det enableAL sc req
|
|
|
|
|
|
|
|
executeIntrospection userInfo introspectionQuery rolesDisabled =
|
|
|
|
lift $ executeIntrospection userInfo introspectionQuery rolesDisabled
|
2020-11-18 21:04:57 +03:00
|
|
|
|
|
|
|
-- turn the current plan into a transaction
|
|
|
|
mkCurPlanTx
|
|
|
|
:: ( HasVersion
|
2021-04-22 00:44:37 +03:00
|
|
|
, Backend ('Postgres pgKind)
|
2020-11-18 21:04:57 +03:00
|
|
|
)
|
|
|
|
=> Env.Environment
|
|
|
|
-> HTTP.Manager
|
|
|
|
-> [HTTP.Header]
|
|
|
|
-> UserInfo
|
2021-04-22 00:44:37 +03:00
|
|
|
-> PreparedSql pgKind
|
|
|
|
-> (Tracing.TraceT (LazyTxT QErr IO) EncJSON, Maybe (PreparedSql pgKind))
|
2021-02-12 06:04:09 +03:00
|
|
|
mkCurPlanTx env manager reqHdrs userInfo ps@(PreparedSql q prepMap remoteJoinsM) =
|
2020-11-18 21:04:57 +03:00
|
|
|
-- generate the SQL and prepared vars or the bytestring
|
2021-02-12 06:04:09 +03:00
|
|
|
let args = withUserVars (_uiSession userInfo) prepMap
|
|
|
|
-- WARNING: this quietly assumes the intmap keys are contiguous
|
|
|
|
prepArgs = fst <$> IntMap.elems args
|
|
|
|
in (, Just ps) $ case remoteJoinsM of
|
|
|
|
Nothing -> do
|
|
|
|
Tracing.trace "Postgres" $ liftTx $ asSingleRowJsonResp q prepArgs
|
|
|
|
Just remoteJoins ->
|
|
|
|
executeQueryWithRemoteJoins env manager reqHdrs userInfo q prepArgs remoteJoins
|
2020-11-18 21:04:57 +03:00
|
|
|
|
|
|
|
-- convert a query from an intermediate representation to... another
|
|
|
|
irToRootFieldPlan
|
2021-04-22 00:44:37 +03:00
|
|
|
:: Backend ('Postgres pgKind)
|
|
|
|
=> PrepArgMap
|
|
|
|
-> QueryDB ('Postgres pgKind) S.SQLExp
|
|
|
|
-> PreparedSql pgKind
|
2020-11-18 21:04:57 +03:00
|
|
|
irToRootFieldPlan prepped = \case
|
2021-02-20 16:45:49 +03:00
|
|
|
QDBMultipleRows s -> mkPreparedSql getRemoteJoinsSelect (DS.selectQuerySQL JASMultipleRows) s
|
|
|
|
QDBSingleRow s -> mkPreparedSql getRemoteJoinsSelect (DS.selectQuerySQL JASSingleObject) s
|
2021-02-03 17:06:30 +03:00
|
|
|
QDBAggregation s -> mkPreparedSql getRemoteJoinsAggregateSelect DS.selectAggregateQuerySQL s
|
|
|
|
QDBConnection s -> mkPreparedSql getRemoteJoinsConnectionSelect DS.connectionSelectQuerySQL s
|
2020-11-18 21:04:57 +03:00
|
|
|
where
|
2021-04-22 00:44:37 +03:00
|
|
|
mkPreparedSql :: (s -> (t, Maybe (RemoteJoins ('Postgres pgKind)))) -> (t -> Q.Query) -> s -> PreparedSql pgKind
|
2020-11-18 21:04:57 +03:00
|
|
|
mkPreparedSql getJoins f simpleSel =
|
|
|
|
let (simpleSel',remoteJoins) = getJoins simpleSel
|
|
|
|
in PreparedSql (f simpleSel') prepped remoteJoins
|