From 4b9f63d374f0c1d18c185120f0b2b19da9693f4a Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Fri, 24 May 2024 22:09:33 +0100 Subject: [PATCH] Express HttpClient as extension method (#140) --- CHANGELOG.md | 14 +- ConsumePlugin/GeneratedVault.fs | 198 ++++++++++++++++++ ConsumePlugin/Vault.fs | 30 +++ .../Attributes.fs | 11 +- .../SurfaceBaseline.txt | 3 + .../version.json | 2 +- .../TestHttpClient/TestVaultClient.fs | 29 ++- .../TestJsonParse/TestJsonParse.fs | 2 + .../HttpClientGenerator.fs | 181 ++++++++++++---- 9 files changed, 422 insertions(+), 48 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8d19437..9e67d69 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,18 @@ Notable changes are recorded here. -# WoofWare.Myriad.Plugins 1.4 -> 2.0 +# WoofWare.Myriad.Plugins 2.1.20, WoofWare.Myriad.Plugins.Attributes 3.0.1 + +We now bundle copies of the RestEase attributes in `WoofWare.Myriad.Plugins.Attributes`, in case you don't want to take a dependency on RestEase. + +# WoofWare.Myriad.Plugins 2.1.15 + +The `GenerateMock` generator now permits a limited amount of inheritance in the record we're mocking out (specifically, `IDisposable`). + +# WoofWare.Myriad.Plugins 2.1.8 + +No change to the packages, but this is when we started creating and tagging GitHub releases, which are a better source of truth than this file. + +# WoofWare.Myriad.Plugins 2.0 This transition split the attributes (e.g. `[]`) into their own assembly, WoofWare.Myriad.Plugins.Attributes. The new assembly has minimal dependencies, so you may safely use it from your own code. diff --git a/ConsumePlugin/GeneratedVault.fs b/ConsumePlugin/GeneratedVault.fs index 1a1f5dd..358064e 100644 --- a/ConsumePlugin/GeneratedVault.fs +++ b/ConsumePlugin/GeneratedVault.fs @@ -543,3 +543,201 @@ module VaultClient = } |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) } +namespace ConsumePlugin + +open System +open System.Collections.Generic +open System.Text.Json.Serialization +open System.Threading +open System.Threading.Tasks +open RestEase + +/// Module for constructing a REST client. +[] +[] +module VaultClientNonExtensionMethod = + /// Create a REST client. + let make (client : System.Net.Http.HttpClient) : IVaultClientNonExtensionMethod = + { new IVaultClientNonExtensionMethod with + member _.GetSecret + (jwt : JwtVaultResponse, path : string, mountPoint : string, ct : CancellationToken option) + = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> + raise ( + System.ArgumentNullException ( + nameof (client.BaseAddress), + "No base address was supplied on the type, and no BaseAddress was on the HttpClient." + ) + ) + | v -> v), + System.Uri ( + "v1/{mountPoint}/{path}" + .Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode) + .Replace ( + "{mountPoint}", + mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode + ), + System.UriKind.Relative + ) + ) + + let httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + return JwtSecretResponse.jsonParse jsonNode + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member _.GetJwt (role : string, jwt : string, ct : CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> + raise ( + System.ArgumentNullException ( + nameof (client.BaseAddress), + "No base address was supplied on the type, and no BaseAddress was on the HttpClient." + ) + ) + | v -> v), + System.Uri ("v1/auth/jwt/login", System.UriKind.Relative) + ) + + let httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + return JwtVaultResponse.jsonParse jsonNode + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + } +namespace ConsumePlugin + +open System +open System.Collections.Generic +open System.Text.Json.Serialization +open System.Threading +open System.Threading.Tasks +open RestEase + +/// Extension methods for constructing a REST client. +[] +module VaultClientExtensionMethodHttpClientExtension = + /// Extension methods for HTTP clients + type VaultClientExtensionMethod with + + /// Create a REST client. + static member make (client : System.Net.Http.HttpClient) : IVaultClientExtensionMethod = + { new IVaultClientExtensionMethod with + member _.GetSecret + (jwt : JwtVaultResponse, path : string, mountPoint : string, ct : CancellationToken option) + = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> + raise ( + System.ArgumentNullException ( + nameof (client.BaseAddress), + "No base address was supplied on the type, and no BaseAddress was on the HttpClient." + ) + ) + | v -> v), + System.Uri ( + "v1/{mountPoint}/{path}" + .Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode) + .Replace ( + "{mountPoint}", + mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode + ), + System.UriKind.Relative + ) + ) + + let httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + return JwtSecretResponse.jsonParse jsonNode + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member _.GetJwt (role : string, jwt : string, ct : CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> + raise ( + System.ArgumentNullException ( + nameof (client.BaseAddress), + "No base address was supplied on the type, and no BaseAddress was on the HttpClient." + ) + ) + | v -> v), + System.Uri ("v1/auth/jwt/login", System.UriKind.Relative) + ) + + let httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + return JwtVaultResponse.jsonParse jsonNode + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + } diff --git a/ConsumePlugin/Vault.fs b/ConsumePlugin/Vault.fs index 73dcaf9..4414125 100644 --- a/ConsumePlugin/Vault.fs +++ b/ConsumePlugin/Vault.fs @@ -76,3 +76,33 @@ type IVaultClient = [] abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task + +[] +type IVaultClientNonExtensionMethod = + [] + abstract GetSecret : + jwt : JwtVaultResponse * + [] path : string * + [] mountPoint : string * + ?ct : CancellationToken -> + Task + + [] + abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task + +[] +type IVaultClientExtensionMethod = + [] + abstract GetSecret : + jwt : JwtVaultResponse * + [] path : string * + [] mountPoint : string * + ?ct : CancellationToken -> + Task + + [] + abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task + +[] +type VaultClientExtensionMethod = + static member thisClashes = 99 diff --git a/WoofWare.Myriad.Plugins.Attributes/Attributes.fs b/WoofWare.Myriad.Plugins.Attributes/Attributes.fs index dce93de..63dbf1e 100644 --- a/WoofWare.Myriad.Plugins.Attributes/Attributes.fs +++ b/WoofWare.Myriad.Plugins.Attributes/Attributes.fs @@ -60,8 +60,17 @@ type JsonParseAttribute (isExtensionMethod : bool) = /// generator should apply during build. /// This generator is intended to replicate much of the functionality of RestEase, /// i.e. to stamp out HTTP REST clients from interfaces defining the API. -type HttpClientAttribute () = +/// +/// If you supply isExtensionMethod = true, you will get extension methods. +/// These can only be consumed from F#, but the benefit is that they don't use up the module name +/// (since by default we create a module called "{TypeName}"). +type HttpClientAttribute (isExtensionMethod : bool) = inherit Attribute () + /// The default value of `isExtensionMethod`, the optional argument to the HttpClientAttribute constructor. + static member DefaultIsExtensionMethod = false + + /// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details. + new () = HttpClientAttribute HttpClientAttribute.DefaultIsExtensionMethod /// Attribute indicating a DU type to which the "create catamorphism" Myriad /// generator should apply during build. diff --git a/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt b/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt index 9655f64..58d4b8f 100644 --- a/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt +++ b/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt @@ -6,7 +6,10 @@ WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: unit WoofWare.Myriad.Plugins.GenerateMockAttribute.DefaultIsInternal [static property]: [read-only] bool WoofWare.Myriad.Plugins.GenerateMockAttribute.get_DefaultIsInternal [static method]: unit -> bool WoofWare.Myriad.Plugins.HttpClientAttribute inherit System.Attribute +WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: bool WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: unit +WoofWare.Myriad.Plugins.HttpClientAttribute.DefaultIsExtensionMethod [static property]: [read-only] bool +WoofWare.Myriad.Plugins.HttpClientAttribute.get_DefaultIsExtensionMethod [static method]: unit -> bool WoofWare.Myriad.Plugins.JsonParseAttribute inherit System.Attribute WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: bool WoofWare.Myriad.Plugins.JsonParseAttribute..ctor [constructor]: unit diff --git a/WoofWare.Myriad.Plugins.Attributes/version.json b/WoofWare.Myriad.Plugins.Attributes/version.json index c53eb2b..d0b7b91 100644 --- a/WoofWare.Myriad.Plugins.Attributes/version.json +++ b/WoofWare.Myriad.Plugins.Attributes/version.json @@ -1,5 +1,5 @@ { - "version": "3.0", + "version": "3.1", "publicReleaseRefSpec": [ "^refs/heads/main$" ], diff --git a/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVaultClient.fs b/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVaultClient.fs index bfacfab..d3f71df 100644 --- a/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVaultClient.fs +++ b/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVaultClient.fs @@ -87,8 +87,10 @@ module TestVaultClient = } }""" - [] - let ``URI example`` () = + [] + [] + [] + let ``URI example`` (vaultClientId : int) = let proc (message : HttpRequestMessage) : HttpResponseMessage Async = async { message.Method |> shouldEqual HttpMethod.Get @@ -112,10 +114,25 @@ module TestVaultClient = } use client = HttpClientMock.make (Uri "https://my-vault.com") proc - let api = VaultClient.make client - let vaultResponse = api.GetJwt("role", "jwt").Result - let value = api.GetSecret(vaultResponse, "path", "mount").Result + let value = + match vaultClientId with + | 1 -> + let api = VaultClient.make client + let vaultResponse = api.GetJwt("role", "jwt").Result + let value = api.GetSecret(vaultResponse, "path", "mount").Result + value + | 2 -> + let api = VaultClientNonExtensionMethod.make client + let vaultResponse = api.GetJwt("role", "jwt").Result + let value = api.GetSecret(vaultResponse, "path", "mount").Result + value + | 3 -> + let api = VaultClientExtensionMethod.make client + let vaultResponse = api.GetJwt("role", "jwt").Result + let value = api.GetSecret(vaultResponse, "path", "mount").Result + value + | _ -> failwith $"Unrecognised ID: %i{vaultClientId}" value.Data |> Seq.toList @@ -168,3 +185,5 @@ module TestVaultClient = "key8_1", "https://example.com/data8/1" "key8_2", "https://example.com/data8/2" ] + + let _canSeePastExtensionMethod = VaultClientExtensionMethod.thisClashes diff --git a/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestJsonParse.fs b/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestJsonParse.fs index 2cae6ef..d3da019 100644 --- a/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestJsonParse.fs +++ b/WoofWare.Myriad.Plugins.Test/TestJsonParse/TestJsonParse.fs @@ -7,6 +7,8 @@ open FsUnitTyped [] module TestJsonParse = + let _canSeePastExtensionMethod = ToGetExtensionMethod.thisModuleWouldClash + [] let ``Single example`` () = let s = diff --git a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs index 1442fde..1d15d9d 100644 --- a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs +++ b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs @@ -6,6 +6,11 @@ open Fantomas.FCS.SyntaxTrivia open Fantomas.FCS.Xml open Myriad.Core +type internal HttpClientGeneratorOutputSpec = + { + ExtensionMethods : bool + } + [] module internal HttpClientGenerator = open Fantomas.FCS.Text.Range @@ -811,7 +816,7 @@ module internal HttpClientGenerator = let createModule (opens : SynOpenDeclTarget list) (ns : LongIdent) - (interfaceType : SynTypeDefn) + (interfaceType : SynTypeDefn, spec : HttpClientGeneratorOutputSpec) : SynModuleOrNamespace = let interfaceType = AstHelper.parseInterface interfaceType @@ -959,7 +964,13 @@ module internal HttpClientGenerator = let members = propertyMembers @ nonPropertyMembers - let docString = PreXmlDoc.Create " Module for constructing a REST client." + let docString = + (if spec.ExtensionMethods then + "Extension methods" + else + "Module") + |> sprintf " %s for constructing a REST client." + |> PreXmlDoc.Create let interfaceImpl = SynExpr.ObjExpr ( @@ -995,38 +1006,38 @@ module internal HttpClientGenerator = " Create a REST client." else " Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties." + |> PreXmlDoc.Create - let createFunc = - SynBinding.SynBinding ( - None, - SynBindingKind.Normal, - false, - false, - [], - PreXmlDoc.Create xmlDoc, - SynValData.SynValData ( - None, - SynValInfo.SynValInfo ( - [ [ SynArgInfo.SynArgInfo ([], false, Some (Ident.Create "client")) ] ], - SynArgInfo.Empty - ), + let functionName = Ident.Create "client" + + let valData = + let memberFlags = + if spec.ExtensionMethods then + { + SynMemberFlags.IsInstance = false + SynMemberFlags.IsDispatchSlot = false + SynMemberFlags.IsOverrideOrExplicitImpl = false + SynMemberFlags.IsFinal = false + SynMemberFlags.GetterOrSetterIsCompilerGenerated = false + SynMemberFlags.MemberKind = SynMemberKind.Member + } + |> Some + else None - ), - SynPat.CreateLongIdent (SynLongIdent.CreateString "make", headerArgs @ [ clientCreationArg ]), - Some ( - SynBindingReturnInfo.Create ( - SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name) - ) - ), - interfaceImpl, - range0, - DebugPointAtBinding.NoneAtLet, - SynExpr.synBindingTriviaZero false - ) - |> List.singleton - |> SynModuleDecl.CreateLet - let moduleName : LongIdent = + SynValData.SynValData ( + memberFlags, + SynValInfo.SynValInfo ([ [ SynArgInfo.SynArgInfo ([], false, Some functionName) ] ], SynArgInfo.Empty), + None + ) + + let pattern = + SynPat.CreateLongIdent (SynLongIdent.CreateString "make", headerArgs @ [ clientCreationArg ]) + + let returnInfo = + SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent interfaceType.Name)) + + let nameWithoutLeadingI = List.last interfaceType.Name |> _.idText |> fun s -> @@ -1034,14 +1045,84 @@ module internal HttpClientGenerator = s.[1..] else failwith $"Expected interface type to start with 'I', but was: %s{s}" - |> Ident.Create - |> List.singleton + + let createFunc = + if spec.ExtensionMethods then + let binding = + SynBinding.SynBinding ( + None, + SynBindingKind.Normal, + false, + false, + [], + xmlDoc, + valData, + pattern, + Some returnInfo, + interfaceImpl, + range0, + DebugPointAtBinding.NoneAtInvisible, + { + LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0) + InlineKeyword = None + EqualsRange = Some range0 + } + ) + + let mem = SynMemberDefn.Member (binding, range0) + + let containingType = + SynTypeDefn.SynTypeDefn ( + SynComponentInfo.Create ( + [ Ident.Create nameWithoutLeadingI ], + xmldoc = PreXmlDoc.Create " Extension methods for HTTP clients" + ), + SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0), + [ mem ], + None, + range0, + { + LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0 + EqualsRange = None + WithKeyword = None + } + ) + + SynModuleDecl.Types ([ containingType ], range0) + + else + SynBinding.SynBinding ( + None, + SynBindingKind.Normal, + false, + false, + [], + xmlDoc, + valData, + pattern, + Some returnInfo, + interfaceImpl, + range0, + DebugPointAtBinding.NoneAtLet, + SynExpr.synBindingTriviaZero false + ) + |> List.singleton + |> SynModuleDecl.CreateLet + + let moduleName : LongIdent = + if spec.ExtensionMethods then + [ Ident.Create (nameWithoutLeadingI + "HttpClientExtension") ] + else + [ Ident.Create nameWithoutLeadingI ] let attribs = - [ - SynAttributeList.Create SynAttribute.compilationRepresentation - SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ()) - ] + if spec.ExtensionMethods then + [ SynAttributeList.Create SynAttribute.autoOpen ] + else + [ + SynAttributeList.Create SynAttribute.compilationRepresentation + SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ()) + ] let modInfo = SynComponentInfo.Create ( @@ -1079,9 +1160,29 @@ type HttpClientGenerator () = let namespaceAndTypes = types |> List.choose (fun (ns, types) -> - match types |> List.filter Ast.hasAttribute with - | [] -> None - | types -> Some (ns, types) + types + |> List.choose (fun typeDef -> + match Ast.getAttribute typeDef with + | None -> None + | Some attr -> + let arg = + match SynExpr.stripOptionalParen attr.ArgExpr with + | SynExpr.Const (SynConst.Bool value, _) -> value + | SynExpr.Const (SynConst.Unit, _) -> JsonParseAttribute.DefaultIsExtensionMethod + | arg -> + failwith + $"Unrecognised argument %+A{arg} to [<%s{nameof HttpClientAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only." + + let spec = + { + ExtensionMethods = arg + } + + Some (typeDef, spec) + ) + |> function + | [] -> None + | ty -> Some (ns, ty) ) let modules =