mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
ce243f5899
* add types to represent unparsed http gql requests
This will help when we add caching of frequently used ASTs
* query plan caching
* move livequery to execute
* add multiplexed module
* session variable can be customised depending on the context
Previously the value was always "current_setting('hasura.user')"
* get rid of typemap requirement in reusable plan
* subscriptions are multiplexed when possible
* use lazytx for introspection to avoid acquiring a pg connection
* refactor to make execute a completely decoupled module
* don't issue a transaction for a query
* don't use current setting for explained sql
* move postgres related types to a different module
* validate variableValues on postgres before multiplexing subs
* don't user current_setting for queries over ws
* plan_cache is only visible when developer flag is enabled
* introduce 'batch size' when multiplexing subscriptions
* bump stackage to 13.16
* fix schema_stitching test case error code
* store hashes instead of actual responses for subscriptions
* internal api to dump subscriptions state
* remove PlanCache from SchemaCacheRef
* allow live query options to be configured on server startup
* capture metrics for multiplexed subscriptions
* more metrics captured for multiplexed subs
* switch to tvar based hashmap for faster snapshotting
* livequery modules do not expose internal details
* fix typo in live query env vars
* switch to hasura's pg-client-hs
133 lines
4.3 KiB
Haskell
133 lines
4.3 KiB
Haskell
module Hasura.GraphQL.Explain
|
|
( explainGQLQuery
|
|
, GQLExplain
|
|
) where
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Aeson.Casing as J
|
|
import qualified Data.Aeson.TH as J
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Database.PG.Query as Q
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
import Hasura.EncJSON
|
|
import Hasura.GraphQL.Context
|
|
import Hasura.GraphQL.Resolve.Context
|
|
import Hasura.GraphQL.Validate.Field
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DML.Internal
|
|
import Hasura.RQL.Types
|
|
import Hasura.SQL.Types
|
|
import Hasura.SQL.Value
|
|
|
|
import qualified Hasura.GraphQL.Execute as E
|
|
import qualified Hasura.GraphQL.Resolve as RS
|
|
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
|
import qualified Hasura.GraphQL.Validate as GV
|
|
import qualified Hasura.SQL.DML as S
|
|
|
|
data GQLExplain
|
|
= GQLExplain
|
|
{ _gqeQuery :: !GH.GQLReqParsed
|
|
, _gqeUser :: !(Maybe (Map.HashMap Text Text))
|
|
} deriving (Show, Eq)
|
|
|
|
$(J.deriveJSON (J.aesonDrop 4 J.camelCase){J.omitNothingFields=True}
|
|
''GQLExplain
|
|
)
|
|
|
|
data FieldPlan
|
|
= FieldPlan
|
|
{ _fpField :: !G.Name
|
|
, _fpSql :: !(Maybe Text)
|
|
, _fpPlan :: !(Maybe [Text])
|
|
} deriving (Show, Eq)
|
|
|
|
$(J.deriveJSON (J.aesonDrop 3 J.camelCase) ''FieldPlan)
|
|
|
|
type Explain r =
|
|
(ReaderT r (Except QErr))
|
|
|
|
runExplain
|
|
:: (MonadError QErr m)
|
|
=> r -> Explain r a -> m a
|
|
runExplain ctx m =
|
|
either throwError return $ runExcept $ runReaderT m ctx
|
|
|
|
resolveVal
|
|
:: (MonadError QErr m)
|
|
=> UserInfo -> UnresolvedVal -> m S.SQLExp
|
|
resolveVal userInfo = \case
|
|
RS.UVPG annPGVal ->
|
|
txtConverter annPGVal
|
|
RS.UVSessVar colTy sessVar -> do
|
|
sessVarVal <- getSessVarVal userInfo sessVar
|
|
return $ S.withTyAnn colTy $ withGeoVal colTy $
|
|
S.SELit sessVarVal
|
|
RS.UVSQL sqlExp -> return sqlExp
|
|
|
|
getSessVarVal
|
|
:: (MonadError QErr m)
|
|
=> UserInfo -> SessVar -> m SessVarVal
|
|
getSessVarVal userInfo sessVar =
|
|
onNothing (getVarVal sessVar usrVars) $
|
|
throw400 UnexpectedPayload $
|
|
"missing required session variable for role " <> rn <<>
|
|
" : " <> sessVar
|
|
where
|
|
rn = userRole userInfo
|
|
usrVars = userVars userInfo
|
|
|
|
explainField
|
|
:: (MonadTx m)
|
|
=> UserInfo -> GCtx -> SQLGenCtx -> Field -> m FieldPlan
|
|
explainField userInfo gCtx sqlGenCtx fld =
|
|
case fName of
|
|
"__type" -> return $ FieldPlan fName Nothing Nothing
|
|
"__schema" -> return $ FieldPlan fName Nothing Nothing
|
|
"__typename" -> return $ FieldPlan fName Nothing Nothing
|
|
_ -> do
|
|
unresolvedAST <-
|
|
runExplain (opCtxMap, userInfo, fldMap, orderByCtx, sqlGenCtx) $
|
|
RS.queryFldToPGAST fld
|
|
resolvedAST <- RS.traverseQueryRootFldAST (resolveVal userInfo)
|
|
unresolvedAST
|
|
let txtSQL = Q.getQueryText $ RS.toPGQuery resolvedAST
|
|
withExplain = "EXPLAIN (FORMAT TEXT) " <> txtSQL
|
|
planLines <- liftTx $ map runIdentity <$>
|
|
Q.listQE dmlTxErrorHandler (Q.fromText withExplain) () True
|
|
return $ FieldPlan fName (Just txtSQL) $ Just planLines
|
|
where
|
|
fName = _fName fld
|
|
|
|
opCtxMap = _gOpCtxMap gCtx
|
|
fldMap = _gFields gCtx
|
|
orderByCtx = _gOrdByCtx gCtx
|
|
|
|
explainGQLQuery
|
|
:: (MonadError QErr m, MonadIO m)
|
|
=> PGExecCtx
|
|
-> SchemaCache
|
|
-> SQLGenCtx
|
|
-> GQLExplain
|
|
-> m EncJSON
|
|
explainGQLQuery pgExecCtx sc sqlGenCtx (GQLExplain query userVarsRaw)= do
|
|
execPlan <- E.getExecPlanPartial userInfo sc query
|
|
(gCtx, rootSelSet) <- case execPlan of
|
|
E.GExPHasura (gCtx, rootSelSet, _) ->
|
|
return (gCtx, rootSelSet)
|
|
E.GExPRemote _ _ ->
|
|
throw400 InvalidParams "only hasura queries can be explained"
|
|
case rootSelSet of
|
|
GV.RQuery selSet -> do
|
|
let tx = mapM (explainField userInfo gCtx sqlGenCtx) (toList selSet)
|
|
plans <- liftIO (runExceptT $ runLazyTx pgExecCtx tx) >>= liftEither
|
|
return $ encJFromJValue plans
|
|
GV.RMutation _ ->
|
|
throw400 InvalidParams "only queries can be explained"
|
|
GV.RSubscription _ ->
|
|
throw400 InvalidParams "only queries can be explained"
|
|
where
|
|
usrVars = mkUserVars $ maybe [] Map.toList userVarsRaw
|
|
userInfo = mkUserInfo (fromMaybe adminRole $ roleFromVars usrVars) usrVars
|