From a8f38f1938c8cc7e7cb000180e3ffaf903721dd9 Mon Sep 17 00:00:00 2001 From: Chris Jensen Date: Fri, 8 May 2020 13:02:42 +0100 Subject: [PATCH 1/5] Add echo benchmark test --- test-bin/echo/dune | 10 ++++++++ test-bin/echo/echo.ml | 29 +++++++++++++++++++++++ test-bin/echo/echo_api.capnp | 5 ++++ test-bin/echo/echo_bench.ml | 46 ++++++++++++++++++++++++++++++++++++ 4 files changed, 90 insertions(+) create mode 100644 test-bin/echo/dune create mode 100755 test-bin/echo/echo.ml create mode 100755 test-bin/echo/echo_api.capnp create mode 100755 test-bin/echo/echo_bench.ml diff --git a/test-bin/echo/dune b/test-bin/echo/dune new file mode 100644 index 00000000..ecfebf52 --- /dev/null +++ b/test-bin/echo/dune @@ -0,0 +1,10 @@ +(executable + (name echo_bench) + (libraries lwt.unix capnp-rpc capnp-rpc-lwt capnp-rpc-net capnp-rpc-unix logs.fmt) + (preprocess (pps lwt_ppx)) + (flags (:standard -w -53-55))) + +(rule + (targets echo_api.ml echo_api.mli) + (deps echo_api.capnp) + (action (run capnpc -o %{bin:capnpc-ocaml} %{deps}))) diff --git a/test-bin/echo/echo.ml b/test-bin/echo/echo.ml new file mode 100755 index 00000000..f94e58a6 --- /dev/null +++ b/test-bin/echo/echo.ml @@ -0,0 +1,29 @@ +module Api = Echo_api.MakeRPC(Capnp_rpc_lwt) + +open Lwt.Infix +open Capnp_rpc_lwt + +(*-- Server ----------------------------------------*) +let local = + let module Echo = Api.Service.Echo in + + Echo.local @@ object + inherit Echo.service + + method ping_impl params release_param_caps = + let open Echo.Ping in + let msg = Params.msg_get params in + release_param_caps (); + let response, results = Service.Response.create Results.init_pointer in + Results.reply_set results ("echo:" ^ msg); + Service.return response + end + +(*-- Client ----------------------------------------*) +module Echo = Api.Client.Echo + +let ping t msg = + let open Echo.Ping in + let request, params = Capability.Request.create Params.init_pointer in + Params.msg_set params msg; + Capability.call_for_value_exn t method_id request >|= Results.reply_get diff --git a/test-bin/echo/echo_api.capnp b/test-bin/echo/echo_api.capnp new file mode 100755 index 00000000..b7faa07a --- /dev/null +++ b/test-bin/echo/echo_api.capnp @@ -0,0 +1,5 @@ +@0xb13fc2f2a4c1d65b; + +interface Echo { + ping @0 (msg :Text) -> (reply :Text); +} diff --git a/test-bin/echo/echo_bench.ml b/test-bin/echo/echo_bench.ml new file mode 100755 index 00000000..6a3da064 --- /dev/null +++ b/test-bin/echo/echo_bench.ml @@ -0,0 +1,46 @@ + +open Lwt.Infix + +open Capnp_rpc_lwt + +let () = + Logs.set_level (Some Logs.Info); + Logs.set_reporter (Logs_fmt.reporter ()) + +let rec create_for v = function + | 0. -> [] + | n -> v n :: (create_for v (n-.1.)) + +let run_client service = + let n = 100000. in + let ops = n |> create_for (fun i -> + fun () -> + let%lwt res = Echo.ping service (Float.to_string i) in + Lwt.return (res = "echo:" ^ (Float.to_string i)) + ) in + let st = Unix.gettimeofday () in + let%lwt _res = Lwt_list.map_p (fun v -> v ()) ops in + let ed = Unix.gettimeofday () in + let rate = n /. (ed -. st) in + Logs.info (fun m -> m "rate = %f" rate ); + Lwt.return_unit + +let secret_key = `Ephemeral +let listen_address = `TCP ("127.0.0.1", 7000) + +let start_server () = + let config = Capnp_rpc_unix.Vat_config.create ~secret_key ~serve_tls:false listen_address in + let service_id = Capnp_rpc_unix.Vat_config.derived_id config "main" in + let restore = Capnp_rpc_net.Restorer.single service_id Echo.local in + Capnp_rpc_unix.serve config ~restore >|= fun vat -> + Capnp_rpc_unix.Vat.sturdy_uri vat service_id + +let () = + Lwt_main.run begin + start_server () >>= fun uri -> + Fmt.pr "Connecting to echo service at: %a@." Uri.pp_hum uri; + let client_vat = Capnp_rpc_unix.client_only_vat () in + let sr = Capnp_rpc_unix.Vat.import_exn client_vat uri in + let%lwt proxy = Sturdy_ref.connect_exn sr in + run_client proxy + end From 10bda38c8f40569435ef14bd53569577ab581817 Mon Sep 17 00:00:00 2001 From: Chris Jensen Date: Sat, 9 May 2020 15:44:34 +0100 Subject: [PATCH 2/5] Remove lwt ppx --- test-bin/echo/dune | 1 - test-bin/echo/echo_bench.ml | 6 +++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/test-bin/echo/dune b/test-bin/echo/dune index ecfebf52..2a4fd0bc 100644 --- a/test-bin/echo/dune +++ b/test-bin/echo/dune @@ -1,7 +1,6 @@ (executable (name echo_bench) (libraries lwt.unix capnp-rpc capnp-rpc-lwt capnp-rpc-net capnp-rpc-unix logs.fmt) - (preprocess (pps lwt_ppx)) (flags (:standard -w -53-55))) (rule diff --git a/test-bin/echo/echo_bench.ml b/test-bin/echo/echo_bench.ml index 6a3da064..21e731e5 100755 --- a/test-bin/echo/echo_bench.ml +++ b/test-bin/echo/echo_bench.ml @@ -15,11 +15,11 @@ let run_client service = let n = 100000. in let ops = n |> create_for (fun i -> fun () -> - let%lwt res = Echo.ping service (Float.to_string i) in + Echo.ping service (Float.to_string i) >>= fun res -> Lwt.return (res = "echo:" ^ (Float.to_string i)) ) in let st = Unix.gettimeofday () in - let%lwt _res = Lwt_list.map_p (fun v -> v ()) ops in + Lwt_list.map_p (fun v -> v ()) ops >>= fun _ -> let ed = Unix.gettimeofday () in let rate = n /. (ed -. st) in Logs.info (fun m -> m "rate = %f" rate ); @@ -41,6 +41,6 @@ let () = Fmt.pr "Connecting to echo service at: %a@." Uri.pp_hum uri; let client_vat = Capnp_rpc_unix.client_only_vat () in let sr = Capnp_rpc_unix.Vat.import_exn client_vat uri in - let%lwt proxy = Sturdy_ref.connect_exn sr in + Sturdy_ref.connect_exn sr >>= fun proxy -> run_client proxy end From 00aa0f3f450a5d91f0710e1288ad58ce68be5574 Mon Sep 17 00:00:00 2001 From: Chris Jensen Date: Sat, 9 May 2020 16:08:36 +0100 Subject: [PATCH 3/5] Add empty mli to look for unused values --- test-bin/echo/echo_bench.mli | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 test-bin/echo/echo_bench.mli diff --git a/test-bin/echo/echo_bench.mli b/test-bin/echo/echo_bench.mli new file mode 100644 index 00000000..e69de29b From 89bd7a32af4480fefb972194fbecc90d42c43a4e Mon Sep 17 00:00:00 2001 From: Chris Jensen Date: Sat, 9 May 2020 16:09:28 +0100 Subject: [PATCH 4/5] Use List.init instead of create_for, move setup code out of critical path --- test-bin/echo/echo_bench.ml | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/test-bin/echo/echo_bench.ml b/test-bin/echo/echo_bench.ml index 21e731e5..24a2cbed 100755 --- a/test-bin/echo/echo_bench.ml +++ b/test-bin/echo/echo_bench.ml @@ -7,21 +7,19 @@ let () = Logs.set_level (Some Logs.Info); Logs.set_reporter (Logs_fmt.reporter ()) -let rec create_for v = function - | 0. -> [] - | n -> v n :: (create_for v (n-.1.)) - let run_client service = - let n = 100000. in - let ops = n |> create_for (fun i -> + let n = 100000 in + let ops = List.init n (fun i -> + let payload = Int.to_string i in + let desired_result = "echo:" ^ payload in fun () -> - Echo.ping service (Float.to_string i) >>= fun res -> - Lwt.return (res = "echo:" ^ (Float.to_string i)) + Echo.ping service payload >>= fun res -> + Lwt.return (res = desired_result) ) in let st = Unix.gettimeofday () in Lwt_list.map_p (fun v -> v ()) ops >>= fun _ -> let ed = Unix.gettimeofday () in - let rate = n /. (ed -. st) in + let rate = (Int.to_float n) /. (ed -. st) in Logs.info (fun m -> m "rate = %f" rate ); Lwt.return_unit From 74c7470e967668e7fecf4ea7af0bd450f4569ea6 Mon Sep 17 00:00:00 2001 From: Chris Jensen Date: Mon, 11 May 2020 10:26:28 +0100 Subject: [PATCH 5/5] Apply suggestions from code review Ensure that the result is as expected. Co-authored-by: Thomas Leonard --- test-bin/echo/echo_bench.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test-bin/echo/echo_bench.ml b/test-bin/echo/echo_bench.ml index 24a2cbed..692261fd 100755 --- a/test-bin/echo/echo_bench.ml +++ b/test-bin/echo/echo_bench.ml @@ -13,11 +13,11 @@ let run_client service = let payload = Int.to_string i in let desired_result = "echo:" ^ payload in fun () -> - Echo.ping service payload >>= fun res -> - Lwt.return (res = desired_result) + Echo.ping service payload >|= fun res -> + assert (res = desired_result) ) in let st = Unix.gettimeofday () in - Lwt_list.map_p (fun v -> v ()) ops >>= fun _ -> + Lwt_list.iter_p (fun v -> v ()) ops >>= fun () -> let ed = Unix.gettimeofday () in let rate = (Int.to_float n) /. (ed -. st) in Logs.info (fun m -> m "rate = %f" rate );