Skip to content

Commit 1506a22

Browse files
Copilotxperiandri
Copilot
and
xperiandri
committed
Enforce input/output kind safety for ListOf/Nullable wrappers at compile time (fsprojects#569)
Co-authored-by: xperiandri <2365592+xperiandri@users.noreply.github.com> Co-authored-by: copilot-swe-agent[bot] <198982749+Copilot@users.noreply.github.com> Co-authored-by: Andrii Chebukin <XperiAndri@Outlook.com>
1 parent 66b743b commit 1506a22

16 files changed

Lines changed: 354 additions & 35 deletions

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

Lines changed: 71 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -392,17 +392,73 @@ module SchemaDefinitions =
392392
| false, _ -> getParseError destinationType s
393393
| InlineConstant value -> value.GetCoerceError destinationType
394394

395-
/// Wraps a GraphQL type definition, allowing defining field/argument
396-
/// to take option of provided value.
397-
let Nullable(innerDef : #TypeDef<'Val>) : NullableDef<'Val> = upcast { NullableDefinition.OfType = innerDef }
398-
399-
/// Wraps a GraphQL type definition, allowing defining field/argument
400-
/// to take voption of provided value.
401-
let StructNullable(innerDef : #TypeDef<'Val>) : StructNullableDef<'Val> = upcast { StructNullableDefinition.OfType = innerDef }
402-
403-
/// Wraps a GraphQL type definition, allowing defining field/argument
404-
/// to take collection of provided value.
405-
let ListOf(innerDef : #TypeDef<'Val>) : ListOfDef<'Val, 'Seq> = upcast { ListOfDefinition.OfType = innerDef }
395+
type TypeWrapperStaticDispatch =
396+
397+
static member Nullable<'Val>(innerDef : InputOutputDef<'Val>) : NullableDef<'Val> =
398+
let ofType : TypeDef<'Val> = upcast innerDef
399+
upcast { NullableDefinition.OfType = ofType }
400+
401+
static member Nullable<'Val>(innerDef : InputDef<'Val>) : InputDef<'Val option> =
402+
let ofType : TypeDef<'Val> = upcast innerDef
403+
upcast { NullableDefinition.OfType = ofType }
404+
405+
static member Nullable<'Val>(innerDef : OutputDef<'Val>) : OutputDef<'Val option> =
406+
let ofType : TypeDef<'Val> = upcast innerDef
407+
upcast { NullableDefinition.OfType = ofType }
408+
409+
static member StructNullable<'Val>(innerDef : InputOutputDef<'Val>) : StructNullableDef<'Val> =
410+
let ofType : TypeDef<'Val> = upcast innerDef
411+
upcast { StructNullableDefinition.OfType = ofType }
412+
413+
static member StructNullable<'Val>(innerDef : InputDef<'Val>) : InputDef<'Val voption> =
414+
let ofType : TypeDef<'Val> = upcast innerDef
415+
upcast { StructNullableDefinition.OfType = ofType }
416+
417+
static member StructNullable<'Val>(innerDef : OutputDef<'Val>) : OutputDef<'Val voption> =
418+
let ofType : TypeDef<'Val> = upcast innerDef
419+
upcast { StructNullableDefinition.OfType = ofType }
420+
421+
static member ListOf<'Val, 'Seq when 'Seq :> 'Val seq>(innerDef : InputOutputDef<'Val>) : ListOfDef<'Val, 'Seq> =
422+
let ofType : TypeDef<'Val> = upcast innerDef
423+
upcast { ListOfDefinition.OfType = ofType }
424+
425+
static member ListOf<'Val, 'Seq when 'Seq :> 'Val seq>(innerDef : InputDef<'Val>) : InputDef<'Seq> =
426+
let ofType : TypeDef<'Val> = upcast innerDef
427+
upcast { ListOfDefinition.OfType = ofType }
428+
429+
static member ListOf<'Val, 'Seq when 'Seq :> 'Val seq>(innerDef : OutputDef<'Val>) : OutputDef<'Seq> =
430+
let ofType : TypeDef<'Val> = upcast innerDef
431+
upcast { ListOfDefinition.OfType = ofType }
432+
433+
/// Wraps a GraphQL input or output type definition, allowing defining field/argument
434+
/// to take option of provided value while preserving input/output kind of wrapped type.
435+
/// Input wrappers produce input definitions, output wrappers produce output definitions,
436+
/// and wrappers over types implementing both kinds keep both capabilities.
437+
/// Dispatch is selected at compile time via SRTP.
438+
let inline Nullable< ^Def, ^Wrapped when (^Def or TypeWrapperStaticDispatch) : (static member Nullable : ^Def -> ^Wrapped) >
439+
(innerDef : ^Def)
440+
: ^Wrapped =
441+
((^Def or TypeWrapperStaticDispatch) : (static member Nullable : ^Def -> ^Wrapped) innerDef)
442+
443+
/// Wraps a GraphQL input or output type definition, allowing defining field/argument
444+
/// to take voption of provided value while preserving input/output kind of wrapped type.
445+
/// Input wrappers produce input definitions, output wrappers produce output definitions,
446+
/// and wrappers over types implementing both kinds keep both capabilities.
447+
/// Dispatch is selected at compile time via SRTP.
448+
let inline StructNullable< ^Def, ^Wrapped when (^Def or TypeWrapperStaticDispatch) : (static member StructNullable : ^Def -> ^Wrapped) >
449+
(innerDef : ^Def)
450+
: ^Wrapped =
451+
((^Def or TypeWrapperStaticDispatch) : (static member StructNullable : ^Def -> ^Wrapped) innerDef)
452+
453+
/// Wraps a GraphQL input or output type definition, allowing defining field/argument
454+
/// to take collection of provided value while preserving input/output kind of wrapped type.
455+
/// Input wrappers produce input definitions, output wrappers produce output definitions,
456+
/// and wrappers over types implementing both kinds keep both capabilities.
457+
/// Dispatch is selected at compile time via SRTP.
458+
let inline ListOf< ^Def, ^Wrapped when (^Def or TypeWrapperStaticDispatch) : (static member ListOf : ^Def -> ^Wrapped) >
459+
(innerDef : ^Def)
460+
: ^Wrapped =
461+
((^Def or TypeWrapperStaticDispatch) : (static member ListOf : ^Def -> ^Wrapped) innerDef)
406462

407463
let internal variableOrElse other (_ : InputExecutionContextProvider) value (variables : IReadOnlyDictionary<string, obj>) =
408464
match value with
@@ -1415,13 +1471,14 @@ module SchemaDefinitions =
14151471
/// <param name="defaultValue">If defined, this value will be used when no matching input has been provided by the requester.</param>
14161472
/// <param name="description">Optional input description. Usefull for generating documentation.</param>
14171473
static member SkippableInput(name : string, typedef : #InputDef<'In>, ?description : string) : InputFieldDef =
1474+
let typedef : InputDef<'In> = upcast typedef
14181475
upcast { InputFieldDefinition.Name = name
14191476
Description = description |> Option.map (fun s -> s + " Skip this field if you want to avoid saving it")
14201477
IsSkippable = true
14211478
TypeDef =
1422-
match (box typedef) with
1423-
| :? NullableDef<'In> as n -> n
1424-
| _ -> Nullable typedef
1479+
match (box typedef) with
1480+
| :? NullableDef<'In> as n -> (n :> InputDef<'In option>)
1481+
| _ -> Nullable typedef
14251482
DefaultValue = None
14261483
ExecuteInput = Unchecked.defaultof<ExecuteInput> }
14271484

@@ -1539,4 +1596,3 @@ module SchemaDefinitions =
15391596
Description = description
15401597
FieldsFn = fun () -> fieldsFn() |> List.toArray
15411598
ResolveType = resolveType }
1542-

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

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,10 @@ type internal CustomFieldsObjectDefinition<'Val> (source : ObjectDef<'Val>, fiel
2727
member _.Implements = source.Implements
2828
member _.IsTypeOf = source.IsTypeOf
2929
interface TypeDef with
30-
member this.MakeList () = upcast (ListOf this)
31-
member this.MakeNullable () = upcast (Nullable this)
30+
// We construct wrappers directly here because this API works with untyped TypeDef values.
31+
// The public ListOf/Nullable helpers use SRTP dispatch and require statically known direction.
32+
member this.MakeList () = upcast { ListOfDefinition.OfType = this }
33+
member this.MakeNullable () = upcast { NullableDefinition.OfType = this }
3234
member _.Type = (source :> TypeDef).Type
3335
interface NamedDef with
3436
member _.Name = (source :> NamedDef).Name

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

Lines changed: 27 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -609,6 +609,24 @@ and OutputDef<'Val> =
609609
inherit TypeDef<'Val>
610610
end
611611

612+
/// Representation of type definitions that can be used as both inputs and outputs
613+
/// (for example scalars and enums). This marker is also used by SRTP wrapper dispatch.
614+
and InputOutputDef =
615+
interface
616+
inherit InputDef
617+
inherit OutputDef
618+
end
619+
620+
/// Representation of all type definitions, that can be used as both inputs and outputs
621+
/// and are constrained to represent the provided .NET type.
622+
and InputOutputDef<'Val> =
623+
interface
624+
inherit InputOutputDef
625+
inherit TypeDef<'Val>
626+
inherit InputDef<'Val>
627+
inherit OutputDef<'Val>
628+
end
629+
612630
/// Representation of leaf type definitions. Leaf types represents leafs
613631
/// of the GraphQL query tree. Each query path must end with a leaf.
614632
/// By default only scalars and enums are valid leaf types.
@@ -1067,8 +1085,7 @@ and ScalarDef =
10671085
abstract CoerceOutput : obj -> obj option
10681086
inherit TypeDef
10691087
inherit NamedDef
1070-
inherit InputDef
1071-
inherit OutputDef
1088+
inherit InputOutputDef
10721089
inherit LeafDef
10731090
end
10741091

@@ -1098,6 +1115,7 @@ and [<CustomEquality; NoComparison>] ScalarDefinition<'Primitive, 'Val> = {
10981115

10991116
interface InputDef
11001117
interface OutputDef
1118+
interface InputOutputDef
11011119

11021120
interface ScalarDef with
11031121
member x.Name = x.Name
@@ -1107,6 +1125,7 @@ and [<CustomEquality; NoComparison>] ScalarDefinition<'Primitive, 'Val> = {
11071125

11081126
interface InputDef<'Val>
11091127
interface OutputDef<'Val>
1128+
interface InputOutputDef<'Val>
11101129
interface LeafDef
11111130

11121131
interface NamedDef with
@@ -1182,8 +1201,7 @@ and EnumDef =
11821201
/// List of available enum cases.
11831202
abstract Options : EnumVal[]
11841203
inherit TypeDef
1185-
inherit InputDef
1186-
inherit OutputDef
1204+
inherit InputOutputDef
11871205
inherit LeafDef
11881206
inherit NamedDef
11891207
end
@@ -1197,8 +1215,7 @@ and EnumDef<'Val> =
11971215
abstract Options : EnumValue<'Val>[]
11981216
inherit EnumDef
11991217
inherit TypeDef<'Val>
1200-
inherit InputDef<'Val>
1201-
inherit OutputDef<'Val>
1218+
inherit InputOutputDef<'Val>
12021219
end
12031220

12041221
and internal EnumDefinition<'Val> = {
@@ -1212,6 +1229,7 @@ and internal EnumDefinition<'Val> = {
12121229

12131230
interface InputDef
12141231
interface OutputDef
1232+
interface InputOutputDef
12151233

12161234
interface TypeDef with
12171235
member _.Type = typeof<'Val>
@@ -1523,8 +1541,7 @@ and ListOfDef<'Val, 'Seq when 'Seq :> 'Val seq> =
15231541
/// GraphQL type definition of the container element type.
15241542
abstract OfType : TypeDef<'Val>
15251543
inherit TypeDef<'Seq>
1526-
inherit InputDef<'Seq>
1527-
inherit OutputDef<'Seq>
1544+
inherit InputOutputDef<'Seq>
15281545
inherit ListOfDef
15291546
end
15301547

@@ -1574,8 +1591,7 @@ and NullableDef<'Val> =
15741591
interface
15751592
/// GraphQL type definition of the nested type.
15761593
abstract OfType : TypeDef<'Val>
1577-
inherit InputDef<'Val option>
1578-
inherit OutputDef<'Val option>
1594+
inherit InputOutputDef<'Val option>
15791595
inherit NullableDef
15801596
end
15811597

@@ -1614,8 +1630,7 @@ and StructNullableDef<'Val> =
16141630
interface
16151631
/// GraphQL type definition of the nested type.
16161632
abstract OfType : TypeDef<'Val>
1617-
inherit InputDef<'Val voption>
1618-
inherit OutputDef<'Val voption>
1633+
inherit InputOutputDef<'Val voption>
16191634
inherit NullableDef
16201635
end
16211636

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

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,16 @@
4141
<Compile Include="UnionInterfaceTests.fs" />
4242
<Compile Include="DirectivesTests.fs" />
4343
<Compile Include="TypeValidationTests.fs" />
44+
<Compile Include="TypeWrappersKindSafetyTests.fs" />
45+
<None Include="TypeWrappersKindSafety\.gitignore" />
46+
<None Include="TypeWrappersKindSafety\References.fsx" Condition="exists('TypeWrappersKindSafety\References.fsx')" CopyToOutputDirectory="PreserveNewest" />
47+
<None Include="TypeWrappersKindSafety\ListOf.InputAsOutput.fsx" CopyToOutputDirectory="PreserveNewest" />
48+
<None Include="TypeWrappersKindSafety\ListOf.OutputAsInput.fsx" CopyToOutputDirectory="PreserveNewest" />
49+
<None Include="TypeWrappersKindSafety\Nullable.InputAsOutput.fsx" CopyToOutputDirectory="PreserveNewest" />
50+
<None Include="TypeWrappersKindSafety\Nullable.OutputAsInput.fsx" CopyToOutputDirectory="PreserveNewest" />
51+
<None Include="TypeWrappersKindSafety\StructNullable.InputAsOutput.fsx" CopyToOutputDirectory="PreserveNewest" />
52+
<None Include="TypeWrappersKindSafety\StructNullable.OutputAsInput.fsx" CopyToOutputDirectory="PreserveNewest" />
53+
<None Include="TypeWrappersKindSafety\Valid.fsx" CopyToOutputDirectory="PreserveNewest" />
4454
<Compile Include="AstValidationTests.fs" />
4555
<Compile Include="ParserTests.fs" />
4656
<Compile Include="SchemaTests.fs" />

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -139,7 +139,7 @@ let ``Planning must retain correct types for lists``() =
139139
}
140140
}
141141
}"""
142-
let PersonList : ListOfDef<Person, Person list> = ListOf Person
142+
let PersonList : OutputDef<Person list> = ListOf Person
143143
let plan = schemaProcessor.CreateExecutionPlanOrFail(query)
144144
equals 1 plan.Fields.Length
145145
let listInfo = plan.Fields.Head
@@ -178,7 +178,7 @@ let ``Planning must work with interfaces``() =
178178
}"""
179179
let plan = schemaProcessor.CreateExecutionPlanOrFail(query)
180180
equals 1 plan.Fields.Length
181-
let INamedList : ListOfDef<obj, obj list> = ListOf INamed
181+
let INamedList : OutputDef<obj list> = ListOf INamed
182182
let listInfo = plan.Fields.Head
183183
listInfo.Identifier |> equals "names"
184184
listInfo.ReturnDef |> equals (upcast INamedList)
@@ -215,7 +215,7 @@ let ``Planning must work with unions``() =
215215
let plan = schemaProcessor.CreateExecutionPlanOrFail(query)
216216
equals 1 plan.Fields.Length
217217
let listInfo = plan.Fields.Head
218-
let UNamedList : ListOfDef<Named, Named list> = ListOf UNamed
218+
let UNamedList : OutputDef<Named list> = ListOf UNamed
219219
listInfo.Identifier |> equals "names"
220220
listInfo.ReturnDef |> equals (upcast UNamedList)
221221
let (ResolveCollection(info)) = listInfo.Kind
@@ -309,7 +309,7 @@ let ``Planning must handle inline fragment with non-matching type condition in u
309309
// Verify the execution plan structure
310310
equals 1 plan.Fields.Length
311311
let listInfo = plan.Fields.Head
312-
let UNamedList : ListOfDef<Named, Named list> = ListOf UNamed
312+
let UNamedList : OutputDef<Named list> = ListOf UNamed
313313
listInfo.Identifier |> equals "names"
314314
listInfo.ReturnDef |> equals (upcast UNamedList)
315315
let (ResolveCollection(info)) = listInfo.Kind

‎tests/FSharp.Data.GraphQL.Tests/TypeWrappersKindSafety/.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
References.fsx

‎tests/FSharp.Data.GraphQL.Tests/TypeWrappersKindSafety/ListOf.InputAsOutput.fsx‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
#load "References.fsx"
2+
3+
open FSharp.Data.GraphQL.Types
4+
5+
type InputOnly = { Value : int }
6+
type OutputOnly = { Value : int }
7+
8+
let inputOnlyType =
9+
Define.InputObject<InputOnly> (name = "InputOnlyType", fields = [ Define.Input ("value", IntType) ])
10+
11+
// This should fail: InputDef cannot be assigned to OutputDef
12+
let _ : OutputDef<InputOnly list> = ListOf inputOnlyType

‎tests/FSharp.Data.GraphQL.Tests/TypeWrappersKindSafety/ListOf.OutputAsInput.fsx‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
#load "References.fsx"
2+
3+
open FSharp.Data.GraphQL.Types
4+
5+
type InputOnly = { Value : int }
6+
type OutputOnly = { Value : int }
7+
8+
let outputOnlyType =
9+
Define.Object<OutputOnly> (name = "OutputOnlyType", fields = [ Define.Field ("value", IntType, fun _ x -> x.Value) ])
10+
11+
// This should fail: OutputDef cannot be assigned to InputDef
12+
let _ : InputDef<OutputOnly list> = ListOf outputOnlyType

‎tests/FSharp.Data.GraphQL.Tests/TypeWrappersKindSafety/Nullable.InputAsOutput.fsx‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
#load "References.fsx"
2+
3+
open FSharp.Data.GraphQL.Types
4+
5+
type InputOnly = { Value : int }
6+
type OutputOnly = { Value : int }
7+
8+
let inputOnlyType =
9+
Define.InputObject<InputOnly> (name = "InputOnlyType", fields = [ Define.Input ("value", IntType) ])
10+
11+
// This should fail: InputDef cannot be assigned to OutputDef
12+
let _ : OutputDef<InputOnly option> = Nullable inputOnlyType

‎tests/FSharp.Data.GraphQL.Tests/TypeWrappersKindSafety/Nullable.OutputAsInput.fsx‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
#load "References.fsx"
2+
3+
open FSharp.Data.GraphQL.Types
4+
5+
type InputOnly = { Value : int }
6+
type OutputOnly = { Value : int }
7+
8+
let outputOnlyType =
9+
Define.Object<OutputOnly> (name = "OutputOnlyType", fields = [ Define.Field ("value", IntType, fun _ x -> x.Value) ])
10+
11+
// This should fail: OutputDef cannot be assigned to InputDef
12+
let _ : InputDef<OutputOnly option> = Nullable outputOnlyType

0 commit comments

Comments
 (0)