diff --git a/src/FSharp.Data.GraphQL.Client.DesignTime/FSharp.Data.GraphQL.Client.DesignTime.fsproj b/src/FSharp.Data.GraphQL.Client.DesignTime/FSharp.Data.GraphQL.Client.DesignTime.fsproj
index 6d728c7a..8f3559c3 100644
--- a/src/FSharp.Data.GraphQL.Client.DesignTime/FSharp.Data.GraphQL.Client.DesignTime.fsproj
+++ b/src/FSharp.Data.GraphQL.Client.DesignTime/FSharp.Data.GraphQL.Client.DesignTime.fsproj
@@ -20,6 +20,7 @@
contentFiles;runtime
+
@@ -29,8 +30,6 @@
-
-
diff --git a/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs b/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs
index 504207bb..b9bc6434 100644
--- a/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs
+++ b/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs
@@ -8,6 +8,7 @@ open System.Collections
open System.Collections.Generic
open System.Net.Http
open System.Reflection
+open System.Text.Json
open System.Text.Json.Serialization
open FSharp.Core
open FSharp.Data.GraphQL
@@ -333,7 +334,7 @@ module internal ProvidedOperation =
let serverUrl = info.ServerUrl
let headerNames = info.HttpHeaders |> Seq.map fst |> Array.ofSeq
let headerValues = info.HttpHeaders |> Seq.map snd |> Array.ofSeq
- <@@ { ServerUrl = serverUrl; HttpHeaders = Array.zip headerNames headerValues; Connection = new GraphQLClientConnection() } @@>
+ <@@ { ServerUrl = serverUrl; HttpHeaders = Array.zip headerNames headerValues; Connection = new GraphQLClientConnection(); JsonSerializerOptions = Serialization.defaultSerializerOptions.Value } @@>
| None -> <@@ Unchecked.defaultof @@>
// We need to use the combination strategy to generate overloads for variables in the Run/AsyncRun methods.
// The strategy follows the same principle with ProvidedRecord constructor overloads,
@@ -403,16 +404,16 @@ module internal ProvidedOperation =
HttpHeaders = context.HttpHeaders
OperationName = Option.ofObj operationName
Query = actualQuery
- Variables = %%variables }
+ Variables = %%variables
+ JsonSerializerOptions = context.JsonSerializerOptions }
let response =
if shouldUseMultipartRequest
then Tracer.runAndMeasureExecutionTime "Ran a multipart GraphQL query request" (fun _ -> GraphQLClient.sendMultipartRequest context.Connection request)
else Tracer.runAndMeasureExecutionTime "Ran a GraphQL query request" (fun _ -> GraphQLClient.sendRequest context.Connection request)
let responseString = response.Content.ReadAsStringAsync().GetAwaiter().GetResult()
- let responseJson = Tracer.runAndMeasureExecutionTime "Parsed a GraphQL response to a JsonValue" (fun _ -> JsonValue.Parse responseString)
// If the user does not provide a context, we should dispose the default one after running the query
if isDefaultContext then (context :> IDisposable).Dispose()
- OperationResultBase(response, responseJson, %%operationFieldsExpr, operationTypeName) @@>
+ new OperationResultBase(response, responseString, %%operationFieldsExpr, operationTypeName) @@>
let methodParameters = overloadParameters |> List.map (fun struct (name, _, t) -> ProvidedParameter(name, t, ?optionalValue = if isOption t then Some null else None))
let methodDef = ProvidedMethod("Run", methodParameters, operationResultDef, invoker)
methodDef.AddXmlDoc("Executes the operation on the server and fetch its results.")
@@ -449,7 +450,8 @@ module internal ProvidedOperation =
HttpHeaders = context.HttpHeaders
OperationName = Option.ofObj operationName
Query = actualQuery
- Variables = %%variables }
+ Variables = %%variables
+ JsonSerializerOptions = context.JsonSerializerOptions }
async {
let! ct = Async.CancellationToken
let! response =
@@ -457,17 +459,16 @@ module internal ProvidedOperation =
then Tracer.asyncRunAndMeasureExecutionTime "Ran a multipart GraphQL query request asynchronously" (fun _ -> GraphQLClient.sendMultipartRequestAsync ct context.Connection request |> Async.AwaitTask)
else Tracer.asyncRunAndMeasureExecutionTime "Ran a GraphQL query request asynchronously" (fun _ -> GraphQLClient.sendRequestAsync ct context.Connection request |> Async.AwaitTask)
let! responseString = response.Content.ReadAsStringAsync() |> Async.AwaitTask
- let responseJson = Tracer.runAndMeasureExecutionTime "Parsed a GraphQL response to a JsonValue" (fun _ -> JsonValue.Parse responseString)
// If the user does not provide a context, we should dispose the default one after running the query
if isDefaultContext then (context :> IDisposable).Dispose()
- return OperationResultBase(response, responseJson, %%operationFieldsExpr, operationTypeName)
+ return new OperationResultBase(response, responseString, %%operationFieldsExpr, operationTypeName)
} @@>
let methodParameters = overloadParameters |> List.map (fun struct (name, _, t) -> ProvidedParameter(name, t, ?optionalValue = if isOption t then Some null else None))
let methodDef = ProvidedMethod("AsyncRun", methodParameters, TypeMapping.makeAsync operationResultDef, invoker)
methodDef.AddXmlDoc("Executes the operation asynchronously on the server and fetch its results.")
upcast methodDef)
let parseResultDef =
- let invoker (args : Expr list) = <@@ OperationResultBase(%%args.[1], JsonValue.Parse %%args.[2], %%operationFieldsExpr, operationTypeName) @@>
+ let invoker (args : Expr list) = <@@ new OperationResultBase(%%args.[1], %%args.[2], %%operationFieldsExpr, operationTypeName) @@>
let parameters = [
ProvidedParameter("rawResponse", typeof)
ProvidedParameter("responseJson", typeof)
@@ -753,7 +754,8 @@ module internal Provider =
| _ -> ProvidedParameter("serverUrl", typeof)
let httpHeaders = ProvidedParameter("httpHeaders", typeof>, optionalValue = null)
let connectionFactory = ProvidedParameter("connectionFactory", typeof GraphQLClientConnection>, optionalValue = null)
- [serverUrl; httpHeaders; connectionFactory]
+ let jsonSerializerOptions = ProvidedParameter("jsonSerializerOptions", typeof, optionalValue = null)
+ [serverUrl; httpHeaders; connectionFactory; jsonSerializerOptions]
let defaultHttpHeadersExpr =
let names = httpHeaders |> Seq.map fst |> Array.ofSeq
let values = httpHeaders |> Seq.map snd |> Array.ofSeq
@@ -768,7 +770,11 @@ module internal Provider =
match %%args.[2] : unit -> GraphQLClientConnection with
| argHeaders when obj.Equals(argHeaders, null) -> fun () -> new GraphQLClientConnection()
| argHeaders -> argHeaders
- { ServerUrl = %%serverUrl; HttpHeaders = httpHeaders; Connection = connectionFactory() } @@>
+ let jsonOptions =
+ match %%args.[3] : JsonSerializerOptions with
+ | null -> Serialization.defaultSerializerOptions.Value
+ | opts -> opts
+ { ServerUrl = %%serverUrl; HttpHeaders = httpHeaders; Connection = connectionFactory(); JsonSerializerOptions = jsonOptions } @@>
ProvidedMethod("GetContext", methodParameters, typeof, invoker, isStatic = true)
let operationMethodDef =
let staticParams =
diff --git a/src/FSharp.Data.GraphQL.Client/BaseTypes.fs b/src/FSharp.Data.GraphQL.Client/BaseTypes.fs
index 4b93c3ff..dabdd414 100644
--- a/src/FSharp.Data.GraphQL.Client/BaseTypes.fs
+++ b/src/FSharp.Data.GraphQL.Client/BaseTypes.fs
@@ -267,55 +267,54 @@ module internal TypeMapping =
let makeAsync (t : Type) = typedefof>.MakeGenericType (t)
module internal JsonValueHelper =
- let getResponseFields (responseJson : JsonValue) =
- match responseJson with
- | JsonValue.Record fields -> fields
- | _ -> failwithf "Expected root type to be a Record type, but type is %A." responseJson
-
- let getResponseDataFields (responseJson : JsonValue) =
- match
- getResponseFields responseJson
- |> Array.tryFind (fun (name, _) -> name = "data")
- with
- | Some (_, data) ->
- match data with
- | JsonValue.Record fields -> Some fields
- | JsonValue.Null -> None
- | _ -> failwithf "Expected data field of root type to be a Record type, but type is %A." data
- | None -> None
-
- let getResponseErrors (responseJson : JsonValue) =
- match
- getResponseFields responseJson
- |> Array.tryFind (fun (name, _) -> name = "errors")
- with
- | Some (_, errors) ->
- match errors with
- | JsonValue.Array [||]
- | JsonValue.Null -> None
- | JsonValue.Array items -> Some items
- | _ -> failwithf "Expected error field of root type to be an Array type, but type is %A." errors
- | None -> None
-
- let getResponseCustomFields (responseJson : JsonValue) =
- getResponseFields responseJson
- |> Array.filter (fun (name, _) -> name <> "data" && name <> "errors")
-
- let private removeTypeNameField (fields : (string * JsonValue)[]) =
+ open System.Text.Json
+
+ let getResponseDataFields (responseJson : JsonElement) =
+ match responseJson.TryGetProperty "data" with
+ | true, data ->
+ match data.ValueKind with
+ | JsonValueKind.Object ->
+ data.EnumerateObject ()
+ |> Seq.map (fun prop -> prop.Name, prop.Value)
+ |> Array.ofSeq
+ |> Some
+ | JsonValueKind.Null -> None
+ | _ -> failwithf "Expected data field of root type to be a Record type, but type is %A." data.ValueKind
+ | _ -> None
+
+ let getResponseErrors (responseJson : JsonElement) =
+ match responseJson.TryGetProperty "errors" with
+ | true, errors ->
+ match errors.ValueKind with
+ | JsonValueKind.Null -> None
+ | JsonValueKind.Array ->
+ let items = errors.EnumerateArray () |> Array.ofSeq
+ if items.Length = 0 then None
+ else Some items
+ | _ -> failwithf "Expected error field of root type to be an Array type, but type is %A." errors.ValueKind
+ | _ -> None
+
+ let getResponseCustomFields (responseJson : JsonElement) =
+ responseJson.EnumerateObject ()
+ |> Seq.filter (fun prop -> prop.Name <> "data" && prop.Name <> "errors")
+ |> Seq.map (fun prop -> prop.Name, prop.Value)
+ |> Array.ofSeq
+
+ let private removeTypeNameField (fields : (string * JsonElement) []) =
fields
|> Array.filter (fun (name, _) -> name <> "__typename")
let firstUpper (name : string, value) = name.FirstCharUpper (), value
- let getTypeName (fields : (string * JsonValue) seq) =
+ let getTypeName (fields : (string * JsonElement) seq) =
fields
|> Seq.tryFind (fun (name, _) -> name = "__typename")
|> Option.map (fun (_, value) ->
- match value with
- | JsonValue.String x -> x
- | _ -> failwithf "Expected \"__typename\" field to be a string field, but it was %A." value)
+ match value.ValueKind with
+ | JsonValueKind.String -> value.GetString ()
+ | _ -> failwithf "Expected \"__typename\" field to be a string field, but it was %A." value.ValueKind)
- let rec getFieldValue (schemaField : SchemaFieldInfo) (fieldName : string, fieldValue : JsonValue) =
+ let rec getFieldValue (schemaField : SchemaFieldInfo) (fieldName : string, fieldValue : JsonElement) =
let getScalarType (typeRef : IntrospectionTypeRef) =
let getType (typeName : string) =
match Map.tryFind typeName TypeMapping.scalar with
@@ -324,7 +323,16 @@ module internal JsonValueHelper =
match typeRef.Name with
| Some name -> getType name
| None -> failwith "Expected scalar type to have a name, but it does not have one."
- let rec helper (useOption : bool) (schemaField : SchemaFieldInfo) (fieldValue : JsonValue) : obj =
+
+ let getNumericValue (typeRef : IntrospectionTypeRef) (element : JsonElement) : obj =
+ let t = getScalarType typeRef
+ if t = typeof then element.GetDouble () |> box
+ elif t = typeof then element.GetInt32 () |> box
+ elif t = typeof then element.GetDecimal () |> box
+ elif t = typeof then element.GetInt64 () |> box
+ else element.GetDouble () |> box
+
+ let rec helper (useOption : bool) (schemaField : SchemaFieldInfo) (fieldValue : JsonElement) : obj =
let makeSomeIfNeeded value =
match schemaField.SchemaTypeRef.Kind with
| TypeKind.NON_NULL -> value
@@ -335,8 +343,9 @@ module internal JsonValueHelper =
| TypeKind.NON_NULL -> null
| _ when useOption -> makeNone t
| _ -> null
- match fieldValue with
- | JsonValue.Array items ->
+ match fieldValue.ValueKind with
+ | JsonValueKind.Array ->
+ let itemsArr = fieldValue.EnumerateArray () |> Array.ofSeq
let items =
let itemType =
let tref =
@@ -355,7 +364,7 @@ module internal JsonValueHelper =
| None -> failwith "Schema type is a list type, but no underlying type was specified."
let items =
let schemaField = { schemaField with SchemaTypeRef = itemType }
- items |> Array.map (helper false schemaField)
+ itemsArr |> Array.map (helper false schemaField)
match itemType.Kind with
| TypeKind.NON_NULL ->
match itemType.OfType with
@@ -376,12 +385,16 @@ module internal JsonValueHelper =
| TypeKind.SCALAR -> makeOptionArray (getScalarType itemType) items
| kind -> failwithf "Unsupported type kind \"%A\"." kind
makeSomeIfNeeded items
- | JsonValue.Record props ->
+ | JsonValueKind.Object ->
+ let props =
+ fieldValue.EnumerateObject ()
+ |> Seq.map (fun p -> p.Name, p.Value)
+ |> Array.ofSeq
let typeName =
match getTypeName props with
| Some typeName -> typeName
| None -> failwith "Expected type to have a \"__typename\" field, but it was not found."
- let mapRecordProperty (aliasOrName : string, value : JsonValue) =
+ let mapRecordProperty (aliasOrName : string, value : JsonElement) =
let schemaField =
match
schemaField.Fields
@@ -400,9 +413,22 @@ module internal JsonValueHelper =
|> removeTypeNameField
|> Array.map (firstUpper >> mapRecordProperty)
RecordBase (typeName, props) |> makeSomeIfNeeded
- | JsonValue.Boolean b -> makeSomeIfNeeded b
- | JsonValue.Float f -> makeSomeIfNeeded f
- | JsonValue.Null ->
+ | JsonValueKind.True -> makeSomeIfNeeded true
+ | JsonValueKind.False -> makeSomeIfNeeded false
+ | JsonValueKind.Number ->
+ // Use the schema type to determine the correct numeric CLR type,
+ // fixing the issue where JSON integers (e.g. 0) were returned as int
+ // even when the schema declares the field as Float.
+ let innerTypeRef =
+ match schemaField.SchemaTypeRef.Kind with
+ | TypeKind.NON_NULL ->
+ match schemaField.SchemaTypeRef.OfType with
+ | Some t -> t
+ | None -> schemaField.SchemaTypeRef
+ | _ -> schemaField.SchemaTypeRef
+ let numVal = getNumericValue innerTypeRef fieldValue
+ makeSomeIfNeeded numVal
+ | JsonValueKind.Null ->
match schemaField.SchemaTypeRef.Kind with
| TypeKind.NON_NULL -> failwith "Expected a non null item from the schema definition, but a null item was found in the response."
| TypeKind.OBJECT
@@ -412,8 +438,8 @@ module internal JsonValueHelper =
| TypeKind.SCALAR -> getScalarType schemaField.SchemaTypeRef |> makeNoneIfNeeded
| TypeKind.LIST -> null
| kind -> failwithf "Unsupported type kind \"%A\"." kind
- | JsonValue.Integer n -> makeSomeIfNeeded n
- | JsonValue.String s ->
+ | JsonValueKind.String ->
+ let s = fieldValue.GetString ()
match schemaField.SchemaTypeRef.Kind with
| TypeKind.NON_NULL ->
match schemaField.SchemaTypeRef.OfType with
@@ -457,10 +483,11 @@ module internal JsonValueHelper =
| _ ->
failwith
"A string type was received in the query response item, but the matching schema field is not a string based type or an enum type."
+ | kind -> failwithf "Unexpected JSON value kind \"%A\"." kind
fieldName, (helper true schemaField fieldValue)
- let getFieldValues (schemaTypeName : string) (schemaFields : SchemaFieldInfo[]) (dataFields : (string * JsonValue)[]) =
- let mapFieldValue (aliasOrName : string, value : JsonValue) =
+ let getFieldValues (schemaTypeName : string) (schemaFields : SchemaFieldInfo[]) (dataFields : (string * JsonElement) []) =
+ let mapFieldValue (aliasOrName : string, value : JsonElement) =
let schemaField =
match
schemaFields
@@ -476,66 +503,75 @@ module internal JsonValueHelper =
removeTypeNameField dataFields
|> Array.map (firstUpper >> mapFieldValue)
- let getErrors (errors : JsonValue[]) =
- let tryFindField fieldName (fields : (string * JsonValue)[]) =
- fields
- |> Array.tryFind (fun (name, _) -> name = fieldName)
- |> Option.map snd
-
- let parsePath =
- function
- | Some (JsonValue.Array path) ->
- let pathMapper =
- function
- | JsonValue.String x -> box x
- | JsonValue.Integer x -> box x
+ let getErrors (errors : JsonElement []) =
+ let tryGetProperty (name : string) (element : JsonElement) =
+ match element.TryGetProperty name with
+ | true, v -> Some v
+ | _ -> None
+
+ let parsePath (pathElement : JsonElement option) =
+ match pathElement with
+ | Some e when e.ValueKind = JsonValueKind.Array ->
+ let pathMapper (item : JsonElement) =
+ match item.ValueKind with
+ | JsonValueKind.String -> item.GetString () |> box
+ | JsonValueKind.Number -> item.GetInt32 () |> box
| _ -> failwith "Error parsing response errors. An item in the path is neither a String nor an Integer."
- path |> Array.map pathMapper
- | Some JsonValue.Null
+ e.EnumerateArray () |> Seq.map pathMapper |> Array.ofSeq
| None -> [||]
+ | Some e when e.ValueKind = JsonValueKind.Null -> [||]
| _ -> failwith "Error parsing response errors. Path field must be an Array."
- let parseLocations =
- function
- | Some (JsonValue.Array locations) ->
- let parseLocation =
- function
- | JsonValue.Record locationFields ->
- match tryFindField "line" locationFields, tryFindField "column" locationFields with
- | Some (JsonValue.Integer line), Some (JsonValue.Integer column) -> { Line = line; Column = column }
+ let parseLocations (locElement : JsonElement option) =
+ match locElement with
+ | Some e when e.ValueKind = JsonValueKind.Array ->
+ let parseLocation (loc : JsonElement) =
+ match loc.ValueKind with
+ | JsonValueKind.Object ->
+ match loc.TryGetProperty "line", loc.TryGetProperty "column" with
+ | (true, lineEl), (true, colEl) -> { Line = lineEl.GetInt32 (); Column = colEl.GetInt32 () }
| _ -> failwith "Error parsing response errors. A location item must contain Integer fields named \"line\" and \"column\"."
| _ -> failwith "Error parsing response errors. A location item is not a Record."
- locations |> Array.map parseLocation
- | Some JsonValue.Null
+ e.EnumerateArray () |> Seq.map parseLocation |> Array.ofSeq
| None -> [||]
+ | Some e when e.ValueKind = JsonValueKind.Null -> [||]
| _ -> failwith "Error parsing response errors. Locations field must be an Array."
- let parseExtensions =
- function
- | Some (JsonValue.Record fields) -> Serialization.deserializeMap fields
- | Some JsonValue.Null
+ let parseExtensions (extElement : JsonElement option) =
+ match extElement with
+ | Some e when e.ValueKind = JsonValueKind.Object ->
+ e.EnumerateObject ()
+ |> Seq.map (fun prop -> prop.Name, prop.Value)
+ |> Array.ofSeq
+ |> Serialization.deserializeMap
| None -> Map.empty
+ | Some e when e.ValueKind = JsonValueKind.Null -> Map.empty
| _ -> failwith "Error parsing response errors. Extensions field must be a Record."
- let errorMapper =
- function
- | JsonValue.Record fields ->
- match tryFindField "message" fields with
- | Some (JsonValue.String message) -> {
- Message = message
- Locations = tryFindField "locations" fields |> parseLocations
- Path = tryFindField "path" fields |> parsePath
- Extensions = tryFindField "extensions" fields |> parseExtensions
+ let errorMapper (errorElement : JsonElement) =
+ match errorElement.ValueKind with
+ | JsonValueKind.Object ->
+ match tryGetProperty "message" errorElement with
+ | Some msgEl when msgEl.ValueKind = JsonValueKind.String -> {
+ Message = msgEl.GetString ()
+ Locations = tryGetProperty "locations" errorElement |> parseLocations
+ Path = tryGetProperty "path" errorElement |> parsePath
+ Extensions = tryGetProperty "extensions" errorElement |> parseExtensions
}
| _ -> failwith "Error parsing response errors. Unsupported errors field format."
- | other -> failwithf "Error parsing response errors. Expected error to be a Record type, but it is %s." (other.ToString ())
+ | _ -> failwith "Error parsing response errors. Expected error to be a Record type."
Array.map errorMapper errors
/// The base type for all GraphQLProvider operation result provided types.
type OperationResultBase
- (rawResponse : HttpResponseMessage, responseJson : JsonValue, operationFields : SchemaFieldInfo[], operationTypeName : string) =
+ (rawResponse : HttpResponseMessage, responseJson : string, operationFields : SchemaFieldInfo[], operationTypeName : string) =
+ let parsedJson =
+ try System.Text.Json.JsonDocument.Parse responseJson
+ with ex -> raise (System.InvalidOperationException ($"Failed to parse GraphQL response JSON: {ex.Message}", ex))
+ let rootElement = parsedJson.RootElement
+
let rawData =
- let data = JsonValueHelper.getResponseDataFields responseJson
+ let data = JsonValueHelper.getResponseDataFields rootElement
match data with
| Some [||]
| None -> None
@@ -547,13 +583,13 @@ type OperationResultBase
Some (RecordBase (operationTypeName, props))
let errors =
- let errors = JsonValueHelper.getResponseErrors responseJson
+ let errors = JsonValueHelper.getResponseErrors rootElement
match errors with
| None -> [||]
| Some errors -> JsonValueHelper.getErrors errors
let customData =
- JsonValueHelper.getResponseCustomFields responseJson
+ JsonValueHelper.getResponseCustomFields rootElement
|> Serialization.deserializeMap
member private _.ResponseJson = responseJson
@@ -582,7 +618,10 @@ type OperationResultBase
override x.GetHashCode () = x.ResponseJson.GetHashCode ()
-/// The base type for al GraphQLProvider operation provided types.
+ interface IDisposable with
+ member _.Dispose () = parsedJson.Dispose ()
+
+/// The base type for all GraphQLProvider operation provided types.
type OperationBase (query : string) =
/// Gets the query string of the operation.
member _.Query = query
@@ -597,6 +636,7 @@ module VariableMapping =
| :? string -> value
| :? EnumBase as v -> v.GetValue () |> box
| :? RecordBase as v -> v.ToDictionary () |> box
- | OptionValue v -> v |> Option.map mapVariableValue |> box
+ | OptionValue None -> null
+ | OptionValue (Some v) -> mapVariableValue v
| EnumerableValue v -> v |> Array.map mapVariableValue |> box
| v -> v
diff --git a/src/FSharp.Data.GraphQL.Client/FSharp.Data.GraphQL.Client.fsproj b/src/FSharp.Data.GraphQL.Client/FSharp.Data.GraphQL.Client.fsproj
index ee00d2db..fac5e51e 100644
--- a/src/FSharp.Data.GraphQL.Client/FSharp.Data.GraphQL.Client.fsproj
+++ b/src/FSharp.Data.GraphQL.Client/FSharp.Data.GraphQL.Client.fsproj
@@ -16,13 +16,13 @@
all
runtime
+
+
-
-
diff --git a/src/FSharp.Data.GraphQL.Client/GraphQLClient.fs b/src/FSharp.Data.GraphQL.Client/GraphQLClient.fs
index 6a757fc2..a1a439a3 100644
--- a/src/FSharp.Data.GraphQL.Client/GraphQLClient.fs
+++ b/src/FSharp.Data.GraphQL.Client/GraphQLClient.fs
@@ -5,9 +5,9 @@ namespace FSharp.Data.GraphQL
open System
open System.Collections.Generic
-open System.Collections.Immutable
open System.Net.Http
open System.Text
+open System.Text.Json
open System.Threading
open System.Threading.Tasks
@@ -15,7 +15,7 @@ open FSharp.Data.GraphQL
open FSharp.Data.GraphQL.Client
open ReflectionPatterns
-/// A requrest object for making GraphQL calls using the GraphQL client module.
+/// A request object for making GraphQL calls using the GraphQL client module.
type GraphQLRequest = {
/// Gets the URL of the GraphQL server which will be called.
ServerUrl : string
@@ -27,6 +27,8 @@ type GraphQLRequest = {
Query : string
/// Gets variables to be sent with the query.
Variables : (string * obj)[]
+ /// Gets the JSON serializer options used for serializing request variables.
+ JsonSerializerOptions : JsonSerializerOptions
}
/// Executes calls to GraphQL servers and return their responses.
@@ -57,22 +59,8 @@ module GraphQLClient =
/// Sends a request to a GraphQL server asynchronously.
let sendRequestAsync ct (connection : GraphQLClientConnection) (request : GraphQLRequest) = task {
let invoker = connection.Invoker
- let variables =
- match request.Variables with
- | null | [||] -> JsonValue.Null
- | _ -> Map.ofArray request.Variables |> Serialization.toJsonValue
- let operationName =
- match request.OperationName with
- | Some x -> JsonValue.String x
- | None -> JsonValue.Null
- let requestJson =
- [|
- "operationName", operationName
- "query", JsonValue.String request.Query
- "variables", variables
- |]
- |> JsonValue.Record
- let content = new StringContent (requestJson.ToString (), Encoding.UTF8, "application/json")
+ let json = Serialization.buildRequestJson request.JsonSerializerOptions request.OperationName request.Query request.Variables
+ let content = new StringContent (json, Encoding.UTF8, "application/json")
return! postAsync ct invoker request.ServerUrl request.HttpHeaders content
}
@@ -103,6 +91,7 @@ module GraphQLClient =
OperationName = None
Query = IntrospectionQuery.Definition
Variables = [||]
+ JsonSerializerOptions = Serialization.defaultSerializerOptions.Value
}
try
return! sendRequestAsync ct connection request
@@ -145,35 +134,14 @@ module GraphQLClient =
|> Array.collect (tryMapFileVariable >> (Option.defaultValue [||]))
let operationContent =
- let variables =
- match request.Variables with
- | null
- | [||] -> JsonValue.Null
- | _ ->
- request.Variables
- |> Map.ofArray
- |> Serialization.toJsonValue
- let operationName =
- match request.OperationName with
- | Some x -> JsonValue.String x
- | None -> JsonValue.Null
- let json =
- [|
- "operationName", operationName
- "query", JsonValue.String request.Query
- "variables", variables
- |]
- |> JsonValue.Record
- let content = new StringContent (json.ToString (JsonSaveOptions.DisableFormatting))
+ let json = Serialization.buildRequestJson request.JsonSerializerOptions request.OperationName request.Query request.Variables
+ let content = new StringContent (json)
content.Headers.Add ("Content-Disposition", "form-data; name=\"operations\"")
content
content.Add (operationContent)
let mapContent =
- let files =
- files
- |> Array.mapi (fun ix (name, _) -> ix.ToString (), JsonValue.Array [| JsonValue.String ("variables." + name) |])
- |> JsonValue.Record
- let content = new StringContent (files.ToString (JsonSaveOptions.DisableFormatting))
+ let json = Serialization.buildMapJson files
+ let content = new StringContent (json)
content.Headers.Add ("Content-Disposition", "form-data; name=\"map\"")
content
content.Add (mapContent)
diff --git a/src/FSharp.Data.GraphQL.Client/GraphQLProviderRuntimeContext.fs b/src/FSharp.Data.GraphQL.Client/GraphQLProviderRuntimeContext.fs
index 9c254b6f..72d2847f 100644
--- a/src/FSharp.Data.GraphQL.Client/GraphQLProviderRuntimeContext.fs
+++ b/src/FSharp.Data.GraphQL.Client/GraphQLProviderRuntimeContext.fs
@@ -4,6 +4,7 @@
namespace FSharp.Data.GraphQL
open System
+open System.Text.Json
/// Contains information about a GraphQLRuntimeContext.
type GraphQLRuntimeContextInfo =
@@ -17,6 +18,9 @@ type GraphQLProviderRuntimeContext =
/// Gets the HTTP headers used for calls to the server that this context refers to.
HttpHeaders : seq
/// Gets the connection component used to make calls to the server.
- Connection : GraphQLClientConnection }
+ Connection : GraphQLClientConnection
+ /// Gets the JSON serializer options used for serializing request variables and
+ /// deserializing scalar values. Pass a customized instance to support custom scalar types.
+ JsonSerializerOptions : JsonSerializerOptions }
interface IDisposable with
member x.Dispose() = (x.Connection :> IDisposable).Dispose()
diff --git a/src/FSharp.Data.GraphQL.Client/Serialization.fs b/src/FSharp.Data.GraphQL.Client/Serialization.fs
index 6572c1aa..ae57226b 100644
--- a/src/FSharp.Data.GraphQL.Client/Serialization.fs
+++ b/src/FSharp.Data.GraphQL.Client/Serialization.fs
@@ -5,198 +5,309 @@ namespace FSharp.Data.GraphQL.Client
open System
open System.Collections.Generic
-open System.Diagnostics
-open System.Globalization
-open System.Reflection
-open Microsoft.FSharp.Reflection
+open System.IO
+open System.Text
+open System.Text.Json
open FSharp.Data.GraphQL
open FSharp.Data.GraphQL.Client.ReflectionPatterns
+open FSharp.Data.GraphQL.Types
+open FSharp.Data.GraphQL.Types.Introspection
+
+/// Manual schema parser that uses JsonElement directly, enabling lenient handling
+/// of missing fields (e.g., 'kind' is absent in queryType/mutationType references).
+module private SchemaParser =
+
+ let private tryGetString (element : JsonElement) (name : string) =
+ match element.TryGetProperty name with
+ | true, el when el.ValueKind = JsonValueKind.String -> Some (el.GetString ())
+ | _ -> None
+
+ let private tryGetBool (element : JsonElement) (name : string) (defaultValue : bool) =
+ match element.TryGetProperty name with
+ | true, el ->
+ match el.ValueKind with
+ | JsonValueKind.True -> true
+ | JsonValueKind.False -> false
+ | _ -> defaultValue
+ | _ -> defaultValue
+
+ let private parseTypeKind (s : string) =
+ match s with
+ | "SCALAR" -> TypeKind.SCALAR
+ | "OBJECT" -> TypeKind.OBJECT
+ | "INTERFACE" -> TypeKind.INTERFACE
+ | "UNION" -> TypeKind.UNION
+ | "ENUM" -> TypeKind.ENUM
+ | "INPUT_OBJECT" -> TypeKind.INPUT_OBJECT
+ | "LIST" -> TypeKind.LIST
+ | "NON_NULL" -> TypeKind.NON_NULL
+ | _ -> Unchecked.defaultof
+
+ let private parseDirectiveLocation (s : string) =
+ match s with
+ | "QUERY" -> DirectiveLocation.QUERY
+ | "MUTATION" -> DirectiveLocation.MUTATION
+ | "SUBSCRIPTION" -> DirectiveLocation.SUBSCRIPTION
+ | "FIELD" -> DirectiveLocation.FIELD
+ | "FRAGMENT_DEFINITION" -> DirectiveLocation.FRAGMENT_DEFINITION
+ | "FRAGMENT_SPREAD" -> DirectiveLocation.FRAGMENT_SPREAD
+ | "INLINE_FRAGMENT" -> DirectiveLocation.INLINE_FRAGMENT
+ | "SCHEMA" -> DirectiveLocation.SCHEMA
+ | "SCALAR" -> DirectiveLocation.SCALAR
+ | "OBJECT" -> DirectiveLocation.OBJECT
+ | "FIELD_DEFINITION" -> DirectiveLocation.FIELD_DEFINITION
+ | "ARGUMENT_DEFINITION" -> DirectiveLocation.ARGUMENT_DEFINITION
+ | "INTERFACE" -> DirectiveLocation.INTERFACE
+ | "UNION" -> DirectiveLocation.UNION
+ | "ENUM" -> DirectiveLocation.ENUM
+ | "ENUM_VALUE" -> DirectiveLocation.ENUM_VALUE
+ | "INPUT_OBJECT" -> DirectiveLocation.INPUT_OBJECT
+ | "INPUT_FIELD_DEFINITION" -> DirectiveLocation.INPUT_FIELD_DEFINITION
+ | _ -> Unchecked.defaultof
+
+ let rec private parseTypeRef (element : JsonElement) : IntrospectionTypeRef =
+ {
+ Kind =
+ match element.TryGetProperty "kind" with
+ | true, el when el.ValueKind = JsonValueKind.String -> parseTypeKind (el.GetString ())
+ | _ -> Unchecked.defaultof
+ Name = tryGetString element "name"
+ Description = tryGetString element "description"
+ OfType =
+ match element.TryGetProperty "ofType" with
+ | true, el when el.ValueKind = JsonValueKind.Object -> Some (parseTypeRef el)
+ | _ -> None
+ }
+
+ let private parseInputVal (element : JsonElement) : IntrospectionInputVal =
+ {
+ Name = tryGetString element "name" |> Option.defaultValue ""
+ Description = tryGetString element "description"
+ Type =
+ match element.TryGetProperty "type" with
+ | true, el -> parseTypeRef el
+ | _ -> { Kind = Unchecked.defaultof; Name = None; Description = None; OfType = None }
+ DefaultValue = tryGetString element "defaultValue"
+ }
+
+ let private parseEnumVal (element : JsonElement) : IntrospectionEnumVal =
+ {
+ Name = tryGetString element "name" |> Option.defaultValue ""
+ Description = tryGetString element "description"
+ IsDeprecated = tryGetBool element "isDeprecated" false
+ DeprecationReason = tryGetString element "deprecationReason"
+ }
+
+ let private parseField (element : JsonElement) : IntrospectionField =
+ {
+ Name = tryGetString element "name" |> Option.defaultValue ""
+ Description = tryGetString element "description"
+ Args =
+ match element.TryGetProperty "args" with
+ | true, el when el.ValueKind = JsonValueKind.Array ->
+ el.EnumerateArray () |> Seq.map parseInputVal |> Array.ofSeq
+ | _ -> [||]
+ Type =
+ match element.TryGetProperty "type" with
+ | true, el -> parseTypeRef el
+ | _ -> { Kind = Unchecked.defaultof; Name = None; Description = None; OfType = None }
+ IsDeprecated = tryGetBool element "isDeprecated" false
+ DeprecationReason = tryGetString element "deprecationReason"
+ }
+
+ let private parseType (element : JsonElement) : IntrospectionType =
+ let tryGetArrayOfTypeRef (name : string) =
+ match element.TryGetProperty name with
+ | true, el when el.ValueKind = JsonValueKind.Array ->
+ Some (el.EnumerateArray () |> Seq.map parseTypeRef |> Array.ofSeq)
+ | _ -> None
+ {
+ Kind =
+ match element.TryGetProperty "kind" with
+ | true, el when el.ValueKind = JsonValueKind.String -> parseTypeKind (el.GetString ())
+ | _ -> Unchecked.defaultof
+ Name = tryGetString element "name" |> Option.defaultValue ""
+ Description = tryGetString element "description"
+ Fields =
+ match element.TryGetProperty "fields" with
+ | true, el when el.ValueKind = JsonValueKind.Array ->
+ Some (el.EnumerateArray () |> Seq.map parseField |> Array.ofSeq)
+ | _ -> None
+ Interfaces = tryGetArrayOfTypeRef "interfaces"
+ PossibleTypes = tryGetArrayOfTypeRef "possibleTypes"
+ EnumValues =
+ match element.TryGetProperty "enumValues" with
+ | true, el when el.ValueKind = JsonValueKind.Array ->
+ Some (el.EnumerateArray () |> Seq.map parseEnumVal |> Array.ofSeq)
+ | _ -> None
+ InputFields =
+ match element.TryGetProperty "inputFields" with
+ | true, el when el.ValueKind = JsonValueKind.Array ->
+ Some (el.EnumerateArray () |> Seq.map parseInputVal |> Array.ofSeq)
+ | _ -> None
+ OfType =
+ match element.TryGetProperty "ofType" with
+ | true, el when el.ValueKind = JsonValueKind.Object -> Some (parseTypeRef el)
+ | _ -> None
+ }
+
+ let private parseDirective (element : JsonElement) : IntrospectionDirective =
+ {
+ Name = tryGetString element "name" |> Option.defaultValue ""
+ Description = tryGetString element "description"
+ Locations =
+ match element.TryGetProperty "locations" with
+ | true, el when el.ValueKind = JsonValueKind.Array ->
+ el.EnumerateArray ()
+ |> Seq.choose (fun e ->
+ if e.ValueKind = JsonValueKind.String then
+ Some (parseDirectiveLocation (e.GetString ()))
+ else
+ None)
+ |> Array.ofSeq
+ | _ -> [||]
+ Args =
+ match element.TryGetProperty "args" with
+ | true, el when el.ValueKind = JsonValueKind.Array ->
+ el.EnumerateArray () |> Seq.map parseInputVal |> Array.ofSeq
+ | _ -> [||]
+ }
+
+ let parseSchema (element : JsonElement) : IntrospectionSchema =
+ {
+ QueryType =
+ match element.TryGetProperty "queryType" with
+ | true, el -> parseTypeRef el
+ | _ -> { Kind = Unchecked.defaultof; Name = None; Description = None; OfType = None }
+ MutationType =
+ match element.TryGetProperty "mutationType" with
+ | true, el when el.ValueKind = JsonValueKind.Object -> Some (parseTypeRef el)
+ | _ -> None
+ SubscriptionType =
+ match element.TryGetProperty "subscriptionType" with
+ | true, el when el.ValueKind = JsonValueKind.Object -> Some (parseTypeRef el)
+ | _ -> None
+ Types =
+ match element.TryGetProperty "types" with
+ | true, el when el.ValueKind = JsonValueKind.Array ->
+ el.EnumerateArray () |> Seq.map parseType |> Array.ofSeq
+ | _ -> [||]
+ Directives =
+ match element.TryGetProperty "directives" with
+ | true, el when el.ValueKind = JsonValueKind.Array ->
+ el.EnumerateArray () |> Seq.map parseDirective |> Array.ofSeq
+ | _ -> [||]
+ }
-// TODO: Remove and use FSharp.SystemTextJson
module Serialization =
- let private makeOption t (value : obj) =
- let otype = typedefof<_ option>
- let cases = FSharpType.GetUnionCases(otype.MakeGenericType([|t|]))
+
+ /// The default JSON serializer options used for request serialization when no custom options are provided.
+ let defaultSerializerOptions =
+ lazy FSharp.Data.GraphQL.Shared.Json.getSerializerOptions Seq.empty
+
+ /// Converts special types (Uri, Upload, etc.) that System.Text.Json cannot handle natively
+ /// into their JSON-serializable representations. Applied recursively to variable values.
+ /// Also normalizes dictionary keys to camelCase to match GraphQL field naming conventions.
+ let rec private normalizeForSerialization (value : obj) : obj =
match value with
- | null -> FSharpValue.MakeUnion(cases.[0], [||])
- | _ -> FSharpValue.MakeUnion(cases.[1], [|value|])
-
- let private downcastNone<'T> t =
- match t with
- | Option t -> downcast (makeOption t null)
- | _ -> failwith $"Error parsing JSON value: %O{t} is not an option value."
-
- let private downcastType (t : Type) x =
- match t with
- | Option t -> downcast (makeOption t (Convert.ChangeType(x, t)))
- | _ -> downcast (Convert.ChangeType(x, t))
-
- let private isStringType = isType typeof
- let private isDateTimeType = isType typeof
- let private isDateTimeOffsetType = isType typeof
- let private isUriType = isType typeof
- let private isGuidType = isType typeof
- let private isBooleanType = isType typeof
- let private isEnumType = function (Option t | t) when t.IsEnum -> true | _ -> false
-
- let private downcastString (t : Type) (s : string) =
- match t with
- | t when isStringType t -> downcastType t s
- | t when isUriType t ->
- match Uri.TryCreate(s, UriKind.RelativeOrAbsolute) with
- | (true, uri) -> downcastType t uri
- | _ -> failwith $"Error parsing JSON value: %O{t} is an URI type, but parsing of value \"%s{s}\" failed."
- | t when isDateTimeType t ->
- match DateTime.TryParse(s, CultureInfo.InvariantCulture, DateTimeStyles.None) with
- | (true, d) -> downcastType t d
- | _ -> failwith $"Error parsing JSON value: %O{t} is a date type, but parsing of value \"%s{s}\" failed."
- | t when isDateTimeOffsetType t ->
- match DateTimeOffset.TryParse(s, CultureInfo.InvariantCulture, DateTimeStyles.None) with
- | (true, d) -> downcastType t d
- | _ -> failwith $"Error parsing JSON value: %O{t} is a date time offset type, but parsing of value \"%s{s}\" failed."
- | t when isGuidType t ->
- match Guid.TryParse(s) with
- | (true, g) -> downcastType t g
- | _ -> failwith $"Error parsing JSON value: %O{t} is a Guid type, but parsing of value \"%s{s}\" failed."
- | t when isEnumType t ->
- match t with
- | (Option et | et) ->
- try Enum.Parse(et, s) |> downcastType t
- with _ -> failwith $"Error parsing JSON value: %O{t} is a Enum type, but parsing of value \"%s{s}\" failed."
- | _ -> failwith $"Error parsing JSON value: %O{t} is not a string type."
-
- let private downcastBoolean (t : Type) b =
- match t with
- | t when isBooleanType t -> downcastType t b
- | _ -> failwith $"Error parsing JSON value: %O{t} is not a boolean type."
-
- let rec private getArrayValue (t : Type) (converter : Type -> JsonValue -> obj) (items : JsonValue []) =
- let castArray itemType (items : obj []) : obj =
- let arr = Array.CreateInstance(itemType, items.Length)
- items |> Array.iteri (fun ix i -> arr.SetValue(i, ix))
- upcast arr
- let castList itemType (items : obj list) =
- let tlist = typedefof<_ list>.MakeGenericType([|itemType|])
- let empty =
- let uc =
- Reflection.FSharpType.GetUnionCases(tlist)
- |> Seq.filter (fun uc -> uc.Name = "Empty")
- |> Seq.exactlyOne
- Reflection.FSharpValue.MakeUnion(uc, [||])
- let rec helper items =
- match items with
- | [] -> empty
- | [x] -> Activator.CreateInstance(tlist, [|x; empty|])
- | x :: xs -> Activator.CreateInstance(tlist, [|x; helper xs|])
- helper items
- Tracer.runAndMeasureExecutionTime "Converted Array JsonValue to CLR array" (fun _ ->
- match t with
- | Option t -> getArrayValue t converter items |> makeOption t
- | Array itype | Seq itype -> items |> Array.map (converter itype) |> castArray itype
- | List itype -> items |> Array.map (converter itype) |> Array.toList |> castList itype
- | _ -> failwith $"Error parsing JSON value: %O{t} is not an array type.")
-
- let private downcastNumber (t : Type) n =
- match t with
- | t when isNumericType t -> downcastType t n
- | _ -> failwith $"Error parsing JSON value: %O{t} is not a numeric type."
-
- let rec private convert t parsed : obj =
- Tracer.runAndMeasureExecutionTime $"Converted JsonValue to %O{t} type." (fun _ ->
- match parsed with
- | JsonValue.Null -> downcastNone t
- | JsonValue.String s -> downcastString t s
- | JsonValue.Float n -> downcastNumber t n
- | JsonValue.Integer n -> downcastNumber t n
- | JsonValue.Record jprops ->
- let jprops =
- jprops
- |> Array.map (fun (n, v) -> n.ToLowerInvariant(), v)
- |> Map.ofSeq
- let tprops t =
- FSharpType.GetRecordFields(t, true)
- |> Array.map (fun p -> p.Name.ToLowerInvariant(), p.PropertyType)
- let vals t =
- tprops t
- |> Array.map (fun (n, t) ->
- match Map.tryFind n jprops with
- | Some p -> n, convert t p
- | None -> n, makeOption t null)
- let rcrd =
- let t = match t with Option t -> t | _ -> t
- let vals = vals t
- if isMap t
- then Map.ofArray vals |> box
- else FSharpValue.MakeRecord(t, Array.map snd vals, true)
- downcastType t rcrd
- | JsonValue.Array items -> items |> getArrayValue t convert
- | JsonValue.Boolean b -> downcastBoolean t b)
-
- let deserializeRecord<'T> (json : string) : 'T =
- let t = typeof<'T>
- Tracer.runAndMeasureExecutionTime $"Deserialized JSON string to record type %O{t}." (fun _ ->
- downcast (JsonValue.Parse(json) |> convert t))
-
- let deserializeMap values =
- let rec helper (values : (string * JsonValue) []) =
- values
- |> Array.map (fun (name, value) ->
- match value with
- | JsonValue.Record fields -> name, (fields |> helper |> Map.ofArray |> box)
- | JsonValue.Null -> name, null
- | JsonValue.String s -> name, box s
- | JsonValue.Integer n -> name, box n
- | JsonValue.Float f -> name, box f
- | JsonValue.Array items -> name, (items |> Array.map (fun item -> null, item) |> helper |> Array.map snd |> box)
- | JsonValue.Boolean b -> name, box b)
+ | null -> null
+ | :? string -> value // Must come before EnumerableValue: string implements IEnumerable
+ | :? Uri as u -> box (u.ToString ())
+ | :? Upload as u -> box u.Name // File variables are written as the form-part name string
+ | :? IDictionary as d ->
+ // Apply FirstCharLower to keys: RecordBase.ToDictionary() uses PascalCase (FirstCharUpper) for property names
+ d |> Seq.map (fun kvp -> kvp.Key.FirstCharLower (), normalizeForSerialization kvp.Value) |> dict |> box
+ | EnumerableValue items -> items |> Array.map normalizeForSerialization |> box
+ | v -> v
+
+ /// Converts a JsonElement to an F# object recursively.
+ let rec private deserializeElement (element : JsonElement) : obj =
+ match element.ValueKind with
+ | JsonValueKind.Object ->
+ element.EnumerateObject ()
+ |> Seq.map (fun prop -> prop.Name, deserializeElement prop.Value)
+ |> Map.ofSeq
+ |> box
+ | JsonValueKind.Array ->
+ element.EnumerateArray ()
+ |> Seq.map deserializeElement
+ |> Array.ofSeq
+ |> box
+ | JsonValueKind.String -> element.GetString () |> box
+ | JsonValueKind.Number ->
+ match element.TryGetInt32 () with
+ | true, n -> box n
+ | _ ->
+ match element.TryGetInt64 () with
+ | true, n -> box n
+ | _ -> element.GetDouble () |> box
+ | JsonValueKind.True -> box true
+ | JsonValueKind.False -> box false
+ | _ -> null
+
+ let deserializeMap (values : (string * JsonElement) []) =
Tracer.runAndMeasureExecutionTime "Deserialized JSON Record into FSharp Map" (fun _ ->
- helper values |> Map.ofArray)
-
- let private isoDateFormat = "yyyy-MM-dd"
- let private isoDateTimeFormat = "O"
-
- let rec toJsonValue (x : obj) : JsonValue =
- if isNull x
- then JsonValue.Null
- else
- let t = x.GetType()
- Tracer.runAndMeasureExecutionTime $"Converted object type %O{t} to JsonValue" (fun _ ->
- match x with
- | null -> JsonValue.Null
- | OptionValue None -> JsonValue.Null
- | :? int as x -> JsonValue.Integer (int x)
- | :? float as x -> JsonValue.Float x
- | :? string as x -> JsonValue.String x
- | :? Guid as x -> JsonValue.String (x.ToString())
- | :? DateTime as x when x.Date = x -> JsonValue.String (x.ToString(isoDateFormat))
- | :? DateTime as x -> JsonValue.String (x.ToString(isoDateTimeFormat))
- | :? DateTimeOffset as x -> JsonValue.String (x.ToString(isoDateTimeFormat))
- | :? bool as x -> JsonValue.Boolean x
- | :? Uri as x -> JsonValue.String (x.ToString())
- | :? Upload as u -> JsonValue.String u.Name
- | :? IDictionary as items ->
- items
- |> Seq.map (fun (KeyValue (k, v)) -> k.FirstCharLower(), toJsonValue v)
- |> Seq.toArray
- |> JsonValue.Record
- | EnumerableValue items ->
- items
- |> Array.map toJsonValue
- |> JsonValue.Array
- | OptionValue (Some x) -> toJsonValue x
- | EnumValue x -> JsonValue.String x
- | _ ->
- let props = t.GetProperties(BindingFlags.Public ||| BindingFlags.Instance)
- let items = props |> Array.map (fun p -> (p.Name.FirstCharLower(), p.GetValue(x) |> toJsonValue))
- JsonValue.Record items)
-
- let serializeRecord (x : obj) =
- Tracer.runAndMeasureExecutionTime $"Serialized object type %O{x.GetType()} to a JSON string" (fun _ ->
- (toJsonValue x).ToString())
+ values
+ |> Array.map (fun (name, element) -> name, deserializeElement element)
+ |> Map.ofArray)
+
+ /// Builds the JSON body for a standard GraphQL request.
+ let buildRequestJson (options : JsonSerializerOptions) (operationName : string option) (query : string) (variables : (string * obj) []) =
+ Tracer.runAndMeasureExecutionTime "Built GraphQL request JSON" (fun _ ->
+ use stream = new MemoryStream ()
+ use writer = new Utf8JsonWriter (stream, JsonWriterOptions (Indented = false))
+ writer.WriteStartObject ()
+ writer.WritePropertyName "operationName"
+ match operationName with
+ | Some name -> writer.WriteStringValue name
+ | None -> writer.WriteNullValue ()
+ writer.WritePropertyName "query"
+ writer.WriteStringValue query
+ writer.WritePropertyName "variables"
+ if variables = null || variables.Length = 0 then
+ writer.WriteNullValue ()
+ else
+ let dict = variables |> Array.map (fun (k, v) -> k, normalizeForSerialization v) |> dict
+ JsonSerializer.Serialize (writer, dict, options)
+ writer.WriteEndObject ()
+ writer.Flush ()
+ Encoding.UTF8.GetString (stream.ToArray ()))
+
+ /// Builds the JSON body for the "map" part of a multipart GraphQL request.
+ let buildMapJson (files : (string * Upload) []) =
+ Tracer.runAndMeasureExecutionTime "Built GraphQL map JSON" (fun _ ->
+ use stream = new MemoryStream ()
+ use writer = new Utf8JsonWriter (stream, JsonWriterOptions (Indented = false))
+ writer.WriteStartObject ()
+ files
+ |> Array.iteri (fun ix (name, _) ->
+ writer.WritePropertyName (ix.ToString ())
+ writer.WriteStartArray ()
+ writer.WriteStringValue ("variables." + name)
+ writer.WriteEndArray ())
+ writer.WriteEndObject ()
+ writer.Flush ()
+ Encoding.UTF8.GetString (stream.ToArray ()))
let deserializeSchema (json : string) =
Tracer.runAndMeasureExecutionTime "Deserialized schema" (fun _ ->
- let result = deserializeRecord> json
- match result.Errors with
- | None -> result.Data.__schema
- | Some errors -> String.concat "\n" errors |> failwithf "%s")
+ use doc = JsonDocument.Parse json
+ let root = doc.RootElement
+ let errors =
+ match root.TryGetProperty "errors" with
+ | true, errorsEl when errorsEl.ValueKind = JsonValueKind.Array && errorsEl.GetArrayLength () > 0 ->
+ errorsEl.EnumerateArray ()
+ |> Seq.choose (fun e ->
+ match e.TryGetProperty "message" with
+ | true, msgEl when msgEl.ValueKind = JsonValueKind.String -> Some (msgEl.GetString ())
+ | _ -> None)
+ |> Seq.toArray
+ | _ -> [||]
+ if errors.Length > 0 then
+ String.concat "\n" errors |> failwithf "%s"
+ match root.TryGetProperty "data" with
+ | true, dataEl ->
+ match dataEl.TryGetProperty "__schema" with
+ | true, schemaEl -> SchemaParser.parseSchema schemaEl
+ | _ -> failwith "Expected \"__schema\" field in the response data."
+ | _ -> failwith "Expected \"data\" field in the response.")
diff --git a/tests/FSharp.Data.GraphQL.IntegrationTests/OperationErrorTests.fs b/tests/FSharp.Data.GraphQL.IntegrationTests/OperationErrorTests.fs
index 5080dc19..ec95133e 100644
--- a/tests/FSharp.Data.GraphQL.IntegrationTests/OperationErrorTests.fs
+++ b/tests/FSharp.Data.GraphQL.IntegrationTests/OperationErrorTests.fs
@@ -26,18 +26,17 @@ module ErrorOperation =
[]
let ``Should parse operation error fields from raw response`` () =
let result =
- OperationResultBase (
+ new OperationResultBase (
rawResponse = new HttpResponseMessage (),
responseJson =
- JsonValue.Parse
- """{
- "errors": [{
- "message": "unit-test error",
- "path": ["alwaysError", 0],
- "locations": [{ "line": 2, "column": 13 }],
- "extensions": { "code": "UNIT_TEST", "retryable": false, "severity": 7 }
- }]
- }""",
+ """{
+ "errors": [{
+ "message": "unit-test error",
+ "path": ["alwaysError", 0],
+ "locations": [{ "line": 2, "column": 13 }],
+ "extensions": { "code": "UNIT_TEST", "retryable": false, "severity": 7 }
+ }]
+ }""",
operationFields = [||],
operationTypeName = "Query"
)
@@ -79,9 +78,9 @@ let ``Should parse all combinations of optional operation error fields`` () =
let responseJson = $"""{{"errors":[{{{errorObjectJson}}}]}}"""
let result =
- OperationResultBase (
+ new OperationResultBase (
rawResponse = new HttpResponseMessage (),
- responseJson = JsonValue.Parse responseJson,
+ responseJson = responseJson,
operationFields = [||],
operationTypeName = "Query"
)