From 4fe4e3f2778bd33178c7a8236e053af01a7e95aa Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Wed, 18 Jun 2025 16:46:14 +0100 Subject: [PATCH] Add JSON headers automatically to Body in HTTP client (#395) --- CHANGELOG.md | 5 + ConsumePlugin/GeneratedRestClient.fs | 187 ++++++++++++++++- ConsumePlugin/RestApiExample.fs | 32 +++ .../TestHttpClient/TestVariableHeader.fs | 189 +++++++++++++++--- .../WoofWare.Myriad.Plugins.Test.fsproj | 1 + .../HttpClientGenerator.fs | 11 +- nix/deps.json | 20 ++ 7 files changed, 411 insertions(+), 34 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fca201b..142c603 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ Notable changes are recorded here. +# WoofWare.Myriad.Plugins 8.0.3 + +The RestEase-style HTTP client generator now automatically adds the `application/json` content type header to requests which are POSTing a body that is known to be JSON-serialised. +You can override this by setting the `[]` header manually on any affected member. + # WoofWare.Myriad.Plugins 7.0.1 All generators should now be compatible with `enable`. diff --git a/ConsumePlugin/GeneratedRestClient.fs b/ConsumePlugin/GeneratedRestClient.fs index 587a991..4e08f9c 100644 --- a/ConsumePlugin/GeneratedRestClient.fs +++ b/ConsumePlugin/GeneratedRestClient.fs @@ -375,7 +375,9 @@ module PureGymApi = match node with | None -> "null" | Some node -> node.ToJsonString () - ) + ), + null, + "application/json" ) do httpMessage.Content <- queryParams @@ -667,7 +669,9 @@ module PureGymApi = let queryParams = new System.Net.Http.StringContent ( - user |> PureGym.Member.toJsonNode |> (fun node -> node.ToJsonString ()) + user |> PureGym.Member.toJsonNode |> (fun node -> node.ToJsonString ()), + null, + "application/json" ) do httpMessage.Content <- queryParams @@ -710,7 +714,9 @@ module PureGymApi = ) | field -> field) ) - |> (fun node -> node.ToJsonString ()) + |> (fun node -> node.ToJsonString ()), + null, + "application/json" ) do httpMessage.Content <- queryParams @@ -753,7 +759,9 @@ module PureGymApi = ) | field -> field) ) - |> (fun node -> node.ToJsonString ()) + |> (fun node -> node.ToJsonString ()), + null, + "application/json" ) do httpMessage.Content <- queryParams @@ -1801,3 +1809,174 @@ module ApiWithHeaders2 = } |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) } +namespace PureGym + +open System +open System.Threading +open System.Threading.Tasks +open System.IO +open System.Net +open System.Net.Http +open RestEase + +/// Module for constructing a REST client. +[] +module ClientWithJsonBody = + /// Create a REST client. + let make (client : System.Net.Http.HttpClient) : IClientWithJsonBody = + { new IClientWithJsonBody with + member _.GetPathParam (parameter : string, mem : PureGym.Member, ct : CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> + raise ( + System.ArgumentNullException ( + nameof (client.BaseAddress), + "No base address was supplied on the type, and no BaseAddress was on the HttpClient." + ) + ) + | v -> v), + System.Uri ( + "endpoint/{param}" + .Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString), + System.UriKind.Relative + ) + ) + + let httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Post, + RequestUri = uri + ) + + let queryParams = + new System.Net.Http.StringContent ( + mem |> PureGym.Member.toJsonNode |> (fun node -> node.ToJsonString ()), + null, + "application/json" + ) + + do httpMessage.Content <- queryParams + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask + return responseString + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + } +namespace PureGym + +open System +open System.Threading +open System.Threading.Tasks +open System.IO +open System.Net +open System.Net.Http +open RestEase + +/// Module for constructing a REST client. +[] +module ClientWithJsonBodyOverridden = + /// Create a REST client. + let make (client : System.Net.Http.HttpClient) : IClientWithJsonBodyOverridden = + { new IClientWithJsonBodyOverridden with + member _.GetPathParam (parameter : string, mem : PureGym.Member, ct : CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> + raise ( + System.ArgumentNullException ( + nameof (client.BaseAddress), + "No base address was supplied on the type, and no BaseAddress was on the HttpClient." + ) + ) + | v -> v), + System.Uri ( + "endpoint/{param}" + .Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString), + System.UriKind.Relative + ) + ) + + let httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Post, + RequestUri = uri + ) + + let queryParams = + new System.Net.Http.StringContent ( + mem |> PureGym.Member.toJsonNode |> (fun node -> node.ToJsonString ()), + null, + "application/ecmascript" + ) + + do httpMessage.Content <- queryParams + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask + return responseString + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + } +namespace PureGym + +open System +open System.Threading +open System.Threading.Tasks +open System.IO +open System.Net +open System.Net.Http +open RestEase + +/// Module for constructing a REST client. +[] +module ClientWithStringBody = + /// Create a REST client. + let make (client : System.Net.Http.HttpClient) : IClientWithStringBody = + { new IClientWithStringBody with + member _.GetPathParam (parameter : string, mem : string, ct : CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> + raise ( + System.ArgumentNullException ( + nameof (client.BaseAddress), + "No base address was supplied on the type, and no BaseAddress was on the HttpClient." + ) + ) + | v -> v), + System.Uri ( + "endpoint/{param}" + .Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString), + System.UriKind.Relative + ) + ) + + let httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Post, + RequestUri = uri + ) + + let queryParams = new System.Net.Http.StringContent (mem) + do httpMessage.Content <- queryParams + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask + return responseString + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + } diff --git a/ConsumePlugin/RestApiExample.fs b/ConsumePlugin/RestApiExample.fs index 66db8e2..302b0b7 100644 --- a/ConsumePlugin/RestApiExample.fs +++ b/ConsumePlugin/RestApiExample.fs @@ -203,3 +203,35 @@ type IApiWithHeaders2 = [] abstract GetPathParam : [] parameter : string * ?ct : CancellationToken -> Task + +[] +type IClientWithJsonBody = + // As a POST request of a JSON-serialised body, we automatically set Content-Type: application/json. + [] + abstract GetPathParam : + [] parameter : string * + [] mem : PureGym.Member * + ?ct : CancellationToken -> + Task + +[] +type IClientWithJsonBodyOverridden = + // As a POST request of a JSON-serialised body, we *would* automatically set Content-Type: application/json, + // but this method has overridden it. + [] + [] + abstract GetPathParam : + [] parameter : string * + [] mem : PureGym.Member * + ?ct : CancellationToken -> + Task + +[] +type IClientWithStringBody = + // As a POST request of a bare string body, we don't override the Content-Type. + [] + abstract GetPathParam : + [] parameter : string * + [] mem : string * + ?ct : CancellationToken -> + Task diff --git a/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVariableHeader.fs b/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVariableHeader.fs index 98b1890..48b3518 100644 --- a/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVariableHeader.fs +++ b/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVariableHeader.fs @@ -3,10 +3,12 @@ namespace WoofWare.Myriad.Plugins.Test open System open System.Net open System.Net.Http +open System.Text.Json.Nodes open System.Threading open NUnit.Framework open FsUnitTyped open PureGym +open WoofWare.Expect [] module TestVariableHeader = @@ -50,15 +52,17 @@ module TestVariableHeader = someHeaderCount.Value |> shouldEqual 10 someOtherHeaderCount.Value |> shouldEqual -100 - api.GetPathParam("param").Result.Split "\n" - |> Array.sort - |> shouldEqual - [| - "Authorization: -99" - "Header-Name: Header-Value" - "Something-Else: val" - "X-Foo: 11" - |] + expect { + snapshotJson + @"[ + ""Authorization: -99"", + ""Header-Name: Header-Value"", + ""Something-Else: val"", + ""X-Foo: 11"" +]" + + return api.GetPathParam("param").Result.Split "\n" |> Array.sort + } someHeaderCount.Value |> shouldEqual 11 someOtherHeaderCount.Value |> shouldEqual -99 @@ -102,25 +106,156 @@ module TestVariableHeader = someHeaderCount.Value |> shouldEqual 10 someOtherHeaderCount.Value |> shouldEqual -100 - api.GetPathParam("param").Result.Split "\n" - |> Array.sort - |> shouldEqual - [| - "Authorization: -99" - "Header-Name: Header-Value" - "Something-Else: val" - "X-Foo: 11" - |] + expect { + snapshotJson + @"[ + ""Authorization: -99"", + ""Header-Name: Header-Value"", + ""Something-Else: val"", + ""X-Foo: 11"" +]" - api.GetPathParam("param").Result.Split "\n" - |> Array.sort - |> shouldEqual - [| - "Authorization: -98" - "Header-Name: Header-Value" - "Something-Else: val" - "X-Foo: 12" - |] + return api.GetPathParam("param").Result.Split "\n" |> Array.sort + } + + expect { + snapshotJson + @"[ + ""Authorization: -98"", + ""Header-Name: Header-Value"", + ""Something-Else: val"", + ""X-Foo: 12"" +]" + + return api.GetPathParam("param").Result.Split "\n" |> Array.sort + } someHeaderCount.Value |> shouldEqual 12 someOtherHeaderCount.Value |> shouldEqual -98 + + let pureGymMember = + { + Id = 3 + CompoundMemberId = "compound" + FirstName = "Patrick" + LastName = "Stevens" + HomeGymId = 1223 + HomeGymName = "Arnie's Temple o' Gainz" + EmailAddress = "patrick@home" + GymAccessPin = "1234" + DateOfBirth = DateOnly (1992, 03, 04) + MobileNumber = "number" + Postcode = "postcode" + MembershipName = "member" + MembershipLevel = 9999 + SuspendedReason = -1 + MemberStatus = 100 + } + + [] + let ``Content-Type header is automatically inserted`` () = + let proc (message : HttpRequestMessage) : HttpResponseMessage Async = + async { + message.Method |> shouldEqual HttpMethod.Post + + message.RequestUri.ToString () + |> shouldEqual "https://example.com/endpoint/param" + + let headers = + [ + for h in message.Content.Headers do + yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}" + ] + |> String.concat "\n" + + let! ct = Async.CancellationToken + let! content = message.Content.ReadAsStringAsync ct |> Async.AwaitTask + content |> JsonNode.Parse |> Member.jsonParse |> shouldEqual pureGymMember + + let content = new StringContent (headers) + let resp = new HttpResponseMessage (HttpStatusCode.OK) + resp.Content <- content + return resp + } + + use client = HttpClientMock.make (Uri "https://example.com") proc + + let api = ClientWithJsonBody.make client + let result = api.GetPathParam ("param", pureGymMember) |> _.Result + + expect { + snapshot @"Content-Type: application/json; charset=utf-8" + return result + } + + [] + let ``Content-Type header is respected if overridden`` () = + let proc (message : HttpRequestMessage) : HttpResponseMessage Async = + async { + message.Method |> shouldEqual HttpMethod.Post + + message.RequestUri.ToString () + |> shouldEqual "https://example.com/endpoint/param" + + let headers = + [ + for h in message.Content.Headers do + yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}" + ] + |> String.concat "\n" + + let! ct = Async.CancellationToken + let! content = message.Content.ReadAsStringAsync ct |> Async.AwaitTask + content |> JsonNode.Parse |> Member.jsonParse |> shouldEqual pureGymMember + + let content = new StringContent (headers) + let resp = new HttpResponseMessage (HttpStatusCode.OK) + resp.Content <- content + return resp + } + + use client = HttpClientMock.make (Uri "https://example.com") proc + + let api = ClientWithJsonBodyOverridden.make client + let result = api.GetPathParam ("param", pureGymMember) |> _.Result + + expect { + snapshot @"Content-Type: application/ecmascript; charset=utf-8" + return result + } + + [] + let ``Content-Type header is the default for strings`` () = + let proc (message : HttpRequestMessage) : HttpResponseMessage Async = + async { + message.Method |> shouldEqual HttpMethod.Post + + message.RequestUri.ToString () + |> shouldEqual "https://example.com/endpoint/param" + + let headers = + [ + for h in message.Content.Headers do + yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}" + ] + |> String.concat "\n" + + let! ct = Async.CancellationToken + let! content = message.Content.ReadAsStringAsync ct |> Async.AwaitTask + content |> shouldEqual "hello!" + + let content = new StringContent (headers) + let resp = new HttpResponseMessage (HttpStatusCode.OK) + resp.Content <- content + return resp + } + + use client = HttpClientMock.make (Uri "https://example.com") proc + + let api = ClientWithStringBody.make client + let result = api.GetPathParam ("param", "hello!") |> _.Result + + expect { + snapshot @"Content-Type: text/plain; charset=utf-8" + return result + } diff --git a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj index 4fe0849..701cbed 100644 --- a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj +++ b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj @@ -48,6 +48,7 @@ + diff --git a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs index d984b5c..cdda485 100644 --- a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs +++ b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs @@ -453,15 +453,20 @@ module internal HttpClientGenerator = let contentTypeHeader, memberHeaders = info.Headers - |> List.partition (fun (headerName, headerValue) -> + |> List.partition (fun (headerName, _headerValue) -> match headerName |> SynExpr.stripOptionalParen with - | SynExpr.Const (SynConst.String ("Content-Type", _, _), _) -> true + | SynExpr.Const (SynConst.String (s, _, _), _) -> + System.String.Equals (s, "Content-Type", System.StringComparison.OrdinalIgnoreCase) | _ -> false ) let contentTypeHeader = match contentTypeHeader with - | [] -> None + | [] -> + // Set application/json if we *know* we're sending JSON + match bodyParam with + | Some (BodyParamMethods.Serialise _, _) -> Some (SynExpr.CreateConst "application/json") + | _ -> None | [ _, ct ] -> Some (SynExpr.stripOptionalParen ct) | _ -> failwith "Unexpectedly got multiple Content-Type headers" diff --git a/nix/deps.json b/nix/deps.json index 785de0e..da741d9 100644 --- a/nix/deps.json +++ b/nix/deps.json @@ -44,6 +44,11 @@ "version": "9.0.202", "hash": "sha256-64Gub0qemmCoMa1tDus6TeTuB1+5sHfE6KD2j4o84mA=" }, + { + "pname": "FSharp.SystemTextJson", + "version": "1.4.36", + "hash": "sha256-zZEhjP0mdc5E3fBPS4/lqD7sxoaoT5SOspP546RWYdc=" + }, { "pname": "FsUnit", "version": "7.0.1", @@ -364,16 +369,31 @@ "version": "4.5.0", "hash": "sha256-BkUYNguz0e4NJp1kkW7aJBn3dyH9STwB5N8XqnlCsmY=" }, + { + "pname": "System.Text.Json", + "version": "6.0.10", + "hash": "sha256-UijYh0dxFjFinMPSTJob96oaRkNm+Wsa+7Ffg6mRnsc=" + }, { "pname": "System.Text.Json", "version": "8.0.5", "hash": "sha256-yKxo54w5odWT6nPruUVsaX53oPRe+gKzGvLnnxtwP68=" }, + { + "pname": "System.Text.Json", + "version": "9.0.0", + "hash": "sha256-aM5Dh4okLnDv940zmoFAzRmqZre83uQBtGOImJpoIqk=" + }, { "pname": "TypeEquality", "version": "0.3.0", "hash": "sha256-V50xAOzzyUJrY+MYPRxtnqW5MVeATXCes89wPprv1r4=" }, + { + "pname": "WoofWare.Expect", + "version": "0.4.2", + "hash": "sha256-CaVcj9Fo0VSMgfKIukM9WHGufPWHDqMO1D4VYVdJKJk=" + }, { "pname": "WoofWare.Whippet.Fantomas", "version": "0.6.3",