STJ: Add ToByteArrayCodec/ToJsonElementCodec shims

src/FsCodec.NewtonsoftJson/Codec.fs

@@ -81,7 +81,11 @@ type Codec private () =
         let dataCodec =
             TypeShape.UnionContract.UnionContractEncoder.Create<'Contract, byte[]>(
                 bytesEncoder,
-                requireRecordFields = true, // See JsonConverterTests - round-tripping UTF-8 correctly with Json.net is painful so for now we lock up the dragons
+                // 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,
                 allowNullaryCases = not (defaultArg rejectNullaryCases false))
 
         { new FsCodec.IEventCodec<'Event, byte[], 'Context> with

src/FsCodec.SystemTextJson/Codec.fs

@@ -51,7 +51,9 @@ type Codec private () =
         let dataCodec =
             TypeShape.UnionContract.UnionContractEncoder.Create<'Contract, JsonElement>(
                 elementEncoder,
-                requireRecordFields = true, // See JsonConverterTests - round-tripping UTF-8 correctly with Json.net is painful so for now we lock up the dragons
+                // Round-tripping cases like null and/or empty strings etc involves edge cases that stores,
+                // FsCodec.NewtonsoftJson.Codec, Interop.fs and InteropTests.fs do not cover, so we disable this
+                requireRecordFields = true,
                 allowNullaryCases = not (defaultArg rejectNullaryCases false))
 
         { new FsCodec.IEventCodec<'Event, JsonElement, 'Context> with

src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj

@@ -19,6 +19,7 @@
     <Compile Include="Options.fs" />
     <Compile Include="Codec.fs" />
     <Compile Include="Serdes.fs" />
+    <Compile Include="Interop.fs" />
   </ItemGroup>
 
   <ItemGroup>

src/FsCodec.SystemTextJson/Interop.fs

@@ -0,0 +1,58 @@
+namespace FsCodec.SystemTextJson
+
+open System.Runtime.CompilerServices
+open System.Text.Json
+
+[<Extension>]
+type InteropExtensions =
+    static member private Adapt<'From, 'To, 'Event, 'Context>
+        (   native : FsCodec.IEventCodec<'Event, 'From, 'Context>,
+            up : 'From -> 'To,
+            down : 'To -> 'From) : FsCodec.IEventCodec<'Event, 'To, 'Context> =
+
+        { new FsCodec.IEventCodec<'Event, 'To, 'Context> with
+            member __.Encode(context, event) =
+                let encoded = native.Encode(context, event)
+                { new FsCodec.IEventData<_> with
+                    member __.EventType = encoded.EventType
+                    member __.Data = up encoded.Data
+                    member __.Meta = up encoded.Meta
+                    member __.EventId = encoded.EventId
+                    member __.CorrelationId = encoded.CorrelationId
+                    member __.CausationId = encoded.CausationId
+                    member __.Timestamp = encoded.Timestamp }
+
+            member __.TryDecode encoded =
+                let mapped =
+                    { new FsCodec.ITimelineEvent<_> with
+                        member __.Index = encoded.Index
+                        member __.IsUnfold = encoded.IsUnfold
+                        member __.Context = encoded.Context
+                        member __.EventType = encoded.EventType
+                        member __.Data = down encoded.Data
+                        member __.Meta = down encoded.Meta
+                        member __.EventId = encoded.EventId
+                        member __.CorrelationId = encoded.CorrelationId
+                        member __.CausationId = encoded.CausationId
+                        member __.Timestamp = encoded.Timestamp }
+                native.TryDecode mapped }
+
+    static member private MapFrom(x : byte[]) : JsonElement =
+        if x = null then JsonElement()
+        else JsonSerializer.Deserialize(System.ReadOnlySpan.op_Implicit x)
+    static member private MapTo(x: JsonElement) : byte[] =
+        if x.ValueKind = JsonValueKind.Undefined then null
+        else JsonSerializer.SerializeToUtf8Bytes(x, InteropExtensions.NoOverEscapingOptions)
+    // Avoid introduction of HTML escaping for things like quotes etc (as standard Options.Create() profile does)
+    static member private NoOverEscapingOptions =
+        System.Text.Json.JsonSerializerOptions(Encoder = System.Text.Encodings.Web.JavaScriptEncoder.UnsafeRelaxedJsonEscaping)
+
+    [<Extension>]
+    static member ToByteArrayCodec<'Event, 'Context>(native : FsCodec.IEventCodec<'Event, JsonElement, 'Context>)
+        : FsCodec.IEventCodec<'Event, byte[], 'Context> =
+        InteropExtensions.Adapt(native, InteropExtensions.MapTo, InteropExtensions.MapFrom)
+
+    [<Extension>]
+    static member ToJsonElementCodec<'Event, 'Context>(native : FsCodec.IEventCodec<'Event, byte[], 'Context>)
+        : FsCodec.IEventCodec<'Event, JsonElement, 'Context> =
+        InteropExtensions.Adapt(native, InteropExtensions.MapFrom, InteropExtensions.MapTo)

tests/FsCodec.NewtonsoftJson.Tests/VerbatimUtf8ConverterTests.fs

@@ -49,37 +49,39 @@ type [<NoEquality; NoComparison; JsonObject(ItemRequired=Required.Always)>]
         i: int64
         n: int64
         e: Event[] }
-
-let defaultSettings = Settings.CreateDefault()
+let mkBatch (encoded : FsCodec.IEventData<byte[]>) : Batch =
+    {   p = "streamName"; id = string 0; i = -1L; n = -1L; _etag = null
+        e = [| { t = DateTimeOffset.MinValue; c = encoded.EventType; d = encoded.Data; m = null } |] }
 
 #nowarn "1182" // From hereon in, we may have some 'unused' privates (the tests)
 
-type VerbatimUtf8Tests() =
-    let eventCodec = Codec.Create()
+module VerbatimUtf8Tests = // not a module or CI will fail for net461
+
+    let eventCodec = Codec.Create<Union>()
 
-    [<Fact>]
-    let ``encodes correctly`` () =
-        let encoded = eventCodec.Encode(None, A { embed = "\"" })
-        let e : Batch =
-            {   p = "streamName"; id = string 0; i = -1L; n = -1L; _etag = null
-                e = [| { t = DateTimeOffset.MinValue; c = encoded.EventType; d = encoded.Data; m = null } |] }
+    let [<Fact>] ``encodes correctly`` () =
+        let input = Union.A { embed = "\"" }
+        let encoded = eventCodec.Encode(None, input)
+        let e : Batch = mkBatch encoded
         let res = JsonConvert.SerializeObject(e)
         test <@ res.Contains """"d":{"embed":"\""}""" @>
+        let des = JsonConvert.DeserializeObject<Batch>(res)
+        let loaded = FsCodec.Core.TimelineEvent.Create(-1L, des.e.[0].c, des.e.[0].d)
+        let decoded = eventCodec.TryDecode loaded |> Option.get
+        input =! decoded
 
+    let defaultSettings = Settings.CreateDefault()
     let defaultEventCodec = Codec.Create<U>(defaultSettings)
 
-    let [<Property(MaxTest=100)>] ``round-trips diverse bodies correctly`` (x: U) =
+    let [<Property>] ``round-trips diverse bodies correctly`` (x: U) =
         let encoded = defaultEventCodec.Encode(None,x)
-        let e : Batch =
-            {   p = "streamName"; id = string 0; i = -1L; n = -1L; _etag = null
-                e = [| { t = DateTimeOffset.MinValue; c = encoded.EventType; d = encoded.Data; m = null } |] }
+        let e : Batch = mkBatch encoded
         let ser = JsonConvert.SerializeObject(e, defaultSettings)
         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
 
-    // NB while this aspect works, we don't support it as it gets messy when you then use the VerbatimUtf8Converter
     // 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`` () =
         let x = ES { embed = "2016-03-31T07:02:00+07:00" }
@@ -97,6 +99,7 @@ type VerbatimUtf8Tests() =
     //    test <@ x = decoded @>
 
 module VerbatimUtf8NullHandling =
+
     type [<NoEquality; NoComparison>] EventHolderWithAndWithoutRequired =
         {   /// Event body, as UTF-8 encoded JSON ready to be injected directly into the Json being rendered
             [<JsonConverter(typeof<VerbatimUtf8JsonConverter>)>]
@@ -118,4 +121,4 @@ module VerbatimUtf8NullHandling =
         let ser = JsonConvert.SerializeObject(e)
         let des = JsonConvert.DeserializeObject<EventHolderWithAndWithoutRequired>(ser)
         test <@ ((e.m = null || e.m.Length = 0) && (des.m = null)) || System.Linq.Enumerable.SequenceEqual(e.m, des.m) @>
-        test <@ ((e.d = null || e.d.Length = 0) && (des.d = null)) || System.Linq.Enumerable.SequenceEqual(e.d, des.d) @>
+        test <@ ((e.d = null || e.d.Length = 0) && (des.d = null)) || System.Linq.Enumerable.SequenceEqual(e.d, des.d) @>

tests/FsCodec.SystemTextJson.Tests/CodecTests.fs

@@ -1,5 +1,6 @@
 module FsCodec.SystemTextJson.Tests.CodecTests
 
+open FsCodec.SystemTextJson // bring in ToByteArrayCodec etc extension methods
 open System.Text.Json
 open FsCheck.Xunit
 open Swensen.Unquote
@@ -18,6 +19,7 @@ let elementEncoder : TypeShape.UnionContract.IEncoder<System.Text.Json.JsonEleme
     FsCodec.SystemTextJson.Core.JsonElementEncoder(ignoreNullOptions) :> _
 
 let eventCodec = FsCodec.SystemTextJson.Codec.Create<Union>(ignoreNullOptions)
+let doubleHopCodec = eventCodec.ToByteArrayCodec().ToJsonElementCodec()
 
 [<NoComparison>]
 type Envelope = { d : JsonElement }
@@ -61,3 +63,7 @@ let [<Property>] roundtrips value =
         | BO ({ opt = Some null } as v) -> BO { v with opt = None }
         | x -> x
     test <@ expected = decoded @>
+
+    // Also validate the adapters work when put in series (NewtonsoftJson tests are responsible for covering the individual hops)
+    let decodedDoubleHop = doubleHopCodec.TryDecode wrapped |> Option.get
+    test <@ expected = decodedDoubleHop @>

tests/FsCodec.SystemTextJson.Tests/FsCodec.SystemTextJson.Tests.fsproj

@@ -18,6 +18,8 @@
 
   <ItemGroup>
     <ProjectReference Include="../../src/FsCodec.SystemTextJson/FsCodec.SystemTextJson.fsproj" />
+    <!-- For InteropTests.fs -->
+    <ProjectReference Include="../FsCodec.NewtonsoftJson.Tests/FsCodec.NewtonsoftJson.Tests.fsproj" />
   </ItemGroup>
 
   <ItemGroup>
@@ -27,6 +29,7 @@
     <Compile Include="UmxInteropTests.fs" />
     <Compile Include="TypeSafeEnumConverterTests.fs" />
     <None Include="Examples.fsx" />
+    <Compile Include="InteropTests.fs" />
   </ItemGroup>
 
 </Project>

tests/FsCodec.SystemTextJson.Tests/InteropTests.fs

@@ -0,0 +1,48 @@
+/// Covers interop with stores that manage event bodies as byte[]
+module FsCodec.SystemTextJson.Tests.InteropTests
+
+open FsCheck.Xunit
+open Newtonsoft.Json
+open Swensen.Unquote
+open System
+open Xunit
+
+type Batch = FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests.Batch
+type Union = FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests.Union
+let mkBatch = FsCodec.NewtonsoftJson.Tests.VerbatimUtf8ConverterTests.mkBatch
+
+let indirectCodec = FsCodec.SystemTextJson.Codec.Create() |> FsCodec.SystemTextJson.InteropExtensions.ToByteArrayCodec
+let [<Fact>] ``encodes correctly`` () =
+    let input = Union.A { embed = "\"" }
+    let encoded = indirectCodec.Encode(None, input)
+    let e : Batch = mkBatch encoded
+    let res = JsonConvert.SerializeObject(e)
+    test <@ res.Contains """"d":{"embed":"\""}""" @>
+    let des = JsonConvert.DeserializeObject<Batch>(res)
+    let loaded = FsCodec.Core.TimelineEvent.Create(-1L, des.e.[0].c, des.e.[0].d)
+    let decoded = indirectCodec.TryDecode loaded |> Option.get
+    input =! decoded
+
+type EmbeddedString = { embed : string }
+type EmbeddedDateTimeOffset = { embed : DateTimeOffset }
+type U =
+    // | S of string // Opens up some edge cases wrt handling missing/empty/null `d` fields in stores, but possible if you have time to shave that yak!
+    | EDto of EmbeddedDateTimeOffset
+    | ES of EmbeddedString
+    | N
+    interface TypeShape.UnionContract.IUnionContract
+
+let defaultSettings = FsCodec.NewtonsoftJson.Settings.CreateDefault() // Test without converters, as that's what Equinox.Cosmos will do
+let defaultEventCodec = FsCodec.NewtonsoftJson.Codec.Create<U>(defaultSettings)
+let indirectCodecU = FsCodec.SystemTextJson.Codec.Create<U>() |> FsCodec.SystemTextJson.InteropExtensions.ToByteArrayCodec
+
+let [<Property>] ``round-trips diverse bodies correctly`` (x: U, encodeDirect, decodeDirect) =
+    let encoder = if encodeDirect then defaultEventCodec else indirectCodecU
+    let decoder = if decodeDirect then defaultEventCodec else indirectCodecU
+    let encoded = encoder.Encode(None,x)
+    let e : Batch = mkBatch encoded
+    let ser = JsonConvert.SerializeObject(e, defaultSettings)
+    let des = JsonConvert.DeserializeObject<Batch>(ser, defaultSettings)
+    let loaded = FsCodec.Core.TimelineEvent.Create(-1L, des.e.[0].c, des.e.[0].d)
+    let decoded = decoder.TryDecode loaded |> Option.get
+    x =! decoded