-- | Tools for generating fields for Apollo federation
module Hasura.GraphQL.ApolloFederation
  ( -- * Field Parser generators
    apolloRootFields,
    ApolloFederationParserFunction (..),
    convertToApolloFedParserFunc,
    getApolloFederationStatus,
    generateSDLWithAllTypes,
    generateSDL,
  )
where

import Control.Lens ((??))
import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KMap
import Data.Aeson.Ordered qualified as JO
import Data.Bifunctor (Bifunctor (bimap))
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Text qualified as T
import Hasura.Base.Error
import Hasura.Base.ErrorMessage (toErrorMessage)
import Hasura.GraphQL.Parser qualified as P
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Parser
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.IR.Root
import Hasura.RQL.IR.Select
import Hasura.RQL.IR.Value (UnpreparedValue, ValueWithOrigin (ValueNoOrigin))
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.NamingCase
import Hasura.RQL.Types.Schema.Options (StringifyNumbers)
import Hasura.RQL.Types.Source
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Server.Types
import Hasura.Table.Cache
import Language.GraphQL.Draft.Printer qualified as Printer
import Language.GraphQL.Draft.Syntax qualified as G
import Text.Builder qualified as Builder

-- | Internal parser function for entities field
data ApolloFederationParserFunction n = ApolloFederationParserFunction
  { forall (n :: * -> *).
ApolloFederationParserFunction n
-> ApolloFederationAnyType -> n (QueryRootField UnpreparedValue)
aafuGetRootField :: ApolloFederationAnyType -> n (QueryRootField UnpreparedValue)
  }

-- | Haskell representation of _Any scalar
data ApolloFederationAnyType = ApolloFederationAnyType
  { ApolloFederationAnyType -> Name
afTypename :: G.Name,
    ApolloFederationAnyType -> Object
afPKValues :: J.Object
  }
  deriving stock (Int -> ApolloFederationAnyType -> ShowS
[ApolloFederationAnyType] -> ShowS
ApolloFederationAnyType -> String
(Int -> ApolloFederationAnyType -> ShowS)
-> (ApolloFederationAnyType -> String)
-> ([ApolloFederationAnyType] -> ShowS)
-> Show ApolloFederationAnyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApolloFederationAnyType -> ShowS
showsPrec :: Int -> ApolloFederationAnyType -> ShowS
$cshow :: ApolloFederationAnyType -> String
show :: ApolloFederationAnyType -> String
$cshowList :: [ApolloFederationAnyType] -> ShowS
showList :: [ApolloFederationAnyType] -> ShowS
Show)

-- | Parser for _Any scalar
anyParser :: P.Parser origin 'Both Parse ApolloFederationAnyType
anyParser :: forall origin. Parser origin 'Both Parse ApolloFederationAnyType
anyParser =
  Name -> Maybe Description -> Parser origin 'Both Parse Value
forall (m :: * -> *) origin.
MonadParse m =>
Name -> Maybe Description -> Parser origin 'Both m Value
jsonScalar Name
Name.__Any (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"Scalar _Any") Parser origin 'Both Parse Value
-> (Value -> Parse ApolloFederationAnyType)
-> Parser origin 'Both Parse ApolloFederationAnyType
forall (m :: * -> *) origin (k :: Kind) a b.
Monad m =>
Parser origin k m a -> (a -> m b) -> Parser origin k m b
`bind` \Value
val -> do
    let typenameKey :: Key
typenameKey = Text -> Key
K.fromText Text
"__typename"
    case Value
val of
      J.Object Object
obj -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KMap.lookup Key
typenameKey Object
obj of
        Just (J.String Text
txt) -> case Text -> Maybe Name
G.mkName Text
txt of
          Just Name
tName ->
            ApolloFederationAnyType -> Parse ApolloFederationAnyType
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (ApolloFederationAnyType -> Parse ApolloFederationAnyType)
-> ApolloFederationAnyType -> Parse ApolloFederationAnyType
forall a b. (a -> b) -> a -> b
$ ApolloFederationAnyType
                { afTypename :: Name
afTypename = Name
tName,
                  afPKValues :: Object
afPKValues = Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
KMap.delete Key
typenameKey Object
obj
                }
          Maybe Name
Nothing -> ErrorMessage -> Parse ApolloFederationAnyType
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> Parse ApolloFederationAnyType)
-> ErrorMessage -> Parse ApolloFederationAnyType
forall a b. (a -> b) -> a -> b
$ Text -> ErrorMessage
toErrorMessage (Text -> ErrorMessage) -> Text -> ErrorMessage
forall a b. (a -> b) -> a -> b
$ Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a valid graphql name"
        Maybe Value
Nothing -> ErrorMessage -> Parse ApolloFederationAnyType
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> Parse ApolloFederationAnyType)
-> ErrorMessage -> Parse ApolloFederationAnyType
forall a b. (a -> b) -> a -> b
$ Text -> ErrorMessage
toErrorMessage Text
"__typename key not found"
        Maybe Value
_ -> ErrorMessage -> Parse ApolloFederationAnyType
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> Parse ApolloFederationAnyType)
-> ErrorMessage -> Parse ApolloFederationAnyType
forall a b. (a -> b) -> a -> b
$ Text -> ErrorMessage
toErrorMessage Text
"__typename can only be a string value"
      Value
_ -> ErrorMessage -> Parse ApolloFederationAnyType
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> Parse ApolloFederationAnyType)
-> ErrorMessage -> Parse ApolloFederationAnyType
forall a b. (a -> b) -> a -> b
$ Text -> ErrorMessage
toErrorMessage Text
"representations is expecting a list of objects only"

convertToApolloFedParserFunc ::
  (MonadParse n, Backend b) =>
  SourceInfo b ->
  TableInfo b ->
  TablePermG b (UnpreparedValue b) ->
  StringifyNumbers ->
  Maybe NamingCase ->
  NESeq (ColumnInfo b) ->
  Parser 'Output n (AnnotatedFields b) ->
  Parser 'Output n (ApolloFederationParserFunction n)
convertToApolloFedParserFunc :: forall (n :: * -> *) (b :: BackendType).
(MonadParse n, Backend b) =>
SourceInfo b
-> TableInfo b
-> TablePermG b (UnpreparedValue b)
-> StringifyNumbers
-> Maybe NamingCase
-> NESeq (ColumnInfo b)
-> Parser 'Output n (AnnotatedFields b)
-> Parser 'Output n (ApolloFederationParserFunction n)
convertToApolloFedParserFunc SourceInfo b
sInfo TableInfo b
tInfo TablePermG b (UnpreparedValue b)
selPerm StringifyNumbers
stringifyNumbers Maybe NamingCase
tCase NESeq (ColumnInfo b)
pKeys =
  (AnnotatedFields b -> ApolloFederationParserFunction n)
-> Parser MetadataObjId 'Output n (AnnotatedFields b)
-> Parser
     MetadataObjId 'Output n (ApolloFederationParserFunction n)
forall a b.
(a -> b)
-> Parser MetadataObjId 'Output n a
-> Parser MetadataObjId 'Output n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SourceInfo b
-> TableInfo b
-> TablePermG b (UnpreparedValue b)
-> StringifyNumbers
-> Maybe NamingCase
-> NESeq (ColumnInfo b)
-> AnnotatedFields b
-> ApolloFederationParserFunction n
forall (n :: * -> *) (b :: BackendType).
(MonadParse n, Backend b) =>
SourceInfo b
-> TableInfo b
-> TablePermG b (UnpreparedValue b)
-> StringifyNumbers
-> Maybe NamingCase
-> NESeq (ColumnInfo b)
-> AnnotatedFields b
-> ApolloFederationParserFunction n
modifyApolloFedParserFunc SourceInfo b
sInfo TableInfo b
tInfo TablePermG b (UnpreparedValue b)
selPerm StringifyNumbers
stringifyNumbers Maybe NamingCase
tCase NESeq (ColumnInfo b)
pKeys)

modifyApolloFedParserFunc ::
  (MonadParse n, Backend b) =>
  SourceInfo b ->
  TableInfo b ->
  TablePermG b (UnpreparedValue b) ->
  StringifyNumbers ->
  Maybe NamingCase ->
  NESeq (ColumnInfo b) ->
  AnnotatedFields b ->
  ApolloFederationParserFunction n
modifyApolloFedParserFunc :: forall (n :: * -> *) (b :: BackendType).
(MonadParse n, Backend b) =>
SourceInfo b
-> TableInfo b
-> TablePermG b (UnpreparedValue b)
-> StringifyNumbers
-> Maybe NamingCase
-> NESeq (ColumnInfo b)
-> AnnotatedFields b
-> ApolloFederationParserFunction n
modifyApolloFedParserFunc
  SourceInfo {Maybe QueryTagsConfig
TableCache b
FunctionCache b
StoredProcedureCache b
LogicalModelCache b
NativeQueryCache b
BackendSourceKind b
SourceName
SourceConfig b
ResolvedSourceCustomization
DBObjectsIntrospection b
_siName :: SourceName
_siSourceKind :: BackendSourceKind b
_siTables :: TableCache b
_siFunctions :: FunctionCache b
_siNativeQueries :: NativeQueryCache b
_siStoredProcedures :: StoredProcedureCache b
_siLogicalModels :: LogicalModelCache b
_siConfiguration :: SourceConfig b
_siQueryTagsConfig :: Maybe QueryTagsConfig
_siCustomization :: ResolvedSourceCustomization
_siDbObjectsIntrospection :: DBObjectsIntrospection b
_siName :: forall (b :: BackendType). SourceInfo b -> SourceName
_siSourceKind :: forall (b :: BackendType). SourceInfo b -> BackendSourceKind b
_siTables :: forall (b :: BackendType). SourceInfo b -> TableCache b
_siFunctions :: forall (b :: BackendType). SourceInfo b -> FunctionCache b
_siNativeQueries :: forall (b :: BackendType). SourceInfo b -> NativeQueryCache b
_siStoredProcedures :: forall (b :: BackendType). SourceInfo b -> StoredProcedureCache b
_siLogicalModels :: forall (b :: BackendType). SourceInfo b -> LogicalModelCache b
_siConfiguration :: forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siQueryTagsConfig :: forall (b :: BackendType). SourceInfo b -> Maybe QueryTagsConfig
_siCustomization :: forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siDbObjectsIntrospection :: forall (b :: BackendType). SourceInfo b -> DBObjectsIntrospection b
..}
  TableInfo {RolePermInfoMap b
EventTriggerInfoMap b
RolePermInfo b
TableCoreInfo b
_tiCoreInfo :: TableCoreInfo b
_tiRolePermInfoMap :: RolePermInfoMap b
_tiEventTriggerInfoMap :: EventTriggerInfoMap b
_tiAdminRolePermInfo :: RolePermInfo b
_tiCoreInfo :: forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiRolePermInfoMap :: forall (b :: BackendType). TableInfo b -> RolePermInfoMap b
_tiEventTriggerInfoMap :: forall (b :: BackendType). TableInfo b -> EventTriggerInfoMap b
_tiAdminRolePermInfo :: forall (b :: BackendType). TableInfo b -> RolePermInfo b
..}
  TablePermG b (UnpreparedValue b)
selectPermissions
  StringifyNumbers
stringifyNumbers
  Maybe NamingCase
tCase
  NESeq (ColumnInfo b)
primaryKeys
  AnnotatedFields b
annField = (ApolloFederationAnyType -> n (QueryRootField UnpreparedValue))
-> ApolloFederationParserFunction n
forall (n :: * -> *).
(ApolloFederationAnyType -> n (QueryRootField UnpreparedValue))
-> ApolloFederationParserFunction n
ApolloFederationParserFunction ((ApolloFederationAnyType -> n (QueryRootField UnpreparedValue))
 -> ApolloFederationParserFunction n)
-> (ApolloFederationAnyType -> n (QueryRootField UnpreparedValue))
-> ApolloFederationParserFunction n
forall a b. (a -> b) -> a -> b
$ \ApolloFederationAnyType {Object
Name
afTypename :: ApolloFederationAnyType -> Name
afPKValues :: ApolloFederationAnyType -> Object
afTypename :: Name
afPKValues :: Object
..} -> do
    NESeq (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
allConstraints <-
      NESeq (ColumnInfo b)
-> (ColumnInfo b
    -> n (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))))
-> n (NESeq (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for NESeq (ColumnInfo b)
primaryKeys \ColumnInfo b
columnInfo -> do
        let colName :: Text
colName = Name -> Text
G.unName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> Name
forall (b :: BackendType). ColumnInfo b -> Name
ciName ColumnInfo b
columnInfo
            cvType :: ColumnType b
cvType = ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo b
columnInfo
        ScalarValue b
cvValue <- case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KMap.lookup (Text -> Key
K.fromText Text
colName) Object
afPKValues of
          Maybe Value
Nothing -> ErrorMessage -> n (ScalarValue b)
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> n (ScalarValue b))
-> (Text -> ErrorMessage) -> Text -> n (ScalarValue b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorMessage
toErrorMessage (Text -> n (ScalarValue b)) -> Text -> n (ScalarValue b)
forall a b. (a -> b) -> a -> b
$ Text
"cannot find " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
colName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in _Any type"
          Just Value
va -> Except QErr (ScalarValue b) -> n (ScalarValue b)
forall {a}. Except QErr a -> n a
liftQErr (Except QErr (ScalarValue b) -> n (ScalarValue b))
-> Except QErr (ScalarValue b) -> n (ScalarValue b)
forall a b. (a -> b) -> a -> b
$ (ReaderT (SourceConfig b) (ExceptT QErr Identity) (ScalarValue b)
 -> SourceConfig b -> Except QErr (ScalarValue b))
-> SourceConfig b
-> ReaderT (SourceConfig b) (ExceptT QErr Identity) (ScalarValue b)
-> Except QErr (ScalarValue b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (SourceConfig b) (ExceptT QErr Identity) (ScalarValue b)
-> SourceConfig b -> Except QErr (ScalarValue b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT SourceConfig b
_siConfiguration (ReaderT (SourceConfig b) (ExceptT QErr Identity) (ScalarValue b)
 -> Except QErr (ScalarValue b))
-> ReaderT (SourceConfig b) (ExceptT QErr Identity) (ScalarValue b)
-> Except QErr (ScalarValue b)
forall a b. (a -> b) -> a -> b
$ ColumnType b
-> Value
-> ReaderT (SourceConfig b) (ExceptT QErr Identity) (ScalarValue b)
forall (m :: * -> *) (b :: BackendType) r.
(MonadError QErr m, Backend b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnType (ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo b
columnInfo) Value
va
        GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
-> n (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
 -> n (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))))
-> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
-> n (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ AnnBoolExpFld b (UnpreparedValue b)
-> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
forall (backend :: BackendType) field.
field -> GBoolExp backend field
IR.BoolField
          (AnnBoolExpFld b (UnpreparedValue b)
 -> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
-> (ValueWithOrigin (ColumnValue b)
    -> AnnBoolExpFld b (UnpreparedValue b))
-> ValueWithOrigin (ColumnValue b)
-> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo b
-> [OpExpG b (UnpreparedValue b)]
-> AnnBoolExpFld b (UnpreparedValue b)
forall (backend :: BackendType) leaf.
ColumnInfo backend
-> [OpExpG backend leaf] -> AnnBoolExpFld backend leaf
IR.AVColumn ColumnInfo b
columnInfo
          ([OpExpG b (UnpreparedValue b)]
 -> AnnBoolExpFld b (UnpreparedValue b))
-> (ValueWithOrigin (ColumnValue b)
    -> [OpExpG b (UnpreparedValue b)])
-> ValueWithOrigin (ColumnValue b)
-> AnnBoolExpFld b (UnpreparedValue b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpExpG b (UnpreparedValue b) -> [OpExpG b (UnpreparedValue b)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (OpExpG b (UnpreparedValue b) -> [OpExpG b (UnpreparedValue b)])
-> (ValueWithOrigin (ColumnValue b)
    -> OpExpG b (UnpreparedValue b))
-> ValueWithOrigin (ColumnValue b)
-> [OpExpG b (UnpreparedValue b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComparisonNullability
-> UnpreparedValue b -> OpExpG b (UnpreparedValue b)
forall (backend :: BackendType) field.
ComparisonNullability -> field -> OpExpG backend field
IR.AEQ ComparisonNullability
IR.NonNullableComparison
          (UnpreparedValue b -> OpExpG b (UnpreparedValue b))
-> (ValueWithOrigin (ColumnValue b) -> UnpreparedValue b)
-> ValueWithOrigin (ColumnValue b)
-> OpExpG b (UnpreparedValue b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
forall (b :: BackendType).
ValueWithOrigin (ColumnValue b) -> UnpreparedValue b
IR.mkParameter
          (ValueWithOrigin (ColumnValue b)
 -> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
-> ValueWithOrigin (ColumnValue b)
-> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ ColumnValue b -> ValueWithOrigin (ColumnValue b)
forall a. a -> ValueWithOrigin a
ValueNoOrigin
          (ColumnValue b -> ValueWithOrigin (ColumnValue b))
-> ColumnValue b -> ValueWithOrigin (ColumnValue b)
forall a b. (a -> b) -> a -> b
$ ColumnValue {ScalarValue b
ColumnType b
cvType :: ColumnType b
cvValue :: ScalarValue b
cvType :: ColumnType b
cvValue :: ScalarValue b
..}
    let whereExpr :: Maybe (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
whereExpr = GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
-> Maybe (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
forall a. a -> Maybe a
Just (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
 -> Maybe (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))))
-> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
-> Maybe (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ [GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))]
-> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
IR.BoolAnd ([GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))]
 -> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
-> [GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))]
-> GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ NESeq (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
-> [GBoolExp b (AnnBoolExpFld b (UnpreparedValue b))]
forall a. NESeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NESeq (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
allConstraints
        sourceName :: SourceName
sourceName = SourceName
_siName
        sourceConfig :: SourceConfig b
sourceConfig = SourceConfig b
_siConfiguration
        tableName :: TableName b
tableName = TableCoreInfo b -> TableName b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName TableCoreInfo b
_tiCoreInfo
        queryDBRoot :: QueryDBRoot
  (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
queryDBRoot =
          QueryDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDBRoot
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
forall r (v :: BackendType -> *) (b :: BackendType).
QueryDB b r (v b) -> QueryDBRoot r v b
IR.QDBR
            (QueryDB
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> QueryDBRoot
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDBRoot
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
forall a b. (a -> b) -> a -> b
$ AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
IR.QDBSingleRow
            (AnnSimpleSelectG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$ IR.AnnSelectG
              { $sel:_asnFields:AnnSelectG :: AnnotatedFields b
IR._asnFields = AnnotatedFields b
annField,
                $sel:_asnFrom:AnnSelectG :: SelectFromG b (UnpreparedValue b)
IR._asnFrom = TableName b -> SelectFromG b (UnpreparedValue b)
forall (b :: BackendType) v. TableName b -> SelectFromG b v
IR.FromTable TableName b
tableName,
                $sel:_asnPerm:AnnSelectG :: TablePermG b (UnpreparedValue b)
IR._asnPerm = TablePermG b (UnpreparedValue b)
selectPermissions,
                $sel:_asnArgs:AnnSelectG :: SelectArgsG b (UnpreparedValue b)
IR._asnArgs = SelectArgsG b (UnpreparedValue b)
forall (backend :: BackendType) v. SelectArgsG backend v
IR.noSelectArgs {$sel:_saWhere:SelectArgs :: Maybe (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
IR._saWhere = Maybe (GBoolExp b (AnnBoolExpFld b (UnpreparedValue b)))
whereExpr},
                $sel:_asnStrfyNum:AnnSelectG :: StringifyNumbers
IR._asnStrfyNum = StringifyNumbers
stringifyNumbers,
                $sel:_asnNamingConvention:AnnSelectG :: Maybe NamingCase
IR._asnNamingConvention = Maybe NamingCase
tCase
              }
    QueryRootField UnpreparedValue
-> n (QueryRootField UnpreparedValue)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (QueryRootField UnpreparedValue
 -> n (QueryRootField UnpreparedValue))
-> QueryRootField UnpreparedValue
-> n (QueryRootField UnpreparedValue)
forall a b. (a -> b) -> a -> b
$ SourceName
-> AnyBackend
     (SourceConfigWith
        (QueryDBRoot
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> QueryRootField UnpreparedValue
forall (db :: BackendType -> *) remote action raw.
SourceName
-> AnyBackend (SourceConfigWith db)
-> RootField db remote action raw
IR.RFDB SourceName
sourceName
      (AnyBackend
   (SourceConfigWith
      (QueryDBRoot
         (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
 -> QueryRootField UnpreparedValue)
-> AnyBackend
     (SourceConfigWith
        (QueryDBRoot
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> QueryRootField UnpreparedValue
forall a b. (a -> b) -> a -> b
$ SourceConfigWith
  (QueryDBRoot
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
  b
-> AnyBackend
     (SourceConfigWith
        (QueryDBRoot
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
      (SourceConfigWith
   (QueryDBRoot
      (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
   b
 -> AnyBackend
      (SourceConfigWith
         (QueryDBRoot
            (RemoteRelationshipField UnpreparedValue) UnpreparedValue)))
-> SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
     b
-> AnyBackend
     (SourceConfigWith
        (QueryDBRoot
           (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
forall a b. (a -> b) -> a -> b
$ SourceConfig b
-> Maybe QueryTagsConfig
-> QueryDBRoot
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
-> SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
     b
forall (db :: BackendType -> *) (b :: BackendType).
SourceConfig b
-> Maybe QueryTagsConfig -> db b -> SourceConfigWith db b
IR.SourceConfigWith SourceConfig b
sourceConfig Maybe QueryTagsConfig
forall a. Maybe a
Nothing
      (QueryDBRoot
   (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
 -> SourceConfigWith
      (QueryDBRoot
         (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
      b)
-> QueryDBRoot
     (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
-> SourceConfigWith
     (QueryDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue)
     b
forall a b. (a -> b) -> a -> b
$ QueryDBRoot
  (RemoteRelationshipField UnpreparedValue) UnpreparedValue b
queryDBRoot
    where
      liftQErr :: Except QErr a -> n a
liftQErr = (QErr -> n a) -> (a -> n a) -> Either QErr a -> n a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ErrorMessage -> n a
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> n a) -> (QErr -> ErrorMessage) -> QErr -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorMessage
toErrorMessage (Text -> ErrorMessage) -> (QErr -> Text) -> QErr -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QErr -> Text
qeError) a -> n a
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QErr a -> n a)
-> (Except QErr a -> Either QErr a) -> Except QErr a -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except QErr a -> Either QErr a
forall e a. Except e a -> Either e a
runExcept

-------------------------------------------------------------------------------
-- Related to @service@ field

-- main function

-- | Creates @_service@ @FieldParser@ using the schema introspection.
--   This will allow us to process the following query:
--
--   > query {
--   >   _service {
--   >     sdl
--   >   }
--   > }
mkServiceField ::
  FieldParser P.Parse (G.SchemaIntrospection -> QueryRootField UnpreparedValue)
mkServiceField :: FieldParser
  Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
mkServiceField = FieldParser
  Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
serviceFieldParser
  where
    sdlField :: FieldParser origin Parse (SchemaIntrospection -> Value)
sdlField = Text -> Value
JO.String (Text -> Value)
-> (SchemaIntrospection -> Text) -> SchemaIntrospection -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaIntrospection -> Text
generateSDL (SchemaIntrospection -> Value)
-> FieldParser origin Parse ()
-> FieldParser origin Parse (SchemaIntrospection -> Value)
forall a b.
a -> FieldParser origin Parse b -> FieldParser origin Parse a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Name
-> Maybe Description
-> Parser origin 'Both Parse Text
-> FieldParser origin Parse ()
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Both m a
-> FieldParser origin m ()
P.selection_ Name
Name._sdl (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"SDL representation of schema") Parser origin 'Both Parse Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.string
    serviceParser :: Parser
  MetadataObjId
  'Output
  Parse
  (InsOrdHashMap
     Name (ParsedSelection (SchemaIntrospection -> Value)))
serviceParser = Parser
  MetadataObjId
  'Output
  Parse
  (InsOrdHashMap
     Name (ParsedSelection (SchemaIntrospection -> Value)))
-> Parser
     MetadataObjId
     'Output
     Parse
     (InsOrdHashMap
        Name (ParsedSelection (SchemaIntrospection -> Value)))
forall (m :: * -> *) origin (k :: Kind) a.
Parser origin k m a -> Parser origin k m a
P.nonNullableParser (Parser
   MetadataObjId
   'Output
   Parse
   (InsOrdHashMap
      Name (ParsedSelection (SchemaIntrospection -> Value)))
 -> Parser
      MetadataObjId
      'Output
      Parse
      (InsOrdHashMap
         Name (ParsedSelection (SchemaIntrospection -> Value))))
-> Parser
     MetadataObjId
     'Output
     Parse
     (InsOrdHashMap
        Name (ParsedSelection (SchemaIntrospection -> Value)))
-> Parser
     MetadataObjId
     'Output
     Parse
     (InsOrdHashMap
        Name (ParsedSelection (SchemaIntrospection -> Value)))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> [FieldParser MetadataObjId Parse (SchemaIntrospection -> Value)]
-> Parser
     MetadataObjId
     'Output
     Parse
     (InsOrdHashMap
        Name (ParsedSelection (SchemaIntrospection -> Value)))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> [FieldParser origin m a]
-> Parser origin 'Output m (InsOrdHashMap Name (ParsedSelection a))
P.selectionSet Name
Name.__Service Maybe Description
forall a. Maybe a
Nothing [FieldParser MetadataObjId Parse (SchemaIntrospection -> Value)
forall {origin}.
FieldParser origin Parse (SchemaIntrospection -> Value)
sdlField]
    serviceFieldParser :: FieldParser
  Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
serviceFieldParser =
      Name
-> Maybe Description
-> Parser
     MetadataObjId
     'Output
     Parse
     (InsOrdHashMap
        Name (ParsedSelection (SchemaIntrospection -> Value)))
-> FieldParser
     MetadataObjId
     Parse
     (InsOrdHashMap
        Name (ParsedSelection (SchemaIntrospection -> Value)))
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Output m a
-> FieldParser origin m a
P.subselection_ Name
Name.__service Maybe Description
forall a. Maybe a
Nothing Parser
  MetadataObjId
  'Output
  Parse
  (InsOrdHashMap
     Name (ParsedSelection (SchemaIntrospection -> Value)))
serviceParser FieldParser
  MetadataObjId
  Parse
  (InsOrdHashMap
     Name (ParsedSelection (SchemaIntrospection -> Value)))
-> (InsOrdHashMap
      Name (ParsedSelection (SchemaIntrospection -> Value))
    -> Parse (SchemaIntrospection -> QueryRootField UnpreparedValue))
-> FieldParser
     Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
forall (m :: * -> *) origin a b.
Monad m =>
FieldParser origin m a -> (a -> m b) -> FieldParser origin m b
`bindField` \InsOrdHashMap Name (ParsedSelection (SchemaIntrospection -> Value))
selSet -> do
        let partialValue :: InsOrdHashMap Text (SchemaIntrospection -> Value)
partialValue = (ParsedSelection (SchemaIntrospection -> Value)
 -> SchemaIntrospection -> Value)
-> InsOrdHashMap
     Text (ParsedSelection (SchemaIntrospection -> Value))
-> InsOrdHashMap Text (SchemaIntrospection -> Value)
forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
InsOrdHashMap.map (\ParsedSelection (SchemaIntrospection -> Value)
ps -> (Name -> SchemaIntrospection -> Value)
-> ParsedSelection (SchemaIntrospection -> Value)
-> SchemaIntrospection
-> Value
forall a. (Name -> a) -> ParsedSelection a -> a
handleTypename (\Name
tName SchemaIntrospection
_ -> Name -> Value
forall a. ToJSON a => a -> Value
JO.toOrdered Name
tName) ParsedSelection (SchemaIntrospection -> Value)
ps) ((Name -> Text)
-> InsOrdHashMap
     Name (ParsedSelection (SchemaIntrospection -> Value))
-> InsOrdHashMap
     Text (ParsedSelection (SchemaIntrospection -> Value))
forall k' k v.
(Eq k', Hashable k') =>
(k -> k') -> InsOrdHashMap k v -> InsOrdHashMap k' v
InsOrdHashMap.mapKeys Name -> Text
G.unName InsOrdHashMap Name (ParsedSelection (SchemaIntrospection -> Value))
selSet)
        (SchemaIntrospection -> QueryRootField UnpreparedValue)
-> Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure \SchemaIntrospection
schemaIntrospection -> Value -> QueryRootField UnpreparedValue
forall raw (db :: BackendType -> *) remote action.
raw -> RootField db remote action raw
RFRaw (Value -> QueryRootField UnpreparedValue)
-> (InsOrdHashMap Text Value -> Value)
-> InsOrdHashMap Text Value
-> QueryRootField UnpreparedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap Text Value -> Value
JO.fromOrderedHashMap (InsOrdHashMap Text Value -> QueryRootField UnpreparedValue)
-> InsOrdHashMap Text Value -> QueryRootField UnpreparedValue
forall a b. (a -> b) -> a -> b
$ (InsOrdHashMap Text (SchemaIntrospection -> Value)
partialValue InsOrdHashMap Text (SchemaIntrospection -> Value)
-> SchemaIntrospection -> InsOrdHashMap Text Value
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? SchemaIntrospection
schemaIntrospection)

apolloRootFields ::
  ApolloFederationStatus ->
  [(G.Name, Parser 'Output P.Parse (ApolloFederationParserFunction P.Parse))] ->
  [FieldParser P.Parse (G.SchemaIntrospection -> QueryRootField UnpreparedValue)]
apolloRootFields :: ApolloFederationStatus
-> [(Name,
     Parser 'Output Parse (ApolloFederationParserFunction Parse))]
-> [FieldParser
      Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)]
apolloRootFields ApolloFederationStatus
apolloFederationStatus [(Name,
  Parser 'Output Parse (ApolloFederationParserFunction Parse))]
apolloFedTableParsers =
  let -- generate the `_service` field parser
      serviceField :: FieldParser
  Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
serviceField = FieldParser
  Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
mkServiceField

      -- generate the `_entities` field parser
      entityField :: FieldParser
  Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
entityField = QueryRootField UnpreparedValue
-> SchemaIntrospection -> QueryRootField UnpreparedValue
forall a b. a -> b -> a
const (QueryRootField UnpreparedValue
 -> SchemaIntrospection -> QueryRootField UnpreparedValue)
-> FieldParser MetadataObjId Parse (QueryRootField UnpreparedValue)
-> FieldParser
     Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name,
  Parser 'Output Parse (ApolloFederationParserFunction Parse))]
-> FieldParser MetadataObjId Parse (QueryRootField UnpreparedValue)
mkEntityUnionFieldParser [(Name,
  Parser 'Output Parse (ApolloFederationParserFunction Parse))]
apolloFedTableParsers
   in -- we would want to expose these fields inorder to support apollo federation
      -- refer https://www.apollographql.com/docs/federation/federation-spec
      -- `serviceField` is essential to connect hasura to gateway, `entityField`
      -- is essential only if we have types that has @key directive
      if
        | ApolloFederationStatus -> Bool
isApolloFederationEnabled ApolloFederationStatus
apolloFederationStatus Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Name,
  Parser 'Output Parse (ApolloFederationParserFunction Parse))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name,
  Parser 'Output Parse (ApolloFederationParserFunction Parse))]
apolloFedTableParsers) ->
            [FieldParser
  Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
serviceField, FieldParser
  Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
entityField]
        | ApolloFederationStatus -> Bool
isApolloFederationEnabled ApolloFederationStatus
apolloFederationStatus ->
            [FieldParser
  Parse (SchemaIntrospection -> QueryRootField UnpreparedValue)
serviceField]
        | Bool
otherwise -> []

-- helpers

-- | Check if the Apollo Federation feature is enabled or not. If the user has explicitly set the Apollo Federation
--   status, then we use that else we fallback to the experimental feature flag
getApolloFederationStatus :: HashSet ExperimentalFeature -> Maybe ApolloFederationStatus -> ApolloFederationStatus
getApolloFederationStatus :: HashSet ExperimentalFeature
-> Maybe ApolloFederationStatus -> ApolloFederationStatus
getApolloFederationStatus HashSet ExperimentalFeature
experimentalFeatures Maybe ApolloFederationStatus
Nothing =
  ApolloFederationStatus
-> ApolloFederationStatus -> Bool -> ApolloFederationStatus
forall a. a -> a -> Bool -> a
bool ApolloFederationStatus
ApolloFederationDisabled ApolloFederationStatus
ApolloFederationEnabled (ExperimentalFeature
EFApolloFederation ExperimentalFeature -> HashSet ExperimentalFeature -> Bool
forall a. Eq a => a -> HashSet a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HashSet ExperimentalFeature
experimentalFeatures)
getApolloFederationStatus HashSet ExperimentalFeature
_ (Just ApolloFederationStatus
apolloFederationStatus) = ApolloFederationStatus
apolloFederationStatus

data GenerateSDLType
  = -- | Preserves schema types (GraphQL types prefixed with __) in the sdl generated
    AllTypes
  | -- | Removes schema types (GraphQL types prefixed with __) in the sdl generated
    RemoveSchemaTypes
  deriving (GenerateSDLType -> GenerateSDLType -> Bool
(GenerateSDLType -> GenerateSDLType -> Bool)
-> (GenerateSDLType -> GenerateSDLType -> Bool)
-> Eq GenerateSDLType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenerateSDLType -> GenerateSDLType -> Bool
== :: GenerateSDLType -> GenerateSDLType -> Bool
$c/= :: GenerateSDLType -> GenerateSDLType -> Bool
/= :: GenerateSDLType -> GenerateSDLType -> Bool
Eq)

generateSDLFromIntrospection :: GenerateSDLType -> G.SchemaIntrospection -> Text
generateSDLFromIntrospection :: GenerateSDLType -> SchemaIntrospection -> Text
generateSDLFromIntrospection GenerateSDLType
genSdlType (G.SchemaIntrospection HashMap Name (TypeDefinition [Name] InputValueDefinition)
sIntro) = Text
sdl
  where
    -- NOTE:  add this to the sdl to support apollo v2 directive
    _supportV2 :: Text
    _supportV2 :: Text
_supportV2 = Text
"\n\nextend schema\n@link(url: \"https://specs.apollo.dev/federation/v2.0\",\nimport: [\"@key\", \"@shareable\"])"

    schemaFilterFn :: TypeDefinition () InputValueDefinition
-> TypeDefinition () InputValueDefinition
schemaFilterFn = (TypeDefinition () InputValueDefinition
 -> TypeDefinition () InputValueDefinition)
-> (TypeDefinition () InputValueDefinition
    -> TypeDefinition () InputValueDefinition)
-> Bool
-> TypeDefinition () InputValueDefinition
-> TypeDefinition () InputValueDefinition
forall a. a -> a -> Bool -> a
bool TypeDefinition () InputValueDefinition
-> TypeDefinition () InputValueDefinition
forall a. a -> a
id TypeDefinition () InputValueDefinition
-> TypeDefinition () InputValueDefinition
forall possibleTypes.
TypeDefinition possibleTypes InputValueDefinition
-> TypeDefinition possibleTypes InputValueDefinition
filterTypeDefinition (GenerateSDLType
genSdlType GenerateSDLType -> GenerateSDLType -> Bool
forall a. Eq a => a -> a -> Bool
== GenerateSDLType
RemoveSchemaTypes)

    -- first we filter out the type definitions which are not relevent such as
    -- schema fields and types (starts with `__`)
    typeDefns :: [TypeSystemDefinition]
typeDefns = (TypeDefinition [Name] InputValueDefinition
 -> TypeSystemDefinition)
-> [TypeDefinition [Name] InputValueDefinition]
-> [TypeSystemDefinition]
forall a b. (a -> b) -> [a] -> [b]
map (TypeDefinition () InputValueDefinition -> TypeSystemDefinition
G.TypeSystemDefinitionType (TypeDefinition () InputValueDefinition -> TypeSystemDefinition)
-> (TypeDefinition [Name] InputValueDefinition
    -> TypeDefinition () InputValueDefinition)
-> TypeDefinition [Name] InputValueDefinition
-> TypeSystemDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition () InputValueDefinition
-> TypeDefinition () InputValueDefinition
schemaFilterFn (TypeDefinition () InputValueDefinition
 -> TypeDefinition () InputValueDefinition)
-> (TypeDefinition [Name] InputValueDefinition
    -> TypeDefinition () InputValueDefinition)
-> TypeDefinition [Name] InputValueDefinition
-> TypeDefinition () InputValueDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Name] -> ())
-> (InputValueDefinition -> InputValueDefinition)
-> TypeDefinition [Name] InputValueDefinition
-> TypeDefinition () InputValueDefinition
forall a b c d.
(a -> b) -> (c -> d) -> TypeDefinition a c -> TypeDefinition b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (() -> [Name] -> ()
forall a b. a -> b -> a
const ()) InputValueDefinition -> InputValueDefinition
forall a. a -> a
id) (HashMap Name (TypeDefinition [Name] InputValueDefinition)
-> [TypeDefinition [Name] InputValueDefinition]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap Name (TypeDefinition [Name] InputValueDefinition)
sIntro)

    -- next we get the root operation type definitions
    rootOpTypeDefns :: [RootOperationTypeDefinition]
rootOpTypeDefns =
      ((Name, OperationType) -> Maybe RootOperationTypeDefinition)
-> [(Name, OperationType)] -> [RootOperationTypeDefinition]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
        ( \(Name
fieldName, OperationType
operationType) ->
            Name
-> HashMap Name (TypeDefinition [Name] InputValueDefinition)
-> Maybe (TypeDefinition [Name] InputValueDefinition)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
fieldName HashMap Name (TypeDefinition [Name] InputValueDefinition)
sIntro
              Maybe (TypeDefinition [Name] InputValueDefinition)
-> RootOperationTypeDefinition -> Maybe RootOperationTypeDefinition
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> OperationType -> Name -> RootOperationTypeDefinition
G.RootOperationTypeDefinition OperationType
operationType Name
fieldName
        )
        [ (Name
Name._query_root, OperationType
G.OperationTypeQuery),
          (Name
Name._mutation_root, OperationType
G.OperationTypeMutation),
          (Name
Name._subscription_root, OperationType
G.OperationTypeSubscription)
        ]

    -- finally we gather everything, run the printer and generate full sdl in `Text`
    sdl :: Text
sdl = Builder -> Text
Builder.run (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ SchemaDocument -> Builder
forall a. Printer a => SchemaDocument -> a
Printer.schemaDocument SchemaDocument
getSchemaDocument

    getSchemaDocument :: G.SchemaDocument
    getSchemaDocument :: SchemaDocument
getSchemaDocument =
      [TypeSystemDefinition] -> SchemaDocument
G.SchemaDocument
        ([TypeSystemDefinition] -> SchemaDocument)
-> [TypeSystemDefinition] -> SchemaDocument
forall a b. (a -> b) -> a -> b
$ SchemaDefinition -> TypeSystemDefinition
G.TypeSystemDefinitionSchema (Maybe [Directive Void]
-> [RootOperationTypeDefinition] -> SchemaDefinition
G.SchemaDefinition Maybe [Directive Void]
forall a. Maybe a
Nothing [RootOperationTypeDefinition]
rootOpTypeDefns)
        TypeSystemDefinition
-> [TypeSystemDefinition] -> [TypeSystemDefinition]
forall a. a -> [a] -> [a]
: [TypeSystemDefinition]
typeDefns

-- | Filter out schema components from sdl which are not required by apollo federation
filterTypeDefinition :: G.TypeDefinition possibleTypes G.InputValueDefinition -> G.TypeDefinition possibleTypes G.InputValueDefinition
filterTypeDefinition :: forall possibleTypes.
TypeDefinition possibleTypes InputValueDefinition
-> TypeDefinition possibleTypes InputValueDefinition
filterTypeDefinition = \case
  G.TypeDefinitionObject (G.ObjectTypeDefinition Maybe Description
a Name
b [Name]
c [Directive Void]
d [FieldDefinition InputValueDefinition]
e) ->
    -- We are skipping the schema types here
    ObjectTypeDefinition InputValueDefinition
-> TypeDefinition possibleTypes InputValueDefinition
forall possibleTypes inputType.
ObjectTypeDefinition inputType
-> TypeDefinition possibleTypes inputType
G.TypeDefinitionObject
      (ObjectTypeDefinition InputValueDefinition
 -> TypeDefinition possibleTypes InputValueDefinition)
-> ObjectTypeDefinition InputValueDefinition
-> TypeDefinition possibleTypes InputValueDefinition
forall a b. (a -> b) -> a -> b
$ Maybe Description
-> Name
-> [Name]
-> [Directive Void]
-> [FieldDefinition InputValueDefinition]
-> ObjectTypeDefinition InputValueDefinition
forall inputType.
Maybe Description
-> Name
-> [Name]
-> [Directive Void]
-> [FieldDefinition inputType]
-> ObjectTypeDefinition inputType
G.ObjectTypeDefinition Maybe Description
a Name
b [Name]
c [Directive Void]
d ((FieldDefinition InputValueDefinition -> Bool)
-> [FieldDefinition InputValueDefinition]
-> [FieldDefinition InputValueDefinition]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (FieldDefinition InputValueDefinition -> Bool)
-> FieldDefinition InputValueDefinition
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
T.isPrefixOf Text
"__" (Text -> Bool)
-> (FieldDefinition InputValueDefinition -> Text)
-> FieldDefinition InputValueDefinition
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName (Name -> Text)
-> (FieldDefinition InputValueDefinition -> Name)
-> FieldDefinition InputValueDefinition
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition InputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName) [FieldDefinition InputValueDefinition]
e)
  TypeDefinition possibleTypes InputValueDefinition
typeDef -> TypeDefinition possibleTypes InputValueDefinition
typeDef

generateSDLWithAllTypes :: G.SchemaIntrospection -> Text
generateSDLWithAllTypes :: SchemaIntrospection -> Text
generateSDLWithAllTypes = GenerateSDLType -> SchemaIntrospection -> Text
generateSDLFromIntrospection GenerateSDLType
AllTypes

generateSDL :: G.SchemaIntrospection -> Text
generateSDL :: SchemaIntrospection -> Text
generateSDL = GenerateSDLType -> SchemaIntrospection -> Text
generateSDLFromIntrospection GenerateSDLType
RemoveSchemaTypes

-------------------------------------------------------------------------------
-- Related to @_entities@ field

-- main function

-- | Creates @_entities@ @FieldParser@ using `Parser`s for Entity union, schema
--   introspection and a list of all query `FieldParser`.
--   This will allow us to process the following query:
--
--   > query ($representations: [_Any!]!) {
--   >   _entities(representations: $representations) {
--   >     ... on SomeType {
--   >       foo
--   >       bar
--   >     }
--   >   }
--   > }
mkEntityUnionFieldParser ::
  [(G.Name, Parser 'Output Parse (ApolloFederationParserFunction Parse))] ->
  FieldParser P.Parse (QueryRootField UnpreparedValue)
mkEntityUnionFieldParser :: [(Name,
  Parser 'Output Parse (ApolloFederationParserFunction Parse))]
-> FieldParser MetadataObjId Parse (QueryRootField UnpreparedValue)
mkEntityUnionFieldParser [(Name,
  Parser 'Output Parse (ApolloFederationParserFunction Parse))]
apolloFedTableParsers =
  let entityParserMap :: HashMap
  Name (Parser 'Output Parse (ApolloFederationParserFunction Parse))
entityParserMap = [(Name,
  Parser 'Output Parse (ApolloFederationParserFunction Parse))]
-> HashMap
     Name (Parser 'Output Parse (ApolloFederationParserFunction Parse))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Name,
  Parser 'Output Parse (ApolloFederationParserFunction Parse))]
apolloFedTableParsers

      -- the Union `Entities`
      bodyParser :: Parser
  MetadataObjId
  'Output
  Parse
  (HashMap Name (ApolloFederationParserFunction Parse))
bodyParser = Name
-> Maybe Description
-> HashMap
     Name (Parser 'Output Parse (ApolloFederationParserFunction Parse))
-> Parser
     MetadataObjId
     'Output
     Parse
     (HashMap Name (ApolloFederationParserFunction Parse))
forall (n :: * -> *) (t :: * -> *) origin b.
(MonadParse n, Traversable t) =>
Name
-> Maybe Description
-> t (Parser origin 'Output n b)
-> Parser origin 'Output n (t b)
P.selectionSetUnion Name
Name.__Entity (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"A union of all types that use the @key directive") HashMap
  Name (Parser 'Output Parse (ApolloFederationParserFunction Parse))
entityParserMap

      -- name of the field
      name :: Name
name = Name
Name.__entities

      -- description of the field
      description :: Maybe Description
description = Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"query _Entity union"

      representationParser :: InputFieldsParser origin Parse [ApolloFederationAnyType]
representationParser =
        Name
-> Maybe Description
-> Parser origin 'Both Parse [ApolloFederationAnyType]
-> InputFieldsParser origin Parse [ApolloFederationAnyType]
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
field Name
Name._representations Maybe Description
forall a. Maybe a
Nothing (Parser origin 'Both Parse [ApolloFederationAnyType]
 -> InputFieldsParser origin Parse [ApolloFederationAnyType])
-> Parser origin 'Both Parse [ApolloFederationAnyType]
-> InputFieldsParser origin Parse [ApolloFederationAnyType]
forall a b. (a -> b) -> a -> b
$ Parser origin 'Both Parse ApolloFederationAnyType
-> Parser origin 'Both Parse [ApolloFederationAnyType]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
list (Parser origin 'Both Parse ApolloFederationAnyType
 -> Parser origin 'Both Parse [ApolloFederationAnyType])
-> Parser origin 'Both Parse ApolloFederationAnyType
-> Parser origin 'Both Parse [ApolloFederationAnyType]
forall a b. (a -> b) -> a -> b
$ Parser origin 'Both Parse ApolloFederationAnyType
forall origin. Parser origin 'Both Parse ApolloFederationAnyType
anyParser

      entityParser :: FieldParser MetadataObjId Parse (QueryRootField UnpreparedValue)
entityParser =
        Name
-> Maybe Description
-> InputFieldsParser MetadataObjId Parse [ApolloFederationAnyType]
-> Parser
     MetadataObjId
     'Output
     Parse
     (HashMap Name (ApolloFederationParserFunction Parse))
-> FieldParser
     MetadataObjId
     Parse
     ([ApolloFederationAnyType],
      HashMap Name (ApolloFederationParserFunction Parse))
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser origin m (a, b)
subselection Name
name Maybe Description
description InputFieldsParser MetadataObjId Parse [ApolloFederationAnyType]
forall {origin}.
InputFieldsParser origin Parse [ApolloFederationAnyType]
representationParser Parser
  MetadataObjId
  'Output
  Parse
  (HashMap Name (ApolloFederationParserFunction Parse))
bodyParser
          FieldParser
  MetadataObjId
  Parse
  ([ApolloFederationAnyType],
   HashMap Name (ApolloFederationParserFunction Parse))
-> (([ApolloFederationAnyType],
     HashMap Name (ApolloFederationParserFunction Parse))
    -> Parse (QueryRootField UnpreparedValue))
-> FieldParser MetadataObjId Parse (QueryRootField UnpreparedValue)
forall (m :: * -> *) origin a b.
Monad m =>
FieldParser origin m a -> (a -> m b) -> FieldParser origin m b
`bindField` \([ApolloFederationAnyType]
parsedArgs, HashMap Name (ApolloFederationParserFunction Parse)
parsedBody) -> do
            [QueryRootField UnpreparedValue]
rootFields <-
              [ApolloFederationAnyType]
-> (ApolloFederationAnyType
    -> Parse (QueryRootField UnpreparedValue))
-> Parse [QueryRootField UnpreparedValue]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
                [ApolloFederationAnyType]
parsedArgs
                ( \ApolloFederationAnyType
anyArg ->
                    case Name
-> HashMap Name (ApolloFederationParserFunction Parse)
-> Maybe (ApolloFederationParserFunction Parse)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (ApolloFederationAnyType -> Name
afTypename ApolloFederationAnyType
anyArg) HashMap Name (ApolloFederationParserFunction Parse)
parsedBody of
                      Maybe (ApolloFederationParserFunction Parse)
Nothing -> (ErrorMessage -> Parse (QueryRootField UnpreparedValue)
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> Parse (QueryRootField UnpreparedValue))
-> (Text -> ErrorMessage)
-> Text
-> Parse (QueryRootField UnpreparedValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorMessage
toErrorMessage) (Text -> Parse (QueryRootField UnpreparedValue))
-> Text -> Parse (QueryRootField UnpreparedValue)
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName (ApolloFederationAnyType -> Name
afTypename ApolloFederationAnyType
anyArg) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not found in selection set or apollo federation is not enabled for the type"
                      Just ApolloFederationParserFunction Parse
aafus -> (ApolloFederationParserFunction Parse
-> ApolloFederationAnyType
-> Parse (QueryRootField UnpreparedValue)
forall (n :: * -> *).
ApolloFederationParserFunction n
-> ApolloFederationAnyType -> n (QueryRootField UnpreparedValue)
aafuGetRootField ApolloFederationParserFunction Parse
aafus) ApolloFederationAnyType
anyArg
                )
            QueryRootField UnpreparedValue
-> Parse (QueryRootField UnpreparedValue)
forall a. a -> Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryRootField UnpreparedValue
 -> Parse (QueryRootField UnpreparedValue))
-> QueryRootField UnpreparedValue
-> Parse (QueryRootField UnpreparedValue)
forall a b. (a -> b) -> a -> b
$ [QueryRootField UnpreparedValue] -> QueryRootField UnpreparedValue
concatQueryRootFields [QueryRootField UnpreparedValue]
rootFields
   in FieldParser MetadataObjId Parse (QueryRootField UnpreparedValue)
entityParser

-- | concatenates multiple fields
concatQueryRootFields :: [QueryRootField UnpreparedValue] -> QueryRootField UnpreparedValue
concatQueryRootFields :: [QueryRootField UnpreparedValue] -> QueryRootField UnpreparedValue
concatQueryRootFields = [QueryRootField UnpreparedValue] -> QueryRootField UnpreparedValue
forall (db :: BackendType -> *) remote action raw.
[RootField db remote action raw] -> RootField db remote action raw
RFMulti