From 7e5bc138f90242a0a5da22993fe9ffc08435e7d2 Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Sun, 17 May 2026 19:54:31 +0000
Subject: [PATCH 1/4] Migrate client JSON serialization from JsonValue.fs to
System.Text.Json
Agent-Logs-Url: https://github.com/fsprojects/FSharp.Data.GraphQL/sessions/f2373ad8-e1ad-4cd6-8854-dc45f7e71e0c
Co-authored-by: xperiandri <2365592+xperiandri@users.noreply.github.com>
---
...harp.Data.GraphQL.Client.DesignTime.fsproj | 3 +-
.../ProvidedTypesHelper.fs | 8 +-
src/FSharp.Data.GraphQL.Client/BaseTypes.fs | 229 ++++----
.../FSharp.Data.GraphQL.Client.fsproj | 4 +-
.../GraphQLClient.fs | 50 +-
.../Serialization.fs | 511 +++++++++++-------
.../OperationErrorTests.fs | 23 +-
7 files changed, 485 insertions(+), 343 deletions(-)
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 6d728c7a1..8f3559c38 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 504207bbc..94d14a081 100644
--- a/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs
+++ b/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs
@@ -409,10 +409,9 @@ module internal ProvidedOperation =
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.")
@@ -457,17 +456,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)
diff --git a/src/FSharp.Data.GraphQL.Client/BaseTypes.fs b/src/FSharp.Data.GraphQL.Client/BaseTypes.fs
index 4b93c3ff1..060c1c1d8 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,73 @@ 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 = System.Text.Json.JsonDocument.Parse responseJson
+ let rootElement = parsedJson.RootElement
+
let rawData =
- let data = JsonValueHelper.getResponseDataFields responseJson
+ let data = JsonValueHelper.getResponseDataFields rootElement
match data with
| Some [||]
| None -> None
@@ -547,13 +581,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,6 +616,9 @@ type OperationResultBase
override x.GetHashCode () = x.ResponseJson.GetHashCode ()
+ interface IDisposable with
+ member _.Dispose () = parsedJson.Dispose ()
+
/// The base type for al GraphQLProvider operation provided types.
type OperationBase (query : string) =
/// Gets the query string of the operation.
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 ee00d2dbb..fac5e51ee 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 6a757fc2d..9a984ee70 100644
--- a/src/FSharp.Data.GraphQL.Client/GraphQLClient.fs
+++ b/src/FSharp.Data.GraphQL.Client/GraphQLClient.fs
@@ -5,7 +5,6 @@ namespace FSharp.Data.GraphQL
open System
open System.Collections.Generic
-open System.Collections.Immutable
open System.Net.Http
open System.Text
open System.Threading
@@ -15,7 +14,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
@@ -57,22 +56,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.OperationName request.Query request.Variables
+ let content = new StringContent (json, Encoding.UTF8, "application/json")
return! postAsync ct invoker request.ServerUrl request.HttpHeaders content
}
@@ -145,35 +130,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.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/Serialization.fs b/src/FSharp.Data.GraphQL.Client/Serialization.fs
index 6572c1aae..fffb49afc 100644
--- a/src/FSharp.Data.GraphQL.Client/Serialization.fs
+++ b/src/FSharp.Data.GraphQL.Client/Serialization.fs
@@ -5,198 +5,343 @@ namespace FSharp.Data.GraphQL.Client
open System
open System.Collections.Generic
-open System.Diagnostics
-open System.Globalization
+open System.IO
open System.Reflection
-open Microsoft.FSharp.Reflection
+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|]))
- 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)
- 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())
+ /// 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 _ ->
+ values
+ |> Array.map (fun (name, element) -> name, deserializeElement element)
+ |> Map.ofArray)
+
+ let private writeValue (writer : Utf8JsonWriter) =
+ let rec write (value : obj) =
+ match value with
+ | null -> writer.WriteNullValue ()
+ | OptionValue None -> writer.WriteNullValue ()
+ | OptionValue (Some v) -> write v
+ | :? bool as b -> writer.WriteBooleanValue b
+ | :? int as n -> writer.WriteNumberValue n
+ | :? float as f -> writer.WriteNumberValue f
+ | :? decimal as d -> writer.WriteNumberValue d
+ | :? int64 as n -> writer.WriteNumberValue n
+ | :? uint64 as n -> writer.WriteNumberValue n
+ | :? int16 as n -> writer.WriteNumberValue (int n)
+ | :? uint16 as n -> writer.WriteNumberValue (uint32 n)
+ | :? byte as n -> writer.WriteNumberValue (uint32 n)
+ | :? sbyte as n -> writer.WriteNumberValue (int n)
+ | :? string as s -> writer.WriteStringValue s
+ | :? Guid as g -> writer.WriteStringValue (g.ToString ())
+ | :? DateTime as d when d.Date = d -> writer.WriteStringValue (d.ToString isoDateFormat)
+ | :? DateTime as d -> writer.WriteStringValue (d.ToString isoDateTimeFormat)
+ | :? DateTimeOffset as d -> writer.WriteStringValue (d.ToString isoDateTimeFormat)
+ | :? Uri as u -> writer.WriteStringValue (u.ToString ())
+ | :? Upload as u -> writer.WriteStringValue u.Name
+ | :? IDictionary as dict ->
+ writer.WriteStartObject ()
+ for kvp in dict do
+ writer.WritePropertyName (kvp.Key.FirstCharLower ())
+ write kvp.Value
+ writer.WriteEndObject ()
+ | EnumerableValue items ->
+ writer.WriteStartArray ()
+ Array.iter write items
+ writer.WriteEndArray ()
+ | EnumValue s -> writer.WriteStringValue s
+ | _ ->
+ let props = value.GetType().GetProperties (BindingFlags.Public ||| BindingFlags.Instance)
+ writer.WriteStartObject ()
+ for p in props do
+ writer.WritePropertyName (p.Name.FirstCharLower ())
+ write (p.GetValue value)
+ writer.WriteEndObject ()
+ write
+
+ /// Builds the JSON body for a standard GraphQL request.
+ let buildRequestJson (operationName : string option) (query : string) (variables : (string * obj) []) =
+ Tracer.runAndMeasureExecutionTime "Built GraphQL request JSON" (fun _ ->
+ use stream = new MemoryStream ()
+ let writerOptions = JsonWriterOptions (Indented = false)
+ use writer = new Utf8JsonWriter (stream, writerOptions)
+ let write = writeValue writer
+ 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
+ writer.WriteStartObject ()
+ for (name, value) in variables do
+ writer.WritePropertyName name
+ write value
+ writer.WriteEndObject ()
+ 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 ()
+ let writerOptions = JsonWriterOptions (Indented = false)
+ use writer = new Utf8JsonWriter (stream, writerOptions)
+ 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 5080dc195..ec95133e2 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"
)
From 25618fa2f28b75c8403ae7e40c8c947cc01c37bb Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Sun, 17 May 2026 19:56:36 +0000
Subject: [PATCH 2/4] Address code review: fix typo, inline JsonWriterOptions,
improve error message
Agent-Logs-Url: https://github.com/fsprojects/FSharp.Data.GraphQL/sessions/f2373ad8-e1ad-4cd6-8854-dc45f7e71e0c
Co-authored-by: xperiandri <2365592+xperiandri@users.noreply.github.com>
---
src/FSharp.Data.GraphQL.Client/BaseTypes.fs | 6 ++++--
src/FSharp.Data.GraphQL.Client/Serialization.fs | 6 ++----
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/src/FSharp.Data.GraphQL.Client/BaseTypes.fs b/src/FSharp.Data.GraphQL.Client/BaseTypes.fs
index 060c1c1d8..3449627a8 100644
--- a/src/FSharp.Data.GraphQL.Client/BaseTypes.fs
+++ b/src/FSharp.Data.GraphQL.Client/BaseTypes.fs
@@ -565,7 +565,9 @@ module internal JsonValueHelper =
/// The base type for all GraphQLProvider operation result provided types.
type OperationResultBase
(rawResponse : HttpResponseMessage, responseJson : string, operationFields : SchemaFieldInfo[], operationTypeName : string) =
- let parsedJson = System.Text.Json.JsonDocument.Parse responseJson
+ 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 =
@@ -619,7 +621,7 @@ type OperationResultBase
interface IDisposable with
member _.Dispose () = parsedJson.Dispose ()
-/// The base type for al GraphQLProvider operation provided types.
+/// The base type for all GraphQLProvider operation provided types.
type OperationBase (query : string) =
/// Gets the query string of the operation.
member _.Query = query
diff --git a/src/FSharp.Data.GraphQL.Client/Serialization.fs b/src/FSharp.Data.GraphQL.Client/Serialization.fs
index fffb49afc..412c668a7 100644
--- a/src/FSharp.Data.GraphQL.Client/Serialization.fs
+++ b/src/FSharp.Data.GraphQL.Client/Serialization.fs
@@ -283,8 +283,7 @@ module Serialization =
let buildRequestJson (operationName : string option) (query : string) (variables : (string * obj) []) =
Tracer.runAndMeasureExecutionTime "Built GraphQL request JSON" (fun _ ->
use stream = new MemoryStream ()
- let writerOptions = JsonWriterOptions (Indented = false)
- use writer = new Utf8JsonWriter (stream, writerOptions)
+ use writer = new Utf8JsonWriter (stream, JsonWriterOptions (Indented = false))
let write = writeValue writer
writer.WriteStartObject ()
writer.WritePropertyName "operationName"
@@ -310,8 +309,7 @@ module Serialization =
let buildMapJson (files : (string * Upload) []) =
Tracer.runAndMeasureExecutionTime "Built GraphQL map JSON" (fun _ ->
use stream = new MemoryStream ()
- let writerOptions = JsonWriterOptions (Indented = false)
- use writer = new Utf8JsonWriter (stream, writerOptions)
+ use writer = new Utf8JsonWriter (stream, JsonWriterOptions (Indented = false))
writer.WriteStartObject ()
files
|> Array.iteri (fun ix (name, _) ->
From 9f878a107160e1a2ac7af26369c9c4fb6c46cd97 Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Sun, 17 May 2026 20:36:09 +0000
Subject: [PATCH 3/4] Address review: add JsonSerializerOptions to
context/request, use JsonSerializer.Serialize for variables
Agent-Logs-Url: https://github.com/fsprojects/FSharp.Data.GraphQL/sessions/63700bd7-a033-4fb4-a394-21e09ca3943e
Co-authored-by: xperiandri <2365592+xperiandri@users.noreply.github.com>
---
.../ProvidedTypesHelper.fs | 18 +++--
src/FSharp.Data.GraphQL.Client/BaseTypes.fs | 3 +-
.../GraphQLClient.fs | 8 +-
.../GraphQLProviderRuntimeContext.fs | 6 +-
.../Serialization.fs | 74 ++++++-------------
5 files changed, 47 insertions(+), 62 deletions(-)
diff --git a/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs b/src/FSharp.Data.GraphQL.Client.DesignTime/ProvidedTypesHelper.fs
index 94d14a081..b9bc6434a 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,7 +404,8 @@ 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)
@@ -448,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 =
@@ -751,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
@@ -766,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 3449627a8..dabdd4140 100644
--- a/src/FSharp.Data.GraphQL.Client/BaseTypes.fs
+++ b/src/FSharp.Data.GraphQL.Client/BaseTypes.fs
@@ -636,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/GraphQLClient.fs b/src/FSharp.Data.GraphQL.Client/GraphQLClient.fs
index 9a984ee70..a1a439a3e 100644
--- a/src/FSharp.Data.GraphQL.Client/GraphQLClient.fs
+++ b/src/FSharp.Data.GraphQL.Client/GraphQLClient.fs
@@ -7,6 +7,7 @@ open System
open System.Collections.Generic
open System.Net.Http
open System.Text
+open System.Text.Json
open System.Threading
open System.Threading.Tasks
@@ -26,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.
@@ -56,7 +59,7 @@ module GraphQLClient =
/// Sends a request to a GraphQL server asynchronously.
let sendRequestAsync ct (connection : GraphQLClientConnection) (request : GraphQLRequest) = task {
let invoker = connection.Invoker
- let json = Serialization.buildRequestJson request.OperationName request.Query request.Variables
+ 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
}
@@ -88,6 +91,7 @@ module GraphQLClient =
OperationName = None
Query = IntrospectionQuery.Definition
Variables = [||]
+ JsonSerializerOptions = Serialization.defaultSerializerOptions.Value
}
try
return! sendRequestAsync ct connection request
@@ -130,7 +134,7 @@ module GraphQLClient =
|> Array.collect (tryMapFileVariable >> (Option.defaultValue [||]))
let operationContent =
- let json = Serialization.buildRequestJson request.OperationName request.Query request.Variables
+ 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
diff --git a/src/FSharp.Data.GraphQL.Client/GraphQLProviderRuntimeContext.fs b/src/FSharp.Data.GraphQL.Client/GraphQLProviderRuntimeContext.fs
index 9c254b6fa..72d2847f0 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 412c668a7..bf6e7ee2f 100644
--- a/src/FSharp.Data.GraphQL.Client/Serialization.fs
+++ b/src/FSharp.Data.GraphQL.Client/Serialization.fs
@@ -6,7 +6,6 @@ namespace FSharp.Data.GraphQL.Client
open System
open System.Collections.Generic
open System.IO
-open System.Reflection
open System.Text
open System.Text.Json
open FSharp.Data.GraphQL
@@ -202,8 +201,24 @@ module private SchemaParser =
module Serialization =
- let private isoDateFormat = "yyyy-MM-dd"
- let private isoDateTimeFormat = "O"
+ /// 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 -> 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 =
@@ -236,55 +251,11 @@ module Serialization =
|> Array.map (fun (name, element) -> name, deserializeElement element)
|> Map.ofArray)
- let private writeValue (writer : Utf8JsonWriter) =
- let rec write (value : obj) =
- match value with
- | null -> writer.WriteNullValue ()
- | OptionValue None -> writer.WriteNullValue ()
- | OptionValue (Some v) -> write v
- | :? bool as b -> writer.WriteBooleanValue b
- | :? int as n -> writer.WriteNumberValue n
- | :? float as f -> writer.WriteNumberValue f
- | :? decimal as d -> writer.WriteNumberValue d
- | :? int64 as n -> writer.WriteNumberValue n
- | :? uint64 as n -> writer.WriteNumberValue n
- | :? int16 as n -> writer.WriteNumberValue (int n)
- | :? uint16 as n -> writer.WriteNumberValue (uint32 n)
- | :? byte as n -> writer.WriteNumberValue (uint32 n)
- | :? sbyte as n -> writer.WriteNumberValue (int n)
- | :? string as s -> writer.WriteStringValue s
- | :? Guid as g -> writer.WriteStringValue (g.ToString ())
- | :? DateTime as d when d.Date = d -> writer.WriteStringValue (d.ToString isoDateFormat)
- | :? DateTime as d -> writer.WriteStringValue (d.ToString isoDateTimeFormat)
- | :? DateTimeOffset as d -> writer.WriteStringValue (d.ToString isoDateTimeFormat)
- | :? Uri as u -> writer.WriteStringValue (u.ToString ())
- | :? Upload as u -> writer.WriteStringValue u.Name
- | :? IDictionary as dict ->
- writer.WriteStartObject ()
- for kvp in dict do
- writer.WritePropertyName (kvp.Key.FirstCharLower ())
- write kvp.Value
- writer.WriteEndObject ()
- | EnumerableValue items ->
- writer.WriteStartArray ()
- Array.iter write items
- writer.WriteEndArray ()
- | EnumValue s -> writer.WriteStringValue s
- | _ ->
- let props = value.GetType().GetProperties (BindingFlags.Public ||| BindingFlags.Instance)
- writer.WriteStartObject ()
- for p in props do
- writer.WritePropertyName (p.Name.FirstCharLower ())
- write (p.GetValue value)
- writer.WriteEndObject ()
- write
-
/// Builds the JSON body for a standard GraphQL request.
- let buildRequestJson (operationName : string option) (query : string) (variables : (string * obj) []) =
+ 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))
- let write = writeValue writer
writer.WriteStartObject ()
writer.WritePropertyName "operationName"
match operationName with
@@ -296,11 +267,8 @@ module Serialization =
if variables = null || variables.Length = 0 then
writer.WriteNullValue ()
else
- writer.WriteStartObject ()
- for (name, value) in variables do
- writer.WritePropertyName name
- write value
- writer.WriteEndObject ()
+ 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 ()))
From 4d4799faef019b3e17857909aeb166f9499d52e8 Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Sun, 17 May 2026 20:37:59 +0000
Subject: [PATCH 4/4] Simplify lazy expression per code review
Agent-Logs-Url: https://github.com/fsprojects/FSharp.Data.GraphQL/sessions/63700bd7-a033-4fb4-a394-21e09ca3943e
Co-authored-by: xperiandri <2365592+xperiandri@users.noreply.github.com>
---
src/FSharp.Data.GraphQL.Client/Serialization.fs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/src/FSharp.Data.GraphQL.Client/Serialization.fs b/src/FSharp.Data.GraphQL.Client/Serialization.fs
index bf6e7ee2f..ae57226b9 100644
--- a/src/FSharp.Data.GraphQL.Client/Serialization.fs
+++ b/src/FSharp.Data.GraphQL.Client/Serialization.fs
@@ -203,7 +203,7 @@ module Serialization =
/// 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)
+ 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.