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, MonadMemoize)
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
-> RemoteSchemaMap
-> RemoteSchemaPermissions
-> RemoteRelationshipParserBuilder
remoteRelationshipField SourceCache
sourceCache RemoteSchemaMap
remoteSchemaCache RemoteSchemaPermissions
remoteSchemaPermissions = (forall lhsJoinField r (n :: * -> *) (m :: * -> *).
 MonadBuildSchemaBase r m n =>
 RemoteFieldInfo lhsJoinField
 -> m (Maybe
         [FieldParser n (RemoteRelationshipField UnpreparedValue)]))
-> RemoteRelationshipParserBuilder
RemoteRelationshipParserBuilder
  \RemoteFieldInfo {HashMap FieldName lhsJoinField
RemoteFieldInfoRHS
_rfiRHS :: forall lhsJoinField.
RemoteFieldInfo lhsJoinField -> RemoteFieldInfoRHS
_rfiLHS :: forall lhsJoinField.
RemoteFieldInfo lhsJoinField -> HashMap FieldName lhsJoinField
_rfiRHS :: RemoteFieldInfoRHS
_rfiLHS :: HashMap FieldName lhsJoinField
..} -> MaybeT m [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> m (Maybe
        [FieldParser n (RemoteRelationshipField UnpreparedValue)])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    SchemaKind
queryType <- (SchemaContext -> SchemaKind) -> MaybeT m SchemaKind
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> SchemaKind
scSchemaKind
    -- https://github.com/hasura/graphql-engine/issues/5144
    -- The above issue is easily fixable by removing the following guard
    Bool -> MaybeT m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT m ()) -> Bool -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ SchemaKind -> Bool
isHasuraSchema SchemaKind
queryType
    case RemoteFieldInfoRHS
_rfiRHS of
      RFISource AnyBackend RemoteSourceFieldInfo
anyRemoteSourceFieldInfo ->
        AnyBackend RemoteSourceFieldInfo
-> (forall (b :: BackendType).
    (BackendSchema b, BackendTableSelectSchema b) =>
    RemoteSourceFieldInfo b
    -> MaybeT
         m [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> MaybeT
     m [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall (c1 :: BackendType -> Constraint)
       (c2 :: BackendType -> Constraint) (i :: BackendType -> *) r.
(AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
AnyBackend i
-> (forall (b :: BackendType). (c1 b, c2 b) => i b -> r) -> r
dispatchAnyBackendWithTwoConstraints @BackendSchema @BackendTableSelectSchema
          AnyBackend RemoteSourceFieldInfo
anyRemoteSourceFieldInfo
          \RemoteSourceFieldInfo b
remoteSourceFieldInfo -> do
            [FieldParser
   n
   (RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)]
fields <- m [FieldParser
     n
     (RemoteSourceSelect
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)]
-> MaybeT
     m
     [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [FieldParser
      n
      (RemoteSourceSelect
         (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)]
 -> MaybeT
      m
      [FieldParser
         n
         (RemoteSourceSelect
            (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)])
-> m [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)]
-> MaybeT
     m
     [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)]
forall a b. (a -> b) -> a -> b
$ SourceCache
-> RemoteSourceFieldInfo b
-> m [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)]
forall r (m :: * -> *) (n :: * -> *) (tgt :: BackendType).
(MonadBuildSchemaBase r m n, BackendSchema tgt,
 BackendTableSelectSchema tgt) =>
SourceCache
-> RemoteSourceFieldInfo tgt
-> m [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
remoteRelationshipToSourceField SourceCache
sourceCache RemoteSourceFieldInfo b
remoteSourceFieldInfo
            [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> MaybeT
     m [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser n (RemoteRelationshipField UnpreparedValue)]
 -> MaybeT
      m [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> MaybeT
     m [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall a b. (a -> b) -> a -> b
$ (RemoteSourceSelect
   (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
 -> RemoteRelationshipField UnpreparedValue)
-> FieldParser
     n
     (RemoteSourceSelect
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)
-> FieldParser n (RemoteRelationshipField UnpreparedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AnyBackend
  (RemoteSourceSelect
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> RemoteRelationshipField UnpreparedValue
forall (vf :: BackendType -> *).
AnyBackend (RemoteSourceSelect (RemoteRelationshipField vf) vf)
-> RemoteRelationshipField vf
IR.RemoteSourceField (AnyBackend
   (RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
 -> RemoteRelationshipField UnpreparedValue)
-> (RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
    -> AnyBackend
         (RemoteSourceSelect
            (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> RemoteSourceSelect
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
-> RemoteRelationshipField UnpreparedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSourceSelect
  (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
-> AnyBackend
     (RemoteSourceSelect
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
mkAnyBackend) (FieldParser
   n
   (RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)
 -> FieldParser n (RemoteRelationshipField UnpreparedValue))
-> [FieldParser
      n
      (RemoteSourceSelect
         (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)]
-> [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldParser
   n
   (RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)]
fields
      RFISchema RemoteSchemaFieldInfo
remoteSchema -> do
        FieldParser
  n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))
fields <- m (Maybe
     (FieldParser
        n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))))
-> MaybeT
     m
     (FieldParser
        n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe
      (FieldParser
         n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))))
 -> MaybeT
      m
      (FieldParser
         n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))))
-> m (Maybe
        (FieldParser
           n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))))
-> MaybeT
     m
     (FieldParser
        n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)))
forall a b. (a -> b) -> a -> b
$ RemoteSchemaMap
-> RemoteSchemaPermissions
-> HashMap FieldName lhsJoinField
-> RemoteSchemaFieldInfo
-> m (Maybe
        (FieldParser
           n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))))
forall r (m :: * -> *) (n :: * -> *) lhsJoinField.
MonadBuildSchemaBase r m n =>
RemoteSchemaMap
-> RemoteSchemaPermissions
-> HashMap FieldName lhsJoinField
-> RemoteSchemaFieldInfo
-> m (Maybe
        (FieldParser
           n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))))
remoteRelationshipToSchemaField RemoteSchemaMap
remoteSchemaCache RemoteSchemaPermissions
remoteSchemaPermissions HashMap FieldName lhsJoinField
_rfiLHS RemoteSchemaFieldInfo
remoteSchema
        [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> MaybeT
     m [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser n (RemoteRelationshipField UnpreparedValue)]
 -> MaybeT
      m [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> MaybeT
     m [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall a b. (a -> b) -> a -> b
$ FieldParser n (RemoteRelationshipField UnpreparedValue)
-> [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser n (RemoteRelationshipField UnpreparedValue)
 -> [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> FieldParser n (RemoteRelationshipField UnpreparedValue)
-> [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall a b. (a -> b) -> a -> b
$ RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)
-> RemoteRelationshipField UnpreparedValue
forall (vf :: BackendType -> *).
RemoteSchemaSelect (RemoteRelationshipField vf)
-> RemoteRelationshipField vf
IR.RemoteSchemaField (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)
 -> RemoteRelationshipField UnpreparedValue)
-> FieldParser
     n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))
-> FieldParser n (RemoteRelationshipField UnpreparedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser
  n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))
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 :: RemoteSchemaMap
-> RemoteSchemaPermissions
-> HashMap FieldName lhsJoinField
-> RemoteSchemaFieldInfo
-> m (Maybe
        (FieldParser
           n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))))
remoteRelationshipToSchemaField RemoteSchemaMap
remoteSchemaCache RemoteSchemaPermissions
remoteSchemaPermissions HashMap FieldName lhsJoinField
lhsFields RemoteSchemaFieldInfo {[TypeDefinition [Name] RemoteSchemaInputValueDefinition]
HashMap Name RemoteSchemaInputValueDefinition
RelName
RemoteSchemaName
RemoteSchemaInfo
LHSIdentifier
RemoteFields
_rrfiLHSIdentifier :: RemoteSchemaFieldInfo -> LHSIdentifier
_rrfiRemoteSchemaName :: RemoteSchemaFieldInfo -> RemoteSchemaName
_rrfiInputValueDefinitions :: RemoteSchemaFieldInfo
-> [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
_rrfiRemoteSchema :: RemoteSchemaFieldInfo -> RemoteSchemaInfo
_rrfiRemoteFields :: RemoteSchemaFieldInfo -> RemoteFields
_rrfiParamMap :: RemoteSchemaFieldInfo
-> HashMap Name RemoteSchemaInputValueDefinition
_rrfiName :: RemoteSchemaFieldInfo -> RelName
_rrfiLHSIdentifier :: LHSIdentifier
_rrfiRemoteSchemaName :: RemoteSchemaName
_rrfiInputValueDefinitions :: [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
_rrfiRemoteSchema :: RemoteSchemaInfo
_rrfiRemoteFields :: RemoteFields
_rrfiParamMap :: HashMap Name RemoteSchemaInputValueDefinition
_rrfiName :: RelName
..} = MaybeT
  m
  (FieldParser
     n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)))
-> m (Maybe
        (FieldParser
           n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  RoleName
roleName <- (SchemaContext -> RoleName) -> MaybeT m RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  RemoteSchemaCtx
remoteSchemaContext <-
    RemoteSchemaName -> RemoteSchemaMap -> Maybe RemoteSchemaCtx
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup RemoteSchemaName
_rrfiRemoteSchemaName RemoteSchemaMap
remoteSchemaCache
      Maybe RemoteSchemaCtx
-> MaybeT m RemoteSchemaCtx -> MaybeT m RemoteSchemaCtx
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> MaybeT m RemoteSchemaCtx
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"invalid remote schema name: " Text -> RemoteSchemaName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RemoteSchemaName
_rrfiRemoteSchemaName)
  IntrospectionResult
introspection <- Maybe IntrospectionResult -> MaybeT m IntrospectionResult
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe IntrospectionResult -> MaybeT m IntrospectionResult)
-> Maybe IntrospectionResult -> MaybeT m IntrospectionResult
forall a b. (a -> b) -> a -> b
$ RemoteSchemaPermissions
-> RoleName -> RemoteSchemaCtx -> Maybe IntrospectionResult
getIntrospectionResult RemoteSchemaPermissions
remoteSchemaPermissions RoleName
roleName RemoteSchemaCtx
remoteSchemaContext
  let remoteSchemaRelationships :: RemoteSchemaRelationships
remoteSchemaRelationships = RemoteSchemaCtx -> RemoteSchemaRelationships
_rscRemoteRelationships RemoteSchemaCtx
remoteSchemaContext
      roleIntrospection :: RemoteSchemaIntrospection
roleIntrospection = IntrospectionResult -> RemoteSchemaIntrospection
irDoc IntrospectionResult
introspection
      remoteSchemaRoot :: Name
remoteSchemaRoot = IntrospectionResult -> Name
irQueryRoot IntrospectionResult
introspection
      remoteSchemaCustomizer :: RemoteSchemaCustomizer
remoteSchemaCustomizer = RemoteSchemaInfo -> RemoteSchemaCustomizer
rsCustomizer (RemoteSchemaInfo -> RemoteSchemaCustomizer)
-> RemoteSchemaInfo -> RemoteSchemaCustomizer
forall a b. (a -> b) -> a -> b
$ RemoteSchemaCtx -> RemoteSchemaInfo
_rscInfo RemoteSchemaCtx
remoteSchemaContext
      RemoteSchemaIntrospection HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefns = RemoteSchemaIntrospection
roleIntrospection
  let hasuraFieldNames :: HashSet FieldName
hasuraFieldNames = HashMap FieldName lhsJoinField -> HashSet FieldName
forall k a. HashMap k a -> HashSet k
Map.keysSet HashMap FieldName lhsJoinField
lhsFields
      relationshipDef :: ToSchemaRelationshipDef
relationshipDef = RemoteSchemaName
-> HashSet FieldName -> RemoteFields -> ToSchemaRelationshipDef
ToSchemaRelationshipDef RemoteSchemaName
_rrfiRemoteSchemaName HashSet FieldName
hasuraFieldNames RemoteFields
_rrfiRemoteFields
  ([TypeDefinition [Name] RemoteSchemaInputValueDefinition]
newInpValDefns :: [G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition], HashMap Name RemoteSchemaInputValueDefinition
remoteFieldParamMap) <-
    if RoleName
roleName RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== 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
        ([TypeDefinition [Name] RemoteSchemaInputValueDefinition],
 HashMap Name RemoteSchemaInputValueDefinition)
-> MaybeT
     m
     ([TypeDefinition [Name] RemoteSchemaInputValueDefinition],
      HashMap Name RemoteSchemaInputValueDefinition)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TypeDefinition [Name] RemoteSchemaInputValueDefinition]
_rrfiInputValueDefinitions, HashMap Name RemoteSchemaInputValueDefinition
_rrfiParamMap)
      else do
        (HashMap FieldName lhsJoinField
_, RemoteSchemaFieldInfo
roleRemoteField) <-
          forall (f :: * -> *) a.
(Foldable (Either ValidationError), Alternative f) =>
Either ValidationError a -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t a -> f a
afold @(Either _) (Either
   ValidationError
   (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo)
 -> MaybeT
      m (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo))
-> Either
     ValidationError
     (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo)
-> MaybeT m (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo)
forall a b. (a -> b) -> a -> b
$
            -- TODO: this really needs to go way, we shouldn't be doing
            -- validation when building parsers
            ToSchemaRelationshipDef
-> LHSIdentifier
-> RelName
-> (RemoteSchemaInfo, IntrospectionResult)
-> HashMap FieldName lhsJoinField
-> Either
     ValidationError
     (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo)
forall (m :: * -> *) joinField.
MonadError ValidationError m =>
ToSchemaRelationshipDef
-> LHSIdentifier
-> RelName
-> (RemoteSchemaInfo, IntrospectionResult)
-> HashMap FieldName joinField
-> m (HashMap FieldName joinField, RemoteSchemaFieldInfo)
validateToSchemaRelationship ToSchemaRelationshipDef
relationshipDef LHSIdentifier
_rrfiLHSIdentifier RelName
_rrfiName (RemoteSchemaInfo
_rrfiRemoteSchema, IntrospectionResult
introspection) HashMap FieldName lhsJoinField
lhsFields
        ([TypeDefinition [Name] RemoteSchemaInputValueDefinition],
 HashMap Name RemoteSchemaInputValueDefinition)
-> MaybeT
     m
     ([TypeDefinition [Name] RemoteSchemaInputValueDefinition],
      HashMap Name RemoteSchemaInputValueDefinition)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteSchemaFieldInfo
-> [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
Remote._rrfiInputValueDefinitions RemoteSchemaFieldInfo
roleRemoteField, RemoteSchemaFieldInfo
-> HashMap Name RemoteSchemaInputValueDefinition
Remote._rrfiParamMap RemoteSchemaFieldInfo
roleRemoteField)
  let -- add the new input value definitions created by the remote relationship
      -- to the existing schema introspection of the role
      remoteRelationshipIntrospection :: RemoteSchemaIntrospection
remoteRelationshipIntrospection = HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> RemoteSchemaIntrospection
RemoteSchemaIntrospection (HashMap
   Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
 -> RemoteSchemaIntrospection)
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> RemoteSchemaIntrospection
forall a b. (a -> b) -> a -> b
$ HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefns HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a. Semigroup a => a -> a -> a
<> (TypeDefinition [Name] RemoteSchemaInputValueDefinition -> Name)
-> [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall k v. (Eq k, Hashable k) => (v -> k) -> [v] -> HashMap k v
Map.fromListOn TypeDefinition [Name] RemoteSchemaInputValueDefinition -> Name
forall possibleTypes inputType.
TypeDefinition possibleTypes inputType -> Name
getTypeName [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
newInpValDefns
  Name
fieldName <- Text -> MaybeT m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (Text -> MaybeT m Name) -> Text -> MaybeT m Name
forall a b. (a -> b) -> a -> b
$ RelName -> Text
relNameToTxt RelName
_rrfiName

  -- This selection set parser, should be of the remote node's selection set parser, which comes
  -- from the fieldCall
  let fieldCalls :: NonEmpty FieldCall
fieldCalls = RemoteFields -> NonEmpty FieldCall
unRemoteFields RemoteFields
_rrfiRemoteFields
  GType
nestedFieldType <- m GType -> MaybeT m GType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GType -> MaybeT m GType) -> m GType -> MaybeT m GType
forall a b. (a -> b) -> a -> b
$ Name -> RemoteSchemaIntrospection -> NonEmpty FieldCall -> m GType
forall (m :: * -> *).
(MonadMemoize m, MonadError QErr m) =>
Name -> RemoteSchemaIntrospection -> NonEmpty FieldCall -> m GType
lookupNestedFieldType Name
remoteSchemaRoot RemoteSchemaIntrospection
roleIntrospection NonEmpty FieldCall
fieldCalls
  let typeName :: Name
typeName = GType -> Name
G.getBaseType GType
nestedFieldType
  TypeDefinition [Name] RemoteSchemaInputValueDefinition
fieldTypeDefinition <-
    Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> MaybeT
     m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> MaybeT
     m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
roleIntrospection Name
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
    (MaybeT m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
 -> MaybeT
      m (TypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> MaybeT
     m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> MaybeT
     m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$
      Text
-> MaybeT
     m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
 -> MaybeT
      m (TypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> Text
-> MaybeT
     m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ Text
"unexpected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
typeName Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found "
  -- These are the arguments that are given by the user while executing a query
  let remoteFieldUserArguments :: [RemoteSchemaInputValueDefinition]
remoteFieldUserArguments = ((Name, RemoteSchemaInputValueDefinition)
 -> RemoteSchemaInputValueDefinition)
-> [(Name, RemoteSchemaInputValueDefinition)]
-> [RemoteSchemaInputValueDefinition]
forall a b. (a -> b) -> [a] -> [b]
map (Name, RemoteSchemaInputValueDefinition)
-> RemoteSchemaInputValueDefinition
forall a b. (a, b) -> b
snd ([(Name, RemoteSchemaInputValueDefinition)]
 -> [RemoteSchemaInputValueDefinition])
-> [(Name, RemoteSchemaInputValueDefinition)]
-> [RemoteSchemaInputValueDefinition]
forall a b. (a -> b) -> a -> b
$ HashMap Name RemoteSchemaInputValueDefinition
-> [(Name, RemoteSchemaInputValueDefinition)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap Name RemoteSchemaInputValueDefinition
remoteFieldParamMap
  FieldParser
  MetadataObjId
  n
  (GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
remoteFld <-
    RemoteSchemaCustomizer
-> MaybeT
     m
     (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> MaybeT
     m
     (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (m :: * -> *) r a.
(MonadReader r m, Has MkTypename r,
 Has CustomizeRemoteFieldName r) =>
RemoteSchemaCustomizer -> m a -> m a
withRemoteSchemaCustomization RemoteSchemaCustomizer
remoteSchemaCustomizer (MaybeT
   m
   (FieldParser
      MetadataObjId
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
 -> MaybeT
      m
      (FieldParser
         MetadataObjId
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> MaybeT
     m
     (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> MaybeT
     m
     (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$
      m (FieldParser
     MetadataObjId
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> MaybeT
     m
     (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (FieldParser
      MetadataObjId
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
 -> MaybeT
      m
      (FieldParser
         MetadataObjId
         n
         (GraphQLField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)))
-> m (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> MaybeT
     m
     (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall a b. (a -> b) -> a -> b
$
        GType
-> FieldParser
     MetadataObjId
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> FieldParser
     MetadataObjId
     n
     (GraphQLField
        (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
forall (m :: * -> *) origin a.
GType -> FieldParser origin m a -> FieldParser origin m a
P.wrapFieldParser GType
nestedFieldType
          (FieldParser
   MetadataObjId
   n
   (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
 -> FieldParser
      MetadataObjId
      n
      (GraphQLField
         (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> m (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
-> m (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> [RemoteSchemaInputValueDefinition]
-> TypeDefinition [Name] RemoteSchemaInputValueDefinition
-> m (FieldParser
        MetadataObjId
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
RemoteSchemaIntrospection
-> RemoteSchemaRelationships
-> Name
-> Name
-> Maybe Description
-> [RemoteSchemaInputValueDefinition]
-> TypeDefinition [Name] RemoteSchemaInputValueDefinition
-> m (FieldParser
        n
        (GraphQLField
           (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))
remoteField RemoteSchemaIntrospection
remoteRelationshipIntrospection RemoteSchemaRelationships
remoteSchemaRelationships Name
remoteSchemaRoot Name
fieldName Maybe Description
forall a. Maybe a
Nothing [RemoteSchemaInputValueDefinition]
remoteFieldUserArguments TypeDefinition [Name] RemoteSchemaInputValueDefinition
fieldTypeDefinition

  FieldParser
  n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))
-> MaybeT
     m
     (FieldParser
        n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser
   n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))
 -> MaybeT
      m
      (FieldParser
         n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))))
-> FieldParser
     n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))
-> MaybeT
     m
     (FieldParser
        n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)))
forall a b. (a -> b) -> a -> b
$
    FieldParser
  MetadataObjId
  n
  (GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
remoteFld
      FieldParser
  MetadataObjId
  n
  (GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable)
-> (GraphQLField
      (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
    -> n (RemoteSchemaSelect
            (RemoteRelationshipField UnpreparedValue)))
-> FieldParser
     n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))
forall (m :: * -> *) origin a b.
Monad m =>
FieldParser origin m a -> (a -> m b) -> FieldParser origin m b
`P.bindField` \fld :: GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
fld@IR.GraphQLField {_fArguments :: forall r var. GraphQLField r var -> HashMap Name (Value var)
IR._fArguments = HashMap Name (Value RemoteSchemaVariable)
args, _fSelectionSet :: forall r var. GraphQLField r var -> SelectionSet r var
IR._fSelectionSet = SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
selSet, _fName :: forall r var. GraphQLField r var -> Name
IR._fName = Name
fname} -> do
        let remoteArgs :: [RemoteFieldArgument]
remoteArgs =
              HashMap Name (Value RemoteSchemaVariable)
-> [(Name, Value RemoteSchemaVariable)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap Name (Value RemoteSchemaVariable)
args [(Name, Value RemoteSchemaVariable)]
-> ((Name, Value RemoteSchemaVariable) -> RemoteFieldArgument)
-> [RemoteFieldArgument]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
argName, Value RemoteSchemaVariable
argVal) -> Name -> InputValue RemoteSchemaVariable -> RemoteFieldArgument
IR.RemoteFieldArgument Name
argName (InputValue RemoteSchemaVariable -> RemoteFieldArgument)
-> InputValue RemoteSchemaVariable -> RemoteFieldArgument
forall a b. (a -> b) -> a -> b
$ Value RemoteSchemaVariable -> InputValue RemoteSchemaVariable
forall v. Value v -> InputValue v
P.GraphQLValue Value RemoteSchemaVariable
argVal
        let resultCustomizer :: ResultCustomizer
resultCustomizer =
              NonEmpty FieldCall -> ResultCustomizer -> ResultCustomizer
applyFieldCalls NonEmpty FieldCall
fieldCalls (ResultCustomizer -> ResultCustomizer)
-> ResultCustomizer -> ResultCustomizer
forall a b. (a -> b) -> a -> b
$
                AliasMapping -> ResultCustomizer -> ResultCustomizer
applyAliasMapping (Name -> Name -> AliasMapping
singletonAliasMapping Name
fname (FieldCall -> Name
fcName (FieldCall -> Name) -> FieldCall -> Name
forall a b. (a -> b) -> a -> b
$ NonEmpty FieldCall -> FieldCall
forall a. NonEmpty a -> a
NE.last NonEmpty FieldCall
fieldCalls)) (ResultCustomizer -> ResultCustomizer)
-> ResultCustomizer -> ResultCustomizer
forall a b. (a -> b) -> a -> b
$
                  RemoteSchemaCustomizer
-> GraphQLField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> ResultCustomizer
makeResultCustomizer RemoteSchemaCustomizer
remoteSchemaCustomizer GraphQLField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
fld
        RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)
-> n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)
 -> n (RemoteSchemaSelect
         (RemoteRelationshipField UnpreparedValue)))
-> RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue)
-> n (RemoteSchemaSelect (RemoteRelationshipField UnpreparedValue))
forall a b. (a -> b) -> a -> b
$
          RemoteSchemaSelect :: forall r.
[RemoteFieldArgument]
-> ResultCustomizer
-> SelectionSet r RemoteSchemaVariable
-> NonEmpty FieldCall
-> RemoteSchemaInfo
-> RemoteSchemaSelect r
IR.RemoteSchemaSelect
            { _rselArgs :: [RemoteFieldArgument]
IR._rselArgs = [RemoteFieldArgument]
remoteArgs,
              _rselResultCustomizer :: ResultCustomizer
IR._rselResultCustomizer = ResultCustomizer
resultCustomizer,
              _rselSelection :: SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
IR._rselSelection = SelectionSet
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
selSet,
              _rselFieldCall :: NonEmpty FieldCall
IR._rselFieldCall = NonEmpty FieldCall
fieldCalls,
              _rselRemoteSchema :: RemoteSchemaInfo
IR._rselRemoteSchema = RemoteSchemaInfo
_rrfiRemoteSchema
            }
  where
    -- Apply parent field calls so that the result customizer modifies the nested field
    applyFieldCalls :: NonEmpty FieldCall -> ResultCustomizer -> ResultCustomizer
    applyFieldCalls :: NonEmpty FieldCall -> ResultCustomizer -> ResultCustomizer
applyFieldCalls NonEmpty FieldCall
fieldCalls ResultCustomizer
resultCustomizer =
      (FieldCall -> ResultCustomizer -> ResultCustomizer)
-> ResultCustomizer -> [FieldCall] -> ResultCustomizer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Name -> ResultCustomizer -> ResultCustomizer
modifyFieldByName (Name -> ResultCustomizer -> ResultCustomizer)
-> (FieldCall -> Name)
-> FieldCall
-> ResultCustomizer
-> ResultCustomizer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldCall -> Name
fcName) ResultCustomizer
resultCustomizer ([FieldCall] -> ResultCustomizer)
-> [FieldCall] -> ResultCustomizer
forall a b. (a -> b) -> a -> b
$ NonEmpty FieldCall -> [FieldCall]
forall a. NonEmpty a -> [a]
NE.init NonEmpty FieldCall
fieldCalls

lookupNestedFieldType' ::
  (MonadMemoize m, MonadError QErr m) =>
  G.Name ->
  RemoteSchemaIntrospection ->
  FieldCall ->
  m G.GType
lookupNestedFieldType' :: Name -> RemoteSchemaIntrospection -> FieldCall -> m GType
lookupNestedFieldType' Name
parentTypeName RemoteSchemaIntrospection
remoteSchemaIntrospection (FieldCall Name
fcName RemoteArguments
_) =
  case RemoteSchemaIntrospection
-> Name
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupObject RemoteSchemaIntrospection
remoteSchemaIntrospection Name
parentTypeName of
    Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
Nothing -> Code -> Text -> m GType
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError (Text -> m GType) -> Text -> m GType
forall a b. (a -> b) -> a -> b
$ Text
"object with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
parentTypeName Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found"
    Just G.ObjectTypeDefinition {[Directive Void]
[FieldDefinition RemoteSchemaInputValueDefinition]
[Name]
Maybe Description
Name
_otdName :: forall inputType. ObjectTypeDefinition inputType -> Name
_otdImplementsInterfaces :: forall inputType. ObjectTypeDefinition inputType -> [Name]
_otdFieldsDefinition :: forall inputType.
ObjectTypeDefinition inputType -> [FieldDefinition inputType]
_otdDirectives :: forall inputType.
ObjectTypeDefinition inputType -> [Directive Void]
_otdDescription :: forall inputType.
ObjectTypeDefinition inputType -> Maybe Description
_otdFieldsDefinition :: [FieldDefinition RemoteSchemaInputValueDefinition]
_otdDirectives :: [Directive Void]
_otdImplementsInterfaces :: [Name]
_otdName :: Name
_otdDescription :: Maybe Description
..} ->
      case (FieldDefinition RemoteSchemaInputValueDefinition -> Bool)
-> [FieldDefinition RemoteSchemaInputValueDefinition]
-> Maybe (FieldDefinition RemoteSchemaInputValueDefinition)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
fcName) (Name -> Bool)
-> (FieldDefinition RemoteSchemaInputValueDefinition -> Name)
-> FieldDefinition RemoteSchemaInputValueDefinition
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName) [FieldDefinition RemoteSchemaInputValueDefinition]
_otdFieldsDefinition of
        Maybe (FieldDefinition RemoteSchemaInputValueDefinition)
Nothing -> Code -> Text -> m GType
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError (Text -> m GType) -> Text -> m GType
forall a b. (a -> b) -> a -> b
$ Text
"field with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
fcName Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found"
        Just G.FieldDefinition {[Directive Void]
[RemoteSchemaInputValueDefinition]
Maybe Description
GType
Name
_fldType :: forall inputType. FieldDefinition inputType -> GType
_fldDirectives :: forall inputType. FieldDefinition inputType -> [Directive Void]
_fldDescription :: forall inputType. FieldDefinition inputType -> Maybe Description
_fldArgumentsDefinition :: forall inputType.
FieldDefinition inputType -> ArgumentsDefinition inputType
_fldDirectives :: [Directive Void]
_fldType :: GType
_fldArgumentsDefinition :: [RemoteSchemaInputValueDefinition]
_fldName :: Name
_fldDescription :: Maybe Description
_fldName :: forall inputType. FieldDefinition inputType -> Name
..} -> GType -> m GType
forall (f :: * -> *) a. Applicative f => a -> f a
pure GType
_fldType

lookupNestedFieldType ::
  (MonadMemoize m, MonadError QErr m) =>
  G.Name ->
  RemoteSchemaIntrospection ->
  NonEmpty FieldCall ->
  m G.GType
lookupNestedFieldType :: Name -> RemoteSchemaIntrospection -> NonEmpty FieldCall -> m GType
lookupNestedFieldType Name
parentTypeName RemoteSchemaIntrospection
remoteSchemaIntrospection (FieldCall
fieldCall :| [FieldCall]
rest) = do
  GType
fieldType <- Name -> RemoteSchemaIntrospection -> FieldCall -> m GType
forall (m :: * -> *).
(MonadMemoize m, MonadError QErr m) =>
Name -> RemoteSchemaIntrospection -> FieldCall -> m GType
lookupNestedFieldType' Name
parentTypeName RemoteSchemaIntrospection
remoteSchemaIntrospection FieldCall
fieldCall
  case [FieldCall] -> Maybe (NonEmpty FieldCall)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [FieldCall]
rest of
    Maybe (NonEmpty FieldCall)
Nothing -> GType -> m GType
forall (f :: * -> *) a. Applicative f => a -> f a
pure GType
fieldType
    Just NonEmpty FieldCall
rest' -> do
      Name -> RemoteSchemaIntrospection -> NonEmpty FieldCall -> m GType
forall (m :: * -> *).
(MonadMemoize m, MonadError QErr m) =>
Name -> RemoteSchemaIntrospection -> NonEmpty FieldCall -> m GType
lookupNestedFieldType (GType -> Name
G.getBaseType GType
fieldType) RemoteSchemaIntrospection
remoteSchemaIntrospection NonEmpty FieldCall
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 tgt
-> m [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
remoteRelationshipToSourceField SourceCache
sourceCache RemoteSourceFieldInfo {HashMap FieldName (ScalarType tgt, Column tgt)
SourceName
RelType
RelName
SourceConfig tgt
TableName tgt
SourceTypeCustomization
_rsfiMapping :: forall (tgt :: BackendType).
RemoteSourceFieldInfo tgt
-> HashMap FieldName (ScalarType tgt, Column tgt)
_rsfiTable :: forall (tgt :: BackendType).
RemoteSourceFieldInfo tgt -> TableName tgt
_rsfiSourceCustomization :: forall (tgt :: BackendType).
RemoteSourceFieldInfo tgt -> SourceTypeCustomization
_rsfiSourceConfig :: forall (tgt :: BackendType).
RemoteSourceFieldInfo tgt -> SourceConfig tgt
_rsfiSource :: forall (tgt :: BackendType).
RemoteSourceFieldInfo tgt -> SourceName
_rsfiType :: forall (tgt :: BackendType). RemoteSourceFieldInfo tgt -> RelType
_rsfiName :: forall (tgt :: BackendType). RemoteSourceFieldInfo tgt -> RelName
_rsfiMapping :: HashMap FieldName (ScalarType tgt, Column tgt)
_rsfiTable :: TableName tgt
_rsfiSourceCustomization :: SourceTypeCustomization
_rsfiSourceConfig :: SourceConfig tgt
_rsfiSource :: SourceName
_rsfiType :: RelType
_rsfiName :: RelName
..} =
  MkTypename
-> m [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
-> m [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
forall (m :: * -> *) r a.
(MonadReader r m, Has MkTypename r) =>
MkTypename -> m a -> m a
withTypenameCustomization (Maybe SourceTypeCustomization -> NamingCase -> MkTypename
mkCustomizedTypename (SourceTypeCustomization -> Maybe SourceTypeCustomization
forall a. a -> Maybe a
Just SourceTypeCustomization
_rsfiSourceCustomization) NamingCase
HasuraCase) do
    NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
    RoleName
roleName <- (SchemaContext -> RoleName) -> m RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
    SourceInfo tgt
sourceInfo <-
      Maybe (SourceInfo tgt) -> m (SourceInfo tgt) -> m (SourceInfo tgt)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (HasTag tgt => BackendSourceInfo -> Maybe (SourceInfo tgt)
forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo @tgt (BackendSourceInfo -> Maybe (SourceInfo tgt))
-> Maybe BackendSourceInfo -> Maybe (SourceInfo tgt)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceName -> SourceCache -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup SourceName
_rsfiSource SourceCache
sourceCache) (m (SourceInfo tgt) -> m (SourceInfo tgt))
-> m (SourceInfo tgt) -> m (SourceInfo tgt)
forall a b. (a -> b) -> a -> b
$
        Text -> m (SourceInfo tgt)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m (SourceInfo tgt)) -> Text -> m (SourceInfo tgt)
forall a b. (a -> b) -> a -> b
$ Text
"source not found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
forall t. ToTxt t => t -> Text
dquote SourceName
_rsfiSource
    TableInfo tgt
tableInfo <- SourceInfo tgt -> TableName tgt -> m (TableInfo tgt)
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
SourceInfo b -> TableName b -> m (TableInfo b)
askTableInfo SourceInfo tgt
sourceInfo TableName tgt
_rsfiTable
    Name
fieldName <- Text -> m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (Text -> m Name) -> Text -> m Name
forall a b. (a -> b) -> a -> b
$ RelName -> Text
relNameToTxt RelName
_rsfiName
    case RoleName -> TableInfo tgt -> Maybe (SelPermInfo tgt)
forall (b :: BackendType).
RoleName -> TableInfo b -> Maybe (SelPermInfo b)
tableSelectPermissions @tgt RoleName
roleName TableInfo tgt
tableInfo of
      Maybe (SelPermInfo tgt)
Nothing -> [FieldParser
   n
   (RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
-> m [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just SelPermInfo tgt
tablePerms -> do
        [FieldParser
   MetadataObjId
   n
   (SourceRelationshipSelection
      tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
parsers <- case RelType
_rsfiType of
          RelType
ObjRel -> do
            Maybe (Parser 'Output n (AnnotatedFields tgt))
selectionSetParserM <- SourceInfo tgt
-> TableInfo tgt
-> m (Maybe (Parser 'Output n (AnnotatedFields tgt)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSchemaBase r m n) =>
SourceInfo b
-> TableInfo b -> m (Maybe (Parser 'Output n (AnnotatedFields b)))
tableSelectionSet SourceInfo tgt
sourceInfo TableInfo tgt
tableInfo
            [FieldParser
   MetadataObjId
   n
   (SourceRelationshipSelection
      tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
-> m [FieldParser
        MetadataObjId
        n
        (SourceRelationshipSelection
           tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser
    MetadataObjId
    n
    (SourceRelationshipSelection
       tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
 -> m [FieldParser
         MetadataObjId
         n
         (SourceRelationshipSelection
            tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)])
-> [FieldParser
      MetadataObjId
      n
      (SourceRelationshipSelection
         tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
-> m [FieldParser
        MetadataObjId
        n
        (SourceRelationshipSelection
           tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
forall a b. (a -> b) -> a -> b
$ case Maybe (Parser 'Output n (AnnotatedFields tgt))
selectionSetParserM of
              Maybe (Parser 'Output n (AnnotatedFields tgt))
Nothing -> []
              Just Parser 'Output n (AnnotatedFields tgt)
selectionSetParser ->
                FieldParser
  MetadataObjId
  n
  (SourceRelationshipSelection
     tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> [FieldParser
      MetadataObjId
      n
      (SourceRelationshipSelection
         tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser
   MetadataObjId
   n
   (SourceRelationshipSelection
      tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
 -> [FieldParser
       MetadataObjId
       n
       (SourceRelationshipSelection
          tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)])
-> FieldParser
     MetadataObjId
     n
     (SourceRelationshipSelection
        tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> [FieldParser
      MetadataObjId
      n
      (SourceRelationshipSelection
         tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
forall a b. (a -> b) -> a -> b
$
                  Name
-> Maybe Description
-> Parser 'Output n (AnnotatedFields tgt)
-> FieldParser MetadataObjId n (AnnotatedFields tgt)
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Output m a
-> FieldParser origin m a
P.subselection_ Name
fieldName Maybe Description
forall a. Maybe a
Nothing Parser 'Output n (AnnotatedFields tgt)
selectionSetParser FieldParser MetadataObjId n (AnnotatedFields tgt)
-> (AnnotatedFields tgt
    -> SourceRelationshipSelection
         tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> FieldParser
     MetadataObjId
     n
     (SourceRelationshipSelection
        tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \AnnotatedFields tgt
fields ->
                    AnnObjectSelectG
  tgt (RemoteRelationshipField UnpreparedValue) (UnpreparedValue tgt)
-> SourceRelationshipSelection
     tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue
forall (b :: BackendType) r (vf :: BackendType -> *).
AnnObjectSelectG b r (vf b) -> SourceRelationshipSelection b r vf
IR.SourceRelationshipObject (AnnObjectSelectG
   tgt (RemoteRelationshipField UnpreparedValue) (UnpreparedValue tgt)
 -> SourceRelationshipSelection
      tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> AnnObjectSelectG
     tgt (RemoteRelationshipField UnpreparedValue) (UnpreparedValue tgt)
-> SourceRelationshipSelection
     tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue
forall a b. (a -> b) -> a -> b
$
                      AnnotatedFields tgt
-> TableName tgt
-> AnnBoolExp tgt (UnpreparedValue tgt)
-> AnnObjectSelectG
     tgt (RemoteRelationshipField UnpreparedValue) (UnpreparedValue tgt)
forall (b :: BackendType) r v.
AnnFieldsG b r v
-> TableName b -> AnnBoolExp b v -> AnnObjectSelectG b r v
IR.AnnObjectSelectG AnnotatedFields tgt
fields TableName tgt
_rsfiTable (AnnBoolExp tgt (UnpreparedValue tgt)
 -> AnnObjectSelectG
      tgt
      (RemoteRelationshipField UnpreparedValue)
      (UnpreparedValue tgt))
-> AnnBoolExp tgt (UnpreparedValue tgt)
-> AnnObjectSelectG
     tgt (RemoteRelationshipField UnpreparedValue) (UnpreparedValue tgt)
forall a b. (a -> b) -> a -> b
$ TablePermG tgt (UnpreparedValue tgt)
-> AnnBoolExp tgt (UnpreparedValue tgt)
forall (b :: BackendType) v. TablePermG b v -> AnnBoolExp b v
IR._tpFilter (TablePermG tgt (UnpreparedValue tgt)
 -> AnnBoolExp tgt (UnpreparedValue tgt))
-> TablePermG tgt (UnpreparedValue tgt)
-> AnnBoolExp tgt (UnpreparedValue tgt)
forall a b. (a -> b) -> a -> b
$ SelPermInfo tgt -> TablePermG tgt (UnpreparedValue tgt)
forall (b :: BackendType).
Backend b =>
SelPermInfo b -> TablePerms b
tablePermissionsInfo SelPermInfo tgt
tablePerms
          RelType
ArrRel -> do
            let aggFieldName :: Name
aggFieldName = NamingCase -> GQLNameIdentifier -> Name
applyFieldNameCaseIdentifier NamingCase
tCase (GQLNameIdentifier -> Name) -> GQLNameIdentifier -> Name
forall a b. (a -> b) -> a -> b
$ (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple (Name
fieldName, [Name -> NameSuffix
G.convertNameToSuffix Name
Name._aggregate])
            Maybe (FieldParser n (SelectExp tgt))
selectionSetParser <- SourceInfo tgt
-> TableInfo tgt
-> Name
-> Maybe Description
-> m (Maybe (FieldParser n (SelectExp tgt)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSchemaBase r m n) =>
SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe (FieldParser n (SelectExp b)))
selectTable SourceInfo tgt
sourceInfo TableInfo tgt
tableInfo Name
fieldName Maybe Description
forall a. Maybe a
Nothing
            Maybe (FieldParser n (AggSelectExp tgt))
aggSelectionSetParser <- SourceInfo tgt
-> TableInfo tgt
-> Name
-> Maybe Description
-> m (Maybe (FieldParser n (AggSelectExp tgt)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSchemaBase r m n) =>
SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe (FieldParser n (AggSelectExp b)))
selectTableAggregate SourceInfo tgt
sourceInfo TableInfo tgt
tableInfo Name
aggFieldName Maybe Description
forall a. Maybe a
Nothing
            [FieldParser
   MetadataObjId
   n
   (SourceRelationshipSelection
      tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
-> m [FieldParser
        MetadataObjId
        n
        (SourceRelationshipSelection
           tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser
    MetadataObjId
    n
    (SourceRelationshipSelection
       tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
 -> m [FieldParser
         MetadataObjId
         n
         (SourceRelationshipSelection
            tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)])
-> [FieldParser
      MetadataObjId
      n
      (SourceRelationshipSelection
         tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
-> m [FieldParser
        MetadataObjId
        n
        (SourceRelationshipSelection
           tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
forall a b. (a -> b) -> a -> b
$
              [Maybe
   (FieldParser
      MetadataObjId
      n
      (SourceRelationshipSelection
         tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue))]
-> [FieldParser
      MetadataObjId
      n
      (SourceRelationshipSelection
         tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
                [ Maybe (FieldParser n (SelectExp tgt))
selectionSetParser Maybe (FieldParser n (SelectExp tgt))
-> (FieldParser n (SelectExp tgt)
    -> FieldParser
         MetadataObjId
         n
         (SourceRelationshipSelection
            tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> Maybe
     (FieldParser
        MetadataObjId
        n
        (SourceRelationshipSelection
           tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (SelectExp tgt
 -> SourceRelationshipSelection
      tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> FieldParser n (SelectExp tgt)
-> FieldParser
     MetadataObjId
     n
     (SourceRelationshipSelection
        tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelectExp tgt
-> SourceRelationshipSelection
     tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue
forall (b :: BackendType) r (vf :: BackendType -> *).
AnnSimpleSelectG b r (vf b) -> SourceRelationshipSelection b r vf
IR.SourceRelationshipArray,
                  Maybe (FieldParser n (AggSelectExp tgt))
aggSelectionSetParser Maybe (FieldParser n (AggSelectExp tgt))
-> (FieldParser n (AggSelectExp tgt)
    -> FieldParser
         MetadataObjId
         n
         (SourceRelationshipSelection
            tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> Maybe
     (FieldParser
        MetadataObjId
        n
        (SourceRelationshipSelection
           tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (AggSelectExp tgt
 -> SourceRelationshipSelection
      tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> FieldParser n (AggSelectExp tgt)
-> FieldParser
     MetadataObjId
     n
     (SourceRelationshipSelection
        tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AggSelectExp tgt
-> SourceRelationshipSelection
     tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue
forall (b :: BackendType) r (vf :: BackendType -> *).
AnnAggregateSelectG b r (vf b)
-> SourceRelationshipSelection b r vf
IR.SourceRelationshipArrayAggregate
                ]
        [FieldParser
   n
   (RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
-> m [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FieldParser
    n
    (RemoteSourceSelect
       (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
 -> m [FieldParser
         n
         (RemoteSourceSelect
            (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)])
-> [FieldParser
      n
      (RemoteSourceSelect
         (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
-> m [FieldParser
        n
        (RemoteSourceSelect
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
forall a b. (a -> b) -> a -> b
$
          [FieldParser
   MetadataObjId
   n
   (SourceRelationshipSelection
      tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
parsers [FieldParser
   MetadataObjId
   n
   (SourceRelationshipSelection
      tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)]
-> (FieldParser
      MetadataObjId
      n
      (SourceRelationshipSelection
         tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
    -> FieldParser
         n
         (RemoteSourceSelect
            (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt))
-> [FieldParser
      n
      (RemoteSourceSelect
         (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (SourceRelationshipSelection
   tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue
 -> RemoteSourceSelect
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)
-> FieldParser
     MetadataObjId
     n
     (SourceRelationshipSelection
        tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
-> FieldParser
     n
     (RemoteSourceSelect
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \SourceRelationshipSelection
  tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue
select ->
            SourceName
-> SourceConfig tgt
-> SourceRelationshipSelection
     tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue
-> HashMap FieldName (ScalarType tgt, Column tgt)
-> RemoteSourceSelect
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue tgt
forall r (vf :: BackendType -> *) (tgt :: BackendType).
SourceName
-> SourceConfig tgt
-> SourceRelationshipSelection tgt r vf
-> HashMap FieldName (ScalarType tgt, Column tgt)
-> RemoteSourceSelect r vf tgt
IR.RemoteSourceSelect SourceName
_rsfiSource SourceConfig tgt
_rsfiSourceConfig SourceRelationshipSelection
  tgt (RemoteRelationshipField UnpreparedValue) UnpreparedValue
select HashMap FieldName (ScalarType tgt, Column tgt)
_rsfiMapping