mirror of
https://github.com/Smaug123/WoofWare.Whippet
synced 2025-10-12 19:28:41 +00:00
Import Swagger generator (#15)
This commit is contained in:
Patrick Stevens
GitHub
@@ -5,7 +5,7 @@ type internal DesiredGenerator =
|
||||
|
||||
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}"
|
||||
| "HttpClient" -> DesiredGenerator.HttpClient None |> Some
|
||||
| "HttpClient(true)" -> DesiredGenerator.HttpClient (Some true) |> Some
|
||||
| "HttpClient(false)" -> DesiredGenerator.HttpClient (Some false) |> Some
|
||||
| _ -> None
|
||||
|
||||
@@ -968,7 +968,7 @@ type HttpClientGenerator () =
|
||||
desired
|
||||
|> List.tryPick (fun generator ->
|
||||
match generator with
|
||||
| DesiredGenerator.HttpClient arg ->
|
||||
| Some (DesiredGenerator.HttpClient arg) ->
|
||||
let spec =
|
||||
{
|
||||
ExtensionMethods =
|
||||
@@ -978,6 +978,7 @@ type HttpClientGenerator () =
|
||||
}
|
||||
|
||||
Some (typeDef, spec)
|
||||
| None -> None
|
||||
)
|
||||
| _ -> None
|
||||
| Some attr ->
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,38 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net8.0</TargetFramework>
|
||||
<GenerateDocumentationFile>true</GenerateDocumentationFile>
|
||||
<IsPackable>false</IsPackable>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\..\HttpClient\WoofWare.Whippet.Plugin.HttpClient.Attributes\WoofWare.Whippet.Plugin.HttpClient.Attributes.fsproj" />
|
||||
<ProjectReference Include="..\..\Json\WoofWare.Whippet.Plugin.Json.Attributes\WoofWare.Whippet.Plugin.Json.Attributes.fsproj" />
|
||||
<ProjectReference Include="..\..\Json\WoofWare.Whippet.Plugin.Json\WoofWare.Whippet.Plugin.Json.fsproj" PrivateAssets="all" WhippetPlugin="true" />
|
||||
<ProjectReference Include="..\WoofWare.Whippet.Plugin.Swagger\WoofWare.Whippet.Plugin.Swagger.fsproj" PrivateAssets="all" WhippetPlugin="true" />
|
||||
<ProjectReference Include="..\..\InterfaceMock\WoofWare.Whippet.Plugin.InterfaceMock\WoofWare.Whippet.Plugin.InterfaceMock.fsproj" PrivateAssets="all" WhippetPlugin="true" />
|
||||
<ProjectReference Include="..\..\HttpClient\WoofWare.Whippet.Plugin.HttpClient\WoofWare.Whippet.Plugin.HttpClient.fsproj" PrivateAssets="all" WhippetPlugin="true" />
|
||||
<!-- Dance to get a binary dependency on a locally-built Whippet -->
|
||||
<!-- ProjectReference Include="..\..\..\WoofWare.Whippet\WoofWare.Whippet.fsproj" PrivateAssets="all" -->
|
||||
<PackageReference Include="WoofWare.Whippet" Version="*-*" PrivateAssets="all" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<None Include="swagger-gitea.json" />
|
||||
<Compile Include="GeneratedSwaggerGitea.fs">
|
||||
<WhippetFile>swagger-gitea.json</WhippetFile>
|
||||
<WhippetParamClassName>Gitea</WhippetParamClassName>
|
||||
</Compile>
|
||||
<Compile Include="GeneratedSwaggerGiteaMockAndJson.fs">
|
||||
<WhippetFile>GeneratedSwaggerGitea.fs</WhippetFile>
|
||||
<WhippetParamIGitea>InterfaceMock</WhippetParamIGitea>
|
||||
</Compile>
|
||||
<Compile Include="GeneratedSwaggerGiteaHttpClient.fs">
|
||||
<WhippetFile>GeneratedSwaggerGitea.fs</WhippetFile>
|
||||
<WhippetParamIGitea>HttpClient</WhippetParamIGitea>
|
||||
<WhippetSuppressPlugin>JsonParseGenerator,JsonSerializeGenerator</WhippetSuppressPlugin>
|
||||
</Compile>
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
File diff suppressed because it is too large
Load Diff
13
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/List.fs
Normal file
13
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/List.fs
Normal file
@@ -0,0 +1,13 @@
|
||||
namespace WoofWare.Whippet.Plugin.Swagger
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal List =
|
||||
|
||||
let allSome<'a> (l : 'a option list) : 'a list option =
|
||||
let rec go acc (l : 'a option list) =
|
||||
match l with
|
||||
| [] -> Some (List.rev acc)
|
||||
| None :: _ -> None
|
||||
| Some head :: tail -> go (head :: acc) tail
|
||||
|
||||
go [] l
|
||||
108
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/README.md
Normal file
108
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/README.md
Normal file
@@ -0,0 +1,108 @@
|
||||
# WoofWare.Whippet.Plugin.Swagger
|
||||
|
||||
This is a [Whippet](https://github.com/Smaug123/WoofWare.Whippet) plugin for defining strongly-typed HTTP clients according to [Swagger](https://swagger.io/) schemas.
|
||||
|
||||
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
|
||||
|
||||
Save a Swagger schema as `my-swagger-schema.json`.
|
||||
|
||||
In your `fsproj`:
|
||||
|
||||
```xml
|
||||
<Project>
|
||||
<ItemGroup>
|
||||
<None Include="my-swagger-schema.json" />
|
||||
<Compile Include="Client.fs">
|
||||
<WhippetFile>my-swagger-schema.json</WhippetFile>
|
||||
<WhippetParamClassName>GiteaClient</WhippetParamClassName>
|
||||
</Compile>
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<PackageReference Include="WoofWare.Whippet.Plugin.HttpClient.Attributes" Version="" />
|
||||
<PackageReference Include="WoofWare.Whippet.Plugin.Json.Attributes" Version="" />
|
||||
|
||||
<!-- Development dependencies, hence PrivateAssets="all". Note `WhippetPlugin="true"`. -->
|
||||
<PackageReference Include="WoofWare.Whippet.Plugin.Swagger" WhippetPlugin="true" Version="" />
|
||||
<PackageReference Include="WoofWare.Whippet" Version="" PrivateAssets="all" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
```
|
||||
|
||||
(Note that you must supply `<WhippetParamClassName>SomeClassName</WhippetParamClassName>` to tell the generator what to name the type it produces.)
|
||||
|
||||
The generator produces code like this.
|
||||
Notice that it adds `JsonParse` and `JsonSerialize` attributes (i.e. it assumes you have access to [WoofWare.Whippet.Plugin.Json.Attributes](https://www.nuget.org/packages/WoofWare.Whippet.Plugin.Json.Attributes)),
|
||||
and also the `HttpClient` attribute (i.e. it assumes you have access to [WoofWare.Whippet.Plugin.HttpClient.Attributes](https://www.nuget.org/packages/WoofWare.Whippet.Plugin.HttpClient.Attributes)).
|
||||
|
||||
```fsharp
|
||||
/// A type which was defined in the Swagger spec
|
||||
[<JsonParse true ; JsonSerialize true>]
|
||||
type SwaggerType1 =
|
||||
{
|
||||
[<System.Text.Json.Serialization.JsonExtensionData>]
|
||||
AdditionalProperties : System.Collections.Generic.Dictionary<string, System.Text.Json.Nodes.JsonNode>
|
||||
Message : string
|
||||
}
|
||||
|
||||
/// Documentation from the Swagger spec
|
||||
[<HttpClient false ; RestEase.BasePath "/api/v1">]
|
||||
type IGitea =
|
||||
/// Returns the Person actor for a user
|
||||
[<RestEase.Get "/activitypub/user/{username}">]
|
||||
abstract ActivitypubPerson :
|
||||
[<RestEase.Path "username">] username : string * ?ct : System.Threading.CancellationToken ->
|
||||
ActivityPub System.Threading.Tasks.Task
|
||||
```
|
||||
|
||||
That means if you choose to, you can chain other Whippet generators off this one, to generate JSON serde methods and HTTP REST clients:
|
||||
|
||||
```xml
|
||||
<Project>
|
||||
<ItemGroup>
|
||||
<None Include="my-swagger-schema.json" />
|
||||
<Compile Include="Client.fs">
|
||||
<WhippetFile>my-swagger-schema.json</WhippetFile>
|
||||
<WhippetParamClassName>GiteaClient</WhippetParamClassName>
|
||||
</Compile>
|
||||
<Compile Include="GeneratedClientMockAndJson.fs">
|
||||
<WhippetFile>Client.fs</WhippetFile>
|
||||
<WhippetParamIGiteaClient>InterfaceMock</WhippetParamIGiteaClient>
|
||||
</Compile>
|
||||
<Compile Include="GeneratedClient.fs">
|
||||
<WhippetFile>Client.fs</WhippetFile>
|
||||
<WhippetParamIGiteaClient>HttpClient</WhippetParamIGiteaClient>
|
||||
<!-- We're consuming the `Client.fs` file *again*, so prevent the JSON generators from firing again.-->
|
||||
<WhippetSuppressPlugin>JsonParseGenerator,JsonSourceGenerator</WhippetSuppressPlugin>
|
||||
</Compile>
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<PackageReference Include="WoofWare.Whippet.Plugin.HttpClient.Attributes" Version="" />
|
||||
<PackageReference Include="WoofWare.Whippet.Plugin.Json.Attributes" Version="" />
|
||||
|
||||
<PackageReference Include="WoofWare.Whippet.Plugin.HttpClient" WhippetPlugin="true" Version="" />
|
||||
<PackageReference Include="WoofWare.Whippet.Plugin.Json" WhippetPlugin="true" Version="" />
|
||||
<PackageReference Include="WoofWare.Whippet.Plugin.Swagger" WhippetPlugin="true" Version="" />
|
||||
<PackageReference Include="WoofWare.Whippet.Plugin.InterfaceMock" WhippetPlugin="true" Version="" />
|
||||
<PackageReference Include="WoofWare.Whippet" Version="" PrivateAssets="all" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
```
|
||||
|
||||
The `<WhippetParamClassName />` key tells us what to name the resulting interface (it gets an `I` prepended for you).
|
||||
|
||||
### What's the point?
|
||||
|
||||
[`SwaggerProvider`](https://github.com/fsprojects/SwaggerProvider) is *absolutely magical*, but it's kind of witchcraft.
|
||||
I fear no man, but that thing… it scares me.
|
||||
|
||||
Also, builds using `SwaggerProvider` appear to be inherently nondeterministic, even if the data source doesn't change.
|
||||
|
||||
## Limitations
|
||||
|
||||
Swagger API specs appear to be pretty cowboy in the wild.
|
||||
I try to cope with invalid schemas I have seen, but I can't guarantee I do so correctly.
|
||||
Definitely do perform integration tests and let me know of weird specs you encounter, and bits of the (very extensive) Swagger spec I have omitted!
|
||||
|
||||
I have only attempted to deal with Swagger v2.0 so far.
|
||||
576
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/Swagger.fs
Normal file
576
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/Swagger.fs
Normal file
@@ -0,0 +1,576 @@
|
||||
namespace WoofWare.Whippet.Plugin.Swagger
|
||||
|
||||
open System
|
||||
open System.Text.Json.Nodes
|
||||
|
||||
[<AutoOpen>]
|
||||
module internal JsonHelpers =
|
||||
let inline asString (n : JsonNode) (key : string) : string =
|
||||
match n.[key] with
|
||||
| null -> failwith $"Expected node to have a key '%s{key}', but it did not: %s{n.ToJsonString ()}"
|
||||
| s -> s.GetValue<string> ()
|
||||
|
||||
[<RequiresExplicitTypeArguments>]
|
||||
let inline asOpt<'ret> (n : JsonNode) (key : string) : 'ret option =
|
||||
match n.[key] with
|
||||
| null -> None
|
||||
| s -> s.GetValue<'ret> () |> Some
|
||||
|
||||
let inline asObj (n : JsonNode) (key : string) : JsonObject =
|
||||
match n.[key] with
|
||||
| null -> failwith $"Expected node to have a key '%s{key}', but it did not: %s{n.ToJsonString ()}"
|
||||
| o -> o.AsObject ()
|
||||
|
||||
let inline asObjOpt (n : JsonNode) (key : string) : JsonObject option =
|
||||
match n.[key] with
|
||||
| null -> None
|
||||
| o -> o.AsObject () |> Some
|
||||
|
||||
let inline asArr (n : JsonNode) (key : string) : JsonArray =
|
||||
match n.[key] with
|
||||
| null -> failwith $"Expected node to have a key '%s{key}', but it did not: %s{n.ToJsonString ()}"
|
||||
| o -> o.AsArray ()
|
||||
|
||||
let inline asArrOpt (n : JsonNode) (key : string) : JsonArray option =
|
||||
match n.[key] with
|
||||
| null -> None
|
||||
| o -> o.AsArray () |> Some
|
||||
|
||||
[<RequiresExplicitTypeArguments>]
|
||||
let inline asArr'<'v> (n : JsonNode) (key : string) : 'v list =
|
||||
match n.[key] with
|
||||
| null -> failwith $"Expected node to have a key '%s{key}', but it did not: %s{n.ToJsonString ()}"
|
||||
| o -> o.AsArray () |> Seq.map (fun v -> v.GetValue<'v> ()) |> Seq.toList
|
||||
|
||||
[<RequiresExplicitTypeArguments>]
|
||||
let inline asArrOpt'<'v> (n : JsonNode) (key : string) : 'v list option =
|
||||
match n.[key] with
|
||||
| null -> None
|
||||
| o -> o.AsArray () |> Seq.map (fun v -> v.GetValue<'v> ()) |> Seq.toList |> Some
|
||||
|
||||
/// A MIME type, like "application/json"
|
||||
type MimeType =
|
||||
/// A MIME type, like "application/json"
|
||||
| MimeType of string
|
||||
|
||||
/// A URL scheme, like "https"
|
||||
type Scheme =
|
||||
/// A URL scheme, like "https"
|
||||
| Scheme of string
|
||||
|
||||
/// "Licence information for the exposed API", whatever that means.
|
||||
type SwaggerLicense =
|
||||
{
|
||||
/// "The license name used for the API", whatever that means.
|
||||
Name : string
|
||||
/// Link to the license used. Mutually exclusive with `Identifier`.
|
||||
Url : Uri option
|
||||
/// SPDX license identifier. Mutually exclusive with `Url`.
|
||||
Identifier : string option
|
||||
}
|
||||
|
||||
/// Render a JsonObject into the strongly-typed version, performing sanity
|
||||
/// checks and throwing on input that can't be parsed.
|
||||
static member Parse (node : JsonObject) : SwaggerLicense =
|
||||
let name = asString node "name"
|
||||
let url = asOpt<string> node "url" |> Option.map Uri
|
||||
let identifier = asOpt<string> node "identifier"
|
||||
|
||||
match url, identifier with
|
||||
| Some _, Some _ -> failwith "Invalid license spec: cannot supply both URL and identifier"
|
||||
| _, _ -> ()
|
||||
|
||||
{
|
||||
Name = name
|
||||
Url = url
|
||||
Identifier = identifier
|
||||
}
|
||||
|
||||
/// Overall information about the API described by this Swagger spec.
|
||||
type SwaggerInfo =
|
||||
{
|
||||
/// Human-readable description of what this Swagger API is for.
|
||||
/// Supports GitHub-flavoured markdown, apparently.
|
||||
Description : string
|
||||
/// Human-readable title of the service to which this is an API.
|
||||
Title : string
|
||||
/// The license applying to this schema. It's very unclear what this means.
|
||||
/// The spec just says:
|
||||
/// "Licence information for the exposed API"
|
||||
License : SwaggerLicense
|
||||
/// The version of this API (not the version of Swagger or the file defining the API!).
|
||||
/// Strictly speaking this can be anything, but I am assuming it's roughly
|
||||
/// SemVer.
|
||||
Version : Version
|
||||
}
|
||||
|
||||
/// Render a JsonObject into the strongly-typed version, performing sanity
|
||||
/// checks and throwing on input that can't be parsed.
|
||||
static member Parse (node : JsonObject) : SwaggerInfo =
|
||||
let description = asString node "description"
|
||||
let title = asString node "title"
|
||||
let version = asString node "version" |> Version.Parse
|
||||
let license = asObj node "license" |> SwaggerLicense.Parse
|
||||
|
||||
{
|
||||
Description = description
|
||||
Title = title
|
||||
License = license
|
||||
Version = version
|
||||
}
|
||||
|
||||
/// An "optional unique string used to describe an operation".
|
||||
/// If present, these are assumed to be unique among all operations described
|
||||
/// in the API.
|
||||
type OperationId =
|
||||
/// An "optional unique string used to describe an operation".
|
||||
/// If present, these are assumed to be unique among all operations described
|
||||
/// in the API.
|
||||
| OperationId of string
|
||||
|
||||
/// Round-trip string representation.
|
||||
override this.ToString () =
|
||||
match this with
|
||||
| OperationId.OperationId s -> s
|
||||
|
||||
/// Constraints on the `additionalProperties` (in the JSON schema sense).
|
||||
/// "Additional properties" are properties of a JSON object which were not
|
||||
/// listed in the schema.
|
||||
type AdditionalProperties =
|
||||
/// No additional properties are allowed: all properties must have been
|
||||
/// mentioned in the schema.
|
||||
| Never
|
||||
/// Additional properties are permitted, but if they exist, they must
|
||||
/// match this schema definition.
|
||||
| Constrained of Definition
|
||||
|
||||
/// The Swagger schema lets you define types. An ObjectTypeDefinition
|
||||
/// is specifically the information about types defined as `"type": "object"`.
|
||||
and ObjectTypeDefinition =
|
||||
{
|
||||
/// Human-readable description of the purpose of this type.
|
||||
Description : string option
|
||||
/// Fields which any object must have to satisfy this type.
|
||||
Properties : Map<string, Definition> option
|
||||
/// Extra properties in the type description. In Gitea, these are
|
||||
/// (for example) "x-go-package":"code.gitea.io/gitea/modules/structs".
|
||||
Extras : Map<string, JsonNode>
|
||||
/// List of fields which are required; all other fields are optional.
|
||||
Required : string list option
|
||||
/// Constraints, if any, placed on fields which are not mentioned in
|
||||
/// the schema. If absent, there are no constraints.
|
||||
AdditionalProperties : AdditionalProperties option
|
||||
/// Example of an object which satisfies this schema.
|
||||
Example : JsonObject option
|
||||
}
|
||||
|
||||
/// Render a JsonObject into the strongly-typed version, performing sanity
|
||||
/// checks and throwing on input that can't be parsed.
|
||||
static member Parse (node : JsonObject) : ObjectTypeDefinition =
|
||||
let description =
|
||||
match asOpt<string> node "description", asOpt<string> node "title" with
|
||||
| None, None -> None
|
||||
| Some v, None
|
||||
| None, Some v -> Some v
|
||||
| Some v1, Some v2 -> failwith "both description and title were given"
|
||||
|
||||
let additionalProperties =
|
||||
match node.["additionalProperties"] with
|
||||
| null -> None
|
||||
| :? JsonValue as p ->
|
||||
if not (p.GetValue<bool> ()) then
|
||||
Some AdditionalProperties.Never
|
||||
else
|
||||
failwith $"additionalProperties should be 'false' or an object, but was: %s{p.ToJsonString ()}"
|
||||
| p ->
|
||||
let p = p.AsObject ()
|
||||
Definition.Parse p |> AdditionalProperties.Constrained |> Some
|
||||
|
||||
let properties =
|
||||
match node.["properties"] with
|
||||
| null -> None
|
||||
| p ->
|
||||
p.AsObject ()
|
||||
|> Seq.map (fun (KeyValue (key, value)) ->
|
||||
let value = value.AsObject ()
|
||||
key, Definition.Parse value
|
||||
)
|
||||
|> Map.ofSeq
|
||||
|> Some
|
||||
|
||||
let example = asObjOpt node "example"
|
||||
|
||||
let required = asArrOpt'<string> node "required"
|
||||
|
||||
let extras =
|
||||
node.AsObject ()
|
||||
|> Seq.choose (fun (KeyValue (key, value)) ->
|
||||
match key with
|
||||
| "type"
|
||||
| "description"
|
||||
| "title"
|
||||
| "additionalProperties"
|
||||
| "example"
|
||||
| "required"
|
||||
| "properties" -> None
|
||||
| _ -> Some (key, value)
|
||||
)
|
||||
|> Map.ofSeq
|
||||
|
||||
{
|
||||
Description = description
|
||||
Properties = properties
|
||||
AdditionalProperties = additionalProperties
|
||||
Required = required
|
||||
Extras = extras
|
||||
Example = example
|
||||
}
|
||||
|
||||
/// The Swagger schema lets you define types. An ArrayTypeDefinition
|
||||
/// is specifically the information about types defined as `"type": "array"`.
|
||||
and ArrayTypeDefinition =
|
||||
{
|
||||
/// The type is `'a array`; this field describes `'a`.
|
||||
Items : Definition
|
||||
}
|
||||
|
||||
/// Render a JsonNode into the strongly-typed version, performing sanity
|
||||
/// checks and throwing on input that can't be parsed.
|
||||
static member Parse (n : JsonNode) : ArrayTypeDefinition =
|
||||
let items = asObj n "items" |> Definition.Parse
|
||||
|
||||
{
|
||||
Items = items
|
||||
}
|
||||
|
||||
/// Any definition of a type in the Swagger document. This is basically any
|
||||
/// information associated with the `"type": "blah"` field.
|
||||
and Definition =
|
||||
/// For example, if `"$ref": "#/responses/Blah", then this is "#/responses/Blah".
|
||||
| Handle of string
|
||||
/// A type definition with "type": "object".
|
||||
| Object of ObjectTypeDefinition
|
||||
/// A type definition with "type": "array".
|
||||
| Array of ArrayTypeDefinition
|
||||
/// A type definition with "type": "string".
|
||||
| String
|
||||
/// A type definition with "type": "boolean".
|
||||
| Boolean
|
||||
/// A response without a body has no "schema" specified.
|
||||
| Unspecified
|
||||
/// A type definition with "type": "integer".
|
||||
/// The format is an optional hint which could be e.g. "int64" or "int32".
|
||||
/// https://swagger.io/docs/specification/data-models/data-types/#numbers
|
||||
| Integer of format : string option
|
||||
/// Not a JSON schema type, but a Swagger 2.0 type.
|
||||
| File
|
||||
|
||||
/// Render a JsonObject into this strongly-typed specification.
|
||||
static member Parse (n : JsonObject) : Definition =
|
||||
match n.["$ref"] |> Option.ofObj with
|
||||
| Some ref -> Definition.Handle (ref.GetValue<string> ())
|
||||
| None ->
|
||||
|
||||
let ty = asOpt<string> n "type"
|
||||
|
||||
match ty with
|
||||
| None -> Definition.Unspecified
|
||||
| Some "object" -> ObjectTypeDefinition.Parse n |> Definition.Object
|
||||
| Some "array" -> ArrayTypeDefinition.Parse n |> Definition.Array
|
||||
| Some "string" -> Definition.String
|
||||
| Some "boolean" -> Definition.Boolean
|
||||
| Some "file" -> Definition.File
|
||||
| Some "integer" ->
|
||||
let format = asOpt<string> n "format"
|
||||
Definition.Integer format
|
||||
| Some ty -> failwith $"Unrecognised type: %s{ty}"
|
||||
|
||||
/// REST APIs allow their parameters to be passed in various ways. This describes
|
||||
/// how one single parameter is passed.
|
||||
type ParameterIn =
|
||||
/// The parameter is interpolated into the path, e.g. "/foo/{blah}".
|
||||
/// The "name" is what we replace in the path: e.g. "/foo/{person}" would
|
||||
/// have a name of "person".
|
||||
| Path of name : string
|
||||
/// The parameter is appended to the URL's query params, e.g. "?<name>=blah"
|
||||
| Query of name : string
|
||||
/// The parameter is passed in the body of the HTTP request.
|
||||
| Body
|
||||
/// Some spec that WoofWare.Myriad doesn't support.
|
||||
| Unrecognised of op : string * name : string
|
||||
|
||||
/// Description of a single input parameter to an endpoint.
|
||||
type SwaggerParameter =
|
||||
{
|
||||
/// The type schema to which this parameter must conform.
|
||||
Type : Definition
|
||||
/// Optional human-readable description of this parameter.
|
||||
Description : string option
|
||||
/// How this parameter is passed.
|
||||
In : ParameterIn
|
||||
/// Name of this parameter. For most `In` values, this name is the
|
||||
/// name of the parameter as supplied to the API at runtime, and in WoofWare's
|
||||
/// strongly-typed domain types this information is also contained in the `In` field.
|
||||
/// For `Body` parameters, this is purely for dev-time information.
|
||||
Name : string
|
||||
/// Whether this parameter is required for validation to succeed.
|
||||
/// I think this defaults to "no".
|
||||
Required : bool option
|
||||
}
|
||||
|
||||
/// Render a JsonObject into this strongly-typed specification.
|
||||
static member Parse (node : JsonObject) : SwaggerParameter =
|
||||
let ty =
|
||||
match asObjOpt node "schema" with
|
||||
| None -> Definition.Parse node
|
||||
| Some node -> Definition.Parse node
|
||||
|
||||
let description = asOpt<string> node "description"
|
||||
let name = asString node "name"
|
||||
|
||||
let paramIn =
|
||||
match asString node "in" with
|
||||
| "path" -> ParameterIn.Path name
|
||||
| "query" -> ParameterIn.Query name
|
||||
| "body" -> ParameterIn.Body
|
||||
| f -> ParameterIn.Unrecognised (f, name)
|
||||
|
||||
let required = asOpt<bool> node "required"
|
||||
|
||||
{
|
||||
Type = ty
|
||||
Description = description
|
||||
In = paramIn
|
||||
Name = name
|
||||
Required = required
|
||||
}
|
||||
|
||||
/// An "endpoint" is basically a single HTTP verb, applied to some path.
|
||||
type SwaggerEndpoint =
|
||||
{
|
||||
/// The MIME types we should send our request body in.
|
||||
/// This overrides (does not extend) any global definitions on the spec itself.
|
||||
Consumes : MimeType list option
|
||||
/// The MIME types we should expect to receive in response to this request.
|
||||
/// This overrides (does not extend) any global definitions on the spec itself.
|
||||
Produces : MimeType list option
|
||||
/// Arbitrary list of [tags](https://swagger.io/docs/specification/2-0/grouping-operations-with-tags/).
|
||||
Tags : string list
|
||||
/// Human-readable description of the endpoint.
|
||||
Summary : string
|
||||
/// Arbitrary identifier of this endpoint; this must be unique across *all* endpoints
|
||||
/// in this entire spec.
|
||||
OperationId : OperationId
|
||||
/// Parameters that must be supplied at HTTP-request-time to the endpoint.
|
||||
/// (Each parameter knows how it needs to be supplied: e.g. if it's a query parameter or
|
||||
/// if it's interpolated into the path.)
|
||||
Parameters : SwaggerParameter list option
|
||||
/// Map of HTTP response code to the type that we expect to receive in the body if we
|
||||
/// get that response code back.
|
||||
Responses : Map<int, Definition>
|
||||
}
|
||||
|
||||
/// Render a JsonObject into this strongly-typed specification.
|
||||
static member Parse (r : JsonObject) : SwaggerEndpoint =
|
||||
let produces = asArrOpt'<string> r "produces" |> Option.map (List.map MimeType)
|
||||
let consumes = asArrOpt'<string> r "consumes" |> Option.map (List.map MimeType)
|
||||
let tags = asArr'<string> r "tags"
|
||||
let summary = asString r "summary"
|
||||
let operationId = asString r "operationId" |> OperationId
|
||||
|
||||
let responses =
|
||||
asObj r "responses"
|
||||
|> Seq.map (fun (KeyValue (key, value)) ->
|
||||
let value = value.AsObject ()
|
||||
Int32.Parse key, Definition.Parse value
|
||||
)
|
||||
|> Map.ofSeq
|
||||
|
||||
let parameters =
|
||||
asArrOpt r "parameters"
|
||||
|> Option.map (fun pars ->
|
||||
pars
|
||||
|> Seq.map (fun par -> par.AsObject () |> SwaggerParameter.Parse)
|
||||
|> Seq.toList
|
||||
)
|
||||
|
||||
{
|
||||
Produces = produces
|
||||
Consumes = consumes
|
||||
Tags = tags
|
||||
Summary = summary
|
||||
OperationId = operationId
|
||||
Parameters = parameters
|
||||
Responses = responses
|
||||
}
|
||||
|
||||
/// Specifies the form a response to an endpoint will take if it's complying with this spec.
|
||||
type Response =
|
||||
{
|
||||
/// Human-readable description.
|
||||
Description : string
|
||||
/// Specification of the type to which responses will conform under this spec.
|
||||
Schema : Definition
|
||||
}
|
||||
|
||||
/// Render a JsonObject into this strongly-typed specification.
|
||||
static member Parse (r : JsonObject) : Response =
|
||||
let desc = asString r "description"
|
||||
|
||||
let schema =
|
||||
match asObjOpt r "schema" with
|
||||
| None -> Definition.Unspecified
|
||||
| Some s -> Definition.Parse s
|
||||
|
||||
{
|
||||
Description = desc
|
||||
Schema = schema
|
||||
}
|
||||
|
||||
/// An HTTP method. This is System.Net.Http.HttpMethod, but
|
||||
/// a proper discriminated union.
|
||||
type HttpMethod =
|
||||
/// HTTP Get
|
||||
| Get
|
||||
/// HTTP Post
|
||||
| Post
|
||||
/// HTTP Delete
|
||||
| Delete
|
||||
/// HTTP Patch
|
||||
| Patch
|
||||
/// HTTP Options
|
||||
| Options
|
||||
/// HTTP Head
|
||||
| Head
|
||||
/// HTTP Put
|
||||
| Put
|
||||
/// HTTP Trace
|
||||
| Trace
|
||||
|
||||
/// Convert to the standard library's enum type.
|
||||
member this.ToDotNet () : System.Net.Http.HttpMethod =
|
||||
match this with
|
||||
| HttpMethod.Get -> System.Net.Http.HttpMethod.Get
|
||||
| HttpMethod.Post -> System.Net.Http.HttpMethod.Post
|
||||
| HttpMethod.Delete -> System.Net.Http.HttpMethod.Delete
|
||||
| HttpMethod.Patch -> System.Net.Http.HttpMethod.Patch
|
||||
| HttpMethod.Options -> System.Net.Http.HttpMethod.Options
|
||||
| HttpMethod.Head -> System.Net.Http.HttpMethod.Head
|
||||
| HttpMethod.Put -> System.Net.Http.HttpMethod.Put
|
||||
| HttpMethod.Trace -> System.Net.Http.HttpMethod.Trace
|
||||
|
||||
/// Human-readable string representation.
|
||||
override this.ToString () : string =
|
||||
match this with
|
||||
| HttpMethod.Get -> "Get"
|
||||
| HttpMethod.Post -> "Post"
|
||||
| HttpMethod.Delete -> "Delete"
|
||||
| HttpMethod.Patch -> "Post"
|
||||
| HttpMethod.Options -> "Options"
|
||||
| HttpMethod.Head -> "Head"
|
||||
| HttpMethod.Put -> "Put"
|
||||
| HttpMethod.Trace -> "Trace"
|
||||
|
||||
/// Throws on invalid inputs.
|
||||
static member Parse (s : string) : HttpMethod =
|
||||
if String.Equals (s, "get", StringComparison.OrdinalIgnoreCase) then
|
||||
HttpMethod.Get
|
||||
elif String.Equals (s, "post", StringComparison.OrdinalIgnoreCase) then
|
||||
HttpMethod.Post
|
||||
elif String.Equals (s, "patch", StringComparison.OrdinalIgnoreCase) then
|
||||
HttpMethod.Patch
|
||||
elif String.Equals (s, "delete", StringComparison.OrdinalIgnoreCase) then
|
||||
HttpMethod.Delete
|
||||
elif String.Equals (s, "head", StringComparison.OrdinalIgnoreCase) then
|
||||
HttpMethod.Head
|
||||
elif String.Equals (s, "options", StringComparison.OrdinalIgnoreCase) then
|
||||
HttpMethod.Options
|
||||
elif String.Equals (s, "put", StringComparison.OrdinalIgnoreCase) then
|
||||
HttpMethod.Put
|
||||
else
|
||||
failwith $"Unrecognised method: %s{s}"
|
||||
|
||||
/// A Swagger API specification.
|
||||
type Swagger =
|
||||
{
|
||||
/// Global collection of MIME types which any endpoint expects to consume its inputs in.
|
||||
/// This may be overridden on any individual endpoint by that endpoint.
|
||||
Consumes : MimeType list
|
||||
/// Global collection of MIME types which any endpoint will produce.
|
||||
/// This may be overridden on any individual endpoint by that endpoint.
|
||||
Produces : MimeType list
|
||||
/// HTTP or HTTPS, for example. Indicates which scheme to access the API on.
|
||||
Schemes : Scheme list
|
||||
/// The version of OpenAPI this specification is written against.
|
||||
/// (As of this writing, we only support 2.0.)
|
||||
Swagger : Version
|
||||
/// General information about this API.
|
||||
Info : SwaggerInfo
|
||||
/// Path under the URI host, which should be prefixed (with trailing slash if necessary)
|
||||
/// to all requests.
|
||||
BasePath : string
|
||||
/// Map from relative path to "what is served at that path".
|
||||
Paths : Map<string, Map<HttpMethod, SwaggerEndpoint>>
|
||||
/// Types defined in the schema. Requests may use these definitions just like in any other JSON schema.
|
||||
/// Key is a domain type name, e.g. "APIError".
|
||||
Definitions : Map<string, Definition>
|
||||
/// Types of each response.
|
||||
/// Key is a domain type name, e.g. "AccessToken".
|
||||
Responses : Map<string, Response>
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Swagger =
|
||||
/// Parse a JSON-schema-based specification of a Swagger 2.0 API and
|
||||
/// build the strongly-typed version. Throws on invalid inputs.
|
||||
let parse (s : string) : Swagger =
|
||||
let node = JsonNode.Parse s
|
||||
let consumes = asArr'<string> node "consumes" |> List.map MimeType
|
||||
let produces = asArr'<string> node "produces" |> List.map MimeType
|
||||
let schemes = asArr'<string> node "schemes" |> List.map Scheme
|
||||
let swagger = asString node "swagger" |> Version.Parse
|
||||
let info = asObj node "info" |> SwaggerInfo.Parse
|
||||
let basePath = asString node "basePath"
|
||||
|
||||
let definitions =
|
||||
asObj node "definitions"
|
||||
|> Seq.map (fun (KeyValue (key, value)) ->
|
||||
let value = value.AsObject ()
|
||||
key, Definition.Parse value
|
||||
)
|
||||
|> Map.ofSeq
|
||||
|
||||
let paths =
|
||||
asObj node "paths"
|
||||
|> Seq.map (fun (KeyValue (key, value)) ->
|
||||
let contents =
|
||||
value.AsObject ()
|
||||
|> Seq.map (fun (KeyValue (endpoint, contents)) ->
|
||||
let contents = contents.AsObject ()
|
||||
HttpMethod.Parse endpoint, SwaggerEndpoint.Parse contents
|
||||
)
|
||||
|> Map.ofSeq
|
||||
|
||||
key, contents
|
||||
)
|
||||
|> Map.ofSeq
|
||||
|
||||
let responses =
|
||||
asObj node "responses"
|
||||
|> Seq.map (fun (KeyValue (key, value)) ->
|
||||
let value = value.AsObject ()
|
||||
key, Response.Parse value
|
||||
)
|
||||
|> Map.ofSeq
|
||||
|
||||
{
|
||||
Consumes = consumes
|
||||
Produces = produces
|
||||
Schemes = schemes
|
||||
Swagger = swagger
|
||||
Info = info
|
||||
BasePath = basePath
|
||||
Paths = paths
|
||||
Definitions = definitions
|
||||
Responses = responses
|
||||
}
|
||||
@@ -0,0 +1,709 @@
|
||||
namespace WoofWare.Whippet.Plugin.Swagger
|
||||
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
open System.IO
|
||||
open System.Text
|
||||
open System.Threading
|
||||
open Fantomas.FCS.Syntax
|
||||
open Fantomas.FCS.Xml
|
||||
open WoofWare.Whippet.Core
|
||||
open WoofWare.Whippet.Fantomas
|
||||
open Fantomas.FCS.Text.Range
|
||||
|
||||
type internal SwaggerClientConfig =
|
||||
{
|
||||
ClassName : string
|
||||
}
|
||||
|
||||
type internal Produces =
|
||||
// TODO: this will cope with decoding JSON, plain text, etc
|
||||
| Produces of string
|
||||
|
||||
type internal Endpoint =
|
||||
{
|
||||
DocString : PreXmlDoc
|
||||
Produces : Produces
|
||||
ReturnType : Definition
|
||||
Method : HttpMethod
|
||||
Operation : OperationId
|
||||
Parameters : SwaggerParameter list
|
||||
Endpoint : string
|
||||
}
|
||||
|
||||
type internal TypeEntry =
|
||||
{
|
||||
/// If we had to define a type for this, here it is.
|
||||
FSharpDefinition : SynTypeDefn option
|
||||
/// SynType you use in e.g. a type annotation to refer to this type in F# code.
|
||||
Signature : SynType
|
||||
}
|
||||
|
||||
type internal Types =
|
||||
{
|
||||
ByHandle : IReadOnlyDictionary<string, TypeEntry>
|
||||
ByDefinition : IReadOnlyDictionary<Definition, TypeEntry>
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal SwaggerClientGenerator =
|
||||
let outputFile = FileInfo "/tmp/output.txt"
|
||||
|
||||
// do
|
||||
// use _ = File.Create outputFile.FullName
|
||||
// ()
|
||||
|
||||
let log (line : string) =
|
||||
// use w = outputFile.AppendText ()
|
||||
// w.WriteLine line
|
||||
()
|
||||
|
||||
let renderType (types : Types) (defn : Definition) : SynType option =
|
||||
match types.ByDefinition.TryGetValue defn with
|
||||
| true, v -> Some v.Signature
|
||||
| false, _ ->
|
||||
|
||||
match defn with
|
||||
| Definition.Handle h ->
|
||||
match types.ByHandle.TryGetValue h with
|
||||
| false, _ -> None
|
||||
| true, v -> Some v.Signature
|
||||
| Definition.Object _ -> failwith "should not hit"
|
||||
| Definition.Array _ -> failwith "should not hit"
|
||||
| Definition.Unspecified -> failwith "should not hit"
|
||||
| Definition.String -> SynType.string |> Some
|
||||
| Definition.Boolean -> SynType.bool |> Some
|
||||
| Definition.Integer _ -> SynType.int |> Some
|
||||
| Definition.File -> SynType.createLongIdent' [ "System" ; "IO" ; "Stream" ] |> Some
|
||||
|
||||
/// Returns None if we lacked the information required to do this.
|
||||
/// bigCache is a map of e.g. {"securityDefinition": {Defn : F# type}}.
|
||||
let rec defnToType
|
||||
(anonymousTypeCount : int ref)
|
||||
(handlesMap : Dictionary<string, TypeEntry>)
|
||||
(bigCache : Dictionary<string, Dictionary<Definition, TypeEntry>>)
|
||||
(thisKey : string)
|
||||
(typeName : string option)
|
||||
(d : Definition)
|
||||
: TypeEntry option
|
||||
=
|
||||
let cache =
|
||||
match bigCache.TryGetValue thisKey with
|
||||
| false, _ ->
|
||||
let d = Dictionary ()
|
||||
bigCache.Add (thisKey, d)
|
||||
d
|
||||
| true, d -> d
|
||||
|
||||
let handleKey =
|
||||
match typeName with
|
||||
| None -> None
|
||||
| Some typeName -> $"#/%s{thisKey}/%s{typeName}" |> Some
|
||||
|
||||
match handleKey with
|
||||
| Some hk when handlesMap.ContainsKey hk ->
|
||||
let result = handlesMap.[hk]
|
||||
cache.[d] <- result
|
||||
Some result
|
||||
|
||||
| _ ->
|
||||
|
||||
match cache.TryGetValue d with
|
||||
| true, v ->
|
||||
match handleKey with
|
||||
| None -> ()
|
||||
| Some key -> handlesMap.Add (key, v)
|
||||
|
||||
Some v
|
||||
| false, _ ->
|
||||
|
||||
let result =
|
||||
match d with
|
||||
| Definition.Object obj ->
|
||||
let requiredFields = obj.Required |> Option.defaultValue [] |> Set.ofList
|
||||
|
||||
let namedProperties =
|
||||
obj.Properties
|
||||
|> Option.map Seq.cast
|
||||
|> Option.defaultValue Seq.empty
|
||||
|> Seq.map (fun (KeyValue (fieldName, defn)) ->
|
||||
// TODO this is a horrible hack and is incomplete, e.g. if we contain an array of ourself
|
||||
// Special case for when this is a reference to this very type
|
||||
let isOurself =
|
||||
match defn with
|
||||
| Definition.Handle h ->
|
||||
match h.Split '/' with
|
||||
| [| "#" ; location ; ty |] when location = thisKey && Some ty = typeName ->
|
||||
SynType.named ty |> Some
|
||||
| _ -> None
|
||||
| _ -> None
|
||||
|
||||
let jsonPropertyName =
|
||||
SynExpr.CreateConst (fieldName : string)
|
||||
|> SynAttribute.create (
|
||||
SynLongIdent.createS'
|
||||
[ "System" ; "Text" ; "Json" ; "Serialization" ; "JsonPropertyName" ]
|
||||
)
|
||||
|
||||
match isOurself with
|
||||
| Some alreadyDone ->
|
||||
let ty =
|
||||
if Set.contains fieldName requiredFields then
|
||||
alreadyDone
|
||||
else
|
||||
SynType.option alreadyDone
|
||||
|
||||
{
|
||||
Attrs = [ jsonPropertyName ]
|
||||
Type = ty
|
||||
Ident = Some (Ident.createSanitisedTypeName fieldName)
|
||||
}
|
||||
|> SynField.make
|
||||
|> Some
|
||||
| None ->
|
||||
|
||||
let defn' = defnToType anonymousTypeCount handlesMap bigCache thisKey None defn
|
||||
|
||||
match defn' with
|
||||
| None -> None
|
||||
| Some defn' ->
|
||||
let ty =
|
||||
if Set.contains fieldName requiredFields then
|
||||
defn'.Signature
|
||||
else
|
||||
defn'.Signature |> SynType.option
|
||||
|
||||
{
|
||||
Attrs = [ jsonPropertyName ]
|
||||
Ident = Ident.createSanitisedTypeName fieldName |> Some
|
||||
Type = ty
|
||||
}
|
||||
|> SynField.make
|
||||
|> Some
|
||||
)
|
||||
|> Seq.toList
|
||||
|
||||
let additionalProperties =
|
||||
match obj.AdditionalProperties with
|
||||
| None ->
|
||||
{
|
||||
Attrs =
|
||||
[
|
||||
SynAttribute.create
|
||||
(SynLongIdent.createS'
|
||||
[ "System" ; "Text" ; "Json" ; "Serialization" ; "JsonExtensionData" ])
|
||||
(SynExpr.CreateConst ())
|
||||
]
|
||||
Ident = Ident.create "AdditionalProperties" |> Some
|
||||
Type =
|
||||
SynType.app'
|
||||
(SynType.createLongIdent' [ "System" ; "Collections" ; "Generic" ; "Dictionary" ])
|
||||
[
|
||||
SynType.string
|
||||
SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
|
||||
]
|
||||
}
|
||||
|> SynField.make
|
||||
|> List.singleton
|
||||
|> Some
|
||||
| Some AdditionalProperties.Never -> Some []
|
||||
| Some (AdditionalProperties.Constrained defn) ->
|
||||
let defn' = defnToType anonymousTypeCount handlesMap bigCache thisKey None defn
|
||||
|
||||
match defn' with
|
||||
| None -> None
|
||||
| Some defn' ->
|
||||
{
|
||||
Attrs =
|
||||
[
|
||||
SynAttribute.create
|
||||
(SynLongIdent.createS'
|
||||
[ "System" ; "Text" ; "Json" ; "Serialization" ; "JsonExtensionData" ])
|
||||
(SynExpr.CreateConst ())
|
||||
]
|
||||
Ident = Ident.create "AdditionalProperties" |> Some
|
||||
Type =
|
||||
SynType.app'
|
||||
(SynType.createLongIdent'
|
||||
[ "System" ; "Collections" ; "Generic" ; "Dictionary" ])
|
||||
[ SynType.string ; defn'.Signature ]
|
||||
}
|
||||
|> SynField.make
|
||||
|> List.singleton
|
||||
|> Some
|
||||
|
||||
match additionalProperties with
|
||||
| None -> None
|
||||
| Some additionalProperties ->
|
||||
|
||||
match List.allSome namedProperties with
|
||||
| None -> None
|
||||
| Some namedProperties ->
|
||||
|
||||
let fSharpTypeName =
|
||||
match typeName with
|
||||
| None -> $"Type%i{Interlocked.Increment anonymousTypeCount}"
|
||||
| Some typeName -> typeName
|
||||
|
||||
let properties = additionalProperties @ namedProperties
|
||||
|
||||
let properties =
|
||||
if properties.IsEmpty then
|
||||
// sigh, they didn't give us any properties at all; let's make one up
|
||||
{
|
||||
Attrs = []
|
||||
Ident = Some (Ident.create "_SchemaUnspecified")
|
||||
Type = SynType.obj
|
||||
}
|
||||
|> SynField.make
|
||||
|> List.singleton
|
||||
else
|
||||
properties
|
||||
|
||||
let defn =
|
||||
let sci =
|
||||
SynComponentInfo.create (Ident.createSanitisedTypeName fSharpTypeName)
|
||||
|> SynComponentInfo.addAttributes
|
||||
[
|
||||
SynAttribute.create (SynLongIdent.createS' [ "JsonParse" ]) (SynExpr.CreateConst true)
|
||||
SynAttribute.create
|
||||
(SynLongIdent.createS' [ "JsonSerialize" ])
|
||||
(SynExpr.CreateConst true)
|
||||
]
|
||||
|> fun sci ->
|
||||
match obj.Description with
|
||||
| None -> sci
|
||||
| Some doc -> sci |> SynComponentInfo.withDocString (PreXmlDoc.create doc)
|
||||
|
||||
properties |> SynTypeDefnRepr.record |> SynTypeDefn.create sci
|
||||
|
||||
let defn =
|
||||
{
|
||||
Signature = SynType.named fSharpTypeName
|
||||
FSharpDefinition = Some defn
|
||||
}
|
||||
|
||||
defn |> Some
|
||||
|
||||
| Definition.Array elt ->
|
||||
let child = defnToType anonymousTypeCount handlesMap bigCache thisKey None elt.Items
|
||||
|
||||
match child with
|
||||
| None -> None
|
||||
| Some child ->
|
||||
let defn =
|
||||
{
|
||||
Signature = SynType.list child.Signature
|
||||
FSharpDefinition = None
|
||||
}
|
||||
|
||||
Some defn
|
||||
| Definition.String ->
|
||||
{
|
||||
Signature = SynType.string
|
||||
FSharpDefinition = None
|
||||
}
|
||||
|> Some
|
||||
| Definition.Boolean ->
|
||||
{
|
||||
Signature = SynType.bool
|
||||
FSharpDefinition = None
|
||||
}
|
||||
|> Some
|
||||
| Definition.Unspecified ->
|
||||
{
|
||||
Signature = SynType.unit
|
||||
FSharpDefinition = None
|
||||
}
|
||||
|> Some
|
||||
| Definition.Integer _ ->
|
||||
{
|
||||
Signature = SynType.createLongIdent' [ "int" ]
|
||||
FSharpDefinition = None
|
||||
}
|
||||
|> Some
|
||||
| Definition.File ->
|
||||
{
|
||||
Signature = SynType.createLongIdent' [ "System" ; "IO" ; "Stream" ]
|
||||
FSharpDefinition = None
|
||||
}
|
||||
|> Some
|
||||
| Definition.Handle s ->
|
||||
let split = s.Split '/' |> List.ofArray
|
||||
|
||||
match split with
|
||||
| [ "#" ; _location ; _handle ] ->
|
||||
match handlesMap.TryGetValue s with
|
||||
| false, _ -> None
|
||||
| true, computed ->
|
||||
let defn =
|
||||
{
|
||||
FSharpDefinition = None
|
||||
Signature = computed.Signature
|
||||
}
|
||||
|
||||
defn |> Some
|
||||
| _ -> failwith $"we don't know how to deal with object handle %s{s}"
|
||||
|
||||
match result with
|
||||
| None -> None
|
||||
| Some result ->
|
||||
|
||||
match handleKey with
|
||||
| None -> ()
|
||||
| Some handleKey -> handlesMap.Add (handleKey, result)
|
||||
|
||||
cache.Add (d, result)
|
||||
Some result
|
||||
|
||||
let instantiateRequiredTypes (types : Types) : SynModuleDecl =
|
||||
types.ByDefinition
|
||||
|> Seq.choose (fun (KeyValue (_defn, typeEntry)) -> typeEntry.FSharpDefinition)
|
||||
|> Seq.toList
|
||||
|> SynModuleDecl.createTypes
|
||||
|
||||
type private IsIn =
|
||||
| Path of str : string
|
||||
| Query of str : string
|
||||
| Body
|
||||
|
||||
let computeType
|
||||
(options : SwaggerClientConfig)
|
||||
(basePath : string)
|
||||
(types : Types)
|
||||
(clientDocString : PreXmlDoc)
|
||||
(endpoints : Endpoint list)
|
||||
: SynModuleDecl list
|
||||
=
|
||||
endpoints
|
||||
|> List.choose (fun ep ->
|
||||
let name = (Ident.createSanitisedTypeName (ep.Operation.ToString ())).idText
|
||||
|
||||
match renderType types ep.ReturnType with
|
||||
| None ->
|
||||
log $"Skipping %O{ep.Operation}: Couldn't render return type: %O{ep.ReturnType}"
|
||||
None
|
||||
| Some returnType ->
|
||||
|
||||
let pars =
|
||||
ep.Parameters
|
||||
|> List.map (fun par ->
|
||||
let inParam =
|
||||
match par.In with
|
||||
| ParameterIn.Unrecognised (f, name) ->
|
||||
log
|
||||
$"Skipping %O{ep.Operation} at %s{ep.Endpoint}: unrecognised In parameter %s{f} with name %s{name}"
|
||||
|
||||
None
|
||||
| ParameterIn.Body -> Some IsIn.Body
|
||||
| ParameterIn.Query name -> Some (IsIn.Query name)
|
||||
| ParameterIn.Path name -> Some (IsIn.Path name)
|
||||
|
||||
match inParam with
|
||||
| None -> None
|
||||
| Some inParam ->
|
||||
|
||||
match renderType types par.Type with
|
||||
| None ->
|
||||
// Couldn't render the return type
|
||||
// failwith "Did not have a type here"
|
||||
log $"Skipping %O{ep.Operation}: Couldn't render parameter: %O{par.Type}"
|
||||
None
|
||||
| Some v -> Some (Ident.createSanitisedParamName par.Name, inParam, v)
|
||||
)
|
||||
|> List.allSome
|
||||
|
||||
match pars with
|
||||
| None -> None
|
||||
| Some pars ->
|
||||
|
||||
let arity =
|
||||
SynValInfo.SynValInfo (
|
||||
[
|
||||
ep.Parameters
|
||||
|> List.map (fun par ->
|
||||
let name = par.Name |> Ident.create |> Some
|
||||
SynArgInfo.SynArgInfo ([], false, name)
|
||||
)
|
||||
|> fun l -> l @ [ SynArgInfo.SynArgInfo ([], true, Some (Ident.create "ct")) ]
|
||||
],
|
||||
SynArgInfo.SynArgInfo ([], false, None)
|
||||
)
|
||||
|
||||
let domain =
|
||||
let ctParam =
|
||||
SynType.signatureParamOfType
|
||||
[]
|
||||
(SynType.createLongIdent' [ "System" ; "Threading" ; "CancellationToken" ])
|
||||
true
|
||||
(Some (Ident.create "ct"))
|
||||
|
||||
let argParams =
|
||||
pars
|
||||
|> List.map (fun (ident, isIn, t) ->
|
||||
let attr : SynAttribute list =
|
||||
match isIn with
|
||||
| IsIn.Path name ->
|
||||
SynAttribute.create
|
||||
(SynLongIdent.createS' [ "RestEase" ; "Path" ])
|
||||
(SynExpr.CreateConst name)
|
||||
|> List.singleton
|
||||
| IsIn.Query name ->
|
||||
SynAttribute.create
|
||||
(SynLongIdent.createS' [ "RestEase" ; "Query" ])
|
||||
(SynExpr.CreateConst name)
|
||||
|> List.singleton
|
||||
| IsIn.Body ->
|
||||
SynAttribute.create
|
||||
(SynLongIdent.createS' [ "RestEase" ; "Body" ])
|
||||
(SynExpr.CreateConst ())
|
||||
|> List.singleton
|
||||
|
||||
SynType.signatureParamOfType attr t false (Some ident)
|
||||
)
|
||||
|
||||
SynType.tupleNoParen (argParams @ [ ctParam ]) |> Option.get
|
||||
|
||||
let attrs =
|
||||
[
|
||||
SynAttribute.create
|
||||
(SynLongIdent.createS' [ "RestEase" ; ep.Method.ToString () ])
|
||||
// Gitea, at least, starts with a `/`, which `Uri` then takes to indicate an absolute path.
|
||||
(SynExpr.CreateConst (ep.Endpoint.TrimStart '/'))
|
||||
|
||||
match ep.Produces with
|
||||
| Produces.Produces contentType ->
|
||||
SynAttribute.create
|
||||
(SynLongIdent.createS' [ "RestEase" ; "Header" ])
|
||||
// Gitea, at least, starts with a `/`, which `Uri` then takes to indicate an absolute path.
|
||||
(SynExpr.tuple [ SynExpr.CreateConst "Content-Type" ; SynExpr.CreateConst contentType ])
|
||||
]
|
||||
|
||||
returnType
|
||||
|> SynType.task
|
||||
|> SynType.toFun [ domain ]
|
||||
|> SynMemberDefn.abstractMember attrs (SynIdent.createS name) None arity ep.DocString
|
||||
|> Some
|
||||
)
|
||||
|> SynTypeDefnRepr.interfaceType
|
||||
|> SynTypeDefn.create (
|
||||
let attrs =
|
||||
[
|
||||
yield
|
||||
SynAttribute.create
|
||||
(SynLongIdent.createS' [ "RestEase" ; "BasePath" ])
|
||||
(SynExpr.CreateConst basePath)
|
||||
]
|
||||
|
||||
SynComponentInfo.create (Ident.create ("I" + options.ClassName))
|
||||
|> SynComponentInfo.withDocString clientDocString
|
||||
|> SynComponentInfo.addAttributes attrs
|
||||
)
|
||||
|> List.singleton
|
||||
|> SynModuleDecl.createTypes
|
||||
|> List.singleton
|
||||
|
||||
/// Whippet generator that stamps out an interface and class to access a Swagger-specified API.
|
||||
[<WhippetGenerator>]
|
||||
type SwaggerClientGenerator () =
|
||||
|
||||
interface IGenerateRawFromRaw with
|
||||
member _.GenerateRawFromRaw (context : RawSourceGenerationArgs) =
|
||||
if not (context.FilePath.EndsWith (".json", StringComparison.Ordinal)) then
|
||||
null
|
||||
else
|
||||
|
||||
let contents = Encoding.UTF8.GetString context.FileContents |> Swagger.parse
|
||||
|
||||
let scheme =
|
||||
let preferred = Scheme "https"
|
||||
|
||||
if List.isEmpty contents.Schemes then
|
||||
failwith "no schemes specified in API spec!"
|
||||
|
||||
if List.contains preferred contents.Schemes then
|
||||
preferred
|
||||
else
|
||||
List.head contents.Schemes
|
||||
|
||||
let clientDocstring = contents.Info.Description |> PreXmlDoc.create
|
||||
|
||||
let basePath = contents.BasePath
|
||||
|
||||
let typeDefs =
|
||||
let bigCache = Dictionary<_, Dictionary<_, _>> ()
|
||||
|
||||
let countAll () =
|
||||
(0, bigCache) ||> Seq.fold (fun count (KeyValue (_, v)) -> count + v.Count)
|
||||
|
||||
let byHandle = Dictionary ()
|
||||
let anonymousTypeCount = ref 0
|
||||
|
||||
let rec go (contents : ((string * Definition) * string) list) =
|
||||
let lastRound = countAll ()
|
||||
|
||||
contents
|
||||
|> List.filter (fun ((name, defn), defnClass) ->
|
||||
let doIt =
|
||||
SwaggerClientGenerator.defnToType
|
||||
anonymousTypeCount
|
||||
byHandle
|
||||
bigCache
|
||||
defnClass
|
||||
(Some name)
|
||||
defn
|
||||
|
||||
match doIt with
|
||||
| None -> true
|
||||
| Some _ -> false
|
||||
)
|
||||
|> fun remaining ->
|
||||
if not remaining.IsEmpty then
|
||||
let currentCount = countAll ()
|
||||
|
||||
if currentCount = lastRound then
|
||||
for (name, remaining), kind in remaining do
|
||||
SwaggerClientGenerator.log $"Remaining: %s{name} (%s{kind})"
|
||||
|
||||
SwaggerClientGenerator.log "--------"
|
||||
|
||||
for KeyValue (handle, defn) in byHandle do
|
||||
SwaggerClientGenerator.log $"Known: %s{handle} %O{defn}"
|
||||
|
||||
// TODO: ohh noooooo the Gitea spec is genuinely circular,
|
||||
// it's impossible to construct a Repository type
|
||||
// we're going to have to somehow detect this case and break the cycle
|
||||
// by artificially making a property optional
|
||||
// :sob: Gitea why are you like this
|
||||
// failwith "Made no further progress rendering types"
|
||||
()
|
||||
else
|
||||
go remaining
|
||||
|
||||
seq {
|
||||
for defnClass in [ "definitions" ; "responses" ] do
|
||||
match defnClass with
|
||||
| "definitions" ->
|
||||
for KeyValue (k, v) in contents.Definitions do
|
||||
yield (k, v), defnClass
|
||||
| "responses" ->
|
||||
for KeyValue (k, v) in contents.Responses do
|
||||
yield (k, v.Schema), defnClass
|
||||
| _ -> failwith "oh no"
|
||||
}
|
||||
|> Seq.toList
|
||||
|> go
|
||||
|
||||
let result = Dictionary ()
|
||||
|
||||
for KeyValue (_container, types) in bigCache do
|
||||
for KeyValue (defn, rendered) in types do
|
||||
result.TryAdd (defn, rendered) |> ignore<bool>
|
||||
|
||||
{
|
||||
ByHandle = byHandle
|
||||
ByDefinition = result :> IReadOnlyDictionary<_, _>
|
||||
}
|
||||
|
||||
let summary =
|
||||
contents.Paths
|
||||
|> Seq.collect (fun (KeyValue (path, endpoints)) ->
|
||||
endpoints
|
||||
|> Seq.choose (fun (KeyValue (method, endpoint)) ->
|
||||
let docstring = endpoint.Summary |> PreXmlDoc.create
|
||||
|
||||
let produces =
|
||||
match endpoint.Produces with
|
||||
| None -> Produces "json"
|
||||
| Some [] -> failwith $"API specified empty Produces: %s{path} (%O{method})"
|
||||
| Some [ MimeType "application/json" ] -> Produces "json"
|
||||
| Some [ MimeType (StartsWith "text/" t) ] -> Produces t
|
||||
| Some [ MimeType s ] ->
|
||||
failwithf
|
||||
$"we don't support non-JSON Produces right now, got: %s{s} (%s{path} %O{method})"
|
||||
| Some (_ :: _) ->
|
||||
failwith $"we don't support multiple Produces right now, at %s{path} (%O{method})"
|
||||
|
||||
let returnType =
|
||||
endpoint.Responses
|
||||
|> Seq.choose (fun (KeyValue (response, defn)) ->
|
||||
if 200 <= response && response < 300 then
|
||||
Some defn
|
||||
else
|
||||
None
|
||||
)
|
||||
|> Seq.toList
|
||||
|
||||
let returnType =
|
||||
match returnType with
|
||||
| [ t ] -> Some t
|
||||
| [] -> failwith $"got no successful response results, %s{path} %O{method}"
|
||||
| _ ->
|
||||
SwaggerClientGenerator.log
|
||||
$"Ignoring %s{path} %O{method} due to multiple success responses"
|
||||
// can't be bothered to work out how to deal with multiple success
|
||||
// results right now
|
||||
None
|
||||
|
||||
match returnType with
|
||||
| None -> None
|
||||
| Some returnType ->
|
||||
|
||||
{
|
||||
Method = method
|
||||
Produces = produces
|
||||
DocString = docstring
|
||||
ReturnType = returnType
|
||||
Operation = endpoint.OperationId
|
||||
Parameters = endpoint.Parameters |> Option.defaultValue []
|
||||
Endpoint = path
|
||||
}
|
||||
|> Some
|
||||
)
|
||||
|> Seq.toList
|
||||
)
|
||||
|> Seq.toList
|
||||
|
||||
let config =
|
||||
let pars =
|
||||
context.Parameters
|
||||
|> Seq.map (fun (KeyValue (k, v)) -> k.ToUpperInvariant (), v)
|
||||
|> Map.ofSeq
|
||||
|
||||
if pars.IsEmpty then
|
||||
failwith "No parameters given. You must supply the <WhippetParamClassName /> parameter."
|
||||
|
||||
let className =
|
||||
match Map.tryFind "CLASSNAME" pars with
|
||||
| None -> failwith "You must supply the <WhippetParamClassName /> parameter."
|
||||
| Some v -> v
|
||||
|
||||
{
|
||||
ClassName = className
|
||||
}
|
||||
|
||||
let ty =
|
||||
SwaggerClientGenerator.computeType config basePath typeDefs clientDocstring summary
|
||||
|
||||
[
|
||||
yield
|
||||
SynModuleDecl.openAny (
|
||||
SynOpenDeclTarget.ModuleOrNamespace (
|
||||
SynLongIdent.createS' [ "WoofWare" ; "Whippet" ; "Plugin" ; "Json" ],
|
||||
range0
|
||||
)
|
||||
)
|
||||
yield
|
||||
SynModuleDecl.openAny (
|
||||
SynOpenDeclTarget.ModuleOrNamespace (
|
||||
SynLongIdent.createS' [ "WoofWare" ; "Whippet" ; "Plugin" ; "HttpClient" ],
|
||||
range0
|
||||
)
|
||||
)
|
||||
yield SwaggerClientGenerator.instantiateRequiredTypes typeDefs
|
||||
yield! ty
|
||||
]
|
||||
|> SynModuleOrNamespace.createNamespace [ Ident.create config.ClassName ]
|
||||
|> List.singleton
|
||||
|> Ast.render
|
||||
|> Option.toObj
|
||||
11
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/Text.fs
Normal file
11
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/Text.fs
Normal file
@@ -0,0 +1,11 @@
|
||||
namespace WoofWare.Whippet.Plugin.Swagger
|
||||
|
||||
open System
|
||||
|
||||
[<AutoOpen>]
|
||||
module internal Text =
|
||||
let (|StartsWith|_|) (prefix : string) (s : string) : string option =
|
||||
if s.StartsWith (prefix, StringComparison.Ordinal) then
|
||||
Some (s.Substring prefix.Length)
|
||||
else
|
||||
None
|
||||
@@ -0,0 +1,84 @@
|
||||
namespace WoofWare.Whippet.Plugin.Swagger.Test
|
||||
|
||||
open System.Text.Json.Nodes
|
||||
open NUnit.Framework
|
||||
open FsUnitTyped
|
||||
open WoofWare.Whippet.Plugin.Swagger
|
||||
|
||||
[<TestFixture>]
|
||||
module TestSwaggerParse =
|
||||
[<Test>]
|
||||
let ``Can parse parameters`` () : unit =
|
||||
let s =
|
||||
"""{
|
||||
"tags": [
|
||||
"organization"
|
||||
],
|
||||
"summary": "Check if a user is a member of an organization",
|
||||
"operationId": "orgIsMember",
|
||||
"parameters": [
|
||||
{
|
||||
"type": "string",
|
||||
"description": "name of the organization",
|
||||
"name": "org",
|
||||
"in": "path",
|
||||
"required": true
|
||||
},
|
||||
{
|
||||
"type": "string",
|
||||
"description": "username of the user",
|
||||
"name": "username",
|
||||
"in": "path",
|
||||
"required": true
|
||||
}
|
||||
],
|
||||
"responses": {
|
||||
"204": {
|
||||
"description": "user is a member"
|
||||
},
|
||||
"303": {
|
||||
"description": "redirection to /orgs/{org}/public_members/{username}"
|
||||
},
|
||||
"404": {
|
||||
"description": "user is not a member"
|
||||
}
|
||||
}
|
||||
}
|
||||
"""
|
||||
|> JsonNode.Parse
|
||||
|
||||
s.AsObject ()
|
||||
|> SwaggerEndpoint.Parse
|
||||
|> shouldEqual
|
||||
{
|
||||
Consumes = None
|
||||
Produces = None
|
||||
Tags = [ "organization" ]
|
||||
Summary = "Check if a user is a member of an organization"
|
||||
OperationId = OperationId "orgIsMember"
|
||||
Parameters =
|
||||
[
|
||||
{
|
||||
Type = Definition.String
|
||||
Description = Some "name of the organization"
|
||||
Name = "org"
|
||||
In = ParameterIn.Path "org"
|
||||
Required = Some true
|
||||
}
|
||||
{
|
||||
Type = Definition.String
|
||||
Description = Some "username of the user"
|
||||
Name = "username"
|
||||
In = ParameterIn.Path "username"
|
||||
Required = Some true
|
||||
}
|
||||
]
|
||||
|> Some
|
||||
Responses =
|
||||
[
|
||||
204, Definition.Unspecified
|
||||
303, Definition.Unspecified
|
||||
404, Definition.Unspecified
|
||||
]
|
||||
|> Map.ofList
|
||||
}
|
||||
@@ -0,0 +1,25 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net8.0</TargetFramework>
|
||||
<IsPackable>false</IsPackable>
|
||||
<IsTestProject>true</IsTestProject>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<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"/>
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="TestSwaggerParse.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\..\WoofWare.Whippet.Plugin.Swagger.Consumer\WoofWare.Whippet.Plugin.Swagger.Consumer.fsproj" />
|
||||
<ProjectReference Include="..\WoofWare.Whippet.Plugin.Swagger.fsproj" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
@@ -0,0 +1,44 @@
|
||||
<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 Swagger 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;swagger</PackageTags>
|
||||
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
|
||||
<WarnOn>FS3559</WarnOn>
|
||||
<PackageId>WoofWare.Whippet.Plugin.Swagger</PackageId>
|
||||
<DevelopmentDependency>true</DevelopmentDependency>
|
||||
<CopyLocalLockFileAssemblies>true</CopyLocalLockFileAssemblies>
|
||||
<NoWarn>NU5118</NoWarn>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="List.fs" />
|
||||
<Compile Include="Text.fs" />
|
||||
<Compile Include="Swagger.fs" />
|
||||
<Compile Include="SwaggerClientGenerator.fs" />
|
||||
<EmbeddedResource Include="version.json" />
|
||||
<None Include="README.md">
|
||||
<Pack>True</Pack>
|
||||
<PackagePath>/</PackagePath>
|
||||
<Link>README.md</Link>
|
||||
</None>
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="System.Text.Json" Version="8.0.4" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\..\..\WoofWare.Whippet.Core\WoofWare.Whippet.Core.fsproj" />
|
||||
<ProjectReference Include="..\..\..\WoofWare.Whippet.Fantomas\WoofWare.Whippet.Fantomas.fsproj" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
13
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/version.json
Normal file
13
Plugins/Swagger/WoofWare.Whippet.Plugin.Swagger/version.json
Normal file
@@ -0,0 +1,13 @@
|
||||
{
|
||||
"version": "0.1",
|
||||
"publicReleaseRefSpec": [
|
||||
"^refs/heads/main$"
|
||||
],
|
||||
"pathFilters": [
|
||||
"./",
|
||||
":/WoofWare.Whippet.Core/",
|
||||
":/WoofWare.Whippet.Fantomas/",
|
||||
":/global.json",
|
||||
":/Directory.Build.props"
|
||||
]
|
||||
}
|
||||
Reference in New Issue
Block a user