balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

RPC: simplify the signature of Client_rpcs.ctxt

Browse Source
This commit is contained in:
Grégoire Henry 2017-12-08 22:08:29 +01:00 committed by Benjamin Canou
parent c66f0232f5
commit 3c38458843
14 changed files with 213 additions and 502 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin_client/jbuild
View File

@ -4,12 +4,14 @@
((name main) ((name main)
(public_name tezos-client) (public_name tezos-client)
(libraries (tezos-base (libraries (tezos-base
tezos-rpc-http
tezos-client-base tezos-client-base
tezos-embedded-client-genesis tezos-embedded-client-genesis
tezos-embedded-client-alpha)) tezos-embedded-client-alpha))
(flags (:standard -w -9+27-30-32-40@8 (flags (:standard -w -9+27-30-32-40@8
-safe-string -safe-string
-open Tezos_base__TzPervasives -open Tezos_base__TzPervasives
-open Tezos_rpc_http
-open Tezos_client_base -open Tezos_client_base
-linkall)))) -linkall))))

6
bin_client/main.ml
View File

@ -31,7 +31,7 @@ let main () =
port = parsed_config_file.node_port ; port = parsed_config_file.node_port ;
tls = parsed_config_file.tls ; tls = parsed_config_file.tls ;
} in } in
let ctxt = new Client_rpcs.rpc rpc_config in let ctxt = new Client_rpcs.http_ctxt rpc_config in
begin begin
Client_node_rpcs.Blocks.protocol ctxt parsed_args.block >>= function Client_node_rpcs.Blocks.protocol ctxt parsed_args.block >>= function
| Ok version -> begin | Ok version -> begin
@ -72,9 +72,9 @@ let main () =
let rpc_config = let rpc_config =
if parsed_args.print_timings then if parsed_args.print_timings then
{ rpc_config with { rpc_config with
logger = Client_rpcs.timings_logger Format.err_formatter } logger = RPC_client.timings_logger Format.err_formatter }
else if parsed_args.log_requests else if parsed_args.log_requests
then { rpc_config with logger = Client_rpcs.full_logger Format.err_formatter } then { rpc_config with logger = RPC_client.full_logger Format.err_formatter }
else rpc_config else rpc_config
in in
let client_config = let client_config =

2
lib_client_base/client_commands.ml
View File

@ -142,7 +142,7 @@ let make_context
object object
inherit logger log inherit logger log
inherit file_wallet base_dir inherit file_wallet base_dir
inherit Client_rpcs.rpc rpc_config inherit Client_rpcs.http_ctxt rpc_config
method block = block method block = block
end end

43
lib_client_base/client_generic_rpcs.ml
View File

@ -350,9 +350,21 @@ let fill_in schema =
| Any | Object { properties = [] } -> Lwt.return (Ok (`O [])) | Any | Object { properties = [] } -> Lwt.return (Ok (`O []))
| _ -> editor_fill_in schema | _ -> editor_fill_in schema
let call url (cctxt : Client_commands.full_context) = let display_answer (cctxt : #Client_commands.full_context) = function
let args = String.split '/' url in | `Ok json ->
let open RPC_description in cctxt#message "%a"
Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
return ()
| `Not_found _ ->
cctxt#message "No service found at this URL\n%!" >>= fun () ->
return ()
| `Unauthorized _ | `Error _ | `Forbidden _ | `Conflict _ ->
cctxt#message "Unexpected server answer\n%!" >>= fun () ->
return ()
let call raw_url (cctxt : #Client_commands.full_context) =
let uri = Uri.of_string raw_url in
let args = String.split_path (Uri.path uri) in
Client_node_rpcs.describe cctxt ~recurse:false args >>=? function Client_node_rpcs.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin | Static { services } -> begin
match RPC_service.MethMap.find `POST services with match RPC_service.MethMap.find `POST services with
@ -360,35 +372,32 @@ let call url (cctxt : Client_commands.full_context) =
cctxt#message cctxt#message
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
return () return ()
| { input = None } -> assert false (* TODO *) | { input = None } ->
cctxt#generic_json_call `POST uri >>=?
display_answer cctxt
| { input = Some input } -> | { input = Some input } ->
fill_in input >>= function fill_in input >>= function
| Error msg -> | Error msg ->
cctxt#error "%s" msg >>= fun () -> cctxt#error "%s" msg >>= fun () ->
return () return ()
| Ok json -> | Ok json ->
cctxt#get_json `POST args json >>=? fun json -> cctxt#generic_json_call `POST ~body:json uri >>=?
cctxt#message "%a" display_answer cctxt
Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
return ()
end end
| _ -> | _ ->
cctxt#message cctxt#message "No service found at this URL\n%!" >>= fun () ->
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
return () return ()
let call_with_json url json (cctxt: Client_commands.full_context) = let call_with_json raw_url json (cctxt: Client_commands.full_context) =
let args = String.split '/' url in let uri = Uri.of_string raw_url in
match Data_encoding_ezjsonm.from_string json with match Data_encoding_ezjsonm.from_string json with
| Error err -> | Error err ->
cctxt#error cctxt#error
"Failed to parse the provided json: %s\n%!" "Failed to parse the provided json: %s\n%!"
err err
| Ok json -> | Ok body ->
cctxt#get_json `POST args json >>=? fun json -> cctxt#generic_json_call `POST ~body uri >>=?
cctxt#message "%a" display_answer cctxt
Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
return ()
let group = let group =
{ Cli_entries.name = "rpc" ; { Cli_entries.name = "rpc" ;

10
lib_client_base/client_helpers.ml
View File

@ -40,15 +40,11 @@ let commands () = Cli_entries.[
stop) stop)
(fun () (cctxt : Client_commands.full_context) -> (fun () (cctxt : Client_commands.full_context) ->
Client_node_rpcs.bootstrapped cctxt >>=? fun stream -> Client_node_rpcs.bootstrapped cctxt >>=? fun stream ->
Lwt_stream.iter_s (function Lwt_stream.iter_s
| Ok (hash, time) -> (fun (hash, time) ->
cctxt#message "Current head: %a (%a)" cctxt#message "Current head: %a (%a)"
Block_hash.pp_short hash Block_hash.pp_short hash
Time.pp_hum time Time.pp_hum time) stream >>= fun () ->
| Error err ->
cctxt#error "Error: %a"
pp_print_error err
) stream >>= fun () ->
cctxt#answer "Bootstrapped." >>= fun () -> cctxt#answer "Bootstrapped." >>= fun () ->
return () return ()
) )

16
lib_client_base/client_node_rpcs.ml
View File

@ -42,18 +42,10 @@ let complete cctxt ?block prefix =
| Some block -> | Some block ->
call_service2 cctxt Services.Blocks.complete block prefix () call_service2 cctxt Services.Blocks.complete block prefix ()
let describe config ?(recurse = true) path = let describe cctxt ?(recurse = true) path =
let { RPC_service.meth ; uri } = Client_rpcs.call_service cctxt
RPC_service.forge_request Node_rpc_services.describe Node_rpc_services.describe
((), path) { RPC_description.recurse } in ((), path) { recurse } ()
let path = String.split_path (Uri.path uri) in (* Temporary *)
config#get_json meth path (`O []) >>=? fun json ->
match Data_encoding.Json.destruct (RPC_service.output_encoding Node_rpc_services.describe) json with
| exception msg ->
let msg =
Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in
failwith "Failed to parse Json answer: %s" msg
| v -> return v
module Blocks = struct module Blocks = struct

6
lib_client_base/client_node_rpcs.mli
View File

@ -109,7 +109,7 @@ module Blocks : sig
#Client_rpcs.ctxt -> #Client_rpcs.ctxt ->
?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list -> ?include_ops:bool -> ?length:int -> ?heads:Block_hash.t list ->
?delay:int -> ?min_date:Time.t -> ?min_heads:int -> ?delay:int -> ?min_date:Time.t -> ?min_heads:int ->
unit -> block_info list list tzresult Lwt_stream.t tzresult Lwt.t unit -> block_info list list Lwt_stream.t tzresult Lwt.t
type preapply_result = { type preapply_result = {
shell_header: Block_header.shell_header ; shell_header: Block_header.shell_header ;
@ -132,7 +132,7 @@ module Operations : sig
#Client_rpcs.ctxt -> #Client_rpcs.ctxt ->
?contents:bool -> ?contents:bool ->
unit -> unit ->
(Operation_hash.t * Operation.t option) list list tzresult Lwt_stream.t tzresult Lwt.t (Operation_hash.t * Operation.t option) list list Lwt_stream.t tzresult Lwt.t
end end
@ -150,7 +150,7 @@ module Protocols : sig
end end
val bootstrapped: val bootstrapped:
#Client_rpcs.ctxt -> (Block_hash.t * Time.t) tzresult Lwt_stream.t tzresult Lwt.t #Client_rpcs.ctxt -> (Block_hash.t * Time.t) Lwt_stream.t tzresult Lwt.t
module Network : sig module Network : sig

444
lib_client_base/client_rpcs.ml
View File

@ -7,408 +7,128 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
type logger = Logger : { module Client = Resto_cohttp.Client.Make(RPC_encoding)
log_request: Uri.t -> Data_encoding.json -> 'a Lwt.t ;
log_success:
'a -> Cohttp.Code.status_code -> Data_encoding.json -> unit Lwt.t ;
log_error:
'a -> Cohttp.Code.status_code -> string -> unit Lwt.t ;
} -> logger
type config = { type config = {
host : string ; host : string ;
port : int ; port : int ;
tls : bool ; tls : bool ;
logger : logger ; logger : RPC_client.logger ;
} }
let null_logger =
Logger {
log_request = (fun _ _ -> Lwt.return_unit) ;
log_success = (fun _ _ _ -> Lwt.return_unit) ;
log_error = (fun _ _ _ -> Lwt.return_unit) ;
}
let config_encoding = let config_encoding =
let open Data_encoding in let open Data_encoding in
conv conv
(fun { host ; port ; tls } -> (host, port, tls)) (fun { host ; port ; tls } -> (host, port, tls))
(fun (host, port, tls) -> { host ; port ; tls ; logger = null_logger}) (fun (host, port, tls) -> { host ; port ; tls ; logger = RPC_client.null_logger})
(obj3 (obj3
(req "host" string) (req "host" string)
(req "port" uint16) (req "port" uint16)
(req "tls" bool)) (req "tls" bool))
let timings_logger ppf =
Logger {
log_request = begin fun url _body ->
let tzero = Unix.gettimeofday () in
let url = Uri.to_string url in
Lwt.return (url, tzero)
end ;
log_success = begin fun (url, tzero) _code _body ->
let time = Unix.gettimeofday () -. tzero in
Format.fprintf ppf "Request to %s succeeded in %gs" url time ;
Lwt.return_unit
end ;
log_error = begin fun (url, tzero) _code _body ->
let time = Unix.gettimeofday () -. tzero in
Format.fprintf ppf "Request to %s failed in %gs" url time ;
Lwt.return_unit
end ;
}
let full_logger ppf =
let cpt = ref 0 in
Logger {
log_request = begin fun url body ->
let id = !cpt in
let url = Uri.to_string url in
let body = Data_encoding_ezjsonm.to_string body in
incr cpt ;
Format.fprintf ppf ">>>>%d: %s\n%s@." id url body ;
Lwt.return (id, url)
end ;
log_success = begin fun (id, _url) code body ->
let code = Cohttp.Code.string_of_status code in
let body = Data_encoding_ezjsonm.to_string body in
Format.fprintf ppf "<<<<%d: %s\n%s@." id code body ;
Lwt.return_unit
end ;
log_error = begin fun (id, _url) code body ->
let code = Cohttp.Code.string_of_status code in
Format.fprintf ppf "<<<<%d: %s\n%s@." id code body ;
Lwt.return_unit
end ;
}
let default_config = { let default_config = {
host = "localhost" ; host = "localhost" ;
port = 8732 ; port = 8732 ;
tls = false ; tls = false ;
logger = null_logger ; logger = RPC_client.null_logger ;
} }
type rpc_error = class type json_ctxt = object
| Connection_failed of string method generic_json_call :
| Request_failed of string list * Cohttp.Code.status_code RPC_service.meth ->
| Malformed_json of string list * string * string ?body:Data_encoding.json ->
| Unexpected_json of string list * Data_encoding.json * string Uri.t ->
(Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t
end
type error += RPC_error of config * rpc_error class type service_ctxt = object
method call_service :
let rpc_error_encoding = 'm 'p 'q 'i 'o 'e.
let open Data_encoding in ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o, 'e) RPC_service.t ->
union 'p -> 'q -> 'i -> 'o tzresult Lwt.t
[ case ~tag: 1 method call_streamed_service :
(obj2 'm 'p 'q 'i 'o 'e.
(req "rpc_error_kind" (constant "connection_failed")) ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o, 'e) RPC_service.t ->
(req "message" string)) on_chunk: ('o -> unit) ->
(function Connection_failed msg -> Some ((), msg) | _ -> None) on_close: (unit -> unit) ->
(function (), msg -> Connection_failed msg) ; 'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
case ~tag: 2 end
(obj3
(req "rpc_error_kind" (constant "request_failed"))
(req "path" (list string))
(req "http_code" (conv Cohttp.Code.code_of_status Cohttp.Code.status_of_code uint16)))
(function Request_failed (path, code) -> Some ((), path, code) | _ -> None)
(function (), path, code -> Request_failed (path, code)) ;
case ~tag: 3
(obj4
(req "rpc_error_kind" (constant "malformed_json"))
(req "path" (list string))
(req "message" string)
(req "text" string))
(function Malformed_json (path, json, msg) -> Some ((), path, msg, json) | _ -> None)
(function (), path, msg, json -> Malformed_json (path, json, msg)) ;
case ~tag: 4
(obj4
(req "rpc_error_kind" (constant "unexpected_json"))
(req "path" (list string))
(req "message" string)
(req "json" json))
(function Unexpected_json (path, json, msg) -> Some ((), path, msg, json) | _ -> None)
(function (), path, msg, json -> Unexpected_json (path, json, msg)) ]
let pp_error ppf (config, err) =
let pp_path ppf path =
Format.fprintf ppf "%s://%s:%d/%s"
(if config.tls then "https" else "http")
config.host config.port
(String.concat "/" path) in
match err with
| Connection_failed msg ->
Format.fprintf ppf
"@[<v 2>Unable to connect to the node:@,\
Node's address: %s@,\
Node's RPC port: %d@,\
Error: %s@]"
config.host config.port msg
| Request_failed (path, code) ->
let code = Cohttp.Code.code_of_status code in
Format.fprintf ppf "@[<v 2>RPC Request failed:@,\
Path: %a@,\
HTTP status: %d (%s)@]"
pp_path path
code (Cohttp.Code.reason_phrase_of_code code)
| Malformed_json (path, json, msg) ->
Format.fprintf ppf "@[<v 2>RPC request returned malformed JSON:@,\
Path: %a@,\
Error: %s@,\
@[<v 2>JSON data:@,%a@]@]"
pp_path path
msg
(Format.pp_print_list
(fun ppf s -> Format.fprintf ppf "> %s" s))
(String.split '\n' json)
| Unexpected_json (path, json, msg) ->
Format.fprintf ppf "@[<v 2>RPC request returned unexpected JSON:@,\
Path: %a@,\
@[<v 2>Error:@,%a@]@,\
@[<v 2>JSON data:@,%a@]@]"
pp_path path
(Format.pp_print_list (fun ppf s -> Format.fprintf ppf "%s" s))
(String.split '\n' msg)
Json_repr.(pp (module Ezjsonm)) json
let () =
register_error_kind
`Branch
~id: "client_rpc"
~title: "Client side RPC error"
~description: "An RPC call failed"
~pp: pp_error
Data_encoding.(obj2
(req "config" config_encoding)
(req "error" rpc_error_encoding))
(function RPC_error (config, err) -> Some (config, err) | _ -> None)
(fun (config, err) -> RPC_error (config, err))
let fail config err = fail (RPC_error (config, err))
class type ctxt = object class type ctxt = object
method get_json : inherit json_ctxt
RPC_service.meth -> inherit service_ctxt
string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt.t
method get_streamed_json :
RPC_service.meth ->
string list ->
Data_encoding.json ->
Data_encoding.json tzresult Lwt_stream.t tzresult Lwt.t
method make_request :
(Uri.t -> Data_encoding.json -> 'a Lwt.t) ->
RPC_service.meth ->
string list ->
Data_encoding.json ->
('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t
method parse_answer :
'meth 'params 'input 'output.
([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output, unit) RPC_service.t ->
string list ->
Data_encoding.json -> 'output tzresult Lwt.t
method parse_err_answer :
'meth 'params 'input 'output.
([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output tzresult, unit) RPC_service.t ->
string list ->
Data_encoding.json -> 'output tzresult Lwt.t
end end
class rpc config : ctxt = object (self) class http_ctxt config : ctxt =
val config = config let base =
method make_request : Uri.make
type a. (Uri.t -> Data_encoding.json -> a Lwt.t) -> ~scheme:(if config.tls then "https" else "http")
RPC_service.meth -> ~host:config.host
string list -> ~port:config.port
Data_encoding.json -> () in
(a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t = let logger = config.logger in
fun log_request meth service json -> object
let scheme = if config.tls then "https" else "http" in method generic_json_call meth ?body uri =
let path = String.concat "/" service in let uri = Uri.with_path base (Uri.path uri) in
let uri = let uri = Uri.with_query uri (Uri.query uri) in
Uri.make ~scheme ~host:config.host ~port:config.port ~path () in RPC_client.generic_json_call ~logger meth ?body uri
let reqbody = Data_encoding_ezjsonm.to_string json in method call_service
Lwt.catch begin fun () -> : 'm 'p 'q 'i 'o 'e.
let body = Cohttp_lwt.Body.of_string reqbody in ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o, 'e) RPC_service.t ->
Cohttp_lwt_unix.Client.call 'p -> 'q -> 'i -> 'o tzresult Lwt.t =
(meth :> Cohttp.Code.meth) ~body uri >>= fun (code, ansbody) -> fun service params query body ->
log_request uri json >>= fun reqid -> RPC_client.call_service Media_type.all_media_types ~logger ~base service params query body
return (reqid, code.Cohttp.Response.status, ansbody) method call_streamed_service
end begin fun exn -> : 'm 'p 'q 'i 'o 'e.
let msg = match exn with ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o, 'e) RPC_service.t ->
| Unix.Unix_error (e, _, _) -> Unix.error_message e on_chunk: ('o -> unit) ->
| Failure msg -> msg on_close: (unit -> unit) ->
| Invalid_argument msg -> msg 'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t =
| e -> Printexc.to_string e in fun service ~on_chunk ~on_close params query body ->
fail config (Connection_failed msg) RPC_client.call_streamed_service Media_type.all_media_types service
~logger ~base ~on_chunk ~on_close params query body
end end
method get_streamed_json meth service json = let call_service (ctxt : #service_ctxt) service params query body =
let Logger logger = config.logger in ctxt#call_service service params query body
self#make_request logger.log_request
meth service json >>=? fun (reqid, code, ansbody) ->
match code with
| #Cohttp.Code.success_status ->
let ansbody = Cohttp_lwt.Body.to_stream ansbody in
let json_st = Data_encoding_ezjsonm.from_stream ansbody in
let parsed_st, push = Lwt_stream.create () in
let rec loop () =
Lwt_stream.get json_st >>= function
| Some (Ok json) as v ->
push v ;
logger.log_success reqid code json >>= fun () ->
loop ()
| None ->
push None ;
Lwt.return_unit
| Some (Error msg) ->
let error =
RPC_error (config, Malformed_json (service, "", msg)) in
push (Some (Error [error])) ;
push None ;
Lwt.return_unit
in
Lwt.async loop ;
return parsed_st
| err ->
Cohttp_lwt.Body.to_string ansbody >>= fun ansbody ->
logger.log_error reqid code ansbody >>= fun () ->
fail config (Request_failed (service, err))
method parse_answer let call_err_service ctxt service params query body =
: 'm 'p 'i 'o. call_service ctxt service params query body >>=? Lwt.return
([< Resto.meth ] as 'm, unit, 'p, unit, 'i, 'o, unit) RPC_service.t ->
string list ->
Data_encoding.json -> 'o tzresult Lwt.t =
fun service path json ->
match Data_encoding.Json.destruct (RPC_service.output_encoding service) json with
| exception msg ->
let msg =
Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in
fail config (Unexpected_json (path, json, msg))
| v -> return v
let call_streamed_service (ctxt : #service_ctxt) service param query body =
let stream, push = Lwt_stream.create () in
ctxt#call_streamed_service
~on_chunk:(fun o -> push (Some o)) ~on_close:(fun () -> push None)
service param query body >>= function
| Error _ as err -> Lwt.return err
| Ok _finalizer ->
return stream
method get_json : RPC_service.meth -> (* Currified params *)
string list -> Data_encoding.json -> Data_encoding.json tzresult Lwt.t =
fun meth service json ->
let Logger logger = config.logger in
self#make_request logger.log_request
meth service json >>=? fun (reqid, code, ansbody) ->
Cohttp_lwt.Body.to_string ansbody >>= fun ansbody ->
match code with
| #Cohttp.Code.success_status -> begin
if ansbody = "" then
return `Null
else
match Data_encoding_ezjsonm.from_string ansbody with
| Error msg ->
logger.log_error reqid code ansbody >>= fun () ->
fail config (Malformed_json (service, ansbody, msg))
| Ok json ->
logger.log_success reqid code json >>= fun () ->
return json
end
| err ->
logger.log_error reqid code ansbody >>= fun () ->
fail config (Request_failed (service, err))
method parse_err_answer let call_service0 ctxt service body =
: 'm 'p 'i 'o. call_service ctxt service () () body
([< Resto.meth ] as 'm, unit, 'p, unit, 'i, 'o tzresult, unit) RPC_service.t ->
string list ->
Data_encoding.json -> 'o tzresult Lwt.t =
fun service path json ->
match Data_encoding.Json.destruct (RPC_service.output_encoding service) json with
| exception msg -> (* TODO print_error *)
let msg =
Format.asprintf "%a" (fun x -> Data_encoding.Json.print_error x) msg in
fail config (Unexpected_json (path, json, msg))
| v -> Lwt.return v
end
let make_request config log_request meth service json = let call_service1 ctxt service a1 body =
let scheme = if config.tls then "https" else "http" in call_service ctxt service ((), a1) () body
let path = String.concat "/" service in
let uri =
Uri.make ~scheme ~host:config.host ~port:config.port ~path () in
let reqbody = Data_encoding_ezjsonm.to_string json in
Lwt.catch begin fun () ->
let body = Cohttp_lwt.Body.of_string reqbody in
Cohttp_lwt_unix.Client.call
(meth :> Cohttp.Code.meth)
~body uri >>= fun (code, ansbody) ->
log_request uri json >>= fun reqid ->
return (reqid, code.Cohttp.Response.status, ansbody)
end begin fun exn ->
let msg = match exn with
| Unix.Unix_error (e, _, _) -> Unix.error_message e
| e -> Printexc.to_string e in
fail config (Connection_failed msg)
end
let forge_request (type i) (service: (_,_,_,_,i,_,_) RPC_service.t) params body = let call_service2 ctxt service a1 a2 body =
let { RPC_service.meth ; uri } = call_service ctxt service (((), a1), a2) () body
RPC_service.forge_request service params () in
let json =
match RPC_service.input_encoding service with
| RPC_service.No_input -> assert false (* TODO *)
| RPC_service.Input input -> Data_encoding.Json.construct input body in
let path = String.split_path (Uri.path uri) in (* Temporary *)
meth, path, json
let call_service0 (rpc : #ctxt) service arg = let call_streamed_service0 ctxt service body =
let meth, path, arg = forge_request service () arg in call_streamed_service ctxt service () () body
rpc#get_json meth path arg >>=? fun json ->
rpc#parse_answer service path json
let call_service1 (rpc : #ctxt) service a1 arg = let call_streamed_service1 ctxt service a1 body =
let meth, path, arg = forge_request service ((), a1) arg in call_streamed_service ctxt service ((), a1) () body
rpc#get_json meth path arg >>=? fun json ->
rpc#parse_answer service path json
let call_service2 (rpc : #ctxt) service a1 a2 arg = let call_err_service0 ctxt service body =
let meth, path, arg = forge_request service (((), a1), a2) arg in call_err_service ctxt service () () body
rpc#get_json meth path arg >>=? fun json ->
rpc#parse_answer service path json
let call_streamed (rpc : #ctxt) service (meth, path, arg) = let call_err_service1 ctxt service a1 body =
rpc#get_streamed_json meth path arg >>=? fun json_st -> call_err_service ctxt service ((), a1) () body
let parsed_st, push = Lwt_stream.create () in
let rec loop () =
Lwt_stream.get json_st >>= function
| Some (Ok json) -> begin
rpc#parse_answer service path json >>= function
| Ok v -> push (Some (Ok v)) ; loop ()
| Error _ as err ->
push (Some err) ; push None ; Lwt.return_unit
end
| Some (Error _) as v ->
push v ; push None ; Lwt.return_unit
| None -> push None ; Lwt.return_unit
in
Lwt.async loop ;
return parsed_st
let call_streamed_service0 (rpc : #ctxt) service arg = let call_err_service2 ctxt service a1 a2 body =
call_streamed rpc service (forge_request service () arg) call_err_service ctxt service (((), a1), a2) () body
let call_streamed_service1 cctxt service arg1 arg2 =
call_streamed cctxt service (forge_request service ((), arg1) arg2)
let call_err_service0 (rpc : #ctxt) service arg =
let meth, path, arg = forge_request service () arg in
rpc#get_json meth path arg >>=? fun json ->
rpc#parse_err_answer service path json
let call_err_service1 (rpc : #ctxt) service a1 arg =
let meth, path, arg = forge_request service ((), a1) arg in
rpc#get_json meth path arg >>=? fun json ->
rpc#parse_err_answer service path json
let call_err_service2 (rpc : #ctxt) service a1 a2 arg =
let meth, path, arg = forge_request service (((), a1), a2) arg in
rpc#get_json meth path arg >>=? fun json ->
rpc#parse_err_answer service path json
type block = Node_rpc_services.Blocks.block type block = Node_rpc_services.Blocks.block

118
lib_client_base/client_rpcs.mli
View File

@ -11,107 +11,99 @@ type config = {
host : string ; host : string ;
port : int ; port : int ;
tls : bool ; tls : bool ;
logger : logger ; logger : RPC_client.logger ;
} }
and logger = class type json_ctxt = object
Logger : { method generic_json_call :
log_request : Uri.t -> Data_encoding.json -> 'a Lwt.t ;
log_success :
'a -> Cohttp.Code.status_code -> Data_encoding.json -> unit Lwt.t ;
log_error :
'a -> Cohttp.Code.status_code -> string -> unit Lwt.t ;
} -> logger
class type ctxt = object
method get_json :
RPC_service.meth -> RPC_service.meth ->
string list -> Data_encoding.json -> ?body:Data_encoding.json ->
Data_encoding.json tzresult Lwt.t Uri.t ->
method get_streamed_json : (Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t
RPC_service.meth ->
string list ->
Data_encoding.json ->
Data_encoding.json tzresult Lwt_stream.t tzresult Lwt.t
method make_request :
(Uri.t -> Data_encoding.json -> 'a Lwt.t) ->
RPC_service.meth ->
string list ->
Data_encoding.json ->
('a * Cohttp.Code.status_code * Cohttp_lwt.Body.t) tzresult Lwt.t
method parse_answer :
'meth 'params 'input 'output.
([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output, unit) RPC_service.t ->
string list ->
Data_encoding.json -> 'output tzresult Lwt.t
method parse_err_answer :
'meth 'params 'input 'output.
([< Resto.meth ] as 'meth, unit, 'params, unit, 'input, 'output tzresult, unit) RPC_service.t ->
string list ->
Data_encoding.json -> 'output tzresult Lwt.t
end end
class rpc : config -> ctxt class type service_ctxt = object
method call_service :
'm 'p 'q 'i 'o 'e.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o, 'e) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t
method call_streamed_service :
'm 'p 'q 'i 'o 'e.
([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o, 'e) RPC_service.t ->
on_chunk: ('o -> unit) ->
on_close: (unit -> unit) ->
'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
end
class type ctxt = object
inherit json_ctxt
inherit service_ctxt
end
val default_config: config val default_config: config
val null_logger: logger class http_ctxt: config -> ctxt
val timings_logger: Format.formatter -> logger
val full_logger: Format.formatter -> logger val call_service:
#service_ctxt ->
('m, unit,
'p, 'q, 'i,
'o, 'e) RPC_service.t ->
'p -> 'q -> 'i -> 'o tzresult Lwt.t
val call_service0: val call_service0:
#ctxt -> #service_ctxt ->
([ `POST ], unit, ('m, unit,
unit, unit, 'i, unit, unit, 'i,
'o, unit) RPC_service.t -> 'o, 'e) RPC_service.t ->
'i -> 'o tzresult Lwt.t 'i -> 'o tzresult Lwt.t
val call_service1: val call_service1:
#ctxt -> #service_ctxt ->
([ `POST ], unit, ('m, unit,
unit * 'a, unit, 'i, unit * 'a, unit, 'i,
'o, unit) RPC_service.t -> 'o, 'e) RPC_service.t ->
'a -> 'i -> 'o tzresult Lwt.t 'a -> 'i -> 'o tzresult Lwt.t
val call_service2: val call_service2:
#ctxt -> #service_ctxt ->
([ `POST ], unit, ('m, unit,
(unit * 'a) * 'b, unit, 'i, (unit * 'a) * 'b, unit, 'i,
'o, unit) RPC_service.t -> 'o, 'e) RPC_service.t ->
'a -> 'b -> 'i -> 'o tzresult Lwt.t 'a -> 'b -> 'i -> 'o tzresult Lwt.t
val call_streamed_service0: val call_streamed_service0:
#ctxt -> #service_ctxt ->
([ `POST ], unit, ('m, unit,
unit, unit, 'a, unit, unit, 'a,
'b, unit) RPC_service.t -> 'b, unit) RPC_service.t ->
'a -> 'b tzresult Lwt_stream.t tzresult Lwt.t 'a -> 'b Lwt_stream.t tzresult Lwt.t
val call_streamed_service1: val call_streamed_service1:
#ctxt -> #service_ctxt ->
([ `POST ], unit, ('m, unit,
unit * 'a, unit, 'b, unit * 'a, unit, 'b,
'c, unit) RPC_service.t -> 'c, unit) RPC_service.t ->
'a -> 'b -> 'c tzresult Lwt_stream.t tzresult Lwt.t 'a -> 'b -> 'c Lwt_stream.t tzresult Lwt.t
val call_err_service0: val call_err_service0:
#ctxt -> #service_ctxt ->
([ `POST ], unit, ('m, unit,
unit, unit, 'i, unit, unit, 'i,
'o tzresult, unit) RPC_service.t -> 'o tzresult, 'e) RPC_service.t ->
'i -> 'o tzresult Lwt.t 'i -> 'o tzresult Lwt.t
val call_err_service1: val call_err_service1:
#ctxt -> #service_ctxt ->
([ `POST ], unit, ('m, unit,
unit * 'a, unit, 'i, unit * 'a, unit, 'i,
'o tzresult, unit) RPC_service.t -> 'o tzresult, 'e) RPC_service.t ->
'a -> 'i -> 'o tzresult Lwt.t 'a -> 'i -> 'o tzresult Lwt.t
val call_err_service2: val call_err_service2:
#ctxt -> #service_ctxt ->
([ `POST ], unit, ('m, unit,
(unit * 'a) * 'b, unit, 'i, (unit * 'a) * 'b, unit, 'i,
'o tzresult, unit) RPC_service.t -> 'o tzresult, 'e) RPC_service.t ->
'a -> 'b -> 'i -> 'o tzresult Lwt.t 'a -> 'b -> 'i -> 'o tzresult Lwt.t
type block = Node_rpc_services.Blocks.block type block = Node_rpc_services.Blocks.block

1
lib_embedded_client_alpha/client_baking_blocks.ml
View File

@ -63,7 +63,6 @@ let monitor cctxt
?include_ops ?length ?heads ?delay ?min_date ?min_heads ?include_ops ?length ?heads ?delay ?min_date ?min_heads
() >>=? fun block_stream -> () >>=? fun block_stream ->
let convert blocks = let convert blocks =
Lwt.return blocks >>=? fun blocks ->
sort_blocks cctxt ?compare (List.flatten blocks) >>= return in sort_blocks cctxt ?compare (List.flatten blocks) >>= return in
return (Lwt_stream.map_s convert block_stream) return (Lwt_stream.map_s convert block_stream)

1
lib_embedded_client_alpha/client_baking_operations.ml
View File

@ -15,7 +15,6 @@ type operation = {
let monitor cctxt ?contents ?check () = let monitor cctxt ?contents ?check () =
Client_node_rpcs.Operations.monitor cctxt ?contents () >>=? fun ops_stream -> Client_node_rpcs.Operations.monitor cctxt ?contents () >>=? fun ops_stream ->
let convert ops = let convert ops =
Lwt.return ops >>=? fun ops ->
map_s map_s
(fun (hash, op) -> (fun (hash, op) ->
match op with match op with

6
lib_embedded_client_alpha/client_proto_rpcs.mli
View File

@ -13,13 +13,13 @@ val handle_error: Client_commands.full_context -> 'a tzresult -> 'a Lwt.t
type block = Node_rpc_services.Blocks.block type block = Node_rpc_services.Blocks.block
val header: val header:
Client_rpcs.rpc -> block -> Block_header.t tzresult Lwt.t #Client_rpcs.ctxt -> block -> Block_header.t tzresult Lwt.t
module Header : sig module Header : sig
val priority: val priority:
Client_rpcs.rpc -> block -> int tzresult Lwt.t #Client_rpcs.ctxt -> block -> int tzresult Lwt.t
val seed_nonce_hash: val seed_nonce_hash:
Client_rpcs.rpc -> block -> Nonce_hash.t tzresult Lwt.t #Client_rpcs.ctxt -> block -> Nonce_hash.t tzresult Lwt.t
end end
module Constants : sig module Constants : sig

2
test/proto_alpha/jbuild
View File

@ -7,12 +7,14 @@
test_transaction test_transaction
test_vote)) test_vote))
(libraries (tezos-base (libraries (tezos-base
tezos-rpc-http
tezos-client-base tezos-client-base
tezos-embedded-client-genesis tezos-embedded-client-genesis
tezos-embedded-client-alpha tezos-embedded-client-alpha
test_lib)) test_lib))
(flags (:standard -w -9-32 -safe-string (flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives -open Tezos_base__TzPervasives
-open Tezos_rpc_http
-open Tezos_embedded_protocol_environment_alpha -open Tezos_embedded_protocol_environment_alpha
-open Tezos_embedded_raw_protocol_alpha -open Tezos_embedded_raw_protocol_alpha
-open Tezos_client_base -open Tezos_client_base

50
test/proto_alpha/proto_alpha_helpers.ml
View File

@ -17,12 +17,12 @@ let rpc_config = ref {
Client_rpcs.host = "localhost" ; Client_rpcs.host = "localhost" ;
port = 8192 + Random.int 8192 ; port = 8192 + Random.int 8192 ;
tls = false ; tls = false ;
logger = Client_rpcs.null_logger ; logger = RPC_client.null_logger ;
} }
(* Context that does not write to alias files *) (* Context that does not write to alias files *)
let no_write_context config block : Client_commands.full_context = object let no_write_context config block : Client_commands.full_context = object
inherit Client_rpcs.rpc config inherit Client_rpcs.http_ctxt config
inherit Client_commands.logger (fun _ _ -> Lwt.return_unit) inherit Client_commands.logger (fun _ _ -> Lwt.return_unit)
method load : type a. string -> default:a -> a Data_encoding.encoding -> a Error_monad.tzresult Lwt.t = method load : type a. string -> default:a -> a Data_encoding.encoding -> a Error_monad.tzresult Lwt.t =
fun _ ~default _ -> return default fun _ ~default _ -> return default
@ -41,7 +41,7 @@ let dictator_sk =
let activate_alpha () = let activate_alpha () =
let fitness = Fitness_repr.from_int64 0L in let fitness = Fitness_repr.from_int64 0L in
Tezos_embedded_client_genesis.Client_proto_main.bake Tezos_embedded_client_genesis.Client_proto_main.bake
(new Client_rpcs.rpc !rpc_config) (`Head 0) (new Client_rpcs.http_ctxt !rpc_config) (`Head 0)
(Activate { protocol = Client_proto_main.protocol ; validation_passes = 1}) (Activate { protocol = Client_proto_main.protocol ; validation_passes = 1})
fitness dictator_sk fitness dictator_sk
@ -67,7 +67,7 @@ let init ?(sandbox = "sandbox.json") ?rpc_port () =
return (pid, hash) return (pid, hash)
let level block = let level block =
Client_proto_rpcs.Context.level (new Client_rpcs.rpc !rpc_config) block Client_proto_rpcs.Context.level (new Client_rpcs.http_ctxt !rpc_config) block
module Account = struct module Account = struct
@ -194,7 +194,7 @@ module Account = struct
~(account:t) ~(account:t)
~destination ~destination
~amount () = ~amount () =
Client_proto_context.transfer (new Client_rpcs.rpc !rpc_config) Client_proto_context.transfer (new Client_rpcs.http_ctxt !rpc_config)
block block
~source:account.contract ~source:account.contract
~src_pk:account.pk ~src_pk:account.pk
@ -224,7 +224,7 @@ module Account = struct
?delegate ?delegate
~fee ~fee
block block
(new Client_rpcs.rpc !rpc_config) (new Client_rpcs.http_ctxt !rpc_config)
() ()
let set_delegate let set_delegate
@ -235,7 +235,7 @@ module Account = struct
~src_pk ~src_pk
delegate_opt = delegate_opt =
Client_proto_context.set_delegate Client_proto_context.set_delegate
(new Client_rpcs.rpc !rpc_config) (new Client_rpcs.http_ctxt !rpc_config)
block block
~fee ~fee
contract contract
@ -244,12 +244,12 @@ module Account = struct
delegate_opt delegate_opt
let balance ?(block = `Prevalidation) (account : t) = let balance ?(block = `Prevalidation) (account : t) =
Client_proto_rpcs.Context.Contract.balance (new Client_rpcs.rpc !rpc_config) Client_proto_rpcs.Context.Contract.balance (new Client_rpcs.http_ctxt !rpc_config)
block account.contract block account.contract
(* TODO: gather contract related functions in a Contract module? *) (* TODO: gather contract related functions in a Contract module? *)
let delegate ?(block = `Prevalidation) (contract : Contract.t) = let delegate ?(block = `Prevalidation) (contract : Contract.t) =
Client_proto_rpcs.Context.Contract.delegate (new Client_rpcs.rpc !rpc_config) Client_proto_rpcs.Context.Contract.delegate (new Client_rpcs.http_ctxt !rpc_config)
block contract block contract
end end
@ -259,12 +259,12 @@ module Protocol = struct
open Account open Account
let voting_period_kind ?(block = `Prevalidation) () = let voting_period_kind ?(block = `Prevalidation) () =
Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.rpc !rpc_config) block Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.http_ctxt !rpc_config) block
let proposals ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) proposals = let proposals ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) proposals =
Client_node_rpcs.Blocks.info (new Client_rpcs.rpc !rpc_config) block >>=? fun block_info -> Client_node_rpcs.Blocks.info (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_info ->
Client_proto_rpcs.Context.next_level (new Client_rpcs.rpc !rpc_config) block >>=? fun next_level -> Client_proto_rpcs.Context.next_level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun next_level ->
Client_proto_rpcs.Helpers.Forge.Delegate.proposals (new Client_rpcs.rpc !rpc_config) block Client_proto_rpcs.Helpers.Forge.Delegate.proposals (new Client_rpcs.http_ctxt !rpc_config) block
~branch:block_info.hash ~branch:block_info.hash
~source:pk ~source:pk
~period:next_level.voting_period ~period:next_level.voting_period
@ -274,7 +274,7 @@ module Protocol = struct
return (Tezos_base.Operation.of_bytes_exn signed_bytes) return (Tezos_base.Operation.of_bytes_exn signed_bytes)
let ballot ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) ~proposal ballot = let ballot ?(block = `Prevalidation) ~src:({ pk; sk } : Account.t) ~proposal ballot =
let rpc = new Client_rpcs.rpc !rpc_config in let rpc = new Client_rpcs.http_ctxt !rpc_config in
Client_node_rpcs.Blocks.info rpc block >>=? fun block_info -> Client_node_rpcs.Blocks.info rpc block >>=? fun block_info ->
Client_proto_rpcs.Context.next_level rpc block >>=? fun next_level -> Client_proto_rpcs.Context.next_level rpc block >>=? fun next_level ->
Client_proto_rpcs.Helpers.Forge.Delegate.ballot rpc block Client_proto_rpcs.Helpers.Forge.Delegate.ballot rpc block
@ -408,7 +408,7 @@ module Assert = struct
end end
let check_protocol ?msg ~block h = let check_protocol ?msg ~block h =
Client_node_rpcs.Blocks.protocol (new Client_rpcs.rpc !rpc_config) block >>=? fun block_proto -> Client_node_rpcs.Blocks.protocol (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun block_proto ->
return @@ Assert.equal return @@ Assert.equal
?msg:(Assert.format_msg msg) ?msg:(Assert.format_msg msg)
~prn:Protocol_hash.to_b58check ~prn:Protocol_hash.to_b58check
@ -416,7 +416,7 @@ module Assert = struct
block_proto h block_proto h
let check_voting_period_kind ?msg ~block kind = let check_voting_period_kind ?msg ~block kind =
Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.rpc !rpc_config) block Client_proto_rpcs.Context.voting_period_kind (new Client_rpcs.http_ctxt !rpc_config) block
>>=? fun current_kind -> >>=? fun current_kind ->
return @@ Assert.equal return @@ Assert.equal
?msg:(Assert.format_msg msg) ?msg:(Assert.format_msg msg)
@ -434,7 +434,7 @@ module Baking = struct
| Ok nonce -> nonce in | Ok nonce -> nonce in
let seed_nonce_hash = Nonce.hash seed_nonce in let seed_nonce_hash = Nonce.hash seed_nonce in
Client_baking_forge.forge_block Client_baking_forge.forge_block
(new Client_rpcs.rpc !rpc_config) (new Client_rpcs.http_ctxt !rpc_config)
block block
~operations ~operations
~force:true ~force:true
@ -446,7 +446,7 @@ module Baking = struct
() ()
let endorsement_reward block = let endorsement_reward block =
Client_proto_rpcs.Header.priority (new Client_rpcs.rpc !rpc_config) block >>=? fun prio -> Client_proto_rpcs.Header.priority (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun prio ->
Baking.endorsement_reward ~block_priority:prio >|= Baking.endorsement_reward ~block_priority:prio >|=
Environment.wrap_error >>|? Environment.wrap_error >>|?
Tez.to_mutez Tez.to_mutez
@ -461,7 +461,7 @@ module Endorse = struct
source source
slot = slot =
let block = Client_rpcs.last_baked_block block in let block = Client_rpcs.last_baked_block block in
let rpc = new Client_rpcs.rpc !rpc_config in let rpc = new Client_rpcs.http_ctxt !rpc_config in
Client_node_rpcs.Blocks.info rpc block >>=? fun { hash ; _ } -> Client_node_rpcs.Blocks.info rpc block >>=? fun { hash ; _ } ->
Client_proto_rpcs.Helpers.Forge.Delegate.endorsement rpc Client_proto_rpcs.Helpers.Forge.Delegate.endorsement rpc
block block
@ -479,7 +479,7 @@ module Endorse = struct
delegate delegate
level = level =
Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate
(new Client_rpcs.rpc !rpc_config) ~max_priority ~first_level:level ~last_level:level (new Client_rpcs.http_ctxt !rpc_config) ~max_priority ~first_level:level ~last_level:level
block delegate () >>=? fun possibilities -> block delegate () >>=? fun possibilities ->
let slots = let slots =
List.map (fun (_,slot) -> slot) List.map (fun (_,slot) -> slot)
@ -490,7 +490,7 @@ module Endorse = struct
?slot ?slot
(contract : Account.t) (contract : Account.t)
block = block =
Client_proto_rpcs.Context.next_level (new Client_rpcs.rpc !rpc_config) block >>=? fun { level } -> Client_proto_rpcs.Context.next_level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun { level } ->
begin begin
match slot with match slot with
| Some slot -> return slot | Some slot -> return slot
@ -509,7 +509,7 @@ module Endorse = struct
let endorsers_list block = let endorsers_list block =
let get_endorser_list result (account : Account.t) level block = let get_endorser_list result (account : Account.t) level block =
Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate
(new Client_rpcs.rpc !rpc_config) block account.pkh (new Client_rpcs.http_ctxt !rpc_config) block account.pkh
~max_priority:16 ~max_priority:16
~first_level:level ~first_level:level
~last_level:level () >>|? fun slots -> ~last_level:level () >>|? fun slots ->
@ -517,7 +517,7 @@ module Endorse = struct
in in
let { Account.b1 ; b2 ; b3 ; b4 ; b5 } = Account.bootstrap_accounts in let { Account.b1 ; b2 ; b3 ; b4 ; b5 } = Account.bootstrap_accounts in
let result = Array.make 16 b1 in let result = Array.make 16 b1 in
Client_proto_rpcs.Context.level (new Client_rpcs.rpc !rpc_config) block >>=? fun level -> Client_proto_rpcs.Context.level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun level ->
let level = Raw_level.succ @@ level.level in let level = Raw_level.succ @@ level.level in
get_endorser_list result b1 level block >>=? fun () -> get_endorser_list result b1 level block >>=? fun () ->
get_endorser_list result b2 level block >>=? fun () -> get_endorser_list result b2 level block >>=? fun () ->
@ -529,7 +529,7 @@ module Endorse = struct
let endorsement_rights let endorsement_rights
?(max_priority = 1024) ?(max_priority = 1024)
(contract : Account.t) block = (contract : Account.t) block =
let rpc = new Client_rpcs.rpc !rpc_config in let rpc = new Client_rpcs.http_ctxt !rpc_config in
Client_proto_rpcs.Context.level rpc block >>=? fun level -> Client_proto_rpcs.Context.level rpc block >>=? fun level ->
let delegate = contract.pkh in let delegate = contract.pkh in
let level = level.level in let level = level.level in
@ -543,6 +543,6 @@ module Endorse = struct
end end
let display_level block = let display_level block =
Client_proto_rpcs.Context.level (new Client_rpcs.rpc !rpc_config) block >>=? fun lvl -> Client_proto_rpcs.Context.level (new Client_rpcs.http_ctxt !rpc_config) block >>=? fun lvl ->
Format.eprintf "Level: %a@." Level.pp_full lvl ; Format.eprintf "Level: %a@." Level.pp_full lvl ;
return () return ()