58 lines
2.3 KiB
OCaml
58 lines
2.3 KiB
OCaml
|
(**************************************************************************)
|
||
|
|
(* *)
|
||
|
|
(* Copyright (c) 2014 - 2018. *)
|
||
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
||
|
|
(* *)
|
||
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
||
|
|
(* *)
|
||
|
|
(**************************************************************************)
|
||
|
|
|
||
|
|
let build_rpc_directory state distributed_db =
|
||
|
|
|
||
|
|
let dir : unit RPC_directory.t ref = ref RPC_directory.empty in
|
||
|
|
let gen_register0 s f =
|
||
|
|
dir := RPC_directory.gen_register !dir s (fun () p q -> f p q) in
|
||
|
|
let register1 s f =
|
||
|
|
dir := RPC_directory.register !dir s (fun ((), a) p q -> f a p q) in
|
||
|
|
|
||
|
|
gen_register0 Protocol_services.S.list begin fun () p ->
|
||
|
|
let { Protocol_services.S.monitor ; contents } = p in
|
||
|
|
let monitor = match monitor with None -> false | Some x -> x in
|
||
|
|
let include_contents = match contents with None -> false | Some x -> x in
|
||
|
|
State.Protocol.list state >>= fun set ->
|
||
|
|
let protocols = Protocol_hash.Set.elements set in
|
||
|
|
Lwt_list.map_p
|
||
|
|
(fun hash ->
|
||
|
|
if include_contents then
|
||
|
|
State.Protocol.read state hash >>= function
|
||
|
|
| Error _ -> Lwt.return (hash, None)
|
||
|
|
| Ok bytes -> Lwt.return (hash, Some bytes)
|
||
|
|
else
|
||
|
|
Lwt.return (hash, None))
|
||
|
|
protocols >>= fun protocols ->
|
||
|
|
if not monitor then
|
||
|
|
RPC_answer.return protocols
|
||
|
|
else
|
||
|
|
let stream, stopper =
|
||
|
|
Distributed_db.Protocol.watch distributed_db in
|
||
|
|
let shutdown () = Lwt_watcher.shutdown stopper in
|
||
|
|
let first_request = ref true in
|
||
|
|
let next () =
|
||
|
|
if not !first_request then
|
||
|
|
Lwt_stream.get stream >>= function
|
||
|
|
| None -> Lwt.return_none
|
||
|
|
| Some (h, op) when include_contents -> Lwt.return (Some [h, Some op])
|
||
|
|
| Some (h, _) -> Lwt.return (Some [h, None])
|
||
|
|
else begin
|
||
|
|
first_request := false ;
|
||
|
|
Lwt.return (Some protocols)
|
||
|
|
end in
|
||
|
|
RPC_answer.return_stream { next ; shutdown }
|
||
|
|
end;
|
||
|
|
|
||
|
|
register1 Protocol_services.S.contents begin fun hash () () ->
|
||
|
|
State.Protocol.read state hash
|
||
|
|
end ;
|
||
|
|
|
||
|
|
!dir
|