package ocaml-protoc-plugin

  1. Overview
  2. Docs

Source file serialize.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
open StdLabels
open Field

module S = Spec.Make(struct
    type ('a, 'b) dir = ('a, 'b) Spec.serialize
  end)
module C = S.C
open S

(* Take a list of fields and return a field *)
let serialize_message : (int * Field.t) list -> string =
 fun fields ->
  let writer = Writer.init () in
  List.iter ~f:(fun (index, field) -> Writer.write_field writer index field) fields;
  Writer.contents writer

let unsigned_varint v = Field.Varint v

let signed_varint v =
  let open! Infix.Int64 in
  let v =
    match v with
    | v when v < 0L -> v lsl 1 lxor (-1L)
    | v -> v lsl 1
  in
  Field.Varint v


let rec field_of_spec: type a. a spec -> a -> Field.t = function
  | Double -> fun v -> Fixed_64_bit (Int64.bits_of_float v)
  | Float -> fun v -> Fixed_32_bit (Int32.bits_of_float v)
  | Int64 -> unsigned_varint
  | Int64_int -> fun v -> unsigned_varint (Int64.of_int v)
  | UInt64 -> unsigned_varint
  | UInt64_int -> fun v -> unsigned_varint (Int64.of_int v)
  | SInt64 -> signed_varint
  | SInt64_int -> fun v -> signed_varint (Int64.of_int v)

  | Int32 -> fun v -> unsigned_varint (Int64.of_int32 v)
  | Int32_int -> fun v -> unsigned_varint (Int64.of_int v)
  | UInt32 -> fun v -> unsigned_varint (Int64.of_int32 v)
  | UInt32_int -> fun v -> unsigned_varint (Int64.of_int v)
  | SInt32 -> fun v -> signed_varint (Int64.of_int32 v)
  | SInt32_int -> fun v -> signed_varint (Int64.of_int v)

  | Fixed64 -> fixed_64_bit
  | Fixed64_int -> fun v -> Fixed_64_bit (Int64.of_int v)
  | SFixed64 -> fixed_64_bit
  | SFixed64_int -> fun v -> Fixed_64_bit (Int64.of_int v)
  | Fixed32 -> fixed_32_bit
  | Fixed32_int -> fun v -> Fixed_32_bit (Int32.of_int v)
  | SFixed32 -> fixed_32_bit
  | SFixed32_int -> fun v -> Fixed_32_bit (Int32.of_int v)

  | Bool -> fun v -> unsigned_varint (match v with | true -> 1L | false -> 0L)
  | String -> fun v -> Length_delimited {offset = 0; length = String.length v; data = v}
  | Bytes -> fun v -> Length_delimited {offset = 0; length = Bytes.length v; data = Bytes.to_string v}
  | Enum f ->
    let to_field = field_of_spec UInt64 in
    fun v -> f v |> Int64.of_int |> to_field
  | Message to_proto ->
    fun v ->
      let writer = to_proto v in
      Field.length_delimited (Writer.contents writer)


let is_scalar: type a. a spec -> bool = function
  | String -> false
  | Bytes -> false
  | Message _ -> false
  | _ -> true

let rec write: type a. a compound -> Writer.t -> a -> unit = function
  | Basic (index, Message (to_proto), _) -> begin
      fun writer v ->
      let v = to_proto v in
      Writer.concat_as_length_delimited writer ~src:v index
    end
  | Repeated (index, Message to_proto, _) ->
    let write = write (Basic (index, Message to_proto, Required)) in
    fun writer vs -> List.iter ~f:(fun v -> write writer v) vs
  | Repeated (index, spec, Packed) when is_scalar spec -> begin
      let f = field_of_spec spec in
      fun writer -> function
      | [] -> ()
      | vs ->
        let writer' = Writer.init () in
        List.iter ~f:(fun v -> Writer.add_field writer' (f v)) vs;
        Writer.concat_as_length_delimited writer ~src:writer' index
    end
  | Repeated (index, spec, _) ->
      let f = field_of_spec spec in
      fun writer vs -> List.iter ~f:(fun v -> Writer.write_field writer index (f v)) vs
  | Basic (index, spec, default) -> begin
      let f = field_of_spec spec in
      match default with
      | Proto3 -> begin
          fun writer v -> match f v with
            | Varint 0L -> ()
            | Fixed_64_bit 0L -> ()
            | Fixed_32_bit 0l -> ()
            | Length_delimited {length = 0; _} -> ()
            | field -> Writer.write_field writer index field
        end
      | Proto2 _
      | Required -> fun writer v -> Writer.write_field writer index (f v)
    end
  | Basic_opt (index, spec) -> begin
    let f = field_of_spec spec in
    fun writer -> function
      | Some v -> Writer.write_field writer index (f v)
      | None -> ()
  end
  | Oneof f ->
    fun writer v ->
      let Oneof_elem (index, spec, v) = f v in
      write (Basic (index, spec, Required)) writer v

(** Allow emitted code to present a protobuf specification. *)
let rec serialize : type a. (a, Writer.t) compound_list -> Writer.t -> a = function
  | Nil -> fun writer -> writer
  | Cons (compound, rest) ->
    let cont = serialize rest in
    let write = write compound in
    fun writer v ->
      write writer v;
      cont writer

let serialize spec =
  let serialize = serialize spec in
  fun () -> serialize (Writer.init ())


module Test = struct
  let test () =
    let (_:bool) = signed_varint 0L = Varint 0L || failwith "signed_varint 0L" in
    let (_:bool) = signed_varint (-1L) = Varint 1L || failwith "signed_varint -1L" in
    let (_:bool) = signed_varint 1L = Varint 2L || failwith "signed_varint 1L" in
    let (_:bool) = signed_varint (-2L) = Varint 3L || failwith "signed_varint -2L" in
    let (_:bool) = signed_varint 2147483647L = Varint 4294967294L || failwith "signed_varint 2147483647L" in
    let (_:bool) = signed_varint (-2147483648L) = Varint 4294967295L || failwith "signed_varint -2147483648L" in
    ()
end
OCaml

Innovation. Community. Security.