{-# LANGUAGE TemplateHaskell #-}

module Hasura.GraphQL.Schema.Common
  ( SchemaContext (..),
    SchemaKind (..),
    RemoteRelationshipParserBuilder (..),
    NodeInterfaceParserBuilder (..),
    MonadBuildSchemaBase,
    retrieve,
    SchemaT (..),
    MonadBuildSourceSchema,
    MonadBuildRemoteSchema,
    MonadBuildActionSchema,
    runSourceSchema,
    runRemoteSchema,
    runActionSchema,
    ignoreRemoteRelationship,
    isHasuraSchema,
    AggSelectExp,
    AnnotatedField,
    AnnotatedFields,
    ConnectionFields,
    ConnectionSelectExp,
    AnnotatedActionField,
    AnnotatedActionFields,
    AnnotatedNestedObjectSelect,
    AnnotatedNestedArraySelect,
    EdgeFields,
    Scenario (..),
    SelectArgs,
    SelectStreamArgs,
    SelectExp,
    StreamSelectExp,
    TablePerms,
    getTableRoles,
    getLogicalModelRoles,
    askScalarTypeParsingContext,
    askTableInfo,
    askLogicalModelInfo,
    askNativeQueryInfo,
    comparisonAggOperators,
    mapField,
    mkDescriptionWith,
    numericAggOperators,
    optionalFieldParser,
    parsedSelectionsToFields,
    partialSQLExpToUnpreparedValue,
    getRedactionExprForColumn,
    getRedactionExprForComputedField,
    requiredFieldParser,
    takeValidNativeQueries,
    takeValidStoredProcedures,
    takeValidFunctions,
    takeValidTables,
    textToName,
    textToGQLIdentifier,
    RemoteSchemaParser (..),
    mkEnumTypeName,
    addEnumSuffix,
    peelWithOrigin,
    getIntrospectionResult,
  )
where

import Data.Either (isRight)
import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.List (uncons)
import Data.Text qualified as T
import Data.Text.Casing (GQLNameIdentifier)
import Data.Text.Casing qualified as C
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.Types qualified as Postgres
import Hasura.Base.Error
import Hasura.Function.Cache
import Hasura.GraphQL.Namespace (NamespacedField)
import Hasura.GraphQL.Parser.Internal.TypeChecking qualified as P
import Hasura.GraphQL.Schema.Node
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Typename
import Hasura.LogicalModel.Cache (LogicalModelInfo (_lmiPermissions))
import Hasura.LogicalModel.Types (LogicalModelName)
import Hasura.NativeQuery.Cache (NativeQueryCache, NativeQueryInfo)
import Hasura.NativeQuery.Types (NativeQueryName)
import Hasura.Prelude
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField.Name (ComputedFieldName)
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.Roles (RoleName, adminRoleName)
import Hasura.RQL.Types.Schema.Options (SchemaOptions)
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.RQL.Types.SchemaCache hiding (askTableInfo)
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.RemoteSchema.SchemaCache.Types
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.StoredProcedure.Cache (StoredProcedureCache)
import Hasura.Table.Cache (SelPermInfo (..))
import Language.GraphQL.Draft.Syntax qualified as G

-------------------------------------------------------------------------------

-- | Aggregation of contextual information required to build the schema.
data SchemaContext = SchemaContext
  { -- | the kind of schema being built
    SchemaContext -> SchemaKind
scSchemaKind :: SchemaKind,
    -- | how to process remote relationships
    SchemaContext -> RemoteRelationshipParserBuilder
scRemoteRelationshipParserBuilder :: RemoteRelationshipParserBuilder,
    -- | the role for which the schema is being built
    SchemaContext -> RoleName
scRole :: RoleName
  }

-- | The kind of schema we're building, and its associated options.
data SchemaKind
  = HasuraSchema
  | RelaySchema NodeInterfaceParserBuilder

isHasuraSchema :: SchemaKind -> Bool
isHasuraSchema :: SchemaKind -> Bool
isHasuraSchema = \case
  SchemaKind
HasuraSchema -> Bool
True
  RelaySchema NodeInterfaceParserBuilder
_ -> Bool
False

-- | The set of common constraints required to build the schema.
type MonadBuildSchemaBase m n =
  ( MonadError QErr m,
    P.MonadMemoize m,
    P.MonadParse n
  )

-- | How a remote relationship field should be processed when building a
-- schema. Injecting this function from the top level avoids having to know how
-- to do top-level dispatch from deep within the schema code.
--
-- Note: the inner function type uses an existential qualifier: it is expected
-- that the given function will work for _any_ monad @m@ that has the relevant
-- constraints. This prevents us from passing a function that is specfic to the
-- monad in which the schema construction will run, but avoids having to
-- propagate type annotations to each call site.
newtype RemoteRelationshipParserBuilder
  = RemoteRelationshipParserBuilder
      ( forall lhsJoinField r n m.
        (MonadBuildSchemaBase m n) =>
        RemoteFieldInfo lhsJoinField ->
        SchemaT r m (Maybe [P.FieldParser n (IR.RemoteRelationshipField IR.UnpreparedValue)])
      )

-- | A 'RemoteRelationshipParserBuilder' that ignores the field altogether, that can
-- be used in tests or to build a source or remote schema in isolation.
ignoreRemoteRelationship :: RemoteRelationshipParserBuilder
ignoreRemoteRelationship :: RemoteRelationshipParserBuilder
ignoreRemoteRelationship = (forall lhsJoinField r (n :: * -> *) (m :: * -> *).
 MonadBuildSchemaBase m n =>
 RemoteFieldInfo lhsJoinField
 -> SchemaT
      r
      m
      (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)]))
-> RemoteRelationshipParserBuilder
RemoteRelationshipParserBuilder ((forall lhsJoinField r (n :: * -> *) (m :: * -> *).
  MonadBuildSchemaBase m n =>
  RemoteFieldInfo lhsJoinField
  -> SchemaT
       r
       m
       (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)]))
 -> RemoteRelationshipParserBuilder)
-> (forall lhsJoinField r (n :: * -> *) (m :: * -> *).
    MonadBuildSchemaBase m n =>
    RemoteFieldInfo lhsJoinField
    -> SchemaT
         r
         m
         (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)]))
-> RemoteRelationshipParserBuilder
forall a b. (a -> b) -> a -> b
$ SchemaT
  r
  m
  (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> RemoteFieldInfo lhsJoinField
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
forall a b. a -> b -> a
const (SchemaT
   r
   m
   (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
 -> RemoteFieldInfo lhsJoinField
 -> SchemaT
      r
      m
      (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)]))
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
-> RemoteFieldInfo lhsJoinField
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
forall a b. (a -> b) -> a -> b
$ Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)]
-> SchemaT
     r
     m
     (Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)])
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [FieldParser n (RemoteRelationshipField UnpreparedValue)]
forall a. Maybe a
Nothing

-- | How to build the 'Relay' node.
--
-- Similarly to what we do for remote relationships, we pass in the context the
-- builder function required to build the 'Node' interface, in order to avoid
-- the cross-sources cycles it creates otherwise.
newtype NodeInterfaceParserBuilder = NodeInterfaceParserBuilder
  { NodeInterfaceParserBuilder
-> forall (m :: * -> *) (n :: * -> *).
   MonadBuildSchemaBase m n =>
   SchemaContext -> SchemaOptions -> m (Parser 'Output n NodeMap)
runNodeBuilder ::
      ( forall m n.
        (MonadBuildSchemaBase m n) =>
        SchemaContext ->
        SchemaOptions ->
        m (P.Parser 'P.Output n NodeMap)
      )
  }

-- TODO: move this to Prelude?
retrieve ::
  (MonadReader r m, Has a r) =>
  (a -> b) ->
  m b
retrieve :: forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve a -> b
f = (r -> b) -> m b
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((r -> b) -> m b) -> (r -> b) -> m b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (r -> a) -> r -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> a
forall a t. Has a t => t -> a
getter

-------------------------------------------------------------------------------

{- Note [SchemaT and stacking]

The schema is explicitly built in `SchemaT`, rather than in an arbitrary monad
`m` that happens to have the desired properties (`MonadReader`, `MonadMemoize`,
`MonadError`, and so on). The main reason why we do this is that we want to
avoid a specific performance issue that arises out of two specific constraints:

  - we want to build each part of the schema (such as sources and remote
    schemas) with its own dedicated minimal reader context (i.e. not using a
    shared reader context that is the union of all the information required);
  - we want to be able to process remote-relationships, which means "altering"
    the reader context when jumping from one "part" of the schema to another.

What that means, in practice, is that we have to call `runReaderT` (or an
equivalent) every time we build a part of the schema (at the root level or as
part of a remote relationship) so that the part we build has access to its
context. When processing a remote relationship, the calling code is *already* in
a monad stack that contains a `ReaderT`, since we were processing a given part
of the schema. If we directly call `runReaderT` to process the RHS of the remote
relationship, we implicitly make it so that the monad stack of the LHS is the
base underneath the `ReaderT` of the RHS; in other terms, we stack another
reader on top of the existing monad stack.

As the schema is built in a "depth-first" way, in a complicated schema with a
lot of remote relationships we would end up with several readers stacked upon
one another. A manually run benchmark showed that this could significantly
impact performance in complicated schemas. We do now have a benchmark set to
replicate this specific case (see the "deep_schema" benchmark set for more
information).

To prevent this stacking, we need to be able to "bring back" the result of the
`runReaderT` back into the calling monad, rather than defaulting to having the
calling monad be the base of the reader. The simplest way of doing this is to
enforce that we are always building the schema in a monad stack that has the
reader on top of some arbitrary *shared* base. This gives us the guarantee that
the LHS of any remote relationship, the calling context for `runReaderT`, is
itself a `ReaderT` on top og that known shared base, meaning that after a call
to `runReaderT` on another part of the schema, we can always go back to the
calling monad with a simple `lift`, as demonstrated in
'remoteRelationshipField'.
-}

-- | The monad in which the schema is built.
--
-- The implementation of 'SchemaT' is intended to be opaque: running a
-- computation in 'SchemaT' is intended to be done via calls to
-- 'runSourceSchema' and 'runRemoteSchema', which also enforce what the @r@
-- parameter should be in each case.
--
-- The reason why we want to enforce that the schema is built in a reader on top
-- of an arbitrary base monad is for performance: see Note [SchemaT and
-- stacking] for more information.
--
-- In the future, we might monomorphize this further to make `MemoizeT` explicit.
newtype SchemaT r m a = SchemaT {forall r (m :: * -> *) a. SchemaT r m a -> ReaderT r m a
runSchemaT :: ReaderT r m a}
  deriving newtype ((forall a b. (a -> b) -> SchemaT r m a -> SchemaT r m b)
-> (forall a b. a -> SchemaT r m b -> SchemaT r m a)
-> Functor (SchemaT r m)
forall a b. a -> SchemaT r m b -> SchemaT r m a
forall a b. (a -> b) -> SchemaT r m a -> SchemaT r m b
forall r (m :: * -> *) a b.
Functor m =>
a -> SchemaT r m b -> SchemaT r m a
forall r (m :: * -> *) a b.
Functor m =>
(a -> b) -> SchemaT r m a -> SchemaT r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r (m :: * -> *) a b.
Functor m =>
(a -> b) -> SchemaT r m a -> SchemaT r m b
fmap :: forall a b. (a -> b) -> SchemaT r m a -> SchemaT r m b
$c<$ :: forall r (m :: * -> *) a b.
Functor m =>
a -> SchemaT r m b -> SchemaT r m a
<$ :: forall a b. a -> SchemaT r m b -> SchemaT r m a
Functor, Functor (SchemaT r m)
Functor (SchemaT r m)
-> (forall a. a -> SchemaT r m a)
-> (forall a b.
    SchemaT r m (a -> b) -> SchemaT r m a -> SchemaT r m b)
-> (forall a b c.
    (a -> b -> c) -> SchemaT r m a -> SchemaT r m b -> SchemaT r m c)
-> (forall a b. SchemaT r m a -> SchemaT r m b -> SchemaT r m b)
-> (forall a b. SchemaT r m a -> SchemaT r m b -> SchemaT r m a)
-> Applicative (SchemaT r m)
forall a. a -> SchemaT r m a
forall a b. SchemaT r m a -> SchemaT r m b -> SchemaT r m a
forall a b. SchemaT r m a -> SchemaT r m b -> SchemaT r m b
forall a b. SchemaT r m (a -> b) -> SchemaT r m a -> SchemaT r m b
forall a b c.
(a -> b -> c) -> SchemaT r m a -> SchemaT r m b -> SchemaT r m c
forall {r} {m :: * -> *}. Applicative m => Functor (SchemaT r m)
forall r (m :: * -> *) a. Applicative m => a -> SchemaT r m a
forall r (m :: * -> *) a b.
Applicative m =>
SchemaT r m a -> SchemaT r m b -> SchemaT r m a
forall r (m :: * -> *) a b.
Applicative m =>
SchemaT r m a -> SchemaT r m b -> SchemaT r m b
forall r (m :: * -> *) a b.
Applicative m =>
SchemaT r m (a -> b) -> SchemaT r m a -> SchemaT r m b
forall r (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SchemaT r m a -> SchemaT r m b -> SchemaT r m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall r (m :: * -> *) a. Applicative m => a -> SchemaT r m a
pure :: forall a. a -> SchemaT r m a
$c<*> :: forall r (m :: * -> *) a b.
Applicative m =>
SchemaT r m (a -> b) -> SchemaT r m a -> SchemaT r m b
<*> :: forall a b. SchemaT r m (a -> b) -> SchemaT r m a -> SchemaT r m b
$cliftA2 :: forall r (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SchemaT r m a -> SchemaT r m b -> SchemaT r m c
liftA2 :: forall a b c.
(a -> b -> c) -> SchemaT r m a -> SchemaT r m b -> SchemaT r m c
$c*> :: forall r (m :: * -> *) a b.
Applicative m =>
SchemaT r m a -> SchemaT r m b -> SchemaT r m b
*> :: forall a b. SchemaT r m a -> SchemaT r m b -> SchemaT r m b
$c<* :: forall r (m :: * -> *) a b.
Applicative m =>
SchemaT r m a -> SchemaT r m b -> SchemaT r m a
<* :: forall a b. SchemaT r m a -> SchemaT r m b -> SchemaT r m a
Applicative, Applicative (SchemaT r m)
Applicative (SchemaT r m)
-> (forall a b.
    SchemaT r m a -> (a -> SchemaT r m b) -> SchemaT r m b)
-> (forall a b. SchemaT r m a -> SchemaT r m b -> SchemaT r m b)
-> (forall a. a -> SchemaT r m a)
-> Monad (SchemaT r m)
forall a. a -> SchemaT r m a
forall a b. SchemaT r m a -> SchemaT r m b -> SchemaT r m b
forall a b. SchemaT r m a -> (a -> SchemaT r m b) -> SchemaT r m b
forall {r} {m :: * -> *}. Monad m => Applicative (SchemaT r m)
forall r (m :: * -> *) a. Monad m => a -> SchemaT r m a
forall r (m :: * -> *) a b.
Monad m =>
SchemaT r m a -> SchemaT r m b -> SchemaT r m b
forall r (m :: * -> *) a b.
Monad m =>
SchemaT r m a -> (a -> SchemaT r m b) -> SchemaT r m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall r (m :: * -> *) a b.
Monad m =>
SchemaT r m a -> (a -> SchemaT r m b) -> SchemaT r m b
>>= :: forall a b. SchemaT r m a -> (a -> SchemaT r m b) -> SchemaT r m b
$c>> :: forall r (m :: * -> *) a b.
Monad m =>
SchemaT r m a -> SchemaT r m b -> SchemaT r m b
>> :: forall a b. SchemaT r m a -> SchemaT r m b -> SchemaT r m b
$creturn :: forall r (m :: * -> *) a. Monad m => a -> SchemaT r m a
return :: forall a. a -> SchemaT r m a
Monad, MonadReader r, Monad (SchemaT r m)
Monad (SchemaT r m)
-> (forall a p.
    (Ord a, Typeable a, Typeable p) =>
    Name -> a -> SchemaT r m p -> SchemaT r m p)
-> MonadMemoize (SchemaT r m)
forall a p.
(Ord a, Typeable a, Typeable p) =>
Name -> a -> SchemaT r m p -> SchemaT r m p
forall {r} {m :: * -> *}. MonadMemoize m => Monad (SchemaT r m)
forall r (m :: * -> *) a p.
(MonadMemoize m, Ord a, Typeable a, Typeable p) =>
Name -> a -> SchemaT r m p -> SchemaT r m p
forall (m :: * -> *).
Monad m
-> (forall a p.
    (Ord a, Typeable a, Typeable p) =>
    Name -> a -> m p -> m p)
-> MonadMemoize m
$cmemoizeOn :: forall r (m :: * -> *) a p.
(MonadMemoize m, Ord a, Typeable a, Typeable p) =>
Name -> a -> SchemaT r m p -> SchemaT r m p
memoizeOn :: forall a p.
(Ord a, Typeable a, Typeable p) =>
Name -> a -> SchemaT r m p -> SchemaT r m p
P.MonadMemoize, (forall (m :: * -> *) a. Monad m => m a -> SchemaT r m a)
-> MonadTrans (SchemaT r)
forall r (m :: * -> *) a. Monad m => m a -> SchemaT r m a
forall (m :: * -> *) a. Monad m => m a -> SchemaT r m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall r (m :: * -> *) a. Monad m => m a -> SchemaT r m a
lift :: forall (m :: * -> *) a. Monad m => m a -> SchemaT r m a
MonadTrans, MonadError e)

type MonadBuildSourceSchema b r m n =
  ( MonadBuildSchemaBase m n,
    Has SchemaContext r,
    Has SchemaOptions r,
    Has (SourceInfo b) r
  )

-- | Runs a schema-building computation with all the context required to build a source.
runSourceSchema ::
  forall b m a.
  SchemaContext ->
  SchemaOptions ->
  SourceInfo b ->
  SchemaT
    ( SchemaContext,
      SchemaOptions,
      SourceInfo b
    )
    m
    a ->
  m a
runSourceSchema :: forall (b :: BackendType) (m :: * -> *) a.
SchemaContext
-> SchemaOptions
-> SourceInfo b
-> SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m a
-> m a
runSourceSchema SchemaContext
context SchemaOptions
options SourceInfo b
sourceInfo (SchemaT ReaderT (SchemaContext, SchemaOptions, SourceInfo b) m a
action) = ReaderT (SchemaContext, SchemaOptions, SourceInfo b) m a
-> (SchemaContext, SchemaOptions, SourceInfo b) -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (SchemaContext, SchemaOptions, SourceInfo b) m a
action (SchemaContext
context, SchemaOptions
options, SourceInfo b
sourceInfo)

type MonadBuildRemoteSchema r m n =
  ( MonadBuildSchemaBase m n,
    Has SchemaContext r,
    Has CustomizeRemoteFieldName r,
    Has MkTypename r
  )

-- | Runs a schema-building computation with all the context required to build a remote schema.
runRemoteSchema ::
  SchemaContext ->
  SchemaT
    ( SchemaContext,
      MkTypename,
      CustomizeRemoteFieldName
    )
    m
    a ->
  m a
runRemoteSchema :: forall (m :: * -> *) a.
SchemaContext
-> SchemaT
     (SchemaContext, MkTypename, CustomizeRemoteFieldName) m a
-> m a
runRemoteSchema SchemaContext
context (SchemaT ReaderT (SchemaContext, MkTypename, CustomizeRemoteFieldName) m a
action) = ReaderT (SchemaContext, MkTypename, CustomizeRemoteFieldName) m a
-> (SchemaContext, MkTypename, CustomizeRemoteFieldName) -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (SchemaContext, MkTypename, CustomizeRemoteFieldName) m a
action (SchemaContext
context, MkTypename
forall a. Monoid a => a
mempty, CustomizeRemoteFieldName
forall a. Monoid a => a
mempty)

type MonadBuildActionSchema r m n =
  ( MonadBuildSchemaBase m n,
    Has SchemaContext r,
    Has SchemaOptions r
  )

-- | Runs a schema-building computation with all the context required to build actions.
runActionSchema ::
  SchemaContext ->
  SchemaOptions ->
  SchemaT
    ( SchemaContext,
      SchemaOptions
    )
    m
    a ->
  m a
runActionSchema :: forall (m :: * -> *) a.
SchemaContext
-> SchemaOptions
-> SchemaT (SchemaContext, SchemaOptions) m a
-> m a
runActionSchema SchemaContext
context SchemaOptions
options (SchemaT ReaderT (SchemaContext, SchemaOptions) m a
action) = ReaderT (SchemaContext, SchemaOptions) m a
-> (SchemaContext, SchemaOptions) -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (SchemaContext, SchemaOptions) m a
action (SchemaContext
context, SchemaOptions
options)

-------------------------------------------------------------------------------

type SelectExp b = IR.AnnSimpleSelectG b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

type StreamSelectExp b = IR.AnnSimpleStreamSelectG b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

type AggSelectExp b = IR.AnnAggregateSelectG b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

type ConnectionSelectExp b = IR.ConnectionSelect b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

type SelectArgs b = IR.SelectArgsG b (IR.UnpreparedValue b)

type SelectStreamArgs b = IR.SelectStreamArgsG b (IR.UnpreparedValue b)

type TablePerms b = IR.TablePermG b (IR.UnpreparedValue b)

type AnnotatedFields b = IR.AnnFieldsG b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

type AnnotatedField b = IR.AnnFieldG b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

type ConnectionFields b = IR.ConnectionFields b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

type EdgeFields b = IR.EdgeFields b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

type AnnotatedActionFields = IR.ActionFieldsG (IR.RemoteRelationshipField IR.UnpreparedValue)

type AnnotatedActionField = IR.ActionFieldG (IR.RemoteRelationshipField IR.UnpreparedValue)

type AnnotatedNestedObjectSelect b = IR.AnnNestedObjectSelectG b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

type AnnotatedNestedArraySelect b = IR.AnnNestedArraySelectG b (IR.RemoteRelationshipField IR.UnpreparedValue) (IR.UnpreparedValue b)

-------------------------------------------------------------------------------

data RemoteSchemaParser n = RemoteSchemaParser
  { forall (n :: * -> *).
RemoteSchemaParser n
-> [FieldParser
      n
      (NamespacedField
         (RemoteSchemaRootField
            (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
piQuery :: [P.FieldParser n (NamespacedField (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))],
    forall (n :: * -> *).
RemoteSchemaParser n
-> Maybe
     [FieldParser
        n
        (NamespacedField
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
piMutation :: Maybe [P.FieldParser n (NamespacedField (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))],
    forall (n :: * -> *).
RemoteSchemaParser n
-> Maybe
     [FieldParser
        n
        (NamespacedField
           (RemoteSchemaRootField
              (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable))]
piSubscription :: Maybe [P.FieldParser n (NamespacedField (IR.RemoteSchemaRootField (IR.RemoteRelationshipField IR.UnpreparedValue) RemoteSchemaVariable))]
  }

getTableRoles :: BackendSourceInfo -> [RoleName]
getTableRoles :: BackendSourceInfo -> [RoleName]
getTableRoles BackendSourceInfo
bsi = forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend BackendSourceInfo
bsi SourceInfo b -> [RoleName]
forall (b :: BackendType). Backend b => SourceInfo b -> [RoleName]
forall {b :: BackendType}. SourceInfo b -> [RoleName]
go
  where
    go :: SourceInfo b -> [RoleName]
go SourceInfo b
si = HashMap RoleName (RolePermInfo b) -> [RoleName]
forall k v. HashMap k v -> [k]
HashMap.keys (HashMap RoleName (RolePermInfo b) -> [RoleName])
-> (TableInfo b -> HashMap RoleName (RolePermInfo b))
-> TableInfo b
-> [RoleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo b -> HashMap RoleName (RolePermInfo b)
forall (b :: BackendType). TableInfo b -> RolePermInfoMap b
_tiRolePermInfoMap (TableInfo b -> [RoleName]) -> [TableInfo b] -> [RoleName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HashMap (TableName b) (TableInfo b) -> [TableInfo b]
forall k v. HashMap k v -> [v]
HashMap.elems (SourceInfo b -> HashMap (TableName b) (TableInfo b)
forall (b :: BackendType). SourceInfo b -> TableCache b
_siTables SourceInfo b
si)

getLogicalModelRoles :: BackendSourceInfo -> [RoleName]
getLogicalModelRoles :: BackendSourceInfo -> [RoleName]
getLogicalModelRoles BackendSourceInfo
bsi = forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend BackendSourceInfo
bsi SourceInfo b -> [RoleName]
forall (b :: BackendType). Backend b => SourceInfo b -> [RoleName]
forall {b :: BackendType}. SourceInfo b -> [RoleName]
go
  where
    go :: SourceInfo b -> [RoleName]
go SourceInfo b
si = HashMap RoleName (RolePermInfo b) -> [RoleName]
forall k v. HashMap k v -> [k]
HashMap.keys (HashMap RoleName (RolePermInfo b) -> [RoleName])
-> (LogicalModelInfo b -> HashMap RoleName (RolePermInfo b))
-> LogicalModelInfo b
-> [RoleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalModelInfo b -> HashMap RoleName (RolePermInfo b)
forall (b :: BackendType). LogicalModelInfo b -> RolePermInfoMap b
_lmiPermissions (LogicalModelInfo b -> [RoleName])
-> [LogicalModelInfo b] -> [RoleName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HashMap LogicalModelName (LogicalModelInfo b)
-> [LogicalModelInfo b]
forall k v. HashMap k v -> [v]
HashMap.elems (SourceInfo b -> HashMap LogicalModelName (LogicalModelInfo b)
forall (b :: BackendType). SourceInfo b -> LogicalModelCache b
_siLogicalModels SourceInfo b
si)

askScalarTypeParsingContext ::
  forall b r m.
  (MonadReader r m, Has (SourceInfo b) r, Has (ScalarTypeParsingContext b) (SourceConfig b)) =>
  m (ScalarTypeParsingContext b)
askScalarTypeParsingContext :: forall (b :: BackendType) r (m :: * -> *).
(MonadReader r m, Has (SourceInfo b) r,
 Has (ScalarTypeParsingContext b) (SourceConfig b)) =>
m (ScalarTypeParsingContext b)
askScalarTypeParsingContext = (r -> ScalarTypeParsingContext b) -> m (ScalarTypeParsingContext b)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (SourceConfig b -> ScalarTypeParsingContext b
forall a t. Has a t => t -> a
getter (SourceConfig b -> ScalarTypeParsingContext b)
-> (r -> SourceConfig b) -> r -> ScalarTypeParsingContext b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siConfiguration @b (SourceInfo b -> SourceConfig b)
-> (r -> SourceInfo b) -> r -> SourceConfig b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> SourceInfo b
forall a t. Has a t => t -> a
getter)

-- | Looks up table information for the given table name. This function
-- should never fail, since the schema cache construction process is
-- supposed to ensure all dependencies are resolved.
-- TODO: deduplicate this with `CacheRM`.
askTableInfo ::
  forall b r m.
  (Backend b, MonadError QErr m, MonadReader r m, Has (SourceInfo b) r) =>
  TableName b ->
  m (TableInfo b)
askTableInfo :: forall (b :: BackendType) r (m :: * -> *).
(Backend b, MonadError QErr m, MonadReader r m,
 Has (SourceInfo b) r) =>
TableName b -> m (TableInfo b)
askTableInfo TableName b
tableName = do
  SourceInfo {Maybe QueryTagsConfig
TableCache b
FunctionCache b
StoredProcedureCache b
LogicalModelCache b
NativeQueryCache b
BackendSourceKind b
SourceName
SourceConfig b
ResolvedSourceCustomization
DBObjectsIntrospection b
_siTables :: forall (b :: BackendType). SourceInfo b -> TableCache b
_siLogicalModels :: forall (b :: BackendType). SourceInfo b -> LogicalModelCache b
_siConfiguration :: forall (b :: BackendType). SourceInfo b -> SourceConfig 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
_siFunctions :: forall (b :: BackendType). SourceInfo b -> FunctionCache b
_siNativeQueries :: forall (b :: BackendType). SourceInfo b -> NativeQueryCache b
_siStoredProcedures :: forall (b :: BackendType). SourceInfo b -> StoredProcedureCache b
_siQueryTagsConfig :: forall (b :: BackendType). SourceInfo b -> Maybe QueryTagsConfig
_siCustomization :: forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siDbObjectsIntrospection :: forall (b :: BackendType). SourceInfo b -> DBObjectsIntrospection b
..} <- (r -> SourceInfo b) -> m (SourceInfo b)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo b
forall a t. Has a t => t -> a
getter
  TableName b -> TableCache b -> Maybe (TableInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName b
tableName TableCache b
_siTables
    Maybe (TableInfo b) -> m (TableInfo b) -> m (TableInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> m (TableInfo b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"askTableInfo: no info for table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b -> Text
forall t. ToTxt t => t -> Text
dquote TableName b
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
forall t. ToTxt t => t -> Text
dquote SourceName
_siName)

-- | Looks up logical model information for the given logical model name. This function
-- should never fail, since the schema cache construction process is
-- supposed to ensure all dependencies are resolved.
-- TODO: deduplicate this with `CacheRM`.
askLogicalModelInfo ::
  forall b r m.
  (MonadError QErr m, MonadReader r m, Has (SourceInfo b) r) =>
  LogicalModelName ->
  m (LogicalModelInfo b)
askLogicalModelInfo :: forall (b :: BackendType) r (m :: * -> *).
(MonadError QErr m, MonadReader r m, Has (SourceInfo b) r) =>
LogicalModelName -> m (LogicalModelInfo b)
askLogicalModelInfo LogicalModelName
logicalModelName = do
  SourceInfo {Maybe QueryTagsConfig
TableCache b
FunctionCache b
StoredProcedureCache b
LogicalModelCache b
NativeQueryCache b
BackendSourceKind b
SourceName
SourceConfig b
ResolvedSourceCustomization
DBObjectsIntrospection b
_siTables :: forall (b :: BackendType). SourceInfo b -> TableCache b
_siLogicalModels :: forall (b :: BackendType). SourceInfo b -> LogicalModelCache b
_siConfiguration :: forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siName :: forall (b :: BackendType). SourceInfo b -> SourceName
_siSourceKind :: forall (b :: BackendType). SourceInfo b -> BackendSourceKind 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
_siQueryTagsConfig :: forall (b :: BackendType). SourceInfo b -> Maybe QueryTagsConfig
_siCustomization :: forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siDbObjectsIntrospection :: forall (b :: BackendType). SourceInfo b -> 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
..} <- (r -> SourceInfo b) -> m (SourceInfo b)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo b
forall a t. Has a t => t -> a
getter
  LogicalModelName
-> LogicalModelCache b -> Maybe (LogicalModelInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup LogicalModelName
logicalModelName LogicalModelCache b
_siLogicalModels
    Maybe (LogicalModelInfo b)
-> m (LogicalModelInfo b) -> m (LogicalModelInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> m (LogicalModelInfo b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"askLogicalModelInfo: no info for logical model " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName -> Text
forall t. ToTxt t => t -> Text
dquote LogicalModelName
logicalModelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
forall t. ToTxt t => t -> Text
dquote SourceName
_siName)

-- | Looks up native query information for the given native query name. This function
-- should never fail, since the schema cache construction process is
-- supposed to ensure all dependencies are resolved.
-- TODO: deduplicate this with `CacheRM`.
askNativeQueryInfo ::
  forall b r m.
  (MonadError QErr m, MonadReader r m, Has (SourceInfo b) r) =>
  NativeQueryName ->
  m (NativeQueryInfo b)
askNativeQueryInfo :: forall (b :: BackendType) r (m :: * -> *).
(MonadError QErr m, MonadReader r m, Has (SourceInfo b) r) =>
NativeQueryName -> m (NativeQueryInfo b)
askNativeQueryInfo NativeQueryName
nativeQueryName = do
  SourceInfo {Maybe QueryTagsConfig
TableCache b
FunctionCache b
StoredProcedureCache b
LogicalModelCache b
NativeQueryCache b
BackendSourceKind b
SourceName
SourceConfig b
ResolvedSourceCustomization
DBObjectsIntrospection b
_siTables :: forall (b :: BackendType). SourceInfo b -> TableCache b
_siLogicalModels :: forall (b :: BackendType). SourceInfo b -> LogicalModelCache b
_siConfiguration :: forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siName :: forall (b :: BackendType). SourceInfo b -> SourceName
_siSourceKind :: forall (b :: BackendType). SourceInfo b -> BackendSourceKind 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
_siQueryTagsConfig :: forall (b :: BackendType). SourceInfo b -> Maybe QueryTagsConfig
_siCustomization :: forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siDbObjectsIntrospection :: forall (b :: BackendType). SourceInfo b -> 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
..} <- (r -> SourceInfo b) -> m (SourceInfo b)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo b
forall a t. Has a t => t -> a
getter
  NativeQueryName -> NativeQueryCache b -> Maybe (NativeQueryInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup NativeQueryName
nativeQueryName NativeQueryCache b
_siNativeQueries
    Maybe (NativeQueryInfo b)
-> m (NativeQueryInfo b) -> m (NativeQueryInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> m (NativeQueryInfo b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"askNativeQueryInfo: no info for native query " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NativeQueryName -> Text
forall t. ToTxt t => t -> Text
dquote NativeQueryName
nativeQueryName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
forall t. ToTxt t => t -> Text
dquote SourceName
_siName)

-- | Whether the request is sent with `x-hasura-use-backend-only-permissions` set to `true`.
data Scenario = Backend | Frontend deriving (Int -> Scenario
Scenario -> Int
Scenario -> [Scenario]
Scenario -> Scenario
Scenario -> Scenario -> [Scenario]
Scenario -> Scenario -> Scenario -> [Scenario]
(Scenario -> Scenario)
-> (Scenario -> Scenario)
-> (Int -> Scenario)
-> (Scenario -> Int)
-> (Scenario -> [Scenario])
-> (Scenario -> Scenario -> [Scenario])
-> (Scenario -> Scenario -> [Scenario])
-> (Scenario -> Scenario -> Scenario -> [Scenario])
-> Enum Scenario
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Scenario -> Scenario
succ :: Scenario -> Scenario
$cpred :: Scenario -> Scenario
pred :: Scenario -> Scenario
$ctoEnum :: Int -> Scenario
toEnum :: Int -> Scenario
$cfromEnum :: Scenario -> Int
fromEnum :: Scenario -> Int
$cenumFrom :: Scenario -> [Scenario]
enumFrom :: Scenario -> [Scenario]
$cenumFromThen :: Scenario -> Scenario -> [Scenario]
enumFromThen :: Scenario -> Scenario -> [Scenario]
$cenumFromTo :: Scenario -> Scenario -> [Scenario]
enumFromTo :: Scenario -> Scenario -> [Scenario]
$cenumFromThenTo :: Scenario -> Scenario -> Scenario -> [Scenario]
enumFromThenTo :: Scenario -> Scenario -> Scenario -> [Scenario]
Enum, Int -> Scenario -> ShowS
[Scenario] -> ShowS
Scenario -> [Char]
(Int -> Scenario -> ShowS)
-> (Scenario -> [Char]) -> ([Scenario] -> ShowS) -> Show Scenario
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scenario -> ShowS
showsPrec :: Int -> Scenario -> ShowS
$cshow :: Scenario -> [Char]
show :: Scenario -> [Char]
$cshowList :: [Scenario] -> ShowS
showList :: [Scenario] -> ShowS
Show, Scenario -> Scenario -> Bool
(Scenario -> Scenario -> Bool)
-> (Scenario -> Scenario -> Bool) -> Eq Scenario
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scenario -> Scenario -> Bool
== :: Scenario -> Scenario -> Bool
$c/= :: Scenario -> Scenario -> Bool
/= :: Scenario -> Scenario -> Bool
Eq)

textToName :: (MonadError QErr m) => Text -> m G.Name
textToName :: forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName Text
textName =
  Text -> Maybe Name
G.mkName Text
textName
    Maybe Name -> m Name -> m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
      Code
ValidationFailed
      ( Text
"cannot include "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textName
          Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in the GraphQL schema because "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" it is not a valid GraphQL identifier"
      )

textToGQLIdentifier :: (MonadError QErr m) => Text -> m GQLNameIdentifier
textToGQLIdentifier :: forall (m :: * -> *).
MonadError QErr m =>
Text -> m GQLNameIdentifier
textToGQLIdentifier Text
textName = do
  let gqlIdents :: Maybe GQLNameIdentifier
gqlIdents = do
        (Text
pref, [Text]
suffs) <- [Text] -> Maybe (Text, [Text])
forall a. [a] -> Maybe (a, [a])
uncons (Text -> [Text]
C.fromSnake Text
textName)
        Name
prefName <- Text -> Maybe Name
G.mkName Text
pref
        [NameSuffix]
suffNames <- (Text -> Maybe NameSuffix) -> [Text] -> Maybe [NameSuffix]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> Maybe NameSuffix
G.mkNameSuffix [Text]
suffs
        GQLNameIdentifier -> Maybe GQLNameIdentifier
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GQLNameIdentifier -> Maybe GQLNameIdentifier)
-> GQLNameIdentifier -> Maybe GQLNameIdentifier
forall a b. (a -> b) -> a -> b
$ (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple (Name
prefName, [NameSuffix]
suffNames)
  Maybe GQLNameIdentifier
gqlIdents
    Maybe GQLNameIdentifier
-> m GQLNameIdentifier -> m GQLNameIdentifier
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m GQLNameIdentifier
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400
      Code
ValidationFailed
      ( Text
"cannot include "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textName
          Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" in the GraphQL schema because "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" it is not a valid GraphQL identifier"
      )

partialSQLExpToUnpreparedValue :: PartialSQLExp b -> IR.UnpreparedValue b
partialSQLExpToUnpreparedValue :: forall (b :: BackendType). PartialSQLExp b -> UnpreparedValue b
partialSQLExpToUnpreparedValue (PSESessVar SessionVarType b
pftype SessionVariable
var) = SessionVarType b -> SessionVariable -> UnpreparedValue b
forall (b :: BackendType).
SessionVarType b -> SessionVariable -> UnpreparedValue b
IR.UVSessionVar SessionVarType b
pftype SessionVariable
var
partialSQLExpToUnpreparedValue PartialSQLExp b
PSESession = UnpreparedValue b
forall (b :: BackendType). UnpreparedValue b
IR.UVSession
partialSQLExpToUnpreparedValue (PSESQLExp SQLExpression b
sqlExp) = SQLExpression b -> UnpreparedValue b
forall (b :: BackendType). SQLExpression b -> UnpreparedValue b
IR.UVLiteral SQLExpression b
sqlExp

getRedactionExprForColumn :: (Backend b) => SelPermInfo b -> Column b -> Maybe (IR.AnnRedactionExpUnpreparedValue b)
getRedactionExprForColumn :: forall (b :: BackendType).
Backend b =>
SelPermInfo b
-> Column b -> Maybe (AnnRedactionExpUnpreparedValue b)
getRedactionExprForColumn SelPermInfo b
selectPermissions Column b
columnName =
  let redactionExp :: Maybe (AnnRedactionExpPartialSQL b)
redactionExp = Column b
-> HashMap (Column b) (AnnRedactionExpPartialSQL b)
-> Maybe (AnnRedactionExpPartialSQL b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Column b
columnName (SelPermInfo b -> HashMap (Column b) (AnnRedactionExpPartialSQL b)
forall (b :: BackendType).
SelPermInfo b -> HashMap (Column b) (AnnRedactionExpPartialSQL b)
spiCols SelPermInfo b
selectPermissions)
   in (PartialSQLExp b -> UnpreparedValue b)
-> AnnRedactionExpPartialSQL b
-> AnnRedactionExp b (UnpreparedValue b)
forall a b. (a -> b) -> AnnRedactionExp b a -> AnnRedactionExp b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PartialSQLExp b -> UnpreparedValue b
forall (b :: BackendType). PartialSQLExp b -> UnpreparedValue b
partialSQLExpToUnpreparedValue (AnnRedactionExpPartialSQL b
 -> AnnRedactionExp b (UnpreparedValue b))
-> Maybe (AnnRedactionExpPartialSQL b)
-> Maybe (AnnRedactionExp b (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AnnRedactionExpPartialSQL b)
redactionExp

getRedactionExprForComputedField :: (Backend b) => SelPermInfo b -> ComputedFieldName -> Maybe (IR.AnnRedactionExpUnpreparedValue b)
getRedactionExprForComputedField :: forall (b :: BackendType).
Backend b =>
SelPermInfo b
-> ComputedFieldName -> Maybe (AnnRedactionExpUnpreparedValue b)
getRedactionExprForComputedField SelPermInfo b
selectPermissions ComputedFieldName
cfName =
  let redactionExp :: Maybe (AnnRedactionExpPartialSQL b)
redactionExp = ComputedFieldName
-> HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
-> Maybe (AnnRedactionExpPartialSQL b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ComputedFieldName
cfName (SelPermInfo b
-> HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
forall (b :: BackendType).
SelPermInfo b
-> HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
spiComputedFields SelPermInfo b
selectPermissions)
   in (PartialSQLExp b -> UnpreparedValue b)
-> AnnRedactionExpPartialSQL b
-> AnnRedactionExp b (UnpreparedValue b)
forall a b. (a -> b) -> AnnRedactionExp b a -> AnnRedactionExp b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PartialSQLExp b -> UnpreparedValue b
forall (b :: BackendType). PartialSQLExp b -> UnpreparedValue b
partialSQLExpToUnpreparedValue (AnnRedactionExpPartialSQL b
 -> AnnRedactionExp b (UnpreparedValue b))
-> Maybe (AnnRedactionExpPartialSQL b)
-> Maybe (AnnRedactionExp b (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AnnRedactionExpPartialSQL b)
redactionExp

mapField ::
  (Functor m) =>
  P.InputFieldsParser m (Maybe a) ->
  (a -> b) ->
  P.InputFieldsParser m (Maybe b)
mapField :: forall (m :: * -> *) a b.
Functor m =>
InputFieldsParser m (Maybe a)
-> (a -> b) -> InputFieldsParser m (Maybe b)
mapField InputFieldsParser m (Maybe a)
fp a -> b
f = (Maybe a -> Maybe b)
-> InputFieldsParser m (Maybe a)
-> InputFieldsParser MetadataObjId m (Maybe b)
forall a b.
(a -> b)
-> InputFieldsParser MetadataObjId m a
-> InputFieldsParser MetadataObjId m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) InputFieldsParser m (Maybe a)
fp

parsedSelectionsToFields ::
  -- | how to handle @__typename@ fields
  (Text -> a) ->
  InsOrdHashMap.InsOrdHashMap G.Name (P.ParsedSelection a) ->
  Fields a
parsedSelectionsToFields :: forall a.
(Text -> a) -> InsOrdHashMap Name (ParsedSelection a) -> Fields a
parsedSelectionsToFields Text -> a
mkTypenameFromText =
  InsOrdHashMap Name (ParsedSelection a)
-> [(Name, ParsedSelection a)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList
    (InsOrdHashMap Name (ParsedSelection a)
 -> [(Name, ParsedSelection a)])
-> ([(Name, ParsedSelection a)] -> [(FieldName, a)])
-> InsOrdHashMap Name (ParsedSelection a)
-> [(FieldName, a)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Name, ParsedSelection a) -> (FieldName, a))
-> [(Name, ParsedSelection a)] -> [(FieldName, a)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldName
FieldName (Text -> FieldName) -> (Name -> Text) -> Name -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName (Name -> FieldName)
-> (ParsedSelection a -> a)
-> (Name, ParsedSelection a)
-> (FieldName, a)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Name -> a) -> ParsedSelection a -> a
forall a. (Name -> a) -> ParsedSelection a -> a
P.handleTypename (Text -> a
mkTypenameFromText (Text -> a) -> (Name -> Text) -> Name -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName))

numericAggOperators :: [C.GQLNameIdentifier]
numericAggOperators :: [GQLNameIdentifier]
numericAggOperators =
  [ Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "sum"),
    Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "avg"),
    Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "stddev"),
    (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["stddev", "samp"]),
    (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["stddev", "pop"]),
    Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "variance"),
    (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["var", "samp"]),
    (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["var", "pop"])
  ]

comparisonAggOperators :: [C.GQLNameIdentifier]
comparisonAggOperators :: [GQLNameIdentifier]
comparisonAggOperators =
  [ Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "max"),
    Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "min")
  ]

mkDescriptionWith :: Maybe Postgres.PGDescription -> Text -> G.Description
mkDescriptionWith :: Maybe PGDescription -> Text -> Description
mkDescriptionWith Maybe PGDescription
descM Text
defaultTxt = Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ case Maybe PGDescription
descM of
  Maybe PGDescription
Nothing -> Text
defaultTxt
  Just (Postgres.PGDescription Text
descTxt) -> [Text] -> Text
T.unlines [Text
descTxt, Text
"\n", Text
defaultTxt]

-- TODO why do we do these validations at this point? What does it mean to track
--      a function but not add it to the schema...?
--      Auke:
--        I believe the intention is simply to allow the console to do postgres data management
--      Karthikeyan: Yes, this is correct. We allowed this pre PDV but somehow
--        got removed in PDV. OTOH, I’m not sure how prevalent this feature
--        actually is
takeValidTables :: forall b. (Backend b) => TableCache b -> TableCache b
takeValidTables :: forall (b :: BackendType).
Backend b =>
TableCache b -> TableCache b
takeValidTables = (TableName b -> TableInfo b -> Bool)
-> HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) (TableInfo b)
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey TableName b -> TableInfo b -> Bool
graphQLTableFilter
  where
    graphQLTableFilter :: TableName b -> TableInfo b -> Bool
graphQLTableFilter TableName b
tableName TableInfo b
tableInfo =
      -- either the table name should be GraphQL compliant
      -- or it should have a GraphQL custom name set with it
      Either QErr Name -> Bool
forall a b. Either a b -> Bool
isRight (forall (b :: BackendType).
Backend b =>
TableName b -> Either QErr Name
tableGraphQLName @b TableName b
tableName)
        Bool -> Bool -> Bool
|| Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust (TableConfig b -> Maybe Name
forall (b :: BackendType). TableConfig b -> Maybe Name
_tcCustomName (TableConfig b -> Maybe Name) -> TableConfig b -> Maybe Name
forall a b. (a -> b) -> a -> b
$ TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig (TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b)
-> TableCoreInfoG b (FieldInfo b) (ColumnInfo b) -> TableConfig b
forall a b. (a -> b) -> a -> b
$ TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo TableInfo b
tableInfo)

-- TODO and what about graphql-compliant function names here too?
takeValidFunctions :: forall b. FunctionCache b -> FunctionCache b
takeValidFunctions :: forall (b :: BackendType). FunctionCache b -> FunctionCache b
takeValidFunctions = (FunctionInfo b -> Bool)
-> HashMap (FunctionName b) (FunctionInfo b)
-> HashMap (FunctionName b) (FunctionInfo b)
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter FunctionInfo b -> Bool
forall {b :: BackendType}. FunctionInfo b -> Bool
functionFilter
  where
    functionFilter :: FunctionInfo b -> Bool
functionFilter = Bool -> Bool
not (Bool -> Bool)
-> (FunctionInfo b -> Bool) -> FunctionInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemDefined -> Bool
isSystemDefined (SystemDefined -> Bool)
-> (FunctionInfo b -> SystemDefined) -> FunctionInfo b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionInfo b -> SystemDefined
forall (b :: BackendType). FunctionInfo b -> SystemDefined
_fiSystemDefined

-- | @TODO: Currently we do no validation on native queries in schema. Should we?
takeValidNativeQueries :: forall b. NativeQueryCache b -> NativeQueryCache b
takeValidNativeQueries :: forall (b :: BackendType). NativeQueryCache b -> NativeQueryCache b
takeValidNativeQueries = NativeQueryCache b -> NativeQueryCache b
forall a. a -> a
id

-- | @TODO: Currently we do no validation on stored procedures in schema. Should we?
takeValidStoredProcedures :: forall b. StoredProcedureCache b -> StoredProcedureCache b
takeValidStoredProcedures :: forall (b :: BackendType).
StoredProcedureCache b -> StoredProcedureCache b
takeValidStoredProcedures = HashMap (FunctionName b) (StoredProcedureInfo b)
-> HashMap (FunctionName b) (StoredProcedureInfo b)
forall a. a -> a
id

-- root field builder helpers

requiredFieldParser ::
  (Functor n, Functor m) =>
  (a -> b) ->
  m (P.FieldParser n a) ->
  m (Maybe (P.FieldParser n b))
requiredFieldParser :: forall (n :: * -> *) (m :: * -> *) a b.
(Functor n, Functor m) =>
(a -> b) -> m (FieldParser n a) -> m (Maybe (FieldParser n b))
requiredFieldParser a -> b
f = (FieldParser n a -> Maybe (FieldParser n b))
-> m (FieldParser n a) -> m (Maybe (FieldParser n b))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FieldParser n a -> Maybe (FieldParser n b))
 -> m (FieldParser n a) -> m (Maybe (FieldParser n b)))
-> (FieldParser n a -> Maybe (FieldParser n b))
-> m (FieldParser n a)
-> m (Maybe (FieldParser n b))
forall a b. (a -> b) -> a -> b
$ FieldParser n b -> Maybe (FieldParser n b)
forall a. a -> Maybe a
Just (FieldParser n b -> Maybe (FieldParser n b))
-> (FieldParser n a -> FieldParser n b)
-> FieldParser n a
-> Maybe (FieldParser n b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> FieldParser n a -> FieldParser n b
forall a b.
(a -> b)
-> FieldParser MetadataObjId n a -> FieldParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f

optionalFieldParser ::
  (Functor n, Functor m) =>
  (a -> b) ->
  m (Maybe (P.FieldParser n a)) ->
  m (Maybe (P.FieldParser n b))
optionalFieldParser :: forall (n :: * -> *) (m :: * -> *) a b.
(Functor n, Functor m) =>
(a -> b)
-> m (Maybe (FieldParser n a)) -> m (Maybe (FieldParser n b))
optionalFieldParser = (Maybe (FieldParser n a) -> Maybe (FieldParser n b))
-> m (Maybe (FieldParser n a)) -> m (Maybe (FieldParser n b))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (FieldParser n a) -> Maybe (FieldParser n b))
 -> m (Maybe (FieldParser n a)) -> m (Maybe (FieldParser n b)))
-> ((a -> b) -> Maybe (FieldParser n a) -> Maybe (FieldParser n b))
-> (a -> b)
-> m (Maybe (FieldParser n a))
-> m (Maybe (FieldParser n b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldParser n a -> FieldParser n b)
-> Maybe (FieldParser n a) -> Maybe (FieldParser n b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FieldParser n a -> FieldParser n b)
 -> Maybe (FieldParser n a) -> Maybe (FieldParser n b))
-> ((a -> b) -> FieldParser n a -> FieldParser n b)
-> (a -> b)
-> Maybe (FieldParser n a)
-> Maybe (FieldParser n b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> FieldParser n a -> FieldParser n b
forall a b.
(a -> b)
-> FieldParser MetadataObjId n a -> FieldParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | Builds the type name for referenced enum tables.
mkEnumTypeName :: forall b r m. (Backend b, MonadError QErr m, Has (SourceInfo b) r) => TableName b -> Maybe G.Name -> SchemaT r m G.Name
mkEnumTypeName :: forall (b :: BackendType) r (m :: * -> *).
(Backend b, MonadError QErr m, Has (SourceInfo b) r) =>
TableName b -> Maybe Name -> SchemaT r m Name
mkEnumTypeName TableName b
enumTableName Maybe Name
enumTableCustomName = do
  ResolvedSourceCustomization
customization <- (SourceInfo b -> ResolvedSourceCustomization)
-> SchemaT r m ResolvedSourceCustomization
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve ((SourceInfo b -> ResolvedSourceCustomization)
 -> SchemaT r m ResolvedSourceCustomization)
-> (SourceInfo b -> ResolvedSourceCustomization)
-> SchemaT r m ResolvedSourceCustomization
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization @b
  GQLNameIdentifier
enumTableGQLName <- forall (b :: BackendType).
Backend b =>
TableName b -> Either QErr GQLNameIdentifier
getTableIdentifier @b TableName b
enumTableName Either QErr GQLNameIdentifier
-> (QErr -> SchemaT r m GQLNameIdentifier)
-> SchemaT r m GQLNameIdentifier
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` QErr -> SchemaT r m GQLNameIdentifier
forall a. QErr -> SchemaT r m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  Name -> SchemaT r m Name
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> SchemaT r m Name) -> Name -> SchemaT r m Name
forall a b. (a -> b) -> a -> b
$ ResolvedSourceCustomization
-> GQLNameIdentifier -> Maybe Name -> Name
addEnumSuffix ResolvedSourceCustomization
customization GQLNameIdentifier
enumTableGQLName Maybe Name
enumTableCustomName

addEnumSuffix :: ResolvedSourceCustomization -> GQLNameIdentifier -> Maybe G.Name -> G.Name
addEnumSuffix :: ResolvedSourceCustomization
-> GQLNameIdentifier -> Maybe Name -> Name
addEnumSuffix ResolvedSourceCustomization
customization GQLNameIdentifier
enumTableGQLName Maybe Name
enumTableCustomName =
  MkTypename -> Name -> Name
runMkTypename (ResolvedSourceCustomization -> MkTypename
_rscTypeNames ResolvedSourceCustomization
customization)
    (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ NamingCase -> GQLNameIdentifier -> Name
applyTypeNameCaseIdentifier (ResolvedSourceCustomization -> NamingCase
_rscNamingConvention ResolvedSourceCustomization
customization)
    (GQLNameIdentifier -> Name) -> GQLNameIdentifier -> Name
forall a b. (a -> b) -> a -> b
$ GQLNameIdentifier -> Maybe Name -> GQLNameIdentifier
mkEnumTableTypeName GQLNameIdentifier
enumTableGQLName Maybe Name
enumTableCustomName

-- TODO: figure out what the purpose of this method is.
peelWithOrigin :: (P.MonadParse m) => P.Parser 'P.Both m a -> P.Parser 'P.Both m (IR.ValueWithOrigin a)
peelWithOrigin :: forall (m :: * -> *) a.
MonadParse m =>
Parser 'Both m a -> Parser 'Both m (ValueWithOrigin a)
peelWithOrigin Parser 'Both m a
parser =
  Parser 'Both m a
parser
    { pParser :: ParserInput 'Both -> m (ValueWithOrigin a)
P.pParser = \case
        P.GraphQLValue (G.VVariable var :: Variable
var@P.Variable {VariableInfo
vInfo :: VariableInfo
vInfo :: Variable -> VariableInfo
vInfo, Maybe (InputValue Void)
vValue :: Maybe (InputValue Void)
vValue :: Variable -> Maybe (InputValue Void)
vValue}) -> do
          -- Check types c.f. 5.8.5 of the June 2018 GraphQL spec
          Bool -> GType -> Variable -> m ()
forall (m :: * -> *).
MonadParse m =>
Bool -> GType -> Variable -> m ()
P.typeCheck Bool
False (Type MetadataObjId 'Both -> GType
forall origin (k :: Kind). Type origin k -> GType
P.toGraphQLType (Type MetadataObjId 'Both -> GType)
-> Type MetadataObjId 'Both -> GType
forall a b. (a -> b) -> a -> b
$ Parser 'Both m a -> Type MetadataObjId 'Both
forall origin (k :: Kind) (m :: * -> *) a.
Parser origin k m a -> Type origin k
P.pType Parser 'Both m a
parser) Variable
var
          (a -> ValueWithOrigin a) -> m a -> m (ValueWithOrigin a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VariableInfo -> a -> ValueWithOrigin a
forall a. VariableInfo -> a -> ValueWithOrigin a
IR.ValueWithOrigin VariableInfo
vInfo)
            (m a -> m (ValueWithOrigin a)) -> m a -> m (ValueWithOrigin a)
forall a b. (a -> b) -> a -> b
$ Parser 'Both m a -> ParserInput 'Both -> m a
forall origin (k :: Kind) (m :: * -> *) a.
Parser origin k m a -> ParserInput k -> m a
P.pParser Parser 'Both m a
parser
            (ParserInput 'Both -> m a) -> ParserInput 'Both -> m a
forall a b. (a -> b) -> a -> b
$ case Maybe (InputValue Void)
vValue of
              -- TODO: why is faking a null value here semantically correct? RE: GraphQL spec June 2018, section 2.9.5
              Maybe (InputValue Void)
Nothing -> Value Variable -> InputValue Variable
forall v. Value v -> InputValue v
P.GraphQLValue Value Variable
forall var. Value var
G.VNull
              Just InputValue Void
val -> Void -> Variable
forall a. Void -> a
absurd (Void -> Variable) -> InputValue Void -> InputValue Variable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputValue Void
val
        ParserInput 'Both
value -> a -> ValueWithOrigin a
forall a. a -> ValueWithOrigin a
IR.ValueNoOrigin (a -> ValueWithOrigin a) -> m a -> m (ValueWithOrigin a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser 'Both m a -> ParserInput 'Both -> m a
forall origin (k :: Kind) (m :: * -> *) a.
Parser origin k m a -> ParserInput k -> m a
P.pParser Parser 'Both m a
parser ParserInput 'Both
value
    }

getIntrospectionResult :: Options.RemoteSchemaPermissions -> RoleName -> RemoteSchemaCtxG remoteFieldInfo -> Maybe IntrospectionResult
getIntrospectionResult :: forall remoteFieldInfo.
RemoteSchemaPermissions
-> RoleName
-> RemoteSchemaCtxG remoteFieldInfo
-> Maybe IntrospectionResult
getIntrospectionResult RemoteSchemaPermissions
remoteSchemaPermsCtx RoleName
role RemoteSchemaCtxG remoteFieldInfo
remoteSchemaContext =
  if
    | -- admin doesn't have a custom annotated introspection, defaulting to the original one
      RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName ->
        IntrospectionResult -> Maybe IntrospectionResult
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntrospectionResult -> Maybe IntrospectionResult)
-> IntrospectionResult -> Maybe IntrospectionResult
forall a b. (a -> b) -> a -> b
$ RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
_rscIntroOriginal RemoteSchemaCtxG remoteFieldInfo
remoteSchemaContext
    | -- if permissions are disabled, the role map will be empty, defaulting to the original one
      RemoteSchemaPermissions
remoteSchemaPermsCtx RemoteSchemaPermissions -> RemoteSchemaPermissions -> Bool
forall a. Eq a => a -> a -> Bool
== RemoteSchemaPermissions
Options.DisableRemoteSchemaPermissions ->
        IntrospectionResult -> Maybe IntrospectionResult
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntrospectionResult -> Maybe IntrospectionResult)
-> IntrospectionResult -> Maybe IntrospectionResult
forall a b. (a -> b) -> a -> b
$ RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
_rscIntroOriginal RemoteSchemaCtxG remoteFieldInfo
remoteSchemaContext
    | -- otherwise, look the role up in the map; if we find nothing, then the role doesn't have access
      Bool
otherwise ->
        RoleName
-> HashMap RoleName IntrospectionResult
-> Maybe IntrospectionResult
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RoleName
role (RemoteSchemaCtxG remoteFieldInfo
-> HashMap RoleName IntrospectionResult
forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> HashMap RoleName IntrospectionResult
_rscPermissions RemoteSchemaCtxG remoteFieldInfo
remoteSchemaContext)