mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
a3e23adac5
### Description A trivial PR, extracted out of #4936, that removes remote schema permissions from the schema context, as they are only ever used at the top level: whether or not we need to use remote schema permissions is not something that impacts _how_ we build the schema, but whether some parts of the schema should be built at all, and therefore doesn't need to be accessible throughout the build process. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5050 GitOrigin-RevId: 734673370393d5640ad753222982baf2698f6d8f
222 lines
11 KiB
Haskell
222 lines
11 KiB
Haskell
module Hasura.GraphQL.Schema.RemoteRelationship
|
|
( remoteRelationshipField,
|
|
)
|
|
where
|
|
|
|
import Control.Lens
|
|
import Data.Has
|
|
import Data.HashMap.Strict.Extended qualified as Map
|
|
import Data.List.NonEmpty qualified as NE
|
|
import Data.Text.Casing qualified as C
|
|
import Data.Text.Extended
|
|
import Hasura.Base.Error
|
|
import Hasura.GraphQL.Schema.Backend
|
|
import Hasura.GraphQL.Schema.Common
|
|
import Hasura.GraphQL.Schema.Instances ()
|
|
import Hasura.GraphQL.Schema.NamingCase
|
|
import Hasura.GraphQL.Schema.Options (RemoteSchemaPermissions)
|
|
import Hasura.GraphQL.Schema.Parser (FieldParser, MonadSchema)
|
|
import Hasura.GraphQL.Schema.Parser qualified as P
|
|
import Hasura.GraphQL.Schema.Remote
|
|
import Hasura.GraphQL.Schema.Select
|
|
import Hasura.GraphQL.Schema.Table
|
|
import Hasura.GraphQL.Schema.Typename (withTypenameCustomization)
|
|
import Hasura.Name qualified as Name
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DDL.RemoteRelationship.Validate
|
|
import Hasura.RQL.IR qualified as IR
|
|
import Hasura.RQL.Types.Common (FieldName, RelType (..), relNameToTxt)
|
|
import Hasura.RQL.Types.Relationships.Remote
|
|
import Hasura.RQL.Types.Relationships.ToSchema
|
|
import Hasura.RQL.Types.Relationships.ToSchema qualified as Remote
|
|
import Hasura.RQL.Types.RemoteSchema
|
|
import Hasura.RQL.Types.ResultCustomization
|
|
import Hasura.RQL.Types.SchemaCache hiding (askTableInfo)
|
|
import Hasura.RQL.Types.Source
|
|
import Hasura.RQL.Types.SourceCustomization
|
|
import Hasura.SQL.AnyBackend
|
|
import Hasura.Session
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
-- | Remote relationship field parsers
|
|
remoteRelationshipField ::
|
|
SourceCache ->
|
|
RemoteSchemaMap ->
|
|
RemoteSchemaPermissions ->
|
|
RemoteRelationshipParserBuilder
|
|
remoteRelationshipField sourceCache remoteSchemaCache remoteSchemaPermissions = RemoteRelationshipParserBuilder
|
|
\RemoteFieldInfo {..} -> runMaybeT do
|
|
queryType <- retrieve scSchemaKind
|
|
-- https://github.com/hasura/graphql-engine/issues/5144
|
|
-- The above issue is easily fixable by removing the following guard
|
|
guard $ isHasuraSchema queryType
|
|
case _rfiRHS of
|
|
RFISource anyRemoteSourceFieldInfo ->
|
|
dispatchAnyBackendWithTwoConstraints @BackendSchema @BackendTableSelectSchema
|
|
anyRemoteSourceFieldInfo
|
|
\remoteSourceFieldInfo -> do
|
|
fields <- lift $ remoteRelationshipToSourceField sourceCache remoteSourceFieldInfo
|
|
pure $ fmap (IR.RemoteSourceField . mkAnyBackend) <$> fields
|
|
RFISchema remoteSchema -> do
|
|
fields <- MaybeT $ remoteRelationshipToSchemaField remoteSchemaCache remoteSchemaPermissions _rfiLHS remoteSchema
|
|
pure $ pure $ IR.RemoteSchemaField <$> fields
|
|
|
|
-- | Parser(s) for remote relationship fields to a remote schema
|
|
remoteRelationshipToSchemaField ::
|
|
forall r m n lhsJoinField.
|
|
(MonadBuildSchemaBase r m n) =>
|
|
RemoteSchemaMap ->
|
|
RemoteSchemaPermissions ->
|
|
Map.HashMap FieldName lhsJoinField ->
|
|
RemoteSchemaFieldInfo ->
|
|
m (Maybe (FieldParser n (IR.RemoteSchemaSelect (IR.RemoteRelationshipField IR.UnpreparedValue))))
|
|
remoteRelationshipToSchemaField remoteSchemaCache remoteSchemaPermissions lhsFields RemoteSchemaFieldInfo {..} = runMaybeT do
|
|
roleName <- asks getter
|
|
remoteSchemaContext <-
|
|
Map.lookup _rrfiRemoteSchemaName remoteSchemaCache
|
|
`onNothing` throw500 ("invalid remote schema name: " <>> _rrfiRemoteSchemaName)
|
|
introspection <- hoistMaybe $ getIntrospectionResult remoteSchemaPermissions roleName remoteSchemaContext
|
|
let remoteSchemaRelationships = _rscRemoteRelationships remoteSchemaContext
|
|
roleIntrospection = irDoc introspection
|
|
remoteSchemaRoot = irQueryRoot introspection
|
|
remoteSchemaCustomizer = rsCustomizer $ _rscInfo remoteSchemaContext
|
|
RemoteSchemaIntrospection typeDefns = roleIntrospection
|
|
let hasuraFieldNames = Map.keysSet lhsFields
|
|
relationshipDef = ToSchemaRelationshipDef _rrfiRemoteSchemaName hasuraFieldNames _rrfiRemoteFields
|
|
(newInpValDefns :: [G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition], remoteFieldParamMap) <-
|
|
if roleName == adminRoleName
|
|
then do
|
|
-- we don't validate the remote relationship when the role is admin
|
|
-- because it's already been validated, when the remote relationship
|
|
-- was created
|
|
pure (_rrfiInputValueDefinitions, _rrfiParamMap)
|
|
else do
|
|
(_, roleRemoteField) <-
|
|
afold @(Either _) $
|
|
-- TODO: this really needs to go way, we shouldn't be doing
|
|
-- validation when building parsers
|
|
validateToSchemaRelationship relationshipDef _rrfiLHSIdentifier _rrfiName (_rrfiRemoteSchema, introspection) lhsFields
|
|
pure (Remote._rrfiInputValueDefinitions roleRemoteField, Remote._rrfiParamMap roleRemoteField)
|
|
let -- add the new input value definitions created by the remote relationship
|
|
-- to the existing schema introspection of the role
|
|
remoteRelationshipIntrospection = RemoteSchemaIntrospection $ typeDefns <> Map.fromListOn getTypeName newInpValDefns
|
|
fieldName <- textToName $ relNameToTxt _rrfiName
|
|
|
|
-- This selection set parser, should be of the remote node's selection set parser, which comes
|
|
-- from the fieldCall
|
|
let fieldCalls = unRemoteFields _rrfiRemoteFields
|
|
nestedFieldType <- lift $ lookupNestedFieldType remoteSchemaRoot roleIntrospection fieldCalls
|
|
let typeName = G.getBaseType nestedFieldType
|
|
fieldTypeDefinition <-
|
|
onNothing (lookupType roleIntrospection typeName)
|
|
-- the below case will never happen because we get the type name
|
|
-- from the schema document itself i.e. if a field exists for the
|
|
-- given role, then it's return type also must exist
|
|
$
|
|
throw500 $ "unexpected: " <> typeName <<> " not found "
|
|
-- These are the arguments that are given by the user while executing a query
|
|
let remoteFieldUserArguments = map snd $ Map.toList remoteFieldParamMap
|
|
remoteFld <-
|
|
withRemoteSchemaCustomization remoteSchemaCustomizer $
|
|
lift $
|
|
P.wrapFieldParser nestedFieldType
|
|
<$> remoteField remoteRelationshipIntrospection remoteSchemaRelationships remoteSchemaRoot fieldName Nothing remoteFieldUserArguments fieldTypeDefinition
|
|
|
|
pure $
|
|
remoteFld
|
|
`P.bindField` \fld@IR.GraphQLField {IR._fArguments = args, IR._fSelectionSet = selSet, IR._fName = fname} -> do
|
|
let remoteArgs =
|
|
Map.toList args <&> \(argName, argVal) -> IR.RemoteFieldArgument argName $ P.GraphQLValue argVal
|
|
let resultCustomizer =
|
|
applyFieldCalls fieldCalls $
|
|
applyAliasMapping (singletonAliasMapping fname (fcName $ NE.last fieldCalls)) $
|
|
makeResultCustomizer remoteSchemaCustomizer fld
|
|
pure $
|
|
IR.RemoteSchemaSelect
|
|
{ IR._rselArgs = remoteArgs,
|
|
IR._rselResultCustomizer = resultCustomizer,
|
|
IR._rselSelection = selSet,
|
|
IR._rselFieldCall = fieldCalls,
|
|
IR._rselRemoteSchema = _rrfiRemoteSchema
|
|
}
|
|
where
|
|
-- Apply parent field calls so that the result customizer modifies the nested field
|
|
applyFieldCalls :: NonEmpty FieldCall -> ResultCustomizer -> ResultCustomizer
|
|
applyFieldCalls fieldCalls resultCustomizer =
|
|
foldr (modifyFieldByName . fcName) resultCustomizer $ NE.init fieldCalls
|
|
|
|
lookupNestedFieldType' ::
|
|
(MonadSchema n m, MonadError QErr m) =>
|
|
G.Name ->
|
|
RemoteSchemaIntrospection ->
|
|
FieldCall ->
|
|
m G.GType
|
|
lookupNestedFieldType' parentTypeName remoteSchemaIntrospection (FieldCall fcName _) =
|
|
case lookupObject remoteSchemaIntrospection parentTypeName of
|
|
Nothing -> throw400 RemoteSchemaError $ "object with name " <> parentTypeName <<> " not found"
|
|
Just G.ObjectTypeDefinition {..} ->
|
|
case find ((== fcName) . G._fldName) _otdFieldsDefinition of
|
|
Nothing -> throw400 RemoteSchemaError $ "field with name " <> fcName <<> " not found"
|
|
Just G.FieldDefinition {..} -> pure _fldType
|
|
|
|
lookupNestedFieldType ::
|
|
(MonadSchema n m, MonadError QErr m) =>
|
|
G.Name ->
|
|
RemoteSchemaIntrospection ->
|
|
NonEmpty FieldCall ->
|
|
m G.GType
|
|
lookupNestedFieldType parentTypeName remoteSchemaIntrospection (fieldCall :| rest) = do
|
|
fieldType <- lookupNestedFieldType' parentTypeName remoteSchemaIntrospection fieldCall
|
|
case NE.nonEmpty rest of
|
|
Nothing -> pure fieldType
|
|
Just rest' -> do
|
|
lookupNestedFieldType (G.getBaseType fieldType) remoteSchemaIntrospection rest'
|
|
|
|
-- | Parser(s) for remote relationship fields to a database table.
|
|
-- Note that when the target is a database table, an array relationship
|
|
-- declaration would have the '_aggregate' field in addition to the array
|
|
-- relationship field, hence [FieldParser ...] instead of 'FieldParser'
|
|
remoteRelationshipToSourceField ::
|
|
forall r m n tgt.
|
|
( MonadBuildSchemaBase r m n,
|
|
BackendSchema tgt,
|
|
BackendTableSelectSchema tgt
|
|
) =>
|
|
SourceCache ->
|
|
RemoteSourceFieldInfo tgt ->
|
|
m [FieldParser n (IR.RemoteSourceSelect (IR.RemoteRelationshipField IR.UnpreparedValue) IR.UnpreparedValue tgt)]
|
|
remoteRelationshipToSourceField sourceCache RemoteSourceFieldInfo {..} =
|
|
withTypenameCustomization (mkCustomizedTypename (Just _rsfiSourceCustomization) HasuraCase) do
|
|
tCase <- asks getter
|
|
sourceInfo <-
|
|
onNothing (unsafeSourceInfo @tgt =<< Map.lookup _rsfiSource sourceCache) $
|
|
throw500 $ "source not found " <> dquote _rsfiSource
|
|
tableInfo <- askTableInfo sourceInfo _rsfiTable
|
|
fieldName <- textToName $ relNameToTxt _rsfiName
|
|
maybePerms <- tableSelectPermissions @tgt tableInfo
|
|
case maybePerms of
|
|
Nothing -> pure []
|
|
Just tablePerms -> do
|
|
parsers <- case _rsfiType of
|
|
ObjRel -> do
|
|
selectionSetParserM <- tableSelectionSet sourceInfo tableInfo
|
|
pure $ case selectionSetParserM of
|
|
Nothing -> []
|
|
Just selectionSetParser ->
|
|
pure $
|
|
P.subselection_ fieldName Nothing selectionSetParser <&> \fields ->
|
|
IR.SourceRelationshipObject $
|
|
IR.AnnObjectSelectG fields _rsfiTable $ IR._tpFilter $ tablePermissionsInfo tablePerms
|
|
ArrRel -> do
|
|
let aggFieldName = applyFieldNameCaseIdentifier tCase $ C.fromTuple (fieldName, [G.convertNameToSuffix Name._aggregate])
|
|
selectionSetParser <- selectTable sourceInfo tableInfo fieldName Nothing
|
|
aggSelectionSetParser <- selectTableAggregate sourceInfo tableInfo aggFieldName Nothing
|
|
pure $
|
|
catMaybes
|
|
[ selectionSetParser <&> fmap IR.SourceRelationshipArray,
|
|
aggSelectionSetParser <&> fmap IR.SourceRelationshipArrayAggregate
|
|
]
|
|
pure $
|
|
parsers <&> fmap \select ->
|
|
IR.RemoteSourceSelect _rsfiSource _rsfiSourceConfig select _rsfiMapping
|