add twirp-ezcurl, a basic client for twirp

dune-project

@@ -41,6 +41,14 @@
     (pbrt_yojson (= :version)))
   (tags (protobuf encode decode services rpc)))
 
+(package
+  (name twirp_ezcurl)
+  (synopsis "Twirp client implementation using ezcurl")
+  (depends
+    (pbrt (= :version))
+    (pbrt_services (= :version))
+    yojson
+    ezcurl))
 
 (package
   (name twirp_tiny_httpd)

src/twirp_ezcurl/dune

@@ -0,0 +1,14 @@
+
+(library
+ (name twirp_ezcurl)
+ (public_name twirp_ezcurl)
+ (synopsis "Twirp client")
+ (wrapped true)
+ (libraries pbrt pbrt_yojson yojson pbrt_services ezcurl))
+
+(rule
+  (targets twirp_error.ml twirp_error.mli)
+  (deps (:file twirp_error.proto))
+  (mode promote)
+  (action (run ../ocaml-protoc/ocaml_protoc.exe --pp --yojson --ml_out=. %{file})))
+

src/twirp_ezcurl/twirp_error.ml

@@ -0,0 +1,68 @@
+[@@@ocaml.warning "-27-30-39"]
+
+type error = {
+  code : string;
+  msg : string;
+}
+
+let rec default_error 
+  ?code:((code:string) = "")
+  ?msg:((msg:string) = "")
+  () : error  = {
+  code;
+  msg;
+}
+
+type error_mutable = {
+  mutable code : string;
+  mutable msg : string;
+}
+
+let default_error_mutable () : error_mutable = {
+  code = "";
+  msg = "";
+}
+
+[@@@ocaml.warning "-27-30-39"]
+
+(** {2 Formatters} *)
+
+let rec pp_error fmt (v:error) = 
+  let pp_i fmt () =
+    Pbrt.Pp.pp_record_field ~first:true "code" Pbrt.Pp.pp_string fmt v.code;
+    Pbrt.Pp.pp_record_field ~first:false "msg" Pbrt.Pp.pp_string fmt v.msg;
+  in
+  Pbrt.Pp.pp_brk pp_i fmt ()
+
+[@@@ocaml.warning "-27-30-39"]
+
+(** {2 Protobuf YoJson Encoding} *)
+
+let rec encode_json_error (v:error) = 
+  let assoc = [] in 
+  let assoc = ("code", Pbrt_yojson.make_string v.code) :: assoc in
+  let assoc = ("msg", Pbrt_yojson.make_string v.msg) :: assoc in
+  `Assoc assoc
+
+[@@@ocaml.warning "-27-30-39"]
+
+(** {2 JSON Decoding} *)
+
+let rec decode_json_error d =
+  let v = default_error_mutable () in
+  let assoc = match d with
+    | `Assoc assoc -> assoc
+    | _ -> assert(false)
+  in
+  List.iter (function 
+    | ("code", json_value) -> 
+      v.code <- Pbrt_yojson.string json_value "error" "code"
+    | ("msg", json_value) -> 
+      v.msg <- Pbrt_yojson.string json_value "error" "msg"
+
+    | (_, _) -> () (*Unknown fields are ignored*)
+  ) assoc;
+  ({
+    code = v.code;
+    msg = v.msg;
+  } : error)

src/twirp_ezcurl/twirp_error.mli

@@ -0,0 +1,44 @@
+
+(** Code for twirp_error.proto *)
+
+(* generated from "twirp_error.proto", do not edit *)
+
+
+
+(** {2 Types} *)
+
+type error = {
+  code : string;
+  msg : string;
+}
+
+
+(** {2 Basic values} *)
+
+val default_error : 
+  ?code:string ->
+  ?msg:string ->
+  unit ->
+  error
+(** [default_error ()] is the default value for type [error] *)
+
+
+(** {2 Formatters} *)
+
+val pp_error : Format.formatter -> error -> unit 
+(** [pp_error v] formats v *)
+
+
+(** {2 Protobuf YoJson Encoding} *)
+
+val encode_json_error : error -> Yojson.Basic.t
+(** [encode_json_error v encoder] encodes [v] to to json *)
+
+
+(** {2 JSON Decoding} *)
+
+val decode_json_error : Yojson.Basic.t -> error
+(** [decode_json_error decoder] decodes a [error] value from [decoder] *)
+
+
+(** {2 Services} *)

src/twirp_ezcurl/twirp_error.proto

@@ -0,0 +1,11 @@
+syntax = "proto3";
+
+message error {
+  // Error code
+  string code = 1;
+
+  // Human readable message
+  string msg = 2;
+}
+
+// TODO: meta?

src/twirp_ezcurl/twirp_ezcurl.ml

@@ -0,0 +1,99 @@
+open Pbrt_services
+module Twirp_error = Twirp_error
+
+let spf = Printf.sprintf
+
+type error = Twirp_error.error
+
+let pp_error = Twirp_error.pp_error
+
+let decode_error exn : error =
+  {
+    Twirp_error.code = "decoding error";
+    msg = spf "decoding response failed with: %s" (Printexc.to_string exn);
+  }
+
+let unknown_error msg : error =
+  {
+    Twirp_error.code = "unknown";
+    msg = spf "call failed with unknown reason: %s" msg;
+  }
+
+let call ?(client : Ezcurl.t = Ezcurl.make ())
+    ?(encoding : [ `JSON | `BINARY ] = `BINARY) ?(prefix = Some "twirp")
+    ?(use_tls = true) ~host ~port
+    (rpc : ('req, Value_mode.unary, 'res, Value_mode.unary) Client.rpc)
+    (req : 'req) : ('res, error) result =
+  (* first, encode query *)
+  let (req_data : string), content_type =
+    match encoding with
+    | `JSON ->
+      let data = rpc.encode_json_req req |> Yojson.Basic.to_string in
+      data, "application/json"
+    | `BINARY ->
+      let enc = Pbrt.Encoder.create () in
+      rpc.encode_pb_req req enc;
+      Pbrt.Encoder.to_string enc, "application/protobuf"
+  in
+
+  (* Compute remote URL.
+     Routing is done via:
+     [POST [<prefix>]/[<package>.]<Service>/<Method>],
+     see {{:https://twitchtv.github.io/twirp/docs/routing.html} the docs}.
+
+     Errors: [https://twitchtv.github.io/twirp/docs/errors.html]
+  *)
+  let url : string =
+    (* the [<package>.<Service>] part. *)
+    let qualified_service_path_component =
+      match rpc.package with
+      | [] -> rpc.service_name
+      | path -> spf "%s.%s" (String.concat "." path) rpc.service_name
+    in
+
+    let prefix =
+      match prefix with
+      | None -> ""
+      | Some p -> spf "%s/" p
+    in
+
+    let protocol =
+      if use_tls then
+        "https"
+      else
+        "http"
+    in
+    spf "%s://%s:%d/%s%s/%s" protocol host port prefix
+      qualified_service_path_component rpc.rpc_name
+  in
+
+  Printf.printf "url: %S\n" url;
+
+  let headers = [ "content-type", content_type ] in
+
+  let res : _ result =
+    Ezcurl.post ~client ~url ~params:[] ~content:(`String req_data) ~headers ()
+  in
+
+  match res with
+  | Ok { code; body; headers = _; _ } when code >= 200 && code < 300 ->
+    (* success *)
+    (match
+       match encoding with
+       | `JSON -> rpc.decode_json_res (Yojson.Basic.from_string body)
+       | `BINARY -> rpc.decode_pb_res (Pbrt.Decoder.of_string body)
+     with
+    | res -> Ok res
+    | exception exn -> Error (decode_error exn))
+  | Ok { body; headers = _; _ } ->
+    (match Twirp_error.decode_json_error @@ Yojson.Basic.from_string body with
+    | err -> Error err
+    | exception exn -> Error (decode_error exn))
+  | Error _ -> Error (unknown_error "http call failed")
+
+exception E_twirp of error
+
+let call_exn ?client ?encoding ?prefix ?use_tls ~host ~port rpc req =
+  match call ?client ?encoding ?prefix ?use_tls ~host ~port rpc req with
+  | Ok x -> x
+  | Error err -> raise (E_twirp err)

src/twirp_ezcurl/twirp_ezcurl.mli

@@ -0,0 +1,31 @@
+module Twirp_error = Twirp_error
+open Pbrt_services
+
+type error = Twirp_error.error
+
+val pp_error : Format.formatter -> error -> unit
+
+val call :
+  ?client:Ezcurl.t ->
+  ?encoding:[ `JSON | `BINARY ] ->
+  ?prefix:string option ->
+  ?use_tls:bool ->
+  host:string ->
+  port:int ->
+  ('req, Value_mode.unary, 'res, Value_mode.unary) Client.rpc ->
+  'req ->
+  ('res, error) result
+
+exception E_twirp of error
+
+val call_exn :
+  ?client:Ezcurl.t ->
+  ?encoding:[ `JSON | `BINARY ] ->
+  ?prefix:string option ->
+  ?use_tls:bool ->
+  host:string ->
+  port:int ->
+  ('req, Value_mode.unary, 'res, Value_mode.unary) Client.rpc ->
+  'req ->
+  'res
+(** Same as {!call} but raises [E_twirp] on failure. *)

twirp_ezcurl.opam

@@ -0,0 +1,31 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "2.4"
+synopsis: "Twirp client implementation using ezcurl"
+maintainer: ["Maxime Ransan <[email protected]>"]
+authors: ["Maxime Ransan <[email protected]>"]
+license: "MIT"
+homepage: "https://github.com/mransan/ocaml-protoc"
+bug-reports: "https://github.com/mransan/ocaml-protoc/issues"
+depends: [
+  "dune" {>= "2.0"}
+  "pbrt" {= version}
+  "pbrt_services" {= version}
+  "yojson"
+  "ezcurl"
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/mransan/ocaml-protoc.git"