diff --git a/src/Funogram.Tests/UnionDiscriminators.fs b/src/Funogram.Tests/UnionDiscriminators.fs index c740043..b2bc011 100644 --- a/src/Funogram.Tests/UnionDiscriminators.fs +++ b/src/Funogram.Tests/UnionDiscriminators.fs @@ -1,5 +1,8 @@ module Funogram.Tests.UnionDiscriminators +open System.Text +open System.Text.Json +open Funogram open Funogram.Telegram.Types open Xunit open Helpers @@ -81,4 +84,16 @@ let ``MessageOrigin deserializes to the case matching the type value`` (json: st | MessageOrigin.Chat _ -> "Chat" | MessageOrigin.Channel _ -> "Channel" Assert.Equal(expectedCase, actual) - | Error e -> failwith e.Description \ No newline at end of file + | Error e -> failwith e.Description + +[] +let ``Strict RichBlock throws on a gibberish discriminator instead of guessing a case`` () = + let json = """{"type":"foo","text":"x"}""" + let bytes = Encoding.UTF8.GetBytes json + Assert.Throws(fun () -> JsonSerializer.Deserialize(bytes, Tools.strictOptions) |> ignore) |> ignore + Assert.NotNull(box (JsonSerializer.Deserialize(bytes, Tools.options))) + +[] +let ``Strict RichBlock throws when a known discriminator is missing a required field`` () = + let bytes = Encoding.UTF8.GetBytes """{"type":"paragraph"}""" + Assert.Throws(fun () -> JsonSerializer.Deserialize(bytes, Tools.strictOptions) |> ignore) |> ignore \ No newline at end of file diff --git a/src/Funogram/Converters.fs b/src/Funogram/Converters.fs index d65b496..ec5d24d 100644 --- a/src/Funogram/Converters.fs +++ b/src/Funogram/Converters.fs @@ -10,6 +10,7 @@ open System.Runtime.CompilerServices open System.Text.Json open System.Text.Json.Serialization open Funogram.Types +open Microsoft.FSharp.Reflection open TypeShape.Core open TypeShape.Core.SubtypeExtensions @@ -98,7 +99,7 @@ module internal Converters = t.IsArray || (t.IsGenericType && t.GetGenericTypeDefinition() = fsharpListTypeDef) - type DiscriminatedUnionConverter<'a>() = + type DiscriminatedUnionConverter<'a>(strict: bool) = inherit JsonConverter<'a>() let shape = shapeof<'a> @@ -127,6 +128,19 @@ module internal Converters = |> CaseDescriptor.Object) |> Seq.toArray + // "required" = reference-typed, non-option property (Nullable<_> is a value type, excluded by IsValueType) + let requiredProps = + union.UnionCases + |> Seq.map (fun c -> + let tp = if c.Fields.Length = 0 then typeof else c.Fields[0].Member.Type + if c.Fields.Length = 0 || tp.IsPrimitive || tp = typeof || isArrayLike tp then [||] + else + tp.GetProperties() + |> Array.filter (fun p -> + not p.PropertyType.IsValueType + && not (p.PropertyType.IsGenericType && p.PropertyType.GetGenericTypeDefinition() = typedefof<_ option>))) + |> Seq.toArray + let alwaysFields = cases |> Seq.collect (fun x -> @@ -181,6 +195,9 @@ module internal Converters = match exact with | Some _ -> exact + | None when strict && not requiredFields.IsEmpty -> + let discriminator = requiredFields |> Set.toList |> List.map (fun (n, v) -> $"{n}={v}") |> String.concat ", " + raise (JsonException($"Unable to match JSON to any case of union {typeof<'a>.Name}: no case declares discriminator {discriminator}")) | None -> let scored = cases @@ -259,7 +276,13 @@ module internal Converters = match idx with | Some i -> - deserializers[i].Deserialize(&reader, options) + let result = deserializers[i].Deserialize(&reader, options) + if strict && requiredProps[i].Length > 0 then + let caseInfo, fields = FSharpValue.GetUnionFields(box result, typeof<'a>) + for p in requiredProps[i] do + if isNull (p.GetValue(fields[0])) then + raise (JsonException($"Missing required field '{p.Name}' for {typeof<'a>.Name} case {caseName caseInfo}")) + result | None -> raise (JsonException($"Unable to match JSON to any case of union {typeof<'a>.Name}")) @@ -269,12 +292,14 @@ module internal Converters = | Shape.FSharpUnion _ -> true | _ -> false - type DiscriminatedUnionConverterFactory() = + type DiscriminatedUnionConverterFactory(?strict: bool) = inherit JsonConverterFactory() + let strict = defaultArg strict false + override x.CreateConverter(typeToConvert, _) = let g = typedefof>.MakeGenericType(typeToConvert) - Activator.CreateInstance(g) :?> JsonConverter + Activator.CreateInstance(g, [| box strict |]) :?> JsonConverter override x.CanConvert(typeToConvert) = match TypeShape.Create(typeToConvert) with diff --git a/src/Funogram/Tools.fs b/src/Funogram/Tools.fs index a6cd95d..34aa8b2 100644 --- a/src/Funogram/Tools.fs +++ b/src/Funogram/Tools.fs @@ -76,23 +76,28 @@ module internal RequestLogger = logger.Text.Append("Res: ").Append(e.ToString()) |> ignore logger.Logger.Log(logger.Text.ToString()) -/// Shared JSON serializer settings used by Funogram for request and response payloads. -/// -/// Reuse this instance when serializing or deserializing Funogram types so external code -/// stays aligned with the library's snake_case wire format, union handling, Unix timestamps, -/// and null-skipping behavior. -let options = +let private mkOptions (strict: bool) = let o = JsonSerializerOptions( WriteIndented = false, PropertyNamingPolicy = JsonNamingPolicy.SnakeCaseLower, DefaultIgnoreCondition = JsonIgnoreCondition.WhenWritingNull ) - o.Converters.Add(DiscriminatedUnionConverterFactory()) + o.Converters.Add(DiscriminatedUnionConverterFactory(strict)) o.Converters.Add(UnixTimestampDateTimeConverter()) o.Converters.Add(OptionConverterFactory()) o +/// Shared JSON serializer settings used by Funogram for request and response payloads. +/// +/// Reuse this instance when serializing or deserializing Funogram types so external code +/// stays aligned with the library's snake_case wire format, union handling, Unix timestamps, +/// and null-skipping behavior. +let options = mkOptions false + +/// Like `options`, but an unmatched union discriminator or a missing required field raises JsonException instead of guessing a case. +let strictOptions = mkOptions true + let private getUrl (config: BotConfig) methodName = let botToken = sprintf "%s%s" (config.ApiEndpointUrl |> string) config.Token