From e04a2e20ab071d55b7b1f073d6df7dde7831ec99 Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Thu, 23 Nov 2023 17:13:03 +0100 Subject: [PATCH 01/16] 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/16] 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/16] 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/16] 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/16] 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/16] 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/16] 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/16] 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/16] 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/16] 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/16] 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/16] 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 From dcca2d3a264f9ef016d5dc8e3ad9250c963ced0a Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sat, 6 Jan 2024 11:47:17 +0100 Subject: [PATCH 13/16] implement untyped rpc client on top of typed client --- lib/grpc-eio/client.ml | 171 +++++++++++++++++------------------- lib/grpc-eio/client.mli | 80 +++++++++-------- lib/grpc-eio/connection.ml | 98 ++++++++++++--------- lib/grpc-eio/connection.mli | 21 +++++ lib/grpc-eio/server.ml | 34 +++---- 5 files changed, 216 insertions(+), 188 deletions(-) create mode 100644 lib/grpc-eio/connection.mli diff --git a/lib/grpc-eio/client.ml b/lib/grpc-eio/client.ml index 00e93c8..512cc29 100644 --- a/lib/grpc-eio/client.ml +++ b/lib/grpc-eio/client.ml @@ -66,44 +66,19 @@ let call ~service ~rpc ?(scheme = "https") ~handler ~(do_request : do_request) Ok (result, status) | error_status -> Error error_status -module Rpc = struct - type 'a handler = H2.Body.Writer.t -> H2.Body.Reader.t -> 'a - - let bidirectional_streaming ~f write_body read_body = - let response_reader, response_writer = Seq.create_reader_writer () in - let request_reader, request_writer = Seq.create_reader_writer () in - Connection.grpc_recv_streaming read_body response_writer; - let res, res_notify = Eio.Promise.create () in - Eio.Fiber.both - (fun () -> - Eio.Promise.resolve res_notify (f request_writer response_reader)) - (fun () -> - Connection.grpc_send_streaming_client write_body request_reader); - Eio.Promise.await res - - let client_streaming ~f = - bidirectional_streaming ~f:(fun request_writer responses -> - let response, response_resolver = Eio.Promise.create () in - Eio.Fiber.pair - (fun () -> f request_writer response) - (fun () -> - Eio.Promise.resolve response_resolver - (Seq.read_and_exhaust responses)) - |> fst) - - let server_streaming ~f request = - bidirectional_streaming ~f:(fun request_writer responses -> - Seq.write request_writer request; - Seq.close_writer request_writer; - f responses) - - let unary ~f request = - bidirectional_streaming ~f:(fun request_writer responses -> - Seq.write request_writer request; - Seq.close_writer request_writer; - let response = Seq.read_and_exhaust responses in - f response) -end +let make_handler ~encode_request ~decode_response ~f write_body read_body = + let response_reader, response_writer = Seq.create_reader_writer () in + let request_reader, request_writer = Seq.create_reader_writer () in + Connection.Typed.grpc_recv_streaming ~decode:decode_response read_body + response_writer; + let res, res_notify = Eio.Promise.create () in + Eio.Fiber.both + (fun () -> + Eio.Promise.resolve res_notify (f request_writer response_reader)) + (fun () -> + Connection.Typed.grpc_send_streaming_client ~encode:encode_request + write_body request_reader); + Eio.Promise.await res module Typed_rpc = struct type ('request, 'request_mode, 'response, 'response_mode, 'a) handler = @@ -112,33 +87,19 @@ module Typed_rpc = struct H2.Body.Reader.t -> 'a - let unary (type request response) ~f (request : request) - (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 - f response - in - Rpc.unary ~f request + let make_handler (type request response) + (rpc : (request, _, response, _) Grpc.Rpc.Client_rpc.t) ~f = + make_handler ~encode_request:rpc.encode_request + ~decode_response:rpc.decode_response ~f - let server_streaming (type request response) ~f (request : request) + let bidirectional_streaming (type request response) ~f (rpc : ( request, - Grpc.Rpc.Value_mode.unary, + Grpc.Rpc.Value_mode.stream, 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 - f responses - in - Rpc.server_streaming ~f request + make_handler rpc ~f let client_streaming (type request response) ~f (rpc : @@ -147,45 +108,39 @@ module Typed_rpc = struct 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 - Eio.Switch.run @@ fun sw -> - Eio.Fiber.fork ~sw (fun () -> - Eio.Fiber.both - (fun () -> - let 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 (rpc.encode_request request)) - requests_reader; - Seq.close_writer requests)); - f requests' response' - in - Rpc.client_streaming ~f + make_handler rpc ~f:(fun request_writer responses -> + let response, response_resolver = Eio.Promise.create () in + Eio.Fiber.pair + (fun () -> f request_writer response) + (fun () -> + Eio.Promise.resolve response_resolver + (Seq.read_and_exhaust responses)) + |> fst) - let bidirectional_streaming (type request response) ~f + let server_streaming (type request response) ~f (request : request) (rpc : ( request, - Grpc.Rpc.Value_mode.stream, + Grpc.Rpc.Value_mode.unary, 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 - Eio.Switch.run @@ fun sw -> - Eio.Fiber.fork ~sw (fun () -> - Seq.iter - (fun request -> Seq.write requests (rpc.encode_request request)) - requests_reader; - Seq.close_writer requests); - f requests' responses' - in - Rpc.bidirectional_streaming ~f + make_handler rpc ~f:(fun request_writer responses -> + Seq.write request_writer request; + Seq.close_writer request_writer; + f responses) + + let unary (type request response) ~f (request : request) + (rpc : + ( request, + Grpc.Rpc.Value_mode.unary, + response, + Grpc.Rpc.Value_mode.unary ) + Grpc.Rpc.Client_rpc.t) = + make_handler rpc ~f:(fun request_writer responses -> + Seq.write request_writer request; + Seq.close_writer request_writer; + let response = Seq.read_and_exhaust responses in + f response) let call (type request request_mode response response_mode a) (rpc : @@ -197,3 +152,35 @@ module Typed_rpc = struct ~service:(Grpc.Rpc.Service_spec.packaged_service_name rpc.service_spec) ~rpc:rpc.rpc_name ?scheme ~handler:(handler rpc) ~do_request ?headers () end + +module Rpc = struct + type 'a handler = H2.Body.Writer.t -> H2.Body.Reader.t -> 'a + + let bidirectional_streaming ~f = + make_handler ~encode_request:Fun.id ~decode_response:Fun.id ~f + + let client_streaming ~f = + bidirectional_streaming ~f:(fun request_writer responses -> + let response, response_resolver = Eio.Promise.create () in + Eio.Fiber.pair + (fun () -> f request_writer response) + (fun () -> + Eio.Promise.resolve response_resolver + (Seq.read_and_exhaust responses)) + |> fst) + + let server_streaming ~f request = + bidirectional_streaming ~f:(fun request_writer responses -> + Seq.write request_writer request; + Seq.close_writer request_writer; + f responses) + + let unary ~f request = + bidirectional_streaming ~f:(fun request_writer responses -> + Seq.write request_writer request; + Seq.close_writer request_writer; + let response = Seq.read_and_exhaust responses in + f response) + + let call = call +end diff --git a/lib/grpc-eio/client.mli b/lib/grpc-eio/client.mli index 45396f1..30243ec 100644 --- a/lib/grpc-eio/client.mli +++ b/lib/grpc-eio/client.mli @@ -1,29 +1,3 @@ -module Rpc : sig - type 'a handler = H2.Body.Writer.t -> H2.Body.Reader.t -> 'a - - val bidirectional_streaming : - f:(string Seq.writer -> string Seq.t -> 'a) -> 'a handler - (** [bidirectional_streaming ~f write read] sets up the sending and receiving - logic using [write] and [read], then calls [f] with a push function for - requests and a stream of responses. *) - - val client_streaming : - f:(string Seq.writer -> string option Eio.Promise.t -> 'a) -> 'a handler - (** [client_streaming ~f write read] sets up the sending and receiving - logic using [write] and [read], then calls [f] with a push function for - requests and promise for the response. *) - - val server_streaming : f:(string Seq.t -> 'a) -> string -> 'a handler - (** [server_streaming ~f enc write read] sets up the sending and receiving - logic using [write] and [read], then sends [enc] and calls [f] with a - stream of responses. *) - - val unary : f:(string option -> 'a) -> string -> 'a handler - (** [unary ~f enc write read] sets up the sending and receiving - logic using [write] and [read], then sends [enc] and calls [f] with a - promise for the response. *) -end - type response_handler = H2.Client_connection.response_handler type do_request = @@ -34,18 +8,7 @@ type do_request = H2.Body.Writer.t (** [do_request] is the type of a function that performs the request *) -val call : - service:string -> - rpc:string -> - ?scheme:string -> - handler:'a Rpc.handler -> - do_request:do_request -> - ?headers:H2.Headers.t -> - unit -> - ('a * Grpc.Status.t, H2.Status.t) result -(** [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. *) +(** {1 Typed API} *) module Typed_rpc : sig (** This is an experimental API to call RPC from the client side. Compared to @@ -110,3 +73,44 @@ module Typed_rpc : sig coding/decoding of messages as well as allows referring to the service and RPC names specified in the [.proto] file. *) end + +(** {1 Untyped API} *) + +module Rpc : sig + type 'a handler = H2.Body.Writer.t -> H2.Body.Reader.t -> 'a + + val bidirectional_streaming : + f:(string Seq.writer -> string Seq.t -> 'a) -> 'a handler + (** [bidirectional_streaming ~f write read] sets up the sending and receiving + logic using [write] and [read], then calls [f] with a push function for + requests and a stream of responses. *) + + val client_streaming : + f:(string Seq.writer -> string option Eio.Promise.t -> 'a) -> 'a handler + (** [client_streaming ~f write read] sets up the sending and receiving + logic using [write] and [read], then calls [f] with a push function for + requests and promise for the response. *) + + val server_streaming : f:(string Seq.t -> 'a) -> string -> 'a handler + (** [server_streaming ~f enc write read] sets up the sending and receiving + logic using [write] and [read], then sends [enc] and calls [f] with a + stream of responses. *) + + val unary : f:(string option -> 'a) -> string -> 'a handler + (** [unary ~f enc write read] sets up the sending and receiving + logic using [write] and [read], then sends [enc] and calls [f] with a + promise for the response. *) + + val call : + service:string -> + rpc:string -> + ?scheme:string -> + handler:'a handler -> + do_request:do_request -> + ?headers:H2.Headers.t -> + unit -> + ('a * Grpc.Status.t, H2.Status.t) result + (** [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. *) +end diff --git a/lib/grpc-eio/connection.ml b/lib/grpc-eio/connection.ml index 3de3965..9fa8292 100644 --- a/lib/grpc-eio/connection.ml +++ b/lib/grpc-eio/connection.ml @@ -1,45 +1,59 @@ -let grpc_recv_streaming body message_buffer_writer = - let request_buffer = Grpc.Buffer.v () in - let on_eof () = Seq.close_writer message_buffer_writer in - let rec on_read buffer ~off ~len = - Grpc.Buffer.copy_from_bigstringaf ~src_off:off ~src:buffer - ~dst:request_buffer ~length:len; - Grpc.Message.extract_all (Seq.write message_buffer_writer) request_buffer; +module Typed = struct + let grpc_recv_streaming ~decode body message_buffer_writer = + let request_buffer = Grpc.Buffer.v () in + let on_eof () = Seq.close_writer message_buffer_writer in + let rec on_read buffer ~off ~len = + Grpc.Buffer.copy_from_bigstringaf ~src_off:off ~src:buffer + ~dst:request_buffer ~length:len; + Grpc.Message.extract_all + (fun message -> Seq.write message_buffer_writer (decode message)) + request_buffer; + H2.Body.Reader.schedule_read body ~on_read ~on_eof + in H2.Body.Reader.schedule_read body ~on_read ~on_eof - in - H2.Body.Reader.schedule_read body ~on_read ~on_eof -let grpc_send_streaming_client body encoder_stream = - Seq.iter - (fun encoder -> - let payload = Grpc.Message.make encoder in - H2.Body.Writer.write_string body payload) - encoder_stream; - H2.Body.Writer.close body + let grpc_send_streaming_client ~encode body encoder_stream = + Seq.iter + (fun encoder -> + let payload = Grpc.Message.make (encode encoder) in + H2.Body.Writer.write_string body payload) + encoder_stream; + H2.Body.Writer.close body -let grpc_send_streaming request encoder_stream status_promise = - let body = - H2.Reqd.respond_with_streaming ~flush_headers_immediately:true request - (H2.Response.create - ~headers: - (H2.Headers.of_list [ ("content-type", "application/grpc+proto") ]) - `OK) - in - Seq.iter - (fun input -> - let payload = Grpc.Message.make input in - H2.Body.Writer.write_string body payload; - H2.Body.Writer.flush body (fun () -> ())) - encoder_stream; - let status = Eio.Promise.await status_promise in - H2.Reqd.schedule_trailers request - (H2.Headers.of_list - ([ - ( "grpc-status", - string_of_int (Grpc.Status.int_of_code (Grpc.Status.code status)) ); - ] - @ - match Grpc.Status.message status with - | None -> [] - | Some message -> [ ("grpc-message", message) ])); - H2.Body.Writer.close body + let grpc_send_streaming ~encode request encoder_stream status_promise = + let body = + H2.Reqd.respond_with_streaming ~flush_headers_immediately:true request + (H2.Response.create + ~headers: + (H2.Headers.of_list [ ("content-type", "application/grpc+proto") ]) + `OK) + in + Seq.iter + (fun input -> + let payload = Grpc.Message.make (encode input) in + H2.Body.Writer.write_string body payload; + H2.Body.Writer.flush body (fun () -> ())) + encoder_stream; + let status = Eio.Promise.await status_promise in + H2.Reqd.schedule_trailers request + (H2.Headers.of_list + ([ + ( "grpc-status", + string_of_int (Grpc.Status.int_of_code (Grpc.Status.code status)) + ); + ] + @ + match Grpc.Status.message status with + | None -> [] + | Some message -> [ ("grpc-message", message) ])); + H2.Body.Writer.close body +end + +module Untyped = struct + let grpc_recv_streaming body message_buffer_writer = + Typed.grpc_recv_streaming ~decode:Fun.id body message_buffer_writer + + let grpc_send_streaming request encoder_stream status_promise = + Typed.grpc_send_streaming ~encode:Fun.id request encoder_stream + status_promise +end diff --git a/lib/grpc-eio/connection.mli b/lib/grpc-eio/connection.mli new file mode 100644 index 0000000..a5d35c8 --- /dev/null +++ b/lib/grpc-eio/connection.mli @@ -0,0 +1,21 @@ +module Typed : sig + val grpc_recv_streaming : + decode:(string -> 'a) -> H2.Body.Reader.t -> 'a Seq.writer -> unit + + val grpc_send_streaming_client : + encode:('a -> string) -> H2.Body.Writer.t -> 'a Seq.reader -> unit + + val grpc_send_streaming : + encode:('a -> string) -> + H2.Reqd.t -> + 'a Seq.reader -> + Grpc.Status.t Eio.Promise.t -> + unit +end + +module Untyped : sig + val grpc_recv_streaming : H2.Body.Reader.t -> string Seq.writer -> unit + + val grpc_send_streaming : + H2.Reqd.t -> string Seq.reader -> Grpc.Status.t Eio.Promise.t -> unit +end diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index 0de65b0..175f87b 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -62,7 +62,7 @@ module Rpc = struct let body = H2.Reqd.request_body reqd in let request_reader, request_writer = Seq.create_reader_writer () in let response_reader, response_writer = Seq.create_reader_writer () in - Connection.grpc_recv_streaming body request_writer; + Connection.Untyped.grpc_recv_streaming body request_writer; let status_promise, status_notify = Eio.Promise.create () in Eio.Fiber.both (fun () -> @@ -71,7 +71,9 @@ module Rpc = struct Seq.close_writer response_writer; Eio.Promise.resolve status_notify status) (fun () -> - try Connection.grpc_send_streaming reqd response_reader status_promise + try + Connection.Untyped.grpc_send_streaming reqd response_reader + status_promise with exn -> (* https://github.com/anmonteiro/ocaml-h2/issues/175 *) Eio.traceln "%s" (Printexc.to_string exn)) @@ -193,6 +195,20 @@ module Typed_rpc = struct in Service.handle_request service) + let bidirectional_streaming (type request response) + (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)) + in + T { rpc_spec; rpc_impl = Rpc.Bidirectional_streaming handler } + let unary (type request response) (rpc_spec : ( request, @@ -235,18 +251,4 @@ module Typed_rpc = struct (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, - 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)) - in - T { rpc_spec; rpc_impl = Rpc.Bidirectional_streaming handler } end From 7121496b6e211a01c9faad42b4af5d18184e5cfd Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sat, 6 Jan 2024 12:47:54 +0100 Subject: [PATCH 14/16] mark call as deprecated to ease transition --- lib/grpc-eio/client.mli | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/lib/grpc-eio/client.mli b/lib/grpc-eio/client.mli index 30243ec..07a3767 100644 --- a/lib/grpc-eio/client.mli +++ b/lib/grpc-eio/client.mli @@ -114,3 +114,14 @@ module Rpc : sig by [service] and [rpc] using the [do_request] function. The [handler] is called when this request is set up to send and receive data. *) end + +val call : + service:string -> + rpc:string -> + ?scheme:string -> + handler:'a Rpc.handler -> + do_request:do_request -> + ?headers:H2.Headers.t -> + unit -> + ('a * Grpc.Status.t, H2.Status.t) result +(** [@@deprecated "This function was renamed [Grpc_eio.Client.Rpc.call]."] *) From 9b80a3a6c8a5197c7f448aacb621f2224f7e08ee Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sat, 6 Jan 2024 15:39:39 +0100 Subject: [PATCH 15/16] implement untyped rpc server on top of typed server --- lib/grpc-eio/client.ml | 10 +- lib/grpc-eio/server.ml | 236 +++++++++++++++++++++------------------- lib/grpc-eio/server.mli | 100 +++++++++-------- 3 files changed, 184 insertions(+), 162 deletions(-) diff --git a/lib/grpc-eio/client.ml b/lib/grpc-eio/client.ml index 512cc29..95d20b2 100644 --- a/lib/grpc-eio/client.ml +++ b/lib/grpc-eio/client.ml @@ -88,7 +88,7 @@ module Typed_rpc = struct 'a let make_handler (type request response) - (rpc : (request, _, response, _) Grpc.Rpc.Client_rpc.t) ~f = + ~(rpc : (request, _, response, _) Grpc.Rpc.Client_rpc.t) ~f = make_handler ~encode_request:rpc.encode_request ~decode_response:rpc.decode_response ~f @@ -99,7 +99,7 @@ module Typed_rpc = struct response, Grpc.Rpc.Value_mode.stream ) Grpc.Rpc.Client_rpc.t) = - make_handler rpc ~f + make_handler ~rpc ~f let client_streaming (type request response) ~f (rpc : @@ -108,7 +108,7 @@ module Typed_rpc = struct response, Grpc.Rpc.Value_mode.unary ) Grpc.Rpc.Client_rpc.t) = - make_handler rpc ~f:(fun request_writer responses -> + make_handler ~rpc ~f:(fun request_writer responses -> let response, response_resolver = Eio.Promise.create () in Eio.Fiber.pair (fun () -> f request_writer response) @@ -124,7 +124,7 @@ module Typed_rpc = struct response, Grpc.Rpc.Value_mode.stream ) Grpc.Rpc.Client_rpc.t) = - make_handler rpc ~f:(fun request_writer responses -> + make_handler ~rpc ~f:(fun request_writer responses -> Seq.write request_writer request; Seq.close_writer request_writer; f responses) @@ -136,7 +136,7 @@ module Typed_rpc = struct response, Grpc.Rpc.Value_mode.unary ) Grpc.Rpc.Client_rpc.t) = - make_handler rpc ~f:(fun request_writer responses -> + make_handler ~rpc ~f:(fun request_writer responses -> Seq.write request_writer request; Seq.close_writer request_writer; let response = Seq.read_and_exhaust responses in diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index 175f87b..b0fdfb9 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -1,6 +1,7 @@ module ServiceMap = Map.Make (String) -type service = H2.Reqd.t -> unit +type reqd_handler = H2.Reqd.t -> unit +type service = reqd_handler type t = service ServiceMap.t let v () = ServiceMap.empty @@ -44,93 +45,50 @@ let handle_request t reqd = | None -> respond_with `Unsupported_media_type) | _ -> respond_with `Not_found -module Rpc = struct - type unary = string -> Grpc.Status.t * string option - type client_streaming = string Seq.t -> Grpc.Status.t * string option - type server_streaming = string -> (string -> unit) -> Grpc.Status.t - - type bidirectional_streaming = - string Seq.t -> (string -> unit) -> Grpc.Status.t - - type t = - | Unary of unary - | Client_streaming of client_streaming - | Server_streaming of server_streaming - | Bidirectional_streaming of bidirectional_streaming - - let bidirectional_streaming ~f reqd = - let body = H2.Reqd.request_body reqd in - let request_reader, request_writer = Seq.create_reader_writer () in - let response_reader, response_writer = Seq.create_reader_writer () in - Connection.Untyped.grpc_recv_streaming body request_writer; - let status_promise, status_notify = Eio.Promise.create () in - Eio.Fiber.both - (fun () -> - let respond = Seq.write response_writer in - let status = f request_reader respond in - Seq.close_writer response_writer; - Eio.Promise.resolve status_notify status) - (fun () -> - try - Connection.Untyped.grpc_send_streaming reqd response_reader - status_promise - with exn -> - (* https://github.com/anmonteiro/ocaml-h2/issues/175 *) - Eio.traceln "%s" (Printexc.to_string exn)) - - let client_streaming ~f reqd = - bidirectional_streaming reqd ~f:(fun requests respond -> - let status, response = f requests in - (match response with None -> () | Some response -> respond response); - status) - - let server_streaming ~f reqd = - bidirectional_streaming reqd ~f:(fun requests respond -> - match Seq.read_and_exhaust requests with - | None -> Grpc.Status.(v OK) - | Some request -> f request respond) - - let unary ~f reqd = - bidirectional_streaming reqd ~f:(fun requests respond -> - match Seq.read_and_exhaust requests with - | None -> Grpc.Status.(v OK) - | Some request -> - let status, response = f request in - (match response with - | None -> () - | Some response -> respond response); - status) -end +let implement_rpc ~decode_request ~encode_response ~f reqd = + let body = H2.Reqd.request_body reqd in + let request_reader, request_writer = Seq.create_reader_writer () in + let response_reader, response_writer = Seq.create_reader_writer () in + Connection.Typed.grpc_recv_streaming ~decode:decode_request body + request_writer; + let status_promise, status_notify = Eio.Promise.create () in + Eio.Fiber.both + (fun () -> + let respond = Seq.write response_writer in + let status = f request_reader respond in + Seq.close_writer response_writer; + Eio.Promise.resolve status_notify status) + (fun () -> + try + Connection.Typed.grpc_send_streaming ~encode:encode_response reqd + response_reader status_promise + with exn -> + (* https://github.com/anmonteiro/ocaml-h2/issues/175 *) + Eio.traceln "%s" (Printexc.to_string exn)) -module Service = struct - module RpcMap = Map.Make (String) +module Typed_rpc = struct + module Service = struct + module RpcMap = Map.Make (String) - type t = Rpc.t RpcMap.t + type t = reqd_handler RpcMap.t - let v () = RpcMap.empty - let add_rpc ~name ~rpc t = RpcMap.add name rpc t + let v () = RpcMap.empty + let add_rpc ~name ~rpc t = RpcMap.add name rpc t - let handle_request (t : t) reqd = - let request = H2.Reqd.request reqd in - let respond_with code = - H2.Reqd.respond_with_string reqd (H2.Response.create code) "" - in - 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 - | Unary f -> Rpc.unary ~f reqd - | Client_streaming f -> Rpc.client_streaming ~f reqd - | Server_streaming f -> Rpc.server_streaming ~f reqd - | Bidirectional_streaming f -> Rpc.bidirectional_streaming ~f reqd) - | None -> respond_with `Not_found - else respond_with `Not_found -end + let handle_request (t : t) reqd = + let request = H2.Reqd.request reqd in + let respond_with code = + H2.Reqd.respond_with_string reqd (H2.Response.create code) "" + in + 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 + match RpcMap.find_opt rpc_name t with + | Some rpc -> rpc reqd + | None -> respond_with `Not_found + else respond_with `Not_found + end -module Typed_rpc = struct type server = t type ('request, 'response) unary = @@ -154,7 +112,7 @@ module Typed_rpc = struct 'response_mode, 'service_spec ) Grpc.Rpc.Server_rpc.t; - rpc_impl : Rpc.t; + rpc_impl : reqd_handler; } -> 'service_spec t @@ -195,6 +153,14 @@ module Typed_rpc = struct in Service.handle_request service) + let implement_rpc (type request response) + ~(rpc_spec : (request, _, response, _, _) Grpc.Rpc.Server_rpc.t) ~f = + let rpc_impl = + implement_rpc ~decode_request:rpc_spec.decode_request + ~encode_response:rpc_spec.encode_response ~f + in + T { rpc_spec; rpc_impl } + let bidirectional_streaming (type request response) (rpc_spec : ( request, @@ -202,12 +168,8 @@ module Typed_rpc = struct 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)) - in - T { rpc_spec; rpc_impl = Rpc.Bidirectional_streaming handler } + Grpc.Rpc.Server_rpc.t) ~f = + implement_rpc ~rpc_spec ~f let unary (type request response) (rpc_spec : @@ -216,12 +178,16 @@ module Typed_rpc = struct 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) - in - T { rpc_spec; rpc_impl = Rpc.Unary handler } + Grpc.Rpc.Server_rpc.t) ~f = + implement_rpc ~rpc_spec ~f:(fun requests respond -> + match Seq.read_and_exhaust requests with + | None -> Grpc.Status.(v OK) + | Some request -> + let status, response = f request in + (match response with + | None -> () + | Some response -> respond response); + status) let server_streaming (type request response) (rpc_spec : @@ -230,12 +196,11 @@ module Typed_rpc = struct 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)) - in - T { rpc_spec; rpc_impl = Rpc.Server_streaming handler } + Grpc.Rpc.Server_rpc.t) ~f = + implement_rpc ~rpc_spec ~f:(fun requests respond -> + match Seq.read_and_exhaust requests with + | None -> Grpc.Status.(v OK) + | Some request -> f request respond) let client_streaming (type request response) (rpc_spec : @@ -244,11 +209,64 @@ module Typed_rpc = struct 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 - (status, Option.map rpc_spec.encode_response response) - in - T { rpc_spec; rpc_impl = Rpc.Client_streaming handler } + Grpc.Rpc.Server_rpc.t) ~f = + implement_rpc ~rpc_spec ~f:(fun requests respond -> + let status, response = f requests in + (match response with None -> () | Some response -> respond response); + status) +end + +module Rpc = struct + type unary = string -> Grpc.Status.t * string option + type client_streaming = string Seq.t -> Grpc.Status.t * string option + type server_streaming = string -> (string -> unit) -> Grpc.Status.t + + type bidirectional_streaming = + string Seq.t -> (string -> unit) -> Grpc.Status.t + + type t = + | Unary of unary + | Client_streaming of client_streaming + | Server_streaming of server_streaming + | Bidirectional_streaming of bidirectional_streaming + + let bidirectional_streaming ~f reqd = + implement_rpc ~decode_request:Fun.id ~encode_response:Fun.id ~f reqd + + let client_streaming ~f reqd = + bidirectional_streaming reqd ~f:(fun requests respond -> + let status, response = f requests in + (match response with None -> () | Some response -> respond response); + status) + + let server_streaming ~f reqd = + bidirectional_streaming reqd ~f:(fun requests respond -> + match Seq.read_and_exhaust requests with + | None -> Grpc.Status.(v OK) + | Some request -> f request respond) + + let unary ~f reqd = + bidirectional_streaming reqd ~f:(fun requests respond -> + match Seq.read_and_exhaust requests with + | None -> Grpc.Status.(v OK) + | Some request -> + let status, response = f request in + (match response with + | None -> () + | Some response -> respond response); + status) +end + +module Service = struct + include Typed_rpc.Service + + let add_rpc ~name ~rpc t = + add_rpc ~name + ~rpc: + (match rpc with + | Rpc.Unary f -> Rpc.unary ~f + | Client_streaming f -> Rpc.client_streaming ~f + | Server_streaming f -> Rpc.server_streaming ~f + | Bidirectional_streaming f -> Rpc.bidirectional_streaming ~f) + t end diff --git a/lib/grpc-eio/server.mli b/lib/grpc-eio/server.mli index 76c000e..1f4be5a 100644 --- a/lib/grpc-eio/server.mli +++ b/lib/grpc-eio/server.mli @@ -1,53 +1,6 @@ include Grpc.Server.S -module Rpc : sig - type unary = string -> Grpc.Status.t * string option - (** [unary] is the type for a unary grpc rpc, one request, one response. *) - - type client_streaming = string Seq.t -> Grpc.Status.t * string option - (** [client_streaming] is the type for an rpc where the client streams the requests and the server responds once. *) - - type server_streaming = string -> (string -> 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 bidirectional_streaming = - string Seq.t -> (string -> unit) -> Grpc.Status.t - (** [bidirectional_streaming] is the type for an rpc where both the client and server can send multiple messages. *) - - type t = - | Unary of unary - | Client_streaming of client_streaming - | Server_streaming of server_streaming - | Bidirectional_streaming of bidirectional_streaming - - (** [t] represents the types of rpcs available in gRPC. *) - - val unary : f:unary -> H2.Reqd.t -> unit - (** [unary ~f reqd] calls [f] with the request obtained from [reqd] and handles sending the response. *) - - val client_streaming : f:client_streaming -> H2.Reqd.t -> unit - (** [client_streaming ~f reqd] calls [f] with a stream to pull requests from and handles sending the response. *) - - val server_streaming : f:server_streaming -> H2.Reqd.t -> unit - (** [server_streaming ~f reqd] calls [f] with the request optained from [reqd] and handles sending the responses pushed out. *) - - val bidirectional_streaming : f:bidirectional_streaming -> H2.Reqd.t -> unit - (** [bidirectional_streaming ~f reqd] calls [f] with a stream to pull requests from and andles sending the responses pushed out. *) -end - -module Service : sig - type t - (** [t] represents a gRPC service with potentially multiple rpcs and the information needed to route to them. *) - - val v : unit -> t - (** [v ()] creates a new service *) - - val add_rpc : name:string -> rpc:Rpc.t -> t -> t - (** [add_rpc ~name ~rpc t] adds [rpc] to [t] and ensures that [t] can route to it with [name]. *) - - val handle_request : t -> H2.Reqd.t -> unit - (** [handle_request t reqd] handles routing [reqd] to the correct rpc if available in [t]. *) -end +(** {1 Typed API} *) module Typed_rpc : sig (** This is an experimental API to build RPCs on the server side. Compared to @@ -133,3 +86,54 @@ module Typed_rpc : sig takes care of registering the services based on the names provided by the protoc specification. *) end + +(** {1 Untyped API} *) + +module Rpc : sig + type unary = string -> Grpc.Status.t * string option + (** [unary] is the type for a unary grpc rpc, one request, one response. *) + + type client_streaming = string Seq.t -> Grpc.Status.t * string option + (** [client_streaming] is the type for an rpc where the client streams the requests and the server responds once. *) + + type server_streaming = string -> (string -> 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 bidirectional_streaming = + string Seq.t -> (string -> unit) -> Grpc.Status.t + (** [bidirectional_streaming] is the type for an rpc where both the client and server can send multiple messages. *) + + type t = + | Unary of unary + | Client_streaming of client_streaming + | Server_streaming of server_streaming + | Bidirectional_streaming of bidirectional_streaming + + (** [t] represents the types of rpcs available in gRPC. *) + + val unary : f:unary -> H2.Reqd.t -> unit + (** [unary ~f reqd] calls [f] with the request obtained from [reqd] and handles sending the response. *) + + val client_streaming : f:client_streaming -> H2.Reqd.t -> unit + (** [client_streaming ~f reqd] calls [f] with a stream to pull requests from and handles sending the response. *) + + val server_streaming : f:server_streaming -> H2.Reqd.t -> unit + (** [server_streaming ~f reqd] calls [f] with the request optained from [reqd] and handles sending the responses pushed out. *) + + val bidirectional_streaming : f:bidirectional_streaming -> H2.Reqd.t -> unit + (** [bidirectional_streaming ~f reqd] calls [f] with a stream to pull requests from and andles sending the responses pushed out. *) +end + +module Service : sig + type t + (** [t] represents a gRPC service with potentially multiple rpcs and the information needed to route to them. *) + + val v : unit -> t + (** [v ()] creates a new service *) + + val add_rpc : name:string -> rpc:Rpc.t -> t -> t + (** [add_rpc ~name ~rpc t] adds [rpc] to [t] and ensures that [t] can route to it with [name]. *) + + val handle_request : t -> H2.Reqd.t -> unit + (** [handle_request t reqd] handles routing [reqd] to the correct rpc if available in [t]. *) +end From 96733179b7ff613af4afb4f984e2c61d58d5d79e Mon Sep 17 00:00:00 2001 From: Mathieu Barbin Date: Sat, 6 Jan 2024 15:41:45 +0100 Subject: [PATCH 16/16] simplify connection (unused untyped api) --- lib/grpc-eio/client.ml | 6 +-- lib/grpc-eio/connection.ml | 100 ++++++++++++++++-------------------- lib/grpc-eio/connection.mli | 33 +++++------- lib/grpc-eio/server.ml | 5 +- 4 files changed, 61 insertions(+), 83 deletions(-) diff --git a/lib/grpc-eio/client.ml b/lib/grpc-eio/client.ml index 95d20b2..7d2aa47 100644 --- a/lib/grpc-eio/client.ml +++ b/lib/grpc-eio/client.ml @@ -69,15 +69,15 @@ let call ~service ~rpc ?(scheme = "https") ~handler ~(do_request : do_request) let make_handler ~encode_request ~decode_response ~f write_body read_body = let response_reader, response_writer = Seq.create_reader_writer () in let request_reader, request_writer = Seq.create_reader_writer () in - Connection.Typed.grpc_recv_streaming ~decode:decode_response read_body + Connection.grpc_recv_streaming ~decode:decode_response read_body response_writer; let res, res_notify = Eio.Promise.create () in Eio.Fiber.both (fun () -> Eio.Promise.resolve res_notify (f request_writer response_reader)) (fun () -> - Connection.Typed.grpc_send_streaming_client ~encode:encode_request - write_body request_reader); + Connection.grpc_send_streaming_client ~encode:encode_request write_body + request_reader); Eio.Promise.await res module Typed_rpc = struct diff --git a/lib/grpc-eio/connection.ml b/lib/grpc-eio/connection.ml index 9fa8292..31f6930 100644 --- a/lib/grpc-eio/connection.ml +++ b/lib/grpc-eio/connection.ml @@ -1,59 +1,47 @@ -module Typed = struct - let grpc_recv_streaming ~decode body message_buffer_writer = - let request_buffer = Grpc.Buffer.v () in - let on_eof () = Seq.close_writer message_buffer_writer in - let rec on_read buffer ~off ~len = - Grpc.Buffer.copy_from_bigstringaf ~src_off:off ~src:buffer - ~dst:request_buffer ~length:len; - Grpc.Message.extract_all - (fun message -> Seq.write message_buffer_writer (decode message)) - request_buffer; - H2.Body.Reader.schedule_read body ~on_read ~on_eof - in +let grpc_recv_streaming ~decode body message_buffer_writer = + let request_buffer = Grpc.Buffer.v () in + let on_eof () = Seq.close_writer message_buffer_writer in + let rec on_read buffer ~off ~len = + Grpc.Buffer.copy_from_bigstringaf ~src_off:off ~src:buffer + ~dst:request_buffer ~length:len; + Grpc.Message.extract_all + (fun message -> Seq.write message_buffer_writer (decode message)) + request_buffer; H2.Body.Reader.schedule_read body ~on_read ~on_eof + in + H2.Body.Reader.schedule_read body ~on_read ~on_eof - let grpc_send_streaming_client ~encode body encoder_stream = - Seq.iter - (fun encoder -> - let payload = Grpc.Message.make (encode encoder) in - H2.Body.Writer.write_string body payload) - encoder_stream; - H2.Body.Writer.close body +let grpc_send_streaming_client ~encode body encoder_stream = + Seq.iter + (fun encoder -> + let payload = Grpc.Message.make (encode encoder) in + H2.Body.Writer.write_string body payload) + encoder_stream; + H2.Body.Writer.close body - let grpc_send_streaming ~encode request encoder_stream status_promise = - let body = - H2.Reqd.respond_with_streaming ~flush_headers_immediately:true request - (H2.Response.create - ~headers: - (H2.Headers.of_list [ ("content-type", "application/grpc+proto") ]) - `OK) - in - Seq.iter - (fun input -> - let payload = Grpc.Message.make (encode input) in - H2.Body.Writer.write_string body payload; - H2.Body.Writer.flush body (fun () -> ())) - encoder_stream; - let status = Eio.Promise.await status_promise in - H2.Reqd.schedule_trailers request - (H2.Headers.of_list - ([ - ( "grpc-status", - string_of_int (Grpc.Status.int_of_code (Grpc.Status.code status)) - ); - ] - @ - match Grpc.Status.message status with - | None -> [] - | Some message -> [ ("grpc-message", message) ])); - H2.Body.Writer.close body -end - -module Untyped = struct - let grpc_recv_streaming body message_buffer_writer = - Typed.grpc_recv_streaming ~decode:Fun.id body message_buffer_writer - - let grpc_send_streaming request encoder_stream status_promise = - Typed.grpc_send_streaming ~encode:Fun.id request encoder_stream - status_promise -end +let grpc_send_streaming ~encode request encoder_stream status_promise = + let body = + H2.Reqd.respond_with_streaming ~flush_headers_immediately:true request + (H2.Response.create + ~headers: + (H2.Headers.of_list [ ("content-type", "application/grpc+proto") ]) + `OK) + in + Seq.iter + (fun input -> + let payload = Grpc.Message.make (encode input) in + H2.Body.Writer.write_string body payload; + H2.Body.Writer.flush body (fun () -> ())) + encoder_stream; + let status = Eio.Promise.await status_promise in + H2.Reqd.schedule_trailers request + (H2.Headers.of_list + ([ + ( "grpc-status", + string_of_int (Grpc.Status.int_of_code (Grpc.Status.code status)) ); + ] + @ + match Grpc.Status.message status with + | None -> [] + | Some message -> [ ("grpc-message", message) ])); + H2.Body.Writer.close body diff --git a/lib/grpc-eio/connection.mli b/lib/grpc-eio/connection.mli index a5d35c8..fee84be 100644 --- a/lib/grpc-eio/connection.mli +++ b/lib/grpc-eio/connection.mli @@ -1,21 +1,12 @@ -module Typed : sig - val grpc_recv_streaming : - decode:(string -> 'a) -> H2.Body.Reader.t -> 'a Seq.writer -> unit - - val grpc_send_streaming_client : - encode:('a -> string) -> H2.Body.Writer.t -> 'a Seq.reader -> unit - - val grpc_send_streaming : - encode:('a -> string) -> - H2.Reqd.t -> - 'a Seq.reader -> - Grpc.Status.t Eio.Promise.t -> - unit -end - -module Untyped : sig - val grpc_recv_streaming : H2.Body.Reader.t -> string Seq.writer -> unit - - val grpc_send_streaming : - H2.Reqd.t -> string Seq.reader -> Grpc.Status.t Eio.Promise.t -> unit -end +val grpc_recv_streaming : + decode:(string -> 'a) -> H2.Body.Reader.t -> 'a Seq.writer -> unit + +val grpc_send_streaming_client : + encode:('a -> string) -> H2.Body.Writer.t -> 'a Seq.reader -> unit + +val grpc_send_streaming : + encode:('a -> string) -> + H2.Reqd.t -> + 'a Seq.reader -> + Grpc.Status.t Eio.Promise.t -> + unit diff --git a/lib/grpc-eio/server.ml b/lib/grpc-eio/server.ml index b0fdfb9..fff6503 100644 --- a/lib/grpc-eio/server.ml +++ b/lib/grpc-eio/server.ml @@ -49,8 +49,7 @@ let implement_rpc ~decode_request ~encode_response ~f reqd = let body = H2.Reqd.request_body reqd in let request_reader, request_writer = Seq.create_reader_writer () in let response_reader, response_writer = Seq.create_reader_writer () in - Connection.Typed.grpc_recv_streaming ~decode:decode_request body - request_writer; + Connection.grpc_recv_streaming ~decode:decode_request body request_writer; let status_promise, status_notify = Eio.Promise.create () in Eio.Fiber.both (fun () -> @@ -60,7 +59,7 @@ let implement_rpc ~decode_request ~encode_response ~f reqd = Eio.Promise.resolve status_notify status) (fun () -> try - Connection.Typed.grpc_send_streaming ~encode:encode_response reqd + Connection.grpc_send_streaming ~encode:encode_response reqd response_reader status_promise with exn -> (* https://github.com/anmonteiro/ocaml-h2/issues/175 *)