Test reference json decoding, and drop use of ctypes

ocaml-protoc-plugin.opam

@@ -24,7 +24,6 @@ depends: [
   "bisect_ppx" {with-test}
   "odoc" {with-doc}
   "conf-pkg-config" {build}
-  "ctypes-foreign" {with-test}
   "dune-configurator" {with-test}
   "yojson"
   "base64"

test/dune

@@ -24,18 +24,15 @@
 (library
  (name test)
  (enabled_if (and (<> %{architecture} x86_32) (<> %{architecture} arm32)))
- (libraries ocaml_protoc_plugin google_types_pp yojson ctypes-foreign)
- (inline_tests
-  (deps google_include)
-  (executable (link_flags -linkall -cclib -l:libtest_stubs.a -cclib -lprotobuf -cclib "-u protobuf2json")))
+ (libraries ocaml_protoc_plugin google_types_pp yojson)
+ (inline_tests (deps google_include))
  (modules :standard \ proto3_optional_test_opt)
- (preprocess
-  (pps ppx_expect ppx_deriving.show ppx_deriving.eq))
-
+ (preprocess (pps ppx_expect ppx_deriving.show ppx_deriving.eq))
  (foreign_stubs
   (language cxx)
   (names protobuf2json)
   (flags (:include c_flags.sexp) -fPIC))
+ (c_library_flags (-lprotobuf -lstdc++))
 )
 
 (rule

test/json_encoding_test.ml

@@ -45,6 +45,7 @@ let%expect_test _ =
   [%expect {|
     timestamp {
     }
+    Generated json not equal
     Json: { "timestamp": "1970-01-01T00:00:00.000000000Z" }
     Ref:  { "timestamp": "1970-01-01T00:00:00Z" }
     timestamp {
@@ -56,6 +57,7 @@ let%expect_test _ =
     timestamp {
       seconds: 1709985346
     }
+    Generated json not equal
     Json: { "timestamp": "2024-03-09T11:55:46.000000000Z" }
     Ref:  { "timestamp": "2024-03-09T11:55:46Z" }
     timestamp {

test/map_test.ml

@@ -89,6 +89,7 @@ let%expect_test _ =
       value: 3
     }
     Cannot deserialize reference json.
+    Generated json not equal
     Json: {
       "m": { "0": "10", "1": "1", "2": "2", "3": "3" },
       "n": { "0": 0, "1": 1, "2": 2, "3": 3 }
@@ -182,6 +183,7 @@ let%expect_test _ =
       }
     }
     Cannot deserialize reference json.
+    Generated json not equal
     Json: {
       "m": {
         "0": {},

test/packed_test.ml

@@ -68,5 +68,11 @@ let%expect_test "Empty lists are not transmitted" =
   |> Printf.eprintf "Size packed %d\n";
   ();
   [%expect {|
+    Generated json not equal
+    Json: { "i": [] }
+    Ref:  {}
+    Generated json not equal
+    Json: { "i": [] }
+    Ref:  {}
     Size packed 0
     Size packed 0 |}]

test/protobuf2json.cc

@@ -1,7 +1,7 @@
-// pkgconf --libs protobuf
-
-// g++ -o bpjson bpjson.cc `pkgconf --libs protobuf
-// ./bpjson <proto_file> <message type> < <binary data>
+/** Stub for reference implementation of
+    json -> protobuf
+    protobuf -> json
+*/
 
 #include <google/protobuf/util/type_resolver_util.h>
 #include <google/protobuf/util/json_util.h>
@@ -14,11 +14,13 @@
 #include <sstream>
 #include <filesystem>
 
-#include <string.h>
-using namespace google::protobuf;
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
 
+using namespace google::protobuf;
 
-util::TypeResolver * make_resolver(const char* include, const char* proto_file) {
+util::TypeResolver* make_resolver(const char* include, const char* proto_file) {
     auto source_tree = new compiler::DiskSourceTree();
     source_tree->MapPath("", ".");
     source_tree->MapPath("", include);
@@ -41,20 +43,11 @@ std::string make_url(const char * type) {
     return std::string("type.googleapis.com/") + std::string(type);
 }
 
-char* status_to_string(const util::Status& status, const std::string& output_str) {
-    if (status.ok()) {
-        return strdup(output_str.c_str());
-    } else {
-        std::string s = status.ToString();
-        return strdup(s.c_str());
-    }
-}
-
-extern "C" char* protobuf2json(const char *google_include_path, const char* proto_file, const char* type, const void* in_data, int data_length) {
-    std::string url = make_url(type);
-    auto resolver = make_resolver(google_include_path, proto_file);
+extern "C" CAMLprim value protobuf2json(value google_include_path, value proto_file, value type, value data) {
+    std::string url = make_url(String_val(type));
+    auto resolver = make_resolver(String_val(google_include_path), String_val(proto_file));
 
-    io::ArrayInputStream input(in_data, data_length);
+    io::ArrayInputStream input(String_val(data), caml_string_length(data));
     std::string output_str;
     io::StringOutputStream output(&output_str);
 
@@ -63,23 +56,33 @@ extern "C" char* protobuf2json(const char *google_include_path, const char* prot
     //options.always_print_primitive_fields = true;
     auto status = BinaryToJsonStream(
         resolver, url, &input, &output, options);
-    return status_to_string(status, output_str);
+
+    if (!status.ok()) {
+        std::string msg = status.ToString();
+        caml_invalid_argument(msg.c_str());
+    }
+    return caml_alloc_initialized_string(output_str.size(), output_str.c_str());
 }
 
-extern "C" char* json2protobuf(const char *google_include_path, const char* proto_file, const char* type, const void* in_data, int data_length) {
-    std::string url = make_url(type);
-    auto resolver = make_resolver(google_include_path, proto_file);
+extern "C" CAMLprim value json2protobuf(value google_include_path, value proto_file, value type, value data) {
+    int data_length = caml_string_length(data);
+
+    std::string url = make_url(String_val(type));
+    auto resolver = make_resolver(String_val(google_include_path), String_val(proto_file));
 
-    io::ArrayInputStream input(in_data, data_length);
+    io::ArrayInputStream input(String_val(data), caml_string_length(data));
     std::string output_str;
     io::StringOutputStream output(&output_str);
 
     util::JsonParseOptions options;
     options.ignore_unknown_fields = true;
-    //options.always_print_primitive_fields = true;
 
     auto status = JsonToBinaryStream(
         resolver, url, &input, &output, options);
-    return status_to_string(status, output_str);
-    // This function should return the length of the buffer also.
+
+    if (!status.ok()) {
+        std::string msg = status.ToString();
+        caml_invalid_argument(msg.c_str());
+    }
+    return caml_alloc_initialized_string(output_str.size(), output_str.c_str());
 }

test/test_lib.ml

@@ -3,25 +3,30 @@ open Ocaml_protoc_plugin
 
 
 module Reference = struct
-  open Ctypes
-  open Foreign
   let google_include_path =
     let ch = open_in "google_include" in
     let include_path = input_line ch in
     close_in ch;
     include_path
 
-  (* extern "C" char* protobuf2json(const char *google_include_dir, const char* proto_file, const char* type, const char* in_data)  *)
-  let protobuf2json = foreign "protobuf2json" (string @-> string @-> string @-> string @-> int @-> returning string)
+  external protobuf2json : string -> string -> string -> string -> string = "protobuf2json"
   let to_json ~proto_file ~message_type data =
-    protobuf2json google_include_path proto_file message_type data (String.length data)
+    protobuf2json google_include_path proto_file message_type data
+    |> Yojson.Basic.from_string
+
+  external json2protobuf : string -> string -> string -> string -> string = "json2protobuf"
+  let from_json ~proto_file ~message_type json =
+    let data = Yojson.Basic.to_string json in
+    json2protobuf google_include_path proto_file message_type data
+
 end
 
 module type T = sig
   type t [@@deriving show, eq]
   val to_proto' : Writer.t -> t -> unit
   val to_proto : t -> Writer.t
   val from_proto : Reader.t -> t Result.t
+  val from_proto_exn : Reader.t -> t
   val name : unit -> string
   val merge: t -> t -> t
   val to_json: Json_options.t -> t -> Yojson.Basic.t
@@ -76,31 +81,24 @@ let test_merge (type t) (module M : T with type t = t) (t: t) =
   in
   ()
 
-let test_json ~debug ?proto_file (type t) (module M : T with type t = t) (t: t) =
+let test_json ~debug ?(proto_file="") (type t) (module M : T with type t = t) (t: t) =
+  let message_type =
+    match M.name () |> String.split_on_char ~sep:'.' with
+    | _ :: tl ->
+      let message_type = String.concat ~sep:"." tl in
+      message_type
+    | _ -> failwith "Illegal name"
+  in
   ignore debug;
   let json_ref t =
-    let message_type =
-      (* Nice. We can get the name of the file. in which this is defined.  Wonder if there is a different way of doing that! *)
-      match M.name () |> String.split_on_char ~sep:'.' with
-      | _ :: tl ->
-        let message_type = String.concat ~sep:"." tl in
-        message_type
-      | _ -> failwith "Illegal name"
-    in
     let proto = M.to_proto t |> Writer.contents in
-    let proto_file = match proto_file with
-      | None -> ""
-      | Some proto_file -> proto_file
-    in
-    let json = Reference.to_json ~proto_file ~message_type proto in
     try
-      Yojson.Basic.from_string json
+      Reference.to_json ~proto_file ~message_type proto
     with
     | _ ->
-      Printf.printf "Unable to parse reference json:\n  '%s'\n" json;
+      Printf.printf "Unable to parse reference json";
       failwith "Could not parse reference json"
   in
-
   let test_json ?enum_names ?json_names ?omit_default_values t =
     let compare ~message t json =
       match (M.from_json_exn json = t) with
@@ -123,13 +121,24 @@ let test_json ~debug ?proto_file (type t) (module M : T with type t = t) (t: t)
     t
   in
   (* Compare reference json *)
-  let () = try
+  let () =
+    try
       let json' = json_ref t in
       let t' = M.from_json_exn json' in
+      let json = M.to_json Json_options.default t in
+      let t'' =
+        Reference.from_json ~proto_file ~message_type json
+        |> Reader.create
+        |> M.from_proto_exn
+      in
       if t <> t' then Printf.printf "Cannot deserialize reference json.\n";
-      if t <> t' || debug then
+      if t <> t'' then Printf.printf "Cannot deserialize generated json.\n";
+      if (not (Yojson.Basic.equal json' json)) then
+        Printf.printf "Generated json not equal\n";
+
+      if (not (Yojson.Basic.equal json' json) || t <> t' || t <> t'' || debug) then
         Printf.printf "Json: %s\nRef:  %s\n"
-          (Yojson.Basic.pretty_to_string (M.to_json (Json_options.default) t))
+          (Yojson.Basic.pretty_to_string json)
           (Yojson.Basic.pretty_to_string json');
     with
     | exn -> Printf.printf "Cannot deserialize reference json\n  Error: %s\n" (Printexc.to_string exn);