Directive chooser middleware

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.composeSeq
+                |> 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, _ ->

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<Planet> "watchMoon" x
-                            schemaConfig.LiveFieldSubscriptionProvider.Publish<Planet> "Planet" "ismoon" x
+                            schemaConfig.LiveFieldSubscriptionProvider.Publish<Planet> "Planet" "isMoon" x
                             x))])
 
     let schema = Schema(Query, Mutation, Subscription, schemaConfig)
@@ -292,6 +289,7 @@ module Schema =
         [ Define.QueryWeightMiddleware(2.0, true)
           Define.ObjectListFilterMiddleware<Human, Character option>(true)
           Define.ObjectListFilterMiddleware<Droid, Character option>(true)
+          Define.DirectiveChooserMiddleware()
           Define.LiveQueryMiddleware() ]
 
     let executor = Executor(schema, middlewares)

src/FSharp.Data.GraphQL.Server.Middlewares/DefineExtensions.fs

@@ -48,4 +48,16 @@ module DefineExtensions =
         /// </param>
         static member LiveQueryMiddleware(?identityName : IdentityNameResolver) : IExecutorMiddleware =
             let identityName = defaultArg identityName (fun _ -> "Id")
-            upcast LiveQueryMiddleware(identityName)
+            upcast LiveQueryMiddleware(identityName)
+
+        /// <summary>
+        /// 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.
+        /// </summary>
+        /// <remarks>
+        /// 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.
+        /// </remarks>
+        static member DirectiveChooserMiddleware() : IExecutorMiddleware =
+            upcast DirectiveChooserMiddleware()

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.
+[<RequireQualifiedAccess>]
+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. Otherwise, returns None.
+    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

src/FSharp.Data.GraphQL.Server.Middlewares/FSharp.Data.GraphQL.Server.Middlewares.fsproj

@@ -13,6 +13,7 @@
   <ItemGroup>
     <Compile Include="AssemblyInfo.fs" />
     <Compile Include="ObjectListFilter.fs" />
+    <Compile Include="DirectiveChooser.fs" />
     <Compile Include="TypeSystemExtensions.fs" />
     <Compile Include="SchemaDefinitions.fs" />
     <Compile Include="MiddlewareDefinitions.fs" />

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<GQLResponse>) =
@@ -143,4 +144,24 @@ type internal LiveQueryMiddleware(identityNameResolver : IdentityNameResolver) =
     interface IExecutorMiddleware with
         member __.CompileSchema = Some middleware
         member __.PlanOperation = None
+        member __.ExecuteOperationAsync = None
+
+type internal DirectiveChooserMiddleware() =
+    let middleware (ctx : PlanningContext) (next : PlanningContext -> ExecutionPlan) =
+        let chooser = ctx.Metadata.TryFind<DirectiveChooser>("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

src/FSharp.Data.GraphQL.Server.Middlewares/TypeSystemExtensions.fs

@@ -1,7 +1,7 @@
 namespace FSharp.Data.GraphQL.Server.Middlewares
 
 open FSharp.Data.GraphQL.Types
-
+        
 /// Contains extensions for the type system.
 [<AutoOpen>]
 module TypeSystemExtensions =
@@ -23,4 +23,21 @@ module TypeSystemExtensions =
         member this.Filter =
             match this.Args.TryFind("filter") with
             | Some (:? ObjectListFilter as f) -> Some f
-            | _ -> None
+            | _ -> None
+
+    type Metadata with
+        /// <summary>
+        /// 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.
+        /// </summary>
+        /// <param name="chooser">The directive chooser to be added in the Metadata object.</param>
+        member this.WithDirectiveChooser(chooser : DirectiveChooser) =
+            this.Add("directiveChooser", chooser)
+
+        /// <summary>
+        /// 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.
+        /// </summary>
+        /// <param name="chooser">The directive chooser to be added in the Metadata object.</param>
+        static member WithDirectiveChooser(chooser : DirectiveChooser) =
+            Metadata.Empty.WithDirectiveChooser(chooser)

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 ->