diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/MiddlewareDefinitions.fs b/src/FSharp.Data.GraphQL.Server.Middleware/MiddlewareDefinitions.fs index e7f88799c..0214b67b5 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/MiddlewareDefinitions.fs +++ b/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 -> diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs b/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs index cd4a0f18e..b4af52bd7 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs +++ b/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 -> diff --git a/src/FSharp.Data.GraphQL.Server/ErrorsProcessing.fs b/src/FSharp.Data.GraphQL.Server/ErrorsProcessing.fs index 19212c127..ed4ed3270 100644 --- a/src/FSharp.Data.GraphQL.Server/ErrorsProcessing.fs +++ b/src/FSharp.Data.GraphQL.Server/ErrorsProcessing.fs @@ -11,10 +11,10 @@ open FsToolkit.ErrorHandling let getObjectErrors (object: IReadOnlyDictionary>) = 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>) = @@ -30,7 +30,7 @@ let getObjectValues (object: IReadOnlyDictionary>) let splitObjectErrors (object: IReadOnlyDictionary>) = let errors = object |> getObjectErrors - if not <| List.isEmpty errors then + if not errors.IsEmpty then Error errors else let values = object |> getObjectValues @@ -38,10 +38,11 @@ let splitObjectErrors (object: IReadOnlyDictionary let getObjectErrorsList (object: IReadOnlyDictionary>) = 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>) = @@ -57,18 +58,18 @@ let getObjectValuesList (object: IReadOnlyDictionary>) = 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,10 +80,10 @@ 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 @@ -90,10 +91,11 @@ let splitSeqErrors (items: Result<'t, IGQLError> seq) = 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 diff --git a/src/FSharp.Data.GraphQL.Server/ReflectionHelper.fs b/src/FSharp.Data.GraphQL.Server/ReflectionHelper.fs index 26c2aed99..14eb7d32c 100644 --- a/src/FSharp.Data.GraphQL.Server/ReflectionHelper.fs +++ b/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) diff --git a/src/FSharp.Data.GraphQL.Server/Values.fs b/src/FSharp.Data.GraphQL.Server/Values.fs index 5c8cd4dfe..ffbcbe951 100644 --- a/src/FSharp.Data.GraphQL.Server/Values.fs +++ b/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) + |> 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 }) + |> 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] diff --git a/src/FSharp.Data.GraphQL.Shared/Helpers/ObjAndStructConversions.fs b/src/FSharp.Data.GraphQL.Shared/Helpers/ObjAndStructConversions.fs index 9a92e8ed3..fc28a39e0 100644 --- a/src/FSharp.Data.GraphQL.Shared/Helpers/ObjAndStructConversions.fs +++ b/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 diff --git a/src/FSharp.Data.GraphQL.Shared/Validation.fs b/src/FSharp.Data.GraphQL.Shared/Validation.fs index bd078ce8d..de516a3e1 100644 --- a/src/FSharp.Data.GraphQL.Shared/Validation.fs +++ b/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) = 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 = - (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) = diff --git a/tests/FSharp.Data.GraphQL.Tests/Variables and Inputs/OptionalsNormalizationTests.ValidString.fs b/tests/FSharp.Data.GraphQL.Tests/Variables and Inputs/OptionalsNormalizationTests.ValidString.fs index a19834b6a..194c266d6 100644 --- a/tests/FSharp.Data.GraphQL.Tests/Variables and Inputs/OptionalsNormalizationTests.ValidString.fs +++ b/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, ?description: string) = + static member ValidStringScalar<'t> + (typeName, createValid : Validator, 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, 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 ()), diff --git a/tests/FSharp.Data.GraphQL.Tests/Variables and Inputs/OptionalsNormalizationTests.fs b/tests/FSharp.Data.GraphQL.Tests/Variables and Inputs/OptionalsNormalizationTests.fs index 94dc0ff9b..28e70d52d 100644 --- a/tests/FSharp.Data.GraphQL.Tests/Variables and Inputs/OptionalsNormalizationTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/Variables and Inputs/OptionalsNormalizationTests.fs @@ -99,11 +99,11 @@ module Address = open Scalars - let Line1Type = Define.ValidStringScalar("AddressLine1", createLine1, "Address line 1") - let Line2Type = Define.ValidStringScalar("AddressLine2", createLine2, "Address line 2") - let ZipCodeType = Define.ValidStringScalar("AddressZipCode", createZipCode, "Address zip code") - let CityType = Define.ValidStringScalar("City", createCity) - let StateType = Define.ValidStringScalar("State", State.createOrWhitespace) + let Line1Type = Define.ValidStringScalar("AddressLine1", createLine1, ValidString.value, "Address line 1") + let Line2Type = Define.ValidStringScalar("AddressLine2", createLine2, ValidString.value, "Address line 2") + let ZipCodeType = Define.ValidStringScalar("AddressZipCode", createZipCode, ValidString.value, "Address zip code") + let CityType = Define.ValidStringScalar("City", createCity, ValidString.value) + let StateType = Define.ValidStringScalar("State", State.createOrWhitespace, ValidString.value) let InputAddressRecordType = Define.InputObject(