Created ObjectListFilter parsing for filter value through variable

Author: Viktor Tochonov

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

@@ -3,9 +3,6 @@
 module FSharp.Data.GraphQL.Server.Middleware.SchemaDefinitions
 
 open System
-open System.Collections.Generic
-open System.Collections.Immutable
-open System.Text.Json
 open FSharp.Data.GraphQL
 open FSharp.Data.GraphQL.Types
 open FSharp.Data.GraphQL.Ast
@@ -22,7 +19,7 @@ type private ComparisonOperator =
     | LessThanOrEqual of string
     | In of string
 
-let rec private coerceObjectListFilterInput x : Result<ObjectListFilter voption, IGQLError list> =
+let rec private coerceObjectListFilterInput (variables : Variables) inputValue : Result<ObjectListFilter voption, IGQLError list> =
 
     let parseFieldCondition (s : string) =
         let s = s.ToLowerInvariant ()
@@ -81,17 +78,17 @@ let rec private coerceObjectListFilterInput x : Result<ObjectListFilter voption,
                 | ValueSome acc -> build (ValueSome (Or (acc, x))) xs
         build ValueNone x
 
-    let rec mapFilter (name : string, value : InputValue) =
+    let rec mapFilter (condition : ComparisonOperator) (value : InputValue) =
         let mapFilters fields =
             let coerceResults =
                 fields
-                |> Seq.map coerceObjectListFilterInput
+                |> Seq.map (coerceObjectListFilterInput variables)
                 |> Seq.toList
                 |> splitSeqErrorsList
             match coerceResults with
             | Error errs -> Error errs
             | Ok coerced -> coerced |> Seq.vchoose id |> Seq.toList |> Ok
-        match parseFieldCondition name, value with
+        match condition, value with
         | Equals "and", ListValue fields -> fields |> mapFilters |> Result.map buildAnd
         | Equals "or", ListValue fields -> fields |> mapFilters |> Result.map buildOr
         | Equals "not", ObjectValue value ->
@@ -126,60 +123,42 @@ let rec private coerceObjectListFilterInput x : Result<ObjectListFilter voption,
                 |> splitSeqErrors
             return ValueSome (ObjectListFilter.In { FieldName = fname; Value = parsedValues |> Array.toList })
           }
+        | condition, VariableName variableName ->
+            match variables.TryGetValue variableName with
+            | true, value -> mapFilter condition (value |> InputValue.OfObject)
+            | false, _ -> Errors.Variables.getVariableNotFoundError variableName
         | _ -> Ok ValueNone
 
     and mapInput value =
         let filterResults =
             value
-            |> Map.toSeq
-            |> Seq.map mapFilter
+            |> Seq.map (fun kvp -> mapFilter (parseFieldCondition kvp.Key) kvp.Value)
             |> Seq.toList
             |> splitSeqErrorsList
         match filterResults with
         | Error errs -> Error errs
         | Ok filters -> filters |> Seq.vchoose id |> List.ofSeq |> buildAnd |> Ok
 
-    match x with
-    | ObjectValue x -> mapInput x
-    | NullValue -> ValueNone |> Ok
-    // TODO: Get union case
-    | _ ->
-        Error [
-            { new IGQLError with
-                member _.Message = $"'ObjectListFilter' must be defined as object but got '{x.GetType ()}'"
-            }
-        ]
+    let rec parse inputValue =
+        match inputValue with
+        | ObjectValue x -> mapInput x
+        | NullValue -> ValueNone |> Ok
+        | VariableName variableName ->
+            match variables.TryGetValue variableName with
+            | true, (:? ObjectListFilter as filter) -> ValueSome filter |> Ok
+            | true, value ->
+                System.Diagnostics.Debug.Fail "We expect the root value is parsed into ObjectListFilter"
+                value |> InputValue.OfObject |> parse
+            | false, _ -> Errors.Variables.getVariableNotFoundError variableName
+        // TODO: Get union case
+        | _ ->
+            Error [
+                { new IGQLError with
+                    member _.Message = $"'ObjectListFilter' must be defined as object but got '{inputValue.GetType ()}'"
+                }
+            ]
+    parse inputValue
 
-let private coerceObjectListFilterValue (x : obj) : ObjectListFilter option =
-    match x with
-    | :? ObjectListFilter as x -> Some x
-    | _ -> None
-//let private coerceObjectListFilterValue (x : obj) =
-//    match x with
-//    | :? ObjectListFilter as x -> Ok x
-//    | _ -> Error [{ new IGQLError with member _.Message = $"Cannot coerce ObjectListFilter output. '%s{x.GetType().FullName}' is not 'ObjectListFilter'" }]
-
-// TODO: Move to shared and make public
-let rec private jsonElementToInputValue (element : JsonElement) =
-    match element.ValueKind with
-    | JsonValueKind.Null -> NullValue
-    | JsonValueKind.True -> BooleanValue true
-    | JsonValueKind.False -> BooleanValue false
-    | JsonValueKind.String -> StringValue (element.GetString ())
-    | JsonValueKind.Number -> FloatValue (element.GetDouble ())
-    | JsonValueKind.Array ->
-        ListValue (
-            element.EnumerateArray ()
-            |> Seq.map jsonElementToInputValue
-            |> List.ofSeq
-        )
-    | JsonValueKind.Object ->
-        ObjectValue (
-            element.EnumerateObject ()
-            |> Seq.map (fun p -> p.Name, jsonElementToInputValue p.Value)
-            |> Map.ofSeq
-        )
-    | _ -> raise (NotSupportedException "Unsupported JSON element type")
 
 /// Defines an object list filter for use as an argument for filter list of object fields.
 let ObjectListFilterType : InputCustomDefinition<ObjectListFilter> = {
@@ -189,13 +168,13 @@ let ObjectListFilterType : InputCustomDefinition<ObjectListFilter> = {
             "The `Filter` scalar type represents a filter on one or more fields of an object in an object list. The filter is represented by a JSON object where the fields are the complemented by specific suffixes to represent a query."
     CoerceInput =
         (fun input variables ->
-        match input with
-        | InlineConstant c ->
-            coerceObjectListFilterInput c
-            |> Result.map ValueOption.toObj
-        | Variable json ->
-            json
-            |> jsonElementToInputValue
-            |> coerceObjectListFilterInput
-            |> Result.map ValueOption.toObj)
+            match input with
+            | InlineConstant c ->
+                (coerceObjectListFilterInput variables c)
+                |> Result.map ValueOption.toObj
+            | Variable json ->
+                json
+                |> InputValue.OfJsonElement
+                |> (coerceObjectListFilterInput variables)
+                |> Result.map ValueOption.toObj)
 }

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

@@ -321,6 +321,8 @@ type Schema<'Root> (query: ObjectDef<'Root>, ?mutation: ObjectDef<'Root>, ?subsc
                 getPossibleTypes idef
                 |> Array.map (fun tdef -> Map.find tdef.Name namedTypes)
             IntrospectionType.Interface(idef.Name, idef.Description, fields, possibleTypes)
+        | InputCustom inCustDef ->
+            IntrospectionType.InputObject(inCustDef.Name, inCustDef.Description, [||])
         | _ -> failwithf "Unexpected value of typedef: %O" typedef
 
     let introspectSchema (types : TypeMap) : IntrospectionSchema =
@@ -334,6 +336,7 @@ type Schema<'Root> (query: ObjectDef<'Root>, ?mutation: ObjectDef<'Root>, ?subsc
                 | Union x -> typeName, { Kind = TypeKind.UNION; Name = Some typeName; Description = x.Description; OfType = None }
                 | Enum x -> typeName, { Kind = TypeKind.ENUM; Name = Some typeName; Description = x.Description; OfType = None }
                 | Interface x -> typeName, { Kind = TypeKind.INTERFACE; Name = Some typeName; Description = x.Description; OfType = None }
+                | InputCustom x -> typeName, { Kind = TypeKind.INPUT_OBJECT; Name = Some typeName; Description = x.Description; OfType = None }
                 | _ -> failwithf "Unexpected value of typedef: %O" typedef)
             |> Map.ofSeq
         let itypes =

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

@@ -103,8 +103,7 @@ let rec internal compileByType
 
     | Scalar scalardef -> variableOrElse (InlineConstant >> scalardef.CoerceInput)
 
-    | InputCustom customDef ->
-        fun value variables -> customDef.CoerceInput (InlineConstant value) variables
+    | InputCustom customDef -> fun value variables -> customDef.CoerceInput (InlineConstant value) variables
 
     | InputObject objDef ->
         let objtype = objDef.Type
@@ -128,8 +127,7 @@ let rec internal compileByType
                         | Some field ->
                             let isParameterSkippable = ReflectionHelper.isParameterSkippable param
                             match field.TypeDef with
-                            | Nullable _ when field.IsSkippable <> isParameterSkippable ->
-                                skippableMismatchParameters.Add param.Name |> ignore
+                            | Nullable _ when field.IsSkippable <> isParameterSkippable -> skippableMismatchParameters.Add param.Name |> ignore
                             | Nullable _ when
                                 not (isParameterSkippable)
                                 && ReflectionHelper.isPrameterMandatory param
@@ -143,7 +141,8 @@ let rec internal compileByType
                                     else
                                         inputDef.Type, param.ParameterType
                                 if ReflectionHelper.isAssignableWithUnwrap inputType paramType then
-                                    allParameters.Add (struct (ValueSome field, param)) |> ignore
+                                    allParameters.Add (struct (ValueSome field, param))
+                                    |> ignore
                                 else
                                     // TODO: Consider improving by specifying type mismatches
                                     typeMismatchParameters.Add param.Name |> ignore
@@ -223,25 +222,28 @@ let rec internal compileByType
                     |> Seq.map (fun struct (field, param) ->
                         match field with
                         | ValueSome field -> result {
-                                match Map.tryFind field.Name props with
-                                | None when field.IsSkippable -> return Activator.CreateInstance param.ParameterType
-                                | None -> return wrapOptionalNone param.ParameterType field.TypeDef.Type
-                                | Some prop ->
-                                    let! value =
-                                        field.ExecuteInput prop variables
-                                        |> attachErrorExtensionsIfScalar inputSource inputObjectPath originalInputDef field
-                                    if field.IsSkippable then
-                                        let innerType = param.ParameterType.GenericTypeArguments[0]
-                                        if not (ReflectionHelper.isTypeOptional innerType) &&
-                                           (value = null || (innerType.IsValueType && value = Activator.CreateInstance innerType))
-                                        then
-                                            return Activator.CreateInstance param.ParameterType
-                                        else
-                                            let ``include``, _ = ReflectionHelper.ofSkippable param.ParameterType
-                                            return normalizeOptional innerType value |> ``include``
+                            match Map.tryFind field.Name props with
+                            | None when field.IsSkippable -> return Activator.CreateInstance param.ParameterType
+                            | None -> return wrapOptionalNone param.ParameterType field.TypeDef.Type
+                            | Some prop ->
+                                let! value =
+                                    field.ExecuteInput prop variables
+                                    |> attachErrorExtensionsIfScalar inputSource inputObjectPath originalInputDef field
+                                if field.IsSkippable then
+                                    let innerType = param.ParameterType.GenericTypeArguments[0]
+                                    if
+                                        not (ReflectionHelper.isTypeOptional innerType)
+                                        && (value = null
+                                            || (innerType.IsValueType
+                                                && value = Activator.CreateInstance innerType))
+                                    then
+                                        return Activator.CreateInstance param.ParameterType
                                     else
-                                        return normalizeOptional param.ParameterType value
-                            }
+                                        let ``include``, _ = ReflectionHelper.ofSkippable param.ParameterType
+                                        return normalizeOptional innerType value |> ``include``
+                                else
+                                    return normalizeOptional param.ParameterType value
+                          }
                         | ValueNone -> Ok <| wrapOptionalNone param.ParameterType typeof<obj>)
                     |> Seq.toList
 
@@ -413,18 +415,26 @@ type CoerceVariableContext = {
     Input : JsonElement
 }
 
-let rec internal coerceVariableValue (ctx : CoerceVariableContext)
-    : Result<obj, IGQLError list> =
+type CoerceVariableInputContext = {
+    InputObjectPath : FieldPath
+    OriginalObjectDef : InputDef
+    ObjectDef : InputObjectDef
+    VarDef : VarDef
+    Input : JsonElement
+}
+
+let rec internal coerceVariableValue (ctx : CoerceVariableContext) : Result<obj, IGQLError list> =
 
     let {
-        IsNullable = isNullable
-        InputObjectPath = inputObjectPath
-        ObjectFieldErrorDetails = objectFieldErrorDetails
-        OriginalTypeDef = originalTypeDef
-        TypeDef = typeDef
-        VarDef = varDef
-        Input = input
-    } = ctx
+            IsNullable = isNullable
+            InputObjectPath = inputObjectPath
+            ObjectFieldErrorDetails = objectFieldErrorDetails
+            OriginalTypeDef = originalTypeDef
+            TypeDef = typeDef
+            VarDef = varDef
+            Input = input
+        } =
+        ctx
 
     let createVariableCoercionError message =
         Error [
@@ -564,7 +574,14 @@ let rec internal coerceVariableValue (ctx : CoerceVariableContext)
             else
                 return List.foldBack cons items nil
           }
-    | InputObject objdef -> coerceVariableInputObject inputObjectPath (originalTypeDef, objdef) varDef input
+    | InputObject objdef ->
+        coerceVariableInputObject {
+            InputObjectPath = inputObjectPath
+            OriginalObjectDef = originalTypeDef
+            ObjectDef = objdef
+            VarDef = varDef
+            Input = input
+        }
     | Enum enumdef ->
         match input with
         | _ when input.ValueKind = JsonValueKind.Null && isNullable -> Ok null
@@ -579,19 +596,40 @@ let rec internal coerceVariableValue (ctx : CoerceVariableContext)
             | Some option -> Ok option.Value
             | None -> createVariableCoercionError $"A value '%s{value}' is not defined in Enum '%s{enumdef.Name}'."
         | _ -> createVariableCoercionError $"Enum values must be strings but got '%O{input.ValueKind}'."
+    | InputCustom custDef ->
+        if input.ValueKind = JsonValueKind.Null then
+            createNullError originalTypeDef
+        else
+            match custDef.CoerceInput (InputParameterValue.Variable input) ImmutableDictionary.Empty with
+            | Ok null when isNullable -> Ok null
+            // TODO: Capture position in the JSON document
+            | Ok null -> createNullError originalTypeDef
+            | Ok value when not isNullable ->
+                let ``type`` = value.GetType ()
+                if
+                    ``type``.IsValueType
+                    && ``type``.FullName.StartsWith ReflectionHelper.ValueOptionTypeName
+                    && value = Activator.CreateInstance ``type``
+                then
+                    createNullError originalTypeDef
+                else
+                    Ok value
+            | result ->
+                result
+                |> Result.mapError (List.map (mapInputError varDef inputObjectPath objectFieldErrorDetails))
     | _ -> failwith $"Variable '$%s{varDef.Name}': Only Scalars, Nullables, Lists, and InputObjects are valid type definitions."
 
-and private coerceVariableInputObject inputObjectPath (originalObjDef, objDef) (varDef : VarDef) (input : JsonElement) =
-    match input.ValueKind with
+and private coerceVariableInputObject (ctx : CoerceVariableInputContext) =
+    match ctx.Input.ValueKind with
     | JsonValueKind.Object -> result {
         let mappedResult =
-            objDef.Fields
+            ctx.ObjectDef.Fields
             |> Seq.vchoose (fun field ->
                 let inline coerce value =
-                    let inputObjectPath' = (box field.Name) :: inputObjectPath
+                    let inputObjectPath' = (box field.Name) :: ctx.InputObjectPath
                     let objectFieldErrorDetails =
                         ValueSome
-                        <| { ObjectDef = originalObjDef; FieldDef = ValueSome field }
+                        <| { ObjectDef = ctx.OriginalObjectDef; FieldDef = ValueSome field }
                     let fieldTypeDef = field.TypeDef
                     let value =
                         let ctx = {
@@ -600,12 +638,12 @@ and private coerceVariableInputObject inputObjectPath (originalObjDef, objDef) (
                             ObjectFieldErrorDetails = objectFieldErrorDetails
                             OriginalTypeDef = fieldTypeDef
                             TypeDef = fieldTypeDef
-                            VarDef = varDef
+                            VarDef = ctx.VarDef
                             Input = value
                         }
                         coerceVariableValue ctx
                     KeyValuePair (field.Name, value)
-                match input.TryGetProperty field.Name with
+                match ctx.Input.TryGetProperty field.Name with
                 | true, value -> coerce value |> ValueSome
                 | false, _ when field.IsSkippable -> ValueNone
                 | false, _ ->
@@ -619,20 +657,20 @@ and private coerceVariableInputObject inputObjectPath (originalObjDef, objDef) (
         // TODO: Improve without creating a dictionary
         // This also causes incorrect error messages and extensions to be generated
         let variables =
-            seq { KeyValuePair (varDef.Name, mapped :> obj) }
+            seq { KeyValuePair (ctx.VarDef.Name, mapped :> obj) }
             |> ImmutableDictionary.CreateRange
 
-        return! objDef.ExecuteInput (VariableName varDef.Name) variables
+        return! ctx.ObjectDef.ExecuteInput (VariableName ctx.VarDef.Name) variables
       }
     | JsonValueKind.Null -> Ok null
     | valueKind ->
         Error [
             {
-                InputSource = Variable varDef
-                Message = $"A variable '$%s{varDef.Name}' expected to be '%O{JsonValueKind.Object}' but got '%O{valueKind}'."
+                InputSource = Variable ctx.VarDef
+                Message = $"A variable '$%s{ctx.VarDef.Name}' expected to be '%O{JsonValueKind.Object}' but got '%O{valueKind}'."
                 ErrorKind = InputCoercion
-                Path = inputObjectPath
-                FieldErrorDetails = ValueSome { ObjectDef = originalObjDef; FieldDef = ValueNone }
+                Path = ctx.InputObjectPath
+                FieldErrorDetails = ValueSome { ObjectDef = ctx.OriginalObjectDef; FieldDef = ValueNone }
             }
             :> IGQLError
         ]