Express HttpClient as extension method (#140)

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. `[<JsonParseAttribute>]`) into their own assembly, WoofWare.Myriad.Plugins.Attributes.
 The new assembly has minimal dependencies, so you may safely use it from your own code.

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.
+[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
+[<RequireQualifiedAccess>]
+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.
+[<AutoOpen>]
+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))
+            }

ConsumePlugin/Vault.fs

@@ -76,3 +76,33 @@ type IVaultClient =
 
     [<Get "v1/auth/jwt/login">]
     abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse>
+
+[<WoofWare.Myriad.Plugins.HttpClient false>]
+type IVaultClientNonExtensionMethod =
+    [<Get "v1/{mountPoint}/{path}">]
+    abstract GetSecret :
+        jwt : JwtVaultResponse *
+        [<Path "path">] path : string *
+        [<Path "mountPoint">] mountPoint : string *
+        ?ct : CancellationToken ->
+            Task<JwtSecretResponse>
+
+    [<Get "v1/auth/jwt/login">]
+    abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse>
+
+[<WoofWare.Myriad.Plugins.HttpClient(true)>]
+type IVaultClientExtensionMethod =
+    [<Get "v1/{mountPoint}/{path}">]
+    abstract GetSecret :
+        jwt : JwtVaultResponse *
+        [<Path "path">] path : string *
+        [<Path "mountPoint">] mountPoint : string *
+        ?ct : CancellationToken ->
+            Task<JwtSecretResponse>
+
+    [<Get "v1/auth/jwt/login">]
+    abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse>
+
+[<RequireQualifiedAccess>]
+type VaultClientExtensionMethod =
+    static member thisClashes = 99

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.

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

WoofWare.Myriad.Plugins.Attributes/version.json

@@ -1,5 +1,5 @@
 {
-  "version": "3.0",
+  "version": "3.1",
   "publicReleaseRefSpec": [
     "^refs/heads/main$"
   ],

WoofWare.Myriad.Plugins.Test/TestHttpClient/TestVaultClient.fs

@@ -87,8 +87,10 @@ module TestVaultClient =
     }
 }"""
 
-    [<Test>]
+    [<TestCase 1>]
-    let ``URI example`` () =
+    [<TestCase 2>]
+    [<TestCase 3>]
+    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 =
-        let value = api.GetSecret(vaultResponse, "path", "mount").Result
+            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

WoofWare.Myriad.Plugins.Test/TestJsonParse/TestJsonParse.fs

@@ -7,6 +7,8 @@ open FsUnitTyped
 
 [<TestFixture>]
 module TestJsonParse =
+    let _canSeePastExtensionMethod = ToGetExtensionMethod.thisModuleWouldClash
+
     [<Test>]
     let ``Single example`` () =
         let s =

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
+    }
+
 [<RequireQualifiedAccess>]
 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 =
+        let functionName = Ident.Create "client"
-            SynBinding.SynBinding (
+
-                None,
+        let valData =
-                SynBindingKind.Normal,
+            let memberFlags =
-                false,
+                if spec.ExtensionMethods then
-                false,
+                    {
-                [],
+                        SynMemberFlags.IsInstance = false
-                PreXmlDoc.Create xmlDoc,
+                        SynMemberFlags.IsDispatchSlot = false
-                SynValData.SynValData (
+                        SynMemberFlags.IsOverrideOrExplicitImpl = false
-                    None,
+                        SynMemberFlags.IsFinal = false
-                    SynValInfo.SynValInfo (
+                        SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
-                        [ [ SynArgInfo.SynArgInfo ([], false, Some (Ident.Create "client")) ] ],
+                        SynMemberFlags.MemberKind = SynMemberKind.Member
-                        SynArgInfo.Empty
+                    }
-                    ),
+                    |> 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 =
-            [
+            if spec.ExtensionMethods then
-                SynAttributeList.Create SynAttribute.compilationRepresentation
+                [ SynAttributeList.Create SynAttribute.autoOpen ]
-                SynAttributeList.Create (SynAttribute.RequireQualifiedAccess ())
+            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<HttpClientAttribute> with
+                    types
-                    | [] -> None
+                    |> List.choose (fun typeDef ->
-                    | types -> Some (ns, types)
+                        match Ast.getAttribute<HttpClientAttribute> 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 =