Double coercion and error messages fixes

src/FSharp.Data.GraphQL.Server.Middleware/MiddlewareDefinitions.fs

@@ -90,6 +90,7 @@ type internal ObjectListFilterMiddleware<'ObjectType, 'ListType>(reportToMetadat
                         match x.Name with
                         | "filter" -> ObjectListFilter.CoerceInput (InlineConstant x.Value)
                         | _ -> Ok NoFilter)
+                    |> Seq.toList
                 match filterResults |> splitSeqErrorsList with
                 | Error errs -> Error errs
                 | Ok filters ->

src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs

@@ -69,7 +69,8 @@ module SchemaDefinitions =
 
         let rec mapFilter (name : string, value : InputValue) =
             let mapFilters fields =
-                let coerceResults = fields |> Seq.map coerceObjectListFilterInput |> splitSeqErrorsList
+                let coerceResults =
+                    fields |> Seq.map coerceObjectListFilterInput |> Seq.toList |> splitSeqErrorsList
                 match coerceResults with
                 | Error errs -> Error errs
                 | Ok coerced -> coerced |> removeNoFilter |> Seq.toList |> Ok
@@ -95,7 +96,8 @@ module SchemaDefinitions =
             | _ -> Ok NoFilter
 
         and mapInput value =
-            let filterResults = value |> Map.toSeq |> Seq.map mapFilter |> splitSeqErrorsList
+            let filterResults =
+                value |> Map.toSeq |> Seq.map mapFilter |> Seq.toList |> splitSeqErrorsList
             match filterResults with
             | Error errs -> Error errs
             | Ok filters ->

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

@@ -11,10 +11,10 @@ open FsToolkit.ErrorHandling
 
 let getObjectErrors (object: IReadOnlyDictionary<string, Result<'t, IGQLError>>) =
     object
-    |> Seq.choose (fun kvp ->
+    |> Seq.vchoose (fun kvp ->
         match kvp.Value with
-        | Ok _ -> None
-        | Error err -> Some err)
+        | Ok _ -> ValueNone
+        | Error err -> ValueSome err)
     |> Seq.toList
 
 let getObjectValues (object: IReadOnlyDictionary<string, Result<'t, IGQLError>>) =
@@ -30,18 +30,19 @@ let getObjectValues (object: IReadOnlyDictionary<string, Result<'t, IGQLError>>)
 let splitObjectErrors (object: IReadOnlyDictionary<string, Result<'t, IGQLError>>) =
     let errors = object |> getObjectErrors
 
-    if not <| List.isEmpty errors then
+    if not errors.IsEmpty then
         Error errors
     else
         let values = object |> getObjectValues
         Ok values
 
 let getObjectErrorsList (object: IReadOnlyDictionary<string, Result<'t, IGQLError list>>) =
     object
-    |> Seq.choose (fun kvp ->
+    |> Seq.vchoose (fun kvp ->
         match kvp.Value with
-        | Ok _ -> None
-        | Error err -> Some err)
+        | Ok _ -> ValueNone
+        | Error err -> ValueSome err)
+    |> Seq.collect id
     |> Seq.toList
 
 let getObjectValuesList (object: IReadOnlyDictionary<string, Result<'t, IGQLError list>>) =
@@ -57,18 +58,18 @@ let getObjectValuesList (object: IReadOnlyDictionary<string, Result<'t, IGQLErro
 let splitObjectErrorsList (object: IReadOnlyDictionary<string, Result<'t, IGQLError list>>) =
     let errors = object |> getObjectErrorsList
 
-    if not <| List.isEmpty errors then
-        Error (errors |> List.collect id)
+    if not errors.IsEmpty then
+        Error errors
     else
         let values = object |> getObjectValuesList
         Ok values
 
 let getSeqErrors (items: Result<'t, IGQLError> seq) =
     items
-    |> Seq.choose (fun result ->
+    |> Seq.vchoose (fun result ->
         match result with
-        | Ok _ -> None
-        | Error err -> Some err)
+        | Ok _ -> ValueNone
+        | Error err -> ValueSome err)
     |> Seq.toList
 
 let getSeqValues (items: Result<'t, IGQLError> seq) =
@@ -79,21 +80,22 @@ let getSeqValues (items: Result<'t, IGQLError> seq) =
         | Error _ -> raise <| ArgumentException())
     |> Seq.toArray
 
-let splitSeqErrors (items: Result<'t, IGQLError> seq) =
+let splitSeqErrors (items: Result<'t, IGQLError> list) =
     let errors = items |> getSeqErrors
 
-    if not <| List.isEmpty errors then
+    if not errors.IsEmpty then
         Error errors
     else
         let values = items |> getSeqValues
         Ok values
 
 let getSeqErrorsList (items: Result<'t, IGQLError list> seq) =
     items
-    |> Seq.choose (fun result ->
+    |> Seq.vchoose (fun result ->
         match result with
-        | Ok _ -> None
-        | Error err -> Some err)
+        | Ok _ -> ValueNone
+        | Error err -> ValueSome err)
+    |> Seq.collect id
     |> Seq.toList
 
 let getSeqValuesList (items: Result<'t, IGQLError list> seq) =
@@ -104,11 +106,11 @@ let getSeqValuesList (items: Result<'t, IGQLError list> seq) =
         | Error _ -> raise <| ArgumentException())
     |> Seq.toArray
 
-let splitSeqErrorsList (items: Result<'t, IGQLError list> seq) =
+let splitSeqErrorsList (items: Result<'t, IGQLError list> list) =
     let errors = items |> getSeqErrorsList
 
-    if not <| List.isEmpty errors then
-        Error (errors |> List.collect id)
+    if not errors.IsEmpty then
+        Error errors
     else
         let values = items |> getSeqValuesList
         Ok values

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

@@ -149,7 +149,7 @@ module internal ReflectionHelper =
             ty.GetGenericArguments().[0]
         else ty
 
-    let isAssignableWithUnwrap (from: Type) (``to``: Type) =
+    let rec isAssignableWithUnwrap (from: Type) (``to``: Type) =
 
         let checkCollections (from: Type) (``to``: Type) =
             if
@@ -176,17 +176,16 @@ module internal ReflectionHelper =
                 from.GetGenericArguments()[0]
             else from
         let actualTo =
-            if ``to``.FullName.StartsWith OptionTypeName || ``to``.FullName.StartsWith ValueOptionTypeName then
+            if ``to``.FullName.StartsWith OptionTypeName ||
+               ``to``.FullName.StartsWith ValueOptionTypeName
+            then
                 ``to``.GetGenericArguments()[0]
             else ``to``
 
         let result = actualFrom.IsAssignableTo actualTo || checkCollections actualFrom actualTo
-        if result then result
-        else
-            if actualFrom.FullName.StartsWith OptionTypeName || actualFrom.FullName.StartsWith ValueOptionTypeName then
-                let actualFrom = actualFrom.GetGenericArguments()[0]
-                actualFrom.IsAssignableTo actualTo || checkCollections actualFrom actualTo
-            else result
+        if result then true
+        elif actualFrom <> from || actualTo <> ``to`` then isAssignableWithUnwrap actualFrom actualTo
+        else false
 
     let matchConstructor (t: Type) (fields: string []) =
         if FSharpType.IsRecord(t, true) then FSharpValue.PreComputeRecordConstructorInfo(t, true)

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

@@ -147,20 +147,20 @@ let rec internal compileByType
 
         let exceptions : exn list =  [
             if missingParameters.Any () then
-                InvalidInputTypeException (
-                    $"Input object '%s{objDef.Name}' refers to type '%O{objtype}', but mandatory constructor parameters '%A{missingParameters}' don't match any of the defined input fields",
-                    missingParameters.ToImmutableHashSet ()
-                )
+                let message =
+                    let ``params`` = String.Join ("', '", missingParameters)
+                    $"Input object '%s{objDef.Name}' refers to type '%O{objtype}', but mandatory constructor parameters '%s{``params``}' don't match any of the defined GraphQL input fields"
+                InvalidInputTypeException (message, missingParameters.ToImmutableHashSet ())
             if nullableMismatchParameters.Any () then
-                InvalidInputTypeException (
-                    $"Input object %s{objDef.Name} refers to type '%O{objtype}', but optional fields '%A{missingParameters}' are not optional parameters of the constructor",
-                    nullableMismatchParameters.ToImmutableHashSet ()
-                )
+                let message =
+                    let ``params`` = String.Join ("', '", nullableMismatchParameters)
+                    $"Input object %s{objDef.Name} refers to type '%O{objtype}', but constructor parameters for optional GraphQL fields '%s{``params``}' are not optional"
+                InvalidInputTypeException (message, nullableMismatchParameters.ToImmutableHashSet ())
             if typeMismatchParameters.Any () then
-                InvalidInputTypeException (
-                    $"Input object %s{objDef.Name} refers to type '%O{objtype}', but fields '%A{typeMismatchParameters}' have different types than constructor parameters",
-                    typeMismatchParameters.ToImmutableHashSet ()
-                )
+                let message =
+                    let ``params`` = String.Join ("', '", typeMismatchParameters)
+                    $"Input object %s{objDef.Name} refers to type '%O{objtype}', but GraphQL fields '%s{``params``}' have different types than constructor parameters"
+                InvalidInputTypeException (message, typeMismatchParameters.ToImmutableHashSet ())
         ]
         match exceptions with
         | [] -> ()
@@ -208,6 +208,7 @@ let rec internal compileByType
                                 |> Result.map (normalizeOptional param.ParameterType)
                                 |> attachErrorExtensionsIfScalar inputSource inputObjectPath originalInputDef field
                         | ValueNone -> Ok <| wrapOptionalNone param.ParameterType typeof<obj>)
+                    |> Seq.toList
 
                 let! args = argResults |> splitSeqErrorsList
 
@@ -237,6 +238,7 @@ let rec internal compileByType
                                     return normalizeOptional param.ParameterType value
                                 | ValueNone -> return wrapOptionalNone param.ParameterType typeof<obj>
                             })
+                            |> Seq.toList
 
                         let! args = argResults |> splitSeqErrorsList
 
@@ -280,6 +282,7 @@ let rec internal compileByType
                 let! mappedValues =
                     list
                     |> Seq.mapi (fun i value -> inner i value variables)
+                    |> Seq.toList
                     |> splitSeqErrorsList
                 let mappedValues =
                     mappedValues
@@ -430,6 +433,7 @@ let rec internal coerceVariableValue
                             input.EnumerateArray ()
                             |> Seq.mapi (fun i elem ->
                                 coerceVariableValue areItemsNullable ((box i) :: inputObjectPath) ValueNone (originalTypeDef, innerDef) varDef elem)
+                            |> Seq.toList
                             |> splitSeqErrorsList
                         if areItemsNullable then
                             let some, none, _ = ReflectionHelper.optionOfType innerDef.Type.GenericTypeArguments[0]

src/FSharp.Data.GraphQL.Shared/Helpers/ObjAndStructConversions.fs

@@ -27,3 +27,7 @@ module internal Seq =
 module internal List =
 
     let vchoose mapping list = list |> Seq.vchoose mapping |> List.ofSeq
+
+module internal Array =
+
+    let vchoose mapping array = array |> Seq.vchoose mapping |> Array.ofSeq

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

@@ -274,7 +274,9 @@ module Ast =
             |> ValueOption.map _.TypeCondition
             |> ValueOption.defaultValue x.ParentType
 
-    let private tryFindInArrayOption (finder : 'T -> bool) = ValueOption.ofOption >> ValueOption.bind (Array.tryFind finder >> ValueOption.ofOption)
+    let private tryFindInArrayOption (finder : 'T -> bool) =
+        ValueOption.ofOption
+        >> ValueOption.bind (Array.tryFind finder >> ValueOption.ofOption)
 
     let private onAllSelections (ctx : ValidationContext) (onSelection : SelectionInfo -> ValidationResult<GQLProblemDetails>) =
         let rec traverseSelections selection =
@@ -360,7 +362,9 @@ module Ast =
                 |> ValueOption.defaultValue List.empty
             | FragmentSpread fragSpread ->
                 voption {
-                    let! fragDef = ctx.FragmentDefinitions |> List.tryFind (fun def -> def.Name.IsSome && def.Name.Value = fragSpread.Name)
+                    let! fragDef =
+                        ctx.FragmentDefinitions
+                        |> List.tryFind (fun def -> def.Name.IsSome && def.Name.Value = fragSpread.Name)
                     let! typeCondition = fragDef.TypeCondition
                     let! fragType = ctx.Schema.TryGetTypeByName typeCondition
                     let fragType = Spread (fragSpread.Name, fragSpread.Directives, fragType)
@@ -898,10 +902,6 @@ module Ast =
             |> ValidationResult.collect (checkFragmentSpreadIsPossibleInSelection))
 
     let private checkInputValue (schemaInfo : SchemaInfo) (variables : VariableDefinition list option) (selection : SelectionInfo) =
-        let rec getFieldMap (fields : (string * IntrospectionTypeRef) seq) : Map<string, IntrospectionTypeRef> =
-            (Map.empty, fields)
-            ||> Seq.fold (fun acc (name, tref) -> Map.add name tref acc)
-
         let rec checkIsCoercible (tref : IntrospectionTypeRef) (argName : string) (value : InputValue) =
             let canNotCoerce =
                 AstError.AsResult (
@@ -954,8 +954,7 @@ module Ast =
                         let fieldMap =
                             itype.InputFields
                             |> Option.defaultValue [||]
-                            |> Array.map (fun x -> x.Name, x.Type)
-                            |> getFieldMap
+                            |> Array.fold (fun acc inputVal -> Map.add inputVal.Name inputVal.Type acc) Map.empty
                         let canCoerceFields =
                             fieldMap
                             |> ValidationResult.collect (fun kvp ->
@@ -1401,7 +1400,8 @@ module Ast =
                     | ValueSome operationName, _ ->
                         AstError.AsResult
                             $"A variable '$%s{varDef.VariableName}' is not used in operation '%s{operationName}'. Every variable must be used."
-                    | ValueNone, _ -> AstError.AsResult $"A variable '$%s{varDef.VariableName}' is not used in operation. Every variable must be used.")
+                    | ValueNone, _ ->
+                        AstError.AsResult $"A variable '$%s{varDef.VariableName}' is not used in operation. Every variable must be used.")
             | _ -> Success)
 
     let rec private areTypesCompatible (variableTypeRef : IntrospectionTypeRef) (locationTypeRef : IntrospectionTypeRef) =

tests/FSharp.Data.GraphQL.Tests/Variables and Inputs/OptionalsNormalizationTests.ValidString.fs

@@ -81,6 +81,7 @@ module String =
             Ok <| s
 
     open Validus.Operators
+    open System.Text.Json.Serialization
 
     let allowEmpty = ValueOption.ofObj >> ValueOption.filter (not << String.IsNullOrWhiteSpace)
 
@@ -146,7 +147,33 @@ module Scalars =
 
     type Define with
 
-        static member ValidStringScalar<'t>(typeName, createValid : Validator<string, 't voption>, ?description: string) =
+        static member ValidStringScalar<'t>
+            (typeName, createValid : Validator<string, 't>, toString : 't -> string, ?description : string)
+            =
+            let createValid : string -> ValidationResult<'t> = createValid typeName
+            Define.WrappedScalar (
+                name = typeName,
+                coerceInput =
+                    (function
+                    | Variable e when e.ValueKind = JsonValueKind.String ->
+                        e.GetString ()
+                        |> createValid
+                        |> Result.mapError ValidationErrors.toIGQLErrors
+                    | InlineConstant (StringValue s) ->
+                        s
+                        |> createValid
+                        |> Result.mapError ValidationErrors.toIGQLErrors
+                    | Variable e -> e.GetDeserializeError typeName
+                    | InlineConstant value -> value.GetCoerceError typeName),
+                coerceOutput =
+                    (function
+                    | :? 't as x -> Some (toString x)
+                    | :? string as s -> s |> Some
+                    | _ -> raise <| System.NotSupportedException ()),
+                ?description = description
+            )
+
+        static member ValidStringScalar<'t>(typeName, createValid : Validator<string, 't voption>, toString : 't -> string, ?description: string) =
             let createValid = createValid typeName
             Define.WrappedScalar
                 (name = typeName,
@@ -158,8 +185,8 @@ module Scalars =
                     | InlineConstant value -> value.GetCoerceError typeName),
                  coerceOutput =
                     (function
-                    | :? ('t voption) as x -> x |> string |> Some
-                    | :? 't as x -> Some (string x)
+                    | :? ('t voption) as x -> x |> ValueOption.map toString |> ValueOption.toOption
+                    | :? 't as x -> Some (toString x)
                     | :? string as s -> s |> Some
                     | null -> None
                     | _ -> raise <| System.NotSupportedException ()),

tests/FSharp.Data.GraphQL.Tests/Variables and Inputs/OptionalsNormalizationTests.fs

@@ -99,11 +99,11 @@ module Address =
 
     open Scalars
 
-    let Line1Type = Define.ValidStringScalar<AddressLine1>("AddressLine1", createLine1, "Address line 1")
-    let Line2Type = Define.ValidStringScalar<AddressLine2>("AddressLine2", createLine2, "Address line 2")
-    let ZipCodeType = Define.ValidStringScalar<ZipCode>("AddressZipCode", createZipCode, "Address zip code")
-    let CityType = Define.ValidStringScalar<City>("City", createCity)
-    let StateType = Define.ValidStringScalar<State>("State", State.createOrWhitespace)
+    let Line1Type = Define.ValidStringScalar<AddressLine1>("AddressLine1", createLine1, ValidString.value, "Address line 1")
+    let Line2Type = Define.ValidStringScalar<AddressLine2>("AddressLine2", createLine2, ValidString.value, "Address line 2")
+    let ZipCodeType = Define.ValidStringScalar<ZipCode>("AddressZipCode", createZipCode, ValidString.value, "Address zip code")
+    let CityType = Define.ValidStringScalar<City>("City", createCity, ValidString.value)
+    let StateType = Define.ValidStringScalar<State>("State", State.createOrWhitespace, ValidString.value)
 
 let InputAddressRecordType =
     Define.InputObject<AddressRecord>(