From bbbc99394aa458361d851db70ab5f8bb9f72409c Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Sun, 17 May 2026 14:19:52 +0000
Subject: [PATCH 1/4] Initial plan
From f827575e9a53c60155db64a858c715250cdb32d0 Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Sun, 17 May 2026 14:39:17 +0000
Subject: [PATCH 2/4] Add Suave GraphQL server package
Agent-Logs-Url: https://github.com/fsprojects/FSharp.Data.GraphQL/sessions/1f4b9b83-930c-43b3-a8a5-8cf795269b9d
Co-authored-by: xperiandri <2365592+xperiandri@users.noreply.github.com>
---
FSharp.Data.GraphQL.Integration.slnx | 1 +
FSharp.Data.GraphQL.slnx | 1 +
Packages.props | 1 +
build/Program.fs | 8 +
.../FSharp.Data.GraphQL.Server.Suave.fsproj | 25 ++
.../HttpHandlers.fs | 218 ++++++++++++++++++
.../FSharp.Data.GraphQL.Tests.fsproj | 2 +
.../Suave/HttpHandlersTests.fs | 176 ++++++++++++++
8 files changed, 432 insertions(+)
create mode 100644 src/FSharp.Data.GraphQL.Server.Suave/FSharp.Data.GraphQL.Server.Suave.fsproj
create mode 100644 src/FSharp.Data.GraphQL.Server.Suave/HttpHandlers.fs
create mode 100644 tests/FSharp.Data.GraphQL.Tests/Suave/HttpHandlersTests.fs
diff --git a/FSharp.Data.GraphQL.Integration.slnx b/FSharp.Data.GraphQL.Integration.slnx
index ebd07776..56004703 100644
--- a/FSharp.Data.GraphQL.Integration.slnx
+++ b/FSharp.Data.GraphQL.Integration.slnx
@@ -13,6 +13,7 @@
+
diff --git a/FSharp.Data.GraphQL.slnx b/FSharp.Data.GraphQL.slnx
index 6f729a6b..dacee218 100644
--- a/FSharp.Data.GraphQL.slnx
+++ b/FSharp.Data.GraphQL.slnx
@@ -122,6 +122,7 @@
+
diff --git a/Packages.props b/Packages.props
index 7d3b9582..56f18495 100644
--- a/Packages.props
+++ b/Packages.props
@@ -26,6 +26,7 @@
+
diff --git a/build/Program.fs b/build/Program.fs
index 22bbb133..49780e83 100644
--- a/build/Program.fs
+++ b/build/Program.fs
@@ -362,6 +362,9 @@ Target.create "PackServerGiraffe" <| fun _ -> pack "Server.Giraffe"
let [] PackServerOxpecker = "PackServerOxpecker"
Target.create "PackServerOxpecker" <| fun _ -> pack "Server.Oxpecker"
+let [] PackServerSuave = "PackServerSuave"
+Target.create "PackServerSuave" <| fun _ -> pack "Server.Suave"
+
let [] PackClientTarget = "PackClient"
Target.create PackClientTarget <| fun _ -> pack "Client"
@@ -386,6 +389,9 @@ Target.create "PushServerGiraffe" <| fun _ -> push "Server.Giraffe"
let [] PushServerOxpecker = "PushServerOxpecker"
Target.create "PushServerOxpecker" <| fun _ -> push "Server.Oxpecker"
+let [] PushServerSuave = "PushServerSuave"
+Target.create "PushServerSuave" <| fun _ -> push "Server.Suave"
+
let [] PushClientTarget = "PushClient"
Target.create PushClientTarget <| fun _ -> push "Client"
@@ -430,6 +436,8 @@ PackSharedTarget
==> PushServerGiraffe
==> PackServerOxpecker
==> PushServerOxpecker
+==> PackServerSuave
+==> PushServerSuave
==> PackMiddlewareTarget
==> PushMiddlewareTarget
==> PackRelayTarget
diff --git a/src/FSharp.Data.GraphQL.Server.Suave/FSharp.Data.GraphQL.Server.Suave.fsproj b/src/FSharp.Data.GraphQL.Server.Suave/FSharp.Data.GraphQL.Server.Suave.fsproj
new file mode 100644
index 00000000..f78a75a7
--- /dev/null
+++ b/src/FSharp.Data.GraphQL.Server.Suave/FSharp.Data.GraphQL.Server.Suave.fsproj
@@ -0,0 +1,25 @@
+
+
+
+ $(DotNetVersion)
+ true
+ true
+ FSharp implementation of Facebook GraphQL query language (Suave integration)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/FSharp.Data.GraphQL.Server.Suave/HttpHandlers.fs b/src/FSharp.Data.GraphQL.Server.Suave/HttpHandlers.fs
new file mode 100644
index 00000000..1a9a8bdd
--- /dev/null
+++ b/src/FSharp.Data.GraphQL.Server.Suave/HttpHandlers.fs
@@ -0,0 +1,218 @@
+namespace FSharp.Data.GraphQL.Server.Suave
+
+open System
+open System.IO
+open System.Net.Mime
+open System.Text
+open System.Text.Json
+open System.Text.Json.Serialization
+
+open Suave
+open Suave.Filters
+open Suave.Http
+open Suave.Operators
+open Suave.RequestErrors
+open Suave.Successful
+open Suave.Writers
+
+open FSharp.Data.GraphQL
+open FSharp.Data.GraphQL.Server
+open FSharp.Data.GraphQL.Shared
+
+type private SuaveRequestExecutionContext (httpContext : HttpContext) =
+
+ interface IInputExecutionContext with
+
+ member _.GetFile key =
+ match httpContext.request.files |> Seq.tryFind (fun file -> file.fieldName = key) with
+ | Some file ->
+ use source = File.OpenRead file.tempFilePath
+ let stream = new MemoryStream ()
+ source.CopyTo stream
+ stream.Seek (0L, SeekOrigin.Begin) |> ignore
+
+ Ok {
+ FileName = file.fileName
+ Stream = stream
+ ContentType = file.mimeType
+ }
+ | None -> Result.Error $"File with key '{key}' not found"
+
+module HttpHandlers =
+
+ let private jsonMimeType = "application/json; charset=utf-8"
+ let private problemJsonMimeType = "application/problem+json; charset=utf-8"
+ let private serializerOptions = Shared.Json.getSerializerOptions Seq.empty
+
+ let private toResponse { DocumentId = documentId; Content = content } =
+ match content with
+ | Direct (data, errs) -> GQLResponse.Direct (documentId, data, errs)
+ | Deferred (data, errs, _) -> GQLResponse.Direct (documentId, data, errs)
+ | Stream _ -> GQLResponse.Stream documentId
+ | RequestError errs -> GQLResponse.RequestError (documentId, errs)
+
+ let private okJson (payload : string) =
+ setMimeType jsonMimeType
+ >=> ok (Encoding.UTF8.GetBytes payload)
+
+ let private badRequestJson (payload : string) =
+ setMimeType problemJsonMimeType
+ >=> bad_request (Encoding.UTF8.GetBytes payload)
+
+ let private problemDetails title detail instance =
+ JsonSerializer.Serialize (
+ {| title = title
+ detail = detail
+ status = 400
+ instance = instance |},
+ serializerOptions
+ )
+
+ let private isMultipartRequest (request : HttpRequest) =
+ request.headers
+ |> Seq.exists (fun (key, value) ->
+ String.Equals (key, "Content-Type", StringComparison.OrdinalIgnoreCase)
+ && value.Contains (MediaTypeNames.Multipart.FormData, StringComparison.OrdinalIgnoreCase)
+ )
+
+ let private tryGetMultipartField name (request : HttpRequest) =
+ request.multiPartFields
+ |> Seq.tryPick (fun (fieldName, value) ->
+ if String.Equals (fieldName, name, StringComparison.Ordinal) then
+ Some value
+ else
+ None
+ )
+
+ let private requestBody (request : HttpRequest) =
+ if isMultipartRequest request then
+ tryGetMultipartField "operations" request
+ |> Option.defaultValue ""
+ else
+ request.rawForm
+ |> Encoding.UTF8.GetString
+
+ let private operationNameAsValueOption (operationName : string Skippable) =
+ match operationName with
+ | Include value when not (isNull value) -> ValueSome value
+ | _ -> ValueNone
+
+ let private operationNameAsOption (operationName : string Skippable) =
+ match operationName with
+ | Include value when not (isNull value) -> Some value
+ | _ -> None
+
+ let private variablesAsOption (variables : _ Skippable) =
+ match variables with
+ | Include value when not (isNull value) -> Some value
+ | _ -> None
+
+ let private executeIntrospectionQuery (executor : Executor<'Root>) (optionalAstDocument : Ast.Document voption) = task {
+ let inputContext () : IInputExecutionContext =
+ SuaveRequestExecutionContext (HttpContext.empty) :> IInputExecutionContext
+
+ let! result =
+ match optionalAstDocument with
+ | ValueSome ast -> executor.AsyncExecute (ast, inputContext) |> Async.StartAsTask
+ | ValueNone -> executor.AsyncExecute (IntrospectionQuery.Definition, inputContext) |> Async.StartAsTask
+
+ let payload = result |> toResponse |> fun response -> JsonSerializer.Serialize (response, serializerOptions)
+ return okJson payload
+ }
+
+ let private executeOperation
+ (executor : Executor<'Root>)
+ (rootFactory : HttpContext -> 'Root)
+ (httpContext : HttpContext)
+ (content : ParsedGQLQueryRequestContent)
+ =
+ task {
+ let root = rootFactory httpContext
+
+ let inputContext () : IInputExecutionContext =
+ SuaveRequestExecutionContext (httpContext) :> IInputExecutionContext
+
+ let operationName = operationNameAsOption content.OperationName
+ let variables = variablesAsOption content.Variables
+
+ let! result =
+ executor.AsyncExecute (content.Ast, inputContext, root, ?variables = variables, ?operationName = operationName)
+ |> Async.StartAsTask
+
+ let payload = result |> toResponse |> fun response -> JsonSerializer.Serialize (response, serializerOptions)
+ return okJson payload
+ }
+
+ let private checkOperationType (httpContext : HttpContext) =
+ let request = httpContext.request
+
+ if request.method = HttpMethod.GET then
+ Result.Ok (OperationType.IntrospectionQuery ValueNone)
+ else
+ let body = requestBody request
+
+ if String.IsNullOrWhiteSpace body then
+ Result.Ok (OperationType.IntrospectionQuery ValueNone)
+ else
+ try
+ let gqlRequest = JsonSerializer.Deserialize (body, serializerOptions)
+ let ast = gqlRequest.Query |> Parser.tryParse |> Result.mapError (fun message -> problemDetails "Cannot parse GraphQL query" message request.path)
+
+ ast
+ |> Result.map (fun ast ->
+ let parsedContent () = {
+ Query = gqlRequest.Query
+ Ast = ast
+ OperationName = gqlRequest.OperationName
+ Variables = gqlRequest.Variables
+ }
+
+ if ast.IsEmpty then
+ OperationType.IntrospectionQuery ValueNone
+ else
+ match Ast.tryFindOperationByName (operationNameAsValueOption gqlRequest.OperationName) ast with
+ | None -> OperationType.IntrospectionQuery ValueNone
+ | Some _ -> parsedContent () |> OperationType.OperationQuery
+ )
+ with :? JsonException ->
+ Result.Error (
+ problemDetails
+ "Invalid JSON body"
+ $"Expected JSON similar to value in 'expected', but received value as in 'received': {body}"
+ request.path
+ )
+
+ let private handleGraphQL<'Root> (executor : Executor<'Root>) (rootFactory : HttpContext -> 'Root) (httpContext : HttpContext) =
+ async {
+ let! webPart =
+ task {
+ match checkOperationType httpContext with
+ | Result.Error payload -> return badRequestJson payload
+ | Result.Ok (OperationType.IntrospectionQuery optionalAstDocument) -> return! executeIntrospectionQuery executor optionalAstDocument
+ | Result.Ok (OperationType.OperationQuery content) -> return! executeOperation executor rootFactory httpContext content
+ }
+ |> Async.AwaitTask
+
+ return! webPart httpContext
+ }
+
+ ///
+ /// Sets the Request-Type response header to Multipart for multipart form requests and Classic otherwise.
+ ///
+ let setRequestType : WebPart =
+ fun httpContext ->
+ let requestType =
+ if isMultipartRequest httpContext.request then
+ "Multipart"
+ else
+ "Classic"
+
+ setHeader "Request-Type" requestType httpContext
+
+ ///
+ /// Creates a Suave that handles GraphQL GET and POST requests.
+ ///
+ /// The GraphQL executor.
+ /// Creates the GraphQL root object from the current Suave HTTP context.
+ let graphQL<'Root> (executor : Executor<'Root>) (rootFactory : HttpContext -> 'Root) : WebPart =
+ choose [ Filters.GET; Filters.POST ] >=> handleGraphQL executor rootFactory
diff --git a/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj b/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj
index 763d841e..387b86d5 100644
--- a/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj
+++ b/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj
@@ -76,6 +76,7 @@
+
@@ -89,5 +90,6 @@
+
diff --git a/tests/FSharp.Data.GraphQL.Tests/Suave/HttpHandlersTests.fs b/tests/FSharp.Data.GraphQL.Tests/Suave/HttpHandlersTests.fs
new file mode 100644
index 00000000..e1cde02c
--- /dev/null
+++ b/tests/FSharp.Data.GraphQL.Tests/Suave/HttpHandlersTests.fs
@@ -0,0 +1,176 @@
+module FSharp.Data.GraphQL.Tests.Suave.HttpHandlersTests
+
+open System
+open System.Collections.Generic
+open System.IO
+open System.Text
+open System.Text.Json
+open Xunit
+
+open Suave
+open Suave.Http
+open Suave.Operators
+
+open FSharp.Data.GraphQL
+open FSharp.Data.GraphQL.Types
+open FSharp.Data.GraphQL.Server.Suave
+
+type Root = { Path : string }
+
+type UploadPayload = { File : FileData }
+
+let private query =
+ Define.Object (
+ name = "Query",
+ fields = [
+ Define.Field ("path", StringType, resolve = fun _ root -> root.Path)
+ ]
+ )
+
+let private uploadResult =
+ Define.Object (
+ name = "UploadResult",
+ fields = [
+ Define.Field ("name", StringType, resolve = fun _ file -> file.FileName)
+ Define.Field (
+ "content",
+ StringType,
+ resolve =
+ fun _ file ->
+ file.Stream.Seek (0L, SeekOrigin.Begin) |> ignore
+ use reader = new StreamReader (file.Stream, Encoding.UTF8, leaveOpen = true)
+ reader.ReadToEnd ()
+ )
+ ]
+ )
+
+let private mutation =
+ Define.Object (
+ name = "Mutation",
+ fields = [
+ Define.Field (
+ "upload",
+ uploadResult,
+ args = [ Define.Input ("file", FileType) ],
+ resolve = fun ctx _ -> ctx.Arg "file"
+ )
+ ]
+ )
+
+let private executor = Executor (Schema (query, mutation))
+
+let private rootFactory (httpContext : HttpContext) = { Path = httpContext.request.path }
+
+let private createRequest
+ (methodName : string)
+ (path : string)
+ (body : byte array)
+ (headers : (string * string) list)
+ (files : Runtime.HttpUpload list)
+ (multiPartFields : (string * string) list)
+ =
+ { HttpRequest.empty with
+ rawMethod = methodName
+ rawPath = path
+ headers = List (headers :> seq<_>)
+ rawForm = body
+ files = List (files :> seq<_>)
+ multiPartFields = List (multiPartFields :> seq<_>) }
+
+let private run webPart httpContext =
+ match webPart httpContext |> Async.RunSynchronously with
+ | Some handled -> handled
+ | None -> failwith "Expected the WebPart to handle the request"
+
+let private responseHeader name (httpContext : HttpContext) =
+ httpContext.response.headers
+ |> Seq.tryPick (fun (key, value) ->
+ if String.Equals (key, name, StringComparison.OrdinalIgnoreCase) then
+ Some value
+ else
+ None
+ )
+
+let private responseJson httpContext =
+ match httpContext.response.content with
+ | HttpContent.Bytes bytes -> JsonDocument.Parse bytes
+ | content -> failwith $"Expected response bytes but received %A{content}"
+
+[]
+let ``Suave GraphQL handler executes JSON requests`` () =
+ let body = """{"query":"query { path }"}""" |> Encoding.UTF8.GetBytes
+ let request =
+ createRequest
+ "POST"
+ "/graphql"
+ body
+ [ "Content-Type", "application/json" ]
+ []
+ []
+
+ let httpContext = { HttpContext.empty with request = request }
+
+ let handled =
+ HttpHandlers.setRequestType
+ >=> HttpHandlers.graphQL executor rootFactory
+ |> fun webPart -> run webPart httpContext
+
+ Assert.Equal (Some "Classic", responseHeader "Request-Type" handled)
+
+ use document = responseJson handled
+ let value = document.RootElement.GetProperty("data").GetProperty("path").GetString()
+ Assert.Equal ("/graphql", value)
+
+[]
+let ``Suave GraphQL handler executes GET introspection requests`` () =
+ let request = createRequest "GET" "/graphql" Array.empty [ "Accept", "application/json" ] [] []
+ let httpContext = { HttpContext.empty with request = request }
+
+ let handled = HttpHandlers.graphQL executor rootFactory |> fun webPart -> run webPart httpContext
+
+ use document = responseJson handled
+ let schema = document.RootElement.GetProperty("data").GetProperty("__schema")
+ Assert.Equal (JsonValueKind.Object, schema.ValueKind)
+
+[]
+let ``Suave GraphQL handler executes multipart upload requests`` () =
+ let tempFilePath = Path.GetTempFileName ()
+
+ try
+ File.WriteAllText (tempFilePath, "uploaded from suave")
+
+ let upload : Runtime.HttpUpload = {
+ fieldName = "file0"
+ fileName = "hello.txt"
+ mimeType = "text/plain"
+ tempFilePath = tempFilePath
+ }
+
+ let operations =
+ """{"query":"mutation ($file: File!) { upload(file: $file) { name content } }","variables":{"file":"file0"}}"""
+
+ let request =
+ createRequest
+ "POST"
+ "/graphql"
+ Array.empty
+ [ "Content-Type", "multipart/form-data; boundary=graphql" ]
+ [ upload ]
+ [ "operations", operations ]
+
+ let httpContext = { HttpContext.empty with request = request }
+
+ let handled =
+ HttpHandlers.setRequestType
+ >=> HttpHandlers.graphQL executor rootFactory
+ |> fun webPart -> run webPart httpContext
+
+ Assert.Equal (Some "Multipart", responseHeader "Request-Type" handled)
+
+ use document = responseJson handled
+ let uploadResponse = document.RootElement.GetProperty("data").GetProperty("upload")
+ Assert.Equal ("hello.txt", uploadResponse.GetProperty("name").GetString())
+ Assert.Equal ("uploaded from suave", uploadResponse.GetProperty("content").GetString())
+ finally
+ if File.Exists tempFilePath then
+ File.Delete tempFilePath
From 655cdd2bdb653f67ba00161800a901b5a674f174 Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Sun, 17 May 2026 14:40:53 +0000
Subject: [PATCH 3/4] Polish Suave integration tests
Agent-Logs-Url: https://github.com/fsprojects/FSharp.Data.GraphQL/sessions/1f4b9b83-930c-43b3-a8a5-8cf795269b9d
Co-authored-by: xperiandri <2365592+xperiandri@users.noreply.github.com>
---
tests/FSharp.Data.GraphQL.Tests/Suave/HttpHandlersTests.fs | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/tests/FSharp.Data.GraphQL.Tests/Suave/HttpHandlersTests.fs b/tests/FSharp.Data.GraphQL.Tests/Suave/HttpHandlersTests.fs
index e1cde02c..fca41df8 100644
--- a/tests/FSharp.Data.GraphQL.Tests/Suave/HttpHandlersTests.fs
+++ b/tests/FSharp.Data.GraphQL.Tests/Suave/HttpHandlersTests.fs
@@ -147,7 +147,12 @@ let ``Suave GraphQL handler executes multipart upload requests`` () =
}
let operations =
- """{"query":"mutation ($file: File!) { upload(file: $file) { name content } }","variables":{"file":"file0"}}"""
+ """{
+ "query": "mutation ($file: File!) { upload(file: $file) { name content } }",
+ "variables": {
+ "file": "file0"
+ }
+ }"""
let request =
createRequest
From 46c887171ede59343653f308e41b16eb0814f588 Mon Sep 17 00:00:00 2001
From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com>
Date: Sun, 17 May 2026 14:41:47 +0000
Subject: [PATCH 4/4] Fix Suave handler XML docs
Agent-Logs-Url: https://github.com/fsprojects/FSharp.Data.GraphQL/sessions/1f4b9b83-930c-43b3-a8a5-8cf795269b9d
Co-authored-by: xperiandri <2365592+xperiandri@users.noreply.github.com>
---
src/FSharp.Data.GraphQL.Server.Suave/HttpHandlers.fs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/src/FSharp.Data.GraphQL.Server.Suave/HttpHandlers.fs b/src/FSharp.Data.GraphQL.Server.Suave/HttpHandlers.fs
index 1a9a8bdd..69c7d7ca 100644
--- a/src/FSharp.Data.GraphQL.Server.Suave/HttpHandlers.fs
+++ b/src/FSharp.Data.GraphQL.Server.Suave/HttpHandlers.fs
@@ -210,7 +210,7 @@ module HttpHandlers =
setHeader "Request-Type" requestType httpContext
///
- /// Creates a Suave that handles GraphQL GET and POST requests.
+ /// Creates a Suave WebPart that handles GraphQL GET and POST requests.
///
/// The GraphQL executor.
/// Creates the GraphQL root object from the current Suave HTTP context.