diff --git a/CHANGELOG.md b/CHANGELOG.md index 329844b1..7c815bdb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,24 @@ Notable changes are recorded here. +# Unreleased + +The `swagger-client` generator now accepts OpenAPI 3.0 JSON documents as well as Swagger 2.0 documents. +It generates DTO records and a chained `HttpClient` interface from component schemas, paths, parameters, request bodies, responses, and root server definitions. +Unsupported or structurally ambiguous OpenAPI constructs fail with structured, JSON-pointer-located diagnostics; unconstrained JSON values preserve `null`, and unbounded integers use `BigInteger`. + +The OpenAPI 3.0 generator now applies `security` requirements, rather than ignoring them. +Each security scheme an operation requires becomes a `unit -> string` argument of the generated `make`, evaluated afresh per request, and each operation sends exactly the credentials its own requirement asks for (an operation with `security: []` sends none). +Supported schemes are the header-carried ones: `apiKey` in a header, `http` of any scheme, and `oauth2`/`openIdConnect` (for which you supply the `Authorization` header value; no token flow is performed). +Where an operation can be authenticated in more than one way, the generator refuses to guess: name the one you want in the new `SecuritySchemes` Myriad parameter (or set it empty to send no credentials wherever the document permits that). +An operation with no satisfiable requirement is now a build failure rather than a silently unauthenticated client. + +Fixes a latent bug in the `HttpClient` generator: an interface property named `Client` collided with the `HttpClient` argument of the generated `make`, so the generated source did not compile. + +Adds the `[]` attribute for the `HttpClient` generator, which sets a header on one member's requests, taking its value from a property of the same interface. +(`[]` on a property continues to set its header on every member's requests.) +The property may be named either by a string literal or by `nameof Unchecked.defaultof.TheProperty`. +This is how the OpenAPI generator expresses per-operation security requirements. + # WoofWare.Myriad.Plugins 10.3.1 The `ArgParserGenerator` now supports positional args together with arbitrary discriminated-union args. diff --git a/ConsumePlugin/ConsumePlugin.fsproj b/ConsumePlugin/ConsumePlugin.fsproj index 3b8a7408..4ffe9c22 100644 --- a/ConsumePlugin/ConsumePlugin.fsproj +++ b/ConsumePlugin/ConsumePlugin.fsproj @@ -113,6 +113,16 @@ OpensLeakRegression.fs + + + openapi-petstore.json + + OpenApiPetstore + + + + GeneratedOpenApiPetstore.fs + swagger-gitea.json diff --git a/ConsumePlugin/Generated2OpenApiPetstore.fs b/ConsumePlugin/Generated2OpenApiPetstore.fs new file mode 100644 index 00000000..5a62a085 --- /dev/null +++ b/ConsumePlugin/Generated2OpenApiPetstore.fs @@ -0,0 +1,1196 @@ +//------------------------------------------------------------------------------ +// This code was generated by myriad. +// Changes to this file will be lost when the code is regenerated. +//------------------------------------------------------------------------------ + + + +namespace OpenApiPetstore + +open WoofWare.Myriad.Plugins + +/// Module containing JSON serializing extension members for the GenerateMockAttribute2 type +[] +module GenerateMockAttribute2JsonSerializeExtension = + /// Extension methods for JSON parsing + type GenerateMockAttribute2 with + + /// Serialize to a JSON node + static member toJsonNode (input : GenerateMockAttribute2) : System.Text.Json.Nodes.JsonNode = + let node = System.Text.Json.Nodes.JsonObject () + + do + for KeyValue (key, value) in input.AdditionalProperties do + node.Add ( + key, + (fun field -> + match field with + | None -> None + | Some field -> + field + |> (fun node -> + match node |> box with + | null -> Unchecked.defaultof + | _ -> (node : System.Text.Json.Nodes.JsonNode).DeepClone () + ) + |> Some + ) + value + |> Option.toObj + ) + + node.Add ( + "value", + (input.Value + |> (fun field -> + match field with + | None -> None + | Some field -> + (field + |> (fun field -> + let field = System.Text.Json.Nodes.JsonValue.Create field + + (match field with + | null -> + raise ( + System.ArgumentNullException ( + "field", + "Expected type string to be non-null, but received a null value when serialising" + ) + ) + | field -> field) + )) + :> System.Text.Json.Nodes.JsonNode + |> Some + ) + |> Option.toObj) + ) + + node :> _ +namespace OpenApiPetstore + +open WoofWare.Myriad.Plugins + +/// Module containing JSON serializing extension members for the HttpClientAttribute2 type +[] +module HttpClientAttribute2JsonSerializeExtension = + /// Extension methods for JSON parsing + type HttpClientAttribute2 with + + /// Serialize to a JSON node + static member toJsonNode (input : HttpClientAttribute2) : System.Text.Json.Nodes.JsonNode = + let node = System.Text.Json.Nodes.JsonObject () + + do + for KeyValue (key, value) in input.AdditionalProperties do + node.Add ( + key, + (fun field -> + match field with + | None -> None + | Some field -> + field + |> (fun node -> + match node |> box with + | null -> Unchecked.defaultof + | _ -> (node : System.Text.Json.Nodes.JsonNode).DeepClone () + ) + |> Some + ) + value + |> Option.toObj + ) + + node.Add ( + "value", + (input.Value + |> (fun field -> + match field with + | None -> None + | Some field -> + (field + |> (fun field -> + let field = System.Text.Json.Nodes.JsonValue.Create field + + (match field with + | null -> + raise ( + System.ArgumentNullException ( + "field", + "Expected type string to be non-null, but received a null value when serialising" + ) + ) + | field -> field) + )) + :> System.Text.Json.Nodes.JsonNode + |> Some + ) + |> Option.toObj) + ) + + node :> _ +namespace OpenApiPetstore + +open WoofWare.Myriad.Plugins + +/// Module containing JSON serializing extension members for the JsonParseAttribute2 type +[] +module JsonParseAttribute2JsonSerializeExtension = + /// Extension methods for JSON parsing + type JsonParseAttribute2 with + + /// Serialize to a JSON node + static member toJsonNode (input : JsonParseAttribute2) : System.Text.Json.Nodes.JsonNode = + let node = System.Text.Json.Nodes.JsonObject () + + do + for KeyValue (key, value) in input.AdditionalProperties do + node.Add ( + key, + (fun field -> + match field with + | None -> None + | Some field -> + field + |> (fun node -> + match node |> box with + | null -> Unchecked.defaultof + | _ -> (node : System.Text.Json.Nodes.JsonNode).DeepClone () + ) + |> Some + ) + value + |> Option.toObj + ) + + node.Add ( + "value", + (input.Value + |> (fun field -> + match field with + | None -> None + | Some field -> + (field + |> (fun field -> + let field = System.Text.Json.Nodes.JsonValue.Create field + + (match field with + | null -> + raise ( + System.ArgumentNullException ( + "field", + "Expected type string to be non-null, but received a null value when serialising" + ) + ) + | field -> field) + )) + :> System.Text.Json.Nodes.JsonNode + |> Some + ) + |> Option.toObj) + ) + + node :> _ +namespace OpenApiPetstore + +open WoofWare.Myriad.Plugins + +/// Module containing JSON serializing extension members for the JsonSerializeAttribute2 type +[] +module JsonSerializeAttribute2JsonSerializeExtension = + /// Extension methods for JSON parsing + type JsonSerializeAttribute2 with + + /// Serialize to a JSON node + static member toJsonNode (input : JsonSerializeAttribute2) : System.Text.Json.Nodes.JsonNode = + let node = System.Text.Json.Nodes.JsonObject () + + do + for KeyValue (key, value) in input.AdditionalProperties do + node.Add ( + key, + (fun field -> + match field with + | None -> None + | Some field -> + field + |> (fun node -> + match node |> box with + | null -> Unchecked.defaultof + | _ -> (node : System.Text.Json.Nodes.JsonNode).DeepClone () + ) + |> Some + ) + value + |> Option.toObj + ) + + node.Add ( + "value", + (input.Value + |> (fun field -> + match field with + | None -> None + | Some field -> + (field + |> (fun field -> + let field = System.Text.Json.Nodes.JsonValue.Create field + + (match field with + | null -> + raise ( + System.ArgumentNullException ( + "field", + "Expected type string to be non-null, but received a null value when serialising" + ) + ) + | field -> field) + )) + :> System.Text.Json.Nodes.JsonNode + |> Some + ) + |> Option.toObj) + ) + + node :> _ +namespace OpenApiPetstore + +open WoofWare.Myriad.Plugins + +/// Module containing JSON serializing extension members for the NewPet type +[] +module NewPetJsonSerializeExtension = + /// Extension methods for JSON parsing + type NewPet with + + /// Serialize to a JSON node + static member toJsonNode (input : NewPet) : System.Text.Json.Nodes.JsonNode = + let node = System.Text.Json.Nodes.JsonObject () + + do + for KeyValue (key, value) in input.AdditionalProperties do + node.Add ( + key, + (fun field -> + match field with + | None -> None + | Some field -> + field + |> (fun node -> + match node |> box with + | null -> Unchecked.defaultof + | _ -> (node : System.Text.Json.Nodes.JsonNode).DeepClone () + ) + |> Some + ) + value + |> Option.toObj + ) + + node.Add ( + "name", + (input.Name + |> (fun field -> + let field = System.Text.Json.Nodes.JsonValue.Create field + + (match field with + | null -> + raise ( + System.ArgumentNullException ( + "field", + "Expected type string to be non-null, but received a null value when serialising" + ) + ) + | field -> field) + )) + ) + + node.Add ( + "tag", + (input.Tag + |> (fun field -> + match field with + | None -> None + | Some field -> + (field + |> (fun field -> + let field = System.Text.Json.Nodes.JsonValue.Create field + + (match field with + | null -> + raise ( + System.ArgumentNullException ( + "field", + "Expected type string to be non-null, but received a null value when serialising" + ) + ) + | field -> field) + )) + :> System.Text.Json.Nodes.JsonNode + |> Some + ) + |> Option.toObj) + ) + + node :> _ +namespace OpenApiPetstore + +open WoofWare.Myriad.Plugins + +/// Module containing JSON serializing extension members for the Pet type +[] +module PetJsonSerializeExtension = + /// Extension methods for JSON parsing + type Pet with + + /// Serialize to a JSON node + static member toJsonNode (input : Pet) : System.Text.Json.Nodes.JsonNode = + let node = System.Text.Json.Nodes.JsonObject () + + do + for KeyValue (key, value) in input.AdditionalProperties do + node.Add ( + key, + (fun field -> + match field with + | None -> None + | Some field -> + field + |> (fun node -> + match node |> box with + | null -> Unchecked.defaultof + | _ -> (node : System.Text.Json.Nodes.JsonNode).DeepClone () + ) + |> Some + ) + value + |> Option.toObj + ) + + node.Add ( + "id", + (input.Id + |> (fun field -> + let field = System.Text.Json.Nodes.JsonValue.Create field + + (match field with + | null -> + raise ( + System.ArgumentNullException ( + "field", + "Expected type int64 to be non-null, but received a null value when serialising" + ) + ) + | field -> field) + )) + ) + + node.Add ( + "name", + (input.Name + |> (fun field -> + let field = System.Text.Json.Nodes.JsonValue.Create field + + (match field with + | null -> + raise ( + System.ArgumentNullException ( + "field", + "Expected type string to be non-null, but received a null value when serialising" + ) + ) + | field -> field) + )) + ) + + node.Add ( + "parent", + (input.Parent + |> (fun field -> + match field with + | None -> None + | Some field -> field |> Pet.toJsonNode |> Some + ) + |> Option.toObj) + ) + + node.Add ( + "tag", + (input.Tag + |> (fun field -> + match field with + | None -> None + | Some field -> + (field + |> (fun field -> + let field = System.Text.Json.Nodes.JsonValue.Create field + + (match field with + | null -> + raise ( + System.ArgumentNullException ( + "field", + "Expected type string to be non-null, but received a null value when serialising" + ) + ) + | field -> field) + )) + :> System.Text.Json.Nodes.JsonNode + |> Some + ) + |> Option.toObj) + ) + + node :> _ + +namespace OpenApiPetstore + +/// Module containing JSON parsing extension members for the GenerateMockAttribute2 type +[] +module GenerateMockAttribute2JsonParseExtension = + /// Extension methods for JSON parsing + type GenerateMockAttribute2 with + + /// Parse from a JSON node. + static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : GenerateMockAttribute2 = + let arg_1 = + match node.["value"] |> Option.ofObj with + | None -> None + | Some v -> v.AsValue().GetValue () |> Some + + let arg_0 = + let result = + System.Collections.Generic.Dictionary () + + let node = node.AsObject () + + for KeyValue (key, value) in node do + if key = "value" then + () + else + result.Add ( + key, + match node.[key] |> Option.ofObj with + | None -> None + | Some v -> v |> Some + ) + + result + + { + AdditionalProperties = arg_0 + Value = arg_1 + } +namespace OpenApiPetstore + +/// Module containing JSON parsing extension members for the HttpClientAttribute2 type +[] +module HttpClientAttribute2JsonParseExtension = + /// Extension methods for JSON parsing + type HttpClientAttribute2 with + + /// Parse from a JSON node. + static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : HttpClientAttribute2 = + let arg_1 = + match node.["value"] |> Option.ofObj with + | None -> None + | Some v -> v.AsValue().GetValue () |> Some + + let arg_0 = + let result = + System.Collections.Generic.Dictionary () + + let node = node.AsObject () + + for KeyValue (key, value) in node do + if key = "value" then + () + else + result.Add ( + key, + match node.[key] |> Option.ofObj with + | None -> None + | Some v -> v |> Some + ) + + result + + { + AdditionalProperties = arg_0 + Value = arg_1 + } +namespace OpenApiPetstore + +/// Module containing JSON parsing extension members for the JsonParseAttribute2 type +[] +module JsonParseAttribute2JsonParseExtension = + /// Extension methods for JSON parsing + type JsonParseAttribute2 with + + /// Parse from a JSON node. + static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonParseAttribute2 = + let arg_1 = + match node.["value"] |> Option.ofObj with + | None -> None + | Some v -> v.AsValue().GetValue () |> Some + + let arg_0 = + let result = + System.Collections.Generic.Dictionary () + + let node = node.AsObject () + + for KeyValue (key, value) in node do + if key = "value" then + () + else + result.Add ( + key, + match node.[key] |> Option.ofObj with + | None -> None + | Some v -> v |> Some + ) + + result + + { + AdditionalProperties = arg_0 + Value = arg_1 + } +namespace OpenApiPetstore + +/// Module containing JSON parsing extension members for the JsonSerializeAttribute2 type +[] +module JsonSerializeAttribute2JsonParseExtension = + /// Extension methods for JSON parsing + type JsonSerializeAttribute2 with + + /// Parse from a JSON node. + static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : JsonSerializeAttribute2 = + let arg_1 = + match node.["value"] |> Option.ofObj with + | None -> None + | Some v -> v.AsValue().GetValue () |> Some + + let arg_0 = + let result = + System.Collections.Generic.Dictionary () + + let node = node.AsObject () + + for KeyValue (key, value) in node do + if key = "value" then + () + else + result.Add ( + key, + match node.[key] |> Option.ofObj with + | None -> None + | Some v -> v |> Some + ) + + result + + { + AdditionalProperties = arg_0 + Value = arg_1 + } +namespace OpenApiPetstore + +/// Module containing JSON parsing extension members for the NewPet type +[] +module NewPetJsonParseExtension = + /// Extension methods for JSON parsing + type NewPet with + + /// Parse from a JSON node. + static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : NewPet = + let arg_2 = + match node.["tag"] |> Option.ofObj with + | None -> None + | Some v -> v.AsValue().GetValue () |> Some + + let arg_1 = + match node.["name"] |> Option.ofObj with + | None -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("name") + ) + ) + | Some node -> node.AsValue().GetValue () + + let arg_0 = + let result = + System.Collections.Generic.Dictionary () + + let node = node.AsObject () + + for KeyValue (key, value) in node do + if key = "name" || key = "tag" then + () + else + result.Add ( + key, + match node.[key] |> Option.ofObj with + | None -> None + | Some v -> v |> Some + ) + + result + + { + AdditionalProperties = arg_0 + Name = arg_1 + Tag = arg_2 + } +namespace OpenApiPetstore + +/// Module containing JSON parsing extension members for the Pet type +[] +module PetJsonParseExtension = + /// Extension methods for JSON parsing + type Pet with + + /// Parse from a JSON node. + static member jsonParse (node : System.Text.Json.Nodes.JsonNode) : Pet = + let arg_4 = + match node.["tag"] |> Option.ofObj with + | None -> None + | Some v -> v.AsValue().GetValue () |> Some + + let arg_3 = + match node.["parent"] |> Option.ofObj with + | None -> None + | Some v -> Pet.jsonParse v |> Some + + let arg_2 = + match node.["name"] |> Option.ofObj with + | None -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("name") + ) + ) + | Some node -> node.AsValue().GetValue () + + let arg_1 = + match node.["id"] |> Option.ofObj with + | None -> + raise ( + System.Collections.Generic.KeyNotFoundException ( + sprintf "Required key '%s' not found on JSON object" ("id") + ) + ) + | Some node -> node.AsValue().GetValue () + + let arg_0 = + let result = + System.Collections.Generic.Dictionary () + + let node = node.AsObject () + + for KeyValue (key, value) in node do + if key = "id" || key = "name" || key = "parent" || key = "tag" then + () + else + result.Add ( + key, + match node.[key] |> Option.ofObj with + | None -> None + | Some v -> v |> Some + ) + + result + + { + AdditionalProperties = arg_0 + Id = arg_1 + Name = arg_2 + Parent = arg_3 + Tag = arg_4 + } + +namespace OpenApiPetstore + +open WoofWare.Myriad.Plugins + +/// Module for constructing a REST client. +[] +module OpenApiPetstore = + /// Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties. + let make + (apiKeyAuth : unit -> string) + (bearerAuth : unit -> string) + (client : System.Net.Http.HttpClient) + : IOpenApiPetstore + = + { new IOpenApiPetstore with + member _.ApiKeyAuth : string = apiKeyAuth () + member _.BearerAuth : string = bearerAuth () + + member this.CreatePet (body : NewPet, ct : System.Threading.CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ("pets", System.UriKind.Relative) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Post, + RequestUri = uri + ) + + let queryParams = + new System.Net.Http.StringContent ( + body |> NewPet.toJsonNode |> (fun node -> node.ToJsonString ()) + ) + + do + queryParams.Headers.ContentType <- + System.Net.Http.Headers.MediaTypeHeaderValue.Parse ("application/json; charset=utf-8") + + do httpMessage.Content <- queryParams + do httpMessage.Headers.Add ("X-API-Key", this.ApiKeyAuth.ToString ()) + do httpMessage.Headers.Add ("Authorization", this.BearerAuth.ToString ()) + do httpMessage.Headers.Add ("Accept", "application/json") + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + let jsonNode = + (match jsonNode with + | null -> + raise ( + System.ArgumentNullException ( + "jsonNode", + "Response from server was the JSON null object; expected a non-nullable type Pet" + ) + ) + | jsonNode -> jsonNode) + + return Pet.jsonParse jsonNode + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.DeletePet (pet_id : int64, ct : System.Threading.CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ( + "pets/{pet-id}".Replace ("{pet-id}", pet_id.ToString () |> System.Uri.EscapeDataString), + System.UriKind.Relative + ) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Delete, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("Authorization", this.BearerAuth.ToString ()) + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + return () + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.Download (ct : System.Threading.CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ("download", System.UriKind.Relative) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("X-API-Key", this.ApiKeyAuth.ToString ()) + do httpMessage.Headers.Add ("Accept", "application/octet-stream") + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + return responseStream + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.Echo (body : string, ct : System.Threading.CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ("echo", System.UriKind.Relative) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Post, + RequestUri = uri + ) + + let queryParams = new System.Net.Http.StringContent (body) + + do + queryParams.Headers.ContentType <- + System.Net.Http.Headers.MediaTypeHeaderValue.Parse ("text/plain; charset=utf-8") + + do httpMessage.Content <- queryParams + do httpMessage.Headers.Add ("X-API-Key", this.ApiKeyAuth.ToString ()) + do httpMessage.Headers.Add ("Accept", "text/plain") + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask + return responseString + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.EchoAnything + (body : System.Text.Json.Nodes.JsonNode option, ct : System.Threading.CancellationToken option) + = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ("anything", System.UriKind.Relative) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Post, + RequestUri = uri + ) + + let queryParams = + new System.Net.Http.StringContent ( + body + |> (fun field -> + match field with + | None -> "null" + | Some field -> + (fun node -> (node : System.Text.Json.Nodes.JsonNode).ToJsonString ()) field + ) + ) + + do + queryParams.Headers.ContentType <- + System.Net.Http.Headers.MediaTypeHeaderValue.Parse ("application/json; charset=utf-8") + + do httpMessage.Content <- queryParams + do httpMessage.Headers.Add ("X-API-Key", this.ApiKeyAuth.ToString ()) + do httpMessage.Headers.Add ("Accept", "application/json") + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + let jsonNode = jsonNode |> Option.ofObj + + return + match jsonNode with + | None -> None + | Some v -> v |> Some + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.EchoCounter + (body : System.Numerics.BigInteger, ct : System.Threading.CancellationToken option) + = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ("counter", System.UriKind.Relative) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Post, + RequestUri = uri + ) + + let queryParams = + new System.Net.Http.StringContent ( + body + |> (fun field -> + let value = field : System.Numerics.BigInteger + value.ToString ("D", System.Globalization.CultureInfo.InvariantCulture) + ) + ) + + do + queryParams.Headers.ContentType <- + System.Net.Http.Headers.MediaTypeHeaderValue.Parse ("application/json; charset=utf-8") + + do httpMessage.Content <- queryParams + do httpMessage.Headers.Add ("X-API-Key", this.ApiKeyAuth.ToString ()) + do httpMessage.Headers.Add ("Accept", "application/json") + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + let jsonNode = + (match jsonNode with + | null -> + raise ( + System.ArgumentNullException ( + "jsonNode", + "Response from server was the JSON null object; expected a non-nullable type bigint" + ) + ) + | jsonNode -> jsonNode) + + return + System.Numerics.BigInteger.Parse ( + jsonNode.ToJsonString (), + System.Globalization.NumberStyles.Float, + System.Globalization.CultureInfo.InvariantCulture + ) + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.GetCounter (ct : System.Threading.CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ("counter", System.UriKind.Relative) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("X-API-Key", this.ApiKeyAuth.ToString ()) + do httpMessage.Headers.Add ("Accept", "application/json") + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + let jsonNode = + (match jsonNode with + | null -> + raise ( + System.ArgumentNullException ( + "jsonNode", + "Response from server was the JSON null object; expected a non-nullable type bigint" + ) + ) + | jsonNode -> jsonNode) + + return + System.Numerics.BigInteger.Parse ( + jsonNode.ToJsonString (), + System.Globalization.NumberStyles.Float, + System.Globalization.CultureInfo.InvariantCulture + ) + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.GetPet (pet_id : int64, ct : System.Threading.CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ( + "pets/{pet-id}".Replace ("{pet-id}", pet_id.ToString () |> System.Uri.EscapeDataString), + System.UriKind.Relative + ) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("X-API-Key", this.ApiKeyAuth.ToString ()) + do httpMessage.Headers.Add ("Accept", "application/json") + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + let jsonNode = + (match jsonNode with + | null -> + raise ( + System.ArgumentNullException ( + "jsonNode", + "Response from server was the JSON null object; expected a non-nullable type Pet" + ) + ) + | jsonNode -> jsonNode) + + return Pet.jsonParse jsonNode + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member _.GetStatus (ct : System.Threading.CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ("status", System.UriKind.Relative) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("Accept", "text/plain") + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask + return responseString + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.ListPets (limit : int option, ct : System.Threading.CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let queryString = + [ + limit + |> Option.map (fun queryParam -> + "limit=" + ((queryParam.ToString ()) |> System.Uri.EscapeDataString) + ) + |> Option.toList + ] + |> List.concat + |> String.concat "&" + + let uri = + System.Uri ( + (match client.BaseAddress with + | null -> System.Uri "https://api.example.test/v1/public/" + | v -> v), + System.Uri ( + ("pets" + + (if queryString = "" then + "" + else + ((if "pets".IndexOf (char 63) >= 0 then "&" else "?") + queryString))), + System.UriKind.Relative + ) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("X-API-Key", this.ApiKeyAuth.ToString ()) + do httpMessage.Headers.Add ("Accept", "application/json") + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseStream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask + + let! jsonNode = + System.Text.Json.Nodes.JsonNode.ParseAsync (responseStream, cancellationToken = ct) + |> Async.AwaitTask + + let jsonNode = + (match jsonNode with + | null -> + raise ( + System.ArgumentNullException ( + "jsonNode", + "Response from server was the JSON null object; expected a non-nullable type Pet list" + ) + ) + | jsonNode -> jsonNode) + + return + jsonNode.AsArray () + |> Seq.map (fun elt -> + (match elt with + | null -> + raise ( + System.ArgumentNullException ( + "elt", + "Expected element of array (element type Pet) to be non-null, but found a null element" + ) + ) + | elt -> Pet.jsonParse elt) + ) + |> List.ofSeq + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + } diff --git a/ConsumePlugin/GeneratedOpenApiPetstore.fs b/ConsumePlugin/GeneratedOpenApiPetstore.fs new file mode 100644 index 00000000..cf47875b --- /dev/null +++ b/ConsumePlugin/GeneratedOpenApiPetstore.fs @@ -0,0 +1,171 @@ +//------------------------------------------------------------------------------ +// This code was generated by myriad. +// Changes to this file will be lost when the code is regenerated. +//------------------------------------------------------------------------------ + + + + + + + + +namespace OpenApiPetstore + +open WoofWare.Myriad.Plugins + +/// Generated representation of the 'GenerateMockAttribute' OpenAPI schema. +[] +type GenerateMockAttribute2 = + { + [] + AdditionalProperties : System.Collections.Generic.Dictionary + [] + Value : string option + } + +/// Generated representation of the 'HttpClientAttribute' OpenAPI schema. +[] +type HttpClientAttribute2 = + { + [] + AdditionalProperties : System.Collections.Generic.Dictionary + [] + Value : string option + } + +/// Generated representation of the 'JsonParseAttribute' OpenAPI schema. +[] +type JsonParseAttribute2 = + { + [] + AdditionalProperties : System.Collections.Generic.Dictionary + [] + Value : string option + } + +/// Generated representation of the 'JsonSerializeAttribute' OpenAPI schema. +[] +type JsonSerializeAttribute2 = + { + [] + AdditionalProperties : System.Collections.Generic.Dictionary + [] + Value : string option + } + +/// Generated representation of the 'NewPet' OpenAPI schema. +[] +type NewPet = + { + [] + AdditionalProperties : System.Collections.Generic.Dictionary + [] + Name : string + [] + Tag : string option + } + +/// Generated representation of the 'Pet' OpenAPI schema. +[] +type Pet = + { + [] + AdditionalProperties : System.Collections.Generic.Dictionary + [] + Id : int64 + [] + Name : string + [] + Parent : Pet option + [] + Tag : string option + } + +/// A compact OpenAPI 3 fixture used to compile the generated client. +[] +type IOpenApiPetstore = + /// The value of the 'X-API-Key' header, which carries the API key of the 'apiKeyAuth' security scheme. + /// This function is called afresh on every request which requires this scheme, so it can return a token that has since been refreshed. + /// Key issued from the pet store console. + abstract ApiKeyAuth : string + /// The complete value of the 'Authorization' header for the 'bearerAuth' security scheme, which is HTTP authentication scheme 'Bearer'. + /// The value must include the scheme name: for example, "Bearer <credentials>". + /// This function is called afresh on every request which requires this scheme, so it can return a token that has since been refreshed. + abstract BearerAuth : string + + /// Invoke the 'createPet' OpenAPI operation. + [] + [] + [] + [] + [] + abstract CreatePet : + [] body : NewPet * ?ct : System.Threading.CancellationToken -> Pet System.Threading.Tasks.Task + + /// Invoke the 'deletePet' OpenAPI operation. + [] + [] + abstract DeletePet : + [] pet_id : int64 * ?ct : System.Threading.CancellationToken -> + unit System.Threading.Tasks.Task + + /// Invoke the 'download' OpenAPI operation. + [] + [] + [] + abstract Download : ?ct : System.Threading.CancellationToken -> System.IO.Stream System.Threading.Tasks.Task + + /// Invoke the 'echo' OpenAPI operation. + [] + [] + [] + [] + abstract Echo : + [] body : string * ?ct : System.Threading.CancellationToken -> string System.Threading.Tasks.Task + + /// Invoke the 'echoAnything' OpenAPI operation. + [] + [] + [] + [] + abstract EchoAnything : + [] body : System.Text.Json.Nodes.JsonNode option * ?ct : System.Threading.CancellationToken -> + System.Text.Json.Nodes.JsonNode option System.Threading.Tasks.Task + + /// Invoke the 'echoCounter' OpenAPI operation. + [] + [] + [] + [] + abstract EchoCounter : + [] body : System.Numerics.BigInteger * ?ct : System.Threading.CancellationToken -> + System.Numerics.BigInteger System.Threading.Tasks.Task + + /// Invoke the 'getCounter' OpenAPI operation. + [] + [] + [] + abstract GetCounter : + ?ct : System.Threading.CancellationToken -> System.Numerics.BigInteger System.Threading.Tasks.Task + + /// Invoke the 'getPet' OpenAPI operation. + [] + [] + [] + abstract GetPet : + [] pet_id : int64 * ?ct : System.Threading.CancellationToken -> + Pet System.Threading.Tasks.Task + + /// Invoke the 'getStatus' OpenAPI operation. + [] + [] + abstract GetStatus : ?ct : System.Threading.CancellationToken -> string System.Threading.Tasks.Task + + /// Invoke the 'listPets' OpenAPI operation. + [] + [] + [] + abstract ListPets : + [] limit : int option * ?ct : System.Threading.CancellationToken -> + Pet list System.Threading.Tasks.Task diff --git a/ConsumePlugin/GeneratedRestClient.fs b/ConsumePlugin/GeneratedRestClient.fs index 4cbe83f9..2351fca7 100644 --- a/ConsumePlugin/GeneratedRestClient.fs +++ b/ConsumePlugin/GeneratedRestClient.fs @@ -1989,6 +1989,196 @@ open System.Net open System.Net.Http open RestEase +/// Module for constructing a REST client. +[] +module ApiWithPerEndpointHeaders = + /// Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties. + let make + (bearerToken : unit -> string) + (apiKey : unit -> int) + (ubiquitous : unit -> string) + (client : System.Net.Http.HttpClient) + : IApiWithPerEndpointHeaders + = + { new IApiWithPerEndpointHeaders with + member _.BearerToken : string = bearerToken () + member _.ApiKey : int = apiKey () + member _.Ubiquitous : string = ubiquitous () + + member this.Authorized (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 ( + "authorized/{param}" + .Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString), + System.UriKind.Relative + ) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("X-Everywhere", this.Ubiquitous.ToString ()) + do httpMessage.Headers.Add ("Authorization", this.BearerToken.ToString ()) + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask + return responseString + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.Both (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 ( + "both/{param}".Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString), + System.UriKind.Relative + ) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("X-Everywhere", this.Ubiquitous.ToString ()) + do httpMessage.Headers.Add ("Authorization", this.BearerToken.ToString ()) + do httpMessage.Headers.Add ("X-Api-Key", this.ApiKey.ToString ()) + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask + return responseString + } + |> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct)) + + member this.Anonymous (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 ( + "anonymous/{param}" + .Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString), + System.UriKind.Relative + ) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("X-Everywhere", this.Ubiquitous.ToString ()) + let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask + return responseString + } + |> (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. +[] +module ApiWithClientProperty = + /// Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties. + let make (client : unit -> string) (client1 : System.Net.Http.HttpClient) : IApiWithClientProperty = + { new IApiWithClientProperty with + member _.Client : string = client () + + member this.Get (ct : CancellationToken option) = + async { + let! ct = Async.CancellationToken + + let uri = + System.Uri ( + (match client1.BaseAddress with + | null -> + raise ( + System.ArgumentNullException ( + nameof (client1.BaseAddress), + "No base address was supplied on the type, and no BaseAddress was on the HttpClient." + ) + ) + | v -> v), + System.Uri ("endpoint", System.UriKind.Relative) + ) + + use httpMessage = + new System.Net.Http.HttpRequestMessage ( + Method = System.Net.Http.HttpMethod.Get, + RequestUri = uri + ) + + do httpMessage.Headers.Add ("X-Client", this.Client.ToString ()) + let! response = client1.SendAsync (httpMessage, ct) |> Async.AwaitTask + let response = response.EnsureSuccessStatusCode () + use response = response + let! responseString = response.Content.ReadAsStringAsync ct |> Async.AwaitTask + return responseString + } + |> (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. [] module ClientWithJsonBody = diff --git a/ConsumePlugin/RestApiExample.fs b/ConsumePlugin/RestApiExample.fs index 4f7f28fc..d121d373 100644 --- a/ConsumePlugin/RestApiExample.fs +++ b/ConsumePlugin/RestApiExample.fs @@ -211,6 +211,44 @@ type IApiWithHeaders2 = abstract GetPathParam : [] parameter : string * ?ct : CancellationToken -> Task +/// Different endpoints require different credentials, and one requires none at all: exactly the shape +/// OpenAPI security requirements take. +[] +type IApiWithPerEndpointHeaders = + abstract BearerToken : string + + abstract ApiKey : int + + /// Stamps a header onto every endpoint, to prove the two mechanisms compose. + [
] + abstract Ubiquitous : string + + // The property may be named by a literal, or (so that renaming it is a compile error rather than + // a header which silently stops being sent) by `nameof`, which is what the OpenAPI generator emits. + [] + [] + abstract Authorized : [] parameter : string * ?ct : CancellationToken -> Task + + [] + [.BearerToken)>] + [.ApiKey)>] + abstract Both : [] parameter : string * ?ct : CancellationToken -> Task + + [] + abstract Anonymous : [] parameter : string * ?ct : CancellationToken -> Task + +/// Regression test: the generated `make` takes one argument per property plus an HttpClient of its +/// own, so a property named `Client` would collide with it and fail to compile. +[] +type IApiWithClientProperty = + [
] + abstract Client : string + + [] + abstract Get : ?ct : CancellationToken -> Task + [] type IClientWithJsonBody = // As a POST request of a JSON-serialised body, we automatically set Content-Type: application/json. diff --git a/ConsumePlugin/openapi-petstore.json b/ConsumePlugin/openapi-petstore.json new file mode 100644 index 00000000..6706c1d7 --- /dev/null +++ b/ConsumePlugin/openapi-petstore.json @@ -0,0 +1,367 @@ +{ + "openapi": "3.0.3", + "info": { + "title": "Systematic pet store", + "description": "A compact OpenAPI 3 fixture used to compile the generated client.", + "version": "1.0.0" + }, + "servers": [ + { + "url": "https://api.example.test/v1/{tenant}", + "variables": { + "tenant": { + "default": "public" + } + } + } + ], + "paths": { + "/pets": { + "get": { + "operationId": "listPets", + "parameters": [ + { + "name": "limit", + "in": "query", + "required": false, + "schema": { + "type": "integer", + "format": "int32" + } + } + ], + "responses": { + "200": { + "description": "All pets", + "content": { + "application/json": { + "schema": { + "type": "array", + "items": { + "$ref": "#/components/schemas/Pet" + } + } + } + } + } + } + }, + "post": { + "operationId": "createPet", + "requestBody": { + "$ref": "#/components/requestBodies/CreatePet" + }, + "responses": { + "201": { + "$ref": "#/components/responses/PetResponse" + } + }, + "security": [ + { + "apiKeyAuth": [], + "bearerAuth": [] + } + ] + } + }, + "/pets/{pet-id}": { + "parameters": [ + { + "$ref": "#/components/parameters/PetId" + } + ], + "get": { + "operationId": "getPet", + "responses": { + "200": { + "$ref": "#/components/responses/PetResponse" + } + } + }, + "delete": { + "operationId": "deletePet", + "responses": { + "204": { + "description": "Deleted" + } + }, + "security": [ + { + "legacyQueryKey": [] + }, + { + "bearerAuth": [] + } + ] + } + }, + "/status": { + "get": { + "operationId": "getStatus", + "responses": { + "200": { + "description": "Plain-text status", + "content": { + "text/plain": { + "schema": { + "type": "string" + } + } + } + } + }, + "security": [] + } + }, + "/download": { + "get": { + "operationId": "download", + "responses": { + "200": { + "description": "Binary payload", + "content": { + "application/octet-stream": { + "schema": { + "type": "string", + "format": "binary" + } + } + } + } + } + } + }, + "/echo": { + "post": { + "operationId": "echo", + "requestBody": { + "required": true, + "content": { + "text/plain": { + "schema": { + "type": "string" + } + } + } + }, + "responses": { + "200": { + "description": "Echoed text", + "content": { + "text/plain": { + "schema": { + "type": "string" + } + } + } + } + } + } + }, + "/anything": { + "post": { + "operationId": "echoAnything", + "requestBody": { + "required": true, + "content": { + "application/json": { + "schema": {} + } + } + }, + "responses": { + "200": { + "description": "Any JSON value", + "content": { + "application/json": { + "schema": {} + } + } + } + } + } + }, + "/counter": { + "get": { + "operationId": "getCounter", + "responses": { + "200": { + "description": "An unconstrained-size integer", + "content": { + "application/json": { + "schema": { + "type": "integer" + } + } + } + } + } + }, + "post": { + "operationId": "echoCounter", + "requestBody": { + "required": true, + "content": { + "application/json": { + "schema": { + "type": "integer" + } + } + } + }, + "responses": { + "200": { + "description": "The same unconstrained-size integer", + "content": { + "application/json": { + "schema": { + "type": "integer" + } + } + } + } + } + } + } + }, + "components": { + "schemas": { + "NewPet": { + "allOf": [ + { + "type": "object", + "required": [ + "name" + ], + "properties": { + "name": { + "type": "string" + } + } + }, + { + "type": "object", + "properties": { + "tag": { + "type": "string" + } + } + } + ] + }, + "Pet": { + "allOf": [ + { + "$ref": "#/components/schemas/NewPet" + }, + { + "type": "object", + "required": [ + "id" + ], + "properties": { + "id": { + "type": "integer", + "format": "int64" + }, + "parent": { + "$ref": "#/components/schemas/Pet" + } + } + } + ] + }, + "JsonParseAttribute": { + "type": "object", + "properties": { + "value": { + "type": "string" + } + } + }, + "JsonSerializeAttribute": { + "type": "object", + "properties": { + "value": { + "type": "string" + } + } + }, + "HttpClientAttribute": { + "type": "object", + "properties": { + "value": { + "type": "string" + } + } + }, + "GenerateMockAttribute": { + "type": "object", + "properties": { + "value": { + "type": "string" + } + } + } + }, + "parameters": { + "PetId": { + "name": "pet-id", + "in": "path", + "required": true, + "schema": { + "type": "integer", + "format": "int64" + } + } + }, + "requestBodies": { + "CreatePet": { + "required": true, + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/NewPet" + } + } + } + } + }, + "responses": { + "PetResponse": { + "description": "A pet", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/Pet" + } + } + } + } + }, + "securitySchemes": { + "apiKeyAuth": { + "type": "apiKey", + "name": "X-API-Key", + "in": "header", + "description": "Key issued from the pet store console." + }, + "bearerAuth": { + "type": "http", + "scheme": "Bearer", + "bearerFormat": "JWT" + }, + "legacyQueryKey": { + "type": "apiKey", + "name": "api_key", + "in": "query", + "description": "Deprecated: this client cannot carry a key in the query string." + } + } + }, + "security": [ + { + "apiKeyAuth": [] + } + ] +} diff --git a/README.md b/README.md index 2ed8e75c..8d6906cd 100644 --- a/README.md +++ b/README.md @@ -15,7 +15,7 @@ Currently implemented: * `HttpClient` (to stamp out a [RestEase](https://github.com/canton7/RestEase)-style HTTP client). * `GenerateMock` and `GenerateCapturingMock` (to stamp out a record type corresponding to an interface, like a compile-time [Foq](https://github.com/fsprojects/Foq)). * `ArgParser` (to stamp out a basic argument parser). -* `SwaggerClient` (to stamp out an HTTP client for a Swagger API). +* `SwaggerClient` (to stamp out an HTTP client for a Swagger 2.0 or OpenAPI 3.0 API). * `CreateCatamorphism` (to stamp out a non-stack-overflowing [catamorphism](https://fsharpforfunandprofit.com/posts/recursive-types-and-folds/) for a discriminated union). * `RemoveOptions` (to strip `option` modifiers from a type) - this one is particularly half-baked! @@ -285,7 +285,7 @@ It should work fine if you just want to compose a few primitive types, though. ## `SwaggerClient` -Takes a JSON-schema definition of a [Swagger API](https://swagger.io/), and stamps out a client like this: +Takes a JSON definition of a [Swagger 2.0 or OpenAPI 3.0 API](https://swagger.io/), and stamps out a client like this: ```fsharp /// A type which was defined in the Swagger spec @@ -349,6 +349,71 @@ so that the following manoeuvre will result in a generated mock: (Note that you do have to create the `GeneratedSwaggerGitea.fs` file manually before code generation happens. Myriad will throw if that file isn't there, because `Generated2SwaggerGitea.fs` depends on it so Myriad wants to compute its hash. Just make an empty file.) +### OpenAPI 3.0 + +The generator detects the document version from the root `swagger` or `openapi` field, so OpenAPI 3.0 uses the same project configuration as Swagger 2.0. +OpenAPI 3.1 is rejected at build time. + +The OpenAPI 3.0 path supports: + +* local component references for schemas, parameters, request bodies, and responses; +* primitive schemas and formats, arrays, objects, required properties, `nullable`, `additionalProperties`, compatible object `allOf` intersections, and self-recursive records; +* inherited and operation-level path/query parameters, with operation-level overrides; +* JSON and plain-text request bodies, successful JSON/plain-text/binary responses, and no-content responses; +* root server URLs, including expansion of server-variable defaults; +* root and operation-level `security` requirements, for header-carried security schemes; and +* deterministic sanitisation and collision handling for generated F# identifiers. + +The planner fails with a located diagnostic for structural constructs which the generated HTTP/JSON layer cannot represent. +This currently includes OpenAPI 3.1, external references, `oneOf`/`anyOf`/`not`, optional-and-nullable three-state values, mutually recursive groups of records, header/cookie parameters, non-default parameter styles, optional or binary request bodies, and operations whose possible successful responses have incompatible body shapes. + +#### Security requirements + +Each security scheme some operation requires becomes an abstract property on the generated interface, +and hence a `unit -> string` argument of the generated `make`, which is called afresh on every request +that needs that credential (so a token can be refreshed between calls). +Each operation sends exactly the credentials its own `security` demands: an operation with `security: []` +sends none and doesn't even ask for them, and one whose requirement names several schemes sends all of them. +An operation's `security` replaces the root's rather than adding to it, as the specification says. + +Supported schemes are the ones whose credential is a request header whose entire value the caller supplies: +`apiKey` with `in: header`, `http` with any scheme (the value must include the scheme name, e.g. `"Bearer eyJ…"`), +and `oauth2`/`openIdConnect` (which supply the `Authorization` header value: the generated client runs no +token flow of its own, so you remain responsible for acquiring and refreshing tokens). +`apiKey` with `in: query` or `in: cookie` is not supported. + +Where an operation can be authenticated in more than one way, the generator **refuses to guess**, because +a document lists its alternatives in no particular order, and choosing between them chooses how you +authenticate. +Say which you want with the `SecuritySchemes` Myriad parameter, which takes a comma-separated list of +scheme names: + +```xml + + Petstore + bearerAuth,apiKeyAuth + +``` + +This includes the case where one of the alternatives is the empty requirement `{}`, i.e. "no credentials": +sending nothing is a choice too, and a silently unauthenticated client is exactly what this is here to +prevent. Set `SecuritySchemes` to the empty string to take that alternative wherever the document offers it. + +An operation with no satisfiable requirement is a build failure, rather than a client which silently +issues unauthenticated requests. +If you would rather authenticate the `HttpClient` yourself (with a `DelegatingHandler`, say), the way to +say so is `security: []`, or to remove the security schemes from the document you generate from. + +This is only a typed client generator, not a complete OpenAPI validator or policy engine: + +* schema validation keywords such as `enum`, patterns, and numeric bounds are not enforced by the generated F# types; +* OAuth 2.0 and OpenID Connect flows, scopes, and token endpoints are not implemented: the generated client sends the `Authorization` header value you give it and nothing more; +* the existing JSON codecs represent both an absent optional field and an explicit JSON `null` as `None`, and likewise cannot distinguish a missing required-nullable field from `null` (schemas which require all three states are rejected); and +* optional query parameters are emitted as `option` arguments, with wire-level omission delegated to the chained `HttpClient` generator. + +Unconstrained JSON schemas use `JsonNode option` so that JSON `null` remains representable, and unformatted or extension-formatted integers use `System.Numerics.BigInteger` rather than silently narrowing their range. +Unformatted or unknown-format `number` schemas are rejected because `float` cannot preserve the full JSON number range; explicit `float`, `double`, and `decimal` formats are supported. + ### What's the point? [`SwaggerProvider`](https://github.com/fsprojects/SwaggerProvider) is *absolutely magical*, but it's kind of witchcraft. @@ -358,7 +423,7 @@ Also, builds using `SwaggerProvider` appear to be inherently nondeterministic, e ## Limitations -Swagger API specs appear to be pretty cowboy in the wild. +Swagger and OpenAPI 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! @@ -475,6 +540,19 @@ The motivating example is again ahead-of-time compilation: we wish to avoid the * Variable and constant header values are supported: see [the definition of `IApiWithHeaders`](./ConsumePlugin/RestApiExample.fs). +* A `[
]` property sets its header on *every* request. To set one on only some of them, + declare a property with no `[
]` attribute and name it from the members which want it: + `[]`. + The property still becomes a `unit -> _` argument of `make`, re-evaluated per request, but it is + only called by the members which name it. + You can name the property with `nameof` instead of a literal, so that renaming it is a compile + error rather than a header which silently stops being sent; since `nameof` needs an instance for a + non-static member, the spelling is + `[.BearerToken)>]`. + (The OpenAPI generator emits the literal form: Fantomas cannot print that chain from a generated + syntax tree, and there both sides come from the same string in any case.) + See [the definition of `IApiWithPerEndpointHeaders`](./ConsumePlugin/RestApiExample.fs); + this is what the OpenAPI generator emits for per-operation security requirements. ### Limitations diff --git a/WoofWare.Myriad.Plugins.Attributes/Attributes.fs b/WoofWare.Myriad.Plugins.Attributes/Attributes.fs index 53b7a587..ec361be4 100644 --- a/WoofWare.Myriad.Plugins.Attributes/Attributes.fs +++ b/WoofWare.Myriad.Plugins.Attributes/Attributes.fs @@ -95,6 +95,20 @@ type HttpClientAttribute (isExtensionMethod : bool) = /// Shorthand for the "isExtensionMethod = false" constructor; see documentation there for details. new () = HttpClientAttribute HttpClientAttribute.DefaultIsExtensionMethod +/// Attribute indicating that this interface member sets the given header on its own requests, +/// taking the value from the named parameterless property of the same interface (which the +/// "create HTTP client" generator turns into a `unit -> _` argument, re-evaluated on every request). +/// +/// This differs from `[]` on a property, which sets its header on *every* +/// member's requests: this attribute applies the header only to the members which name the property. +/// It is how the OpenAPI generator expresses per-operation security requirements, where two +/// operations of the same API may require different credentials, or none at all. +/// +/// The named property must exist on the same interface, and must not itself carry a +/// `[]` attribute (which would apply it everywhere anyway). +type HeaderFromPropertyAttribute (header : string, propertyName : string) = + inherit Attribute () + /// Attribute indicating a DU type to which the "create catamorphism" Myriad /// generator should apply during build. /// Supply the `typeName` for the name of the record type we will generate, which contains diff --git a/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt b/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt index e6e082e7..907d9015 100644 --- a/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt +++ b/WoofWare.Myriad.Plugins.Attributes/SurfaceBaseline.txt @@ -27,6 +27,8 @@ WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: bool WoofWare.Myriad.Plugins.GenerateMockAttribute..ctor [constructor]: unit WoofWare.Myriad.Plugins.GenerateMockAttribute.DefaultIsInternal [static property]: [read-only] bool WoofWare.Myriad.Plugins.GenerateMockAttribute.get_DefaultIsInternal [static method]: unit -> bool +WoofWare.Myriad.Plugins.HeaderFromPropertyAttribute inherit System.Attribute +WoofWare.Myriad.Plugins.HeaderFromPropertyAttribute..ctor [constructor]: (string, string) WoofWare.Myriad.Plugins.HttpClientAttribute inherit System.Attribute WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: bool WoofWare.Myriad.Plugins.HttpClientAttribute..ctor [constructor]: unit diff --git a/WoofWare.Myriad.Plugins.Attributes/version.json b/WoofWare.Myriad.Plugins.Attributes/version.json index 3f1d2288..c2da8b91 100644 --- a/WoofWare.Myriad.Plugins.Attributes/version.json +++ b/WoofWare.Myriad.Plugins.Attributes/version.json @@ -1,5 +1,5 @@ { - "version": "3.8", + "version": "3.9", "publicReleaseRefSpec": [ "^refs/heads/main$" ], diff --git a/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestPerEndpointHeader.fs b/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestPerEndpointHeader.fs new file mode 100644 index 00000000..7d9f2666 --- /dev/null +++ b/WoofWare.Myriad.Plugins.Test/TestHttpClient/TestPerEndpointHeader.fs @@ -0,0 +1,110 @@ +namespace WoofWare.Myriad.Plugins.Test + +open System +open System.Net +open System.Net.Http +open System.Threading +open NUnit.Framework +open FsUnitTyped +open PureGym + +/// Headers whose values come from an interface property, but which are stamped only onto the +/// endpoints that ask for them. This is how per-operation OpenAPI security requirements are +/// expressed: two endpoints of the same API may need different credentials, or none. +[] +module TestPerEndpointHeader = + + /// Echoes the request's headers back, one per line, so the test can assert on them. + let private echoHeaders (message : HttpRequestMessage) : HttpResponseMessage Async = + async { + let headers = + [ + for h in message.Headers do + yield $"%s{h.Key}: %s{Seq.exactlyOne h.Value}" + ] + |> List.sort + |> String.concat "\n" + + let resp = new HttpResponseMessage (HttpStatusCode.OK) + resp.Content <- new StringContent (headers) + return resp + } + + let private makeApi (client : HttpClient) (bearerReads : int ref) (apiKeyReads : int ref) = + let bearerToken () = + Interlocked.Increment bearerReads |> ignore + "token-value" + + let apiKey () = + Interlocked.Increment apiKeyReads |> ignore + 42 + + ApiWithPerEndpointHeaders.make bearerToken apiKey (fun () -> "everywhere") client + + [] + let ``An endpoint gets only the credentials it asks for`` () = + use client = HttpClientMock.make (Uri "https://example.com") echoHeaders + let bearerReads = ref 0 + let apiKeyReads = ref 0 + let api = makeApi client bearerReads apiKeyReads + + api.Authorized("param").Result.Split "\n" + |> shouldEqual [| "Authorization: token-value" ; "X-Everywhere: everywhere" |] + + bearerReads.Value |> shouldEqual 1 + apiKeyReads.Value |> shouldEqual 0 + + [] + let ``An endpoint requiring several credentials gets all of them`` () = + use client = HttpClientMock.make (Uri "https://example.com") echoHeaders + let bearerReads = ref 0 + let apiKeyReads = ref 0 + let api = makeApi client bearerReads apiKeyReads + + api.Both("param").Result.Split "\n" + |> shouldEqual + [| + "Authorization: token-value" + "X-Api-Key: 42" + "X-Everywhere: everywhere" + |] + + bearerReads.Value |> shouldEqual 1 + apiKeyReads.Value |> shouldEqual 1 + + [] + let ``An endpoint requiring no credentials is not sent any`` () = + use client = HttpClientMock.make (Uri "https://example.com") echoHeaders + let bearerReads = ref 0 + let apiKeyReads = ref 0 + let api = makeApi client bearerReads apiKeyReads + + api.Anonymous("param").Result.Split "\n" + |> shouldEqual [| "X-Everywhere: everywhere" |] + + // The credentials aren't merely omitted from the request: they're never even asked for, + // so a caller who has no credentials at all can still call this endpoint. + bearerReads.Value |> shouldEqual 0 + apiKeyReads.Value |> shouldEqual 0 + + [] + let ``Credentials are re-read on every request`` () = + use client = HttpClientMock.make (Uri "https://example.com") echoHeaders + let bearerReads = ref 0 + let apiKeyReads = ref 0 + let api = makeApi client bearerReads apiKeyReads + + for _ in 1..3 do + api.Authorized("param").Result |> ignore + + bearerReads.Value |> shouldEqual 3 + + /// The generated `make` takes one argument per property and an HttpClient of its own; a property + /// named `Client` claims the name the HttpClient would otherwise have had, so the generator has + /// to rename its own argument. If it didn't, the generated source wouldn't compile at all. + [] + let ``A property named Client does not collide with the generated HttpClient argument`` () = + use client = HttpClientMock.make (Uri "https://example.com") echoHeaders + let api = ApiWithClientProperty.make (fun () -> "clash") client + + api.Get().Result.Split "\n" |> shouldEqual [| "X-Client: clash" |] diff --git a/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs b/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs index 0d1b224a..80c587f1 100644 --- a/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs +++ b/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs @@ -480,6 +480,36 @@ module TestJsonSerde = CollectRemainingNullable.toJsonNode(toWrite).ToJsonString () |> shouldEqual """{"present":3,"absent":null}""" + [] + let ``Null extension data is written as JSON null`` () = + let toWrite = + { + Rest = [ "nothing", Unchecked.defaultof ] |> dict + Message = None + } + + CollectRemaining.toJsonNode(toWrite).ToJsonString () + |> shouldEqual """{"message":null,"nothing":null}""" + + [] + let ``Null serialization failures identify the parameter and explain the invariant`` () = + let toWrite = + { + Header = Unchecked.defaultof + Value = "value" + } + + let error = + Assert.Throws (fun () -> HeaderAndValue.toJsonNode toWrite |> ignore) + + error.ParamName |> shouldEqual "field" + + error.Message.Contains ( + "Expected type string to be non-null, but received a null value when serialising", + StringComparison.Ordinal + ) + |> shouldEqual true + [] let ``Can collect extension data, nested`` () = let str = diff --git a/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Client.fs b/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Client.fs new file mode 100644 index 00000000..dc6358e3 --- /dev/null +++ b/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Client.fs @@ -0,0 +1,345 @@ +namespace WoofWare.Myriad.Plugins.Test + +open System +open System.Collections.Generic +open System.IO +open System.Net +open System.Net.Http +open System.Numerics +open System.Text.Json.Nodes +open System.Threading +open FsUnitTyped +open NUnit.Framework +open OpenApiPetstore + +[] +module TestOpenApi3Client = + + /// The security schemes of the petstore document, whose credentials the generated client demands + /// of us before it will issue any request that needs them. + let private credentials () = + let apiKeyReads = ref 0 + let bearerReads = ref 0 + + let client (httpClient : HttpClient) = + OpenApiPetstore.make + (fun () -> + Interlocked.Increment apiKeyReads |> ignore + "api-key-value" + ) + (fun () -> + Interlocked.Increment bearerReads |> ignore + "Bearer token-value" + ) + httpClient + + client, apiKeyReads, bearerReads + + let private response (status : HttpStatusCode) (body : string option) = + let result = new HttpResponseMessage (status) + + match body with + | None -> () + | Some body -> result.Content <- new StringContent (body) + + result + + [] + let ``Generated OpenAPI client composes server paths, media, bodies, and recursive DTOs`` () = + task { + let mutable calls = 0 + let mutable counterReads = 0 + + let handler (message : HttpRequestMessage) = + async { + calls <- calls + 1 + + match message.Method.Method, message.RequestUri.ToString () with + | "GET", "https://api.example.test/v1/public/pets/42" -> + message.Headers.Accept + |> Seq.exactlyOne + |> _.MediaType + |> shouldEqual "application/json" + + return + response + HttpStatusCode.OK + (Some + """{"id":42,"name":"Ada","parent":{"id":1,"name":"Root"},"metadata":{"source":"fixture"},"discarded":null}""") + | "POST", "https://api.example.test/v1/public/pets" -> + message.Headers.Accept + |> Seq.exactlyOne + |> _.MediaType + |> shouldEqual "application/json" + + message.Content.Headers.ContentType.MediaType |> shouldEqual "application/json" + + let! requestBody = message.Content.ReadAsStringAsync () |> Async.AwaitTask + let requestBody = JsonNode.Parse requestBody + requestBody.["name"].GetValue () |> shouldEqual "Ada" + requestBody.["tag"].GetValue () |> shouldEqual "cat" + + return response HttpStatusCode.Created (Some """{"id":43,"name":"Ada","tag":"cat"}""") + | "DELETE", "https://api.example.test/v1/public/pets/43" -> + return response HttpStatusCode.NoContent None + | "GET", "https://api.example.test/v1/public/status" -> + message.Headers.Accept + |> Seq.exactlyOne + |> _.MediaType + |> shouldEqual "text/plain" + + return response HttpStatusCode.OK (Some "healthy") + | "GET", "https://api.example.test/v1/public/download" -> + message.Headers.Accept + |> Seq.exactlyOne + |> _.MediaType + |> shouldEqual "application/octet-stream" + + return response HttpStatusCode.OK (Some "binary payload") + | "POST", "https://api.example.test/v1/public/echo" -> + message.Headers.Accept + |> Seq.exactlyOne + |> _.MediaType + |> shouldEqual "text/plain" + + message.Content.Headers.ContentType.MediaType |> shouldEqual "text/plain" + let! requestBody = message.Content.ReadAsStringAsync () |> Async.AwaitTask + requestBody |> shouldEqual "hello" + return response HttpStatusCode.OK (Some requestBody) + | "POST", "https://api.example.test/v1/public/anything" -> + message.Headers.Accept + |> Seq.exactlyOne + |> _.MediaType + |> shouldEqual "application/json" + + message.Content.Headers.ContentType.MediaType |> shouldEqual "application/json" + let! requestBody = message.Content.ReadAsStringAsync () |> Async.AwaitTask + JsonNode.Parse requestBody |> ignore + return response HttpStatusCode.OK (Some requestBody) + | "GET", "https://api.example.test/v1/public/counter" -> + message.Headers.Accept + |> Seq.exactlyOne + |> _.MediaType + |> shouldEqual "application/json" + + counterReads <- counterReads + 1 + + return response HttpStatusCode.OK (Some (if counterReads = 1 then "1e30" else "1.0")) + | "POST", "https://api.example.test/v1/public/counter" -> + message.Headers.Accept + |> Seq.exactlyOne + |> _.MediaType + |> shouldEqual "application/json" + + message.Content.Headers.ContentType.MediaType |> shouldEqual "application/json" + let! requestBody = message.Content.ReadAsStringAsync () |> Async.AwaitTask + requestBody |> shouldEqual "1000000000000000000000000000000" + return response HttpStatusCode.OK (Some requestBody) + | method, uri -> return failwith $"Unexpected generated request: %s{method} %s{uri}" + } + + use httpClient = HttpClientMock.makeNoUri handler + let make, _, _ = credentials () + let client = make httpClient + + let! fetched = client.GetPet 42L + fetched.Id |> shouldEqual 42L + fetched.Name |> shouldEqual "Ada" + fetched.Parent |> Option.map _.Name |> shouldEqual (Some "Root") + + fetched.AdditionalProperties.["metadata"] + |> Option.get + |> fun metadata -> metadata.["source"].GetValue () + |> shouldEqual "fixture" + + fetched.AdditionalProperties.["discarded"] |> shouldEqual None + + let roundTripped = Pet.toJsonNode fetched + + roundTripped.["metadata"].["source"].GetValue () + |> shouldEqual "fixture" + + roundTripped.AsObject().ContainsKey "discarded" |> shouldEqual true + isNull roundTripped.["discarded"] |> shouldEqual true + + let newPet = + { + AdditionalProperties = Dictionary () + Name = "Ada" + Tag = Some "cat" + } + + let! created = client.CreatePet newPet + created.Id |> shouldEqual 43L + created.Tag |> shouldEqual (Some "cat") + + do! client.DeletePet 43L + let! status = client.GetStatus () + status |> shouldEqual "healthy" + + use! download = client.Download () + use reader = new StreamReader (download) + let! downloaded = reader.ReadToEndAsync () + downloaded |> shouldEqual "binary payload" + + let! echoed = client.Echo "hello" + echoed |> shouldEqual "hello" + + let! anything = client.EchoAnything None + anything |> shouldEqual None + + let anythingBody = JsonNode.Parse """{"nested":[1,null,"value"]}""" + let! echoedAnything = client.EchoAnything (Some anythingBody) + + JsonNode.DeepEquals (echoedAnything |> Option.get, anythingBody) + |> shouldEqual true + + isNull anythingBody.Parent |> shouldEqual true + + let! counter = client.GetCounter () + counter |> shouldEqual (BigInteger.Pow (10I, 30)) + + let! zeroFractionCounter = client.GetCounter () + zeroFractionCounter |> shouldEqual 1I + + let! echoedCounter = client.EchoCounter counter + echoedCounter |> shouldEqual counter + calls |> shouldEqual 11 + } + + [] + let ``Generated extension-data codecs round-trip every JSON value kind repeatedly`` () = + let extensionCases : (string * JsonNode option) list = + [ + "null", None + "scalar", Some (JsonValue.Create 17 :> JsonNode) + "object", Some (JsonNode.Parse """{"nested":"yes"}""") + "array", Some (JsonNode.Parse """[1,null,"x"]""") + ] + + for caseName, extensionValue in extensionCases do + for hasParent in [ false ; true ] do + let extensions = Dictionary () + extensions.Add (caseName, extensionValue |> Option.map (fun value -> value.DeepClone ())) + + let parent = + if hasParent then + Some + { + AdditionalProperties = Dictionary () + Id = 1L + Name = "Parent" + Parent = None + Tag = None + } + else + None + + let pet = + { + AdditionalProperties = extensions + Id = 2L + Name = "Child" + Parent = parent + Tag = Some "tag" + } + + let first = Pet.toJsonNode pet + let repeatedFromInput = Pet.toJsonNode pet + JsonNode.DeepEquals (first, repeatedFromInput) |> shouldEqual true + + let parsed = Pet.jsonParse first + let second = Pet.toJsonNode parsed + let third = Pet.toJsonNode parsed + JsonNode.DeepEquals (first, second) |> shouldEqual true + JsonNode.DeepEquals (second, third) |> shouldEqual true + + [] + [] + let ``Optional query parameters are omitted from the URL when absent`` (supplied : bool) = + task { + let expectedUri = + if supplied then + "https://api.example.test/v1/public/pets?limit=25" + else + "https://api.example.test/v1/public/pets" + + let handler (message : HttpRequestMessage) = + async { + message.RequestUri.ToString () |> shouldEqual expectedUri + return response HttpStatusCode.OK (Some "[]") + } + + use httpClient = HttpClientMock.makeNoUri handler + let make, _, _ = credentials () + let client = make httpClient + + let! pets = client.ListPets (if supplied then Some 25 else None) + pets |> shouldBeEmpty + } + + /// The document's security requirements, as they reach the wire: the root requirement applies + /// everywhere it isn't overridden, `security: []` suppresses it, an operation naming two schemes + /// sends both, and the query-carried key we can't represent is passed over for the bearer token. + [] + let ``Each operation sends exactly the credentials its security requirement asks for`` () = + task { + let observed = ResizeArray () + + let handler (message : HttpRequestMessage) = + async { + let credentialHeaders = + [ + for header in message.Headers do + if header.Key = "X-API-Key" || header.Key = "Authorization" then + yield header.Key, Seq.exactlyOne header.Value + ] + |> List.sortBy fst + + observed.Add (message.RequestUri.AbsolutePath, credentialHeaders) + + match message.Method.Method with + | "DELETE" -> return response HttpStatusCode.NoContent None + | "POST" -> return response HttpStatusCode.Created (Some """{"id":43,"name":"Ada"}""") + | _ when message.RequestUri.AbsolutePath.EndsWith ("status", StringComparison.Ordinal) -> + return response HttpStatusCode.OK (Some "healthy") + | _ -> return response HttpStatusCode.OK (Some """{"id":42,"name":"Ada"}""") + } + + use httpClient = HttpClientMock.makeNoUri handler + let make, apiKeyReads, bearerReads = credentials () + let client = make httpClient + + let! _ = client.GetPet 42L + + let! _ = + client.CreatePet + { + AdditionalProperties = Dictionary () + Name = "Ada" + Tag = None + } + + do! client.DeletePet 43L + let! _ = client.GetStatus () + + observed + |> List.ofSeq + |> shouldEqual + [ + // The root requirement: the API key alone. + "/v1/public/pets/42", [ "X-API-Key", "api-key-value" ] + // Two schemes in one requirement: both credentials go. + "/v1/public/pets", [ "Authorization", "Bearer token-value" ; "X-API-Key", "api-key-value" ] + // Alternatives: the legacy query-string key is unrepresentable, so we take the bearer. + "/v1/public/pets/43", [ "Authorization", "Bearer token-value" ] + // security: [] really does mean "send nothing". + "/v1/public/status", [] + ] + + // A caller who has no bearer token can still call every operation which doesn't need one: + // the credential is fetched only where the document requires it, not merely dropped from + // the request afterwards. + apiKeyReads.Value |> shouldEqual 2 + bearerReads.Value |> shouldEqual 2 + } diff --git a/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Generator.fs b/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Generator.fs new file mode 100644 index 00000000..4bb96db4 --- /dev/null +++ b/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Generator.fs @@ -0,0 +1,1730 @@ +namespace WoofWare.Myriad.Plugins.Test + +open System +open System.Collections.Generic +open System.Text.Json.Nodes +open FsCheck +open FsCheck.FSharp +open FsUnitTyped +open NUnit.Framework +open WoofWare.Myriad.Plugins + +[] +module TestOpenApi3Generator = + + type private GeneratedScalar = + | String + | Boolean + | Int32 + | Int64 + | Float32 + | Float + | Decimal + | Date + | DateTime + | Guid + + type private GeneratedField = + { + Name : string + Scalar : GeneratedScalar + Required : bool + Nullable : bool + } + + let private jsonString (value : string) : JsonNode = JsonValue.Create value + let private jsonBool (value : bool) : JsonNode = JsonValue.Create value + + let private jsonObject (properties : (string * JsonNode) list) : JsonNode = + let result = JsonObject () + + for name, value in properties do + result.Add (name, value) + + result :> JsonNode + + let private jsonArray (values : JsonNode list) : JsonNode = + JsonArray (values |> List.toArray) :> JsonNode + + let private schemaForScalar (scalar : GeneratedScalar) (nullable : bool) : JsonNode = + let typeName, format = + match scalar with + | GeneratedScalar.String -> "string", None + | GeneratedScalar.Boolean -> "boolean", None + | GeneratedScalar.Int32 -> "integer", Some "int32" + | GeneratedScalar.Int64 -> "integer", Some "int64" + | GeneratedScalar.Float32 -> "number", Some "float" + | GeneratedScalar.Float -> "number", Some "double" + | GeneratedScalar.Decimal -> "number", Some "decimal" + | GeneratedScalar.Date -> "string", Some "date" + | GeneratedScalar.DateTime -> "string", Some "date-time" + | GeneratedScalar.Guid -> "string", Some "uuid" + + jsonObject + [ + "type", jsonString typeName + match format with + | None -> () + | Some value -> "format", jsonString value + if nullable then + "nullable", jsonBool true + ] + + let private reference (target : string) : JsonNode = + jsonObject [ "$ref", jsonString ("#/components/schemas/" + target) ] + + let private responseWithSchema (schema : JsonNode) : JsonNode = + jsonObject + [ + "description", jsonString "success" + "content", jsonObject [ "application/json", jsonObject [ "schema", schema ] ] + ] + + let private noContentResponse () : JsonNode = + jsonObject [ "description", jsonString "success" ] + + let private parameter (name : string) (location : string) (required : bool) (schema : JsonNode) : JsonNode = + jsonObject + [ + "name", jsonString name + "in", jsonString location + "required", jsonBool required + "schema", schema + ] + + let private document + (version : string) + (schemas : (string * JsonNode) list) + (path : string) + (pathItem : JsonNode) + : string + = + jsonObject + [ + "openapi", jsonString version + "info", + jsonObject + [ + "title", jsonString "Generated API" + "description", jsonString "Generated test API" + "version", jsonString "1.0.0" + ] + "servers", jsonArray [ jsonObject [ "url", jsonString "/api/v1" ] ] + "paths", jsonObject [ path, pathItem ] + "components", jsonObject [ "schemas", jsonObject schemas ] + ] + |> _.ToJsonString() + + let private standardPathItem + (response : JsonNode) + (pathParameters : JsonNode list) + (operationParameters : JsonNode list) + : JsonNode + = + jsonObject + [ + if not pathParameters.IsEmpty then + "parameters", jsonArray pathParameters + "get", + jsonObject + [ + "operationId", jsonString "getThing" + if not operationParameters.IsEmpty then + "parameters", jsonArray operationParameters + "responses", jsonObject [ "200", response ] + ] + ] + + let private config = Map [ "CLASSNAME", "GeneratedClient" ] + + let private plan (source : string) : OpenApiClientPlan = + match OpenApiClientGenerator.parseAndPlan config source with + | Ok value -> value + | Error diagnostics -> + diagnostics + |> List.map (fun diagnostic -> $"%s{diagnostic.Location}: %s{diagnostic.Message}") + |> String.concat Environment.NewLine + |> failwith + + let private expectedPrimitive (scalar : GeneratedScalar) : OpenApiPrimitive = + match scalar with + | GeneratedScalar.String -> OpenApiPrimitive.String + | GeneratedScalar.Boolean -> OpenApiPrimitive.Boolean + | GeneratedScalar.Int32 -> OpenApiPrimitive.Int32 + | GeneratedScalar.Int64 -> OpenApiPrimitive.Int64 + | GeneratedScalar.Float32 -> OpenApiPrimitive.Float32 + | GeneratedScalar.Float -> OpenApiPrimitive.Float + | GeneratedScalar.Decimal -> OpenApiPrimitive.Decimal + | GeneratedScalar.Date -> OpenApiPrimitive.Date + | GeneratedScalar.DateTime -> OpenApiPrimitive.DateTime + | GeneratedScalar.Guid -> OpenApiPrimitive.Guid + + let private generatedFields : Gen = + gen { + let! count = Gen.choose (1, 8) + + let field = + gen { + let! scalar = + Gen.elements + [ + GeneratedScalar.String + GeneratedScalar.Boolean + GeneratedScalar.Int32 + GeneratedScalar.Int64 + GeneratedScalar.Float32 + GeneratedScalar.Float + GeneratedScalar.Decimal + GeneratedScalar.Date + GeneratedScalar.DateTime + GeneratedScalar.Guid + ] + + let! required = ArbMap.generate ArbMap.defaults + + let! nullable = + if required then + ArbMap.generate ArbMap.defaults + else + Gen.constant false + + return + { + Name = "field" + Scalar = scalar + Required = required + Nullable = nullable + } + } + + let! fields = Gen.listOfLength count field + + return + fields + |> List.mapi (fun index value -> + { value with + Name = $"field%i{index}" + } + ) + } + + let private renderObjectDocument (fields : GeneratedField list) : string = + let properties = + fields + |> List.map (fun field -> field.Name, schemaForScalar field.Scalar field.Nullable) + + let required = + fields + |> List.choose (fun field -> + if field.Required then + Some (jsonString field.Name) + else + None + ) + + let thingSchema = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject properties + if not required.IsEmpty then + "required", jsonArray required + ] + + let pathParameter = + parameter "id" "path" true (schemaForScalar GeneratedScalar.Int64 false) + + standardPathItem (responseWithSchema (reference "Thing")) [ pathParameter ] [] + |> fun pathItem -> document "3.0.3" [ "Thing", thingSchema ] "/things/{id}" pathItem + + [] + let ``Object planning agrees with an independent field oracle across generated schemas`` () = + let scalarCounts = System.Collections.Generic.Dictionary () + let mutable requiredCount = 0 + let mutable optionalCount = 0 + let mutable nullableCount = 0 + let mutable noRequiredDocuments = 0 + let mutable allRequiredDocuments = 0 + let mutable mixedRequiredDocuments = 0 + let mutable documentsWithNullableFields = 0 + + let property (fields : GeneratedField list) = + let requiredInDocument = fields |> List.filter _.Required |> List.length + + if requiredInDocument = 0 then + noRequiredDocuments <- noRequiredDocuments + 1 + elif requiredInDocument = fields.Length then + allRequiredDocuments <- allRequiredDocuments + 1 + else + mixedRequiredDocuments <- mixedRequiredDocuments + 1 + + if fields |> List.exists _.Nullable then + documentsWithNullableFields <- documentsWithNullableFields + 1 + + for field in fields do + scalarCounts.[field.Scalar] <- + match scalarCounts.TryGetValue field.Scalar with + | true, count -> count + 1 + | false, _ -> 1 + + if field.Required then + requiredCount <- requiredCount + 1 + else + optionalCount <- optionalCount + 1 + + if field.Nullable then + nullableCount <- nullableCount + 1 + + let actual = renderObjectDocument fields |> plan + let actualType = actual.Types |> List.exactlyOne + actualType.SourceName |> shouldEqual "Thing" + + let actualFields = + actualType.Fields |> List.map (fun field -> field.JsonName, field) |> Map + + actualType.Fields |> List.length |> shouldEqual fields.Length + + actualType.Fields + |> List.map _.JsonName + |> Set.ofList + |> shouldEqual (fields |> List.map _.Name |> Set.ofList) + + for expected in fields do + let actualField = actualFields.[expected.Name] + actualField.Required |> shouldEqual expected.Required + + let expectedType = + OpenApiPlannedType.Primitive (expectedPrimitive expected.Scalar) + |> if expected.Required && not expected.Nullable then + id + else + OpenApiPlannedType.Optional + + actualField.Type |> shouldEqual expectedType + + let reordered = fields |> List.rev |> renderObjectDocument |> plan + reordered |> shouldEqual actual + + property + |> Prop.forAll (Arb.fromGen generatedFields) + |> Check.QuickThrowOnFailure + + for scalar in + [ + GeneratedScalar.String + GeneratedScalar.Boolean + GeneratedScalar.Int32 + GeneratedScalar.Int64 + GeneratedScalar.Float32 + GeneratedScalar.Float + GeneratedScalar.Decimal + GeneratedScalar.Date + GeneratedScalar.DateTime + GeneratedScalar.Guid + ] do + let observed = scalarCounts.GetValueOrDefault scalar + + if observed < 8 then + failwith $"Generator only exercised %A{scalar} %i{observed} times" + + if requiredCount < 80 || optionalCount < 80 || nullableCount < 30 then + failwith + $"Insufficient generated distribution: required=%i{requiredCount}, optional=%i{optionalCount}, nullable=%i{nullableCount}" + + if + noRequiredDocuments < 3 + || allRequiredDocuments < 3 + || mixedRequiredDocuments < 20 + || documentsWithNullableFields < 10 + then + failwith + $"Insufficient document distribution: none-required=%i{noRequiredDocuments}, all-required=%i{allRequiredDocuments}, mixed=%i{mixedRequiredDocuments}, nullable=%i{documentsWithNullableFields}" + + [] + let ``Operation parameters override inherited parameters by name and location`` () = + for scalar in [ GeneratedScalar.String ; GeneratedScalar.Int32 ; GeneratedScalar.Int64 ] do + for required in [ false ; true ] do + let inheritedPath = + parameter "id" "path" true (schemaForScalar GeneratedScalar.Int64 false) + + let inheritedQuery = + parameter "limit" "query" false (schemaForScalar GeneratedScalar.String false) + + let overridingQuery = + parameter "limit" "query" required (schemaForScalar scalar false) + + let pathItem = + standardPathItem (noContentResponse ()) [ inheritedPath ; inheritedQuery ] [ overridingQuery ] + + let actual = document "3.0.3" [] "/things/{id}" pathItem |> plan + let operation = actual.Operations |> List.exactlyOne + + operation.Parameters |> List.map _.WireName |> shouldEqual [ "id" ; "limit" ] + + let path = operation.Parameters.[0] + path.Location |> shouldEqual OpenApiParameterLocation.Path + path.Required |> shouldEqual true + path.Type |> shouldEqual (OpenApiPlannedType.Primitive OpenApiPrimitive.Int64) + + let limit = operation.Parameters.[1] + limit.Location |> shouldEqual OpenApiParameterLocation.Query + limit.Required |> shouldEqual required + + let expected = + OpenApiPlannedType.Primitive (expectedPrimitive scalar) + |> if required then id else OpenApiPlannedType.Optional + + limit.Type |> shouldEqual expected + + [] + let ``Parameters cannot shadow the generated HTTP client binding`` () = + let clientParameter = + parameter "client" "path" true (schemaForScalar GeneratedScalar.String false) + + let pathItem = standardPathItem (noContentResponse ()) [ clientParameter ] [] + let actual = document "3.0.3" [] "/things/{client}" pathItem |> plan + + let plannedParameter = + actual.Operations |> List.exactlyOne |> _.Parameters |> List.exactlyOne + + plannedParameter.WireName |> shouldEqual "client" + plannedParameter.FSharpName |> shouldEqual "client2" + + let rec private referencedTypeNames (plannedType : OpenApiPlannedType) : Set = + match plannedType with + | OpenApiPlannedType.Named name -> Set.singleton name + | OpenApiPlannedType.List inner + | OpenApiPlannedType.Optional inner -> referencedTypeNames inner + | OpenApiPlannedType.Primitive _ + | OpenApiPlannedType.JsonNode + | OpenApiPlannedType.Stream + | OpenApiPlannedType.Unit -> Set.empty + + [] + let ``Every planned named reference is bound, including self references`` () = + let mutable shortChains = 0 + let mutable longChains = 0 + + let property count = + if count <= 4 then + shortChains <- shortChains + 1 + + if count >= 9 then + longChains <- longChains + 1 + + let chain = + [ + for index in 0..count do + let properties = + if index = 0 then + [ "value", schemaForScalar GeneratedScalar.Int32 false ] + else + [ "previous", reference $"Type%i{index - 1}" ] + + let schema = + jsonObject [ "type", jsonString "object" ; "properties", jsonObject properties ] + + $"Type%i{index}", schema + ] + + let node = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "next", reference "Node" ] + ] + + let pathParameter = + parameter "id" "path" true (schemaForScalar GeneratedScalar.Int64 false) + + let pathItem = + standardPathItem (responseWithSchema (reference "Node")) [ pathParameter ] [] + + let actual = + document "3.0.3" (("Node", node) :: chain) "/things/{id}" pathItem |> plan + + let bound = actual.Types |> List.map _.FSharpName |> Set.ofList + + let referenced = + actual.Types + |> List.collect (fun definition -> + [ + yield! + definition.Fields + |> List.collect (fun field -> referencedTypeNames field.Type |> Set.toList) + + match definition.AdditionalProperties with + | None -> () + | Some value -> yield! referencedTypeNames value + ] + ) + |> Set.ofList + + Set.isSubset referenced bound |> shouldEqual true + + let bySource = + actual.Types + |> List.map (fun definition -> definition.SourceName, definition) + |> Map + + let positions = + actual.Types + |> List.mapi (fun index definition -> definition.FSharpName, index) + |> Map + + for index in 1..count do + let current = bySource.[$"Type%i{index}"] + let previous = bySource.[$"Type%i{index - 1}"] + let field = current.Fields |> List.exactlyOne + + field.Type + |> shouldEqual (OpenApiPlannedType.Optional (OpenApiPlannedType.Named previous.FSharpName)) + + positions.[previous.FSharpName] < positions.[current.FSharpName] + |> shouldEqual true + + let node = bySource.["Node"] + + node.Fields + |> List.exactlyOne + |> _.Type + |> shouldEqual (OpenApiPlannedType.Optional (OpenApiPlannedType.Named node.FSharpName)) + + property + |> Prop.forAll (Arb.fromGen (Gen.choose (1, 12))) + |> Check.QuickThrowOnFailure + + if shortChains < 10 || longChains < 10 then + failwith $"Insufficient chain distribution: short=%i{shortChains}, long=%i{longChains}" + + [] + let ``Mutually recursive record components fail explicitly before codec generation`` () = + let schemaA = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "b", reference "B" ] + ] + + let schemaB = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "a", reference "A" ] + ] + + let pathItem = standardPathItem (responseWithSchema (reference "A")) [] [] + + let source = document "3.0.3" [ "A", schemaA ; "B", schemaB ] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly accepted mutually recursive generated codecs" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema) + |> shouldEqual true + + [] + let ``Mutually recursive allOf components produce a diagnostic instead of recursing forever`` () = + let composedWith name = + jsonObject [ "allOf", jsonArray [ reference name ] ] + + let pathItem = standardPathItem (responseWithSchema (reference "A")) [] [] + + let source = + document "3.0.3" [ "A", composedWith "B" ; "B", composedWith "A" ] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly accepted mutually recursive allOf components" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema) + |> shouldEqual true + + [] + let ``Dangling references always produce a located diagnostic`` () = + let property (PositiveInt suffix) = + let missing = $"Missing%i{suffix}" + + let schema = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "child", reference missing ] + ] + + let pathParameter = + parameter "id" "path" true (schemaForScalar GeneratedScalar.Int64 false) + + let pathItem = + standardPathItem (responseWithSchema (reference "Thing")) [ pathParameter ] [] + + let source = document "3.0.3" [ "Thing", schema ] "/things/{id}" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith $"Planning unexpectedly accepted dangling reference %s{missing}" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnresolvedReference + && diagnostic.Location.Contains ("/properties/child", StringComparison.Ordinal) + && diagnostic.Message.Contains (missing, StringComparison.Ordinal) + ) + |> shouldEqual true + + Check.QuickThrowOnFailure property + + [] + let ``Required properties without schemas remain required nullable JsonNode fields`` () = + let schema = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [] + "required", jsonArray [ jsonString "ghost" ] + ] + + let pathParameter = + parameter "id" "path" true (schemaForScalar GeneratedScalar.Int64 false) + + let pathItem = + standardPathItem (responseWithSchema (reference "Thing")) [ pathParameter ] [] + + let source = document "3.0.3" [ "Thing", schema ] "/things/{id}" pathItem + + let actual = source |> plan + let thing = actual.Types |> List.exactlyOne + let ghost = thing.Fields |> List.exactlyOne + ghost.JsonName |> shouldEqual "ghost" + ghost.Required |> shouldEqual true + + ghost.Type + |> shouldEqual (OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode) + + [] + let ``Optional nullable fields fail explicitly because their three states are not representable`` () = + let schema = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "value", schemaForScalar GeneratedScalar.String true ] + ] + + let pathParameter = + parameter "id" "path" true (schemaForScalar GeneratedScalar.Int64 false) + + let pathItem = + standardPathItem (responseWithSchema (reference "Thing")) [ pathParameter ] [] + + let source = document "3.0.3" [ "Thing", schema ] "/things/{id}" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly conflated missing, null, and present values" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema + && diagnostic.Location.Contains ("/properties/value", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Unconstrained JSON request and response schemas preserve null as an explicit value`` () = + let unconstrained () = jsonObject [] + + let requestBody = + jsonObject + [ + "required", jsonBool true + "content", jsonObject [ "application/json", jsonObject [ "schema", unconstrained () ] ] + ] + + let pathItem = + jsonObject + [ + "post", + jsonObject + [ + "operationId", jsonString "echoAnything" + "requestBody", requestBody + "responses", jsonObject [ "200", responseWithSchema (unconstrained ()) ] + ] + ] + + let actual = document "3.0.3" [] "/anything" pathItem |> plan + let operation = actual.Operations |> List.exactlyOne + let body = operation.Parameters |> List.exactlyOne + body.Location |> shouldEqual OpenApiParameterLocation.Body + body.Required |> shouldEqual true + + body.Type + |> shouldEqual (OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode) + + operation.ReturnType + |> shouldEqual (OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode) + + [] + let ``Optional unconstrained properties fail because all three wire states are legal`` () = + let schema = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "value", jsonObject [] ] + ] + + let pathItem = standardPathItem (responseWithSchema (reference "Thing")) [] [] + let source = document "3.0.3" [ "Thing", schema ] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly conflated a missing property with a present JSON null" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema + && diagnostic.Location.EndsWith ("/properties/value", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Unbounded and extension-formatted integers use BigInteger rather than narrowing`` () = + for format in [ None ; Some "uint64" ] do + let schema = + jsonObject + [ + "type", jsonString "integer" + match format with + | None -> () + | Some value -> "format", jsonString value + ] + + let pathItem = standardPathItem (responseWithSchema schema) [] [] + let actual = document "3.0.3" [] "/integer" pathItem |> plan + + actual.Operations + |> List.exactlyOne + |> _.ReturnType + |> shouldEqual (OpenApiPlannedType.Primitive OpenApiPrimitive.BigInteger) + + [] + let ``Unformatted and unknown-format numbers fail instead of narrowing to double`` () = + for format in [ None ; Some "arbitrary-precision" ] do + let schema = + jsonObject + [ + "type", jsonString "number" + match format with + | None -> () + | Some value -> "format", jsonString value + ] + + let pathItem = standardPathItem (responseWithSchema schema) [] [] + let source = document "3.0.3" [] "/number" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly narrowed an arbitrary JSON number to double" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema + && diagnostic.Location.EndsWith ("/format", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Nullable component schemas stay nullable through references`` () = + let maybe = + jsonObject + [ + "type", jsonString "object" + "nullable", jsonBool true + "properties", jsonObject [ "id", schemaForScalar GeneratedScalar.Int64 false ] + ] + + let holder = + jsonObject + [ + "type", jsonString "object" + "required", jsonArray [ jsonString "value" ] + "properties", jsonObject [ "value", reference "Maybe" ] + ] + + let pathItem = standardPathItem (responseWithSchema (reference "Holder")) [] [] + + let actual = + document "3.0.3" [ "Maybe", maybe ; "Holder", holder ] "/things" pathItem + |> plan + + let maybeType = + actual.Types |> List.find (fun definition -> definition.SourceName = "Maybe") + + let holderType = + actual.Types |> List.find (fun definition -> definition.SourceName = "Holder") + + let value = holderType.Fields |> List.find (fun field -> field.JsonName = "value") + + value.Type + |> shouldEqual (OpenApiPlannedType.Optional (OpenApiPlannedType.Named maybeType.FSharpName)) + + [] + let ``AllOf permits null exactly when its outer constraint and every branch permit it`` () = + let branch name nullable = + jsonObject + [ + "type", jsonString "object" + "nullable", jsonBool nullable + "properties", jsonObject [ name, schemaForScalar GeneratedScalar.String false ] + ] + + let bothNullable = + jsonObject [ "allOf", jsonArray [ branch "left" true ; branch "right" true ] ] + + let onlyOuterNullable = + jsonObject + [ + "nullable", jsonBool true + "allOf", jsonArray [ branch "left" false ; branch "right" false ] + ] + + let responseFor name schema = + let pathItem = standardPathItem (responseWithSchema (reference name)) [] [] + document "3.0.3" [ name, schema ] "/things" pathItem |> plan + + let bothPlan = responseFor "Both" bothNullable + let bothType = bothPlan.Types |> List.exactlyOne + + bothPlan.Operations + |> List.exactlyOne + |> _.ReturnType + |> shouldEqual (OpenApiPlannedType.Optional (OpenApiPlannedType.Named bothType.FSharpName)) + + let outerPlan = responseFor "Outer" onlyOuterNullable + let outerType = outerPlan.Types |> List.exactlyOne + + outerPlan.Operations + |> List.exactlyOne + |> _.ReturnType + |> shouldEqual (OpenApiPlannedType.Named outerType.FSharpName) + + [] + let ``Additional-properties modes map exhaustively to their generated value types`` () = + let cases : (string * JsonNode option * OpenApiPlannedType option) list = + [ + "omitted", None, Some (OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode) + "allowed", Some (jsonBool true), Some (OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode) + "forbidden", Some (jsonBool false), None + "typed", + Some (schemaForScalar GeneratedScalar.String false), + Some (OpenApiPlannedType.Primitive OpenApiPrimitive.String) + "typed-nullable", + Some (schemaForScalar GeneratedScalar.String true), + Some (OpenApiPlannedType.Optional (OpenApiPlannedType.Primitive OpenApiPrimitive.String)) + "typed-any", Some (jsonObject []), Some (OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode) + ] + + for caseName, additionalProperties, expected in cases do + let schema = + jsonObject + [ + "type", jsonString "object" + "required", jsonArray [ jsonString "id" ] + "properties", jsonObject [ "id", schemaForScalar GeneratedScalar.Int64 false ] + match additionalProperties with + | None -> () + | Some value -> "additionalProperties", value + ] + + let pathItem = standardPathItem (responseWithSchema (reference "Thing")) [] [] + + let actual = + document "3.0.3" [ "Thing", schema ] $"/things/%s{caseName}" pathItem |> plan + + actual.Types + |> List.exactlyOne + |> _.AdditionalProperties + |> shouldEqual expected + + [] + let ``Closed empty objects fail instead of gaining a synthetic JSON field`` () = + let empty = + jsonObject [ "type", jsonString "object" ; "additionalProperties", jsonBool false ] + + let pathItem = standardPathItem (responseWithSchema (reference "Empty")) [] [] + let source = document "3.0.3" [ "Empty", empty ] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly invented a field for a closed empty object" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema) + |> shouldEqual true + + [] + let ``Required document strings reject explicit JSON null`` () = + let source = + """{"openapi":null,"info":{"title":"API","version":"1"},"paths":{},"components":{"schemas":{}}}""" + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly treated a null OpenAPI version as absent" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.InvalidDocument + && diagnostic.Location = "#/openapi" + ) + |> shouldEqual true + + [] + let ``Optional structural properties reject explicit JSON null`` () = + let source = + """{"openapi":"3.0.3","info":{"title":"API","version":"1"},"servers":null,"paths":{},"components":{"schemas":{}}}""" + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly treated a null servers array as absent" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.InvalidDocument + && diagnostic.Location = "#/servers" + ) + |> shouldEqual true + + [] + let ``Parameterized JSON media types use their base media type and JSON schema`` () = + let responseMediaType = "application/problem+json; charset=utf-8" + let requestMediaType = "application/json; charset=utf-8" + + let operation = + jsonObject + [ + "operationId", jsonString "createThing" + "requestBody", + jsonObject + [ + "required", jsonBool true + "content", + jsonObject + [ + requestMediaType, + jsonObject [ "schema", schemaForScalar GeneratedScalar.Int64 false ] + ] + ] + "responses", + jsonObject + [ + "200", + jsonObject + [ + "description", jsonString "success" + "content", + jsonObject + [ + responseMediaType, + jsonObject [ "schema", schemaForScalar GeneratedScalar.Int64 false ] + ] + ] + ] + ] + + let source = document "3.0.3" [] "/things" (jsonObject [ "post", operation ]) + let actual = plan source |> _.Operations |> List.exactlyOne + + actual.RequestContentType |> shouldEqual (Some "application/json") + actual.Accept |> shouldEqual (Some "application/problem+json") + + actual.Parameters + |> List.exactlyOne + |> _.Type + |> shouldEqual (OpenApiPlannedType.Primitive OpenApiPrimitive.Int64) + + actual.ReturnType + |> shouldEqual (OpenApiPlannedType.Primitive OpenApiPrimitive.Int64) + + [] + let ``Unsupported media diagnostics list the content keys`` () = + let response = + jsonObject + [ + "description", jsonString "success" + "content", jsonObject [ "application/xml", jsonObject [] ; "image/png", jsonObject [] ] + ] + + let source = document "3.0.3" [] "/things" (standardPathItem response [] []) + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly accepted unsupported response media" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedOperation + && diagnostic.Message.Contains ("application/xml", StringComparison.Ordinal) + && diagnostic.Message.Contains ("image/png", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Additional document servers are diagnosed instead of silently ignored`` () = + let source = + jsonObject + [ + "openapi", jsonString "3.0.3" + "info", jsonObject [ "title", jsonString "API" ; "version", jsonString "1" ] + "servers", + jsonArray + [ + jsonObject [ "url", jsonString "https://first.example" ] + jsonObject [ "url", jsonString "https://second.example" ] + ] + "paths", jsonObject [] + "components", jsonObject [ "schemas", jsonObject [] ] + ] + |> _.ToJsonString() + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly ignored additional document servers" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedOperation + && diagnostic.Location = "#/servers" + && diagnostic.Message.Contains ("first", StringComparison.OrdinalIgnoreCase) + ) + |> shouldEqual true + + [] + let ``Generated types cannot shadow namespaces used by emitted code`` () = + let objectSchema fieldName = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ fieldName, schemaForScalar GeneratedScalar.String false ] + ] + + let schemas = + [ + "System", objectSchema "systemValue" + "RestEase", objectSchema "restEaseValue" + "WoofWare", objectSchema "woofWareValue" + "GeneratedClient", objectSchema "clientValue" + ] + + let actual = + document "3.0.3" schemas "/things" (standardPathItem (noContentResponse ()) [] []) + |> plan + + actual.Types + |> List.map (fun definition -> definition.SourceName, definition.FSharpName) + |> Map.ofList + |> shouldEqual ( + Map + [ + "GeneratedClient", "GeneratedClient2" + "RestEase", "RestEase2" + "System", "System2" + "WoofWare", "WoofWare2" + ] + ) + + [] + let ``Fallback operation ids participate in duplicate detection`` () = + let operation operationId = + jsonObject + [ + match operationId with + | None -> () + | Some value -> "operationId", jsonString value + "responses", jsonObject [ "200", noContentResponse () ] + ] + + let source = + jsonObject + [ + "openapi", jsonString "3.0.3" + "info", jsonObject [ "title", jsonString "API" ; "version", jsonString "1" ] + "paths", + jsonObject + [ + "/other", jsonObject [ "get", operation (Some "get-/things") ] + "/things", jsonObject [ "get", operation None ] + ] + "components", jsonObject [ "schemas", jsonObject [] ] + ] + |> _.ToJsonString() + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly accepted colliding explicit and fallback operation ids" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.InvalidDocument + && diagnostic.Message.Contains ("get-/things", StringComparison.Ordinal) + && diagnostic.Message.Contains ("duplicated", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Unsupported composition keywords on named objects are not bypassed by references`` () = + let schema = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "id", schemaForScalar GeneratedScalar.Int64 false ] + "oneOf", jsonArray [ jsonObject [ "type", jsonString "object" ] ] + ] + + let pathItem = standardPathItem (responseWithSchema (reference "Thing")) [] [] + let source = document "3.0.3" [ "Thing", schema ] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly ignored oneOf on a referenced object component" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema) + |> shouldEqual true + + [] + let ``AllOf deduplication cannot hide unsupported keywords on a discarded property schema`` () = + let propertySchema includeUnsupportedKeyword = + jsonObject + [ + "type", jsonString "string" + if includeUnsupportedKeyword then + "oneOf", jsonArray [ jsonObject [ "type", jsonString "string" ] ] + ] + + let branch includeUnsupportedKeyword = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "value", propertySchema includeUnsupportedKeyword ] + ] + + let child = jsonObject [ "allOf", jsonArray [ branch false ; branch true ] ] + let pathItem = standardPathItem (responseWithSchema (reference "Child")) [] [] + let source = document "3.0.3" [ "Child", child ] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly hid oneOf on a discarded allOf property" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema + && diagnostic.Location.Contains ("/allOf/1/properties/value", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Anonymous-type cache hits still validate every nested schema occurrence`` () = + let schema includeUnsupportedKeyword = + jsonObject + [ + "type", jsonString "object" + "properties", + jsonObject + [ + "value", + jsonObject + [ + "type", jsonString "string" + if includeUnsupportedKeyword then + "oneOf", jsonArray [ jsonObject [ "type", jsonString "string" ] ] + ] + ] + ] + + let pathItem = + jsonObject + [ + "get", + jsonObject + [ + "operationId", jsonString "getThing" + "responses", + jsonObject + [ + "200", responseWithSchema (schema false) + "201", responseWithSchema (schema true) + ] + ] + ] + + let source = document "3.0.3" [] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly hid oneOf on a cached anonymous type" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema + && diagnostic.Location.Contains ("/responses/201", StringComparison.Ordinal) + && diagnostic.Location.EndsWith ("/properties/value", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Sanitised component and field identifiers remain unique`` () = + let collidingSchema = + jsonObject + [ + "type", jsonString "object" + "properties", + jsonObject + [ + "foo-bar", schemaForScalar GeneratedScalar.String false + "foo_bar", schemaForScalar GeneratedScalar.String false + ] + ] + + let otherSchema = + jsonObject [ "type", jsonString "object" ; "properties", jsonObject [] ] + + let pathParameter = + parameter "id" "path" true (schemaForScalar GeneratedScalar.Int64 false) + + let pathItem = + standardPathItem (responseWithSchema (reference "foo-bar")) [ pathParameter ] [] + + let actual = + document "3.0.3" [ "foo-bar", collidingSchema ; "foo_bar", otherSchema ] "/things/{id}" pathItem + |> plan + + let typeNames = actual.Types |> List.map _.FSharpName + typeNames |> Set.ofList |> Set.count |> shouldEqual typeNames.Length + + let fieldNames = + actual.Types + |> List.find (fun definition -> definition.SourceName = "foo-bar") + |> _.Fields + |> List.map _.FSharpName + + fieldNames |> Set.ofList |> Set.count |> shouldEqual fieldNames.Length + + [] + let ``AllOf object composition has the union of its fields`` () = + let baseSchema = + jsonObject + [ + "type", jsonString "object" + "required", jsonArray [ jsonString "id" ] + "properties", jsonObject [ "id", schemaForScalar GeneratedScalar.Int64 false ] + ] + + let extension = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "display-name", schemaForScalar GeneratedScalar.String false ] + ] + + let childSchema = jsonObject [ "allOf", jsonArray [ reference "Base" ; extension ] ] + + let pathParameter = + parameter "id" "path" true (schemaForScalar GeneratedScalar.Int64 false) + + let pathItem = + standardPathItem (responseWithSchema (reference "Child")) [ pathParameter ] [] + + let actual = + document "3.0.3" [ "Base", baseSchema ; "Child", childSchema ] "/things/{id}" pathItem + |> plan + + let child = + actual.Types |> List.find (fun definition -> definition.SourceName = "Child") + + child.Fields + |> List.map _.JsonName + |> Set.ofList + |> shouldEqual (Set [ "id" ; "display-name" ]) + + child.Fields + |> List.find (fun field -> field.JsonName = "id") + |> _.Required + |> shouldEqual true + + [] + let ``Equivalent inline success schemas share one planned type despite annotations and ordering`` () = + let first = + jsonObject + [ + "type", jsonString "object" + "description", jsonString "first spelling" + "required", jsonArray [ jsonString "id" ; jsonString "name" ] + "properties", + jsonObject + [ + "id", schemaForScalar GeneratedScalar.Int64 false + "name", schemaForScalar GeneratedScalar.String false + ] + ] + + let second = + jsonObject + [ + "description", jsonString "same wire shape, different annotation" + "properties", + jsonObject + [ + "name", schemaForScalar GeneratedScalar.String false + "id", schemaForScalar GeneratedScalar.Int64 false + ] + "required", jsonArray [ jsonString "name" ; jsonString "id" ] + "type", jsonString "object" + ] + + let pathItem = + jsonObject + [ + "get", + jsonObject + [ + "operationId", jsonString "getThing" + "responses", + jsonObject [ "200", responseWithSchema first ; "201", responseWithSchema second ] + ] + ] + + let actual = document "3.0.3" [] "/things" pathItem |> plan + actual.Types |> List.length |> shouldEqual 1 + + actual.Operations + |> List.exactlyOne + |> _.ReturnType + |> shouldEqual (OpenApiPlannedType.Named (actual.Types |> List.exactlyOne |> _.FSharpName)) + + [] + let ``Equivalent inline allOf schemas share one type across branch permutations`` () = + let baseSchema = + jsonObject + [ + "type", jsonString "object" + "required", jsonArray [ jsonString "id" ] + "properties", jsonObject [ "id", schemaForScalar GeneratedScalar.Int64 false ] + ] + + let extension = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "name", schemaForScalar GeneratedScalar.String false ] + ] + + let composed (description : string) (branches : JsonNode list) = + jsonObject + [ + "description", jsonString description + "allOf", jsonArray (branches |> List.map (fun branch -> branch.DeepClone ())) + ] + + let pathItem = + jsonObject + [ + "get", + jsonObject + [ + "operationId", jsonString "getThing" + "responses", + jsonObject + [ + "200", responseWithSchema (composed "first" [ baseSchema ; extension ]) + "201", responseWithSchema (composed "second" [ extension ; baseSchema ]) + ] + ] + ] + + let actual = document "3.0.3" [] "/things" pathItem |> plan + let definition = actual.Types |> List.exactlyOne + + definition.Fields + |> List.map _.JsonName + |> Set.ofList + |> shouldEqual (Set [ "id" ; "name" ]) + + actual.Operations + |> List.exactlyOne + |> _.ReturnType + |> shouldEqual (OpenApiPlannedType.Named definition.FSharpName) + + [] + let ``Direct and single-branch allOf object schemas share their flattened record type`` () = + let direct = + jsonObject + [ + "type", jsonString "object" + "required", jsonArray [ jsonString "id" ] + "properties", jsonObject [ "id", schemaForScalar GeneratedScalar.Int64 false ] + ] + + let composed = + jsonObject + [ + "description", jsonString "different syntax, same record" + "allOf", jsonArray [ direct.DeepClone () ] + ] + + let pathItem = + jsonObject + [ + "get", + jsonObject + [ + "operationId", jsonString "getThing" + "responses", + jsonObject [ "200", responseWithSchema direct ; "201", responseWithSchema composed ] + ] + ] + + let actual = document "3.0.3" [] "/things" pathItem |> plan + let definition = actual.Types |> List.exactlyOne + definition.Fields |> List.map _.JsonName |> shouldEqual [ "id" ] + + actual.Operations + |> List.exactlyOne + |> _.ReturnType + |> shouldEqual (OpenApiPlannedType.Named definition.FSharpName) + + [] + let ``Equivalent additionalProperties forms share their generated dictionary type`` () = + let schema additionalProperties = + jsonObject [ "type", jsonString "object" ; "additionalProperties", additionalProperties ] + + let pathItem = + jsonObject + [ + "get", + jsonObject + [ + "operationId", jsonString "getThing" + "responses", + jsonObject + [ + "200", responseWithSchema (schema (jsonBool true)) + "201", responseWithSchema (schema (jsonObject [])) + ] + ] + ] + + let actual = document "3.0.3" [] "/things" pathItem |> plan + let definition = actual.Types |> List.exactlyOne + + definition.AdditionalProperties + |> shouldEqual (Some (OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode)) + + actual.Operations + |> List.exactlyOne + |> _.ReturnType + |> shouldEqual (OpenApiPlannedType.Named definition.FSharpName) + + [] + let ``AllOf repeated properties compare their canonical generated type rather than source syntax`` () = + let payload = + jsonObject + [ + "type", jsonString "object" + "required", jsonArray [ jsonString "id" ] + "properties", jsonObject [ "id", schemaForScalar GeneratedScalar.Int64 false ] + ] + + let branch propertySchema = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "payload", propertySchema ] + ] + + let parent = + jsonObject + [ + "allOf", + jsonArray + [ + branch (payload.DeepClone ()) + branch (jsonObject [ "allOf", jsonArray [ payload.DeepClone () ] ]) + ] + ] + + let pathItem = standardPathItem (responseWithSchema (reference "Parent")) [] [] + let actual = document "3.0.3" [ "Parent", parent ] "/things" pathItem |> plan + + let parentType = + actual.Types |> List.find (fun definition -> definition.SourceName = "Parent") + + let payloadField = parentType.Fields |> List.exactlyOne + + payloadField.JsonName |> shouldEqual "payload" + + match payloadField.Type with + | OpenApiPlannedType.Optional (OpenApiPlannedType.Named payloadTypeName) -> + actual.Types + |> List.exists (fun definition -> definition.FSharpName = payloadTypeName) + |> shouldEqual true + | unexpected -> failwith $"Expected an optional generated payload type, got %A{unexpected}" + + [] + let ``Anonymous object deduplication keeps incompatible field types distinct`` () = + let schema scalar = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "value", schemaForScalar scalar false ] + ] + + let pathItem = + jsonObject + [ + "get", + jsonObject + [ + "operationId", jsonString "getThing" + "responses", + jsonObject + [ + "200", responseWithSchema (schema GeneratedScalar.String) + "201", responseWithSchema (schema GeneratedScalar.Int64) + ] + ] + ] + + let source = document "3.0.3" [] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly merged incompatible anonymous record fields" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.AmbiguousSuccessResponse + && diagnostic.Location.EndsWith ("/responses/201", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Media selection exhaustively follows supported priority and ignores insertion order`` () = + let objectSchema = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "id", schemaForScalar GeneratedScalar.Int64 false ] + ] + + let stringSchema = schemaForScalar GeneratedScalar.String false + + let media = + [ + "application/json", objectSchema + "application/problem+json", objectSchema + "text/plain", stringSchema + "application/octet-stream", stringSchema + ] + + for selectedIndex in 0 .. media.Length - 1 do + let selectedName = fst media.[selectedIndex] + let available = media |> List.skip selectedIndex + + let makePlan (entries : (string * JsonNode) list) = + let response = + jsonObject + [ + "description", jsonString "success" + "content", + jsonObject ( + entries + |> List.map (fun (name, schema) -> name, jsonObject [ "schema", schema.DeepClone () ]) + ) + ] + + let pathItem = standardPathItem response [] [] + document "3.0.3" [] "/things" pathItem |> plan + + let forward = makePlan available + let reversed = makePlan (List.rev available) + reversed |> shouldEqual forward + + let operation = forward.Operations |> List.exactlyOne + operation.Accept |> shouldEqual (Some selectedName) + + match selectedIndex with + | 0 + | 1 -> + let definition = forward.Types |> List.exactlyOne + + operation.ReturnType + |> shouldEqual (OpenApiPlannedType.Named definition.FSharpName) + | 2 -> + operation.ReturnType + |> shouldEqual (OpenApiPlannedType.Primitive OpenApiPrimitive.String) + + forward.Types |> shouldEqual [] + | 3 -> + operation.ReturnType |> shouldEqual OpenApiPlannedType.Stream + forward.Types |> shouldEqual [] + | _ -> failwith "Unreachable media case" + + [] + let ``Incompatible successful response media produce a diagnostic at the mutated status`` () = + let response mediaType = + jsonObject + [ + "description", jsonString "success" + "content", + jsonObject + [ + mediaType, jsonObject [ "schema", schemaForScalar GeneratedScalar.String false ] + ] + ] + + let pathItem = + jsonObject + [ + "get", + jsonObject + [ + "operationId", jsonString "getThing" + "responses", + jsonObject [ "200", response "text/plain" ; "201", response "application/octet-stream" ] + ] + ] + + let source = document "3.0.3" [] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly accepted incompatible successful responses" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.AmbiguousSuccessResponse + && diagnostic.Location.EndsWith ("/responses/201", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Default responses constrain unspecified successful statuses unless 2XX covers them`` () = + let response mediaType = + jsonObject + [ + "description", jsonString "response" + "content", + jsonObject + [ + mediaType, jsonObject [ "schema", schemaForScalar GeneratedScalar.String false ] + ] + ] + + let makeSource responses = + let pathItem = + jsonObject + [ + "get", jsonObject [ "operationId", jsonString "getThing" ; "responses", jsonObject responses ] + ] + + document "3.0.3" [] "/things" pathItem + + let incompatible = + makeSource + [ + "200", response "text/plain" + "default", response "application/octet-stream" + ] + + match OpenApiClientGenerator.parseAndPlan config incompatible with + | Ok _ -> failwith "Planning unexpectedly ignored default for unspecified 2xx statuses" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.AmbiguousSuccessResponse + && diagnostic.Location.EndsWith ("/responses/default", StringComparison.Ordinal) + ) + |> shouldEqual true + + let rangeCovered = + makeSource + [ + "2XX", response "text/plain" + "default", response "application/octet-stream" + ] + |> plan + + rangeCovered.Operations + |> List.exactlyOne + |> _.ReturnType + |> shouldEqual (OpenApiPlannedType.Primitive OpenApiPrimitive.String) + + let defaultOnly = makeSource [ "default", response "text/plain" ] |> plan + + defaultOnly.Operations + |> List.exactlyOne + |> _.Accept + |> shouldEqual (Some "text/plain") + + [] + let ``AllOf rejects fields made impossible by another branch's additionalProperties constraint`` () = + let closed = + jsonObject + [ + "type", jsonString "object" + "additionalProperties", jsonBool false + "properties", jsonObject [ "id", schemaForScalar GeneratedScalar.Int64 false ] + ] + + let extension = + jsonObject + [ + "type", jsonString "object" + "properties", jsonObject [ "display-name", schemaForScalar GeneratedScalar.String false ] + ] + + let child = jsonObject [ "allOf", jsonArray [ closed ; extension ] ] + let pathItem = standardPathItem (responseWithSchema (reference "Child")) [] [] + let source = document "3.0.3" [ "Child", child ] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly weakened an allOf additionalProperties constraint" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSchema) + |> shouldEqual true + + [] + let ``A single path-parameter mismatch mutation always produces a diagnostic`` () = + for missingParameter in [ false ; true ] do + let path, parameters = + if missingParameter then + "/things/{id}", [] + else + "/things", [ parameter "id" "path" true (schemaForScalar GeneratedScalar.Int64 false) ] + + let pathItem = standardPathItem (noContentResponse ()) parameters [] + let source = document "3.0.3" [] path pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly accepted a path/parameter mismatch" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedParameter + ) + |> shouldEqual true + + [] + let ``OpenAPI 3.1 is rejected rather than silently interpreted as 3.0`` () = + let pathItem = standardPathItem (noContentResponse ()) [] [] + let source = document "3.1.0" [] "/things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly accepted OpenAPI 3.1" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedVersion) + |> shouldEqual true + + [] + let ``Paths beginning with multiple slashes are rejected before URI semantics can change them`` () = + let pathItem = standardPathItem (noContentResponse ()) [] [] + let source = document "3.0.3" [] "//things" pathItem + + match OpenApiClientGenerator.parseAndPlan config source with + | Ok _ -> failwith "Planning unexpectedly allowed the HTTP shell to reinterpret a network-path reference" + | Error diagnostics -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.InvalidDocument + && diagnostic.Location.Contains ("~1~1things", StringComparison.Ordinal) + ) + |> shouldEqual true diff --git a/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Parse.fs b/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Parse.fs deleted file mode 100644 index add81e77..00000000 --- a/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Parse.fs +++ /dev/null @@ -1,3503 +0,0 @@ -namespace WoofWare.Myriad.Plugins.Test - -open WoofWare.Myriad.Plugins.OpenApi3 -open System.Text.Json.Nodes -open NUnit.Framework -open WoofWare.Expect - -[] -[] -module TestOpenApi3Parse = - [] - let ``Prepare to bulk-update tests`` () = - // GlobalBuilderConfig.enterBulkUpdateMode () - () - - [] - let ``Update all tests`` () = - GlobalBuilderConfig.updateAllSnapshots () - - type Dummy = class end - - [] - let ``API with examples`` () = - let resource = - Assembly.getEmbeddedResource typeof.Assembly "api-with-examples.json" - |> JsonNode.Parse - |> _.AsObject() - - let actual = OpenApiSpec.Parse resource - - expect { - snapshotJson - @"{ - ""OpenApi"": ""3.0.0"", - ""Info"": { - ""Title"": ""Simple API overview"", - ""Description"": null, - ""TermsOfService"": null, - ""Contact"": null, - ""License"": null, - ""Version"": ""2.0.0"" - }, - ""Servers"": null, - ""Paths"": { - ""Fields"": { - ""/"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": ""List API versions"", - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""listVersionsv2"", - ""Parameters"": null, - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""200 response"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": null, - ""Example"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""foo"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Summary"": null, - ""Description"": null, - ""Value"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""versions"": [ - { - ""status"": ""CURRENT"", - ""updated"": ""2011-01-21T11:33:21Z"", - ""id"": ""v2.0"", - ""links"": [ - { - ""href"": ""http://127.0.0.1:8774/v2/"", - ""rel"": ""self"" - } - ] - }, - { - ""status"": ""EXPERIMENTAL"", - ""updated"": ""2013-07-23T11:33:21Z"", - ""id"": ""v3.0"", - ""links"": [ - { - ""href"": ""http://127.0.0.1:8774/v3/"", - ""rel"": ""self"" - } - ] - } - ] - } - ] - } - } - ] - } - } - ] - }, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""300"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""300 response"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": null, - ""Example"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""foo"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Summary"": null, - ""Description"": null, - ""Value"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""versions"": [ - { - ""status"": ""CURRENT"", - ""updated"": ""2011-01-21T11:33:21Z"", - ""id"": ""v2.0"", - ""links"": [ - { - ""href"": ""http://127.0.0.1:8774/v2/"", - ""rel"": ""self"" - } - ] - }, - { - ""status"": ""EXPERIMENTAL"", - ""updated"": ""2013-07-23T11:33:21Z"", - ""id"": ""v3.0"", - ""links"": [ - { - ""href"": ""http://127.0.0.1:8774/v3/"", - ""rel"": ""self"" - } - ] - } - ] - } - ] - } - } - ] - } - } - ] - }, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/v2"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": ""Show API version details"", - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""getVersionDetailsv2"", - ""Parameters"": null, - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""200 response"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": null, - ""Example"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""foo"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Summary"": null, - ""Description"": null, - ""Value"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""version"": { - ""status"": ""CURRENT"", - ""updated"": ""2011-01-21T11:33:21Z"", - ""media-types"": [ - { - ""base"": ""application/xml"", - ""type"": ""application/vnd.openstack.compute\u002Bxml;version=2"" - }, - { - ""base"": ""application/json"", - ""type"": ""application/vnd.openstack.compute\u002Bjson;version=2"" - } - ], - ""id"": ""v2.0"", - ""links"": [ - { - ""href"": ""http://127.0.0.1:8774/v2/"", - ""rel"": ""self"" - }, - { - ""href"": ""http://docs.openstack.org/api/openstack-compute/2/os-compute-devguide-2.pdf"", - ""type"": ""application/pdf"", - ""rel"": ""describedby"" - }, - { - ""href"": ""http://docs.openstack.org/api/openstack-compute/2/wadl/os-compute-2.wadl"", - ""type"": ""application/vnd.sun.wadl\u002Bxml"", - ""rel"": ""describedby"" - }, - { - ""href"": ""http://docs.openstack.org/api/openstack-compute/2/wadl/os-compute-2.wadl"", - ""type"": ""application/vnd.sun.wadl\u002Bxml"", - ""rel"": ""describedby"" - } - ] - } - } - ] - } - } - ] - } - } - ] - }, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""203"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""203 response"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": null, - ""Example"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""foo"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Summary"": null, - ""Description"": null, - ""Value"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""version"": { - ""status"": ""CURRENT"", - ""updated"": ""2011-01-21T11:33:21Z"", - ""media-types"": [ - { - ""base"": ""application/xml"", - ""type"": ""application/vnd.openstack.compute\u002Bxml;version=2"" - }, - { - ""base"": ""application/json"", - ""type"": ""application/vnd.openstack.compute\u002Bjson;version=2"" - } - ], - ""id"": ""v2.0"", - ""links"": [ - { - ""href"": ""http://23.253.228.211:8774/v2/"", - ""rel"": ""self"" - }, - { - ""href"": ""http://docs.openstack.org/api/openstack-compute/2/os-compute-devguide-2.pdf"", - ""type"": ""application/pdf"", - ""rel"": ""describedby"" - }, - { - ""href"": ""http://docs.openstack.org/api/openstack-compute/2/wadl/os-compute-2.wadl"", - ""type"": ""application/vnd.sun.wadl\u002Bxml"", - ""rel"": ""describedby"" - } - ] - } - } - ] - } - } - ] - } - } - ] - }, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - } - } - }, - ""Components"": null, - ""Security"": null, - ""Tags"": null, - ""ExternalDocs"": null -}" - - return actual - } - - [] - let ``Callback example`` () = - let resource = - Assembly.getEmbeddedResource typeof.Assembly "callback-example.json" - |> JsonNode.Parse - |> _.AsObject() - - let actual = OpenApiSpec.Parse resource - - expect { - snapshotJson - @"{ - ""OpenApi"": ""3.0.0"", - ""Info"": { - ""Title"": ""Callback Example"", - ""Description"": null, - ""TermsOfService"": null, - ""Contact"": null, - ""License"": null, - ""Version"": ""1.0.0"" - }, - ""Servers"": null, - ""Paths"": { - ""Fields"": { - ""/streams"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": null, - ""Put"": null, - ""Post"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": ""subscribes a client to receive out-of-band data"", - ""ExternalDocs"": null, - ""OperationId"": null, - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""callbackUrl"", - ""In"": { - ""Case"": ""Query"" - }, - ""Description"": ""the location where data will be sent. Must be network accessible\nby the source server\n"", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""201"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""subscription successfully created"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": { - ""onData"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Patterns"": { - ""{$request.query.callbackUrl}/data"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": null, - ""Put"": null, - ""Post"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": null, - ""Parameters"": null, - ""RequestBody"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""subscription payload"", - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Required"": null - } - ] - }, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""202"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""Your server implementation should return this HTTP status code\nif the data was received successfully\n"", - ""Headers"": null, - ""Content"": null, - ""Links"": null - } - ] - }, - ""204"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""Your server should return this HTTP status code if no longer interested\nin further updates\n"", - ""Headers"": null, - ""Content"": null, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - } - } - } - ] - } - }, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - } - } - }, - ""Components"": null, - ""Security"": null, - ""Tags"": null, - ""ExternalDocs"": null -}" - - return actual - } - - [] - let ``Link example`` () = - let resource = - Assembly.getEmbeddedResource typeof.Assembly "link-example.json" - |> JsonNode.Parse - |> _.AsObject() - - let actual = OpenApiSpec.Parse resource - - expect { - snapshotJson - @"{ - ""OpenApi"": ""3.0.0"", - ""Info"": { - ""Title"": ""Link Example"", - ""Description"": null, - ""TermsOfService"": null, - ""Contact"": null, - ""License"": null, - ""Version"": ""1.0.0"" - }, - ""Servers"": null, - ""Paths"": { - ""Fields"": { - ""/2.0/repositories/{username}"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""getRepositoriesByOwner"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""username"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""repositories owned by the supplied user"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": { - ""userRepository"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/links/UserRepository"" - } - ] - } - } - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/2.0/repositories/{username}/{slug}"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""getRepository"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""username"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""slug"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""The repository"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/repository"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": { - ""repositoryPullRequests"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/links/RepositoryPullRequests"" - } - ] - } - } - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/2.0/repositories/{username}/{slug}/pullrequests"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""getPullRequestsByRepository"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""username"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""slug"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""state"", - ""In"": { - ""Case"": ""Query"" - }, - ""Description"": null, - ""Required"": null, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""an array of pull request objects"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/2.0/repositories/{username}/{slug}/pullrequests/{pid}"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""getPullRequestsById"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""username"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""slug"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""pid"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""a pull request object"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/pullrequest"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": { - ""pullRequestMerge"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/links/PullRequestMerge"" - } - ] - } - } - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/2.0/repositories/{username}/{slug}/pullrequests/{pid}/merge"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": null, - ""Put"": null, - ""Post"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""mergePullRequest"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""username"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""slug"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""pid"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""204"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""the PR was successfully merged"", - ""Headers"": null, - ""Content"": null, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/2.0/users/{username}"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""getUserByName"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""username"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": null, - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""The User"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/user"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": { - ""userRepositories"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/links/UserRepositories"" - } - ] - } - } - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - } - } - }, - ""Components"": { - ""Schemas"": { - ""pullrequest"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""repository"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""user"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - } - }, - ""Responses"": null, - ""Parameters"": null, - ""Examples"": null, - ""RequestBodies"": null, - ""Headers"": null, - ""SecuritySchemes"": null, - ""Links"": { - ""PullRequestMerge"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Operation"": { - ""Case"": ""Id"", - ""Fields"": [ - ""mergePullRequest"" - ] - }, - ""Parameters"": { - ""pid"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""$response.body#/id"" - ] - }, - ""slug"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""$response.body#/repository/slug"" - ] - }, - ""username"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""$response.body#/author/username"" - ] - } - }, - ""RequestBody"": null, - ""Description"": null, - ""Server"": null - } - ] - }, - ""RepositoryPullRequests"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Operation"": { - ""Case"": ""Id"", - ""Fields"": [ - ""getPullRequestsByRepository"" - ] - }, - ""Parameters"": { - ""slug"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""$response.body#/slug"" - ] - }, - ""username"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""$response.body#/owner/username"" - ] - } - }, - ""RequestBody"": null, - ""Description"": null, - ""Server"": null - } - ] - }, - ""UserRepositories"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Operation"": { - ""Case"": ""Id"", - ""Fields"": [ - ""getRepositoriesByOwner"" - ] - }, - ""Parameters"": { - ""username"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""$response.body#/username"" - ] - } - }, - ""RequestBody"": null, - ""Description"": null, - ""Server"": null - } - ] - }, - ""UserRepository"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Operation"": { - ""Case"": ""Id"", - ""Fields"": [ - ""getRepository"" - ] - }, - ""Parameters"": { - ""slug"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""$response.body#/slug"" - ] - }, - ""username"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""$response.body#/owner/username"" - ] - } - }, - ""RequestBody"": null, - ""Description"": null, - ""Server"": null - } - ] - } - }, - ""Callbacks"": null - }, - ""Security"": null, - ""Tags"": null, - ""ExternalDocs"": null -}" - - return actual - } - - [] - let ``Non-oauth scopes example`` () = - let resource = - Assembly.getEmbeddedResource typeof.Assembly "non-oauth-scopes.json" - |> JsonNode.Parse - |> _.AsObject() - - let actual = OpenApiSpec.Parse resource - - expect { - snapshotJson - @"{ - ""OpenApi"": ""3.1.0"", - ""Info"": { - ""Title"": ""Non-oAuth Scopes example"", - ""Description"": null, - ""TermsOfService"": null, - ""Contact"": null, - ""License"": null, - ""Version"": ""1.0.0"" - }, - ""Servers"": null, - ""Paths"": { - ""Fields"": { - ""/users"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": null, - ""Parameters"": null, - ""RequestBody"": null, - ""Responses"": null, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": [ - { - ""Fields"": { - ""bearerAuth"": [ - ""read:users"", - ""public"" - ] - } - } - ], - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - } - } - }, - ""Components"": { - ""Schemas"": null, - ""Responses"": null, - ""Parameters"": null, - ""Examples"": null, - ""RequestBodies"": null, - ""Headers"": null, - ""SecuritySchemes"": { - ""bearerAuth"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Case"": ""Http"", - ""Fields"": [ - ""note: non-oauth scopes are not defined at the securityScheme level"", - ""bearer"", - ""jwt"" - ] - } - ] - } - }, - ""Links"": null, - ""Callbacks"": null - }, - ""Security"": null, - ""Tags"": null, - ""ExternalDocs"": null -}" - - return actual - } - - [] - let ``Petstore example`` () = - let resource = - Assembly.getEmbeddedResource typeof.Assembly "petstore.json" - |> JsonNode.Parse - |> _.AsObject() - - let actual = OpenApiSpec.Parse resource - - expect { - snapshotJson - @"{ - ""OpenApi"": ""3.0.0"", - ""Info"": { - ""Title"": ""Swagger Petstore"", - ""Description"": null, - ""TermsOfService"": null, - ""Contact"": null, - ""License"": { - ""Name"": ""MIT"", - ""Url"": null - }, - ""Version"": ""1.0.0"" - }, - ""Servers"": [ - { - ""Url"": ""http://petstore.swagger.io/v1"", - ""Description"": null, - ""Variables"": null - } - ], - ""Paths"": { - ""Fields"": { - ""/pets"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": [ - ""pets"" - ], - ""Summary"": ""List all pets"", - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""listPets"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""limit"", - ""In"": { - ""Case"": ""Query"" - }, - ""Description"": ""How many items to return at one time (max 100)"", - ""Required"": false, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""unexpected error"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Error"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""A paged array of pets"", - ""Headers"": { - ""x-next"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""A link to the next page of responses"", - ""Required"": null, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - }, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Pets"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": { - ""Tags"": [ - ""pets"" - ], - ""Summary"": ""Create a pet"", - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""createPets"", - ""Parameters"": null, - ""RequestBody"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Pet"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Required"": true - } - ] - }, - ""Responses"": { - ""Default"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""unexpected error"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Error"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""Patterns"": { - ""201"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""Null response"", - ""Headers"": null, - ""Content"": null, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/pets/{petId}"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": [ - ""pets"" - ], - ""Summary"": ""Info for a specific pet"", - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""showPetById"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""petId"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": ""The id of the pet to retrieve"", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""unexpected error"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Error"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""Expected response to a valid request"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Pet"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - } - } - }, - ""Components"": { - ""Schemas"": { - ""Error"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Pet"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Pets"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - } - }, - ""Responses"": null, - ""Parameters"": null, - ""Examples"": null, - ""RequestBodies"": null, - ""Headers"": null, - ""SecuritySchemes"": null, - ""Links"": null, - ""Callbacks"": null - }, - ""Security"": null, - ""Tags"": null, - ""ExternalDocs"": null -}" - - return actual - } - - [] - let ``Petstore expanded example`` () = - let resource = - Assembly.getEmbeddedResource typeof.Assembly "petstore-expanded.json" - |> JsonNode.Parse - |> _.AsObject() - - let actual = OpenApiSpec.Parse resource - - expect { - snapshotJson - @"{ - ""OpenApi"": ""3.0.0"", - ""Info"": { - ""Title"": ""Swagger Petstore"", - ""Description"": ""A sample API that uses a petstore as an example to demonstrate features in the OpenAPI 3.0 specification"", - ""TermsOfService"": ""http://swagger.io/terms/"", - ""Contact"": { - ""Name"": ""Swagger API Team"", - ""Url"": ""http://swagger.io"", - ""Email"": ""apiteam@swagger.io"" - }, - ""License"": { - ""Name"": ""Apache 2.0"", - ""Url"": ""https://www.apache.org/licenses/LICENSE-2.0.html"" - }, - ""Version"": ""1.0.0"" - }, - ""Servers"": [ - { - ""Url"": ""https://petstore.swagger.io/v2"", - ""Description"": null, - ""Variables"": null - } - ], - ""Paths"": { - ""Fields"": { - ""/pets"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": ""Returns all pets from the system that the user has access to\nNam sed condimentum est. Maecenas tempor sagittis sapien, nec rhoncus sem sagittis sit amet. Aenean at gravida augue, ac iaculis sem. Curabitur odio lorem, ornare eget elementum nec, cursus id lectus. Duis mi turpis, pulvinar ac eros ac, tincidunt varius justo. In hac habitasse platea dictumst. Integer at adipiscing ante, a sagittis ligula. Aenean pharetra tempor ante molestie imperdiet. Vivamus id aliquam diam. Cras quis velit non tortor eleifend sagittis. Praesent at enim pharetra urna volutpat venenatis eget eget mauris. In eleifend fermentum facilisis. Praesent enim enim, gravida ac sodales sed, placerat id erat. Suspendisse lacus dolor, consectetur non augue vel, vehicula interdum libero. Morbi euismod sagittis libero sed lacinia.\n\nSed tempus felis lobortis leo pulvinar rutrum. Nam mattis velit nisl, eu condimentum ligula luctus nec. Phasellus semper velit eget aliquet faucibus. In a mattis elit. Phasellus vel urna viverra, condimentum lorem id, rhoncus nibh. Ut pellentesque posuere elementum. Sed a varius odio. Morbi rhoncus ligula libero, vel eleifend nunc tristique vitae. Fusce et sem dui. Aenean nec scelerisque tortor. Fusce malesuada accumsan magna vel tempus. Quisque mollis felis eu dolor tristique, sit amet auctor felis gravida. Sed libero lorem, molestie sed nisl in, accumsan tempor nisi. Fusce sollicitudin massa ut lacinia mattis. Sed vel eleifend lorem. Pellentesque vitae felis pretium, pulvinar elit eu, euismod sapien.\n"", - ""ExternalDocs"": null, - ""OperationId"": ""findPets"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""tags"", - ""In"": { - ""Case"": ""Query"" - }, - ""Description"": ""tags to filter by"", - ""Required"": false, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": ""form"", - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""limit"", - ""In"": { - ""Case"": ""Query"" - }, - ""Description"": ""maximum number of results to return"", - ""Required"": false, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""unexpected error"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Error"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""pet response"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": ""Creates a new pet in the store. Duplicates are allowed"", - ""ExternalDocs"": null, - ""OperationId"": ""addPet"", - ""Parameters"": null, - ""RequestBody"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""Pet to add to the store"", - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/NewPet"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Required"": true - } - ] - }, - ""Responses"": { - ""Default"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""unexpected error"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Error"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""pet response"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Pet"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/pets/{id}"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": ""Returns a user based on a single ID, if the user does not have access to the pet"", - ""ExternalDocs"": null, - ""OperationId"": ""find pet by id"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""id"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": ""ID of pet to fetch"", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""unexpected error"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Error"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""pet response"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Pet"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": { - ""Tags"": null, - ""Summary"": null, - ""Description"": ""deletes a single pet based on the ID supplied"", - ""ExternalDocs"": null, - ""OperationId"": ""deletePet"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""id"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": ""ID of pet to delete"", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""unexpected error"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/Error"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""Patterns"": { - ""204"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""pet deleted"", - ""Headers"": null, - ""Content"": null, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - } - } - }, - ""Components"": { - ""Schemas"": { - ""Error"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""NewPet"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Pet"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - } - }, - ""Responses"": null, - ""Parameters"": null, - ""Examples"": null, - ""RequestBodies"": null, - ""Headers"": null, - ""SecuritySchemes"": null, - ""Links"": null, - ""Callbacks"": null - }, - ""Security"": null, - ""Tags"": null, - ""ExternalDocs"": null -}" - - return actual - } - - [] - let ``Tictactoe example`` () = - let resource = - Assembly.getEmbeddedResource typeof.Assembly "tictactoe.json" - |> JsonNode.Parse - |> _.AsObject() - - let actual = OpenApiSpec.Parse resource - - expect { - snapshotJson - @"{ - ""OpenApi"": ""3.1.0"", - ""Info"": { - ""Title"": ""Tic Tac Toe"", - ""Description"": ""This API allows writing down marks on a Tic Tac Toe board\nand requesting the state of the board or of individual squares.\n"", - ""TermsOfService"": null, - ""Contact"": null, - ""License"": null, - ""Version"": ""1.0.0"" - }, - ""Servers"": null, - ""Paths"": { - ""Fields"": { - ""/board"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": [ - ""Gameplay"" - ], - ""Summary"": ""Get the whole board"", - ""Description"": ""Retrieves the current state of the board and the winner."", - ""ExternalDocs"": null, - ""OperationId"": ""get-board"", - ""Parameters"": null, - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""OK"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/status"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": [ - { - ""Fields"": { - ""defaultApiKey"": [] - } - }, - { - ""Fields"": { - ""app2AppOauth"": [ - ""board:read"" - ] - } - } - ], - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/board/{row}/{column}"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": [ - ""Gameplay"" - ], - ""Summary"": ""Get a single board square"", - ""Description"": ""Retrieves the requested square."", - ""ExternalDocs"": null, - ""OperationId"": ""get-square"", - ""Parameters"": null, - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""OK"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/mark"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""400"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""The provided parameters are incorrect"", - ""Headers"": null, - ""Content"": { - ""text/html"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/errorMessage"" - } - ] - }, - ""Example"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""Illegal coordinates"" - ] - }, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": [ - { - ""Fields"": { - ""bearerHttpAuthentication"": [] - } - }, - { - ""Fields"": { - ""user2AppOauth"": [ - ""board:read"" - ] - } - } - ], - ""Servers"": null - }, - ""Put"": { - ""Tags"": [ - ""Gameplay"" - ], - ""Summary"": ""Set a single board square"", - ""Description"": ""Places a mark on the board and retrieves the whole board and the winner (if any)."", - ""ExternalDocs"": null, - ""OperationId"": ""put-square"", - ""Parameters"": null, - ""RequestBody"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/mark"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Required"": true - } - ] - }, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""OK"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/status"" - } - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""400"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""The provided parameters are incorrect"", - ""Headers"": null, - ""Content"": { - ""text/html"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/errorMessage"" - } - ] - }, - ""Example"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""illegalCoordinates"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Summary"": null, - ""Description"": null, - ""Value"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""Illegal coordinates."" - ] - } - } - ] - }, - ""invalidMark"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Summary"": null, - ""Description"": null, - ""Value"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""Invalid Mark (X or O)."" - ] - } - } - ] - }, - ""notEmpty"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Summary"": null, - ""Description"": null, - ""Value"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""Square is not empty."" - ] - } - } - ] - } - } - ] - }, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": [ - { - ""Fields"": { - ""bearerHttpAuthentication"": [] - } - }, - { - ""Fields"": { - ""user2AppOauth"": [ - ""board:write"" - ] - } - } - ], - ""Servers"": null - }, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": [ - { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/parameters/rowParam"" - } - ] - }, - { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/parameters/columnParam"" - } - ] - } - ] - } - } - }, - ""Components"": { - ""Schemas"": { - ""board"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""coordinate"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""errorMessage"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""mark"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""status"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""winner"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - } - }, - ""Responses"": null, - ""Parameters"": { - ""columnParam"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""column"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": ""Board column (horizontal coordinate)"", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/coordinate"" - } - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - ""rowParam"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""row"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": ""Board row (vertical coordinate)"", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/coordinate"" - } - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - }, - ""Examples"": null, - ""RequestBodies"": null, - ""Headers"": null, - ""SecuritySchemes"": { - ""app2AppOauth"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Case"": ""Oauth2"", - ""Fields"": [ - null, - { - ""Implicit"": null, - ""Password"": null, - ""ClientCredentials"": { - ""AuthorizationUrl"": null, - ""TokenUrl"": ""https://learn.openapis.org/oauth/2.0/token"", - ""RefreshUrl"": null, - ""Scopes"": { - ""board:read"": ""Read the board"" - } - }, - ""AuthorizationCode"": null - } - ] - } - ] - }, - ""basicHttpAuthentication"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Case"": ""Http"", - ""Fields"": [ - ""Basic HTTP Authentication"", - ""Basic"", - null - ] - } - ] - }, - ""bearerHttpAuthentication"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Case"": ""Http"", - ""Fields"": [ - ""Bearer token using a JWT"", - ""Bearer"", - ""JWT"" - ] - } - ] - }, - ""defaultApiKey"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Case"": ""ApiKey"", - ""Fields"": [ - ""API key provided in console"", - ""api-key"", - { - ""Case"": ""Header"" - } - ] - } - ] - }, - ""user2AppOauth"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Case"": ""Oauth2"", - ""Fields"": [ - null, - { - ""Implicit"": null, - ""Password"": null, - ""ClientCredentials"": null, - ""AuthorizationCode"": { - ""AuthorizationUrl"": ""https://learn.openapis.org/oauth/2.0/auth"", - ""TokenUrl"": ""https://learn.openapis.org/oauth/2.0/token"", - ""RefreshUrl"": null, - ""Scopes"": { - ""board:read"": ""Read the board"", - ""board:write"": ""Write to the board"" - } - } - } - ] - } - ] - } - }, - ""Links"": null, - ""Callbacks"": null - }, - ""Security"": null, - ""Tags"": [ - { - ""Name"": ""Gameplay"", - ""Description"": null, - ""ExternalDocs"": null - } - ], - ""ExternalDocs"": null -}" - - return actual - } - - [] - let ``uspto example`` () = - let resource = - Assembly.getEmbeddedResource typeof.Assembly "uspto.json" - |> JsonNode.Parse - |> _.AsObject() - - let actual = OpenApiSpec.Parse resource - - expect { - snapshotJson - @"{ - ""OpenApi"": ""3.0.1"", - ""Info"": { - ""Title"": ""USPTO Data Set API"", - ""Description"": ""The Data Set API (DSAPI) allows the public users to discover and search USPTO exported data sets. This is a generic API that allows USPTO users to make any CSV based data files searchable through API. With the help of GET call, it returns the list of data fields that are searchable. With the help of POST call, data can be fetched based on the filters on the field names. Please note that POST call is used to search the actual data. The reason for the POST call is that it allows users to specify any complex search criteria without worry about the GET size limitations as well as encoding of the input parameters."", - ""TermsOfService"": null, - ""Contact"": { - ""Name"": ""Open Data Portal"", - ""Url"": ""https://developer.uspto.gov"", - ""Email"": ""developer@uspto.gov"" - }, - ""License"": null, - ""Version"": ""1.0.0"" - }, - ""Servers"": [ - { - ""Url"": ""{scheme}://developer.uspto.gov/ds-api"", - ""Description"": null, - ""Variables"": { - ""scheme"": { - ""Enum"": [ - ""https"", - ""http"" - ], - ""Default"": ""https"", - ""Description"": ""The Data Set API is accessible via https and http"" - } - } - } - ], - ""Paths"": { - ""Fields"": { - ""/"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": [ - ""metadata"" - ], - ""Summary"": ""List available data sets"", - ""Description"": null, - ""ExternalDocs"": null, - ""OperationId"": ""list-data-sets"", - ""Parameters"": null, - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""Returns a list of data sets"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice2Of2"", - ""Fields"": [ - { - ""Ref"": ""#/components/schemas/dataSetList"" - } - ] - }, - ""Example"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""total"": 2, - ""apis"": [ - { - ""apiKey"": ""oa_citations"", - ""apiVersionNumber"": ""v1"", - ""apiUrl"": ""https://developer.uspto.gov/ds-api/oa_citations/v1/fields"", - ""apiDocumentationUrl"": ""https://developer.uspto.gov/ds-api-docs/index.html?url=https://developer.uspto.gov/ds-api/swagger/docs/oa_citations.json"" - }, - { - ""apiKey"": ""cancer_moonshot"", - ""apiVersionNumber"": ""v1"", - ""apiUrl"": ""https://developer.uspto.gov/ds-api/cancer_moonshot/v1/fields"", - ""apiDocumentationUrl"": ""https://developer.uspto.gov/ds-api-docs/index.html?url=https://developer.uspto.gov/ds-api/swagger/docs/cancer_moonshot.json"" - } - ] - } - ] - }, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/{dataset}/{version}/fields"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": { - ""Tags"": [ - ""metadata"" - ], - ""Summary"": ""Provides the general information about the API and the list of fields that can be used to query the dataset."", - ""Description"": ""This GET API returns the list of all the searchable field names that are in the oa_citations. Please see the \u0027fields\u0027 attribute which returns an array of field names. Each field or a combination of fields can be searched using the syntax options shown below."", - ""ExternalDocs"": null, - ""OperationId"": ""list-searchable-fields"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""dataset"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": ""Name of the dataset."", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""oa_citations"" - ] - }, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""version"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": ""Version of the dataset."", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - ""v1"" - ] - }, - ""Content"": null - } - ] - } - ], - ""RequestBody"": null, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""The dataset API for the given version is found and it is accessible to consume."", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""404"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""The combination of dataset name and version is not found in the system or it is not published yet to be consumed by public."", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Put"": null, - ""Post"": null, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - }, - ""/{dataset}/{version}/records"": { - ""Ref"": null, - ""Summary"": null, - ""Description"": null, - ""Get"": null, - ""Put"": null, - ""Post"": { - ""Tags"": [ - ""search"" - ], - ""Summary"": ""Provides search capability for the data set with the given search criteria."", - ""Description"": ""This API is based on Solr/Lucene Search. The data is indexed using SOLR. This GET API returns the list of all the searchable field names that are in the Solr Index. Please see the \u0027fields\u0027 attribute which returns an array of field names. Each field or a combination of fields can be searched using the Solr/Lucene Syntax. Please refer https://lucene.apache.org/core/3_6_2/queryparsersyntax.html#Overview for the query syntax. List of field names that are searchable can be determined using above GET api."", - ""ExternalDocs"": null, - ""OperationId"": ""perform-search"", - ""Parameters"": [ - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""version"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": ""Version of the dataset."", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - }, - { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Name"": ""dataset"", - ""In"": { - ""Case"": ""Path"" - }, - ""Description"": ""Name of the dataset. In this case, the default value is oa_citations"", - ""Required"": true, - ""Deprecated"": null, - ""AllowEmptyValue"": null, - ""Style"": null, - ""Explode"": null, - ""AllowReserved"": null, - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Content"": null - } - ] - } - ], - ""RequestBody"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": null, - ""Content"": { - ""application/x-www-form-urlencoded"": { - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Required"": null - } - ] - }, - ""Responses"": { - ""Default"": null, - ""Patterns"": { - ""200"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""successful operation"", - ""Headers"": null, - ""Content"": { - ""application/json"": { - ""Schema"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - }, - ""Example"": null, - ""Encoding"": null - } - }, - ""Links"": null - } - ] - }, - ""404"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - { - ""Description"": ""No matching record found for the given criteria."", - ""Headers"": null, - ""Content"": null, - ""Links"": null - } - ] - } - } - }, - ""Callbacks"": null, - ""Deprecated"": null, - ""Security"": null, - ""Servers"": null - }, - ""Delete"": null, - ""Options"": null, - ""Head"": null, - ""Patch"": null, - ""Trace"": null, - ""Servers"": null, - ""Parameters"": null - } - } - }, - ""Components"": { - ""Schemas"": { - ""dataSetList"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - } - }, - ""Responses"": null, - ""Parameters"": null, - ""Examples"": null, - ""RequestBodies"": null, - ""Headers"": null, - ""SecuritySchemes"": null, - ""Links"": null, - ""Callbacks"": null - }, - ""Security"": null, - ""Tags"": [ - { - ""Name"": ""metadata"", - ""Description"": ""Find out about the data sets"", - ""ExternalDocs"": null - }, - { - ""Name"": ""search"", - ""Description"": ""Search a data set"", - ""ExternalDocs"": null - } - ], - ""ExternalDocs"": null -}" - - return actual - } - - [] - let ``webhook example`` () = - // Webhooks aren't mentioned in the 3.0.0 spec so we have no information here. - let resource = - Assembly.getEmbeddedResource typeof.Assembly "webhook-example.json" - |> JsonNode.Parse - |> _.AsObject() - - let actual = OpenApiSpec.Parse resource - - expect { - snapshotJson - @"{ - ""OpenApi"": ""3.1.0"", - ""Info"": { - ""Title"": ""Webhook Example"", - ""Description"": null, - ""TermsOfService"": null, - ""Contact"": null, - ""License"": null, - ""Version"": ""1.0.0"" - }, - ""Servers"": null, - ""Paths"": null, - ""Components"": { - ""Schemas"": { - ""Pet"": { - ""Case"": ""Choice1Of2"", - ""Fields"": [ - null - ] - } - }, - ""Responses"": null, - ""Parameters"": null, - ""Examples"": null, - ""RequestBodies"": null, - ""Headers"": null, - ""SecuritySchemes"": null, - ""Links"": null, - ""Callbacks"": null - }, - ""Security"": null, - ""Tags"": null, - ""ExternalDocs"": null -}" - - return actual - } diff --git a/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Security.fs b/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Security.fs new file mode 100644 index 00000000..e6876a1c --- /dev/null +++ b/WoofWare.Myriad.Plugins.Test/TestSwagger/TestOpenApi3Security.fs @@ -0,0 +1,595 @@ +namespace WoofWare.Myriad.Plugins.Test + +open System +open System.Text.Json.Nodes +open FsCheck +open FsCheck.FSharp +open FsUnitTyped +open NUnit.Framework +open WoofWare.Myriad.Plugins + +/// The OpenAPI planner's treatment of `security` and `components.securitySchemes`: which credentials +/// each operation sends, and which documents it refuses rather than silently authenticating nothing. +[] +module TestOpenApi3Security = + + let private jsonString (value : string) : JsonNode = JsonValue.Create value + + let private jsonObject (properties : (string * JsonNode) list) : JsonNode = + let result = JsonObject () + + for name, value in properties do + result.Add (name, value) + + result :> JsonNode + + let private jsonArray (values : JsonNode list) : JsonNode = + JsonArray (values |> List.toArray) :> JsonNode + + let private apiKeyHeaderScheme (headerName : string) : JsonNode = + jsonObject + [ + "type", jsonString "apiKey" + "name", jsonString headerName + "in", jsonString "header" + ] + + let private apiKeyElsewhereScheme (location : string) : JsonNode = + jsonObject + [ + "type", jsonString "apiKey" + "name", jsonString "key" + "in", jsonString location + ] + + let private httpScheme (scheme : string) : JsonNode = + jsonObject [ "type", jsonString "http" ; "scheme", jsonString scheme ] + + let private oauth2Scheme () : JsonNode = + jsonObject + [ + "type", jsonString "oauth2" + "flows", + jsonObject + [ + "clientCredentials", + jsonObject + [ + "tokenUrl", jsonString "https://example.test/token" + "scopes", jsonObject [ "read", jsonString "Read things" ] + ] + ] + ] + + let private openIdConnectScheme () : JsonNode = + jsonObject + [ + "type", jsonString "openIdConnect" + "openIdConnectUrl", jsonString "https://example.test/.well-known/openid-configuration" + ] + + /// One alternative of a `security` array: all of these schemes together. + let private requirement (schemes : string list) : JsonNode = + jsonObject (schemes |> List.map (fun scheme -> scheme, jsonArray [])) + + /// A document whose operations are named by their path, so a test can look up an operation's + /// plan by name. `operations` gives each operation's `security` array, if it declares one. + let private securityDocument + (schemes : (string * JsonNode) list) + (rootSecurity : JsonNode list option) + (operations : (string * JsonNode list option) list) + : string + = + let pathItem (name : string) (security : JsonNode list option) = + jsonObject + [ + "get", + jsonObject + [ + "operationId", jsonString name + "responses", jsonObject [ "200", jsonObject [ "description", jsonString "success" ] ] + match security with + | None -> () + | Some security -> "security", jsonArray security + ] + ] + + jsonObject + [ + "openapi", jsonString "3.0.3" + "info", jsonObject [ "title", jsonString "Generated API" ; "version", jsonString "1.0.0" ] + "servers", jsonArray [ jsonObject [ "url", jsonString "/api/v1" ] ] + "paths", + jsonObject ( + operations + |> List.map (fun (name, security) -> $"/%s{name}", pathItem name security) + ) + "components", jsonObject [ "securitySchemes", jsonObject schemes ] + match rootSecurity with + | None -> () + | Some security -> "security", jsonArray security + ] + |> _.ToJsonString() + + let private config = Map [ "CLASSNAME", "GeneratedClient" ] + + let private plan (parameters : Map) (source : string) : OpenApiClientPlan = + match OpenApiClientGenerator.parseAndPlan parameters source with + | Ok value -> value + | Error diagnostics -> + diagnostics + |> List.map (fun diagnostic -> $"%s{diagnostic.Location}: %s{diagnostic.Message}") + |> String.concat Environment.NewLine + |> failwith + + let private diagnostics (parameters : Map) (source : string) : OpenApiGenerationDiagnostic list = + match OpenApiClientGenerator.parseAndPlan parameters source with + | Ok _ -> failwith "Planning unexpectedly succeeded" + | Error diagnostics -> diagnostics + + /// The operation whose path was `/name`, by the F# name the planner gave it. + let private operation (plan : OpenApiClientPlan) (name : string) : OpenApiPlannedOperation = + plan.Operations + |> List.filter (fun operation -> operation.Path = $"/%s{name}") + |> List.exactlyOne + + [] + let ``A root security requirement is applied to every operation`` () = + let source = + securityDocument + [ "bearerAuth", httpScheme "bearer" ] + (Some [ requirement [ "bearerAuth" ] ]) + [ "first", None ; "second", None ] + + let plan = plan config source + + for name in [ "first" ; "second" ] do + (operation plan name).Security |> shouldEqual [ "bearerAuth" ] + + let credential = plan.Credentials.["bearerAuth"] + credential.HeaderName |> shouldEqual "Authorization" + credential.Kind |> shouldEqual (OpenApiSecuritySchemeKind.Http "bearer") + credential.FSharpName |> shouldEqual "BearerAuth" + + [] + let ``An operation's security replaces the root's, and an empty one demands no credentials`` () = + let source = + securityDocument + [ + "bearerAuth", httpScheme "bearer" + "apiKeyAuth", apiKeyHeaderScheme "X-API-Key" + ] + (Some [ requirement [ "bearerAuth" ] ]) + [ + "inherited", None + "overridden", Some [ requirement [ "apiKeyAuth" ] ] + "public", Some [] + ] + + let plan = plan config source + + (operation plan "inherited").Security |> shouldEqual [ "bearerAuth" ] + (operation plan "overridden").Security |> shouldEqual [ "apiKeyAuth" ] + (operation plan "public").Security |> shouldEqual [] + + plan.Credentials.["apiKeyAuth"].HeaderName |> shouldEqual "X-API-Key" + + plan.Credentials.["apiKeyAuth"].Kind + |> shouldEqual OpenApiSecuritySchemeKind.ApiKey + + [] + let ``A requirement naming several schemes sends all of their credentials`` () = + let source = + securityDocument + [ + "bearerAuth", httpScheme "bearer" + "apiKeyAuth", apiKeyHeaderScheme "X-API-Key" + ] + None + [ "both", Some [ requirement [ "apiKeyAuth" ; "bearerAuth" ] ] ] + + let plan = plan config source + + (operation plan "both").Security |> shouldEqual [ "apiKeyAuth" ; "bearerAuth" ] + + plan.Credentials |> Map.count |> shouldEqual 2 + + [] + let ``Only the schemes some operation uses become credentials the caller must supply`` () = + let source = + securityDocument + [ + "used", httpScheme "bearer" + "unused", apiKeyHeaderScheme "X-Unused" + "alsoUnrepresentable", apiKeyElsewhereScheme "query" + ] + None + [ "thing", Some [ requirement [ "used" ] ] ] + + let plan = plan config source + + plan.Credentials |> Map.toList |> List.map fst |> shouldEqual [ "used" ] + + [] + let ``OAuth2 and OpenID Connect credentials are carried, but no flow is performed`` () = + let source = + securityDocument + [ "oauth", oauth2Scheme () ; "oidc", openIdConnectScheme () ] + None + [ + "oauthThing", Some [ requirement [ "oauth" ] ] + "oidcThing", Some [ requirement [ "oidc" ] ] + ] + + let plan = plan config source + + plan.Credentials.["oauth"].Kind |> shouldEqual OpenApiSecuritySchemeKind.OAuth2 + + plan.Credentials.["oauth"].HeaderName |> shouldEqual "Authorization" + + plan.Credentials.["oidc"].Kind + |> shouldEqual OpenApiSecuritySchemeKind.OpenIdConnect + + [] + let ``The one satisfiable alternative is applied, whatever its position`` () = + let source = + securityDocument + [ + "queryKey", apiKeyElsewhereScheme "query" + "cookieKey", apiKeyElsewhereScheme "cookie" + "bearerAuth", httpScheme "bearer" + ] + None + [ + "thing", + Some + [ + requirement [ "queryKey" ] + requirement [ "bearerAuth" ] + requirement [ "cookieKey" ] + ] + ] + + let plan = plan config source + + (operation plan "thing").Security |> shouldEqual [ "bearerAuth" ] + + // Document order is not a preference: a spec which says an operation accepts any of several + // credentials is not saying which one *you* should send, and picking for you would silently + // choose how you authenticate. + [] + let ``Several satisfiable alternatives are ambiguous rather than guessed between`` () = + let source = + securityDocument + [ + "bearerAuth", httpScheme "bearer" + "apiKeyAuth", apiKeyHeaderScheme "X-API-Key" + ] + None + [ + "thing", Some [ requirement [ "bearerAuth" ] ; requirement [ "apiKeyAuth" ] ] + ] + + diagnostics config source + |> List.filter (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.AmbiguousSecurity) + |> List.map _.Location + |> shouldEqual [ "#/paths/~1thing/get/security" ] + + /// An operation offering both "no credentials" and a real scheme is a genuine choice too: + /// sending nothing is exactly the silently-unauthenticated client this all exists to prevent. + [] + let ``An alternative demanding no credentials does not win by default`` () = + let source = + securityDocument + [ "bearerAuth", httpScheme "bearer" ] + None + [ "thing", Some [ requirement [] ; requirement [ "bearerAuth" ] ] ] + + let diagnostics = diagnostics config source + + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.AmbiguousSecurity) + |> shouldEqual true + + // The message has to say how to ask for the unauthenticated one, since it has no name. + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Message.Contains ("(no credentials)", StringComparison.Ordinal)) + |> shouldEqual true + + [] + let ``An empty SecuritySchemes parameter selects the unauthenticated alternative`` () = + let source = + securityDocument + [ "bearerAuth", httpScheme "bearer" ] + None + [ "thing", Some [ requirement [] ; requirement [ "bearerAuth" ] ] ] + + let plan = plan (config |> Map.add "SECURITYSCHEMES" "") source + + (operation plan "thing").Security |> shouldEqual [] + plan.Credentials |> shouldEqual Map.empty + + // A single request cannot carry two Authorization values: HttpRequestHeaders.Add throws. An + // alternative demanding both would generate a client that failed on every call. + [] + let ``Schemes which compete for one header cannot be satisfied together`` () = + let source = + securityDocument + [ "bearerAuth", httpScheme "bearer" ; "oauth", oauth2Scheme () ] + None + [ "thing", Some [ requirement [ "bearerAuth" ; "oauth" ] ] ] + + diagnostics config source + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSecurity + && diagnostic.Message.Contains ("'Authorization' header", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``A header collision doesn't stop a later alternative being chosen`` () = + let source = + securityDocument + [ + "bearerAuth", httpScheme "bearer" + "oauth", oauth2Scheme () + "apiKeyAuth", apiKeyHeaderScheme "X-API-Key" + ] + None + [ + "thing", Some [ requirement [ "bearerAuth" ; "oauth" ] ; requirement [ "apiKeyAuth" ] ] + ] + + (operation (plan config source) "thing").Security + |> shouldEqual [ "apiKeyAuth" ] + + [] + let ``Schemes with distinct headers can be satisfied together`` () = + let source = + securityDocument + [ + "bearerAuth", httpScheme "bearer" + "apiKeyAuth", apiKeyHeaderScheme "X-API-Key" + ] + None + [ "thing", Some [ requirement [ "bearerAuth" ; "apiKeyAuth" ] ] ] + + (operation (plan config source) "thing").Security + |> shouldEqual [ "apiKeyAuth" ; "bearerAuth" ] + + [] + let ``An unsatisfiable security requirement fails the build rather than authenticating nothing`` () = + for location in [ "query" ; "cookie" ] do + let source = + securityDocument + [ "key", apiKeyElsewhereScheme location ] + None + [ "thing", Some [ requirement [ "key" ] ] ] + + diagnostics config source + |> List.filter (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSecurity) + |> List.map _.Location + |> shouldEqual [ "#/paths/~1thing/get/security" ] + + [] + let ``A root security requirement we cannot satisfy fails every operation which inherits it`` () = + let source = + securityDocument + [ "key", apiKeyElsewhereScheme "query" ] + (Some [ requirement [ "key" ] ]) + [ "thing", None ; "public", Some [] ] + + let diagnostics = diagnostics config source + + diagnostics + |> List.filter (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSecurity) + |> List.length + |> shouldEqual 1 + + [] + let ``A requirement naming an undefined scheme is a dangling reference`` () = + let source = + securityDocument + [ "bearerAuth", httpScheme "bearer" ] + None + [ "thing", Some [ requirement [ "nonexistent" ] ] ] + + diagnostics config source + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnresolvedReference) + |> shouldEqual true + + [] + let ``A security scheme of unknown type is rejected`` () = + let source = + securityDocument + [ "weird", jsonObject [ "type", jsonString "magic" ] ] + None + [ "thing", Some [ requirement [ "weird" ] ] ] + + let diagnostics = diagnostics config source + + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.InvalidDocument) + |> shouldEqual true + + diagnostics + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSecurity) + |> shouldEqual true + + [] + let ``The SecuritySchemes parameter chooses between alternatives`` () = + let source = + securityDocument + [ + "bearerAuth", httpScheme "bearer" + "apiKeyAuth", apiKeyHeaderScheme "X-API-Key" + ] + None + [ + "thing", Some [ requirement [ "bearerAuth" ] ; requirement [ "apiKeyAuth" ] ] + ] + + let restricted = plan (config |> Map.add "SECURITYSCHEMES" "apiKeyAuth") source + + (operation restricted "thing").Security |> shouldEqual [ "apiKeyAuth" ] + + // Without the restriction, this document doesn't say which to use, so it doesn't generate. + diagnostics config source + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.AmbiguousSecurity) + |> shouldEqual true + + [] + let ``The SecuritySchemes parameter cannot silently exclude every alternative`` () = + let source = + securityDocument + [ "bearerAuth", httpScheme "bearer" ] + None + [ "thing", Some [ requirement [ "bearerAuth" ] ] ] + + diagnostics (config |> Map.add "SECURITYSCHEMES" "apiKeyAuth") source + |> List.exists (fun diagnostic -> diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSecurity) + |> shouldEqual true + + [] + let ``A SecuritySchemes parameter naming an undefined scheme is rejected`` () = + let source = + securityDocument + [ "bearerAuth", httpScheme "bearer" ] + None + [ "thing", Some [ requirement [ "bearerAuth" ] ] ] + + diagnostics (config |> Map.add "SECURITYSCHEMES" "bearerAuth, typo") source + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.InvalidDocument + && diagnostic.Location.Contains ("SecuritySchemes", StringComparison.Ordinal) + ) + |> shouldEqual true + + [] + let ``Credential property names do not collide with operation names`` () = + // The scheme and the operation sanitise to the same F# identifier, and both are members of + // the same interface. + let source = + securityDocument [ "thing", httpScheme "bearer" ] None [ "thing", Some [ requirement [ "thing" ] ] ] + + let plan = plan config source + + (operation plan "thing").FSharpName |> shouldEqual "Thing" + plan.Credentials.["thing"].FSharpName |> shouldEqual "Thing2" + + type private GeneratedSchemeKind = + | Bearer + | ApiKeyHeader + | OAuth2 + | ApiKeyQuery + | ApiKeyCookie + + /// A scheme as the generated document declares it, paired with the header it would occupy + /// (`None` if the planner can't carry it at all). + type private GeneratedScheme = + { + Name : string + Json : JsonNode + Header : string option + } + + let private generatedScheme (index : int) (kind : GeneratedSchemeKind) : GeneratedScheme = + let json, header = + match kind with + | Bearer -> httpScheme "bearer", Some "Authorization" + | ApiKeyHeader -> apiKeyHeaderScheme $"X-Key-%i{index}", Some $"X-Key-%i{index}" + | OAuth2 -> oauth2Scheme (), Some "Authorization" + | ApiKeyQuery -> apiKeyElsewhereScheme "query", None + | ApiKeyCookie -> apiKeyElsewhereScheme "cookie", None + + { + Name = $"scheme%i{index}" + Json = json + Header = header + } + + /// A document's schemes, plus one operation's alternatives as indices into them. + let private securityCase : Gen = + gen { + let! schemeCount = Gen.choose (1, 4) + + let! kinds = + Gen.listOfLength + schemeCount + (Gen.elements [ Bearer ; ApiKeyHeader ; OAuth2 ; ApiKeyQuery ; ApiKeyCookie ]) + + let schemes = kinds |> List.mapi generatedScheme + + let alternative = + gen { + let! size = Gen.choose (0, 2) + let! indices = Gen.listOfLength size (Gen.choose (0, schemeCount - 1)) + // A requirement is a JSON object, so it cannot name the same scheme twice. + return List.distinct indices + } + + let! alternativeCount = Gen.choose (0, 4) + let! alternatives = Gen.listOfLength alternativeCount alternative + return schemes, alternatives + } + + [] + let ``The applied requirement is always the document's unique satisfiable alternative`` () = + let property (schemes : GeneratedScheme list, alternatives : int list list) = + // An alternative works if we can carry every scheme it names, and no two of them want + // the same header (one request can't carry two Authorization values). + let satisfiable (alternative : int list) = + let headers = alternative |> List.map (fun index -> schemes.[index].Header) + + List.forall Option.isSome headers + && List.length (List.distinct headers) = List.length headers + + let schemeNames (alternative : int list) = + alternative + |> List.map (fun index -> schemes.[index].Name) + |> List.distinct + |> List.sort + + // The oracle: the operation generates exactly when one distinct alternative works. An + // absent alternative list is not a failure; it means "this operation needs no + // credentials". + let expected = + if List.isEmpty alternatives then + Some [] + else + match alternatives |> List.filter satisfiable |> List.map schemeNames |> List.distinct with + | [ chosen ] -> Some chosen + | _ -> None + + let source = + securityDocument + (schemes |> List.map (fun scheme -> scheme.Name, scheme.Json)) + None + [ + "thing", + Some ( + alternatives + |> List.map (fun alternative -> + alternative |> List.map (fun index -> schemes.[index].Name) |> requirement + ) + ) + ] + + match OpenApiClientGenerator.parseAndPlan config source, expected with + | Ok plan, Some expected -> + (operation plan "thing").Security = expected + && (plan.Credentials |> Map.toList |> List.map fst) = List.distinct expected + | Error diagnostics, None -> + diagnostics + |> List.exists (fun diagnostic -> + diagnostic.Code = OpenApiGenerationDiagnosticCode.UnsupportedSecurity + || diagnostic.Code = OpenApiGenerationDiagnosticCode.AmbiguousSecurity + ) + | Ok plan, None -> + let sent = (operation plan "thing").Security + failwith $"Planning chose credentials %+A{sent} where the document did not say to" + | Error diagnostics, Some expected -> + failwith + $"Planning rejected a satisfiable requirement %+A{expected}: %+A{diagnostics |> List.map _.Message}" + + Check.QuickThrowOnFailure (Prop.forAll (Arb.fromGen securityCase) property) diff --git a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj index 6b50b0f8..c054dac9 100644 --- a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj +++ b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj @@ -26,6 +26,7 @@ + @@ -55,7 +56,9 @@ - + + + diff --git a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs index 4e912166..f6b60013 100644 --- a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs +++ b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs @@ -64,6 +64,10 @@ module internal HttpClientGenerator = /// Headers which apply *only* to this endpoint. /// For example, SynConst "Authorization" and SynConst "token BLAH". Headers : (SynExpr * SynExpr) list + /// Headers which apply *only* to this endpoint, whose values come from a property of the + /// interface (and so are re-evaluated on every request). + /// For example, SynConst "Authorization" and the identifier `BearerToken`. + PropertyHeaders : (SynExpr * Ident) list } /// Allocate an identifier based on `desired` that does not clash with any name in `taken`. @@ -206,6 +210,42 @@ module internal HttpClientGenerator = | _ -> None ) + /// The property a HeaderFromProperty attribute names. The compiler only ever sees a string here, + /// but the source may spell it either as a literal or, so that a rename is a compile error rather + /// than a silent breakage, as `nameof Unchecked.defaultof.TheProperty` (F#'s `nameof` + /// requires an instance for a non-static member, hence the dance). We read the syntax, not the + /// evaluated constant, so we take the last identifier of whatever `nameof` was applied to. + let private propertyNameOfAttributeArg (expr : SynExpr) : string = + match SynExpr.stripOptionalParen expr with + | SynExpr.Const (SynConst.String (property, SynStringKind.Regular, _), _) -> property + | SynExpr.App (_, _, SynExpr.Ident funcName, arg, _) when funcName.idText = "nameof" -> + match SynExpr.stripOptionalParen arg with + | SynExpr.DotGet (_, _, SynLongIdent (path, _, _), _) + | SynExpr.LongIdent (_, SynLongIdent (path, _, _), _, _) when not path.IsEmpty -> (List.last path).idText + | arg -> failwith $"Expected `nameof` to be applied to a property access, but got: %+A{arg}" + | expr -> + failwith + $"Expected the property in a HeaderFromProperty attribute to be a string literal or a `nameof`, but got: %+A{expr}" + + /// Get the (header name, name of the property supplying its value) pairs associated with the + /// HeaderFromProperty attributes within the list. + let extractHeaderFromPropertyInformation (attrs : SynAttribute list) : (SynExpr * string) list = + attrs + |> List.choose (fun attr -> + match SynLongIdent.toString attr.TypeName with + | "HeaderFromProperty" + | "HeaderFromPropertyAttribute" + | "WoofWare.Myriad.Plugins.HeaderFromProperty" + | "WoofWare.Myriad.Plugins.HeaderFromPropertyAttribute" -> + match attr.ArgExpr with + | SynExpr.Paren (SynExpr.Tuple (_, [ header ; property ], _, _), _, _, _) -> + Some (SynExpr.stripOptionalParen header, propertyNameOfAttributeArg property) + | e -> + failwith + $"Expected HeaderFromProperty attributes to be of the form [], but got: %+A{e}" + | _ -> None + ) + let shouldAllowAnyStatusCode (attrs : SynAttribute list) : bool = attrs |> List.exists (fun attr -> @@ -219,7 +259,10 @@ module internal HttpClientGenerator = /// constantHeaders are a list of (headerName, headerValue) /// variableHeaders are a list of (headerName, selfPropertyToGetValueOf) + /// `clientName` is the name we gave the HttpClient argument of the generated `make`; it isn't + /// always "client", because an interface property may already have claimed that name. let constructMember + (clientName : string) (constantHeaders : (SynExpr * SynExpr) list) (variableHeaders : (SynExpr * Ident) list) (info : MemberInfo) @@ -431,7 +474,7 @@ module internal HttpClientGenerator = let requestUri = let uriIdent = SynExpr.createLongIdent [ "System" ; "Uri" ] - let baseAddress = SynExpr.createLongIdent [ "client" ; "BaseAddress" ] + let baseAddress = SynExpr.createLongIdent [ clientName ; "BaseAddress" ] let baseAddress = [ @@ -785,7 +828,7 @@ module internal HttpClientGenerator = ) let setVariableHeaders = - variableHeaders + variableHeaders @ info.PropertyHeaders |> List.map (fun (headerName, callToGetValue) -> [ headerName @@ -851,7 +894,7 @@ module internal HttpClientGenerator = "response", SynExpr.awaitTask ( SynExpr.applyFunction - (SynExpr.createLongIdent [ "client" ; "SendAsync" ]) + (SynExpr.createLongIdent [ clientName ; "SendAsync" ]) (SynExpr.tuple [ SynExpr.createIdent "httpMessage" ; SynExpr.createIdent "ct" ]) ) ) @@ -899,7 +942,10 @@ module internal HttpClientGenerator = |> SynExpr.startAsTask cancellationTokenArg let thisIdent = - if variableHeaders.IsEmpty then "_" else "this" + if variableHeaders.IsEmpty && info.PropertyHeaders.IsEmpty then + "_" + else + "this" |> Ident.create let args = args |> List.map snd |> SynPat.tuple |> List.singleton @@ -1028,24 +1074,45 @@ module internal HttpClientGenerator = let properties = interfaceType.Properties |> List.map (fun pi -> + // A property with no Header attribute supplies no header of its own; it's addressable + // by the members which name it in a HeaderFromProperty attribute. let headerInfo = match extractHeaderInformation pi.Attributes with - | [ [ x ] ] -> x + | [ [ x ] ] -> Some x | [ _ ] -> failwith - "Expected exactly one Header parameter on the member, with exactly one arg; got one Header parameter with non-1-many args" - | [] -> - failwith - "Expected exactly one Header parameter on the member, with exactly one arg; got no Header parameters" + "Expected at most one Header parameter on the member, with exactly one arg; got one Header parameter with non-1-many args" + | [] -> None | _ -> failwith - "Expected exactly one Header parameter on the member, with exactly one arg; got multiple Header parameters" + "Expected at most one Header parameter on the member, with exactly one arg; got multiple Header parameters" headerInfo, pi ) + // Every property becomes a `unit -> _` argument of `make`, named by lowercasing it; the + // HttpClient argument we add alongside them must not collide with any of those. + let clientName = + properties + |> List.map (fun (_, pi) -> (Ident.lowerFirstLetter pi.Identifier).idText) + |> Set.ofList + |> freshName "client" + + /// The properties which a member may name in a HeaderFromProperty attribute: that is, all + /// the properties which don't already stamp their header onto every request. + let addressableProperties = + properties + |> List.choose (fun (header, pi) -> + match header with + | Some _ -> None + | None -> Some (pi.Identifier.idText, pi.Identifier) + ) + |> Map.ofList + let nonPropertyMembers = - let properties = properties |> List.map (fun (header, pi) -> header, pi.Identifier) + let properties = + properties + |> List.choose (fun (header, pi) -> header |> Option.map (fun header -> header, pi.Identifier)) interfaceType.Members |> List.map (fun mem -> @@ -1061,6 +1128,19 @@ module internal HttpClientGenerator = $"Expected Header attribute on member %s{mem.Identifier.idText} to have exactly two arguments." ) + let propertyHeaders = + extractHeaderFromPropertyInformation mem.Attributes + |> List.map (fun (headerName, propertyName) -> + match Map.tryFind propertyName addressableProperties with + | Some identifier -> headerName, identifier + | None -> + let available = + addressableProperties |> Map.toList |> List.map fst |> String.concat ", " + + failwith + $"Member %s{mem.Identifier.idText} takes a header from property '%s{propertyName}', but the interface has no such property without a Header attribute of its own. Available: [%s{available}]" + ) + let shouldEnsureSuccess = not (shouldAllowAnyStatusCode mem.Attributes) let returnType = @@ -1102,9 +1182,10 @@ module internal HttpClientGenerator = BasePath = basePath Accessibility = mem.Accessibility Headers = specificHeaders + PropertyHeaders = propertyHeaders } ) - |> List.map (constructMember constantHeaders properties) + |> List.map (constructMember clientName constantHeaders properties) let propertyMembers = properties @@ -1148,7 +1229,7 @@ module internal HttpClientGenerator = ) let clientCreationArg = - SynPat.named "client" + SynPat.named clientName |> SynPat.annotateType (SynType.createLongIdent' [ "System" ; "Net" ; "Http" ; "HttpClient" ]) let xmlDoc = @@ -1158,8 +1239,6 @@ module internal HttpClientGenerator = "Create a REST client. The input functions will be re-evaluated on every HTTP request to obtain the required values for the corresponding header properties." |> PreXmlDoc.create - let functionName = Ident.create "client" - let pattern = SynLongIdent.createS "make" let returnInfo = SynType.createLongIdent interfaceType.Name diff --git a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs index 753e6685..910e53df 100644 --- a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs +++ b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs @@ -464,7 +464,6 @@ module internal JsonParseGenerator = SynExpr.createLongIdent [ "System" ; "Globalization" ; "CultureInfo" ; "InvariantCulture" ] ] ) - | Measure (_measure, primType) -> parseNumberType options propertyName node primType |> SynExpr.pipeThroughFunction (Measure.getLanguagePrimitivesMeasure primType) diff --git a/WoofWare.Myriad.Plugins/OpenApi3.fs b/WoofWare.Myriad.Plugins/OpenApi3.fs deleted file mode 100644 index d21c9630..00000000 --- a/WoofWare.Myriad.Plugins/OpenApi3.fs +++ /dev/null @@ -1,1332 +0,0 @@ -module internal WoofWare.Myriad.Plugins.OpenApi3 - -open System -open System.Text.Json.Nodes - -type ExternalDocumentation = - { - /// A short description of the target documentation, possibly in CommonMark. - Description : string option - /// The URL for the target documentation. - Url : Uri - } - - static member Parse (node : JsonObject) : ExternalDocumentation = - let description = asOpt node "description" - let url = asString node "url" |> Uri - - { - Description = description - Url = url - } - -type Schema = - | Schema of unit - - static member Parse (_ : JsonObject) : Schema = Schema () - -type Example = - { - /// Short description for the example. - Summary : string option - /// Long description for the example, possibly CommonMark. - Description : string option - Value : Choice option - } - - static member Parse (node : JsonObject) : Example = - let description = asOpt node "description" - let summary = asOpt node "summary" - let externalValue = asOpt node "externalValue" |> Option.map Uri - - let value = - match externalValue with - | Some u -> Choice2Of2 u |> Some - | None -> - match node.TryGetPropertyValue "value" with - | true, v -> Choice1Of2 v |> Some - | false, _ -> None - - { - Summary = summary - Description = description - Value = value - } - -type Reference = - { - /// The reference string. - Ref : string - } - - static member Parse (node : JsonObject) : Reference = - let ref = asString node "$ref" - - { - Ref = ref - } - -type Tag = - { - /// The name of the tag. - Name : string - /// A short description for the tag, possibly CommonMark. - Description : string option - /// Additional external documentation for this tag. - ExternalDocs : ExternalDocumentation option - } - - static member Parse (node : JsonObject) : Tag = - let name = asString node "name" - let description = asOpt node "description" - let docs = asObjOpt node "externalDocs" |> Option.map ExternalDocumentation.Parse - - { - Name = name - Description = description - ExternalDocs = docs - } - -type ServerVariable = - { - /// An enumeration of string values to be used if the substitution options are from a limited set. - Enum : string list option - /// The default value to use for substitution, and to send, if an alternate value is not supplied. - /// Unlike the Schema Object’s default, this value MUST be provided by the consumer. - Default : string - /// An optional description for the server variable, possibly in CommonMark. - Description : string option - } - - static member Parse (node : JsonObject) : ServerVariable = - let enum = asArrOpt' node "enum" - let default' = asString node "default" - let description = asOpt node "description" - - { - Enum = enum - Default = default' - Description = description - } - -type Server = - { - /// A URL to the target host. - /// This URL supports Server Variables and MAY be relative, to indicate that the host location is relative to the location where the OpenAPI document is being served. - /// Variable substitutions will be made when a variable is named in {brackets}. - Url : string - /// Describes the host designated by the URL, possibly with CommonMark. - Description : string option - /// Used for substituting in the Url. - Variables : Map option - } - - static member Parse (node : JsonObject) : Server = - let url = asString node "url" - let description = asOpt node "description" - - let variables = - match node.TryGetPropertyValue "variables" with - | false, _ -> None - | true, o -> - o.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> k, ServerVariable.Parse (v.AsObject ())) - |> Map.ofSeq - |> Some - - { - Url = url - Description = description - Variables = variables - } - -type StringFormat = - /// base64-encoded characters - | Byte - /// any sequence of octets - | Binary - /// As defined by full-date - RFC3339 Section 5.6 - | Date - /// As defined by date-time - RFC3339 Section 5.6 - | DateTime - /// A hint to UIs to obscure input - | Password - | Verbatim of string - -type IntegerFormat = - /// Signed 32 bits - | Int32 - /// Signed 64 bits - | Int64 - | Verbatim of string - -type NumberFormat = - | Float - | Double - | Verbatim of string - -type DataFormat = - | Integer of IntegerFormat option - | Number of NumberFormat option - | String of StringFormat option - | Boolean of format : string option - -type Contact = - { - /// The identifying name of the contact person/organization. - Name : string option - /// The URL pointing to the contact information. - Url : Uri option - /// This MUST be in email address format. - Email : string option - } - - static member Parse (node : JsonObject) : Contact = - let name = asOpt node "name" - let url = asOpt node "url" |> Option.map Uri - let email = asOpt node "email" - - { - Email = email - Url = url - Name = name - } - -type License = - { - /// The license name used for the API. - Name : string - /// A URL to the license used for the API. - Url : Uri option - } - - static member Parse (node : JsonObject) : License = - let url = asOpt node "url" |> Option.map Uri - let name = asString node "name" - - { - Name = name - Url = url - } - -type OpenApiInfo = - { - /// Title of the application - Title : string - /// Short description of the application, might be in CommonMark - Description : string option - /// Link to the ToS of the application - TermsOfService : Uri option - /// The contact information for the exposed API. - Contact : Contact option - /// The license information for the exposed API. - License : License option - /// The version of the OpenAPI document (which is distinct from the OpenAPI Specification version or the API implementation version). - Version : string - } - - static member Parse (node : JsonObject) : OpenApiInfo = - let title = asString node "title" - let version = asString node "version" - let desc = asOpt node "description" - let termsOfService = asOpt node "termsOfService" |> Option.map Uri - let contact = asObjOpt node "contact" |> Option.map Contact.Parse - let license = asObjOpt node "license" |> Option.map License.Parse - - { - Title = title - Description = desc - TermsOfService = termsOfService - Contact = contact - License = license - Version = version - } - -type Encoding = - { - /// The Content-Type for encoding a specific property. - /// Default value depends on the property type: - /// for string with format being binary – application/octet-stream; - /// for other primitive types – text/plain; - /// for object - application/json; - /// for array – the default is defined based on the inner type. - /// The value can be a specific media type (e.g. application/json), a wildcard media type (e.g. image/*), or a comma-separated list of the two types. - ContentType : string option - /// A map allowing additional information to be provided as headers, for example Content-Disposition. - /// Content-Type is described separately and SHALL be ignored in this section. - /// This property SHALL be ignored if the request body media type is not a multipart. - Headers : Map> option - /// Describes how a specific property value will be serialized depending on its type. - /// See Parameter Object for details on the style property. - /// The behavior follows the same values as query parameters, including default values. - /// This property SHALL be ignored if the request body media type is not application/x-www-form-urlencoded. - Style : string option - /// When this is true, property values of type array or object generate separate parameters for each value of the array, or key-value-pair of the map. - /// For other types of properties this property has no effect. - /// When style is form, the default value is true. - /// For all other styles, the default value is false. - /// This property SHALL be ignored if the request body media type is not application/x-www-form-urlencoded. - Explode : bool option - /// Determines whether the parameter value SHOULD allow reserved characters, as defined by [RFC3986] Section 2.2 :/?#[]@!$&'()*+,;= - /// to be included without percent-encoding. - /// The default value is false. - /// This property SHALL be ignored if the request body media type is not application/x-www-form-urlencoded. - AllowReserved : bool option - } - - static member Parse (node : JsonObject) : Encoding = - let contentType = asOpt node "contentType" - let style = asOpt node "style" - let explode = asOpt node "explode" - let allowReserved = asOpt node "allowReserved" - - let headers = - match node.TryGetPropertyValue "headers" with - | false, _ -> None - | true, o -> - o.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> - let obj = v.AsObject () - - let parsed = - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Header.Parse obj) - - k, parsed - ) - |> Map.ofSeq - |> Some - - { - ContentType = contentType - Headers = headers - Style = style - Explode = explode - AllowReserved = allowReserved - } - -and MediaType = - { - /// The schema defining the type used for the request body. - Schema : Choice option - Example : Choice>> option - /// A map between a property name and its encoding information. - /// The key, being the property name, MUST exist in the schema as a property. - /// The encoding object SHALL only apply to requestBody objects when the media type is multipart or application/x-www-form-urlencoded. - Encoding : Map option - } - - static member Parse (node : JsonObject) : MediaType = - let schema = - match node.TryGetPropertyValue "schema" with - | false, _ -> None - | true, s -> - let obj = s.AsObject () - - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) |> Some - else - Choice1Of2 (Schema.Parse obj) |> Some - - let example = - match node.TryGetPropertyValue "example" with - | true, e -> Choice1Of2 e |> Some - | false, _ -> - match node.TryGetPropertyValue "examples" with - | false, _ -> None - | true, e -> - e.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> - let obj = v.AsObject () - - let parsed = - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Example.Parse obj) - - k, parsed - ) - |> Map.ofSeq - |> Choice2Of2 - |> Some - - let encoding = - match node.TryGetPropertyValue "encoding" with - | false, _ -> None - | true, e -> - e.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> k, Encoding.Parse (v.AsObject ())) - |> Map.ofSeq - |> Some - - { - Schema = schema - Example = example - Encoding = encoding - } - -/// The Header Object basically follows the structure of the Parameter Object. -/// All traits that are affected by the location MUST be applicable to a location of header (for example, style). -and Header = - { - /// A brief description of the header, possibly CommonMark. - Description : string option - /// Determines whether this header is mandatory. - /// If the header location is “path”, this property is REQUIRED and its value MUST be true. - /// Otherwise, the property MAY be included and its default value is false. - Required : bool option - /// Specifies that a header is deprecated and SHOULD be transitioned out of usage. - Deprecated : bool option - /// Sets the ability to pass empty-valued headers. - /// This is valid only for query headers and allows sending a header with an empty value. - /// Default value is false. - /// If style is used, and if behavior is n/a (cannot be serialized), the value of allowEmptyValue SHALL be ignored. - AllowEmptyValue : bool option - /// Describes how the header value will be serialized depending on the type of the header value. - /// Default values (based on value of in): for query - form; for path - simple; for header - simple; for cookie - form. - Style : string option - /// When this is true, header values of type array or object generate separate headers for each value of the array or key-value pair of the map. - /// For other types of headers this property has no effect. - /// When style is form, the default value is true. - /// For all other styles, the default value is false. - Explode : bool option - /// Determines whether the header value SHOULD allow reserved characters, as defined by [RFC3986] Section 2.2 :/?#[]@!$&'()*+,;= - /// to be included without percent-encoding. - /// This property only applies to headers with an in value of query. - /// The default value is false. - AllowReserved : bool option - /// The schema defining the type used for the header. - Schema : Choice option - Example : Choice>> option - /// A map containing the representations for the header. - /// The key is the media type and the value describes it. - /// The map MUST only contain one entry. - Content : Map option - } - - static member Parse (node : JsonObject) : Header = - let description = asOpt node "description" - let required = asOpt node "required" - let deprecated = asOpt node "deprecated" - let allowEmptyValue = asOpt node "allowEmptyValue" - let style = asOpt node "style" - let explode = asOpt node "explode" - let allowReserved = asOpt node "allowReserved" - - let schema = - match node.TryGetPropertyValue "schema" with - | false, _ -> None - | true, s -> - let obj = s.AsObject () - - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) |> Some - else - Choice1Of2 (Schema.Parse obj) |> Some - - let example = - match node.TryGetPropertyValue "example" with - | true, e -> Choice1Of2 e |> Some - | false, _ -> - match node.TryGetPropertyValue "examples" with - | false, _ -> None - | true, e -> - e.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> - let obj = v.AsObject () - - let parsed = - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Example.Parse obj) - - k, parsed - ) - |> Map.ofSeq - |> Choice2Of2 - |> Some - - let content = - match node.TryGetPropertyValue "content" with - | false, _ -> None - | true, c -> - c.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> k, MediaType.Parse (v.AsObject ())) - |> Map.ofSeq - |> Some - - { - Description = description - Required = required - Deprecated = deprecated - AllowEmptyValue = allowEmptyValue - Style = style - Explode = explode - AllowReserved = allowReserved - Schema = schema - Example = example - Content = content - } - -type LinkOperation = - /// A relative or absolute reference to an OAS operation. - /// This field is mutually exclusive of the operationId field, and MUST point to an Operation Object. - /// Relative operationRef values MAY be used to locate an existing Operation Object in the OpenAPI definition. - | Ref of string - /// The name of an existing, resolvable OAS operation, as defined with a unique operationId. - /// This field is mutually exclusive of the operationRef field. - | Id of string - -type RuntimeExpression = | RuntimeExpression of unit - -type Link = - { - /// A relative or absolute reference to an OAS operation. - /// This field is mutually exclusive of the operationId field, and MUST point to an Operation Object. Relative operationRef values MAY be used to locate an existing Operation Object in the OpenAPI definition. - Operation : LinkOperation option - /// A map representing parameters to pass to an operation as specified with operationId or identified via operationRef. - /// The key is the parameter name to be used, whereas the value can be a constant or an expression to be evaluated and passed to the linked operation. - /// The parameter name can be qualified using the parameter location [{in}.]{name} for operations that use the same parameter name in different locations (e.g. path.id). - Parameters : Map> option - /// A literal value or {expression} to use as a request body when calling the target operation. - RequestBody : Choice option - /// A description of the link, possibly CommonMark. - Description : string option - /// A server object to be used by the target operation. - Server : Server option - } - - static member Parse (node : JsonObject) : Link = - let operation = - match node.TryGetPropertyValue "operationRef" with - | true, ref -> LinkOperation.Ref (ref.GetValue ()) |> Some - | false, _ -> - match node.TryGetPropertyValue "operationId" with - | true, id -> LinkOperation.Id (id.GetValue ()) |> Some - | false, _ -> None - - let parameters = - match node.TryGetPropertyValue "parameters" with - | false, _ -> None - | true, p -> - p.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> - // In OpenAPI spec, this can be any value or {expression} - // For simplicity, treating non-string values as JsonNode - k, Choice1Of2 v - ) - |> Map.ofSeq - |> Some - - let requestBody = - match node.TryGetPropertyValue "requestBody" with - | false, _ -> None - | true, rb -> Choice1Of2 rb |> Some - - let description = asOpt node "description" - let server = asObjOpt node "server" |> Option.map Server.Parse - - { - Operation = operation - Parameters = parameters - RequestBody = requestBody - Description = description - Server = server - } - -type Response = - { - /// A short description of the response, possibly CommonMark. - Description : string - /// Maps a header name to its definition. - /// [RFC7230] Page 22 states header names are case insensitive. - /// If a response header is defined with the name "Content-Type", it SHALL be ignored. - Headers : Map> option - /// A map containing descriptions of potential response payloads. - /// The key is a media type or media type range, see [RFC7231] Appendix D, and the value describes it. - /// For responses that match multiple keys, only the most specific key is applicable. e.g. text/plain overrides text/* - Content : Map option - /// A map of operations links that can be followed from the response. - /// The key of the map is a short name for the link, following the naming constraints of the names for Component Objects. - Links : Map> option - } - - static member Parse (node : JsonObject) : Response = - let description = asString node "description" - - let headers = - match node.TryGetPropertyValue "headers" with - | false, _ -> None - | true, h -> - h.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> - let obj = v.AsObject () - - let parsed = - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Header.Parse obj) - - k, parsed - ) - |> Map.ofSeq - |> Some - - let content = - match node.TryGetPropertyValue "content" with - | false, _ -> None - | true, c -> - c.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> k, MediaType.Parse (v.AsObject ())) - |> Map.ofSeq - |> Some - - let links = - match node.TryGetPropertyValue "links" with - | false, _ -> None - | true, l -> - l.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> - let obj = v.AsObject () - - let parsed = - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Link.Parse obj) - - k, parsed - ) - |> Map.ofSeq - |> Some - - { - Description = description - Headers = headers - Content = content - Links = links - } - -type Responses = - { - /// The documentation of responses other than the ones declared for specific HTTP response codes. - /// Use this field to cover undeclared responses. - Default : Choice option - /// Map from HTTP status code to expected response. - /// The keys are allowed to be "2XX" for example, hence being strings and not ints. - Patterns : Map> option - } - - static member Parse (node : JsonObject) : Responses = - let default' = - match node.TryGetPropertyValue "default" with - | false, _ -> None - | true, d -> - let obj = d.AsObject () - - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) |> Some - else - Choice1Of2 (Response.Parse obj) |> Some - - // All other properties are HTTP status codes - let patterns = - node - |> Seq.choose (fun (KeyValue (k, v)) -> - if k = "default" then - None - else - let obj = v.AsObject () - - let parsed = - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Response.Parse obj) - - Some (k, parsed) - ) - |> Map.ofSeq - |> function - | m when m.IsEmpty -> None - | m -> Some m - - { - Default = default' - Patterns = patterns - } - -type SecuritySchemeIn = - | Query - | Header - | Cookie - -type OauthFlow = - { - /// The authorization URL to be used for this flow. - /// Required for "implicit" and "authorizationCode". - AuthorizationUrl : Uri option - /// The token URL to be used for this flow. - /// Required for "password", "clientCredentials", "authorizationCode". - TokenUrl : Uri option - /// The URL to be used for obtaining refresh tokens. - RefreshUrl : Uri option - /// The available scopes for the OAuth2 security scheme. A map between the scope name and a short description for it. - /// Required for "oauth2". - Scopes : Map option - } - - static member Parse (node : JsonObject) : OauthFlow = - let authorizationUrl = asOpt node "authorizationUrl" |> Option.map Uri - let tokenUrl = asOpt node "tokenUrl" |> Option.map Uri - let refreshUrl = asOpt node "refreshUrl" |> Option.map Uri - - let scopes = - asObjOpt node "scopes" - |> Option.map (fun s -> s |> Seq.map (fun (KeyValue (k, v)) -> k, v.GetValue ()) |> Map.ofSeq) - - { - AuthorizationUrl = authorizationUrl - TokenUrl = tokenUrl - RefreshUrl = refreshUrl - Scopes = scopes - } - -type SecurityRequirement = - { - /// Each name MUST correspond to a security scheme which is declared in the Security Schemes under the Components Object. - /// If the security scheme is of type "oauth2" or "openIdConnect", then the value is a list of scope names required for the execution. - /// For other security scheme types, the array MUST be empty. - Fields : Map option - } - - static member Parse (node : JsonObject) : SecurityRequirement = - // The entire object is the security requirement - let fields = - node - |> Seq.map (fun (KeyValue (k, v)) -> - let scopes = v.AsArray () |> Seq.map (fun s -> s.GetValue ()) |> Seq.toList - k, scopes - ) - |> Map.ofSeq - |> function - | m when m.IsEmpty -> None - | m -> Some m - - { - Fields = fields - } - -type OauthFlows = - { - /// Configuration for the OAuth Implicit flow - Implicit : OauthFlow option - /// Configuration for the OAuth Resource Owner Password flow - Password : OauthFlow option - /// Configuration for the OAuth Client Credentials flow. - ClientCredentials : OauthFlow option - /// Configuration for the OAuth Authorization Code flow. - AuthorizationCode : OauthFlow option - } - - static member Parse (node : JsonObject) : OauthFlows = - let implicit = asObjOpt node "implicit" |> Option.map OauthFlow.Parse - let password = asObjOpt node "password" |> Option.map OauthFlow.Parse - - let clientCredentials = - asObjOpt node "clientCredentials" |> Option.map OauthFlow.Parse - - let authorizationCode = - asObjOpt node "authorizationCode" |> Option.map OauthFlow.Parse - - { - Implicit = implicit - Password = password - ClientCredentials = clientCredentials - AuthorizationCode = authorizationCode - } - -type SecurityScheme = - | ApiKey of description : string option * name : string * inValue : SecuritySchemeIn - | Http of description : string option * scheme : string * bearerFormat : string option - | Oauth2 of description : string option * OauthFlows - | OpenIdConnect of description : string option * url : Uri - - static member Parse (node : JsonObject) : SecurityScheme = - let type' = asString node "type" - let description = asOpt node "description" - - match type' with - | "apiKey" -> - let name = asString node "name" - - let inValue = - match asString node "in" with - | "query" -> SecuritySchemeIn.Query - | "header" -> SecuritySchemeIn.Header - | "cookie" -> SecuritySchemeIn.Cookie - | other -> failwithf "Unknown 'in' value for apiKey: %s" other - - SecurityScheme.ApiKey (description, name, inValue) - | "http" -> - let scheme = asString node "scheme" - let bearerFormat = asOpt node "bearerFormat" - SecurityScheme.Http (description, scheme, bearerFormat) - | "oauth2" -> - let flows = asObj node "flows" |> OauthFlows.Parse - SecurityScheme.Oauth2 (description, flows) - | "openIdConnect" -> - let url = asString node "openIdConnectUrl" |> Uri - SecurityScheme.OpenIdConnect (description, url) - | other -> failwithf "Unknown security scheme type: %s" other - -type ParameterIn = - /// Used together with Path Templating, where the parameter value is actually part of the operation’s URL. - /// This does not include the host or base path of the API. - /// For example, in /items/{itemId}, the path parameter is itemId. - | Path - /// Custom headers that are expected as part of the request. - /// Note that [RFC7230] Page 22 states header names are case insensitive. - | Header - /// Parameters that are appended to the URL. For example, in /items?id=###, the query parameter is id. - | Query - /// Used to pass a specific cookie value to the API. - | Cookie - -/// A unique parameter is defined by a combination of a name and location. -type Parameter = - { - /// Name of the parameter, case sensitive. - /// If in is "path", the name field MUST correspond to the associated path segment from the path field in the Paths Object. - /// See Path Templating for further information. - /// If in is "header" and the name field is "Accept", "Content-Type" or "Authorization", the parameter definition SHALL be ignored. - /// For all other cases, the name corresponds to the parameter name used by the in property. - Name : string - /// The location of the parameter. - In : ParameterIn - /// A brief description of the parameter, possibly CommonMark. - Description : string option - /// Determines whether this parameter is mandatory. - /// If the parameter location is “path”, this property is REQUIRED and its value MUST be true. - /// Otherwise, the property MAY be included and its default value is false. - Required : bool option - /// Specifies that a parameter is deprecated and SHOULD be transitioned out of usage. - Deprecated : bool option - /// Sets the ability to pass empty-valued parameters. - /// This is valid only for query parameters and allows sending a parameter with an empty value. - /// Default value is false. - /// If style is used, and if behavior is n/a (cannot be serialized), the value of allowEmptyValue SHALL be ignored. - AllowEmptyValue : bool option - /// Describes how the parameter value will be serialized depending on the type of the parameter value. - /// Default values (based on value of in): for query - form; for path - simple; for header - simple; for cookie - form. - Style : string option - /// When this is true, parameter values of type array or object generate separate parameters for each value of the array or key-value pair of the map. - /// For other types of parameters this property has no effect. - /// When style is form, the default value is true. - /// For all other styles, the default value is false. - Explode : bool option - /// Determines whether the parameter value SHOULD allow reserved characters, as defined by [RFC3986] Section 2.2 :/?#[]@!$&'()*+,;= - /// to be included without percent-encoding. - /// This property only applies to parameters with an in value of query. - /// The default value is false. - AllowReserved : bool option - /// The schema defining the type used for the parameter. - Schema : Choice option - Example : Choice>> option - /// A map containing the representations for the parameter. - /// The key is the media type and the value describes it. - /// The map MUST only contain one entry. - Content : Map option - } - - static member Parse (node : JsonObject) : Parameter = - let name = asString node "name" - - let in' = - match asString node "in" with - | "path" -> ParameterIn.Path - | "header" -> ParameterIn.Header - | "query" -> ParameterIn.Query - | "cookie" -> ParameterIn.Cookie - | other -> failwithf "Unknown 'in' value for parameter: %s" other - - let description = asOpt node "description" - let required = asOpt node "required" - let deprecated = asOpt node "deprecated" - let allowEmptyValue = asOpt node "allowEmptyValue" - let style = asOpt node "style" - let explode = asOpt node "explode" - let allowReserved = asOpt node "allowReserved" - - let schema = - match node.TryGetPropertyValue "schema" with - | false, _ -> None - | true, s -> - let obj = s.AsObject () - - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) |> Some - else - Choice1Of2 (Schema.Parse obj) |> Some - - let example = - match node.TryGetPropertyValue "example" with - | true, e -> Choice1Of2 e |> Some - | false, _ -> - match node.TryGetPropertyValue "examples" with - | false, _ -> None - | true, e -> - e.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> - let obj = v.AsObject () - - let parsed = - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Example.Parse obj) - - k, parsed - ) - |> Map.ofSeq - |> Choice2Of2 - |> Some - - let content = - match node.TryGetPropertyValue "content" with - | false, _ -> None - | true, c -> - c.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> k, MediaType.Parse (v.AsObject ())) - |> Map.ofSeq - |> Some - - { - Name = name - In = in' - Description = description - Required = required - Deprecated = deprecated - AllowEmptyValue = allowEmptyValue - Style = style - Explode = explode - AllowReserved = allowReserved - Schema = schema - Example = example - Content = content - } - -type RequestBody = - { - /// A brief description of the request body. This could contain examples of use. - /// Possibly CommonMark. - Description : string option - /// The content of the request body. - /// The key is a media type or media type range, see [RFC7231] Appendix D, and the value describes it. - /// For requests that match multiple keys, only the most specific key is applicable. e.g. text/plain overrides text/* - Content : Map - /// Determines if the request body is required in the request. Defaults to false. - Required : bool option - } - - static member Parse (node : JsonObject) : RequestBody = - let description = asOpt node "description" - - let content = - asObj node "content" - |> Seq.map (fun (KeyValue (k, v)) -> k, MediaType.Parse (v.AsObject ())) - |> Map.ofSeq - - let required = asOpt node "required" - - { - Description = description - Content = content - Required = required - } - -type Callback = - { - /// For the semantics of the keys, see https://spec.openapis.org/oas/v3.0.0#key-expression - Patterns : Map option - } - - static member Parse (node : JsonObject) : Callback = - let patterns = - node - |> Seq.map (fun (KeyValue (k, v)) -> k, PathItem.Parse (v.AsObject ())) - |> Map.ofSeq - |> function - | m when m.IsEmpty -> None - | m -> Some m - - { - Patterns = patterns - } - -and Operation = - { - /// A list of tags for API documentation control. - /// Tags can be used for logical grouping of operations by resources or any other qualifier. - Tags : string list option - /// A short summary of what the operation does. - Summary : string option - /// A verbose explanation of the operation behavior, possibly in CommonMark. - Description : string option - /// Additional external documentation for this operation. - ExternalDocs : ExternalDocumentation option - /// Unique string used to identify the operation. - /// The id MUST be unique among all operations described in the API. - /// Tools and libraries MAY use the operationId to uniquely identify an operation, therefore, - /// it is RECOMMENDED to follow common programming naming conventions. - OperationId : string option - /// A list of parameters that are applicable for this operation. - /// If a parameter is already defined at the Path Item, the new definition will override it but can never remove it. - /// The list MUST NOT include duplicated parameters. - /// A unique parameter is defined by a combination of a name and location. - /// The list can use the Reference Object to link to parameters that are defined at the OpenAPI Object’s components/parameters. - Parameters : Choice list option - /// The request body applicable for this operation. - /// The requestBody is only supported in HTTP methods where the HTTP 1.1 specification [RFC7231] Section 4.3.1 has explicitly defined semantics for request bodies. - /// In other cases where the HTTP spec is vague, requestBody SHALL be ignored by consumers. - RequestBody : Choice option - /// The list of possible responses as they are returned from executing this operation. - /// Per the spec these are required, but one of the official examples lacks them. - Responses : Responses option - /// A map of possible out-of band callbacks related to the parent operation. - /// The key is a unique identifier for the Callback Object. - /// Each value in the map is a Callback Object that describes a request that may be initiated by the API provider and the expected responses. - /// The key value used to identify the callback object is an expression, evaluated at runtime, that identifies a URL to use for the callback operation. - Callbacks : Map> option - /// Default value is "false". - Deprecated : bool option - /// A declaration of which security mechanisms can be used for this operation. - /// The list of values includes alternative security requirement objects that can be used. - /// Only one of the security requirement objects need to be satisfied to authorize a request. - /// This definition overrides any declared top-level security. - /// To remove a top-level security declaration, an empty array can be used. - Security : SecurityRequirement list option - /// An alternative server array to service this operation. - /// If an alternative server object is specified at the Path Item Object or Root level, it will be overridden by this value. - Servers : Server list option - } - - static member Parse (node : JsonObject) : Operation = - let tags = asArrOpt' node "tags" - let summary = asOpt node "summary" - let description = asOpt node "description" - - let externalDocs = - asObjOpt node "externalDocs" |> Option.map ExternalDocumentation.Parse - - let operationId = asOpt node "operationId" - - let parameters = - match node.TryGetPropertyValue "parameters" with - | false, _ -> None - | true, p -> - p.AsArray () - |> Seq.map (fun v -> - let obj = v.AsObject () - - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Parameter.Parse obj) - ) - |> Seq.toList - |> Some - - let requestBody = - match node.TryGetPropertyValue "requestBody" with - | false, _ -> None - | true, rb -> - let obj = rb.AsObject () - - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) |> Some - else - Choice1Of2 (RequestBody.Parse obj) |> Some - - let responses = asObjOpt node "responses" |> Option.map Responses.Parse - - let callbacks = - match node.TryGetPropertyValue "callbacks" with - | false, _ -> None - | true, c -> - c.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> - let obj = v.AsObject () - - let parsed = - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Callback.Parse obj) - - k, parsed - ) - |> Map.ofSeq - |> Some - - let deprecated = asOpt node "deprecated" - - let security = - match node.TryGetPropertyValue "security" with - | false, _ -> None - | true, s -> - s.AsArray () - |> Seq.map (fun v -> SecurityRequirement.Parse (v.AsObject ())) - |> Seq.toList - |> Some - - let servers = - match node.TryGetPropertyValue "servers" with - | false, _ -> None - | true, s -> - s.AsArray () - |> Seq.map (fun v -> Server.Parse (v.AsObject ())) - |> Seq.toList - |> Some - - { - Tags = tags - Summary = summary - Description = description - ExternalDocs = externalDocs - OperationId = operationId - Parameters = parameters - RequestBody = requestBody - Responses = responses - Callbacks = callbacks - Deprecated = deprecated - Security = security - Servers = servers - } - -and PathItem = - { - /// Allows for an external definition of this path item. - /// The referenced structure MUST be in the format of a Path Item Object. - /// If there are conflicts between the referenced definition and this Path Item’s definition, the behavior is undefined. - Ref : string option - /// A string summary, intended to apply to all operations in this path. - Summary : string option - /// A string description, intended to apply to all operations in this path, possibly in CommonMark - Description : string option - /// A definition of a GET operation on this path. - Get : Operation option - /// A definition of a PUT operation on this path. - Put : Operation option - /// A definition of a POST operation on this path. - Post : Operation option - /// A definition of a DELETE operation on this path. - Delete : Operation option - /// A definition of an OPTIONS operation on this path. - Options : Operation option - /// A definition of a HEAD operation on this path. - Head : Operation option - /// A definition of a PATCH operation on this path. - Patch : Operation option - /// A definition of a TRACE operation on this path. - Trace : Operation option - /// An alternative server array to service all operations in this path. - Servers : Server list option - /// A list of parameters that are applicable for all the operations described under this path. - /// These parameters can be overridden at the operation level, but cannot be removed there. - /// The list MUST NOT include duplicated parameters. - /// A unique parameter is defined by a combination of a name and location. - /// The list can use the Reference Object to link to parameters that are defined at the OpenAPI Object’s components/parameters. - Parameters : Choice list option - } - - static member Parse (node : JsonObject) : PathItem = - let ref = asOpt node "$ref" - let summary = asOpt node "summary" - let description = asOpt node "description" - let get = asObjOpt node "get" |> Option.map Operation.Parse - let put = asObjOpt node "put" |> Option.map Operation.Parse - let post = asObjOpt node "post" |> Option.map Operation.Parse - let delete = asObjOpt node "delete" |> Option.map Operation.Parse - let options = asObjOpt node "options" |> Option.map Operation.Parse - let head = asObjOpt node "head" |> Option.map Operation.Parse - let patch = asObjOpt node "patch" |> Option.map Operation.Parse - let trace = asObjOpt node "trace" |> Option.map Operation.Parse - - let servers = - match node.TryGetPropertyValue "servers" with - | false, _ -> None - | true, s -> - s.AsArray () - |> Seq.map (fun v -> Server.Parse (v.AsObject ())) - |> Seq.toList - |> Some - - let parameters = - match node.TryGetPropertyValue "parameters" with - | false, _ -> None - | true, p -> - p.AsArray () - |> Seq.map (fun v -> - let obj = v.AsObject () - - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (Parameter.Parse obj) - ) - |> Seq.toList - |> Some - - { - Ref = ref - Summary = summary - Description = description - Get = get - Put = put - Post = post - Delete = delete - Options = options - Head = head - Patch = patch - Trace = trace - Servers = servers - Parameters = parameters - } - -type Paths = - { - /// A relative path to an individual endpoint. - /// The field name MUST begin with a slash. - /// The path is appended (no relative URL resolution) to the expanded URL from the Server Object’s url field in order to construct the full URL. - /// Path templating is allowed. - /// When matching URLs, concrete (non-templated) paths would be matched before their templated counterparts. - /// Templated paths with the same hierarchy but different templated names MUST NOT exist as they are identical. - /// In case of ambiguous matching, it’s up to the tooling to decide which one to use. - Fields : Map option - } - - static member Parse (node : JsonObject) : Paths = - let fields = - node - |> Seq.map (fun (KeyValue (k, v)) -> k, PathItem.Parse (v.AsObject ())) - |> Map.ofSeq - |> function - | m when m.IsEmpty -> None - | m -> Some m - - { - Fields = fields - } - -type Components = - { - Schemas : Map> option - Responses : Map> option - Parameters : Map> option - Examples : Map> option - RequestBodies : Map> option - Headers : Map> option - SecuritySchemes : Map> option - Links : Map> option - Callbacks : Map> option - } - - static member Parse (node : JsonObject) : Components = - let parseMap (key : string) (parser : JsonObject -> 'T) = - match node.TryGetPropertyValue key with - | false, _ -> None - | true, o -> - o.AsObject () - |> Seq.map (fun (KeyValue (k, v)) -> - let obj = v.AsObject () - - let parsed = - if obj.ContainsKey "$ref" then - Choice2Of2 (Reference.Parse obj) - else - Choice1Of2 (parser obj) - - k, parsed - ) - |> Map.ofSeq - |> Some - - { - Schemas = parseMap "schemas" Schema.Parse - Responses = parseMap "responses" Response.Parse - Parameters = parseMap "parameters" Parameter.Parse - Examples = parseMap "examples" Example.Parse - RequestBodies = parseMap "requestBodies" RequestBody.Parse - Headers = parseMap "headers" Header.Parse - SecuritySchemes = parseMap "securitySchemes" SecurityScheme.Parse - Links = parseMap "links" Link.Parse - Callbacks = parseMap "callbacks" Callback.Parse - } - -type OpenApiSpec = - { - OpenApi : Version - Info : OpenApiInfo - Servers : Server list option - /// According to the spec, this is required, but then one of their own examples - /// does not contain a Paths. - Paths : Paths option - Components : Components option - Security : SecurityRequirement list option - Tags : Tag list option - ExternalDocs : ExternalDocumentation option - } - - static member Parse (node : JsonObject) : OpenApiSpec = - let openapi = asString node "openapi" |> Version - let info = asObj node "info" |> OpenApiInfo.Parse - - let servers = - match node.TryGetPropertyValue "servers" with - | false, _ -> None - | true, s -> - s.AsArray () - |> Seq.map (fun v -> Server.Parse (v.AsObject ())) - |> Seq.toList - |> Some - - let paths = asObjOpt node "paths" |> Option.map Paths.Parse - let components = asObjOpt node "components" |> Option.map Components.Parse - - let security = - match node.TryGetPropertyValue "security" with - | false, _ -> None - | true, s -> - s.AsArray () - |> Seq.map (fun v -> SecurityRequirement.Parse (v.AsObject ())) - |> Seq.toList - |> Some - - let tags = - match node.TryGetPropertyValue "tags" with - | false, _ -> None - | true, t -> - t.AsArray () - |> Seq.map (fun v -> Tag.Parse (v.AsObject ())) - |> Seq.toList - |> Some - - let externalDocs = - asObjOpt node "externalDocs" |> Option.map ExternalDocumentation.Parse - - { - OpenApi = openapi - Info = info - Servers = servers - Paths = paths - Components = components - Security = security - Tags = tags - ExternalDocs = externalDocs - } diff --git a/WoofWare.Myriad.Plugins/OpenApiClientGenerator.fs b/WoofWare.Myriad.Plugins/OpenApiClientGenerator.fs new file mode 100644 index 00000000..7764fca7 --- /dev/null +++ b/WoofWare.Myriad.Plugins/OpenApiClientGenerator.fs @@ -0,0 +1,2860 @@ +namespace WoofWare.Myriad.Plugins + +open System +open System.Collections.Generic +open System.Text.Json +open System.Text.Json.Nodes +open System.Text.RegularExpressions +open Fantomas.FCS.Syntax +open Fantomas.FCS.Text.Range +open Fantomas.FCS.Xml +open Myriad.Core +open WoofWare.Whippet.Fantomas + +type internal OpenApiGenerationDiagnosticCode = + | InvalidJson + | InvalidDocument + | UnsupportedVersion + | UnresolvedReference + | UnsupportedSchema + | UnsupportedParameter + | UnsupportedOperation + | UnsupportedSecurity + | AmbiguousSecurity + | AmbiguousSuccessResponse + +type internal OpenApiGenerationDiagnostic = + { + Code : OpenApiGenerationDiagnosticCode + Location : string + Message : string + } + +type internal OpenApiPrimitive = + | String + | Boolean + | Int32 + | Int64 + | BigInteger + | Float32 + | Float + | Decimal + | Date + | DateTime + | Guid + +type internal OpenApiPlannedType = + | Primitive of OpenApiPrimitive + | Named of string + | List of OpenApiPlannedType + | Optional of OpenApiPlannedType + | JsonNode + | Stream + | Unit + +type internal OpenApiPlannedField = + { + JsonName : string + FSharpName : string + Type : OpenApiPlannedType + Required : bool + } + +type internal OpenApiPlannedTypeDefinition = + { + SourceName : string + FSharpName : string + Description : string option + Fields : OpenApiPlannedField list + AdditionalProperties : OpenApiPlannedType option + } + +type internal OpenApiParameterLocation = + | Path + | Query + | Body + +type internal OpenApiPlannedParameter = + { + WireName : string + FSharpName : string + Location : OpenApiParameterLocation + Type : OpenApiPlannedType + Required : bool + } + +/// The kind of an OpenAPI security scheme. Every kind we support is carried in a request header +/// whose entire value the caller supplies; we perform no token acquisition of any sort. +type internal OpenApiSecuritySchemeKind = + /// `type: apiKey`, `in: header`. + | ApiKey + /// `type: http`; the argument is the `scheme`, e.g. "bearer" or "basic". The credential is the + /// whole `Authorization` header value, scheme name and all. + | Http of scheme : string + /// `type: oauth2`. We run no OAuth flow: the caller supplies an `Authorization` header value. + | OAuth2 + /// `type: openIdConnect`. As for `oauth2`, the caller supplies an `Authorization` header value. + | OpenIdConnect + +/// A credential which the generated client requires its caller to supply, because some operation's +/// security requirement asks for it. +type internal OpenApiPlannedCredential = + { + /// The name under which this scheme appears in `components.securitySchemes`. + SchemeName : string + /// The property on the generated interface which supplies this credential. + FSharpName : string + /// The header whose entire value this credential is. + HeaderName : string + Kind : OpenApiSecuritySchemeKind + Description : string option + } + +type internal OpenApiPlannedOperation = + { + OperationId : string + FSharpName : string + Description : string option + Method : HttpMethod + Path : string + Parameters : OpenApiPlannedParameter list + ReturnType : OpenApiPlannedType + Accept : string option + RequestContentType : string option + /// The security schemes whose credentials this operation sends, by `SchemeName`. Empty when + /// the operation requires no credentials. Every entry is a key of the plan's `Credentials`. + Security : string list + } + +type internal OpenApiServerBase = + | BaseAddress of string + | BasePath of string + +type internal OpenApiClientPlan = + { + Namespace : string + InterfaceName : string + Description : string option + CreateMock : bool option + ServerBase : OpenApiServerBase + Types : OpenApiPlannedTypeDefinition list + Operations : OpenApiPlannedOperation list + /// The credentials the generated client's operations require, keyed by scheme name. Only the + /// schemes some operation actually uses appear here. + Credentials : Map + } + +[] +module internal OpenApiClientGenerator = + + type private LocatedObject = + { + Value : JsonObject + Location : string + } + + type private SchemaReference = + { + Name : string + Location : string + } + + type private CanonicalSchema = + { + Location : string + Description : string option + Nullable : bool + Shape : CanonicalSchemaShape + } + + and private CanonicalSchemaShape = + | Reference of SchemaReference + | Any + | Primitive of OpenApiPrimitive + | Array of CanonicalSchema option + | Object of DirectObjectShape + | AllOf of + outerAllowsNull : bool * + hasSiblingObjectKeywords : bool * + allBranchesValid : bool * + branches : CanonicalSchema list + | UnsupportedNumber of format : string option + | UnsupportedType of typeName : string + | Invalid + + and private DirectObjectShape = + { + Properties : Map + Required : Set + AdditionalProperties : AdditionalProperties + } + + and private AdditionalProperties = + | Any + | Forbidden + | Typed of CanonicalSchema + + type private ObjectShape = + { + Description : string option + Properties : Map + Required : Set + AdditionalProperties : AdditionalProperties + } + + type private SchemaIdentity = + | Json + | Primitive of OpenApiPrimitive + | Named of componentName : string + | List of SchemaIdentity + | Optional of SchemaIdentity + | Object of ObjectShapeIdentity + + and private ObjectShapeIdentity = + { + Properties : Map + Required : Set + AdditionalProperties : AdditionalPropertiesIdentity + } + + and private AdditionalPropertiesIdentity = + | Forbidden + | Value of SchemaIdentity + + type private ResolvedParameterLocation = + | Path + | Query + | Header + | Cookie + + type private ResolvedParameter = + { + Name : string + Location : ResolvedParameterLocation + Required : bool + Schema : CanonicalSchema + SourceLocation : string + } + + let private pointerToken (value : string) : string = + let value = value.Replace ("~", "~0", StringComparison.Ordinal) + value.Replace ("/", "~1", StringComparison.Ordinal) + + let private diagnostic + (code : OpenApiGenerationDiagnosticCode) + (location : string) + (message : string) + : OpenApiGenerationDiagnostic + = + { + Code = code + Location = location + Message = message + } + + let private normaliseParameters (parameters : Map) : Map = + parameters + |> Map.toSeq + |> Seq.map (fun (key, value) -> key.ToUpperInvariant (), value) + |> Map.ofSeq + + let private allocateUniqueName + (used : HashSet) + (fallback : string) + (sanitise : string -> string) + (source : string) + : string + = + let baseName = + let result = sanitise source + + if String.IsNullOrWhiteSpace result then + fallback + else + result + + let mutable suffix = 1 + let mutable candidate = baseName + + while not (used.Add candidate) do + suffix <- suffix + 1 + candidate <- $"%s{baseName}%i{suffix}" + + candidate + + let private sanitiseTypeName (value : string) : string = + (Ident.createSanitisedTypeName value).idText + + let private sanitiseParameterName (value : string) : string = + (Ident.createSanitisedParamName value).idText + + let private report + (diagnostics : ResizeArray) + (code : OpenApiGenerationDiagnosticCode) + (location : string) + (message : string) + = + diagnostics.Add (diagnostic code location message) + + let private tryProperty + (diagnostics : ResizeArray) + (location : string) + (node : JsonObject) + (name : string) + : JsonNode option + = + let propertyLocation = $"%s{location}/%s{pointerToken name}" + + match node.TryGetPropertyValue name with + | false, _ -> None + | true, value when isNull value -> + report diagnostics InvalidDocument propertyLocation "An optional property cannot be null." + None + | true, value -> Some value + + let private tryString + (diagnostics : ResizeArray) + (location : string) + (node : JsonNode) + : string option + = + try + Some (node.GetValue ()) + with + | :? InvalidOperationException + | :? FormatException -> + report diagnostics InvalidDocument location "Expected a JSON string." + None + + let private optionalString diagnostics location (node : JsonObject) name : string option = + tryProperty diagnostics location node name + |> Option.bind (tryString diagnostics ($"%s{location}/%s{pointerToken name}")) + + let private requiredString diagnostics location (node : JsonObject) name : string option = + let propertyLocation = $"%s{location}/%s{pointerToken name}" + + match node.TryGetPropertyValue name with + | false, _ -> + report diagnostics InvalidDocument propertyLocation "A required string property is missing." + None + | true, value when isNull value -> + report diagnostics InvalidDocument propertyLocation "A required string property cannot be null." + None + | true, value -> tryString diagnostics propertyLocation value + + let private tryBool + (diagnostics : ResizeArray) + (location : string) + (node : JsonNode) + : bool option + = + try + Some (node.GetValue ()) + with + | :? InvalidOperationException + | :? FormatException -> + report diagnostics InvalidDocument location "Expected a JSON boolean." + None + + let private optionalBool diagnostics location (node : JsonObject) name : bool option = + tryProperty diagnostics location node name + |> Option.bind (tryBool diagnostics ($"%s{location}/%s{pointerToken name}")) + + let private tryObject + (diagnostics : ResizeArray) + (location : string) + (node : JsonNode) + : LocatedObject option + = + match node with + | :? JsonObject as value -> + Some + { + Value = value + Location = location + } + | _ -> + report diagnostics InvalidDocument location "Expected a JSON object." + None + + let private optionalObject diagnostics location (node : JsonObject) name : LocatedObject option = + tryProperty diagnostics location node name + |> Option.bind (tryObject diagnostics ($"%s{location}/%s{pointerToken name}")) + + let private tryArray + (diagnostics : ResizeArray) + (location : string) + (node : JsonNode) + : JsonArray option + = + match node with + | :? JsonArray as value -> Some value + | _ -> + report diagnostics InvalidDocument location "Expected a JSON array." + None + + let private optionalArray diagnostics location (node : JsonObject) name : JsonArray option = + tryProperty diagnostics location node name + |> Option.bind (tryArray diagnostics ($"%s{location}/%s{pointerToken name}")) + + let private objectMap diagnostics location (node : JsonObject) : Map = + node + |> Seq.choose (fun (KeyValue (name, value)) -> + tryObject diagnostics ($"%s{location}/%s{pointerToken name}") value + |> Option.map (fun value -> name, value) + ) + |> Map.ofSeq + + let private componentMap diagnostics (components : LocatedObject option) name : Map = + match + components + |> Option.bind (fun value -> optionalObject diagnostics value.Location value.Value name) + with + | None -> Map.empty + | Some values -> objectMap diagnostics values.Location values.Value + + let private decodePointerToken diagnostics code location (value : string) : string option = + let value = Uri.UnescapeDataString value + + if Regex.IsMatch (value, "~(?:[^01]|$)") then + report diagnostics code location $"Reference token '%s{value}' contains an invalid JSON Pointer escape." + None + else + let value = value.Replace ("~1", "/", StringComparison.Ordinal) + value.Replace ("~0", "~", StringComparison.Ordinal) |> Some + + let private referenceName diagnostics code expectedPrefix referenceLocation (reference : string) : string option = + if reference.StartsWith (expectedPrefix, StringComparison.Ordinal) then + reference.Substring expectedPrefix.Length + |> decodePointerToken diagnostics code referenceLocation + else + report + diagnostics + code + referenceLocation + $"Only local references below '%s{expectedPrefix}' are supported; got '%s{reference}'." + + None + + let rec private analyzeSchema + (diagnostics : ResizeArray) + (cache : Dictionary) + (schema : LocatedObject) + : CanonicalSchema + = + match cache.TryGetValue schema.Location with + | true, analyzed -> analyzed + | false, _ -> + let reference = optionalString diagnostics schema.Location schema.Value "$ref" + + let analyzed = + match reference with + | Some reference -> + let referenceLocation = $"%s{schema.Location}/$ref" + + let shape = + referenceName + diagnostics + UnresolvedReference + "#/components/schemas/" + referenceLocation + reference + |> Option.map (fun name -> + CanonicalSchemaShape.Reference + { + Name = name + Location = referenceLocation + } + ) + |> Option.defaultValue CanonicalSchemaShape.Invalid + + { + Location = schema.Location + Description = None + Nullable = false + Shape = shape + } + | None -> + let description = + optionalString diagnostics schema.Location schema.Value "description" + + let nullable = + optionalBool diagnostics schema.Location schema.Value "nullable" + |> Option.defaultValue false + + let typeName = optionalString diagnostics schema.Location schema.Value "type" + let format = optionalString diagnostics schema.Location schema.Value "format" + + let unsupportedKeywords = + [ "oneOf" ; "anyOf" ; "not" ; "discriminator" ] + |> List.filter schema.Value.ContainsKey + + if not unsupportedKeywords.IsEmpty then + let keywordList = String.concat ", " unsupportedKeywords + + report + diagnostics + UnsupportedSchema + schema.Location + $"Unsupported shape-changing schema keyword(s): %s{keywordList}." + + match + optionalBool diagnostics schema.Location schema.Value "readOnly", + optionalBool diagnostics schema.Location schema.Value "writeOnly" + with + | Some true, _ + | _, Some true -> + report + diagnostics + UnsupportedSchema + schema.Location + "readOnly/writeOnly schemas require separate request and response projections." + | _ -> () + + let hasObjectKeywords = + schema.Value.ContainsKey "properties" + || schema.Value.ContainsKey "required" + || schema.Value.ContainsKey "additionalProperties" + || schema.Value.ContainsKey "allOf" + + match typeName with + | Some value when value <> "object" && hasObjectKeywords -> + report + diagnostics + UnsupportedSchema + ($"%s{schema.Location}/type") + $"Schema type '%s{value}' contradicts its object-shape keywords." + | _ -> () + + let isObject = typeName = Some "object" || (typeName.IsNone && hasObjectKeywords) + + // Parse every nested schema occurrence once, even if contradictory keywords mean that + // the occurrence cannot contribute to the generated type. Diagnostics must not depend on + // which planning branch happens to consume the canonical schema. + let properties : Map = + match optionalObject diagnostics schema.Location schema.Value "properties" with + | None -> Map.empty + | Some properties -> + properties.Value + |> Seq.choose (fun (KeyValue (name, value)) -> + tryObject diagnostics ($"%s{properties.Location}/%s{pointerToken name}") value + |> Option.map (fun value -> name, Some (analyzeSchema diagnostics cache value)) + ) + |> Map.ofSeq + + let required = + match optionalArray diagnostics schema.Location schema.Value "required" with + | None -> Set.empty + | Some values -> + values + |> Seq.mapi (fun index value -> + tryString diagnostics ($"%s{schema.Location}/required/%i{index}") value + ) + |> Seq.choose id + |> Set.ofSeq + + let additionalProperties : AdditionalProperties = + match tryProperty diagnostics schema.Location schema.Value "additionalProperties" with + | None -> AdditionalProperties.Any + | Some (:? JsonObject as value) -> + { + Value = value + Location = $"%s{schema.Location}/additionalProperties" + } + |> analyzeSchema diagnostics cache + |> AdditionalProperties.Typed + | Some value -> + match tryBool diagnostics ($"%s{schema.Location}/additionalProperties") value with + | Some true -> AdditionalProperties.Any + | Some false -> AdditionalProperties.Forbidden + | None -> AdditionalProperties.Any + + let items = + optionalObject diagnostics schema.Location schema.Value "items" + |> Option.map (analyzeSchema diagnostics cache) + + let allOf = + optionalArray diagnostics schema.Location schema.Value "allOf" + |> Option.map (fun values -> + let branches = + values + |> Seq.mapi (fun index value -> + tryObject diagnostics ($"%s{schema.Location}/allOf/%i{index}") value + |> Option.map (analyzeSchema diagnostics cache) + ) + |> Seq.toList + + branches, values.Count + ) + + let directObject : DirectObjectShape = + { + Properties = properties + Required = required + AdditionalProperties = additionalProperties + } + + let shape = + if isObject && schema.Value.ContainsKey "allOf" then + match allOf with + | None -> CanonicalSchemaShape.Object directObject + | Some (branches, branchCount) -> + let parsedBranches = branches |> List.choose id + let allBranchesValid = parsedBranches.Length = branchCount + + let hasSiblingObjectKeywords = + schema.Value.ContainsKey "properties" + || schema.Value.ContainsKey "required" + || schema.Value.ContainsKey "additionalProperties" + + CanonicalSchemaShape.AllOf ( + typeName.IsNone || nullable, + hasSiblingObjectKeywords, + allBranchesValid, + parsedBranches + ) + elif isObject then + CanonicalSchemaShape.Object directObject + else + match typeName with + | None -> CanonicalSchemaShape.Any + | Some "string" -> + match format with + | Some "date" -> CanonicalSchemaShape.Primitive OpenApiPrimitive.Date + | Some "date-time" -> CanonicalSchemaShape.Primitive OpenApiPrimitive.DateTime + | Some "uuid" -> CanonicalSchemaShape.Primitive OpenApiPrimitive.Guid + | _ -> CanonicalSchemaShape.Primitive OpenApiPrimitive.String + | Some "boolean" -> CanonicalSchemaShape.Primitive OpenApiPrimitive.Boolean + | Some "integer" -> + match format with + | Some "int32" -> CanonicalSchemaShape.Primitive OpenApiPrimitive.Int32 + | Some "int64" -> CanonicalSchemaShape.Primitive OpenApiPrimitive.Int64 + | _ -> CanonicalSchemaShape.Primitive OpenApiPrimitive.BigInteger + | Some "number" -> + match format with + | Some "float" -> CanonicalSchemaShape.Primitive OpenApiPrimitive.Float32 + | Some "double" -> CanonicalSchemaShape.Primitive OpenApiPrimitive.Float + | Some "decimal" -> CanonicalSchemaShape.Primitive OpenApiPrimitive.Decimal + | format -> CanonicalSchemaShape.UnsupportedNumber format + | Some "array" -> CanonicalSchemaShape.Array items + | Some other -> CanonicalSchemaShape.UnsupportedType other + + { + Location = schema.Location + Description = description + Nullable = nullable + Shape = shape + } + + cache.Add (schema.Location, analyzed) + analyzed + + type private SchemaResolutionContext = + { + Diagnostics : ResizeArray + Components : Map + } + + let private trySchemaTarget + (context : SchemaResolutionContext) + (reportMissing : bool) + (reference : SchemaReference) + : CanonicalSchema option + = + match Map.tryFind reference.Name context.Components with + | Some target -> Some target + | None -> + if reportMissing then + report + context.Diagnostics + UnresolvedReference + reference.Location + $"Schema component '%s{reference.Name}' does not exist." + + None + + let rec private resolveSchemaReferences + (context : SchemaResolutionContext) + (reportFailures : bool) + (visited : Set) + (schema : CanonicalSchema) + : (Set * CanonicalSchema) option + = + match schema.Shape with + | CanonicalSchemaShape.Reference reference when Set.contains reference.Name visited -> + if reportFailures then + report + context.Diagnostics + UnsupportedSchema + reference.Location + $"Schema reference cycle involving '%s{reference.Name}' is unsupported." + + None + | CanonicalSchemaShape.Reference reference -> + trySchemaTarget context reportFailures reference + |> Option.bind (resolveSchemaReferences context reportFailures (Set.add reference.Name visited)) + | _ -> Some (visited, schema) + + let private schemaIsObjectLike (context : SchemaResolutionContext) (schema : CanonicalSchema) : bool = + match resolveSchemaReferences context false Set.empty schema with + | Some (_, + { + Shape = CanonicalSchemaShape.Object _ + }) + | Some (_, + { + Shape = CanonicalSchemaShape.AllOf _ + }) -> true + | _ -> false + + let rec private schemaAllowsNullInner + (context : SchemaResolutionContext) + (visited : Set) + (schema : CanonicalSchema) + : bool + = + match resolveSchemaReferences context false visited schema with + | None -> false + | Some (visited, resolved) -> + match resolved.Shape with + | CanonicalSchemaShape.Any -> true + | CanonicalSchemaShape.AllOf (outerAllowsNull, _, allBranchesValid, branches) -> + outerAllowsNull + && allBranchesValid + && (branches |> List.forall (schemaAllowsNullInner context visited)) + | _ -> resolved.Nullable + + let private schemaAllowsNull (context : SchemaResolutionContext) (schema : CanonicalSchema) : bool = + schemaAllowsNullInner context Set.empty schema + + type private SchemaPlanningContext = + { + Resolution : SchemaResolutionContext + UsedTypeNames : HashSet + ComponentTypeNames : Map + Definitions : ResizeArray + LiftedObjectTypes : Dictionary + } + + let private emptyObjectShape description : ObjectShape = + { + Description = description + Properties = Map.empty + Required = Set.empty + AdditionalProperties = AdditionalProperties.Any + } + + let rec private typeForSchema + (context : SchemaPlanningContext) + (aliasStack : Set) + (suggestedName : string) + (schema : CanonicalSchema) + : OpenApiPlannedType + = + match schema.Shape with + | CanonicalSchemaShape.Reference reference when Map.containsKey reference.Name context.ComponentTypeNames -> + match trySchemaTarget context.Resolution true reference with + | Some target -> + let typeName = context.ComponentTypeNames.[reference.Name] + let result = OpenApiPlannedType.Named typeName + + if schemaAllowsNull context.Resolution target then + OpenApiPlannedType.Optional result + else + result + | None -> OpenApiPlannedType.JsonNode + | CanonicalSchemaShape.Reference _ -> + match resolveSchemaReferences context.Resolution true aliasStack schema with + | None -> OpenApiPlannedType.JsonNode + | Some (aliasStack, target) -> typeForSchema context aliasStack suggestedName target + | shape -> + let baseType = + match shape with + | CanonicalSchemaShape.Any -> OpenApiPlannedType.JsonNode + | CanonicalSchemaShape.Primitive primitive -> OpenApiPlannedType.Primitive primitive + | CanonicalSchemaShape.Array None -> + report + context.Resolution.Diagnostics + UnsupportedSchema + ($"%s{schema.Location}/items") + "Array schemas must specify items." + + OpenApiPlannedType.List OpenApiPlannedType.JsonNode + | CanonicalSchemaShape.Array (Some items) -> + typeForSchema context aliasStack ($"%s{suggestedName}Item") items + |> OpenApiPlannedType.List + | CanonicalSchemaShape.Object _ + | CanonicalSchemaShape.AllOf _ -> liftObject context suggestedName schema + | CanonicalSchemaShape.UnsupportedNumber format -> + report + context.Resolution.Diagnostics + UnsupportedSchema + ($"%s{schema.Location}/format") + (match format with + | None -> "Unformatted JSON numbers have no lossless built-in F# representation." + | Some format -> $"Number format '%s{format}' has no lossless built-in F# representation.") + + OpenApiPlannedType.JsonNode + | CanonicalSchemaShape.UnsupportedType value -> + report + context.Resolution.Diagnostics + UnsupportedSchema + ($"%s{schema.Location}/type") + $"Schema type '%s{value}' is unsupported." + + OpenApiPlannedType.JsonNode + | CanonicalSchemaShape.Invalid + | CanonicalSchemaShape.Reference _ -> OpenApiPlannedType.JsonNode + + if schemaAllowsNull context.Resolution schema then + OpenApiPlannedType.Optional baseType + else + baseType + + and private liftObject + (context : SchemaPlanningContext) + (suggestedName : string) + (schema : CanonicalSchema) + : OpenApiPlannedType + = + let shape = collectObjectShape context Set.empty schema + let identity = objectIdentity context shape + + match context.LiftedObjectTypes.TryGetValue identity with + | true, typeName -> OpenApiPlannedType.Named typeName + | false, _ -> + let typeName = + allocateUniqueName context.UsedTypeNames "AnonymousType" sanitiseTypeName suggestedName + + context.LiftedObjectTypes.Add (identity, typeName) + + buildDefinition context suggestedName schema.Location typeName shape + |> context.Definitions.Add + + OpenApiPlannedType.Named typeName + + and private buildDefinition + (context : SchemaPlanningContext) + sourceName + sourceLocation + typeName + (shape : ObjectShape) + : OpenApiPlannedTypeDefinition + = + let allProperties = + (shape.Properties, shape.Required) + ||> Set.fold (fun properties requiredName -> + if Map.containsKey requiredName properties then + properties + else + Map.add requiredName None properties + ) + + if + allProperties.IsEmpty + && shape.AdditionalProperties = AdditionalProperties.Forbidden + then + report + context.Resolution.Diagnostics + UnsupportedSchema + sourceLocation + "A closed object with no properties has no faithful non-null F# record representation." + + let usedFieldNames = HashSet (StringComparer.Ordinal) + + if shape.AdditionalProperties <> AdditionalProperties.Forbidden then + usedFieldNames.Add "AdditionalProperties" |> ignore + + let fields = + allProperties + |> Map.toList + |> List.map (fun (jsonName, propertySchema) -> + let required = Set.contains jsonName shape.Required + let fsharpName = allocateUniqueName usedFieldNames "Field" sanitiseTypeName jsonName + + let fieldType = + match propertySchema with + | None -> OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode + | Some propertySchema -> + let allowsNull = schemaAllowsNull context.Resolution propertySchema + + if allowsNull && not required then + report + context.Resolution.Diagnostics + UnsupportedSchema + propertySchema.Location + "An optional property whose schema allows null has three wire states (missing, null, value), which this generated API does not conflate." + + let result = + typeForSchema context Set.empty ($"%s{typeName}%s{fsharpName}") propertySchema + + if required || allowsNull then + result + else + OpenApiPlannedType.Optional result + + { + JsonName = jsonName + FSharpName = fsharpName + Type = fieldType + Required = required + } + ) + + let additionalProperties = + match shape.AdditionalProperties with + | AdditionalProperties.Forbidden -> None + | AdditionalProperties.Any -> Some (OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode) + | AdditionalProperties.Typed schema -> + typeForSchema context Set.empty ($"%s{typeName}AdditionalProperty") schema + |> Some + + { + SourceName = sourceName + FSharpName = typeName + Description = shape.Description + Fields = fields + AdditionalProperties = additionalProperties + } + + and private collectObjectShape + (context : SchemaPlanningContext) + (compositionStack : Set) + (schema : CanonicalSchema) + : ObjectShape + = + match resolveSchemaReferences context.Resolution true compositionStack schema with + | None -> emptyObjectShape None + | Some (compositionStack, resolved) -> + match resolved.Shape with + | CanonicalSchemaShape.Object shape -> + { + Description = resolved.Description + Properties = shape.Properties + Required = shape.Required + AdditionalProperties = shape.AdditionalProperties + } + | CanonicalSchemaShape.AllOf (_, hasSiblingObjectKeywords, _, branches) -> + if hasSiblingObjectKeywords then + report + context.Resolution.Diagnostics + UnsupportedSchema + resolved.Location + "An allOf schema with sibling object-shape keywords is not currently supported." + + let shapes = + branches + |> List.map (fun branch -> + if not (schemaIsObjectLike context.Resolution branch) then + report + context.Resolution.Diagnostics + UnsupportedSchema + branch.Location + "Only object-shaped allOf branches can be represented as an F# record." + + collectObjectShape context compositionStack branch + ) + + let merge (left : ObjectShape) (right : ObjectShape) : ObjectShape = + let ensureNoForbiddenIntroductions (constrained : ObjectShape) (other : ObjectShape) = + match constrained.AdditionalProperties with + | AdditionalProperties.Any -> () + | AdditionalProperties.Forbidden + | AdditionalProperties.Typed _ -> + let introduced = + Set.difference + (other.Properties |> Map.toSeq |> Seq.map fst |> Set.ofSeq) + (constrained.Properties |> Map.toSeq |> Seq.map fst |> Set.ofSeq) + + if not introduced.IsEmpty then + report + context.Resolution.Diagnostics + UnsupportedSchema + resolved.Location + "allOf cannot merge fields introduced outside a branch with constrained additionalProperties." + + ensureNoForbiddenIntroductions left right + ensureNoForbiddenIntroductions right left + + let properties = + (left.Properties, right.Properties) + ||> Map.fold (fun current name propertySchema -> + match Map.tryFind name current, propertySchema with + | None, _ -> Map.add name propertySchema current + | Some None, Some value -> Map.add name (Some value) current + | Some None, None + | Some (Some _), None -> current + | Some (Some existing), Some value -> + if + schemaIdentity context Set.empty existing + <> schemaIdentity context Set.empty value + then + report + context.Resolution.Diagnostics + UnsupportedSchema + value.Location + $"allOf gives property '%s{name}' incompatible schemas." + + current + ) + + let additionalProperties = + match left.AdditionalProperties, right.AdditionalProperties with + | AdditionalProperties.Any, value + | value, AdditionalProperties.Any -> value + | AdditionalProperties.Forbidden, AdditionalProperties.Forbidden -> + AdditionalProperties.Forbidden + | AdditionalProperties.Typed left, AdditionalProperties.Typed right when + schemaIdentity context Set.empty left = schemaIdentity context Set.empty right + -> + AdditionalProperties.Typed left + | _ -> + report + context.Resolution.Diagnostics + UnsupportedSchema + resolved.Location + "allOf branches have incompatible additionalProperties constraints." + + AdditionalProperties.Forbidden + + { + Description = None + Properties = properties + Required = Set.union left.Required right.Required + AdditionalProperties = additionalProperties + } + + match shapes with + | [] -> emptyObjectShape resolved.Description + | head :: tail -> + { List.fold merge head tail with + Description = resolved.Description + } + | _ -> + report + context.Resolution.Diagnostics + UnsupportedSchema + resolved.Location + "Expected an object-shaped schema." + + emptyObjectShape resolved.Description + + and private schemaIdentity + (context : SchemaPlanningContext) + (aliasStack : Set) + (schema : CanonicalSchema) + : SchemaIdentity + = + match schema.Shape with + | CanonicalSchemaShape.Reference reference when Map.containsKey reference.Name context.ComponentTypeNames -> + match trySchemaTarget context.Resolution false reference with + | None -> SchemaIdentity.Json + | Some target -> + let core = SchemaIdentity.Named reference.Name + + if schemaAllowsNull context.Resolution target then + SchemaIdentity.Optional core + else + core + | CanonicalSchemaShape.Reference _ -> + match resolveSchemaReferences context.Resolution false aliasStack schema with + | None -> SchemaIdentity.Json + | Some (aliasStack, target) -> schemaIdentity context aliasStack target + | shape -> + let core = + match shape with + | CanonicalSchemaShape.Any -> SchemaIdentity.Json + | CanonicalSchemaShape.Primitive primitive -> SchemaIdentity.Primitive primitive + | CanonicalSchemaShape.Array None -> SchemaIdentity.List SchemaIdentity.Json + | CanonicalSchemaShape.Array (Some items) -> + SchemaIdentity.List (schemaIdentity context aliasStack items) + | CanonicalSchemaShape.Object _ + | CanonicalSchemaShape.AllOf _ -> + collectObjectShape context Set.empty schema + |> objectIdentity context + |> SchemaIdentity.Object + | CanonicalSchemaShape.UnsupportedNumber _ + | CanonicalSchemaShape.UnsupportedType _ + | CanonicalSchemaShape.Invalid + | CanonicalSchemaShape.Reference _ -> SchemaIdentity.Json + + if schemaAllowsNull context.Resolution schema then + SchemaIdentity.Optional core + else + core + + and private objectIdentity (context : SchemaPlanningContext) (shape : ObjectShape) : ObjectShapeIdentity = + let allProperties = + (shape.Properties, shape.Required) + ||> Set.fold (fun properties requiredName -> + if Map.containsKey requiredName properties then + properties + else + Map.add requiredName None properties + ) + + let properties = + allProperties + |> Map.map (fun _ schema -> + match schema with + | None -> SchemaIdentity.Optional SchemaIdentity.Json + | Some schema -> schemaIdentity context Set.empty schema + ) + + let additionalProperties = + match shape.AdditionalProperties with + | AdditionalProperties.Forbidden -> AdditionalPropertiesIdentity.Forbidden + | AdditionalProperties.Any -> + SchemaIdentity.Optional SchemaIdentity.Json + |> AdditionalPropertiesIdentity.Value + | AdditionalProperties.Typed schema -> + schemaIdentity context Set.empty schema |> AdditionalPropertiesIdentity.Value + + { + Properties = properties + Required = shape.Required + AdditionalProperties = additionalProperties + } + + let private addComponentDefinition + (context : SchemaPlanningContext) + (sourceName : string) + (schema : CanonicalSchema) + : unit + = + let shape = collectObjectShape context (Set.singleton sourceName) schema + let typeName = context.ComponentTypeNames.[sourceName] + + buildDefinition context sourceName schema.Location typeName shape + |> context.Definitions.Add + + let rec private resolveComponentReference + (diagnostics : ResizeArray) + (diagnosticCode : OpenApiGenerationDiagnosticCode) + (prefix : string) + (components : Map) + (visited : Set) + (value : LocatedObject) + : LocatedObject option + = + match optionalString diagnostics value.Location value.Value "$ref" with + | None -> Some value + | Some reference -> + let location = $"%s{value.Location}/$ref" + + match referenceName diagnostics diagnosticCode prefix location reference with + | None -> None + | Some name when Set.contains name visited -> + report diagnostics diagnosticCode location $"Reference cycle involving '%s{name}' is unsupported here." + None + | Some name -> + match Map.tryFind name components with + | None -> + report diagnostics diagnosticCode location $"Component '%s{name}' does not exist." + None + | Some target -> + resolveComponentReference diagnostics diagnosticCode prefix components (Set.add name visited) target + + let private parseServerBase + (diagnostics : ResizeArray) + (root : JsonObject) + : OpenApiServerBase + = + let report = report diagnostics + let optionalArray = optionalArray diagnostics + let tryObject = tryObject diagnostics + let requiredString = requiredString diagnostics + let optionalObject = optionalObject diagnostics + let objectMap = objectMap diagnostics + + match optionalArray "#" root "servers" with + | None -> OpenApiServerBase.BasePath "/" + | Some servers when servers.Count = 0 -> OpenApiServerBase.BasePath "/" + | Some servers -> + if servers.Count > 1 then + report + UnsupportedOperation + "#/servers" + "Only the first document-level server is supported; additional server entries would be ignored." + + match tryObject "#/servers/0" servers.[0] with + | None -> OpenApiServerBase.BasePath "/" + | Some server -> + let mutable url = + requiredString server.Location server.Value "url" |> Option.defaultValue "/" + + let variables = + match optionalObject server.Location server.Value "variables" with + | None -> Map.empty + | Some variables -> objectMap variables.Location variables.Value + + for found in Regex.Matches (url, "\\{([^{}]+)\\}") |> Seq.cast do + let variableName = found.Groups.[1].Value + + match Map.tryFind variableName variables with + | None -> + report + InvalidDocument + ($"%s{server.Location}/url") + $"Server variable '%s{variableName}' has no definition." + | Some variable -> + match requiredString variable.Location variable.Value "default" with + | None -> () + | Some value -> url <- url.Replace (found.Value, value, StringComparison.Ordinal) + + match Uri.TryCreate (url, UriKind.Absolute) with + | true, _ -> OpenApiServerBase.BaseAddress url + | false, _ -> OpenApiServerBase.BasePath url + + /// A security scheme from `components.securitySchemes`, as far as the generated client is + /// concerned: either a header whose entire value the caller supplies, or a reason we can't + /// carry it at all. + type private SecurityScheme = + | Representable of headerName : string * kind : OpenApiSecuritySchemeKind * description : string option + | Unrepresentable of reason : string + + /// One entry of a `security` array: the schemes which must *all* be satisfied together, sorted + /// for determinism. The empty list is the OpenAPI empty requirement `{}`, i.e. "no credentials". + type private SecurityRequirement = + { + Schemes : string list + Location : string + } + + /// The `security` of an operation or of the document root: an ordered list of alternatives, any + /// one of which suffices. `None` means the key was absent (so the root's value is inherited); + /// `Some []` means it was present and empty, which explicitly demands no credentials. + type private SecurityRequirements = SecurityRequirement list option + + let private parseSecuritySchemes + (diagnostics : ResizeArray) + (components : LocatedObject option) + : Map + = + let report = report diagnostics + let requiredString = requiredString diagnostics + let optionalString = optionalString diagnostics + let optionalObject = optionalObject diagnostics + + let declared = componentMap diagnostics components "securitySchemes" + + declared + |> Map.map (fun _ scheme -> + match + resolveComponentReference + diagnostics + UnresolvedReference + "#/components/securitySchemes/" + declared + Set.empty + scheme + with + | None -> SecurityScheme.Unrepresentable "the security scheme's reference could not be resolved" + | Some scheme -> + + let description = optionalString scheme.Location scheme.Value "description" + + match requiredString scheme.Location scheme.Value "type" with + | None -> SecurityScheme.Unrepresentable "the security scheme has no type" + | Some "apiKey" -> + let name = requiredString scheme.Location scheme.Value "name" + + match requiredString scheme.Location scheme.Value "in" with + | None -> SecurityScheme.Unrepresentable "the apiKey security scheme does not say where the key goes" + | Some "header" -> + match name with + | None -> SecurityScheme.Unrepresentable "the apiKey security scheme names no header" + | Some name -> SecurityScheme.Representable (name, OpenApiSecuritySchemeKind.ApiKey, description) + | Some ("query" | "cookie" as location) -> + SecurityScheme.Unrepresentable + $"apiKey credentials carried in the %s{location} are not representable by the generated HTTP client, which can only set headers" + | Some other -> + report + InvalidDocument + ($"%s{scheme.Location}/in") + $"An apiKey security scheme's 'in' must be one of header, query, or cookie, but got '%s{other}'." + + SecurityScheme.Unrepresentable + $"the apiKey security scheme has an unrecognised location '%s{other}'" + | Some "http" -> + match requiredString scheme.Location scheme.Value "scheme" with + | None -> SecurityScheme.Unrepresentable "the http security scheme names no authentication scheme" + | Some httpScheme -> + SecurityScheme.Representable ( + "Authorization", + OpenApiSecuritySchemeKind.Http httpScheme, + description + ) + | Some "oauth2" -> + match optionalObject scheme.Location scheme.Value "flows" with + | None -> + report InvalidDocument scheme.Location "An oauth2 security scheme must have a 'flows' object." + SecurityScheme.Unrepresentable "the oauth2 security scheme has no flows" + | Some _ -> + SecurityScheme.Representable ("Authorization", OpenApiSecuritySchemeKind.OAuth2, description) + | Some "openIdConnect" -> + match requiredString scheme.Location scheme.Value "openIdConnectUrl" with + | None -> SecurityScheme.Unrepresentable "the openIdConnect security scheme has no discovery URL" + | Some _ -> + SecurityScheme.Representable ( + "Authorization", + OpenApiSecuritySchemeKind.OpenIdConnect, + description + ) + | Some other -> + report + InvalidDocument + ($"%s{scheme.Location}/type") + $"Security scheme type '%s{other}' is not one of apiKey, http, oauth2, openIdConnect." + + SecurityScheme.Unrepresentable $"'%s{other}' is not a security scheme type defined by OpenAPI 3.0" + ) + + /// Parse the `security` of a document root or an operation. Scheme names which no security + /// scheme defines are a document error, and are reported here however the requirement is later + /// used: a dangling reference is a bug in the document even if we don't happen to need it. + let private parseSecurityRequirements + (diagnostics : ResizeArray) + (schemes : Map) + (owner : LocatedObject) + : SecurityRequirements + = + let report = report diagnostics + let optionalArray = optionalArray diagnostics + let tryObject = tryObject diagnostics + let tryArray = tryArray diagnostics + + match optionalArray owner.Location owner.Value "security" with + | None -> None + | Some requirements -> + + let location = $"%s{owner.Location}/security" + + requirements + |> Seq.mapi (fun index requirement -> + let location = $"%s{location}/%i{index}" + + match tryObject location requirement with + | None -> None + | Some requirement -> + let schemeNames = + requirement.Value + |> Seq.map (fun (KeyValue (name, scopes)) -> name, scopes) + |> Seq.sortBy fst + |> Seq.toList + + for name, scopes in schemeNames do + let schemeLocation = $"%s{location}/%s{pointerToken name}" + // The scopes carry no information the generated client can act on, but a + // non-array here means the document doesn't say what it thinks it says. + tryArray schemeLocation scopes |> ignore + + if not (Map.containsKey name schemes) then + report + UnresolvedReference + schemeLocation + $"Security requirement names scheme '%s{name}', which no security scheme defines." + + { + Schemes = schemeNames |> List.map fst + Location = location + } + |> Some + ) + |> Seq.toList + |> List.choose id + |> Some + + /// Why an operation's security requirement could not be met. + type private SecuritySelectionFailure = + /// No alternative can be satisfied, so the client could only issue unauthenticated requests. + /// Each entry is a requirement's location and why it was rejected. + | Unsatisfiable of rejections : (string * string) list + /// Several alternatives could be satisfied, and the document says nothing about which the + /// caller would prefer. Each entry is a candidate's location and the schemes it names. + | Ambiguous of candidates : (string * string list) list + + /// Choose the credentials an operation sends. `Ok []` means "send none", which is what an absent + /// or empty `security` demands. + /// + /// Exactly one alternative must be satisfiable. *Several* is an error rather than a guess: a + /// document lists its alternatives in no particular order, so choosing between them would choose + /// how the caller authenticates. They say which they want with the SecuritySchemes parameter. + let private selectSecurityRequirement + (permitted : Set option) + (schemes : Map) + (alternatives : SecurityRequirement list) + : Result + = + let rejection (schemeName : string) : string option = + match Map.tryFind schemeName schemes with + | None -> Some $"'%s{schemeName}' is not defined by any security scheme" + | Some (SecurityScheme.Unrepresentable reason) -> Some $"'%s{schemeName}' is unsupported: %s{reason}" + | Some (SecurityScheme.Representable _) -> + match permitted with + | Some permitted when not (Set.contains schemeName permitted) -> + Some $"'%s{schemeName}' was not listed in the SecuritySchemes Myriad parameter" + | _ -> None + + /// Schemes which must be satisfied *together* must each contribute a distinct header: a + /// single request cannot carry two `Authorization` values (the BCL throws when you try), so + /// a requirement pairing, say, an http scheme with an oauth2 one is not one we can send. + let collidingHeaders (alternativeSchemes : string list) : string option = + let collisions = + alternativeSchemes + |> List.choose (fun schemeName -> + match Map.tryFind schemeName schemes with + | Some (SecurityScheme.Representable (headerName, _, _)) -> Some (headerName, schemeName) + | _ -> None + ) + |> List.groupBy fst + |> List.filter (fun (_, users) -> List.length users > 1) + + match collisions with + | [] -> None + | collisions -> + collisions + |> List.map (fun (headerName, users) -> + let users = users |> List.map snd |> String.concat " and " + $"%s{users} would all have to set the '%s{headerName}' header, which can only carry one value" + ) + |> String.concat "; " + |> Some + + // No alternatives at all is not a failure to satisfy anything: it is the statement that this + // operation needs no credentials. + if List.isEmpty alternatives then + Ok [] + else + + let satisfiable, rejected = + alternatives + |> List.map (fun alternative -> + match alternative.Schemes |> List.choose rejection with + | [] -> + match collidingHeaders alternative.Schemes with + | None -> Choice1Of2 alternative + | Some reason -> Choice2Of2 (alternative.Location, reason) + | reasons -> Choice2Of2 (alternative.Location, String.concat "; " reasons) + ) + |> List.partitionChoice + + // Two alternatives naming the same schemes are the same choice, not a choice between two. + match satisfiable |> List.distinctBy _.Schemes with + | [ chosen ] -> Ok chosen.Schemes + | [] -> Error (SecuritySelectionFailure.Unsatisfiable rejected) + | candidates -> + candidates + |> List.map (fun candidate -> candidate.Location, candidate.Schemes) + |> SecuritySelectionFailure.Ambiguous + |> Error + + type private OperationPlanningContext = + { + Diagnostics : ResizeArray + SchemaCache : Dictionary + SchemaPlanning : SchemaPlanningContext + ParameterComponents : Map + RequestBodyComponents : Map + ResponseComponents : Map + SecuritySchemes : Map + /// The schemes the caller is willing to have the generated client use, if they restricted + /// them; `None` permits every scheme the document defines. + PermittedSecuritySchemes : Set option + /// Names already taken by members of the generated interface. Shared with the credential + /// properties, which live in the same scope as the operation methods. + UsedMemberNames : HashSet + } + + let private parseParameter (context : OperationPlanningContext) (value : LocatedObject) : ResolvedParameter option = + let diagnostics = context.Diagnostics + let report = report diagnostics + let requiredString = requiredString diagnostics + let optionalString = optionalString diagnostics + let optionalBool = optionalBool diagnostics + let optionalObject = optionalObject diagnostics + + resolveComponentReference + diagnostics + UnresolvedReference + "#/components/parameters/" + context.ParameterComponents + Set.empty + value + |> Option.bind (fun value -> + let name = requiredString value.Location value.Value "name" + + let location = + requiredString value.Location value.Value "in" + |> Option.bind (fun location -> + match location with + | "path" -> Some ResolvedParameterLocation.Path + | "query" -> Some ResolvedParameterLocation.Query + | "header" -> Some ResolvedParameterLocation.Header + | "cookie" -> Some ResolvedParameterLocation.Cookie + | other -> + report + UnsupportedParameter + ($"%s{value.Location}/in") + $"Parameter location '%s{other}' is unsupported." + + None + ) + + let schema = + optionalObject value.Location value.Value "schema" + |> Option.map (analyzeSchema diagnostics context.SchemaCache) + + let hasSchema = value.Value.ContainsKey "schema" + let hasContent = value.Value.ContainsKey "content" + + if hasContent then + report + UnsupportedParameter + ($"%s{value.Location}/content") + "Content-based parameters are not supported." + + if not hasSchema && not hasContent then + report InvalidDocument value.Location "A parameter must contain exactly one of schema or content." + + if hasSchema && schema.IsNone then + report + InvalidDocument + ($"%s{value.Location}/schema") + "A parameter schema must be a non-null JSON object." + + match name, location, schema with + | Some name, Some location, Some schema -> + let required = + optionalBool value.Location value.Value "required" |> Option.defaultValue false + + match location with + | ResolvedParameterLocation.Path when not required -> + report UnsupportedParameter value.Location "Path parameters must specify required: true." + | ResolvedParameterLocation.Query when not (Regex.IsMatch (name, "^[A-Za-z0-9._~-]+$")) -> + report + UnsupportedParameter + ($"%s{value.Location}/name") + "Query parameter names must contain only RFC 3986 unreserved characters." + | ResolvedParameterLocation.Header + | ResolvedParameterLocation.Cookie -> + report + UnsupportedParameter + value.Location + "Header and cookie parameters are not representable by the generated HTTP client." + | _ -> () + + let expectedStyle = + match location with + | ResolvedParameterLocation.Path -> Some "simple" + | ResolvedParameterLocation.Query -> Some "form" + | _ -> None + + match expectedStyle, optionalString value.Location value.Value "style" with + | Some expected, Some actual when actual <> expected -> + report + UnsupportedParameter + ($"%s{value.Location}/style") + $"Only the default '%s{expected}' parameter style is supported." + | _ -> () + + match optionalBool value.Location value.Value "allowReserved" with + | Some true -> + report + UnsupportedParameter + ($"%s{value.Location}/allowReserved") + "allowReserved parameters require a different URI-escaping strategy." + | _ -> () + + { + Name = name + Location = location + Required = required + Schema = schema + SourceLocation = value.Location + } + |> Some + | _ -> None + ) + + let private parseParameterList + (context : OperationPlanningContext) + (owner : LocatedObject) + : ResolvedParameter list + = + let diagnostics = context.Diagnostics + let report = report diagnostics + let optionalArray = optionalArray diagnostics + let tryObject = tryObject diagnostics + + match optionalArray owner.Location owner.Value "parameters" with + | None -> [] + | Some values -> + let parsed = + values + |> Seq.mapi (fun index value -> + tryObject ($"%s{owner.Location}/parameters/%i{index}") value + |> Option.bind (parseParameter context) + ) + |> Seq.choose id + |> Seq.toList + + parsed + |> List.groupBy (fun parameter -> parameter.Name, parameter.Location) + |> List.iter (fun ((name, _), values) -> + if values.Length > 1 then + report InvalidDocument owner.Location $"Parameter '%s{name}' is duplicated at the same location." + ) + + parsed + + let private mergeParameters + (inherited : ResolvedParameter list) + (operation : ResolvedParameter list) + : ResolvedParameter list + = + let overrides = + operation + |> List.map (fun parameter -> (parameter.Name, parameter.Location), parameter) + |> Map + + [ + for parameter in inherited do + match Map.tryFind (parameter.Name, parameter.Location) overrides with + | Some replacement -> yield replacement + | None -> yield parameter + + let inheritedKeys = + inherited + |> List.map (fun parameter -> parameter.Name, parameter.Location) + |> Set + + for parameter in operation do + if not (Set.contains (parameter.Name, parameter.Location) inheritedKeys) then + yield parameter + ] + + let private mediaTypeWithoutParameters (name : string) : string = + match name.IndexOf ';' with + | -1 -> name.Trim () + | separator -> (name.Substring (0, separator)).Trim () + + let private mediaTypeEquals (expected : string) (actual : string) : bool = + (mediaTypeWithoutParameters actual).Equals (expected, StringComparison.OrdinalIgnoreCase) + + let private selectMedia + (context : OperationPlanningContext) + (purpose : string) + (content : LocatedObject) + : (string * CanonicalSchema option) option + = + let diagnostics = context.Diagnostics + let report = report diagnostics + let tryObject = tryObject diagnostics + let optionalObject = optionalObject diagnostics + + let rank (name : string) = + let name = mediaTypeWithoutParameters name + + if name.Equals ("application/json", StringComparison.OrdinalIgnoreCase) then + 0 + elif name.EndsWith ("+json", StringComparison.OrdinalIgnoreCase) then + 1 + elif name.Equals ("text/plain", StringComparison.OrdinalIgnoreCase) then + 2 + elif name.Equals ("application/octet-stream", StringComparison.OrdinalIgnoreCase) then + 3 + else + 100 + + let candidates = + content.Value + |> Seq.choose (fun (KeyValue (name, node)) -> + let rank = rank name + + if rank = 100 then + None + else + tryObject ($"%s{content.Location}/%s{pointerToken name}") node + |> Option.map (fun media -> rank, name, media) + ) + |> Seq.sortBy (fun (rank, name, _) -> rank, name) + |> Seq.toList + + match candidates with + | [] -> + let keys = + content.Value + |> Seq.map (fun (KeyValue (name, _)) -> name) + |> Seq.sort + |> String.concat "', '" + |> fun value -> + if String.IsNullOrEmpty value then + "(none)" + else + $"'%s{value}'" + + report + UnsupportedOperation + content.Location + $"No supported media type was found for %s{purpose}. Content keys: %s{keys}." + + None + | (_, selectedName, selected) :: _ -> + let selectedSchema = + optionalObject selected.Location selected.Value "schema" + |> Option.map (analyzeSchema diagnostics context.SchemaCache) + + Some (mediaTypeWithoutParameters selectedName, selectedSchema) + + let rec private isJsonStringType (plannedType : OpenApiPlannedType) : bool = + match plannedType with + | OpenApiPlannedType.Primitive OpenApiPrimitive.String -> true + | OpenApiPlannedType.Optional inner -> isJsonStringType inner + | _ -> false + + let private isJsonMediaType (mediaType : string) : bool = + let mediaType = mediaTypeWithoutParameters mediaType + + mediaType.Equals ("application/json", StringComparison.OrdinalIgnoreCase) + || mediaType.EndsWith ("+json", StringComparison.OrdinalIgnoreCase) + + let private responseShape + (context : OperationPlanningContext) + (operationName : string) + (value : LocatedObject) + : OpenApiPlannedType * string option + = + let diagnostics = context.Diagnostics + let report = report diagnostics + let optionalObject = optionalObject diagnostics + + let value = + resolveComponentReference + diagnostics + UnresolvedReference + "#/components/responses/" + context.ResponseComponents + Set.empty + value + + match value with + | None -> OpenApiPlannedType.JsonNode, None + | Some value -> + match optionalObject value.Location value.Value "content" with + | None -> OpenApiPlannedType.Unit, None + | Some content when content.Value.Count = 0 -> OpenApiPlannedType.Unit, None + | Some content -> + match selectMedia context "a response" content with + | None -> OpenApiPlannedType.JsonNode, None + | Some (mediaType, schema) -> + let result = + if mediaTypeEquals "application/octet-stream" mediaType then + match schema with + | None -> () + | Some schema -> + match + typeForSchema + context.SchemaPlanning + Set.empty + ($"%s{operationName}BinaryResponse") + schema + with + | OpenApiPlannedType.Primitive OpenApiPrimitive.String -> () + | _ -> + report + UnsupportedOperation + schema.Location + "application/octet-stream responses require a non-null string/binary schema." + + OpenApiPlannedType.Stream + elif mediaTypeEquals "text/plain" mediaType then + match schema with + | None -> () + | Some schema -> + match + typeForSchema + context.SchemaPlanning + Set.empty + ($"%s{operationName}TextResponse") + schema + with + | OpenApiPlannedType.Primitive OpenApiPrimitive.String -> () + | _ -> + report + UnsupportedOperation + schema.Location + "text/plain responses require a non-null string schema." + + OpenApiPlannedType.Primitive OpenApiPrimitive.String + else + match schema with + | None -> OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode + | Some schema -> + typeForSchema context.SchemaPlanning Set.empty ($"%s{operationName}Response") schema + + if isJsonMediaType mediaType && isJsonStringType result then + report + UnsupportedOperation + content.Location + "JSON string responses need JSON unquoting, which the generated HTTP shell cannot distinguish from text/plain." + + result, Some mediaType + + let private successfulResponses + (context : OperationPlanningContext) + (operationName : string) + (responses : LocatedObject) + : OpenApiPlannedType * string option + = + let diagnostics = context.Diagnostics + let report = report diagnostics + let tryObject = tryObject diagnostics + + let declaredSuccesses = + responses.Value + |> Seq.choose (fun (KeyValue (status, node)) -> + let successful = + if status.Equals ("2XX", StringComparison.OrdinalIgnoreCase) then + true + else + match Int32.TryParse status with + | true, value -> 200 <= value && value < 300 + | false, _ -> false + + if successful then + tryObject ($"%s{responses.Location}/%s{pointerToken status}") node + |> Option.map (fun response -> status, response) + else + None + ) + |> Seq.sortBy fst + |> Seq.toList + + let rangeCoversEverySuccess = + declaredSuccesses + |> List.exists (fun (status, _) -> status.Equals ("2XX", StringComparison.OrdinalIgnoreCase)) + + let candidates = + if rangeCoversEverySuccess then + declaredSuccesses + else + match responses.Value.TryGetPropertyValue "default" with + | false, _ -> declaredSuccesses + | true, value -> + match tryObject ($"%s{responses.Location}/default") value with + | None -> declaredSuccesses + | Some response -> declaredSuccesses @ [ "default", response ] + + match candidates with + | [] -> + report + AmbiguousSuccessResponse + responses.Location + "At least one exact 2xx, 2XX, or default response is required to describe success." + + OpenApiPlannedType.Unit, None + | (_, first) :: rest -> + let firstShape = responseShape context operationName first + + for status, response in rest do + let otherShape = responseShape context operationName response + + if otherShape <> firstShape then + report + AmbiguousSuccessResponse + ($"%s{responses.Location}/%s{pointerToken status}") + "All possible successful responses must have the same body type and media type." + + firstShape + + let private requestBodyParameter + (context : OperationPlanningContext) + (operationName : string) + (operation : LocatedObject) + : (OpenApiPlannedParameter * string) option + = + let diagnostics = context.Diagnostics + let report = report diagnostics + let optionalBool = optionalBool diagnostics + let optionalObject = optionalObject diagnostics + + match optionalObject operation.Location operation.Value "requestBody" with + | None -> None + | Some body -> + let body = + resolveComponentReference + diagnostics + UnresolvedReference + "#/components/requestBodies/" + context.RequestBodyComponents + Set.empty + body + + body + |> Option.bind (fun body -> + let required = + optionalBool body.Location body.Value "required" |> Option.defaultValue false + + if not required then + report + UnsupportedOperation + body.Location + "Optional request bodies cannot be represented without conflating omission and JSON null." + + match optionalObject body.Location body.Value "content" with + | None -> + report InvalidDocument ($"%s{body.Location}/content") "Request bodies require content." + None + | Some content -> + selectMedia context "a request body" content + |> Option.map (fun (mediaType, schema) -> + let plannedType = + if mediaTypeEquals "application/octet-stream" mediaType then + OpenApiPlannedType.Stream + elif mediaTypeEquals "text/plain" mediaType then + match schema with + | None -> () + | Some schema -> + match + typeForSchema + context.SchemaPlanning + Set.empty + ($"%s{operationName}TextRequest") + schema + with + | OpenApiPlannedType.Primitive OpenApiPrimitive.String -> () + | _ -> + report + UnsupportedOperation + schema.Location + "text/plain request bodies require a non-null string schema." + + OpenApiPlannedType.Primitive OpenApiPrimitive.String + else + match schema with + | None -> OpenApiPlannedType.Optional OpenApiPlannedType.JsonNode + | Some schema -> + typeForSchema + context.SchemaPlanning + Set.empty + ($"%s{operationName}Request") + schema + + if mediaTypeEquals "application/octet-stream" mediaType then + report + UnsupportedOperation + content.Location + "Binary request content types are not emitted correctly by the generated HTTP shell." + + if isJsonMediaType mediaType && isJsonStringType plannedType then + report + UnsupportedOperation + content.Location + "JSON string request bodies need JSON quoting, which the generated HTTP shell cannot distinguish from text/plain." + + { + WireName = "body" + FSharpName = "body" + Location = OpenApiParameterLocation.Body + Type = plannedType + Required = required + }, + mediaType + ) + ) + + let private planOperations (context : OperationPlanningContext) (root : JsonObject) : OpenApiPlannedOperation list = + let diagnostics = context.Diagnostics + let report = report diagnostics + let optionalString = optionalString diagnostics + let optionalObject = optionalObject diagnostics + let optionalArray = optionalArray diagnostics + let tryObject = tryObject diagnostics + let schemaResolution = context.SchemaPlanning.Resolution + let typeForSchema = typeForSchema context.SchemaPlanning + + let paths = optionalObject "#" root "paths" + let operations = ResizeArray () + let usedOperationIds = HashSet (StringComparer.Ordinal) + let usedMethodNames = context.UsedMemberNames + + let rootSecurity = + parseSecurityRequirements + diagnostics + context.SecuritySchemes + { + Location = "#" + Value = root + } + |> Option.defaultValue [] + + let methodEntries (pathItem : LocatedObject) = + [ + "get", HttpMethod.Get + "put", HttpMethod.Put + "post", HttpMethod.Post + "delete", HttpMethod.Delete + "options", HttpMethod.Options + "head", HttpMethod.Head + "patch", HttpMethod.Patch + "trace", HttpMethod.Trace + ] + |> List.choose (fun (name, method) -> + optionalObject pathItem.Location pathItem.Value name + |> Option.map (fun operation -> method, operation) + ) + + match paths with + | None -> report InvalidDocument "#/paths" "The OpenAPI paths object is required for client generation." + | Some paths -> + for path, pathItemNode in + paths.Value + |> Seq.map (fun (KeyValue (key, value)) -> key, value) + |> Seq.filter (fun (key, _) -> not (key.StartsWith ("x-", StringComparison.OrdinalIgnoreCase))) + |> Seq.sortBy fst do + if not (path.StartsWith ('/')) then + report + InvalidDocument + ($"%s{paths.Location}/%s{pointerToken path}") + "OpenAPI paths must start with '/'." + elif path.StartsWith ("//", StringComparison.Ordinal) then + report + InvalidDocument + ($"%s{paths.Location}/%s{pointerToken path}") + "Paths beginning with multiple slashes cannot be preserved by the generated URI composition." + + match tryObject ($"%s{paths.Location}/%s{pointerToken path}") pathItemNode with + | None -> () + | Some pathItem -> + if pathItem.Value.ContainsKey "$ref" then + report UnsupportedOperation pathItem.Location "Referenced Path Item Objects are unsupported." + + match optionalArray pathItem.Location pathItem.Value "servers" with + | Some values when values.Count > 0 -> + report + UnsupportedOperation + ($"%s{pathItem.Location}/servers") + "Path-specific servers are unsupported." + | _ -> () + + let inheritedParameters = parseParameterList context pathItem + + for httpMethod, operation in methodEntries pathItem do + match optionalArray operation.Location operation.Value "servers" with + | Some values when values.Count > 0 -> + report + UnsupportedOperation + ($"%s{operation.Location}/servers") + "Operation-specific servers are unsupported." + | _ -> () + + let operationId, operationIdLocation = + match optionalString operation.Location operation.Value "operationId" with + | Some value -> value, $"%s{operation.Location}/operationId" + | None -> + let methodName = httpMethod.ToString().ToLowerInvariant () + $"%s{methodName}-%s{path}", operation.Location + + if not (usedOperationIds.Add operationId) then + report InvalidDocument operationIdLocation $"Operation id '%s{operationId}' is duplicated." + + let operationFSharpName = + allocateUniqueName usedMethodNames "Operation" sanitiseTypeName operationId + + // An operation's own `security` replaces the root's entirely, including when it + // is present and empty (which demands that we send no credentials at all). + let security = + let alternatives = + parseSecurityRequirements diagnostics context.SecuritySchemes operation + |> Option.defaultValue rootSecurity + + match + selectSecurityRequirement + context.PermittedSecuritySchemes + context.SecuritySchemes + alternatives + with + | Ok schemes -> schemes + | Error (SecuritySelectionFailure.Unsatisfiable rejections) -> + let rejections = + rejections + |> List.map (fun (location, reason) -> $"%s{location}: %s{reason}") + |> String.concat Environment.NewLine + + report + UnsupportedSecurity + ($"%s{operation.Location}/security") + $"No security requirement of this operation can be satisfied by the generated client, so it would silently issue unauthenticated requests.%s{Environment.NewLine}%s{rejections}" + + [] + | Error (SecuritySelectionFailure.Ambiguous candidates) -> + let candidates = + candidates + |> List.map (fun (location, schemes) -> + let schemes = + match schemes with + | [] -> "(no credentials)" + | schemes -> String.concat " + " schemes + + $"%s{location}: %s{schemes}" + ) + |> String.concat Environment.NewLine + + report + AmbiguousSecurity + ($"%s{operation.Location}/security") + $"This operation can be authenticated in more than one way, and choosing between them would choose how you authenticate. Name the scheme you want in the SecuritySchemes Myriad parameter (comma-separated; leave it empty to send no credentials wherever the document permits that).%s{Environment.NewLine}%s{candidates}" + + [] + + let mergedParameters = + parseParameterList context operation |> mergeParameters inheritedParameters + + let templateNames = + Regex.Matches (path, "\\{([^{}]+)\\}") + |> Seq.cast + |> Seq.map (fun value -> value.Groups.[1].Value) + |> Set.ofSeq + + let pathParameters = + mergedParameters + |> List.filter (fun parameter -> parameter.Location = ResolvedParameterLocation.Path) + + for templateName in templateNames do + if not (pathParameters |> List.exists (fun parameter -> parameter.Name = templateName)) then + report + UnsupportedParameter + operation.Location + $"Path template variable '%s{templateName}' has no path parameter." + + for parameter in pathParameters do + if not (Set.contains parameter.Name templateNames) then + report + UnsupportedParameter + parameter.SourceLocation + $"Path parameter '%s{parameter.Name}' does not occur in the path template." + + let usedParameterNames = HashSet (StringComparer.Ordinal) + usedParameterNames.Add "ct" |> ignore + usedParameterNames.Add "body" |> ignore + usedParameterNames.Add "client" |> ignore + + let plannedParameters = + mergedParameters + |> List.choose (fun parameter -> + let location = + match parameter.Location with + | ResolvedParameterLocation.Path -> Some OpenApiParameterLocation.Path + | ResolvedParameterLocation.Query -> Some OpenApiParameterLocation.Query + | ResolvedParameterLocation.Header + | ResolvedParameterLocation.Cookie -> None + + location + |> Option.map (fun location -> + let parameterFSharpName = + allocateUniqueName + usedParameterNames + "parameter" + sanitiseParameterName + parameter.Name + + let parameterType = + typeForSchema + Set.empty + ($"%s{operationFSharpName}%s{parameterFSharpName}") + parameter.Schema + + if schemaAllowsNull schemaResolution parameter.Schema then + report + UnsupportedParameter + parameter.Schema.Location + "Path/query parameter schemas which allow null cannot be represented distinctly from omission." + + match parameterType with + | OpenApiPlannedType.Primitive OpenApiPrimitive.String + | OpenApiPlannedType.Primitive OpenApiPrimitive.Int32 + | OpenApiPlannedType.Primitive OpenApiPrimitive.Int64 -> () + | _ -> + report + UnsupportedParameter + parameter.Schema.Location + "Only string, int32, and int64 path/query parameter schemas currently have an exact wire encoding." + + let parameterType = + if parameter.Required then + parameterType + else + match parameterType with + | OpenApiPlannedType.Optional _ -> parameterType + | _ -> OpenApiPlannedType.Optional parameterType + + { + WireName = parameter.Name + FSharpName = parameterFSharpName + Location = location + Type = parameterType + Required = parameter.Required + } + ) + ) + + let body = requestBodyParameter context operationFSharpName operation + + let plannedParameters = + match body with + | None -> plannedParameters + | Some (parameter, _) -> plannedParameters @ [ parameter ] + + let responses = optionalObject operation.Location operation.Value "responses" + + let returnType, accept = + match responses with + | None -> + report + InvalidDocument + ($"%s{operation.Location}/responses") + "Operations require responses." + + OpenApiPlannedType.Unit, None + | Some responses -> successfulResponses context operationFSharpName responses + + operations.Add + { + OperationId = operationId + FSharpName = operationFSharpName + Description = + optionalString operation.Location operation.Value "summary" + |> Option.orElseWith (fun () -> + optionalString operation.Location operation.Value "description" + ) + Method = httpMethod + Path = path + Parameters = plannedParameters + ReturnType = returnType + Accept = accept + RequestContentType = body |> Option.map snd + Security = security + } + + operations |> Seq.sortBy _.FSharpName |> Seq.toList + + let private orderDefinitions + (diagnostics : ResizeArray) + (definitions : OpenApiPlannedTypeDefinition seq) + : OpenApiPlannedTypeDefinition list + = + let report = report diagnostics + + let rec namedDependencies (plannedType : OpenApiPlannedType) : Set = + match plannedType with + | OpenApiPlannedType.Named name -> Set.singleton name + | OpenApiPlannedType.List inner + | OpenApiPlannedType.Optional inner -> namedDependencies inner + | OpenApiPlannedType.Primitive _ + | OpenApiPlannedType.JsonNode + | OpenApiPlannedType.Stream + | OpenApiPlannedType.Unit -> Set.empty + + let definitionsByName = + definitions + |> Seq.map (fun definition -> definition.FSharpName, definition) + |> Map.ofSeq + + let definitionDependencies (definition : OpenApiPlannedTypeDefinition) : Set = + [ + yield! + definition.Fields + |> List.collect (fun field -> namedDependencies field.Type |> Set.toList) + + match definition.AdditionalProperties with + | None -> () + | Some value -> yield! namedDependencies value + ] + |> Set.ofList + // A record can recursively refer to itself; its generated codec member can recursively call itself too. + |> Set.remove definition.FSharpName + |> Set.filter (fun name -> Map.containsKey name definitionsByName) + + let visitedDefinitions = HashSet (StringComparer.Ordinal) + let visitingDefinitions = HashSet (StringComparer.Ordinal) + let reportedCycles = HashSet (StringComparer.Ordinal) + let orderedDefinitions = ResizeArray () + + let rec visitDefinition (name : string) = + if not (visitedDefinitions.Contains name) then + if not (visitingDefinitions.Add name) then + if reportedCycles.Add name then + report + UnsupportedSchema + "#/components/schemas" + $"Mutually recursive schema components involving '%s{name}' cannot use the generated JSON codecs." + else + let definition = definitionsByName.[name] + + for dependency in definitionDependencies definition |> Set.toList |> List.sort do + visitDefinition dependency + + visitingDefinitions.Remove name |> ignore + + if visitedDefinitions.Add name then + orderedDefinitions.Add definition + + for name in definitionsByName |> Map.toList |> List.map fst do + visitDefinition name + + orderedDefinitions |> Seq.toList + + let private parseDocument + (parameters : Map) + (root : JsonObject) + : Result + = + let diagnostics = ResizeArray () + let report = report diagnostics + let optionalString = optionalString diagnostics + let requiredString = requiredString diagnostics + let optionalObject = optionalObject diagnostics + let componentMap = componentMap diagnostics + + let version = requiredString "#" root "openapi" + + match version with + | Some value -> + let parts = value.Split '.' + + if parts.Length < 2 || parts.[0] <> "3" || parts.[1] <> "0" then + report UnsupportedVersion "#/openapi" $"Expected an OpenAPI 3.0.x document, but got '%s{value}'." + | None -> () + + let parameters = normaliseParameters parameters + + let className = + match Map.tryFind "CLASSNAME" parameters with + | Some value when not (String.IsNullOrWhiteSpace value) -> value + | _ -> + report InvalidDocument "#/$parameters/ClassName" "The ClassName Myriad parameter is required." + "GeneratedClient" + + if sanitiseTypeName className <> className then + report + InvalidDocument + "#/$parameters/ClassName" + "ClassName must already be a valid PascalCase F# identifier." + + let createMock = + match Map.tryFind "GENERATEMOCKVISIBILITY" parameters with + | None -> None + | Some value -> + match value.ToLowerInvariant () with + | "internal" -> Some true + | "public" -> Some false + | _ -> + report + InvalidDocument + "#/$parameters/GenerateMockVisibility" + "GenerateMockVisibility must be 'internal' or 'public'." + + None + + // Restricting the schemes is how a caller resolves an operation's *alternative* security + // requirements at generation time: we take the first alternative the caller permitted, so + // the choice is visible in the generated source rather than made at runtime. + let permittedSecuritySchemes = + match Map.tryFind "SECURITYSCHEMES" parameters with + | None -> None + | Some value -> + value.Split ',' + |> Seq.map _.Trim() + |> Seq.filter (fun value -> not (String.IsNullOrWhiteSpace value)) + |> Set.ofSeq + |> Some + + let info = optionalObject "#" root "info" + + let description = + info + |> Option.bind (fun value -> optionalString value.Location value.Value "description") + + match info with + | None -> report InvalidDocument "#/info" "The OpenAPI info object is required." + | Some value -> requiredString value.Location value.Value "title" |> ignore + + let components = optionalObject "#" root "components" + let schemaCache = Dictionary (StringComparer.Ordinal) + + let schemaComponents = + componentMap components "schemas" + |> Map.map (fun _ -> analyzeSchema diagnostics schemaCache) + + let parameterComponents = componentMap components "parameters" + let requestBodyComponents = componentMap components "requestBodies" + let responseComponents = componentMap components "responses" + let securitySchemes = parseSecuritySchemes diagnostics components + + match permittedSecuritySchemes with + | None -> () + | Some permitted -> + for name in permitted do + if not (Map.containsKey name securitySchemes) then + report + InvalidDocument + "#/$parameters/SecuritySchemes" + $"The SecuritySchemes Myriad parameter names '%s{name}', which the document does not define." + + let schemaResolution = + { + Diagnostics = diagnostics + Components = schemaComponents + } + + let usedTypeNames = HashSet (StringComparer.Ordinal) + + for reservedTypeName in + [ + className + "I" + className + "System" + "RestEase" + "WoofWare" + "GenerateMockAttribute" + "HttpClientAttribute" + "JsonParseAttribute" + "JsonSerializeAttribute" + ] do + usedTypeNames.Add reservedTypeName |> ignore + + let objectComponentNames = + schemaComponents + |> Map.toList + |> List.choose (fun (name, schema) -> + if schemaIsObjectLike schemaResolution schema then + Some name + else + None + ) + + let componentTypeNames = + objectComponentNames + |> List.map (fun sourceName -> + let fsharpName = + allocateUniqueName usedTypeNames "GeneratedType" sanitiseTypeName sourceName + + sourceName, fsharpName + ) + |> Map.ofList + + let definitions = ResizeArray () + + let schemaPlanning = + { + Resolution = schemaResolution + UsedTypeNames = usedTypeNames + ComponentTypeNames = componentTypeNames + Definitions = definitions + LiftedObjectTypes = Dictionary () + } + + for sourceName in objectComponentNames do + addComponentDefinition schemaPlanning sourceName schemaComponents.[sourceName] + + let usedMemberNames = HashSet (StringComparer.Ordinal) + + let operationPlanning = + { + Diagnostics = diagnostics + SchemaCache = schemaCache + SchemaPlanning = schemaPlanning + ParameterComponents = parameterComponents + RequestBodyComponents = requestBodyComponents + ResponseComponents = responseComponents + SecuritySchemes = securitySchemes + PermittedSecuritySchemes = permittedSecuritySchemes + UsedMemberNames = usedMemberNames + } + + let serverBase = parseServerBase diagnostics root + let operations = planOperations operationPlanning root + let orderedDefinitions = orderDefinitions diagnostics definitions + + // Only the schemes some operation actually sends become credentials the caller must supply. + let credentials = + operations + |> List.collect _.Security + |> Set.ofList + |> Seq.map (fun schemeName -> + match Map.tryFind schemeName securitySchemes with + | Some (SecurityScheme.Representable (headerName, kind, schemeDescription)) -> + let credential = + { + SchemeName = schemeName + FSharpName = + allocateUniqueName usedMemberNames "SecurityScheme" sanitiseTypeName schemeName + HeaderName = headerName + Kind = kind + Description = schemeDescription + } + + schemeName, credential + | _ -> + // selectSecurityRequirement only ever returns representable schemes. + failwith $"Logic error: security scheme '%s{schemeName}' was selected but is not representable." + ) + |> Map.ofSeq + + let plan = + { + Namespace = className + InterfaceName = "I" + className + Description = description + CreateMock = createMock + ServerBase = serverBase + Types = orderedDefinitions + Operations = operations + Credentials = credentials + } + + if diagnostics.Count = 0 then + Ok plan + else + diagnostics |> Seq.toList |> Error + + let parseAndPlan + (parameters : Map) + (source : string) + : Result + = + try + match JsonNode.Parse source with + | :? JsonObject as root -> parseDocument parameters root + | _ -> + Error + [ + diagnostic InvalidDocument "#" "The OpenAPI document root must be a JSON object." + ] + with :? JsonException as ex -> + Error [ diagnostic InvalidJson "#" ex.Message ] + + let rec private renderType (plannedType : OpenApiPlannedType) : SynType = + match plannedType with + | OpenApiPlannedType.Primitive primitive -> + match primitive with + | OpenApiPrimitive.String -> SynType.string + | OpenApiPrimitive.Boolean -> SynType.bool + | OpenApiPrimitive.Int32 -> SynType.int + | OpenApiPrimitive.Int64 -> SynType.createLongIdent' [ "int64" ] + | OpenApiPrimitive.BigInteger -> SynType.createLongIdent' [ "System" ; "Numerics" ; "BigInteger" ] + | OpenApiPrimitive.Float32 -> SynType.createLongIdent' [ "float32" ] + | OpenApiPrimitive.Float -> SynType.createLongIdent' [ "float" ] + | OpenApiPrimitive.Decimal -> SynType.createLongIdent' [ "decimal" ] + | OpenApiPrimitive.Date -> SynType.createLongIdent' [ "System" ; "DateOnly" ] + | OpenApiPrimitive.DateTime -> SynType.createLongIdent' [ "System" ; "DateTimeOffset" ] + | OpenApiPrimitive.Guid -> SynType.createLongIdent' [ "System" ; "Guid" ] + | OpenApiPlannedType.Named name -> SynType.named name + | OpenApiPlannedType.List element -> renderType element |> SynType.list + | OpenApiPlannedType.Optional value -> renderType value |> SynType.option + | OpenApiPlannedType.JsonNode -> SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ] + | OpenApiPlannedType.Stream -> SynType.createLongIdent' [ "System" ; "IO" ; "Stream" ] + | OpenApiPlannedType.Unit -> SynType.unit + + let private renderRecord (definition : OpenApiPlannedTypeDefinition) : SynTypeDefn = + let fields = + [ + match definition.AdditionalProperties with + | None -> () + | Some additionalProperties -> + yield + { + Attrs = + [ + SynAttribute.create + (SynLongIdent.createS' + [ "System" ; "Text" ; "Json" ; "Serialization" ; "JsonExtensionData" ]) + (SynExpr.CreateConst ()) + ] + Ident = Some (Ident.create "AdditionalProperties") + Type = + SynType.app' + (SynType.createLongIdent' [ "System" ; "Collections" ; "Generic" ; "Dictionary" ]) + [ SynType.string ; renderType additionalProperties ] + } + |> SynField.make + + for field in definition.Fields do + yield + { + Attrs = + [ + SynAttribute.create + (SynLongIdent.createS' + [ "System" ; "Text" ; "Json" ; "Serialization" ; "JsonPropertyName" ]) + (SynExpr.CreateConst field.JsonName) + ] + Ident = Some (Ident.create field.FSharpName) + Type = renderType field.Type + } + |> SynField.make + ] + + let fields = + if fields.IsEmpty then + [ + { + Attrs = [] + Ident = Some (Ident.create "_SchemaUnspecified") + Type = SynType.obj + } + |> SynField.make + ] + else + fields + + let componentInfo = + SynComponentInfo.create (Ident.create definition.FSharpName) + |> SynComponentInfo.withDocString ( + definition.Description + |> Option.defaultValue $"Generated representation of the '%s{definition.SourceName}' OpenAPI schema." + |> PreXmlDoc.create + ) + |> SynComponentInfo.addAttributes + [ + SynAttribute.create + (SynLongIdent.createS' [ "WoofWare" ; "Myriad" ; "Plugins" ; "JsonParse" ]) + (SynExpr.CreateConst true) + + SynAttribute.create + (SynLongIdent.createS' [ "WoofWare" ; "Myriad" ; "Plugins" ; "JsonSerialize" ]) + (SynExpr.CreateConst true) + ] + + fields |> SynTypeDefnRepr.record |> SynTypeDefn.create componentInfo + + /// The documentation of the property through which the caller supplies one credential. It has to + /// say exactly what string the client will send, because we send it verbatim. + let private credentialDoc (credential : OpenApiPlannedCredential) : string list = + [ + match credential.Kind with + | OpenApiSecuritySchemeKind.ApiKey -> + yield + $"The value of the '%s{credential.HeaderName}' header, which carries the API key of the '%s{credential.SchemeName}' security scheme." + | OpenApiSecuritySchemeKind.Http scheme -> + yield + $"The complete value of the '%s{credential.HeaderName}' header for the '%s{credential.SchemeName}' security scheme, which is HTTP authentication scheme '%s{scheme}'." + + yield $"The value must include the scheme name: for example, \"%s{scheme} <credentials>\"." + | OpenApiSecuritySchemeKind.OAuth2 + | OpenApiSecuritySchemeKind.OpenIdConnect -> + let kind = + match credential.Kind with + | OpenApiSecuritySchemeKind.OpenIdConnect -> "OpenID Connect" + | _ -> "OAuth 2.0" + + yield + $"The complete value of the '%s{credential.HeaderName}' header for the '%s{credential.SchemeName}' security scheme, which is %s{kind}." + + yield + "This client runs no token flow of its own: it sends exactly the value you return, so you must acquire and refresh the token yourself (the value is usually \"Bearer <access token>\")." + + yield + "This function is called afresh on every request which requires this scheme, so it can return a token that has since been refreshed." + + match credential.Description with + | None -> () + | Some description -> yield description + ] + + let private renderCredential (credential : OpenApiPlannedCredential) : SynMemberDefn = + SynType.string + |> SynMemberDefn.abstractMember + [] + (SynIdent.createS credential.FSharpName) + None + SynValInfo.empty + // PreXmlDoc.create' emits each line verbatim, where PreXmlDoc.create inserts the space + // after the slashes for you. + (credentialDoc credential + |> List.map (fun line -> " " + line) + |> PreXmlDoc.create') + + let private renderOperation + (credentials : Map) + (operation : OpenApiPlannedOperation) + : SynMemberDefn + = + let cancellationToken = + SynType.signatureParamOfType + [] + (SynType.createLongIdent' [ "System" ; "Threading" ; "CancellationToken" ]) + true + (Some (Ident.create "ct")) + + let parameterType (parameter : OpenApiPlannedParameter) = + let attributes = + match parameter.Location with + | OpenApiParameterLocation.Path -> + [ + SynAttribute.create + (SynLongIdent.createS' [ "RestEase" ; "Path" ]) + (SynExpr.CreateConst parameter.WireName) + ] + | OpenApiParameterLocation.Query -> + [ + SynAttribute.create + (SynLongIdent.createS' [ "RestEase" ; "Query" ]) + (SynExpr.CreateConst parameter.WireName) + ] + | OpenApiParameterLocation.Body -> + [ + SynAttribute.create (SynLongIdent.createS' [ "RestEase" ; "Body" ]) (SynExpr.CreateConst ()) + ] + + SynType.signatureParamOfType + attributes + (renderType parameter.Type) + false + (Some (Ident.create parameter.FSharpName)) + + let domain = + operation.Parameters + |> List.map parameterType + |> fun parameters -> parameters @ [ cancellationToken ] + |> SynType.tupleNoParen + |> Option.get + + let arity = + SynValInfo.SynValInfo ( + [ + [ + for parameter in operation.Parameters do + yield SynArgInfo.SynArgInfo ([], false, Some (Ident.create parameter.FSharpName)) + + yield SynArgInfo.SynArgInfo ([], true, Some (Ident.create "ct")) + ] + ], + SynArgInfo.SynArgInfo ([], false, None) + ) + + let attributes = + [ + yield + SynAttribute.create + (SynLongIdent.createS' [ "RestEase" ; operation.Method.ToString () ]) + (SynExpr.CreateConst (operation.Path.TrimStart '/')) + + match operation.Accept with + | None -> () + | Some mediaType -> + yield + SynAttribute.create + (SynLongIdent.createS' [ "RestEase" ; "Header" ]) + (SynExpr.tuple [ SynExpr.CreateConst "Accept" ; SynExpr.CreateConst mediaType ]) + + match operation.RequestContentType with + | None -> () + | Some mediaType -> + yield + SynAttribute.create + (SynLongIdent.createS' [ "RestEase" ; "Header" ]) + (SynExpr.tuple [ SynExpr.CreateConst "Content-Type" ; SynExpr.CreateConst mediaType ]) + + // The property is named by a literal rather than the `nameof` the attribute also + // accepts: the only spelling F# accepts for a non-static member is the unbroken chain + // `nameof Unchecked.defaultof.Prop`, which Fantomas cannot print from an AST + // whose ranges are synthetic. Both sides of this correspondence are generated from the + // same string anyway, so there is nothing here for `nameof` to catch. + for schemeName in operation.Security do + let credential = credentials.[schemeName] + + yield + SynAttribute.create + (SynLongIdent.createS' [ "WoofWare" ; "Myriad" ; "Plugins" ; "HeaderFromProperty" ]) + (SynExpr.tuple + [ + SynExpr.CreateConst credential.HeaderName + SynExpr.CreateConst credential.FSharpName + ]) + ] + + renderType operation.ReturnType + |> SynType.task + |> SynType.toFun [ domain ] + |> SynMemberDefn.abstractMember + attributes + (SynIdent.createS operation.FSharpName) + None + arity + (operation.Description + |> Option.defaultValue $"Invoke the '%s{operation.OperationId}' OpenAPI operation." + |> PreXmlDoc.create) + + let private renderPlan (plan : OpenApiClientPlan) : Output = + let typeDeclarations = + plan.Types |> List.map renderRecord |> SynModuleDecl.createTypes + + let interfaceType = + // Credential properties come first, so that the generated `make` takes them before its + // HttpClient and in an order that doesn't shift when operations are added. + (plan.Credentials |> Map.toList |> List.map (snd >> renderCredential)) + @ (plan.Operations |> List.map (renderOperation plan.Credentials)) + |> SynTypeDefnRepr.interfaceType + |> SynTypeDefn.create ( + let attributes = + [ + yield + SynAttribute.create + (SynLongIdent.createS' [ "WoofWare" ; "Myriad" ; "Plugins" ; "HttpClient" ]) + (SynExpr.CreateConst false) + + match plan.ServerBase with + | OpenApiServerBase.BaseAddress address -> + yield + SynAttribute.create + (SynLongIdent.createS' [ "RestEase" ; "BaseAddress" ]) + (SynExpr.CreateConst address) + | OpenApiServerBase.BasePath path -> + yield + SynAttribute.create + (SynLongIdent.createS' [ "RestEase" ; "BasePath" ]) + (SynExpr.CreateConst path) + + match plan.CreateMock with + | None -> () + | Some isInternal -> + yield + SynAttribute.create + (SynLongIdent.createS' [ "WoofWare" ; "Myriad" ; "Plugins" ; "GenerateMock" ]) + (SynExpr.CreateConst isInternal) + ] + + SynComponentInfo.create (Ident.create plan.InterfaceName) + |> SynComponentInfo.withDocString ( + plan.Description + |> Option.defaultValue "HTTP client generated from an OpenAPI 3.0 document." + |> PreXmlDoc.create + ) + |> SynComponentInfo.addAttributes attributes + ) + + [ + SynModuleDecl.Open ( + SynOpenDeclTarget.ModuleOrNamespace ( + SynLongIdent.createS' [ "WoofWare" ; "Myriad" ; "Plugins" ], + range0 + ), + range0 + ) + typeDeclarations + SynModuleDecl.createTypes [ interfaceType ] + ] + |> SynModuleOrNamespace.createNamespace [ Ident.create plan.Namespace ] + |> List.singleton + |> Output.Ast + + let generate (parameters : Map) (source : string) : Output = + match parseAndPlan parameters source with + | Ok plan -> renderPlan plan + | Error diagnostics -> + diagnostics + |> List.map (fun value -> $"[%O{value.Code}] %s{value.Location}: %s{value.Message}") + |> String.concat Environment.NewLine + |> failwith diff --git a/WoofWare.Myriad.Plugins/SwaggerClientGenerator.fs b/WoofWare.Myriad.Plugins/SwaggerClientGenerator.fs index 1bc23797..aeac7030 100644 --- a/WoofWare.Myriad.Plugins/SwaggerClientGenerator.fs +++ b/WoofWare.Myriad.Plugins/SwaggerClientGenerator.fs @@ -753,6 +753,7 @@ module internal SwaggerClientGenerator = open Myriad.Core open System.IO +open System.Text.Json.Nodes [] module internal SwaggerV2Generator = @@ -1022,8 +1023,18 @@ type SwaggerClientGenerator () = if pars.IsEmpty then failwith "No parameters given. You must supply the parameter in ." - let contents = File.ReadAllText context.InputFilename |> SwaggerV2.parse - - match contents with - | Ok contents -> SwaggerV2Generator.generate pars contents - | Error node -> failwith "Input was not a Swagger 2 spec" + let source = File.ReadAllText context.InputFilename + + let root = + try + JsonNode.Parse source + with :? System.Text.Json.JsonException as ex -> + failwith $"[InvalidJson] #: %s{ex.Message}" + + match root with + | :? JsonObject as root when root.ContainsKey "swagger" -> + match SwaggerV2.parse source with + | Ok contents -> SwaggerV2Generator.generate pars contents + | Error _ -> failwith "Input was not a Swagger 2 spec" + | :? JsonObject as root when root.ContainsKey "openapi" -> OpenApiClientGenerator.generate pars source + | _ -> failwith "Input was neither a Swagger 2 nor an OpenAPI 3 spec" diff --git a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj index 7fd88747..5e3e7917 100644 --- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj +++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj @@ -48,7 +48,7 @@ - +