Boilerplate for GraphQL F# implementation.

GraphQL.fs

module GraphQL.Web

open Microsoft.AspNetCore.Http
open System.IO
open Ronnies.Server.Schema
open Microsoft.AspNetCore.Authentication.JwtBearer
open Microsoft.AspNetCore.Authentication
open FSharp.Data.GraphQL.Execution
open Newtonsoft.Json
open Newtonsoft.Json.Linq
open Microsoft.FSharp.Reflection
open FSharp.Data.GraphQL
open FSharp.Data.GraphQL.Types
open System.Collections.Generic
open Newtonsoft.Json.Serialization
open System.Text


[<Sealed>]
type OptionConverter() =
    inherit JsonConverter()

    override __.CanConvert(t) =
        t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<option<_>>

    override __.WriteJson(writer, value, serializer) =
        let value =
            if isNull value then null
            else
                let _,fields = Microsoft.FSharp.Reflection.FSharpValue.GetUnionFields(value, value.GetType())
                fields.[0]
        serializer.Serialize(writer, value)

    override __.ReadJson(reader, t, _, serializer) =
        let innerType = t.GetGenericArguments().[0]
        let innerType =
            if innerType.IsValueType then (typedefof<System.Nullable<_>>).MakeGenericType([|innerType|])
            else innerType
        let value = serializer.Deserialize(reader, innerType)
        let cases = FSharpType.GetUnionCases(t)
        if isNull value then FSharpValue.MakeUnion(cases.[0], [||])
        else FSharpValue.MakeUnion(cases.[1], [|value|])

let private converters : JsonConverter [] = [| OptionConverter() |]


let jsonSerializerSettings (converters : JsonConverter seq) =
    JsonSerializerSettings()
    |> (fun s ->
        s.Converters <- List<JsonConverter>(converters)
        s.ContractResolver <- CamelCasePropertyNamesContractResolver()
        s)

let private jsonSettings = jsonSerializerSettings converters

let private serialize d = JsonConvert.SerializeObject(d, jsonSettings)

let private deserialize (data : string) =
    let getMap (token : JToken) = 
        let rec mapper (name : string) (token : JToken) =
            match name, token.Type with
            | "variables", JTokenType.Object -> token.Children<JProperty>() |> Seq.map (fun x -> x.Name, mapper x.Name x.Value) |> Map.ofSeq |> box
            | name, JTokenType.Array -> token |> Seq.map (fun x -> mapper name x) |> Array.ofSeq |> box
            | _ -> (token :?> JValue).Value
        token.Children<JProperty>()
        |> Seq.map (fun x -> x.Name, mapper x.Name x.Value)
        |> Map.ofSeq
    if System.String.IsNullOrWhiteSpace(data) 
    then None
    else data |> JToken.Parse |> getMap |> Some

let private json result : string =
    match result with
    | Direct (data, _) ->
        JsonConvert.SerializeObject(data, jsonSettings)
    | Deferred (data, _, deferred) ->
        deferred |> Observable.add(fun d -> printfn "Deferred: %s" (serialize d))
        JsonConvert.SerializeObject(data, jsonSettings)
    | Stream data ->  
        data |> Observable.add(fun d -> printfn "Subscription data: %s" (serialize d))
        "{}"

let private removeWhitespacesAndLineBreaks (str : string) = str.Trim().Replace("\r\n", " ")

let private readStream (s : Stream) =
    use ms = new MemoryStream(4096)
    s.CopyTo(ms)
    ms.ToArray()

let processRequest (ctx: HttpContext) =
    async {
        let! authenticationInfo = ctx.AuthenticateAsync(JwtBearerDefaults.AuthenticationScheme) |> Async.AwaitTask
        let claims = Seq.toArray ctx.User.Claims
        let root =
            if authenticationInfo.Succeeded && authenticationInfo.Properties.Items.ContainsKey(".Token.access_token") then
                let user = { AccessToken = authenticationInfo.Properties.Items.[".Token.access_token"]
                             Claims = claims }
                { User = Some user }
            else
                { User = None }
                
        let data = Encoding.UTF8.GetString(readStream ctx.Request.Body) |> deserialize

        let query =
            data |> Option.bind (fun data ->
                if data.ContainsKey("query")
                then
                    match data.["query"] with
                    | :? string as x -> Some x
                    | _ -> failwith "Failure deserializing repsonse. Could not read query - it is not stringified in request."
                else None)
        
        let variables =
            data |> Option.bind (fun data ->
                if data.ContainsKey("variables")
                then
                    match data.["variables"] with
                    | null -> None
                    | :? string as x -> deserialize x
                    | :? Map<string, obj> as x -> Some x
                    | _ -> failwith "Failure deserializing response. Could not read variables - it is not a object in the request."
                else None)                
        
        match query, variables  with
        | Some query, Some variables ->
            printfn "Received query: %s" query
            printfn "Received variables: %A" variables
            let query = removeWhitespacesAndLineBreaks query
            
            let! result = Schema.executor.AsyncExecute(query, root, variables)
            printfn "Result metadata: %A" result.Metadata
            return json result
        | Some query, None ->
            printfn "Received query: %s" query
            let query = removeWhitespacesAndLineBreaks query
            let! result = Schema.executor.AsyncExecute(query, root)
            printfn "Result metadata: %A" result.Metadata
            return json result
        | None, _ ->
            let! result = Schema.executor.AsyncExecute(Introspection.IntrospectionQuery)
            printfn "Result metadata: %A" result.Metadata
            return json result
    }