Add metadata for gRPC reflection API

README.md

@@ -120,6 +120,7 @@ can generate the Ocaml code by running
 | singleton\_record    | Messages with only one field will be wrapped in a record        | `singleton_record=true`      | false   |
 | prefix\_output\_with\_package | Emit files prefixed with their package name. This allows multiple protofiles of the same name with different package names to be used | `prefix_output_with_package=true`[^5] | false |
 | singleton\_oneof\_as\_option | Oneof declarations only containing one field are mapped to a single optional field | singleton\_oneof\_as\_option=false | true |
+| service\_info        | Include file descriptors, source proto file path and list of its services in generated code | `service_info=true`          | false   |
 
 Parameters are separated by `;`
 

examples/echo/dune

@@ -13,7 +13,7 @@
  (deps
   (:proto echo.proto) (package ocaml-protoc-plugin))
  (action
-  (run protoc -I %{read-lines:google_include} -I . "--ocaml_out=open=Google_types:." %{proto})))
+  (run protoc -I %{read-lines:google_include} -I . "--ocaml_out=open=Google_types;service_info=true:." %{proto})))
 (rule
  (deps test.exe)
  (action (ignore-stdout (run %{deps})))

examples/echo/test.ml

@@ -51,4 +51,5 @@ let () =
   let name = Echo.Echo.package_service_name in
   let request = mk_request () in
   let reply = do_request ~handler:handle_request request in
-  Printf.printf "Reply to %s: %s\n" name reply
+  Printf.printf "Reply to %s: %s\n" name reply;
+  assert (List.mem Echo.Echo.package_service_name Service_info.package_service_names)

src/ocaml_protoc_plugin/service.ml

@@ -28,3 +28,9 @@ let make_service_functions (type req) (type rep)
     ((module Request : Spec.Message with type t = req),
     (module Response : Spec.Message with type t = rep)) =
   Request.from_proto, Response.to_proto
+
+module type Service_info = sig
+  val file_name : string
+  val file_descriptor_proto : string
+  val package_service_names : string list
+end

src/plugin/emit.ml

@@ -153,6 +153,7 @@ let emit_service_type ~scope ~comment_db ~type_db ServiceDescriptorProto.{ name;
     | "" :: packages | packages ->
        (String.concat ~sep:"." packages) ^ "." ^ name
   in
+
   let signature = Code.init () in
   let implementation = Code.init () in
   Code.emit_comment ~position:`Leading signature (Comment_db.get_service_comments comment_db ~proto_path ~name);
@@ -166,7 +167,7 @@ let emit_service_type ~scope ~comment_db ~type_db ServiceDescriptorProto.{ name;
   Code.emit signature `None "";
   Code.emit implementation `End "end%s" (Code.append_deprecaton_if ~deprecated `Item "");
   Code.emit implementation `None "";
-  signature, implementation
+  signature, implementation, package_service_name
 
 let emit_extension ~scope ~params ~comment_db ~type_db field =
   let FieldDescriptorProto.{ name; extendee; options; _ } = field in
@@ -392,22 +393,23 @@ let rec wrap_packages ~params ~syntax ~options ~comment_db ~type_db ~scope messa
   | [] ->
     let { module_name = _; implementation; signature; deprecated = _; comments = _ } =
       emit_message ~params ~syntax ~scope ~comment_db ~type_db message_type in
-    List.iter ~f:(fun service ->
-      let signature', implementation' = emit_service_type ~scope ~type_db ~comment_db service in
-      Code.append implementation implementation';
-      Code.append signature signature';
-      ()
-    ) services;
-    signature, implementation
-
+    let package_service_names =
+      List.map ~f:(fun service ->
+        let signature', implementation', package_service_name = emit_service_type ~scope ~type_db ~comment_db service in
+        Code.append implementation implementation';
+        Code.append signature signature';
+        package_service_name
+      ) services
+    in
+    signature, implementation, package_service_names
   | package :: packages ->
     let signature = Code.init () in
     let implementation = Code.init () in
     let proto_path = Scope.get_proto_path scope in
     let package_name = Type_db.get_package_name type_db ~proto_path package in
     let scope = Scope.push scope package in
 
-    let signature', implementation' =
+    let signature', implementation', package_service_names =
       wrap_packages ~params ~syntax ~options ~scope ~type_db ~comment_db message_type services packages
     in
     Code.emit implementation `Begin "module rec %s : sig" package_name;
@@ -418,7 +420,7 @@ let rec wrap_packages ~params ~syntax ~options ~comment_db ~type_db ~scope messa
     Code.emit signature `Begin "module rec %s : sig" package_name;
     Code.append signature signature';
     Code.emit signature `End "end";
-    signature, implementation
+    signature, implementation, package_service_names
 
 
 let emit_header implementation ~proto_name ~syntax ~params =
@@ -446,6 +448,16 @@ let emit_header implementation ~proto_name ~syntax ~params =
   (* Code.emit implementation `None "%s" (Code.append_deprecaton_if ~deprecated `Floating ""); *)
   ()
 
+let emit_service_info implementation fd file_name package_service_names =
+  let file_descriptor_bytes = Spec.Descriptor.Google.Protobuf.FileDescriptorProto.to_proto fd |> Ocaml_protoc_plugin.Writer.contents |> String.escaped in
+  Code.emit implementation `Begin "module Service_info : Runtime'.Service.Service_info = struct";
+  Code.emit implementation `None {|let file_name = "%s"|} file_name;
+  Code.emit implementation `None {|let file_descriptor_proto = "%s"|} file_descriptor_bytes;
+  Code.emit implementation `Begin "let package_service_names = [";
+  List.iter ~f:(fun name -> Code.emit implementation `None {|"%s";|} name) package_service_names;
+  Code.emit implementation `End "]";
+  Code.emit implementation `End "end"
+
 let parse_proto_file ~params ~scope ~type_db filedescriptorproto =
   let FileDescriptorProto.{ name = proto_name; package; dependency = dependencies;
                             public_dependency = _;
@@ -483,13 +495,15 @@ let parse_proto_file ~params ~scope ~type_db filedescriptorproto =
   Code.emit implementation `End "end";
   Code.emit implementation `None "(**/**)";
 
-  let _signature', implementation' =
+  let _signature', implementation', package_service_names =
     wrap_packages ~params ~syntax ~options ~scope ~type_db ~comment_db message_type services (Option.value_map ~default:[] ~f:(String.split_on_char ~sep:'.') package)
   in
 
   Code.append implementation implementation';
   Code.emit implementation `None "";
 
+  emit_service_info implementation filedescriptorproto proto_name package_service_names;
+
   let output_file_name =
     Type_db.get_module_name type_db proto_name
     |> String.uncapitalize_ascii

src/plugin/parameters.ml

@@ -10,6 +10,7 @@ type t = {
   singleton_record: bool;
   prefix_output_with_package: bool;
   singleton_oneof_as_option: bool;
+  service_info: bool;
 }
 
 let default = {
@@ -22,6 +23,7 @@ let default = {
   singleton_record = false;
   prefix_output_with_package = false;
   singleton_oneof_as_option = true;
+  service_info = false;
 }
 
 let parse_option str =
@@ -44,6 +46,7 @@ let parse parameters =
       | `Stmt "debug" -> { param with debug = true}
       | `Expr ("prefix_output_with_package", (("true"|"false") as v)) -> { param with prefix_output_with_package = (bool_of_string v)}
       | `Expr ("singleton_oneof_as_option", (("true"|"false") as v)) -> { param with singleton_oneof_as_option = (bool_of_string v)}
+      | `Expr ("service_info", (("true"|"false") as v)) -> { param with service_info = (bool_of_string v)}
       | `Stmt "" -> param
       | _ -> failwith ("Unknown parameter: " ^ option)
     )

test/dune

@@ -142,3 +142,13 @@
        "--experimental_allow_proto3_optional"
        "--plugin=protoc-gen-ocaml=%{plugin}"
        "--ocaml_out=open=Google_types_pp;open=Test_runtime;annot=[@@deriving show { with_path = false }, eq]:." %{proto})))
+
+(rule
+ (targets reflection.ml reflection_parts.ml)
+ (deps
+  (:plugin %{bin:protoc-gen-ocaml})
+  (:proto reflection.proto reflection_parts.proto))
+ (action
+  (run %{bin:protoc} -I %{read-lines:google_include} -I .
+       "--plugin=protoc-gen-ocaml=%{plugin}"
+       "--ocaml_out=open=Google_types_pp;service_info=true:." %{proto})))

test/reflection.proto

@@ -0,0 +1,10 @@
+syntax = "proto3";
+
+package test.reflection;
+import "reflection_parts.proto";
+
+service EmptyService { }
+
+service SomeService {
+  rpc Call (test.reflection_parts.Request) returns (test.reflection_parts.Response);
+}

test/reflection_parts.proto

@@ -0,0 +1,9 @@
+syntax = "proto3";
+
+package test.reflection_parts;
+
+message Request {
+  uint64 i = 1;
+}
+
+message Response { }

test/reflection_test.ml

@@ -0,0 +1,39 @@
+open Ocaml_protoc_plugin
+
+module S = Reflection
+module P = Reflection_parts
+
+let%test _ =
+  S.Service_info.file_name = "reflection.proto"
+
+let%test _ =
+  S.Service_info.package_service_names = [ "test.reflection.EmptyService"; "test.reflection.SomeService" ]
+
+let%test _ =
+  P.Service_info.file_name ="reflection_parts.proto" 
+
+let%test _ =
+  List.is_empty P.Service_info.package_service_names
+
+let%test_module "Construct service_info by itself" = (module
+  struct
+    open Google_types_pp.Descriptor.Google.Protobuf
+    let spec = Reader.create S.Service_info.file_descriptor_proto |> FileDescriptorProto.from_proto_exn
+    let fd = FileDescriptorProto.to_proto spec |> Writer.contents |> String.escaped
+
+    let package = Option.value spec.package ~default:""
+
+    let%test "file_name" =
+      spec.name = Some S.Service_info.file_name
+
+    let%test "file_descriptor_proto" =
+      fd = String.escaped S.Service_info.file_descriptor_proto
+
+    let%test "package_service_names" =
+      let services =
+        spec.service
+        |> List.map
+        @@ fun ServiceDescriptorProto.{name; _} -> Option.fold name ~none:"" ~some:(Printf.sprintf "%s.%s" package)
+      in
+      services = S.Service_info.package_service_names
+  end)