Fix BaseAddress semantics (#45)

This commit is contained in:
Patrick Stevens
2023-12-30 10:37:30 +00:00
committed by GitHub
parent 0d231c5200
commit 4c55bbed22
5 changed files with 147 additions and 19 deletions

View File

@@ -482,10 +482,10 @@ open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
module ApiWithoutBasePath =
module ApiWithoutBaseAddress =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithoutBasePath =
{ new IApiWithoutBasePath with
let make (client : System.Net.Http.HttpClient) : IApiWithoutBaseAddress =
{ new IApiWithoutBaseAddress with
member _.GetPathParam (parameter : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
@@ -497,7 +497,7 @@ module ApiWithoutBasePath =
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base path was supplied on the type, and no BaseAddress was on the HttpClient."
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
@@ -521,3 +521,101 @@ module ApiWithoutBasePath =
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
module ApiWithBasePath =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithBasePath =
{ new IApiWithBasePath with
member _.GetPathParam (parameter : 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 (
"endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}
namespace PureGym
open System
open System.Threading
open System.Threading.Tasks
open System.IO
open System.Net
open System.Net.Http
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
module ApiWithBasePathAndAddress =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IApiWithBasePathAndAddress =
{ new IApiWithBasePathAndAddress with
member _.GetPathParam (parameter : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null -> System.Uri "https://whatnot.com"
| v -> v),
System.Uri (
"endpoint/{param}"
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! node = response.Content.ReadAsStringAsync ct |> Async.AwaitTask
return node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}

View File

@@ -9,7 +9,7 @@ open System.Net.Http
open RestEase
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "https://whatnot.com">]
[<BaseAddress "https://whatnot.com">]
type IPureGymApi =
[<Get "v1/gyms/">]
abstract GetGyms : ?ct : CancellationToken -> Task<Gym list>
@@ -63,6 +63,21 @@ type IPureGymApi =
abstract GetWithoutAnyReturnCode : ?ct : CancellationToken -> Task<HttpResponseMessage>
[<WoofWare.Myriad.Plugins.HttpClient>]
type IApiWithoutBasePath =
type IApiWithoutBaseAddress =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
// TODO: implement BasePath support
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BasePath "foo">]
type IApiWithBasePath =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>
[<WoofWare.Myriad.Plugins.HttpClient>]
[<BaseAddress "https://whatnot.com">]
[<BasePath "foo">]
type IApiWithBasePathAndAddress =
[<Get "endpoint/{param}">]
abstract GetPathParam : [<Path "param">] parameter : string * ?ct : CancellationToken -> Task<string>

View File

@@ -10,7 +10,7 @@ open FsUnitTyped
[<TestFixture>]
module TestBasePath =
[<Test>]
let ``Base path is respected`` () =
let ``Base address is respected`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
@@ -27,7 +27,7 @@ module TestBasePath =
observedUri |> shouldEqual "https://whatnot.com/endpoint/param"
[<Test>]
let ``Without a base path but with BaseAddress, request goes through`` () =
let ``Without a base address attr but with BaseAddress on client, request goes through`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
@@ -38,13 +38,13 @@ module TestBasePath =
}
use client = HttpClientMock.make (System.Uri "https://baseaddress.com") proc
let api = ApiWithoutBasePath.make client
let api = ApiWithoutBaseAddress.make client
let observedUri = api.GetPathParam("param").Result
observedUri |> shouldEqual "https://baseaddress.com/endpoint/param"
[<Test>]
let ``Without a base path, request throws`` () =
let ``Without a base address attr or BaseAddress on client, request throws`` () =
let proc (message : HttpRequestMessage) : HttpResponseMessage Async =
async {
message.Method |> shouldEqual HttpMethod.Get
@@ -55,7 +55,7 @@ module TestBasePath =
}
use client = HttpClientMock.makeNoUri proc
let api = ApiWithoutBasePath.make client
let api = ApiWithoutBaseAddress.make client
let observedExc =
async {
@@ -77,4 +77,4 @@ module TestBasePath =
observedExc.Message
|> shouldEqual
"No base path was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"
"No base address was supplied on the type, and no BaseAddress was on the HttpClient. (Parameter 'BaseAddress')"

View File

@@ -210,14 +210,12 @@ RestEase is complex, and handles a lot of different stuff.
* Deserialisation follows the same logic as the `JsonParse` generator,
and it generally assumes you're using types which `JsonParse` is applied to.
* Headers are not yet supported.
* You have to specify the `BaseAddress` on the input client yourself, and you can't have the same client talking to a
different `BaseAddress` this way unless you manually set it before making any different request.
* I haven't yet worked out how to integrate this with a mocked HTTP client; you can always mock up an `HttpClient`,
but I prefer to use a mock which defines a single member `SendAsync`.
* Anonymous parameters are currently forbidden.
There are also some design decisions:
* Every function must take an optional `CancellationToken` (which is good practice anyway);
so arguments are forced to be tupled.
This is a won't-fix for as long as F# requires tupled arguments if any of the args are optional.
# Detailed examples

View File

@@ -53,6 +53,7 @@ module internal HttpClientGenerator =
Args : Parameter list
Identifier : Ident
EnsureSuccessHttpCode : bool
BaseAddress : SynExpr option
BasePath : SynExpr option
}
@@ -307,7 +308,7 @@ module internal HttpClientGenerator =
SynMatchClause.Create (
SynPat.CreateNull,
None,
match info.BasePath with
match info.BaseAddress with
| None ->
SynExpr.CreateApp (
SynExpr.CreateIdentString "raise",
@@ -323,7 +324,7 @@ module internal HttpClientGenerator =
SynExpr.CreateParen baseAddress
)
SynExpr.CreateConstString
"No base path was supplied on the type, and no BaseAddress was on the HttpClient."
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
]
)
)
@@ -608,6 +609,20 @@ module internal HttpClientGenerator =
)
)
let extractBaseAddress (attrs : SynAttributes) : SynExpr option =
attrs
|> List.tryPick (fun attr ->
attr.Attributes
|> List.tryPick (fun attr ->
match attr.TypeName.AsString with
| "BaseAddress"
| "RestEase.BaseAddress"
| "BaseAddressAttribute"
| "RestEase.BaseAddressAttribute" -> Some attr.ArgExpr
| _ -> None
)
)
let createModule
(opens : SynOpenDeclTarget list)
(ns : LongIdent)
@@ -617,6 +632,7 @@ module internal HttpClientGenerator =
let (SynTypeDefn (SynComponentInfo (attrs, _, _, interfaceName, _, _, _, _), synTypeDefnRepr, _, _, _, _)) =
interfaceType
let baseAddress = extractBaseAddress attrs
let basePath = extractBasePath attrs
let members =
@@ -699,6 +715,7 @@ module internal HttpClientGenerator =
Args = args
Identifier = ident
EnsureSuccessHttpCode = shouldEnsureSuccess
BaseAddress = baseAddress
BasePath = basePath
}
| _ -> failwithf "Unrecognised member definition: %+A" defn