From e04a2e20ab071d55b7b1f073d6df7dde7831ec99 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Thu, 23 Nov 2023 17:13:03 +0100 Subject: [PATCH 01/12] draft --- .../greeter-client-eio/greeter_client_eio.ml | 24 +- .../greeter-server-eio/greeter_server_eio.ml | 37 +-- examples/routeguide-tutorial.md | 313 +++++++----------- examples/routeguide/src/client.ml | 79 +---- examples/routeguide/src/server.ml | 239 ++++++------- lib/grpc-eio/client.ml | 98 ++++++ lib/grpc-eio/client.mli | 40 +++ lib/grpc-eio/dune | 2 +- lib/grpc-eio/protoc_rpc.ml | 30 ++ lib/grpc-eio/protoc_rpc.mli | 17 + lib/grpc-eio/server.ml | 114 +++++++ lib/grpc-eio/server.mli | 67 ++++ 12 files changed, 621 insertions(+), 439 deletions(-) create mode 100644 lib/grpc-eio/protoc_rpc.ml create mode 100644 lib/grpc-eio/protoc_rpc.mli diff --git a/examples/greeter-client-eio/greeter_client_eio.ml b/examples/greeter-client-eio/greeter_client_eio.ml index c8b0530..3104642 100644 --- a/examples/greeter-client-eio/greeter_client_eio.ml +++ b/examples/greeter-client-eio/greeter_client_eio.ml @@ -19,31 +19,23 @@ let main env = H2_eio.Client.create_connection ~sw ~error_handler:ignore socket in - let open Ocaml_protoc_plugin in let open Greeter.Mypackage in - let encode, decode = Service.make_client_functions Greeter.sayHello in - let encoded_request = - HelloRequest.make ~name () |> encode |> Writer.contents - in + let request = HelloRequest.make ~name () in - let f decoder = - match decoder with - | Some decoder -> ( - Reader.create decoder |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e))) + let f response = + match response with + | Some response -> response | None -> Greeter.SayHello.Response.make () in let result = - Grpc_eio.Client.call ~service:"mypackage.Greeter" ~rpc:"SayHello" + Grpc_eio.Client.Typed_rpc.call + (module Greeter.SayHello) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler:(Grpc_eio.Client.Rpc.unary encoded_request ~f) + ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) () in + Eio.Promise.await (H2_eio.Client.shutdown connection); result in diff --git a/examples/greeter-server-eio/greeter_server_eio.ml b/examples/greeter-server-eio/greeter_server_eio.ml index 16aaba0..95fa58c 100644 --- a/examples/greeter-server-eio/greeter_server_eio.ml +++ b/examples/greeter-server-eio/greeter_server_eio.ml @@ -1,22 +1,16 @@ open Grpc_eio -let say_hello buffer = - let open Ocaml_protoc_plugin in - let open Greeter.Mypackage in - let decode, encode = Service.make_service_functions Greeter.sayHello in - let request = - Reader.create buffer |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" (Result.show_error e)) - in - let message = - if request = "" then "You forgot your name!" - else Format.sprintf "Hello, %s!" request - in - let reply = Greeter.SayHello.Response.make ~message () in - (Grpc.Status.(v OK), Some (encode reply |> Writer.contents)) +let say_hello = + let module SayHello = Greeter.Mypackage.Greeter.SayHello in + Grpc_eio.Server.Typed_rpc.unary + (module SayHello) + ~f:(fun request -> + let message = + if request = "" then "You forgot your name!" + else Format.sprintf "Hello, %s!" request + in + let reply = SayHello.Response.make ~message () in + (Grpc.Status.(v OK), Some reply)) let connection_handler server sw = let error_handler client_address ?request:_ _error start_response = @@ -59,12 +53,5 @@ let serve server env = listen () let () = - let greeter_service = - Server.Service.( - v () |> add_rpc ~name:"SayHello" ~rpc:(Unary say_hello) |> handle_request) - in - let server = - Server.( - v () |> add_service ~name:"mypackage.Greeter" ~service:greeter_service) - in + let server = Server.Typed_rpc.server [ say_hello ] in Eio_main.run (serve server) diff --git a/examples/routeguide-tutorial.md b/examples/routeguide-tutorial.md index 96128be..d2e0ba9 100644 --- a/examples/routeguide-tutorial.md +++ b/examples/routeguide-tutorial.md @@ -192,20 +192,9 @@ The individual service functions from our proto definition are implemented using ```ocaml -let route_guide_service clock = - Server.Service.( - v () - |> add_rpc ~name:"GetFeature" ~rpc:(Unary get_feature) - |> add_rpc ~name:"ListFeatures" ~rpc:(Server_streaming list_features) - |> add_rpc ~name:"RecordRoute" ~rpc:(Client_streaming (record_route clock)) - |> add_rpc ~name:"RouteChat" ~rpc:(Bidirectional_streaming route_chat) - |> handle_request) - -let server clock = - Server.( - v () - |> add_service ~name:"routeguide.RouteGuide" - ~service:(route_guide_service clock)) +let server t clock = + Server.Typed_rpc.server + [ get_feature t; list_features t; record_route t clock; route_chat t ] ``` ### Simple RPC @@ -214,36 +203,28 @@ Let's look at the simplest type first, `GetFeature` which just gets a `Point` fr ```ocaml -let get_feature (buffer : string) = - let decode, encode = Service.make_service_functions RouteGuide.getFeature in - (* Decode the request. *) - let point = - Reader.create buffer |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" (Result.show_error e)) - in - Eio.traceln "GetFeature = {:%s}" (Point.show point); - - (* Lookup the feature and if found return it. *) - let feature = - List.find_opt - (fun (f : Feature.t) -> - match (f.location, point) with - | Some p1, p2 -> Point.equal p1 p2 - | _, _ -> false) - !features - in - Eio.traceln "Found feature %s" - (feature |> Option.map Feature.show |> Option.value ~default:"Missing"); - match feature with - | Some feature -> - (Grpc.Status.(v OK), Some (feature |> encode |> Writer.contents)) - | None -> - (* No feature was found, return an unnamed feature. *) - ( Grpc.Status.(v OK), - Some (Feature.make ~location:point () |> encode |> Writer.contents) ) +let get_feature (t : t) = + Grpc_eio.Server.Typed_rpc.unary + (module RouteGuide.GetFeature) + ~f:(fun point -> + Eio.traceln "GetFeature = {:%s}" (Point.show point); + + (* Lookup the feature and if found return it. *) + let feature = + List.find_opt + (fun (f : Feature.t) -> + match (f.location, point) with + | Some p1, p2 -> Point.equal p1 p2 + | _, _ -> false) + t.features + in + Eio.traceln "Found feature %s" + (feature |> Option.map Feature.show |> Option.value ~default:"Missing"); + match feature with + | Some feature -> (Grpc.Status.(v OK), Some feature) + | None -> + (* No feature was found, return an unnamed feature. *) + (Grpc.Status.(v OK), Some (Feature.make ~location:point ()))) ``` The method is passed the client's `Point` protocol buffer request. It decodes the request into a `Point.t` and uses that to look up the feature. It returns a `Feature` protocol buffer object with the response information indicating the successful response, based on the feature found or an unnamed default feature. @@ -254,27 +235,19 @@ Now let's look at one of our streaming RPCs. `list_features` is a server-side st ```ocaml -let list_features (buffer : string) (f : string -> unit) = - (* Decode request. *) - let decode, encode = Service.make_service_functions RouteGuide.listFeatures in - let rectangle = - Reader.create buffer |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" (Result.show_error e)) - in - - (* Lookup and reply with features found. *) - let () = - List.iter - (fun (feature : Feature.t) -> - if in_range (Option.get feature.location) rectangle then - encode feature |> Writer.contents |> f - else ()) - !features - in - Grpc.Status.(v OK) +let list_features (t : t) = + Grpc_eio.Server.Typed_rpc.server_streaming + (module RouteGuide.ListFeatures) + ~f:(fun rectangle f -> + (* Lookup and reply with features found. *) + let () = + List.iter + (fun (feature : Feature.t) -> + if in_range (Option.get feature.location) rectangle then f feature + else ()) + t.features + in + Grpc.Status.(v OK)) ``` Like `get_feature` `list_feature`'s input is a single message. A `Rectangle` that is decoded from a string buffer. The `f: (string -> unit)` function is for writing the encoded responses back to the client. In the function we decode the request, lookup any matching features and stream them back to the client as we find them using `f`. Once we've looked at all the `features` we respond with an `OK` indicating the streaming has finished successfully. @@ -285,55 +258,49 @@ Now let's look at something a little more complicated: the client-side streaming ```ocaml -let record_route (clock : _ Eio.Time.clock) (stream : string Seq.t) = - Eio.traceln "RecordRoute"; - - let last_point = ref None in - let start = Eio.Time.now clock in - let decode, encode = Service.make_service_functions RouteGuide.recordRoute in - - let point_count, feature_count, distance = - Seq.fold_left - (fun (point_count, feature_count, distance) i -> - let point = - Reader.create i |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e)) - in - Eio.traceln " ==> Point = {%s}" (Point.show point); - - (* Increment the point count *) - let point_count = point_count + 1 in - - (* Find features *) - let feature_count = - List.find_all - (fun (feature : Feature.t) -> - Point.equal (Option.get feature.location) point) - !features - |> fun x -> List.length x + feature_count - in - - (* Calculate the distance *) - let distance = - match !last_point with - | Some last_point -> calc_distance last_point point - | None -> distance - in - last_point := Some point; - (point_count, feature_count, distance)) - (0, 0, 0) stream - in - let stop = Eio.Time.now clock in - let elapsed_time = int_of_float (stop -. start) in - let summary = - RouteSummary.make ~point_count ~feature_count ~distance ~elapsed_time () - in - Eio.traceln "RecordRoute exit\n"; - (Grpc.Status.(v OK), Some (encode summary |> Writer.contents)) +let record_route (t : t) (clock : _ Eio.Time.clock) = + Grpc_eio.Server.Typed_rpc.client_streaming + (module RouteGuide.RecordRoute) + ~f:(fun (stream : Point.t Seq.t) -> + Eio.traceln "RecordRoute"; + + let last_point = ref None in + let start = Eio.Time.now clock in + + let point_count, feature_count, distance = + Seq.fold_left + (fun (point_count, feature_count, distance) point -> + Eio.traceln " ==> Point = {%s}" (Point.show point); + + (* Increment the point count *) + let point_count = point_count + 1 in + + (* Find features *) + let feature_count = + List.find_all + (fun (feature : Feature.t) -> + Point.equal (Option.get feature.location) point) + t.features + |> fun x -> List.length x + feature_count + in + + (* Calculate the distance *) + let distance = + match !last_point with + | Some last_point -> calc_distance last_point point + | None -> distance + in + last_point := Some point; + (point_count, feature_count, distance)) + (0, 0, 0) stream + in + let stop = Eio.Time.now clock in + let elapsed_time = int_of_float (stop -. start) in + let summary = + RouteSummary.make ~point_count ~feature_count ~distance ~elapsed_time () + in + Eio.traceln "RecordRoute exit\n"; + (Grpc.Status.(v OK), Some summary)) ``` ### Bidirectional streaming RPCs @@ -342,26 +309,20 @@ Finally, let's look at our bidirectional streaming RPC `route_chat`, which recei ```ocaml -let route_chat (stream : string Seq.t) (f : string -> unit) = - Printf.printf "RouteChat\n"; - - let decode, encode = Service.make_service_functions RouteGuide.routeChat in - Seq.iter - (fun i -> - let note = - Reader.create i |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e)) - in - Printf.printf " ==> Note = {%s}\n" (RouteNote.show note); - encode note |> Writer.contents |> f) - stream; +let route_chat (_ : t) = + Grpc_eio.Server.Typed_rpc.bidirectional_streaming + (module RouteGuide.RouteChat) + ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> + Printf.printf "RouteChat\n"; + + Seq.iter + (fun note -> + Printf.printf " ==> Note = {%s}\n" (RouteNote.show note); + f note) + stream; - Printf.printf "RouteChat exit\n"; - Grpc.Status.(v OK) + Printf.printf "RouteChat exit\n"; + Grpc.Status.(v OK)) ``` `route_chat` receives a `string Seq.t` of requests which it decodes, logs to stdout to show it has received the note, and then encodes again to send back to the client. Finally it responds with an `OK` indicating it has finished. The logic is we receive one `RouteNote` and respond directly with the same `RouteNote` using the `f` function supplied. @@ -372,13 +333,13 @@ Once we've implemented all our functions, we also need to startup a gRPC server ```ocaml -let serve server env = +let serve t env = let port = 8080 in let net = Eio.Stdenv.net env in let clock = Eio.Stdenv.clock env in let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in Eio.Switch.run @@ fun sw -> - let handler = connection_handler ~sw (server clock) in + let handler = connection_handler ~sw (server t clock) in let server_socket = Eio.Net.listen net ~sw ~reuse_addr:true ~backlog:10 addr in @@ -398,9 +359,9 @@ let () = in (* Load features. *) - features := load path; + let t = { features = load_features path } in - Eio_main.run (serve server) + Eio_main.run (serve t) ``` To handle requests we use `h2-lwt-unix`, an implementation of the HTTP/2 specification entirely in OCaml. What that means is we can swap in other h2 implementations like MirageOS to run in a Unikernel or Async to use JaneStreet's alternatve async implementation. Furthermore we can add TLS or SSL encryptionon to our HTTP/2 stack. @@ -437,23 +398,14 @@ Calling the simple RPC `get_feature` requires building up a `Client.call` repres ```ocaml let call_get_feature connection point = - let encode, decode = Service.make_client_functions RouteGuide.getFeature in let response = - Client.call ~service:"routeguide.RouteGuide" ~rpc:"GetFeature" + Client.Typed_rpc.call + (module RouteGuide.GetFeature) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: - (Client.Rpc.unary - (encode point |> Writer.contents) - ~f:(fun response -> - match response with - | Some response -> ( - Reader.create response |> decode |> function - | Ok feature -> feature - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e))) - | None -> Feature.make ())) + (Client.Typed_rpc.unary point ~f:(function + | Some feature -> feature + | None -> Feature.make ())) () in match response with @@ -474,26 +426,11 @@ let print_features connection = () in - let encode, decode = Service.make_client_functions RouteGuide.listFeatures in let stream = - Client.call ~service:"routeguide.RouteGuide" ~rpc:"ListFeatures" + Client.Typed_rpc.call + (module RouteGuide.ListFeatures) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Rpc.server_streaming - (encode rectangle |> Writer.contents) - ~f:(fun responses -> - let stream = - Seq.map - (fun str -> - Reader.create str |> decode |> function - | Ok feature -> feature - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e))) - responses - in - stream)) + ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () in match stream with @@ -526,30 +463,21 @@ let run_record_route connection = |> Seq.unfold (function 0 -> None | x -> Some (random_point (), x - 1)) in - let encode, decode = Service.make_client_functions RouteGuide.recordRoute in let response = - Client.call ~service:"routeguide.RouteGuide" ~rpc:"RecordRoute" + Client.Typed_rpc.call + (module RouteGuide.RecordRoute) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: - (Client.Rpc.client_streaming ~f:(fun f response -> + (Client.Typed_rpc.client_streaming ~f:(fun f response -> (* Stream points to server. *) - Seq.iter - (fun point -> - encode point |> Writer.contents |> fun x -> Seq.write f x) - points; + Seq.iter (fun point -> Seq.write f point) points; (* Signal we have finished sending points. *) Seq.close_writer f; (* Decode RouteSummary responses. *) Eio.Promise.await response |> function - | Some str -> ( - Reader.create str |> decode |> function - | Ok feature -> feature - | Error err -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error err))) + | Some summary -> summary | None -> failwith (Printf.sprintf "No RouteSummary received."))) () in @@ -587,14 +515,12 @@ let run_route_chat clock connection = We start by generating a short sequence of locations, similar to how we did for `record_route`. ```ocaml - let encode, decode = Service.make_client_functions RouteGuide.routeChat in let rec go writer reader notes = match Seq.uncons notes with | None -> Seq.close_writer writer (* Signal no more notes from the client. *) | Some (route_note, xs) -> ( - encode route_note |> Writer.contents |> fun x -> - Seq.write writer x; + Seq.write writer route_note; (* Yield and sleep, waiting for server reply. *) Eio.Time.sleep clock 1.0; @@ -602,23 +528,16 @@ We start by generating a short sequence of locations, similar to how we did for match Seq.uncons reader with | None -> failwith "Expecting response" - | Some (response, reader') -> - let route_note = - Reader.create response |> decode |> function - | Ok route_note -> route_note - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e)) - in + | Some (route_note, reader') -> Printf.printf "NOTE = {%s}\n" (RouteNote.show route_note); go writer reader' xs) in let result = - Client.call ~service:"routeguide.RouteGuide" ~rpc:"RouteChat" + Client.Typed_rpc.call + (module RouteGuide.RouteChat) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: - (Client.Rpc.bidirectional_streaming ~f:(fun writer reader -> + (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> go writer reader route_notes)) () in diff --git a/examples/routeguide/src/client.ml b/examples/routeguide/src/client.ml index 47d8dba..8e9fa7d 100644 --- a/examples/routeguide/src/client.ml +++ b/examples/routeguide/src/client.ml @@ -1,6 +1,5 @@ open Grpc_eio open Routeguide.Route_guide.Routeguide -open Ocaml_protoc_plugin (* $MDX part-begin=client-h2 *) let client ~sw host port network = @@ -20,23 +19,14 @@ let client ~sw host port network = (* $MDX part-end *) (* $MDX part-begin=client-get-feature *) let call_get_feature connection point = - let encode, decode = Service.make_client_functions RouteGuide.getFeature in let response = - Client.call ~service:"routeguide.RouteGuide" ~rpc:"GetFeature" + Client.Typed_rpc.call + (module RouteGuide.GetFeature) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: - (Client.Rpc.unary - (encode point |> Writer.contents) - ~f:(fun response -> - match response with - | Some response -> ( - Reader.create response |> decode |> function - | Ok feature -> feature - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e))) - | None -> Feature.make ())) + (Client.Typed_rpc.unary point ~f:(function + | Some feature -> feature + | None -> Feature.make ())) () in match response with @@ -53,26 +43,11 @@ let print_features connection = () in - let encode, decode = Service.make_client_functions RouteGuide.listFeatures in let stream = - Client.call ~service:"routeguide.RouteGuide" ~rpc:"ListFeatures" + Client.Typed_rpc.call + (module RouteGuide.ListFeatures) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Rpc.server_streaming - (encode rectangle |> Writer.contents) - ~f:(fun responses -> - let stream = - Seq.map - (fun str -> - Reader.create str |> decode |> function - | Ok feature -> feature - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e))) - responses - in - stream)) + ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () in match stream with @@ -98,30 +73,21 @@ let run_record_route connection = |> Seq.unfold (function 0 -> None | x -> Some (random_point (), x - 1)) in - let encode, decode = Service.make_client_functions RouteGuide.recordRoute in let response = - Client.call ~service:"routeguide.RouteGuide" ~rpc:"RecordRoute" + Client.Typed_rpc.call + (module RouteGuide.RecordRoute) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: - (Client.Rpc.client_streaming ~f:(fun f response -> + (Client.Typed_rpc.client_streaming ~f:(fun f response -> (* Stream points to server. *) - Seq.iter - (fun point -> - encode point |> Writer.contents |> fun x -> Seq.write f x) - points; + Seq.iter (fun point -> Seq.write f point) points; (* Signal we have finished sending points. *) Seq.close_writer f; (* Decode RouteSummary responses. *) Eio.Promise.await response |> function - | Some str -> ( - Reader.create str |> decode |> function - | Ok feature -> feature - | Error err -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error err))) + | Some summary -> summary | None -> failwith (Printf.sprintf "No RouteSummary received."))) () in @@ -150,14 +116,12 @@ let run_route_chat clock connection = in (* $MDX part-end *) (* $MDX part-begin=client-route-chat-2 *) - let encode, decode = Service.make_client_functions RouteGuide.routeChat in let rec go writer reader notes = match Seq.uncons notes with | None -> Seq.close_writer writer (* Signal no more notes from the client. *) | Some (route_note, xs) -> ( - encode route_note |> Writer.contents |> fun x -> - Seq.write writer x; + Seq.write writer route_note; (* Yield and sleep, waiting for server reply. *) Eio.Time.sleep clock 1.0; @@ -165,23 +129,16 @@ let run_route_chat clock connection = match Seq.uncons reader with | None -> failwith "Expecting response" - | Some (response, reader') -> - let route_note = - Reader.create response |> decode |> function - | Ok route_note -> route_note - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e)) - in + | Some (route_note, reader') -> Printf.printf "NOTE = {%s}\n" (RouteNote.show route_note); go writer reader' xs) in let result = - Client.call ~service:"routeguide.RouteGuide" ~rpc:"RouteChat" + Client.Typed_rpc.call + (module RouteGuide.RouteChat) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: - (Client.Rpc.bidirectional_streaming ~f:(fun writer reader -> + (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> go writer reader route_notes)) () in diff --git a/examples/routeguide/src/server.ml b/examples/routeguide/src/server.ml index bfa30d9..ad0d90c 100644 --- a/examples/routeguide/src/server.ml +++ b/examples/routeguide/src/server.ml @@ -1,13 +1,13 @@ open Grpc_eio open Routeguide.Route_guide.Routeguide -open Ocaml_protoc_plugin (* Derived data types to make reading JSON data easier. *) type location = { latitude : int; longitude : int } [@@deriving yojson] type feature = { location : location; name : string } [@@deriving yojson] type feature_list = feature list [@@deriving yojson] -let features : Feature.t list ref = ref [] +(* This will act as a master state that the server is serving over RPC. *) +type t = { features : Feature.t list } module RouteNotesMap = Hashtbl.Make (struct type t = Point.t @@ -17,7 +17,7 @@ module RouteNotesMap = Hashtbl.Make (struct end) (** Load route_guide data from a JSON file. *) -let load path : Feature.t list = +let load_features path : Feature.t list = let json = Yojson.Safe.from_file path in match feature_list_of_yojson json with | Ok v -> @@ -73,152 +73,113 @@ let calc_distance (p1 : Point.t) (p2 : Point.t) : int = Float.to_int (r *. c) (* $MDX part-begin=server-get-feature *) -let get_feature (buffer : string) = - let decode, encode = Service.make_service_functions RouteGuide.getFeature in - (* Decode the request. *) - let point = - Reader.create buffer |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" (Result.show_error e)) - in - Eio.traceln "GetFeature = {:%s}" (Point.show point); - - (* Lookup the feature and if found return it. *) - let feature = - List.find_opt - (fun (f : Feature.t) -> - match (f.location, point) with - | Some p1, p2 -> Point.equal p1 p2 - | _, _ -> false) - !features - in - Eio.traceln "Found feature %s" - (feature |> Option.map Feature.show |> Option.value ~default:"Missing"); - match feature with - | Some feature -> - (Grpc.Status.(v OK), Some (feature |> encode |> Writer.contents)) - | None -> - (* No feature was found, return an unnamed feature. *) - ( Grpc.Status.(v OK), - Some (Feature.make ~location:point () |> encode |> Writer.contents) ) +let get_feature (t : t) = + Grpc_eio.Server.Typed_rpc.unary + (module RouteGuide.GetFeature) + ~f:(fun point -> + Eio.traceln "GetFeature = {:%s}" (Point.show point); + + (* Lookup the feature and if found return it. *) + let feature = + List.find_opt + (fun (f : Feature.t) -> + match (f.location, point) with + | Some p1, p2 -> Point.equal p1 p2 + | _, _ -> false) + t.features + in + Eio.traceln "Found feature %s" + (feature |> Option.map Feature.show |> Option.value ~default:"Missing"); + match feature with + | Some feature -> (Grpc.Status.(v OK), Some feature) + | None -> + (* No feature was found, return an unnamed feature. *) + (Grpc.Status.(v OK), Some (Feature.make ~location:point ()))) (* $MDX part-end *) (* $MDX part-begin=server-list-features *) -let list_features (buffer : string) (f : string -> unit) = - (* Decode request. *) - let decode, encode = Service.make_service_functions RouteGuide.listFeatures in - let rectangle = - Reader.create buffer |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" (Result.show_error e)) - in - - (* Lookup and reply with features found. *) - let () = - List.iter - (fun (feature : Feature.t) -> - if in_range (Option.get feature.location) rectangle then - encode feature |> Writer.contents |> f - else ()) - !features - in - Grpc.Status.(v OK) +let list_features (t : t) = + Grpc_eio.Server.Typed_rpc.server_streaming + (module RouteGuide.ListFeatures) + ~f:(fun rectangle f -> + (* Lookup and reply with features found. *) + let () = + List.iter + (fun (feature : Feature.t) -> + if in_range (Option.get feature.location) rectangle then f feature + else ()) + t.features + in + Grpc.Status.(v OK)) (* $MDX part-end *) (* $MDX part-begin=server-record-route *) -let record_route (clock : _ Eio.Time.clock) (stream : string Seq.t) = - Eio.traceln "RecordRoute"; - - let last_point = ref None in - let start = Eio.Time.now clock in - let decode, encode = Service.make_service_functions RouteGuide.recordRoute in - - let point_count, feature_count, distance = - Seq.fold_left - (fun (point_count, feature_count, distance) i -> - let point = - Reader.create i |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e)) - in - Eio.traceln " ==> Point = {%s}" (Point.show point); - - (* Increment the point count *) - let point_count = point_count + 1 in - - (* Find features *) - let feature_count = - List.find_all - (fun (feature : Feature.t) -> - Point.equal (Option.get feature.location) point) - !features - |> fun x -> List.length x + feature_count - in - - (* Calculate the distance *) - let distance = - match !last_point with - | Some last_point -> calc_distance last_point point - | None -> distance - in - last_point := Some point; - (point_count, feature_count, distance)) - (0, 0, 0) stream - in - let stop = Eio.Time.now clock in - let elapsed_time = int_of_float (stop -. start) in - let summary = - RouteSummary.make ~point_count ~feature_count ~distance ~elapsed_time () - in - Eio.traceln "RecordRoute exit\n"; - (Grpc.Status.(v OK), Some (encode summary |> Writer.contents)) +let record_route (t : t) (clock : _ Eio.Time.clock) = + Grpc_eio.Server.Typed_rpc.client_streaming + (module RouteGuide.RecordRoute) + ~f:(fun (stream : Point.t Seq.t) -> + Eio.traceln "RecordRoute"; + + let last_point = ref None in + let start = Eio.Time.now clock in + + let point_count, feature_count, distance = + Seq.fold_left + (fun (point_count, feature_count, distance) point -> + Eio.traceln " ==> Point = {%s}" (Point.show point); + + (* Increment the point count *) + let point_count = point_count + 1 in + + (* Find features *) + let feature_count = + List.find_all + (fun (feature : Feature.t) -> + Point.equal (Option.get feature.location) point) + t.features + |> fun x -> List.length x + feature_count + in + + (* Calculate the distance *) + let distance = + match !last_point with + | Some last_point -> calc_distance last_point point + | None -> distance + in + last_point := Some point; + (point_count, feature_count, distance)) + (0, 0, 0) stream + in + let stop = Eio.Time.now clock in + let elapsed_time = int_of_float (stop -. start) in + let summary = + RouteSummary.make ~point_count ~feature_count ~distance ~elapsed_time () + in + Eio.traceln "RecordRoute exit\n"; + (Grpc.Status.(v OK), Some summary)) (* $MDX part-end *) (* $MDX part-begin=server-route-chat *) -let route_chat (stream : string Seq.t) (f : string -> unit) = - Printf.printf "RouteChat\n"; +let route_chat (_ : t) = + Grpc_eio.Server.Typed_rpc.bidirectional_streaming + (module RouteGuide.RouteChat) + ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> + Printf.printf "RouteChat\n"; - let decode, encode = Service.make_service_functions RouteGuide.routeChat in - Seq.iter - (fun i -> - let note = - Reader.create i |> decode |> function - | Ok v -> v - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Result.show_error e)) - in - Printf.printf " ==> Note = {%s}\n" (RouteNote.show note); - encode note |> Writer.contents |> f) - stream; + Seq.iter + (fun note -> + Printf.printf " ==> Note = {%s}\n" (RouteNote.show note); + f note) + stream; - Printf.printf "RouteChat exit\n"; - Grpc.Status.(v OK) + Printf.printf "RouteChat exit\n"; + Grpc.Status.(v OK)) (* $MDX part-end *) (* $MDX part-begin=server-grpc *) -let route_guide_service clock = - Server.Service.( - v () - |> add_rpc ~name:"GetFeature" ~rpc:(Unary get_feature) - |> add_rpc ~name:"ListFeatures" ~rpc:(Server_streaming list_features) - |> add_rpc ~name:"RecordRoute" ~rpc:(Client_streaming (record_route clock)) - |> add_rpc ~name:"RouteChat" ~rpc:(Bidirectional_streaming route_chat) - |> handle_request) - -let server clock = - Server.( - v () - |> add_service ~name:"routeguide.RouteGuide" - ~service:(route_guide_service clock)) +let server t clock = + Server.Typed_rpc.server + [ get_feature t; list_features t; record_route t clock; route_chat t ] (* $MDX part-end *) let connection_handler server ~sw = @@ -238,13 +199,13 @@ let connection_handler server ~sw = ~error_handler addr socket ~sw (* $MDX part-begin=server-main *) -let serve server env = +let serve t env = let port = 8080 in let net = Eio.Stdenv.net env in let clock = Eio.Stdenv.clock env in let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in Eio.Switch.run @@ fun sw -> - let handler = connection_handler ~sw (server clock) in + let handler = connection_handler ~sw (server t clock) in let server_socket = Eio.Net.listen net ~sw ~reuse_addr:true ~backlog:10 addr in @@ -264,7 +225,7 @@ let () = in (* Load features. *) - features := load path; + let t = { features = load_features path } in - Eio_main.run (serve server) + Eio_main.run (serve t) (* $MDX part-end *) diff --git a/lib/grpc-eio/client.ml b/lib/grpc-eio/client.ml index 4efe5cd..3f1a5f4 100644 --- a/lib/grpc-eio/client.ml +++ b/lib/grpc-eio/client.ml @@ -104,3 +104,101 @@ module Rpc = struct let response = Seq.read_and_exhaust responses in f response) end + +module Typed_rpc = struct + type ('request, 'response, 'a) handler = + ('request, 'response) Protoc_rpc.t -> + H2.Body.Writer.t -> + H2.Body.Reader.t -> + 'a + + let unary (type request response) ~f (request : request) + (module R : Protoc_rpc.S + with type Request.t = request + and type Response.t = response) = + let request = Protoc_rpc.encode (module R.Request) request in + let f response = + let response = + response + |> Option.map (fun response -> + response |> Protoc_rpc.decode_exn (module R.Response)) + in + f response + in + Rpc.unary ~f request + + let server_streaming (type request response) ~f (request : request) + (module R : Protoc_rpc.S + with type Request.t = request + and type Response.t = response) = + let request = Protoc_rpc.encode (module R.Request) request in + let f responses = + let responses = + Seq.map + (fun str -> Protoc_rpc.decode_exn (module R.Response) str) + responses + in + f responses + in + Rpc.server_streaming ~f request + + let client_streaming (type request response) ~f + (module R : Protoc_rpc.S + with type Request.t = request + and type Response.t = response) = + let f requests response = + let requests_reader, requests' = Seq.create_reader_writer () in + let response', response_u = Eio.Promise.create () in + Eio.Switch.run @@ fun sw -> + Eio.Fiber.fork ~sw (fun () -> + Eio.Fiber.both + (fun () -> + let response = + Eio.Promise.await response + |> Option.map (fun response -> + Protoc_rpc.decode_exn (module R.Response) response) + in + Eio.Promise.resolve response_u response) + (fun () -> + Seq.iter + (fun request -> + Seq.write requests + (Protoc_rpc.encode (module R.Request) request)) + requests_reader; + Seq.close_writer requests)); + f requests' response' + in + Rpc.client_streaming ~f + + let bidirectional_streaming (type request response) ~f + (module R : Protoc_rpc.S + with type Request.t = request + and type Response.t = response) = + let f requests responses = + let requests_reader, requests' = Seq.create_reader_writer () in + let responses' = + Seq.map + (fun str -> Protoc_rpc.decode_exn (module R.Response) str) + responses + in + Eio.Switch.run @@ fun sw -> + Eio.Fiber.fork ~sw (fun () -> + Seq.iter + (fun request -> + Seq.write requests (Protoc_rpc.encode (module R.Request) request)) + requests_reader; + Seq.close_writer requests); + f requests' responses' + in + Rpc.bidirectional_streaming ~f + + let call (type request response a) + ((module R : Protoc_rpc.S + with type Request.t = request + and type Response.t = response) as protoc_rpc) ?scheme + ~(handler : (request, response, a) handler) ~do_request ?headers () = + call + ~service:(Protoc_rpc.service_name protoc_rpc) + ~rpc:(Protoc_rpc.rpc_name protoc_rpc) + ?scheme ~handler:(handler protoc_rpc) ~do_request ?headers () +end diff --git a/lib/grpc-eio/client.mli b/lib/grpc-eio/client.mli index 745d33c..63c1236 100644 --- a/lib/grpc-eio/client.mli +++ b/lib/grpc-eio/client.mli @@ -46,3 +46,43 @@ val call : (** [call ~service ~rpc ~handler ~do_request ()] calls the rpc endpoint given by [service] and [rpc] using the [do_request] function. The [handler] is called when this request is set up to send and receive data. *) + +module Typed_rpc : sig + (** This is an experimental API to call RPC from the client side. Compared to + {Rpc}, this interface will: + + - handle the coding/decoding of messages for you under the hood; + - use the service and RPC names provided by the protoc specification to + register the services with their expected names. *) + + type ('request, 'response, 'a) handler + + (** The next functions are meant to be used by the client to handle + call to RPCs. *) + + val bidirectional_streaming : + f:('request Seq.writer -> 'response Seq.t -> 'a) -> + ('request, 'response, 'a) handler + + val client_streaming : + f:('request Seq.writer -> 'response option Eio.Promise.t -> 'a) -> + ('request, 'response, 'a) handler + + val server_streaming : + f:('response Seq.t -> 'a) -> 'request -> ('request, 'response, 'a) handler + + val unary : + f:('response option -> 'a) -> 'request -> ('request, 'response, 'a) handler + + val call : + ('request, 'response) Protoc_rpc.t -> + ?scheme:string -> + handler:('request, 'response, 'a) handler -> + do_request:do_request -> + ?headers:H2.Headers.t -> + unit -> + ('a * Grpc.Status.t, H2.Status.t) result + (** The protoc rpc must be provided as it is used to handle coding/decoding of + messages as well as allows referring to the service and RPC names + specified in the [.proto] file. *) +end diff --git a/lib/grpc-eio/dune b/lib/grpc-eio/dune index 39ce5ea..69197dc 100644 --- a/lib/grpc-eio/dune +++ b/lib/grpc-eio/dune @@ -1,4 +1,4 @@ (library (name grpc_eio) (public_name grpc-eio) - (libraries grpc h2 eio)) + (libraries grpc h2 eio ocaml-protoc-plugin)) diff --git a/lib/grpc-eio/protoc_rpc.ml b/lib/grpc-eio/protoc_rpc.ml new file mode 100644 index 0000000..4cb677b --- /dev/null +++ b/lib/grpc-eio/protoc_rpc.ml @@ -0,0 +1,30 @@ +module type S = Ocaml_protoc_plugin.Service.Rpc + +type ('request, 'response) t = + (module S with type Request.t = 'request and type Response.t = 'response) + +let service_name (type request response) + (module R : S with type Request.t = request and type Response.t = response) + = + (match R.package_name with Some p -> p ^ "." | None -> "") ^ R.service_name + +let rpc_name (type request response) + (module R : S with type Request.t = request and type Response.t = response) + = + R.method_name + +let encode (type a) + (module M : Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message + with type t = a) (a : a) = + a |> M.to_proto |> Ocaml_protoc_plugin.Runtime.Runtime'.Writer.contents + +let decode_exn (type a) + (module M : Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message + with type t = a) buffer = + buffer |> Ocaml_protoc_plugin.Runtime.Runtime'.Reader.create |> M.from_proto + |> function + | Ok r -> r + | Error e -> + failwith + (Printf.sprintf "Could not decode request: %s" + (Ocaml_protoc_plugin.Result.show_error e)) diff --git a/lib/grpc-eio/protoc_rpc.mli b/lib/grpc-eio/protoc_rpc.mli new file mode 100644 index 0000000..8d66e15 --- /dev/null +++ b/lib/grpc-eio/protoc_rpc.mli @@ -0,0 +1,17 @@ +module type S = Ocaml_protoc_plugin.Service.Rpc + +type ('request, 'response) t = + (module S with type Request.t = 'request and type Response.t = 'response) + +val service_name : _ t -> string +val rpc_name : _ t -> string + +val encode : + (module Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message with type t = 'a) -> + 'a -> + string + +val decode_exn : + (module Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message with type t = 'a) -> + string -> + 'a diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index ffd850c..59e147d 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -127,3 +127,117 @@ module Service = struct | None -> respond_with `Not_found else respond_with `Not_found end + +module Typed_rpc = struct + type server = t + + type ('request, 'response) unary = + 'request -> Grpc.Status.t * 'response option + + type ('request, 'response) client_streaming = + 'request Seq.t -> Grpc.Status.t * 'response option + + type ('request, 'response) server_streaming = + 'request -> ('response -> unit) -> Grpc.Status.t + + type ('request, 'response) bidirectional_streaming = + 'request Seq.t -> ('response -> unit) -> Grpc.Status.t + + type t = { protoc_rpc : (module Protoc_rpc.S); rpc : Rpc.t } + + let server ts : server = + List.fold_left + (fun map t -> + let module R = (val t.protoc_rpc) in + let service_name = Protoc_rpc.service_name (module R) in + let rpc = + ServiceMap.find_opt service_name map |> Option.value ~default:[] + in + ServiceMap.add service_name (t :: rpc) map) + ServiceMap.empty ts + |> ServiceMap.map (fun ts -> + let service = + List.fold_left + (fun acc t -> + let module R = (val t.protoc_rpc) in + Service.add_rpc + ~name:(Protoc_rpc.rpc_name (module R)) + ~rpc:t.rpc acc) + (Service.v ()) ts + in + Service.handle_request service) + + let encode (type a) + (module M : Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message + with type t = a) (a : a) = + a |> M.to_proto |> Ocaml_protoc_plugin.Runtime.Runtime'.Writer.contents + + let decode_exn (type a) + (module M : Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message + with type t = a) buffer = + buffer |> Ocaml_protoc_plugin.Runtime.Runtime'.Reader.create |> M.from_proto + |> function + | Ok r -> r + | Error e -> + failwith + (Printf.sprintf "Could not decode request: %s" + (Ocaml_protoc_plugin.Result.show_error e)) + + let unary (type request response) + (module Protoc_rpc : Protoc_rpc.S + with type Request.t = request + and type Response.t = response) ~f:handler = + let handler buffer = + let status, response = + handler (decode_exn (module Protoc_rpc.Request) buffer) + in + ( status, + Option.map + (fun response -> encode (module Protoc_rpc.Response) response) + response ) + in + { protoc_rpc = (module Protoc_rpc); rpc = Rpc.Unary handler } + + let server_streaming (type request response) + (module Protoc_rpc : Protoc_rpc.S + with type Request.t = request + and type Response.t = response) ~f:handler = + let handler buffer f = + handler + (decode_exn (module Protoc_rpc.Request) buffer) + (fun response -> f (encode (module Protoc_rpc.Response) response)) + in + { protoc_rpc = (module Protoc_rpc); rpc = Rpc.Server_streaming handler } + + let client_streaming (type request response) + (module Protoc_rpc : Protoc_rpc.S + with type Request.t = request + and type Response.t = response) ~f:handler = + let handler requests = + let requests = + Seq.map (fun str -> decode_exn (module Protoc_rpc.Request) str) requests + in + let status, response = handler requests in + ( status, + Option.map + (fun response -> encode (module Protoc_rpc.Response) response) + response ) + in + { protoc_rpc = (module Protoc_rpc); rpc = Rpc.Client_streaming handler } + + let bidirectional_streaming (type request response) + (module Protoc_rpc : Protoc_rpc.S + with type Request.t = request + and type Response.t = response) ~f:handler = + let handler requests f = + let requests = + Seq.map (fun str -> decode_exn (module Protoc_rpc.Request) str) requests + in + handler requests (fun response -> + f (encode (module Protoc_rpc.Response) response)) + in + { + protoc_rpc = (module Protoc_rpc); + rpc = Rpc.Bidirectional_streaming handler; + } +end diff --git a/lib/grpc-eio/server.mli b/lib/grpc-eio/server.mli index 40961f5..7ec550a 100644 --- a/lib/grpc-eio/server.mli +++ b/lib/grpc-eio/server.mli @@ -48,3 +48,70 @@ module Service : sig val handle_request : t -> H2.Reqd.t -> unit (** [handle_request t reqd] handles routing [reqd] to the correct rpc if available in [t]. *) end + +module Typed_rpc : sig + (** This is an experimental API to build RPCs on the server side. Compared to + {Rpc}, this interface will: + + - handle the coding/decoding of messages for you under the hood; + - use the service and RPC names provided by the protoc specification to + register the services with their expected names. + + If you need a more fine-grained control over the failures encountered by + encoding/decoding during the lifetime of a connection, you should use the + {Rpc} interface instead. *) + + type server := t + + type ('request, 'response) unary = + 'request -> Grpc.Status.t * 'response option + (** [unary] is the type for a unary grpc rpc, one request, one response. *) + + type ('request, 'response) client_streaming = + 'request Seq.t -> Grpc.Status.t * 'response option + (** [client_streaming] is the type for an rpc where the client streams the + requests and the server responds once. *) + + type ('request, 'response) server_streaming = + 'request -> ('response -> unit) -> Grpc.Status.t + (** [server_streaming] is the type for an rpc where the client sends one + request and the server sends multiple responses. *) + + type ('request, 'response) bidirectional_streaming = + 'request Seq.t -> ('response -> unit) -> Grpc.Status.t + (** [bidirectional_streaming] is the type for an rpc where both the client and + server can send multiple messages. *) + + type t + (** [t] represents an implementation for an RPC on the server side. *) + + (** The next functions are meant to be used by the server to create RPC + implementations. The protoc rpc that the function implements must be + provided as it is used to handle coding/decoding of messages. It also + allows to refer to the service and RPC names specified in the [.proto] + file. *) + + val unary : + ('request, 'response) Protoc_rpc.t -> f:('request, 'response) unary -> t + + val client_streaming : + ('request, 'response) Protoc_rpc.t -> + f:('request, 'response) client_streaming -> + t + + val server_streaming : + ('request, 'response) Protoc_rpc.t -> + f:('request, 'response) server_streaming -> + t + + val bidirectional_streaming : + ('request, 'response) Protoc_rpc.t -> + f:('request, 'response) bidirectional_streaming -> + t + + val server : t list -> server + (** Having built a list of RPCs you will use this function to package them up + into a server that is ready to be served over the network. This function + takes care of registering the services based on the names provided by the + protoc specification. *) +end From c6c8e5ae713855ba5ac19f0681d857090ce87b64 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Mon, 27 Nov 2023 20:46:16 +0100 Subject: [PATCH 02/12] split codec into own lib --- dune-project | 16 ++++ examples/greeter-client-eio/dune | 10 ++- .../greeter-client-eio/greeter_client_eio.ml | 2 +- examples/greeter-server-eio/dune | 10 ++- .../greeter-server-eio/greeter_server_eio.ml | 2 +- examples/routeguide-tutorial.md | 16 ++-- examples/routeguide/src/client.ml | 8 +- examples/routeguide/src/dune | 1 + examples/routeguide/src/server.ml | 8 +- grpc-protobuf-eio.opam | 43 ++++++++++ lib/grpc-eio/client.ml | 45 +++++------ lib/grpc-eio/client.mli | 2 +- lib/grpc-eio/dune | 2 +- lib/grpc-eio/grpc_eio.ml | 1 + lib/grpc-eio/protoc_rpc.mli | 17 ---- lib/grpc-eio/rpc_codec.ml | 35 ++++++++ lib/grpc-eio/rpc_codec.mli | 17 ++++ lib/grpc-eio/rpc_codec_interface.ml | 26 ++++++ lib/grpc-eio/rpc_codec_interface.mli | 26 ++++++ lib/grpc-eio/server.ml | 81 +++++++------------ lib/grpc-eio/server.mli | 8 +- lib/grpc-protobuf-eio/dune | 4 + .../protoc_codec.ml} | 40 +++++---- lib/grpc-protobuf-eio/protoc_codec.mli | 7 ++ 24 files changed, 292 insertions(+), 135 deletions(-) create mode 100644 grpc-protobuf-eio.opam delete mode 100644 lib/grpc-eio/protoc_rpc.mli create mode 100644 lib/grpc-eio/rpc_codec.ml create mode 100644 lib/grpc-eio/rpc_codec.mli create mode 100644 lib/grpc-eio/rpc_codec_interface.ml create mode 100644 lib/grpc-eio/rpc_codec_interface.mli create mode 100644 lib/grpc-protobuf-eio/dune rename lib/{grpc-eio/protoc_rpc.ml => grpc-protobuf-eio/protoc_codec.ml} (52%) create mode 100644 lib/grpc-protobuf-eio/protoc_codec.mli diff --git a/dune-project b/dune-project index 9856ec7..745eb2a 100644 --- a/dune-project +++ b/dune-project @@ -77,6 +77,22 @@ (eio (>= 0.12)) stringext)) +(package + (name grpc-protobuf-eio) + (synopsis "An Eio implementation of gRPC with protobuf serialization") + (description + "Functionality for building gRPC services and rpcs with `eio` and `ocaml-protoc-plugin`") + (depends + (grpc + (= :version)) + (grpc-eio + (= :version)) + (eio + (>= 0.12)) + (ocaml-protoc-plugin + (>= 4.5)) + stringext)) + (package (name grpc-examples) (synopsis "Various gRPC examples") diff --git a/examples/greeter-client-eio/dune b/examples/greeter-client-eio/dune index 37f97bc..f87588c 100644 --- a/examples/greeter-client-eio/dune +++ b/examples/greeter-client-eio/dune @@ -1,3 +1,11 @@ (executable (name greeter_client_eio) - (libraries grpc grpc-eio ocaml-protoc-plugin eio_main greeter h2 h2-eio)) + (libraries + grpc + grpc-eio + grpc-protobuf-eio + ocaml-protoc-plugin + eio_main + greeter + h2 + h2-eio)) diff --git a/examples/greeter-client-eio/greeter_client_eio.ml b/examples/greeter-client-eio/greeter_client_eio.ml index 3104642..0fc34ed 100644 --- a/examples/greeter-client-eio/greeter_client_eio.ml +++ b/examples/greeter-client-eio/greeter_client_eio.ml @@ -30,7 +30,7 @@ let main env = let result = Grpc_eio.Client.Typed_rpc.call - (module Greeter.SayHello) + (Grpc_protobuf_eio.Protoc_codec.make (module Greeter.SayHello)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) () diff --git a/examples/greeter-server-eio/dune b/examples/greeter-server-eio/dune index 8108aa6..12d7b05 100644 --- a/examples/greeter-server-eio/dune +++ b/examples/greeter-server-eio/dune @@ -1,3 +1,11 @@ (executable (name greeter_server_eio) - (libraries grpc grpc-eio ocaml-protoc-plugin eio_main greeter h2 h2-eio)) + (libraries + grpc + grpc-eio + grpc-protobuf-eio + ocaml-protoc-plugin + eio_main + greeter + h2 + h2-eio)) diff --git a/examples/greeter-server-eio/greeter_server_eio.ml b/examples/greeter-server-eio/greeter_server_eio.ml index 95fa58c..1bede24 100644 --- a/examples/greeter-server-eio/greeter_server_eio.ml +++ b/examples/greeter-server-eio/greeter_server_eio.ml @@ -3,7 +3,7 @@ open Grpc_eio let say_hello = let module SayHello = Greeter.Mypackage.Greeter.SayHello in Grpc_eio.Server.Typed_rpc.unary - (module SayHello) + (Grpc_protobuf_eio.Protoc_codec.make (module SayHello)) ~f:(fun request -> let message = if request = "" then "You forgot your name!" diff --git a/examples/routeguide-tutorial.md b/examples/routeguide-tutorial.md index d2e0ba9..8e0eab2 100644 --- a/examples/routeguide-tutorial.md +++ b/examples/routeguide-tutorial.md @@ -205,7 +205,7 @@ Let's look at the simplest type first, `GetFeature` which just gets a `Point` fr ```ocaml let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (module RouteGuide.GetFeature) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -237,7 +237,7 @@ Now let's look at one of our streaming RPCs. `list_features` is a server-side st ```ocaml let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (module RouteGuide.ListFeatures) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -260,7 +260,7 @@ Now let's look at something a little more complicated: the client-side streaming ```ocaml let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (module RouteGuide.RecordRoute) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -311,7 +311,7 @@ Finally, let's look at our bidirectional streaming RPC `route_chat`, which recei ```ocaml let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (module RouteGuide.RouteChat) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -400,7 +400,7 @@ Calling the simple RPC `get_feature` requires building up a `Client.call` repres let call_get_feature connection point = let response = Client.Typed_rpc.call - (module RouteGuide.GetFeature) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -428,7 +428,7 @@ let print_features connection = let stream = Client.Typed_rpc.call - (module RouteGuide.ListFeatures) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -465,7 +465,7 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (module RouteGuide.RecordRoute) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -534,7 +534,7 @@ We start by generating a short sequence of locations, similar to how we did for in let result = Client.Typed_rpc.call - (module RouteGuide.RouteChat) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/client.ml b/examples/routeguide/src/client.ml index 8e9fa7d..787c995 100644 --- a/examples/routeguide/src/client.ml +++ b/examples/routeguide/src/client.ml @@ -21,7 +21,7 @@ let client ~sw host port network = let call_get_feature connection point = let response = Client.Typed_rpc.call - (module RouteGuide.GetFeature) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -45,7 +45,7 @@ let print_features connection = let stream = Client.Typed_rpc.call - (module RouteGuide.ListFeatures) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -75,7 +75,7 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (module RouteGuide.RecordRoute) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -135,7 +135,7 @@ let run_route_chat clock connection = in let result = Client.Typed_rpc.call - (module RouteGuide.RouteChat) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/dune b/examples/routeguide/src/dune index 9c5afaf..5e6f852 100644 --- a/examples/routeguide/src/dune +++ b/examples/routeguide/src/dune @@ -4,6 +4,7 @@ (public_names routeguide-server routeguide-client) (libraries grpc-eio + grpc-protobuf-eio eio_main h2-eio ocaml-protoc-plugin diff --git a/examples/routeguide/src/server.ml b/examples/routeguide/src/server.ml index ad0d90c..6422b11 100644 --- a/examples/routeguide/src/server.ml +++ b/examples/routeguide/src/server.ml @@ -75,7 +75,7 @@ let calc_distance (p1 : Point.t) (p2 : Point.t) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (module RouteGuide.GetFeature) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -100,7 +100,7 @@ let get_feature (t : t) = (* $MDX part-begin=server-list-features *) let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (module RouteGuide.ListFeatures) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -116,7 +116,7 @@ let list_features (t : t) = (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (module RouteGuide.RecordRoute) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -162,7 +162,7 @@ let record_route (t : t) (clock : _ Eio.Time.clock) = (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (module RouteGuide.RouteChat) + (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; diff --git a/grpc-protobuf-eio.opam b/grpc-protobuf-eio.opam new file mode 100644 index 0000000..6e18c71 --- /dev/null +++ b/grpc-protobuf-eio.opam @@ -0,0 +1,43 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "An Eio implementation of gRPC with protobuf serialization" +description: + "Functionality for building gRPC services and rpcs with `eio` and `ocaml-protoc-plugin`" +maintainer: ["Daniel Quernheim "] +authors: [ + "Andrew Jeffery " + "Daniel Quernheim " + "Michael Bacarella " + "Sven Anderson " + "Tim McGilchrist " + "Wojtek Czekalski " + "dimitris.mostrous " +] +license: "BSD-3-Clause" +homepage: "https://github.com/dialohq/ocaml-grpc" +doc: "https://dialohq.github.io/ocaml-grpc" +bug-reports: "https://github.com/dialohq/ocaml-grpc/issues" +depends: [ + "dune" {>= "3.7"} + "grpc" {= version} + "grpc-eio" {= version} + "eio" {>= "0.12"} + "ocaml-protoc-plugin" {>= "4.5"} + "stringext" + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/dialohq/ocaml-grpc.git" diff --git a/lib/grpc-eio/client.ml b/lib/grpc-eio/client.ml index 3f1a5f4..61ec788 100644 --- a/lib/grpc-eio/client.ml +++ b/lib/grpc-eio/client.ml @@ -107,35 +107,31 @@ end module Typed_rpc = struct type ('request, 'response, 'a) handler = - ('request, 'response) Protoc_rpc.t -> + ('request, 'response) Rpc_codec.t -> H2.Body.Writer.t -> H2.Body.Reader.t -> 'a let unary (type request response) ~f (request : request) - (module R : Protoc_rpc.S - with type Request.t = request - and type Response.t = response) = - let request = Protoc_rpc.encode (module R.Request) request in + (rpc_codec : (request, response) Rpc_codec.t) = + let request = Rpc_codec.encode (Rpc_codec.request rpc_codec) request in let f response = let response = response |> Option.map (fun response -> - response |> Protoc_rpc.decode_exn (module R.Response)) + response |> Rpc_codec.decode (Rpc_codec.response rpc_codec)) in f response in Rpc.unary ~f request let server_streaming (type request response) ~f (request : request) - (module R : Protoc_rpc.S - with type Request.t = request - and type Response.t = response) = - let request = Protoc_rpc.encode (module R.Request) request in + (rpc_codec : (request, response) Rpc_codec.t) = + let request = Rpc_codec.encode (Rpc_codec.request rpc_codec) request in let f responses = let responses = Seq.map - (fun str -> Protoc_rpc.decode_exn (module R.Response) str) + (fun str -> Rpc_codec.decode (Rpc_codec.response rpc_codec) str) responses in f responses @@ -143,9 +139,7 @@ module Typed_rpc = struct Rpc.server_streaming ~f request let client_streaming (type request response) ~f - (module R : Protoc_rpc.S - with type Request.t = request - and type Response.t = response) = + (rpc_codec : (request, response) Rpc_codec.t) = let f requests response = let requests_reader, requests' = Seq.create_reader_writer () in let response', response_u = Eio.Promise.create () in @@ -156,14 +150,14 @@ module Typed_rpc = struct let response = Eio.Promise.await response |> Option.map (fun response -> - Protoc_rpc.decode_exn (module R.Response) response) + Rpc_codec.decode (Rpc_codec.response rpc_codec) response) in Eio.Promise.resolve response_u response) (fun () -> Seq.iter (fun request -> Seq.write requests - (Protoc_rpc.encode (module R.Request) request)) + (Rpc_codec.encode (Rpc_codec.request rpc_codec) request)) requests_reader; Seq.close_writer requests)); f requests' response' @@ -171,21 +165,20 @@ module Typed_rpc = struct Rpc.client_streaming ~f let bidirectional_streaming (type request response) ~f - (module R : Protoc_rpc.S - with type Request.t = request - and type Response.t = response) = + (rpc_codec : (request, response) Rpc_codec.t) = let f requests responses = let requests_reader, requests' = Seq.create_reader_writer () in let responses' = Seq.map - (fun str -> Protoc_rpc.decode_exn (module R.Response) str) + (fun str -> Rpc_codec.decode (Rpc_codec.response rpc_codec) str) responses in Eio.Switch.run @@ fun sw -> Eio.Fiber.fork ~sw (fun () -> Seq.iter (fun request -> - Seq.write requests (Protoc_rpc.encode (module R.Request) request)) + Seq.write requests + (Rpc_codec.encode (Rpc_codec.request rpc_codec) request)) requests_reader; Seq.close_writer requests); f requests' responses' @@ -193,12 +186,10 @@ module Typed_rpc = struct Rpc.bidirectional_streaming ~f let call (type request response a) - ((module R : Protoc_rpc.S - with type Request.t = request - and type Response.t = response) as protoc_rpc) ?scheme + (rpc_codec : (request, response) Rpc_codec.t) ?scheme ~(handler : (request, response, a) handler) ~do_request ?headers () = call - ~service:(Protoc_rpc.service_name protoc_rpc) - ~rpc:(Protoc_rpc.rpc_name protoc_rpc) - ?scheme ~handler:(handler protoc_rpc) ~do_request ?headers () + ~service:(Rpc_codec.service_name rpc_codec) + ~rpc:(Rpc_codec.rpc_name rpc_codec) + ?scheme ~handler:(handler rpc_codec) ~do_request ?headers () end diff --git a/lib/grpc-eio/client.mli b/lib/grpc-eio/client.mli index 63c1236..2e138c8 100644 --- a/lib/grpc-eio/client.mli +++ b/lib/grpc-eio/client.mli @@ -75,7 +75,7 @@ module Typed_rpc : sig f:('response option -> 'a) -> 'request -> ('request, 'response, 'a) handler val call : - ('request, 'response) Protoc_rpc.t -> + ('request, 'response) Rpc_codec.t -> ?scheme:string -> handler:('request, 'response, 'a) handler -> do_request:do_request -> diff --git a/lib/grpc-eio/dune b/lib/grpc-eio/dune index 69197dc..39ce5ea 100644 --- a/lib/grpc-eio/dune +++ b/lib/grpc-eio/dune @@ -1,4 +1,4 @@ (library (name grpc_eio) (public_name grpc-eio) - (libraries grpc h2 eio ocaml-protoc-plugin)) + (libraries grpc h2 eio)) diff --git a/lib/grpc-eio/grpc_eio.ml b/lib/grpc-eio/grpc_eio.ml index c7e9399..54aecdd 100644 --- a/lib/grpc-eio/grpc_eio.ml +++ b/lib/grpc-eio/grpc_eio.ml @@ -1,3 +1,4 @@ module Server = Server module Client = Client +module Rpc_codec = Rpc_codec module Seq = Seq diff --git a/lib/grpc-eio/protoc_rpc.mli b/lib/grpc-eio/protoc_rpc.mli deleted file mode 100644 index 8d66e15..0000000 --- a/lib/grpc-eio/protoc_rpc.mli +++ /dev/null @@ -1,17 +0,0 @@ -module type S = Ocaml_protoc_plugin.Service.Rpc - -type ('request, 'response) t = - (module S with type Request.t = 'request and type Response.t = 'response) - -val service_name : _ t -> string -val rpc_name : _ t -> string - -val encode : - (module Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message with type t = 'a) -> - 'a -> - string - -val decode_exn : - (module Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message with type t = 'a) -> - string -> - 'a diff --git a/lib/grpc-eio/rpc_codec.ml b/lib/grpc-eio/rpc_codec.ml new file mode 100644 index 0000000..002015b --- /dev/null +++ b/lib/grpc-eio/rpc_codec.ml @@ -0,0 +1,35 @@ +include Rpc_codec_interface + +type ('request, 'response) t = + (module S with type Request.t = 'request and type Response.t = 'response) + +let service_name (type request response) + (module R : S with type Request.t = request and type Response.t = response) + = + (match R.package_name with Some p -> p ^ "." | None -> "") ^ R.service_name + +let rpc_name (type request response) + (module R : S with type Request.t = request and type Response.t = response) + = + R.method_name + +module Codec = struct + type 'a t = (module Codec with type t = 'a) +end + +let request (type request response) + (module Rpc_codec : S + with type Request.t = request + and type Response.t = response) = + (module Rpc_codec.Request : Codec with type t = request) + +let response (type request response) + (module Rpc_codec : S + with type Request.t = request + and type Response.t = response) = + (module Rpc_codec.Response : Codec with type t = response) + +let encode (type a) (module M : Codec with type t = a) (a : a) = a |> M.encode + +let decode (type a) (module M : Codec with type t = a) buffer : a = + buffer |> M.decode diff --git a/lib/grpc-eio/rpc_codec.mli b/lib/grpc-eio/rpc_codec.mli new file mode 100644 index 0000000..c85245f --- /dev/null +++ b/lib/grpc-eio/rpc_codec.mli @@ -0,0 +1,17 @@ +module type Codec = Rpc_codec_interface.Codec +module type S = Rpc_codec_interface.S + +type ('request, 'response) t = + (module S with type Request.t = 'request and type Response.t = 'response) + +val service_name : _ t -> string +val rpc_name : _ t -> string + +module Codec : sig + type 'a t = (module Codec with type t = 'a) +end + +val request : ('request, _) t -> 'request Codec.t +val response : (_, 'response) t -> 'response Codec.t +val encode : 'a Codec.t -> 'a -> string +val decode : 'a Codec.t -> string -> 'a diff --git a/lib/grpc-eio/rpc_codec_interface.ml b/lib/grpc-eio/rpc_codec_interface.ml new file mode 100644 index 0000000..816eb56 --- /dev/null +++ b/lib/grpc-eio/rpc_codec_interface.ml @@ -0,0 +1,26 @@ +type buffer = string + +module type Codec = sig + type t + + val encode : t -> buffer + val decode : buffer -> t +end + +module type S = sig + module Request : sig + type t + + include Codec with type t := t + end + + module Response : sig + type t + + include Codec with type t := t + end + + val package_name : string option + val service_name : string + val method_name : string +end diff --git a/lib/grpc-eio/rpc_codec_interface.mli b/lib/grpc-eio/rpc_codec_interface.mli new file mode 100644 index 0000000..816eb56 --- /dev/null +++ b/lib/grpc-eio/rpc_codec_interface.mli @@ -0,0 +1,26 @@ +type buffer = string + +module type Codec = sig + type t + + val encode : t -> buffer + val decode : buffer -> t +end + +module type S = sig + module Request : sig + type t + + include Codec with type t := t + end + + module Response : sig + type t + + include Codec with type t := t + end + + val package_name : string option + val service_name : string + val method_name : string +end diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index 59e147d..5fc6f63 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -143,101 +143,80 @@ module Typed_rpc = struct type ('request, 'response) bidirectional_streaming = 'request Seq.t -> ('response -> unit) -> Grpc.Status.t - type t = { protoc_rpc : (module Protoc_rpc.S); rpc : Rpc.t } + type t = + | T : { rpc_codec : ('request, 'response) Rpc_codec.t; rpc : Rpc.t } -> t let server ts : server = List.fold_left - (fun map t -> - let module R = (val t.protoc_rpc) in - let service_name = Protoc_rpc.service_name (module R) in + (fun map (T t as packed) -> + let service_name = Rpc_codec.service_name t.rpc_codec in let rpc = ServiceMap.find_opt service_name map |> Option.value ~default:[] in - ServiceMap.add service_name (t :: rpc) map) + ServiceMap.add service_name (packed :: rpc) map) ServiceMap.empty ts |> ServiceMap.map (fun ts -> let service = List.fold_left - (fun acc t -> - let module R = (val t.protoc_rpc) in + (fun acc (T t) -> Service.add_rpc - ~name:(Protoc_rpc.rpc_name (module R)) + ~name:(Rpc_codec.rpc_name t.rpc_codec) ~rpc:t.rpc acc) (Service.v ()) ts in Service.handle_request service) - let encode (type a) - (module M : Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message - with type t = a) (a : a) = - a |> M.to_proto |> Ocaml_protoc_plugin.Runtime.Runtime'.Writer.contents - - let decode_exn (type a) - (module M : Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message - with type t = a) buffer = - buffer |> Ocaml_protoc_plugin.Runtime.Runtime'.Reader.create |> M.from_proto - |> function - | Ok r -> r - | Error e -> - failwith - (Printf.sprintf "Could not decode request: %s" - (Ocaml_protoc_plugin.Result.show_error e)) - let unary (type request response) - (module Protoc_rpc : Protoc_rpc.S - with type Request.t = request - and type Response.t = response) ~f:handler = + (rpc_codec : (request, response) Rpc_codec.t) ~f:handler = let handler buffer = let status, response = - handler (decode_exn (module Protoc_rpc.Request) buffer) + handler (Rpc_codec.decode (Rpc_codec.request rpc_codec) buffer) in ( status, Option.map - (fun response -> encode (module Protoc_rpc.Response) response) + (fun response -> + Rpc_codec.encode (Rpc_codec.response rpc_codec) response) response ) in - { protoc_rpc = (module Protoc_rpc); rpc = Rpc.Unary handler } + T { rpc_codec; rpc = Rpc.Unary handler } let server_streaming (type request response) - (module Protoc_rpc : Protoc_rpc.S - with type Request.t = request - and type Response.t = response) ~f:handler = + (rpc_codec : (request, response) Rpc_codec.t) ~f:handler = let handler buffer f = handler - (decode_exn (module Protoc_rpc.Request) buffer) - (fun response -> f (encode (module Protoc_rpc.Response) response)) + (Rpc_codec.decode (Rpc_codec.request rpc_codec) buffer) + (fun response -> + f (Rpc_codec.encode (Rpc_codec.response rpc_codec) response)) in - { protoc_rpc = (module Protoc_rpc); rpc = Rpc.Server_streaming handler } + T { rpc_codec; rpc = Rpc.Server_streaming handler } let client_streaming (type request response) - (module Protoc_rpc : Protoc_rpc.S - with type Request.t = request - and type Response.t = response) ~f:handler = + (rpc_codec : (request, response) Rpc_codec.t) ~f:handler = let handler requests = let requests = - Seq.map (fun str -> decode_exn (module Protoc_rpc.Request) str) requests + Seq.map + (fun buffer -> Rpc_codec.decode (Rpc_codec.request rpc_codec) buffer) + requests in let status, response = handler requests in ( status, Option.map - (fun response -> encode (module Protoc_rpc.Response) response) + (fun response -> + Rpc_codec.encode (Rpc_codec.response rpc_codec) response) response ) in - { protoc_rpc = (module Protoc_rpc); rpc = Rpc.Client_streaming handler } + T { rpc_codec; rpc = Rpc.Client_streaming handler } let bidirectional_streaming (type request response) - (module Protoc_rpc : Protoc_rpc.S - with type Request.t = request - and type Response.t = response) ~f:handler = + (rpc_codec : (request, response) Rpc_codec.t) ~f:handler = let handler requests f = let requests = - Seq.map (fun str -> decode_exn (module Protoc_rpc.Request) str) requests + Seq.map + (fun buffer -> Rpc_codec.decode (Rpc_codec.request rpc_codec) buffer) + requests in handler requests (fun response -> - f (encode (module Protoc_rpc.Response) response)) + f (Rpc_codec.encode (Rpc_codec.response rpc_codec) response)) in - { - protoc_rpc = (module Protoc_rpc); - rpc = Rpc.Bidirectional_streaming handler; - } + T { rpc_codec; rpc = Rpc.Bidirectional_streaming handler } end diff --git a/lib/grpc-eio/server.mli b/lib/grpc-eio/server.mli index 7ec550a..d12c39a 100644 --- a/lib/grpc-eio/server.mli +++ b/lib/grpc-eio/server.mli @@ -92,20 +92,20 @@ module Typed_rpc : sig file. *) val unary : - ('request, 'response) Protoc_rpc.t -> f:('request, 'response) unary -> t + ('request, 'response) Rpc_codec.t -> f:('request, 'response) unary -> t val client_streaming : - ('request, 'response) Protoc_rpc.t -> + ('request, 'response) Rpc_codec.t -> f:('request, 'response) client_streaming -> t val server_streaming : - ('request, 'response) Protoc_rpc.t -> + ('request, 'response) Rpc_codec.t -> f:('request, 'response) server_streaming -> t val bidirectional_streaming : - ('request, 'response) Protoc_rpc.t -> + ('request, 'response) Rpc_codec.t -> f:('request, 'response) bidirectional_streaming -> t diff --git a/lib/grpc-protobuf-eio/dune b/lib/grpc-protobuf-eio/dune new file mode 100644 index 0000000..13af2d0 --- /dev/null +++ b/lib/grpc-protobuf-eio/dune @@ -0,0 +1,4 @@ +(library + (name grpc_protobuf_eio) + (public_name grpc-protobuf-eio) + (libraries grpc h2 eio grpc-eio ocaml-protoc-plugin)) diff --git a/lib/grpc-eio/protoc_rpc.ml b/lib/grpc-protobuf-eio/protoc_codec.ml similarity index 52% rename from lib/grpc-eio/protoc_rpc.ml rename to lib/grpc-protobuf-eio/protoc_codec.ml index 4cb677b..6218a85 100644 --- a/lib/grpc-eio/protoc_rpc.ml +++ b/lib/grpc-protobuf-eio/protoc_codec.ml @@ -1,24 +1,11 @@ module type S = Ocaml_protoc_plugin.Service.Rpc -type ('request, 'response) t = - (module S with type Request.t = 'request and type Response.t = 'response) - -let service_name (type request response) - (module R : S with type Request.t = request and type Response.t = response) - = - (match R.package_name with Some p -> p ^ "." | None -> "") ^ R.service_name - -let rpc_name (type request response) - (module R : S with type Request.t = request and type Response.t = response) - = - R.method_name - let encode (type a) (module M : Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message with type t = a) (a : a) = a |> M.to_proto |> Ocaml_protoc_plugin.Runtime.Runtime'.Writer.contents -let decode_exn (type a) +let decode (type a) (module M : Ocaml_protoc_plugin.Runtime.Runtime'.Service.Message with type t = a) buffer = buffer |> Ocaml_protoc_plugin.Runtime.Runtime'.Reader.create |> M.from_proto @@ -28,3 +15,28 @@ let decode_exn (type a) failwith (Printf.sprintf "Could not decode request: %s" (Ocaml_protoc_plugin.Result.show_error e)) + +let make (type request response) + (module R : S with type Request.t = request and type Response.t = response) + = + (module struct + module Request = struct + type t = request + + let encode t = encode (module R.Request) t + let decode buffer = decode (module R.Request) buffer + end + + module Response = struct + type t = response + + let encode t = encode (module R.Response) t + let decode buffer = decode (module R.Response) buffer + end + + let package_name = R.package_name + let service_name = R.service_name + let method_name = R.method_name + end : Grpc_eio.Rpc_codec.S + with type Request.t = request + and type Response.t = response) diff --git a/lib/grpc-protobuf-eio/protoc_codec.mli b/lib/grpc-protobuf-eio/protoc_codec.mli new file mode 100644 index 0000000..113e729 --- /dev/null +++ b/lib/grpc-protobuf-eio/protoc_codec.mli @@ -0,0 +1,7 @@ +module type S = Ocaml_protoc_plugin.Service.Rpc + +val make : + (module Ocaml_protoc_plugin.Service.Rpc + with type Request.t = 'request + and type Response.t = 'response) -> + ('request, 'response) Grpc_eio.Rpc_codec.t From 65f0f7f043d0c6078d58d84d6f39431a26de5797 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Fri, 8 Dec 2023 09:42:05 +0100 Subject: [PATCH 03/12] move rpc spec to grpc - `Grpc_protobuf` is no longer eio specific --- dune-project | 13 ++--- examples/greeter-client-eio/dune | 10 +--- .../greeter-client-eio/greeter_client_eio.ml | 2 +- examples/greeter-server-eio/dune | 10 +--- .../greeter-server-eio/greeter_server_eio.ml | 2 +- examples/routeguide-tutorial.md | 16 +++--- examples/routeguide/src/client.ml | 8 +-- examples/routeguide/src/dune | 3 +- examples/routeguide/src/server.ml | 8 +-- grpc-protobuf-eio.opam => grpc-protobuf.opam | 7 +-- lib/grpc-eio/client.ml | 38 ++++++------- lib/grpc-eio/client.mli | 12 ++--- lib/grpc-eio/grpc_eio.ml | 1 - lib/grpc-eio/rpc_codec_interface.ml | 26 --------- lib/grpc-eio/rpc_codec_interface.mli | 26 --------- lib/grpc-eio/server.ml | 54 +++++++++---------- lib/grpc-eio/server.mli | 20 +++---- lib/grpc-protobuf-eio/dune | 4 -- lib/grpc-protobuf/dune | 4 ++ .../grpc_protobuf.ml} | 4 +- .../grpc_protobuf.mli} | 4 +- lib/grpc/grpc.ml | 1 + lib/{grpc-eio/rpc_codec.ml => grpc/rpc.ml} | 35 ++++++++++-- lib/{grpc-eio/rpc_codec.mli => grpc/rpc.mli} | 28 +++++++++- 24 files changed, 152 insertions(+), 184 deletions(-) rename grpc-protobuf-eio.opam => grpc-protobuf.opam (81%) delete mode 100644 lib/grpc-eio/rpc_codec_interface.ml delete mode 100644 lib/grpc-eio/rpc_codec_interface.mli delete mode 100644 lib/grpc-protobuf-eio/dune create mode 100644 lib/grpc-protobuf/dune rename lib/{grpc-protobuf-eio/protoc_codec.ml => grpc-protobuf/grpc_protobuf.ml} (95%) rename lib/{grpc-protobuf-eio/protoc_codec.mli => grpc-protobuf/grpc_protobuf.mli} (75%) rename lib/{grpc-eio/rpc_codec.ml => grpc/rpc.ml} (62%) rename lib/{grpc-eio/rpc_codec.mli => grpc/rpc.mli} (52%) diff --git a/dune-project b/dune-project index 745eb2a..1b10386 100644 --- a/dune-project +++ b/dune-project @@ -78,20 +78,15 @@ stringext)) (package - (name grpc-protobuf-eio) - (synopsis "An Eio implementation of gRPC with protobuf serialization") + (name grpc-protobuf) + (synopsis "An implementation of gRPC with protobuf serialization") (description - "Functionality for building gRPC services and rpcs with `eio` and `ocaml-protoc-plugin`") + "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin`") (depends (grpc (= :version)) - (grpc-eio - (= :version)) - (eio - (>= 0.12)) (ocaml-protoc-plugin - (>= 4.5)) - stringext)) + (>= 4.5)))) (package (name grpc-examples) diff --git a/examples/greeter-client-eio/dune b/examples/greeter-client-eio/dune index f87588c..7846601 100644 --- a/examples/greeter-client-eio/dune +++ b/examples/greeter-client-eio/dune @@ -1,11 +1,3 @@ (executable (name greeter_client_eio) - (libraries - grpc - grpc-eio - grpc-protobuf-eio - ocaml-protoc-plugin - eio_main - greeter - h2 - h2-eio)) + (libraries grpc grpc-eio grpc-protobuf eio_main greeter h2 h2-eio)) diff --git a/examples/greeter-client-eio/greeter_client_eio.ml b/examples/greeter-client-eio/greeter_client_eio.ml index 0fc34ed..9e83e0c 100644 --- a/examples/greeter-client-eio/greeter_client_eio.ml +++ b/examples/greeter-client-eio/greeter_client_eio.ml @@ -30,7 +30,7 @@ let main env = let result = Grpc_eio.Client.Typed_rpc.call - (Grpc_protobuf_eio.Protoc_codec.make (module Greeter.SayHello)) + (Grpc_protobuf.rpc (module Greeter.SayHello)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) () diff --git a/examples/greeter-server-eio/dune b/examples/greeter-server-eio/dune index 12d7b05..1228ac4 100644 --- a/examples/greeter-server-eio/dune +++ b/examples/greeter-server-eio/dune @@ -1,11 +1,3 @@ (executable (name greeter_server_eio) - (libraries - grpc - grpc-eio - grpc-protobuf-eio - ocaml-protoc-plugin - eio_main - greeter - h2 - h2-eio)) + (libraries grpc grpc-eio grpc-protobuf eio_main greeter h2 h2-eio)) diff --git a/examples/greeter-server-eio/greeter_server_eio.ml b/examples/greeter-server-eio/greeter_server_eio.ml index 1bede24..451522e 100644 --- a/examples/greeter-server-eio/greeter_server_eio.ml +++ b/examples/greeter-server-eio/greeter_server_eio.ml @@ -3,7 +3,7 @@ open Grpc_eio let say_hello = let module SayHello = Greeter.Mypackage.Greeter.SayHello in Grpc_eio.Server.Typed_rpc.unary - (Grpc_protobuf_eio.Protoc_codec.make (module SayHello)) + (Grpc_protobuf.rpc (module SayHello)) ~f:(fun request -> let message = if request = "" then "You forgot your name!" diff --git a/examples/routeguide-tutorial.md b/examples/routeguide-tutorial.md index 8e0eab2..db777ce 100644 --- a/examples/routeguide-tutorial.md +++ b/examples/routeguide-tutorial.md @@ -205,7 +205,7 @@ Let's look at the simplest type first, `GetFeature` which just gets a `Point` fr ```ocaml let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.GetFeature)) + (Grpc_protobuf.rpc (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -237,7 +237,7 @@ Now let's look at one of our streaming RPCs. `list_features` is a server-side st ```ocaml let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.ListFeatures)) + (Grpc_protobuf.rpc (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -260,7 +260,7 @@ Now let's look at something a little more complicated: the client-side streaming ```ocaml let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RecordRoute)) + (Grpc_protobuf.rpc (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -311,7 +311,7 @@ Finally, let's look at our bidirectional streaming RPC `route_chat`, which recei ```ocaml let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RouteChat)) + (Grpc_protobuf.rpc (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -400,7 +400,7 @@ Calling the simple RPC `get_feature` requires building up a `Client.call` repres let call_get_feature connection point = let response = Client.Typed_rpc.call - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.GetFeature)) + (Grpc_protobuf.rpc (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -428,7 +428,7 @@ let print_features connection = let stream = Client.Typed_rpc.call - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.ListFeatures)) + (Grpc_protobuf.rpc (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -465,7 +465,7 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RecordRoute)) + (Grpc_protobuf.rpc (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -534,7 +534,7 @@ We start by generating a short sequence of locations, similar to how we did for in let result = Client.Typed_rpc.call - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RouteChat)) + (Grpc_protobuf.rpc (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/client.ml b/examples/routeguide/src/client.ml index 787c995..b057289 100644 --- a/examples/routeguide/src/client.ml +++ b/examples/routeguide/src/client.ml @@ -21,7 +21,7 @@ let client ~sw host port network = let call_get_feature connection point = let response = Client.Typed_rpc.call - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.GetFeature)) + (Grpc_protobuf.rpc (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -45,7 +45,7 @@ let print_features connection = let stream = Client.Typed_rpc.call - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.ListFeatures)) + (Grpc_protobuf.rpc (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -75,7 +75,7 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RecordRoute)) + (Grpc_protobuf.rpc (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -135,7 +135,7 @@ let run_route_chat clock connection = in let result = Client.Typed_rpc.call - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RouteChat)) + (Grpc_protobuf.rpc (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/dune b/examples/routeguide/src/dune index 5e6f852..4fe4a41 100644 --- a/examples/routeguide/src/dune +++ b/examples/routeguide/src/dune @@ -4,10 +4,9 @@ (public_names routeguide-server routeguide-client) (libraries grpc-eio - grpc-protobuf-eio + grpc-protobuf eio_main h2-eio - ocaml-protoc-plugin routeguide yojson ppx_deriving_yojson.runtime) diff --git a/examples/routeguide/src/server.ml b/examples/routeguide/src/server.ml index 6422b11..02cbcca 100644 --- a/examples/routeguide/src/server.ml +++ b/examples/routeguide/src/server.ml @@ -75,7 +75,7 @@ let calc_distance (p1 : Point.t) (p2 : Point.t) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.GetFeature)) + (Grpc_protobuf.rpc (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -100,7 +100,7 @@ let get_feature (t : t) = (* $MDX part-begin=server-list-features *) let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.ListFeatures)) + (Grpc_protobuf.rpc (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -116,7 +116,7 @@ let list_features (t : t) = (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RecordRoute)) + (Grpc_protobuf.rpc (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -162,7 +162,7 @@ let record_route (t : t) (clock : _ Eio.Time.clock) = (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protobuf_eio.Protoc_codec.make (module RouteGuide.RouteChat)) + (Grpc_protobuf.rpc (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; diff --git a/grpc-protobuf-eio.opam b/grpc-protobuf.opam similarity index 81% rename from grpc-protobuf-eio.opam rename to grpc-protobuf.opam index 6e18c71..44973ce 100644 --- a/grpc-protobuf-eio.opam +++ b/grpc-protobuf.opam @@ -1,8 +1,8 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -synopsis: "An Eio implementation of gRPC with protobuf serialization" +synopsis: "An implementation of gRPC with protobuf serialization" description: - "Functionality for building gRPC services and rpcs with `eio` and `ocaml-protoc-plugin`" + "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin`" maintainer: ["Daniel Quernheim "] authors: [ "Andrew Jeffery " @@ -20,10 +20,7 @@ bug-reports: "https://github.com/dialohq/ocaml-grpc/issues" depends: [ "dune" {>= "3.7"} "grpc" {= version} - "grpc-eio" {= version} - "eio" {>= "0.12"} "ocaml-protoc-plugin" {>= "4.5"} - "stringext" "odoc" {with-doc} ] build: [ diff --git a/lib/grpc-eio/client.ml b/lib/grpc-eio/client.ml index 61ec788..5656eff 100644 --- a/lib/grpc-eio/client.ml +++ b/lib/grpc-eio/client.ml @@ -107,31 +107,31 @@ end module Typed_rpc = struct type ('request, 'response, 'a) handler = - ('request, 'response) Rpc_codec.t -> + ('request, 'response) Grpc.Rpc.t -> H2.Body.Writer.t -> H2.Body.Reader.t -> 'a let unary (type request response) ~f (request : request) - (rpc_codec : (request, response) Rpc_codec.t) = - let request = Rpc_codec.encode (Rpc_codec.request rpc_codec) request in + (rpc : (request, response) Grpc.Rpc.t) = + let request = Grpc.Rpc.encode (Grpc.Rpc.request rpc) request in let f response = let response = response |> Option.map (fun response -> - response |> Rpc_codec.decode (Rpc_codec.response rpc_codec)) + response |> Grpc.Rpc.decode (Grpc.Rpc.response rpc)) in f response in Rpc.unary ~f request let server_streaming (type request response) ~f (request : request) - (rpc_codec : (request, response) Rpc_codec.t) = - let request = Rpc_codec.encode (Rpc_codec.request rpc_codec) request in + (rpc : (request, response) Grpc.Rpc.t) = + let request = Grpc.Rpc.encode (Grpc.Rpc.request rpc) request in let f responses = let responses = Seq.map - (fun str -> Rpc_codec.decode (Rpc_codec.response rpc_codec) str) + (fun str -> Grpc.Rpc.decode (Grpc.Rpc.response rpc) str) responses in f responses @@ -139,7 +139,7 @@ module Typed_rpc = struct Rpc.server_streaming ~f request let client_streaming (type request response) ~f - (rpc_codec : (request, response) Rpc_codec.t) = + (rpc : (request, response) Grpc.Rpc.t) = let f requests response = let requests_reader, requests' = Seq.create_reader_writer () in let response', response_u = Eio.Promise.create () in @@ -150,14 +150,14 @@ module Typed_rpc = struct let response = Eio.Promise.await response |> Option.map (fun response -> - Rpc_codec.decode (Rpc_codec.response rpc_codec) response) + Grpc.Rpc.decode (Grpc.Rpc.response rpc) response) in Eio.Promise.resolve response_u response) (fun () -> Seq.iter (fun request -> Seq.write requests - (Rpc_codec.encode (Rpc_codec.request rpc_codec) request)) + (Grpc.Rpc.encode (Grpc.Rpc.request rpc) request)) requests_reader; Seq.close_writer requests)); f requests' response' @@ -165,12 +165,12 @@ module Typed_rpc = struct Rpc.client_streaming ~f let bidirectional_streaming (type request response) ~f - (rpc_codec : (request, response) Rpc_codec.t) = + (rpc : (request, response) Grpc.Rpc.t) = let f requests responses = let requests_reader, requests' = Seq.create_reader_writer () in let responses' = Seq.map - (fun str -> Rpc_codec.decode (Rpc_codec.response rpc_codec) str) + (fun str -> Grpc.Rpc.decode (Grpc.Rpc.response rpc) str) responses in Eio.Switch.run @@ fun sw -> @@ -178,18 +178,18 @@ module Typed_rpc = struct Seq.iter (fun request -> Seq.write requests - (Rpc_codec.encode (Rpc_codec.request rpc_codec) request)) + (Grpc.Rpc.encode (Grpc.Rpc.request rpc) request)) requests_reader; Seq.close_writer requests); f requests' responses' in Rpc.bidirectional_streaming ~f - let call (type request response a) - (rpc_codec : (request, response) Rpc_codec.t) ?scheme - ~(handler : (request, response, a) handler) ~do_request ?headers () = + let call (type request response a) (rpc : (request, response) Grpc.Rpc.t) + ?scheme ~(handler : (request, response, a) handler) ~do_request ?headers + () = call - ~service:(Rpc_codec.service_name rpc_codec) - ~rpc:(Rpc_codec.rpc_name rpc_codec) - ?scheme ~handler:(handler rpc_codec) ~do_request ?headers () + ~service:(Grpc.Rpc.service_name rpc) + ~rpc:(Grpc.Rpc.rpc_name rpc) ?scheme ~handler:(handler rpc) ~do_request + ?headers () end diff --git a/lib/grpc-eio/client.mli b/lib/grpc-eio/client.mli index 2e138c8..7a037d9 100644 --- a/lib/grpc-eio/client.mli +++ b/lib/grpc-eio/client.mli @@ -52,8 +52,8 @@ module Typed_rpc : sig {Rpc}, this interface will: - handle the coding/decoding of messages for you under the hood; - - use the service and RPC names provided by the protoc specification to - register the services with their expected names. *) + - use the service and RPC names provided by the rpc specification to + call the services with their expected names. *) type ('request, 'response, 'a) handler @@ -75,14 +75,14 @@ module Typed_rpc : sig f:('response option -> 'a) -> 'request -> ('request, 'response, 'a) handler val call : - ('request, 'response) Rpc_codec.t -> + ('request, 'response) Grpc.Rpc.t -> ?scheme:string -> handler:('request, 'response, 'a) handler -> do_request:do_request -> ?headers:H2.Headers.t -> unit -> ('a * Grpc.Status.t, H2.Status.t) result - (** The protoc rpc must be provided as it is used to handle coding/decoding of - messages as well as allows referring to the service and RPC names - specified in the [.proto] file. *) + (** The rpc specification must be provided as it is used to handle + coding/decoding of messages as well as allows referring to the service + and RPC names specified in the [.proto] file. *) end diff --git a/lib/grpc-eio/grpc_eio.ml b/lib/grpc-eio/grpc_eio.ml index 54aecdd..c7e9399 100644 --- a/lib/grpc-eio/grpc_eio.ml +++ b/lib/grpc-eio/grpc_eio.ml @@ -1,4 +1,3 @@ module Server = Server module Client = Client -module Rpc_codec = Rpc_codec module Seq = Seq diff --git a/lib/grpc-eio/rpc_codec_interface.ml b/lib/grpc-eio/rpc_codec_interface.ml deleted file mode 100644 index 816eb56..0000000 --- a/lib/grpc-eio/rpc_codec_interface.ml +++ /dev/null @@ -1,26 +0,0 @@ -type buffer = string - -module type Codec = sig - type t - - val encode : t -> buffer - val decode : buffer -> t -end - -module type S = sig - module Request : sig - type t - - include Codec with type t := t - end - - module Response : sig - type t - - include Codec with type t := t - end - - val package_name : string option - val service_name : string - val method_name : string -end diff --git a/lib/grpc-eio/rpc_codec_interface.mli b/lib/grpc-eio/rpc_codec_interface.mli deleted file mode 100644 index 816eb56..0000000 --- a/lib/grpc-eio/rpc_codec_interface.mli +++ /dev/null @@ -1,26 +0,0 @@ -type buffer = string - -module type Codec = sig - type t - - val encode : t -> buffer - val decode : buffer -> t -end - -module type S = sig - module Request : sig - type t - - include Codec with type t := t - end - - module Response : sig - type t - - include Codec with type t := t - end - - val package_name : string option - val service_name : string - val method_name : string -end diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index 5fc6f63..11964a7 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -116,10 +116,10 @@ module Service = struct let parts = String.split_on_char '/' request.target in if List.length parts > 1 then let rpc_name = List.nth parts (List.length parts - 1) in - let rpc = RpcMap.find_opt rpc_name t in - match rpc with - | Some rpc -> ( - match rpc with + let rpc_impl = RpcMap.find_opt rpc_name t in + match rpc_impl with + | Some rpc_impl -> ( + match rpc_impl with | Unary f -> Rpc.unary ~f reqd | Client_streaming f -> Rpc.client_streaming ~f reqd | Server_streaming f -> Rpc.server_streaming ~f reqd @@ -144,79 +144,79 @@ module Typed_rpc = struct 'request Seq.t -> ('response -> unit) -> Grpc.Status.t type t = - | T : { rpc_codec : ('request, 'response) Rpc_codec.t; rpc : Rpc.t } -> t + | T : { rpc_spec : ('request, 'response) Grpc.Rpc.t; rpc_impl : Rpc.t } -> t let server ts : server = List.fold_left (fun map (T t as packed) -> - let service_name = Rpc_codec.service_name t.rpc_codec in - let rpc = + let service_name = Grpc.Rpc.service_name t.rpc_spec in + let rpc_impl = ServiceMap.find_opt service_name map |> Option.value ~default:[] in - ServiceMap.add service_name (packed :: rpc) map) + ServiceMap.add service_name (packed :: rpc_impl) map) ServiceMap.empty ts |> ServiceMap.map (fun ts -> let service = List.fold_left (fun acc (T t) -> Service.add_rpc - ~name:(Rpc_codec.rpc_name t.rpc_codec) - ~rpc:t.rpc acc) + ~name:(Grpc.Rpc.rpc_name t.rpc_spec) + ~rpc:t.rpc_impl acc) (Service.v ()) ts in Service.handle_request service) - let unary (type request response) - (rpc_codec : (request, response) Rpc_codec.t) ~f:handler = + let unary (type request response) (rpc_spec : (request, response) Grpc.Rpc.t) + ~f:handler = let handler buffer = let status, response = - handler (Rpc_codec.decode (Rpc_codec.request rpc_codec) buffer) + handler (Grpc.Rpc.decode (Grpc.Rpc.request rpc_spec) buffer) in ( status, Option.map (fun response -> - Rpc_codec.encode (Rpc_codec.response rpc_codec) response) + Grpc.Rpc.encode (Grpc.Rpc.response rpc_spec) response) response ) in - T { rpc_codec; rpc = Rpc.Unary handler } + T { rpc_spec; rpc_impl = Rpc.Unary handler } let server_streaming (type request response) - (rpc_codec : (request, response) Rpc_codec.t) ~f:handler = + (rpc_spec : (request, response) Grpc.Rpc.t) ~f:handler = let handler buffer f = handler - (Rpc_codec.decode (Rpc_codec.request rpc_codec) buffer) + (Grpc.Rpc.decode (Grpc.Rpc.request rpc_spec) buffer) (fun response -> - f (Rpc_codec.encode (Rpc_codec.response rpc_codec) response)) + f (Grpc.Rpc.encode (Grpc.Rpc.response rpc_spec) response)) in - T { rpc_codec; rpc = Rpc.Server_streaming handler } + T { rpc_spec; rpc_impl = Rpc.Server_streaming handler } let client_streaming (type request response) - (rpc_codec : (request, response) Rpc_codec.t) ~f:handler = + (rpc_spec : (request, response) Grpc.Rpc.t) ~f:handler = let handler requests = let requests = Seq.map - (fun buffer -> Rpc_codec.decode (Rpc_codec.request rpc_codec) buffer) + (fun buffer -> Grpc.Rpc.decode (Grpc.Rpc.request rpc_spec) buffer) requests in let status, response = handler requests in ( status, Option.map (fun response -> - Rpc_codec.encode (Rpc_codec.response rpc_codec) response) + Grpc.Rpc.encode (Grpc.Rpc.response rpc_spec) response) response ) in - T { rpc_codec; rpc = Rpc.Client_streaming handler } + T { rpc_spec; rpc_impl = Rpc.Client_streaming handler } let bidirectional_streaming (type request response) - (rpc_codec : (request, response) Rpc_codec.t) ~f:handler = + (rpc_spec : (request, response) Grpc.Rpc.t) ~f:handler = let handler requests f = let requests = Seq.map - (fun buffer -> Rpc_codec.decode (Rpc_codec.request rpc_codec) buffer) + (fun buffer -> Grpc.Rpc.decode (Grpc.Rpc.request rpc_spec) buffer) requests in handler requests (fun response -> - f (Rpc_codec.encode (Rpc_codec.response rpc_codec) response)) + f (Grpc.Rpc.encode (Grpc.Rpc.response rpc_spec) response)) in - T { rpc_codec; rpc = Rpc.Bidirectional_streaming handler } + T { rpc_spec; rpc_impl = Rpc.Bidirectional_streaming handler } end diff --git a/lib/grpc-eio/server.mli b/lib/grpc-eio/server.mli index d12c39a..caebcfb 100644 --- a/lib/grpc-eio/server.mli +++ b/lib/grpc-eio/server.mli @@ -54,12 +54,8 @@ module Typed_rpc : sig {Rpc}, this interface will: - handle the coding/decoding of messages for you under the hood; - - use the service and RPC names provided by the protoc specification to - register the services with their expected names. - - If you need a more fine-grained control over the failures encountered by - encoding/decoding during the lifetime of a connection, you should use the - {Rpc} interface instead. *) + - use the service and RPC names provided by the rpc specification to + register the services with their expected names. *) type server := t @@ -86,26 +82,26 @@ module Typed_rpc : sig (** [t] represents an implementation for an RPC on the server side. *) (** The next functions are meant to be used by the server to create RPC - implementations. The protoc rpc that the function implements must be - provided as it is used to handle coding/decoding of messages. It also + implementations. The rpc specification that the function implements must + be provided as it is used to handle coding/decoding of messages. It also allows to refer to the service and RPC names specified in the [.proto] file. *) val unary : - ('request, 'response) Rpc_codec.t -> f:('request, 'response) unary -> t + ('request, 'response) Grpc.Rpc.t -> f:('request, 'response) unary -> t val client_streaming : - ('request, 'response) Rpc_codec.t -> + ('request, 'response) Grpc.Rpc.t -> f:('request, 'response) client_streaming -> t val server_streaming : - ('request, 'response) Rpc_codec.t -> + ('request, 'response) Grpc.Rpc.t -> f:('request, 'response) server_streaming -> t val bidirectional_streaming : - ('request, 'response) Rpc_codec.t -> + ('request, 'response) Grpc.Rpc.t -> f:('request, 'response) bidirectional_streaming -> t diff --git a/lib/grpc-protobuf-eio/dune b/lib/grpc-protobuf-eio/dune deleted file mode 100644 index 13af2d0..0000000 --- a/lib/grpc-protobuf-eio/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name grpc_protobuf_eio) - (public_name grpc-protobuf-eio) - (libraries grpc h2 eio grpc-eio ocaml-protoc-plugin)) diff --git a/lib/grpc-protobuf/dune b/lib/grpc-protobuf/dune new file mode 100644 index 0000000..9824ab4 --- /dev/null +++ b/lib/grpc-protobuf/dune @@ -0,0 +1,4 @@ +(library + (name grpc_protobuf) + (public_name grpc-protobuf) + (libraries grpc ocaml-protoc-plugin)) diff --git a/lib/grpc-protobuf-eio/protoc_codec.ml b/lib/grpc-protobuf/grpc_protobuf.ml similarity index 95% rename from lib/grpc-protobuf-eio/protoc_codec.ml rename to lib/grpc-protobuf/grpc_protobuf.ml index 6218a85..b662e35 100644 --- a/lib/grpc-protobuf-eio/protoc_codec.ml +++ b/lib/grpc-protobuf/grpc_protobuf.ml @@ -16,7 +16,7 @@ let decode (type a) (Printf.sprintf "Could not decode request: %s" (Ocaml_protoc_plugin.Result.show_error e)) -let make (type request response) +let rpc (type request response) (module R : S with type Request.t = request and type Response.t = response) = (module struct @@ -37,6 +37,6 @@ let make (type request response) let package_name = R.package_name let service_name = R.service_name let method_name = R.method_name - end : Grpc_eio.Rpc_codec.S + end : Grpc.Rpc.S with type Request.t = request and type Response.t = response) diff --git a/lib/grpc-protobuf-eio/protoc_codec.mli b/lib/grpc-protobuf/grpc_protobuf.mli similarity index 75% rename from lib/grpc-protobuf-eio/protoc_codec.mli rename to lib/grpc-protobuf/grpc_protobuf.mli index 113e729..33b7b39 100644 --- a/lib/grpc-protobuf-eio/protoc_codec.mli +++ b/lib/grpc-protobuf/grpc_protobuf.mli @@ -1,7 +1,7 @@ module type S = Ocaml_protoc_plugin.Service.Rpc -val make : +val rpc : (module Ocaml_protoc_plugin.Service.Rpc with type Request.t = 'request and type Response.t = 'response) -> - ('request, 'response) Grpc_eio.Rpc_codec.t + ('request, 'response) Grpc.Rpc.t diff --git a/lib/grpc/grpc.ml b/lib/grpc/grpc.ml index 00ca697..c84744b 100644 --- a/lib/grpc/grpc.ml +++ b/lib/grpc/grpc.ml @@ -2,3 +2,4 @@ module Server = Server module Status = Status module Message = Message module Buffer = Buffer +module Rpc = Rpc diff --git a/lib/grpc-eio/rpc_codec.ml b/lib/grpc/rpc.ml similarity index 62% rename from lib/grpc-eio/rpc_codec.ml rename to lib/grpc/rpc.ml index 002015b..c8dec13 100644 --- a/lib/grpc-eio/rpc_codec.ml +++ b/lib/grpc/rpc.ml @@ -1,4 +1,29 @@ -include Rpc_codec_interface +type buffer = string + +module type Codec = sig + type t + + val encode : t -> buffer + val decode : buffer -> t +end + +module type S = sig + module Request : sig + type t + + include Codec with type t := t + end + + module Response : sig + type t + + include Codec with type t := t + end + + val package_name : string option + val service_name : string + val method_name : string +end type ('request, 'response) t = (module S with type Request.t = 'request and type Response.t = 'response) @@ -18,16 +43,16 @@ module Codec = struct end let request (type request response) - (module Rpc_codec : S + (module Rpc_spec : S with type Request.t = request and type Response.t = response) = - (module Rpc_codec.Request : Codec with type t = request) + (module Rpc_spec.Request : Codec with type t = request) let response (type request response) - (module Rpc_codec : S + (module Rpc_spec : S with type Request.t = request and type Response.t = response) = - (module Rpc_codec.Response : Codec with type t = response) + (module Rpc_spec.Response : Codec with type t = response) let encode (type a) (module M : Codec with type t = a) (a : a) = a |> M.encode diff --git a/lib/grpc-eio/rpc_codec.mli b/lib/grpc/rpc.mli similarity index 52% rename from lib/grpc-eio/rpc_codec.mli rename to lib/grpc/rpc.mli index c85245f..2303446 100644 --- a/lib/grpc-eio/rpc_codec.mli +++ b/lib/grpc/rpc.mli @@ -1,5 +1,29 @@ -module type Codec = Rpc_codec_interface.Codec -module type S = Rpc_codec_interface.S +type buffer = string + +module type Codec = sig + type t + + val encode : t -> buffer + val decode : buffer -> t +end + +module type S = sig + module Request : sig + type t + + include Codec with type t := t + end + + module Response : sig + type t + + include Codec with type t := t + end + + val package_name : string option + val service_name : string + val method_name : string +end type ('request, 'response) t = (module S with type Request.t = 'request and type Response.t = 'response) From 7531988981829776db7566e15a8eb929fa904737 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Tue, 12 Dec 2023 20:28:07 +0100 Subject: [PATCH 04/12] rename grpc-protoc-plugin --- dune-project | 53 ++++++++++++------- examples/greeter-client-eio/dune | 2 +- .../greeter-client-eio/greeter_client_eio.ml | 2 +- examples/greeter-server-eio/dune | 2 +- .../greeter-server-eio/greeter_server_eio.ml | 2 +- examples/routeguide-tutorial.md | 16 +++--- examples/routeguide/src/client.ml | 8 +-- examples/routeguide/src/dune | 2 +- examples/routeguide/src/server.ml | 8 +-- grpc-protobuf.opam => grpc-protoc-plugin.opam | 0 lib/grpc-protobuf/dune | 4 -- lib/grpc-protoc-plugin/dune | 4 ++ .../grpc_protoc_plugin.ml} | 0 .../grpc_protoc_plugin.mli} | 0 14 files changed, 60 insertions(+), 43 deletions(-) rename grpc-protobuf.opam => grpc-protoc-plugin.opam (100%) delete mode 100644 lib/grpc-protobuf/dune create mode 100644 lib/grpc-protoc-plugin/dune rename lib/{grpc-protobuf/grpc_protobuf.ml => grpc-protoc-plugin/grpc_protoc_plugin.ml} (100%) rename lib/{grpc-protobuf/grpc_protobuf.mli => grpc-protoc-plugin/grpc_protoc_plugin.mli} (100%) diff --git a/dune-project b/dune-project index 1b10386..71cb9f1 100644 --- a/dune-project +++ b/dune-project @@ -29,7 +29,8 @@ (synopsis "A modular gRPC library") (description "This library builds some of the signatures and implementations of gRPC functionality. This is used in the more specialised package `grpc-lwt` which has more machinery, however this library can also be used to do some bits yourself.") - (tags (network rpc serialisation)) + (tags + (network rpc serialisation)) (depends (ocaml (>= 4.08)) @@ -44,7 +45,8 @@ (synopsis "An Lwt implementation of gRPC") (description "Functionality for building gRPC services and rpcs with `lwt`.") - (tags (network rpc serialisation)) + (tags + (network rpc serialisation)) (depends (grpc (= :version)) @@ -57,28 +59,31 @@ (synopsis "An Async implementation of gRPC") (description "Functionality for building gRPC services and rpcs with `async`.") - (tags (network rpc serialisation)) + (tags + (network rpc serialisation)) (depends (ocaml (>= 4.11)) (grpc (= :version)) - (async (>= v0.16)) + (async + (>= v0.16)) stringext)) (package (name grpc-eio) (synopsis "An Eio implementation of gRPC") (description - "Functionality for building gRPC services and rpcs with `eio`.") + "Functionality for building gRPC services and rpcs with `eio`.") (depends (grpc (= :version)) - (eio (>= 0.12)) - stringext)) + (eio + (>= 0.12)) + stringext)) (package - (name grpc-protobuf) + (name grpc-protoc-plugin) (synopsis "An implementation of gRPC with protobuf serialization") (description "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin`") @@ -92,7 +97,8 @@ (name grpc-examples) (synopsis "Various gRPC examples") (description "Various gRPC examples.") - (tags (network rpc serialisation)) + (tags + (network rpc serialisation)) (depends grpc-lwt h2-lwt-unix @@ -100,25 +106,36 @@ h2-async grpc-eio h2-eio - (ocaml-protoc-plugin (>= 4.5)) + (ocaml-protoc-plugin + (>= 4.5)) ppx_deriving_yojson conduit-lwt-unix cohttp-lwt-unix tls-async - (lwt_ssl (>= 1.2.0)) - (mdx (and (>= 2.2.1) :with-test)) - (eio_main (>= 0.12)) + (lwt_ssl + (>= 1.2.0)) + (mdx + (and + (>= 2.2.1) + :with-test)) + (eio_main + (>= 0.12)) stringext)) (package (name grpc-bench) (synopsis "Benchmarking package for gRPC") (description "Benchmarking package for gRPC.") - (tags (network rpc serialisation benchmark)) + (tags + (network rpc serialisation benchmark)) (depends grpc - (bechamel(>= 0.4.0)) + (bechamel + (>= 0.4.0)) notty - (bechamel-notty (>= 0.4.0)) - (bigstringaf (>= 0.9.1)) - (notty (>= 0.2.3)))) + (bechamel-notty + (>= 0.4.0)) + (bigstringaf + (>= 0.9.1)) + (notty + (>= 0.2.3)))) diff --git a/examples/greeter-client-eio/dune b/examples/greeter-client-eio/dune index 7846601..40151b3 100644 --- a/examples/greeter-client-eio/dune +++ b/examples/greeter-client-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_client_eio) - (libraries grpc grpc-eio grpc-protobuf eio_main greeter h2 h2-eio)) + (libraries grpc grpc-eio grpc-protoc-plugin eio_main greeter h2 h2-eio)) diff --git a/examples/greeter-client-eio/greeter_client_eio.ml b/examples/greeter-client-eio/greeter_client_eio.ml index 9e83e0c..f57cf86 100644 --- a/examples/greeter-client-eio/greeter_client_eio.ml +++ b/examples/greeter-client-eio/greeter_client_eio.ml @@ -30,7 +30,7 @@ let main env = let result = Grpc_eio.Client.Typed_rpc.call - (Grpc_protobuf.rpc (module Greeter.SayHello)) + (Grpc_protoc_plugin.rpc (module Greeter.SayHello)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) () diff --git a/examples/greeter-server-eio/dune b/examples/greeter-server-eio/dune index 1228ac4..05f400e 100644 --- a/examples/greeter-server-eio/dune +++ b/examples/greeter-server-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_server_eio) - (libraries grpc grpc-eio grpc-protobuf eio_main greeter h2 h2-eio)) + (libraries grpc grpc-eio grpc-protoc-plugin eio_main greeter h2 h2-eio)) diff --git a/examples/greeter-server-eio/greeter_server_eio.ml b/examples/greeter-server-eio/greeter_server_eio.ml index 451522e..75479f6 100644 --- a/examples/greeter-server-eio/greeter_server_eio.ml +++ b/examples/greeter-server-eio/greeter_server_eio.ml @@ -3,7 +3,7 @@ open Grpc_eio let say_hello = let module SayHello = Greeter.Mypackage.Greeter.SayHello in Grpc_eio.Server.Typed_rpc.unary - (Grpc_protobuf.rpc (module SayHello)) + (Grpc_protoc_plugin.rpc (module SayHello)) ~f:(fun request -> let message = if request = "" then "You forgot your name!" diff --git a/examples/routeguide-tutorial.md b/examples/routeguide-tutorial.md index db777ce..b6463d4 100644 --- a/examples/routeguide-tutorial.md +++ b/examples/routeguide-tutorial.md @@ -205,7 +205,7 @@ Let's look at the simplest type first, `GetFeature` which just gets a `Point` fr ```ocaml let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (Grpc_protobuf.rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.rpc (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -237,7 +237,7 @@ Now let's look at one of our streaming RPCs. `list_features` is a server-side st ```ocaml let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protobuf.rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.rpc (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -260,7 +260,7 @@ Now let's look at something a little more complicated: the client-side streaming ```ocaml let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protobuf.rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.rpc (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -311,7 +311,7 @@ Finally, let's look at our bidirectional streaming RPC `route_chat`, which recei ```ocaml let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protobuf.rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.rpc (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -400,7 +400,7 @@ Calling the simple RPC `get_feature` requires building up a `Client.call` repres let call_get_feature connection point = let response = Client.Typed_rpc.call - (Grpc_protobuf.rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.rpc (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -428,7 +428,7 @@ let print_features connection = let stream = Client.Typed_rpc.call - (Grpc_protobuf.rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.rpc (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -465,7 +465,7 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (Grpc_protobuf.rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.rpc (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -534,7 +534,7 @@ We start by generating a short sequence of locations, similar to how we did for in let result = Client.Typed_rpc.call - (Grpc_protobuf.rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.rpc (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/client.ml b/examples/routeguide/src/client.ml index b057289..71d7c90 100644 --- a/examples/routeguide/src/client.ml +++ b/examples/routeguide/src/client.ml @@ -21,7 +21,7 @@ let client ~sw host port network = let call_get_feature connection point = let response = Client.Typed_rpc.call - (Grpc_protobuf.rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.rpc (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -45,7 +45,7 @@ let print_features connection = let stream = Client.Typed_rpc.call - (Grpc_protobuf.rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.rpc (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -75,7 +75,7 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (Grpc_protobuf.rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.rpc (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -135,7 +135,7 @@ let run_route_chat clock connection = in let result = Client.Typed_rpc.call - (Grpc_protobuf.rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.rpc (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/dune b/examples/routeguide/src/dune index 4fe4a41..5da330a 100644 --- a/examples/routeguide/src/dune +++ b/examples/routeguide/src/dune @@ -4,7 +4,7 @@ (public_names routeguide-server routeguide-client) (libraries grpc-eio - grpc-protobuf + grpc-protoc-plugin eio_main h2-eio routeguide diff --git a/examples/routeguide/src/server.ml b/examples/routeguide/src/server.ml index 02cbcca..aecf7e0 100644 --- a/examples/routeguide/src/server.ml +++ b/examples/routeguide/src/server.ml @@ -75,7 +75,7 @@ let calc_distance (p1 : Point.t) (p2 : Point.t) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (Grpc_protobuf.rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.rpc (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -100,7 +100,7 @@ let get_feature (t : t) = (* $MDX part-begin=server-list-features *) let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protobuf.rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.rpc (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -116,7 +116,7 @@ let list_features (t : t) = (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protobuf.rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.rpc (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -162,7 +162,7 @@ let record_route (t : t) (clock : _ Eio.Time.clock) = (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protobuf.rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.rpc (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; diff --git a/grpc-protobuf.opam b/grpc-protoc-plugin.opam similarity index 100% rename from grpc-protobuf.opam rename to grpc-protoc-plugin.opam diff --git a/lib/grpc-protobuf/dune b/lib/grpc-protobuf/dune deleted file mode 100644 index 9824ab4..0000000 --- a/lib/grpc-protobuf/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name grpc_protobuf) - (public_name grpc-protobuf) - (libraries grpc ocaml-protoc-plugin)) diff --git a/lib/grpc-protoc-plugin/dune b/lib/grpc-protoc-plugin/dune new file mode 100644 index 0000000..900987e --- /dev/null +++ b/lib/grpc-protoc-plugin/dune @@ -0,0 +1,4 @@ +(library + (name grpc_protoc_plugin) + (public_name grpc-protoc-plugin) + (libraries grpc ocaml-protoc-plugin)) diff --git a/lib/grpc-protobuf/grpc_protobuf.ml b/lib/grpc-protoc-plugin/grpc_protoc_plugin.ml similarity index 100% rename from lib/grpc-protobuf/grpc_protobuf.ml rename to lib/grpc-protoc-plugin/grpc_protoc_plugin.ml diff --git a/lib/grpc-protobuf/grpc_protobuf.mli b/lib/grpc-protoc-plugin/grpc_protoc_plugin.mli similarity index 100% rename from lib/grpc-protobuf/grpc_protobuf.mli rename to lib/grpc-protoc-plugin/grpc_protoc_plugin.mli From 4f33face360d6bc0836316395d6c32625e3077e4 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Tue, 12 Dec 2023 21:22:42 +0100 Subject: [PATCH 05/12] adding support for ocaml-protoc and example --- dune-project | 17 +++++- examples/greeter-protoc-client-eio/dune | 3 + .../greeter_client_eio.ml | 49 ++++++++++++++++ examples/greeter-protoc-server-eio/dune | 3 + .../greeter_server_eio.ml | 58 +++++++++++++++++++ examples/greeter-protoc/dune | 11 ++++ examples/greeter-protoc/greeter.proto | 14 +++++ grpc-protoc-plugin.opam | 2 +- grpc-protoc.opam | 42 ++++++++++++++ lib/grpc-protoc/dune | 4 ++ lib/grpc-protoc/grpc_protoc.ml | 43 ++++++++++++++ lib/grpc-protoc/grpc_protoc.mli | 8 +++ 12 files changed, 252 insertions(+), 2 deletions(-) create mode 100644 examples/greeter-protoc-client-eio/dune create mode 100644 examples/greeter-protoc-client-eio/greeter_client_eio.ml create mode 100644 examples/greeter-protoc-server-eio/dune create mode 100644 examples/greeter-protoc-server-eio/greeter_server_eio.ml create mode 100644 examples/greeter-protoc/dune create mode 100644 examples/greeter-protoc/greeter.proto create mode 100644 grpc-protoc.opam create mode 100644 lib/grpc-protoc/dune create mode 100644 lib/grpc-protoc/grpc_protoc.ml create mode 100644 lib/grpc-protoc/grpc_protoc.mli diff --git a/dune-project b/dune-project index 71cb9f1..cf3a55e 100644 --- a/dune-project +++ b/dune-project @@ -84,7 +84,7 @@ (package (name grpc-protoc-plugin) - (synopsis "An implementation of gRPC with protobuf serialization") + (synopsis "An implementation of gRPC using ocaml-protoc-plugin") (description "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin`") (depends @@ -93,6 +93,21 @@ (ocaml-protoc-plugin (>= 4.5)))) +(package + (name grpc-protoc) + (synopsis "An implementation of gRPC using ocaml-protoc") + (description + "Functionality for building gRPC services and rpcs with `ocaml-protoc`") + (depends + (grpc + (= :version)) + (ocaml-protoc + (>= 3.0)) + (pbrt + (>= 3.0)) + (pbrt_services + (>= 3.0)))) + (package (name grpc-examples) (synopsis "Various gRPC examples") diff --git a/examples/greeter-protoc-client-eio/dune b/examples/greeter-protoc-client-eio/dune new file mode 100644 index 0000000..9ba8a85 --- /dev/null +++ b/examples/greeter-protoc-client-eio/dune @@ -0,0 +1,3 @@ +(executable + (name greeter_client_eio) + (libraries grpc grpc-eio grpc-protoc eio_main greeter_protoc h2 h2-eio)) diff --git a/examples/greeter-protoc-client-eio/greeter_client_eio.ml b/examples/greeter-protoc-client-eio/greeter_client_eio.ml new file mode 100644 index 0000000..dc9c0b0 --- /dev/null +++ b/examples/greeter-protoc-client-eio/greeter_client_eio.ml @@ -0,0 +1,49 @@ +let main env = + let name = if Array.length Sys.argv > 1 then Sys.argv.(1) else "anonymous" in + let host = "localhost" in + let port = "8080" in + let network = Eio.Stdenv.net env in + let run sw = + let inet, port = + Eio_unix.run_in_systhread (fun () -> + Unix.getaddrinfo host port [ Unix.(AI_FAMILY PF_INET) ]) + |> List.filter_map (fun (addr : Unix.addr_info) -> + match addr.ai_addr with + | Unix.ADDR_UNIX _ -> None + | ADDR_INET (addr, port) -> Some (addr, port)) + |> List.hd + in + let addr = `Tcp (Eio_unix.Net.Ipaddr.of_unix inet, port) in + let socket = Eio.Net.connect ~sw network addr in + let connection = + H2_eio.Client.create_connection ~sw ~error_handler:ignore socket + in + + let request = Greeter_protoc.Greeter.default_hello_request ~name () in + + let f response = + match response with + | Some response -> response + | None -> Greeter_protoc.Greeter.default_hello_reply () + in + + let result = + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc.rpc ~client:Greeter_protoc.Greeter.Greeter.Client.sayHello + ~server:(fun f -> + Greeter_protoc.Greeter.Greeter.Server.make ~sayHello:f ())) + ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) + ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) + () + in + + Eio.Promise.await (H2_eio.Client.shutdown connection); + result + in + Eio.Switch.run run + +let () = + match Eio_main.run main with + | Ok (reply, status) -> + Eio.traceln "%s: %s" (Grpc.Status.show status) reply.message + | Error err -> Eio.traceln "Error: %a" H2.Status.pp_hum err diff --git a/examples/greeter-protoc-server-eio/dune b/examples/greeter-protoc-server-eio/dune new file mode 100644 index 0000000..b4cb2b0 --- /dev/null +++ b/examples/greeter-protoc-server-eio/dune @@ -0,0 +1,3 @@ +(executable + (name greeter_server_eio) + (libraries grpc grpc-eio grpc-protoc eio_main greeter_protoc h2 h2-eio)) diff --git a/examples/greeter-protoc-server-eio/greeter_server_eio.ml b/examples/greeter-protoc-server-eio/greeter_server_eio.ml new file mode 100644 index 0000000..20fb51d --- /dev/null +++ b/examples/greeter-protoc-server-eio/greeter_server_eio.ml @@ -0,0 +1,58 @@ +open Grpc_eio + +let say_hello = + Grpc_eio.Server.Typed_rpc.unary + (Grpc_protoc.rpc ~client:Greeter_protoc.Greeter.Greeter.Client.sayHello + ~server:(fun f -> + Greeter_protoc.Greeter.Greeter.Server.make ~sayHello:f ())) + ~f:(fun request -> + let message = + if request.name = "" then "You forgot your name!" + else Format.sprintf "Hello, %s!" request.name + in + let reply = Greeter_protoc.Greeter.default_hello_reply ~message () in + (Grpc.Status.(v OK), Some reply)) + +let connection_handler server sw = + let error_handler client_address ?request:_ _error start_response = + Eio.traceln "Error in request from:%a" Eio.Net.Sockaddr.pp client_address; + let response_body = start_response H2.Headers.empty in + H2.Body.Writer.write_string response_body + "There was an error handling your request.\n"; + H2.Body.Writer.close response_body + in + let request_handler client_address request_descriptor = + Eio.traceln "Handling a request from:%a" Eio.Net.Sockaddr.pp client_address; + Eio.Fiber.fork ~sw (fun () -> + Grpc_eio.Server.handle_request server request_descriptor) + in + fun socket addr -> + H2_eio.Server.create_connection_handler ?config:None ~request_handler + ~error_handler addr ~sw socket + +let serve server env = + let port = 8080 in + let net = Eio.Stdenv.net env in + let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in + Eio.Switch.run @@ fun sw -> + let handler = connection_handler server sw in + let server_socket = + Eio.Net.listen net ~sw ~reuse_addr:true ~backlog:10 addr + in + let rec listen () = + Eio.Net.accept_fork ~sw server_socket + ~on_error:(fun exn -> Eio.traceln "%s" (Printexc.to_string exn)) + handler; + listen () + in + Printf.printf "Listening on port %i for grpc requests\n" port; + print_endline ""; + print_endline "Try running:"; + print_endline ""; + print_endline + {| dune exec -- examples/greeter-protoc-client-eio/greeter_client_eio.exe |}; + listen () + +let () = + let server = Server.Typed_rpc.server [ say_hello ] in + Eio_main.run (serve server) diff --git a/examples/greeter-protoc/dune b/examples/greeter-protoc/dune new file mode 100644 index 0000000..7cc5b2c --- /dev/null +++ b/examples/greeter-protoc/dune @@ -0,0 +1,11 @@ +(library + (name greeter_protoc) + (public_name grpc-examples.greeter-protoc) + (libraries ocaml-protoc pbrt pbrt_services)) + +(rule + (targets greeter.ml greeter.mli) + (deps + (:proto greeter.proto)) + (action + (run ocaml-protoc %{proto} --binary --pp --services --ml_out .))) diff --git a/examples/greeter-protoc/greeter.proto b/examples/greeter-protoc/greeter.proto new file mode 100644 index 0000000..1607c70 --- /dev/null +++ b/examples/greeter-protoc/greeter.proto @@ -0,0 +1,14 @@ +syntax = "proto3"; +package mypackage; + +// The greeting service definition. +service Greeter { + // Sends a greeting + rpc SayHello(HelloRequest) returns (HelloReply) {} +} + +// The request message containing the user's name. +message HelloRequest { string name = 1; } + +// The response message containing the greetings +message HelloReply { string message = 1; } diff --git a/grpc-protoc-plugin.opam b/grpc-protoc-plugin.opam index 44973ce..1ddae22 100644 --- a/grpc-protoc-plugin.opam +++ b/grpc-protoc-plugin.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -synopsis: "An implementation of gRPC with protobuf serialization" +synopsis: "An implementation of gRPC using ocaml-protoc-plugin" description: "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin`" maintainer: ["Daniel Quernheim "] diff --git a/grpc-protoc.opam b/grpc-protoc.opam new file mode 100644 index 0000000..fde3dfd --- /dev/null +++ b/grpc-protoc.opam @@ -0,0 +1,42 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "An implementation of gRPC using ocaml-protoc" +description: + "Functionality for building gRPC services and rpcs with `ocaml-protoc`" +maintainer: ["Daniel Quernheim "] +authors: [ + "Andrew Jeffery " + "Daniel Quernheim " + "Michael Bacarella " + "Sven Anderson " + "Tim McGilchrist " + "Wojtek Czekalski " + "dimitris.mostrous " +] +license: "BSD-3-Clause" +homepage: "https://github.com/dialohq/ocaml-grpc" +doc: "https://dialohq.github.io/ocaml-grpc" +bug-reports: "https://github.com/dialohq/ocaml-grpc/issues" +depends: [ + "dune" {>= "3.7"} + "grpc" {= version} + "ocaml-protoc" {>= "3.0"} + "pbrt" {>= "3.0"} + "pbrt_services" {>= "3.0"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/dialohq/ocaml-grpc.git" diff --git a/lib/grpc-protoc/dune b/lib/grpc-protoc/dune new file mode 100644 index 0000000..14a98b6 --- /dev/null +++ b/lib/grpc-protoc/dune @@ -0,0 +1,4 @@ +(library + (name grpc_protoc) + (public_name grpc-protoc) + (libraries grpc ocaml-protoc pbrt pbrt_services)) diff --git a/lib/grpc-protoc/grpc_protoc.ml b/lib/grpc-protoc/grpc_protoc.ml new file mode 100644 index 0000000..d836125 --- /dev/null +++ b/lib/grpc-protoc/grpc_protoc.ml @@ -0,0 +1,43 @@ +let encode (type a) (encode : a -> Pbrt.Encoder.t -> unit) (a : a) = + let encoder = Pbrt.Encoder.create () in + encode a encoder; + Pbrt.Encoder.to_string encoder + +let decode (type a) (decode : Pbrt.Decoder.t -> a) buffer = + let decoder = Pbrt.Decoder.of_string buffer in + decode decoder + +let rpc (type request response) + ~(client : (request, _, response, _) Pbrt_services.Client.rpc) + ~(server : + ((request, 'c, response, 'd) Pbrt_services.Server.rpc -> + (request, 'c, response, 'd) Pbrt_services.Server.rpc) -> + (request, 'c, response, 'd) Pbrt_services.Server.rpc + Pbrt_services.Server.t) = + let service = server (fun t -> t) in + let server = List.hd service.handlers in + (module struct + module Request = struct + type t = request + + let encode t = encode client.encode_pb_req t + let decode buffer = decode server.decode_pb_req buffer + end + + module Response = struct + type t = response + + let encode t = encode server.encode_pb_res t + let decode buffer = decode client.decode_pb_res buffer + end + + let package_name = + match service.package with + | [] -> None + | _ :: _ as packages -> Some (String.concat "." packages) + + let service_name = service.service_name + let method_name = server.name + end : Grpc.Rpc.S + with type Request.t = request + and type Response.t = response) diff --git a/lib/grpc-protoc/grpc_protoc.mli b/lib/grpc-protoc/grpc_protoc.mli new file mode 100644 index 0000000..d4283f8 --- /dev/null +++ b/lib/grpc-protoc/grpc_protoc.mli @@ -0,0 +1,8 @@ +val rpc : + client:('request, _, 'response, _) Pbrt_services.Client.rpc -> + server: + ((('request, 'c, 'response, 'd) Pbrt_services.Server.rpc -> + ('request, 'c, 'response, 'd) Pbrt_services.Server.rpc) -> + ('request, 'c, 'response, 'd) Pbrt_services.Server.rpc + Pbrt_services.Server.t) -> + ('request, 'response) Grpc.Rpc.t From 45d48787d98460614fbea527e44867dafacd3cc3 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Wed, 13 Dec 2023 09:25:29 +0100 Subject: [PATCH 06/12] improve support for ocaml-protoc (wip) - Make use of ocaml-protoc's server implementation bundle as intended; - Adapt routeguide example to ocaml-protoc to show the differences. This results in a more complicated [Grpc.Rpc] interface that tries to better capture the common parts between ocaml-protoc and ocaml-protoc-plugin that can be used by ocaml-grpc. --- .../greeter-client-eio/greeter_client_eio.ml | 2 +- .../greeter_client_eio.ml | 4 +- .../greeter_server_eio.ml | 18 +- examples/greeter-protoc/dune | 5 +- examples/greeter-protoc/greeter.proto | 14 - .../greeter-server-eio/greeter_server_eio.ml | 5 +- examples/routeguide-protoc/proto/dune | 24 ++ examples/routeguide-protoc/src/client.ml | 195 ++++++++++++++ examples/routeguide-protoc/src/dune | 14 + examples/routeguide-protoc/src/server.ml | 245 ++++++++++++++++++ examples/routeguide-tutorial.md | 19 +- examples/routeguide/src/client.ml | 8 +- examples/routeguide/src/server.ml | 11 +- lib/grpc-eio/client.ml | 55 ++-- lib/grpc-eio/client.mli | 2 +- lib/grpc-eio/server.ml | 99 ++++--- lib/grpc-eio/server.mli | 35 ++- lib/grpc-protoc-plugin/grpc_protoc_plugin.ml | 43 +-- lib/grpc-protoc-plugin/grpc_protoc_plugin.mli | 10 +- lib/grpc-protoc/grpc_protoc.ml | 50 ++-- lib/grpc-protoc/grpc_protoc.mli | 15 +- lib/grpc/rpc.ml | 74 ++---- lib/grpc/rpc.mli | 54 ++-- 23 files changed, 722 insertions(+), 279 deletions(-) delete mode 100644 examples/greeter-protoc/greeter.proto create mode 100644 examples/routeguide-protoc/proto/dune create mode 100644 examples/routeguide-protoc/src/client.ml create mode 100644 examples/routeguide-protoc/src/dune create mode 100644 examples/routeguide-protoc/src/server.ml diff --git a/examples/greeter-client-eio/greeter_client_eio.ml b/examples/greeter-client-eio/greeter_client_eio.ml index f57cf86..23be377 100644 --- a/examples/greeter-client-eio/greeter_client_eio.ml +++ b/examples/greeter-client-eio/greeter_client_eio.ml @@ -30,7 +30,7 @@ let main env = let result = Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc_plugin.rpc (module Greeter.SayHello)) + (Grpc_protoc_plugin.client_rpc (module Greeter.SayHello)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) () diff --git a/examples/greeter-protoc-client-eio/greeter_client_eio.ml b/examples/greeter-protoc-client-eio/greeter_client_eio.ml index dc9c0b0..ea1d57f 100644 --- a/examples/greeter-protoc-client-eio/greeter_client_eio.ml +++ b/examples/greeter-protoc-client-eio/greeter_client_eio.ml @@ -29,9 +29,7 @@ let main env = let result = Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc.rpc ~client:Greeter_protoc.Greeter.Greeter.Client.sayHello - ~server:(fun f -> - Greeter_protoc.Greeter.Greeter.Server.make ~sayHello:f ())) + (Grpc_protoc.client_rpc Greeter_protoc.Greeter.Greeter.Client.sayHello) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) () diff --git a/examples/greeter-protoc-server-eio/greeter_server_eio.ml b/examples/greeter-protoc-server-eio/greeter_server_eio.ml index 20fb51d..ba2a672 100644 --- a/examples/greeter-protoc-server-eio/greeter_server_eio.ml +++ b/examples/greeter-protoc-server-eio/greeter_server_eio.ml @@ -1,11 +1,8 @@ open Grpc_eio -let say_hello = - Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc.rpc ~client:Greeter_protoc.Greeter.Greeter.Client.sayHello - ~server:(fun f -> - Greeter_protoc.Greeter.Greeter.Server.make ~sayHello:f ())) - ~f:(fun request -> +let sayHello rpc = + Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) + ~f:(fun (request : Greeter_protoc.Greeter.hello_request) -> let message = if request.name = "" then "You forgot your name!" else Format.sprintf "Hello, %s!" request.name @@ -54,5 +51,12 @@ let serve server env = listen () let () = - let server = Server.Typed_rpc.server [ say_hello ] in + let server = + let { Pbrt_services.Server.package; service_name; handlers } = + Greeter_protoc.Greeter.Greeter.Server.make ~sayHello () + in + Server.Typed_rpc.server + (With_service_spec { package; service_name; handlers }) + in + Eio_main.run (serve server) diff --git a/examples/greeter-protoc/dune b/examples/greeter-protoc/dune index 7cc5b2c..9ebdcdb 100644 --- a/examples/greeter-protoc/dune +++ b/examples/greeter-protoc/dune @@ -1,8 +1,11 @@ (library (name greeter_protoc) - (public_name grpc-examples.greeter-protoc) + (package grpc-examples) (libraries ocaml-protoc pbrt pbrt_services)) +(rule + (copy ../greeter/greeter.proto greeter.proto)) + (rule (targets greeter.ml greeter.mli) (deps diff --git a/examples/greeter-protoc/greeter.proto b/examples/greeter-protoc/greeter.proto deleted file mode 100644 index 1607c70..0000000 --- a/examples/greeter-protoc/greeter.proto +++ /dev/null @@ -1,14 +0,0 @@ -syntax = "proto3"; -package mypackage; - -// The greeting service definition. -service Greeter { - // Sends a greeting - rpc SayHello(HelloRequest) returns (HelloReply) {} -} - -// The request message containing the user's name. -message HelloRequest { string name = 1; } - -// The response message containing the greetings -message HelloReply { string message = 1; } diff --git a/examples/greeter-server-eio/greeter_server_eio.ml b/examples/greeter-server-eio/greeter_server_eio.ml index 75479f6..a4e5df3 100644 --- a/examples/greeter-server-eio/greeter_server_eio.ml +++ b/examples/greeter-server-eio/greeter_server_eio.ml @@ -3,7 +3,7 @@ open Grpc_eio let say_hello = let module SayHello = Greeter.Mypackage.Greeter.SayHello in Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.rpc (module SayHello)) + (Grpc_protoc_plugin.server_rpc (module SayHello)) ~f:(fun request -> let message = if request = "" then "You forgot your name!" @@ -53,5 +53,6 @@ let serve server env = listen () let () = - let server = Server.Typed_rpc.server [ say_hello ] in + let server = Server.Typed_rpc.server (Handlers [ say_hello ]) in + Eio_main.run (serve server) diff --git a/examples/routeguide-protoc/proto/dune b/examples/routeguide-protoc/proto/dune new file mode 100644 index 0000000..6d00d81 --- /dev/null +++ b/examples/routeguide-protoc/proto/dune @@ -0,0 +1,24 @@ +(library + (name routeguide_protoc) + (package grpc-examples) + (preprocess + (pps ppx_deriving.show ppx_deriving.eq)) + (libraries ocaml-protoc pbrt pbrt_services)) + +(rule + (copy ../../routeguide/proto/route_guide.proto route_guide.proto)) + +(rule + (targets route_guide.ml route_guide.mli) + (deps + (:proto route_guide.proto)) + (action + (run + ocaml-protoc + %{proto} + --binary + --ocaml_all_types_ppx + "deriving show { with_path = false }, eq" + --services + --ml_out + .))) diff --git a/examples/routeguide-protoc/src/client.ml b/examples/routeguide-protoc/src/client.ml new file mode 100644 index 0000000..0d7681b --- /dev/null +++ b/examples/routeguide-protoc/src/client.ml @@ -0,0 +1,195 @@ +open Grpc_eio +module Route_guide = Routeguide_protoc.Route_guide + +(* $MDX part-begin=client-h2 *) +let client ~sw host port network = + let inet, port = + Eio_unix.run_in_systhread (fun () -> + Unix.getaddrinfo host port [ Unix.(AI_FAMILY PF_INET) ]) + |> List.filter_map (fun (addr : Unix.addr_info) -> + match addr.ai_addr with + | Unix.ADDR_UNIX _ -> None + | ADDR_INET (addr, port) -> Some (addr, port)) + |> List.hd + in + let addr = `Tcp (Eio_unix.Net.Ipaddr.of_unix inet, port) in + let socket = Eio.Net.connect ~sw network addr in + H2_eio.Client.create_connection ~sw ~error_handler:ignore socket + +(* $MDX part-end *) +(* $MDX part-begin=client-get-feature *) +let call_get_feature connection point = + let response = + Client.Typed_rpc.call + (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.getFeature) + ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) + ~handler: + (Client.Typed_rpc.unary point ~f:(function + | Some feature -> feature + | None -> Route_guide.default_feature ())) + () + in + match response with + | Ok (res, _ok) -> + Format.printf "RESPONSE = {%s}" (Route_guide.show_feature res) + | Error _ -> Printf.printf "an error occurred" + +(* $MDX part-end *) +(* $MDX part-begin=client-list-features *) +let print_features connection = + let rectangle = + Route_guide.default_rectangle + ~lo: + (Routeguide_protoc.Route_guide.default_point ~latitude:400000000l + ~longitude:(-750000000l) () + |> Option.some) + ~hi: + (Routeguide_protoc.Route_guide.default_point ~latitude:420000000l + ~longitude:(-730000000l) () + |> Option.some) + () + in + + let stream = + Client.Typed_rpc.call + (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.listFeatures) + ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) + ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) + () + in + match stream with + | Ok (results, _ok) -> + Seq.iter + (fun f -> Format.printf "RESPONSE = {%a}" Route_guide.pp_feature f) + results + | Error e -> + failwith (Printf.sprintf "HTTP2 error: %s" (H2.Status.to_string e)) + +(* $MDX part-end *) +(* $MDX part-begin=client-random-point *) +let random_point () : Route_guide.point = + let latitude = (Random.int 180 - 90) * 10000000 |> Int32.of_int in + let longitude = (Random.int 360 - 180) * 10000000 |> Int32.of_int in + Route_guide.default_point ~latitude ~longitude () + +(* $MDX part-end *) +(* $MDX part-begin=client-record-route *) +let run_record_route connection = + let points = + Random.int 100 + |> Seq.unfold (function 0 -> None | x -> Some (random_point (), x - 1)) + in + + let response = + Client.Typed_rpc.call + (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.recordRoute) + ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) + ~handler: + (Client.Typed_rpc.client_streaming ~f:(fun f response -> + (* Stream points to server. *) + Seq.iter (fun point -> Seq.write f point) points; + + (* Signal we have finished sending points. *) + Seq.close_writer f; + + (* Decode RouteSummary responses. *) + Eio.Promise.await response |> function + | Some summary -> summary + | None -> failwith (Printf.sprintf "No RouteSummary received."))) + () + in + match response with + | Ok (result, _ok) -> + Format.printf "SUMMARY = {%a}" Route_guide.pp_route_summary result + | Error e -> + failwith (Printf.sprintf "HTTP2 error: %s" (H2.Status.to_string e)) + +(* $MDX part-end *) +(* $MDX part-begin=client-route-chat-1 *) +let run_route_chat clock connection = + (* Generate locations. *) + let location_count = 5 in + Printf.printf "Generating %i locations\n" location_count; + let route_notes = + location_count + |> Seq.unfold (function + | 0 -> None + | x -> + Some + ( Route_guide.default_route_note + ~location:(random_point () |> Option.some) + ~message:(Printf.sprintf "Random Message %i" x) + (), + x - 1 )) + in + (* $MDX part-end *) + (* $MDX part-begin=client-route-chat-2 *) + let rec go writer reader notes = + match Seq.uncons notes with + | None -> + Seq.close_writer writer (* Signal no more notes from the client. *) + | Some (route_note, xs) -> ( + Seq.write writer route_note; + + (* Yield and sleep, waiting for server reply. *) + Eio.Time.sleep clock 1.0; + Eio.Fiber.yield (); + + match Seq.uncons reader with + | None -> failwith "Expecting response" + | Some (route_note, reader') -> + Format.printf "NOTE = {%s}\n" + (Route_guide.show_route_note route_note); + go writer reader' xs) + in + let result = + Client.Typed_rpc.call + (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.routeChat) + ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) + ~handler: + (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> + go writer reader route_notes)) + () + in + match result with + | Ok ((), _ok) -> () + | Error e -> + failwith (Printf.sprintf "HTTP2 error: %s" (H2.Status.to_string e)) + +(* $MDX part-end *) +(* $MDX part-begin=client-main *) + +let main env = + let port = "8080" in + let host = "localhost" in + let clock = Eio.Stdenv.clock env in + let network = Eio.Stdenv.net env in + let () = Random.self_init () in + + let run sw = + let connection = client ~sw host port network in + + Printf.printf "*** SIMPLE RPC ***\n"; + let request = + Route_guide.default_point ~latitude:409146138l ~longitude:(-746188906l) () + in + let result = call_get_feature connection request in + + Printf.printf "\n*** SERVER STREAMING ***\n"; + print_features connection; + + Printf.printf "\n*** CLIENT STREAMING ***\n"; + run_record_route connection; + + Printf.printf "\n*** BIDIRECTIONAL STREAMING ***\n"; + run_route_chat clock connection; + + Eio.Promise.await (H2_eio.Client.shutdown connection); + result + in + + Eio.Switch.run run + +let () = Eio_main.run main + +(* $MDX part-end *) diff --git a/examples/routeguide-protoc/src/dune b/examples/routeguide-protoc/src/dune new file mode 100644 index 0000000..b0b91be --- /dev/null +++ b/examples/routeguide-protoc/src/dune @@ -0,0 +1,14 @@ +(executables + (names server client) + (package grpc-examples) + (public_names routeguide-protoc-server routeguide-protoc-client) + (libraries + grpc-eio + grpc-protoc + eio_main + h2-eio + routeguide_protoc + yojson + ppx_deriving_yojson.runtime) + (preprocess + (pps ppx_deriving_yojson ppx_deriving.show ppx_deriving.eq))) diff --git a/examples/routeguide-protoc/src/server.ml b/examples/routeguide-protoc/src/server.ml new file mode 100644 index 0000000..4cb1e50 --- /dev/null +++ b/examples/routeguide-protoc/src/server.ml @@ -0,0 +1,245 @@ +open Grpc_eio +module Route_guide = Routeguide_protoc.Route_guide + +(* Derived data types to make reading JSON data easier. *) +type location = { latitude : int; longitude : int } [@@deriving yojson] +type feature = { location : location; name : string } [@@deriving yojson] +type feature_list = feature list [@@deriving yojson] + +(* This will act as a master state that the server is serving over RPC. *) +type t = { features : Route_guide.feature list } + +module RouteNotesMap = Hashtbl.Make (struct + type t = Route_guide.point + + let equal = Route_guide.equal_point + let hash s = Hashtbl.hash s +end) + +(** Load route_guide data from a JSON file. *) +let load_features path : Route_guide.feature list = + let json = Yojson.Safe.from_file path in + match feature_list_of_yojson json with + | Ok v -> + List.map + (fun feature -> + Route_guide.default_feature ~name:feature.name + ~location: + (Route_guide.default_point + ~longitude:(feature.location.longitude |> Int32.of_int) + ~latitude:(feature.location.latitude |> Int32.of_int) + () + |> Option.some) + ()) + v + | Error err -> failwith err + +let in_range (point : Route_guide.point) (rect : Route_guide.rectangle) : bool = + let lo = Option.get rect.lo in + let hi = Option.get rect.hi in + + let left = Int32.min lo.longitude hi.longitude in + let right = Int32.max lo.longitude hi.longitude in + let top = Int32.max lo.latitude hi.latitude in + let bottom = Int32.min lo.latitude hi.latitude in + + point.longitude >= left && point.longitude <= right + && point.latitude >= bottom && point.latitude <= top + +let pi = 4. *. atan 1. +let radians_of_degrees = ( *. ) (pi /. 180.) + +(* Calculates the distance between two points using the "haversine" formula. *) +(* This code was taken from http://www.movable-type.co.uk/scripts/latlong.html. *) +let calc_distance (p1 : Route_guide.point) (p2 : Route_guide.point) : int = + let cord_factor = 1e7 in + let r = 6_371_000.0 in + (* meters *) + let lat1 = Int32.to_float p1.latitude /. cord_factor in + let lat2 = Int32.to_float p2.latitude /. cord_factor in + let lng1 = Int32.to_float p1.longitude /. cord_factor in + let lng2 = Int32.to_float p2.longitude /. cord_factor in + + let lat_rad1 = radians_of_degrees lat1 in + let lat_rad2 = radians_of_degrees lat2 in + + let delta_lat = radians_of_degrees (lat2 -. lat1) in + let delta_lng = radians_of_degrees (lng2 -. lng1) in + + let a = + (sin (delta_lat /. 2.0) *. sin (delta_lat /. 2.0)) + +. cos lat_rad1 *. cos lat_rad2 + *. sin (delta_lng /. 2.0) + *. sin (delta_lng /. 2.0) + in + let c = 2.0 *. atan2 (sqrt a) (sqrt (1.0 -. a)) in + Float.to_int (r *. c) + +(* $MDX part-begin=server-get-feature *) +let get_feature (t : t) rpc = + Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) ~f:(fun point -> + Eio.traceln "GetFeature = {:%a}" Route_guide.pp_point point; + + (* Lookup the feature and if found return it. *) + let feature = + List.find_opt + (fun (f : Route_guide.feature) -> + match (f.location, point) with + | Some p1, p2 -> Route_guide.equal_point p1 p2 + | _, _ -> false) + t.features + in + Eio.traceln "Found feature %s" + (feature + |> Option.map Route_guide.show_feature + |> Option.value ~default:"Missing"); + match feature with + | Some feature -> (Grpc.Status.(v OK), Some feature) + | None -> + (* No feature was found, return an unnamed feature. *) + ( Grpc.Status.(v OK), + Some (Route_guide.default_feature ~location:(Some point) ()) )) + +(* $MDX part-end *) +(* $MDX part-begin=server-list-features *) +let list_features (t : t) rpc = + Grpc_eio.Server.Typed_rpc.server_streaming (Grpc_protoc.server_rpc rpc) + ~f:(fun rectangle f -> + (* Lookup and reply with features found. *) + let () = + List.iter + (fun (feature : Route_guide.feature) -> + if in_range (Option.get feature.location) rectangle then f feature + else ()) + t.features + in + Grpc.Status.(v OK)) + +(* $MDX part-end *) +(* $MDX part-begin=server-record-route *) +let record_route (t : t) (clock : _ Eio.Time.clock) rpc = + Grpc_eio.Server.Typed_rpc.client_streaming (Grpc_protoc.server_rpc rpc) + ~f:(fun (stream : Route_guide.point Seq.t) -> + Eio.traceln "RecordRoute"; + + let last_point = ref None in + let start = Eio.Time.now clock in + + let point_count, feature_count, distance = + Seq.fold_left + (fun (point_count, feature_count, distance) point -> + Eio.traceln " ==> Point = {%s}" (Route_guide.show_point point); + + (* Increment the point count *) + let point_count = point_count + 1 in + + (* Find features *) + let feature_count = + List.find_all + (fun (feature : Route_guide.feature) -> + Route_guide.equal_point (Option.get feature.location) point) + t.features + |> fun x -> List.length x + feature_count + in + + (* Calculate the distance *) + let distance = + match !last_point with + | Some last_point -> calc_distance last_point point + | None -> distance + in + last_point := Some point; + (point_count, feature_count, distance)) + (0, 0, 0) stream + in + let stop = Eio.Time.now clock in + let elapsed_time = int_of_float (stop -. start) in + let summary = + Route_guide.default_route_summary + ~point_count:(point_count |> Int32.of_int) + ~feature_count:(feature_count |> Int32.of_int) + ~distance:(distance |> Int32.of_int) + ~elapsed_time:(elapsed_time |> Int32.of_int) + () + in + Eio.traceln "RecordRoute exit\n"; + (Grpc.Status.(v OK), Some summary)) + +(* $MDX part-end *) +(* $MDX part-begin=server-route-chat *) +let route_chat (_ : t) rpc = + Grpc_eio.Server.Typed_rpc.bidirectional_streaming (Grpc_protoc.server_rpc rpc) + ~f:(fun + (stream : Route_guide.route_note Seq.t) + (f : Route_guide.route_note -> unit) + -> + Printf.printf "RouteChat\n"; + + Seq.iter + (fun note -> + Printf.printf " ==> Note = {%s}\n" (Route_guide.show_route_note note); + f note) + stream; + + Printf.printf "RouteChat exit\n"; + Grpc.Status.(v OK)) + +(* $MDX part-end *) +(* $MDX part-begin=server-grpc *) +let server t clock = + let { Pbrt_services.Server.package; service_name; handlers } = + Route_guide.RouteGuide.Server.make ~getFeature:(get_feature t) + ~listFeatures:(list_features t) ~recordRoute:(record_route t clock) + ~routeChat:(route_chat t) () + in + Server.Typed_rpc.server + (With_service_spec { package; service_name; handlers }) + +(* $MDX part-end *) +let connection_handler server ~sw = + let error_handler client_address ?request:_ _error start_response = + Eio.traceln "Error in request from:%a" Eio.Net.Sockaddr.pp client_address; + let response_body = start_response H2.Headers.empty in + H2.Body.Writer.write_string response_body + "There was an error handling your request.\n"; + H2.Body.Writer.close response_body + in + let request_handler _client_address request_descriptor = + Eio.Fiber.fork ~sw (fun () -> + Grpc_eio.Server.handle_request server request_descriptor) + in + fun socket addr -> + H2_eio.Server.create_connection_handler ?config:None ~request_handler + ~error_handler addr socket ~sw + +(* $MDX part-begin=server-main *) +let serve t env = + let port = 8080 in + let net = Eio.Stdenv.net env in + let clock = Eio.Stdenv.clock env in + let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in + Eio.Switch.run @@ fun sw -> + let handler = connection_handler ~sw (server t clock) in + let server_socket = + Eio.Net.listen net ~sw ~reuse_addr:true ~backlog:10 addr + in + let rec listen () = + Eio.Net.accept_fork ~sw server_socket + ~on_error:(fun exn -> Eio.traceln "%s" (Printexc.to_string exn)) + handler; + listen () + in + Eio.traceln "Listening on port %i for grpc requests\n" port; + listen () + +let () = + let path = + if Array.length Sys.argv > 1 then Sys.argv.(1) + else failwith "Path to datafile required." + in + + (* Load features. *) + let t = { features = load_features path } in + + Eio_main.run (serve t) +(* $MDX part-end *) diff --git a/examples/routeguide-tutorial.md b/examples/routeguide-tutorial.md index b6463d4..10261f7 100644 --- a/examples/routeguide-tutorial.md +++ b/examples/routeguide-tutorial.md @@ -194,7 +194,8 @@ The individual service functions from our proto definition are implemented using ```ocaml let server t clock = Server.Typed_rpc.server - [ get_feature t; list_features t; record_route t clock; route_chat t ] + (Handlers + [ get_feature t; list_features t; record_route t clock; route_chat t ]) ``` ### Simple RPC @@ -205,7 +206,7 @@ Let's look at the simplest type first, `GetFeature` which just gets a `Point` fr ```ocaml let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.server_rpc (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -237,7 +238,7 @@ Now let's look at one of our streaming RPCs. `list_features` is a server-side st ```ocaml let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protoc_plugin.rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.server_rpc (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -260,7 +261,7 @@ Now let's look at something a little more complicated: the client-side streaming ```ocaml let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protoc_plugin.rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.server_rpc (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -311,7 +312,7 @@ Finally, let's look at our bidirectional streaming RPC `route_chat`, which recei ```ocaml let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protoc_plugin.rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.server_rpc (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -400,7 +401,7 @@ Calling the simple RPC `get_feature` requires building up a `Client.call` repres let call_get_feature connection point = let response = Client.Typed_rpc.call - (Grpc_protoc_plugin.rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.client_rpc (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -428,7 +429,7 @@ let print_features connection = let stream = Client.Typed_rpc.call - (Grpc_protoc_plugin.rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.client_rpc (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -465,7 +466,7 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (Grpc_protoc_plugin.rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.client_rpc (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -534,7 +535,7 @@ We start by generating a short sequence of locations, similar to how we did for in let result = Client.Typed_rpc.call - (Grpc_protoc_plugin.rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.client_rpc (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/client.ml b/examples/routeguide/src/client.ml index 71d7c90..c55a304 100644 --- a/examples/routeguide/src/client.ml +++ b/examples/routeguide/src/client.ml @@ -21,7 +21,7 @@ let client ~sw host port network = let call_get_feature connection point = let response = Client.Typed_rpc.call - (Grpc_protoc_plugin.rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.client_rpc (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -45,7 +45,7 @@ let print_features connection = let stream = Client.Typed_rpc.call - (Grpc_protoc_plugin.rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.client_rpc (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -75,7 +75,7 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (Grpc_protoc_plugin.rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.client_rpc (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -135,7 +135,7 @@ let run_route_chat clock connection = in let result = Client.Typed_rpc.call - (Grpc_protoc_plugin.rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.client_rpc (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/server.ml b/examples/routeguide/src/server.ml index aecf7e0..91f88a6 100644 --- a/examples/routeguide/src/server.ml +++ b/examples/routeguide/src/server.ml @@ -75,7 +75,7 @@ let calc_distance (p1 : Point.t) (p2 : Point.t) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.server_rpc (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -100,7 +100,7 @@ let get_feature (t : t) = (* $MDX part-begin=server-list-features *) let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protoc_plugin.rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.server_rpc (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -116,7 +116,7 @@ let list_features (t : t) = (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protoc_plugin.rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.server_rpc (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -162,7 +162,7 @@ let record_route (t : t) (clock : _ Eio.Time.clock) = (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protoc_plugin.rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.server_rpc (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -179,7 +179,8 @@ let route_chat (_ : t) = (* $MDX part-begin=server-grpc *) let server t clock = Server.Typed_rpc.server - [ get_feature t; list_features t; record_route t clock; route_chat t ] + (Handlers + [ get_feature t; list_features t; record_route t clock; route_chat t ]) (* $MDX part-end *) let connection_handler server ~sw = diff --git a/lib/grpc-eio/client.ml b/lib/grpc-eio/client.ml index 5656eff..a8480c5 100644 --- a/lib/grpc-eio/client.ml +++ b/lib/grpc-eio/client.ml @@ -107,39 +107,31 @@ end module Typed_rpc = struct type ('request, 'response, 'a) handler = - ('request, 'response) Grpc.Rpc.t -> + ('request, 'response) Grpc.Rpc.Client_rpc.t -> H2.Body.Writer.t -> H2.Body.Reader.t -> 'a let unary (type request response) ~f (request : request) - (rpc : (request, response) Grpc.Rpc.t) = - let request = Grpc.Rpc.encode (Grpc.Rpc.request rpc) request in + (rpc : (request, response) Grpc.Rpc.Client_rpc.t) = + let request = rpc.encode_request request in let f response = - let response = - response - |> Option.map (fun response -> - response |> Grpc.Rpc.decode (Grpc.Rpc.response rpc)) - in + let response = response |> Option.map rpc.decode_response in f response in Rpc.unary ~f request let server_streaming (type request response) ~f (request : request) - (rpc : (request, response) Grpc.Rpc.t) = - let request = Grpc.Rpc.encode (Grpc.Rpc.request rpc) request in + (rpc : (request, response) Grpc.Rpc.Client_rpc.t) = + let request = rpc.encode_request request in let f responses = - let responses = - Seq.map - (fun str -> Grpc.Rpc.decode (Grpc.Rpc.response rpc) str) - responses - in + let responses = Seq.map rpc.decode_response responses in f responses in Rpc.server_streaming ~f request let client_streaming (type request response) ~f - (rpc : (request, response) Grpc.Rpc.t) = + (rpc : (request, response) Grpc.Rpc.Client_rpc.t) = let f requests response = let requests_reader, requests' = Seq.create_reader_writer () in let response', response_u = Eio.Promise.create () in @@ -148,16 +140,12 @@ module Typed_rpc = struct Eio.Fiber.both (fun () -> let response = - Eio.Promise.await response - |> Option.map (fun response -> - Grpc.Rpc.decode (Grpc.Rpc.response rpc) response) + Eio.Promise.await response |> Option.map rpc.decode_response in Eio.Promise.resolve response_u response) (fun () -> Seq.iter - (fun request -> - Seq.write requests - (Grpc.Rpc.encode (Grpc.Rpc.request rpc) request)) + (fun request -> Seq.write requests (rpc.encode_request request)) requests_reader; Seq.close_writer requests)); f requests' response' @@ -165,31 +153,24 @@ module Typed_rpc = struct Rpc.client_streaming ~f let bidirectional_streaming (type request response) ~f - (rpc : (request, response) Grpc.Rpc.t) = + (rpc : (request, response) Grpc.Rpc.Client_rpc.t) = let f requests responses = let requests_reader, requests' = Seq.create_reader_writer () in - let responses' = - Seq.map - (fun str -> Grpc.Rpc.decode (Grpc.Rpc.response rpc) str) - responses - in + let responses' = Seq.map rpc.decode_response responses in Eio.Switch.run @@ fun sw -> Eio.Fiber.fork ~sw (fun () -> Seq.iter - (fun request -> - Seq.write requests - (Grpc.Rpc.encode (Grpc.Rpc.request rpc) request)) + (fun request -> Seq.write requests (rpc.encode_request request)) requests_reader; Seq.close_writer requests); f requests' responses' in Rpc.bidirectional_streaming ~f - let call (type request response a) (rpc : (request, response) Grpc.Rpc.t) - ?scheme ~(handler : (request, response, a) handler) ~do_request ?headers - () = + let call (type request response a) + (rpc : (request, response) Grpc.Rpc.Client_rpc.t) ?scheme + ~(handler : (request, response, a) handler) ~do_request ?headers () = call - ~service:(Grpc.Rpc.service_name rpc) - ~rpc:(Grpc.Rpc.rpc_name rpc) ?scheme ~handler:(handler rpc) ~do_request - ?headers () + ~service:(Grpc.Rpc.Client_rpc.packaged_service_name rpc) + ~rpc:rpc.rpc_name ?scheme ~handler:(handler rpc) ~do_request ?headers () end diff --git a/lib/grpc-eio/client.mli b/lib/grpc-eio/client.mli index 7a037d9..023f866 100644 --- a/lib/grpc-eio/client.mli +++ b/lib/grpc-eio/client.mli @@ -75,7 +75,7 @@ module Typed_rpc : sig f:('response option -> 'a) -> 'request -> ('request, 'response, 'a) handler val call : - ('request, 'response) Grpc.Rpc.t -> + ('request, 'response) Grpc.Rpc.Client_rpc.t -> ?scheme:string -> handler:('request, 'response, 'a) handler -> do_request:do_request -> diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index 11964a7..b8da679 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -143,13 +143,53 @@ module Typed_rpc = struct type ('request, 'response) bidirectional_streaming = 'request Seq.t -> ('response -> unit) -> Grpc.Status.t - type t = - | T : { rpc_spec : ('request, 'response) Grpc.Rpc.t; rpc_impl : Rpc.t } -> t + type 'service_spec t = + | T : { + rpc_spec : ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t; + rpc_impl : Rpc.t; + } + -> 'service_spec t + + module Handlers = struct + type 'service_spec rpc = 'service_spec t + + type t = + | Handlers : Grpc.Rpc.Service_spec.t rpc list -> t + | With_service_spec : { + package : string list; + service_name : string; + handlers : unit rpc list; + } + -> t + end + + let server handlers : server = + let ts = + match (handlers : Handlers.t) with + | Handlers ts -> ts + | With_service_spec { package; service_name; handlers = ts } -> + List.map + (fun (T t) -> + T + { + t with + rpc_spec = + { + t.rpc_spec with + service_spec = Some { package; service_name }; + }; + }) + ts + in - let server ts : server = List.fold_left (fun map (T t as packed) -> - let service_name = Grpc.Rpc.service_name t.rpc_spec in + let service_name = + match t.rpc_spec.service_spec with + | Some service_spec -> + Grpc.Rpc.Service_spec.packaged_service_name service_spec + in + let rpc_impl = ServiceMap.find_opt service_name map |> Option.value ~default:[] in @@ -159,64 +199,41 @@ module Typed_rpc = struct let service = List.fold_left (fun acc (T t) -> - Service.add_rpc - ~name:(Grpc.Rpc.rpc_name t.rpc_spec) - ~rpc:t.rpc_impl acc) + Service.add_rpc ~name:t.rpc_spec.rpc_name ~rpc:t.rpc_impl acc) (Service.v ()) ts in Service.handle_request service) - let unary (type request response) (rpc_spec : (request, response) Grpc.Rpc.t) - ~f:handler = + let unary (type request response) + (rpc_spec : (request, response, _) Grpc.Rpc.Server_rpc.t) ~f:handler = let handler buffer = - let status, response = - handler (Grpc.Rpc.decode (Grpc.Rpc.request rpc_spec) buffer) - in - ( status, - Option.map - (fun response -> - Grpc.Rpc.encode (Grpc.Rpc.response rpc_spec) response) - response ) + let status, response = handler (rpc_spec.decode_request buffer) in + (status, Option.map rpc_spec.encode_response response) in T { rpc_spec; rpc_impl = Rpc.Unary handler } let server_streaming (type request response) - (rpc_spec : (request, response) Grpc.Rpc.t) ~f:handler = + (rpc_spec : (request, response, _) Grpc.Rpc.Server_rpc.t) ~f:handler = let handler buffer f = - handler - (Grpc.Rpc.decode (Grpc.Rpc.request rpc_spec) buffer) - (fun response -> - f (Grpc.Rpc.encode (Grpc.Rpc.response rpc_spec) response)) + handler (rpc_spec.decode_request buffer) (fun response -> + f (rpc_spec.encode_response response)) in T { rpc_spec; rpc_impl = Rpc.Server_streaming handler } let client_streaming (type request response) - (rpc_spec : (request, response) Grpc.Rpc.t) ~f:handler = + (rpc_spec : (request, response, _) Grpc.Rpc.Server_rpc.t) ~f:handler = let handler requests = - let requests = - Seq.map - (fun buffer -> Grpc.Rpc.decode (Grpc.Rpc.request rpc_spec) buffer) - requests - in + let requests = Seq.map rpc_spec.decode_request requests in let status, response = handler requests in - ( status, - Option.map - (fun response -> - Grpc.Rpc.encode (Grpc.Rpc.response rpc_spec) response) - response ) + (status, Option.map rpc_spec.encode_response response) in T { rpc_spec; rpc_impl = Rpc.Client_streaming handler } let bidirectional_streaming (type request response) - (rpc_spec : (request, response) Grpc.Rpc.t) ~f:handler = + (rpc_spec : (request, response, _) Grpc.Rpc.Server_rpc.t) ~f:handler = let handler requests f = - let requests = - Seq.map - (fun buffer -> Grpc.Rpc.decode (Grpc.Rpc.request rpc_spec) buffer) - requests - in - handler requests (fun response -> - f (Grpc.Rpc.encode (Grpc.Rpc.response rpc_spec) response)) + let requests = Seq.map rpc_spec.decode_request requests in + handler requests (fun response -> f (rpc_spec.encode_response response)) in T { rpc_spec; rpc_impl = Rpc.Bidirectional_streaming handler } end diff --git a/lib/grpc-eio/server.mli b/lib/grpc-eio/server.mli index caebcfb..4aa8bbe 100644 --- a/lib/grpc-eio/server.mli +++ b/lib/grpc-eio/server.mli @@ -78,7 +78,7 @@ module Typed_rpc : sig (** [bidirectional_streaming] is the type for an rpc where both the client and server can send multiple messages. *) - type t + type 'service_spec t (** [t] represents an implementation for an RPC on the server side. *) (** The next functions are meant to be used by the server to create RPC @@ -88,24 +88,39 @@ module Typed_rpc : sig file. *) val unary : - ('request, 'response) Grpc.Rpc.t -> f:('request, 'response) unary -> t + ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t -> + f:('request, 'response) unary -> + 'service_spec t val client_streaming : - ('request, 'response) Grpc.Rpc.t -> + ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t -> f:('request, 'response) client_streaming -> - t + 'service_spec t val server_streaming : - ('request, 'response) Grpc.Rpc.t -> + ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t -> f:('request, 'response) server_streaming -> - t + 'service_spec t val bidirectional_streaming : - ('request, 'response) Grpc.Rpc.t -> + ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t -> f:('request, 'response) bidirectional_streaming -> - t - - val server : t list -> server + 'service_spec t + + module Handlers : sig + type 'service_spec rpc := 'service_spec t + + type t = + | Handlers : Grpc.Rpc.Service_spec.t rpc list -> t + | With_service_spec : { + package : string list; + service_name : string; + handlers : unit rpc list; + } + -> t + end + + val server : Handlers.t -> server (** Having built a list of RPCs you will use this function to package them up into a server that is ready to be served over the network. This function takes care of registering the services based on the names provided by the diff --git a/lib/grpc-protoc-plugin/grpc_protoc_plugin.ml b/lib/grpc-protoc-plugin/grpc_protoc_plugin.ml index b662e35..a06d5f0 100644 --- a/lib/grpc-protoc-plugin/grpc_protoc_plugin.ml +++ b/lib/grpc-protoc-plugin/grpc_protoc_plugin.ml @@ -16,27 +16,30 @@ let decode (type a) (Printf.sprintf "Could not decode request: %s" (Ocaml_protoc_plugin.Result.show_error e)) -let rpc (type request response) +let service_spec (type request response) (module R : S with type Request.t = request and type Response.t = response) = - (module struct - module Request = struct - type t = request + { + Grpc.Rpc.Service_spec.package = R.package_name |> Option.to_list; + service_name = R.service_name; + } - let encode t = encode (module R.Request) t - let decode buffer = decode (module R.Request) buffer - end - - module Response = struct - type t = response - - let encode t = encode (module R.Response) t - let decode buffer = decode (module R.Response) buffer - end +let client_rpc (type request response) + (module R : S with type Request.t = request and type Response.t = response) + = + { + Grpc.Rpc.Client_rpc.service_spec = service_spec (module R); + rpc_name = R.method_name; + encode_request = encode (module R.Request); + decode_response = decode (module R.Response); + } - let package_name = R.package_name - let service_name = R.service_name - let method_name = R.method_name - end : Grpc.Rpc.S - with type Request.t = request - and type Response.t = response) +let server_rpc (type request response) + (module R : S with type Request.t = request and type Response.t = response) + = + { + Grpc.Rpc.Server_rpc.service_spec = Some (service_spec (module R)); + rpc_name = R.method_name; + decode_request = decode (module R.Request); + encode_response = encode (module R.Response); + } diff --git a/lib/grpc-protoc-plugin/grpc_protoc_plugin.mli b/lib/grpc-protoc-plugin/grpc_protoc_plugin.mli index 33b7b39..33a8056 100644 --- a/lib/grpc-protoc-plugin/grpc_protoc_plugin.mli +++ b/lib/grpc-protoc-plugin/grpc_protoc_plugin.mli @@ -1,7 +1,13 @@ module type S = Ocaml_protoc_plugin.Service.Rpc -val rpc : +val client_rpc : (module Ocaml_protoc_plugin.Service.Rpc with type Request.t = 'request and type Response.t = 'response) -> - ('request, 'response) Grpc.Rpc.t + ('request, 'response) Grpc.Rpc.Client_rpc.t + +val server_rpc : + (module Ocaml_protoc_plugin.Service.Rpc + with type Request.t = 'request + and type Response.t = 'response) -> + ('request, 'response, Grpc.Rpc.Service_spec.t) Grpc.Rpc.Server_rpc.t diff --git a/lib/grpc-protoc/grpc_protoc.ml b/lib/grpc-protoc/grpc_protoc.ml index d836125..b2567fa 100644 --- a/lib/grpc-protoc/grpc_protoc.ml +++ b/lib/grpc-protoc/grpc_protoc.ml @@ -7,37 +7,21 @@ let decode (type a) (decode : Pbrt.Decoder.t -> a) buffer = let decoder = Pbrt.Decoder.of_string buffer in decode decoder -let rpc (type request response) - ~(client : (request, _, response, _) Pbrt_services.Client.rpc) - ~(server : - ((request, 'c, response, 'd) Pbrt_services.Server.rpc -> - (request, 'c, response, 'd) Pbrt_services.Server.rpc) -> - (request, 'c, response, 'd) Pbrt_services.Server.rpc - Pbrt_services.Server.t) = - let service = server (fun t -> t) in - let server = List.hd service.handlers in - (module struct - module Request = struct - type t = request +let client_rpc (type request response) + (rpc : (request, _, response, _) Pbrt_services.Client.rpc) = + { + Grpc.Rpc.Client_rpc.service_spec = + { package = rpc.package; service_name = rpc.service_name }; + rpc_name = rpc.rpc_name; + encode_request = encode rpc.encode_pb_req; + decode_response = decode rpc.decode_pb_res; + } - let encode t = encode client.encode_pb_req t - let decode buffer = decode server.decode_pb_req buffer - end - - module Response = struct - type t = response - - let encode t = encode server.encode_pb_res t - let decode buffer = decode client.decode_pb_res buffer - end - - let package_name = - match service.package with - | [] -> None - | _ :: _ as packages -> Some (String.concat "." packages) - - let service_name = service.service_name - let method_name = server.name - end : Grpc.Rpc.S - with type Request.t = request - and type Response.t = response) +let server_rpc (type request response) + (rpc : (request, _, response, _) Pbrt_services.Server.rpc) = + { + Grpc.Rpc.Server_rpc.service_spec = None; + rpc_name = rpc.name; + decode_request = decode rpc.decode_pb_req; + encode_response = encode rpc.encode_pb_res; + } diff --git a/lib/grpc-protoc/grpc_protoc.mli b/lib/grpc-protoc/grpc_protoc.mli index d4283f8..8356284 100644 --- a/lib/grpc-protoc/grpc_protoc.mli +++ b/lib/grpc-protoc/grpc_protoc.mli @@ -1,8 +1,7 @@ -val rpc : - client:('request, _, 'response, _) Pbrt_services.Client.rpc -> - server: - ((('request, 'c, 'response, 'd) Pbrt_services.Server.rpc -> - ('request, 'c, 'response, 'd) Pbrt_services.Server.rpc) -> - ('request, 'c, 'response, 'd) Pbrt_services.Server.rpc - Pbrt_services.Server.t) -> - ('request, 'response) Grpc.Rpc.t +val client_rpc : + ('request, _, 'response, _) Pbrt_services.Client.rpc -> + ('request, 'response) Grpc.Rpc.Client_rpc.t + +val server_rpc : + ('request, _, 'response, _) Pbrt_services.Server.rpc -> + ('request, 'response, unit) Grpc.Rpc.Server_rpc.t diff --git a/lib/grpc/rpc.ml b/lib/grpc/rpc.ml index c8dec13..3191c5c 100644 --- a/lib/grpc/rpc.ml +++ b/lib/grpc/rpc.ml @@ -1,60 +1,34 @@ type buffer = string -module type Codec = sig - type t +module Service_spec = struct + type t = { package : string list; service_name : string } - val encode : t -> buffer - val decode : buffer -> t + let packaged_service_name t = + (match t.package with _ :: _ as p -> String.concat "." p | [] -> "") + ^ t.service_name end -module type S = sig - module Request : sig - type t +module Client_rpc = struct + type ('request, 'response) t = { + service_spec : Service_spec.t; + rpc_name : string; + encode_request : 'request -> buffer; + decode_response : buffer -> 'response; + } - include Codec with type t := t - end - - module Response : sig - type t - - include Codec with type t := t - end - - val package_name : string option - val service_name : string - val method_name : string + let packaged_service_name t = + Service_spec.packaged_service_name t.service_spec end -type ('request, 'response) t = - (module S with type Request.t = 'request and type Response.t = 'response) - -let service_name (type request response) - (module R : S with type Request.t = request and type Response.t = response) - = - (match R.package_name with Some p -> p ^ "." | None -> "") ^ R.service_name - -let rpc_name (type request response) - (module R : S with type Request.t = request and type Response.t = response) - = - R.method_name +module Server_rpc = struct + module Service_spec = struct + type 'a t = None : unit t | Some : Service_spec.t -> Service_spec.t t + end -module Codec = struct - type 'a t = (module Codec with type t = 'a) + type ('request, 'response, 'service_spec) t = { + service_spec : 'service_spec Service_spec.t; + rpc_name : string; + decode_request : buffer -> 'request; + encode_response : 'response -> buffer; + } end - -let request (type request response) - (module Rpc_spec : S - with type Request.t = request - and type Response.t = response) = - (module Rpc_spec.Request : Codec with type t = request) - -let response (type request response) - (module Rpc_spec : S - with type Request.t = request - and type Response.t = response) = - (module Rpc_spec.Response : Codec with type t = response) - -let encode (type a) (module M : Codec with type t = a) (a : a) = a |> M.encode - -let decode (type a) (module M : Codec with type t = a) buffer : a = - buffer |> M.decode diff --git a/lib/grpc/rpc.mli b/lib/grpc/rpc.mli index 2303446..442a4e7 100644 --- a/lib/grpc/rpc.mli +++ b/lib/grpc/rpc.mli @@ -1,41 +1,33 @@ type buffer = string -module type Codec = sig - type t +(** Exploring a separate client/server api that works better with [ocaml-protoc]. *) - val encode : t -> buffer - val decode : buffer -> t -end - -module type S = sig - module Request : sig - type t +module Service_spec : sig + type t = { package : string list; service_name : string } - include Codec with type t := t - end + val packaged_service_name : t -> string +end - module Response : sig - type t +module Client_rpc : sig + type ('request, 'response) t = { + service_spec : Service_spec.t; + rpc_name : string; + encode_request : 'request -> buffer; + decode_response : buffer -> 'response; + } - include Codec with type t := t - end - - val package_name : string option - val service_name : string - val method_name : string + val packaged_service_name : _ t -> string end -type ('request, 'response) t = - (module S with type Request.t = 'request and type Response.t = 'response) - -val service_name : _ t -> string -val rpc_name : _ t -> string +module Server_rpc : sig + module Service_spec : sig + type 'a t = None : unit t | Some : Service_spec.t -> Service_spec.t t + end -module Codec : sig - type 'a t = (module Codec with type t = 'a) + type ('request, 'response, 'service_spec) t = { + service_spec : 'service_spec Service_spec.t; + rpc_name : string; + decode_request : buffer -> 'request; + encode_response : 'response -> buffer; + } end - -val request : ('request, _) t -> 'request Codec.t -val response : (_, 'response) t -> 'response Codec.t -val encode : 'a Codec.t -> 'a -> string -val decode : 'a Codec.t -> string -> 'a From 042efeba3a81d1558654638df4b36261dc455012 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Fri, 15 Dec 2023 12:30:43 +0100 Subject: [PATCH 07/12] add dedicated user facing libraries --- dune-project | 42 +++++++++- examples/greeter-client-eio/dune | 2 +- .../greeter-client-eio/greeter_client_eio.ml | 7 +- examples/greeter-protoc-client-eio/dune | 2 +- .../greeter_client_eio.ml | 6 +- examples/greeter-protoc-server-eio/dune | 2 +- .../greeter_server_eio.ml | 11 +-- examples/greeter-server-eio/dune | 2 +- .../greeter-server-eio/greeter_server_eio.ml | 8 +- examples/routeguide-protoc/src/client.ml | 61 +++++++------- examples/routeguide-protoc/src/dune | 2 +- examples/routeguide-protoc/src/server.ml | 20 ++--- examples/routeguide-tutorial.md | 84 +++++++++---------- examples/routeguide/src/client.ml | 64 +++++++------- examples/routeguide/src/dune | 2 +- examples/routeguide/src/server.ml | 21 +++-- grpc-protoc-eio.opam | 44 ++++++++++ grpc-protoc-plugin-eio.opam | 42 ++++++++++ grpc-protoc-plugin.opam | 4 +- grpc-protoc.opam | 4 +- lib/grpc-eio/server.ml | 17 ++-- lib/grpc-eio/server.mli | 8 +- lib/grpc-protoc-eio/dune | 4 + lib/grpc-protoc-eio/grpc_protoc_eio.ml | 66 +++++++++++++++ lib/grpc-protoc-eio/grpc_protoc_eio.mli | 63 ++++++++++++++ lib/grpc-protoc-plugin-eio/dune | 4 + .../grpc_protoc_plugin_eio.ml | 73 ++++++++++++++++ .../grpc_protoc_plugin_eio.mli | 63 ++++++++++++++ 28 files changed, 541 insertions(+), 187 deletions(-) create mode 100644 grpc-protoc-eio.opam create mode 100644 grpc-protoc-plugin-eio.opam create mode 100644 lib/grpc-protoc-eio/dune create mode 100644 lib/grpc-protoc-eio/grpc_protoc_eio.ml create mode 100644 lib/grpc-protoc-eio/grpc_protoc_eio.mli create mode 100644 lib/grpc-protoc-plugin-eio/dune create mode 100644 lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.ml create mode 100644 lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.mli diff --git a/dune-project b/dune-project index cf3a55e..b835871 100644 --- a/dune-project +++ b/dune-project @@ -84,23 +84,57 @@ (package (name grpc-protoc-plugin) - (synopsis "An implementation of gRPC using ocaml-protoc-plugin") + (synopsis "Internal gRPC utils for ocaml-protoc-plugin") (description - "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin`") + "Internal utils for building gRPC services and rpcs with `ocaml-protoc-plugin`") (depends (grpc (= :version)) (ocaml-protoc-plugin (>= 4.5)))) +(package + (name grpc-protoc-plugin-eio) + (synopsis "An Eio implementation of gRPC using ocaml-protoc-plugin") + (description + "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin` and `eio`") + (depends + (grpc + (= :version)) + (grpc-eio + (= :version)) + (grpc-protoc-plugin + (= :version)) + (ocaml-protoc-plugin + (>= 4.5)))) + (package (name grpc-protoc) - (synopsis "An implementation of gRPC using ocaml-protoc") + (synopsis "Internal gRPC utils for ocaml-protoc") + (description + "Internal utils for building gRPC services and rpcs with `ocaml-protoc`") + (depends + (grpc + (= :version)) + (ocaml-protoc + (>= 3.0)) + (pbrt + (>= 3.0)) + (pbrt_services + (>= 3.0)))) + +(package + (name grpc-protoc-eio) + (synopsis "An Eio implementation of gRPC using ocaml-protoc") (description - "Functionality for building gRPC services and rpcs with `ocaml-protoc`") + "Functionality for building gRPC services and rpcs with `ocaml-protoc` and `eio`") (depends (grpc (= :version)) + (grpc-eio + (= :version)) + (grpc-protoc + (= :version)) (ocaml-protoc (>= 3.0)) (pbrt diff --git a/examples/greeter-client-eio/dune b/examples/greeter-client-eio/dune index 40151b3..3617055 100644 --- a/examples/greeter-client-eio/dune +++ b/examples/greeter-client-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_client_eio) - (libraries grpc grpc-eio grpc-protoc-plugin eio_main greeter h2 h2-eio)) + (libraries grpc grpc-protoc-plugin-eio eio_main greeter h2 h2-eio)) diff --git a/examples/greeter-client-eio/greeter_client_eio.ml b/examples/greeter-client-eio/greeter_client_eio.ml index 23be377..02230e7 100644 --- a/examples/greeter-client-eio/greeter_client_eio.ml +++ b/examples/greeter-client-eio/greeter_client_eio.ml @@ -29,11 +29,10 @@ let main env = in let result = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module Greeter.SayHello)) + Grpc_protoc_plugin_eio.Call.unary + (module Greeter.SayHello) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) - () + request ~f in Eio.Promise.await (H2_eio.Client.shutdown connection); diff --git a/examples/greeter-protoc-client-eio/dune b/examples/greeter-protoc-client-eio/dune index 9ba8a85..1154ed1 100644 --- a/examples/greeter-protoc-client-eio/dune +++ b/examples/greeter-protoc-client-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_client_eio) - (libraries grpc grpc-eio grpc-protoc eio_main greeter_protoc h2 h2-eio)) + (libraries grpc grpc-eio grpc-protoc-eio eio_main greeter_protoc h2 h2-eio)) diff --git a/examples/greeter-protoc-client-eio/greeter_client_eio.ml b/examples/greeter-protoc-client-eio/greeter_client_eio.ml index ea1d57f..5a78495 100644 --- a/examples/greeter-protoc-client-eio/greeter_client_eio.ml +++ b/examples/greeter-protoc-client-eio/greeter_client_eio.ml @@ -28,11 +28,9 @@ let main env = in let result = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc.client_rpc Greeter_protoc.Greeter.Greeter.Client.sayHello) + Grpc_protoc_eio.Call.unary Greeter_protoc.Greeter.Greeter.Client.sayHello ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) - () + request ~f in Eio.Promise.await (H2_eio.Client.shutdown connection); diff --git a/examples/greeter-protoc-server-eio/dune b/examples/greeter-protoc-server-eio/dune index b4cb2b0..e2c79eb 100644 --- a/examples/greeter-protoc-server-eio/dune +++ b/examples/greeter-protoc-server-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_server_eio) - (libraries grpc grpc-eio grpc-protoc eio_main greeter_protoc h2 h2-eio)) + (libraries grpc grpc-eio grpc-protoc-eio eio_main greeter_protoc h2 h2-eio)) diff --git a/examples/greeter-protoc-server-eio/greeter_server_eio.ml b/examples/greeter-protoc-server-eio/greeter_server_eio.ml index ba2a672..70acaf9 100644 --- a/examples/greeter-protoc-server-eio/greeter_server_eio.ml +++ b/examples/greeter-protoc-server-eio/greeter_server_eio.ml @@ -1,7 +1,5 @@ -open Grpc_eio - let sayHello rpc = - Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) + Grpc_protoc_eio.Implement.unary rpc ~f:(fun (request : Greeter_protoc.Greeter.hello_request) -> let message = if request.name = "" then "You forgot your name!" @@ -52,11 +50,8 @@ let serve server env = let () = let server = - let { Pbrt_services.Server.package; service_name; handlers } = - Greeter_protoc.Greeter.Greeter.Server.make ~sayHello () - in - Server.Typed_rpc.server - (With_service_spec { package; service_name; handlers }) + Greeter_protoc.Greeter.Greeter.Server.make ~sayHello () + |> Grpc_protoc_eio.Implement.server in Eio_main.run (serve server) diff --git a/examples/greeter-server-eio/dune b/examples/greeter-server-eio/dune index 05f400e..f859303 100644 --- a/examples/greeter-server-eio/dune +++ b/examples/greeter-server-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_server_eio) - (libraries grpc grpc-eio grpc-protoc-plugin eio_main greeter h2 h2-eio)) + (libraries grpc grpc-eio grpc-protoc-plugin-eio eio_main greeter h2 h2-eio)) diff --git a/examples/greeter-server-eio/greeter_server_eio.ml b/examples/greeter-server-eio/greeter_server_eio.ml index a4e5df3..8afcde6 100644 --- a/examples/greeter-server-eio/greeter_server_eio.ml +++ b/examples/greeter-server-eio/greeter_server_eio.ml @@ -1,9 +1,7 @@ -open Grpc_eio - let say_hello = let module SayHello = Greeter.Mypackage.Greeter.SayHello in - Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.server_rpc (module SayHello)) + Grpc_protoc_plugin_eio.Implement.unary + (module SayHello) ~f:(fun request -> let message = if request = "" then "You forgot your name!" @@ -53,6 +51,6 @@ let serve server env = listen () let () = - let server = Server.Typed_rpc.server (Handlers [ say_hello ]) in + let server = Grpc_protoc_plugin_eio.Implement.server [ say_hello ] in Eio_main.run (serve server) diff --git a/examples/routeguide-protoc/src/client.ml b/examples/routeguide-protoc/src/client.ml index 0d7681b..11f0a67 100644 --- a/examples/routeguide-protoc/src/client.ml +++ b/examples/routeguide-protoc/src/client.ml @@ -20,15 +20,13 @@ let client ~sw host port network = (* $MDX part-begin=client-get-feature *) let call_get_feature connection point = let response = - Client.Typed_rpc.call - (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.getFeature) - ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Typed_rpc.unary point ~f:(function - | Some feature -> feature - | None -> Route_guide.default_feature ())) - () + Grpc_protoc_eio.Call.unary Route_guide.RouteGuide.Client.getFeature + ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) point + ~f:(function + | Some feature -> feature + | None -> Route_guide.default_feature ()) in + match response with | Ok (res, _ok) -> Format.printf "RESPONSE = {%s}" (Route_guide.show_feature res) @@ -51,12 +49,12 @@ let print_features connection = in let stream = - Client.Typed_rpc.call - (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.listFeatures) + Grpc_protoc_eio.Call.server_streaming + Route_guide.RouteGuide.Client.listFeatures ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) - () + rectangle ~f:Fun.id in + match stream with | Ok (results, _ok) -> Seq.iter @@ -81,23 +79,22 @@ let run_record_route connection = in let response = - Client.Typed_rpc.call - (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.recordRoute) + Grpc_protoc_eio.Call.client_streaming + Route_guide.RouteGuide.Client.recordRoute ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Typed_rpc.client_streaming ~f:(fun f response -> - (* Stream points to server. *) - Seq.iter (fun point -> Seq.write f point) points; - - (* Signal we have finished sending points. *) - Seq.close_writer f; - - (* Decode RouteSummary responses. *) - Eio.Promise.await response |> function - | Some summary -> summary - | None -> failwith (Printf.sprintf "No RouteSummary received."))) - () + ~f:(fun f response -> + (* Stream points to server. *) + Seq.iter (fun point -> Seq.write f point) points; + + (* Signal we have finished sending points. *) + Seq.close_writer f; + + (* Decode RouteSummary responses. *) + Eio.Promise.await response |> function + | Some summary -> summary + | None -> failwith (Printf.sprintf "No RouteSummary received.")) in + match response with | Ok (result, _ok) -> Format.printf "SUMMARY = {%a}" Route_guide.pp_route_summary result @@ -143,14 +140,12 @@ let run_route_chat clock connection = go writer reader' xs) in let result = - Client.Typed_rpc.call - (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.routeChat) + Grpc_protoc_eio.Call.bidirectional_streaming + Route_guide.RouteGuide.Client.routeChat ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> - go writer reader route_notes)) - () + ~f:(fun writer reader -> go writer reader route_notes) in + match result with | Ok ((), _ok) -> () | Error e -> diff --git a/examples/routeguide-protoc/src/dune b/examples/routeguide-protoc/src/dune index b0b91be..18fa44b 100644 --- a/examples/routeguide-protoc/src/dune +++ b/examples/routeguide-protoc/src/dune @@ -4,7 +4,7 @@ (public_names routeguide-protoc-server routeguide-protoc-client) (libraries grpc-eio - grpc-protoc + grpc-protoc-eio eio_main h2-eio routeguide_protoc diff --git a/examples/routeguide-protoc/src/server.ml b/examples/routeguide-protoc/src/server.ml index 4cb1e50..3f3e183 100644 --- a/examples/routeguide-protoc/src/server.ml +++ b/examples/routeguide-protoc/src/server.ml @@ -77,7 +77,7 @@ let calc_distance (p1 : Route_guide.point) (p2 : Route_guide.point) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) rpc = - Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) ~f:(fun point -> + Grpc_protoc_eio.Implement.unary rpc ~f:(fun point -> Eio.traceln "GetFeature = {:%a}" Route_guide.pp_point point; (* Lookup the feature and if found return it. *) @@ -103,8 +103,7 @@ let get_feature (t : t) rpc = (* $MDX part-end *) (* $MDX part-begin=server-list-features *) let list_features (t : t) rpc = - Grpc_eio.Server.Typed_rpc.server_streaming (Grpc_protoc.server_rpc rpc) - ~f:(fun rectangle f -> + Grpc_protoc_eio.Implement.server_streaming rpc ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = List.iter @@ -118,7 +117,7 @@ let list_features (t : t) rpc = (* $MDX part-end *) (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) rpc = - Grpc_eio.Server.Typed_rpc.client_streaming (Grpc_protoc.server_rpc rpc) + Grpc_protoc_eio.Implement.client_streaming rpc ~f:(fun (stream : Route_guide.point Seq.t) -> Eio.traceln "RecordRoute"; @@ -168,7 +167,7 @@ let record_route (t : t) (clock : _ Eio.Time.clock) rpc = (* $MDX part-end *) (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) rpc = - Grpc_eio.Server.Typed_rpc.bidirectional_streaming (Grpc_protoc.server_rpc rpc) + Grpc_protoc_eio.Implement.bidirectional_streaming rpc ~f:(fun (stream : Route_guide.route_note Seq.t) (f : Route_guide.route_note -> unit) @@ -187,13 +186,10 @@ let route_chat (_ : t) rpc = (* $MDX part-end *) (* $MDX part-begin=server-grpc *) let server t clock = - let { Pbrt_services.Server.package; service_name; handlers } = - Route_guide.RouteGuide.Server.make ~getFeature:(get_feature t) - ~listFeatures:(list_features t) ~recordRoute:(record_route t clock) - ~routeChat:(route_chat t) () - in - Server.Typed_rpc.server - (With_service_spec { package; service_name; handlers }) + Route_guide.RouteGuide.Server.make ~getFeature:(get_feature t) + ~listFeatures:(list_features t) ~recordRoute:(record_route t clock) + ~routeChat:(route_chat t) () + |> Grpc_protoc_eio.Implement.server (* $MDX part-end *) let connection_handler server ~sw = diff --git a/examples/routeguide-tutorial.md b/examples/routeguide-tutorial.md index 10261f7..e112c3d 100644 --- a/examples/routeguide-tutorial.md +++ b/examples/routeguide-tutorial.md @@ -193,9 +193,8 @@ The individual service functions from our proto definition are implemented using ```ocaml let server t clock = - Server.Typed_rpc.server - (Handlers - [ get_feature t; list_features t; record_route t clock; route_chat t ]) + Grpc_protoc_plugin_eio.Implement.server + [ get_feature t; list_features t; record_route t clock; route_chat t ] ``` ### Simple RPC @@ -205,8 +204,8 @@ Let's look at the simplest type first, `GetFeature` which just gets a `Point` fr ```ocaml let get_feature (t : t) = - Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.server_rpc (module RouteGuide.GetFeature)) + Grpc_protoc_plugin_eio.Implement.unary + (module RouteGuide.GetFeature) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -237,8 +236,8 @@ Now let's look at one of our streaming RPCs. `list_features` is a server-side st ```ocaml let list_features (t : t) = - Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.ListFeatures)) + Grpc_protoc_plugin_eio.Implement.server_streaming + (module RouteGuide.ListFeatures) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -260,8 +259,8 @@ Now let's look at something a little more complicated: the client-side streaming ```ocaml let record_route (t : t) (clock : _ Eio.Time.clock) = - Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.RecordRoute)) + Grpc_protoc_plugin_eio.Implement.client_streaming + (module RouteGuide.RecordRoute) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -311,8 +310,8 @@ Finally, let's look at our bidirectional streaming RPC `route_chat`, which recei ```ocaml let route_chat (_ : t) = - Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.RouteChat)) + Grpc_protoc_plugin_eio.Implement.bidirectional_streaming + (module RouteGuide.RouteChat) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -400,15 +399,13 @@ Calling the simple RPC `get_feature` requires building up a `Client.call` repres ```ocaml let call_get_feature connection point = let response = - Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.GetFeature)) + Grpc_protoc_plugin_eio.Call.unary + (module RouteGuide.GetFeature) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Typed_rpc.unary point ~f:(function - | Some feature -> feature - | None -> Feature.make ())) - () + point + ~f:(function Some feature -> feature | None -> Feature.make ()) in + match response with | Ok (res, _ok) -> Printf.printf "RESPONSE = {%s}" (Feature.show res) | Error _ -> Printf.printf "an error occurred" @@ -428,12 +425,12 @@ let print_features connection = in let stream = - Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.ListFeatures)) + Grpc_protoc_plugin_eio.Call.server_streaming + (module RouteGuide.ListFeatures) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) - () + rectangle ~f:Fun.id in + match stream with | Ok (results, _ok) -> Seq.iter @@ -465,22 +462,20 @@ let run_record_route connection = in let response = - Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.RecordRoute)) + Grpc_protoc_plugin_eio.Call.client_streaming + (module RouteGuide.RecordRoute) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Typed_rpc.client_streaming ~f:(fun f response -> - (* Stream points to server. *) - Seq.iter (fun point -> Seq.write f point) points; - - (* Signal we have finished sending points. *) - Seq.close_writer f; - - (* Decode RouteSummary responses. *) - Eio.Promise.await response |> function - | Some summary -> summary - | None -> failwith (Printf.sprintf "No RouteSummary received."))) - () + ~f:(fun f response -> + (* Stream points to server. *) + Seq.iter (fun point -> Grpc_eio.Seq.write f point) points; + + (* Signal we have finished sending points. *) + Grpc_eio.Seq.close_writer f; + + (* Decode RouteSummary responses. *) + Eio.Promise.await response |> function + | Some summary -> summary + | None -> failwith (Printf.sprintf "No RouteSummary received.")) in match response with | Ok (result, _ok) -> @@ -519,9 +514,10 @@ We start by generating a short sequence of locations, similar to how we did for let rec go writer reader notes = match Seq.uncons notes with | None -> - Seq.close_writer writer (* Signal no more notes from the client. *) + Grpc_eio.Seq.close_writer + writer (* Signal no more notes from the client. *) | Some (route_note, xs) -> ( - Seq.write writer route_note; + Grpc_eio.Seq.write writer route_note; (* Yield and sleep, waiting for server reply. *) Eio.Time.sleep clock 1.0; @@ -534,14 +530,12 @@ We start by generating a short sequence of locations, similar to how we did for go writer reader' xs) in let result = - Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.RouteChat)) + Grpc_protoc_plugin_eio.Call.bidirectional_streaming + (module RouteGuide.RouteChat) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> - go writer reader route_notes)) - () + ~f:(fun writer reader -> go writer reader route_notes) in + match result with | Ok ((), _ok) -> () | Error e -> diff --git a/examples/routeguide/src/client.ml b/examples/routeguide/src/client.ml index c55a304..09f434b 100644 --- a/examples/routeguide/src/client.ml +++ b/examples/routeguide/src/client.ml @@ -1,4 +1,3 @@ -open Grpc_eio open Routeguide.Route_guide.Routeguide (* $MDX part-begin=client-h2 *) @@ -20,15 +19,13 @@ let client ~sw host port network = (* $MDX part-begin=client-get-feature *) let call_get_feature connection point = let response = - Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.GetFeature)) + Grpc_protoc_plugin_eio.Call.unary + (module RouteGuide.GetFeature) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Typed_rpc.unary point ~f:(function - | Some feature -> feature - | None -> Feature.make ())) - () + point + ~f:(function Some feature -> feature | None -> Feature.make ()) in + match response with | Ok (res, _ok) -> Printf.printf "RESPONSE = {%s}" (Feature.show res) | Error _ -> Printf.printf "an error occurred" @@ -44,12 +41,12 @@ let print_features connection = in let stream = - Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.ListFeatures)) + Grpc_protoc_plugin_eio.Call.server_streaming + (module RouteGuide.ListFeatures) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) - () + rectangle ~f:Fun.id in + match stream with | Ok (results, _ok) -> Seq.iter @@ -74,22 +71,20 @@ let run_record_route connection = in let response = - Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.RecordRoute)) + Grpc_protoc_plugin_eio.Call.client_streaming + (module RouteGuide.RecordRoute) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Typed_rpc.client_streaming ~f:(fun f response -> - (* Stream points to server. *) - Seq.iter (fun point -> Seq.write f point) points; - - (* Signal we have finished sending points. *) - Seq.close_writer f; - - (* Decode RouteSummary responses. *) - Eio.Promise.await response |> function - | Some summary -> summary - | None -> failwith (Printf.sprintf "No RouteSummary received."))) - () + ~f:(fun f response -> + (* Stream points to server. *) + Seq.iter (fun point -> Grpc_eio.Seq.write f point) points; + + (* Signal we have finished sending points. *) + Grpc_eio.Seq.close_writer f; + + (* Decode RouteSummary responses. *) + Eio.Promise.await response |> function + | Some summary -> summary + | None -> failwith (Printf.sprintf "No RouteSummary received.")) in match response with | Ok (result, _ok) -> @@ -119,9 +114,10 @@ let run_route_chat clock connection = let rec go writer reader notes = match Seq.uncons notes with | None -> - Seq.close_writer writer (* Signal no more notes from the client. *) + Grpc_eio.Seq.close_writer + writer (* Signal no more notes from the client. *) | Some (route_note, xs) -> ( - Seq.write writer route_note; + Grpc_eio.Seq.write writer route_note; (* Yield and sleep, waiting for server reply. *) Eio.Time.sleep clock 1.0; @@ -134,14 +130,12 @@ let run_route_chat clock connection = go writer reader' xs) in let result = - Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.RouteChat)) + Grpc_protoc_plugin_eio.Call.bidirectional_streaming + (module RouteGuide.RouteChat) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~handler: - (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> - go writer reader route_notes)) - () + ~f:(fun writer reader -> go writer reader route_notes) in + match result with | Ok ((), _ok) -> () | Error e -> diff --git a/examples/routeguide/src/dune b/examples/routeguide/src/dune index 5da330a..733c7a6 100644 --- a/examples/routeguide/src/dune +++ b/examples/routeguide/src/dune @@ -4,7 +4,7 @@ (public_names routeguide-server routeguide-client) (libraries grpc-eio - grpc-protoc-plugin + grpc-protoc-plugin-eio eio_main h2-eio routeguide diff --git a/examples/routeguide/src/server.ml b/examples/routeguide/src/server.ml index 91f88a6..78fae93 100644 --- a/examples/routeguide/src/server.ml +++ b/examples/routeguide/src/server.ml @@ -74,8 +74,8 @@ let calc_distance (p1 : Point.t) (p2 : Point.t) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) = - Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.server_rpc (module RouteGuide.GetFeature)) + Grpc_protoc_plugin_eio.Implement.unary + (module RouteGuide.GetFeature) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -99,8 +99,8 @@ let get_feature (t : t) = (* $MDX part-end *) (* $MDX part-begin=server-list-features *) let list_features (t : t) = - Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.ListFeatures)) + Grpc_protoc_plugin_eio.Implement.server_streaming + (module RouteGuide.ListFeatures) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -115,8 +115,8 @@ let list_features (t : t) = (* $MDX part-end *) (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) = - Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.RecordRoute)) + Grpc_protoc_plugin_eio.Implement.client_streaming + (module RouteGuide.RecordRoute) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -161,8 +161,8 @@ let record_route (t : t) (clock : _ Eio.Time.clock) = (* $MDX part-end *) (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) = - Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.RouteChat)) + Grpc_protoc_plugin_eio.Implement.bidirectional_streaming + (module RouteGuide.RouteChat) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -178,9 +178,8 @@ let route_chat (_ : t) = (* $MDX part-end *) (* $MDX part-begin=server-grpc *) let server t clock = - Server.Typed_rpc.server - (Handlers - [ get_feature t; list_features t; record_route t clock; route_chat t ]) + Grpc_protoc_plugin_eio.Implement.server + [ get_feature t; list_features t; record_route t clock; route_chat t ] (* $MDX part-end *) let connection_handler server ~sw = diff --git a/grpc-protoc-eio.opam b/grpc-protoc-eio.opam new file mode 100644 index 0000000..f06b976 --- /dev/null +++ b/grpc-protoc-eio.opam @@ -0,0 +1,44 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "An Eio implementation of gRPC using ocaml-protoc" +description: + "Functionality for building gRPC services and rpcs with `ocaml-protoc` and `eio`" +maintainer: ["Daniel Quernheim "] +authors: [ + "Andrew Jeffery " + "Daniel Quernheim " + "Michael Bacarella " + "Sven Anderson " + "Tim McGilchrist " + "Wojtek Czekalski " + "dimitris.mostrous " +] +license: "BSD-3-Clause" +homepage: "https://github.com/dialohq/ocaml-grpc" +doc: "https://dialohq.github.io/ocaml-grpc" +bug-reports: "https://github.com/dialohq/ocaml-grpc/issues" +depends: [ + "dune" {>= "3.7"} + "grpc" {= version} + "grpc-eio" {= version} + "grpc-protoc" {= version} + "ocaml-protoc" {>= "3.0"} + "pbrt" {>= "3.0"} + "pbrt_services" {>= "3.0"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/dialohq/ocaml-grpc.git" diff --git a/grpc-protoc-plugin-eio.opam b/grpc-protoc-plugin-eio.opam new file mode 100644 index 0000000..656cc9a --- /dev/null +++ b/grpc-protoc-plugin-eio.opam @@ -0,0 +1,42 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "An Eio implementation of gRPC using ocaml-protoc-plugin" +description: + "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin` and `eio`" +maintainer: ["Daniel Quernheim "] +authors: [ + "Andrew Jeffery " + "Daniel Quernheim " + "Michael Bacarella " + "Sven Anderson " + "Tim McGilchrist " + "Wojtek Czekalski " + "dimitris.mostrous " +] +license: "BSD-3-Clause" +homepage: "https://github.com/dialohq/ocaml-grpc" +doc: "https://dialohq.github.io/ocaml-grpc" +bug-reports: "https://github.com/dialohq/ocaml-grpc/issues" +depends: [ + "dune" {>= "3.7"} + "grpc" {= version} + "grpc-eio" {= version} + "grpc-protoc-plugin" {= version} + "ocaml-protoc-plugin" {>= "4.5"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/dialohq/ocaml-grpc.git" diff --git a/grpc-protoc-plugin.opam b/grpc-protoc-plugin.opam index 1ddae22..e0b048b 100644 --- a/grpc-protoc-plugin.opam +++ b/grpc-protoc-plugin.opam @@ -1,8 +1,8 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -synopsis: "An implementation of gRPC using ocaml-protoc-plugin" +synopsis: "Internal gRPC utils for ocaml-protoc-plugin" description: - "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin`" + "Internal utils for building gRPC services and rpcs with `ocaml-protoc-plugin`" maintainer: ["Daniel Quernheim "] authors: [ "Andrew Jeffery " diff --git a/grpc-protoc.opam b/grpc-protoc.opam index fde3dfd..4080c65 100644 --- a/grpc-protoc.opam +++ b/grpc-protoc.opam @@ -1,8 +1,8 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -synopsis: "An implementation of gRPC using ocaml-protoc" +synopsis: "Internal gRPC utils for ocaml-protoc" description: - "Functionality for building gRPC services and rpcs with `ocaml-protoc`" + "Internal utils for building gRPC services and rpcs with `ocaml-protoc`" maintainer: ["Daniel Quernheim "] authors: [ "Andrew Jeffery " diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index b8da679..5b965d6 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -154,30 +154,25 @@ module Typed_rpc = struct type 'service_spec rpc = 'service_spec t type t = - | Handlers : Grpc.Rpc.Service_spec.t rpc list -> t - | With_service_spec : { - package : string list; - service_name : string; + | Handlers of { handlers : Grpc.Rpc.Service_spec.t rpc list } + | Handlers_and_service_spec of { + service_spec : Grpc.Rpc.Service_spec.t; handlers : unit rpc list; } - -> t end let server handlers : server = let ts = match (handlers : Handlers.t) with - | Handlers ts -> ts - | With_service_spec { package; service_name; handlers = ts } -> + | Handlers { handlers = ts } -> ts + | Handlers_and_service_spec { service_spec; handlers = ts } -> List.map (fun (T t) -> T { t with rpc_spec = - { - t.rpc_spec with - service_spec = Some { package; service_name }; - }; + { t.rpc_spec with service_spec = Some service_spec }; }) ts in diff --git a/lib/grpc-eio/server.mli b/lib/grpc-eio/server.mli index 4aa8bbe..1d30622 100644 --- a/lib/grpc-eio/server.mli +++ b/lib/grpc-eio/server.mli @@ -111,13 +111,11 @@ module Typed_rpc : sig type 'service_spec rpc := 'service_spec t type t = - | Handlers : Grpc.Rpc.Service_spec.t rpc list -> t - | With_service_spec : { - package : string list; - service_name : string; + | Handlers of { handlers : Grpc.Rpc.Service_spec.t rpc list } + | Handlers_and_service_spec of { + service_spec : Grpc.Rpc.Service_spec.t; handlers : unit rpc list; } - -> t end val server : Handlers.t -> server diff --git a/lib/grpc-protoc-eio/dune b/lib/grpc-protoc-eio/dune new file mode 100644 index 0000000..7bf592a --- /dev/null +++ b/lib/grpc-protoc-eio/dune @@ -0,0 +1,4 @@ +(library + (name grpc_protoc_eio) + (public_name grpc-protoc-eio) + (libraries grpc grpc_eio grpc_protoc h2-eio ocaml-protoc pbrt pbrt_services)) diff --git a/lib/grpc-protoc-eio/grpc_protoc_eio.ml b/lib/grpc-protoc-eio/grpc_protoc_eio.ml new file mode 100644 index 0000000..49b5918 --- /dev/null +++ b/lib/grpc-protoc-eio/grpc_protoc_eio.ml @@ -0,0 +1,66 @@ +open Pbrt_services.Value_mode + +module Call = struct + let unary (type request response) ?scheme ?headers + (rpc : (request, unary, response, unary) Pbrt_services.Client.rpc) + ~do_request request ~f = + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc.client_rpc rpc) + ?scheme ~do_request ?headers + ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) + () + + let client_streaming (type request response) ?scheme ?headers + (rpc : (request, stream, response, unary) Pbrt_services.Client.rpc) + ~do_request ~f = + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc.client_rpc rpc) + ?scheme ~do_request ?headers + ~handler:(Grpc_eio.Client.Typed_rpc.client_streaming ~f) + () + + let server_streaming (type request response) ?scheme ?headers + (rpc : (request, unary, response, stream) Pbrt_services.Client.rpc) + ~do_request request ~f = + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc.client_rpc rpc) + ?scheme ~do_request ?headers + ~handler:(Grpc_eio.Client.Typed_rpc.server_streaming request ~f) + () + + let bidirectional_streaming (type request response) ?scheme ?headers + (rpc : (request, stream, response, stream) Pbrt_services.Client.rpc) + ~do_request ~f = + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc.client_rpc rpc) + ?scheme ~do_request ?headers + ~handler:(Grpc_eio.Client.Typed_rpc.bidirectional_streaming ~f) + () +end + +module Implement = struct + type rpc = unit Grpc_eio.Server.Typed_rpc.t + + let unary (type request response) + (rpc : (request, unary, response, unary) Pbrt_services.Server.rpc) ~f = + Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) ~f + + let client_streaming (type request response) + (rpc : (request, stream, response, unary) Pbrt_services.Server.rpc) ~f = + Grpc_eio.Server.Typed_rpc.client_streaming (Grpc_protoc.server_rpc rpc) ~f + + let server_streaming (type request response) + (rpc : (request, unary, response, stream) Pbrt_services.Server.rpc) ~f = + Grpc_eio.Server.Typed_rpc.server_streaming (Grpc_protoc.server_rpc rpc) ~f + + let bidirectional_streaming (type request response) + (rpc : (request, stream, response, stream) Pbrt_services.Server.rpc) ~f = + Grpc_eio.Server.Typed_rpc.bidirectional_streaming + (Grpc_protoc.server_rpc rpc) + ~f + + let server { Pbrt_services.Server.package; service_name; handlers } = + Grpc_eio.Server.Typed_rpc.server + (Handlers_and_service_spec + { service_spec = { package; service_name }; handlers }) +end diff --git a/lib/grpc-protoc-eio/grpc_protoc_eio.mli b/lib/grpc-protoc-eio/grpc_protoc_eio.mli new file mode 100644 index 0000000..e45294c --- /dev/null +++ b/lib/grpc-protoc-eio/grpc_protoc_eio.mli @@ -0,0 +1,63 @@ +open Pbrt_services.Value_mode + +module Call : sig + val unary : + ?scheme:string -> + ?headers:H2.Headers.t -> + ('request, unary, 'response, unary) Pbrt_services.Client.rpc -> + do_request:Grpc_eio.Client.do_request -> + 'request -> + f:('response option -> 'a) -> + ('a * Grpc.Status.t, H2.Status.t) result + + val client_streaming : + ?scheme:string -> + ?headers:H2.Headers.t -> + ('request, stream, 'response, unary) Pbrt_services.Client.rpc -> + do_request:Grpc_eio.Client.do_request -> + f:('request Grpc_eio.Seq.writer -> 'response option Eio.Promise.t -> 'a) -> + ('a * Grpc.Status.t, H2.Status.t) result + + val server_streaming : + ?scheme:string -> + ?headers:H2.Headers.t -> + ('request, unary, 'response, stream) Pbrt_services.Client.rpc -> + do_request:Grpc_eio.Client.do_request -> + 'request -> + f:('response Grpc_eio.Seq.t -> 'a) -> + ('a * Grpc.Status.t, H2.Status.t) result + + val bidirectional_streaming : + ?scheme:string -> + ?headers:H2.Headers.t -> + ('request, stream, 'response, stream) Pbrt_services.Client.rpc -> + do_request:Grpc_eio.Client.do_request -> + f:('request Grpc_eio.Seq.writer -> 'response Grpc_eio.Seq.t -> 'a) -> + ('a * Grpc.Status.t, H2.Status.t) result +end + +module Implement : sig + type rpc = unit Grpc_eio.Server.Typed_rpc.t + + val unary : + ('request, unary, 'response, unary) Pbrt_services.Server.rpc -> + f:('request -> Grpc.Status.t * 'response option) -> + rpc + + val client_streaming : + ('request, stream, 'response, unary) Pbrt_services.Server.rpc -> + f:('request Seq.t -> Grpc.Status.t * 'response option) -> + rpc + + val server_streaming : + ('request, unary, 'response, stream) Pbrt_services.Server.rpc -> + f:('request -> ('response -> unit) -> Grpc.Status.t) -> + rpc + + val bidirectional_streaming : + ('request, stream, 'response, stream) Pbrt_services.Server.rpc -> + f:('request Seq.t -> ('response -> unit) -> Grpc.Status.t) -> + rpc + + val server : rpc Pbrt_services.Server.t -> Grpc_eio.Server.t +end diff --git a/lib/grpc-protoc-plugin-eio/dune b/lib/grpc-protoc-plugin-eio/dune new file mode 100644 index 0000000..616251e --- /dev/null +++ b/lib/grpc-protoc-plugin-eio/dune @@ -0,0 +1,4 @@ +(library + (name grpc_protoc_plugin_eio) + (public_name grpc-protoc-plugin-eio) + (libraries grpc grpc_eio grpc_protoc_plugin h2-eio ocaml-protoc-plugin)) diff --git a/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.ml b/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.ml new file mode 100644 index 0000000..9d7eb29 --- /dev/null +++ b/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.ml @@ -0,0 +1,73 @@ +module type S = Ocaml_protoc_plugin.Service.Rpc + +module Call = struct + let unary (type request response) ?scheme ?headers + (module R : S with type Request.t = request and type Response.t = response) + ~do_request request ~f = + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module R)) + ?scheme ~do_request ?headers + ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) + () + + let client_streaming (type request response) ?scheme ?headers + (module R : S with type Request.t = request and type Response.t = response) + ~do_request ~f = + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module R)) + ?scheme ~do_request ?headers + ~handler:(Grpc_eio.Client.Typed_rpc.client_streaming ~f) + () + + let server_streaming (type request response) ?scheme ?headers + (module R : S with type Request.t = request and type Response.t = response) + ~do_request request ~f = + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module R)) + ?scheme ~do_request ?headers + ~handler:(Grpc_eio.Client.Typed_rpc.server_streaming request ~f) + () + + let bidirectional_streaming (type request response) ?scheme ?headers + (module R : S with type Request.t = request and type Response.t = response) + ~do_request ~f = + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module R)) + ?scheme ~do_request ?headers + ~handler:(Grpc_eio.Client.Typed_rpc.bidirectional_streaming ~f) + () +end + +module Implement = struct + type rpc = Grpc.Rpc.Service_spec.t Grpc_eio.Server.Typed_rpc.t + + let unary (type request response) + (module R : S with type Request.t = request and type Response.t = response) + ~f = + Grpc_eio.Server.Typed_rpc.unary + (Grpc_protoc_plugin.server_rpc (module R)) + ~f + + let client_streaming (type request response) + (module R : S with type Request.t = request and type Response.t = response) + ~f = + Grpc_eio.Server.Typed_rpc.client_streaming + (Grpc_protoc_plugin.server_rpc (module R)) + ~f + + let server_streaming (type request response) + (module R : S with type Request.t = request and type Response.t = response) + ~f = + Grpc_eio.Server.Typed_rpc.server_streaming + (Grpc_protoc_plugin.server_rpc (module R)) + ~f + + let bidirectional_streaming (type request response) + (module R : S with type Request.t = request and type Response.t = response) + ~f = + Grpc_eio.Server.Typed_rpc.bidirectional_streaming + (Grpc_protoc_plugin.server_rpc (module R)) + ~f + + let server handlers = Grpc_eio.Server.Typed_rpc.server (Handlers { handlers }) +end diff --git a/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.mli b/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.mli new file mode 100644 index 0000000..a2572d9 --- /dev/null +++ b/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.mli @@ -0,0 +1,63 @@ +module type S = Ocaml_protoc_plugin.Service.Rpc + +module Call : sig + val unary : + ?scheme:string -> + ?headers:H2.Headers.t -> + (module S with type Request.t = 'request and type Response.t = 'response) -> + do_request:Grpc_eio.Client.do_request -> + 'request -> + f:('response option -> 'a) -> + ('a * Grpc.Status.t, H2.Status.t) result + + val client_streaming : + ?scheme:string -> + ?headers:H2.Headers.t -> + (module S with type Request.t = 'request and type Response.t = 'response) -> + do_request:Grpc_eio.Client.do_request -> + f:('request Grpc_eio.Seq.writer -> 'response option Eio.Promise.t -> 'a) -> + ('a * Grpc.Status.t, H2.Status.t) result + + val server_streaming : + ?scheme:string -> + ?headers:H2.Headers.t -> + (module S with type Request.t = 'request and type Response.t = 'response) -> + do_request:Grpc_eio.Client.do_request -> + 'request -> + f:('response Grpc_eio.Seq.t -> 'a) -> + ('a * Grpc.Status.t, H2.Status.t) result + + val bidirectional_streaming : + ?scheme:string -> + ?headers:H2.Headers.t -> + (module S with type Request.t = 'request and type Response.t = 'response) -> + do_request:Grpc_eio.Client.do_request -> + f:('request Grpc_eio.Seq.writer -> 'response Grpc_eio.Seq.t -> 'a) -> + ('a * Grpc.Status.t, H2.Status.t) result +end + +module Implement : sig + type rpc = Grpc.Rpc.Service_spec.t Grpc_eio.Server.Typed_rpc.t + + val unary : + (module S with type Request.t = 'request and type Response.t = 'response) -> + f:('request -> Grpc.Status.t * 'response option) -> + rpc + + val client_streaming : + (module S with type Request.t = 'request and type Response.t = 'response) -> + f:('request Seq.t -> Grpc.Status.t * 'response option) -> + rpc + + val server_streaming : + (module S with type Request.t = 'request and type Response.t = 'response) -> + f:('request -> ('response -> unit) -> Grpc.Status.t) -> + rpc + + val bidirectional_streaming : + (module S with type Request.t = 'request and type Response.t = 'response) -> + f:('request Seq.t -> ('response -> unit) -> Grpc.Status.t) -> + rpc + + val server : rpc list -> Grpc_eio.Server.t +end From 8677baa00aa2d1a79715bc5d93cf134a87882e88 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Fri, 15 Dec 2023 20:38:04 +0100 Subject: [PATCH 08/12] Revert "add dedicated user facing libraries" This reverts commit 042efeba3a81d1558654638df4b36261dc455012. --- dune-project | 42 +--------- examples/greeter-client-eio/dune | 2 +- .../greeter-client-eio/greeter_client_eio.ml | 7 +- examples/greeter-protoc-client-eio/dune | 2 +- .../greeter_client_eio.ml | 6 +- examples/greeter-protoc-server-eio/dune | 2 +- .../greeter_server_eio.ml | 11 ++- examples/greeter-server-eio/dune | 2 +- .../greeter-server-eio/greeter_server_eio.ml | 8 +- examples/routeguide-protoc/src/client.ml | 61 +++++++------- examples/routeguide-protoc/src/dune | 2 +- examples/routeguide-protoc/src/server.ml | 20 +++-- examples/routeguide-tutorial.md | 84 ++++++++++--------- examples/routeguide/src/client.ml | 64 +++++++------- examples/routeguide/src/dune | 2 +- examples/routeguide/src/server.ml | 21 ++--- grpc-protoc-eio.opam | 44 ---------- grpc-protoc-plugin-eio.opam | 42 ---------- grpc-protoc-plugin.opam | 4 +- grpc-protoc.opam | 4 +- lib/grpc-eio/server.ml | 17 ++-- lib/grpc-eio/server.mli | 8 +- lib/grpc-protoc-eio/dune | 4 - lib/grpc-protoc-eio/grpc_protoc_eio.ml | 66 --------------- lib/grpc-protoc-eio/grpc_protoc_eio.mli | 63 -------------- lib/grpc-protoc-plugin-eio/dune | 4 - .../grpc_protoc_plugin_eio.ml | 73 ---------------- .../grpc_protoc_plugin_eio.mli | 63 -------------- 28 files changed, 187 insertions(+), 541 deletions(-) delete mode 100644 grpc-protoc-eio.opam delete mode 100644 grpc-protoc-plugin-eio.opam delete mode 100644 lib/grpc-protoc-eio/dune delete mode 100644 lib/grpc-protoc-eio/grpc_protoc_eio.ml delete mode 100644 lib/grpc-protoc-eio/grpc_protoc_eio.mli delete mode 100644 lib/grpc-protoc-plugin-eio/dune delete mode 100644 lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.ml delete mode 100644 lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.mli diff --git a/dune-project b/dune-project index b835871..cf3a55e 100644 --- a/dune-project +++ b/dune-project @@ -84,57 +84,23 @@ (package (name grpc-protoc-plugin) - (synopsis "Internal gRPC utils for ocaml-protoc-plugin") + (synopsis "An implementation of gRPC using ocaml-protoc-plugin") (description - "Internal utils for building gRPC services and rpcs with `ocaml-protoc-plugin`") + "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin`") (depends (grpc (= :version)) (ocaml-protoc-plugin (>= 4.5)))) -(package - (name grpc-protoc-plugin-eio) - (synopsis "An Eio implementation of gRPC using ocaml-protoc-plugin") - (description - "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin` and `eio`") - (depends - (grpc - (= :version)) - (grpc-eio - (= :version)) - (grpc-protoc-plugin - (= :version)) - (ocaml-protoc-plugin - (>= 4.5)))) - (package (name grpc-protoc) - (synopsis "Internal gRPC utils for ocaml-protoc") - (description - "Internal utils for building gRPC services and rpcs with `ocaml-protoc`") - (depends - (grpc - (= :version)) - (ocaml-protoc - (>= 3.0)) - (pbrt - (>= 3.0)) - (pbrt_services - (>= 3.0)))) - -(package - (name grpc-protoc-eio) - (synopsis "An Eio implementation of gRPC using ocaml-protoc") + (synopsis "An implementation of gRPC using ocaml-protoc") (description - "Functionality for building gRPC services and rpcs with `ocaml-protoc` and `eio`") + "Functionality for building gRPC services and rpcs with `ocaml-protoc`") (depends (grpc (= :version)) - (grpc-eio - (= :version)) - (grpc-protoc - (= :version)) (ocaml-protoc (>= 3.0)) (pbrt diff --git a/examples/greeter-client-eio/dune b/examples/greeter-client-eio/dune index 3617055..40151b3 100644 --- a/examples/greeter-client-eio/dune +++ b/examples/greeter-client-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_client_eio) - (libraries grpc grpc-protoc-plugin-eio eio_main greeter h2 h2-eio)) + (libraries grpc grpc-eio grpc-protoc-plugin eio_main greeter h2 h2-eio)) diff --git a/examples/greeter-client-eio/greeter_client_eio.ml b/examples/greeter-client-eio/greeter_client_eio.ml index 02230e7..23be377 100644 --- a/examples/greeter-client-eio/greeter_client_eio.ml +++ b/examples/greeter-client-eio/greeter_client_eio.ml @@ -29,10 +29,11 @@ let main env = in let result = - Grpc_protoc_plugin_eio.Call.unary - (module Greeter.SayHello) + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module Greeter.SayHello)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - request ~f + ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) + () in Eio.Promise.await (H2_eio.Client.shutdown connection); diff --git a/examples/greeter-protoc-client-eio/dune b/examples/greeter-protoc-client-eio/dune index 1154ed1..9ba8a85 100644 --- a/examples/greeter-protoc-client-eio/dune +++ b/examples/greeter-protoc-client-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_client_eio) - (libraries grpc grpc-eio grpc-protoc-eio eio_main greeter_protoc h2 h2-eio)) + (libraries grpc grpc-eio grpc-protoc eio_main greeter_protoc h2 h2-eio)) diff --git a/examples/greeter-protoc-client-eio/greeter_client_eio.ml b/examples/greeter-protoc-client-eio/greeter_client_eio.ml index 5a78495..ea1d57f 100644 --- a/examples/greeter-protoc-client-eio/greeter_client_eio.ml +++ b/examples/greeter-protoc-client-eio/greeter_client_eio.ml @@ -28,9 +28,11 @@ let main env = in let result = - Grpc_protoc_eio.Call.unary Greeter_protoc.Greeter.Greeter.Client.sayHello + Grpc_eio.Client.Typed_rpc.call + (Grpc_protoc.client_rpc Greeter_protoc.Greeter.Greeter.Client.sayHello) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - request ~f + ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) + () in Eio.Promise.await (H2_eio.Client.shutdown connection); diff --git a/examples/greeter-protoc-server-eio/dune b/examples/greeter-protoc-server-eio/dune index e2c79eb..b4cb2b0 100644 --- a/examples/greeter-protoc-server-eio/dune +++ b/examples/greeter-protoc-server-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_server_eio) - (libraries grpc grpc-eio grpc-protoc-eio eio_main greeter_protoc h2 h2-eio)) + (libraries grpc grpc-eio grpc-protoc eio_main greeter_protoc h2 h2-eio)) diff --git a/examples/greeter-protoc-server-eio/greeter_server_eio.ml b/examples/greeter-protoc-server-eio/greeter_server_eio.ml index 70acaf9..ba2a672 100644 --- a/examples/greeter-protoc-server-eio/greeter_server_eio.ml +++ b/examples/greeter-protoc-server-eio/greeter_server_eio.ml @@ -1,5 +1,7 @@ +open Grpc_eio + let sayHello rpc = - Grpc_protoc_eio.Implement.unary rpc + Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) ~f:(fun (request : Greeter_protoc.Greeter.hello_request) -> let message = if request.name = "" then "You forgot your name!" @@ -50,8 +52,11 @@ let serve server env = let () = let server = - Greeter_protoc.Greeter.Greeter.Server.make ~sayHello () - |> Grpc_protoc_eio.Implement.server + let { Pbrt_services.Server.package; service_name; handlers } = + Greeter_protoc.Greeter.Greeter.Server.make ~sayHello () + in + Server.Typed_rpc.server + (With_service_spec { package; service_name; handlers }) in Eio_main.run (serve server) diff --git a/examples/greeter-server-eio/dune b/examples/greeter-server-eio/dune index f859303..05f400e 100644 --- a/examples/greeter-server-eio/dune +++ b/examples/greeter-server-eio/dune @@ -1,3 +1,3 @@ (executable (name greeter_server_eio) - (libraries grpc grpc-eio grpc-protoc-plugin-eio eio_main greeter h2 h2-eio)) + (libraries grpc grpc-eio grpc-protoc-plugin eio_main greeter h2 h2-eio)) diff --git a/examples/greeter-server-eio/greeter_server_eio.ml b/examples/greeter-server-eio/greeter_server_eio.ml index 8afcde6..a4e5df3 100644 --- a/examples/greeter-server-eio/greeter_server_eio.ml +++ b/examples/greeter-server-eio/greeter_server_eio.ml @@ -1,7 +1,9 @@ +open Grpc_eio + let say_hello = let module SayHello = Greeter.Mypackage.Greeter.SayHello in - Grpc_protoc_plugin_eio.Implement.unary - (module SayHello) + Grpc_eio.Server.Typed_rpc.unary + (Grpc_protoc_plugin.server_rpc (module SayHello)) ~f:(fun request -> let message = if request = "" then "You forgot your name!" @@ -51,6 +53,6 @@ let serve server env = listen () let () = - let server = Grpc_protoc_plugin_eio.Implement.server [ say_hello ] in + let server = Server.Typed_rpc.server (Handlers [ say_hello ]) in Eio_main.run (serve server) diff --git a/examples/routeguide-protoc/src/client.ml b/examples/routeguide-protoc/src/client.ml index 11f0a67..0d7681b 100644 --- a/examples/routeguide-protoc/src/client.ml +++ b/examples/routeguide-protoc/src/client.ml @@ -20,13 +20,15 @@ let client ~sw host port network = (* $MDX part-begin=client-get-feature *) let call_get_feature connection point = let response = - Grpc_protoc_eio.Call.unary Route_guide.RouteGuide.Client.getFeature - ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) point - ~f:(function - | Some feature -> feature - | None -> Route_guide.default_feature ()) + Client.Typed_rpc.call + (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.getFeature) + ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) + ~handler: + (Client.Typed_rpc.unary point ~f:(function + | Some feature -> feature + | None -> Route_guide.default_feature ())) + () in - match response with | Ok (res, _ok) -> Format.printf "RESPONSE = {%s}" (Route_guide.show_feature res) @@ -49,12 +51,12 @@ let print_features connection = in let stream = - Grpc_protoc_eio.Call.server_streaming - Route_guide.RouteGuide.Client.listFeatures + Client.Typed_rpc.call + (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.listFeatures) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - rectangle ~f:Fun.id + ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) + () in - match stream with | Ok (results, _ok) -> Seq.iter @@ -79,22 +81,23 @@ let run_record_route connection = in let response = - Grpc_protoc_eio.Call.client_streaming - Route_guide.RouteGuide.Client.recordRoute + Client.Typed_rpc.call + (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.recordRoute) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~f:(fun f response -> - (* Stream points to server. *) - Seq.iter (fun point -> Seq.write f point) points; - - (* Signal we have finished sending points. *) - Seq.close_writer f; - - (* Decode RouteSummary responses. *) - Eio.Promise.await response |> function - | Some summary -> summary - | None -> failwith (Printf.sprintf "No RouteSummary received.")) + ~handler: + (Client.Typed_rpc.client_streaming ~f:(fun f response -> + (* Stream points to server. *) + Seq.iter (fun point -> Seq.write f point) points; + + (* Signal we have finished sending points. *) + Seq.close_writer f; + + (* Decode RouteSummary responses. *) + Eio.Promise.await response |> function + | Some summary -> summary + | None -> failwith (Printf.sprintf "No RouteSummary received."))) + () in - match response with | Ok (result, _ok) -> Format.printf "SUMMARY = {%a}" Route_guide.pp_route_summary result @@ -140,12 +143,14 @@ let run_route_chat clock connection = go writer reader' xs) in let result = - Grpc_protoc_eio.Call.bidirectional_streaming - Route_guide.RouteGuide.Client.routeChat + Client.Typed_rpc.call + (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.routeChat) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~f:(fun writer reader -> go writer reader route_notes) + ~handler: + (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> + go writer reader route_notes)) + () in - match result with | Ok ((), _ok) -> () | Error e -> diff --git a/examples/routeguide-protoc/src/dune b/examples/routeguide-protoc/src/dune index 18fa44b..b0b91be 100644 --- a/examples/routeguide-protoc/src/dune +++ b/examples/routeguide-protoc/src/dune @@ -4,7 +4,7 @@ (public_names routeguide-protoc-server routeguide-protoc-client) (libraries grpc-eio - grpc-protoc-eio + grpc-protoc eio_main h2-eio routeguide_protoc diff --git a/examples/routeguide-protoc/src/server.ml b/examples/routeguide-protoc/src/server.ml index 3f3e183..4cb1e50 100644 --- a/examples/routeguide-protoc/src/server.ml +++ b/examples/routeguide-protoc/src/server.ml @@ -77,7 +77,7 @@ let calc_distance (p1 : Route_guide.point) (p2 : Route_guide.point) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) rpc = - Grpc_protoc_eio.Implement.unary rpc ~f:(fun point -> + Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) ~f:(fun point -> Eio.traceln "GetFeature = {:%a}" Route_guide.pp_point point; (* Lookup the feature and if found return it. *) @@ -103,7 +103,8 @@ let get_feature (t : t) rpc = (* $MDX part-end *) (* $MDX part-begin=server-list-features *) let list_features (t : t) rpc = - Grpc_protoc_eio.Implement.server_streaming rpc ~f:(fun rectangle f -> + Grpc_eio.Server.Typed_rpc.server_streaming (Grpc_protoc.server_rpc rpc) + ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = List.iter @@ -117,7 +118,7 @@ let list_features (t : t) rpc = (* $MDX part-end *) (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) rpc = - Grpc_protoc_eio.Implement.client_streaming rpc + Grpc_eio.Server.Typed_rpc.client_streaming (Grpc_protoc.server_rpc rpc) ~f:(fun (stream : Route_guide.point Seq.t) -> Eio.traceln "RecordRoute"; @@ -167,7 +168,7 @@ let record_route (t : t) (clock : _ Eio.Time.clock) rpc = (* $MDX part-end *) (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) rpc = - Grpc_protoc_eio.Implement.bidirectional_streaming rpc + Grpc_eio.Server.Typed_rpc.bidirectional_streaming (Grpc_protoc.server_rpc rpc) ~f:(fun (stream : Route_guide.route_note Seq.t) (f : Route_guide.route_note -> unit) @@ -186,10 +187,13 @@ let route_chat (_ : t) rpc = (* $MDX part-end *) (* $MDX part-begin=server-grpc *) let server t clock = - Route_guide.RouteGuide.Server.make ~getFeature:(get_feature t) - ~listFeatures:(list_features t) ~recordRoute:(record_route t clock) - ~routeChat:(route_chat t) () - |> Grpc_protoc_eio.Implement.server + let { Pbrt_services.Server.package; service_name; handlers } = + Route_guide.RouteGuide.Server.make ~getFeature:(get_feature t) + ~listFeatures:(list_features t) ~recordRoute:(record_route t clock) + ~routeChat:(route_chat t) () + in + Server.Typed_rpc.server + (With_service_spec { package; service_name; handlers }) (* $MDX part-end *) let connection_handler server ~sw = diff --git a/examples/routeguide-tutorial.md b/examples/routeguide-tutorial.md index e112c3d..10261f7 100644 --- a/examples/routeguide-tutorial.md +++ b/examples/routeguide-tutorial.md @@ -193,8 +193,9 @@ The individual service functions from our proto definition are implemented using ```ocaml let server t clock = - Grpc_protoc_plugin_eio.Implement.server - [ get_feature t; list_features t; record_route t clock; route_chat t ] + Server.Typed_rpc.server + (Handlers + [ get_feature t; list_features t; record_route t clock; route_chat t ]) ``` ### Simple RPC @@ -204,8 +205,8 @@ Let's look at the simplest type first, `GetFeature` which just gets a `Point` fr ```ocaml let get_feature (t : t) = - Grpc_protoc_plugin_eio.Implement.unary - (module RouteGuide.GetFeature) + Grpc_eio.Server.Typed_rpc.unary + (Grpc_protoc_plugin.server_rpc (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -236,8 +237,8 @@ Now let's look at one of our streaming RPCs. `list_features` is a server-side st ```ocaml let list_features (t : t) = - Grpc_protoc_plugin_eio.Implement.server_streaming - (module RouteGuide.ListFeatures) + Grpc_eio.Server.Typed_rpc.server_streaming + (Grpc_protoc_plugin.server_rpc (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -259,8 +260,8 @@ Now let's look at something a little more complicated: the client-side streaming ```ocaml let record_route (t : t) (clock : _ Eio.Time.clock) = - Grpc_protoc_plugin_eio.Implement.client_streaming - (module RouteGuide.RecordRoute) + Grpc_eio.Server.Typed_rpc.client_streaming + (Grpc_protoc_plugin.server_rpc (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -310,8 +311,8 @@ Finally, let's look at our bidirectional streaming RPC `route_chat`, which recei ```ocaml let route_chat (_ : t) = - Grpc_protoc_plugin_eio.Implement.bidirectional_streaming - (module RouteGuide.RouteChat) + Grpc_eio.Server.Typed_rpc.bidirectional_streaming + (Grpc_protoc_plugin.server_rpc (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -399,13 +400,15 @@ Calling the simple RPC `get_feature` requires building up a `Client.call` repres ```ocaml let call_get_feature connection point = let response = - Grpc_protoc_plugin_eio.Call.unary - (module RouteGuide.GetFeature) + Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - point - ~f:(function Some feature -> feature | None -> Feature.make ()) + ~handler: + (Client.Typed_rpc.unary point ~f:(function + | Some feature -> feature + | None -> Feature.make ())) + () in - match response with | Ok (res, _ok) -> Printf.printf "RESPONSE = {%s}" (Feature.show res) | Error _ -> Printf.printf "an error occurred" @@ -425,12 +428,12 @@ let print_features connection = in let stream = - Grpc_protoc_plugin_eio.Call.server_streaming - (module RouteGuide.ListFeatures) + Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - rectangle ~f:Fun.id + ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) + () in - match stream with | Ok (results, _ok) -> Seq.iter @@ -462,20 +465,22 @@ let run_record_route connection = in let response = - Grpc_protoc_plugin_eio.Call.client_streaming - (module RouteGuide.RecordRoute) + Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~f:(fun f response -> - (* Stream points to server. *) - Seq.iter (fun point -> Grpc_eio.Seq.write f point) points; - - (* Signal we have finished sending points. *) - Grpc_eio.Seq.close_writer f; - - (* Decode RouteSummary responses. *) - Eio.Promise.await response |> function - | Some summary -> summary - | None -> failwith (Printf.sprintf "No RouteSummary received.")) + ~handler: + (Client.Typed_rpc.client_streaming ~f:(fun f response -> + (* Stream points to server. *) + Seq.iter (fun point -> Seq.write f point) points; + + (* Signal we have finished sending points. *) + Seq.close_writer f; + + (* Decode RouteSummary responses. *) + Eio.Promise.await response |> function + | Some summary -> summary + | None -> failwith (Printf.sprintf "No RouteSummary received."))) + () in match response with | Ok (result, _ok) -> @@ -514,10 +519,9 @@ We start by generating a short sequence of locations, similar to how we did for let rec go writer reader notes = match Seq.uncons notes with | None -> - Grpc_eio.Seq.close_writer - writer (* Signal no more notes from the client. *) + Seq.close_writer writer (* Signal no more notes from the client. *) | Some (route_note, xs) -> ( - Grpc_eio.Seq.write writer route_note; + Seq.write writer route_note; (* Yield and sleep, waiting for server reply. *) Eio.Time.sleep clock 1.0; @@ -530,12 +534,14 @@ We start by generating a short sequence of locations, similar to how we did for go writer reader' xs) in let result = - Grpc_protoc_plugin_eio.Call.bidirectional_streaming - (module RouteGuide.RouteChat) + Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~f:(fun writer reader -> go writer reader route_notes) + ~handler: + (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> + go writer reader route_notes)) + () in - match result with | Ok ((), _ok) -> () | Error e -> diff --git a/examples/routeguide/src/client.ml b/examples/routeguide/src/client.ml index 09f434b..c55a304 100644 --- a/examples/routeguide/src/client.ml +++ b/examples/routeguide/src/client.ml @@ -1,3 +1,4 @@ +open Grpc_eio open Routeguide.Route_guide.Routeguide (* $MDX part-begin=client-h2 *) @@ -19,13 +20,15 @@ let client ~sw host port network = (* $MDX part-begin=client-get-feature *) let call_get_feature connection point = let response = - Grpc_protoc_plugin_eio.Call.unary - (module RouteGuide.GetFeature) + Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - point - ~f:(function Some feature -> feature | None -> Feature.make ()) + ~handler: + (Client.Typed_rpc.unary point ~f:(function + | Some feature -> feature + | None -> Feature.make ())) + () in - match response with | Ok (res, _ok) -> Printf.printf "RESPONSE = {%s}" (Feature.show res) | Error _ -> Printf.printf "an error occurred" @@ -41,12 +44,12 @@ let print_features connection = in let stream = - Grpc_protoc_plugin_eio.Call.server_streaming - (module RouteGuide.ListFeatures) + Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - rectangle ~f:Fun.id + ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) + () in - match stream with | Ok (results, _ok) -> Seq.iter @@ -71,20 +74,22 @@ let run_record_route connection = in let response = - Grpc_protoc_plugin_eio.Call.client_streaming - (module RouteGuide.RecordRoute) + Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~f:(fun f response -> - (* Stream points to server. *) - Seq.iter (fun point -> Grpc_eio.Seq.write f point) points; - - (* Signal we have finished sending points. *) - Grpc_eio.Seq.close_writer f; - - (* Decode RouteSummary responses. *) - Eio.Promise.await response |> function - | Some summary -> summary - | None -> failwith (Printf.sprintf "No RouteSummary received.")) + ~handler: + (Client.Typed_rpc.client_streaming ~f:(fun f response -> + (* Stream points to server. *) + Seq.iter (fun point -> Seq.write f point) points; + + (* Signal we have finished sending points. *) + Seq.close_writer f; + + (* Decode RouteSummary responses. *) + Eio.Promise.await response |> function + | Some summary -> summary + | None -> failwith (Printf.sprintf "No RouteSummary received."))) + () in match response with | Ok (result, _ok) -> @@ -114,10 +119,9 @@ let run_route_chat clock connection = let rec go writer reader notes = match Seq.uncons notes with | None -> - Grpc_eio.Seq.close_writer - writer (* Signal no more notes from the client. *) + Seq.close_writer writer (* Signal no more notes from the client. *) | Some (route_note, xs) -> ( - Grpc_eio.Seq.write writer route_note; + Seq.write writer route_note; (* Yield and sleep, waiting for server reply. *) Eio.Time.sleep clock 1.0; @@ -130,12 +134,14 @@ let run_route_chat clock connection = go writer reader' xs) in let result = - Grpc_protoc_plugin_eio.Call.bidirectional_streaming - (module RouteGuide.RouteChat) + Client.Typed_rpc.call + (Grpc_protoc_plugin.client_rpc (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) - ~f:(fun writer reader -> go writer reader route_notes) + ~handler: + (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> + go writer reader route_notes)) + () in - match result with | Ok ((), _ok) -> () | Error e -> diff --git a/examples/routeguide/src/dune b/examples/routeguide/src/dune index 733c7a6..5da330a 100644 --- a/examples/routeguide/src/dune +++ b/examples/routeguide/src/dune @@ -4,7 +4,7 @@ (public_names routeguide-server routeguide-client) (libraries grpc-eio - grpc-protoc-plugin-eio + grpc-protoc-plugin eio_main h2-eio routeguide diff --git a/examples/routeguide/src/server.ml b/examples/routeguide/src/server.ml index 78fae93..91f88a6 100644 --- a/examples/routeguide/src/server.ml +++ b/examples/routeguide/src/server.ml @@ -74,8 +74,8 @@ let calc_distance (p1 : Point.t) (p2 : Point.t) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) = - Grpc_protoc_plugin_eio.Implement.unary - (module RouteGuide.GetFeature) + Grpc_eio.Server.Typed_rpc.unary + (Grpc_protoc_plugin.server_rpc (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -99,8 +99,8 @@ let get_feature (t : t) = (* $MDX part-end *) (* $MDX part-begin=server-list-features *) let list_features (t : t) = - Grpc_protoc_plugin_eio.Implement.server_streaming - (module RouteGuide.ListFeatures) + Grpc_eio.Server.Typed_rpc.server_streaming + (Grpc_protoc_plugin.server_rpc (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -115,8 +115,8 @@ let list_features (t : t) = (* $MDX part-end *) (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) = - Grpc_protoc_plugin_eio.Implement.client_streaming - (module RouteGuide.RecordRoute) + Grpc_eio.Server.Typed_rpc.client_streaming + (Grpc_protoc_plugin.server_rpc (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -161,8 +161,8 @@ let record_route (t : t) (clock : _ Eio.Time.clock) = (* $MDX part-end *) (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) = - Grpc_protoc_plugin_eio.Implement.bidirectional_streaming - (module RouteGuide.RouteChat) + Grpc_eio.Server.Typed_rpc.bidirectional_streaming + (Grpc_protoc_plugin.server_rpc (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -178,8 +178,9 @@ let route_chat (_ : t) = (* $MDX part-end *) (* $MDX part-begin=server-grpc *) let server t clock = - Grpc_protoc_plugin_eio.Implement.server - [ get_feature t; list_features t; record_route t clock; route_chat t ] + Server.Typed_rpc.server + (Handlers + [ get_feature t; list_features t; record_route t clock; route_chat t ]) (* $MDX part-end *) let connection_handler server ~sw = diff --git a/grpc-protoc-eio.opam b/grpc-protoc-eio.opam deleted file mode 100644 index f06b976..0000000 --- a/grpc-protoc-eio.opam +++ /dev/null @@ -1,44 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "An Eio implementation of gRPC using ocaml-protoc" -description: - "Functionality for building gRPC services and rpcs with `ocaml-protoc` and `eio`" -maintainer: ["Daniel Quernheim "] -authors: [ - "Andrew Jeffery " - "Daniel Quernheim " - "Michael Bacarella " - "Sven Anderson " - "Tim McGilchrist " - "Wojtek Czekalski " - "dimitris.mostrous " -] -license: "BSD-3-Clause" -homepage: "https://github.com/dialohq/ocaml-grpc" -doc: "https://dialohq.github.io/ocaml-grpc" -bug-reports: "https://github.com/dialohq/ocaml-grpc/issues" -depends: [ - "dune" {>= "3.7"} - "grpc" {= version} - "grpc-eio" {= version} - "grpc-protoc" {= version} - "ocaml-protoc" {>= "3.0"} - "pbrt" {>= "3.0"} - "pbrt_services" {>= "3.0"} - "odoc" {with-doc} -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/dialohq/ocaml-grpc.git" diff --git a/grpc-protoc-plugin-eio.opam b/grpc-protoc-plugin-eio.opam deleted file mode 100644 index 656cc9a..0000000 --- a/grpc-protoc-plugin-eio.opam +++ /dev/null @@ -1,42 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -synopsis: "An Eio implementation of gRPC using ocaml-protoc-plugin" -description: - "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin` and `eio`" -maintainer: ["Daniel Quernheim "] -authors: [ - "Andrew Jeffery " - "Daniel Quernheim " - "Michael Bacarella " - "Sven Anderson " - "Tim McGilchrist " - "Wojtek Czekalski " - "dimitris.mostrous " -] -license: "BSD-3-Clause" -homepage: "https://github.com/dialohq/ocaml-grpc" -doc: "https://dialohq.github.io/ocaml-grpc" -bug-reports: "https://github.com/dialohq/ocaml-grpc/issues" -depends: [ - "dune" {>= "3.7"} - "grpc" {= version} - "grpc-eio" {= version} - "grpc-protoc-plugin" {= version} - "ocaml-protoc-plugin" {>= "4.5"} - "odoc" {with-doc} -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] -] -dev-repo: "git+https://github.com/dialohq/ocaml-grpc.git" diff --git a/grpc-protoc-plugin.opam b/grpc-protoc-plugin.opam index e0b048b..1ddae22 100644 --- a/grpc-protoc-plugin.opam +++ b/grpc-protoc-plugin.opam @@ -1,8 +1,8 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -synopsis: "Internal gRPC utils for ocaml-protoc-plugin" +synopsis: "An implementation of gRPC using ocaml-protoc-plugin" description: - "Internal utils for building gRPC services and rpcs with `ocaml-protoc-plugin`" + "Functionality for building gRPC services and rpcs with `ocaml-protoc-plugin`" maintainer: ["Daniel Quernheim "] authors: [ "Andrew Jeffery " diff --git a/grpc-protoc.opam b/grpc-protoc.opam index 4080c65..fde3dfd 100644 --- a/grpc-protoc.opam +++ b/grpc-protoc.opam @@ -1,8 +1,8 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -synopsis: "Internal gRPC utils for ocaml-protoc" +synopsis: "An implementation of gRPC using ocaml-protoc" description: - "Internal utils for building gRPC services and rpcs with `ocaml-protoc`" + "Functionality for building gRPC services and rpcs with `ocaml-protoc`" maintainer: ["Daniel Quernheim "] authors: [ "Andrew Jeffery " diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index 5b965d6..b8da679 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -154,25 +154,30 @@ module Typed_rpc = struct type 'service_spec rpc = 'service_spec t type t = - | Handlers of { handlers : Grpc.Rpc.Service_spec.t rpc list } - | Handlers_and_service_spec of { - service_spec : Grpc.Rpc.Service_spec.t; + | Handlers : Grpc.Rpc.Service_spec.t rpc list -> t + | With_service_spec : { + package : string list; + service_name : string; handlers : unit rpc list; } + -> t end let server handlers : server = let ts = match (handlers : Handlers.t) with - | Handlers { handlers = ts } -> ts - | Handlers_and_service_spec { service_spec; handlers = ts } -> + | Handlers ts -> ts + | With_service_spec { package; service_name; handlers = ts } -> List.map (fun (T t) -> T { t with rpc_spec = - { t.rpc_spec with service_spec = Some service_spec }; + { + t.rpc_spec with + service_spec = Some { package; service_name }; + }; }) ts in diff --git a/lib/grpc-eio/server.mli b/lib/grpc-eio/server.mli index 1d30622..4aa8bbe 100644 --- a/lib/grpc-eio/server.mli +++ b/lib/grpc-eio/server.mli @@ -111,11 +111,13 @@ module Typed_rpc : sig type 'service_spec rpc := 'service_spec t type t = - | Handlers of { handlers : Grpc.Rpc.Service_spec.t rpc list } - | Handlers_and_service_spec of { - service_spec : Grpc.Rpc.Service_spec.t; + | Handlers : Grpc.Rpc.Service_spec.t rpc list -> t + | With_service_spec : { + package : string list; + service_name : string; handlers : unit rpc list; } + -> t end val server : Handlers.t -> server diff --git a/lib/grpc-protoc-eio/dune b/lib/grpc-protoc-eio/dune deleted file mode 100644 index 7bf592a..0000000 --- a/lib/grpc-protoc-eio/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name grpc_protoc_eio) - (public_name grpc-protoc-eio) - (libraries grpc grpc_eio grpc_protoc h2-eio ocaml-protoc pbrt pbrt_services)) diff --git a/lib/grpc-protoc-eio/grpc_protoc_eio.ml b/lib/grpc-protoc-eio/grpc_protoc_eio.ml deleted file mode 100644 index 49b5918..0000000 --- a/lib/grpc-protoc-eio/grpc_protoc_eio.ml +++ /dev/null @@ -1,66 +0,0 @@ -open Pbrt_services.Value_mode - -module Call = struct - let unary (type request response) ?scheme ?headers - (rpc : (request, unary, response, unary) Pbrt_services.Client.rpc) - ~do_request request ~f = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc.client_rpc rpc) - ?scheme ~do_request ?headers - ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) - () - - let client_streaming (type request response) ?scheme ?headers - (rpc : (request, stream, response, unary) Pbrt_services.Client.rpc) - ~do_request ~f = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc.client_rpc rpc) - ?scheme ~do_request ?headers - ~handler:(Grpc_eio.Client.Typed_rpc.client_streaming ~f) - () - - let server_streaming (type request response) ?scheme ?headers - (rpc : (request, unary, response, stream) Pbrt_services.Client.rpc) - ~do_request request ~f = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc.client_rpc rpc) - ?scheme ~do_request ?headers - ~handler:(Grpc_eio.Client.Typed_rpc.server_streaming request ~f) - () - - let bidirectional_streaming (type request response) ?scheme ?headers - (rpc : (request, stream, response, stream) Pbrt_services.Client.rpc) - ~do_request ~f = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc.client_rpc rpc) - ?scheme ~do_request ?headers - ~handler:(Grpc_eio.Client.Typed_rpc.bidirectional_streaming ~f) - () -end - -module Implement = struct - type rpc = unit Grpc_eio.Server.Typed_rpc.t - - let unary (type request response) - (rpc : (request, unary, response, unary) Pbrt_services.Server.rpc) ~f = - Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) ~f - - let client_streaming (type request response) - (rpc : (request, stream, response, unary) Pbrt_services.Server.rpc) ~f = - Grpc_eio.Server.Typed_rpc.client_streaming (Grpc_protoc.server_rpc rpc) ~f - - let server_streaming (type request response) - (rpc : (request, unary, response, stream) Pbrt_services.Server.rpc) ~f = - Grpc_eio.Server.Typed_rpc.server_streaming (Grpc_protoc.server_rpc rpc) ~f - - let bidirectional_streaming (type request response) - (rpc : (request, stream, response, stream) Pbrt_services.Server.rpc) ~f = - Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protoc.server_rpc rpc) - ~f - - let server { Pbrt_services.Server.package; service_name; handlers } = - Grpc_eio.Server.Typed_rpc.server - (Handlers_and_service_spec - { service_spec = { package; service_name }; handlers }) -end diff --git a/lib/grpc-protoc-eio/grpc_protoc_eio.mli b/lib/grpc-protoc-eio/grpc_protoc_eio.mli deleted file mode 100644 index e45294c..0000000 --- a/lib/grpc-protoc-eio/grpc_protoc_eio.mli +++ /dev/null @@ -1,63 +0,0 @@ -open Pbrt_services.Value_mode - -module Call : sig - val unary : - ?scheme:string -> - ?headers:H2.Headers.t -> - ('request, unary, 'response, unary) Pbrt_services.Client.rpc -> - do_request:Grpc_eio.Client.do_request -> - 'request -> - f:('response option -> 'a) -> - ('a * Grpc.Status.t, H2.Status.t) result - - val client_streaming : - ?scheme:string -> - ?headers:H2.Headers.t -> - ('request, stream, 'response, unary) Pbrt_services.Client.rpc -> - do_request:Grpc_eio.Client.do_request -> - f:('request Grpc_eio.Seq.writer -> 'response option Eio.Promise.t -> 'a) -> - ('a * Grpc.Status.t, H2.Status.t) result - - val server_streaming : - ?scheme:string -> - ?headers:H2.Headers.t -> - ('request, unary, 'response, stream) Pbrt_services.Client.rpc -> - do_request:Grpc_eio.Client.do_request -> - 'request -> - f:('response Grpc_eio.Seq.t -> 'a) -> - ('a * Grpc.Status.t, H2.Status.t) result - - val bidirectional_streaming : - ?scheme:string -> - ?headers:H2.Headers.t -> - ('request, stream, 'response, stream) Pbrt_services.Client.rpc -> - do_request:Grpc_eio.Client.do_request -> - f:('request Grpc_eio.Seq.writer -> 'response Grpc_eio.Seq.t -> 'a) -> - ('a * Grpc.Status.t, H2.Status.t) result -end - -module Implement : sig - type rpc = unit Grpc_eio.Server.Typed_rpc.t - - val unary : - ('request, unary, 'response, unary) Pbrt_services.Server.rpc -> - f:('request -> Grpc.Status.t * 'response option) -> - rpc - - val client_streaming : - ('request, stream, 'response, unary) Pbrt_services.Server.rpc -> - f:('request Seq.t -> Grpc.Status.t * 'response option) -> - rpc - - val server_streaming : - ('request, unary, 'response, stream) Pbrt_services.Server.rpc -> - f:('request -> ('response -> unit) -> Grpc.Status.t) -> - rpc - - val bidirectional_streaming : - ('request, stream, 'response, stream) Pbrt_services.Server.rpc -> - f:('request Seq.t -> ('response -> unit) -> Grpc.Status.t) -> - rpc - - val server : rpc Pbrt_services.Server.t -> Grpc_eio.Server.t -end diff --git a/lib/grpc-protoc-plugin-eio/dune b/lib/grpc-protoc-plugin-eio/dune deleted file mode 100644 index 616251e..0000000 --- a/lib/grpc-protoc-plugin-eio/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name grpc_protoc_plugin_eio) - (public_name grpc-protoc-plugin-eio) - (libraries grpc grpc_eio grpc_protoc_plugin h2-eio ocaml-protoc-plugin)) diff --git a/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.ml b/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.ml deleted file mode 100644 index 9d7eb29..0000000 --- a/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.ml +++ /dev/null @@ -1,73 +0,0 @@ -module type S = Ocaml_protoc_plugin.Service.Rpc - -module Call = struct - let unary (type request response) ?scheme ?headers - (module R : S with type Request.t = request and type Response.t = response) - ~do_request request ~f = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module R)) - ?scheme ~do_request ?headers - ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) - () - - let client_streaming (type request response) ?scheme ?headers - (module R : S with type Request.t = request and type Response.t = response) - ~do_request ~f = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module R)) - ?scheme ~do_request ?headers - ~handler:(Grpc_eio.Client.Typed_rpc.client_streaming ~f) - () - - let server_streaming (type request response) ?scheme ?headers - (module R : S with type Request.t = request and type Response.t = response) - ~do_request request ~f = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module R)) - ?scheme ~do_request ?headers - ~handler:(Grpc_eio.Client.Typed_rpc.server_streaming request ~f) - () - - let bidirectional_streaming (type request response) ?scheme ?headers - (module R : S with type Request.t = request and type Response.t = response) - ~do_request ~f = - Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module R)) - ?scheme ~do_request ?headers - ~handler:(Grpc_eio.Client.Typed_rpc.bidirectional_streaming ~f) - () -end - -module Implement = struct - type rpc = Grpc.Rpc.Service_spec.t Grpc_eio.Server.Typed_rpc.t - - let unary (type request response) - (module R : S with type Request.t = request and type Response.t = response) - ~f = - Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.server_rpc (module R)) - ~f - - let client_streaming (type request response) - (module R : S with type Request.t = request and type Response.t = response) - ~f = - Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protoc_plugin.server_rpc (module R)) - ~f - - let server_streaming (type request response) - (module R : S with type Request.t = request and type Response.t = response) - ~f = - Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protoc_plugin.server_rpc (module R)) - ~f - - let bidirectional_streaming (type request response) - (module R : S with type Request.t = request and type Response.t = response) - ~f = - Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protoc_plugin.server_rpc (module R)) - ~f - - let server handlers = Grpc_eio.Server.Typed_rpc.server (Handlers { handlers }) -end diff --git a/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.mli b/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.mli deleted file mode 100644 index a2572d9..0000000 --- a/lib/grpc-protoc-plugin-eio/grpc_protoc_plugin_eio.mli +++ /dev/null @@ -1,63 +0,0 @@ -module type S = Ocaml_protoc_plugin.Service.Rpc - -module Call : sig - val unary : - ?scheme:string -> - ?headers:H2.Headers.t -> - (module S with type Request.t = 'request and type Response.t = 'response) -> - do_request:Grpc_eio.Client.do_request -> - 'request -> - f:('response option -> 'a) -> - ('a * Grpc.Status.t, H2.Status.t) result - - val client_streaming : - ?scheme:string -> - ?headers:H2.Headers.t -> - (module S with type Request.t = 'request and type Response.t = 'response) -> - do_request:Grpc_eio.Client.do_request -> - f:('request Grpc_eio.Seq.writer -> 'response option Eio.Promise.t -> 'a) -> - ('a * Grpc.Status.t, H2.Status.t) result - - val server_streaming : - ?scheme:string -> - ?headers:H2.Headers.t -> - (module S with type Request.t = 'request and type Response.t = 'response) -> - do_request:Grpc_eio.Client.do_request -> - 'request -> - f:('response Grpc_eio.Seq.t -> 'a) -> - ('a * Grpc.Status.t, H2.Status.t) result - - val bidirectional_streaming : - ?scheme:string -> - ?headers:H2.Headers.t -> - (module S with type Request.t = 'request and type Response.t = 'response) -> - do_request:Grpc_eio.Client.do_request -> - f:('request Grpc_eio.Seq.writer -> 'response Grpc_eio.Seq.t -> 'a) -> - ('a * Grpc.Status.t, H2.Status.t) result -end - -module Implement : sig - type rpc = Grpc.Rpc.Service_spec.t Grpc_eio.Server.Typed_rpc.t - - val unary : - (module S with type Request.t = 'request and type Response.t = 'response) -> - f:('request -> Grpc.Status.t * 'response option) -> - rpc - - val client_streaming : - (module S with type Request.t = 'request and type Response.t = 'response) -> - f:('request Seq.t -> Grpc.Status.t * 'response option) -> - rpc - - val server_streaming : - (module S with type Request.t = 'request and type Response.t = 'response) -> - f:('request -> ('response -> unit) -> Grpc.Status.t) -> - rpc - - val bidirectional_streaming : - (module S with type Request.t = 'request and type Response.t = 'response) -> - f:('request Seq.t -> ('response -> unit) -> Grpc.Status.t) -> - rpc - - val server : rpc list -> Grpc_eio.Server.t -end From c0c4df50547fc527b80966def39d4ba2735361ae Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Fri, 15 Dec 2023 21:54:52 +0100 Subject: [PATCH 09/12] enforce consistency of request and response modes - This adds type safety to ensure the RPCs are called with the expected protocol (e.g. you cannot call a unary rpc with a server_streaming entry point, etc.). On the ocaml-protoc-plugin side, currently there are no markers for the rpc modes - this interface will permit adding them in the future without user facing changes. On the ocaml-protoc plugin, the value mode flows from the proto file definition and is checked in the user code as expected. Implementation note: There's perhaps a way to shorten the mapping of value-modes but I couldn't find one given that `Grpc` cannot depend on `Ocaml_protoc`, and thus the `Value_mode` types are not equal. --- .../greeter-client-eio/greeter_client_eio.ml | 2 +- .../greeter_client_eio.ml | 3 +- .../greeter_server_eio.ml | 9 +- .../greeter-server-eio/greeter_server_eio.ml | 6 +- examples/routeguide-protoc/src/client.ml | 11 +- examples/routeguide-protoc/src/server.ml | 24 ++-- examples/routeguide-tutorial.md | 24 ++-- examples/routeguide/src/client.ml | 11 +- examples/routeguide/src/server.ml | 13 ++- lib/grpc-eio/client.ml | 41 +++++-- lib/grpc-eio/client.mli | 38 ++++-- lib/grpc-eio/server.ml | 64 ++++++---- lib/grpc-eio/server.mli | 43 ++++--- lib/grpc-protoc-plugin/grpc_protoc_plugin.ml | 60 +++++++--- lib/grpc-protoc-plugin/grpc_protoc_plugin.mli | 84 +++++++++++-- lib/grpc-protoc/grpc_protoc.ml | 64 +++++++--- lib/grpc-protoc/grpc_protoc.mli | 110 +++++++++++++++++- lib/grpc/rpc.ml | 20 +++- lib/grpc/rpc.mli | 20 +++- 19 files changed, 487 insertions(+), 160 deletions(-) diff --git a/examples/greeter-client-eio/greeter_client_eio.ml b/examples/greeter-client-eio/greeter_client_eio.ml index 23be377..bd19265 100644 --- a/examples/greeter-client-eio/greeter_client_eio.ml +++ b/examples/greeter-client-eio/greeter_client_eio.ml @@ -30,7 +30,7 @@ let main env = let result = Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module Greeter.SayHello)) + (Grpc_protoc_plugin.Client_rpc.unary (module Greeter.SayHello)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) () diff --git a/examples/greeter-protoc-client-eio/greeter_client_eio.ml b/examples/greeter-protoc-client-eio/greeter_client_eio.ml index ea1d57f..5fc1521 100644 --- a/examples/greeter-protoc-client-eio/greeter_client_eio.ml +++ b/examples/greeter-protoc-client-eio/greeter_client_eio.ml @@ -29,7 +29,8 @@ let main env = let result = Grpc_eio.Client.Typed_rpc.call - (Grpc_protoc.client_rpc Greeter_protoc.Greeter.Greeter.Client.sayHello) + (Grpc_protoc.Client_rpc.unary + Greeter_protoc.Greeter.Greeter.Client.sayHello) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Grpc_eio.Client.Typed_rpc.unary request ~f) () diff --git a/examples/greeter-protoc-server-eio/greeter_server_eio.ml b/examples/greeter-protoc-server-eio/greeter_server_eio.ml index ba2a672..ac11d5d 100644 --- a/examples/greeter-protoc-server-eio/greeter_server_eio.ml +++ b/examples/greeter-protoc-server-eio/greeter_server_eio.ml @@ -1,7 +1,7 @@ open Grpc_eio let sayHello rpc = - Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) + Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.Server_rpc.unary rpc) ~f:(fun (request : Greeter_protoc.Greeter.hello_request) -> let message = if request.name = "" then "You forgot your name!" @@ -52,11 +52,8 @@ let serve server env = let () = let server = - let { Pbrt_services.Server.package; service_name; handlers } = - Greeter_protoc.Greeter.Greeter.Server.make ~sayHello () - in - Server.Typed_rpc.server - (With_service_spec { package; service_name; handlers }) + Greeter_protoc.Greeter.Greeter.Server.make ~sayHello () + |> Grpc_protoc.handlers |> Server.Typed_rpc.server in Eio_main.run (serve server) diff --git a/examples/greeter-server-eio/greeter_server_eio.ml b/examples/greeter-server-eio/greeter_server_eio.ml index a4e5df3..bd2a636 100644 --- a/examples/greeter-server-eio/greeter_server_eio.ml +++ b/examples/greeter-server-eio/greeter_server_eio.ml @@ -3,7 +3,7 @@ open Grpc_eio let say_hello = let module SayHello = Greeter.Mypackage.Greeter.SayHello in Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.server_rpc (module SayHello)) + (Grpc_protoc_plugin.Server_rpc.unary (module SayHello)) ~f:(fun request -> let message = if request = "" then "You forgot your name!" @@ -53,6 +53,8 @@ let serve server env = listen () let () = - let server = Server.Typed_rpc.server (Handlers [ say_hello ]) in + let server = + Server.Typed_rpc.server (Grpc_protoc_plugin.handlers [ say_hello ]) + in Eio_main.run (serve server) diff --git a/examples/routeguide-protoc/src/client.ml b/examples/routeguide-protoc/src/client.ml index 0d7681b..860da38 100644 --- a/examples/routeguide-protoc/src/client.ml +++ b/examples/routeguide-protoc/src/client.ml @@ -21,7 +21,7 @@ let client ~sw host port network = let call_get_feature connection point = let response = Client.Typed_rpc.call - (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.getFeature) + (Grpc_protoc.Client_rpc.unary Route_guide.RouteGuide.Client.getFeature) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -52,7 +52,8 @@ let print_features connection = let stream = Client.Typed_rpc.call - (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.listFeatures) + (Grpc_protoc.Client_rpc.server_streaming + Route_guide.RouteGuide.Client.listFeatures) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -82,7 +83,8 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.recordRoute) + (Grpc_protoc.Client_rpc.client_streaming + Route_guide.RouteGuide.Client.recordRoute) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -144,7 +146,8 @@ let run_route_chat clock connection = in let result = Client.Typed_rpc.call - (Grpc_protoc.client_rpc Route_guide.RouteGuide.Client.routeChat) + (Grpc_protoc.Client_rpc.bidirectional_streaming + Route_guide.RouteGuide.Client.routeChat) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide-protoc/src/server.ml b/examples/routeguide-protoc/src/server.ml index 4cb1e50..3c18fb3 100644 --- a/examples/routeguide-protoc/src/server.ml +++ b/examples/routeguide-protoc/src/server.ml @@ -77,7 +77,8 @@ let calc_distance (p1 : Route_guide.point) (p2 : Route_guide.point) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) rpc = - Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.server_rpc rpc) ~f:(fun point -> + Grpc_eio.Server.Typed_rpc.unary (Grpc_protoc.Server_rpc.unary rpc) + ~f:(fun point -> Eio.traceln "GetFeature = {:%a}" Route_guide.pp_point point; (* Lookup the feature and if found return it. *) @@ -103,8 +104,8 @@ let get_feature (t : t) rpc = (* $MDX part-end *) (* $MDX part-begin=server-list-features *) let list_features (t : t) rpc = - Grpc_eio.Server.Typed_rpc.server_streaming (Grpc_protoc.server_rpc rpc) - ~f:(fun rectangle f -> + Grpc_eio.Server.Typed_rpc.server_streaming + (Grpc_protoc.Server_rpc.server_streaming rpc) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = List.iter @@ -118,7 +119,8 @@ let list_features (t : t) rpc = (* $MDX part-end *) (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) rpc = - Grpc_eio.Server.Typed_rpc.client_streaming (Grpc_protoc.server_rpc rpc) + Grpc_eio.Server.Typed_rpc.client_streaming + (Grpc_protoc.Server_rpc.client_streaming rpc) ~f:(fun (stream : Route_guide.point Seq.t) -> Eio.traceln "RecordRoute"; @@ -168,7 +170,8 @@ let record_route (t : t) (clock : _ Eio.Time.clock) rpc = (* $MDX part-end *) (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) rpc = - Grpc_eio.Server.Typed_rpc.bidirectional_streaming (Grpc_protoc.server_rpc rpc) + Grpc_eio.Server.Typed_rpc.bidirectional_streaming + (Grpc_protoc.Server_rpc.bidirectional_streaming rpc) ~f:(fun (stream : Route_guide.route_note Seq.t) (f : Route_guide.route_note -> unit) @@ -187,13 +190,10 @@ let route_chat (_ : t) rpc = (* $MDX part-end *) (* $MDX part-begin=server-grpc *) let server t clock = - let { Pbrt_services.Server.package; service_name; handlers } = - Route_guide.RouteGuide.Server.make ~getFeature:(get_feature t) - ~listFeatures:(list_features t) ~recordRoute:(record_route t clock) - ~routeChat:(route_chat t) () - in - Server.Typed_rpc.server - (With_service_spec { package; service_name; handlers }) + Route_guide.RouteGuide.Server.make ~getFeature:(get_feature t) + ~listFeatures:(list_features t) ~recordRoute:(record_route t clock) + ~routeChat:(route_chat t) () + |> Grpc_protoc.handlers |> Server.Typed_rpc.server (* $MDX part-end *) let connection_handler server ~sw = diff --git a/examples/routeguide-tutorial.md b/examples/routeguide-tutorial.md index 10261f7..b99e3b3 100644 --- a/examples/routeguide-tutorial.md +++ b/examples/routeguide-tutorial.md @@ -194,7 +194,7 @@ The individual service functions from our proto definition are implemented using ```ocaml let server t clock = Server.Typed_rpc.server - (Handlers + (Grpc_protoc_plugin.handlers [ get_feature t; list_features t; record_route t clock; route_chat t ]) ``` @@ -206,7 +206,7 @@ Let's look at the simplest type first, `GetFeature` which just gets a `Point` fr ```ocaml let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.server_rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.Server_rpc.unary (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -238,7 +238,8 @@ Now let's look at one of our streaming RPCs. `list_features` is a server-side st ```ocaml let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.Server_rpc.server_streaming + (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -261,7 +262,8 @@ Now let's look at something a little more complicated: the client-side streaming ```ocaml let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.Server_rpc.client_streaming + (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -312,7 +314,8 @@ Finally, let's look at our bidirectional streaming RPC `route_chat`, which recei ```ocaml let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.Server_rpc.bidirectional_streaming + (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -401,7 +404,7 @@ Calling the simple RPC `get_feature` requires building up a `Client.call` repres let call_get_feature connection point = let response = Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.Client_rpc.unary (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -429,7 +432,8 @@ let print_features connection = let stream = Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.Client_rpc.server_streaming + (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -466,7 +470,8 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.Client_rpc.client_streaming + (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -535,7 +540,8 @@ We start by generating a short sequence of locations, similar to how we did for in let result = Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.Client_rpc.bidirectional_streaming + (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/client.ml b/examples/routeguide/src/client.ml index c55a304..94c8167 100644 --- a/examples/routeguide/src/client.ml +++ b/examples/routeguide/src/client.ml @@ -21,7 +21,7 @@ let client ~sw host port network = let call_get_feature connection point = let response = Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.Client_rpc.unary (module RouteGuide.GetFeature)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.unary point ~f:(function @@ -45,7 +45,8 @@ let print_features connection = let stream = Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.Client_rpc.server_streaming + (module RouteGuide.ListFeatures)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler:(Client.Typed_rpc.server_streaming rectangle ~f:Fun.id) () @@ -75,7 +76,8 @@ let run_record_route connection = let response = Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.Client_rpc.client_streaming + (module RouteGuide.RecordRoute)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.client_streaming ~f:(fun f response -> @@ -135,7 +137,8 @@ let run_route_chat clock connection = in let result = Client.Typed_rpc.call - (Grpc_protoc_plugin.client_rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.Client_rpc.bidirectional_streaming + (module RouteGuide.RouteChat)) ~do_request:(H2_eio.Client.request connection ~error_handler:ignore) ~handler: (Client.Typed_rpc.bidirectional_streaming ~f:(fun writer reader -> diff --git a/examples/routeguide/src/server.ml b/examples/routeguide/src/server.ml index 91f88a6..557e323 100644 --- a/examples/routeguide/src/server.ml +++ b/examples/routeguide/src/server.ml @@ -75,7 +75,7 @@ let calc_distance (p1 : Point.t) (p2 : Point.t) : int = (* $MDX part-begin=server-get-feature *) let get_feature (t : t) = Grpc_eio.Server.Typed_rpc.unary - (Grpc_protoc_plugin.server_rpc (module RouteGuide.GetFeature)) + (Grpc_protoc_plugin.Server_rpc.unary (module RouteGuide.GetFeature)) ~f:(fun point -> Eio.traceln "GetFeature = {:%s}" (Point.show point); @@ -100,7 +100,8 @@ let get_feature (t : t) = (* $MDX part-begin=server-list-features *) let list_features (t : t) = Grpc_eio.Server.Typed_rpc.server_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.ListFeatures)) + (Grpc_protoc_plugin.Server_rpc.server_streaming + (module RouteGuide.ListFeatures)) ~f:(fun rectangle f -> (* Lookup and reply with features found. *) let () = @@ -116,7 +117,8 @@ let list_features (t : t) = (* $MDX part-begin=server-record-route *) let record_route (t : t) (clock : _ Eio.Time.clock) = Grpc_eio.Server.Typed_rpc.client_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.RecordRoute)) + (Grpc_protoc_plugin.Server_rpc.client_streaming + (module RouteGuide.RecordRoute)) ~f:(fun (stream : Point.t Seq.t) -> Eio.traceln "RecordRoute"; @@ -162,7 +164,8 @@ let record_route (t : t) (clock : _ Eio.Time.clock) = (* $MDX part-begin=server-route-chat *) let route_chat (_ : t) = Grpc_eio.Server.Typed_rpc.bidirectional_streaming - (Grpc_protoc_plugin.server_rpc (module RouteGuide.RouteChat)) + (Grpc_protoc_plugin.Server_rpc.bidirectional_streaming + (module RouteGuide.RouteChat)) ~f:(fun (stream : RouteNote.t Seq.t) (f : RouteNote.t -> unit) -> Printf.printf "RouteChat\n"; @@ -179,7 +182,7 @@ let route_chat (_ : t) = (* $MDX part-begin=server-grpc *) let server t clock = Server.Typed_rpc.server - (Handlers + (Grpc_protoc_plugin.handlers [ get_feature t; list_features t; record_route t clock; route_chat t ]) (* $MDX part-end *) diff --git a/lib/grpc-eio/client.ml b/lib/grpc-eio/client.ml index a8480c5..4210579 100644 --- a/lib/grpc-eio/client.ml +++ b/lib/grpc-eio/client.ml @@ -106,14 +106,19 @@ module Rpc = struct end module Typed_rpc = struct - type ('request, 'response, 'a) handler = - ('request, 'response) Grpc.Rpc.Client_rpc.t -> + type ('request, 'request_mode, 'response, 'response_mode, 'a) handler = + ('request, 'request_mode, 'response, 'response_mode) Grpc.Rpc.Client_rpc.t -> H2.Body.Writer.t -> H2.Body.Reader.t -> 'a let unary (type request response) ~f (request : request) - (rpc : (request, response) Grpc.Rpc.Client_rpc.t) = + (rpc : + ( request, + Grpc.Rpc.Value_mode.unary, + response, + Grpc.Rpc.Value_mode.unary ) + Grpc.Rpc.Client_rpc.t) = let request = rpc.encode_request request in let f response = let response = response |> Option.map rpc.decode_response in @@ -122,7 +127,12 @@ module Typed_rpc = struct Rpc.unary ~f request let server_streaming (type request response) ~f (request : request) - (rpc : (request, response) Grpc.Rpc.Client_rpc.t) = + (rpc : + ( request, + Grpc.Rpc.Value_mode.unary, + response, + Grpc.Rpc.Value_mode.stream ) + Grpc.Rpc.Client_rpc.t) = let request = rpc.encode_request request in let f responses = let responses = Seq.map rpc.decode_response responses in @@ -131,7 +141,12 @@ module Typed_rpc = struct Rpc.server_streaming ~f request let client_streaming (type request response) ~f - (rpc : (request, response) Grpc.Rpc.Client_rpc.t) = + (rpc : + ( request, + Grpc.Rpc.Value_mode.stream, + response, + Grpc.Rpc.Value_mode.unary ) + Grpc.Rpc.Client_rpc.t) = let f requests response = let requests_reader, requests' = Seq.create_reader_writer () in let response', response_u = Eio.Promise.create () in @@ -153,7 +168,12 @@ module Typed_rpc = struct Rpc.client_streaming ~f let bidirectional_streaming (type request response) ~f - (rpc : (request, response) Grpc.Rpc.Client_rpc.t) = + (rpc : + ( request, + Grpc.Rpc.Value_mode.stream, + response, + Grpc.Rpc.Value_mode.stream ) + Grpc.Rpc.Client_rpc.t) = let f requests responses = let requests_reader, requests' = Seq.create_reader_writer () in let responses' = Seq.map rpc.decode_response responses in @@ -167,9 +187,12 @@ module Typed_rpc = struct in Rpc.bidirectional_streaming ~f - let call (type request response a) - (rpc : (request, response) Grpc.Rpc.Client_rpc.t) ?scheme - ~(handler : (request, response, a) handler) ~do_request ?headers () = + let call (type request request_mode response response_mode a) + (rpc : + (request, request_mode, response, response_mode) Grpc.Rpc.Client_rpc.t) + ?scheme + ~(handler : (request, request_mode, response, response_mode, a) handler) + ~do_request ?headers () = call ~service:(Grpc.Rpc.Client_rpc.packaged_service_name rpc) ~rpc:rpc.rpc_name ?scheme ~handler:(handler rpc) ~do_request ?headers () diff --git a/lib/grpc-eio/client.mli b/lib/grpc-eio/client.mli index 023f866..45396f1 100644 --- a/lib/grpc-eio/client.mli +++ b/lib/grpc-eio/client.mli @@ -55,29 +55,53 @@ module Typed_rpc : sig - use the service and RPC names provided by the rpc specification to call the services with their expected names. *) - type ('request, 'response, 'a) handler + type ('request, 'request_mode, 'response, 'response_mode, 'a) handler (** The next functions are meant to be used by the client to handle call to RPCs. *) val bidirectional_streaming : f:('request Seq.writer -> 'response Seq.t -> 'a) -> - ('request, 'response, 'a) handler + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.stream, + 'a ) + handler val client_streaming : f:('request Seq.writer -> 'response option Eio.Promise.t -> 'a) -> - ('request, 'response, 'a) handler + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.unary, + 'a ) + handler val server_streaming : - f:('response Seq.t -> 'a) -> 'request -> ('request, 'response, 'a) handler + f:('response Seq.t -> 'a) -> + 'request -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.stream, + 'a ) + handler val unary : - f:('response option -> 'a) -> 'request -> ('request, 'response, 'a) handler + f:('response option -> 'a) -> + 'request -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.unary, + 'a ) + handler val call : - ('request, 'response) Grpc.Rpc.Client_rpc.t -> + ('request, 'request_mode, 'response, 'response_mode) Grpc.Rpc.Client_rpc.t -> ?scheme:string -> - handler:('request, 'response, 'a) handler -> + handler:('request, 'request_mode, 'response, 'response_mode, 'a) handler -> do_request:do_request -> ?headers:H2.Headers.t -> unit -> diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index b8da679..bf0b037 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -145,39 +145,29 @@ module Typed_rpc = struct type 'service_spec t = | T : { - rpc_spec : ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t; + rpc_spec : + ( 'request, + 'request_mode, + 'response, + 'response_mode, + 'service_spec ) + Grpc.Rpc.Server_rpc.t; rpc_impl : Rpc.t; } -> 'service_spec t - module Handlers = struct - type 'service_spec rpc = 'service_spec t - - type t = - | Handlers : Grpc.Rpc.Service_spec.t rpc list -> t - | With_service_spec : { - package : string list; - service_name : string; - handlers : unit rpc list; - } - -> t - end - let server handlers : server = let ts = - match (handlers : Handlers.t) with - | Handlers ts -> ts - | With_service_spec { package; service_name; handlers = ts } -> + match (handlers : _ Grpc.Rpc.Handlers.t) with + | Handlers { handlers = ts } -> ts + | With_service_spec { service_spec; handlers = ts } -> List.map (fun (T t) -> T { t with rpc_spec = - { - t.rpc_spec with - service_spec = Some { package; service_name }; - }; + { t.rpc_spec with service_spec = Some service_spec }; }) ts in @@ -205,7 +195,13 @@ module Typed_rpc = struct Service.handle_request service) let unary (type request response) - (rpc_spec : (request, response, _) Grpc.Rpc.Server_rpc.t) ~f:handler = + (rpc_spec : + ( request, + Grpc.Rpc.Value_mode.unary, + response, + Grpc.Rpc.Value_mode.unary, + _ ) + Grpc.Rpc.Server_rpc.t) ~f:handler = let handler buffer = let status, response = handler (rpc_spec.decode_request buffer) in (status, Option.map rpc_spec.encode_response response) @@ -213,7 +209,13 @@ module Typed_rpc = struct T { rpc_spec; rpc_impl = Rpc.Unary handler } let server_streaming (type request response) - (rpc_spec : (request, response, _) Grpc.Rpc.Server_rpc.t) ~f:handler = + (rpc_spec : + ( request, + Grpc.Rpc.Value_mode.unary, + response, + Grpc.Rpc.Value_mode.stream, + _ ) + Grpc.Rpc.Server_rpc.t) ~f:handler = let handler buffer f = handler (rpc_spec.decode_request buffer) (fun response -> f (rpc_spec.encode_response response)) @@ -221,7 +223,13 @@ module Typed_rpc = struct T { rpc_spec; rpc_impl = Rpc.Server_streaming handler } let client_streaming (type request response) - (rpc_spec : (request, response, _) Grpc.Rpc.Server_rpc.t) ~f:handler = + (rpc_spec : + ( request, + Grpc.Rpc.Value_mode.stream, + response, + Grpc.Rpc.Value_mode.unary, + _ ) + Grpc.Rpc.Server_rpc.t) ~f:handler = let handler requests = let requests = Seq.map rpc_spec.decode_request requests in let status, response = handler requests in @@ -230,7 +238,13 @@ module Typed_rpc = struct T { rpc_spec; rpc_impl = Rpc.Client_streaming handler } let bidirectional_streaming (type request response) - (rpc_spec : (request, response, _) Grpc.Rpc.Server_rpc.t) ~f:handler = + (rpc_spec : + ( request, + Grpc.Rpc.Value_mode.stream, + response, + Grpc.Rpc.Value_mode.stream, + _ ) + Grpc.Rpc.Server_rpc.t) ~f:handler = let handler requests f = let requests = Seq.map rpc_spec.decode_request requests in handler requests (fun response -> f (rpc_spec.encode_response response)) diff --git a/lib/grpc-eio/server.mli b/lib/grpc-eio/server.mli index 4aa8bbe..76c000e 100644 --- a/lib/grpc-eio/server.mli +++ b/lib/grpc-eio/server.mli @@ -88,39 +88,46 @@ module Typed_rpc : sig file. *) val unary : - ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.unary, + 'service_spec ) + Grpc.Rpc.Server_rpc.t -> f:('request, 'response) unary -> 'service_spec t val client_streaming : - ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.unary, + 'service_spec ) + Grpc.Rpc.Server_rpc.t -> f:('request, 'response) client_streaming -> 'service_spec t val server_streaming : - ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.stream, + 'service_spec ) + Grpc.Rpc.Server_rpc.t -> f:('request, 'response) server_streaming -> 'service_spec t val bidirectional_streaming : - ('request, 'response, 'service_spec) Grpc.Rpc.Server_rpc.t -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.stream, + 'service_spec ) + Grpc.Rpc.Server_rpc.t -> f:('request, 'response) bidirectional_streaming -> 'service_spec t - module Handlers : sig - type 'service_spec rpc := 'service_spec t - - type t = - | Handlers : Grpc.Rpc.Service_spec.t rpc list -> t - | With_service_spec : { - package : string list; - service_name : string; - handlers : unit rpc list; - } - -> t - end - - val server : Handlers.t -> server + val server : (Grpc.Rpc.Service_spec.t t, unit t) Grpc.Rpc.Handlers.t -> server (** Having built a list of RPCs you will use this function to package them up into a server that is ready to be served over the network. This function takes care of registering the services based on the names provided by the diff --git a/lib/grpc-protoc-plugin/grpc_protoc_plugin.ml b/lib/grpc-protoc-plugin/grpc_protoc_plugin.ml index a06d5f0..baea692 100644 --- a/lib/grpc-protoc-plugin/grpc_protoc_plugin.ml +++ b/lib/grpc-protoc-plugin/grpc_protoc_plugin.ml @@ -24,22 +24,46 @@ let service_spec (type request response) service_name = R.service_name; } -let client_rpc (type request response) - (module R : S with type Request.t = request and type Response.t = response) - = - { - Grpc.Rpc.Client_rpc.service_spec = service_spec (module R); - rpc_name = R.method_name; - encode_request = encode (module R.Request); - decode_response = decode (module R.Response); - } +module Client_rpc = struct + let make (type request response) + (module R : S with type Request.t = request and type Response.t = response) + ~request_mode ~response_mode = + { + Grpc.Rpc.Client_rpc.service_spec = service_spec (module R); + rpc_name = R.method_name; + encode_request = encode (module R.Request); + decode_response = decode (module R.Response); + request_mode; + response_mode; + } -let server_rpc (type request response) - (module R : S with type Request.t = request and type Response.t = response) - = - { - Grpc.Rpc.Server_rpc.service_spec = Some (service_spec (module R)); - rpc_name = R.method_name; - decode_request = decode (module R.Request); - encode_response = encode (module R.Response); - } + let unary rpc = make rpc ~request_mode:Unary ~response_mode:Unary + let client_streaming rpc = make rpc ~request_mode:Stream ~response_mode:Unary + let server_streaming rpc = make rpc ~request_mode:Unary ~response_mode:Stream + + let bidirectional_streaming rpc = + make rpc ~request_mode:Stream ~response_mode:Stream +end + +module Server_rpc = struct + let make (type request response) + (module R : S with type Request.t = request and type Response.t = response) + ~request_mode ~response_mode = + { + Grpc.Rpc.Server_rpc.service_spec = Some (service_spec (module R)); + rpc_name = R.method_name; + decode_request = decode (module R.Request); + encode_response = encode (module R.Response); + request_mode; + response_mode; + } + + let unary rpc = make rpc ~request_mode:Unary ~response_mode:Unary + let client_streaming rpc = make rpc ~request_mode:Stream ~response_mode:Unary + let server_streaming rpc = make rpc ~request_mode:Unary ~response_mode:Stream + + let bidirectional_streaming rpc = + make rpc ~request_mode:Stream ~response_mode:Stream +end + +let handlers handlers = Grpc.Rpc.Handlers.Handlers { handlers } diff --git a/lib/grpc-protoc-plugin/grpc_protoc_plugin.mli b/lib/grpc-protoc-plugin/grpc_protoc_plugin.mli index 33a8056..7bd147f 100644 --- a/lib/grpc-protoc-plugin/grpc_protoc_plugin.mli +++ b/lib/grpc-protoc-plugin/grpc_protoc_plugin.mli @@ -1,13 +1,75 @@ module type S = Ocaml_protoc_plugin.Service.Rpc -val client_rpc : - (module Ocaml_protoc_plugin.Service.Rpc - with type Request.t = 'request - and type Response.t = 'response) -> - ('request, 'response) Grpc.Rpc.Client_rpc.t - -val server_rpc : - (module Ocaml_protoc_plugin.Service.Rpc - with type Request.t = 'request - and type Response.t = 'response) -> - ('request, 'response, Grpc.Rpc.Service_spec.t) Grpc.Rpc.Server_rpc.t +module Client_rpc : sig + val unary : + (module S with type Request.t = 'request and type Response.t = 'response) -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.unary ) + Grpc.Rpc.Client_rpc.t + + val client_streaming : + (module S with type Request.t = 'request and type Response.t = 'response) -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.unary ) + Grpc.Rpc.Client_rpc.t + + val server_streaming : + (module S with type Request.t = 'request and type Response.t = 'response) -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.stream ) + Grpc.Rpc.Client_rpc.t + + val bidirectional_streaming : + (module S with type Request.t = 'request and type Response.t = 'response) -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.stream ) + Grpc.Rpc.Client_rpc.t +end + +module Server_rpc : sig + val unary : + (module S with type Request.t = 'request and type Response.t = 'response) -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.unary, + Grpc.Rpc.Service_spec.t ) + Grpc.Rpc.Server_rpc.t + + val client_streaming : + (module S with type Request.t = 'request and type Response.t = 'response) -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.unary, + Grpc.Rpc.Service_spec.t ) + Grpc.Rpc.Server_rpc.t + + val server_streaming : + (module S with type Request.t = 'request and type Response.t = 'response) -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.stream, + Grpc.Rpc.Service_spec.t ) + Grpc.Rpc.Server_rpc.t + + val bidirectional_streaming : + (module S with type Request.t = 'request and type Response.t = 'response) -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.stream, + Grpc.Rpc.Service_spec.t ) + Grpc.Rpc.Server_rpc.t +end + +val handlers : 'a list -> ('a, _) Grpc.Rpc.Handlers.t diff --git a/lib/grpc-protoc/grpc_protoc.ml b/lib/grpc-protoc/grpc_protoc.ml index b2567fa..5ba88aa 100644 --- a/lib/grpc-protoc/grpc_protoc.ml +++ b/lib/grpc-protoc/grpc_protoc.ml @@ -7,21 +7,49 @@ let decode (type a) (decode : Pbrt.Decoder.t -> a) buffer = let decoder = Pbrt.Decoder.of_string buffer in decode decoder -let client_rpc (type request response) - (rpc : (request, _, response, _) Pbrt_services.Client.rpc) = - { - Grpc.Rpc.Client_rpc.service_spec = - { package = rpc.package; service_name = rpc.service_name }; - rpc_name = rpc.rpc_name; - encode_request = encode rpc.encode_pb_req; - decode_response = decode rpc.decode_pb_res; - } - -let server_rpc (type request response) - (rpc : (request, _, response, _) Pbrt_services.Server.rpc) = - { - Grpc.Rpc.Server_rpc.service_spec = None; - rpc_name = rpc.name; - decode_request = decode rpc.decode_pb_req; - encode_response = encode rpc.encode_pb_res; - } +module Client_rpc = struct + let make (type request response) + (rpc : (request, _, response, _) Pbrt_services.Client.rpc) ~request_mode + ~response_mode = + { + Grpc.Rpc.Client_rpc.service_spec = + { package = rpc.package; service_name = rpc.service_name }; + rpc_name = rpc.rpc_name; + encode_request = encode rpc.encode_pb_req; + decode_response = decode rpc.decode_pb_res; + request_mode; + response_mode; + } + + let unary rpc = make rpc ~request_mode:Unary ~response_mode:Unary + let client_streaming rpc = make rpc ~request_mode:Stream ~response_mode:Unary + let server_streaming rpc = make rpc ~request_mode:Unary ~response_mode:Stream + + let bidirectional_streaming rpc = + make rpc ~request_mode:Stream ~response_mode:Stream +end + +module Server_rpc = struct + let make (type request response) + (rpc : (request, _, response, _) Pbrt_services.Server.rpc) ~request_mode + ~response_mode = + { + Grpc.Rpc.Server_rpc.service_spec = None; + rpc_name = rpc.name; + decode_request = decode rpc.decode_pb_req; + encode_response = encode rpc.encode_pb_res; + request_mode; + response_mode; + } + + let unary rpc = make rpc ~request_mode:Unary ~response_mode:Unary + let client_streaming rpc = make rpc ~request_mode:Stream ~response_mode:Unary + let server_streaming rpc = make rpc ~request_mode:Unary ~response_mode:Stream + + let bidirectional_streaming rpc = + make rpc ~request_mode:Stream ~response_mode:Stream +end + +let handlers { Pbrt_services.Server.package; service_name; handlers } = + Grpc.Rpc.Handlers.With_service_spec + { service_spec = { package; service_name }; handlers } diff --git a/lib/grpc-protoc/grpc_protoc.mli b/lib/grpc-protoc/grpc_protoc.mli index 8356284..6390a10 100644 --- a/lib/grpc-protoc/grpc_protoc.mli +++ b/lib/grpc-protoc/grpc_protoc.mli @@ -1,7 +1,105 @@ -val client_rpc : - ('request, _, 'response, _) Pbrt_services.Client.rpc -> - ('request, 'response) Grpc.Rpc.Client_rpc.t +module Client_rpc : sig + val unary : + ( 'request, + Pbrt_services.Value_mode.unary, + 'response, + Pbrt_services.Value_mode.unary ) + Pbrt_services.Client.rpc -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.unary ) + Grpc.Rpc.Client_rpc.t -val server_rpc : - ('request, _, 'response, _) Pbrt_services.Server.rpc -> - ('request, 'response, unit) Grpc.Rpc.Server_rpc.t + val client_streaming : + ( 'request, + Pbrt_services.Value_mode.stream, + 'response, + Pbrt_services.Value_mode.unary ) + Pbrt_services.Client.rpc -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.unary ) + Grpc.Rpc.Client_rpc.t + + val server_streaming : + ( 'request, + Pbrt_services.Value_mode.unary, + 'response, + Pbrt_services.Value_mode.stream ) + Pbrt_services.Client.rpc -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.stream ) + Grpc.Rpc.Client_rpc.t + + val bidirectional_streaming : + ( 'request, + Pbrt_services.Value_mode.stream, + 'response, + Pbrt_services.Value_mode.stream ) + Pbrt_services.Client.rpc -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.stream ) + Grpc.Rpc.Client_rpc.t +end + +module Server_rpc : sig + val unary : + ( 'request, + Pbrt_services.Value_mode.unary, + 'response, + Pbrt_services.Value_mode.unary ) + Pbrt_services.Server.rpc -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.unary, + unit ) + Grpc.Rpc.Server_rpc.t + + val client_streaming : + ( 'request, + Pbrt_services.Value_mode.stream, + 'response, + Pbrt_services.Value_mode.unary ) + Pbrt_services.Server.rpc -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.unary, + unit ) + Grpc.Rpc.Server_rpc.t + + val server_streaming : + ( 'request, + Pbrt_services.Value_mode.unary, + 'response, + Pbrt_services.Value_mode.stream ) + Pbrt_services.Server.rpc -> + ( 'request, + Grpc.Rpc.Value_mode.unary, + 'response, + Grpc.Rpc.Value_mode.stream, + unit ) + Grpc.Rpc.Server_rpc.t + + val bidirectional_streaming : + ( 'request, + Pbrt_services.Value_mode.stream, + 'response, + Pbrt_services.Value_mode.stream ) + Pbrt_services.Server.rpc -> + ( 'request, + Grpc.Rpc.Value_mode.stream, + 'response, + Grpc.Rpc.Value_mode.stream, + unit ) + Grpc.Rpc.Server_rpc.t +end + +val handlers : 'a Pbrt_services.Server.t -> (_, 'a) Grpc.Rpc.Handlers.t diff --git a/lib/grpc/rpc.ml b/lib/grpc/rpc.ml index 3191c5c..c303b7c 100644 --- a/lib/grpc/rpc.ml +++ b/lib/grpc/rpc.ml @@ -1,5 +1,11 @@ type buffer = string +module Value_mode = struct + type unary + type stream + type _ t = Unary : unary t | Stream : stream t +end + module Service_spec = struct type t = { package : string list; service_name : string } @@ -8,12 +14,20 @@ module Service_spec = struct ^ t.service_name end +module Handlers = struct + type ('a, 'b) t = + | Handlers of { handlers : 'a list } + | With_service_spec of { handlers : 'b list; service_spec : Service_spec.t } +end + module Client_rpc = struct - type ('request, 'response) t = { + type ('request, 'request_mode, 'response, 'response_mode) t = { service_spec : Service_spec.t; rpc_name : string; encode_request : 'request -> buffer; decode_response : buffer -> 'response; + request_mode : 'request_mode Value_mode.t; + response_mode : 'response_mode Value_mode.t; } let packaged_service_name t = @@ -25,10 +39,12 @@ module Server_rpc = struct type 'a t = None : unit t | Some : Service_spec.t -> Service_spec.t t end - type ('request, 'response, 'service_spec) t = { + type ('request, 'request_mode, 'response, 'response_mode, 'service_spec) t = { service_spec : 'service_spec Service_spec.t; rpc_name : string; decode_request : buffer -> 'request; encode_response : 'response -> buffer; + request_mode : 'request_mode Value_mode.t; + response_mode : 'response_mode Value_mode.t; } end diff --git a/lib/grpc/rpc.mli b/lib/grpc/rpc.mli index 442a4e7..02db146 100644 --- a/lib/grpc/rpc.mli +++ b/lib/grpc/rpc.mli @@ -2,18 +2,32 @@ type buffer = string (** Exploring a separate client/server api that works better with [ocaml-protoc]. *) +module Value_mode : sig + type unary + type stream + type _ t = Unary : unary t | Stream : stream t +end + module Service_spec : sig type t = { package : string list; service_name : string } val packaged_service_name : t -> string end +module Handlers : sig + type ('a, 'b) t = + | Handlers of { handlers : 'a list } + | With_service_spec of { handlers : 'b list; service_spec : Service_spec.t } +end + module Client_rpc : sig - type ('request, 'response) t = { + type ('request, 'request_mode, 'response, 'response_mode) t = { service_spec : Service_spec.t; rpc_name : string; encode_request : 'request -> buffer; decode_response : buffer -> 'response; + request_mode : 'request_mode Value_mode.t; + response_mode : 'response_mode Value_mode.t; } val packaged_service_name : _ t -> string @@ -24,10 +38,12 @@ module Server_rpc : sig type 'a t = None : unit t | Some : Service_spec.t -> Service_spec.t t end - type ('request, 'response, 'service_spec) t = { + type ('request, 'request_mode, 'response, 'response_mode, 'service_spec) t = { service_spec : 'service_spec Service_spec.t; rpc_name : string; decode_request : buffer -> 'request; encode_response : 'response -> buffer; + request_mode : 'request_mode Value_mode.t; + response_mode : 'response_mode Value_mode.t; } end From 358e2c0ce33b0583a6ee06dd47df6bdc00c51f20 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Tue, 19 Dec 2023 19:59:33 +0100 Subject: [PATCH 10/12] allow implementing several services on a single server --- lib/grpc-eio/server.ml | 33 ++++++++++++++++----------------- lib/grpc/rpc.ml | 1 + lib/grpc/rpc.mli | 1 + 3 files changed, 18 insertions(+), 17 deletions(-) diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index bf0b037..de526a6 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -156,22 +156,22 @@ module Typed_rpc = struct } -> 'service_spec t - let server handlers : server = - let ts = - match (handlers : _ Grpc.Rpc.Handlers.t) with - | Handlers { handlers = ts } -> ts - | With_service_spec { service_spec; handlers = ts } -> - List.map - (fun (T t) -> - T - { - t with - rpc_spec = - { t.rpc_spec with service_spec = Some service_spec }; - }) - ts - in + let rec make_handlers handlers = + match (handlers : _ Grpc.Rpc.Handlers.t) with + | a :: tl -> List.concat (make_handlers a :: List.map make_handlers tl) + | Handlers { handlers = ts } -> ts + | With_service_spec { service_spec; handlers = ts } -> + List.map + (fun (T t) -> + T + { + t with + rpc_spec = { t.rpc_spec with service_spec = Some service_spec }; + }) + ts + let server handlers : server = + let handlers = make_handlers handlers in List.fold_left (fun map (T t as packed) -> let service_name = @@ -179,12 +179,11 @@ module Typed_rpc = struct | Some service_spec -> Grpc.Rpc.Service_spec.packaged_service_name service_spec in - let rpc_impl = ServiceMap.find_opt service_name map |> Option.value ~default:[] in ServiceMap.add service_name (packed :: rpc_impl) map) - ServiceMap.empty ts + ServiceMap.empty handlers |> ServiceMap.map (fun ts -> let service = List.fold_left diff --git a/lib/grpc/rpc.ml b/lib/grpc/rpc.ml index c303b7c..8733833 100644 --- a/lib/grpc/rpc.ml +++ b/lib/grpc/rpc.ml @@ -18,6 +18,7 @@ module Handlers = struct type ('a, 'b) t = | Handlers of { handlers : 'a list } | With_service_spec of { handlers : 'b list; service_spec : Service_spec.t } + | ( :: ) of ('a, 'b) t * ('a, 'b) t list end module Client_rpc = struct diff --git a/lib/grpc/rpc.mli b/lib/grpc/rpc.mli index 02db146..2e4d799 100644 --- a/lib/grpc/rpc.mli +++ b/lib/grpc/rpc.mli @@ -18,6 +18,7 @@ module Handlers : sig type ('a, 'b) t = | Handlers of { handlers : 'a list } | With_service_spec of { handlers : 'b list; service_spec : Service_spec.t } + | ( :: ) of ('a, 'b) t * ('a, 'b) t list end module Client_rpc : sig From 225db75866581e7ecf2894571f4bf9c6b821f7ff Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sat, 6 Jan 2024 09:46:57 +0100 Subject: [PATCH 11/12] revert unintentional local variable rename --- lib/grpc-eio/server.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index de526a6..0de65b0 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -116,10 +116,10 @@ module Service = struct let parts = String.split_on_char '/' request.target in if List.length parts > 1 then let rpc_name = List.nth parts (List.length parts - 1) in - let rpc_impl = RpcMap.find_opt rpc_name t in - match rpc_impl with - | Some rpc_impl -> ( - match rpc_impl with + let rpc = RpcMap.find_opt rpc_name t in + match rpc with + | Some rpc -> ( + match rpc with | Unary f -> Rpc.unary ~f reqd | Client_streaming f -> Rpc.client_streaming ~f reqd | Server_streaming f -> Rpc.server_streaming ~f reqd From 67537c11de4596e413e2d229c9b1553fe5f04cf5 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sat, 6 Jan 2024 09:56:53 +0100 Subject: [PATCH 12/12] fix the service names used by Typed_rpc In the existing examples, the service name is separated from the package name by a dot, which I inadvertently omitted in the previous implementation. Note that as long as the service name used by a client and a server is the same, the right handler is executed, so there's some leeway in the actual choice of the convention to use. The hope is that the dot separated one is standard. --- lib/grpc-eio/client.ml | 2 +- lib/grpc/rpc.ml | 6 +----- lib/grpc/rpc.mli | 2 -- 3 files changed, 2 insertions(+), 8 deletions(-) diff --git a/lib/grpc-eio/client.ml b/lib/grpc-eio/client.ml index 4210579..00e93c8 100644 --- a/lib/grpc-eio/client.ml +++ b/lib/grpc-eio/client.ml @@ -194,6 +194,6 @@ module Typed_rpc = struct ~(handler : (request, request_mode, response, response_mode, a) handler) ~do_request ?headers () = call - ~service:(Grpc.Rpc.Client_rpc.packaged_service_name rpc) + ~service:(Grpc.Rpc.Service_spec.packaged_service_name rpc.service_spec) ~rpc:rpc.rpc_name ?scheme ~handler:(handler rpc) ~do_request ?headers () end diff --git a/lib/grpc/rpc.ml b/lib/grpc/rpc.ml index 8733833..487cf7e 100644 --- a/lib/grpc/rpc.ml +++ b/lib/grpc/rpc.ml @@ -10,8 +10,7 @@ module Service_spec = struct type t = { package : string list; service_name : string } let packaged_service_name t = - (match t.package with _ :: _ as p -> String.concat "." p | [] -> "") - ^ t.service_name + String.concat "." (t.package @ [ t.service_name ]) end module Handlers = struct @@ -30,9 +29,6 @@ module Client_rpc = struct request_mode : 'request_mode Value_mode.t; response_mode : 'response_mode Value_mode.t; } - - let packaged_service_name t = - Service_spec.packaged_service_name t.service_spec end module Server_rpc = struct diff --git a/lib/grpc/rpc.mli b/lib/grpc/rpc.mli index 2e4d799..4f86232 100644 --- a/lib/grpc/rpc.mli +++ b/lib/grpc/rpc.mli @@ -30,8 +30,6 @@ module Client_rpc : sig request_mode : 'request_mode Value_mode.t; response_mode : 'response_mode Value_mode.t; } - - val packaged_service_name : _ t -> string end module Server_rpc : sig