patrick/WoofWare.Whippet
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Whippet synced 2025-10-05 15:58:39 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Add HttpClient generator (#12)

Browse Source
This commit is contained in:
Patrick Stevens
2024-10-07 19:44:11 +01:00
committed by GitHub
parent da609db2ce
commit 9b7a27f2de
41 changed files with 7187 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
.github/workflows/dotnet.yaml vendored
View File

@@ -180,6 +180,16 @@ jobs:
with:
name: nuget-package-argparser
path: Plugins/ArgParser/WoofWare.Whippet.Plugin.ArgParser/bin/Release/WoofWare.Whippet.Plugin.ArgParser.*.nupkg
- name: Upload NuGet artifact (httpclient attrs)
uses: actions/upload-artifact@v4
with:
name: nuget-package-httpclient-attrs
path: Plugins/ArgParser/WoofWare.Whippet.Plugin.HttpClient.Attributes/bin/Release/WoofWare.Whippet.Plugin.HttpClient.*.nupkg
- name: Upload NuGet artifact (httpclient plugin)
uses: actions/upload-artifact@v4
with:
name: nuget-package-httpclient
path: Plugins/ArgParser/WoofWare.Whippet.Plugin.HttpClient/bin/Release/WoofWare.Whippet.Plugin.HttpClient.*.nupkg
expected-pack:
needs: [nuget-pack]
@@ -473,3 +483,69 @@ jobs:
nuget-key: ${{ secrets.NUGET_API_KEY }}
nupkg-dir: packed/
dotnet: ${{ steps.dotnet-identify.outputs.dotnet }}
nuget-publish-httpclient-plugin:
runs-on: ubuntu-latest
if: ${{ !github.event.repository.fork && github.ref == 'refs/heads/main' }}
needs: [all-required-checks-complete]
environment: main-deploy
permissions:
id-token: write
attestations: write
contents: read
steps:
- uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v29
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Download NuGet artifact
uses: actions/download-artifact@v4
with:
name: nuget-package-httpclient
path: packed
- name: Identify `dotnet`
id: dotnet-identify
run: nix develop --command bash -c 'echo "dotnet=$(which dotnet)" >> $GITHUB_OUTPUT'
- name: Publish to NuGet
id: publish-success
uses: G-Research/common-actions/publish-nuget@2b7dc49cb14f3344fbe6019c14a31165e258c059
with:
package-name: WoofWare.Whippet.Plugin.HttpClient
nuget-key: ${{ secrets.NUGET_API_KEY }}
nupkg-dir: packed/
dotnet: ${{ steps.dotnet-identify.outputs.dotnet }}
nuget-publish-httpclient-attrs:
runs-on: ubuntu-latest
if: ${{ !github.event.repository.fork && github.ref == 'refs/heads/main' }}
needs: [all-required-checks-complete]
environment: main-deploy
permissions:
id-token: write
attestations: write
contents: read
steps:
- uses: actions/checkout@v4
- name: Install Nix
uses: cachix/install-nix-action@v29
with:
extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
- name: Download NuGet artifact
uses: actions/download-artifact@v4
with:
name: nuget-package-httpclient-attrs
path: packed
- name: Identify `dotnet`
id: dotnet-identify
run: nix develop --command bash -c 'echo "dotnet=$(which dotnet)" >> $GITHUB_OUTPUT'
- name: Publish to NuGet
id: publish-success
uses: G-Research/common-actions/publish-nuget@2b7dc49cb14f3344fbe6019c14a31165e258c059
with:
package-name: WoofWare.Whippet.Plugin.HttpClient.Attributes
nuget-key: ${{ secrets.NUGET_API_KEY }}
nupkg-dir: packed/
dotnet: ${{ steps.dotnet-identify.outputs.dotnet }}

2
Plugins/ArgParser/WoofWare.Whippet.Plugin.ArgParser/WoofWare.Whippet.Plugin.ArgParser.fsproj
View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<TargetFramework>netstandard2.1</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<Authors>Patrick Stevens</Authors>
<Copyright>Copyright (c) Patrick Stevens 2024</Copyright>

16
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Attributes/Attributes.fs Normal file
View File

@@ -0,0 +1,16 @@
namespace WoofWare.Whippet.Plugin.HttpClient
/// Attribute indicating a record type to which the "create HTTP client" Whippet
/// 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.
///
/// If you supply isExtensionMethod = false, you will get a genuine module (which can
/// be consumed from C#) rather than extension methods.
type HttpClientAttribute (isExtensionMethod : bool) =
inherit System.Attribute ()
/// The default value of `isExtensionMethod`, the optional argument to the HttpClientAttribute constructor.
static member DefaultIsExtensionMethod = true
/// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details.
new () = HttpClientAttribute HttpClientAttribute.DefaultIsExtensionMethod

6
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Attributes/README.md Normal file
View File

@@ -0,0 +1,6 @@
# WoofWare.Whippet.Plugin.HttpClient.Attributes
This is a very slim runtime dependency which consumers of WoofWare.Whippet.Plugin.HttpClient may optionally take.
This dependency contains attributes which control that source generator,
although you may instead omit this dependency and control the generator entirely through configuration in consumer's `.fsproj`.
Please see WoofWare.Whippet.Plugin.HttpClient's README for further information.

88
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Attributes/RestEase.fs Normal file
View File

@@ -0,0 +1,88 @@
namespace WoofWare.Whippet.Plugin.HttpClient
open System
/// Module containing duplicates of the supported RestEase attributes, in case you don't want
/// to take a dependency on RestEase.
module RestEase =
/// Indicates that a method represents an HTTP Get query to the specified endpoint.
type GetAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Post query to the specified endpoint.
type PostAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Delete query to the specified endpoint.
type DeleteAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Head query to the specified endpoint.
type HeadAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Options query to the specified endpoint.
type OptionsAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Put query to the specified endpoint.
type PutAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Patch query to the specified endpoint.
type PatchAttribute (path : string) =
inherit Attribute ()
/// Indicates that a method represents an HTTP Trace query to the specified endpoint.
type TraceAttribute (path : string) =
inherit Attribute ()
/// Indicates that this argument to a method is interpolated into the HTTP request at runtime
/// by setting a query parameter (with the given name) to the value of the annotated argument.
type QueryAttribute (paramName : string) =
inherit Attribute ()
new () = QueryAttribute null
/// Indicates that this interface represents a REST client which accesses an API whose paths are
/// all relative to the given address.
///
/// We will essentially unconditionally append a slash to this for you, on the grounds that you probably don't
/// intend the base path *itself* to be an endpoint.
type BaseAddressAttribute (addr : string) =
inherit Attribute ()
/// Indicates that this interface member causes the interface to set a header with the given name,
/// whose value is obtained whenever required by a fresh call to the interface member.
type HeaderAttribute (header : string, value : string option) =
inherit Attribute ()
new (header : string) = HeaderAttribute (header, None)
new (header : string, value : string) = HeaderAttribute (header, Some value)
/// Indicates that this argument to a method is interpolated into the request path at runtime
/// by writing it into the templated string that specifies the HTTP query e.g. in the `[<Get "/foo/{template}">]`.
type PathAttribute (path : string option) =
inherit Attribute ()
new (path : string) = PathAttribute (Some path)
new () = PathAttribute None
/// Indicates that this argument to a method is passed to the remote API by being serialised into the request
/// body.
type BodyAttribute () =
inherit Attribute ()
/// This is interpolated into every URL, between the BaseAddress and the path specified by e.g. [<Get>].
/// Note that if the [<Get>]-specified path starts with a slash, the BasePath is ignored, because then [<Get>]
/// is considered to be relative to the URL root (i.e. the host part of the BaseAddress).
/// Similarly, if the [<BasePath>] starts with a slash, then any path component of the BaseAddress is ignored.
///
/// We will essentially unconditionally append a slash to this for you, on the grounds that you probably don't
/// intend the base path *itself* to be an endpoint.
///
/// Can contain {placeholders}; hopefully your methods define values for those placeholders with [<Path>]
/// attributes!
type BasePathAttribute (path : string) =
inherit Attribute ()
/// Indicates that this REST endpoint may return a non-success status code but we still want to consume its output.
type AllowAnyStatusCodeAttribute () =
inherit Attribute ()

41
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Attributes/SurfaceBaseline.txt Normal file
View File

@@ -0,0 +1,41 @@
WoofWare.Whippet.Plugin.HttpClient.HttpClientAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.HttpClientAttribute..ctor [constructor]: bool
WoofWare.Whippet.Plugin.HttpClient.HttpClientAttribute..ctor [constructor]: unit
WoofWare.Whippet.Plugin.HttpClient.HttpClientAttribute.DefaultIsExtensionMethod [static property]: [read-only] bool
WoofWare.Whippet.Plugin.HttpClient.HttpClientAttribute.get_DefaultIsExtensionMethod [static method]: unit -> bool
WoofWare.Whippet.Plugin.HttpClient.RestEase inherit obj
WoofWare.Whippet.Plugin.HttpClient.RestEase+AllowAnyStatusCodeAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+AllowAnyStatusCodeAttribute..ctor [constructor]: unit
WoofWare.Whippet.Plugin.HttpClient.RestEase+BaseAddressAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+BaseAddressAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+BasePathAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+BasePathAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+BodyAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+BodyAttribute..ctor [constructor]: unit
WoofWare.Whippet.Plugin.HttpClient.RestEase+DeleteAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+DeleteAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+GetAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+GetAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+HeadAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+HeadAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+HeaderAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+HeaderAttribute..ctor [constructor]: (string, string option)
WoofWare.Whippet.Plugin.HttpClient.RestEase+HeaderAttribute..ctor [constructor]: (string, string)
WoofWare.Whippet.Plugin.HttpClient.RestEase+HeaderAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+OptionsAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+OptionsAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+PatchAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+PatchAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+PathAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+PathAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+PathAttribute..ctor [constructor]: string option
WoofWare.Whippet.Plugin.HttpClient.RestEase+PathAttribute..ctor [constructor]: unit
WoofWare.Whippet.Plugin.HttpClient.RestEase+PostAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+PostAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+PutAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+PutAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+QueryAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+QueryAttribute..ctor [constructor]: string
WoofWare.Whippet.Plugin.HttpClient.RestEase+QueryAttribute..ctor [constructor]: unit
WoofWare.Whippet.Plugin.HttpClient.RestEase+TraceAttribute inherit System.Attribute
WoofWare.Whippet.Plugin.HttpClient.RestEase+TraceAttribute..ctor [constructor]: string

19
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Attributes/WoofWare.Whippet.Plugin.HttpClient.Attributes.fsproj Normal file
View File

@@ -0,0 +1,19 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<ItemGroup>
<Compile Include="Attributes.fs" />
<Compile Include="RestEase.fs" />
<EmbeddedResource Include="SurfaceBaseline.txt" />
<EmbeddedResource Include="version.json" />
<Content Include="README.md" />
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="4.3.4" />
</ItemGroup>
</Project>

11
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Attributes/version.json Normal file
View File

@@ -0,0 +1,11 @@
{
"version": "0.1",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],
"pathFilters": [
"./",
":/global.json",
":/Directory.Build.props"
]
}

5
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/AssemblyInfo.fs Normal file
View File

@@ -0,0 +1,5 @@
namespace ConsumePlugin.AssemblyInfo
[<assembly : System.Runtime.CompilerServices.InternalsVisibleTo("WoofWare.Whippet.Plugin.HttpClient.Test")>]
do ()

1116
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/GeneratedPureGymDto.fs Normal file
View File

File diff suppressed because it is too large Load Diff

1669
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/GeneratedRestClient.fs Normal file
View File

File diff suppressed because it is too large Load Diff

291
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/GeneratedVault.fs Normal file
View File

@@ -0,0 +1,291 @@
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open WoofWare.Whippet.Plugin.Json
open WoofWare.Whippet.Plugin.HttpClient
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix) ; RequireQualifiedAccess>]
module VaultClient =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IVaultClient =
{ new IVaultClient 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.Uri.EscapeDataString)
.Replace ("{mountPoint}", mountPoint.ToString () |> System.Uri.EscapeDataString),
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 WoofWare.Whippet.Plugin.Json
open WoofWare.Whippet.Plugin.HttpClient
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.Uri.EscapeDataString)
.Replace ("{mountPoint}", mountPoint.ToString () |> System.Uri.EscapeDataString),
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 WoofWare.Whippet.Plugin.Json
open WoofWare.Whippet.Plugin.HttpClient
open RestEase
/// Extension methods for constructing a REST client.
[<AutoOpen>]
module VaultClientExtensionMethodHttpClientExtension =
/// Extension methods for HTTP clients
type IVaultClientExtensionMethod 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.Uri.EscapeDataString)
.Replace ("{mountPoint}", mountPoint.ToString () |> System.Uri.EscapeDataString),
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))
}

445
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/GeneratedVaultDto.fs Normal file
View File

@@ -0,0 +1,445 @@
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the JwtVaultAuthResponse type
[<AutoOpen>]
module JwtVaultAuthResponseJsonParseExtension =
/// Extension methods for JSON parsing
type JwtVaultAuthResponse with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse =
let arg_10 =
(match node.["num_uses"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("num_uses")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
let arg_9 =
(match node.["orphan"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("orphan")
)
)
| v -> v)
.AsValue()
.GetValue<System.Boolean> ()
let arg_8 =
(match node.["entity_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("entity_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
let arg_7 =
(match node.["token_type"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_type")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
let arg_6 =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<System.Boolean> ()
let arg_5 =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
let arg_4 =
(match node.["identity_policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("identity_policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ())
|> List.ofSeq
let arg_3 =
(match node.["token_policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ())
|> List.ofSeq
let arg_2 =
(match node.["policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<System.String> ())
|> List.ofSeq
let arg_1 =
(match node.["accessor"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("accessor")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
let arg_0 =
(match node.["client_token"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("client_token")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
{
ClientToken = arg_0
Accessor = arg_1
Policies = arg_2
TokenPolicies = arg_3
IdentityPolicies = arg_4
LeaseDuration = arg_5
Renewable = arg_6
TokenType = arg_7
EntityId = arg_8
Orphan = arg_9
NumUses = arg_10
}
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the JwtVaultResponse type
[<AutoOpen>]
module JwtVaultResponseJsonParseExtension =
/// Extension methods for JSON parsing
type JwtVaultResponse with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse =
let arg_4 =
JwtVaultAuthResponse.jsonParse (
match node.["auth"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("auth")
)
)
| v -> v
)
let arg_3 =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
let arg_2 =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<System.Boolean> ()
let arg_1 =
(match node.["lease_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
let arg_0 =
(match node.["request_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
{
RequestId = arg_0
LeaseId = arg_1
Renewable = arg_2
LeaseDuration = arg_3
Auth = arg_4
}
namespace ConsumePlugin
/// Module containing JSON parsing extension members for the JwtSecretResponse type
[<AutoOpen>]
module JwtSecretResponseJsonParseExtension =
/// Extension methods for JSON parsing
type JwtSecretResponse with
/// Parse from a JSON node.
static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse =
let arg_11 =
(match node.["data8"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data8")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> () |> System.Uri
key, value
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let arg_10 =
(match node.["data7"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data7")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.Int32> ()
key, value
)
|> Map.ofSeq
let arg_9 =
(match node.["data6"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data6")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> dict
let arg_8 =
(match node.["data5"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data5")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> readOnlyDict
let arg_7 =
(match node.["data4"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data4")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> Map.ofSeq
let arg_6 =
(match node.["data3"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data3")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let arg_5 =
(match node.["data2"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data2")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> dict
let arg_4 =
(match node.["data"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<System.String> ()
key, value
)
|> readOnlyDict
let arg_3 =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<System.Int32> ()
let arg_2 =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<System.Boolean> ()
let arg_1 =
(match node.["lease_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
let arg_0 =
(match node.["request_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| v -> v)
.AsValue()
.GetValue<System.String> ()
{
RequestId = arg_0
LeaseId = arg_1
Renewable = arg_2
LeaseDuration = arg_3
Data = arg_4
Data2 = arg_5
Data3 = arg_6
Data4 = arg_7
Data5 = arg_8
Data6 = arg_9
Data7 = arg_10
Data8 = arg_11
}

190
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/PureGymDto.fs Normal file
View File

@@ -0,0 +1,190 @@
// Copied from https://gitea.patrickstevens.co.uk/patrick/puregym-unofficial-dotnet/src/commit/2741c5e36cf0bdb203b12b78a8062e25af9d89c7/PureGym/Api.fs
namespace PureGym
open System
open System.Text.Json.Serialization
open WoofWare.Whippet.Plugin.Json
[<JsonParse>]
type GymOpeningHours =
{
IsAlwaysOpen : bool
OpeningHours : string list
}
[<JsonParse>]
type GymAccessOptions =
{
PinAccess : bool
QrCodeAccess : bool
}
[<Measure>]
type measure
[<JsonParse>]
type GymLocation =
{
[<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>]
Longitude : float
[<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>]
Latitude : float<measure>
}
[<JsonParse>]
type GymAddress =
{
[<JsonRequired>]
AddressLine1 : string
AddressLine2 : string option
AddressLine3 : string option
[<JsonRequired>]
Town : string
County : string option
[<JsonRequired>]
Postcode : string
}
[<JsonParse>]
type Gym =
{
[<JsonRequired>]
Name : string
[<JsonRequired>]
Id : int
[<JsonRequired>]
Status : int
[<JsonRequired>]
Address : GymAddress
[<JsonRequired>]
PhoneNumber : string
[<JsonRequired>]
EmailAddress : string
[<JsonRequired>]
GymOpeningHours : GymOpeningHours
[<JsonRequired>]
AccessOptions : GymAccessOptions
[<JsonRequired>]
Location : GymLocation
[<JsonRequired>]
TimeZone : string
ReopenDate : string
}
[<JsonParse true>]
[<JsonSerialize true>]
type Member =
{
Id : int
CompoundMemberId : string
FirstName : string
LastName : string
HomeGymId : int
HomeGymName : string
EmailAddress : string
GymAccessPin : string
[<JsonPropertyName "dateofBirth">]
DateOfBirth : DateOnly
MobileNumber : string
[<JsonPropertyName "postCode">]
Postcode : string
MembershipName : string
MembershipLevel : int
SuspendedReason : int
MemberStatus : int
}
[<JsonParse>]
type GymAttendance =
{
[<JsonRequired>]
Description : string
[<JsonRequired>]
TotalPeopleInGym : int
[<JsonRequired>]
TotalPeopleInClasses : int
TotalPeopleSuffix : string option
[<JsonRequired>]
IsApproximate : bool
AttendanceTime : DateTime
LastRefreshed : DateTime
LastRefreshedPeopleInClasses : DateTime
MaximumCapacity : int
}
[<JsonParse>]
type MemberActivityDto =
{
[<JsonRequired>]
TotalDuration : int
[<JsonRequired>]
AverageDuration : int
[<JsonRequired>]
TotalVisits : int
[<JsonRequired>]
TotalClasses : int
[<JsonRequired>]
IsEstimated : bool
[<JsonRequired>]
LastRefreshed : DateTime
}
[<JsonParse>]
type SessionsAggregate =
{
[<JsonPropertyName "Activities">]
Activities : int
[<JsonPropertyName "Visits">]
Visits : int
[<JsonPropertyName "Duration">]
Duration : int
}
[<JsonParse>]
type VisitGym =
{
[<JsonPropertyName "Id">]
Id : int
[<JsonPropertyName "Name">]
Name : string
[<JsonPropertyName "Status">]
Status : string
}
[<JsonParse>]
type Visit =
{
[<JsonPropertyName "IsDurationEstimated">]
IsDurationEstimated : bool
[<JsonPropertyName "StartTime">]
StartTime : DateTime
[<JsonPropertyName "Duration">]
Duration : int
[<JsonPropertyName "Gym">]
Gym : VisitGym
}
[<JsonParse>]
type SessionsSummary =
{
[<JsonPropertyName "Total">]
Total : SessionsAggregate
[<JsonPropertyName "ThisWeek">]
ThisWeek : SessionsAggregate
}
[<JsonParse>]
type Sessions =
{
[<JsonPropertyName "Summary">]
Summary : SessionsSummary
[<JsonPropertyName "Visits">]
Visits : Visit list
}
[<JsonParse>]
type UriThing =
{
SomeUri : Uri
}

205
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/RestApiExample.fs Normal file
View File

@@ -0,0 +1,205 @@
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open WoofWare.Whippet.Plugin.HttpClient
open RestEase
[<HttpClient false>]
[<BaseAddress "https://whatnot.com">]
type IPureGymApi =
[<Get("v1/gyms/")>]
abstract GetGyms : ?ct : CancellationToken -> Task<Gym list>
[<Get "v1/gyms/{gym_id}/attendance">]
abstract GetGymAttendance : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<GymAttendance>
[<Get "v1/gyms/{gym_id}/attendance">]
abstract GetGymAttendance' : [<Path("gym_id")>] gymId : int * ?ct : CancellationToken -> Task<GymAttendance>
[<RestEase.GetAttribute "v1/member">]
abstract GetMember : ?ct : CancellationToken -> Member Task
[<RestEase.Get "v1/gyms/{gym}">]
abstract GetGym : [<Path>] gym : int * ?ct : CancellationToken -> Task<Gym>
[<GetAttribute "v1/member/activity">]
abstract GetMemberActivity : ?ct : CancellationToken -> Task<MemberActivityDto>
[<Get "some/url">]
abstract GetUrl : ?ct : CancellationToken -> Task<UriThing>
[<Post "some/url">]
abstract PostStringToString :
[<Body>] foo : Map<string, string> option * ?ct : CancellationToken -> Task<Map<string, string> option>
// We'll use this one to check handling of absolute URIs too
[<Get "/v2/gymSessions/member">]
abstract GetSessions :
[<Query>] fromDate : DateOnly * [<Query>] toDate : DateOnly * ?ct : CancellationToken -> Task<Sessions>
[<Get "/v2/gymSessions/member?foo=1">]
abstract GetSessionsWithQuery :
[<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 CreateUserSerialisedBody : [<Body>] user : PureGym.Member * ?ct : CancellationToken -> Task<string>
[<Post "users/new">]
abstract CreateUserSerialisedUrlBody : [<Body>] user : Uri * ?ct : CancellationToken -> Task<string>
[<Post "users/new">]
abstract CreateUserSerialisedIntBody : [<Body>] user : int * ?ct : CancellationToken -> Task<string>
[<Post "users/new">]
abstract CreateUserHttpContent :
[<Body>] user : System.Net.Http.HttpContent * ?ct : CancellationToken -> Task<string>
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<Get "endpoint">]
abstract GetStream : ?ct : CancellationToken -> Task<System.IO.Stream>
[<Get "endpoint">]
abstract GetStream' : ?ct : CancellationToken -> Task<IO.Stream>
[<Get "endpoint">]
abstract GetStream'' : ?ct : CancellationToken -> Task<Stream>
[<Get "endpoint">]
abstract GetResponseMessage : ?ct : CancellationToken -> Task<System.Net.Http.HttpResponseMessage>
[<Get "endpoint">]
abstract GetResponseMessage' : ?ct : CancellationToken -> Task<Net.Http.HttpResponseMessage>
[<Get "endpoint">]
abstract GetResponseMessage'' : ?ct : CancellationToken -> Task<Http.HttpResponseMessage>
[<Get "endpoint">]
abstract GetResponseMessage''' : ?ct : CancellationToken -> Task<HttpResponseMessage>
[<Get "endpoint">]
abstract GetResponse : ?ct : CancellationToken -> Task<Response<MemberActivityDto>>
[<Get "endpoint">]
abstract GetResponse' : ?ct : CancellationToken -> Task<RestEase.Response<MemberActivityDto>>
[<Get "endpoint">]
abstract GetResponse'' : ?ct : CancellationToken -> Task<MemberActivityDto Response>
[<Get "endpoint">]
abstract GetResponse''' : ?ct : CancellationToken -> Task<MemberActivityDto RestEase.Response>
[<Get "endpoint">]
[<AllowAnyStatusCode>]
abstract GetWithAnyReturnCode : ?ct : CancellationToken -> Task<HttpResponseMessage>
[<Get "endpoint">]
abstract GetWithoutAnyReturnCode : ?ct : CancellationToken -> Task<HttpResponseMessage>
[<HttpClient>]
type internal IApiWithoutBaseAddress =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<HttpClient>]
[<BasePath "foo">]
type IApiWithBasePath =
// Example where we use the bundled attributes rather than RestEase's
[<WoofWare.Whippet.Plugin.HttpClient.RestEase.Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<HttpClient>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "foo">]
type IApiWithBasePathAndAddress =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<HttpClient>]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePath =
// Example where we use the bundled attributes rather than RestEase's
[<WoofWare.Whippet.Plugin.HttpClient.RestEase.Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<HttpClient>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePathAndAddress =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<HttpClient>]
[<BasePath "foo">]
type IApiWithBasePathAndAbsoluteEndpoint =
// Example where we use the bundled attributes rather than RestEase's
[<WoofWare.Whippet.Plugin.HttpClient.RestEase.Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<HttpClient>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "foo">]
type IApiWithBasePathAndAddressAndAbsoluteEndpoint =
[<Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<HttpClient>]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePathAndAbsoluteEndpoint =
// Example where we use the bundled attributes rather than RestEase's
[<WoofWare.Whippet.Plugin.HttpClient.RestEase.Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?cancellationToken : CancellationToken -> Task<string>
[<HttpClient>]
[<BaseAddress "https://whatnot.com/thing">]
[<BasePath "/foo">]
type IApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint =
[<Get "/endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<HttpClient>]
[<Header("Header-Name", "Header-Value")>]
type IApiWithHeaders =
[<Header "X-Foo">]
abstract SomeHeader : string
[<Header "Authorization">]
abstract SomeOtherHeader : int
[<Get "endpoint/{param}">]
[<Header("Something-Else", "val")>]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<HttpClient>]
[<Header("Header-Name", "Header-Value")>]
type IApiWithHeaders2 =
[<Header "X-Foo">]
abstract SomeHeader : string
[<Header "Authorization">]
abstract SomeOtherHeader : int
[<Get "endpoint/{param}">]
abstract GetPathParam : [<RestEase.Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>

53
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/Vault.fs Normal file
View File

@@ -0,0 +1,53 @@
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open WoofWare.Whippet.Plugin.Json
open WoofWare.Whippet.Plugin.HttpClient
open RestEase
[<HttpClient false>]
type IVaultClient =
[<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>
[<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>
[<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

64
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/VaultDto.fs Normal file
View File

@@ -0,0 +1,64 @@
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open WoofWare.Whippet.Plugin.Json
open WoofWare.Whippet.Plugin.HttpClient
[<JsonParse>]
type JwtVaultAuthResponse =
{
[<JsonPropertyName "client_token">]
ClientToken : string
Accessor : string
Policies : string list
[<JsonPropertyName "token_policies">]
TokenPolicies : string list
[<JsonPropertyName "identity_policies">]
IdentityPolicies : string list
[<JsonPropertyName "lease_duration">]
LeaseDuration : int
Renewable : bool
[<JsonPropertyName "token_type">]
TokenType : string
[<JsonPropertyName "entity_id">]
EntityId : string
Orphan : bool
[<JsonPropertyName "num_uses">]
NumUses : int
}
[<JsonParse>]
type JwtVaultResponse =
{
[<JsonPropertyName "request_id">]
RequestId : string
[<JsonPropertyName "lease_id">]
LeaseId : string
Renewable : bool
[<JsonPropertyName "lease_duration">]
LeaseDuration : int
Auth : JwtVaultAuthResponse
}
[<JsonParse>]
type JwtSecretResponse =
{
[<JsonPropertyName "request_id">]
RequestId : string
[<JsonPropertyName "lease_id">]
LeaseId : string
Renewable : bool
[<JsonPropertyName "lease_duration">]
LeaseDuration : int
Data : IReadOnlyDictionary<string, string>
// These ones aren't actually part of the Vault response, but are here for tests
Data2 : IDictionary<string, string>
Data3 : Dictionary<string, string>
Data4 : Map<string, string>
Data5 : IReadOnlyDictionary<System.Uri, string>
Data6 : IDictionary<Uri, string>
Data7 : Map<string, int>
Data8 : Dictionary<string, Uri>
}

42
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient.Consumer/WoofWare.Whippet.Plugin.HttpClient.Consumer.fsproj Normal file
View File

@@ -0,0 +1,42 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<IsPackable>false</IsPackable>
</PropertyGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.fs" />
<Compile Include="PureGymDto.fs" />
<Compile Include="GeneratedPureGymDto.fs">
<WhippetFile>PureGymDto.fs</WhippetFile>
</Compile>
<Compile Include="RestApiExample.fs"/>
<Compile Include="GeneratedRestClient.fs">
<WhippetFile>RestApiExample.fs</WhippetFile>
</Compile>
<Compile Include="VaultDto.fs" />
<Compile Include="GeneratedVaultDto.fs">
<WhippetFile>VaultDto.fs</WhippetFile>
</Compile>
<Compile Include="Vault.fs" />
<Compile Include="GeneratedVault.fs">
<WhippetFile>Vault.fs</WhippetFile>
</Compile>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\Json\WoofWare.Whippet.Plugin.Json.Attributes\WoofWare.Whippet.Plugin.Json.Attributes.fsproj" />
<ProjectReference Include="..\WoofWare.Whippet.Plugin.HttpClient.Attributes\WoofWare.Whippet.Plugin.HttpClient.Attributes.fsproj" />
<ProjectReference Include="..\WoofWare.Whippet.Plugin.HttpClient\WoofWare.Whippet.Plugin.HttpClient.fsproj" WhippetPlugin="true" />
<ProjectReference Include="..\..\Json\WoofWare.Whippet.Plugin.Json\WoofWare.Whippet.Plugin.Json.fsproj" WhippetPlugin="true" />
<!-- Dance to get a binary dependency on a locally-built Whippet -->
<PackageReference Include="WoofWare.Whippet" Version="*-*" PrivateAssets="all" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="RestEase" Version="1.6.4" />
</ItemGroup>
</Project>

11
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/DesiredGenerator.fs Normal file
View File

@@ -0,0 +1,11 @@
namespace WoofWare.Whippet.Plugin.HttpClient
type internal DesiredGenerator =
| HttpClient of extensionMethod : bool option
static member Parse (s : string) =
match s with
| "HttpClient" -> DesiredGenerator.HttpClient None
| "HttpClient(true)" -> DesiredGenerator.HttpClient (Some true)
| "HttpClient(false)" -> DesiredGenerator.HttpClient (Some false)
| _ -> failwith $"Failed to parse as a generator specification: %s{s}"

1008
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/HttpClientGenerator.fs Normal file
View File

File diff suppressed because it is too large Load Diff

130
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/README.md Normal file
View File

@@ -0,0 +1,130 @@
# WoofWare.Whippet.Plugin.HttpClient
This is a [Whippet](https://github.com/Smaug123/WoofWare.Whippet) plugin for defining [RestEase](https://github.com/canton7/RestEase)-style HTTP clients.
It is a copy of the corresponding [Myriad](https://github.com/MoiraeSoftware/myriad) HttpClient plugin in [WoofWare.Myriad](https://github.com/Smaug123/WoofWare.Myriad), taken from commit d59ebdfccb87a06579fb99008a15f58ea8be394e.
## Usage
Define a file like `Client.fs`:
```fsharp
open System.Threading.Tasks
open WoofWare.Whippet.Plugin.HttpClient
[<HttpClient>]
type IPureGymApi =
[<Get "v1/gyms/">]
abstract GetGyms : ?ct : CancellationToken -> Task<Gym list>
[<Get "v1/gyms/{gym_id}/attendance">]
abstract GetGymAttendance : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<GymAttendance>
[<Get "v1/member">]
abstract GetMember : ?ct : CancellationToken -> Task<Member>
[<Get "v1/gyms/{gym_id}">]
abstract GetGym : [<Path "gym_id">] gymId : int * ?ct : CancellationToken -> Task<Gym>
[<Get "v1/member/activity">]
abstract GetMemberActivity : ?ct : CancellationToken -> Task<MemberActivityDto>
[<Get "v2/gymSessions/member">]
abstract GetSessions :
[<Query>] fromDate : DateTime * [<Query>] toDate : DateTime * ?ct : CancellationToken -> Task<Sessions>
```
In your fsproj:
```xml
<Project>
<ItemGroup>
<Compile Include="Client.fs" />
<Compile Include="GeneratedClient.fs">
<WhippetFile>Client.fs</WhippetFile>
</Compile>
</ItemGroup>
<ItemGroup>
<!-- Optional runtime dependency: you may use attributes to give instructions to the generator.
Specify the `Version` appropriately by getting the latest version from NuGet.org.
You may instead wish to take a dependency on RestEase to get the attributes;
and if you want to use RestEase's types like `Response` then you *must* do so.
-->
<PackageReference Include="WoofWare.Whippet.Plugin.HttpClient.Attributes" Version="" />
<!-- Development dependencies, hence PrivateAssets="all". Note `WhippetPlugin="true"`. -->
<PackageReference Include="WoofWare.Whippet.Plugin.HttpClient" WhippetPlugin="true" Version="" />
<PackageReference Include="WoofWare.Whippet" Version="" PrivateAssets="all" />
</ItemGroup>
</Project>
```
The generator produces a type like this (here I'm showing the `isExtensionMethod = false` version):
```fsharp
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
module PureGymApi =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IPureGymApi =
{ new IPureGymApi with
member _.GetGyms (ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = System.Uri (client.BaseAddress.ToString () + "v1/gyms/")
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! node =
System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
|> Async.AwaitTask
return node.AsArray () |> Seq.map (fun elt -> Gym.jsonParse elt) |> List.ofSeq
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
// (more methods here)
}
```
You tell the generator to generate a client using the `[<HttpClient>]` attribute.
You may instead choose to define an attribute with the correct name yourself (if you don't want to take a dependency on the `WoofWare.Whippet.Plugin.RestEase.Attributes` package),
and use the RestEase attributes directly from RestEase by taking a dependency on RestEase.
Alternatively, you may omit the `[<HttpClient>]` attribute entirely, and control the generator through the fsproj file:
```xml
<Project>
<ItemGroup>
<Compile Include="Client.fs" />
<Compile Include="GeneratedClient.fs">
<WhippetFile>Client.fs</WhippetFile>
<WhippetParamClientType1>HttpClient</WhippetParamClientType1>
<WhippetParamClientType2>HttpClient(false)</WhippetParamClientType2>
</Compile>
</ItemGroup>
<ItemGroup>
<!-- Development dependencies, hence PrivateAssets="all". Note `WhippetPlugin="true"`. -->
<PackageReference Include="WoofWare.Whippet.Plugin.HttpClient" WhippetPlugin="true" Version="" />
<PackageReference Include="WoofWare.Whippet" Version="" PrivateAssets="all" />
</ItemGroup>
</Project>
```
(This plugin follows a standard convention taken by `WoofWare.Whippet.Plugin` plugins,
where you use Whippet parameters with the same name as each input type,
whose contents are a `!`-delimited list of the generators which you wish to apply to that input type.)
## Notes
* The plugin assumes access to the `WoofWare.Whippet.Plugin.Json` generators in some situations. If you find the result does not compile due to the lack of `.jsonParse` methods, you might want to generate them using that plugin.
* Supply the optional boolean arg `false` to the `[<HttpClient>]` attribute, or pass it via `<WhippetParamMyType>HttpClient(false)</WhippetParamMyType>`, to get a genuine module that can be consumed from C# (rather than an extension method).

21
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/HttpClient.fs Normal file
View File

@@ -0,0 +1,21 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open System.Net.Http
/// Simple implementation of an HttpClient.
type HttpClientMock (result : HttpRequestMessage -> Async<HttpResponseMessage>) =
inherit HttpClient ()
override this.SendAsync (message, ct) =
Async.StartAsTask (result message, cancellationToken = ct)
[<RequireQualifiedAccess>]
module HttpClientMock =
let makeNoUri (handler : HttpRequestMessage -> Async<HttpResponseMessage>) =
let result = new HttpClientMock (handler)
result
let make (baseUrl : System.Uri) (handler : HttpRequestMessage -> Async<HttpResponseMessage>) =
let result = makeNoUri handler
result.BaseAddress <- baseUrl
result

264
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/PureGymDtos.fs Normal file
View File

@@ -0,0 +1,264 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open PureGym
open System
[<RequireQualifiedAccess>]
module PureGymDtos =
let gymOpeningHoursCases =
[
"""{"openingHours": [], "isAlwaysOpen": false}""",
{
GymOpeningHours.OpeningHours = []
IsAlwaysOpen = false
}
"""{"openingHours": ["something"], "isAlwaysOpen": false}""",
{
GymOpeningHours.OpeningHours = [ "something" ]
IsAlwaysOpen = false
}
]
let gymAccessOptionsCases =
List.allPairs [ true ; false ] [ true ; false ]
|> List.map (fun (a, b) ->
let s = sprintf """{"pinAccess": %b, "qrCodeAccess": %b}""" a b
s,
{
GymAccessOptions.PinAccess = a
QrCodeAccess = b
}
)
let gymAddressCases =
[
"""{"addressLine1": "", "postCode": "hi", "town": ""}""",
{
GymAddress.AddressLine1 = ""
AddressLine2 = None
AddressLine3 = None
County = None
Postcode = "hi"
Town = ""
}
"""{"addressLine1": "", "addressLine2": null, "postCode": "hi", "town": ""}""",
{
GymAddress.AddressLine1 = ""
AddressLine2 = None
AddressLine3 = None
County = None
Postcode = "hi"
Town = ""
}
]
let gymLocationCases =
[
"""{"latitude": 1.0, "longitude": 3.0}""",
{
GymLocation.Latitude = 1.0<measure>
Longitude = 3.0
}
]
let gymCases =
let ovalJson =
"""{"name":"London Oval","id":19,"status":2,"address":{"addressLine1":"Canterbury Court","addressLine2":"Units 4, 4A, 5 And 5A","addressLine3":"Kennington Park","town":"LONDON","county":null,"postcode":"SW9 6DE"},"phoneNumber":"+44 3444770005","emailAddress":"info.londonoval@puregym.com","staffMembers":null,"gymOpeningHours":{"isAlwaysOpen":true,"openingHours":[]},"reasonsToJoin":null,"accessOptions":{"pinAccess":true,"qrCodeAccess":true},"virtualTourUrl":null,"personalTrainersUrl":null,"webViewUrl":null,"floorPlanUrl":null,"location":{"longitude":"-0.110252","latitude":"51.480401"},"timeZone":"Europe/London","reopenDate":"2021-04-12T00:00:00+01 Europe/London"}"""
let oval =
{
Gym.Name = "London Oval"
Id = 19
Status = 2
Address =
{
AddressLine1 = "Canterbury Court"
AddressLine2 = Some "Units 4, 4A, 5 And 5A"
AddressLine3 = Some "Kennington Park"
Town = "LONDON"
County = None
Postcode = "SW9 6DE"
}
PhoneNumber = "+44 3444770005"
EmailAddress = "info.londonoval@puregym.com"
GymOpeningHours =
{
IsAlwaysOpen = true
OpeningHours = []
}
AccessOptions =
{
PinAccess = true
QrCodeAccess = true
}
Location =
{
Longitude = -0.110252
Latitude = 51.480401<measure>
}
TimeZone = "Europe/London"
ReopenDate = "2021-04-12T00:00:00+01 Europe/London"
}
[ ovalJson, oval ]
let memberCases =
let me =
{
Id = 1234567
CompoundMemberId = "12A123456"
FirstName = "Patrick"
LastName = "Stevens"
HomeGymId = 19
HomeGymName = "London Oval"
EmailAddress = "someone@somewhere"
GymAccessPin = "00000000"
DateOfBirth = DateOnly (1994, 01, 02)
MobileNumber = "+44 1234567"
Postcode = "W1A 1AA"
MembershipName = "Corporate"
MembershipLevel = 12
SuspendedReason = 0
MemberStatus = 2
}
let meJson =
"""{
"id": 1234567,
"compoundMemberId": "12A123456",
"firstName": "Patrick",
"lastName": "Stevens",
"homeGymId": 19,
"homeGymName": "London Oval",
"emailAddress": "someone@somewhere",
"gymAccessPin": "00000000",
"dateofBirth": "1994-01-02",
"mobileNumber": "+44 1234567",
"postCode": "W1A 1AA",
"membershipName": "Corporate",
"membershipLevel": 12,
"suspendedReason": 0,
"memberStatus": 2
}"""
[ meJson, me ]
let gymAttendanceCases =
let json =
"""{
"description": "65",
"totalPeopleInGym": 65,
"totalPeopleInClasses": 2,
"totalPeopleSuffix": null,
"isApproximate": false,
"attendanceTime": "2023-12-27T18:54:09.5101697",
"lastRefreshed": "2023-12-27T18:54:09.5101697Z",
"lastRefreshedPeopleInClasses": "2023-12-27T18:50:26.0782286Z",
"maximumCapacity": 0
}"""
let expected =
{
Description = "65"
TotalPeopleInGym = 65
TotalPeopleInClasses = 2
TotalPeopleSuffix = None
IsApproximate = false
AttendanceTime =
DateTime (2023, 12, 27, 18, 54, 09, 510, 169, DateTimeKind.Utc)
+ TimeSpan.FromTicks 7L
LastRefreshed =
DateTime (2023, 12, 27, 18, 54, 09, 510, 169, DateTimeKind.Utc)
+ TimeSpan.FromTicks 7L
LastRefreshedPeopleInClasses =
DateTime (2023, 12, 27, 18, 50, 26, 078, 228, DateTimeKind.Utc)
+ TimeSpan.FromTicks 6L
MaximumCapacity = 0
}
[ json, expected ]
let memberActivityDtoCases =
let json =
"""{"totalDuration":2217,"averageDuration":48,"totalVisits":46,"totalClasses":0,"isEstimated":false,"lastRefreshed":"2023-12-27T19:00:56.0309892Z"}"""
let value =
{
TotalDuration = 2217
AverageDuration = 48
TotalVisits = 46
TotalClasses = 0
IsEstimated = false
LastRefreshed =
DateTime (2023, 12, 27, 19, 00, 56, 030, 989, DateTimeKind.Utc)
+ TimeSpan.FromTicks 2L
}
[ json, value ]
let sessionsCases =
let json =
"""{
"Summary":{"Total":{"Activities":0,"Visits":10,"Duration":445},"ThisWeek":{"Activities":0,"Visits":0,"Duration":0}},
"Visits":[
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-21T10:12:00","Duration":50,"Name":null},
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-20T12:05:00","Duration":80,"Name":null},
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-17T19:37:00","Duration":46,"Name":null},
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-16T12:19:00","Duration":37,"Name":null},
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-15T11:14:00","Duration":47,"Name":null},
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-13T10:30:00","Duration":36,"Name":null},
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-10T16:18:00","Duration":32,"Name":null},
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-05T22:36:00","Duration":40,"Name":null},
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-03T17:59:00","Duration":48,"Name":null},
{"IsDurationEstimated":false,"Gym":{"Id":19,"Name":"London Oval","Status":"Blocked","Location":null,"GymAccess":null,"ContactInfo":null,"TimeZone":null},"StartTime":"2023-12-01T21:41:00","Duration":29,"Name":null}],
"Activities":[]}
"""
let singleVisit startTime duration =
{
IsDurationEstimated = false
Gym =
{
Id = 19
Name = "London Oval"
Status = "Blocked"
}
StartTime = startTime
Duration = duration
}
let expected =
{
Summary =
{
Total =
{
Activities = 0
Visits = 10
Duration = 445
}
ThisWeek =
{
Activities = 0
Visits = 0
Duration = 0
}
}
Visits =
[
singleVisit (DateTime (2023, 12, 21, 10, 12, 00)) 50
singleVisit (DateTime (2023, 12, 20, 12, 05, 00)) 80
singleVisit (DateTime (2023, 12, 17, 19, 37, 00)) 46
singleVisit (DateTime (2023, 12, 16, 12, 19, 00)) 37
singleVisit (DateTime (2023, 12, 15, 11, 14, 00)) 47
singleVisit (DateTime (2023, 12, 13, 10, 30, 00)) 36
singleVisit (DateTime (2023, 12, 10, 16, 18, 00)) 32
singleVisit (DateTime (2023, 12, 05, 22, 36, 00)) 40
singleVisit (DateTime (2023, 12, 03, 17, 59, 00)) 48
singleVisit (DateTime (2023, 12, 01, 21, 41, 00)) 29
]
}
[ json, expected ]

62
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/TestAllowAnyStatusCode.fs Normal file
View File

@@ -0,0 +1,62 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open System
open System.Net
open System.Net.Http
open NUnit.Framework
open FsUnitTyped
open PureGym
[<TestFixture>]
module TestAllowAnyStatusCode =
[<Test>]
let ``Without AllowAnyStatusCode we throw`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent ("nothing was here :(")
let resp = new HttpResponseMessage (HttpStatusCode.NotFound)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
let exc =
async {
let! message = Async.AwaitTask (api.GetWithoutAnyReturnCode ()) |> Async.Catch
match message with
| Choice1Of2 _ -> return failwith "test failure"
| Choice2Of2 exc -> return exc
}
|> Async.RunSynchronously
let exc =
match exc with
| :? AggregateException as exc -> exc
| exc -> failwith $"Test failure: expected AggregateException, got %+A{exc}"
match exc.InnerException with
| :? HttpRequestException as exc -> exc.Message.Contains "404 (Not Found)" |> shouldEqual true
| e -> failwith $"Test failure: %+A{e}"
[<Test>]
let ``With AllowAnyStatusCode we do not throw`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent ("nothing was here :(")
let resp = new HttpResponseMessage (HttpStatusCode.NotFound)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
let message = api.GetWithAnyReturnCode().Result
message.StatusCode |> shouldEqual HttpStatusCode.NotFound
message.Content.ReadAsStringAsync().Result |> shouldEqual "nothing was here :("

170
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/TestBasePath.fs Normal file
View File

@@ -0,0 +1,170 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open System
open System.Net
open System.Net.Http
open NUnit.Framework
open PureGym
open FsUnitTyped
[<TestFixture>]
module TestBasePath =
let replyWithUrl (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (message.RequestUri.ToString ())
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
[<Test>]
let ``Base address is respected`` () =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = PureGymApi.make client
let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://whatnot.com/endpoint/param"
[<Test>]
let ``Without a base address attr but with BaseAddress on client, request goes through`` () =
use client = HttpClientMock.make (Uri "https://baseaddress.com") replyWithUrl
let api = IApiWithoutBaseAddress.make client
let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://baseaddress.com/endpoint/param"
[<Test>]
let ``Base address on client takes precedence`` () =
use client = HttpClientMock.make (Uri "https://baseaddress.com") replyWithUrl
let api = PureGymApi.make client
let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://baseaddress.com/endpoint/param"
[<Test>]
let ``Without a base address attr or BaseAddress on client, request throws`` () =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = IApiWithoutBaseAddress.make client
let observedExc =
async {
let! result = api.GetPathParam "param" |> Async.AwaitTask |> Async.Catch
match result with
| Choice1Of2 _ -> return failwith "test failure"
| Choice2Of2 exc -> return exc
}
|> Async.RunSynchronously
let observedExc =
match observedExc with
| :? AggregateException as exc ->
match exc.InnerException with
| :? ArgumentNullException as exc -> exc
| _ -> failwith "test failure"
| _ -> failwith "test failure"
observedExc.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
[<Test>]
let ``Relative base path, no base address, relative attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = IApiWithBasePath.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = IApiWithBasePath.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/thing/foo/endpoint/hi"
[<Test>]
let ``Relative base path, base address, relative attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = IApiWithBasePathAndAddress.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/thing/foo/endpoint/hi"
[<Test>]
let ``Absolute base path, no base address, relative attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = IApiWithAbsoluteBasePath.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = IApiWithAbsoluteBasePath.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/foo/endpoint/hi"
[<Test>]
let ``Absolute base path, base address, relative attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = IApiWithAbsoluteBasePathAndAddress.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/foo/endpoint/hi"
[<Test>]
let ``Relative base path, no base address, absolute attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = IApiWithBasePathAndAbsoluteEndpoint.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = IApiWithBasePathAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"
[<Test>]
let ``Relative base path, base address, absolute attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = IApiWithBasePathAndAddressAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"
[<Test>]
let ``Absolute base path, no base address, absolute attribute`` () : unit =
do
use client = HttpClientMock.makeNoUri replyWithUrl
let api = IApiWithAbsoluteBasePathAndAbsoluteEndpoint.make client
let exc =
Assert.Throws<AggregateException> (fun () -> api.GetPathParam("hi").Result |> ignore<string>)
exc.InnerException.Message
|> shouldEqual
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
use client = HttpClientMock.make (Uri "https://whatnot.com/thing/") replyWithUrl
let api = IApiWithAbsoluteBasePathAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"
[<Test>]
let ``Absolute base path, base address, absolute attribute`` () : unit =
use client = HttpClientMock.makeNoUri replyWithUrl
let api = IApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint.make client
let result = api.GetPathParam("hi").Result
result |> shouldEqual "https://whatnot.com/endpoint/hi"

188
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/TestBodyParam.fs Normal file
View File

@@ -0,0 +1,188 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open System
open System.IO
open System.Net
open System.Net.Http
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
[<Test>]
let ``Body param of serialised thing`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
let content = new StringContent ("Done! " + 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 expected =
{
Id = 3
CompoundMemberId = "compound!"
FirstName = "Patrick"
LastName = "Stevens"
HomeGymId = 100
HomeGymName = "Big Boy Gym"
EmailAddress = "woof@ware"
GymAccessPin = "l3tm31n"
// To the reader: what's the significance of this date?
// answer rot13: ghevatpbzchgnovyvglragfpurvqhatfceboyrzcncre
DateOfBirth = DateOnly (1936, 05, 28)
MobileNumber = "+44-GHOST-BUSTERS"
Postcode = "W1A 111"
MembershipName = "mario"
MembershipLevel = 4
SuspendedReason = 1090
MemberStatus = -3
}
let result = api.CreateUserSerialisedBody(expected).Result
result.StartsWith ("Done! ", StringComparison.Ordinal) |> shouldEqual true
let result = result.[6..]
result
|> System.Text.Json.Nodes.JsonNode.Parse
|> PureGym.Member.jsonParse
|> shouldEqual expected
[<Test>]
let ``Body param of primitive: int`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
let content = new StringContent ("Done! " + 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 result = api.CreateUserSerialisedIntBody(3).Result
result |> shouldEqual "Done! 3"
[<Test>]
let ``Body param of primitive: Uri`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
let content = new StringContent ("Done! " + 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 result = api.CreateUserSerialisedUrlBody(Uri "https://mything.com/blah").Result
result |> shouldEqual "Done! \"https://mything.com/blah\""

36
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/TestPathParam.fs Normal file
View File

@@ -0,0 +1,36 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open System
open System.Net
open System.Net.Http
open NUnit.Framework
open FsUnitTyped
open PureGym
[<TestFixture>]
module TestPathParam =
[<Test>]
let ``Path params are escaped`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let expectedUriPrefix = "https://example.com/endpoint/"
let actualUri = message.RequestUri.ToString ()
if not (actualUri.StartsWith (expectedUriPrefix, StringComparison.Ordinal)) then
failwith $"wrong prefix on %s{actualUri}"
let content = new StringContent (actualUri.Substring expectedUriPrefix.Length)
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
api.GetPathParam("hello/world?(hi)").Result
|> shouldEqual "hello%2Fworld%3F%28hi%29"

321
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/TestPureGymRestApi.fs Normal file
View File

@@ -0,0 +1,321 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open System
open System.Net
open System.Net.Http
open NUnit.Framework
open PureGym
open FsUnitTyped
[<TestFixture>]
module TestPureGymRestApi =
// several of these, to check behaviour around treatment of initial slashes
let baseUris =
[
// Everything is relative to the root:
"https://example.com"
// Everything is also relative to the root, because `foo` is not a subdir:
"https://example.com/foo"
// Everything is relative to `foo`, because `foo` is a subdir
"https://example.com/foo/"
]
|> List.map Uri
let gymsCases =
PureGymDtos.gymCases
|> List.collect (fun (json, gym) -> [ $"[%s{json}]", [ gym ] ; $"[%s{json}, %s{json}]", [ gym ; gym ] ])
|> List.allPairs baseUris
|> List.map TestCaseData
[<TestCaseSource(nameof gymsCases)>]
let ``Test GetGyms`` (baseUri : Uri, (json : string, expected : Gym list)) =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
// URI is relative in the attribute on the IPureGymApi member,
// so this never gets redirected
let expectedUri =
match baseUri.ToString () with
| "https://example.com/" -> "https://example.com/v1/gyms/"
| "https://example.com/foo" -> "https://example.com/v1/gyms/"
| "https://example.com/foo/" -> "https://example.com/foo/v1/gyms/"
| s -> failwith $"Unrecognised base URI: %s{s}"
message.RequestUri.ToString () |> shouldEqual expectedUri
let content = new StringContent (json)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make baseUri proc
let api = PureGymApi.make client
api.GetGyms().Result |> shouldEqual expected
let gymAttendanceCases =
PureGymDtos.gymAttendanceCases
|> List.allPairs baseUris
|> List.map TestCaseData
[<TestCaseSource(nameof gymAttendanceCases)>]
let ``Test GetGymAttendance`` (baseUri : Uri, (json : string, expected : GymAttendance)) =
let requestedGym = 3
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
// URI is relative in the attribute on the IPureGymApi member,
// so this never gets redirected
let expectedUri =
match baseUri.ToString () with
| "https://example.com/" -> $"https://example.com/v1/gyms/%i{requestedGym}/attendance"
| "https://example.com/foo" -> $"https://example.com/v1/gyms/%i{requestedGym}/attendance"
| "https://example.com/foo/" -> $"https://example.com/foo/v1/gyms/%i{requestedGym}/attendance"
| s -> failwith $"Unrecognised base URI: %s{s}"
message.RequestUri.ToString () |> shouldEqual expectedUri
let content = new StringContent (json)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make baseUri proc
let api = PureGymApi.make client
api.GetGymAttendance(requestedGym).Result |> shouldEqual expected
api.GetGymAttendance'(requestedGym).Result |> shouldEqual expected
let memberCases =
PureGymDtos.memberCases |> List.allPairs baseUris |> List.map TestCaseData
[<TestCaseSource(nameof memberCases)>]
let ``Test GetMember`` (baseUri : Uri, (json : string, expected : Member)) =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
// URI is relative in the attribute on the IPureGymApi member,
// so this never gets redirected
let expectedUri =
match baseUri.ToString () with
| "https://example.com/" -> "https://example.com/v1/member"
| "https://example.com/foo" -> "https://example.com/v1/member"
| "https://example.com/foo/" -> "https://example.com/foo/v1/member"
| s -> failwith $"Unrecognised base URI: %s{s}"
message.RequestUri.ToString () |> shouldEqual expectedUri
let content = new StringContent (json)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make baseUri proc
let api = PureGymApi.make client
api.GetMember().Result |> shouldEqual expected
let gymCases =
PureGymDtos.gymCases |> List.allPairs baseUris |> List.map TestCaseData
[<TestCaseSource(nameof gymCases)>]
let ``Test GetGym`` (baseUri : Uri, (json : string, expected : Gym)) =
let requestedGym = 3
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
// URI is relative in the attribute on the IPureGymApi member,
// so this never gets redirected
let expectedUri =
match baseUri.ToString () with
| "https://example.com/" -> $"https://example.com/v1/gyms/%i{requestedGym}"
| "https://example.com/foo" -> $"https://example.com/v1/gyms/%i{requestedGym}"
| "https://example.com/foo/" -> $"https://example.com/foo/v1/gyms/%i{requestedGym}"
| s -> failwith $"Unrecognised base URI: %s{s}"
message.RequestUri.ToString () |> shouldEqual expectedUri
let content = new StringContent (json)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make baseUri proc
let api = PureGymApi.make client
api.GetGym(requestedGym).Result |> shouldEqual expected
let memberActivityCases =
PureGymDtos.memberActivityDtoCases
|> List.allPairs baseUris
|> List.map TestCaseData
[<TestCaseSource(nameof memberActivityCases)>]
let ``Test GetMemberActivity`` (baseUri : Uri, (json : string, expected : MemberActivityDto)) =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
// URI is relative in the attribute on the IPureGymApi member,
// so this never gets redirected
let expectedUri =
match baseUri.ToString () with
| "https://example.com/" -> "https://example.com/v1/member/activity"
| "https://example.com/foo" -> "https://example.com/v1/member/activity"
| "https://example.com/foo/" -> "https://example.com/foo/v1/member/activity"
| s -> failwith $"Unrecognised base URI: %s{s}"
message.RequestUri.ToString () |> shouldEqual expectedUri
let content = new StringContent (json)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make baseUri proc
let api = PureGymApi.make client
api.GetMemberActivity().Result |> shouldEqual expected
let dates =
[
for month = 1 to 3 do
// span the number 12, to catch muddling up month and day
for day = 11 to 13 do
yield DateOnly (2023, month, day)
]
let sessionsCases =
PureGymDtos.sessionsCases
|> List.allPairs dates
|> List.allPairs dates
|> List.allPairs baseUris
|> List.map TestCaseData
let inline dateOnlyToString (d : DateOnly) : string =
let month = if d.Month < 10 then $"0%i{d.Month}" else $"%i{d.Month}"
let day = if d.Day < 10 then $"0%i{d.Day}" else $"%i{d.Day}"
$"{d.Year}-{month}-{day}"
[<TestCaseSource(nameof sessionsCases)>]
let ``Test GetSessions``
(baseUri : Uri, (startDate : DateOnly, (endDate : DateOnly, (json : string, expected : Sessions))))
=
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
// This one is specified as being absolute, in its attribute on the IPureGymApi type
let expectedUri =
let fromDate = dateOnlyToString startDate
let toDate = dateOnlyToString endDate
$"https://example.com/v2/gymSessions/member?fromDate=%s{fromDate}&toDate=%s{toDate}"
message.RequestUri.ToString () |> shouldEqual expectedUri
let content = new StringContent (json)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make baseUri proc
let api = PureGymApi.make client
api.GetSessions(startDate, endDate).Result |> shouldEqual expected
[<TestCaseSource(nameof sessionsCases)>]
let ``Test GetSessionsWithQuery``
(baseUri : Uri, (startDate : DateOnly, (endDate : DateOnly, (json : string, expected : Sessions))))
=
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
// This one is specified as being absolute, in its attribute on the IPureGymApi type
let expectedUri =
let fromDate = dateOnlyToString startDate
let toDate = dateOnlyToString endDate
$"https://example.com/v2/gymSessions/member?foo=1&fromDate=%s{fromDate}&toDate=%s{toDate}"
message.RequestUri.ToString () |> shouldEqual expectedUri
let content = new StringContent (json)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make baseUri proc
let api = PureGymApi.make client
api.GetSessionsWithQuery(startDate, endDate).Result |> shouldEqual expected
[<Test>]
let ``URI example`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
message.RequestUri.ToString () |> shouldEqual "https://whatnot.com/some/url"
let content =
new StringContent ("""{"someUri": "https://patrick@en.wikipedia.org/wiki/foo"}""")
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.makeNoUri proc
let api = PureGymApi.make client
let uri = api.GetUrl().Result.SomeUri
uri.ToString () |> shouldEqual "https://patrick@en.wikipedia.org/wiki/foo"
uri.UserInfo |> shouldEqual "patrick"
uri.Host |> shouldEqual "en.wikipedia.org"
[<TestCase false>]
[<TestCase true>]
let ``Map<string, string> option example`` (isSome : bool) =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Post
message.RequestUri.ToString () |> shouldEqual "https://whatnot.com/some/url"
let! content = message.Content.ReadAsStringAsync () |> Async.AwaitTask
if isSome then
content |> shouldEqual """{"hi":"bye"}"""
else
content |> shouldEqual "null"
let content = new StringContent (content)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.makeNoUri proc
let api = PureGymApi.make client
let expected =
if isSome then
[ "hi", "bye" ] |> Map.ofList |> Some
else
None
let actual = api.PostStringToString(expected).Result
actual |> shouldEqual expected

121
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/TestReturnTypes.fs Normal file
View File

@@ -0,0 +1,121 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open System
open System.IO
open System.Net
open FsUnitTyped
open System.Net.Http
open PureGym
open NUnit.Framework
[<TestFixture>]
module TestReturnTypes =
[<Test>]
let ``String return`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent ("this is not a JSON string")
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
api.GetPathParam("hi").Result |> shouldEqual "this is not a JSON string"
[<TestCase "GetStream">]
[<TestCase "GetStream'">]
[<TestCase "GetStream''">]
let ``Stream return`` (case : string) =
let result = [| 1uy ; 2uy ; 3uy ; 4uy |]
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let result = new MemoryStream (result)
let content = new StreamContent (result)
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
use stream =
match case with
| "GetStream" -> api.GetStream().Result
| "GetStream'" -> api.GetStream'().Result
| "GetStream''" -> api.GetStream''().Result
| _ -> failwith $"unrecognised case: %s{case}"
let buf = Array.zeroCreate 10
let written = stream.ReadAtLeast (buf.AsSpan (), 10, false)
Array.take written buf |> shouldEqual result
[<TestCase "GetResponseMessage">]
[<TestCase "GetResponseMessage'">]
[<TestCase "GetResponseMessage''">]
[<TestCase "GetResponseMessage'''">]
let ``HttpResponseMessage return`` (case : string) =
let mutable responseMessage = None
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent ("a response!")
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
responseMessage <- Some resp
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
let message =
match case with
| "GetResponseMessage" -> api.GetResponseMessage().Result
| "GetResponseMessage'" -> api.GetResponseMessage'().Result
| "GetResponseMessage''" -> api.GetResponseMessage''().Result
| "GetResponseMessage'''" -> api.GetResponseMessage'''().Result
| _ -> failwith $"unrecognised case: %s{case}"
Object.ReferenceEquals (message, Option.get responseMessage) |> shouldEqual true
[<TestCase "Task<Response>">]
[<TestCase "Task<RestEase.Response>">]
[<TestCase "RestEase.Response Task">]
[<TestCase "RestEase.Response Task">]
let ``Response return`` (case : string) =
for json, memberDto in PureGymDtos.memberActivityDtoCases do
let mutable responseMessage = None
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let content = new StringContent (json)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
responseMessage <- Some resp
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let api = PureGymApi.make client
let response =
match case with
| "Task<Response>" -> api.GetResponse().Result
| "Task<RestEase.Response>" -> api.GetResponse'().Result
| "Response Task" -> api.GetResponse''().Result
| "RestEase.Response Task" -> api.GetResponse'''().Result
| _ -> failwith $"unrecognised case: %s{case}"
response.ResponseMessage |> shouldEqual (Option.get responseMessage)
response.StringContent |> shouldEqual json
response.GetContent () |> shouldEqual memberDto

26
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/TestSurface.fs Normal file
View File

@@ -0,0 +1,26 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open NUnit.Framework
open WoofWare.Whippet.Plugin.HttpClient
open ApiSurface
[<TestFixture>]
module TestAttributeSurface =
let assembly = typeof<RestEase.BodyAttribute>.Assembly
[<Test>]
let ``Ensure API surface has not been modified`` () = ApiSurface.assertIdentical assembly
(*
[<Test>]
let ``Check version against remote`` () =
MonotonicVersion.validate assembly "WoofWare.Whippet.Plugin.HttpClient.Attributes"
*)
[<Test ; Explicit>]
let ``Update API surface`` () =
ApiSurface.writeAssemblyBaseline assembly
[<Test>]
let ``Ensure public API is fully documented`` () =
DocCoverage.assertFullyDocumented assembly

126
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/TestVariableHeader.fs Normal file
View File

@@ -0,0 +1,126 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open System
open System.Net
open System.Net.Http
open System.Threading
open NUnit.Framework
open FsUnitTyped
open PureGym
[<TestFixture>]
module TestVariableHeader =
[<Test>]
let ``Headers are set`` () : unit =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
message.RequestUri.ToString ()
|> shouldEqual "https://example.com/endpoint/param"
let headers =
[
for h in message.Headers do
yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}"
]
|> String.concat "\n"
let content = new StringContent (headers)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let someHeaderCount = ref 10
let someHeader () =
(Interlocked.Increment someHeaderCount : int).ToString ()
let someOtherHeaderCount = ref -100
let someOtherHeader () =
Interlocked.Increment someOtherHeaderCount
let api = IApiWithHeaders.make someHeader someOtherHeader client
someHeaderCount.Value |> shouldEqual 10
someOtherHeaderCount.Value |> shouldEqual -100
api.GetPathParam("param").Result.Split "\n"
|> Array.sort
|> shouldEqual
[|
"Authorization: -99"
"Header-Name: Header-Value"
"Something-Else: val"
"X-Foo: 11"
|]
someHeaderCount.Value |> shouldEqual 11
someOtherHeaderCount.Value |> shouldEqual -99
[<Test>]
let ``Headers get re-evaluated every time`` () : unit =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
message.RequestUri.ToString ()
|> shouldEqual "https://example.com/endpoint/param"
let headers =
[
for h in message.Headers do
yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}"
]
|> String.concat "\n"
let content = new StringContent (headers)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
}
use client = HttpClientMock.make (Uri "https://example.com") proc
let someHeaderCount = ref 10
let someHeader () =
(Interlocked.Increment someHeaderCount : int).ToString ()
let someOtherHeaderCount = ref -100
let someOtherHeader () =
Interlocked.Increment someOtherHeaderCount
let api = IApiWithHeaders.make someHeader someOtherHeader client
someHeaderCount.Value |> shouldEqual 10
someOtherHeaderCount.Value |> shouldEqual -100
api.GetPathParam("param").Result.Split "\n"
|> Array.sort
|> 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"
"Something-Else: val"
"X-Foo: 12"
|]
someHeaderCount.Value |> shouldEqual 12
someOtherHeaderCount.Value |> shouldEqual -98

189
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/TestVaultClient.fs Normal file
View File

@@ -0,0 +1,189 @@
namespace WoofWare.Whippet.Plugin.HttpClient.Test
open System
open System.Net
open System.Net.Http
open NUnit.Framework
open FsUnitTyped
open ConsumePlugin
[<TestFixture>]
module TestVaultClient =
let exampleVaultKeyResponseString =
"""{
"request_id": "e2470000-0000-0000-0000-000000001f47",
"lease_id": "",
"renewable": false,
"lease_duration": 0,
"data": {
"key1_1": "value1_1",
"key1_2": "value1_2"
},
"data2": {
"key2_1": "value2_1",
"key2_2": "value2_2"
},
"data3": {
"key3_1": "value3_1",
"key3_2": "value3_2"
},
"data4": {
"key4_1": "value4_1",
"key4_2": "value4_2"
},
"data5": {
"https://example.com/data5/1": "value5_1",
"https://example.com/data5/2": "value5_2"
},
"data6": {
"https://example.com/data6/1": "value6_1",
"https://example.com/data6/2": "value6_2"
},
"data7": {
"key7_1": 71,
"key7_2": 72
},
"data8": {
"key8_1": "https://example.com/data8/1",
"key8_2": "https://example.com/data8/2"
}
}"""
let exampleVaultJwtResponseString =
"""{
"request_id": "80000000-0000-0000-0000-00000000000d",
"lease_id": "",
"renewable": false,
"lease_duration": 0,
"data": null,
"wrap_info": null,
"warnings": null,
"auth": {
"client_token": "redacted_client_token",
"accessor": "redacted_accessor",
"policies": [
"policy1",
"default"
],
"identity_policies": [
"identity-policy",
"default-2"
],
"token_policies": [
"token-policy",
"default-3"
],
"metadata": {
"role": "some-role"
},
"lease_duration": 43200,
"renewable": true,
"entity_id": "20000000-0000-0000-0000-000000000007",
"token_type": "service",
"orphan": true,
"mfa_requirement": null,
"num_uses": 0
}
}"""
[<TestCase 1>]
[<TestCase 2>]
[<TestCase 3>]
let ``URI example`` (vaultClientId : int) =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
let requestUri = message.RequestUri.ToString ()
match requestUri with
| "https://my-vault.com/v1/auth/jwt/login" ->
let content = new StringContent (exampleVaultJwtResponseString)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
| "https://my-vault.com/v1/mount/path" ->
let content = new StringContent (exampleVaultKeyResponseString)
let resp = new HttpResponseMessage (HttpStatusCode.OK)
resp.Content <- content
return resp
| _ -> return failwith $"bad URI: %s{requestUri}"
}
use client = HttpClientMock.make (Uri "https://my-vault.com") proc
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 = IVaultClientExtensionMethod.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
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key1_1", "value1_1" ; "key1_2", "value1_2" ]
value.Data2
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key2_1", "value2_1" ; "key2_2", "value2_2" ]
value.Data3
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key3_1", "value3_1" ; "key3_2", "value3_2" ]
value.Data4
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key4_1", "value4_1" ; "key4_2", "value4_2" ]
value.Data5
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> (k : Uri).ToString (), v)
|> shouldEqual
[
"https://example.com/data5/1", "value5_1"
"https://example.com/data5/2", "value5_2"
]
value.Data6
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> (k : Uri).ToString (), v)
|> shouldEqual
[
"https://example.com/data6/1", "value6_1"
"https://example.com/data6/2", "value6_2"
]
value.Data7
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, v)
|> shouldEqual [ "key7_1", 71 ; "key7_2", 72 ]
value.Data8
|> Seq.toList
|> List.map (fun (KeyValue (k, v)) -> k, (v : Uri).ToString ())
|> shouldEqual
[
"key8_1", "https://example.com/data8/1"
"key8_2", "https://example.com/data8/2"
]
let _canSeePastExtensionMethod = VaultClientExtensionMethod.thisClashes

39
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.Test/WoofWare.Whippet.Plugin.HttpClient.Test.fsproj Normal file
View File

@@ -0,0 +1,39 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<IsPackable>false</IsPackable>
<IsTestProject>true</IsTestProject>
</PropertyGroup>
<ItemGroup>
<Compile Include="HttpClient.fs" />
<Compile Include="PureGymDtos.fs" />
<Compile Include="TestPureGymRestApi.fs" />
<Compile Include="TestPathParam.fs" />
<Compile Include="TestReturnTypes.fs" />
<Compile Include="TestAllowAnyStatusCode.fs" />
<Compile Include="TestBasePath.fs" />
<Compile Include="TestBodyParam.fs" />
<Compile Include="TestVaultClient.fs" />
<Compile Include="TestVariableHeader.fs" />
<Compile Include="TestSurface.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="4.1.6" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
<PackageReference Include="NUnit" Version="4.2.2"/>
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
<PackageReference Include="FsUnit" Version="6.0.1"/>
<PackageReference Include="RestEase" Version="1.6.4"/>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\WoofWare.Whippet.Plugin.HttpClient.Attributes\WoofWare.Whippet.Plugin.HttpClient.Attributes.fsproj" />
<ProjectReference Include="..\..\WoofWare.Whippet.Plugin.HttpClient.Consumer\WoofWare.Whippet.Plugin.HttpClient.Consumer.fsproj" />
<ProjectReference Include="..\WoofWare.Whippet.Plugin.HttpClient.fsproj" />
</ItemGroup>
</Project>

40
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/WoofWare.Whippet.Plugin.HttpClient.fsproj Normal file
View File

@@ -0,0 +1,40 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netstandard2.1</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<Authors>Patrick Stevens</Authors>
<Copyright>Copyright (c) Patrick Stevens 2024</Copyright>
<Description>Whippet F# source generator plugin, for generating RestEase-style HTTP clients.</Description>
<RepositoryType>git</RepositoryType>
<RepositoryUrl>https://github.com/Smaug123/WoofWare.Whippet</RepositoryUrl>
<PackageLicenseExpression>MIT</PackageLicenseExpression>
<PackageReadmeFile>README.md</PackageReadmeFile>
<PackageTags>fsharp;source-generator;source-gen;whippet;http;restease</PackageTags>
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
<WarnOn>FS3559</WarnOn>
<PackageId>WoofWare.Whippet.Plugin.HttpClient</PackageId>
<DevelopmentDependency>true</DevelopmentDependency>
<CopyLocalLockFileAssemblies>true</CopyLocalLockFileAssemblies>
<NoWarn>NU5118</NoWarn>
</PropertyGroup>
<ItemGroup>
<Compile Include="DesiredGenerator.fs" />
<Compile Include="HttpClientGenerator.fs" />
<EmbeddedResource Include="version.json" />
<None Include="README.md">
<Pack>True</Pack>
<PackagePath>/</PackagePath>
<Link>README.md</Link>
</None>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\..\WoofWare.Whippet.Core\WoofWare.Whippet.Core.fsproj" />
<ProjectReference Include="..\..\..\WoofWare.Whippet.Fantomas\WoofWare.Whippet.Fantomas.fsproj" />
<ProjectReference Include="..\..\Json\WoofWare.Whippet.Plugin.Json\WoofWare.Whippet.Plugin.Json.fsproj" />
<ProjectReference Include="..\WoofWare.Whippet.Plugin.HttpClient.Attributes\WoofWare.Whippet.Plugin.HttpClient.Attributes.fsproj" />
</ItemGroup>
</Project>

13
Plugins/HttpClient/WoofWare.Whippet.Plugin.HttpClient/version.json Normal file
View File

@@ -0,0 +1,13 @@
{
"version": "0.1",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],
"pathFilters": [
"./",
":/Plugins/Json/WoofWare.Whippet.Plugin.Json",
"!:/Plugins/Json/WoofWare.Whippet.Plugin.Json/WoofWare.Whippet.Plugin.Json.Test/",
":/global.json",
":/Directory.Build.props"
]
}

4
Plugins/Json/WoofWare.Whippet.Plugin.Json/JsonParseGenerator.fs
View File

@@ -7,13 +7,13 @@ open Fantomas.FCS.SyntaxTrivia
open WoofWare.Whippet.Core
open WoofWare.Whippet.Fantomas
type internal JsonParseOutputSpec =
type JsonParseOutputSpec =
{
ExtensionMethods : bool
}
[<RequireQualifiedAccess>]
module internal JsonParseGenerator =
module JsonParseGenerator =
open Fantomas.FCS.Text.Range
type JsonParseOption =

4
Plugins/Json/WoofWare.Whippet.Plugin.Json/JsonSerializeGenerator.fs
View File

@@ -6,13 +6,13 @@ open Fantomas.FCS.Syntax
open WoofWare.Whippet.Core
open WoofWare.Whippet.Fantomas
type internal JsonSerializeOutputSpec =
type JsonSerializeOutputSpec =
{
ExtensionMethods : bool
}
[<RequireQualifiedAccess>]
module internal JsonSerializeGenerator =
module JsonSerializeGenerator =
open Fantomas.FCS.Text.Range

2
Plugins/Json/WoofWare.Whippet.Plugin.Json/WoofWare.Whippet.Plugin.Json.fsproj
View File

@@ -1,7 +1,7 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<TargetFramework>netstandard2.1</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<Authors>Patrick Stevens</Authors>
<Copyright>Copyright (c) Patrick Stevens 2024</Copyright>

13
WoofWare.Whippet.App/Context.fs
View File

@@ -8,11 +8,7 @@ type Ctx (dll : FileInfo, runtimes : DirectoryInfo list) =
inherit AssemblyLoadContext ()
override this.Load (target : AssemblyName) : Assembly =
let path = Path.Combine (dll.Directory.FullName, $"%s{target.Name}.dll")
if File.Exists path then
this.LoadFromAssemblyPath path
else
let localPath = Path.Combine (dll.Directory.FullName, $"%s{target.Name}.dll")
runtimes
|> List.tryPick (fun di ->
@@ -23,4 +19,9 @@ type Ctx (dll : FileInfo, runtimes : DirectoryInfo list) =
else
None
)
|> Option.defaultValue null
|> Option.defaultWith (fun () ->
if File.Exists localPath then
this.LoadFromAssemblyPath localPath
else
null
)

100
WoofWare.Whippet.App/Program.fs
View File

@@ -150,70 +150,66 @@ module Program =
let runtime =
DotnetRuntime.locate (Assembly.GetExecutingAssembly().Location |> FileInfo)
let pluginDll =
match args.Plugins with
| [] -> failwith "must supply a plugin!"
| [ plugin ] -> plugin
| _ -> failwith "We don't yet support running more than one Whippet plugin in a given project file"
let plugins =
args.Plugins
|> List.map (fun pluginDll ->
let ctx = Ctx (pluginDll, runtime)
// TODO: should ideally loop over files, not plugins, so we fully generate a file before moving on to the next
// one
let pluginAssembly = ctx.LoadFromAssemblyPath pluginDll.FullName
Console.Error.WriteLine $"Loading plugin: %s{pluginDll.FullName}"
// We will look up any member called GenerateRawFromRaw and/or GenerateFromRaw.
// It's your responsibility to decide whether to do anything with this call; you return null if you don't want
// to do anything.
// Alternatively, return the text you want to output.
// We provide you with the input file contents.
// GenerateRawFromRaw should return plain text.
// GenerateFromRaw should return a Fantomas AST.
let applicablePlugins =
pluginAssembly.ExportedTypes
|> Seq.choose (fun ty ->
if
ty.CustomAttributes
|> Seq.exists (fun attr ->
attr.AttributeType.Name = typeof<WhippetGeneratorAttribute>.Name
)
then
Some (ty, Activator.CreateInstance ty)
else
None
)
|> Seq.toList
let ctx = Ctx (pluginDll, runtime)
let pluginAssembly = ctx.LoadFromAssemblyPath pluginDll.FullName
// We will look up any member called GenerateRawFromRaw and/or GenerateFromRaw.
// It's your responsibility to decide whether to do anything with this call; you return null if you don't want
// to do anything.
// Alternatively, return the text you want to output.
// We provide you with the input file contents.
// GenerateRawFromRaw should return plain text.
// GenerateFromRaw should return a Fantomas AST.
let applicablePlugins =
pluginAssembly.ExportedTypes
|> Seq.choose (fun ty ->
if
ty.CustomAttributes
|> Seq.exists (fun attr -> attr.AttributeType.Name = typeof<WhippetGeneratorAttribute>.Name)
then
Some (ty, Activator.CreateInstance ty)
else
None
pluginDll, applicablePlugins
)
|> Seq.toList
for item in toGenerate do
use output = item.GeneratedDest.Open (FileMode.Create, FileAccess.Write)
use outputWriter = new StreamWriter (output, leaveOpen = true)
for plugin, hostClass in applicablePlugins do
match getGenerateRawFromRaw hostClass with
| None -> ()
| Some generateRawFromRaw ->
let fileContents = File.ReadAllBytes item.InputSource.FullName
for _, applicablePlugins in plugins do
for plugin, hostClass in applicablePlugins do
match getGenerateRawFromRaw hostClass with
| None -> ()
| Some generateRawFromRaw ->
let fileContents = File.ReadAllBytes item.InputSource.FullName
let args =
{
RawSourceGenerationArgs.FilePath = item.InputSource.FullName
FileContents = fileContents
Parameters = item.Params
}
let args =
{
RawSourceGenerationArgs.FilePath = item.InputSource.FullName
FileContents = fileContents
Parameters = item.Params
}
let result = generateRawFromRaw args
let result = generateRawFromRaw args
match result with
| None
| Some null -> ()
| Some result ->
Console.Error.WriteLine
$"Writing output for generator %s{plugin.Name} to file %s{item.GeneratedDest.FullName}"
match result with
| None
| Some null -> ()
| Some result ->
Console.Error.WriteLine
$"Writing output for generator %s{plugin.Name} to file %s{item.GeneratedDest.FullName}"
outputWriter.Write result
outputWriter.Write "\n"
()
outputWriter.Write result
outputWriter.Write "\n"
0

24
WoofWare.Whippet.sln
View File

@@ -28,6 +28,14 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Whippet.Plugin.Jso
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Whippet.App", "WoofWare.Whippet.App\WoofWare.Whippet.App.fsproj", "{A2258153-1C1F-4B25-B49A-BCC8EA4A3278}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Whippet.Plugin.HttpClient", "Plugins\HttpClient\WoofWare.Whippet.Plugin.HttpClient\WoofWare.Whippet.Plugin.HttpClient.fsproj", "{53352296-A95F-4153-BABB-BF1D4B1C3531}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Whippet.Plugin.HttpClient.Attributes", "Plugins\HttpClient\WoofWare.Whippet.Plugin.HttpClient.Attributes\WoofWare.Whippet.Plugin.HttpClient.Attributes.fsproj", "{985634CD-739C-43E4-8469-C75C20DC7D9F}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Whippet.Plugin.HttpClient.Consumer", "Plugins\HttpClient\WoofWare.Whippet.Plugin.HttpClient.Consumer\WoofWare.Whippet.Plugin.HttpClient.Consumer.fsproj", "{6754719D-E942-4EBE-AB2B-6FAD997DB685}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "WoofWare.Whippet.Plugin.HttpClient.Test", "Plugins\HttpClient\WoofWare.Whippet.Plugin.HttpClient\WoofWare.Whippet.Plugin.HttpClient.Test\WoofWare.Whippet.Plugin.HttpClient.Test.fsproj", "{4DDD15F1-F273-441B-92F3-76BD9C089529}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@@ -90,5 +98,21 @@ Global
{A2258153-1C1F-4B25-B49A-BCC8EA4A3278}.Debug|Any CPU.Build.0 = Debug|Any CPU
{A2258153-1C1F-4B25-B49A-BCC8EA4A3278}.Release|Any CPU.ActiveCfg = Release|Any CPU
{A2258153-1C1F-4B25-B49A-BCC8EA4A3278}.Release|Any CPU.Build.0 = Release|Any CPU
{53352296-A95F-4153-BABB-BF1D4B1C3531}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{53352296-A95F-4153-BABB-BF1D4B1C3531}.Debug|Any CPU.Build.0 = Debug|Any CPU
{53352296-A95F-4153-BABB-BF1D4B1C3531}.Release|Any CPU.ActiveCfg = Release|Any CPU
{53352296-A95F-4153-BABB-BF1D4B1C3531}.Release|Any CPU.Build.0 = Release|Any CPU
{985634CD-739C-43E4-8469-C75C20DC7D9F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{985634CD-739C-43E4-8469-C75C20DC7D9F}.Debug|Any CPU.Build.0 = Debug|Any CPU
{985634CD-739C-43E4-8469-C75C20DC7D9F}.Release|Any CPU.ActiveCfg = Release|Any CPU
{985634CD-739C-43E4-8469-C75C20DC7D9F}.Release|Any CPU.Build.0 = Release|Any CPU
{6754719D-E942-4EBE-AB2B-6FAD997DB685}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{6754719D-E942-4EBE-AB2B-6FAD997DB685}.Debug|Any CPU.Build.0 = Debug|Any CPU
{6754719D-E942-4EBE-AB2B-6FAD997DB685}.Release|Any CPU.ActiveCfg = Release|Any CPU
{6754719D-E942-4EBE-AB2B-6FAD997DB685}.Release|Any CPU.Build.0 = Release|Any CPU
{4DDD15F1-F273-441B-92F3-76BD9C089529}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{4DDD15F1-F273-441B-92F3-76BD9C089529}.Debug|Any CPU.Build.0 = Debug|Any CPU
{4DDD15F1-F273-441B-92F3-76BD9C089529}.Release|Any CPU.ActiveCfg = Release|Any CPU
{4DDD15F1-F273-441B-92F3-76BD9C089529}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
EndGlobal