Serializing F# discriminated unions with protobuf

Question

Is there some way to get protobuf to serialize/deserialize F#\'s discriminated unions?

I\'m trying to serialize messages with protobuf. Messages are F# records and d

Answer 1

I spiked using protobuf-net for event sourcing DUs and am very appreciative of json.net v6's seamless support for DUs.

The reasons I relented on my initial desire to use protobuf-net in preference are:

1. I never got to prove the perf gap I was seeking

2. My desire to be resilient against field renaming (relying on addressing being via [<ProtoMember(n)>]) in my message contracts are mitigated by the combination of:

   • field name aliasing (i.e. using attributed to tell F# to compile under the old name)
   • the ability to use the strengths of DUs Pattern matching to version events by adding in EventXXXV2 alongside EventXxx in the same DU

And I didnt find a cleaner way than:

let registerSerializableDuInModel<'TMessage> (model:RuntimeTypeModel) =
    let baseType = model.[typeof<'TMessage>]
    for case in typeof<'TMessage> |> FSharpType.GetUnionCases do
        let caseType = case.Name |> case.DeclaringType.GetNestedType 
        baseType.AddSubType(1000 + case.Tag, caseType) |> ignore
        let caseTypeModel = model.[caseType]
        caseTypeModel.Add("item").UseConstructor <- false
    baseType.CompileInPlace()

let registerSerializableDu<'TMessage> () = registerSerializableDuInModel<'TMessage> RuntimeTypeModel.Default

registerSerializableDu<Message> ()

to address the need for [<ProtoInclude(100, "ProtoBufTests+Message+MessageA")>] cruft. (I'm still pondering whether what mix of F# and protbuf-net improvements would best address that)

A pretty important difference is lack of need for [<ProtoContract; CLIMutable>] sprinklage (in addition to the ProtoInclude and ProtoMember ones).

Code dump:

module FunDomain.Tests.ProtobufNetSerialization

open ProtoBuf
open ProtoBuf.Meta

open Swensen.Unquote
open Xunit

open System.IO
open Microsoft.FSharp.Reflection

[<ProtoContract; CLIMutable>]
type MessageA = {
    [<ProtoMember(1)>] X: string;
    [<ProtoMember(2)>] Y: int option;
}

[<ProtoContract>]
[<CLIMutable>]
type MessageB = {
    [<ProtoMember(1)>] A: string;
    [<ProtoMember(2)>] B: string;
}

[<ProtoContract>]
type Message =
    | MessageA of MessageA
    | MessageB of MessageB

let serialize msg =
    use ms = new MemoryStream()
    Serializer.SerializeWithLengthPrefix(ms, msg, PrefixStyle.Fixed32)
    ms.ToArray()

let deserialize<'TMessage> bytes =
    use ms = new MemoryStream(buffer=bytes)
    Serializer.DeserializeWithLengthPrefix<'TMessage>(ms, PrefixStyle.Fixed32)

let registerSerializableDuInModel<'TMessage> (model:RuntimeTypeModel) =
    let baseType = model.[typeof<'TMessage>]
    for case in typeof<'TMessage> |> FSharpType.GetUnionCases do
        let caseType = case.Name |> case.DeclaringType.GetNestedType 
        baseType.AddSubType(1000 + case.Tag, caseType) |> ignore
        let caseTypeModel = model.[caseType]
        caseTypeModel.Add("item").UseConstructor <- false
    baseType.CompileInPlace()

let registerSerializableDu<'TMessage> () = registerSerializableDuInModel<'TMessage> RuntimeTypeModel.Default

registerSerializableDu<Message> ()

let [<Fact>] ``MessageA roundtrips with null`` () =
    let msg = {X=null; Y=None}
    let result = serialize msg
    test <@ msg = deserialize result @>

let [<Fact>] ``MessageA roundtrips with Empty`` () =
    let msg = {X=""; Y=None}
    let result = serialize msg
    test <@ msg = deserialize result @>

let [<Fact>] ``MessageA roundtrips with Some`` () =
    let msg = {X="foo"; Y=Some 32}
    let result = serialize msg
    test <@ msg = deserialize result @>

let [<Fact>] ``MessageA roundtrips with None`` () =
    let msg = {X="foo"; Y=None}
    let result = serialize msg
    test <@ msg = deserialize result @>

let [<Fact>] ``MessageB roundtrips`` () =
    let msg = {A="bar"; B="baz"}
    let result = serialize msg
    test <@ msg = deserialize result @>

let [<Fact>] ``roundtrip pair``() =
    let msg1 = MessageA {X="foo"; Y=Some 32}
    let msg1' = msg1 |> serialize |> deserialize
    test <@ msg1' = msg1 @>

    let msg2 = MessageB {A="bar"; B="baz"}     
    let msg2' = msg2 |> serialize |> deserialize
    test <@ msg2' = msg2 @>

let [<Fact>] many() =
    for _ in 1..1000 do
        ``roundtrip pair``()      

Answer 2

What I ended up doing is something like this

    let typeModel = TypeModel.Create()
    let resultType = typedefof<Result>
    let resultNestedTypes = resultType.GetNestedTypes() |> Array.filter (fun x -> x.Name <> "Tags")
    for nestedType in resultNestedTypes do 
        let model = typeModel.Add( nestedType, true )
        model.UseConstructor <- false
        nestedType.GetFields( BindingFlags.NonPublic ||| BindingFlags.Instance ||| BindingFlags.GetField ) |> Array.map (fun x -> x.Name ) |> Array.sort |> model.Add |> ignore

        types.[ nestedType.Name ] <- nestedType

In my case types is dictionary of the union types built when app is launched. I would need to save the name in the message before the serialized data to be able to load it later.

This will work as long as only new fields are added, since each field becomes item1. If there's a need to delete fields I think it could be pretty easily expanded to take the field order number from the field name like so

type Result = 
    | Success of Item1: string * Item3:bool
    | Failure of string

And extract the number after Item, or whatever will work the best. There're numerous approaches.

Answer 3

I've played with your very helpful generated output, and it looks like basically everything works - except the Message.MessageA sub-types. These very nearly work - they are essentially the same as the "auto-tuple" code (a constructor that matches all members), except that auto-tuples doesn't currently apply to sub-types.

I think it should be possible to tweak the code to work automatically, by extending the auto-tuple code to work in this scenario (I'm trying to think of any possible bad side-effects of that, but I'm not seeing any). I don't have a specific time-frame, as I need to balance time between multiple projects and a full-time day-job, and a family, and volunteer work, and (etc etc).

In the short term, the following C# is sufficient to make it work, but I don't expect this will be an attractive option:

RuntimeTypeModel.Default[typeof(Message).GetNestedType("MessageA")]
                .Add("item").UseConstructor = false;
RuntimeTypeModel.Default[typeof(Message).GetNestedType("MessageB")]
                .Add("item").UseConstructor = false;

As an aside, the attributes here are unhelpful and should be avoided:

| [<ProtoMember(1)>] MessageA of MessageA
| [<ProtoMember(2)>] MessageB of MessageB

If they did anything, they would be duplicating the intent of <ProtoInclude(n)>. If it is more convenient to specify them there, that might be interesting, though. But what I find really interesting about that is that the F# compiler completely ignores the AttributeUsageAttribute, which for [ProtoMember] is:

[AttributeUsage(AttributeTargets.Property | AttributeTargets.Field,
    AllowMultiple = false, Inherited = true)]
public class ProtoMemberAttribute {...}

Yes the F# compiler clearly stuck that (illegally) on a method:

[ProtoMember(1)]
[CompilationMapping(SourceConstructFlags.UnionCase, 0)]
public static ProtoBufTests.Message NewMessageA(ProtoBufTests.MessageA item)

naughty F# compiler!