Improve relationship nullability and joins without LATERAL (closes #8977)

server/lib/schema-parsers/src/Hasura/GraphQL/Parser/DirectiveName.hs

@@ -8,6 +8,9 @@ module Hasura.GraphQL.Parser.DirectiveName
     _skip,
     _ttl,
     __multiple_top_level_fields,
+    _overrideTo,
+    _lateral,
+    _nullable,
   )
 where
 
@@ -34,3 +37,12 @@ _ttl = [G.name|ttl|]
 
 __multiple_top_level_fields :: G.Name
 __multiple_top_level_fields = [G.name|_multiple_top_level_fields|]
+
+_overrideTo :: G.Name
+_overrideTo = [G.name|override_to|]
+
+_lateral :: G.Name
+_lateral = [G.name|lateral|]
+
+_nullable :: G.Name
+_nullable = [G.name|nullable|]

server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Directives.hs

@@ -6,12 +6,17 @@ module Hasura.GraphQL.Parser.Directives
     customDirectives,
     -- Custom Directive Types
     CachedDirective (..),
+    extractDirectives,
+    getDirective,
     DirectiveMap,
+    ParsedDirectives,
     -- lookup keys for directives
     include,
     skip,
     cached,
     multipleRootFields,
+    nullableJoin,
+    lateralJoin,
     -- parsing utilities
     parseDirectives,
     withDirective,
@@ -22,6 +27,8 @@ module Hasura.GraphQL.Parser.Directives
     includeDirective,
     cachedDirective,
     multipleRootFieldsDirective,
+    nullableDirective,
+    lateralDirective,
   )
 where
 
@@ -35,9 +42,12 @@ import Data.Functor.Identity (Identity (..))
 import Data.GADT.Compare.Extended
 import Data.HashMap.Strict qualified as HashMap
 import Data.HashSet qualified as S
+import Data.Hashable (Hashable)
 import Data.List qualified as L
+import Data.Maybe (mapMaybe)
 import Data.Traversable (for)
-import Data.Typeable (eqT)
+import Data.Typeable (Typeable, cast, eqT)
+import GHC.Generics (Generic)
 import Hasura.Base.ToErrorValue
 import Hasura.GraphQL.Parser.Class
 import Hasura.GraphQL.Parser.DirectiveName qualified as Name
@@ -46,7 +56,7 @@ import Hasura.GraphQL.Parser.Internal.Scalars
 import Hasura.GraphQL.Parser.Schema
 import Hasura.GraphQL.Parser.Variable
 import Language.GraphQL.Draft.Syntax qualified as G
-import Type.Reflection (Typeable, typeRep, (:~:) (Refl))
+import Type.Reflection (typeRep, (:~:) (Refl))
 import Witherable (catMaybes)
 import Prelude
 
@@ -91,7 +101,7 @@ inclusionDirectives :: forall m origin. (MonadParse m) => [Directive origin m]
 inclusionDirectives = [includeDirective @m, skipDirective @m]
 
 customDirectives :: forall m origin. (MonadParse m) => [Directive origin m]
-customDirectives = [cachedDirective @m, multipleRootFieldsDirective @m]
+customDirectives = [cachedDirective @m, multipleRootFieldsDirective @m, nullableDirective @m, lateralDirective @m]
 
 -- | Parses directives, given a location. Ensures that all directives are known
 -- and match the location; subsequently builds a dependent map of the results,
@@ -241,6 +251,36 @@ include = DirectiveKey Name._include
 ifArgument :: (MonadParse m) => InputFieldsParser origin m Bool
 ifArgument = field Name._if Nothing boolean
 
+-- Table relationships customization
+nullableDirective :: forall m origin. (MonadParse m) => Directive origin m
+nullableDirective =
+  mkDirective
+    Name._nullable -- Directive name
+    (Just "whether the JOIN allows null values (LEFT JOIN) or not (INNER JOIN)") -- Description
+    True -- Advertised in schema
+    [G.DLExecutable G.EDLFIELD]
+    (overrideToArgument False)
+    False -- Not repeatable
+
+lateralDirective :: forall m origin. (MonadParse m) => Directive origin m
+lateralDirective =
+  mkDirective
+    Name._lateral -- Directive name
+    (Just "whether the JOIN is LATERAL. Only works on Object Relationships") -- Description
+    True -- Advertised in schema
+    [G.DLExecutable G.EDLFIELD]
+    (overrideToArgument False)
+    False -- Not repeatable
+
+nullableJoin :: DirectiveKey Bool
+nullableJoin = DirectiveKey Name._nullable
+
+lateralJoin :: DirectiveKey Bool
+lateralJoin = DirectiveKey Name._lateral
+
+overrideToArgument :: (MonadParse m) => Bool -> InputFieldsParser origin m Bool
+overrideToArgument defaultValue = fieldWithDefault Name._overrideTo Nothing (G.VBoolean defaultValue) boolean
+
 -- Parser type for directives.
 
 data Directive origin m where
@@ -275,6 +315,34 @@ instance GCompare DirectiveKey where
 
 type DirectiveMap = DM.DMap DirectiveKey Identity
 
+type ParsedDirectives = HashMap.HashMap G.Name DirectiveData
+
+data DirectiveData
+  = NullableData Bool
+  | LateralData Bool
+  deriving (Generic, Show)
+
+instance Hashable DirectiveData
+
+deriving instance Eq DirectiveData
+
+extractDirectives :: DirectiveMap -> ParsedDirectives
+extractDirectives dmap = HashMap.fromList $ mapMaybe extractPair $ DM.toList dmap
+  where
+    extractPair :: DSum DirectiveKey Identity -> Maybe (G.Name, DirectiveData)
+    extractPair (DirectiveKey name :=> Identity value) =
+      case cast value of
+        Just nullableVal | name == Name._nullable -> Just (name, NullableData nullableVal)
+        Just lateralVal | name == Name._lateral -> Just (name, LateralData lateralVal)
+        _ -> Nothing
+
+getDirective :: (Typeable a) => G.Name -> ParsedDirectives -> Maybe a
+getDirective name directives = do
+  directiveData <- HashMap.lookup name directives
+  case directiveData of
+    NullableData val -> cast val
+    LateralData val -> cast val
+
 mkDirective ::
   (MonadParse m, Typeable a) =>
   G.Name ->

server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Internal/Parser.hs

@@ -397,7 +397,19 @@ rawSelection name description argumentsParser resultParser =
     { fDefinition =
         Definition name description Nothing [] $
           FieldInfo (ifDefinitions argumentsParser) (pType resultParser),
-      fParser = \Field {_fAlias, _fArguments, _fSelectionSet} -> do
+      fParser = \Field {_fAlias, _fArguments, _fSelectionSet, _fDirectives} -> do
+        dirMap <- parseDirectives customDirectives (DLExecutable EDLFIELD) _fDirectives
+
+        -- If the directive is present but this is not a selectionSet (Array or Object type), throw an error
+        withDirective dirMap nullableJoin $ \maybeDirective ->
+          case maybeDirective of
+            Just _ -> parseError $ "The @nullable directive can only be used on fields with selection sets (objects or arrays)"
+            Nothing -> pure ()
+        withDirective dirMap lateralJoin $ \maybeDirective ->
+          case maybeDirective of
+            Just _ -> parseError $ "The @lateral directive can only be used on object relationship fields"
+            Nothing -> pure ()
+
         unless (null _fSelectionSet) $
           parseError "unexpected subselection set for non-object field"
         -- check for extraneous arguments here, since the InputFieldsParser just
@@ -434,11 +446,11 @@ subselection ::
   InputFieldsParser origin m a ->
   -- | parser for the subselection set
   Parser origin 'Output m b ->
-  FieldParser origin m (a, b)
+  FieldParser origin m (a, b, ParsedDirectives)
 {-# INLINE subselection #-}
 subselection name description argumentsParser bodyParser =
   rawSubselection name description argumentsParser bodyParser
-    <&> \(_alias, _args, a, b) -> (a, b)
+    <&> \(_alias, _args, a, b, directives) -> (a, b, directives)
 
 rawSubselection ::
   forall m origin a b.
@@ -449,21 +461,35 @@ rawSubselection ::
   InputFieldsParser origin m a ->
   -- | parser for the subselection set
   Parser origin 'Output m b ->
-  FieldParser origin m (Maybe Name, HashMap Name (Value Variable), a, b)
+  FieldParser origin m (Maybe Name, HashMap Name (Value Variable), a, b, ParsedDirectives)
 {-# INLINE rawSubselection #-}
 rawSubselection name description argumentsParser bodyParser =
   FieldParser
     { fDefinition =
         Definition name description Nothing [] $
           FieldInfo (ifDefinitions argumentsParser) (pType bodyParser),
-      fParser = \Field {_fAlias, _fArguments, _fSelectionSet} -> do
+      fParser = \Field {_fAlias, _fArguments, _fSelectionSet, _fDirectives} -> do
+        dirMap <- parseDirectives customDirectives (DLExecutable EDLFIELD) _fDirectives
+
+        hasLateralDirective <- withDirective dirMap lateralJoin $ pure . Maybe.isJust
+        when hasLateralDirective $ do
+          let fieldType = pType bodyParser
+          let isArrayType = case fieldType of
+                TList _ _ -> True
+                _ -> False
+
+          when isArrayType $
+            parseError $
+              "The @lateral directive cannot be used on array relationship fields"
+
         -- check for extraneous arguments here, since the InputFieldsParser just
         -- handles parsing the fields it cares about
         for_ (HashMap.keys _fArguments) \argumentName ->
           unless (argumentName `S.member` argumentNames) $
             parseError $
               toErrorValue name <> " has no argument named " <> toErrorValue argumentName
-        (_fAlias,_fArguments,,)
+        let parsedDirectives = extractDirectives dirMap
+        (_fAlias,_fArguments,,,parsedDirectives)
           <$> withKey (Key "args") (ifParser argumentsParser $ GraphQLValue <$> _fArguments)
           <*> pParser bodyParser _fSelectionSet
     }
@@ -488,7 +514,8 @@ subselection_ ::
   Maybe Description ->
   -- | parser for the subselection set
   Parser origin 'Output m a ->
-  FieldParser origin m a
+  FieldParser origin m (a, ParsedDirectives)
 {-# INLINE subselection_ #-}
 subselection_ name description bodyParser =
-  snd <$> subselection name description (pure ()) bodyParser
+  rawSubselection name description (pure ()) bodyParser
+    <&> \(_alias, _args, (), result, directives) -> (result, directives)

server/src-lib/Hasura/Backends/BigQuery/Instances/Schema.hs

@@ -429,14 +429,15 @@ bqComputedField ComputedFieldInfo {..} tableName tableInfo = runMaybeT do
       let fieldArgsParser = liftA2 (,) functionArgsParser selectArgsParser
       pure
         $ P.subselection fieldName fieldDescription fieldArgsParser selectionSetParser
-        <&> \((functionArgs', args), fields) ->
+        <&> \((functionArgs', args), fields, directives) ->
           IR.AFComputedField _cfiXComputedFieldInfo _cfiName
             $ IR.CFSTable JASMultipleRows
             $ IR.AnnSelectG
               { IR._asnFields = fields,
                 IR._asnFrom = IR.FromFunction (_cffName _cfiFunction) functionArgs' Nothing,
                 IR._asnPerm = tablePermissionsInfo returnTablePermissions,
                 IR._asnArgs = args,
+                IR._asnDirectives = (Just directives),
                 IR._asnStrfyNum = stringifyNumbers,
                 IR._asnNamingConvention = Nothing
               }
@@ -456,14 +457,15 @@ bqComputedField ComputedFieldInfo {..} tableName tableInfo = runMaybeT do
           <&> parsedSelectionsToFields IR.AFExpression
       pure
         $ P.subselection fieldName fieldDescription functionArgsParser selectionSetParser
-        <&> \(functionArgs', fields) ->
+        <&> \(functionArgs', fields, directives) ->
           IR.AFComputedField _cfiXComputedFieldInfo _cfiName
             $ IR.CFSTable JASMultipleRows
             $ IR.AnnSelectG
               { IR._asnFields = fields,
                 IR._asnFrom = IR.FromFunction (_cffName _cfiFunction) functionArgs' Nothing,
                 IR._asnPerm = IR.noTablePermissions,
                 IR._asnArgs = IR.noSelectArgs,
+                IR._asnDirectives = (Just directives),
                 IR._asnStrfyNum = stringifyNumbers,
                 IR._asnNamingConvention = Nothing
               }

server/src-lib/Hasura/Backends/DataConnector/Adapter/Schema.hs

@@ -205,12 +205,13 @@ selectFunction mkRootFieldName [email protected] {..} description = runMaybeT
         functionFieldName = RQL.runMkRootFieldName mkRootFieldName _fiGQLName
     pure
       $ P.subselection functionFieldName description argsParser selectionSetParser
-      <&> \((funcArgs, tableArgs''), fields) ->
+      <&> \((funcArgs, tableArgs''), fields, directives) ->
         IR.AnnSelectG
           { IR._asnFields = fields,
             IR._asnFrom = IR.FromFunction _fiSQLName funcArgs Nothing,
             IR._asnPerm = GS.C.tablePermissionsInfo selectPermissions,
             IR._asnArgs = tableArgs'',
+            IR._asnDirectives = (Just directives),
             IR._asnStrfyNum = stringifyNumbers,
             IR._asnNamingConvention = Just tCase
           }
@@ -439,7 +440,7 @@ updateCustomOp (API.UpdateColumnOperatorName operatorName) operatorUsages = GS.U
             argumentType <-
               ( HashMap.lookup columnScalarType operatorUsages
                   <&> (\API.UpdateColumnOperatorDefinition {..} -> RQL.ColumnScalar $ Witch.from _ucodArgumentType)
-                )
+              )
                 -- This shouldn't happen 😬 because updateOperatorApplicableColumn should protect this
                 -- parser from being used with unsupported column types
                 `onNothing` throw500 ("updateOperatorParser: Unable to find argument type for update column operator " <> toTxt operatorName <> " used with column scalar type " <> toTxt columnScalarType)

server/src-lib/Hasura/Backends/MSSQL/FromIr/MutationResponse.hs

@@ -50,7 +50,7 @@ mkMutationOutputSelect stringifyNum withAlias = \case
       IR.Fields (IR.AnnFieldG 'MSSQL Void Expression) ->
       FromIr Select
     mkSelect jsonAggSelect annFields = do
-      let annSelect = IR.AnnSelectG annFields (IR.FromIdentifier $ IR.FIIdentifier withAlias) IR.noTablePermissions IR.noSelectArgs stringifyNum Nothing
+      let annSelect = IR.AnnSelectG annFields (IR.FromIdentifier $ IR.FIIdentifier withAlias) IR.noTablePermissions IR.noSelectArgs Nothing stringifyNum Nothing
       fromSelect jsonAggSelect annSelect
 
     -- SELECT COUNT(*) AS "count" FROM [with_alias]

server/src-lib/Hasura/Backends/MSSQL/FromIr/Query.hs

@@ -205,6 +205,7 @@ fromRemoteRelationFieldsG existingJoins joinColumns (IR.FieldName name, field) =
         (IR.RelName $ mkNonEmptyTextUnsafe name)
         joinColumns
         IR.Nullable
+        Nothing
         annotatedRelationship
 
 -- | Top/root-level 'Select'. All descendent/sub-translations are collected to produce a root TSQL.Select.
@@ -280,7 +281,7 @@ mkNodesSelect Args {..} foreignKeyConditions filterExpression permissionBasedTop
             aliasedAlias = IR.getFieldNameTxt fieldName
           }
     )
-    | (index, (fieldName, fieldSources)) <- nodes
+  | (index, (fieldName, fieldSources)) <- nodes
   ]
 
 --
@@ -335,7 +336,7 @@ mkAggregateSelect Args {..} foreignKeyConditions filterExpression selectFrom agg
             aliasedAlias = IR.getFieldNameTxt fieldName
           }
     )
-    | (index, (fieldName, projections)) <- aggregates
+  | (index, (fieldName, projections)) <- aggregates
   ]
 
 fromNativeQuery :: IR.NativeQuery 'MSSQL Expression -> FromIr TSQL.From

server/src-lib/Hasura/Backends/Postgres/Execute/Mutation.hs

@@ -312,7 +312,7 @@ mutateAndFetchCols userInfo qt cols (cte, p) strfyNum tCase = do
       <$> mkSQLSelect
         userInfo
         JASMultipleRows
-        ( AnnSelectG selFlds tabFrom tabPerm noSelectArgs strfyNum tCase
+        ( AnnSelectG selFlds tabFrom tabPerm noSelectArgs Nothing strfyNum tCase
         )
   let selectWith =
         S.SelectWith
@@ -473,9 +473,9 @@ validateDeleteMutation env manager logger userInfo resolvedWebHook confHeaders t
           --     id
           --    }
           -- }
-          do
-            let deleteInputValByPk = J.object ["pk_columns" J..= deleteInputVal]
-            return (J.object ["input" J..= [deleteInputValByPk]])
+            do
+              let deleteInputValByPk = J.object ["pk_columns" J..= deleteInputVal]
+              return (J.object ["input" J..= [deleteInputValByPk]])
           else return (J.object ["input" J..= [deleteInputVal]])
       Nothing -> return J.Null
   validateMutation env manager logger userInfo resolvedWebHook confHeaders timeout forwardClientHeaders reqHeaders inputData headerPrecedence