Merge pull request #254 from talex5/mdx

Update README to use MDX

capnp-rpc-lwt.opam

@@ -21,7 +21,7 @@ depends: [
   "logs"
   "asetmap"
   "uri" {>= "1.6.0"}
-  "dune" {>= "2.0"}
+  "dune" {>= "3.0"}
 ]
 build: [
   ["dune" "build" "-p" name "-j" jobs]

capnp-rpc-mirage.opam

@@ -27,7 +27,7 @@ depends: [
   "io-page-unix" {with-test}
   "mirage-vnetif" {with-test}
   "mirage-crypto-rng" {>= "0.7.0" & with-test}
-  "dune" {>= "2.0"}
+  "dune" {>= "3.0"}
 ]
 build: [
   ["dune" "build" "-p" name "-j" jobs]

capnp-rpc-net.opam

@@ -30,7 +30,7 @@ depends: [
   "asn1-combinators" {>= "0.2.0"}
   "x509" {>= "0.15.0"}
   "tls-mirage"
-  "dune" {>= "2.0"}
+  "dune" {>= "3.0"}
   "mirage-crypto"
   "mirage-crypto-rng"
 ]

capnp-rpc-unix.opam

@@ -19,10 +19,11 @@ depends: [
   "logs"
   "extunix"
   "base64" {>= "3.0.0"}
-  "dune" {>= "2.0"}
+  "dune" {>= "3.0"}
   "alcotest" {>= "1.0.1" & with-test}
   "alcotest-lwt" { >= "1.0.1" & with-test}
   "mirage-crypto-rng" {>= "0.7.0"}
+  "mdx" {with-test}
   "lwt"
   "asetmap" {with-test}
 ]

capnp-rpc.opam

@@ -18,7 +18,7 @@ depends: [
   "fmt" {>= "0.8.7"}
   "logs"
   "asetmap"
-  "dune" {>= "2.0"}
+  "dune" {>= "3.0"}
   "alcotest" {with-test & >= "1.0.1"}
   "afl-persistent" {with-test}
 ]

dune

@@ -0,0 +1,8 @@
+(mdx
+ (package capnp-rpc-unix)
+ (files README.md)
+ (preludes examples/prelude.ml)
+ (enabled_if (<> %{os_type} "Win32"))
+ (deps
+  (source_tree examples)
+  (package capnp-rpc-unix)))

dune-project

@@ -1,5 +1,7 @@
-(lang dune 2.0)
+(lang dune 3.0)
 
 (name capnp-rpc)
 
 (formatting disabled)
+
+(using mdx 0.2)

examples/dune

@@ -1,14 +1,10 @@
-(library
- (name examples)
- (libraries astring capnp-rpc-lwt capnp-rpc-net)
- (flags :standard -w -53-55))
-
-(rule
- (targets test_api.ml test_api.mli)
- (deps test_api.capnp)
- (action (run capnp compile -o %{bin:capnpc-ocaml} %{deps})))
-
-(rule
- (targets calculator.ml calculator.mli)
- (deps calculator.capnp)
- (action (run capnp compile -o %{bin:capnpc-ocaml} %{deps})))
+(data_only_dirs
+  v1
+  v2
+  v3
+  v4
+  pipelining
+  sturdy-refs
+  sturdy-refs-2
+  sturdy-refs-3
+  sturdy-refs-4)

examples/pipelining/dune

@@ -0,0 +1,9 @@
+(executable
+ (name main)
+ (libraries lwt.unix capnp-rpc-unix logs.fmt)
+ (flags (:standard -w -53-55)))
+
+(rule
+ (targets echo_api.ml echo_api.mli)
+ (deps    echo_api.capnp)
+ (action (run capnp compile -o %{bin:capnpc-ocaml} %{deps})))

examples/pipelining/dune-project

@@ -0,0 +1,3 @@
+(lang dune 2.9)
+(name capnp-rpc-demo)
+(formatting disabled)

examples/pipelining/echo.ml

@@ -0,0 +1,99 @@
+module Api = Echo_api.MakeRPC(Capnp_rpc_lwt)
+
+open Lwt.Infix
+open Capnp_rpc_lwt
+
+module Callback = struct
+  let local fn =
+    let module Callback = Api.Service.Callback in
+    Callback.local @@ object
+      inherit Callback.service
+
+      method log_impl params release_param_caps =
+        let open Callback.Log in
+        let msg = Params.msg_get params in
+        release_param_caps ();
+        fn msg;
+        Service.return_empty ()
+    end
+
+  module Callback = Api.Client.Callback
+
+  let log t msg =
+    let open Callback.Log in
+    let request, params = Capability.Request.create Params.init_pointer in
+    Params.msg_set params msg;
+    Capability.call_for_unit t method_id request
+end
+
+let (>>!=) = Lwt_result.bind		(* Return errors *)
+
+let notify callback ~msg =
+  let rec loop = function
+    | 0 ->
+      Lwt.return @@ Ok (Service.Response.create_empty ())
+    | i ->
+      Callback.log callback msg >>!= fun () ->
+      Lwt_unix.sleep 1.0 >>= fun () ->
+      loop (i - 1)
+  in
+  loop 3
+
+let service_logger =
+  Callback.local (Printf.printf "[server] Received %S\n%!")
+
+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
+
+    method heartbeat_impl params release_params =
+      let open Echo.Heartbeat in
+      let msg = Params.msg_get params in
+      let callback = Params.callback_get params in
+      release_params ();
+      match callback with
+      | None -> Service.fail "No callback parameter!"
+      | Some callback ->
+        Service.return_lwt @@ fun () ->
+        Capability.with_ref callback (notify ~msg)
+
+    (* $MDX part-begin=server-get-logger *)
+    method get_logger_impl _ release_params =
+      let open Echo.GetLogger in
+      release_params ();
+      let response, results = Service.Response.create Results.init_pointer in
+      Results.callback_set results (Some service_logger);
+      Service.return response
+    (* $MDX part-end *)
+  end
+
+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
+
+let heartbeat t msg callback =
+  let open Echo.Heartbeat in
+  let request, params = Capability.Request.create Params.init_pointer in
+  Params.msg_set params msg;
+  Params.callback_set params (Some callback);
+  Capability.call_for_unit_exn t method_id request
+
+(* $MDX part-begin=client-get-logger *)
+let get_logger t =
+  let open Echo.GetLogger in
+  let request = Capability.Request.create_no_args () in
+  Capability.call_for_caps t method_id request Results.callback_get_pipelined
+(* $MDX part-end *)

examples/pipelining/echo_api.capnp

@@ -0,0 +1,11 @@
+@0xb287252b6cbed46e;
+
+interface Callback {
+  log @0 (msg :Text) -> ();
+}
+
+interface Echo {
+  ping      @0 (msg :Text) -> (reply :Text);
+  heartbeat @1 (msg :Text, callback :Callback) -> ();
+  getLogger @2 () -> (callback :Callback);
+}

examples/pipelining/main.ml

@@ -0,0 +1,37 @@
+open Lwt.Infix
+open Capnp_rpc_lwt
+
+let () =
+  Logs.set_level (Some Logs.Warning);
+  Logs.set_reporter (Logs_fmt.reporter ())
+
+let callback_fn msg =
+  Fmt.pr "Callback got %S@." msg
+
+(* $MDX part-begin=run-client *)
+let run_client service =
+  let logger = Echo.get_logger service in
+  Echo.Callback.log logger "Message from client" >|= function
+  | Ok () -> ()
+  | Error (`Capnp err) ->
+    Fmt.epr "Server's logger failed: %a" Capnp_rpc.Error.pp err
+(* $MDX part-end *)
+
+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 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 "[client] Connecting to echo service...@.";
+    let client_vat = Capnp_rpc_unix.client_only_vat () in
+    let sr = Capnp_rpc_unix.Vat.import_exn client_vat uri in
+    Sturdy_ref.with_cap_exn sr run_client
+  end

examples/prelude.ml

@@ -0,0 +1,21 @@
+(* Pre-build demos to avoid capnp compiler warnings about PWD *)
+
+#require "unix";;
+
+let examples = [
+  "v1";
+  "v2";
+  "v3";
+  "v4";
+  "pipelining";
+  "sturdy-refs";
+  "sturdy-refs-2";
+  "sturdy-refs-3";
+  "sturdy-refs-4";
+]
+
+let () =
+  examples |> List.iter (fun ex ->
+      let cmd = Printf.sprintf "cd 'examples/%s' && dune build ./main.exe" ex in
+      ignore (Unix.system cmd : Unix.process_status)
+    )

examples/sturdy-refs-2/api.capnp

@@ -0,0 +1,6 @@
+@0x9ab198a53301be6e;
+
+interface Logger {
+  log @0 (msg :Text) -> ();
+  sub @1 (label :Text) -> (logger :Logger);
+}

examples/sturdy-refs-2/dune

@@ -0,0 +1,9 @@
+(executable
+ (name main)
+ (libraries lwt.unix capnp-rpc-unix logs.fmt)
+ (flags (:standard -w -53-55)))
+
+(rule
+ (targets api.ml api.mli)
+ (deps    api.capnp)
+ (action (run capnp compile -o %{bin:capnpc-ocaml} %{deps})))

examples/sturdy-refs-2/dune-project

@@ -0,0 +1,3 @@
+(lang dune 2.9)
+(name capnp-rpc-demo)
+(formatting disabled)

examples/sturdy-refs-2/logger.ml

@@ -0,0 +1,40 @@
+module Api = Api.MakeRPC(Capnp_rpc_lwt)
+
+open Capnp_rpc_lwt
+
+let rec local label =
+  let module Logger = Api.Service.Logger in
+  Logger.local @@ object
+    inherit Logger.service
+
+    method log_impl params release_param_caps =
+      let open Logger.Log in
+      let msg = Params.msg_get params in
+      release_param_caps ();
+      Printf.printf "[server] %S says %S\n%!" label msg;
+      Service.return_empty ()
+
+    method sub_impl params release_param_caps =
+      let open Logger.Sub in
+      let sub_label = Params.label_get params in
+      release_param_caps ();
+      let sub = local (Printf.sprintf "%s/%s" label sub_label) in
+      let response, results = Service.Response.create Results.init_pointer in
+      Results.logger_set results (Some sub);
+      Capability.dec_ref sub;
+      Service.return response
+  end
+
+module Logger = Api.Client.Logger
+
+let log t msg =
+  let open Logger.Log in
+  let request, params = Capability.Request.create Params.init_pointer in
+  Params.msg_set params msg;
+  Capability.call_for_unit_exn t method_id request
+
+let sub t label =
+  let open Logger.Sub in
+  let request, params = Capability.Request.create Params.init_pointer in
+  Params.label_set params label;
+  Capability.call_for_caps t method_id request Results.logger_get_pipelined

examples/sturdy-refs-2/main.ml

@@ -0,0 +1,41 @@
+open Lwt.Infix
+open Capnp_rpc_lwt
+
+module Restorer = Capnp_rpc_net.Restorer
+
+let () =
+  Logs.set_level (Some Logs.Warning);
+  Logs.set_reporter (Logs_fmt.reporter ())
+
+let secret_key = `Ephemeral
+let listen_address = `TCP ("127.0.0.1", 7000)
+
+let or_fail = function
+  | Ok x -> x
+  | Error (`Msg m) -> failwith m
+
+let start_server () =
+  let config = Capnp_rpc_unix.Vat_config.create ~secret_key listen_address in
+  let make_sturdy = Capnp_rpc_unix.Vat_config.sturdy_uri config in
+  let services = Restorer.Table.create make_sturdy in
+  let restore = Restorer.of_table services in
+  let root_id = Capnp_rpc_unix.Vat_config.derived_id config "root" in
+  let root = Logger.local "root" in
+  Restorer.Table.add services root_id root;
+  Capnp_rpc_unix.serve config ~restore >|= fun _vat ->
+  Capnp_rpc_unix.Vat_config.sturdy_uri config root_id
+
+(* $MDX part-begin=main *)
+let () =
+  Lwt_main.run begin
+    start_server () >>= fun root_uri ->
+    let vat = Capnp_rpc_unix.client_only_vat () in
+    let root_sr = Capnp_rpc_unix.Vat.import vat root_uri |> or_fail in
+    Sturdy_ref.with_cap_exn root_sr @@ fun root ->
+    Logger.log root "Message from Admin" >>= fun () ->
+    let for_alice = Logger.sub root "alice" in
+    let for_bob = Logger.sub root "bob" in
+    Logger.log for_alice "Message from Alice" >>= fun () ->
+    Logger.log for_bob "Message from Bob"
+  end
+(* $MDX part-end *)

examples/sturdy-refs-3/api.capnp

@@ -0,0 +1,6 @@
+@0x9ab198a53301be6e;
+
+interface Logger {
+  log @0 (msg :Text) -> ();
+  sub @1 (label :Text) -> (logger :Logger);
+}

examples/sturdy-refs-3/dune

@@ -0,0 +1,9 @@
+(executable
+ (name main)
+ (libraries lwt.unix capnp-rpc-unix logs.fmt)
+ (flags (:standard -w -53-55)))
+
+(rule
+ (targets api.ml api.mli)
+ (deps    api.capnp)
+ (action (run capnp compile -o %{bin:capnpc-ocaml} %{deps})))