{-# LANGUAGE TemplateHaskellQuotes #-}

-- | This module only exposes one function, 'nodeField', which is used at the
-- root level of the schema to create the 'node' field in the Relay API schema.
module Hasura.GraphQL.Schema.Relay
  ( nodeInterface,
    nodeField,
  )
where

import Control.Lens hiding (index)
import Data.Aeson qualified as J
import Data.Aeson.Types qualified as J
import Data.Align (align)
import Data.Has
import Data.HashMap.Strict.Extended qualified as Map
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text qualified as T
import Data.These (partitionThese)
import Hasura.Base.Error
import Hasura.Base.ErrorMessage
import Hasura.Base.ToErrorValue
import Hasura.GraphQL.Schema.Backend
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Instances ()
import Hasura.GraphQL.Schema.NamingCase (NamingCase)
import Hasura.GraphQL.Schema.Node
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.GraphQL.Schema.Parser (Kind (..), Parser, memoizeOn)
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.Table
import Hasura.GraphQL.Schema.Typename (withTypenameCustomization)
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.SchemaCache hiding (askTableInfo)
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Language.GraphQL.Draft.Syntax qualified as G

-- | Constructs the parser for the node interface.
--
-- As mentioned in Note [Internal Relay HashMap], this function must parse an
-- incoming query for ANY potential matching table. Its resulting parser returns
-- a 'NodeMap': a container that, to a source name and a table name, associates
-- both the parsed fields and all the relevant table information required to
-- craft a request.
nodeInterface :: SourceCache -> NodeInterfaceParserBuilder
nodeInterface :: SourceCache -> NodeInterfaceParserBuilder
nodeInterface SourceCache
sourceCache = (forall r (n :: * -> *) (m :: * -> *).
 MonadBuildSchemaBase r m n =>
 m (Parser 'Output n NodeMap))
-> NodeInterfaceParserBuilder
NodeInterfaceParserBuilder ((forall r (n :: * -> *) (m :: * -> *).
  MonadBuildSchemaBase r m n =>
  m (Parser 'Output n NodeMap))
 -> NodeInterfaceParserBuilder)
-> (forall r (n :: * -> *) (m :: * -> *).
    MonadBuildSchemaBase r m n =>
    m (Parser 'Output n NodeMap))
-> NodeInterfaceParserBuilder
forall a b. (a -> b) -> a -> b
$ Name
-> ()
-> m (Parser MetadataObjId 'Output n NodeMap)
-> m (Parser MetadataObjId 'Output n NodeMap)
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
memoizeOn 'nodeInterface () do
  let idDescription :: Description
idDescription = Text -> Description
G.Description Text
"A globally unique identifier"
      idField :: FieldParser origin n ()
idField = Name
-> Maybe Description
-> Parser origin 'Both n Text
-> FieldParser origin n ()
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Both m a
-> FieldParser origin m ()
P.selection_ Name
Name._id (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
idDescription) Parser origin 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.identifier
      nodeInterfaceDescription :: Description
nodeInterfaceDescription = Text -> Description
G.Description Text
"An object with globally unique ID"
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  RoleName
roleName <- (SchemaContext -> RoleName) -> m RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  [Parser 'Output n (SourceName, AnyBackend TableMap)]
tables :: [Parser 'Output n (SourceName, AB.AnyBackend TableMap)] <-
    [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
-> [Parser 'Output n (SourceName, AnyBackend TableMap)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
 -> [Parser 'Output n (SourceName, AnyBackend TableMap)])
-> ([[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
    -> [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))])
-> [[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
-> [Parser 'Output n (SourceName, AnyBackend TableMap)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
-> [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
 -> [Parser 'Output n (SourceName, AnyBackend TableMap)])
-> m [[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
-> m [Parser 'Output n (SourceName, AnyBackend TableMap)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceName, BackendSourceInfo)]
-> ((SourceName, BackendSourceInfo)
    -> m [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))])
-> m [[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (SourceCache -> [(SourceName, BackendSourceInfo)]
forall k v. HashMap k v -> [(k, v)]
Map.toList SourceCache
sourceCache) \(SourceName
sourceName, BackendSourceInfo
anySourceInfo) ->
      BackendSourceInfo
-> (forall (b :: BackendType).
    (BackendSchema b, BackendTableSelectSchema b) =>
    SourceInfo b
    -> m [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))])
-> m [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
forall (c1 :: BackendType -> Constraint)
       (c2 :: BackendType -> Constraint) (i :: BackendType -> *) r.
(AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
AnyBackend i
-> (forall (b :: BackendType). (c1 b, c2 b) => i b -> r) -> r
AB.dispatchAnyBackendWithTwoConstraints @BackendSchema @BackendTableSelectSchema
        BackendSourceInfo
anySourceInfo
        \(SourceInfo b
sourceInfo :: SourceInfo b) ->
          [(TableName b, TableInfo b)]
-> ((TableName b, TableInfo b)
    -> m (Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))))
-> m [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashMap (TableName b) (TableInfo b) -> [(TableName b, TableInfo b)]
forall k v. HashMap k v -> [(k, v)]
Map.toList (HashMap (TableName b) (TableInfo b)
 -> [(TableName b, TableInfo b)])
-> HashMap (TableName b) (TableInfo b)
-> [(TableName b, TableInfo b)]
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) (TableInfo b)
forall (b :: BackendType).
Backend b =>
TableCache b -> TableCache b
takeValidTables (HashMap (TableName b) (TableInfo b)
 -> HashMap (TableName b) (TableInfo b))
-> HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) (TableInfo b)
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> HashMap (TableName b) (TableInfo b)
forall (b :: BackendType). SourceInfo b -> TableCache b
_siTables SourceInfo b
sourceInfo) \(TableName b
tableName, TableInfo b
tableInfo) -> MaybeT m (Parser 'Output n (SourceName, AnyBackend TableMap))
-> m (Maybe (Parser 'Output n (SourceName, AnyBackend TableMap)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
            NESeq (ColumnInfo b)
tablePkeyColumns <- Maybe (NESeq (ColumnInfo b)) -> MaybeT m (NESeq (ColumnInfo b))
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (NESeq (ColumnInfo b)) -> MaybeT m (NESeq (ColumnInfo b)))
-> Maybe (NESeq (ColumnInfo b)) -> MaybeT m (NESeq (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$ TableInfo b
tableInfo TableInfo b
-> Getting
     (First (NESeq (ColumnInfo b))) (TableInfo b) (NESeq (ColumnInfo b))
-> Maybe (NESeq (ColumnInfo b))
forall s a. s -> Getting (First a) s a -> Maybe a
^? (TableCoreInfo b
 -> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b))
-> TableInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableInfo b)
forall (b :: BackendType). Lens' (TableInfo b) (TableCoreInfo b)
tiCoreInfo ((TableCoreInfo b
  -> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b))
 -> TableInfo b
 -> Const (First (NESeq (ColumnInfo b))) (TableInfo b))
-> ((NESeq (ColumnInfo b)
     -> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
    -> TableCoreInfo b
    -> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b))
-> Getting
     (First (NESeq (ColumnInfo b))) (TableInfo b) (NESeq (ColumnInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (PrimaryKey b (ColumnInfo b))
 -> Const
      (First (NESeq (ColumnInfo b)))
      (Maybe (PrimaryKey b (ColumnInfo b))))
-> TableCoreInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b)
forall (b :: BackendType) field primaryKeyColumn1
       primaryKeyColumn2.
Lens
  (TableCoreInfoG b field primaryKeyColumn1)
  (TableCoreInfoG b field primaryKeyColumn2)
  (Maybe (PrimaryKey b primaryKeyColumn1))
  (Maybe (PrimaryKey b primaryKeyColumn2))
tciPrimaryKey ((Maybe (PrimaryKey b (ColumnInfo b))
  -> Const
       (First (NESeq (ColumnInfo b)))
       (Maybe (PrimaryKey b (ColumnInfo b))))
 -> TableCoreInfo b
 -> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b))
-> ((NESeq (ColumnInfo b)
     -> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
    -> Maybe (PrimaryKey b (ColumnInfo b))
    -> Const
         (First (NESeq (ColumnInfo b)))
         (Maybe (PrimaryKey b (ColumnInfo b))))
-> (NESeq (ColumnInfo b)
    -> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
-> TableCoreInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrimaryKey b (ColumnInfo b)
 -> Const
      (First (NESeq (ColumnInfo b))) (PrimaryKey b (ColumnInfo b)))
-> Maybe (PrimaryKey b (ColumnInfo b))
-> Const
     (First (NESeq (ColumnInfo b)))
     (Maybe (PrimaryKey b (ColumnInfo b)))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((PrimaryKey b (ColumnInfo b)
  -> Const
       (First (NESeq (ColumnInfo b))) (PrimaryKey b (ColumnInfo b)))
 -> Maybe (PrimaryKey b (ColumnInfo b))
 -> Const
      (First (NESeq (ColumnInfo b)))
      (Maybe (PrimaryKey b (ColumnInfo b))))
-> ((NESeq (ColumnInfo b)
     -> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
    -> PrimaryKey b (ColumnInfo b)
    -> Const
         (First (NESeq (ColumnInfo b))) (PrimaryKey b (ColumnInfo b)))
-> (NESeq (ColumnInfo b)
    -> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
-> Maybe (PrimaryKey b (ColumnInfo b))
-> Const
     (First (NESeq (ColumnInfo b)))
     (Maybe (PrimaryKey b (ColumnInfo b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NESeq (ColumnInfo b)
 -> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
-> PrimaryKey b (ColumnInfo b)
-> Const
     (First (NESeq (ColumnInfo b))) (PrimaryKey b (ColumnInfo b))
forall (b :: BackendType) a1 a2.
Lens (PrimaryKey b a1) (PrimaryKey b a2) (NESeq a1) (NESeq a2)
pkColumns
            SelPermInfo b
selectPermissions <- Maybe (SelPermInfo b) -> MaybeT m (SelPermInfo b)
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (SelPermInfo b) -> MaybeT m (SelPermInfo b))
-> Maybe (SelPermInfo b) -> MaybeT m (SelPermInfo b)
forall a b. (a -> b) -> a -> b
$ RoleName -> TableInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType).
RoleName -> TableInfo b -> Maybe (SelPermInfo b)
tableSelectPermissions RoleName
roleName TableInfo b
tableInfo
            Parser 'Output n (AnnotatedFields b)
annotatedFieldsParser <-
              m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT m (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Parser 'Output n (AnnotatedFields b)))
 -> MaybeT m (Parser 'Output n (AnnotatedFields b)))
-> m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT m (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$
                MkTypename
-> m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (m :: * -> *) r a.
(MonadReader r m, Has MkTypename r) =>
MkTypename -> m a -> m a
withTypenameCustomization
                  (Maybe SourceTypeCustomization -> NamingCase -> MkTypename
mkCustomizedTypename (SourceCustomization -> Maybe SourceTypeCustomization
_scTypeNames (SourceCustomization -> Maybe SourceTypeCustomization)
-> SourceCustomization -> Maybe SourceTypeCustomization
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> SourceCustomization
forall (b :: BackendType). SourceInfo b -> SourceCustomization
_siCustomization SourceInfo b
sourceInfo) NamingCase
tCase)
                  (SourceInfo b
-> TableInfo b -> m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSchemaBase r m n) =>
SourceInfo b
-> TableInfo b -> m (Maybe (Parser 'Output n (AnnotatedFields b)))
tableSelectionSet SourceInfo b
sourceInfo TableInfo b
tableInfo)
            Parser 'Output n (SourceName, AnyBackend TableMap)
-> MaybeT m (Parser 'Output n (SourceName, AnyBackend TableMap))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser 'Output n (SourceName, AnyBackend TableMap)
 -> MaybeT m (Parser 'Output n (SourceName, AnyBackend TableMap)))
-> Parser 'Output n (SourceName, AnyBackend TableMap)
-> MaybeT m (Parser 'Output n (SourceName, AnyBackend TableMap))
forall a b. (a -> b) -> a -> b
$
              Parser 'Output n (AnnotatedFields b)
annotatedFieldsParser Parser 'Output n (AnnotatedFields b)
-> (AnnotatedFields b -> (SourceName, AnyBackend TableMap))
-> Parser 'Output n (SourceName, AnyBackend TableMap)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \AnnotatedFields b
fields ->
                ( SourceName
sourceName,
                  TableMap b -> AnyBackend TableMap
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (TableMap b -> AnyBackend TableMap)
-> TableMap b -> AnyBackend TableMap
forall a b. (a -> b) -> a -> b
$
                    HashMap (TableName b) (NodeInfo b) -> TableMap b
forall (b :: BackendType).
HashMap (TableName b) (NodeInfo b) -> TableMap b
TableMap (HashMap (TableName b) (NodeInfo b) -> TableMap b)
-> HashMap (TableName b) (NodeInfo b) -> TableMap b
forall a b. (a -> b) -> a -> b
$
                      TableName b -> NodeInfo b -> HashMap (TableName b) (NodeInfo b)
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton TableName b
tableName (NodeInfo b -> HashMap (TableName b) (NodeInfo b))
-> NodeInfo b -> HashMap (TableName b) (NodeInfo b)
forall a b. (a -> b) -> a -> b
$
                        SourceConfig b
-> SelPermInfo b
-> NESeq (ColumnInfo b)
-> AnnotatedFields b
-> NodeInfo b
forall (b :: BackendType).
SourceConfig b
-> SelPermInfo b
-> PrimaryKeyColumns b
-> AnnFieldsG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> NodeInfo b
NodeInfo (SourceInfo b -> SourceConfig b
forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siConfiguration SourceInfo b
sourceInfo) SelPermInfo b
selectPermissions NESeq (ColumnInfo b)
tablePkeyColumns AnnotatedFields b
fields
                )
  Parser MetadataObjId 'Output n NodeMap
-> m (Parser MetadataObjId 'Output n NodeMap)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser MetadataObjId 'Output n NodeMap
 -> m (Parser MetadataObjId 'Output n NodeMap))
-> Parser MetadataObjId 'Output n NodeMap
-> m (Parser MetadataObjId 'Output n NodeMap)
forall a b. (a -> b) -> a -> b
$
    (AnyBackend TableMap -> AnyBackend TableMap -> AnyBackend TableMap)
-> [(SourceName, AnyBackend TableMap)] -> NodeMap
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
Map.fromListWith AnyBackend TableMap -> AnyBackend TableMap -> AnyBackend TableMap
fuseAnyMaps
      ([(SourceName, AnyBackend TableMap)] -> NodeMap)
-> Parser
     MetadataObjId 'Output n [(SourceName, AnyBackend TableMap)]
-> Parser MetadataObjId 'Output n NodeMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> [FieldParser MetadataObjId n ()]
-> [Parser 'Output n (SourceName, AnyBackend TableMap)]
-> Parser
     MetadataObjId 'Output n [(SourceName, AnyBackend TableMap)]
forall (n :: * -> *) (t :: * -> *) origin a b.
(MonadParse n, Traversable t) =>
Name
-> Maybe Description
-> [FieldParser origin n a]
-> t (Parser origin 'Output n b)
-> Parser origin 'Output n (t b)
P.selectionSetInterface
        Name
Name._Node
        (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
nodeInterfaceDescription)
        [FieldParser MetadataObjId n ()
forall origin. FieldParser origin n ()
idField]
        [Parser 'Output n (SourceName, AnyBackend TableMap)]
tables
  where
    -- this can only ever fail if somehow, within the same source, we ran into
    -- two tables of a different type b; in other words, it is impossible.
    fuseAnyMaps :: AB.AnyBackend TableMap -> AB.AnyBackend TableMap -> AB.AnyBackend TableMap
    fuseAnyMaps :: AnyBackend TableMap -> AnyBackend TableMap -> AnyBackend TableMap
fuseAnyMaps AnyBackend TableMap
m1 AnyBackend TableMap
m2 =
      (forall (b :: BackendType).
 Backend b =>
 TableMap b -> TableMap b -> AnyBackend TableMap)
-> AnyBackend TableMap
-> AnyBackend TableMap
-> AnyBackend TableMap
-> AnyBackend TableMap
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
(forall (b :: BackendType). c b => i b -> i b -> r)
-> AnyBackend i -> AnyBackend i -> r -> r
AB.composeAnyBackend @Backend forall (b :: BackendType).
Backend b =>
TableMap b -> TableMap b -> AnyBackend TableMap
fuseMaps AnyBackend TableMap
m1 AnyBackend TableMap
m2 (AnyBackend TableMap -> AnyBackend TableMap)
-> AnyBackend TableMap -> AnyBackend TableMap
forall a b. (a -> b) -> a -> b
$
        [Char] -> AnyBackend TableMap
forall a. HasCallStack => [Char] -> a
error [Char]
"panic: two tables of a different backend type within the same source"

    fuseMaps :: forall b. Backend b => TableMap b -> TableMap b -> AB.AnyBackend TableMap
    fuseMaps :: TableMap b -> TableMap b -> AnyBackend TableMap
fuseMaps (TableMap HashMap (TableName b) (NodeInfo b)
m1) (TableMap HashMap (TableName b) (NodeInfo b)
m2) = forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
forall (i :: BackendType -> *). HasTag b => i b -> AnyBackend i
AB.mkAnyBackend @b (TableMap b -> AnyBackend TableMap)
-> TableMap b -> AnyBackend TableMap
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) (NodeInfo b) -> TableMap b
forall (b :: BackendType).
HashMap (TableName b) (NodeInfo b) -> TableMap b
TableMap (HashMap (TableName b) (NodeInfo b) -> TableMap b)
-> HashMap (TableName b) (NodeInfo b) -> TableMap b
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) (NodeInfo b)
-> HashMap (TableName b) (NodeInfo b)
-> HashMap (TableName b) (NodeInfo b)
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
Map.union HashMap (TableName b) (NodeInfo b)
m1 HashMap (TableName b) (NodeInfo b)
m2

-- | Creates a field parser for the top-level "node" field in the QueryRoot.
--
-- It exepcts one argument, the node id. It looks for the targeted table in the
-- 'NodeMap' returned by 'nodeInterface', and, if successful, attempts to craft
-- a corresponding 'QueryRootField' that will extract the requested row.
nodeField ::
  forall m n r.
  SourceCache ->
  MonadBuildSchemaBase r m n =>
  m (P.FieldParser n (IR.QueryRootField IR.UnpreparedValue))
nodeField :: SourceCache
-> MonadBuildSchemaBase r m n =>
   m (FieldParser n (QueryRootField UnpreparedValue))
nodeField SourceCache
sourceCache = do
  let idDescription :: Description
idDescription = Text -> Description
G.Description Text
"A globally unique id"
      idArgument :: InputFieldsParser origin n Text
idArgument = Name
-> Maybe Description
-> Parser origin 'Both n Text
-> InputFieldsParser origin n Text
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
Name._id (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
idDescription) Parser origin 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.identifier
  StringifyNumbers
stringifyNumbers <- (SchemaOptions -> StringifyNumbers) -> m StringifyNumbers
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> StringifyNumbers
Options.soStringifyNumbers
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  Parser 'Output n NodeMap
nodeObject <-
    (SchemaContext -> SchemaKind) -> m SchemaKind
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> SchemaKind
scSchemaKind m SchemaKind
-> (SchemaKind -> m (Parser 'Output n NodeMap))
-> m (Parser 'Output n NodeMap)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      SchemaKind
HasuraSchema -> Text -> m (Parser 'Output n NodeMap)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"internal error: the node field should only be built for the Relay schema"
      RelaySchema NodeInterfaceParserBuilder
nodeBuilder -> NodeInterfaceParserBuilder
-> forall r (n :: * -> *) (m :: * -> *).
   MonadBuildSchemaBase r m n =>
   m (Parser 'Output n NodeMap)
runNodeBuilder NodeInterfaceParserBuilder
nodeBuilder
  FieldParser n (QueryRootField UnpreparedValue)
-> m (FieldParser n (QueryRootField UnpreparedValue))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser n (QueryRootField UnpreparedValue)
 -> m (FieldParser n (QueryRootField UnpreparedValue)))
-> FieldParser n (QueryRootField UnpreparedValue)
-> m (FieldParser n (QueryRootField UnpreparedValue))
forall a b. (a -> b) -> a -> b
$
    Name
-> Maybe Description
-> InputFieldsParser MetadataObjId n Text
-> Parser 'Output n NodeMap
-> FieldParser MetadataObjId n (Text, NodeMap)
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser origin m (a, b)
P.subselection Name
Name._node Maybe Description
forall a. Maybe a
Nothing InputFieldsParser MetadataObjId n Text
forall origin. InputFieldsParser origin n Text
idArgument Parser 'Output n NodeMap
nodeObject FieldParser MetadataObjId n (Text, NodeMap)
-> ((Text, NodeMap) -> n (QueryRootField UnpreparedValue))
-> FieldParser n (QueryRootField UnpreparedValue)
forall (m :: * -> *) origin a b.
Monad m =>
FieldParser origin m a -> (a -> m b) -> FieldParser origin m b
`P.bindField` \(Text
ident, NodeMap
parseds) -> do
      NodeId
nodeId <- Text -> n NodeId
parseNodeId Text
ident
      case NodeId
nodeId of
        NodeIdV1 (V1NodeId QualifiedTable
tableName NESeq Value
pKeys) -> do
          -- Node id V1.
          --
          -- We don't have the source name in a V1 node; we attempt all of them
          -- and pick the first one we find; there is a risk we might pick the
          -- wrong one if two tables with the same name exist in different
          -- sources! It is, however, unlikely; the engine emits V2 IDs, meaning
          -- if ever encounter a V1 ID it means it has been manually entered bya
          -- user, saved from an older version of the engine?
          let matchingTables :: [(SourceName, NodeInfo ('Postgres 'Vanilla))]
matchingTables = ((SourceName -> Maybe (SourceName, NodeInfo ('Postgres 'Vanilla)))
 -> [SourceName] -> [(SourceName, NodeInfo ('Postgres 'Vanilla))])
-> [SourceName]
-> (SourceName
    -> Maybe (SourceName, NodeInfo ('Postgres 'Vanilla)))
-> [(SourceName, NodeInfo ('Postgres 'Vanilla))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SourceName -> Maybe (SourceName, NodeInfo ('Postgres 'Vanilla)))
-> [SourceName] -> [(SourceName, NodeInfo ('Postgres 'Vanilla))]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (SourceCache -> [SourceName]
forall k v. HashMap k v -> [k]
Map.keys SourceCache
sourceCache) \SourceName
sourceName ->
                (SourceName
sourceName,) (NodeInfo ('Postgres 'Vanilla)
 -> (SourceName, NodeInfo ('Postgres 'Vanilla)))
-> Maybe (NodeInfo ('Postgres 'Vanilla))
-> Maybe (SourceName, NodeInfo ('Postgres 'Vanilla))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName
-> TableName ('Postgres 'Vanilla)
-> NodeMap
-> Maybe (NodeInfo ('Postgres 'Vanilla))
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> NodeMap -> Maybe (NodeInfo b)
findNode @('Postgres 'Vanilla) SourceName
sourceName TableName ('Postgres 'Vanilla)
QualifiedTable
tableName NodeMap
parseds
          case [(SourceName, NodeInfo ('Postgres 'Vanilla))]
matchingTables of
            [(SourceName
sourceName, NodeInfo ('Postgres 'Vanilla)
nodeValue)] -> StringifyNumbers
-> SourceName
-> TableName ('Postgres 'Vanilla)
-> NodeInfo ('Postgres 'Vanilla)
-> NESeq Value
-> Maybe NamingCase
-> n (QueryRootField UnpreparedValue)
forall (b :: BackendType).
Backend b =>
StringifyNumbers
-> SourceName
-> TableName b
-> NodeInfo b
-> NESeq Value
-> Maybe NamingCase
-> n (QueryRootField UnpreparedValue)
createRootField StringifyNumbers
stringifyNumbers SourceName
sourceName TableName ('Postgres 'Vanilla)
QualifiedTable
tableName NodeInfo ('Postgres 'Vanilla)
nodeValue NESeq Value
pKeys (NamingCase -> Maybe NamingCase
forall a. a -> Maybe a
Just NamingCase
tCase)
            [] -> ErrorMessage -> n (QueryRootField UnpreparedValue)
forall a. ErrorMessage -> n a
throwInvalidNodeId (ErrorMessage -> n (QueryRootField UnpreparedValue))
-> ErrorMessage -> n (QueryRootField UnpreparedValue)
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"no such table found: " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> QualifiedTable -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue QualifiedTable
tableName
            [(SourceName, NodeInfo ('Postgres 'Vanilla))]
l ->
              ErrorMessage -> n (QueryRootField UnpreparedValue)
forall a. ErrorMessage -> n a
throwInvalidNodeId (ErrorMessage -> n (QueryRootField UnpreparedValue))
-> ErrorMessage -> n (QueryRootField UnpreparedValue)
forall a b. (a -> b) -> a -> b
$
                ErrorMessage
"this V1 node id matches more than one table across different sources: " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> QualifiedTable -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue QualifiedTable
tableName
                  ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
" exists in sources "
                  ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> [SourceName] -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue ((SourceName, NodeInfo ('Postgres 'Vanilla)) -> SourceName
forall a b. (a, b) -> a
fst ((SourceName, NodeInfo ('Postgres 'Vanilla)) -> SourceName)
-> [(SourceName, NodeInfo ('Postgres 'Vanilla))] -> [SourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceName, NodeInfo ('Postgres 'Vanilla))]
l)
        NodeIdV2 AnyBackend V2NodeId
nodev2 ->
          -- Node id V2.
          --
          -- We have the source name and table name, we can extract the relevant
          -- info directly.
          AnyBackend V2NodeId
-> (forall (b :: BackendType).
    Backend b =>
    V2NodeId b -> n (QueryRootField UnpreparedValue))
-> n (QueryRootField UnpreparedValue)
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend V2NodeId
nodev2 \(V2NodeId SourceName
sourceName TableName b
tableName NESeq Value
pKeys :: V2NodeId b) -> do
            NodeInfo b
nodeValue <-
              SourceName -> TableName b -> NodeMap -> Maybe (NodeInfo b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> NodeMap -> Maybe (NodeInfo b)
findNode @b SourceName
sourceName TableName b
tableName NodeMap
parseds
                Maybe (NodeInfo b) -> n (NodeInfo b) -> n (NodeInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` ErrorMessage -> n (NodeInfo b)
forall a. ErrorMessage -> n a
throwInvalidNodeId (ErrorMessage
"no table " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> TableName b -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue TableName b
tableName ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
" found in source " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> SourceName -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue SourceName
sourceName)
            StringifyNumbers
-> SourceName
-> TableName b
-> NodeInfo b
-> NESeq Value
-> Maybe NamingCase
-> n (QueryRootField UnpreparedValue)
forall (b :: BackendType).
Backend b =>
StringifyNumbers
-> SourceName
-> TableName b
-> NodeInfo b
-> NESeq Value
-> Maybe NamingCase
-> n (QueryRootField UnpreparedValue)
createRootField StringifyNumbers
stringifyNumbers SourceName
sourceName TableName b
tableName NodeInfo b
nodeValue NESeq Value
pKeys (NamingCase -> Maybe NamingCase
forall a. a -> Maybe a
Just NamingCase
tCase)
  where
    throwInvalidNodeId :: ErrorMessage -> n a
    throwInvalidNodeId :: ErrorMessage -> n a
throwInvalidNodeId ErrorMessage
t = JSONPathElement -> n a -> n a
forall (m :: * -> *) a.
MonadParse m =>
JSONPathElement -> m a -> m a
P.withKey (Key -> JSONPathElement
J.Key Key
"args") (n a -> n a) -> n a -> n a
forall a b. (a -> b) -> a -> b
$ JSONPathElement -> n a -> n a
forall (m :: * -> *) a.
MonadParse m =>
JSONPathElement -> m a -> m a
P.withKey (Key -> JSONPathElement
J.Key Key
"id") (n a -> n a) -> n a -> n a
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> n a
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> n a) -> ErrorMessage -> n a
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"invalid node id: " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
t

    parseNodeId :: Text -> n NodeId
    parseNodeId :: Text -> n NodeId
parseNodeId = ([Char] -> n NodeId)
-> (NodeId -> n NodeId) -> Either [Char] NodeId -> n NodeId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ErrorMessage -> n NodeId
forall a. ErrorMessage -> n a
throwInvalidNodeId (ErrorMessage -> n NodeId)
-> ([Char] -> ErrorMessage) -> [Char] -> n NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorMessage
toErrorMessage (Text -> ErrorMessage)
-> ([Char] -> Text) -> [Char] -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) NodeId -> n NodeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] NodeId -> n NodeId)
-> (Text -> Either [Char] NodeId) -> Text -> n NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either [Char] NodeId
forall a. FromJSON a => ByteString -> Either [Char] a
J.eitherDecode (ByteString -> Either [Char] NodeId)
-> (Text -> ByteString) -> Text -> Either [Char] NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
base64Decode

    -- Given all the node id information about a table, and the extracted
    -- 'NodeInfo', craft the top-level query. This relies on the assumption
    -- that all backends that support relay use the same IR for single row
    -- selection.
    createRootField ::
      Backend b =>
      Options.StringifyNumbers ->
      SourceName ->
      TableName b ->
      NodeInfo b ->
      NESeq.NESeq J.Value ->
      Maybe NamingCase ->
      n (IR.QueryRootField IR.UnpreparedValue)
    createRootField :: StringifyNumbers
-> SourceName
-> TableName b
-> NodeInfo b
-> NESeq Value
-> Maybe NamingCase
-> n (QueryRootField UnpreparedValue)
createRootField StringifyNumbers
stringifyNumbers SourceName
sourceName TableName b
tableName (NodeInfo SourceConfig b
sourceConfig SelPermInfo b
perms PrimaryKeyColumns b
pKeys AnnFieldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
fields) NESeq Value
columnValues Maybe NamingCase
tCase = do
      AnnBoolExp b (UnpreparedValue b)
whereExp <- NESeq Value
-> PrimaryKeyColumns b -> n (AnnBoolExp b (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
NESeq Value
-> NESeq (ColumnInfo b) -> n (AnnBoolExp b (UnpreparedValue b))
buildNodeIdBoolExp NESeq Value
columnValues PrimaryKeyColumns b
pKeys
      QueryRootField UnpreparedValue
-> n (QueryRootField UnpreparedValue)
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
$
              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
$
                  AnnSelectG :: forall (b :: BackendType) (f :: * -> *) v.
Fields (f v)
-> SelectFromG b v
-> TablePermG b v
-> SelectArgsG b v
-> StringifyNumbers
-> Maybe NamingCase
-> AnnSelectG b f v
IR.AnnSelectG
                    { $sel:_asnFields:AnnSelectG :: AnnFieldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
IR._asnFields = AnnFieldsG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
fields,
                      $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 = SelPermInfo b -> TablePermG b (UnpreparedValue b)
forall (b :: BackendType).
Backend b =>
SelPermInfo b -> TablePerms b
tablePermissionsInfo SelPermInfo b
perms,
                      $sel:_asnArgs:AnnSelectG :: SelectArgsG b (UnpreparedValue b)
IR._asnArgs =
                        SelectArgs :: forall (b :: BackendType) v.
Maybe (AnnBoolExp b v)
-> Maybe (NonEmpty (AnnotatedOrderByItemG b v))
-> Maybe Int
-> Maybe Int64
-> Maybe (NonEmpty (Column b))
-> SelectArgsG b v
IR.SelectArgs
                          { $sel:_saWhere:SelectArgs :: Maybe (AnnBoolExp b (UnpreparedValue b))
IR._saWhere = AnnBoolExp b (UnpreparedValue b)
-> Maybe (AnnBoolExp b (UnpreparedValue b))
forall a. a -> Maybe a
Just AnnBoolExp b (UnpreparedValue b)
whereExp,
                            $sel:_saOrderBy:SelectArgs :: Maybe (NonEmpty (AnnotatedOrderByItemG b (UnpreparedValue b)))
IR._saOrderBy = Maybe (NonEmpty (AnnotatedOrderByItemG b (UnpreparedValue b)))
forall a. Maybe a
Nothing,
                            $sel:_saLimit:SelectArgs :: Maybe Int
IR._saLimit = Maybe Int
forall a. Maybe a
Nothing,
                            $sel:_saOffset:SelectArgs :: Maybe Int64
IR._saOffset = Maybe Int64
forall a. Maybe a
Nothing,
                            $sel:_saDistinct:SelectArgs :: Maybe (NonEmpty (Column b))
IR._saDistinct = Maybe (NonEmpty (Column b))
forall a. Maybe a
Nothing
                          },
                      $sel:_asnStrfyNum:AnnSelectG :: StringifyNumbers
IR._asnStrfyNum = StringifyNumbers
stringifyNumbers,
                      $sel:_asnNamingConvention:AnnSelectG :: Maybe NamingCase
IR._asnNamingConvention = Maybe NamingCase
tCase
                    }

    -- Craft the 'where' condition of the query by making an `AEQ` entry for
    -- each primary key. This might fail if the given node id doesn't exactly
    -- have a valid entry for each primary key.
    buildNodeIdBoolExp ::
      Backend b =>
      NESeq.NESeq J.Value ->
      NESeq.NESeq (ColumnInfo b) ->
      n (IR.AnnBoolExp b (IR.UnpreparedValue b))
    buildNodeIdBoolExp :: NESeq Value
-> NESeq (ColumnInfo b) -> n (AnnBoolExp b (UnpreparedValue b))
buildNodeIdBoolExp NESeq Value
columnValues NESeq (ColumnInfo b)
pkeyColumns = do
      let ColumnInfo b
firstPkColumn NESeq.:<|| Seq (ColumnInfo b)
remainingPkColumns = NESeq (ColumnInfo b)
pkeyColumns
          Value
firstColumnValue NESeq.:<|| Seq Value
remainingColumns = NESeq Value
columnValues
          ([ColumnInfo b]
nonAlignedPkColumns, [Value]
nonAlignedColumnValues, [(ColumnInfo b, Value)]
alignedTuples) =
            [These (ColumnInfo b) Value]
-> ([ColumnInfo b], [Value], [(ColumnInfo b, Value)])
forall a b. [These a b] -> ([a], [b], [(a, b)])
partitionThese ([These (ColumnInfo b) Value]
 -> ([ColumnInfo b], [Value], [(ColumnInfo b, Value)]))
-> [These (ColumnInfo b) Value]
-> ([ColumnInfo b], [Value], [(ColumnInfo b, Value)])
forall a b. (a -> b) -> a -> b
$ Seq (These (ColumnInfo b) Value) -> [These (ColumnInfo b) Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (These (ColumnInfo b) Value) -> [These (ColumnInfo b) Value])
-> Seq (These (ColumnInfo b) Value) -> [These (ColumnInfo b) Value]
forall a b. (a -> b) -> a -> b
$ Seq (ColumnInfo b) -> Seq Value -> Seq (These (ColumnInfo b) Value)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Seq (ColumnInfo b)
remainingPkColumns Seq Value
remainingColumns

      Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ColumnInfo b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColumnInfo b]
nonAlignedPkColumns) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$
        ErrorMessage -> n ()
forall a. ErrorMessage -> n a
throwInvalidNodeId (ErrorMessage -> n ()) -> ErrorMessage -> n ()
forall a b. (a -> b) -> a -> b
$
          ErrorMessage
"primary key columns " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> [Column b] -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue ((ColumnInfo b -> Column b) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn [ColumnInfo b]
nonAlignedPkColumns) ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
" are missing"

      Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Value] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
nonAlignedColumnValues) (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$
        ErrorMessage -> n ()
forall a. ErrorMessage -> n a
throwInvalidNodeId (ErrorMessage -> n ()) -> ErrorMessage -> n ()
forall a b. (a -> b) -> a -> b
$
          ErrorMessage
"unexpected column values " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> [Value] -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue [Value]
nonAlignedColumnValues

      let allTuples :: [(ColumnInfo b, Value)]
allTuples = (ColumnInfo b
firstPkColumn, Value
firstColumnValue) (ColumnInfo b, Value)
-> [(ColumnInfo b, Value)] -> [(ColumnInfo b, Value)]
forall a. a -> [a] -> [a]
: [(ColumnInfo b, Value)]
alignedTuples
      [AnnBoolExp b (UnpreparedValue b)]
-> AnnBoolExp b (UnpreparedValue b)
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
IR.BoolAnd ([AnnBoolExp b (UnpreparedValue b)]
 -> AnnBoolExp b (UnpreparedValue b))
-> n [AnnBoolExp b (UnpreparedValue b)]
-> n (AnnBoolExp b (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ColumnInfo b, Value)]
-> ((ColumnInfo b, Value) -> n (AnnBoolExp b (UnpreparedValue b)))
-> n [AnnBoolExp b (UnpreparedValue b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(ColumnInfo b, Value)]
allTuples \(ColumnInfo b
columnInfo, Value
columnValue) -> do
        let columnType :: ColumnType b
columnType = ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo b
columnInfo
        ScalarValue b
parsedValue <-
          ColumnType b -> Value -> Either QErr (ScalarValue b)
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnType ColumnType b
columnType Value
columnValue Either QErr (ScalarValue b)
-> (QErr -> n (ScalarValue b)) -> n (ScalarValue b)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` \QErr
e ->
            ParseErrorCode -> ErrorMessage -> n (ScalarValue b)
forall (m :: * -> *) a.
MonadParse m =>
ParseErrorCode -> ErrorMessage -> m a
P.parseErrorWith ParseErrorCode
P.ParseFailed (ErrorMessage -> n (ScalarValue b))
-> ErrorMessage -> n (ScalarValue b)
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"value of column " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> Column b -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue (ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
columnInfo) ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
" in node id: " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> Text -> ErrorMessage
toErrorMessage (QErr -> Text
qeError QErr
e)
        AnnBoolExp b (UnpreparedValue b)
-> n (AnnBoolExp b (UnpreparedValue b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnBoolExp b (UnpreparedValue b)
 -> n (AnnBoolExp b (UnpreparedValue b)))
-> AnnBoolExp b (UnpreparedValue b)
-> n (AnnBoolExp b (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$
          AnnBoolExpFld b (UnpreparedValue b)
-> AnnBoolExp b (UnpreparedValue b)
forall (backend :: BackendType) field.
field -> GBoolExp backend field
IR.BoolField (AnnBoolExpFld b (UnpreparedValue b)
 -> AnnBoolExp b (UnpreparedValue b))
-> AnnBoolExpFld b (UnpreparedValue b)
-> AnnBoolExp b (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$
            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
              [Bool -> UnpreparedValue b -> OpExpG b (UnpreparedValue b)
forall (backend :: BackendType) field.
Bool -> field -> OpExpG backend field
IR.AEQ Bool
True (UnpreparedValue b -> OpExpG b (UnpreparedValue b))
-> UnpreparedValue b -> OpExpG b (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$ Maybe VariableInfo -> ColumnValue b -> UnpreparedValue b
forall (b :: BackendType).
Maybe VariableInfo -> ColumnValue b -> UnpreparedValue b
IR.UVParameter Maybe VariableInfo
forall a. Maybe a
Nothing (ColumnValue b -> UnpreparedValue b)
-> ColumnValue b -> UnpreparedValue b
forall a b. (a -> b) -> a -> b
$ ColumnType b -> ScalarValue b -> ColumnValue b
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue ColumnType b
columnType ScalarValue b
parsedValue]