Switch Equinox.Cosmos over to System.Text.Json

samples/Store/Domain/Domain.fsproj

@@ -21,7 +21,7 @@
     <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="FsCodec.NewtonsoftJson" Version="2.0.0" />
+    <PackageReference Include="FsCodec.NewtonsoftJson" Version="2.0.1" />
   </ItemGroup>
 
   <ItemGroup>

src/Equinox.Core/Infrastructure.fs

@@ -69,6 +69,10 @@ type Async with
                     sc ())
             |> ignore)
 
+#if NETSTANDARD2_1
+    static member inline AwaitValueTask (vtask: ValueTask<'T>) : Async<'T> = vtask.AsTask() |> Async.AwaitTaskCorrect
+#endif
+
 [<RequireQualifiedAccess>]
 module Regex =
     open System.Text.RegularExpressions

src/Equinox.Cosmos/CosmosJsonSerializer.fs

@@ -0,0 +1,35 @@
+namespace Equinox.Cosmos.Store
+
+open System.IO
+open System.Text.Json
+open Azure.Cosmos.Serialization
+open Equinox.Core
+open Equinox.Cosmos.Json
+
+type CosmosJsonSerializer (options: JsonSerializerOptions) =
+    inherit CosmosSerializer()
+
+    override __.FromStream<'T> (stream) =
+        using (stream) (fun stream ->
+            if stream.Length = 0L then
+                Unchecked.defaultof<'T>
+            elif typeof<Stream>.IsAssignableFrom(typeof<'T>) then
+                stream :> obj :?> 'T
+            else
+                JsonSerializer.DeserializeAsync<'T>(stream, options)
+                |> Async.AwaitValueTask
+                |> Async.RunSynchronously
+        )
+
+    override __.ToStream<'T> (input: 'T) =
+        async {
+            let memoryStream = new MemoryStream()
+
+            do!
+                JsonSerializer.SerializeAsync(memoryStream, input, input.GetType(), options)
+                |> Async.AwaitTaskCorrect
+
+            memoryStream.Position <- 0L
+            return memoryStream :> Stream
+        }
+        |> Async.RunSynchronously

src/Equinox.Cosmos/Equinox.Cosmos.fsproj

@@ -10,8 +10,12 @@
   </PropertyGroup>
 
   <ItemGroup>
+    <Compile Include="Json\JsonElementHelpers.fs" />
+    <Compile Include="Json\Utf8JsonReaderExtensions.fs" />
+    <Compile Include="Json\JsonRecordConverter.fs" />
+    <Compile Include="Json\Options.fs" />
     <Compile Include="..\Equinox.Core\Infrastructure.fs" Link="Infrastructure.fs" />
-    <Compile Include="NewtonsoftJsonSerializer.fs" />
+    <Compile Include="CosmosJsonSerializer.fs" />
     <Compile Include="Cosmos.fs" />
   </ItemGroup>
 
@@ -20,13 +24,13 @@
   </ItemGroup>
 
   <ItemGroup>
+    <PackageReference Include="FsCodec" Version="2.0.1" />
     <PackageReference Include="Microsoft.SourceLink.GitHub" Version="1.0.0" PrivateAssets="All" />
     <PackageReference Include="MinVer" Version="2.0.0" PrivateAssets="All" />
 
     <PackageReference Include="FSharp.Core" Version="4.3.4" Condition=" '$(TargetFramework)' == 'netstandard2.0' " />
     <PackageReference Include="Microsoft.Bcl.AsyncInterfaces" Version="1.1.0" />
 
-    <PackageReference Include="FsCodec.NewtonsoftJson" Version="2.0.0" />
     <PackageReference Include="FSharp.Control.AsyncSeq" Version="2.0.23" />
     <PackageReference Include="Azure.Cosmos" Version="4.0.0-preview3" />
     <PackageReference Include="System.Runtime.Caching" Version="4.5.0" />

src/Equinox.Cosmos/Json/JsonElementHelpers.fs

@@ -0,0 +1,20 @@
+namespace Equinox.Cosmos
+
+open System
+open System.Buffers
+open System.Runtime.InteropServices
+open System.Text.Json
+
+[<AutoOpen>]
+module JsonSerializerExtensions =
+    type JsonSerializer with
+        static member SerializeToElement(value: 'T, [<Optional; DefaultParameterValue(null)>] ?options: JsonSerializerOptions) =
+            JsonSerializer.Deserialize<JsonElement>(ReadOnlySpan.op_Implicit(JsonSerializer.SerializeToUtf8Bytes(value, defaultArg options null)))
+
+        static member DeserializeElement<'T>(element: JsonElement, [<Optional; DefaultParameterValue(null)>] ?options: JsonSerializerOptions) =
+            let bufferWriter = ArrayBufferWriter<byte>()
+            (
+                use jsonWriter = new Utf8JsonWriter(bufferWriter)
+                element.WriteTo(jsonWriter)
+            )
+            JsonSerializer.Deserialize<'T>(bufferWriter.WrittenSpan, defaultArg options null)

src/Equinox.Cosmos/Json/JsonRecordConverter.fs

@@ -0,0 +1,154 @@
+namespace Equinox.Cosmos.Json
+
+open System
+open System.Collections.Generic
+open System.Linq.Expressions
+open System.Text.Json
+open System.Text.Json.Serialization
+open FSharp.Reflection
+
+type JsonRecordConverterActivator = delegate of JsonSerializerOptions -> JsonConverter
+
+type IRecordFieldConverter =
+    abstract member Initialize: converter: JsonConverter -> unit
+    abstract member Read: reader: byref<Utf8JsonReader> * typ: Type * options: JsonSerializerOptions -> obj
+    abstract member Write: writer: Utf8JsonWriter * value: obj * options: JsonSerializerOptions -> unit
+
+type RecordFieldConverter<'F> () =
+    let mutable converter = Unchecked.defaultof<JsonConverter<'F>>
+
+    interface IRecordFieldConverter with
+        member __.Initialize (c) =
+            converter <- c :?> JsonConverter<'F>
+
+        member __.Read (reader, typ, options) =
+            converter.Read(&reader, typ, options) :> obj
+
+        member __.Write (writer, value, options) =
+            converter.Write(writer, value :?> 'F, options)
+
+[<NoComparison>]
+type RecordField = {
+    Name: string
+    Type: Type
+    Index: int
+    IsIgnored: bool
+    Converter: IRecordFieldConverter option
+}
+
+type JsonRecordConverter<'T> (options: JsonSerializerOptions) =
+    inherit JsonConverter<'T> ()
+
+    let recordType = typeof<'T>
+
+    let constructor = FSharpValue.PreComputeRecordConstructor(recordType, true)
+    let getFieldValues = FSharpValue.PreComputeRecordReader(typeof<'T>, true)
+
+    let fields =
+        FSharpType.GetRecordFields(recordType, true)
+        |> Array.mapi (fun idx f ->
+            {
+                Name =
+                    f.GetCustomAttributes(typedefof<JsonPropertyNameAttribute>, true)
+                    |> Array.tryHead
+                    |> Option.map (fun attr -> (attr :?> JsonPropertyNameAttribute).Name)
+                    |> Option.defaultWith (fun () ->
+                        if options.PropertyNamingPolicy |> isNull 
+                            then f.Name
+                            else options.PropertyNamingPolicy.ConvertName f.Name)
+
+                Type = f.PropertyType
+                Index = idx
+                IsIgnored = f.GetCustomAttributes(typeof<JsonIgnoreAttribute>, true) |> Array.isEmpty |> not
+                Converter =
+                    f.GetCustomAttributes(typeof<JsonConverterAttribute>, true)
+                    |> Array.tryHead
+                    |> Option.map (fun attr -> attr :?> JsonConverterAttribute)
+                    |> Option.bind (fun attr ->
+                        let baseConverter = attr.CreateConverter(f.PropertyType)
+
+                        if baseConverter |> isNull then
+                            failwithf "Field %s is decorated with a JsonConverter attribute, but it does not implement a CreateConverter method." f.Name
+
+                        if baseConverter.CanConvert(f.PropertyType) then
+                            let converterType = typedefof<RecordFieldConverter<_>>.MakeGenericType(f.PropertyType)
+                            let converter = Activator.CreateInstance(converterType) :?> IRecordFieldConverter
+                            converter.Initialize(baseConverter)
+                            Some converter
+                        else
+                            None
+                    )
+            })
+
+    let fieldsByName =
+        fields
+        |> Array.map (fun f -> f.Name, f)
+        |> Array.map KeyValuePair.Create
+        |> (fun kvp -> Dictionary(kvp, StringComparer.OrdinalIgnoreCase))
+
+    let tryGetFieldByName name =
+        match fieldsByName.TryGetValue(name) with
+        | true, field -> Some field
+        | _ -> None
+
+    let getFieldByName name =
+        match tryGetFieldByName name with
+        | Some field -> field
+        | _ -> KeyNotFoundException(sprintf "Failed to find a field named '%s' on record type '%s'." name recordType.Name) |> raise
+
+    override __.Read (reader, typ, options) =
+        reader.ValidateTokenType(JsonTokenType.StartObject)
+
+        let fields = Array.zeroCreate <| fields.Length
+
+        while reader.Read() && reader.TokenType <> JsonTokenType.EndObject do
+            reader.ValidateTokenType(JsonTokenType.PropertyName)
+
+            match tryGetFieldByName <| reader.GetString() with
+            | Some field -> 
+                fields.[field.Index] <-
+                    match field.Converter with
+                    | Some converter ->
+                        reader.Read() |> ignore
+                        converter.Read(&reader, field.Type, options)
+                    | None ->
+                        JsonSerializer.Deserialize(&reader, field.Type, options)
+            | _ -> 
+                reader.Skip()
+
+        constructor fields :?> 'T
+
+    override __.Write (writer, record, options) =
+        writer.WriteStartObject()
+
+        let fieldValues = getFieldValues record
+
+        (fields, fieldValues)
+        ||> Array.iter2 (fun field value ->
+            match value with
+            | :? JsonElement as je when je.ValueKind = JsonValueKind.Undefined -> ()
+            | _ ->
+                if not field.IsIgnored && not (options.IgnoreNullValues && isNull value) then
+                    writer.WritePropertyName(field.Name)
+
+                    match field.Converter with
+                    | Some converter -> converter.Write(writer, value, options)
+                    | None -> JsonSerializer.Serialize(writer, value, options))
+
+        writer.WriteEndObject()
+
+type JsonRecordConverter () =
+    inherit JsonConverterFactory()
+
+    override __.CanConvert typ =
+        FSharpType.IsRecord (typ, true)
+
+    override __.CreateConverter (typ, options) =
+        let constructor = typedefof<JsonRecordConverter<_>>.MakeGenericType(typ).GetConstructor(typeof<JsonSerializerOptions> |> Array.singleton)
+        let optionsParameter = Expression.Parameter(typeof<JsonSerializerOptions>, "options")
+
+        let newExpression = Expression.New(constructor, optionsParameter)
+        let lambda = Expression.Lambda(typeof<JsonRecordConverterActivator>, newExpression, optionsParameter)
+
+        let activator = lambda.Compile() :?> JsonRecordConverterActivator
+        activator.Invoke(options)

src/Equinox.Cosmos/Json/Options.fs

@@ -0,0 +1,14 @@
+namespace Equinox.Cosmos.Json
+
+open System.Text.Json
+
+[<AutoOpen>]
+module JsonSerializerOptionExtensions =
+    type JsonSerializerOptions with
+        static member Create() =
+            let options = JsonSerializerOptions()
+            options.Converters.Add(new JsonRecordConverter())
+            options
+
+module JsonSerializer =
+    let defaultOptions = JsonSerializerOptions.Create()

src/Equinox.Cosmos/Json/Utf8JsonReaderExtensions.fs

@@ -0,0 +1,22 @@
+namespace Equinox.Cosmos.Json
+
+open System.Text.Json
+open System.Runtime.CompilerServices
+
+[<Extension>]
+type Utf8JsonReaderExtension =
+    [<Extension>]
+    static member ValidateTokenType(reader: Utf8JsonReader, expectedTokenType) =
+        if reader.TokenType <> expectedTokenType then
+            sprintf "Expected a %A token, but encountered a %A token when parsing JSON." expectedTokenType (reader.TokenType)
+            |> JsonException
+            |> raise
+
+    [<Extension>]
+    static member ValidatePropertyName(reader: Utf8JsonReader, expectedPropertyName: string) =
+        reader.ValidateTokenType(JsonTokenType.PropertyName)
+
+        if not <| reader.ValueTextEquals expectedPropertyName then
+            sprintf "Expected a property named '%s', but encounted property with name '%s'." expectedPropertyName (reader.GetString())
+            |> JsonException
+            |> raise

src/Equinox.EventStore/Equinox.EventStore.fsproj

@@ -26,7 +26,7 @@
     <PackageReference Include="FSharp.Core" Version="4.3.4" Condition=" '$(TargetFramework)' == 'netstandard2.0' " />
 
     <PackageReference Include="EventStore.Client" Version="5.0.1" />
-    <PackageReference Include="FsCodec" Version="2.0.0" />
+    <PackageReference Include="FsCodec" Version="2.0.1" />
     <PackageReference Include="FSharp.Control.AsyncSeq" Version="2.0.23" />
   </ItemGroup>
 

src/Equinox.MemoryStore/Equinox.MemoryStore.fsproj

@@ -24,7 +24,7 @@
     <PackageReference Include="FSharp.Core" Version="4.3.4" Condition=" '$(TargetFramework)' == 'netstandard2.0' " />
 
 <!--    only uses FsCodec.Box, which happens to be housed in the NewtonsoftJson package-->
-    <PackageReference Include="FsCodec.NewtonsoftJson" Version="2.0.0" />
+    <PackageReference Include="FsCodec.NewtonsoftJson" Version="2.0.1" />
   </ItemGroup>
 
 </Project>

src/Equinox.SqlStreamStore/Equinox.SqlStreamStore.fsproj

@@ -24,7 +24,7 @@
     <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="FsCodec" Version="2.0.0" />
+    <PackageReference Include="FsCodec" Version="2.0.1" />
     <PackageReference Include="FSharp.Control.AsyncSeq" Version="2.0.23" />
     <PackageReference Include="SqlStreamStore" Version="1.2.0-beta.8" />
   </ItemGroup>