patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-06 04:28:42 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add initial support for [<Body>] (#46)

Browse Source
This commit is contained in:
Patrick Stevens
2023-12-30 11:35:22 +00:00
committed by GitHub
parent 4c55bbed22
commit dd7e004e36
9 changed files with 422 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files

161
ConsumePlugin/GeneratedRestClient.fs
View File

@@ -216,6 +216,167 @@ module PureGymApi =
} }
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserString (user : string, 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)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserStream (user : System.IO.Stream, 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.StreamContent (user)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserByteArr (user : byte[], 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.ByteArrayContent (user)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserByteArr' (user : array<byte>, 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.ByteArrayContent (user)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserByteArr'' (user : byte array, 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.ByteArrayContent (user)
do httpMessage.Content <- queryParams
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.CreateUserHttpContent (user : System.Net.Http.HttpContent, 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
)
do httpMessage.Content <- user
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetPathParam (parameter : string, ct : CancellationToken option) = member _.GetPathParam (parameter : string, ct : CancellationToken option) =
async { async {
let! ct = Async.CancellationToken let! ct = Async.CancellationToken

20
ConsumePlugin/RestApiExample.fs
View File

@@ -31,6 +31,26 @@ type IPureGymApi =
abstract GetSessions : abstract GetSessions :
[<Query>] fromDate : DateOnly * [<Query>] toDate : DateOnly * ?ct : CancellationToken -> Task<Sessions> [<Query>] fromDate : DateOnly * [<Query>] toDate : DateOnly * ?ct : CancellationToken -> Task<Sessions>
// An example from RestEase's own docs
[<Post "users/new">]
abstract CreateUserString : [<Body>] user : string * ?ct : CancellationToken -> Task<string>
[<Post "users/new">]
abstract CreateUserStream : [<Body>] user : System.IO.Stream * ?ct : CancellationToken -> Task<Stream>
[<Post "users/new">]
abstract CreateUserByteArr : [<Body>] user : byte[] * ?ct : CancellationToken -> Task<Stream>
[<Post "users/new">]
abstract CreateUserByteArr' : [<Body>] user : array<byte> * ?ct : CancellationToken -> Task<Stream>
[<Post "users/new">]
abstract CreateUserByteArr'' : [<Body>] user : byte array * ?ct : CancellationToken -> Task<Stream>
[<Post "users/new">]
abstract CreateUserHttpContent :
[<Body>] user : System.Net.Http.HttpContent * ?ct : CancellationToken -> Task<string>
[<Get "endpoint/{param}">] [<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string> abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>

1
MyriadPlugin.Test/MyriadPlugin.Test.fsproj
View File

@@ -16,6 +16,7 @@
<Compile Include="TestHttpClient\TestReturnTypes.fs" /> <Compile Include="TestHttpClient\TestReturnTypes.fs" />
<Compile Include="TestHttpClient\TestAllowAnyStatusCode.fs" /> <Compile Include="TestHttpClient\TestAllowAnyStatusCode.fs" />
<Compile Include="TestHttpClient\TestBasePath.fs" /> <Compile Include="TestHttpClient\TestBasePath.fs" />
<Compile Include="TestHttpClient\TestBodyParam.fs" />
<Compile Include="TestSurface.fs"/> <Compile Include="TestSurface.fs"/>
<Compile Include="TestRemoveOptions.fs"/> <Compile Include="TestRemoveOptions.fs"/>
</ItemGroup> </ItemGroup>

105
MyriadPlugin.Test/TestHttpClient/TestBodyParam.fs Normal file
View File

@@ -0,0 +1,105 @@
namespace MyriadPlugin.Test
open System
open System.IO
open System.Net
open System.Net.Http
open System.Text.Json.Nodes
open NUnit.Framework
open PureGym
open FsUnitTyped
[<TestFixture>]
module TestBodyParam =
[<Test>]
let ``Body param of string`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
let content = new StringContent (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 observedUri = api.CreateUserString("username?not!url%encoded").Result
observedUri |> shouldEqual "username?not!url%encoded"
[<Test>]
let ``Body param of stream`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStreamAsync () |> Async.AwaitTask
let content = new StreamContent (content)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
let contents = [| 1uy ; 2uy ; 3uy ; 4uy |]
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
use stream = new MemoryStream (contents)
let observedContent = api.CreateUserStream(stream).Result
let buf = Array.zeroCreate 10
let written = observedContent.ReadAtLeast (buf.AsSpan (), 5, false)
buf |> Array.take written |> shouldEqual contents
[<Test>]
let ``Body param of HttpContent`` () =
let mutable observedContent = None
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let resp = new HttpResponseMessage (HttpStatusCode.OK)
observedContent <- Some message.Content
resp.Content <- new StringContent ("oh hi")
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
use content = new StringContent ("hello!")
api.CreateUserHttpContent(content).Result |> shouldEqual "oh hi"
Object.ReferenceEquals (Option.get observedContent, content) |> shouldEqual true
[<TestCase "ByteArr">]
[<TestCase "ByteArr'">]
[<TestCase "ByteArr''">]
let ``Body param of byte arr`` (case : string) =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStreamAsync () |> Async.AwaitTask
let content = new StreamContent (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 contents = [| 1uy ; 2uy ; 3uy ; 4uy |]
let observedContent =
match case with
| "ByteArr" -> api.CreateUserByteArr(contents).Result
| "ByteArr'" -> api.CreateUserByteArr'(contents).Result
| "ByteArr''" -> api.CreateUserByteArr''(contents).Result
| _ -> failwith $"Unrecognised case: %s{case}"
let buf = Array.zeroCreate 10
let written = observedContent.ReadAtLeast (buf.AsSpan (), 5, false)
buf |> Array.take written |> shouldEqual contents

4
MyriadPlugin.Test/TestHttpClient/TestReturnTypes.fs
View File

@@ -54,8 +54,8 @@ module TestReturnTypes =
| _ -> failwith $"unrecognised case: %s{case}" | _ -> failwith $"unrecognised case: %s{case}"
let buf = Array.zeroCreate 10 let buf = Array.zeroCreate 10
stream.Read (buf, 0, 10) |> shouldEqual 4 let written = stream.ReadAtLeast (buf.AsSpan (), 10, false)
Array.take 4 buf |> shouldEqual result Array.take written buf |> shouldEqual result
[<TestCase "GetResponseMessage">] [<TestCase "GetResponseMessage">]
[<TestCase "GetResponseMessage'">] [<TestCase "GetResponseMessage'">]

1
README.md
View File

@@ -204,7 +204,6 @@ The motivating example is again ahead-of-time compilation: we wish to avoid the
RestEase is complex, and handles a lot of different stuff. RestEase is complex, and handles a lot of different stuff.
* As of this writing, `[<Body>]` is explicitly unsupported (it throws with a TODO).
* Parameters are serialised solely with `ToString`, and there's no control over this; * Parameters are serialised solely with `ToString`, and there's no control over this;
nor is there control over encoding in any sense. nor is there control over encoding in any sense.
* Deserialisation follows the same logic as the `JsonParse` generator, * Deserialisation follows the same logic as the `JsonParse` generator,

19
WoofWare.Myriad.Plugins/AstHelper.fs
View File

@@ -116,6 +116,14 @@ module internal SynTypePatterns =
| _ -> None | _ -> None
| _ -> None | _ -> None
let (|Byte|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] -> [ "byte" ] |> List.tryFind (fun s -> s = i.idText) |> Option.map ignore<string>
| _ -> None
| _ -> None
let (|HttpResponseMessage|_|) (fieldType : SynType) : unit option = let (|HttpResponseMessage|_|) (fieldType : SynType) : unit option =
match fieldType with match fieldType with
| SynType.LongIdent ident -> | SynType.LongIdent ident ->
@@ -127,6 +135,17 @@ module internal SynTypePatterns =
| _ -> None | _ -> None
| _ -> None | _ -> None
let (|HttpContent|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map (fun i -> i.idText) with
| [ "System" ; "Net" ; "Http" ; "HttpContent" ]
| [ "Net" ; "Http" ; "HttpContent" ]
| [ "Http" ; "HttpContent" ]
| [ "HttpContent" ] -> Some ()
| _ -> None
| _ -> None
let (|Stream|_|) (fieldType : SynType) : unit option = let (|Stream|_|) (fieldType : SynType) : unit option =
match fieldType with match fieldType with
| SynType.LongIdent ident -> | SynType.LongIdent ident ->

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

@@ -31,6 +31,22 @@ module internal HttpClientGenerator =
Type : SynType Type : SynType
} }
[<RequireQualifiedAccess>]
type BodyParamMethods =
| StringContent
| StreamContent
| ByteArrayContent
| HttpContent
| Serialise of SynType
override this.ToString () =
match this with
| BodyParamMethods.Serialise _ -> "ToString"
| BodyParamMethods.ByteArrayContent -> "ByteArrayContent"
| BodyParamMethods.StringContent -> "StringContent"
| BodyParamMethods.StreamContent -> "StreamContent"
| BodyParamMethods.HttpContent -> "HttpContent"
let synBindingTriviaZero (isMember : bool) = let synBindingTriviaZero (isMember : bool) =
{ {
SynBindingTrivia.EqualsRange = Some range0 SynBindingTrivia.EqualsRange = Some range0
@@ -256,18 +272,9 @@ module internal HttpClientGenerator =
| None -> failwith "Unable to get parameter variable name from anonymous parameter" | None -> failwith "Unable to get parameter variable name from anonymous parameter"
| Some id -> id | Some id -> id
let toString (ident : SynExpr) (ty : SynType) =
match ty with
| DateOnly ->
ident
|> SynExpr.callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-dd")
| DateTime ->
ident
|> SynExpr.callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-ddTHH:mm:ss")
| _ -> SynExpr.callMethod "ToString" ident
let prefix = let prefix =
toString (SynExpr.CreateIdent firstValueId) firstValue.Type SynExpr.CreateIdent firstValueId
|> SynExpr.toString firstValue.Type
|> SynExpr.CreateParen |> SynExpr.CreateParen
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]) SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ])
@@ -282,7 +289,7 @@ module internal HttpClientGenerator =
| None -> failwith "Unable to get parameter variable name from anonymous parameter" | None -> failwith "Unable to get parameter variable name from anonymous parameter"
| Some id -> id | Some id -> id
toString (SynExpr.CreateIdent paramValueId) paramValue.Type SynExpr.toString paramValue.Type (SynExpr.CreateIdent paramValueId)
|> SynExpr.CreateParen |> SynExpr.CreateParen
|> SynExpr.pipeThroughFunction ( |> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent ( SynExpr.CreateLongIdent (
@@ -370,8 +377,23 @@ module internal HttpClientGenerator =
) )
) )
if not bodyParams.IsEmpty then let bodyParam =
failwith "[<Body>] is not yet supported" match bodyParams with
| [] -> None
| [ x ] ->
// TODO: body serialisation method
let paramName =
match x.Id with
| None -> failwith "Anonymous [<Body>] parameter is unsupported"
| Some id -> id
match x.Type with
| Stream -> Some (BodyParamMethods.StreamContent, paramName)
| String -> Some (BodyParamMethods.StringContent, paramName)
| ArrayType Byte -> Some (BodyParamMethods.ByteArrayContent, paramName)
| HttpContent -> Some (BodyParamMethods.HttpContent, paramName)
| ty -> Some (BodyParamMethods.Serialise ty, paramName)
| _ -> failwith "You can only have at most one [<Body>] parameter on a method."
let httpReqMessageConstructor = let httpReqMessageConstructor =
[ [
@@ -397,6 +419,71 @@ module internal HttpClientGenerator =
info.ReturnType info.ReturnType
(SynExpr.CreateIdentString "node") (SynExpr.CreateIdentString "node")
let handleBodyParams =
match bodyParam with
| None -> []
| Some (bodyParamType, bodyParamName) ->
match bodyParamType with
| BodyParamMethods.StreamContent
| BodyParamMethods.ByteArrayContent
| BodyParamMethods.StringContent ->
[
Let (
"queryParams",
SynExpr.New (
false,
SynType.CreateLongIdent (
SynLongIdent.Create
[ "System" ; "Net" ; "Http" ; (bodyParamType : BodyParamMethods).ToString () ]
),
SynExpr.CreateParen (SynExpr.CreateIdent bodyParamName),
range0
)
)
Do (
SynExpr.LongIdentSet (
SynLongIdent.Create [ "httpMessage" ; "Content" ],
SynExpr.CreateIdentString "queryParams",
range0
)
)
]
| BodyParamMethods.HttpContent ->
[
Do (
SynExpr.LongIdentSet (
SynLongIdent.Create [ "httpMessage" ; "Content" ],
SynExpr.CreateIdent bodyParamName,
range0
)
)
]
| BodyParamMethods.Serialise _ ->
failwith "We don't yet support serialising Body parameters; use string or Stream instead"
(*
// TODO: this should use JSON instead of ToString
[
Let (
"queryParams",
SynExpr.New (
false,
SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "StringContent" ]
),
SynExpr.CreateParen (SynExpr.CreateIdent bodyParamName |> SynExpr.toString ty),
range0
)
)
Do (
SynExpr.LongIdentSet (
SynLongIdent.Create [ "httpMessage" ; "Content" ],
SynExpr.CreateIdentString "queryParams",
range0
)
)
]
*)
let implementation = let implementation =
[ [
yield LetBang ("ct", SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "CancellationToken" ])) yield LetBang ("ct", SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "CancellationToken" ]))
@@ -413,30 +500,9 @@ module internal HttpClientGenerator =
range0 range0
) )
) )
(*
if not bodyParams.IsEmpty then
yield
Use (
"queryParams",
SynExpr.New (
false,
SynType.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Net" ; "Http" ; "StringContent" ]
),
SynExpr.CreateParen (failwith "TODO"),
range0
)
)
yield yield! handleBodyParams
Do (
SynExpr.LongIdentSet (
SynLongIdent.Create [ "httpMessage" ; "Content" ],
SynExpr.CreateIdentString "queryParams",
range0
)
)
*)
yield yield
LetBang ( LetBang (
"response", "response",

12
WoofWare.Myriad.Plugins/SynExpr.fs
View File

@@ -240,7 +240,7 @@ module internal SynExpr =
SynExprLetOrUseTrivia.InKeyword = None SynExprLetOrUseTrivia.InKeyword = None
} }
) )
| Do body -> SynExpr.Do (body, range0) | Do body -> SynExpr.CreateSequential [ SynExpr.Do (body, range0) ; state ]
) )
SynExpr.CreateApp ( SynExpr.CreateApp (
@@ -252,3 +252,13 @@ module internal SynExpr =
let awaitTask (expr : SynExpr) : SynExpr = let awaitTask (expr : SynExpr) : SynExpr =
expr expr
|> pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "AwaitTask" ])) |> pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "AwaitTask" ]))
/// {ident}.ToString ()
/// with special casing for some types like DateTime
let toString (ty : SynType) (ident : SynExpr) =
match ty with
| DateOnly -> ident |> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-dd")
| DateTime ->
ident
|> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-ddTHH:mm:ss")
| _ -> callMethod "ToString" ident