Added requireRecordFields option to Newtonsoft.Json

src/FsCodec.NewtonsoftJson/Codec.fs

@@ -44,10 +44,27 @@ module Core =
  // TOCONSIDER as noted in the comments on RecyclableMemoryStream.ToArray, ideally we'd be continuing the rental and passing out a Span
  ms.ToArray()
 
- member __.Decode(json : byte[]) =
+ member __.Decode(json : byte[]) : 'a =
  use ms = Utf8BytesEncoder.wrapAsStream json
  use jsonReader = Utf8BytesEncoder.makeJsonReader ms
- serializer.Deserialize<'T>(jsonReader)
+ let returnType = typeof<'a>
+ if returnType = typeof<Guid> then
+ json
+ |> System.Text.Encoding.ASCII.GetString
+ |> Guid.Parse
+ |> unbox
+ elif returnType = typeof<bool> then
+ json
+ |> System.Text.Encoding.ASCII.GetString
+ |> Boolean.Parse
+ |> unbox
+ elif returnType = typeof<char> then
+ json
+ |> System.Text.Encoding.UTF8.GetChars
+ |> Seq.head
+ |> unbox
+ else
+ serializer.Deserialize<'a> jsonReader
 
 /// Provides Codecs that render to a UTF-8 array suitable for storage in Event Stores based using <c>Newtonsoft.Json</c> and the conventions implied by using
 /// <c>TypeShape.UnionContract.UnionContractEncoder</c> - if you need full control and/or have have your own codecs, see <c>FsCodec.Codec.Create</c> instead
@@ -73,19 +90,18 @@ type Codec private () =
  /// Configuration to be used by the underlying <c>Newtonsoft.Json</c> Serializer when encoding/decoding. Defaults to same as <c>Settings.Create()</c>
  [<Optional; DefaultParameterValue(null)>] ?settings,
  /// Enables one to fail encoder generation if union contains nullary cases. Defaults to <c>false</c>, i.e. permitting them
- [<Optional; DefaultParameterValue(null)>] ?rejectNullaryCases)
+ [<Optional; DefaultParameterValue(null)>] ?rejectNullaryCases,
+ [<Optional; DefaultParameterValue(null)>] ?requireRecordFields)
  : FsCodec.IEventCodec<'Event, byte[], 'Context> =
 
  let settings = match settings with Some x -> x | None -> defaultSettings.Value
- let bytesEncoder : TypeShape.UnionContract.IEncoder<_> = new Core.BytesEncoder(settings) :> _
+ let bytesEncoder : TypeShape.UnionContract.IEncoder<_> = Core.BytesEncoder(settings) :> _
+ let requireRecordFields = defaultArg requireRecordFields true
+ Internal.checkIfSupported<'Contract> requireRecordFields
  let dataCodec =
  TypeShape.UnionContract.UnionContractEncoder.Create<'Contract, byte[]>(
  bytesEncoder,
- // For now, we hard wire in disabling of non-record bodies as:
- // a) it's extra yaks to shave
- // b) it's questionable whether allowing one to define event contracts that preclude adding extra fields is a useful idea in the first instance
- // See VerbatimUtf8EncoderTests.fs and InteropTests.fs - there are edge cases when `d` fields have null / zero-length / missing values
- requireRecordFields = true,
+ requireRecordFields = requireRecordFields,
  allowNullaryCases = not (defaultArg rejectNullaryCases false))
 
  { new FsCodec.IEventCodec<'Event, byte[], 'Context> with
@@ -119,14 +135,16 @@ type Codec private () =
  /// Configuration to be used by the underlying <c>Newtonsoft.Json</c> Serializer when encoding/decoding. Defaults to same as <c>Settings.Create()</c>
  [<Optional; DefaultParameterValue(null)>] ?settings,
  /// Enables one to fail encoder generation if union contains nullary cases. Defaults to <c>false</c>, i.e. permitting them
- [<Optional; DefaultParameterValue(null)>] ?rejectNullaryCases)
+ [<Optional; DefaultParameterValue(null)>] ?rejectNullaryCases,
+ /// Enables unions to contain a Guid or most primitives. Defaults to <c>true</c>, i.e. preventing Guids and primitives
+ [<Optional; DefaultParameterValue(null)>] ?requireRecordFields)
  : FsCodec.IEventCodec<'Event, byte[], 'Context> =
 
  let down (context, union) =
  let c, m, t = down union
  let m', eventId, correlationId, causationId = mapCausation (context, m)
  c, m', eventId, correlationId, causationId, t
- Codec.Create(up = up, down = down, ?settings = settings, ?rejectNullaryCases = rejectNullaryCases)
+ Codec.Create(up = up, down = down, ?settings = settings, ?rejectNullaryCases = rejectNullaryCases, ?requireRecordFields = requireRecordFields)
 
  /// Generate an <code>IEventCodec</code> using the supplied <c>Newtonsoft.Json<c/> <c>settings</c>.
  /// Uses <c>up</c> and <c>down</c> and <c>mapCausation</c> functions to facilitate upconversion/downconversion and correlation/causationId mapping
@@ -145,11 +163,13 @@ type Codec private () =
  /// Configuration to be used by the underlying <c>Newtonsoft.Json</c> Serializer when encoding/decoding. Defaults to same as <c>Settings.Create()</c>
  [<Optional; DefaultParameterValue(null)>] ?settings,
  /// Enables one to fail encoder generation if union contains nullary cases. Defaults to <c>false</c>, i.e. permitting them
- [<Optional; DefaultParameterValue(null)>] ?rejectNullaryCases)
+ [<Optional; DefaultParameterValue(null)>] ?rejectNullaryCases,
+ /// Enables unions to contain a Guid or most primitives. Defaults to <c>true</c>, i.e. preventing Guids and primitives
+ [<Optional; DefaultParameterValue(null)>] ?requireRecordFields)
  : FsCodec.IEventCodec<'Event, byte[], obj> =
 
  let mapCausation (_context : obj, m : 'Meta option) = m, Guid.NewGuid(), null, null
- Codec.Create(up = up, down = down, mapCausation = mapCausation, ?settings = settings, ?rejectNullaryCases = rejectNullaryCases)
+ Codec.Create(up = up, down = down, mapCausation = mapCausation, ?settings = settings, ?rejectNullaryCases = rejectNullaryCases, ?requireRecordFields = requireRecordFields)
 
  /// Generate an <code>IEventCodec</code> using the supplied <c>Newtonsoft.Json</c> <c>settings</c>.
  /// The Event Type Names are inferred based on either explicit <c>DataMember(Name=</c> Attributes, or (if unspecified) the Discriminated Union Case Name
@@ -158,9 +178,11 @@ type Codec private () =
  ( // Configuration to be used by the underlying <c>Newtonsoft.Json</c> Serializer when encoding/decoding. Defaults to same as <c>Settings.Create()</c>
  [<Optional; DefaultParameterValue(null)>] ?settings,
  /// Enables one to fail encoder generation if union contains nullary cases. Defaults to <c>false</c>, i.e. permitting them
- [<Optional; DefaultParameterValue(null)>] ?rejectNullaryCases)
+ [<Optional; DefaultParameterValue(null)>] ?rejectNullaryCases,
+ /// Enables unions to contain a Guid or most primitives. Defaults to <c>true</c>, i.e. preventing Guids and primitives
+ [<Optional; DefaultParameterValue(null)>] ?requireRecordFields)
  : FsCodec.IEventCodec<'Union, byte[], obj> =
 
  let up : FsCodec.ITimelineEvent<_> * 'Union -> 'Union = snd
  let down (event : 'Union) = event, None, None
- Codec.Create(up = up, down = down, ?settings = settings, ?rejectNullaryCases = rejectNullaryCases)
+ Codec.Create(up = up, down = down, ?settings = settings, ?rejectNullaryCases = rejectNullaryCases, ?requireRecordFields = requireRecordFields)

src/FsCodec.NewtonsoftJson/FsCodec.NewtonsoftJson.fsproj

@@ -29,7 +29,6 @@
  <PackageReference Include="Microsoft.IO.RecyclableMemoryStream" Version="1.2.2" />
  <PackageReference Include="Newtonsoft.Json" Version="11.0.2" />
  <PackageReference Include="System.Buffers" Version="4.5.0" />
- <PackageReference Include="TypeShape" Version="8.0.0" />
  </ItemGroup>
 
  <ItemGroup>

src/FsCodec.NewtonsoftJson/VerbatimUtf8Converter.fs

@@ -20,5 +20,7 @@ type VerbatimUtf8JsonConverter() =
 
  override __.ReadJson(reader : JsonReader, _ : Type, _ : obj, _ : JsonSerializer) =
  let token = JToken.Load reader
- if token.Type = JTokenType.Null then null
- else token |> string |> enc.GetBytes |> box
+ match token.Type with
+ | JTokenType.Null -> null
+ | JTokenType.Float -> reader.Value :?> double |> fun x -> x.ToString "r" |> enc.GetBytes |> box
+ | _ -> token |> string |> enc.GetBytes |> box

src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj

@@ -27,7 +27,6 @@
  <PackageReference Include="FSharp.Core" Version="4.3.4" />
 
  <PackageReference Include="System.Text.Json" Version="5.0.0-preview.3.20214.6" />
- <PackageReference Include="TypeShape" Version="8.0.0" />
  </ItemGroup>
 
  <ItemGroup>

src/FsCodec/FsCodec.fsproj

@@ -9,6 +9,7 @@
  </PropertyGroup>
 
  <ItemGroup>
+ <Compile Include="Internal.fs" />
  <Compile Include="FsCodec.fs" />
  <Compile Include="Codec.fs" />
  <Compile Include="StreamName.fs" />
@@ -21,6 +22,13 @@
  <PackageReference Include="FSharp.Core" Version="3.1.2.5" Condition=" '$(TargetFramework)' == 'net461' " />
  <PackageReference Include="FSharp.Core" Version="4.3.4" Condition=" '$(TargetFramework)' == 'netstandard2.0' " />
  <PackageReference Include="FSharp.UMX" Version="1.0.0" />
+ <PackageReference Include="TypeShape" Version="8.0.0" />
+ </ItemGroup>
+
+ <ItemGroup>
+ <AssemblyAttribute Include="System.Runtime.CompilerServices.InternalsVisibleTo">
+ <_Parameter1>FsCodec.NewtonsoftJson</_Parameter1>
+ </AssemblyAttribute>
  </ItemGroup>
 
 </Project>

src/FsCodec/Internal.fs

@@ -0,0 +1,43 @@
+module internal Internal
+
+open TypeShape.Core
+
+let checkIfSupported<'Contract> requireRecordFields =
+ if not requireRecordFields then
+ let shape =
+ match shapeof<'Contract> with
+ | Shape.FSharpUnion (:? ShapeFSharpUnion<'Contract> as s) -> s
+ | _ ->
+ sprintf "Type '%O' is not an F# union" typeof<'Contract>
+ |> invalidArg "Union"
+ let isAllowed (scase : ShapeFSharpUnionCase<_>) =
+ match scase.Fields with
+ | [| field |] ->
+ match field.Member with
+ // non-primitives
+ | Shape.FSharpRecord _
+ | Shape.Guid _
+
+ // primitives
+ | Shape.Bool _
+ | Shape.Byte _
+ | Shape.SByte _
+ | Shape.Int16 _
+ | Shape.Int32 _
+ | Shape.Int64 _
+ //| Shape.IntPtr _ // unsupported
+ | Shape.UInt16 _
+ | Shape.UInt32 _
+ | Shape.UInt64 _
+ //| Shape.UIntPtr _ // unsupported
+ | Shape.Single _
+ | Shape.Double _
+ | Shape.Char _ -> true
+ | _ -> false
+ | [||] -> true // allows all nullary cases, but a subsequent check is done by UnionContractEncoder.Create with `allowNullaryCases`
+ | _ -> false
+ shape.UnionCases
+ |> Array.tryFind (not << isAllowed)
+ |> function
+ | None -> ()
+ | Some x -> failwithf "The '%s' case has an unsupported type: '%s'" x.CaseInfo.Name x.Fields.[0].Member.Type.FullName

tests/FsCodec.NewtonsoftJson.Tests/VerbatimUtf8ConverterTests.fs

@@ -24,8 +24,24 @@ type U =
  //| DT of DateTime // Have not analyzed but seems to be same issue as DTO
  | EDto of EmbeddedDateTimeOffset
  | ES of EmbeddedString
- //| I of int // works but removed as no other useful top level values work
+ | Guid of Guid
  | N
+
+ // primitives
+ | Boolean of bool
+ | Byte of byte
+ | SByte of sbyte
+ | Int16 of int16
+ | UInt16 of uint16
+ | Int32 of int32
+ | UInt32 of uint32
+ | Int64 of int64
+ | UInt64 of uint64
+ //| IntPtr of IntPtr // unsupported
+ //| UIntPtr of UIntPtr // unsupported
+ | Char of char
+ | Double of double
+ | Single of single
  interface TypeShape.UnionContract.IUnionContract
 
 type [<NoEquality; NoComparison; JsonObject(ItemRequired=Required.Always)>]
@@ -57,7 +73,7 @@ let mkBatch (encoded : FsCodec.IEventData<byte[]>) : Batch =
 
 module VerbatimUtf8Tests = // not a module or CI will fail for net461
 
- let eventCodec = Codec.Create<Union>()
+ let eventCodec = Codec.Create<Union>(requireRecordFields=false)
 
  let [<Fact>] ``encodes correctly`` () =
  let input = Union.A { embed = "\"" }
@@ -71,7 +87,7 @@ module VerbatimUtf8Tests = // not a module or CI will fail for net461
  input =! decoded
 
  let defaultSettings = Settings.CreateDefault()
- let defaultEventCodec = Codec.Create<U>(defaultSettings)
+ let defaultEventCodec = Codec.Create<U>(defaultSettings, requireRecordFields=false)
 
  let [<Property>] ``round-trips diverse bodies correctly`` (x: U) =
  let encoded = defaultEventCodec.Encode(None,x)
@@ -80,7 +96,12 @@ module VerbatimUtf8Tests = // not a module or CI will fail for net461
  let des = JsonConvert.DeserializeObject<Batch>(ser, defaultSettings)
  let loaded = FsCodec.Core.TimelineEvent.Create(-1L, des.e.[0].c, des.e.[0].d)
  let decoded = defaultEventCodec.TryDecode loaded |> Option.get
- x =! decoded
+ match x, decoded with
+ | U.Double x, U.Double d when Double.IsNaN x && Double.IsNaN d -> ()
+ | U.Single x, U.Single d when Single.IsNaN x && Single.IsNaN d -> ()
+ | U.Double x, U.Double d -> Assert.Equal( x, d, 10)
+ | U.Single x, U.Single d -> Assert.Equal(double x, double d, 10)
+ | _ -> x =! decoded
 
  // https://github.com/JamesNK/Newtonsoft.Json/issues/862 // doesnt apply to this case
  let [<Fact>] ``Codec does not fall prey to Date-strings being mutilated`` () =