From d539072f1b47b0f981bd1a8e77d47c436484409c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sun, 11 Feb 2018 19:17:40 +0100 Subject: [PATCH] Proto/env: export `RPC_context` --- src/lib_base/protocol_environment.ml | 67 +++++++++++++++++++ src/lib_base/protocol_environment.mli | 1 + src/lib_protocol_environment_sigs/jbuild | 1 + .../v1/RPC_context.mli | 55 +++++++++++++++ .../v1/error_monad.mli | 6 ++ 5 files changed, 130 insertions(+) create mode 100644 src/lib_protocol_environment_sigs/v1/RPC_context.mli diff --git a/src/lib_base/protocol_environment.ml b/src/lib_base/protocol_environment.ml index 1cd452011..782486dc3 100644 --- a/src/lib_base/protocol_environment.ml +++ b/src/lib_base/protocol_environment.ml @@ -131,6 +131,7 @@ module type V1 = sig and type Data_encoding.json_schema = Data_encoding.json_schema and type RPC_service.meth = RPC_service.meth and type (+'m,'pr,'p,'q,'i,'o) RPC_service.t = ('m,'pr,'p,'q,'i,'o) RPC_service.t + and type Error_monad.shell_error = Error_monad.error type error += Ecoproto_error of Error_monad.error list val wrap_error : 'a Error_monad.tzresult -> 'a tzresult @@ -184,6 +185,8 @@ module MakeV1 module Ed25519 = Ed25519 module S = S module Error_monad = struct + type 'a shell_tzresult = 'a Error_monad.tzresult + type shell_error = Error_monad.error = .. type error_category = [ `Branch | `Temporary | `Permanent ] include Error_monad.Make() end @@ -312,6 +315,70 @@ module MakeV1 let lwt_register4 root s f = lwt_register root s (curry (S (S (S (S Z)))) f) let lwt_register5 root s f = lwt_register root s (curry (S (S (S (S (S Z))))) f) + end + module RPC_context = struct + + type t = Updater.rpc_context Lwt.t + + class type ['pr] simple = object + method call_proto_service0 : + 'm 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, t, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + method call_proto_service1 : + 'm 'a 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, t * 'a, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'a -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + method call_proto_service2 : + 'm 'a 'b 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'a -> 'b -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + method call_proto_service3 : + 'm 'a 'b 'c 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + end + + let make_call0 s (ctxt : _ simple) = + ctxt#call_proto_service0 s + let make_call0 = (make_call0 : _ -> _ simple -> _ :> _ -> _ #simple -> _) + + let make_call1 s (ctxt: _ simple) = + ctxt#call_proto_service1 s + let make_call1 = (make_call1 : _ -> _ simple -> _ :> _ -> _ #simple -> _) + + let make_call2 s (ctxt: _ simple) = + ctxt#call_proto_service2 s + let make_call2 = (make_call2 : _ -> _ simple -> _ :> _ -> _ #simple -> _) + + let make_call3 s (ctxt: _ simple) = + ctxt#call_proto_service3 s + let make_call3 = (make_call3 : _ -> _ simple -> _ :> _ -> _ #simple -> _) + + let make_opt_call0 s ctxt block q i = + make_call0 s ctxt block q i >>= function + | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) + | Error _ as v -> Lwt.return v + | Ok v -> Lwt.return (Ok (Some v)) + + let make_opt_call1 s ctxt block a1 q i = + make_call1 s ctxt block a1 q i >>= function + | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) + | Error _ as v -> Lwt.return v + | Ok v -> Lwt.return (Ok (Some v)) + + let make_opt_call2 s ctxt block a1 a2 q i = + make_call2 s ctxt block a1 a2 q i >>= function + | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) + | Error _ as v -> Lwt.return v + | Ok v -> Lwt.return (Ok (Some v)) + + let make_opt_call3 s ctxt block a1 a2 a3 q i = + make_call3 s ctxt block a1 a2 a3 q i >>= function + | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) + | Error _ as v -> Lwt.return v + | Ok v -> Lwt.return (Ok (Some v)) + end module Micheline = Micheline module Logging = Logging.Make(Param) diff --git a/src/lib_base/protocol_environment.mli b/src/lib_base/protocol_environment.mli index 0f24d0617..99a258bf2 100644 --- a/src/lib_base/protocol_environment.mli +++ b/src/lib_base/protocol_environment.mli @@ -124,6 +124,7 @@ module type V1 = sig and type ('a, 'b) RPC_path.t = ('a, 'b) RPC_path.t and type RPC_service.meth = RPC_service.meth and type (+'m,'pr,'p,'q,'i,'o) RPC_service.t = ('m,'pr,'p,'q,'i,'o) RPC_service.t + and type Error_monad.shell_error = Error_monad.error type error += Ecoproto_error of Error_monad.error list val wrap_error : 'a Error_monad.tzresult -> 'a tzresult diff --git a/src/lib_protocol_environment_sigs/jbuild b/src/lib_protocol_environment_sigs/jbuild index 70204c3c6..76637c878 100644 --- a/src/lib_protocol_environment_sigs/jbuild +++ b/src/lib_protocol_environment_sigs/jbuild @@ -58,6 +58,7 @@ v1/protocol.mli v1/context.mli v1/updater.mli + v1/RPC_context.mli )) (action diff --git a/src/lib_protocol_environment_sigs/v1/RPC_context.mli b/src/lib_protocol_environment_sigs/v1/RPC_context.mli new file mode 100644 index 000000000..851fb2eff --- /dev/null +++ b/src/lib_protocol_environment_sigs/v1/RPC_context.mli @@ -0,0 +1,55 @@ + +type t = Updater.rpc_context Lwt.t + +class type ['pr] simple = object + method call_proto_service0 : + 'm 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, t, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + method call_proto_service1 : + 'm 'a 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, t * 'a, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'a -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + method call_proto_service2 : + 'm 'a 'b 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'a -> 'b -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + method call_proto_service3 : + 'm 'a 'b 'c 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t +end + +val make_call0: + ([< RPC_service.meth ], t, t, 'q, 'i, 'o) RPC_service.t -> + 'pr #simple -> 'pr -> 'q -> 'i -> 'o shell_tzresult Lwt.t + +val make_call1: + ([< RPC_service.meth ], t, t * 'a, 'q, 'i, 'o) RPC_service.t -> + 'pr #simple -> 'pr -> 'a -> 'q -> 'i -> 'o shell_tzresult Lwt.t + +val make_call2: + ([< RPC_service.meth ], t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> + 'pr #simple -> 'pr -> 'a -> 'b -> 'q -> 'i -> 'o shell_tzresult Lwt.t + +val make_call3: + ([< RPC_service.meth ], t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t -> + 'pr #simple -> 'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o shell_tzresult Lwt.t + + +val make_opt_call0: + ([< RPC_service.meth ], t, t, 'q, 'i, 'o) RPC_service.t -> + 'pr #simple -> 'pr -> 'q -> 'i -> 'o option shell_tzresult Lwt.t + +val make_opt_call1: + ([< RPC_service.meth ], t, t * 'a, 'q, 'i, 'o) RPC_service.t -> + 'pr #simple -> 'pr -> 'a -> 'q -> 'i -> 'o option shell_tzresult Lwt.t + +val make_opt_call2: + ([< RPC_service.meth ], t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> + 'pr #simple -> 'pr -> 'a -> 'b -> 'q -> 'i -> 'o option shell_tzresult Lwt.t + +val make_opt_call3: + ([< RPC_service.meth ], t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t -> + 'pr #simple -> 'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o option shell_tzresult Lwt.t + diff --git a/src/lib_protocol_environment_sigs/v1/error_monad.mli b/src/lib_protocol_environment_sigs/v1/error_monad.mli index 484391380..7203a517a 100644 --- a/src/lib_protocol_environment_sigs/v1/error_monad.mli +++ b/src/lib_protocol_environment_sigs/v1/error_monad.mli @@ -120,3 +120,9 @@ val fold_left_s : ('a -> 'b -> 'a tzresult Lwt.t) -> 'a -> 'b list -> 'a tzresul (** A {!List.fold_right} in the monad *) val fold_right_s : ('a -> 'b -> 'b tzresult Lwt.t) -> 'a list -> 'b -> 'b tzresult Lwt.t + + +(**/**) + +type shell_error +type 'a shell_tzresult = ('a, shell_error list) result