From 8d0b5ae49e0c3db98a331eeccdcf58ae34e26394 Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Tue, 27 Nov 2018 10:27:29 -0200 Subject: [PATCH 01/10] Removing unused function --- src/FSharp.Data.GraphQL.Server/Planning.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharp.Data.GraphQL.Server/Planning.fs b/src/FSharp.Data.GraphQL.Server/Planning.fs index 648912ab9..e3d5244da 100644 --- a/src/FSharp.Data.GraphQL.Server/Planning.fs +++ b/src/FSharp.Data.GraphQL.Server/Planning.fs @@ -126,7 +126,7 @@ let private directiveIncluder (directive: Directive) : Includer = | None -> raise (GraphQLException (sprintf "Expected 'if' argument of directive '@%s' to have boolean value but got %A" directive.Name other)) let private incl: Includer = fun _ -> true -let private excl: Includer = fun _ -> false + let private getIncluder (directives: Directive list) parentIncluder : Includer = directives |> List.fold (fun acc directive -> From d509eac30c7e7c40b2649af82b1151cdac7ed3af Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Tue, 27 Nov 2018 14:24:30 -0200 Subject: [PATCH 02/10] Developing middleware initial design --- .../HttpHandlers.fs | 11 ++- .../Schema.fs | 12 ++- .../DefineExtensions.fs | 5 +- .../MiddlewareDefinitions.fs | 21 +++++ .../TypeSystemExtensions.fs | 80 ++++++++++++++++++- 5 files changed, 118 insertions(+), 11 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Samples.GiraffeServer/HttpHandlers.fs b/src/FSharp.Data.GraphQL.Samples.GiraffeServer/HttpHandlers.fs index d416ab4c0..db59b202a 100644 --- a/src/FSharp.Data.GraphQL.Samples.GiraffeServer/HttpHandlers.fs +++ b/src/FSharp.Data.GraphQL.Samples.GiraffeServer/HttpHandlers.fs @@ -8,6 +8,7 @@ open FSharp.Data.GraphQL.Execution open System.IO open FSharp.Data.GraphQL open FSharp.Data.GraphQL.Types +open FSharp.Data.GraphQL.Server.Middlewares type HttpHandler = HttpFunc -> HttpContext -> HttpFuncResult @@ -59,18 +60,24 @@ module HttpHandlers = let body = readStream ctx.Request.Body let query = body |> tryParse "query" let variables = body |> tryParse "variables" |> mapString + let buildMetadata fallbackDirectives = + let chooser = + [ DirectiveChooser.fallbackDefer; DirectiveChooser.fallbackStream; DirectiveChooser.fallbackLive ] + |> DirectiveChooser.fromSeq + |> DirectiveChooser.merge (DirectiveChooser.fallbackWhen (fun _ -> fallbackDirectives)) + Metadata.WithDirectiveChooser(chooser) match query, variables with | Some query, Some variables -> printfn "Received query: %s" query printfn "Received variables: %A" variables let query = query |> removeSpacesAndNewLines - let result = Schema.executor.AsyncExecute(query, variables = variables, data = Schema.root) |> Async.RunSynchronously + let result = Schema.executor.AsyncExecute(query, variables = variables, data = Schema.root, meta = buildMetadata true) |> Async.RunSynchronously printfn "Result metadata: %A" result.Metadata return! okWithStr (json result) next ctx | Some query, None -> printfn "Received query: %s" query let query = query |> removeSpacesAndNewLines - let result = Schema.executor.AsyncExecute(query) |> Async.RunSynchronously + let result = Schema.executor.AsyncExecute(query, meta = buildMetadata true) |> Async.RunSynchronously printfn "Result metadata: %A" result.Metadata return! okWithStr (json result) next ctx | None, _ -> diff --git a/src/FSharp.Data.GraphQL.Samples.GiraffeServer/Schema.fs b/src/FSharp.Data.GraphQL.Samples.GiraffeServer/Schema.fs index 0efc42667..25a9a3128 100644 --- a/src/FSharp.Data.GraphQL.Samples.GiraffeServer/Schema.fs +++ b/src/FSharp.Data.GraphQL.Samples.GiraffeServer/Schema.fs @@ -5,9 +5,6 @@ namespace FSharp.Data.GraphQL.Samples.GiraffeServer open FSharp.Data.GraphQL open FSharp.Data.GraphQL.Types open FSharp.Data.GraphQL.Server.Middlewares -open System.Threading -open System.Threading.Tasks -open FSharp.Data.GraphQL.Ast type Episode = | NewHope = 1 @@ -232,7 +229,7 @@ module Schema = [ Define.Field("id", String, "The id of the planet", fun _ p -> p.Id) Define.Field("name", Nullable String, "The name of the planet.", fun _ p -> p.Name) - Define.Field("ismoon", Nullable Boolean, "Is that a moon?", fun _ p -> p.IsMoon) + Define.Field("isMoon", Nullable Boolean, "Is that a moon?", fun _ p -> p.IsMoon) ]) and RootType = @@ -277,13 +274,13 @@ module Schema = "setMoon", Nullable PlanetType, "Sets a moon status", - [ Define.Input("id", String); Define.Input("ismoon", Boolean) ], + [ Define.Input("id", String); Define.Input("isMoon", Boolean) ], fun ctx _ -> getPlanet (ctx.Arg("id")) |> Option.map (fun x -> - x.SetMoon(Some(ctx.Arg("ismoon"))) |> ignore + x.SetMoon(Some(ctx.Arg("isMoon"))) |> ignore schemaConfig.SubscriptionProvider.Publish "watchMoon" x - schemaConfig.LiveFieldSubscriptionProvider.Publish "Planet" "ismoon" x + schemaConfig.LiveFieldSubscriptionProvider.Publish "Planet" "isMoon" x x))]) let schema = Schema(Query, Mutation, Subscription, schemaConfig) @@ -292,6 +289,7 @@ module Schema = [ Define.QueryWeightMiddleware(2.0, true) Define.ObjectListFilterMiddleware(true) Define.ObjectListFilterMiddleware(true) + Define.DirectiveFallbackMiddleware() Define.LiveQueryMiddleware() ] let executor = Executor(schema, middlewares) diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs index 1d4c3cd2d..f11f31925 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs @@ -48,4 +48,7 @@ module DefineExtensions = /// static member LiveQueryMiddleware(?identityName : IdentityNameResolver) : IExecutorMiddleware = let identityName = defaultArg identityName (fun _ -> "Id") - upcast LiveQueryMiddleware(identityName) \ No newline at end of file + upcast LiveQueryMiddleware(identityName) + + static member DirectiveFallbackMiddleware() : IExecutorMiddleware = + upcast DirectiveFallbackMiddleware() \ No newline at end of file diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/MiddlewareDefinitions.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/MiddlewareDefinitions.fs index aa3dbf485..95e44245a 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/MiddlewareDefinitions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/MiddlewareDefinitions.fs @@ -4,6 +4,7 @@ open FSharp.Data.GraphQL open FSharp.Data.GraphQL.Types.Patterns open FSharp.Data.GraphQL.Types open FSharp.Data.GraphQL.Execution +open FSharp.Data.GraphQL.Ast type internal QueryWeightMiddleware(threshold : float, reportToMetadata : bool) = let middleware (threshold : float) (ctx : ExecutionContext) (next : ExecutionContext -> AsyncVal) = @@ -143,4 +144,24 @@ type internal LiveQueryMiddleware(identityNameResolver : IdentityNameResolver) = interface IExecutorMiddleware with member __.CompileSchema = Some middleware member __.PlanOperation = None + member __.ExecuteOperationAsync = None + +type internal DirectiveFallbackMiddleware() = + let middleware (ctx : PlanningContext) (next : PlanningContext -> ExecutionPlan) = + let chooser = ctx.Metadata.TryFind("directiveChooser") + let chooseDirectives (chooser : DirectiveChooser) (opdef : OperationDefinition) : OperationDefinition = + let rec selMapper (selectionSet : Selection list) : Selection list = + selectionSet + |> List.map (fun sel -> + match sel with + | Field f -> Field { f with Directives = f.Directives |> List.choose chooser; SelectionSet = selMapper f.SelectionSet } + | FragmentSpread fs -> FragmentSpread { fs with Directives = fs.Directives |> List.choose chooser } + | InlineFragment fd -> InlineFragment { fd with Directives = fd.Directives |> List.choose chooser; SelectionSet = selMapper fd.SelectionSet }) + { opdef with SelectionSet = selMapper opdef.SelectionSet } + match chooser with + | Some chooser -> next { ctx with Operation = chooseDirectives chooser ctx.Operation } + | None -> next ctx + interface IExecutorMiddleware with + member __.CompileSchema = None + member __.PlanOperation = Some middleware member __.ExecuteOperationAsync = None \ No newline at end of file diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs index 438135d41..d10af548b 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs @@ -1,7 +1,68 @@ namespace FSharp.Data.GraphQL.Server.Middlewares open FSharp.Data.GraphQL.Types +open FSharp.Data.GraphQL.Ast +/// A function that checks if a directive should be used in the exection of a query, or changed to a new directive. +type DirectiveChooser = Directive -> Directive option + +/// Basic operations on DirectiveChoosers. +module DirectiveChooser = + let apply (directive : Directive) (chooser : DirectiveChooser) = + chooser directive + + let keep : DirectiveChooser = + let chooser = fun directive -> Some directive + chooser + + let fallback : DirectiveChooser = + let chooser = fun _ -> None + chooser + + let acceptWhen (condition : Directive -> bool) : DirectiveChooser = + let chooser = fun directive -> + if condition directive + then keep directive + else fallback directive + chooser + + let fallbackWhen (condition : Directive -> bool) : DirectiveChooser = + let chooser = fun directive -> + if condition directive + then fallback directive + else keep directive + chooser + + let fallbackByName name = fallbackWhen (fun d -> d.Name = name) + + let fallbackDefer = fallbackByName "defer" + + let fallbackStream = fallbackByName "stream" + + let fallbackLive = fallbackByName "live" + + let compose (other : DirectiveChooser) (actual : DirectiveChooser) : DirectiveChooser = + let chooser = fun directive -> + match actual directive with + | Some d -> other d + | None -> None + chooser + + let merge (other : DirectiveChooser) (actual : DirectiveChooser) : DirectiveChooser = + let chooser = fun directive -> + match other directive, actual directive with + | d1, d2 when d1 = d2 -> d1 + | Some d1, Some d2 when d1 <> d2 -> failwith "Can not merge DirectiveChoosers because they don't return the same directive." + | _ -> None + chooser + + let fromSeq (choosers : DirectiveChooser seq) : DirectiveChooser = + let chooser = fun directive -> + match Seq.length choosers with + | 0 -> keep directive + | _ -> choosers |> Seq.reduce (fun fst snd -> compose fst snd) |> apply directive + chooser + /// Contains extensions for the type system. [] module TypeSystemExtensions = @@ -23,4 +84,21 @@ module TypeSystemExtensions = member this.Filter = match this.Args.TryFind("filter") with | Some (:? ObjectListFilter as f) -> Some f - | _ -> None \ No newline at end of file + | _ -> None + + type Metadata with + /// + /// Creates a new instance of the current Metadata, adding a directive chooser function to it. + /// Directive chooser will be used by a DirectiveFallbackMiddleware if configured in the Executor. + /// + /// The directive chooser to be added in the Metadata object. + member this.WithDirectiveChooser(chooser : DirectiveChooser) = + this.Add("directiveChooser", chooser) + + /// + /// Creates a new instance of Metadata, adding a directive chooser function to it. + /// Directive chooser will be used by a DirectiveFallbackMiddleware if configured in the Executor. + /// + /// The directive chooser to be added in the Metadata object. + static member WithDirectiveChooser(chooser : DirectiveChooser) = + Metadata.Empty.WithDirectiveChooser(chooser) \ No newline at end of file From 5f0a9e4696e8d10a3ab3d171c038b076036e429e Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Tue, 27 Nov 2018 14:36:25 -0200 Subject: [PATCH 03/10] Fixing name of the middleware --- src/FSharp.Data.GraphQL.Samples.GiraffeServer/Schema.fs | 2 +- .../DefineExtensions.fs | 4 ++-- .../MiddlewareDefinitions.fs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Samples.GiraffeServer/Schema.fs b/src/FSharp.Data.GraphQL.Samples.GiraffeServer/Schema.fs index 25a9a3128..a2fbb95ff 100644 --- a/src/FSharp.Data.GraphQL.Samples.GiraffeServer/Schema.fs +++ b/src/FSharp.Data.GraphQL.Samples.GiraffeServer/Schema.fs @@ -289,7 +289,7 @@ module Schema = [ Define.QueryWeightMiddleware(2.0, true) Define.ObjectListFilterMiddleware(true) Define.ObjectListFilterMiddleware(true) - Define.DirectiveFallbackMiddleware() + Define.DirectiveChooserMiddleware() Define.LiveQueryMiddleware() ] let executor = Executor(schema, middlewares) diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs index f11f31925..171790bc1 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs @@ -50,5 +50,5 @@ module DefineExtensions = let identityName = defaultArg identityName (fun _ -> "Id") upcast LiveQueryMiddleware(identityName) - static member DirectiveFallbackMiddleware() : IExecutorMiddleware = - upcast DirectiveFallbackMiddleware() \ No newline at end of file + static member DirectiveChooserMiddleware() : IExecutorMiddleware = + upcast DirectiveChooserMiddleware() \ No newline at end of file diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/MiddlewareDefinitions.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/MiddlewareDefinitions.fs index 95e44245a..143f1fe9f 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/MiddlewareDefinitions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/MiddlewareDefinitions.fs @@ -146,7 +146,7 @@ type internal LiveQueryMiddleware(identityNameResolver : IdentityNameResolver) = member __.PlanOperation = None member __.ExecuteOperationAsync = None -type internal DirectiveFallbackMiddleware() = +type internal DirectiveChooserMiddleware() = let middleware (ctx : PlanningContext) (next : PlanningContext -> ExecutionPlan) = let chooser = ctx.Metadata.TryFind("directiveChooser") let chooseDirectives (chooser : DirectiveChooser) (opdef : OperationDefinition) : OperationDefinition = From 249a3c742c8ee072c58d709f565df260c63ee1aa Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Tue, 27 Nov 2018 15:40:34 -0200 Subject: [PATCH 04/10] Adding documentation to the code --- .../DefineExtensions.fs | 9 +++++ .../TypeSystemExtensions.fs | 38 +++++++++++++++++-- 2 files changed, 43 insertions(+), 4 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs index 171790bc1..89d6099be 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs @@ -50,5 +50,14 @@ module DefineExtensions = let identityName = defaultArg identityName (fun _ -> "Id") upcast LiveQueryMiddleware(identityName) + /// + /// Creates a middleware that can be used to apply a choose function to every Directive of the query. + /// Choose function must be provided in the Metadata object of the execution. + /// + /// + /// When defined, this middleware looks for a DirectiveChooser in the Metadata provider to the executor, + /// and apply it to every directive inside the operation. Chooser can transform or even remove directives, + /// making them loose their effect on the query. + /// static member DirectiveChooserMiddleware() : IExecutorMiddleware = upcast DirectiveChooserMiddleware() \ No newline at end of file diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs index d10af548b..d913d9992 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs @@ -7,25 +7,42 @@ open FSharp.Data.GraphQL.Ast type DirectiveChooser = Directive -> Directive option /// Basic operations on DirectiveChoosers. +[] module DirectiveChooser = + /// Apply a chooser to a directive. let apply (directive : Directive) (chooser : DirectiveChooser) = chooser directive + /// Builds a chooser that, given a Directive x, returns Some x. let keep : DirectiveChooser = let chooser = fun directive -> Some directive chooser + /// Builds a chooser that, for any Directive, returns None. let fallback : DirectiveChooser = let chooser = fun _ -> None chooser - let acceptWhen (condition : Directive -> bool) : DirectiveChooser = + /// Builds a chooser that, when run, runs actual chooser, and if it returns Some directive x, maps + /// x directive using mapper function to y directive, and return Some y. + let map (mapper : Directive -> Directive) (actual : DirectiveChooser) : DirectiveChooser = + let chooser = fun directive -> + match actual directive with + | Some d -> mapper d |> keep + | None -> None + chooser + + /// Builds a chooser that, given a Directive x, apply the condition filter function to x, + /// and if it returns true, returns Some x. Otherwise, returns None. + let keepWhen (condition : Directive -> bool) : DirectiveChooser = let chooser = fun directive -> if condition directive then keep directive else fallback directive chooser + /// Builds a chooser that, given a Directive x, apply the condition filter function to x, + /// and if it returns true, returns None. Otherwise, returns Some x. let fallbackWhen (condition : Directive -> bool) : DirectiveChooser = let chooser = fun directive -> if condition directive @@ -33,14 +50,25 @@ module DirectiveChooser = else keep directive chooser + /// Builds a chooser that, given a Directive x, if x.Name equals given name, returns None. + /// Otherwise, returns Some x. let fallbackByName name = fallbackWhen (fun d -> d.Name = name) + /// Builds a chooser that, given a Directive x, if x.Name is 'defer', returns None. + /// Otherwise, returns Some x. let fallbackDefer = fallbackByName "defer" + /// Builds a chooser that, given a Directive x, if x.Name is 'stream', returns None. + /// Otherwise, returns Some x. let fallbackStream = fallbackByName "stream" + /// Builds a chooser that, given a Directive x, if x.Name is 'live', returns None. + /// Otherwise, returns Some x. let fallbackLive = fallbackByName "live" + /// Builds a chooser that, when run, runs actual chooser, and if it returns Some directive x, + /// uses that directive to run other chooser and return its result. If actual chooser returns None, + /// returns None. let compose (other : DirectiveChooser) (actual : DirectiveChooser) : DirectiveChooser = let chooser = fun directive -> match actual directive with @@ -48,14 +76,16 @@ module DirectiveChooser = | None -> None chooser + /// Builds a chooser that, when run, runs actual chooser and other chooser: if any of the choosers return + /// None, then returns None. Otherwise, compose actual into other, run the composed chooser, and return its result. let merge (other : DirectiveChooser) (actual : DirectiveChooser) : DirectiveChooser = let chooser = fun directive -> - match other directive, actual directive with - | d1, d2 when d1 = d2 -> d1 - | Some d1, Some d2 when d1 <> d2 -> failwith "Can not merge DirectiveChoosers because they don't return the same directive." + match actual directive, other directive with + |Some _, Some _ -> compose other actual |> apply directive | _ -> None chooser + /// Builds a chooser based on the composal of all choosers in choosers sequence, from first to last. let fromSeq (choosers : DirectiveChooser seq) : DirectiveChooser = let chooser = fun directive -> match Seq.length choosers with From 4ada7b8177f2b05092dbc8eb926b949338f9a955 Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Tue, 27 Nov 2018 15:50:45 -0200 Subject: [PATCH 05/10] Refactoring some code --- .../HttpHandlers.fs | 2 +- .../DirectiveChooser.fs | 105 ++++++++++++++++++ ...arp.Data.GraphQL.Server.Middlewares.fsproj | 1 + .../TypeSystemExtensions.fs | 91 --------------- 4 files changed, 107 insertions(+), 92 deletions(-) create mode 100644 src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs diff --git a/src/FSharp.Data.GraphQL.Samples.GiraffeServer/HttpHandlers.fs b/src/FSharp.Data.GraphQL.Samples.GiraffeServer/HttpHandlers.fs index db59b202a..6f807b1f0 100644 --- a/src/FSharp.Data.GraphQL.Samples.GiraffeServer/HttpHandlers.fs +++ b/src/FSharp.Data.GraphQL.Samples.GiraffeServer/HttpHandlers.fs @@ -63,7 +63,7 @@ module HttpHandlers = let buildMetadata fallbackDirectives = let chooser = [ DirectiveChooser.fallbackDefer; DirectiveChooser.fallbackStream; DirectiveChooser.fallbackLive ] - |> DirectiveChooser.fromSeq + |> DirectiveChooser.composeSeq |> DirectiveChooser.merge (DirectiveChooser.fallbackWhen (fun _ -> fallbackDirectives)) Metadata.WithDirectiveChooser(chooser) match query, variables with diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs new file mode 100644 index 000000000..f3a57ac87 --- /dev/null +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs @@ -0,0 +1,105 @@ +namespace FSharp.Data.GraphQL.Server.Middlewares + +open FSharp.Data.GraphQL.Ast + +/// A function that checks if a directive should be used in the exection of a query, or changed to a new directive. +type DirectiveChooser = Directive -> Directive option + +/// Basic operations on DirectiveChoosers. +[] +module DirectiveChooser = + /// Apply a chooser to a directive. + let apply (directive : Directive) (chooser : DirectiveChooser) = + chooser directive + + /// Builds a chooser that, given a Directive x, returns Some x. + let keep : DirectiveChooser = + let chooser = fun directive -> Some directive + chooser + + /// Builds a chooser that, for any Directive, returns None. + let fallback : DirectiveChooser = + let chooser = fun _ -> None + chooser + + /// Builds a chooser that, when run, runs actual chooser, and if it returns Some directive x, maps + /// x directive using mapper function to y directive, and return Some y. + let map (mapper : Directive -> Directive) (actual : DirectiveChooser) : DirectiveChooser = + let chooser = fun directive -> + match actual directive with + | Some d -> mapper d |> keep + | None -> None + chooser + + /// Builds a chooser that, given a Directive x, apply the condition filter function to x, + /// and if it returns true, returns Some x. Otherwise, returns None. + let keepWhen (condition : Directive -> bool) : DirectiveChooser = + let chooser = fun directive -> + if condition directive + then keep directive + else fallback directive + chooser + + /// Builds a chooser that, given a Directive x, apply the condition filter function to x, + /// and if it returns true, returns None. Otherwise, returns Some x. + let fallbackWhen (condition : Directive -> bool) : DirectiveChooser = + let chooser = fun directive -> + if condition directive + then fallback directive + else keep directive + chooser + + /// Builds a chooser that, given a Directive x, if x.Name equals given name, returns None. + /// Otherwise, returns Some x. + let fallbackByName name = fallbackWhen (fun d -> d.Name = name) + + /// Builds a chooser that, given a Directive x, if x.Name is 'defer', returns None. + /// Otherwise, returns Some x. + let fallbackDefer = fallbackByName "defer" + + /// Builds a chooser that, given a Directive x, if x.Name is 'stream', returns None. + /// Otherwise, returns Some x. + let fallbackStream = fallbackByName "stream" + + /// Builds a chooser that, given a Directive x, if x.Name is 'live', returns None. + /// Otherwise, returns Some x. + let fallbackLive = fallbackByName "live" + + /// Builds a chooser that, when run, runs actual chooser, and if it returns Some directive x, + /// uses that directive to run other chooser and return its result. If actual chooser returns None, + /// returns None. + let compose (other : DirectiveChooser) (actual : DirectiveChooser) : DirectiveChooser = + let chooser = fun directive -> + match actual directive with + | Some d -> other d + | None -> None + chooser + + /// Builds a chooser that, when run, runs actual chooser and other chooser: if any of the choosers return + /// None, then returns None. Otherwise, compose actual into other, run the composed chooser, and return its result. + let merge (other : DirectiveChooser) (actual : DirectiveChooser) : DirectiveChooser = + let chooser = fun directive -> + match actual directive, other directive with + |Some _, Some _ -> compose other actual |> apply directive + | _ -> None + chooser + + /// Reduces a sequence of choosers into a single chooser, by applying reducer function. + let reduceSeq reducer (choosers : DirectiveChooser seq) = + choosers |> Seq.reduce reducer + + /// Reduces a sequence of choosers into a single chooser, by applying the compose function to reduce it. + let composeSeq (choosers : DirectiveChooser seq) : DirectiveChooser = + let chooser = fun directive -> + match Seq.length choosers with + | 0 -> keep directive + | _ -> choosers |> reduceSeq compose |> apply directive + chooser + + /// Reduces a sequence of choosers into a single chooser, by applying thee merge function to reduce it. + let mergeSeq (choosers : DirectiveChooser seq) : DirectiveChooser = + let chooser = fun directive -> + match Seq.length choosers with + | 0 -> keep directive + | _ -> choosers |> reduceSeq merge |> apply directive + chooser \ No newline at end of file diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/FSharp.Data.GraphQL.Server.Middlewares.fsproj b/src/FSharp.Data.GraphQL.Server.Middlewares/FSharp.Data.GraphQL.Server.Middlewares.fsproj index 5550705c3..ebb0cf35f 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/FSharp.Data.GraphQL.Server.Middlewares.fsproj +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/FSharp.Data.GraphQL.Server.Middlewares.fsproj @@ -13,6 +13,7 @@ + diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs index d913d9992..df06a5134 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs @@ -1,97 +1,6 @@ namespace FSharp.Data.GraphQL.Server.Middlewares open FSharp.Data.GraphQL.Types -open FSharp.Data.GraphQL.Ast - -/// A function that checks if a directive should be used in the exection of a query, or changed to a new directive. -type DirectiveChooser = Directive -> Directive option - -/// Basic operations on DirectiveChoosers. -[] -module DirectiveChooser = - /// Apply a chooser to a directive. - let apply (directive : Directive) (chooser : DirectiveChooser) = - chooser directive - - /// Builds a chooser that, given a Directive x, returns Some x. - let keep : DirectiveChooser = - let chooser = fun directive -> Some directive - chooser - - /// Builds a chooser that, for any Directive, returns None. - let fallback : DirectiveChooser = - let chooser = fun _ -> None - chooser - - /// Builds a chooser that, when run, runs actual chooser, and if it returns Some directive x, maps - /// x directive using mapper function to y directive, and return Some y. - let map (mapper : Directive -> Directive) (actual : DirectiveChooser) : DirectiveChooser = - let chooser = fun directive -> - match actual directive with - | Some d -> mapper d |> keep - | None -> None - chooser - - /// Builds a chooser that, given a Directive x, apply the condition filter function to x, - /// and if it returns true, returns Some x. Otherwise, returns None. - let keepWhen (condition : Directive -> bool) : DirectiveChooser = - let chooser = fun directive -> - if condition directive - then keep directive - else fallback directive - chooser - - /// Builds a chooser that, given a Directive x, apply the condition filter function to x, - /// and if it returns true, returns None. Otherwise, returns Some x. - let fallbackWhen (condition : Directive -> bool) : DirectiveChooser = - let chooser = fun directive -> - if condition directive - then fallback directive - else keep directive - chooser - - /// Builds a chooser that, given a Directive x, if x.Name equals given name, returns None. - /// Otherwise, returns Some x. - let fallbackByName name = fallbackWhen (fun d -> d.Name = name) - - /// Builds a chooser that, given a Directive x, if x.Name is 'defer', returns None. - /// Otherwise, returns Some x. - let fallbackDefer = fallbackByName "defer" - - /// Builds a chooser that, given a Directive x, if x.Name is 'stream', returns None. - /// Otherwise, returns Some x. - let fallbackStream = fallbackByName "stream" - - /// Builds a chooser that, given a Directive x, if x.Name is 'live', returns None. - /// Otherwise, returns Some x. - let fallbackLive = fallbackByName "live" - - /// Builds a chooser that, when run, runs actual chooser, and if it returns Some directive x, - /// uses that directive to run other chooser and return its result. If actual chooser returns None, - /// returns None. - let compose (other : DirectiveChooser) (actual : DirectiveChooser) : DirectiveChooser = - let chooser = fun directive -> - match actual directive with - | Some d -> other d - | None -> None - chooser - - /// Builds a chooser that, when run, runs actual chooser and other chooser: if any of the choosers return - /// None, then returns None. Otherwise, compose actual into other, run the composed chooser, and return its result. - let merge (other : DirectiveChooser) (actual : DirectiveChooser) : DirectiveChooser = - let chooser = fun directive -> - match actual directive, other directive with - |Some _, Some _ -> compose other actual |> apply directive - | _ -> None - chooser - - /// Builds a chooser based on the composal of all choosers in choosers sequence, from first to last. - let fromSeq (choosers : DirectiveChooser seq) : DirectiveChooser = - let chooser = fun directive -> - match Seq.length choosers with - | 0 -> keep directive - | _ -> choosers |> Seq.reduce (fun fst snd -> compose fst snd) |> apply directive - chooser /// Contains extensions for the type system. [] From 945e139cabecb5a814256b03adcc99f57263e15e Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Tue, 27 Nov 2018 15:52:46 -0200 Subject: [PATCH 06/10] Updating code documentation --- src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs index f3a57ac87..db29c1e1f 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs @@ -23,7 +23,7 @@ module DirectiveChooser = chooser /// Builds a chooser that, when run, runs actual chooser, and if it returns Some directive x, maps - /// x directive using mapper function to y directive, and return Some y. + /// x directive using mapper function to y directive, and return Some y. Otherwise, returns None. let map (mapper : Directive -> Directive) (actual : DirectiveChooser) : DirectiveChooser = let chooser = fun directive -> match actual directive with From 199fb6fa2c65f3d51b268230075b4de72b633fbf Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Mon, 31 Dec 2018 10:53:44 -0200 Subject: [PATCH 07/10] Refactoring code to remove lint warning --- .../DirectiveChooser.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs b/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs index db29c1e1f..2d8e512a5 100644 --- a/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs +++ b/src/FSharp.Data.GraphQL.Server.Middlewares/DirectiveChooser.fs @@ -13,8 +13,8 @@ module DirectiveChooser = chooser directive /// Builds a chooser that, given a Directive x, returns Some x. - let keep : DirectiveChooser = - let chooser = fun directive -> Some directive + let keep : DirectiveChooser = + let chooser = Some chooser /// Builds a chooser that, for any Directive, returns None. @@ -96,7 +96,7 @@ module DirectiveChooser = | _ -> choosers |> reduceSeq compose |> apply directive chooser - /// Reduces a sequence of choosers into a single chooser, by applying thee merge function to reduce it. + /// Reduces a sequence of choosers into a single chooser, by applying the DirectiveChooser.merge to reduce it. let mergeSeq (choosers : DirectiveChooser seq) : DirectiveChooser = let chooser = fun directive -> match Seq.length choosers with From 114a034000c541aef0942ec885cd49f2cb62cfcc Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Mon, 7 Jan 2019 12:30:44 -0200 Subject: [PATCH 08/10] Removing build warnings --- src/FSharp.Data.GraphQL.Shared/AsyncVal.fs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Shared/AsyncVal.fs b/src/FSharp.Data.GraphQL.Shared/AsyncVal.fs index d3da2aff0..e908614b6 100644 --- a/src/FSharp.Data.GraphQL.Shared/AsyncVal.fs +++ b/src/FSharp.Data.GraphQL.Shared/AsyncVal.fs @@ -115,6 +115,10 @@ module AsyncVal = /// Returned array maintain order of values. /// If the array contains a Failure, then the entire array will not resolve let collectSequential (values: AsyncVal<'T> []) : AsyncVal<'T []> = + let mapper = + function + | Value v -> v + | _ -> failwith "Expected AsyncVal to be a direct value." if values.Length = 0 then Value [||] elif values |> Array.exists isAsync then Async(async { @@ -129,7 +133,7 @@ module AsyncVal = | Failure f -> results.[i] <- raise f return results }) - else Value (values |> Array.map (fun (Value v) -> v)) + else Value (values |> Array.map mapper) @@ -197,12 +201,6 @@ module AsyncExtensions = /// Computation expression for working on AsyncVals. let asyncVal = AsyncValBuilder () - - /// Active pattern used for checking if AsyncVal contains immediate value. - let (|Immediate|_|) (x: AsyncVal<'T>) = match x with | Value v -> Some v | _ -> None - - /// Active patter used for checking if AsyncVal wraps an Async computation. - let (|Async|_|) (x: AsyncVal<'T>) = match x with | Async a -> Some a | _ -> None type Microsoft.FSharp.Control.AsyncBuilder with From b57e02082e41357b14da45fb9699f1aafaf25907 Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Mon, 7 Jan 2019 13:21:35 -0200 Subject: [PATCH 09/10] Unit testing --- .../MiddlewaresTests.fs | 47 ++++++++++++++++++- 1 file changed, 45 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Data.GraphQL.Tests/MiddlewaresTests.fs b/tests/FSharp.Data.GraphQL.Tests/MiddlewaresTests.fs index 00d854032..855232ec2 100644 --- a/tests/FSharp.Data.GraphQL.Tests/MiddlewaresTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/MiddlewaresTests.fs @@ -84,12 +84,16 @@ let executor = let middlewares = [ Define.QueryWeightMiddleware(2.0, true) Define.ObjectListFilterMiddleware(true) - Define.ObjectListFilterMiddleware(true) ] + Define.ObjectListFilterMiddleware(true) + Define.DirectiveChooserMiddleware() ] Executor(schema, middlewares) let execute (query : Document) = executor.AsyncExecute(query) |> sync +let executeWithMetadata (meta : Metadata) (query : Document) = + executor.AsyncExecute(query, meta = meta) |> sync + let expectedErrors : Error list = [ "Query complexity exceeds maximum threshold. Please reduce query complexity and try again.", [] ] @@ -417,4 +421,43 @@ let ``Object list filter: should return filter information in Metadata``() = | _ -> fail "Expected Direct GQLResponse" result.Metadata.TryFind("queryWeightThreshold") |> equals (Some 2.0) result.Metadata.TryFind("queryWeight") |> equals (Some 1.0) - result.Metadata.TryFind<(string * ObjectListFilter) list>("filters") |> equals (Some [ expectedFilter ]) \ No newline at end of file + result.Metadata.TryFind<(string * ObjectListFilter) list>("filters") |> equals (Some [ expectedFilter ]) + +[] +let ``Should obey directive chooser condition`` () = + let query = + parse """query testQuery { + A (id : 1) { + id + value + subjects @defer { + id + value + } + } + }""" + let expected = + NameValueLookup.ofList [ + "A", upcast NameValueLookup.ofList [ + "id", upcast 1 + "value", upcast "A1" + "subjects", upcast [ + NameValueLookup.ofList [ + "id", upcast 2 + "value", upcast "A2" + ] + NameValueLookup.ofList [ + "id", upcast 6 + "value", upcast 3000 + ] + ] + ] + ] + let result = query |> executeWithMetadata (Metadata.WithDirectiveChooser(DirectiveChooser.fallbackDefer)) + match result with + | Direct(data, errors) -> + empty errors + data.["data"] |> equals (upcast expected) + | _ -> fail "Expected Direct GQLResponse" + result.Metadata.TryFind("queryWeightThreshold") |> equals (Some 2.0) + result.Metadata.TryFind("queryWeight") |> equals (Some 1.0) \ No newline at end of file From 1db75dab433d6e56cb5774e38a9fc5791786de22 Mon Sep 17 00:00:00 2001 From: Ismael Carlos Velten Date: Mon, 7 Jan 2019 13:39:27 -0200 Subject: [PATCH 10/10] Adding documentation --- README.md | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/README.md b/README.md index 3ec1f18c0..97226b71e 100644 --- a/README.md +++ b/README.md @@ -332,6 +332,35 @@ let executor = Executor(schema, middlewares) The `IdentityNameResolver` is optional, though. If no resolver function is provided, this default implementation of is used. Also, notifications to subscribers must be done via `Publish` of `ILiveFieldSubscriptionProvider`, like explained above. +### Directive chooser middleware + +This middleware can be used to modify directive behavior on a per request basis, by applying a directive chooser function to each directive present in the original query: + +```fsharp +type DirectiveChooser = Directive -> Directive option +``` + +This function can be applied on the Metadata object of `AsyncExecute` calls. Let's say that we want to ignore a defer directive (and treat it as a direct result) by a `isTrustedUser` condition: + +```fsharp +let schema = Schema(query = queryType) + +let middlewares = [ Define.DirectiveChooserMiddleware() ] + +let executor = Executor(schema, middlewares) + +let isTrustedUser = false // Or any calculated boolean value + +let chooser (d : Directive) = if not isTrustedUser then None else Some d + +let result = + executor.AsyncExecute( + query, + meta = Metadata.WithDirectiveChooser(chooser)) +``` + +Altough chooser is just a simple `Directive -> Directive option` function, one may opt to use helpers to build and transform a chooser using the `DirectiveChooser` module. It does have many common chooser and transformations available, like `fallbackWhen`, `apply`, `merge` or `map`, for example. + ### Using extensions to build your own middlewares You can use extension methods provided by the `FSharp.Data.GraphQL.Shared` package to help building your own middlewares. When making a middleware, often you will need to modify schema definitions to add features to the schema defined by the user code. The `ObjectListFilter` middleware is an example, where all fields that implements lists of a certain type needs to be modified, by accepting an argument called `filter`.