139 lines
4.5 KiB
OCaml
139 lines
4.5 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Copyright (c) 2014 - 2017. *)
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
module Client = Resto_cohttp.Client.Make(RPC_encoding)
|
|
|
|
type config = {
|
|
host : string ;
|
|
port : int ;
|
|
tls : bool ;
|
|
logger : RPC_client.logger ;
|
|
}
|
|
|
|
let config_encoding =
|
|
let open Data_encoding in
|
|
conv
|
|
(fun { host ; port ; tls } -> (host, port, tls))
|
|
(fun (host, port, tls) -> { host ; port ; tls ; logger = RPC_client.null_logger})
|
|
(obj3
|
|
(req "host" string)
|
|
(req "port" uint16)
|
|
(req "tls" bool))
|
|
|
|
let default_config = {
|
|
host = "localhost" ;
|
|
port = 8732 ;
|
|
tls = false ;
|
|
logger = RPC_client.null_logger ;
|
|
}
|
|
|
|
class type json_ctxt = object
|
|
method generic_json_call :
|
|
RPC_service.meth ->
|
|
?body:Data_encoding.json ->
|
|
Uri.t ->
|
|
(Data_encoding.json, Data_encoding.json option) RPC_client.rest_result Lwt.t
|
|
end
|
|
|
|
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
|
|
|
|
class http_ctxt config : ctxt =
|
|
let base =
|
|
Uri.make
|
|
~scheme:(if config.tls then "https" else "http")
|
|
~host:config.host
|
|
~port:config.port
|
|
() in
|
|
let logger = config.logger in
|
|
object
|
|
method generic_json_call meth ?body uri =
|
|
let uri = Uri.with_path base (Uri.path uri) in
|
|
let uri = Uri.with_query uri (Uri.query uri) in
|
|
RPC_client.generic_json_call ~logger meth ?body uri
|
|
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 =
|
|
fun service params query body ->
|
|
RPC_client.call_service Media_type.all_media_types ~logger ~base service params query body
|
|
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 =
|
|
fun service ~on_chunk ~on_close params query body ->
|
|
RPC_client.call_streamed_service Media_type.all_media_types service
|
|
~logger ~base ~on_chunk ~on_close params query body
|
|
end
|
|
|
|
let call_service (ctxt : #service_ctxt) service params query body =
|
|
ctxt#call_service service params query body
|
|
|
|
let call_err_service ctxt service params query body =
|
|
call_service ctxt service params query body >>=? Lwt.return
|
|
|
|
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
|
|
|
|
(* Currified params *)
|
|
|
|
let call_service0 ctxt service body =
|
|
call_service ctxt service () () body
|
|
|
|
let call_service1 ctxt service a1 body =
|
|
call_service ctxt service ((), a1) () body
|
|
|
|
let call_service2 ctxt service a1 a2 body =
|
|
call_service ctxt service (((), a1), a2) () body
|
|
|
|
let call_streamed_service0 ctxt service body =
|
|
call_streamed_service ctxt service () () body
|
|
|
|
let call_streamed_service1 ctxt service a1 body =
|
|
call_streamed_service ctxt service ((), a1) () body
|
|
|
|
let call_err_service0 ctxt service body =
|
|
call_err_service ctxt service () () body
|
|
|
|
let call_err_service1 ctxt service a1 body =
|
|
call_err_service ctxt service ((), a1) () body
|
|
|
|
let call_err_service2 ctxt service a1 a2 body =
|
|
call_err_service ctxt service (((), a1), a2) () body
|
|
|
|
type block = Node_rpc_services.Blocks.block
|
|
|
|
let last_baked_block = function
|
|
| `Prevalidation -> `Head 0
|
|
| `Test_prevalidation -> `Test_head 0
|
|
| `Genesis | `Head _ | `Test_head _ | `Hash _ as block -> block
|