server: forward null value to the remote schema when field type is nullable

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9460
Co-authored-by: Auke Booij <164426+abooij@users.noreply.github.com>
GitOrigin-RevId: 9449a679d66817d7bf9f401009a638b57cb58695

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

@@ -121,12 +121,22 @@ wrapFieldParser = \case
   G.TypeList (G.Nullability True) t -> nullableField . multipleField . wrapFieldParser t
   G.TypeList (G.Nullability False) t -> nonNullableField . multipleField . wrapFieldParser t
 
--- | Decorate a schema output type as NON_NULL
-nonNullableParser :: forall m origin a. Parser origin 'Output m a -> Parser origin 'Output m a
+-- | Decorate a schema type as NON_NULL.  Note that this is unsafe for
+-- 'Output parsers, in the sense that 'nonNullableParser' doesn't (and due to
+-- the polymorphic nature of the 'a' type parameter, can't) ensure that the
+-- provided parser provides a semantically non-null value.
+nonNullableParser :: forall m origin k a. Parser origin k m a -> Parser origin k m a
 nonNullableParser parser = parser {pType = nonNullableType (pType parser)}
 
--- | Make a schema output as nullable
-nullableParser :: forall m origin a. Parser origin 'Output m a -> Parser origin 'Output m a
+-- | Mark a schema type as nullable.  Syntactically speaking, this is the
+-- default, because the GraphQL spec explicitly requires use of ! to mark types
+-- as non-nullable.  But many constructions in our codebase are non-nullable by
+-- default, since this matches the Haskell type system better.
+--
+-- Note that this is unsafe for 'Input parsers, in the sense that
+-- 'nullableParser' doesn't ensure that the provided parser actually deals with
+-- 'null' input values.
+nullableParser :: forall m origin k a. Parser origin k m a -> Parser origin k m a
 nullableParser parser = parser {pType = nullableType (pType parser)}
 
 multiple :: forall m origin a. Parser origin 'Output m a -> Parser origin 'Output m a

server/src-lib/Hasura/GraphQL/Schema/Remote.hs

@@ -269,11 +269,10 @@ inputValueDefinitionParser schemaDoc (G.InputValueDefinition desc name fieldType
   where
     doNullability ::
       forall a k.
-      ('Input <: k) =>
       G.Nullability ->
-      Parser k n (Maybe a) ->
-      Parser k n (Maybe a)
-    doNullability (G.Nullability True) = fmap join . P.nullable
+      Parser k n a ->
+      Parser k n a
+    doNullability (G.Nullability True) = nullableParser
     doNullability (G.Nullability False) = id
 
     fieldConstructor ::

server/src-test/Hasura/GraphQL/Schema/RemoteSpec.hs

@@ -182,6 +182,7 @@ spec :: Spec
 spec = do
   testNoVarExpansionIfNoPreset
   testNoVarExpansionIfNoPresetUnlessTopLevelOptionalField
+  testNoVarExpansionIfNoPresetUnlessTopLevelOptionalFieldSendNullField
   testPartialVarExpansionIfPreset
   testVariableSubstitutionCollision
 
@@ -292,6 +293,41 @@ query($a: A) {
                      (J.Object $ KM.fromList [("b", J.Object $ KM.fromList [("c", J.Object $ KM.fromList [("i", J.Number 0)])])])
                )
 
+testNoVarExpansionIfNoPresetUnlessTopLevelOptionalFieldSendNullField :: Spec
+testNoVarExpansionIfNoPresetUnlessTopLevelOptionalFieldSendNullField = it "send null value in the input variable for nullable field" $ do
+  field <-
+    run
+      -- schema
+      [raw|
+scalar Int
+
+type Query {
+  test(a: Int): Int
+}
+|]
+      -- query
+      [raw|
+query ($a: Int) {
+  test(a: $a)
+}
+|]
+      -- variables
+      [raw|
+{
+  "a": null
+}
+|]
+  let arg = head $ HashMap.toList $ _fArguments field
+  arg
+    `shouldBe` ( _a,
+                 -- fieldOptional has peeled the variable; all we see is a JSON blob, and in doubt
+                 -- we repackage it as a newly minted JSON variable
+                 G.VVariable
+                   $ RemoteJSONValue
+                     (G.TypeNamed (G.Nullability True) _Int)
+                     (J.Null)
+               )
+
 testPartialVarExpansionIfPreset :: Spec
 testPartialVarExpansionIfPreset = it "presets cause partial var expansion" $ do
   field <-
@@ -426,3 +462,6 @@ _b = [G.name|b|]
 
 _x :: G.Name
 _x = [G.name|x|]
+
+_Int :: G.Name
+_Int = [G.name|Int|]