patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-12-15 21:35:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

Implement JSON serialisation of body params (#71)

Browse Source
This commit is contained in:
Patrick Stevens
2024-01-26 17:54:45 +00:00
committed by GitHub
parent ae3840d537
commit f83ac24a73
9 changed files with 332 additions and 187 deletions
Download Patch File Download Diff File Expand all files Collapse all files

385
ConsumePlugin/GeneratedPureGymDto.fs
View File

@@ -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 namespace PureGym
@@ -378,210 +411,212 @@ module Gym =
} }
namespace PureGym namespace PureGym
/// Module containing JSON parsing methods for the Member type /// Module containing JSON parsing extension members for the Member type
[<RequireQualifiedAccess>] [<AutoOpen>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>] module MemberJsonParseExtension =
module Member = /// Extension methods for JSON parsing
/// Parse from a JSON node. type Member with
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<int> ()
let SuspendedReason = /// Parse from a JSON node.
(match node.["suspendedReason"] with static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : Member =
| null -> let MemberStatus =
raise ( (match node.["memberStatus"] with
System.Collections.Generic.KeyNotFoundException ( | null ->
sprintf "Required key '%s' not found on JSON object" ("suspendedReason") raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("memberStatus")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<int> ()
.GetValue<int> ()
let MembershipLevel = let SuspendedReason =
(match node.["membershipLevel"] with (match node.["suspendedReason"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("membershipLevel") sprintf "Required key '%s' not found on JSON object" ("suspendedReason")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<int> ()
.GetValue<int> ()
let MembershipName = let MembershipLevel =
(match node.["membershipName"] with (match node.["membershipLevel"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("membershipName") sprintf "Required key '%s' not found on JSON object" ("membershipLevel")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<int> ()
.GetValue<string> ()
let Postcode = let MembershipName =
(match node.["postCode"] with (match node.["membershipName"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("postCode") sprintf "Required key '%s' not found on JSON object" ("membershipName")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<string> ()
let MobileNumber = let Postcode =
(match node.["mobileNumber"] with (match node.["postCode"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("mobileNumber") sprintf "Required key '%s' not found on JSON object" ("postCode")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<string> ()
let DateOfBirth = let MobileNumber =
(match node.["dateofBirth"] with (match node.["mobileNumber"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("dateofBirth") sprintf "Required key '%s' not found on JSON object" ("mobileNumber")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<string> ()
|> System.DateOnly.Parse
let GymAccessPin = let DateOfBirth =
(match node.["gymAccessPin"] with (match node.["dateofBirth"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("gymAccessPin") sprintf "Required key '%s' not found on JSON object" ("dateofBirth")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<string> () |> System.DateOnly.Parse
let EmailAddress = let GymAccessPin =
(match node.["emailAddress"] with (match node.["gymAccessPin"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("emailAddress") sprintf "Required key '%s' not found on JSON object" ("gymAccessPin")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<string> ()
let HomeGymName = let EmailAddress =
(match node.["homeGymName"] with (match node.["emailAddress"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("homeGymName") sprintf "Required key '%s' not found on JSON object" ("emailAddress")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<string> ()
let HomeGymId = let HomeGymName =
(match node.["homeGymId"] with (match node.["homeGymName"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("homeGymId") sprintf "Required key '%s' not found on JSON object" ("homeGymName")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<int> ()
let LastName = let HomeGymId =
(match node.["lastName"] with (match node.["homeGymId"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lastName") sprintf "Required key '%s' not found on JSON object" ("homeGymId")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<int> ()
.GetValue<string> ()
let FirstName = let LastName =
(match node.["firstName"] with (match node.["lastName"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("firstName") sprintf "Required key '%s' not found on JSON object" ("lastName")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<string> ()
let CompoundMemberId = let FirstName =
(match node.["compoundMemberId"] with (match node.["firstName"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("compoundMemberId") sprintf "Required key '%s' not found on JSON object" ("firstName")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<string> ()
let Id = let CompoundMemberId =
(match node.["id"] with (match node.["compoundMemberId"] with
| null -> | null ->
raise ( raise (
System.Collections.Generic.KeyNotFoundException ( System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("id") sprintf "Required key '%s' not found on JSON object" ("compoundMemberId")
)
) )
) | v -> v)
| v -> v) .AsValue()
.AsValue() .GetValue<string> ()
.GetValue<int> ()
{ let Id =
Id = Id (match node.["id"] with
CompoundMemberId = CompoundMemberId | null ->
FirstName = FirstName raise (
LastName = LastName System.Collections.Generic.KeyNotFoundException (
HomeGymId = HomeGymId sprintf "Required key '%s' not found on JSON object" ("id")
HomeGymName = HomeGymName )
EmailAddress = EmailAddress )
GymAccessPin = GymAccessPin | v -> v)
DateOfBirth = DateOfBirth .AsValue()
MobileNumber = MobileNumber .GetValue<int> ()
Postcode = Postcode
MembershipName = MembershipName {
MembershipLevel = MembershipLevel Id = Id
SuspendedReason = SuspendedReason CompoundMemberId = CompoundMemberId
MemberStatus = MemberStatus 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 namespace PureGym
/// Module containing JSON parsing methods for the GymAttendance type /// Module containing JSON parsing methods for the GymAttendance type

31
ConsumePlugin/GeneratedRestClient.fs
View File

@@ -383,6 +383,37 @@ module PureGymApi =
} }
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) |> (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) = member _.CreateUserHttpContent (user : System.Net.Http.HttpContent, ct : CancellationToken option) =
async { async {
let! ct = Async.CancellationToken let! ct = Async.CancellationToken

3
ConsumePlugin/PureGymDto.fs
View File

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

3
ConsumePlugin/RestApiExample.fs
View File

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

5
README.md
View File

@@ -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 * 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"`). 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. 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; * Parameters are serialised naively with `toJsonNode` as though the `JsonSerialize` generator were applied,
nor is there control over encoding in any sense. 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, * Deserialisation follows the same logic as the `JsonParse` generator,
and it generally assumes you're using types which `JsonParse` is applied to. and it generally assumes you're using types which `JsonParse` is applied to.
* Headers are not yet supported. * Headers are not yet supported.

47
WoofWare.Myriad.Plugins.Test/TestHttpClient/TestBodyParam.fs
View File

@@ -4,7 +4,6 @@ open System
open System.IO open System.IO
open System.Net open System.Net
open System.Net.Http open System.Net.Http
open System.Text.Json.Nodes
open NUnit.Framework open NUnit.Framework
open PureGym open PureGym
open FsUnitTyped open FsUnitTyped
@@ -103,3 +102,49 @@ module TestBodyParam =
let buf = Array.zeroCreate 10 let buf = Array.zeroCreate 10
let written = observedContent.ReadAtLeast (buf.AsSpan (), 5, false) let written = observedContent.ReadAtLeast (buf.AsSpan (), 5, false)
buf |> Array.take written |> shouldEqual contents 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

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

@@ -362,7 +362,7 @@ module internal HttpClientGenerator =
arg.Attributes arg.Attributes
|> List.choose (fun attr -> |> List.choose (fun attr ->
match attr with match attr with
| Body -> Some arg | HttpAttribute.Body -> Some arg
| _ -> None | _ -> None
) )
) )
@@ -480,10 +480,12 @@ module internal HttpClientGenerator =
) )
) )
] ]
| BodyParamMethods.Serialise _ -> | BodyParamMethods.Serialise ty ->
failwith "We don't yet support serialising Body parameters; use string or Stream instead" let typeIdent =
(* match SynType.stripOptionalParen ty with
// TODO: this should use JSON instead of ToString | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> ident
| _ -> failwith $"Unable to identify type %+A{ty}"
[ [
Let ( Let (
"queryParams", "queryParams",
@@ -492,19 +494,35 @@ module internal HttpClientGenerator =
SynType.CreateLongIdent ( SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "StringContent" ] 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 range0
) )
) )
Do ( Do (
SynExpr.LongIdentSet ( SynExpr.LongIdentSet (
SynLongIdent.Create [ "httpMessage" ; "Content" ], SynLongIdent.Create [ "httpMessage" ; "Content" ],
SynExpr.CreateIdentString "queryParams", SynExpr.CreateIdent (Ident.Create "queryParams"),
range0 range0
) )
) )
] ]
*)
let implementation = let implementation =
let responseString = let responseString =

10
WoofWare.Myriad.Plugins/SynType.fs Normal file
View File

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

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

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