diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj b/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj index 9eddcf46..fd259130 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj +++ b/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj @@ -20,8 +20,10 @@ - + + + diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs index bb4f80e4..27fff934 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs @@ -2,7 +2,7 @@ namespace FSharp.Data.GraphQL.Server.Middleware open System open System.Collections -open FSharp.Data.GraphQL +open System.Text.Json /// A filter definition for a field value. type FieldFilter<'Val> = { FieldName : string; Value : 'Val } @@ -34,17 +34,13 @@ type ObjectListFilter = | OfTypes of Type list | FilterField of FieldFilter -open System.Linq open System.Linq.Expressions open System.Runtime.InteropServices -open System.Reflection -open System.Collections.Generic type private CompareDiscriminatorExpression<'T, 'D> = Expression> /// -/// Allows to specify discriminator comparison or discriminator getter -/// and a function that return discriminator value depending on entity type +/// Optional configuration for LINQ translation including discriminator handling. /// /// /// // discriminator custom condition @@ -72,14 +68,18 @@ type private CompareDiscriminatorExpression<'T, 'D> = Expression -[] type ObjectListFilterLinqOptions<'T, 'D> - ([] compareDiscriminator : CompareDiscriminatorExpression<'T, 'D> | null, [] getDiscriminatorValue : (Type -> 'D) | null) = + ( + [] compareDiscriminator : CompareDiscriminatorExpression<'T, 'D> | null, + [] getDiscriminatorValue : (Type -> 'D) | null, + [] jsonOptions : JsonSerializerOptions | null + ) = member _.CompareDiscriminator = compareDiscriminator |> ValueOption.ofObj member _.GetDiscriminatorValue = getDiscriminatorValue |> ValueOption.ofObj + member _.JsonOptions = jsonOptions |> ValueOption.ofObj - static member None = ObjectListFilterLinqOptions<'T, 'D> (null, null) + static member None = ObjectListFilterLinqOptions<'T, 'D> (null, null, null) static member GetCompareDiscriminator (getDiscriminatorValue : Expression>) = let tParam = Expression.Parameter (typeof<'T>, "x") @@ -88,362 +88,17 @@ type ObjectListFilterLinqOptions<'T, 'D> Expression.Lambda> (body, tParam, dParam) new (getDiscriminator : Expression>) = - ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, null) - new (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>) = ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator, null) + ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, null, null) + new (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>) = + ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator, null, null) new (getDiscriminatorValue : Type -> 'D) = - ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator = null, getDiscriminatorValue = getDiscriminatorValue) + ObjectListFilterLinqOptions<'T, 'D> (null, getDiscriminatorValue, null) new (getDiscriminator : Expression>, getDiscriminatorValue : Type -> 'D) = - ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, getDiscriminatorValue) + ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, getDiscriminatorValue, null) + new (jsonOptions : JsonSerializerOptions) = + ObjectListFilterLinqOptions<'T, 'D> (null, null, jsonOptions) + new (getDiscriminator : Expression>, jsonOptions : JsonSerializerOptions) = + ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, null, jsonOptions) + new (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>, jsonOptions : JsonSerializerOptions) = + ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator, null, jsonOptions) -/// Contains tooling for working with ObjectListFilter. -module ObjectListFilter = - /// Contains operators for building and comparing ObjectListFilter values. - module Operators = - /// Creates a new ObjectListFilter representing an AND operation between two existing ones. - let ( &&& ) x y = And (x, y) - - /// Creates a new ObjectListFilter representing an OR operation between two existing ones. - let ( ||| ) x y = Or (x, y) - - /// Creates a new ObjectListFilter representing an EQUALS operation between two comparable values. - let ( === ) fname value = Equals ({ FieldName = fname; Value = value }, null) - - /// Creates a new ObjectListFilter representing a GREATER THAN operation of a comparable value. - let ( >>> ) fname value = GreaterThan { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a GREATER THAN OR EQUAL operation of a comparable value. - let ( ==> ) fname value = GreaterThanOrEqual { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a LESS THAN operation of a comparable value. - let ( <<< ) fname value = LessThan { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a LESS THAN OR EQUAL operation of a comparable value. - let ( <== ) fname value = LessThanOrEqual { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a STARTS WITH operation of a string value. - let ( =@@ ) fname value = StartsWith ({ FieldName = fname; Value = value }, null) - - /// Creates a new ObjectListFilter representing an ENDS WITH operation of a string value. - let ( @@= ) fname value = EndsWith ({ FieldName = fname; Value = value }, null) - - /// Creates a new ObjectListFilter representing a CONTAINS operation. - let ( @=@ ) fname value = Contains ({ FieldName = fname; Value = value }, null) - - /// Creates a new ObjectListFilter representing a IN operation. - let ( =~= ) fname value = In { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a field sub comparison. - let ( --> ) fname filter = FilterField { FieldName = fname; Value = filter } - - /// Creates a new ObjectListFilter representing a NOT operation for the existing one. - let ( !!! ) filter = Not filter - - /// Creates a new ObjectListFilter representing a case-insensitive EQUALS operation on a string value. - let ( ===~ ) fname (value : string) = Equals ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) - - /// Creates a new ObjectListFilter representing a case-insensitive STARTS WITH operation on a string value. - let ( =@@~ ) fname (value : string) = StartsWith ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) - - /// Creates a new ObjectListFilter representing a case-insensitive ENDS WITH operation on a string value. - let ( @@=~ ) fname (value : string) = EndsWith ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) - - /// Creates a new ObjectListFilter representing a case-insensitive CONTAINS operation on a string value. - let ( @=@~ ) fname (value : string) = Contains ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) - - let private genericWhereMethod = - typeof.GetMethods () - |> Seq.where (fun m -> m.Name = "Where") - |> Seq.find (fun m -> - let parameters = m.GetParameters () - parameters.Length = 2 - && parameters[1].ParameterType.GetGenericTypeDefinition () = typedefof>>) - - // Helper to create Where expression - let whereExpr<'T> (query : IQueryable<'T>) (param : ParameterExpression) predicate = - let whereMethod = genericWhereMethod.MakeGenericMethod ([| typeof<'T> |]) - Expression.Call (whereMethod, [| query.Expression; Expression.Lambda> (predicate, param) |]) - - let private objectType = typeof - let private stringType = typeof - let private genericIEnumerableType = typedefof> - - let private stringComparisonType = typeof - let private StringStartsWithMethod = stringType.GetMethod ("StartsWith", [| stringType; stringComparisonType |]) - let private StringEndsWithMethod = stringType.GetMethod ("EndsWith", [| stringType; stringComparisonType |]) - let private StringContainsMethod = stringType.GetMethod ("Contains", [| stringType; stringComparisonType |]) - let private StringEqualsMethod = stringType.GetMethod ("Equals", [| stringType; stringComparisonType |]) - let private unwrapOptionMethod = - FSharp.Data.GraphQL.Helpers.moduleType.GetMethod (nameof Helpers.unwrap) - - let private getCollectionInstanceContainsMethod (memberType : Type) = - memberType - .GetMethods(BindingFlags.Instance ||| BindingFlags.Public) - .FirstOrDefault (fun m -> m.Name = "Contains" && m.GetParameters().Length = 1) - |> ValueOption.ofObj - - let private getEnumerableContainsMethod (itemType : Type) = - match - typeof - .GetMethods(BindingFlags.Static ||| BindingFlags.Public) - .FirstOrDefault (fun m -> m.Name = "Contains" && m.GetParameters().Length = 2) - with - | null -> raise (MissingMemberException "Static 'Contains' method with 2 parameters not found on 'Enumerable' class") - | containsGenericStaticMethod -> containsGenericStaticMethod.MakeGenericMethod ([| itemType |]) - - let private getEnumerableCastMethod (itemType : Type) = - match - typeof - .GetMethods(BindingFlags.Static ||| BindingFlags.Public) - .FirstOrDefault (fun m -> m.Name = "Cast" && m.GetParameters().Length = 1) - with - | null -> raise (MissingMemberException "Static 'Cast' method with 1 parameter not found on 'Enumerable' class") - | castGenericStaticMethod -> castGenericStaticMethod.MakeGenericMethod ([| itemType |]) - - let getField (param : ParameterExpression) fieldName = Expression.PropertyOrField (param, fieldName) - - let hasEqualityOperator (``type`` : Type) = - ``type``.GetMethods (BindingFlags.Public ||| BindingFlags.Static) - |> Seq.exists (fun m -> m.Name = " op_Equality") - - let hasInequalityOperator (``type`` : Type) = - ``type``.GetMethods (BindingFlags.Public ||| BindingFlags.Static) - |> Seq.exists (fun m -> m.Name = "op_Inequality") - - [] - type SourceExpression private (expression : Expression) = - new (parameter : ParameterExpression) = SourceExpression (parameter :> Expression) - new (``member`` : MemberExpression) = SourceExpression (``member`` :> Expression) - member _.Value = expression - static member op_Implicit (source : SourceExpression) = source.Value - static member op_Implicit (parameter : ParameterExpression) = SourceExpression (parameter :> Expression) - static member op_Implicit (``member`` : MemberExpression) = SourceExpression (``member`` :> Expression) - - let equalsMethod = - objectType - |> _.GetMethods(BindingFlags.Instance ||| BindingFlags.Public) - |> Seq.where (fun m -> m.Name = "Equals") - |> Seq.head - - let staticEqualsMethod = - objectType - |> _.GetMethods(BindingFlags.Static ||| BindingFlags.Public) - |> Seq.where (fun m -> m.Name = "Equals") - |> Seq.head - - /// Maps an IComparer to a StringComparison value. - /// Returns ValueNone only when the comparer is null or is not a recognized StringComparer. - let private comparerToStringComparison (comparer : IComparer) = - match comparer with - | null -> ValueNone - | :? StringComparer as sc -> - if obj.ReferenceEquals (sc, StringComparer.OrdinalIgnoreCase) then ValueSome StringComparison.OrdinalIgnoreCase - elif obj.ReferenceEquals (sc, StringComparer.InvariantCultureIgnoreCase) then ValueSome StringComparison.InvariantCultureIgnoreCase - elif obj.ReferenceEquals (sc, StringComparer.CurrentCultureIgnoreCase) then ValueSome StringComparison.CurrentCultureIgnoreCase - elif obj.ReferenceEquals (sc, StringComparer.Ordinal) then ValueSome StringComparison.Ordinal - elif obj.ReferenceEquals (sc, StringComparer.InvariantCulture) then ValueSome StringComparison.InvariantCulture - elif obj.ReferenceEquals (sc, StringComparer.CurrentCulture) then ValueSome StringComparison.CurrentCulture - else ValueNone - | _ -> ValueNone - - let rec buildFilterExpr isEnumerableQuery (param : SourceExpression) buildTypeDiscriminatorCheck filter : Expression = - - let build = buildFilterExpr isEnumerableQuery param buildTypeDiscriminatorCheck - - let (|NoCast|Enumerable|NonEnumerableCast|) value = - if obj.ReferenceEquals (value, null) then NoCast - else if isEnumerableQuery then Enumerable - else NonEnumerableCast (value.GetType ()) - - let unsafeConvertTo ``type`` ``member`` = Expression.Convert (Expression.Convert (``member``, objectType), ``type``) - - let normalizeStringMemberExpr (``member`` : MemberExpression) : Expression = - match ``member``.Type with - | t when t = stringType -> ``member`` - | _ when not isEnumerableQuery -> unsafeConvertTo stringType ``member`` - | _ when isEnumerableQuery -> Expression.Convert (Expression.Call (unwrapOptionMethod, ``member``), stringType) - | _ -> Expression.Convert (``member``, stringType) - - match filter with - | Not (Equals (f, comparer)) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match comparerToStringComparison comparer with - | ValueSome comparison -> - let value = Helpers.unwrap (box f.Value) :?> string - Expression.Not (Expression.Call (normalizeStringMemberExpr ``member``, StringEqualsMethod, Expression.Constant (value, typeof), Expression.Constant comparison)) :> Expression - | ValueNone -> - let hasEqualityOperator = hasEqualityOperator ``member``.Type - match f.Value with - | NoCast when hasEqualityOperator -> Expression.NotEqual (``member``, Expression.Constant f.Value) - | NoCast - | NonEnumerableCast _ -> - Expression.NotEqual (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) - | Enumerable -> - let ``const`` = Expression.Constant (Values.normalizeOptional ``member``.Type f.Value) - Expression.Not (Expression.Call (``const``, equalsMethod, ``member``)) - | Not f -> f |> build |> Expression.Not :> Expression - | And (f1, f2) -> Expression.AndAlso (build f1, build f2) - | Or (f1, f2) -> Expression.OrElse (build f1, build f2) - | Equals (f, comparer) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match comparerToStringComparison comparer with - | ValueSome comparison -> - let value = Helpers.unwrap (box f.Value) :?> string - Expression.Call (normalizeStringMemberExpr ``member``, StringEqualsMethod, Expression.Constant (value, typeof), Expression.Constant comparison) :> Expression - | ValueNone -> - let hasEqualityOperator = hasEqualityOperator ``member``.Type - match f.Value with - | NoCast when hasEqualityOperator -> Expression.Equal (``member``, Expression.Constant f.Value) - | NoCast - | NonEnumerableCast _ -> - Expression.Equal (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) - | Enumerable -> - let ``const`` = Expression.Constant (Values.normalizeOptional ``member``.Type f.Value) - Expression.Call (``const``, equalsMethod, ``member``) - | GreaterThan f -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match f.Value with - | NoCast -> Expression.GreaterThan (``member``, Expression.Constant f.Value) - | Enumerable -> Expression.GreaterThan (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) - | NonEnumerableCast ``type`` -> Expression.GreaterThan ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) - | LessThan f -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match f.Value with - | NoCast -> Expression.LessThan (``member``, Expression.Constant f.Value) - | Enumerable -> Expression.LessThan (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) - | NonEnumerableCast ``type`` -> Expression.LessThan ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) - | GreaterThanOrEqual f -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match f.Value with - | NoCast -> Expression.GreaterThanOrEqual (``member``, Expression.Constant f.Value) - | Enumerable -> Expression.GreaterThanOrEqual (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) - | NonEnumerableCast ``type`` -> Expression.GreaterThanOrEqual ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) - | LessThanOrEqual f -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match f.Value with - | NoCast -> Expression.LessThanOrEqual (``member``, Expression.Constant f.Value) - | Enumerable -> Expression.LessThanOrEqual (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) - | NonEnumerableCast ``type`` -> Expression.LessThanOrEqual ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) - | StartsWith (f, comparer) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let comparison = comparerToStringComparison (comparer :> IComparer) |> ValueOption.defaultValue StringComparison.CurrentCulture - Expression.Call (normalizeStringMemberExpr ``member``, StringStartsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) - | EndsWith (f, comparer) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let comparison = comparerToStringComparison (comparer :> IComparer) |> ValueOption.defaultValue StringComparison.CurrentCulture - Expression.Call (normalizeStringMemberExpr ``member``, StringEndsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) - - | Contains (f, comparer) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let isEnumerable (memberType : Type) = - not (Type.(=) (memberType, stringType)) - && typeof.IsAssignableFrom (memberType) - && memberType.GetInterfaces().Any (fun i -> i.FullName.StartsWith "System.Collections.Generic.IEnumerable`1") - let normalizedValue = Values.normalizeOptional ``member``.Type f.Value - let callContains memberType = - let itemType = - if ``member``.Type.IsArray then - ``member``.Type.GetElementType () - else - ``member``.Type.GetGenericArguments()[0] - let valueType = - match normalizedValue with - | null -> itemType - | value -> value.GetType () - let castedMember = - if itemType = valueType then - ``member`` :> Expression - elif isEnumerableQuery then - let castMethod = getEnumerableCastMethod valueType - Expression.Call (castMethod, ``member``) - else - let castedEnumerableType = genericIEnumerableType.MakeGenericType ([| valueType |]) - unsafeConvertTo castedEnumerableType ``member`` - match getCollectionInstanceContainsMethod memberType with - | ValueNone -> - let enumerableContains = getEnumerableContainsMethod valueType - Expression.Call (enumerableContains, castedMember, Expression.Constant (normalizedValue)) - | ValueSome instanceContainsMethod -> Expression.Call (castedMember, instanceContainsMethod, Expression.Constant (normalizedValue)) - match ``member``.Member with - | :? PropertyInfo as prop when prop.PropertyType |> isEnumerable -> callContains prop.PropertyType - | :? FieldInfo as field when field.FieldType |> isEnumerable -> callContains field.FieldType - | _ -> - let unwrappedValue = Helpers.unwrap f.Value - let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.CurrentCulture - Expression.Call (normalizeStringMemberExpr ``member``, StringContainsMethod, Expression.Constant (unwrappedValue :?> string, typeof), Expression.Constant comparison) - | In f when not (f.Value.IsEmpty) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let enumerableContains = getEnumerableContainsMethod objectType - Expression.Call (enumerableContains, (Expression.Constant f.Value), Expression.Convert (``member``, objectType)) - | In f -> Expression.Constant (false) - | OfTypes types -> - types - |> Seq.map (fun t -> buildTypeDiscriminatorCheck param t) - |> Seq.reduce (fun acc expr -> Expression.OrElse (acc, expr)) - | FilterField f -> - let paramExpr = Expression.PropertyOrField (param, f.FieldName) - buildFilterExpr isEnumerableQuery (SourceExpression paramExpr) buildTypeDiscriminatorCheck f.Value - - type private CompareDiscriminatorExpressionVisitor<'T, 'D> - (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>, param : SourceExpression, value : obj) = - inherit ExpressionVisitor () - override _.VisitParameter (node) = - if node = compareDiscriminator.Parameters.[0] then - param.Value - elif node = compareDiscriminator.Parameters.[1] then - Expression.Constant (value) :> Expression - else - node :> Expression - - let enumerableQueryType = typedefof> - - let apply (options : ObjectListFilterLinqOptions<'T, 'D>) (filter : ObjectListFilter) (query : IQueryable<'T>) = - let isEnumerableQuery = query.GetType().GetGenericTypeDefinition () = enumerableQueryType - // Helper for discriminator comparison - let buildTypeDiscriminatorCheck (param : SourceExpression) (t : Type) = - match options.CompareDiscriminator, options.GetDiscriminatorValue with - | ValueNone, ValueNone -> - Expression.Equal ( - // Default discriminator property - Expression.PropertyOrField (param, "__typename"), - // Default discriminator value - Expression.Constant (t.FullName) - ) - :> Expression - | ValueSome discExpr, ValueNone -> - // Replace parameters from the original expression with our new ones - let replacer = CompareDiscriminatorExpressionVisitor (discExpr, param, t.FullName) - replacer.Visit discExpr.Body - | ValueNone, ValueSome discValueFn -> - let discriminatorValue = discValueFn t - Expression.Equal ( - // Default discriminator property - Expression.PropertyOrField (param, "__typename"), - // Provided discriminator value gathered from type - Expression.Constant (discriminatorValue) - ) - :> Expression - | ValueSome discExpr, ValueSome discValueFn -> - let discriminatorValue = discValueFn t - // Replace parameters from the original expression with our new ones - let replacer = CompareDiscriminatorExpressionVisitor (discExpr, param, discriminatorValue) - replacer.Visit discExpr.Body - let queryExpr = - let param = Expression.Parameter (typeof<'T>, "x") - let body = buildFilterExpr isEnumerableQuery (SourceExpression param) buildTypeDiscriminatorCheck filter - whereExpr<'T> query param body - // Create and execute the final expression - query.Provider.CreateQuery<'T> (queryExpr) - -[] -module ObjectListFilterExtensions = - - open ObjectListFilter - - type ObjectListFilter with - - member inline filter.ApplyTo<'T, 'D> (query : IQueryable<'T>, [] options : ObjectListFilterLinqOptions<'T, 'D>) = - apply options filter query - - type IQueryable<'T> with - - member inline query.Apply (filter : ObjectListFilter, [] options : ObjectListFilterLinqOptions<'T, 'D>) = apply options filter query diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs new file mode 100644 index 00000000..3fe2a5fe --- /dev/null +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs @@ -0,0 +1,407 @@ +namespace FSharp.Data.GraphQL.Server.Middleware + +open System +open System.Collections +open System.Collections.Generic +open System.Linq +open System.Linq.Expressions +open System.Reflection +open System.Runtime.InteropServices +open FSharp.Data.GraphQL + +/// Contains tooling for working with ObjectListFilter. +[] +module ObjectListFilter = + /// Contains operators for building and comparing ObjectListFilter values. + module Operators = + /// Creates a new ObjectListFilter representing an AND operation between two existing ones. + let ( &&& ) x y = And (x, y) + + /// Creates a new ObjectListFilter representing an OR operation between two existing ones. + let ( ||| ) x y = Or (x, y) + + /// Creates a new ObjectListFilter representing an EQUALS operation between two comparable values. + let ( === ) fname value = Equals ({ FieldName = fname; Value = value }, null) + + /// Creates a new ObjectListFilter representing a GREATER THAN operation of a comparable value. + let ( >>> ) fname value = GreaterThan { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a GREATER THAN OR EQUAL operation of a comparable value. + let ( ==> ) fname value = GreaterThanOrEqual { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a LESS THAN operation of a comparable value. + let ( <<< ) fname value = LessThan { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a LESS THAN OR EQUAL operation of a comparable value. + let ( <== ) fname value = LessThanOrEqual { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a STARTS WITH operation of a string value. + let ( =@@ ) fname value = StartsWith ({ FieldName = fname; Value = value }, null) + + /// Creates a new ObjectListFilter representing an ENDS WITH operation of a string value. + let ( @@= ) fname value = EndsWith ({ FieldName = fname; Value = value }, null) + + /// Creates a new ObjectListFilter representing a CONTAINS operation. + let ( @=@ ) fname value = Contains ({ FieldName = fname; Value = value }, null) + + /// Creates a new ObjectListFilter representing a IN operation. + let ( =~= ) fname value = In { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a field sub comparison. + let ( --> ) fname filter = FilterField { FieldName = fname; Value = filter } + + /// Creates a new ObjectListFilter representing a NOT operation for the existing one. + let ( !!! ) filter = Not filter + + /// Creates a new ObjectListFilter representing a case-insensitive EQUALS operation on a string value. + let ( ===~ ) fname (value : string) = Equals ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) + + /// Creates a new ObjectListFilter representing a case-insensitive STARTS WITH operation on a string value. + let ( =@@~ ) fname (value : string) = StartsWith ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) + + /// Creates a new ObjectListFilter representing a case-insensitive ENDS WITH operation on a string value. + let ( @@=~ ) fname (value : string) = EndsWith ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) + + /// Creates a new ObjectListFilter representing a case-insensitive CONTAINS operation on a string value. + let ( @=@~ ) fname (value : string) = Contains ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) + + let private genericWhereMethod = + typeof.GetMethods () + |> Seq.where (fun m -> m.Name = "Where") + |> Seq.find (fun m -> + let parameters = m.GetParameters () + parameters.Length = 2 + && parameters[1].ParameterType.GetGenericTypeDefinition () = typedefof>>) + + // Helper to create Where expression + let whereExpr<'T> (query : IQueryable<'T>) (param : ParameterExpression) predicate = + let whereMethod = genericWhereMethod.MakeGenericMethod ([| typeof<'T> |]) + Expression.Call (whereMethod, [| query.Expression; Expression.Lambda> (predicate, param) |]) + + let private objectType = typeof + let private stringType = typeof + let private genericIEnumerableType = typedefof> + let private enumerableType = typeof + let private iEnumerableType = typeof + + let private stringComparisonType = typeof + let private StringStartsWithMethod = stringType.GetMethod ("StartsWith", [| stringType; stringComparisonType |]) + let private StringEndsWithMethod = stringType.GetMethod ("EndsWith", [| stringType; stringComparisonType |]) + let private StringContainsMethod = stringType.GetMethod ("Contains", [| stringType; stringComparisonType |]) + let private StringEqualsMethod = stringType.GetMethod ("Equals", [| stringType; stringComparisonType |]) + let private unwrapOptionMethod = + FSharp.Data.GraphQL.Helpers.moduleType.GetMethod (nameof Helpers.unwrap) + + let private getCollectionInstanceContainsMethod (memberType : Type) = + memberType + .GetMethods(BindingFlags.Instance ||| BindingFlags.Public) + .FirstOrDefault (fun m -> m.Name = "Contains" && m.GetParameters().Length = 1) + |> ValueOption.ofObj + + let private getEnumerableContainsMethod (itemType : Type) = + match + enumerableType + .GetMethods(BindingFlags.Static ||| BindingFlags.Public) + .FirstOrDefault (fun m -> m.Name = "Contains" && m.GetParameters().Length = 2) + with + | null -> raise (MissingMemberException "Static 'Contains' method with 2 parameters not found on 'Enumerable' class") + | containsGenericStaticMethod -> containsGenericStaticMethod.MakeGenericMethod ([| itemType |]) + + let private getEnumerableCastMethod (itemType : Type) = + match + enumerableType + .GetMethods(BindingFlags.Static ||| BindingFlags.Public) + .FirstOrDefault (fun m -> m.Name = "Cast" && m.GetParameters().Length = 1) + with + | null -> raise (MissingMemberException "Static 'Cast' method with 1 parameter not found on 'Enumerable' class") + | castGenericStaticMethod -> castGenericStaticMethod.MakeGenericMethod ([| itemType |]) + + let getField (param : ParameterExpression) fieldName = Expression.PropertyOrField (param, fieldName) + + let hasEqualityOperator (``type`` : Type) = + ``type``.GetMethods (BindingFlags.Public ||| BindingFlags.Static) + |> Seq.exists (fun m -> m.Name = " op_Equality") + + let hasInequalityOperator (``type`` : Type) = + ``type``.GetMethods (BindingFlags.Public ||| BindingFlags.Static) + |> Seq.exists (fun m -> m.Name = "op_Inequality") + + [] + type SourceExpression private (expression : Expression) = + new (parameter : ParameterExpression) = SourceExpression (parameter :> Expression) + new (``member`` : MemberExpression) = SourceExpression (``member`` :> Expression) + member _.Value = expression + static member op_Implicit (source : SourceExpression) = source.Value + static member op_Implicit (parameter : ParameterExpression) = SourceExpression (parameter :> Expression) + static member op_Implicit (``member`` : MemberExpression) = SourceExpression (``member`` :> Expression) + + let equalsMethod = + objectType + |> _.GetMethods(BindingFlags.Instance ||| BindingFlags.Public) + |> Seq.where (fun m -> m.Name = "Equals") + |> Seq.head + + let staticEqualsMethod = + objectType + |> _.GetMethods(BindingFlags.Static ||| BindingFlags.Public) + |> Seq.where (fun m -> m.Name = "Equals") + |> Seq.head + + /// Maps an IComparer to a StringComparison value. + /// Returns ValueNone for null or Ordinal comparers (use default Expression.Equal path). + let private comparerToStringComparison (comparer : IComparer) = + match comparer with + | null -> ValueNone + | :? StringComparer as sc -> + if obj.ReferenceEquals (sc, StringComparer.OrdinalIgnoreCase) then ValueSome StringComparison.OrdinalIgnoreCase + elif obj.ReferenceEquals (sc, StringComparer.InvariantCultureIgnoreCase) then ValueSome StringComparison.InvariantCultureIgnoreCase + elif obj.ReferenceEquals (sc, StringComparer.CurrentCultureIgnoreCase) then ValueSome StringComparison.CurrentCultureIgnoreCase + elif obj.ReferenceEquals (sc, StringComparer.Ordinal) then ValueSome StringComparison.Ordinal + elif obj.ReferenceEquals (sc, StringComparer.InvariantCulture) then ValueSome StringComparison.InvariantCulture + elif obj.ReferenceEquals (sc, StringComparer.CurrentCulture) then ValueSome StringComparison.CurrentCulture + else ValueNone + | _ -> ValueNone + + let rec buildFilterExpr isEnumerableQuery (param : SourceExpression) buildTypeDiscriminatorCheck filter : Expression = + + let build = buildFilterExpr isEnumerableQuery param buildTypeDiscriminatorCheck + + let (|NoCast|Enumerable|NonEnumerableCast|) value = + if obj.ReferenceEquals (value, null) then NoCast + else if isEnumerableQuery then Enumerable + else NonEnumerableCast (value.GetType ()) + + let unsafeConvertTo ``type`` ``member`` = Expression.Convert (Expression.Convert (``member``, objectType), ``type``) + + let normalizeStringMemberExpr (``member`` : MemberExpression) : Expression = + match ``member``.Type with + | t when t = stringType -> ``member`` + | _ when not isEnumerableQuery -> unsafeConvertTo stringType ``member`` + | _ when isEnumerableQuery -> Expression.Convert (Expression.Call (unwrapOptionMethod, ``member``), stringType) + | _ -> Expression.Convert (``member``, stringType) + + match filter with + | Not (Equals (f, comparer)) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match comparerToStringComparison comparer with + | ValueSome comparison -> + let value = Helpers.unwrap (box f.Value) :?> string + Expression.Not (Expression.Call (normalizeStringMemberExpr ``member``, StringEqualsMethod, Expression.Constant (value, stringType), Expression.Constant comparison)) :> Expression + | ValueNone -> + let hasEqualityOperator = hasEqualityOperator ``member``.Type + match f.Value with + | NoCast when hasEqualityOperator -> Expression.NotEqual (``member``, Expression.Constant f.Value) + | NoCast + | NonEnumerableCast _ -> + Expression.NotEqual (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) + | Enumerable -> + let normalized = Values.normalizeOptional ``member``.Type f.Value + let ``const`` = Expression.Constant (normalized) + let boxedArg = Expression.Convert (``member``, objectType) + Expression.Not (Expression.Call (``const``, equalsMethod, boxedArg)) + | Not f -> f |> build |> Expression.Not :> Expression + | And (f1, f2) -> Expression.AndAlso (build f1, build f2) + | Or (f1, f2) -> Expression.OrElse (build f1, build f2) + | Equals (f, comparer) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match comparerToStringComparison comparer with + | ValueSome comparison -> + let value = Helpers.unwrap (box f.Value) :?> string + Expression.Call (normalizeStringMemberExpr ``member``, StringEqualsMethod, Expression.Constant (value, stringType), Expression.Constant comparison) :> Expression + | ValueNone -> + let hasEqualityOperator = hasEqualityOperator ``member``.Type + match f.Value with + | NoCast when hasEqualityOperator -> Expression.Equal (``member``, Expression.Constant f.Value) + | NoCast + | NonEnumerableCast _ -> + Expression.Equal (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) + | Enumerable -> + let normalized = Values.normalizeOptional ``member``.Type f.Value + let ``const`` = Expression.Constant (normalized) + let boxedArg = Expression.Convert (``member``, objectType) + Expression.Call (``const``, equalsMethod, boxedArg) + | GreaterThan f -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match f.Value with + | NoCast -> Expression.GreaterThan (``member``, Expression.Constant f.Value) + | Enumerable -> Expression.GreaterThan (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) + | NonEnumerableCast ``type`` -> Expression.GreaterThan ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) + | LessThan f -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match f.Value with + | NoCast -> Expression.LessThan (``member``, Expression.Constant f.Value) + | Enumerable -> Expression.LessThan (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) + | NonEnumerableCast ``type`` -> Expression.LessThan ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) + | GreaterThanOrEqual f -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match f.Value with + | NoCast -> Expression.GreaterThanOrEqual (``member``, Expression.Constant f.Value) + | Enumerable -> Expression.GreaterThanOrEqual (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) + | NonEnumerableCast ``type`` -> Expression.GreaterThanOrEqual ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) + | LessThanOrEqual f -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match f.Value with + | NoCast -> Expression.LessThanOrEqual (``member``, Expression.Constant f.Value) + | Enumerable -> Expression.LessThanOrEqual (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) + | NonEnumerableCast ``type`` -> Expression.LessThanOrEqual ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) + | StartsWith (f, comparer) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.CurrentCulture + Expression.Call (normalizeStringMemberExpr ``member``, StringStartsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) + | EndsWith (f, comparer) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.CurrentCulture + Expression.Call (normalizeStringMemberExpr ``member``, StringEndsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) + + | Contains (f, comparer) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + let isEnumerable (memberType : Type) = + not (Type.(=) (memberType, stringType)) + && iEnumerableType.IsAssignableFrom (memberType) + && memberType.GetInterfaces().Any (fun i -> i.FullName.StartsWith "System.Collections.Generic.IEnumerable`1") + let normalizedValue = Values.normalizeOptional ``member``.Type f.Value + let callContains memberType = + let itemType = + if ``member``.Type.IsArray then + ``member``.Type.GetElementType () + else + ``member``.Type.GetGenericArguments()[0] + let valueType = + match normalizedValue with + | null -> itemType + | value -> value.GetType () + let castedMember = + if itemType = valueType then + ``member`` :> Expression + elif isEnumerableQuery then + let castMethod = getEnumerableCastMethod valueType + Expression.Call (castMethod, ``member``) + else + let castedEnumerableType = genericIEnumerableType.MakeGenericType ([| valueType |]) + unsafeConvertTo castedEnumerableType ``member`` + match getCollectionInstanceContainsMethod memberType with + | ValueNone -> + let enumerableContains = getEnumerableContainsMethod valueType + Expression.Call (enumerableContains, castedMember, Expression.Constant (normalizedValue)) + | ValueSome instanceContainsMethod -> Expression.Call (castedMember, instanceContainsMethod, Expression.Constant (normalizedValue)) + match ``member``.Member with + | :? PropertyInfo as prop when prop.PropertyType |> isEnumerable -> callContains prop.PropertyType + | :? FieldInfo as field when field.FieldType |> isEnumerable -> callContains field.FieldType + | _ -> + let unwrappedValue = Helpers.unwrap f.Value + let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.CurrentCulture + Expression.Call (normalizeStringMemberExpr ``member``, StringContainsMethod, Expression.Constant (unwrappedValue :?> string, stringType), Expression.Constant comparison) + | In f when not (f.Value.IsEmpty) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + let enumerableContains = getEnumerableContainsMethod objectType + Expression.Call (enumerableContains, (Expression.Constant f.Value), Expression.Convert (``member``, objectType)) + | In f -> Expression.Constant (false) + | OfTypes types -> + types + |> Seq.map (fun t -> buildTypeDiscriminatorCheck param t) + |> Seq.reduce (fun acc expr -> Expression.OrElse (acc, expr)) + | FilterField f -> + let paramExpr = Expression.PropertyOrField (param, f.FieldName) + buildFilterExpr isEnumerableQuery (SourceExpression paramExpr) buildTypeDiscriminatorCheck f.Value + + type private CompareDiscriminatorExpressionVisitor<'T, 'D> + (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>, param : SourceExpression, value : obj) = + inherit ExpressionVisitor () + override _.VisitParameter (node) = + if node = compareDiscriminator.Parameters.[0] then + param.Value + elif node = compareDiscriminator.Parameters.[1] then + Expression.Constant (value) :> Expression + else + node :> Expression + + let enumerableQueryType = typedefof> + + let apply (options : ObjectListFilterLinqOptions<'T, 'D>) (filter : ObjectListFilter) (query : IQueryable<'T>) = + let isEnumerableQuery = query.GetType().GetGenericTypeDefinition () = enumerableQueryType + // Helper for discriminator comparison + let buildTypeDiscriminatorCheck (param : SourceExpression) (t : Type) = + match options.CompareDiscriminator, options.GetDiscriminatorValue with + | ValueNone, ValueNone -> + Expression.Equal ( + // Default discriminator property + Expression.PropertyOrField (param, "__typename"), + // Default discriminator value + Expression.Constant (t.FullName) + ) + :> Expression + | ValueSome discExpr, ValueNone -> + // Replace parameters from the original expression with our new ones + let replacer = CompareDiscriminatorExpressionVisitor (discExpr, param, t.FullName) + replacer.Visit discExpr.Body + | ValueNone, ValueSome discValueFn -> + let discriminatorValue = discValueFn t + Expression.Equal ( + // Default discriminator property + Expression.PropertyOrField (param, "__typename"), + // Provided discriminator value gathered from type + Expression.Constant (discriminatorValue) + ) + :> Expression + | ValueSome discExpr, ValueSome discValueFn -> + let discriminatorValue = discValueFn t + // Replace parameters from the original expression with our new ones + let replacer = CompareDiscriminatorExpressionVisitor (discExpr, param, discriminatorValue) + replacer.Visit discExpr.Body + let queryExpr = + let param = Expression.Parameter (typeof<'T>, "x") + let body = buildFilterExpr isEnumerableQuery (SourceExpression param) buildTypeDiscriminatorCheck filter + whereExpr<'T> query param body + // Create and execute the final expression + query.Provider.CreateQuery<'T> (queryExpr) + +[] +module ObjectListFilterExtensions = + + open ObjectListFilter + + type ObjectListFilter with + + /// + /// Applies the filter to a queryable with automatic type coercion of JSON primitives to CLR types. + /// Supports , , , , and F# discriminated unions. + /// Pass via ObjectListFilterLinqOptions constructor for custom serialization. + /// + /// + /// + /// // Basic usage - automatic coercion of string to Guid + /// let filter = "id" === "550e8400-e29b-41d4-a716-446655440000" + /// let users = filter.ApplyTo query + /// + /// // With custom JsonSerializerOptions + /// let opts = JsonSerializerOptions(PropertyNameCaseInsensitive = true) + /// let options = ObjectListFilterLinqOptions(opts) + /// let events = filter.ApplyTo(query, options) + /// + /// + member inline filter.ApplyTo<'T, 'D> (query : IQueryable<'T>, [] options : ObjectListFilterLinqOptions<'T, 'D> | null) = + let options = options |> ValueOption.ofObj |> ValueOption.defaultValue ObjectListFilterLinqOptions<'T, 'D>.None + let filter = TypeCoercion.coerceFilter options.JsonOptions typeof<'T> filter + apply options filter query + + type IQueryable<'T> with + + /// + /// Applies the filter with automatic type coercion of JSON primitives to CLR types. Supports , , + /// , , and F# discriminated unions. Pass via + /// ObjectListFilterLinqOptions constructor for custom serialization. + /// + /// + /// + /// // Basic usage - automatic coercion of string to Guid + /// let filter = "id" === "550e8400-e29b-41d4-a716-446655440000" + /// let users = query.Apply filter + /// + /// // With custom JsonSerializerOptions + /// let opts = JsonSerializerOptions(PropertyNameCaseInsensitive = true) + /// let options = ObjectListFilterLinqOptions(opts) + /// let events = query.Apply(filter, options) + /// + /// + member inline query.Apply (filter : ObjectListFilter, [] options : ObjectListFilterLinqOptions<'T, 'D> | null) = + filter.ApplyTo (query, options) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs b/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs index 813c3b7b..2fd6951d 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs @@ -20,7 +20,6 @@ type private ComparisonOperator = | LessThanOrEqual of string | In of string - let rec private coerceObjectListFilterInput (variables : Variables) inputValue : Result = let parseFieldCondition (s : string) = @@ -184,7 +183,7 @@ let ObjectListFilterType : InputCustomDefinition = { (String.concat " " [ - "The ObjectListFilter value represents field filters for object lists." + "The `ObjectListFilter` value represents field filters for object lists." "Lowercase string suffixes such as `_starts_with`/`_sw`, `_ends_with`/`_ew`, `_contains` (no shorthand), and `_equals`/`_eq` are case-insensitive when applied to string fields." "Capitalized string suffixes such as `_Starts_With`/`_SW`, `_Ends_With`/`_EW`, `_Contains` (no shorthand), and `_Equals`/`_EQ` are case-sensitive when applied to string fields." "Comparison suffixes such as `_gt`, `_gte`, `_lt`, `_lte`, and `_in` are also supported." diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs new file mode 100644 index 00000000..78cc0f25 --- /dev/null +++ b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs @@ -0,0 +1,259 @@ +namespace FSharp.Data.GraphQL.Server.Middleware + +open System +open System.Buffers +open System.Collections.Generic +open System.Reflection +open System.Text.Json +open FSharp.Data.GraphQL +open FSharp.Data.GraphQL.Extensions + +[] +module TypeCoercion = + + /// Case-insensitive instance property lookup. The middleware lowercases field names during + /// parsing, so we must also ignore casing here. + let propertyBindFlags = + BindingFlags.Public + ||| BindingFlags.Instance + ||| BindingFlags.IgnoreCase + + // Cached type references + let private stringType = typeof + + /// + /// If is voption, option, or Skippable, returns the inner type; otherwise . + /// + let tryUnwrapOption (t : Type) : Type voption = + if t.IsGenericType then + let fullName = t.GetGenericTypeDefinition().FullName + if + fullName.StartsWith ReflectionHelper.ValueOptionTypeName + || fullName.StartsWith ReflectionHelper.OptionTypeName + || fullName.StartsWith ReflectionHelper.SkippableTypeName + then + ValueSome (t.GetGenericArguments().[0]) + else + ValueNone + else + ValueNone + + let unwrapOption (t : Type) : Type = + tryUnwrapOption t |> ValueOption.defaultValue t + + /// + /// If is a generic collection, returns the element type. Handles both concrete collections (where IEnumerable is an + /// implemented interface) and properties typed directly as IEnumerable<T>. + /// + let tryUnwrapEnumerableElement (t : Type) : Type voption = + let isEnumerableInterface (i : Type) = + i.IsGenericType + && Type.(=) (i.GetGenericTypeDefinition (), typedefof>) + if Type.(=) (t, stringType) then + ValueNone + elif t.IsArray then + t.GetElementType () |> ValueOption.ofObj + elif isEnumerableInterface t then + ValueSome (t.GetGenericArguments()[0]) + else + t.GetInterfaces () + |> Array.vtryFind isEnumerableInterface + |> ValueOption.map (fun i -> i.GetGenericArguments()[0]) + + /// + /// Suffixes the middleware's parser preserves on FieldFilter.FieldName for scalar operators (e.g. meetingId_eq, + /// validFrom_gte). They must be stripped before resolving the actual CLR property. + /// These correspond to the lowercase variants produced after Phase 2 parsing in SchemaDefinitions.parseFieldCondition. Longer suffixes are + /// listed first to prevent shorter ones (e.g. _gt) from incorrectly matching longer ones (e.g. _gte). + /// + let operatorSuffixes = + [| + // String operators (case-insensitive variants) + FilterSuffixConstants.CI.StartsWithSuffix + FilterSuffixConstants.CI.EndsWithSuffix + FilterSuffixConstants.CI.SWSuffix + FilterSuffixConstants.CI.EWSuffix + FilterSuffixConstants.CI.ContainsSuffix + FilterSuffixConstants.CI.EqualsSuffix + FilterSuffixConstants.CI.EQSuffix + // String operators (case-sensitive variants) + FilterSuffixConstants.CS.StartsWithSuffix + FilterSuffixConstants.CS.EndsWithSuffix + FilterSuffixConstants.CS.SWSuffix + FilterSuffixConstants.CS.EWSuffix + FilterSuffixConstants.CS.ContainsSuffix + FilterSuffixConstants.CS.EqualsSuffix + FilterSuffixConstants.CS.EQSuffix + // Numeric/comparison operators (from root) + FilterSuffixConstants.GreaterThanOrEqualSuffix + FilterSuffixConstants.LessThanOrEqualSuffix + FilterSuffixConstants.GreaterThanSuffix + FilterSuffixConstants.LessThanSuffix + FilterSuffixConstants.GTESuffix + FilterSuffixConstants.LTESuffix + FilterSuffixConstants.GTSuffix + FilterSuffixConstants.LTSuffix + FilterSuffixConstants.InSuffix + |] + + let stripOperatorSuffix (fieldName : string) : string = + operatorSuffixes + |> Array.vtryFind (fun s -> fieldName.EndsWith (s, StringComparison.OrdinalIgnoreCase)) + |> ValueOption.map (fun s -> fieldName.Substring (0, fieldName.Length - s.Length)) + |> ValueOption.defaultValue fieldName + + /// + /// Writes a boxed GraphQL scalar primitive as a JSON token directly into . Strings become JSON strings; numbers and + /// booleans become raw JSON tokens. Returns true if the value was written; false if the type is unsupported. + /// + let private writeJsonValue (value : obj) (writer : Utf8JsonWriter) : bool = + match value with + | :? string as s -> + writer.WriteStringValue s + true + | :? bool as b -> + writer.WriteBooleanValue b + true + | :? int64 as n -> + writer.WriteNumberValue n + true + | :? int as n -> + writer.WriteNumberValue n + true + | :? double as n -> + writer.WriteNumberValue n + true + | :? float32 as n -> + writer.WriteNumberValue n + true + | :? decimal as n -> + writer.WriteNumberValue n + true + | _ -> + false + + // Suppress nullness warnings for the obj / objnull mixture. +#nowarn "3261" + /// + /// Tries to coerce a value into using STJ deserialization. Primitives are written directly as JSON bytes via + /// into an , then deserialized from ReadOnlySpan<byte>. + /// Already-correct values pass through unchanged. No intermediate string or is allocated. + /// + let tryCoerceValue (jsonOptions : JsonSerializerOptions voption) (targetType : Type) (value : objnull) : obj voption = + if isNull value then + ValueNone + elif targetType.IsInstanceOfType value then + ValueSome value + else + let buffer = ArrayBufferWriter 64 + use writer = new Utf8JsonWriter (buffer) + if not (writeJsonValue value writer) then + ValueNone + else + writer.Flush () + try + let opts = jsonOptions |> ValueOption.defaultValue JsonSerializerOptions.Default + JsonSerializer.Deserialize (buffer.WrittenSpan, targetType, opts) |> ValueSome + with _ -> + ValueNone + + /// + /// Coerces an entire tree recursively by resolving the entities's properties and converting filter values into the + /// property's CLR type. + /// + let rec coerceFilter (jsonOptions : JsonSerializerOptions voption) (entityType : Type) (filter : ObjectListFilter) : ObjectListFilter = + match filter with + | And (l, r) -> And (coerceFilter jsonOptions entityType l, coerceFilter jsonOptions entityType r) + | Or (l, r) -> Or (coerceFilter jsonOptions entityType l, coerceFilter jsonOptions entityType r) + | Not f -> Not (coerceFilter jsonOptions entityType f) + | OfTypes _ -> filter + | Equals (ff, cmp) -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + match tryCoerceValue jsonOptions unwrapped (box ff.Value) with + | ValueNone -> filter + | ValueSome (:? IComparable as coerced) -> Equals ({ ff with Value = coerced }, cmp) + | ValueSome _ -> filter + | GreaterThan ff + | GreaterThanOrEqual ff + | LessThan ff + | LessThanOrEqual ff as originalFilter -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + match tryCoerceValue jsonOptions unwrapped (box ff.Value) with + | ValueNone -> filter + | ValueSome (:? IComparable as coerced) -> + let coercedField = { ff with Value = coerced } + match originalFilter with + | GreaterThan _ -> GreaterThan coercedField + | GreaterThanOrEqual _ -> GreaterThanOrEqual coercedField + | LessThan _ -> LessThan coercedField + | LessThanOrEqual _ -> LessThanOrEqual coercedField + | _ -> filter + | ValueSome _ -> filter + | In ff -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + + let struct (coercedValues, failedValues) = + ff.Value + |> List.fold + (fun struct (coerced, failed) value -> + match tryCoerceValue jsonOptions unwrapped value with + | ValueSome coercedValue -> (coercedValue :: coerced, failed) + | ValueNone -> struct (coerced, value :: failed)) + ([], []) + + match failedValues with + | [] -> In { ff with Value = List.rev coercedValues } + | _ -> + let failedValuesText = + failedValues + |> Seq.rev + |> Seq.map (sprintf "%A") + |> String.concat ", " + + invalidArg + (nameof filter) + ($"Unable to coerce one or more values for '{ff.FieldName}' to '{unwrapped.FullName}'. Uncoerced values: [{failedValuesText}]") + | StartsWith (ff, cmp) + | EndsWith (ff, cmp) as originalFilter -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | _ -> + match tryCoerceValue jsonOptions stringType (box ff.Value) with + | ValueNone -> filter + | ValueSome coerced -> + let coercedField = { ff with Value = coerced :?> string } + match originalFilter with + | StartsWith (_, cmp) -> StartsWith (coercedField, cmp) + | EndsWith (_, cmp) -> EndsWith (coercedField, cmp) + | _ -> filter + | Contains (ff, cmp) -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + let coercionTarget = + match tryUnwrapEnumerableElement unwrapped with + | ValueSome elementType -> elementType + | ValueNone -> stringType + match tryCoerceValue jsonOptions coercionTarget (box ff.Value) with + | ValueNone -> filter + | ValueSome (:? IComparable as coerced) -> Contains ({ ff with Value = coerced }, cmp) + | ValueSome _ -> filter + | FilterField ff -> + match entityType.GetProperty (ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + let nestedType = + tryUnwrapEnumerableElement unwrapped + |> ValueOption.defaultValue unwrapped + FilterField { FieldName = ff.FieldName; Value = coerceFilter jsonOptions nestedType ff.Value } diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/TypeSystemExtensions.fs b/src/FSharp.Data.GraphQL.Server.Middleware/TypeSystemExtensions.fs index 955684e1..215e321f 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/TypeSystemExtensions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/TypeSystemExtensions.fs @@ -3,9 +3,7 @@ namespace FSharp.Data.GraphQL.Server.Middleware open System open System.Collections.Immutable open System.Linq -open FsToolkit.ErrorHandling -open FSharp.Data.GraphQL open FSharp.Data.GraphQL.Types /// Contains extensions for the type system. diff --git a/src/FSharp.Data.GraphQL.Shared/Helpers/Extensions.fs b/src/FSharp.Data.GraphQL.Shared/Helpers/Extensions.fs index 603ba60f..b1a26099 100644 --- a/src/FSharp.Data.GraphQL.Shared/Helpers/Extensions.fs +++ b/src/FSharp.Data.GraphQL.Shared/Helpers/Extensions.fs @@ -85,6 +85,35 @@ module Array = i <- i + 1 Array.sub temp 0 i + /// + /// Attempts to find the first element in an array that satisfies the given predicate. + /// + /// Function to test each element. + /// The input array. + /// ValueSome of the first matching element, or ValueNone if no match is found. + let vtryFind predicate (source : 'T array) = + let mutable result = ValueNone + let mutable i = 0 + while i < source.Length && result.IsNone do + if predicate source[i] then + result <- ValueSome source[i] + i <- i + 1 + result + + /// + /// Applies a function to each element of an array and returns the first result where the function returns ValueSome. + /// + /// Function to apply to each element. + /// The input array. + /// ValueSome of the first successful mapping result, or ValueNone if no match is found. + let vtryPick mapping (source : 'T array) = + let mutable result = ValueNone + let mutable i = 0 + while i < source.Length && result.IsNone do + result <- mapping source[i] + i <- i + 1 + result + module List = /// @@ -99,6 +128,35 @@ module List = |> List.filter (fun x -> not <| List.exists(fun y -> f(x) = f(y)) listy) uniqx @ listy + /// + /// Attempts to find the first element in a list that satisfies the given predicate. + /// + /// Function to test each element. + /// The input list. + /// ValueSome of the first matching element, or ValueNone if no match is found. + let rec vtryFind predicate (source : 'T list) = + match source with + | [] -> ValueNone + | head :: tail -> + if predicate head then + ValueSome head + else + vtryFind predicate tail + + /// + /// Applies a function to each element of a list and returns the first result where the function returns ValueSome. + /// + /// Function to apply to each element. + /// The input list. + /// ValueSome of the first successful mapping result, or ValueNone if no match is found. + let rec vtryPick mapping (source : 'T list) = + match source with + | [] -> ValueNone + | head :: tail -> + match mapping head with + | ValueSome result -> ValueSome result + | ValueNone -> vtryPick mapping tail + module Set = /// diff --git a/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj b/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj index 1bc22455..e6d4ac25 100644 --- a/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj +++ b/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj @@ -75,8 +75,11 @@ - - + + + + + diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqGenerateTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs similarity index 96% rename from tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqGenerateTests.fs rename to tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs index c8a39200..5f103002 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqGenerateTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs @@ -1,4 +1,6 @@ -module FSharp.Data.GraphQL.Tests.ObjectListFilterLinqGenerateTests +[] +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.Linq.GenerateTests open Xunit open System @@ -99,6 +101,7 @@ let cosmosClient = new CosmosClient ("https://localhost:8081/", "C2y6yDjf5/R+ob0N8A7Cgv30VRDJIWEHLM+4QDU5DE2nQ9nDuVTqobD4b8mGGyPMbIZnqyMsEcaGQy67XIw/Jw==", options) let container = cosmosClient.GetContainer ("database", "container") let filterOptions = ObjectListFilterLinqOptions.None +let filterOptionsWithConverters = ObjectListFilterLinqOptions (jsonOptions) [] let ``ObjectListFilter works with Equals operator for ValidStringStruct`` () = @@ -245,13 +248,20 @@ let ``ObjectListFilter works with Contains operator for ValidStringStruct list`` equals queryDefinition.QueryText, """SELECT VALUE root FROM root WHERE ARRAY_CONTAINS(root["validStringStructList"], "athan")""" [] -let ``ObjectListFilter works with In operator for ValidStringStruct list`` () = +let ``ObjectListFilter works with In operator for ValidStringStruct list when converters are provided`` () = let queryable = container.GetItemLinqQueryable () let filter = In { FieldName = "validStringStruct"; Value = [ "athan"; "gaja" ] } - let filterQuery = queryable.Apply (filter, filterOptions) + let filterQuery = queryable.Apply (filter, filterOptionsWithConverters) let queryDefinition = CosmosLinqExtensions.ToQueryDefinition filterQuery equals queryDefinition.QueryText, """SELECT VALUE root FROM root WHERE ARRAY_CONTAINS([ "athan", "gaja" ], root["validStringStruct"])""" +[] +let ``ObjectListFilter works with In operator for ValidStringStruct list when converters are not provided`` () = + let queryable = container.GetItemLinqQueryable () + let filter = In { FieldName = "validStringStruct"; Value = [ "athan"; "gaja" ] } + let ex = Assert.Throws(fun () -> queryable.Apply (filter, filterOptions) |> ignore) + Assert.Contains ("Uncoerced values", ex.Message) + [] let ``ObjectListFilter works with In operator for empty ValidStringStruct list`` () = let queryable = container.GetItemLinqQueryable () diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqTests.fs similarity index 99% rename from tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqTests.fs rename to tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqTests.fs index bdd14b70..133e24a0 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqTests.fs @@ -1,4 +1,6 @@ -module FSharp.Data.GraphQL.Tests.ObjectListFilterLinqTests +[] +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.Linq.Tests open Xunit open System diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs new file mode 100644 index 00000000..b137f3da --- /dev/null +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs @@ -0,0 +1,238 @@ +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.FilterTests + +open Xunit +open FSharp.Data.GraphQL.Server.Middleware +open FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.Common + +// ────────────────────────────────────────────────────────────────────────────── +// Equals operator +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces string to Guid for Equals`` () = + let filter = Equals ({ FieldName = "guidField"; Value = "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter coerces string to CLR enum for Equals`` () = + let filter = Equals ({ FieldName = "color"; Value = "Green" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Bob" + +[] +let ``coerceFilter coerces int to CLR enum for Equals`` () = + let filter = Equals ({ FieldName = "color"; Value = 2 }, null) // Blue = 2 + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +[] +let ``coerceFilter coerces string to DU-as-enum for Equals`` () = + let filter = Equals ({ FieldName = "status"; Value = "Active" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter coerces string to single-case DU wrapping string for Equals`` () = + let filter = Equals ({ FieldName = "wrappedName"; Value = "Bob" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Bob" + +[] +let ``coerceFilter coerces int to single-case DU wrapping int for Equals`` () = + let filter = Equals ({ FieldName = "wrappedScore"; Value = 30 }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +[] +let ``coerceFilter coerces int64 to single-case DU wrapping int64 for Equals`` () = + let filter = Equals ({ FieldName = "wrappedLong"; Value = 200L }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Bob" + +[] +let ``coerceFilter coerces string to single-case DU wrapping Guid for Equals`` () = + let filter = Equals ({ FieldName = "wrappedGuid"; Value = "cccccccc-cccc-cccc-cccc-cccccccccccc" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +[] +let ``coerceFilter passes through bool for Equals`` () = + let filter = Equals ({ FieldName = "isActive"; Value = true }, null) + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.forall (fun e -> e.IsActive) |> equals true + +// ────────────────────────────────────────────────────────────────────────────── +// comparison operators (GreaterThan / LessThan) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces int to decimal for GreaterThanOrEqual`` () = + // Score: Alice=100, Bob=200, Charlie=300. >= 200 -> Bob and Charlie + let filter = GreaterThanOrEqual { FieldName = "score"; Value = 200 } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Bob"; "Charlie" ] + +[] +let ``coerceFilter coerces string to DateTime for GreaterThan`` () = + // CreatedAt: Alice=2024-01-01, Bob=2024-02-01, Charlie=2024-03-01. > 2024-01-15 + let filter = GreaterThan { FieldName = "createdAt"; Value = "2024-01-15T00:00:00" } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Bob"; "Charlie" ] + +[] +let ``coerceFilter coerces string to DateOnly for LessThan`` () = + // BirthDate: Alice=1990-05-15, Bob=1985-08-20, Charlie=2000-12-31. < 2000-01-01 + let filter = LessThan { FieldName = "birthDate"; Value = "2000-01-01" } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Bob" ] + +[] +let ``coerceFilter coerces string to TimeOnly for GreaterThan`` () = + // AlarmTime: Alice=08:00, Bob=09:00, Charlie=10:00. > 08:30 -> Bob and Charlie + let filter = GreaterThan { FieldName = "alarmTime"; Value = "08:30:00" } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Bob"; "Charlie" ] + +// ────────────────────────────────────────────────────────────────────────────── +// option / voption field unwrapping +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces string through option wrapper for Equals`` () = + let filter = Equals ({ FieldName = "optionName"; Value = "Alice" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter coerces int through voption wrapper for Equals`` () = + let filter = Equals ({ FieldName = "vOptionId"; Value = 3 }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +// ────────────────────────────────────────────────────────────────────────────── +// In operator +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces In operator values to CLR enum`` () = + let filter = In { FieldName = "color"; Value = [ box "Red"; box "Blue" ] } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Charlie" ] + +[] +let ``coerceFilter coerces In operator values to DU-as-enum`` () = + let filter = In { FieldName = "status"; Value = [ box "Active"; box "Pending" ] } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Charlie" ] + +[] +let ``coerceFilter coerces In operator values to Guid`` () = + let filter = + In { + FieldName = "guidField" + Value = [ + box "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa" + box "bbbbbbbb-bbbb-bbbb-bbbb-bbbbbbbbbbbb" + ] + } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Bob" ] + +[] +let ``coerceFilter coerces In operator values to single-case DU wrapping int`` () = + let filter = In { FieldName = "wrappedScore"; Value = [ box 10; box 30 ] } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Charlie" ] + +// ────────────────────────────────────────────────────────────────────────────── +// string operators +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter handles StartsWith for plain string field`` () = + let filter = StartsWith ({ FieldName = "name"; Value = "Al" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter handles EndsWith for plain string field`` () = + let filter = EndsWith ({ FieldName = "name"; Value = "ie" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +[] +let ``coerceFilter handles Contains for plain string field`` () = + let filter = Contains ({ FieldName = "name"; Value = "ob" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Bob" + +[] +let ``coerceFilter handles Contains for list field (element membership)`` () = + // Tags: Alice=["admin";"user"], Bob=["user"], Charlie=["moderator";"user"] + let filter = Contains ({ FieldName = "tags"; Value = "admin" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter handles Contains for list field matching multiple entities`` () = + let filter = Contains ({ FieldName = "tags"; Value = "user" }, null) + let result = applyFilter filter + result |> List.length |> equals 3 + +// ────────────────────────────────────────────────────────────────────────────── +// AND / OR / NOT combinators +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces values inside AND`` () = + let filter = + And ( + Equals ({ FieldName = "color"; Value = "Red" }, null), + Equals ({ FieldName = "status"; Value = "Active" }, null) + ) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter coerces values inside OR`` () = + let filter = + Or ( + Equals ({ FieldName = "color"; Value = "Red" }, null), + Equals ({ FieldName = "color"; Value = "Blue" }, null) + ) + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Charlie" ] + +[] +let ``coerceFilter coerces values inside NOT`` () = + let filter = Not (Equals ({ FieldName = "status"; Value = "Active" }, null)) + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Bob"; "Charlie" ] diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs new file mode 100644 index 00000000..d6d37756 --- /dev/null +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs @@ -0,0 +1,136 @@ +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.Common + +open System +open System.Linq +open System.Text.Json +open FSharp.Data.GraphQL.Shared +open FSharp.Data.GraphQL.Server.Middleware + +// ────────────────────────────────────────────────────────────────────────────── +// Test types +// ────────────────────────────────────────────────────────────────────────────── + +/// CLR enum — coerced from string via JsonStringEnumConverter or from int via default STJ. +type Color = + | Red = 0 + | Green = 1 + | Blue = 2 + +/// Multi-case fieldless DU (DU-as-enum) — coerced from string via +/// FSharp.SystemTextJson UnwrapFieldlessTags. +type Status = + | Active + | Inactive + | Pending + +/// Single-case DU wrapping a string — coerced via FSharp.SystemTextJson UnwrapSingleCaseUnions. +type WrappedString = WrappedString of string + +/// Single-case DU wrapping an int. +type WrappedInt = WrappedInt of int + +/// Single-case DU wrapping an int64. +type WrappedInt64 = WrappedInt64 of int64 + +/// Single-case DU wrapping a Guid. +type WrappedGuid = WrappedGuid of Guid + +/// Entity used in coerceFilter integration tests. +type CoercionEntity = { + Id: int + Name: string + Status: Status + Color: Color + GuidField: Guid + WrappedName: WrappedString + WrappedScore: WrappedInt + WrappedLong: WrappedInt64 + WrappedGuid: WrappedGuid + CreatedAt: DateTime + BirthDate: DateOnly + AlarmTime: TimeOnly + Score: decimal + IsActive: bool + Tags: string list + OptionName: string option + VOptionId: int voption +} + +// ────────────────────────────────────────────────────────────────────────────── +// Shared test infrastructure +// ────────────────────────────────────────────────────────────────────────────── + +/// Full serializer options including FSharp.SystemTextJson (DU coercion) and +/// JsonStringEnumConverter (CLR enum coercion). +let jsonOptions = ValueSome (Json.getSerializerOptions Seq.empty) + +/// No options — uses STJ defaults; sufficient for primitives, Guid, date/time. +let noOptions : JsonSerializerOptions voption = ValueNone + +let filterOptions = + ObjectListFilterLinqOptions (Json.getSerializerOptions Seq.empty) + +let testData = + [| + { + Id = 1 + Name = "Alice" + Status = Active + Color = Color.Red + GuidField = Guid.Parse "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa" + WrappedName = WrappedString "Alice" + WrappedScore = WrappedInt 10 + WrappedLong = WrappedInt64 100L + WrappedGuid = WrappedGuid (Guid.Parse "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa") + CreatedAt = DateTime (2024, 1, 1) + BirthDate = DateOnly (1990, 5, 15) + AlarmTime = TimeOnly (8, 0) + Score = 100m + IsActive = true + Tags = [ "admin"; "user" ] + OptionName = Some "Alice" + VOptionId = ValueSome 1 + } + { + Id = 2 + Name = "Bob" + Status = Inactive + Color = Color.Green + GuidField = Guid.Parse "bbbbbbbb-bbbb-bbbb-bbbb-bbbbbbbbbbbb" + WrappedName = WrappedString "Bob" + WrappedScore = WrappedInt 20 + WrappedLong = WrappedInt64 200L + WrappedGuid = WrappedGuid (Guid.Parse "bbbbbbbb-bbbb-bbbb-bbbb-bbbbbbbbbbbb") + CreatedAt = DateTime (2024, 2, 1) + BirthDate = DateOnly (1985, 8, 20) + AlarmTime = TimeOnly (9, 0) + Score = 200m + IsActive = false + Tags = [ "user" ] + OptionName = None + VOptionId = ValueNone + } + { + Id = 3 + Name = "Charlie" + Status = Pending + Color = Color.Blue + GuidField = Guid.Parse "cccccccc-cccc-cccc-cccc-cccccccccccc" + WrappedName = WrappedString "Charlie" + WrappedScore = WrappedInt 30 + WrappedLong = WrappedInt64 300L + WrappedGuid = WrappedGuid (Guid.Parse "cccccccc-cccc-cccc-cccc-cccccccccccc") + CreatedAt = DateTime (2024, 3, 1) + BirthDate = DateOnly (2000, 12, 31) + AlarmTime = TimeOnly (10, 0) + Score = 300m + IsActive = true + Tags = [ "moderator"; "user" ] + OptionName = Some "Charlie" + VOptionId = ValueSome 3 + } + |] + +let applyFilter (filter : ObjectListFilter) = + filter.ApplyTo (testData.AsQueryable (), filterOptions) |> Seq.toList diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs new file mode 100644 index 00000000..123d354c --- /dev/null +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs @@ -0,0 +1,210 @@ +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.ValueTests + +open Xunit +open System +open FSharp.Data.GraphQL.Server.Middleware +open FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.Common + +// ────────────────────────────────────────────────────────────────────────────── +// pass-through (value already has the target type) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue passes through string`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "hello") + |> wantValueSome |> equals (box "hello") + +[] +let ``tryCoerceValue passes through int`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 42) + |> wantValueSome |> equals (box 42) + +[] +let ``tryCoerceValue passes through bool`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box true) + |> wantValueSome |> equals (box true) + +[] +let ``tryCoerceValue passes through Guid`` () = + let g = Guid.NewGuid () + TypeCoercion.tryCoerceValue noOptions typeof (box g) + |> wantValueSome |> equals (box g) + +[] +let ``tryCoerceValue passes through decimal`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 9.99m) + |> wantValueSome |> equals (box 9.99m) + +[] +let ``tryCoerceValue passes through DateTime`` () = + let dt = DateTime (2024, 6, 1) + TypeCoercion.tryCoerceValue noOptions typeof (box dt) + |> wantValueSome |> equals (box dt) + +// ────────────────────────────────────────────────────────────────────────────── +// null → ValueNone +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue returns ValueNone for null`` () = + TypeCoercion.tryCoerceValue noOptions typeof null + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// numeric widening / narrowing +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces int to int64`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 42) + |> wantValueSome |> equals (box 42L) + +[] +let ``tryCoerceValue returns ValueNone for string-to-int (STJ rejects quoted number)`` () = + // STJ does not coerce quoted strings to numbers without JsonNumberHandling.AllowReadingFromString + TypeCoercion.tryCoerceValue noOptions typeof (box "99") + |> wantValueNone + +[] +let ``tryCoerceValue returns ValueNone for string-to-int64 (STJ rejects quoted number)`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "123456789") + |> wantValueNone + +[] +let ``tryCoerceValue coerces double to decimal`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 3.14) + |> wantValueSome |> equals (box 3.14m) + +[] +let ``tryCoerceValue coerces int to decimal`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 200) + |> wantValueSome |> equals (box 200m) + +[] +let ``tryCoerceValue passes through bool (already correct type)`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box true) + |> wantValueSome |> equals (box true) + +// ────────────────────────────────────────────────────────────────────────────── +// string → Guid +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces string to Guid`` () = + let g = Guid.Parse "550e8400-e29b-41d4-a716-446655440000" + TypeCoercion.tryCoerceValue noOptions typeof (box "550e8400-e29b-41d4-a716-446655440000") + |> wantValueSome |> equals (box g) + +[] +let ``tryCoerceValue returns ValueNone for invalid Guid string`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "not-a-guid") + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// string → date/time types (native STJ support) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces ISO string to DateTime`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "2024-06-01T00:00:00") + |> wantValueSome |> equals (box (DateTime (2024, 6, 1, 0, 0, 0))) + +[] +let ``tryCoerceValue coerces ISO string to DateTimeOffset`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "2024-06-01T12:00:00+00:00") + |> wantValueSome |> ignore + +[] +let ``tryCoerceValue coerces ISO string to DateOnly`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "2024-06-01") + |> wantValueSome |> equals (box (DateOnly (2024, 6, 1))) + +[] +let ``tryCoerceValue coerces ISO string to TimeOnly`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "14:30:00") + |> wantValueSome |> equals (box (TimeOnly (14, 30, 0))) + +// ────────────────────────────────────────────────────────────────────────────── +// CLR enum +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces int to CLR enum without jsonOptions`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 2) + |> wantValueSome |> equals (box Color.Blue) + +[] +let ``tryCoerceValue coerces string to CLR enum with jsonOptions (JsonStringEnumConverter)`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Green") + |> wantValueSome |> equals (box Color.Green) + +[] +let ``tryCoerceValue returns ValueNone for string CLR enum without jsonOptions`` () = + // Without JsonStringEnumConverter, STJ rejects string enum tokens by default + TypeCoercion.tryCoerceValue noOptions typeof (box "Red") + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// single-case DU (requires FSharp.SystemTextJson UnwrapSingleCaseUnions) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces string to single-case DU wrapping string`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "hello") + |> wantValueSome |> equals (box (WrappedString "hello")) + +[] +let ``tryCoerceValue coerces int to single-case DU wrapping int`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box 42) + |> wantValueSome |> equals (box (WrappedInt 42)) + +[] +let ``tryCoerceValue coerces int64 to single-case DU wrapping int64`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box 999L) + |> wantValueSome |> equals (box (WrappedInt64 999L)) + +[] +let ``tryCoerceValue coerces string to single-case DU wrapping Guid`` () = + let g = Guid.Parse "550e8400-e29b-41d4-a716-446655440000" + TypeCoercion.tryCoerceValue jsonOptions typeof (box "550e8400-e29b-41d4-a716-446655440000") + |> wantValueSome |> equals (box (WrappedGuid g)) + +[] +let ``tryCoerceValue returns ValueNone for single-case DU without jsonOptions`` () = + // Without FSharp.SystemTextJson, STJ doesn't know how to deserialize DUs + TypeCoercion.tryCoerceValue noOptions typeof (box "hello") + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// multi-case fieldless DU / DU-as-enum (requires FSharp.SystemTextJson UnwrapFieldlessTags) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces string to multi-case fieldless DU - Active`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Active") + |> wantValueSome |> equals (box Active) + +[] +let ``tryCoerceValue coerces string to multi-case fieldless DU - Inactive`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Inactive") + |> wantValueSome |> equals (box Inactive) + +[] +let ``tryCoerceValue coerces string to multi-case fieldless DU - Pending`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Pending") + |> wantValueSome |> equals (box Pending) + +[] +let ``tryCoerceValue returns ValueNone for unknown multi-case DU case name`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Unknown") + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// unsupported conversion +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue returns ValueNone when source type has no JSON representation`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box (obj ())) + |> wantValueNone diff --git a/tests/FSharp.Data.GraphQL.Tests/SelectLinqTests.fs b/tests/FSharp.Data.GraphQL.Tests/SelectLinqTests.fs index dcad5973..409c0a5a 100644 --- a/tests/FSharp.Data.GraphQL.Tests/SelectLinqTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/SelectLinqTests.fs @@ -1,5 +1,6 @@ // The MIT License (MIT) // Copyright (c) 2016 Bazinga Technologies Inc +[] module FSharp.Data.GraphQL.Tests.LinqTests open Xunit diff --git a/tests/FSharp.Data.GraphQL.Tests/TestAttributes.fs b/tests/FSharp.Data.GraphQL.Tests/TestAttributes.fs index 4d3cdc49..f2c45c86 100644 --- a/tests/FSharp.Data.GraphQL.Tests/TestAttributes.fs +++ b/tests/FSharp.Data.GraphQL.Tests/TestAttributes.fs @@ -20,3 +20,18 @@ type UseInvariantCultureAttribute() = override _.After (methodUnderTest) = CultureInfo.CurrentUICulture <- _originalUICulture CultureInfo.CurrentCulture <- _originalCulture + +namespace Tests + +module TraitType = + + [] + let Category = "Category" + +module TraitName = + + [] + let Linq = "LINQ" + + [] + let ObjectListFilter = "ObjectListFilter"