From f83ac24a738821dc50d4bc4bdd31df9ade6ce582 Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Fri, 26 Jan 2024 17:54:45 +0000 Subject: [PATCH] Implement JSON serialisation of body params (#71) --- ConsumePlugin/GeneratedPureGymDto.fs | 385 ++++++++++-------- ConsumePlugin/GeneratedRestClient.fs | 31 ++ ConsumePlugin/PureGymDto.fs | 3 +- ConsumePlugin/RestApiExample.fs | 3 + README.md | 5 +- .../TestHttpClient/TestBodyParam.fs | 47 ++- .../HttpClientGenerator.fs | 34 +- WoofWare.Myriad.Plugins/SynType.fs | 10 + .../WoofWare.Myriad.Plugins.fsproj | 1 + 9 files changed, 332 insertions(+), 187 deletions(-) create mode 100644 WoofWare.Myriad.Plugins/SynType.fs diff --git a/ConsumePlugin/GeneratedPureGymDto.fs b/ConsumePlugin/GeneratedPureGymDto.fs index e8f119f..3f9feb5 100644 --- a/ConsumePlugin/GeneratedPureGymDto.fs +++ b/ConsumePlugin/GeneratedPureGymDto.fs @@ -4,6 +4,39 @@ //------------------------------------------------------------------------------ +namespace PureGym + +open System +open System.Text.Json.Serialization + +/// Module containing JSON serializing extension members for the Member type +[] +module MemberJsonSerializeExtension = + /// Extension methods for JSON parsing + type Member with + + /// Serialize to a JSON node + static member toJsonNode (input : Member) : System.Text.Json.Nodes.JsonNode = + let node = System.Text.Json.Nodes.JsonObject () + + do + node.Add ("id", System.Text.Json.Nodes.JsonValue.Create input.Id) + node.Add ("compoundMemberId", System.Text.Json.Nodes.JsonValue.Create input.CompoundMemberId) + node.Add ("firstName", System.Text.Json.Nodes.JsonValue.Create input.FirstName) + node.Add ("lastName", System.Text.Json.Nodes.JsonValue.Create input.LastName) + node.Add ("homeGymId", System.Text.Json.Nodes.JsonValue.Create input.HomeGymId) + node.Add ("homeGymName", System.Text.Json.Nodes.JsonValue.Create input.HomeGymName) + node.Add ("emailAddress", System.Text.Json.Nodes.JsonValue.Create input.EmailAddress) + node.Add ("gymAccessPin", System.Text.Json.Nodes.JsonValue.Create input.GymAccessPin) + node.Add ("dateofBirth", System.Text.Json.Nodes.JsonValue.Create input.DateOfBirth) + node.Add ("mobileNumber", System.Text.Json.Nodes.JsonValue.Create input.MobileNumber) + node.Add ("postCode", System.Text.Json.Nodes.JsonValue.Create input.Postcode) + node.Add ("membershipName", System.Text.Json.Nodes.JsonValue.Create input.MembershipName) + node.Add ("membershipLevel", System.Text.Json.Nodes.JsonValue.Create input.MembershipLevel) + node.Add ("suspendedReason", System.Text.Json.Nodes.JsonValue.Create input.SuspendedReason) + node.Add ("memberStatus", System.Text.Json.Nodes.JsonValue.Create input.MemberStatus) + + node :> _ namespace PureGym @@ -378,210 +411,212 @@ module Gym = } namespace PureGym -/// Module containing JSON parsing methods for the Member type -[] -[] -module Member = - /// Parse from a JSON node. - let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Member = - let MemberStatus = - (match node.["memberStatus"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("memberStatus") - ) - ) - | v -> v) - .AsValue() - .GetValue () +/// Module containing JSON parsing extension members for the Member type +[] +module MemberJsonParseExtension = + /// Extension methods for JSON parsing + type Member with - let SuspendedReason = - (match node.["suspendedReason"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("suspendedReason") + /// Parse from a JSON node. + static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : Member = + let MemberStatus = + (match node.["memberStatus"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("memberStatus") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let MembershipLevel = - (match node.["membershipLevel"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("membershipLevel") + let SuspendedReason = + (match node.["suspendedReason"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("suspendedReason") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let MembershipName = - (match node.["membershipName"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("membershipName") + let MembershipLevel = + (match node.["membershipLevel"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("membershipLevel") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let Postcode = - (match node.["postCode"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("postCode") + let MembershipName = + (match node.["membershipName"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("membershipName") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let MobileNumber = - (match node.["mobileNumber"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("mobileNumber") + let Postcode = + (match node.["postCode"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("postCode") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let DateOfBirth = - (match node.["dateofBirth"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("dateofBirth") + let MobileNumber = + (match node.["mobileNumber"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("mobileNumber") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () - |> System.DateOnly.Parse + | v -> v) + .AsValue() + .GetValue () - let GymAccessPin = - (match node.["gymAccessPin"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("gymAccessPin") + let DateOfBirth = + (match node.["dateofBirth"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("dateofBirth") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () + |> System.DateOnly.Parse - let EmailAddress = - (match node.["emailAddress"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("emailAddress") + let GymAccessPin = + (match node.["gymAccessPin"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("gymAccessPin") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let HomeGymName = - (match node.["homeGymName"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("homeGymName") + let EmailAddress = + (match node.["emailAddress"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("emailAddress") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let HomeGymId = - (match node.["homeGymId"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("homeGymId") + let HomeGymName = + (match node.["homeGymName"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("homeGymName") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let LastName = - (match node.["lastName"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("lastName") + let HomeGymId = + (match node.["homeGymId"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("homeGymId") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let FirstName = - (match node.["firstName"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("firstName") + let LastName = + (match node.["lastName"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("lastName") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let CompoundMemberId = - (match node.["compoundMemberId"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("compoundMemberId") + let FirstName = + (match node.["firstName"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("firstName") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - let Id = - (match node.["id"] with - | null -> - raise ( - System.Collections.Generic.KeyNotFoundException ( - sprintf "Required key '%s' not found on JSON object" ("id") + let CompoundMemberId = + (match node.["compoundMemberId"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("compoundMemberId") + ) ) - ) - | v -> v) - .AsValue() - .GetValue () + | v -> v) + .AsValue() + .GetValue () - { - Id = Id - CompoundMemberId = CompoundMemberId - FirstName = FirstName - LastName = LastName - HomeGymId = HomeGymId - HomeGymName = HomeGymName - EmailAddress = EmailAddress - GymAccessPin = GymAccessPin - DateOfBirth = DateOfBirth - MobileNumber = MobileNumber - Postcode = Postcode - MembershipName = MembershipName - MembershipLevel = MembershipLevel - SuspendedReason = SuspendedReason - MemberStatus = MemberStatus - } + let Id = + (match node.["id"] with + | null -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("id") + ) + ) + | v -> v) + .AsValue() + .GetValue () + + { + Id = Id + CompoundMemberId = CompoundMemberId + FirstName = FirstName + LastName = LastName + HomeGymId = HomeGymId + HomeGymName = HomeGymName + EmailAddress = EmailAddress + GymAccessPin = GymAccessPin + DateOfBirth = DateOfBirth + MobileNumber = MobileNumber + Postcode = Postcode + MembershipName = MembershipName + MembershipLevel = MembershipLevel + SuspendedReason = SuspendedReason + MemberStatus = MemberStatus + } namespace PureGym /// Module containing JSON parsing methods for the GymAttendance type diff --git a/ConsumePlugin/GeneratedRestClient.fs b/ConsumePlugin/GeneratedRestClient.fs index 614c5c5..63ada16 100644 --- a/ConsumePlugin/GeneratedRestClient.fs +++ b/ConsumePlugin/GeneratedRestClient.fs @@ -383,6 +383,37 @@ module PureGymApi = } |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + member _.CreateUserSerialisedBody (user : PureGym.Member, ct : CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://whatnot.com" + | v -> v), + System.Uri ("users/new", 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 ( + user |> PureGym.Member.toJsonNode |> (fun node -> node.ToJsonString ()) + ) + + 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)) + member _.CreateUserHttpContent (user : System.Net.Http.HttpContent, ct : CancellationToken option) = async { let! ct = Async.CancellationToken diff --git a/ConsumePlugin/PureGymDto.fs b/ConsumePlugin/PureGymDto.fs index 1010dd8..cc21469 100644 --- a/ConsumePlugin/PureGymDto.fs +++ b/ConsumePlugin/PureGymDto.fs @@ -68,7 +68,8 @@ type Gym = ReopenDate : string } -[] +[] +[] type Member = { Id : int diff --git a/ConsumePlugin/RestApiExample.fs b/ConsumePlugin/RestApiExample.fs index 38453e0..ea51ff9 100644 --- a/ConsumePlugin/RestApiExample.fs +++ b/ConsumePlugin/RestApiExample.fs @@ -50,6 +50,9 @@ type IPureGymApi = [] abstract CreateUserByteArr'' : [] user : byte array * ?ct : CancellationToken -> Task + [] + abstract CreateUserSerialisedBody : [] user : PureGym.Member * ?ct : CancellationToken -> Task + [] abstract CreateUserHttpContent : [] user : System.Net.Http.HttpContent * ?ct : CancellationToken -> Task diff --git a/README.md b/README.md index 6965258..19c9f16 100644 --- a/README.md +++ b/README.md @@ -265,8 +265,9 @@ RestEase is complex, and handles a lot of different stuff. * If you set the `BaseAddress` on your input `HttpClient`, make sure to end with a trailing slash on any trailing directories (so `"blah/foo/"` rather than `"blah/foo"`). We combine URIs using `UriKind.Relative`, so without a trailing slash, the last component may be chopped off. -* Parameters are serialised solely with `ToString`, and there's no control over this; - nor is there control over encoding in any sense. +* Parameters are serialised naively with `toJsonNode` as though the `JsonSerialize` generator were applied, + and you can't control the serialisation. You can't yet serialise e.g. a primitive type this way (other than `String`); + all body parameters must be types which have a suitable `toJsonNode : 'a -> JsonNode` method. * Deserialisation follows the same logic as the `JsonParse` generator, and it generally assumes you're using types which `JsonParse` is applied to. * Headers are not yet supported. diff --git a/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestBodyParam.fs b/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestBodyParam.fs index c998e89..f86032f 100644 --- a/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestBodyParam.fs +++ b/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestBodyParam.fs @@ -4,7 +4,6 @@ open System open System.IO open System.Net open System.Net.Http -open System.Text.Json.Nodes open NUnit.Framework open PureGym open FsUnitTyped @@ -103,3 +102,49 @@ module TestBodyParam = let buf = Array.zeroCreate 10 let written = observedContent.ReadAtLeast (buf.AsSpan (), 5, false) buf |> Array.take written |> shouldEqual contents + + [] + let ``Body param of serialised thing`` () = + let proc (message : HttpRequestMessage) : HttpResponseMessage Async = + async { + message.Method |> shouldEqual HttpMethod.Post + let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask + let content = new StringContent ("Done! " + content) + let resp = new HttpResponseMessage (HttpStatusCode.OK) + resp.Content <- content + return resp + } + + use client = HttpClientMock.make (Uri "https://example.com") proc + let api = PureGymApi.make client + + let expected = + { + Id = 3 + CompoundMemberId = "compound!" + FirstName = "Patrick" + LastName = "Stevens" + HomeGymId = 100 + HomeGymName = "Big Boy Gym" + EmailAddress = "woof@ware" + GymAccessPin = "l3tm31n" + // To the reader: what's the significance of this date? + // answer rot13: ghevatpbzchgnovyvglragfpurvqhatfceboyrzcncre + DateOfBirth = DateOnly (1936, 05, 28) + MobileNumber = "+44-GHOST-BUSTERS" + Postcode = "W1A 111" + MembershipName = "mario" + MembershipLevel = 4 + SuspendedReason = 1090 + MemberStatus = -3 + } + + let result = api.CreateUserSerialisedBody(expected).Result + + result.StartsWith ("Done! ", StringComparison.Ordinal) |> shouldEqual true + let result = result.[6..] + + result + |> System.Text.Json.Nodes.JsonNode.Parse + |> PureGym.Member.jsonParse + |> shouldEqual expected diff --git a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs index 344ee1f..48325fd 100644 --- a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs +++ b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs @@ -362,7 +362,7 @@ module internal HttpClientGenerator = arg.Attributes |> List.choose (fun attr -> match attr with - | Body -> Some arg + | HttpAttribute.Body -> Some arg | _ -> None ) ) @@ -480,10 +480,12 @@ module internal HttpClientGenerator = ) ) ] - | BodyParamMethods.Serialise _ -> - failwith "We don't yet support serialising Body parameters; use string or Stream instead" - (* - // TODO: this should use JSON instead of ToString + | BodyParamMethods.Serialise ty -> + let typeIdent = + match SynType.stripOptionalParen ty with + | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> ident + | _ -> failwith $"Unable to identify type %+A{ty}" + [ Let ( "queryParams", @@ -492,19 +494,35 @@ module internal HttpClientGenerator = SynType.CreateLongIdent ( SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "StringContent" ] ), - SynExpr.CreateParen (SynExpr.CreateIdent bodyParamName |> SynExpr.toString ty), + SynExpr.CreateParen ( + SynExpr.CreateIdent bodyParamName + |> SynExpr.pipeThroughFunction ( + SynExpr.CreateLongIdent ( + SynLongIdent.CreateFromLongIdent (typeIdent @ [ Ident.Create "toJsonNode" ]) + ) + ) + |> SynExpr.pipeThroughFunction ( + SynExpr.createLambda + "node" + (SynExpr.CreateApp ( + SynExpr.CreateLongIdent ( + SynLongIdent.Create [ "node" ; "ToJsonString" ] + ), + SynExpr.CreateConst SynConst.Unit + )) + ) + ), range0 ) ) Do ( SynExpr.LongIdentSet ( SynLongIdent.Create [ "httpMessage" ; "Content" ], - SynExpr.CreateIdentString "queryParams", + SynExpr.CreateIdent (Ident.Create "queryParams"), range0 ) ) ] - *) let implementation = let responseString = diff --git a/WoofWare.Myriad.Plugins/SynType.fs b/WoofWare.Myriad.Plugins/SynType.fs new file mode 100644 index 0000000..abf2528 --- /dev/null +++ b/WoofWare.Myriad.Plugins/SynType.fs @@ -0,0 +1,10 @@ +namespace WoofWare.Myriad.Plugins + +open Fantomas.FCS.Syntax + +[] +module internal SynType = + let rec stripOptionalParen (ty : SynType) : SynType = + match ty with + | SynType.Paren (ty, _) -> stripOptionalParen ty + | ty -> ty diff --git a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj index 6142f1a..d98c43d 100644 --- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj +++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj @@ -26,6 +26,7 @@ +