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

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.DirectiveFallbackMiddleware()
           Define.LiveQueryMiddleware() ]
 
     let executor = Executor(schema, middlewares)

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

@@ -48,4 +48,7 @@ module DefineExtensions =
         /// </param>
         static member LiveQueryMiddleware(?identityName : IdentityNameResolver) : IExecutorMiddleware =
             let identityName = defaultArg identityName (fun _ -> "Id")
-            upcast LiveQueryMiddleware(identityName)
+            upcast LiveQueryMiddleware(identityName)
+
+        static member DirectiveFallbackMiddleware() : IExecutorMiddleware =
+            upcast DirectiveFallbackMiddleware()

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 DirectiveFallbackMiddleware() =
+    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,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.
 [<AutoOpen>]
 module TypeSystemExtensions =
@@ -23,4 +84,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 ->