From dd7e004e363faf25ef805dd25697457223f44074 Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Sat, 30 Dec 2023 11:35:22 +0000 Subject: [PATCH] Add initial support for `[]` (#46) --- ConsumePlugin/GeneratedRestClient.fs | 161 ++++++++++++++++++ ConsumePlugin/RestApiExample.fs | 20 +++ MyriadPlugin.Test/MyriadPlugin.Test.fsproj | 1 + .../TestHttpClient/TestBodyParam.fs | 105 ++++++++++++ .../TestHttpClient/TestReturnTypes.fs | 4 +- README.md | 1 - WoofWare.Myriad.Plugins/AstHelper.fs | 19 +++ .../HttpClientGenerator.fs | 140 +++++++++++---- WoofWare.Myriad.Plugins/SynExpr.fs | 12 +- 9 files changed, 422 insertions(+), 41 deletions(-) create mode 100644 MyriadPlugin.Test/TestHttpClient/TestBodyParam.fs diff --git a/ConsumePlugin/GeneratedRestClient.fs b/ConsumePlugin/GeneratedRestClient.fs index 2ac321a..6071063 100644 --- a/ConsumePlugin/GeneratedRestClient.fs +++ b/ConsumePlugin/GeneratedRestClient.fs @@ -216,6 +216,167 @@ module PureGymApi = } |> (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, 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) = async { let! ct = Async.CancellationToken diff --git a/ConsumePlugin/RestApiExample.fs b/ConsumePlugin/RestApiExample.fs index ad75d4e..381b271 100644 --- a/ConsumePlugin/RestApiExample.fs +++ b/ConsumePlugin/RestApiExample.fs @@ -31,6 +31,26 @@ type IPureGymApi = abstract GetSessions : [] fromDate : DateOnly * [] toDate : DateOnly * ?ct : CancellationToken -> Task + // An example from RestEase's own docs + [] + abstract CreateUserString : [] user : string * ?ct : CancellationToken -> Task + + [] + abstract CreateUserStream : [] user : System.IO.Stream * ?ct : CancellationToken -> Task + + [] + abstract CreateUserByteArr : [] user : byte[] * ?ct : CancellationToken -> Task + + [] + abstract CreateUserByteArr' : [] user : array * ?ct : CancellationToken -> Task + + [] + abstract CreateUserByteArr'' : [] user : byte array * ?ct : CancellationToken -> Task + + [] + abstract CreateUserHttpContent : + [] user : System.Net.Http.HttpContent * ?ct : CancellationToken -> Task + [] abstract GetPathParam : [] parameter : string * ?ct : CancellationToken -> Task diff --git a/MyriadPlugin.Test/MyriadPlugin.Test.fsproj b/MyriadPlugin.Test/MyriadPlugin.Test.fsproj index 6b898d0..f6c91a1 100644 --- a/MyriadPlugin.Test/MyriadPlugin.Test.fsproj +++ b/MyriadPlugin.Test/MyriadPlugin.Test.fsproj @@ -16,6 +16,7 @@ + diff --git a/MyriadPlugin.Test/TestHttpClient/TestBodyParam.fs b/MyriadPlugin.Test/TestHttpClient/TestBodyParam.fs new file mode 100644 index 0000000..fcbd45d --- /dev/null +++ b/MyriadPlugin.Test/TestHttpClient/TestBodyParam.fs @@ -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 + +[] +module TestBodyParam = + + [] + 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" + + [] + 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 + + [] + 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 + + [] + [] + [] + 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 diff --git a/MyriadPlugin.Test/TestHttpClient/TestReturnTypes.fs b/MyriadPlugin.Test/TestHttpClient/TestReturnTypes.fs index 91e7792..a0affd8 100644 --- a/MyriadPlugin.Test/TestHttpClient/TestReturnTypes.fs +++ b/MyriadPlugin.Test/TestHttpClient/TestReturnTypes.fs @@ -54,8 +54,8 @@ module TestReturnTypes = | _ -> failwith $"unrecognised case: %s{case}" let buf = Array.zeroCreate 10 - stream.Read (buf, 0, 10) |> shouldEqual 4 - Array.take 4 buf |> shouldEqual result + let written = stream.ReadAtLeast (buf.AsSpan (), 10, false) + Array.take written buf |> shouldEqual result [] [] diff --git a/README.md b/README.md index a52b6a1..574d194 100644 --- a/README.md +++ b/README.md @@ -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. -* As of this writing, `[]` is explicitly unsupported (it throws with a TODO). * Parameters are serialised solely with `ToString`, and there's no control over this; nor is there control over encoding in any sense. * Deserialisation follows the same logic as the `JsonParse` generator, diff --git a/WoofWare.Myriad.Plugins/AstHelper.fs b/WoofWare.Myriad.Plugins/AstHelper.fs index a31f431..1418deb 100644 --- a/WoofWare.Myriad.Plugins/AstHelper.fs +++ b/WoofWare.Myriad.Plugins/AstHelper.fs @@ -116,6 +116,14 @@ module internal SynTypePatterns = | _ -> 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 + | _ -> None + | _ -> None + let (|HttpResponseMessage|_|) (fieldType : SynType) : unit option = match fieldType with | SynType.LongIdent ident -> @@ -127,6 +135,17 @@ module internal SynTypePatterns = | _ -> 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 = match fieldType with | SynType.LongIdent ident -> diff --git a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs index 495d80f..eefa2eb 100644 --- a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs +++ b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs @@ -31,6 +31,22 @@ module internal HttpClientGenerator = Type : SynType } + [] + 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) = { SynBindingTrivia.EqualsRange = Some range0 @@ -256,18 +272,9 @@ module internal HttpClientGenerator = | None -> failwith "Unable to get parameter variable name from anonymous parameter" | 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 = - toString (SynExpr.CreateIdent firstValueId) firstValue.Type + SynExpr.CreateIdent firstValueId + |> SynExpr.toString firstValue.Type |> SynExpr.CreateParen |> SynExpr.pipeThroughFunction ( 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" | Some id -> id - toString (SynExpr.CreateIdent paramValueId) paramValue.Type + SynExpr.toString paramValue.Type (SynExpr.CreateIdent paramValueId) |> SynExpr.CreateParen |> SynExpr.pipeThroughFunction ( SynExpr.CreateLongIdent ( @@ -370,8 +377,23 @@ module internal HttpClientGenerator = ) ) - if not bodyParams.IsEmpty then - failwith "[] is not yet supported" + let bodyParam = + match bodyParams with + | [] -> None + | [ x ] -> + // TODO: body serialisation method + let paramName = + match x.Id with + | None -> failwith "Anonymous [] 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 [] parameter on a method." let httpReqMessageConstructor = [ @@ -397,6 +419,71 @@ module internal HttpClientGenerator = info.ReturnType (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 = [ yield LetBang ("ct", SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "CancellationToken" ])) @@ -413,30 +500,9 @@ module internal HttpClientGenerator = 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 - Do ( - SynExpr.LongIdentSet ( - SynLongIdent.Create [ "httpMessage" ; "Content" ], - SynExpr.CreateIdentString "queryParams", - range0 - ) - ) - *) + yield! handleBodyParams + yield LetBang ( "response", diff --git a/WoofWare.Myriad.Plugins/SynExpr.fs b/WoofWare.Myriad.Plugins/SynExpr.fs index dafc6c7..6f0cf28 100644 --- a/WoofWare.Myriad.Plugins/SynExpr.fs +++ b/WoofWare.Myriad.Plugins/SynExpr.fs @@ -240,7 +240,7 @@ module internal SynExpr = SynExprLetOrUseTrivia.InKeyword = None } ) - | Do body -> SynExpr.Do (body, range0) + | Do body -> SynExpr.CreateSequential [ SynExpr.Do (body, range0) ; state ] ) SynExpr.CreateApp ( @@ -252,3 +252,13 @@ module internal SynExpr = let awaitTask (expr : SynExpr) : SynExpr = expr |> 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