mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
e17e47ef8c
There are two implementations of a Cache, namely a bounded and an unbounded variant. This can be elegantly captured in a type class. In addition to reducing the amount of error-prone code in the definition of the cache, this version reduces the amount of error-prone code in usage sites of the cache, as it makes the cache into an abstract object, so that a calling site cannot distinguish between cache types. Any decision about what should be cached should be made through the interface of a cache, rather than at the callsite, and this is captured by this variant.
404 lines
14 KiB
Haskell
404 lines
14 KiB
Haskell
module Hasura.GraphQL.Execute
|
|
( GQExecPlan(..)
|
|
|
|
, ExecPlanPartial
|
|
, getExecPlanPartial
|
|
|
|
, ExecOp(..)
|
|
, ExecPlanResolved
|
|
, getResolvedExecPlan
|
|
, execRemoteGQ
|
|
, getSubsOp
|
|
|
|
, EP.PlanCache
|
|
, EP.PlanCacheOptions(..)
|
|
, EP.initPlanCache
|
|
, EP.clearPlanCache
|
|
, EP.dumpPlanCache
|
|
|
|
, ExecutionCtx(..)
|
|
) where
|
|
|
|
import Control.Exception (try)
|
|
import Control.Lens
|
|
import Data.Has
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Data.HashSet as Set
|
|
import qualified Data.Text as T
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
import qualified Network.HTTP.Client as HTTP
|
|
import qualified Network.HTTP.Types as N
|
|
import qualified Network.Wreq as Wreq
|
|
|
|
import Hasura.EncJSON
|
|
import Hasura.GraphQL.Context
|
|
import Hasura.GraphQL.Logging
|
|
import Hasura.GraphQL.Resolve.Action
|
|
import Hasura.GraphQL.Resolve.Context
|
|
import Hasura.GraphQL.Schema
|
|
import Hasura.GraphQL.Transport.HTTP.Protocol
|
|
import Hasura.GraphQL.Validate.Types
|
|
import Hasura.HTTP
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DDL.Headers
|
|
import Hasura.RQL.Types
|
|
import Hasura.Server.Utils (RequestId, mkClientHeadersForward,
|
|
mkSetCookieHeaders)
|
|
import Hasura.Server.Version (HasVersion)
|
|
import Hasura.Session
|
|
|
|
import qualified Hasura.GraphQL.Execute.LiveQuery as EL
|
|
import qualified Hasura.GraphQL.Execute.Plan as EP
|
|
import qualified Hasura.GraphQL.Execute.Query as EQ
|
|
import qualified Hasura.GraphQL.Resolve as GR
|
|
import qualified Hasura.GraphQL.Validate as VQ
|
|
import qualified Hasura.GraphQL.Validate.Types as VT
|
|
import qualified Hasura.Logging as L
|
|
import qualified Hasura.Server.Telemetry.Counters as Telem
|
|
|
|
-- The current execution plan of a graphql operation, it is
|
|
-- currently, either local pg execution or a remote execution
|
|
--
|
|
-- The 'a' is parameterised so this AST can represent
|
|
-- intermediate passes
|
|
data GQExecPlan a
|
|
= GExPHasura !a
|
|
| GExPRemote !RemoteSchemaInfo !G.TypedOperationDefinition
|
|
deriving (Functor, Foldable, Traversable)
|
|
|
|
-- | Execution context
|
|
data ExecutionCtx
|
|
= ExecutionCtx
|
|
{ _ecxLogger :: !(L.Logger L.Hasura)
|
|
, _ecxSqlGenCtx :: !SQLGenCtx
|
|
, _ecxPgExecCtx :: !PGExecCtx
|
|
, _ecxPlanCache :: !EP.PlanCache
|
|
, _ecxSchemaCache :: !SchemaCache
|
|
, _ecxSchemaCacheVer :: !SchemaCacheVer
|
|
, _ecxHttpManager :: !HTTP.Manager
|
|
, _ecxEnableAllowList :: !Bool
|
|
}
|
|
|
|
-- Enforces the current limitation
|
|
assertSameLocationNodes
|
|
:: (MonadError QErr m) => [VT.TypeLoc] -> m VT.TypeLoc
|
|
assertSameLocationNodes typeLocs =
|
|
case Set.toList (Set.fromList typeLocs) of
|
|
-- this shouldn't happen
|
|
[] -> return VT.TLHasuraType
|
|
[loc] -> return loc
|
|
_ -> throw400 NotSupported msg
|
|
where
|
|
msg = "cannot mix top level fields from two different graphql servers"
|
|
|
|
-- TODO: we should fix this function asap
|
|
-- as this will fail when there is a fragment at the top level
|
|
getTopLevelNodes :: G.TypedOperationDefinition -> [G.Name]
|
|
getTopLevelNodes opDef =
|
|
mapMaybe f $ G._todSelectionSet opDef
|
|
where
|
|
f = \case
|
|
G.SelectionField fld -> Just $ G._fName fld
|
|
G.SelectionFragmentSpread _ -> Nothing
|
|
G.SelectionInlineFragment _ -> Nothing
|
|
|
|
gatherTypeLocs :: GCtx -> [G.Name] -> [VT.TypeLoc]
|
|
gatherTypeLocs gCtx nodes =
|
|
catMaybes $ flip map nodes $ \node ->
|
|
VT._fiLoc <$> Map.lookup node schemaNodes
|
|
where
|
|
schemaNodes =
|
|
let qr = VT._otiFields $ _gQueryRoot gCtx
|
|
mr = VT._otiFields <$> _gMutRoot gCtx
|
|
in maybe qr (Map.union qr) mr
|
|
|
|
-- This is for when the graphql query is validated
|
|
type ExecPlanPartial = GQExecPlan (GCtx, VQ.RootSelSet)
|
|
|
|
getExecPlanPartial
|
|
:: (MonadReusability m, MonadError QErr m)
|
|
=> UserInfo
|
|
-> SchemaCache
|
|
-> Bool
|
|
-> GQLReqParsed
|
|
-> m ExecPlanPartial
|
|
getExecPlanPartial userInfo sc enableAL req = do
|
|
|
|
-- check if query is in allowlist
|
|
when enableAL checkQueryInAllowlist
|
|
|
|
let gCtx = getGCtx (_uiBackendOnlyFieldAccess userInfo) sc roleName
|
|
queryParts <- flip runReaderT gCtx $ VQ.getQueryParts req
|
|
|
|
let opDef = VQ.qpOpDef queryParts
|
|
topLevelNodes = getTopLevelNodes opDef
|
|
-- gather TypeLoc of topLevelNodes
|
|
typeLocs = gatherTypeLocs gCtx topLevelNodes
|
|
|
|
-- see if they are all the same
|
|
typeLoc <- assertSameLocationNodes typeLocs
|
|
|
|
case typeLoc of
|
|
VT.TLHasuraType -> do
|
|
rootSelSet <- runReaderT (VQ.validateGQ queryParts) gCtx
|
|
return $ GExPHasura (gCtx, rootSelSet)
|
|
VT.TLRemoteType _ rsi ->
|
|
return $ GExPRemote rsi opDef
|
|
VT.TLCustom ->
|
|
throw500 "unexpected custom type for top level field"
|
|
where
|
|
roleName = _uiRole userInfo
|
|
|
|
checkQueryInAllowlist =
|
|
-- only for non-admin roles
|
|
when (roleName /= adminRoleName) $ do
|
|
let notInAllowlist =
|
|
not $ VQ.isQueryInAllowlist (_grQuery req) (scAllowlist sc)
|
|
when notInAllowlist $ modifyQErr modErr $ throwVE "query is not allowed"
|
|
|
|
modErr e =
|
|
let msg = "query is not in any of the allowlists"
|
|
in e{qeInternal = Just $ J.object [ "message" J..= J.String msg]}
|
|
|
|
|
|
-- An execution operation, in case of
|
|
-- queries and mutations it is just a transaction
|
|
-- to be executed
|
|
data ExecOp
|
|
= ExOpQuery !LazyRespTx !(Maybe EQ.GeneratedSqlMap)
|
|
| ExOpMutation !N.ResponseHeaders !LazyRespTx
|
|
| ExOpSubs !EL.LiveQueryPlan
|
|
|
|
-- The graphql query is resolved into an execution operation
|
|
type ExecPlanResolved = GQExecPlan ExecOp
|
|
|
|
getResolvedExecPlan
|
|
:: (HasVersion, MonadError QErr m, MonadIO m)
|
|
=> PGExecCtx
|
|
-> EP.PlanCache
|
|
-> UserInfo
|
|
-> SQLGenCtx
|
|
-> Bool
|
|
-> SchemaCache
|
|
-> SchemaCacheVer
|
|
-> HTTP.Manager
|
|
-> [N.Header]
|
|
-> GQLReqUnparsed
|
|
-> m (Telem.CacheHit, ExecPlanResolved)
|
|
getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx
|
|
enableAL sc scVer httpManager reqHeaders reqUnparsed = do
|
|
planM <- liftIO $ EP.getPlan scVer (_uiRole userInfo)
|
|
opNameM queryStr planCache
|
|
let usrVars = _uiSession userInfo
|
|
case planM of
|
|
-- plans are only for queries and subscriptions
|
|
Just plan -> (Telem.Hit,) . GExPHasura <$> case plan of
|
|
EP.RPQuery queryPlan -> do
|
|
(tx, genSql) <- EQ.queryOpFromPlan usrVars queryVars queryPlan
|
|
return $ ExOpQuery tx (Just genSql)
|
|
EP.RPSubs subsPlan ->
|
|
ExOpSubs <$> EL.reuseLiveQueryPlan pgExecCtx usrVars queryVars subsPlan
|
|
Nothing -> (Telem.Miss,) <$> noExistingPlan
|
|
where
|
|
GQLReq opNameM queryStr queryVars = reqUnparsed
|
|
addPlanToCache plan =
|
|
liftIO $ EP.addPlan scVer (_uiRole userInfo)
|
|
opNameM queryStr plan planCache
|
|
noExistingPlan = do
|
|
req <- toParsed reqUnparsed
|
|
(partialExecPlan, queryReusability) <- runReusabilityT $
|
|
getExecPlanPartial userInfo sc enableAL req
|
|
forM partialExecPlan $ \(gCtx, rootSelSet) ->
|
|
case rootSelSet of
|
|
VQ.RMutation selSet -> do
|
|
(tx, respHeaders) <- getMutOp gCtx sqlGenCtx userInfo httpManager reqHeaders selSet
|
|
pure $ ExOpMutation respHeaders tx
|
|
VQ.RQuery selSet -> do
|
|
(queryTx, plan, genSql) <- getQueryOp gCtx sqlGenCtx userInfo queryReusability (allowQueryActionExecuter httpManager reqHeaders) selSet
|
|
traverse_ (addPlanToCache . EP.RPQuery) plan
|
|
return $ ExOpQuery queryTx (Just genSql)
|
|
VQ.RSubscription fld -> do
|
|
(lqOp, plan) <- getSubsOp pgExecCtx gCtx sqlGenCtx userInfo queryReusability (restrictActionExecuter "query actions cannot be run as a subscription") fld
|
|
traverse_ (addPlanToCache . EP.RPSubs) plan
|
|
return $ ExOpSubs lqOp
|
|
|
|
-- Monad for resolving a hasura query/mutation
|
|
type E m =
|
|
ReaderT ( UserInfo
|
|
, QueryCtxMap
|
|
, MutationCtxMap
|
|
, TypeMap
|
|
, FieldMap
|
|
, OrdByCtx
|
|
, InsCtxMap
|
|
, SQLGenCtx
|
|
) (ExceptT QErr m)
|
|
|
|
runE
|
|
:: (MonadError QErr m)
|
|
=> GCtx
|
|
-> SQLGenCtx
|
|
-> UserInfo
|
|
-> E m a
|
|
-> m a
|
|
runE ctx sqlGenCtx userInfo action = do
|
|
res <- runExceptT $ runReaderT action
|
|
(userInfo, queryCtxMap, mutationCtxMap, typeMap, fldMap, ordByCtx, insCtxMap, sqlGenCtx)
|
|
either throwError return res
|
|
where
|
|
queryCtxMap = _gQueryCtxMap ctx
|
|
mutationCtxMap = _gMutationCtxMap ctx
|
|
typeMap = _gTypes ctx
|
|
fldMap = _gFields ctx
|
|
ordByCtx = _gOrdByCtx ctx
|
|
insCtxMap = _gInsCtxMap ctx
|
|
|
|
getQueryOp
|
|
:: ( HasVersion
|
|
, MonadError QErr m
|
|
, MonadIO m)
|
|
=> GCtx
|
|
-> SQLGenCtx
|
|
-> UserInfo
|
|
-> QueryReusability
|
|
-> QueryActionExecuter
|
|
-> VQ.SelSet
|
|
-> m (LazyRespTx, Maybe EQ.ReusableQueryPlan, EQ.GeneratedSqlMap)
|
|
getQueryOp gCtx sqlGenCtx userInfo queryReusability actionExecuter selSet =
|
|
runE gCtx sqlGenCtx userInfo $ EQ.convertQuerySelSet queryReusability selSet actionExecuter
|
|
|
|
resolveMutSelSet
|
|
:: ( HasVersion
|
|
, MonadError QErr m
|
|
, MonadReader r m
|
|
, Has UserInfo r
|
|
, Has MutationCtxMap r
|
|
, Has FieldMap r
|
|
, Has OrdByCtx r
|
|
, Has SQLGenCtx r
|
|
, Has InsCtxMap r
|
|
, Has HTTP.Manager r
|
|
, Has [N.Header] r
|
|
, MonadIO m
|
|
)
|
|
=> VQ.SelSet
|
|
-> m (LazyRespTx, N.ResponseHeaders)
|
|
resolveMutSelSet fields = do
|
|
aliasedTxs <- forM (toList fields) $ \fld -> do
|
|
fldRespTx <- case VQ._fName fld of
|
|
"__typename" -> return (return $ encJFromJValue mutationRootNamedType, [])
|
|
_ -> evalReusabilityT $ GR.mutFldToTx fld
|
|
return (G.unName $ G.unAlias $ VQ._fAlias fld, fldRespTx)
|
|
|
|
-- combines all transactions into a single transaction
|
|
return (liftTx $ toSingleTx aliasedTxs, concatMap (snd . snd) aliasedTxs)
|
|
where
|
|
-- A list of aliased transactions for eg
|
|
-- [("f1", Tx r1), ("f2", Tx r2)]
|
|
-- are converted into a single transaction as follows
|
|
-- Tx {"f1": r1, "f2": r2}
|
|
-- toSingleTx :: [(Text, LazyRespTx)] -> LazyRespTx
|
|
toSingleTx aliasedTxs =
|
|
fmap encJFromAssocList $
|
|
forM aliasedTxs $ \(al, (tx, _)) -> (,) al <$> tx
|
|
|
|
getMutOp
|
|
:: (HasVersion, MonadError QErr m, MonadIO m)
|
|
=> GCtx
|
|
-> SQLGenCtx
|
|
-> UserInfo
|
|
-> HTTP.Manager
|
|
-> [N.Header]
|
|
-> VQ.SelSet
|
|
-> m (LazyRespTx, N.ResponseHeaders)
|
|
getMutOp ctx sqlGenCtx userInfo manager reqHeaders selSet =
|
|
peelReaderT $ resolveMutSelSet selSet
|
|
where
|
|
peelReaderT action =
|
|
runReaderT action
|
|
( userInfo, queryCtxMap, mutationCtxMap
|
|
, typeMap, fldMap, ordByCtx, insCtxMap, sqlGenCtx
|
|
, manager, reqHeaders
|
|
)
|
|
where
|
|
queryCtxMap = _gQueryCtxMap ctx
|
|
mutationCtxMap = _gMutationCtxMap ctx
|
|
typeMap = _gTypes ctx
|
|
fldMap = _gFields ctx
|
|
ordByCtx = _gOrdByCtx ctx
|
|
insCtxMap = _gInsCtxMap ctx
|
|
|
|
getSubsOp
|
|
:: ( MonadError QErr m
|
|
, MonadIO m
|
|
, HasVersion
|
|
)
|
|
=> PGExecCtx
|
|
-> GCtx
|
|
-> SQLGenCtx
|
|
-> UserInfo
|
|
-> QueryReusability
|
|
-> QueryActionExecuter
|
|
-> VQ.SelSet
|
|
-> m (EL.LiveQueryPlan, Maybe EL.ReusableLiveQueryPlan)
|
|
getSubsOp pgExecCtx gCtx sqlGenCtx userInfo queryReusability actionExecuter fields =
|
|
runE gCtx sqlGenCtx userInfo $ EL.buildLiveQueryPlan pgExecCtx queryReusability actionExecuter fields
|
|
-- runE gCtx sqlGenCtx userInfo $ getSubsOpM pgExecCtx queryReusability fld actionExecuter
|
|
|
|
execRemoteGQ
|
|
:: ( HasVersion
|
|
, MonadIO m
|
|
, MonadError QErr m
|
|
, MonadReader ExecutionCtx m
|
|
)
|
|
=> RequestId
|
|
-> UserInfo
|
|
-> [N.Header]
|
|
-> GQLReqUnparsed
|
|
-> RemoteSchemaInfo
|
|
-> G.TypedOperationDefinition
|
|
-> m (DiffTime, HttpResponse EncJSON)
|
|
-- ^ Also returns time spent in http request, for telemetry.
|
|
execRemoteGQ reqId userInfo reqHdrs q rsi opDef = do
|
|
execCtx <- ask
|
|
let logger = _ecxLogger execCtx
|
|
manager = _ecxHttpManager execCtx
|
|
opTy = G._todType opDef
|
|
when (opTy == G.OperationTypeSubscription) $
|
|
throw400 NotSupported "subscription to remote server is not supported"
|
|
confHdrs <- makeHeadersFromConf hdrConf
|
|
let clientHdrs = bool [] (mkClientHeadersForward reqHdrs) fwdClientHdrs
|
|
-- filter out duplicate headers
|
|
-- priority: conf headers > resolved userinfo vars > client headers
|
|
hdrMaps = [ Map.fromList confHdrs
|
|
, Map.fromList userInfoToHdrs
|
|
, Map.fromList clientHdrs
|
|
]
|
|
headers = Map.toList $ foldr Map.union Map.empty hdrMaps
|
|
finalHeaders = addDefaultHeaders headers
|
|
initReqE <- liftIO $ try $ HTTP.parseRequest (show url)
|
|
initReq <- either httpThrow pure initReqE
|
|
let req = initReq
|
|
{ HTTP.method = "POST"
|
|
, HTTP.requestHeaders = finalHeaders
|
|
, HTTP.requestBody = HTTP.RequestBodyLBS (J.encode q)
|
|
, HTTP.responseTimeout = HTTP.responseTimeoutMicro (timeout * 1000000)
|
|
}
|
|
|
|
L.unLogger logger $ QueryLog q Nothing reqId
|
|
(time, res) <- withElapsedTime $ liftIO $ try $ HTTP.httpLbs req manager
|
|
resp <- either httpThrow return res
|
|
let !httpResp = HttpResponse (encJFromLBS $ resp ^. Wreq.responseBody) $ mkSetCookieHeaders resp
|
|
return (time, httpResp)
|
|
|
|
where
|
|
RemoteSchemaInfo url hdrConf fwdClientHdrs timeout = rsi
|
|
httpThrow :: (MonadError QErr m) => HTTP.HttpException -> m a
|
|
httpThrow = \case
|
|
HTTP.HttpExceptionRequest _req content -> throw500 $ T.pack . show $ content
|
|
HTTP.InvalidUrlException _url reason -> throw500 $ T.pack . show $ reason
|
|
|
|
userInfoToHdrs = sessionVariablesToHeaders $ _uiSession userInfo
|