patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-05 20:18:43 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add JSON headers automatically to Body in HTTP client (#395)

Browse Source
This commit is contained in:
Patrick Stevens
2025-06-18 16:46:14 +01:00
committed by GitHub
parent 9473a080ff
commit 4fe4e3f277
7 changed files with 411 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
CHANGELOG.md
View File

@@ -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 `[<RestEase.Header ("Content-Type", "desired content type")>]` header manually on any affected member.
# WoofWare.Myriad.Plugins 7.0.1
All generators should now be compatible with `<Nullable>enable</Nullable>`.

187
ConsumePlugin/GeneratedRestClient.fs
View File

@@ -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.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
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.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
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.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
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))
}

32
ConsumePlugin/RestApiExample.fs
View File

@@ -203,3 +203,35 @@ type IApiWithHeaders2 =
[<Get "endpoint/{param}">]
abstract GetPathParam :
[<WoofWare.Myriad.Plugins.RestEase.Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
type IClientWithJsonBody =
// As a POST request of a JSON-serialised body, we automatically set Content-Type: application/json.
[<Post "endpoint/{param}">]
abstract GetPathParam :
[<RestEase.Path "param">] parameter : string *
[<WoofWare.Myriad.Plugins.RestEase.Body>] mem : PureGym.Member *
?ct : CancellationToken ->
Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
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.
[<Post "endpoint/{param}">]
[<Header("Content-Type", "application/ecmascript")>]
abstract GetPathParam :
[<RestEase.Path "param">] parameter : string *
[<WoofWare.Myriad.Plugins.RestEase.Body>] mem : PureGym.Member *
?ct : CancellationToken ->
Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
type IClientWithStringBody =
// As a POST request of a bare string body, we don't override the Content-Type.
[<Post "endpoint/{param}">]
abstract GetPathParam :
[<RestEase.Path "param">] parameter : string *
[<WoofWare.Myriad.Plugins.RestEase.Body>] mem : string *
?ct : CancellationToken ->
Task<string>

189
WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVariableHeader.fs
View File

@@ -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
[<TestFixture>]
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
}
[<Test>]
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
}
[<Test>]
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
}
[<Test>]
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
}

1
WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj
View File

@@ -48,6 +48,7 @@
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.14.1"/>
<PackageReference Include="NUnit" Version="4.3.2"/>
<PackageReference Include="NUnit3TestAdapter" Version="5.0.0"/>
<PackageReference Include="WoofWare.Expect" Version="0.4.2" />
</ItemGroup>
<ItemGroup>

11
WoofWare.Myriad.Plugins/HttpClientGenerator.fs
View File

@@ -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"

20
nix/deps.json
View File

@@ -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",