diff --git a/dune-project b/dune-project index 9aa108a8..2eb3eb7a 100644 --- a/dune-project +++ b/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) diff --git a/src/twirp_ezcurl/dune b/src/twirp_ezcurl/dune new file mode 100644 index 00000000..1e0eb069 --- /dev/null +++ b/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}))) + diff --git a/src/twirp_ezcurl/twirp_error.ml b/src/twirp_ezcurl/twirp_error.ml new file mode 100644 index 00000000..aaa61116 --- /dev/null +++ b/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) diff --git a/src/twirp_ezcurl/twirp_error.mli b/src/twirp_ezcurl/twirp_error.mli new file mode 100644 index 00000000..4d5e74cc --- /dev/null +++ b/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} *) diff --git a/src/twirp_ezcurl/twirp_error.proto b/src/twirp_ezcurl/twirp_error.proto new file mode 100644 index 00000000..b6e91733 --- /dev/null +++ b/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? diff --git a/src/twirp_ezcurl/twirp_ezcurl.ml b/src/twirp_ezcurl/twirp_ezcurl.ml new file mode 100644 index 00000000..9e1731e1 --- /dev/null +++ b/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 []/[.]/], + see {{:https://twitchtv.github.io/twirp/docs/routing.html} the docs}. + + Errors: [https://twitchtv.github.io/twirp/docs/errors.html] + *) + let url : string = + (* the [.] 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) diff --git a/src/twirp_ezcurl/twirp_ezcurl.mli b/src/twirp_ezcurl/twirp_ezcurl.mli new file mode 100644 index 00000000..54dcacac --- /dev/null +++ b/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. *) diff --git a/twirp_ezcurl.opam b/twirp_ezcurl.opam new file mode 100644 index 00000000..6d19faf7 --- /dev/null +++ b/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 "] +authors: ["Maxime Ransan "] +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"