Proto/env: export RPC_context

This commit is contained in:
Grégoire Henry 2018-02-11 19:17:40 +01:00
parent 4a1da9407e
commit d539072f1b
5 changed files with 130 additions and 0 deletions

View File

@ -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)

View File

@ -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

View File

@ -58,6 +58,7 @@
v1/protocol.mli
v1/context.mli
v1/updater.mli
v1/RPC_context.mli
))
(action

View File

@ -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

View File

@ -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