From 49e4dba05bd0a0e8575cf76121d1180ee16b10b9 Mon Sep 17 00:00:00 2001 From: William Blum Date: Thu, 11 Aug 2016 16:08:11 -0700 Subject: [PATCH 1/3] Fix bug #3 and add corresponding test case --- FSharpLu.Json/Compact.fs | 46 +++++++++++++++++++++++++++++++------ FSharpLu.Tests/JsonTests.fs | 8 ++++++- 2 files changed, 46 insertions(+), 8 deletions(-) diff --git a/FSharpLu.Json/Compact.fs b/FSharpLu.Json/Compact.fs index c521769..1320a67 100644 --- a/FSharpLu.Json/Compact.fs +++ b/FSharpLu.Json/Compact.fs @@ -89,7 +89,7 @@ type CompactUnionJsonConverter() = // Json that is not null maps to `Some _` else let nestedType = objectType.GetGenericArguments().[0] - let parseBox (jToken:Linq.JToken) = + let parseBoxedOption (jToken:Linq.JToken) = if jToken.Type <> Linq.JTokenType.Object then failwith "Nested option types must be serialized as boxed Json objects" @@ -107,16 +107,46 @@ type CompactUnionJsonConverter() = // => we just deserialize the nested object recursively unboxedValue.ToObject(nestedType, serializer) + let parseBoxedNonOptionObject (jToken:Linq.JToken) = + if jToken.Type <> Linq.JTokenType.Object then + failwith "Nested option types must be serialized as boxed Json objects" + + let jObject = jToken :?> Linq.JObject + match jObject.TryGetValue("Some") with + | false, _ -> + // 'Some' field absent from Json: this must be a nested discriminated union object. + // Not need to unbox: we just deserialize the Json object as is. + jObject.ToObject(nestedType, serializer) + | true, unboxedValue -> + if unboxedValue.Type = Linq.JTokenType.Null then + // Case of Json { "Some" : null } for type option<'a> where 'a is nullable + // => deserialized to `Some null` + null + else + // Case of Json { "Some" : } where is not null + // => we just deserialize the nested object recursively + // + // NOTE: there is a possible ambuiguity here: we assume that the 'Some' field + // from the Json blob corresponds to the Option type being deserialized. However, it + // could just by a coincidence where 'Some' is also the name of a field in a nested + // discriminated union. (type X = { Some : string } and Y = Y option) + // If this is the case the deserialization fails. + unboxedValue.ToObject(nestedType, serializer) + let nestedValue = // Is the nested type an option type itself? - // or is the Json to be deserialized an object Json? - if isOptionType nestedType || jToken.Type = Linq.JTokenType.Object then + // or is the Json to be deserialized is an object Json? + if isOptionType nestedType then // Nested option type are always boxed in Json to prevent any ambguity - parseBox jToken + parseBoxedOption jToken + else if jToken.Type = Linq.JTokenType.Object then + parseBoxedNonOptionObject jToken else - // type is option<'a> where 'a is not an option type + // type is option<'a> where 'a is not an option type and not a + // type that would be serialized as a Json object. i.e. 'a is a base Json type (e.g. integer or string) // => we can deserialize the object of type 'a directly without unboxing jToken.ToObject(nestedType, serializer) + FSharpValue.MakeUnion(caseSome, [| nestedValue |]) // Discriminated union @@ -162,7 +192,7 @@ type CompactUnionJsonConverter() = match matchingCase with | None -> - failwithf "Case %s with fields does not exist for discriminated union %s" caseProperty.Name objectType.Name + failwithf "Case with fields '%s' does not exist for discriminated union %s" caseProperty.Name objectType.Name // Type 2: A union case with a single field: Case2 of 'a | Some case when case.GetFields().Length = 1 -> @@ -192,7 +222,9 @@ module Compact = /// Serialization settings for our compact Json converter type Settings = static member settings = - let s = JsonSerializerSettings(NullValueHandling = NullValueHandling.Ignore) + let s = JsonSerializerSettings( NullValueHandling = NullValueHandling.Ignore, + // Strict deserialization is required to avoid certain ambiguities + MissingMemberHandling = MissingMemberHandling.Error) s.Converters.Add(CompactUnionJsonConverter()) s diff --git a/FSharpLu.Tests/JsonTests.fs b/FSharpLu.Tests/JsonTests.fs index 869d2ca..b51af52 100644 --- a/FSharpLu.Tests/JsonTests.fs +++ b/FSharpLu.Tests/JsonTests.fs @@ -19,6 +19,9 @@ type 'a NestedOptions = 'a option option option option type 'a Ambiguous = { Some : 'a } +type NestedStructure = { subField : int } +type NestedOptionStructure = { field : NestedStructure option } + let inline serialize< ^T> (x: ^T) = Compact.serialize< ^T> x let inline deserialize< ^T> x : ^T = Compact.deserialize< ^T> x @@ -84,6 +87,8 @@ type Reciprocality () = static member x19 = reciprocal static member x20 = reciprocal> static member x21 = reciprocal> + static member x22 = reciprocal + type CoincidesWithJsonNetOnDeserialization () = static member x1 = coincidesWithDefault @@ -107,6 +112,7 @@ type CoincidesWithJsonNetOnDeserialization () = static member x19 = coincidesWithDefault static member x20 = coincidesWithDefault> static member x21 = coincidesWithDefault> + static member x22 = coincidesWithDefault type BackwardCompatibility () = static member x1 = backwardCompatibleWithDefault @@ -130,7 +136,7 @@ type BackwardCompatibility () = static member x19 = backwardCompatibleWithDefault static member x20 = backwardCompatibleWithDefault> static member x21 = backwardCompatibleWithDefault> - + static member x22 = backwardCompatibleWithDefault [] type JsonSerializerTests() = From 00f57031e3313f12bc2dde41189dd2a7e8082ee8 Mon Sep 17 00:00:00 2001 From: William Blum Date: Mon, 15 Aug 2016 23:12:21 -0700 Subject: [PATCH 2/3] More unit test to cover ambiguity with fields named 'Some' --- FSharpLu.Tests/JsonTests.fs | 53 ++++++++++++++++++++++++++----------- 1 file changed, 38 insertions(+), 15 deletions(-) diff --git a/FSharpLu.Tests/JsonTests.fs b/FSharpLu.Tests/JsonTests.fs index b51af52..5e7d3c8 100644 --- a/FSharpLu.Tests/JsonTests.fs +++ b/FSharpLu.Tests/JsonTests.fs @@ -17,11 +17,19 @@ type 'a Test = Case1 | Case2 of int | Case3 of int * string * 'a type MapType = Map type 'a NestedOptions = 'a option option option option -type 'a Ambiguous = { Some : 'a } - type NestedStructure = { subField : int } type NestedOptionStructure = { field : NestedStructure option } +/// Test cases for possible ambiguity between option types and other DU or records with a 'Some' field. +module SomeAmbiguity = + type 'a RecordWithFieldNamedSome = { Some : 'a } + type DUWithFieldlessCaseNamedSome = Some of string | Bla + type DUWithCaseWithFieldNamedSome = Some | Bla + type 'a Ambiguous1 = 'a RecordWithFieldNamedSome option + type Ambiguous2 = DUWithFieldlessCaseNamedSome option + type Ambiguous3 = DUWithCaseWithFieldNamedSome option + + let inline serialize< ^T> (x: ^T) = Compact.serialize< ^T> x let inline deserialize< ^T> x : ^T = Compact.deserialize< ^T> x @@ -32,11 +40,16 @@ let inline reciprocal< ^T when ^T:equality> (x: ^T) = x |> serialize |> deserialize |> serialize |> deserialize = x let inline areReciprocal< ^T when ^T:equality> (x: ^T) = - Assert.IsTrue(reciprocal< ^T> x) + let s = x |> serialize< ^T> + let sds = s |> deserialize< ^T> |> serialize< ^T> + Assert.AreEqual(s, sds, sprintf "Inconsistent serialization: 1st call: <%s> 2nd call <%s>" s sds) + let sdsd = sds |> deserialize< ^T> + Assert.AreEqual(sdsd, x, sprintf "Did not get the same object back: <%A> gave <%A>" x sdsd) /// Check that given object serializes to the specified Json string let inline serializedAs json o = - Assert.AreEqual(json, serialize o) + let s = serialize o + Assert.AreEqual(json, s, sprintf "Object was not serialized to the expected format") /// Check that deserialization coincides with NewtonSoft's default serializer. /// That is: when the Json is deserializable by both deserializers Union and Default @@ -85,9 +98,11 @@ type Reciprocality () = static member x17 = reciprocal static member x18 = reciprocal static member x19 = reciprocal - static member x20 = reciprocal> - static member x21 = reciprocal> + static member x20 = reciprocal> + static member x21 = reciprocal> static member x22 = reciprocal + static member x23 = reciprocal + static member x24 = reciprocal type CoincidesWithJsonNetOnDeserialization () = @@ -110,9 +125,11 @@ type CoincidesWithJsonNetOnDeserialization () = static member x17 = coincidesWithDefault static member x18 = coincidesWithDefault static member x19 = coincidesWithDefault - static member x20 = coincidesWithDefault> - static member x21 = coincidesWithDefault> + static member x20 = coincidesWithDefault> + static member x21 = coincidesWithDefault> static member x22 = coincidesWithDefault + static member x23 = coincidesWithDefault + static member x24 = coincidesWithDefault type BackwardCompatibility () = static member x1 = backwardCompatibleWithDefault @@ -134,15 +151,17 @@ type BackwardCompatibility () = static member x17 = backwardCompatibleWithDefault static member x18 = backwardCompatibleWithDefault static member x19 = backwardCompatibleWithDefault - static member x20 = backwardCompatibleWithDefault> - static member x21 = backwardCompatibleWithDefault> + static member x20 = backwardCompatibleWithDefault> + static member x21 = backwardCompatibleWithDefault> static member x22 = backwardCompatibleWithDefault + static member x23 = backwardCompatibleWithDefault + static member x24 = backwardCompatibleWithDefault [] type JsonSerializerTests() = [] - static member init(context : TestContext) = () + static member Init(context : TestContext) = () [] [] @@ -223,10 +242,14 @@ type JsonSerializerTests() = [] member this.``No ambiguity between records and Option type``() = areReciprocal <| Some (Some (Some None)) - areReciprocal <| { Some = null } - areReciprocal <| { Some = SimpleDu.Foo } - areReciprocal <| { Some = "test" } - areReciprocal <| { Some = 123 } + areReciprocal <| { SomeAmbiguity.Some = null } + areReciprocal <| { SomeAmbiguity.Some = SimpleDu.Foo } + areReciprocal <| { SomeAmbiguity.Some = "test" } + areReciprocal <| { SomeAmbiguity.Some = 123 } + areReciprocal <| (Option.Some { SomeAmbiguity.Some = 345 }) + areReciprocal <| (Option.Some <| SomeAmbiguity.DUWithFieldlessCaseNamedSome.Some "ambiguous") + areReciprocal <| (Option.Some { SomeAmbiguity.RecordWithFieldNamedSome.Some = 8 }) + areReciprocal <| (Option.Some <| SomeAmbiguity.DUWithCaseWithFieldNamedSome.Some) [] [] From 187e9d1260a7f555a89ee7bd0e71ba8c240aeced Mon Sep 17 00:00:00 2001 From: William Blum Date: Mon, 15 Aug 2016 23:50:10 -0700 Subject: [PATCH 3/3] Force boxing for type `Option<'a>` if the structure of type `'a` may lead to ambiguities. (Better and more complete fix for #3) This ambiguity occurs for instance for discriminated union or record types that happen to have a field named 'Some' --- FSharpLu.Json/Compact.fs | 112 ++++++++---------- FSharpLu.Json/FSharpLu.Json.fsproj | 2 + FSharpLu.Json/Script.fsx | 20 +++- .../Scripts/load-project-release.fsx | 9 ++ .../Scripts/load-references-release.fsx | 5 + FSharpLu.Tests/JsonTests.fs | 4 +- 6 files changed, 88 insertions(+), 64 deletions(-) create mode 100644 FSharpLu.Json/Scripts/load-project-release.fsx create mode 100644 FSharpLu.Json/Scripts/load-references-release.fsx diff --git a/FSharpLu.Json/Compact.fs b/FSharpLu.Json/Compact.fs index 1320a67..18b3c80 100644 --- a/FSharpLu.Json/Compact.fs +++ b/FSharpLu.Json/Compact.fs @@ -10,8 +10,18 @@ open Microsoft.FSharp.Reflection type CompactUnionJsonConverter() = inherit Newtonsoft.Json.JsonConverter() + let SomeFieldIdentifier = "Some" + let isOptionType (t:System.Type) = - t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> + t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> + + /// Determine if a given type has a field named 'Some' which would cause + /// ambiguity if nested under an option type without being boxed + let hasFieldNamedSome (t:System.Type) = + isOptionType t // the option type itself has a 'Some' field + || (FSharpType.IsRecord t && FSharpType.GetRecordFields t |> Seq.exists (fun r -> r.Name = SomeFieldIdentifier)) + || (FSharpType.IsUnion t && FSharpType.GetUnionCases t |> Seq.exists (fun r -> r.Name = SomeFieldIdentifier)) + || (FSharpType.IsUnion t && FSharpType.GetUnionCases t |> Seq.exists (fun r -> r.Name = SomeFieldIdentifier)) override __.CanConvert(objectType:System.Type) = // Include F# discriminated unions @@ -38,20 +48,22 @@ type CompactUnionJsonConverter() = let innerValue = fields.[0] if isNull innerValue then writer.WriteStartObject() - writer.WritePropertyName("Some") + writer.WritePropertyName(SomeFieldIdentifier) writer.WriteNull() writer.WriteEndObject() // Some v with v <> null && v <> None else - // Is it a nested option: `(e.g., "Some (Some ... Some ( ... )))"`? - if isOptionType <| innerType then + // Is it nesting another option: `(e.g., "Some (Some ... Some ( ... )))"` + // or any other type with a field named 'Some'? + if hasFieldNamedSome innerType then // Preserved the nested structure through boxing writer.WriteStartObject() - writer.WritePropertyName("Some") + writer.WritePropertyName(SomeFieldIdentifier) serializer.Serialize(writer, innerValue) writer.WriteEndObject() else - // Type is option<'a> where 'a is NOT an option type itself + // Type is option<'a> where 'a does not have a field named 'Some + // (and therfore in particular is NOT an option type itself) // => we can simplify the Json by omitting the `Some` boxing // and serializing the nested object directly serializer.Serialize(writer, innerValue) @@ -86,65 +98,44 @@ type CompactUnionJsonConverter() = if jToken.Type = Linq.JTokenType.Null then FSharpValue.MakeUnion(caseNone, [||]) - // Json that is not null maps to `Some _` + // Json that is not null must map to `Some _` else let nestedType = objectType.GetGenericArguments().[0] - let parseBoxedOption (jToken:Linq.JToken) = - if jToken.Type <> Linq.JTokenType.Object then - failwith "Nested option types must be serialized as boxed Json objects" - - let jObject = jToken :?> Linq.JObject - match jObject.TryGetValue("Some") with - | false, _ -> - failwith "Nested option types must be serialized as boxed Json objects with attribute 'Some'." - | true, unboxedValue -> - if unboxedValue.Type = Linq.JTokenType.Null then - // Case of Json { "Some" : null } for type option<'a> where 'a is nullable - // => deserialized to `Some null` - null - else - // Case of Json { "Some" : } where is not null - // => we just deserialize the nested object recursively - unboxedValue.ToObject(nestedType, serializer) - - let parseBoxedNonOptionObject (jToken:Linq.JToken) = - if jToken.Type <> Linq.JTokenType.Object then - failwith "Nested option types must be serialized as boxed Json objects" - let jObject = jToken :?> Linq.JObject - match jObject.TryGetValue("Some") with - | false, _ -> - // 'Some' field absent from Json: this must be a nested discriminated union object. - // Not need to unbox: we just deserialize the Json object as is. - jObject.ToObject(nestedType, serializer) - | true, unboxedValue -> - if unboxedValue.Type = Linq.JTokenType.Null then - // Case of Json { "Some" : null } for type option<'a> where 'a is nullable - // => deserialized to `Some null` - null - else - // Case of Json { "Some" : } where is not null - // => we just deserialize the nested object recursively - // - // NOTE: there is a possible ambuiguity here: we assume that the 'Some' field - // from the Json blob corresponds to the Option type being deserialized. However, it - // could just by a coincidence where 'Some' is also the name of a field in a nested - // discriminated union. (type X = { Some : string } and Y = Y option) - // If this is the case the deserialization fails. - unboxedValue.ToObject(nestedType, serializer) + // If the specified Json an object of the form `{ "Some" = token }` + // then return `Some token`, otherwise returns `None`. + let tryGetSomeAttributeValue (jToken:Linq.JToken) = + if jToken.Type = Linq.JTokenType.Object then + let jObject = jToken :?> Linq.JObject + match jObject.TryGetValue SomeFieldIdentifier with + | true, token -> Some token + | false, _ -> None + else + None let nestedValue = - // Is the nested type an option type itself? - // or is the Json to be deserialized is an object Json? - if isOptionType nestedType then - // Nested option type are always boxed in Json to prevent any ambguity - parseBoxedOption jToken - else if jToken.Type = Linq.JTokenType.Object then - parseBoxedNonOptionObject jToken - else + match tryGetSomeAttributeValue jToken with + | Some someAttributeValue when someAttributeValue.Type = Linq.JTokenType.Null -> + // The Json object is { "Some" : null } for type option<'a> + // where 'a is nullable => deserialized to `Some null` + null + + | Some someAttributeValue when hasFieldNamedSome nestedType -> + // Case of Json { "Some" : } where is not null + // => we just deserialize the nested object recursively + someAttributeValue.ToObject(nestedType, serializer) + + | Some someAttributeValue -> + failwithf "Unexpected Json 'Some' attribute set to %O" someAttributeValue + + | None when hasFieldNamedSome nestedType -> + failwith "Types with a field named 'Some' and nested under an option type must be boxed under a 'Some' attribute when serialized to Json." + + | None -> // type is option<'a> where 'a is not an option type and not a - // type that would be serialized as a Json object. i.e. 'a is a base Json type (e.g. integer or string) - // => we can deserialize the object of type 'a directly without unboxing + // type that would be serialized as a Json object. + // i.e. 'a is either a base Json type (e.g. integer or string) or + // a Json array => we can deserialize the object of type 'a directly without unboxing jToken.ToObject(nestedType, serializer) FSharpValue.MakeUnion(caseSome, [| nestedValue |]) @@ -224,7 +215,8 @@ module Compact = static member settings = let s = JsonSerializerSettings( NullValueHandling = NullValueHandling.Ignore, // Strict deserialization is required to avoid certain ambiguities - MissingMemberHandling = MissingMemberHandling.Error) + MissingMemberHandling = MissingMemberHandling.Error + ) s.Converters.Add(CompactUnionJsonConverter()) s diff --git a/FSharpLu.Json/FSharpLu.Json.fsproj b/FSharpLu.Json/FSharpLu.Json.fsproj index e537cc2..f2afd09 100644 --- a/FSharpLu.Json/FSharpLu.Json.fsproj +++ b/FSharpLu.Json/FSharpLu.Json.fsproj @@ -60,6 +60,8 @@ + + diff --git a/FSharpLu.Json/Script.fsx b/FSharpLu.Json/Script.fsx index 4c7127c..440de5f 100644 --- a/FSharpLu.Json/Script.fsx +++ b/FSharpLu.Json/Script.fsx @@ -12,8 +12,8 @@ open Microsoft.FSharpLu.Json type WithFields = SomeField of int * int type ComplexDu = ComplexDu of WithFields | SimpleDU | AString of string let x= (ComplexDu (SomeField (4,9))) |> Default.serialize -let y = x |> Default.deserialize :> ComplexDu -let z = x |> Compact.deserialize :> ComplexDu +let y = x |> Default.deserialize +let z = x |> Compact.deserialize module T = type OptionOfBase = int option @@ -22,3 +22,19 @@ module T = Some 5 |> Default.serialize |> BackwardCompatible.deserialize :> OptionOfBase Default.deserialize "null" BackwardCompatible.deserialize "null" + +module T2 = + type X = {Some :string} + + Option.Some { X.Some = "test"} |> Compact.serialize + + Option.Some { X.Some = null} |> Compact.serialize + + let z = Option.Some { X.Some = null} |> Compact.serialize |> Compact.deserialize + + Some (Some null) |> Compact.serialize |> Compact.deserialize + + Some null |> Compact.serialize |> Compact.deserialize + + null |> Compact.serialize|> Compact.deserialize + diff --git a/FSharpLu.Json/Scripts/load-project-release.fsx b/FSharpLu.Json/Scripts/load-project-release.fsx new file mode 100644 index 0000000..b3eb2ae --- /dev/null +++ b/FSharpLu.Json/Scripts/load-project-release.fsx @@ -0,0 +1,9 @@ +// Warning: generated file; your changes could be lost when a new file is generated. +#I __SOURCE_DIRECTORY__ +#load "load-references-release.fsx" +#load "../AssemblyInfo.fs" + "../Helpers.fs" + "../WithFunctor.fs" + "../NewtonSoft.fs" + "../Compact.fs" + "../BackwardCompatible.fs" diff --git a/FSharpLu.Json/Scripts/load-references-release.fsx b/FSharpLu.Json/Scripts/load-references-release.fsx new file mode 100644 index 0000000..3852fe4 --- /dev/null +++ b/FSharpLu.Json/Scripts/load-references-release.fsx @@ -0,0 +1,5 @@ +// Warning: generated file; your changes could be lost when a new file is generated. +#I __SOURCE_DIRECTORY__ +#r "../../packages/Newtonsoft.Json.8.0.3/lib/net45/Newtonsoft.Json.dll" +#r "System.Core.dll" +#r "System.dll" \ No newline at end of file diff --git a/FSharpLu.Tests/JsonTests.fs b/FSharpLu.Tests/JsonTests.fs index 5e7d3c8..0ca462d 100644 --- a/FSharpLu.Tests/JsonTests.fs +++ b/FSharpLu.Tests/JsonTests.fs @@ -42,9 +42,9 @@ let inline reciprocal< ^T when ^T:equality> (x: ^T) = let inline areReciprocal< ^T when ^T:equality> (x: ^T) = let s = x |> serialize< ^T> let sds = s |> deserialize< ^T> |> serialize< ^T> - Assert.AreEqual(s, sds, sprintf "Inconsistent serialization: 1st call: <%s> 2nd call <%s>" s sds) + Assert.AreEqual(s, sds, sprintf "Inconsistent serialization: 1st call: <%s> 2nd call <%s>. Type %A" s sds (typeof< ^T>)) let sdsd = sds |> deserialize< ^T> - Assert.AreEqual(sdsd, x, sprintf "Did not get the same object back: <%A> gave <%A>" x sdsd) + Assert.AreEqual(sdsd, x, sprintf "Did not get the same object back: <%A> gave back <%A> for type %A" x sdsd (typeof< ^T>)) /// Check that given object serializes to the specified Json string let inline serializedAs json o =