Implemented per field authorization using ASP.NET authorization policies

samples/star-wars-api/AuthorizationMiddleware.fs

@@ -0,0 +1,98 @@
+namespace FSharp.Data.GraphQL.Samples.StarWarsApi.Middleware
+
+open System
+open System.Threading.Tasks
+open FSharp.Data.GraphQL.Types
+open Microsoft.FSharp.Quotations
+open Microsoft.FSharp.Quotations.Patterns
+open Microsoft.FSharp.Linq.RuntimeHelpers
+open Microsoft.AspNetCore.Authorization
+open Microsoft.AspNetCore.Http
+open Microsoft.Extensions.DependencyInjection
+open FSharp.Data.GraphQL.Samples.StarWarsApi
+
+type FieldPolicyMiddleware<'Val, 'Res> =
+    ResolveFieldContext -> 'Val -> (ResolveFieldContext -> 'Val -> Async<'Res>) -> Async<'Res>
+
+type internal CustomPolicyFieldDefinition<'Val, 'Res>(source : FieldDef<'Val>, middleware : FieldPolicyMiddleware<'Val, 'Res>) =
+    interface FieldDef<'Val> with
+        member __.Name = source.Name
+        member __.Description = source.Description
+        member __.DeprecationReason = source.DeprecationReason
+        member __.TypeDef = source.TypeDef
+        member __.Args = source.Args
+        member __.Metadata = source.Metadata
+        member __.Resolve =
+            let changeAsyncResolver expr =
+                let expr =
+                    match expr with
+                    | WithValue (_, _, e) -> e
+                    | _ -> failwith "Unexpected resolver expression."
+                let resolver = <@ fun ctx input -> middleware ctx input (%%expr : ResolveFieldContext -> 'Val -> Async<'Res>) @>
+                let compiledResolver = LeafExpressionConverter.EvaluateQuotation resolver
+                Expr.WithValue(compiledResolver, resolver.Type, resolver)
+
+            let changeSyncResolver expr =
+                let expr =
+                    match expr with
+                    | WithValue (_, _, e) -> e
+                    | _ -> failwith "Unexpected resolver expression."
+                let resolver = <@ fun ctx input -> middleware ctx input (fun ctx input -> ((%%expr : ResolveFieldContext -> 'Val -> 'Res) ctx input) |> async.Return) @>
+                let compiledResolver = LeafExpressionConverter.EvaluateQuotation resolver
+                Expr.WithValue(compiledResolver, resolver.Type, resolver)
+
+            match source.Resolve with
+            | Sync (input, output, expr) -> Async (input, output, changeSyncResolver expr)
+            | Async (input, output, expr) -> Async (input, output, changeAsyncResolver expr)
+            | Undefined -> failwith "Field has no resolve function."
+            | x -> failwith <| sprintf "Resolver '%A' is not supported." x
+    interface IEquatable<FieldDef> with
+        member __.Equals(other) = source.Equals(other)
+    override __.Equals y = source.Equals y
+    override __.GetHashCode() = source.GetHashCode()
+    override __.ToString() = source.ToString()
+
+[<AutoOpen>]
+module TypeSystemExtensions =
+
+    let handlePolicies (policies : string array) (ctx : ResolveFieldContext) value = async {
+        let root : Root = downcast ctx.Context.RootValue
+        let serviceProvider = root.ServiceProvider
+        let authorizationService = serviceProvider.GetRequiredService<IAuthorizationService>()
+        let principal = serviceProvider.GetRequiredService<IHttpContextAccessor>().HttpContext.User
+        let! authorizationResults =
+            policies
+            |> Seq.map (fun p -> authorizationService.AuthorizeAsync(principal, value, p))
+            |> Seq.toArray
+            |> Task.WhenAll
+            |> Async.AwaitTask
+        let requirements =
+            authorizationResults
+            |> Seq.where (fun r -> not r.Succeeded)
+            |> Seq.collect (fun r -> r.Failure.FailedRequirements)
+        if Seq.isEmpty requirements
+        then return Ok ()
+        else return Error "Forbidden"
+    }
+
+    [<Literal>]
+    let AuthorizationPolicy = "AuthorizationPolicy"
+
+    type FieldDef<'Val> with
+
+        member this.WithPolicyMiddleware<'Res>(middleware : FieldPolicyMiddleware<'Val, 'Res>) : FieldDef<'Val> =
+            upcast CustomPolicyFieldDefinition(this, middleware)
+
+        member field.WithAuthorizationPolicies<'Res>([<ParamArray>] policies : string array) : FieldDef<'Val> =
+
+            let middleware ctx value (resolver : ResolveFieldContext -> 'Val -> Async<'Res>) : Async<'Res> = async {
+                let! result = handlePolicies policies ctx value
+                match result with
+                | Ok _ -> return! resolver ctx value
+                | Error error ->
+                    let ex = Exception (error)
+                    ctx.AddError ex
+                    return raise <| ex
+            }
+
+            field.WithPolicyMiddleware<'Res> middleware

samples/star-wars-api/FSharp.Data.GraphQL.Samples.StarWarsApi.fsproj

@@ -14,6 +14,9 @@
   <ItemGroup>
     <None Include="ApplicationInsights.config" />
     <Compile Include="Helpers.fs" />
+    <Compile Include="Root.fs" />
+    <Compile Include="Policies.fs" />
+    <Compile Include="AuthorizationMiddleware.fs" />
     <Compile Include="Schema.fs" />
     <Compile Include="WebSocketMessages.fs" />
     <Compile Include="JsonConverters.fs" />

samples/star-wars-api/HttpHandlers.fs

@@ -58,7 +58,7 @@ module HttpHandlers =
                 data |> Observable.add (fun d -> printfn "Subscription data: %s" (serialize d))
                 "{}"
 
-        let removeWhitespacesAndLineBreaks (str : string) = str.Trim().Replace ("\r\n", " ")
+        let removeWhitespacesAndLineBreaks (str : string) = str.Trim().Replace(System.Environment.NewLine, " ")
 
         let readStream (s : Stream) =
             use ms = new MemoryStream (4096)
@@ -96,7 +96,7 @@ module HttpHandlers =
             printfn "Received query: %s" query
             printfn "Received variables: %A" variables
             let query = removeWhitespacesAndLineBreaks query
-            let root = { RequestId = System.Guid.NewGuid().ToString () }
+            let root = { RequestId = System.Guid.NewGuid().ToString(); ServiceProvider = ctx.RequestServices }
             let result = Schema.executor.AsyncExecute (query, root, variables) |> Async.RunSynchronously
             printfn "Result metadata: %A" result.Metadata
             return! okWithStr (json result) next ctx

samples/star-wars-api/Policies.fs

@@ -0,0 +1,24 @@
+namespace FSharp.Data.GraphQL.Samples.StarWarsApi.Authorization
+
+open FSharp.Core
+open Microsoft.AspNetCore.Authorization
+
+module Policies =
+
+    let [<Literal>] CanSetMoon = "CanSetMoon"
+
+type IsCharacterRequierment (character : string seq) =
+    member val Characters = character |> List.ofSeq
+    interface IAuthorizationRequirement
+
+type IsCharacterHandler () =
+    inherit AuthorizationHandler<IsCharacterRequierment> () // Inject services from DI
+        override _.HandleRequirementAsync (context, requirement) =
+            Async.StartAsTask(async {
+                let allowedCharacters = requirement.Characters
+                if context.User.Claims
+                   |> Seq.where (fun c -> c.Type = "character")
+                   |> Seq.exists (fun c -> allowedCharacters |> List.contains c.Value)
+                then context.Succeed requirement
+                else () // Go to next handler if registered
+            }) :> _

samples/star-wars-api/Root.fs

@@ -0,0 +1,12 @@
+namespace FSharp.Data.GraphQL.Samples.StarWarsApi
+
+open System
+open FSharp.Data.GraphQL.Types
+
+type Root =
+    { RequestId: string
+      ServiceProvider: IServiceProvider }
+
+module Root =
+    type ResolveFieldContext with
+         member this.Root : Root = downcast this.Context.RootValue

samples/star-wars-api/Schema.fs

@@ -3,6 +3,8 @@
 open FSharp.Data.GraphQL
 open FSharp.Data.GraphQL.Types
 open FSharp.Data.GraphQL.Server.Middleware
+open FSharp.Data.GraphQL.Samples.StarWarsApi.Middleware
+open FSharp.Data.GraphQL.Samples.StarWarsApi.Authorization
 
 #nowarn "40"
 
@@ -33,9 +35,6 @@ type Planet =
         x.IsMoon <- b
         x
 
-type Root =
-    { RequestId: string }
-
 type Character =
     | Human of Human
     | Droid of Droid
@@ -223,11 +222,11 @@ module Schema =
                             x.SetMoon(Some(ctx.Arg("isMoon"))) |> ignore
                             schemaConfig.SubscriptionProvider.Publish<Planet> "watchMoon" x
                             schemaConfig.LiveFieldSubscriptionProvider.Publish<Planet> "Planet" "isMoon" x
-                            x))])
+                            x)).WithAuthorizationPolicies<Planet>(Policies.CanSetMoon)])
 
     let schema : ISchema<Root> = upcast Schema(Query, Mutation, Subscription, schemaConfig)
 
-    let middlewares = 
+    let middlewares =
         [ Define.QueryWeightMiddleware(2.0, true)
           Define.ObjectListFilterMiddleware<Human, Character option>(true)
           Define.ObjectListFilterMiddleware<Droid, Character option>(true)

samples/star-wars-api/Startup.fs

@@ -1,19 +1,26 @@
 namespace FSharp.Data.GraphQL.Samples.StarWarsApi
 
+open System
+open Microsoft.AspNetCore.Authorization
 open Microsoft.AspNetCore.Builder
+open Microsoft.AspNetCore.Server.Kestrel.Core
 open Microsoft.Extensions.Configuration
 open Microsoft.Extensions.DependencyInjection
-open Giraffe
 open Microsoft.Extensions.Logging
-open System
-open Microsoft.AspNetCore.Server.Kestrel.Core
+open Giraffe
+open FSharp.Data.GraphQL.Samples.StarWarsApi.Authorization
 
 type Startup private () =
-    new (configuration: IConfiguration) as this =
+    new (configuration : IConfiguration) as this =
         Startup() then
         this.Configuration <- configuration
 
-    member _.ConfigureServices(services: IServiceCollection) =
+    member _.ConfigureServices (services : IServiceCollection) =
+        services.AddAuthorization(fun options ->
+                    options.AddPolicy(Policies.CanSetMoon, fun policy -> policy.Requirements.Add(IsCharacterRequierment (Seq.singleton "droid"))))
+                .AddScoped<IAuthorizationHandler, IsCharacterHandler>()
+        |> ignore
+
         services.AddGiraffe()
                 .Configure(Action<KestrelServerOptions>(fun x -> x.AllowSynchronousIO <- true))
                 .Configure(Action<IISServerOptions>(fun x -> x.AllowSynchronousIO <- true))
@@ -26,7 +33,7 @@ type Startup private () =
         app
             .UseGiraffeErrorHandler(errorHandler)
             .UseWebSockets()
-            .UseMiddleware<GraphQLWebSocketMiddleware<Root>>(Schema.executor, fun () -> { RequestId = Guid.NewGuid().ToString() })
+            .UseMiddleware<GraphQLWebSocketMiddleware<Root>>(Schema.executor, fun () -> { RequestId = Guid.NewGuid().ToString(); ServiceProvider = app.ApplicationServices })
             .UseGiraffe HttpHandlers.webApp
 
     member val Configuration : IConfiguration = null with get, set