Map/dictionary support, and check for null when passing to ofJson (#68)

This commit is contained in:
Patrick Stevens
2024-01-25 19:56:44 +00:00
committed by GitHub
parent 268a2f6f52
commit 515ea306a2
9 changed files with 1069 additions and 17 deletions

View File

@@ -31,9 +31,10 @@
<Compile Include="GeneratedMock.fs"> <Compile Include="GeneratedMock.fs">
<MyriadFile>MockExample.fs</MyriadFile> <MyriadFile>MockExample.fs</MyriadFile>
</Compile> </Compile>
<None Include="..\runmyriad.sh"> <Compile Include="Vault.fs" />
<Link>runmyriad.sh</Link> <Compile Include="GeneratedVault.fs">
</None> <MyriadFile>Vault.fs</MyriadFile>
</Compile>
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

View File

@@ -61,7 +61,17 @@ module JsonRecordType =
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ()) |> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> Array.ofSeq |> Array.ofSeq
let D = InnerType.jsonParse node.["d"] let D =
InnerType.jsonParse (
match node.["d"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("d")
)
)
| v -> v
)
let C = let C =
(match node.["hi"] with (match node.["hi"] with

View File

@@ -254,9 +254,41 @@ module Gym =
.AsValue() .AsValue()
.GetValue<string> () .GetValue<string> ()
let Location = GymLocation.jsonParse node.["location"] let Location =
let AccessOptions = GymAccessOptions.jsonParse node.["accessOptions"] GymLocation.jsonParse (
let GymOpeningHours = GymOpeningHours.jsonParse node.["gymOpeningHours"] match node.["location"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("location")
)
)
| v -> v
)
let AccessOptions =
GymAccessOptions.jsonParse (
match node.["accessOptions"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("accessOptions")
)
)
| v -> v
)
let GymOpeningHours =
GymOpeningHours.jsonParse (
match node.["gymOpeningHours"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("gymOpeningHours")
)
)
| v -> v
)
let EmailAddress = let EmailAddress =
(match node.["emailAddress"] with (match node.["emailAddress"] with
@@ -282,7 +314,17 @@ module Gym =
.AsValue() .AsValue()
.GetValue<string> () .GetValue<string> ()
let Address = GymAddress.jsonParse node.["address"] let Address =
GymAddress.jsonParse (
match node.["address"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("address")
)
)
| v -> v
)
let Status = let Status =
(match node.["status"] with (match node.["status"] with
@@ -857,7 +899,17 @@ namespace PureGym
module Visit = module Visit =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Visit = let jsonParse (node : System.Text.Json.Nodes.JsonNode) : Visit =
let Gym = VisitGym.jsonParse node.["Gym"] let Gym =
VisitGym.jsonParse (
match node.["Gym"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("Gym")
)
)
| v -> v
)
let Duration = let Duration =
(match node.["Duration"] with (match node.["Duration"] with
@@ -910,8 +962,29 @@ namespace PureGym
module SessionsSummary = module SessionsSummary =
/// Parse from a JSON node. /// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : SessionsSummary = let jsonParse (node : System.Text.Json.Nodes.JsonNode) : SessionsSummary =
let ThisWeek = SessionsAggregate.jsonParse node.["ThisWeek"] let ThisWeek =
let Total = SessionsAggregate.jsonParse node.["Total"] SessionsAggregate.jsonParse (
match node.["ThisWeek"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("ThisWeek")
)
)
| v -> v
)
let Total =
SessionsAggregate.jsonParse (
match node.["Total"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("Total")
)
)
| v -> v
)
{ {
Total = Total Total = Total
@@ -938,7 +1011,17 @@ module Sessions =
|> Seq.map (fun elt -> Visit.jsonParse elt) |> Seq.map (fun elt -> Visit.jsonParse elt)
|> List.ofSeq |> List.ofSeq
let Summary = SessionsSummary.jsonParse node.["Summary"] let Summary =
SessionsSummary.jsonParse (
match node.["Summary"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("Summary")
)
)
| v -> v
)
{ {
Summary = Summary Summary = Summary

View File

@@ -0,0 +1,549 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace ConsumePlugin
/// Module containing JSON parsing methods for the JwtVaultAuthResponse type
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module JwtVaultAuthResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultAuthResponse =
let NumUses =
(match node.["num_uses"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("num_uses")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let Orphan =
(match node.["orphan"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("orphan")
)
)
| v -> v)
.AsValue()
.GetValue<bool> ()
let EntityId =
(match node.["entity_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("entity_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let TokenType =
(match node.["token_type"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_type")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let Renewable =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<bool> ()
let LeaseDuration =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let IdentityPolicies =
(match node.["identity_policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("identity_policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let TokenPolicies =
(match node.["token_policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("token_policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let Policies =
(match node.["policies"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("policies")
)
)
| v -> v)
.AsArray ()
|> Seq.map (fun elt -> elt.AsValue().GetValue<string> ())
|> List.ofSeq
let Accessor =
(match node.["accessor"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("accessor")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let ClientToken =
(match node.["client_token"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("client_token")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
{
ClientToken = ClientToken
Accessor = Accessor
Policies = Policies
TokenPolicies = TokenPolicies
IdentityPolicies = IdentityPolicies
LeaseDuration = LeaseDuration
Renewable = Renewable
TokenType = TokenType
EntityId = EntityId
Orphan = Orphan
NumUses = NumUses
}
namespace ConsumePlugin
/// Module containing JSON parsing methods for the JwtVaultResponse type
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module JwtVaultResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtVaultResponse =
let Auth =
JwtVaultAuthResponse.jsonParse (
match node.["auth"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("auth")
)
)
| v -> v
)
let LeaseDuration =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let Renewable =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<bool> ()
let LeaseId =
(match node.["lease_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let RequestId =
(match node.["request_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
{
RequestId = RequestId
LeaseId = LeaseId
Renewable = Renewable
LeaseDuration = LeaseDuration
Auth = Auth
}
namespace ConsumePlugin
/// Module containing JSON parsing methods for the JwtSecretResponse type
[<RequireQualifiedAccess>]
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module JwtSecretResponse =
/// Parse from a JSON node.
let jsonParse (node : System.Text.Json.Nodes.JsonNode) : JwtSecretResponse =
let Data8 =
(match node.["data8"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data8")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> () |> System.Uri
key, value
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let Data7 =
(match node.["data7"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data7")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<int> ()
key, value
)
|> Map.ofSeq
let Data6 =
(match node.["data6"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data6")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> dict
let Data5 =
(match node.["data5"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data5")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key) |> System.Uri
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> readOnlyDict
let Data4 =
(match node.["data4"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data4")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> Map.ofSeq
let Data3 =
(match node.["data3"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data3")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> Seq.map System.Collections.Generic.KeyValuePair
|> System.Collections.Generic.Dictionary
let Data2 =
(match node.["data2"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data2")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> dict
let Data =
(match node.["data"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("data")
)
)
| v -> v)
.AsObject ()
|> Seq.map (fun kvp ->
let key = (kvp.Key)
let value = (kvp.Value).AsValue().GetValue<string> ()
key, value
)
|> readOnlyDict
let LeaseDuration =
(match node.["lease_duration"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_duration")
)
)
| v -> v)
.AsValue()
.GetValue<int> ()
let Renewable =
(match node.["renewable"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("renewable")
)
)
| v -> v)
.AsValue()
.GetValue<bool> ()
let LeaseId =
(match node.["lease_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("lease_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
let RequestId =
(match node.["request_id"] with
| null ->
raise (
System.Collections.Generic.KeyNotFoundException (
sprintf "Required key '%s' not found on JSON object" ("request_id")
)
)
| v -> v)
.AsValue()
.GetValue<string> ()
{
RequestId = RequestId
LeaseId = LeaseId
Renewable = Renewable
LeaseDuration = LeaseDuration
Data = Data
Data2 = Data2
Data3 = Data3
Data4 = Data4
Data5 = Data5
Data6 = Data6
Data7 = Data7
Data8 = Data8
}
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open RestEase
/// Module for constructing a REST client.
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<RequireQualifiedAccess>]
module VaultClient =
/// Create a REST client.
let make (client : System.Net.Http.HttpClient) : IVaultClient =
{ new IVaultClient with
member _.GetSecret
(
jwt : JwtVaultResponse,
path : string,
mountPoint : string,
ct : CancellationToken option
)
=
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri (
"v1/{mountPoint}/{path}"
.Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode)
.Replace (
"{mountPoint}",
mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode
),
System.UriKind.Relative
)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! node =
System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
|> Async.AwaitTask
return JwtSecretResponse.jsonParse node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
member _.GetJwt (role : string, jwt : string, ct : CancellationToken option) =
async {
let! ct = Async.CancellationToken
let uri =
System.Uri (
(match client.BaseAddress with
| null ->
raise (
System.ArgumentNullException (
nameof (client.BaseAddress),
"No base address was supplied on the type, and no BaseAddress was on the HttpClient."
)
)
| v -> v),
System.Uri ("v1/auth/jwt/login", System.UriKind.Relative)
)
let httpMessage =
new System.Net.Http.HttpRequestMessage (
Method = System.Net.Http.HttpMethod.Get,
RequestUri = uri
)
let! response = client.SendAsync (httpMessage, ct) |> Async.AwaitTask
let response = response.EnsureSuccessStatusCode ()
let! stream = response.Content.ReadAsStreamAsync ct |> Async.AwaitTask
let! node =
System.Text.Json.Nodes.JsonNode.ParseAsync (stream, cancellationToken = ct)
|> Async.AwaitTask
return JwtVaultResponse.jsonParse node
}
|> (fun a -> Async.StartAsTask (a, ?cancellationToken = ct))
}

78
ConsumePlugin/Vault.fs Normal file
View File

@@ -0,0 +1,78 @@
namespace ConsumePlugin
open System
open System.Collections.Generic
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open RestEase
[<WoofWare.Myriad.Plugins.JsonParse>]
type JwtVaultAuthResponse =
{
[<JsonPropertyName "client_token">]
ClientToken : string
Accessor : string
Policies : string list
[<JsonPropertyName "token_policies">]
TokenPolicies : string list
[<JsonPropertyName "identity_policies">]
IdentityPolicies : string list
[<JsonPropertyName "lease_duration">]
LeaseDuration : int
Renewable : bool
[<JsonPropertyName "token_type">]
TokenType : string
[<JsonPropertyName "entity_id">]
EntityId : string
Orphan : bool
[<JsonPropertyName "num_uses">]
NumUses : int
}
[<WoofWare.Myriad.Plugins.JsonParse>]
type JwtVaultResponse =
{
[<JsonPropertyName "request_id">]
RequestId : string
[<JsonPropertyName "lease_id">]
LeaseId : string
Renewable : bool
[<JsonPropertyName "lease_duration">]
LeaseDuration : int
Auth : JwtVaultAuthResponse
}
[<WoofWare.Myriad.Plugins.JsonParse>]
type JwtSecretResponse =
{
[<JsonPropertyName "request_id">]
RequestId : string
[<JsonPropertyName "lease_id">]
LeaseId : string
Renewable : bool
[<JsonPropertyName "lease_duration">]
LeaseDuration : int
Data : IReadOnlyDictionary<string, string>
// These ones aren't actually part of the Vault response, but are here for tests
Data2 : IDictionary<string, string>
Data3 : Dictionary<string, string>
Data4 : Map<string, string>
Data5 : IReadOnlyDictionary<System.Uri, string>
Data6 : IDictionary<Uri, string>
Data7 : Map<string, int>
Data8 : Dictionary<string, Uri>
}
[<WoofWare.Myriad.Plugins.HttpClient>]
type IVaultClient =
[<Get "v1/{mountPoint}/{path}">]
abstract GetSecret :
jwt : JwtVaultResponse *
[<Path "path">] path : string *
[<Path "mountPoint">] mountPoint : string *
?ct : CancellationToken ->
Task<JwtSecretResponse>
[<Get "v1/auth/jwt/login">]
abstract GetJwt : role : string * jwt : string * ?ct : CancellationToken -> Task<JwtVaultResponse>

View File

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

View File

@@ -18,6 +18,7 @@
<Compile Include="TestHttpClient\TestAllowAnyStatusCode.fs" /> <Compile Include="TestHttpClient\TestAllowAnyStatusCode.fs" />
<Compile Include="TestHttpClient\TestBasePath.fs" /> <Compile Include="TestHttpClient\TestBasePath.fs" />
<Compile Include="TestHttpClient\TestBodyParam.fs" /> <Compile Include="TestHttpClient\TestBodyParam.fs" />
<Compile Include="TestHttpClient\TestVaultClient.fs" />
<Compile Include="TestMockGenerator\TestMockGenerator.fs" /> <Compile Include="TestMockGenerator\TestMockGenerator.fs" />
<Compile Include="TestRemoveOptions.fs"/> <Compile Include="TestRemoveOptions.fs"/>
<Compile Include="TestSurface.fs"/> <Compile Include="TestSurface.fs"/>

View File

@@ -102,10 +102,35 @@ module internal AstHelper =
|| System.String.Equals (i.idText, "[]", System.StringComparison.Ordinal) || System.String.Equals (i.idText, "[]", System.StringComparison.Ordinal)
-> ->
true true
// TODO: consider FSharpList or whatever it is | _ -> false
| [ i ] ->
printfn $"Not array: %s{i.idText}" let isMapIdent (ident : SynLongIdent) : bool =
false match ident.LongIdent |> List.map _.idText with
| [ "Map" ] -> true
| _ -> false
let isReadOnlyDictionaryIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "IReadOnlyDictionary" ]
| [ "Generic" ; "IReadOnlyDictionary" ]
| [ "Collections" ; "Generic" ; "IReadOnlyDictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "IReadOnlyDictionary" ] -> true
| _ -> false
let isDictionaryIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "Dictionary" ]
| [ "Generic" ; "Dictionary" ]
| [ "Collections" ; "Generic" ; "Dictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "Dictionary" ] -> true
| _ -> false
let isIDictionaryIdent (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "IDictionary" ]
| [ "Generic" ; "IDictionary" ]
| [ "Collections" ; "Generic" ; "IDictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "IDictionary" ] -> true
| _ -> false | _ -> false
let rec private extractOpensFromDecl (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list = let rec private extractOpensFromDecl (moduleDecls : SynModuleDecl list) : SynOpenDeclTarget list =
@@ -337,6 +362,32 @@ module internal SynTypePatterns =
| SynType.Array (1, innerType, _) -> Some innerType | SynType.Array (1, innerType, _) -> Some innerType
| _ -> None | _ -> None
let (|DictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isDictionaryIdent ident ->
Some (key, value)
| _ -> None
let (|IDictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isIDictionaryIdent ident ->
Some (key, value)
| _ -> None
let (|IReadOnlyDictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when
AstHelper.isReadOnlyDictionaryIdent ident
->
Some (key, value)
| _ -> None
let (|MapType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when AstHelper.isMapIdent ident ->
Some (key, value)
| _ -> None
/// Returns the string name of the type. /// Returns the string name of the type.
let (|PrimitiveType|_|) (fieldType : SynType) = let (|PrimitiveType|_|) (fieldType : SynType) =
match fieldType with match fieldType with

View File

@@ -85,6 +85,14 @@ module internal JsonParseGenerator =
|> SynExpr.callMethod "AsValue" |> SynExpr.callMethod "AsValue"
|> SynExpr.callGenericMethod "GetValue" typeName |> SynExpr.callGenericMethod "GetValue" typeName
/// {node}.AsObject()
/// If `propertyName` is Some, uses `assertNotNull {node}` instead of `{node}`.
let asObject (propertyName : SynExpr option) (node : SynExpr) : SynExpr =
match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
|> SynExpr.callMethod "AsObject"
/// {type}.jsonParse {node} /// {type}.jsonParse {node}
let typeJsonParse (typeName : LongIdent) (node : SynExpr) : SynExpr = let typeJsonParse (typeName : LongIdent) (node : SynExpr) : SynExpr =
SynExpr.CreateApp ( SynExpr.CreateApp (
@@ -133,6 +141,54 @@ module internal JsonParseGenerator =
let parseFunction (typeName : string) : LongIdent = let parseFunction (typeName : string) : LongIdent =
List.append (SynExpr.qualifyPrimitiveType typeName) [ Ident.Create "Parse" ] List.append (SynExpr.qualifyPrimitiveType typeName) [ Ident.Create "Parse" ]
/// fun kvp -> let key = {key(kvp)} in let value = {value(kvp)} in (key, value))
/// The inputs will be fed with appropriate SynExprs to apply them to the `kvp.Key` and `kvp.Value` args.
let dictionaryMapper (key : SynExpr -> SynExpr) (value : SynExpr -> SynExpr) : SynExpr =
let keyArg =
SynExpr.CreateLongIdent (SynLongIdent.Create [ "kvp" ; "Key" ])
|> SynExpr.CreateParen
let valueArg =
SynExpr.CreateLongIdent (SynLongIdent.Create [ "kvp" ; "Value" ])
|> SynExpr.CreateParen
SynExpr.LetOrUse (
false,
false,
[
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "key"), expr = key keyArg)
],
SynExpr.LetOrUse (
false,
false,
[
SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create "value"), expr = value valueArg)
],
SynExpr.CreateTuple [ SynExpr.CreateIdentString "key" ; SynExpr.CreateIdentString "value" ],
range0,
{
InKeyword = None
}
),
range0,
{
InKeyword = None
}
)
|> SynExpr.createLambda "kvp"
/// A conforming JSON object has only strings as keys. But it would be reasonable to allow the user
/// to parse these as URIs, for example.
let parseKeyString (desiredType : SynType) (key : SynExpr) : SynExpr =
match desiredType with
| String -> key
| Uri ->
key
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Uri" ]))
| _ ->
failwithf
$"Unable to parse the key type %+A{desiredType} of a JSON object. Keys are strings, and this plugin does not know how to convert to that from a string."
/// Given `node.["town"]`, for example, choose how to obtain a JSON value from it. /// Given `node.["town"]`, for example, choose how to obtain a JSON value from it.
/// The property name is used in error messages at runtime to show where a JSON /// The property name is used in error messages at runtime to show where a JSON
/// parse error occurred; supply `None` to indicate "don't validate". /// parse error occurred; supply `None` to indicate "don't validate".
@@ -217,6 +273,56 @@ module internal JsonParseGenerator =
| ArrayType ty -> | ArrayType ty ->
parseNode None options ty (SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt")) parseNode None options ty (SynExpr.CreateLongIdent (SynLongIdent.CreateString "elt"))
|> asArrayMapped propertyName "Array" node |> asArrayMapped propertyName "Array" node
| IDictionaryType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
)
)
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "dict" ]))
| DictionaryType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
)
)
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
SynExpr.CreateLongIdent (
SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "KeyValuePair" ]
)
)
)
|> SynExpr.pipeThroughFunction (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "System" ; "Collections" ; "Generic" ; "Dictionary" ])
)
| IReadOnlyDictionaryType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
)
)
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "readOnlyDict" ]))
| MapType (keyType, valueType) ->
node
|> asObject propertyName
|> SynExpr.pipeThroughFunction (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Seq" ; "map" ]),
dictionaryMapper (parseKeyString keyType) (parseNode None options valueType)
)
)
|> SynExpr.pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Map" ; "ofSeq" ]))
| _ -> | _ ->
// Let's just hope that we've also got our own type annotation! // Let's just hope that we've also got our own type annotation!
let typeName = let typeName =
@@ -224,7 +330,10 @@ module internal JsonParseGenerator =
| SynType.LongIdent ident -> ident.LongIdent | SynType.LongIdent ident -> ident.LongIdent
| _ -> failwith $"Unrecognised type: %+A{fieldType}" | _ -> failwith $"Unrecognised type: %+A{fieldType}"
typeJsonParse typeName node match propertyName with
| None -> node
| Some propertyName -> assertNotNull propertyName node
|> typeJsonParse typeName
/// propertyName is probably a string literal, but it could be a [<Literal>] variable /// propertyName is probably a string literal, but it could be a [<Literal>] variable
/// The result of this function is the body of a let-binding (not including the LHS of that let-binding). /// The result of this function is the body of a let-binding (not including the LHS of that let-binding).