Enforce ListOf/Nullable wrapper kind safety and add tests

Agent-Logs-Url: https://github.com/fsprojects/FSharp.Data.GraphQL/sessions/7e806543-4139-4145-940a-64322cdd35cd

Co-authored-by: xperiandri <2365592+xperiandri@users.noreply.github.com>

Author: Copilot

src/FSharp.Data.GraphQL.Server.Relay/Connections.fs

@@ -159,13 +159,13 @@ module Definitions =
                 )
                 Define.AsyncField (
                     "startCursor",
-                    Nullable StringType,
+                    Nullable (StringType :> OutputDef<string>),
                     "When paginating backwards, the cursor to continue.",
                     fun _ pageInfo -> pageInfo.StartCursor
                 )
                 Define.AsyncField (
                     "endCursor",
-                    Nullable StringType,
+                    Nullable (StringType :> OutputDef<string>),
                     "When paginating forwards, the cursor to continue.",
                     fun _ pageInfo -> pageInfo.EndCursor
                 )
@@ -225,7 +225,7 @@ module Definitions =
             fields = [
                 Define.AsyncField (
                     "totalCount",
-                    Nullable IntType,
+                    Nullable (IntType :> OutputDef<int>),
                     """A count of the total number of objects in this connection, ignoring pagination. This allows a client to fetch the first five objects by passing \"5\" as the argument to `first`, then fetch the total count so it could display \"5 of 83\", for example. In cases where we employ infinite scrolling or don't have an exact count of entries, this field will return `null`.""",
                     fun _ conn -> conn.TotalCount
                 )
@@ -303,15 +303,19 @@ module Connection =
     /// </summary>
     /// <seealso cref="backwardArgs"/>
     /// <seealso cref="allArgs"/>
-    let forwardArgs = [ Define.Input ("first", Nullable IntType); Define.Input ("after", Nullable StringType) ]
+    let forwardArgs =
+        [ Define.Input ("first", Nullable (IntType :> InputDef<int>))
+          Define.Input ("after", Nullable (StringType :> InputDef<string>)) ]
 
     /// <summary>
     /// Argument definitions for backward pagination ("last" and "before").
     /// Use these when defining GraphQL fields that support backward-only pagination.
     /// </summary>
     /// <seealso cref="forwardArgs"/>
     /// <seealso cref="allArgs"/>
-    let backwardArgs = [ Define.Input ("last", Nullable IntType); Define.Input ("before", Nullable StringType) ]
+    let backwardArgs =
+        [ Define.Input ("last", Nullable (IntType :> InputDef<int>))
+          Define.Input ("before", Nullable (StringType :> InputDef<string>)) ]
 
     /// <summary>
     /// Complete set of argument definitions for bidirectional pagination.

src/FSharp.Data.GraphQL.Server/Schema.fs

@@ -152,14 +152,14 @@ type SchemaConfig =
             let args = [|
                 Define.Input(
                     "interval",
-                    Nullable IntType,
+                    Nullable (IntType :> InputDef<int>),
                     defaultValue = streamOptions.Interval,
                     description = "An optional argument used to buffer stream results. " +
                         "When it's value is greater than zero, stream results will be buffered for milliseconds equal to the value, then sent to the client. " +
                         "After that, starts buffering again until all results are streamed.")
                 Define.Input(
                     "preferredBatchSize",
-                    Nullable IntType,
+                    Nullable (IntType :> InputDef<int>),
                     defaultValue = streamOptions.PreferredBatchSize,
                     description = "An optional argument used to buffer stream results. " +
                         "When it's value is greater than zero, stream results will be buffered until item count reaches this value, then sent to the client. " +

src/FSharp.Data.GraphQL.Shared/Introspection.fs

@@ -90,8 +90,8 @@ let rec __Type =
         fieldsFn =
             fun () -> [
                 Define.Field ("kind", __TypeKind, (fun _ t -> t.Kind))
-                Define.Field ("name", Nullable StringType, resolve = (fun _ t -> t.Name))
-                Define.Field ("description", Nullable StringType, resolve = (fun _ t -> t.Description))
+                Define.Field ("name", Nullable (StringType :> OutputDef<string>), resolve = (fun _ t -> t.Name))
+                Define.Field ("description", Nullable (StringType :> OutputDef<string>), resolve = (fun _ t -> t.Description))
                 Define.Field (
                     "fields",
                     Nullable (ListOf __Field),
@@ -173,9 +173,9 @@ and __InputValue =
         fieldsFn =
             fun () -> [
                 Define.Field ("name", StringType, resolve = (fun _ f -> f.Name))
-                Define.Field ("description", Nullable StringType, resolve = (fun _ f -> f.Description))
+                Define.Field ("description", Nullable (StringType :> OutputDef<string>), resolve = (fun _ f -> f.Description))
                 Define.Field ("type", __Type, resolve = (fun _ f -> f.Type))
-                Define.Field ("defaultValue", Nullable StringType, (fun _ f -> f.DefaultValue))
+                Define.Field ("defaultValue", Nullable (StringType :> OutputDef<string>), (fun _ f -> f.DefaultValue))
             ]
     )
 
@@ -189,11 +189,11 @@ and __Field =
         fieldsFn =
             fun () -> [
                 Define.Field ("name", StringType, (fun _ f -> f.Name))
-                Define.Field ("description", Nullable StringType, (fun _ f -> f.Description))
+                Define.Field ("description", Nullable (StringType :> OutputDef<string>), (fun _ f -> f.Description))
                 Define.Field ("args", ListOf __InputValue, (fun _ f -> f.Args))
                 Define.Field ("type", __Type, (fun _ f -> f.Type))
                 Define.Field ("isDeprecated", BooleanType, resolve = (fun _ f -> f.IsDeprecated))
-                Define.Field ("deprecationReason", Nullable StringType, (fun _ f -> f.DeprecationReason))
+                Define.Field ("deprecationReason", Nullable (StringType :> OutputDef<string>), (fun _ f -> f.DeprecationReason))
             ]
     )
 
@@ -208,9 +208,9 @@ and __EnumValue =
         fieldsFn =
             fun () -> [
                 Define.Field ("name", StringType, resolve = (fun _ e -> e.Name))
-                Define.Field ("description", Nullable StringType, resolve = (fun _ e -> e.Description))
+                Define.Field ("description", Nullable (StringType :> OutputDef<string>), resolve = (fun _ e -> e.Description))
                 Define.Field ("isDeprecated", BooleanType, resolve = (fun _ e -> Option.isSome e.DeprecationReason))
-                Define.Field ("deprecationReason", Nullable StringType, resolve = (fun _ e -> e.DeprecationReason))
+                Define.Field ("deprecationReason", Nullable (StringType :> OutputDef<string>), resolve = (fun _ e -> e.DeprecationReason))
             ]
     )
 
@@ -231,8 +231,8 @@ and __Directive =
         fieldsFn =
             fun () -> [
                 Define.Field ("name", StringType, resolve = (fun _ directive -> directive.Name))
-                Define.Field ("description", Nullable StringType, resolve = (fun _ directive -> directive.Description))
-                Define.Field ("locations", ListOf __DirectiveLocation, resolve = (fun _ directive -> directive.Locations))
+                Define.Field ("description", Nullable (StringType :> OutputDef<string>), resolve = (fun _ directive -> directive.Description))
+                Define.Field ("locations", ListOf (__DirectiveLocation :> OutputDef<DirectiveLocation>), resolve = (fun _ directive -> directive.Locations))
                 Define.Field ("args", ListOf __InputValue, resolve = (fun _ directive -> directive.Args))
                 Define.Field (
                     "onOperation",

src/FSharp.Data.GraphQL.Shared/SchemaDefinitions.fs

@@ -392,17 +392,63 @@ module SchemaDefinitions =
             | false, _ -> getParseError destinationType s
         | InlineConstant value -> value.GetCoerceError destinationType
 
-    /// Wraps a GraphQL type definition, allowing defining field/argument
-    /// to take option of provided value.
-    let Nullable(innerDef : #TypeDef<'Val>) : NullableDef<'Val> = upcast { NullableDefinition.OfType = innerDef }
-
-    /// Wraps a GraphQL type definition, allowing defining field/argument
-    /// to take voption of provided value.
-    let StructNullable(innerDef : #TypeDef<'Val>) : StructNullableDef<'Val> = upcast { StructNullableDefinition.OfType = innerDef }
-
-    /// Wraps a GraphQL type definition, allowing defining field/argument
-    /// to take collection of provided value.
-    let ListOf(innerDef : #TypeDef<'Val>) : ListOfDef<'Val, 'Seq> = upcast { ListOfDefinition.OfType = innerDef }
+    type TypeWrapperDispatch =
+        static member Nullable<'Val>(innerDef : InputOutputDef<'Val>) : NullableDef<'Val> =
+            let ofType : TypeDef<'Val> = upcast innerDef
+            upcast { NullableDefinition.OfType = ofType }
+
+        static member Nullable<'Val>(innerDef : InputDef<'Val>) : InputDef<'Val option> =
+            let ofType : TypeDef<'Val> = upcast innerDef
+            upcast { NullableDefinition.OfType = ofType }
+
+        static member Nullable<'Val>(innerDef : OutputDef<'Val>) : OutputDef<'Val option> =
+            let ofType : TypeDef<'Val> = upcast innerDef
+            upcast { NullableDefinition.OfType = ofType }
+
+        static member StructNullable<'Val>(innerDef : InputOutputDef<'Val>) : StructNullableDef<'Val> =
+            let ofType : TypeDef<'Val> = upcast innerDef
+            upcast { StructNullableDefinition.OfType = ofType }
+
+        static member StructNullable<'Val>(innerDef : InputDef<'Val>) : InputDef<'Val voption> =
+            let ofType : TypeDef<'Val> = upcast innerDef
+            upcast { StructNullableDefinition.OfType = ofType }
+
+        static member StructNullable<'Val>(innerDef : OutputDef<'Val>) : OutputDef<'Val voption> =
+            let ofType : TypeDef<'Val> = upcast innerDef
+            upcast { StructNullableDefinition.OfType = ofType }
+
+        static member ListOf<'Val, 'Seq when 'Seq :> 'Val seq>(innerDef : InputOutputDef<'Val>) : ListOfDef<'Val, 'Seq> =
+            let ofType : TypeDef<'Val> = upcast innerDef
+            upcast { ListOfDefinition.OfType = ofType }
+
+        static member ListOf<'Val, 'Seq when 'Seq :> 'Val seq>(innerDef : InputDef<'Val>) : InputDef<'Seq> =
+            let ofType : TypeDef<'Val> = upcast innerDef
+            upcast { ListOfDefinition.OfType = ofType }
+
+        static member ListOf<'Val, 'Seq when 'Seq :> 'Val seq>(innerDef : OutputDef<'Val>) : OutputDef<'Seq> =
+            let ofType : TypeDef<'Val> = upcast innerDef
+            upcast { ListOfDefinition.OfType = ofType }
+
+    /// Wraps a GraphQL input or output type definition, allowing defining field/argument
+    /// to take option of provided value while preserving input/output kind of wrapped type.
+    let inline Nullable< ^Def, ^Wrapped when (^Def or TypeWrapperDispatch) : (static member Nullable : ^Def -> ^Wrapped) >
+        (innerDef : ^Def)
+        : ^Wrapped =
+        ((^Def or TypeWrapperDispatch) : (static member Nullable : ^Def -> ^Wrapped) innerDef)
+
+    /// Wraps a GraphQL input or output type definition, allowing defining field/argument
+    /// to take voption of provided value while preserving input/output kind of wrapped type.
+    let inline StructNullable< ^Def, ^Wrapped when (^Def or TypeWrapperDispatch) : (static member StructNullable : ^Def -> ^Wrapped) >
+        (innerDef : ^Def)
+        : ^Wrapped =
+        ((^Def or TypeWrapperDispatch) : (static member StructNullable : ^Def -> ^Wrapped) innerDef)
+
+    /// Wraps a GraphQL input or output type definition, allowing defining field/argument
+    /// to take collection of provided value while preserving input/output kind of wrapped type.
+    let inline ListOf< ^Def, ^Wrapped when (^Def or TypeWrapperDispatch) : (static member ListOf : ^Def -> ^Wrapped) >
+        (innerDef : ^Def)
+        : ^Wrapped =
+        ((^Def or TypeWrapperDispatch) : (static member ListOf : ^Def -> ^Wrapped) innerDef)
 
     let internal variableOrElse other (_ : InputExecutionContextProvider) value (variables : IReadOnlyDictionary<string, obj>)  =
         match value with
@@ -1415,13 +1461,14 @@ module SchemaDefinitions =
         /// <param name="defaultValue">If defined, this value will be used when no matching input has been provided by the requester.</param>
         /// <param name="description">Optional input description. Usefull for generating documentation.</param>
         static member SkippableInput(name : string, typedef : #InputDef<'In>, ?description : string) : InputFieldDef =
+            let typedef : InputDef<'In> = upcast typedef
             upcast { InputFieldDefinition.Name = name
                      Description = description |> Option.map (fun s -> s + " Skip this field if you want to avoid saving it")
                      IsSkippable = true
                      TypeDef =
-                        match (box typedef) with
-                        | :? NullableDef<'In> as n -> n
-                        | _ -> Nullable typedef
+                         match (box typedef) with
+                         | :? NullableDef<'In> as n -> (n :> InputDef<'In option>)
+                         | _ -> Nullable typedef
                      DefaultValue = None
                      ExecuteInput = Unchecked.defaultof<ExecuteInput> }
 
@@ -1539,4 +1586,3 @@ module SchemaDefinitions =
                      Description = description
                      FieldsFn = fun () -> fieldsFn() |> List.toArray
                      ResolveType = resolveType }
-

src/FSharp.Data.GraphQL.Shared/SchemaDefinitionsExtensions.fs

@@ -27,8 +27,8 @@ type internal CustomFieldsObjectDefinition<'Val> (source : ObjectDef<'Val>, fiel
         member _.Implements = source.Implements
         member _.IsTypeOf = source.IsTypeOf
     interface TypeDef with
-        member this.MakeList () = upcast (ListOf this)
-        member this.MakeNullable () = upcast (Nullable this)
+        member this.MakeList () = upcast { ListOfDefinition.OfType = this }
+        member this.MakeNullable () = upcast { NullableDefinition.OfType = this }
         member _.Type = (source :> TypeDef).Type
     interface NamedDef with
         member _.Name = (source :> NamedDef).Name

src/FSharp.Data.GraphQL.Shared/TypeSystem.fs

@@ -609,6 +609,21 @@ and OutputDef<'Val> =
         inherit TypeDef<'Val>
     end
 
+/// Representation of all type definitions, that can be used as both inputs and outputs.
+and InputOutputDef =
+    interface
+        inherit InputDef
+        inherit OutputDef
+    end
+
+/// Representation of all type definitions, that can be used as both inputs and outputs.
+and InputOutputDef<'Val> =
+    interface
+        inherit InputOutputDef
+        inherit InputDef<'Val>
+        inherit OutputDef<'Val>
+    end
+
 /// Representation of leaf type definitions. Leaf types represents leafs
 /// of the GraphQL query tree. Each query path must end with a leaf.
 /// By default only scalars and enums are valid leaf types.
@@ -1067,8 +1082,7 @@ and ScalarDef =
         abstract CoerceOutput : obj -> obj option
         inherit TypeDef
         inherit NamedDef
-        inherit InputDef
-        inherit OutputDef
+        inherit InputOutputDef
         inherit LeafDef
     end
 
@@ -1098,6 +1112,7 @@ and [<CustomEquality; NoComparison>] ScalarDefinition<'Primitive, 'Val> = {
 
     interface InputDef
     interface OutputDef
+    interface InputOutputDef
 
     interface ScalarDef with
         member x.Name = x.Name
@@ -1107,6 +1122,7 @@ and [<CustomEquality; NoComparison>] ScalarDefinition<'Primitive, 'Val> = {
 
     interface InputDef<'Val>
     interface OutputDef<'Val>
+    interface InputOutputDef<'Val>
     interface LeafDef
 
     interface NamedDef with
@@ -1182,8 +1198,7 @@ and EnumDef =
         /// List of available enum cases.
         abstract Options : EnumVal[]
         inherit TypeDef
-        inherit InputDef
-        inherit OutputDef
+        inherit InputOutputDef
         inherit LeafDef
         inherit NamedDef
     end
@@ -1197,8 +1212,7 @@ and EnumDef<'Val> =
         abstract Options : EnumValue<'Val>[]
         inherit EnumDef
         inherit TypeDef<'Val>
-        inherit InputDef<'Val>
-        inherit OutputDef<'Val>
+        inherit InputOutputDef<'Val>
     end
 
 and internal EnumDefinition<'Val> = {
@@ -1212,6 +1226,7 @@ and internal EnumDefinition<'Val> = {
 
     interface InputDef
     interface OutputDef
+    interface InputOutputDef
 
     interface TypeDef with
         member _.Type = typeof<'Val>
@@ -1523,8 +1538,7 @@ and ListOfDef<'Val, 'Seq when 'Seq :> 'Val seq> =
         /// GraphQL type definition of the container element type.
         abstract OfType : TypeDef<'Val>
         inherit TypeDef<'Seq>
-        inherit InputDef<'Seq>
-        inherit OutputDef<'Seq>
+        inherit InputOutputDef<'Seq>
         inherit ListOfDef
     end
 
@@ -1574,8 +1588,7 @@ and NullableDef<'Val> =
     interface
         /// GraphQL type definition of the nested type.
         abstract OfType : TypeDef<'Val>
-        inherit InputDef<'Val option>
-        inherit OutputDef<'Val option>
+        inherit InputOutputDef<'Val option>
         inherit NullableDef
     end
 
@@ -1614,8 +1627,7 @@ and StructNullableDef<'Val> =
     interface
         /// GraphQL type definition of the nested type.
         abstract OfType : TypeDef<'Val>
-        inherit InputDef<'Val voption>
-        inherit OutputDef<'Val voption>
+        inherit InputOutputDef<'Val voption>
         inherit NullableDef
     end
 

tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj

@@ -41,6 +41,7 @@
     <Compile Include="UnionInterfaceTests.fs" />
     <Compile Include="DirectivesTests.fs" />
     <Compile Include="TypeValidationTests.fs" />
+    <Compile Include="TypeWrappersKindSafetyTests.fs" />
     <Compile Include="AstValidationTests.fs" />
     <Compile Include="ParserTests.fs" />
     <Compile Include="SchemaTests.fs" />

tests/FSharp.Data.GraphQL.Tests/PlanningTests.fs

@@ -139,7 +139,7 @@ let ``Planning must retain correct types for lists``() =
             }
         }
     }"""
-    let PersonList : ListOfDef<Person, Person list> = ListOf Person
+    let PersonList : OutputDef<Person list> = ListOf Person
     let plan = schemaProcessor.CreateExecutionPlanOrFail(query)
     equals 1 plan.Fields.Length
     let listInfo = plan.Fields.Head
@@ -178,7 +178,7 @@ let ``Planning must work with interfaces``() =
     }"""
     let plan = schemaProcessor.CreateExecutionPlanOrFail(query)
     equals 1 plan.Fields.Length
-    let INamedList : ListOfDef<obj, obj list> = ListOf INamed
+    let INamedList : OutputDef<obj list> = ListOf INamed
     let listInfo = plan.Fields.Head
     listInfo.Identifier |> equals "names"
     listInfo.ReturnDef |> equals (upcast INamedList)
@@ -215,7 +215,7 @@ let ``Planning must work with unions``() =
     let plan = schemaProcessor.CreateExecutionPlanOrFail(query)
     equals 1 plan.Fields.Length
     let listInfo = plan.Fields.Head
-    let UNamedList : ListOfDef<Named, Named list> = ListOf UNamed
+    let UNamedList : OutputDef<Named list> = ListOf UNamed
     listInfo.Identifier |> equals "names"
     listInfo.ReturnDef |> equals (upcast UNamedList)
     let (ResolveCollection(info)) = listInfo.Kind
@@ -309,7 +309,7 @@ let ``Planning must handle inline fragment with non-matching type condition in u
     // Verify the execution plan structure
     equals 1 plan.Fields.Length
     let listInfo = plan.Fields.Head
-    let UNamedList : ListOfDef<Named, Named list> = ListOf UNamed
+    let UNamedList : OutputDef<Named list> = ListOf UNamed
     listInfo.Identifier |> equals "names"
     listInfo.ReturnDef |> equals (upcast UNamedList)
     let (ResolveCollection(info)) = listInfo.Kind