Alpha/Endorser: wait for first block

This commit is contained in:
Raphaël Proust 2018-06-13 14:38:16 +08:00 committed by Grégoire Henry
parent f4cadd37a5
commit b0e9e44673

View File

@ -248,41 +248,65 @@ let check_error f =
| Ok () -> Lwt.return_unit | Ok () -> Lwt.return_unit
| Error errs -> lwt_log_error "Error while endorsing:@\n%a" pp_print_error errs | Error errs -> lwt_log_error "Error while endorsing:@\n%a" pp_print_error errs
let create (cctxt : #Proto_alpha.full) ?(max_past=110L) ~delay contracts (block_stream : Client_baking_blocks.block_info tzresult Lwt_stream.t) = let create
(cctxt: #Proto_alpha.full)
~max_past
~delay
contracts
block_stream
bi =
lwt_log_info "Preparing endorsement daemon" >>= fun () -> lwt_log_info "Preparing endorsement daemon" >>= fun () ->
Lwt_stream.get block_stream >>= function
| None | Some (Error _) ->
cctxt#error "Can't fetch the current block head."
| Some (Ok head) ->
let last_get_block = ref None in (* statefulness setup *)
let get_block () = let last_get_block = ref None in
match !last_get_block with let get_block () =
| None -> match !last_get_block with
let t = Lwt_stream.get block_stream in | None ->
last_get_block := Some t ; let t = Lwt_stream.get block_stream in
t last_get_block := Some t ;
| Some t -> t in t
let state = create_state contracts (Int64.of_int delay) in | Some t -> t in
let state = create_state contracts (Int64.of_int delay) in
let rec worker_loop () = (* main loop *)
begin let rec worker_loop () =
let timeout = compute_timeout state in begin
Lwt.choose [ (timeout >|= fun () -> `Timeout) ; let timeout = compute_timeout state in
(get_block () >|= fun b -> `Hash b) ] >>= function Lwt.choose [ (timeout >|= fun () -> `Timeout) ;
| `Hash (None | Some (Error _)) -> (get_block () >|= fun b -> `Hash b) ] >>= function
Lwt.cancel timeout; | `Hash (None | Some (Error _)) ->
last_get_block := None; Lwt.cancel timeout;
Lwt.return_unit last_get_block := None;
| `Hash (Some (Ok bi)) -> Lwt.return_unit
Lwt.cancel timeout; | `Hash (Some (Ok bi)) ->
last_get_block := None; Lwt.cancel timeout;
check_error (prepare_endorsement cctxt ~max_past state bi) last_get_block := None;
| `Timeout -> check_error (prepare_endorsement cctxt ~max_past state bi)
check_error (endorse_for cctxt state.to_endorse) | `Timeout ->
end >>= fun () -> check_error (endorse_for cctxt state.to_endorse)
worker_loop () in end >>= fun () ->
worker_loop () in
check_error (prepare_endorsement cctxt ~max_past state head) >>= fun () -> (* ignition *)
lwt_log_info "Starting endorsement daemon" >>= fun () -> check_error (prepare_endorsement cctxt ~max_past state bi) >>= fun () ->
worker_loop () lwt_log_info "Starting endorsement daemon" >>= fun () ->
worker_loop ()
(* A wrapper around the main create function (above) to wait for the initial
block. *)
let create
(cctxt: #Proto_alpha.full)
?(max_past=110L)
~delay
contracts
(block_stream: Client_baking_blocks.block_info tzresult Lwt_stream.t) =
let rec wait_for_first_block () =
Lwt_stream.get block_stream >>= function
| None | Some (Error _) ->
cctxt#message "Can't fetch the current block head. Retrying soon." >>= fun () ->
(* NOTE: this is not a tight loop because of Lwt_stream.get *)
wait_for_first_block ()
| Some (Ok bi) ->
create cctxt ~max_past ~delay contracts block_stream bi
in
wait_for_first_block ()