ligo/src/lib_shell/worker_directory.ml

93 lines
3.6 KiB
OCaml
Raw Normal View History

(**************************************************************************)
(* *)
(* 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 =
let dir : unit RPC_directory.t ref = ref RPC_directory.empty in
let register0 s f =
dir := RPC_directory.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
let register2 s f =
dir := RPC_directory.register !dir s (fun (((), a), b) p q -> f a b p q) in
(* Workers : Prevalidators *)
register0 Worker_services.Prevalidators.S.list begin fun () () ->
return
(List.map
(fun (id, w) -> (id, Prevalidator.status w))
(Prevalidator.running_workers ()))
end ;
register1 Worker_services.Prevalidators.S.state begin fun chain () () ->
Chain_directory.get_chain_id state chain >>= fun chain_id ->
let w = List.assoc chain_id (Prevalidator.running_workers ()) in
return
{ Worker_types.status = Prevalidator.status w ;
pending_requests = Prevalidator.pending_requests w ;
backlog = Prevalidator.last_events w ;
current_request = Prevalidator.current_request w }
end ;
(* Workers : Block_validator *)
register0 Worker_services.Block_validator.S.state begin fun () () ->
let w = Block_validator.running_worker () in
return
{ Worker_types.status = Block_validator.status w ;
pending_requests = Block_validator.pending_requests w ;
backlog = Block_validator.last_events w ;
current_request = Block_validator.current_request w }
end ;
(* Workers : Peer validators *)
register1 Worker_services.Peer_validators.S.list begin fun chain () () ->
Chain_directory.get_chain_id state chain >>= fun chain_id ->
return
(List.filter_map
(fun ((id, peer_id), w) ->
if Chain_id.equal id chain_id then
Some (peer_id, Peer_validator.status w)
else None)
(Peer_validator.running_workers ()))
end ;
register2 Worker_services.Peer_validators.S.state begin fun chain peer_id () () ->
Chain_directory.get_chain_id state chain >>= fun chain_id ->
let w = List.assoc (chain_id, peer_id) (Peer_validator.running_workers ()) in
return
{ Worker_types.status = Peer_validator.status w ;
pending_requests = [] ;
backlog = Peer_validator.last_events w ;
current_request = Peer_validator.current_request w }
end ;
(* Workers : Net validators *)
register0 Worker_services.Chain_validators.S.list begin fun () () ->
return
(List.map
(fun (id, w) -> (id, Chain_validator.status w))
(Chain_validator.running_workers ()))
end ;
register1 Worker_services.Chain_validators.S.state begin fun chain () () ->
Chain_directory.get_chain_id state chain >>= fun chain_id ->
let w = List.assoc chain_id (Chain_validator.running_workers ()) in
return
{ Worker_types.status = Chain_validator.status w ;
pending_requests = Chain_validator.pending_requests w ;
backlog = Chain_validator.last_events w ;
current_request = Chain_validator.current_request w }
end ;
!dir