Implement JSON serialisation of body params (#71)

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
+[<AutoOpen>]
+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<int> input.Id)
+                node.Add ("compoundMemberId", System.Text.Json.Nodes.JsonValue.Create<string> input.CompoundMemberId)
+                node.Add ("firstName", System.Text.Json.Nodes.JsonValue.Create<string> input.FirstName)
+                node.Add ("lastName", System.Text.Json.Nodes.JsonValue.Create<string> input.LastName)
+                node.Add ("homeGymId", System.Text.Json.Nodes.JsonValue.Create<int> input.HomeGymId)
+                node.Add ("homeGymName", System.Text.Json.Nodes.JsonValue.Create<string> input.HomeGymName)
+                node.Add ("emailAddress", System.Text.Json.Nodes.JsonValue.Create<string> input.EmailAddress)
+                node.Add ("gymAccessPin", System.Text.Json.Nodes.JsonValue.Create<string> input.GymAccessPin)
+                node.Add ("dateofBirth", System.Text.Json.Nodes.JsonValue.Create<DateOnly> input.DateOfBirth)
+                node.Add ("mobileNumber", System.Text.Json.Nodes.JsonValue.Create<string> input.MobileNumber)
+                node.Add ("postCode", System.Text.Json.Nodes.JsonValue.Create<string> input.Postcode)
+                node.Add ("membershipName", System.Text.Json.Nodes.JsonValue.Create<string> input.MembershipName)
+                node.Add ("membershipLevel", System.Text.Json.Nodes.JsonValue.Create<int> input.MembershipLevel)
+                node.Add ("suspendedReason", System.Text.Json.Nodes.JsonValue.Create<int> input.SuspendedReason)
+                node.Add ("memberStatus", System.Text.Json.Nodes.JsonValue.Create<int> input.MemberStatus)
+
+            node :> _
 
 namespace PureGym
 
@@ -378,12 +411,14 @@ module Gym =
         }
 namespace PureGym
 
-/// Module containing JSON parsing methods for the Member type
-[<RequireQualifiedAccess>]
-[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
-module Member =
+/// Module containing JSON parsing extension members for the Member type
+[<AutoOpen>]
+module MemberJsonParseExtension =
+    /// Extension methods for JSON parsing
+    type Member with
+
         /// Parse from a JSON node.
-    let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Member =
+        static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : Member =
             let MemberStatus =
                 (match node.["memberStatus"] with
                  | null ->

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

ConsumePlugin/PureGymDto.fs

@@ -68,7 +68,8 @@ type Gym =
         ReopenDate : string
     }
 
-[<WoofWare.Myriad.Plugins.JsonParse>]
+[<WoofWare.Myriad.Plugins.JsonParse true>]
+[<WoofWare.Myriad.Plugins.JsonSerialize true>]
 type Member =
     {
         Id : int

ConsumePlugin/RestApiExample.fs

@@ -50,6 +50,9 @@ type IPureGymApi =
     [<Post "users/new">]
     abstract CreateUserByteArr'' : [<Body>] user : byte array * ?ct : CancellationToken -> Task<Stream>
 
+    [<Post "users/new">]
+    abstract CreateUserSerialisedBody : [<Body>] user : PureGym.Member * ?ct : CancellationToken -> Task<string>
+
     [<Post "users/new">]
     abstract CreateUserHttpContent :
         [<Body>] user : System.Net.Http.HttpContent * ?ct : CancellationToken -> Task<string>

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.

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
+
+    [<Test>]
+    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

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 =

WoofWare.Myriad.Plugins/SynType.fs

@@ -0,0 +1,10 @@
+namespace WoofWare.Myriad.Plugins
+
+open Fantomas.FCS.Syntax
+
+[<RequireQualifiedAccess>]
+module internal SynType =
+    let rec stripOptionalParen (ty : SynType) : SynType =
+        match ty with
+        | SynType.Paren (ty, _) -> stripOptionalParen ty
+        | ty -> ty

WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj

@@ -26,6 +26,7 @@
   <ItemGroup>
     <Compile Include="AstHelper.fs"/>
     <Compile Include="SynExpr.fs"/>
+    <Compile Include="SynType.fs" />
     <Compile Include="SynAttribute.fs"/>
     <Compile Include="RemoveOptionsGenerator.fs"/>
     <Compile Include="InterfaceMockGenerator.fs" />