Support individual per-method headers (#268)

* Bump fantomas from 6.3.12 to 6.3.15

Bumps [fantomas](https://github.com/fsprojects/fantomas) from 6.3.12 to 6.3.15.
- [Release notes](https://github.com/fsprojects/fantomas/releases)
- [Changelog](https://github.com/fsprojects/fantomas/blob/main/CHANGELOG.md)
- [Commits](https://github.com/fsprojects/fantomas/compare/v6.3.12...v6.3.15)

---
updated-dependencies:
- dependency-name: fantomas
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Bump FsUnit from 6.0.0 to 6.0.1

Bumps [FsUnit](https://github.com/fsprojects/FsUnit) from 6.0.0 to 6.0.1.
- [Release notes](https://github.com/fsprojects/FsUnit/releases)
- [Changelog](https://github.com/fsprojects/FsUnit/blob/master/RELEASE_NOTES.md)
- [Commits](https://github.com/fsprojects/FsUnit/compare/6.0.0...6.0.1)

---
updated-dependencies:
- dependency-name: FsUnit
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Deps

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>

.config/dotnet-tools.json

@@ -3,7 +3,7 @@
   "isRoot": true,
   "tools": {
     "fantomas": {
-      "version": "6.3.12",
+      "version": "6.3.15",
       "commands": [
         "fantomas"
       ]

.github/workflows/dotnet.yaml

@@ -29,7 +29,7 @@ jobs:
       with:
         fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
     - name: Install Nix
-      uses: cachix/install-nix-action@V27
+      uses: cachix/install-nix-action@V28
       with:
         extra_nix_config: |
           access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -50,7 +50,7 @@ jobs:
         with:
           fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
       - name: Install Nix
-        uses: cachix/install-nix-action@V27
+        uses: cachix/install-nix-action@V28
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -67,7 +67,7 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v4
       - name: Install Nix
-        uses: cachix/install-nix-action@V27
+        uses: cachix/install-nix-action@V28
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -82,7 +82,7 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v4
       - name: Install Nix
-        uses: cachix/install-nix-action@V27
+        uses: cachix/install-nix-action@V28
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -97,7 +97,7 @@ jobs:
         with:
           fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
       - name: Install Nix
-        uses: cachix/install-nix-action@V27
+        uses: cachix/install-nix-action@V28
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -116,7 +116,7 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v4
       - name: Install Nix
-        uses: cachix/install-nix-action@V27
+        uses: cachix/install-nix-action@V28
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -129,7 +129,7 @@ jobs:
     steps:
       - uses: actions/checkout@master
       - name: Install Nix
-        uses: cachix/install-nix-action@V27
+        uses: cachix/install-nix-action@V28
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -142,7 +142,7 @@ jobs:
     steps:
       - uses: actions/checkout@master
       - name: Install Nix
-        uses: cachix/install-nix-action@V27
+        uses: cachix/install-nix-action@V28
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -156,7 +156,7 @@ jobs:
       with:
         fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
     - name: Install Nix
-      uses: cachix/install-nix-action@V27
+      uses: cachix/install-nix-action@V28
       with:
         extra_nix_config: |
           access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -276,7 +276,7 @@ jobs:
     steps:
       - uses: actions/checkout@v4
       - name: Install Nix
-        uses: cachix/install-nix-action@V27
+        uses: cachix/install-nix-action@V28
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -309,7 +309,7 @@ jobs:
     steps:
       - uses: actions/checkout@v4
       - name: Install Nix
-        uses: cachix/install-nix-action@V27
+        uses: cachix/install-nix-action@V28
         with:
           extra_nix_config: |
             access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}

ConsumePlugin/GeneratedRestClient.fs

@@ -1557,6 +1557,7 @@ module ApiWithHeaders =
                     do httpMessage.Headers.Add ("X-Foo", this.SomeHeader.ToString ())
                     do httpMessage.Headers.Add ("Authorization", this.SomeOtherHeader.ToString ())
                     do httpMessage.Headers.Add ("Header-Name", "Header-Value")
+                    do httpMessage.Headers.Add ("Something-Else", "val")
                     let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
                     let response = response.EnsureSuccessStatusCode ()
                     let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask

ConsumePlugin/RestApiExample.fs

@@ -188,6 +188,7 @@ type IApiWithHeaders =
     abstract SomeOtherHeader : int
 
     [<Get "endpoint/{param}">]
+    [<Header("Something-Else", "val")>]
     abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
 
 [<WoofWare.Myriad.Plugins.HttpClient>]

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

@@ -52,7 +52,13 @@ module TestVariableHeader =
 
         api.GetPathParam("param").Result.Split "\n"
         |> Array.sort
-        |> shouldEqual [| "Authorization: -99" ; "Header-Name: Header-Value" ; "X-Foo: 11" |]
+        |> shouldEqual
+            [|
+                "Authorization: -99"
+                "Header-Name: Header-Value"
+                "Something-Else: val"
+                "X-Foo: 11"
+            |]
 
         someHeaderCount.Value |> shouldEqual 11
         someOtherHeaderCount.Value |> shouldEqual -99
@@ -98,11 +104,23 @@ module TestVariableHeader =
 
         api.GetPathParam("param").Result.Split "\n"
         |> Array.sort
-        |> shouldEqual [| "Authorization: -99" ; "Header-Name: Header-Value" ; "X-Foo: 11" |]
+        |> shouldEqual
+            [|
+                "Authorization: -99"
+                "Header-Name: Header-Value"
+                "Something-Else: val"
+                "X-Foo: 11"
+            |]
 
         api.GetPathParam("param").Result.Split "\n"
         |> Array.sort
-        |> shouldEqual [| "Authorization: -98" ; "Header-Name: Header-Value" ; "X-Foo: 12" |]
+        |> shouldEqual
+            [|
+                "Authorization: -98"
+                "Header-Name: Header-Value"
+                "Something-Else: val"
+                "X-Foo: 12"
+            |]
 
         someHeaderCount.Value |> shouldEqual 12
         someOtherHeaderCount.Value |> shouldEqual -98

WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj

@@ -41,7 +41,7 @@
   <ItemGroup>
     <PackageReference Include="ApiSurface" Version="4.1.5"/>
     <PackageReference Include="FsCheck" Version="2.16.6"/>
-    <PackageReference Include="FsUnit" Version="6.0.0"/>
+    <PackageReference Include="FsUnit" Version="6.0.1"/>
     <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
     <PackageReference Include="NUnit" Version="4.2.2"/>
     <PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>

WoofWare.Myriad.Plugins/HttpClientGenerator.fs

@@ -1,5 +1,6 @@
 namespace WoofWare.Myriad.Plugins
 
+open System.IO
 open System.Net.Http
 open Fantomas.FCS.Syntax
 
@@ -12,6 +13,17 @@ type internal HttpClientGeneratorOutputSpec =
 module internal HttpClientGenerator =
     open Fantomas.FCS.Text.Range
 
+    let outputFile = FileInfo "/tmp/output.txt"
+
+    // do
+    //     use _ = File.Create outputFile.FullName
+    //     ()
+
+    let log (line : string) =
+        // use w = outputFile.AppendText ()
+        // w.WriteLine line
+        ()
+
     [<RequireQualifiedAccess>]
     type PathSpec =
         | Verbatim of string
@@ -60,6 +72,9 @@ module internal HttpClientGenerator =
             BaseAddress : SynExpr option
             BasePath : SynExpr option
             Accessibility : SynAccess option
+            /// Headers which apply *only* to this endpoint.
+            /// For example, SynConst "Authorization" and SynConst "token BLAH".
+            Headers : (SynExpr * SynExpr) list
         }
 
     let httpMethodString (m : HttpMethod) : string =
@@ -422,14 +437,54 @@ module internal HttpClientGenerator =
                     retType
                     (SynExpr.createIdent "jsonNode")
 
+        let contentTypeHeader, memberHeaders =
+            info.Headers
+            |> List.partition (fun (headerName, headerValue) ->
+                match headerName |> SynExpr.stripOptionalParen with
+                | SynExpr.Const (SynConst.String ("Content-Type", _, _), _) -> true
+                | _ -> false
+            )
+
+        let contentTypeHeader =
+            match contentTypeHeader with
+            | [] -> None
+            | [ _, ct ] -> Some (SynExpr.stripOptionalParen ct)
+            | _ -> failwith "Unexpectedly got multiple Content-Type headers"
+
+        let createStringContent (contents : SynExpr) =
+            SynExpr.createNew
+                (SynType.createLongIdent' [ "System" ; "Net" ; "Http" ; "StringContent" ])
+                (SynExpr.tupleNoParen
+                    [
+                        yield contents
+                        match contentTypeHeader with
+                        | None -> ()
+                        | Some ch ->
+                            yield SynExpr.createNull ()
+                            // Sigh, Gitea in particular passes "json" here
+                            match ch with
+                            | SynExpr.Const (SynConst.String ("json", _, _), _) ->
+                                yield SynExpr.CreateConst "application/json"
+                            | SynExpr.Const (SynConst.String ("html", _, _), _) -> yield SynExpr.CreateConst "text/html"
+                            | _ -> yield ch
+                    ])
+
         let handleBodyParams =
             match bodyParam with
             | None -> []
             | Some (bodyParamType, bodyParamName) ->
                 match bodyParamType with
-                | BodyParamMethods.StreamContent
-                | BodyParamMethods.ByteArrayContent
                 | BodyParamMethods.StringContent ->
+                    [
+                        Let ("queryParams", createStringContent (SynExpr.createIdent' bodyParamName))
+                        Do (
+                            SynExpr.assign
+                                (SynLongIdent.createS' [ "httpMessage" ; "Content" ])
+                                (SynExpr.createIdent "queryParams")
+                        )
+                    ]
+                | BodyParamMethods.StreamContent
+                | BodyParamMethods.ByteArrayContent ->
                     [
                         Let (
                             "queryParams",
@@ -456,22 +511,22 @@ module internal HttpClientGenerator =
                     [
                         Let (
                             "queryParams",
-                            SynExpr.createNew
+                            createStringContent (
-                                (SynType.createLongIdent' [ "System" ; "Net" ; "Http" ; "StringContent" ])
+                                SynExpr.createIdent' bodyParamName
-                                (SynExpr.createIdent' bodyParamName
+                                |> SynExpr.pipeThroughFunction (fst (JsonSerializeGenerator.serializeNode ty))
-                                 |> SynExpr.pipeThroughFunction (fst (JsonSerializeGenerator.serializeNode ty))
+                                |> SynExpr.pipeThroughFunction (
-                                 |> SynExpr.pipeThroughFunction (
+                                    SynExpr.createLambda
-                                     SynExpr.createLambda
+                                        "node"
-                                         "node"
+                                        (SynExpr.ifThenElse
-                                         (SynExpr.ifThenElse
+                                            (SynExpr.applyFunction
-                                             (SynExpr.applyFunction
+                                                (SynExpr.createIdent "isNull")
-                                                 (SynExpr.createIdent "isNull")
+                                                (SynExpr.createIdent "node"))
-                                                 (SynExpr.createIdent "node"))
+                                            (SynExpr.applyFunction
-                                             (SynExpr.applyFunction
+                                                (SynExpr.createLongIdent [ "node" ; "ToJsonString" ])
-                                                 (SynExpr.createLongIdent [ "node" ; "ToJsonString" ])
+                                                (SynExpr.CreateConst ()))
-                                                 (SynExpr.CreateConst ()))
+                                            (SynExpr.CreateConst "null"))
-                                             (SynExpr.CreateConst "null"))
+                                )
-                                 ))
+                            )
                         )
                         Do (
                             SynExpr.assign
@@ -540,6 +595,16 @@ module internal HttpClientGenerator =
                     |> Do
                 )
 
+            let setMemberHeaders =
+                memberHeaders
+                |> List.map (fun (headerName, headerValue) ->
+                    // Best-effort: assume this is a message header.
+                    SynExpr.applyFunction
+                        (SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ])
+                        (SynExpr.tuple [ headerName ; headerValue ])
+                    |> Do
+                )
+
             [
                 yield LetBang ("ct", SynExpr.createLongIdent [ "Async" ; "CancellationToken" ])
                 yield Let ("uri", requestUri)
@@ -555,6 +620,7 @@ module internal HttpClientGenerator =
 
                 yield! setVariableHeaders
                 yield! setConstantHeaders
+                yield! setMemberHeaders
 
                 yield
                     LetBang (
@@ -581,6 +647,9 @@ module internal HttpClientGenerator =
                     yield jsonNode
                 | String -> yield responseString
                 | Stream -> yield responseStream
+                | Unit ->
+                    // What we're returning doesn't depend on the content, so don't bother!
+                    ()
                 | _ ->
                     yield responseStream
                     yield jsonNode
@@ -741,6 +810,16 @@ module internal HttpClientGenerator =
             |> List.map (fun mem ->
                 let httpMethod, url = extractHttpInformation mem.Attributes
 
+                let specificHeaders =
+                    extractHeaderInformation mem.Attributes
+                    |> List.map (fun l ->
+                        match l with
+                        | [ x ; y ] -> x, y
+                        | _ ->
+                            failwith
+                                $"Expected Header attribute on member %s{mem.Identifier.idText} to have exactly two arguments."
+                    )
+
                 let shouldEnsureSuccess = not (shouldAllowAnyStatusCode mem.Attributes)
 
                 let returnType =
@@ -781,6 +860,7 @@ module internal HttpClientGenerator =
                     BaseAddress = baseAddress
                     BasePath = basePath
                     Accessibility = mem.Accessibility
+                    Headers = specificHeaders
                 }
             )
             |> List.map (constructMember constantHeaders properties)

nix/deps.nix

@@ -8,8 +8,8 @@
   })
   (fetchNuGet {
     pname = "fantomas";
-    version = "6.3.12";
+    version = "6.3.15";
-    hash = "sha256-LFZn2cO72FlsmLI0vTLz52Bn4XBeGILTOr8rz/EuXeg=";
+    hash = "sha256-Gjw7MxjUNckMWSfnOye4UTe5fZWnor6RHCls3PNsuG8=";
   })
   (fetchNuGet {
     pname = "Fantomas.Core";
@@ -48,8 +48,8 @@
   })
   (fetchNuGet {
     pname = "FsUnit";
-    version = "6.0.0";
+    version = "6.0.1";
-    hash = "sha256-q87WQf6MqGhzvaQ7WkkUlCdoE94DY0CD5PaXEj64A6M=";
+    hash = "sha256-vka/aAgWhDCl5tu+kgO7GtSaHOOvlSaWxG+tExwGXpI=";
   })
   (fetchNuGet {
     pname = "Microsoft.AspNetCore.App.Ref";