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

Alpha/daemons: some factorisation

Browse Source
This commit is contained in:
Raphaël Proust 2018-06-14 14:24:33 +08:00 committed by Grégoire Henry
parent f221e21444
commit ac20391c62
4 changed files with 58 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/proto_alpha/lib_delegate/client_baking_endorsement.ml
View File

@ -206,12 +206,6 @@ let endorse_for cctxt = function
ignore errored; (* TODO: log *)
return still_waiting
let compute_timeout time =
let delay = Time.diff time (Time.now ()) in
if delay < 0L then
None
else
Some (Lwt_unix.sleep (Int64.to_float delay))
let allowed_to_endorse cctxt state (block: Client_baking_blocks.block_info) delegate time =
Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
@ -227,7 +221,7 @@ let allowed_to_endorse cctxt state (block: Client_baking_blocks.block_info) dele
lwt_debug "Level %a (or higher) previously endorsed: do not endorse."
Raw_level.pp level >>= return
| false ->
match compute_timeout time with
match Client_baking_scheduling.sleep_until time with
| None ->
lwt_debug "Endorsment opportunity is passed." >>= fun () ->
return ()
@ -336,13 +330,7 @@ let create
~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 ()
Client_baking_scheduling.wait_for_first_block
~info:cctxt#message
block_stream
(create cctxt ~max_past ~delay contracts block_stream)

23
src/proto_alpha/lib_delegate/client_baking_forge.ml
View File

@ -387,20 +387,13 @@ let drop_old_slots ~before state =
(fun (t, _slot) -> Time.compare before t <= 0)
state.future_slots
let compute_timeout time =
let delay = Time.diff time (Time.now ()) in
if delay < 0L then
None
else
Some (Lwt_unix.sleep (Int64.to_float delay))
let compute_timeout { future_slots } =
match future_slots with
| [] ->
(* No slots, just wait for new blocks which will give more info *)
Lwt_utils.never_ending
| (timestamp, _) :: _ ->
match compute_timeout timestamp with
match Client_baking_scheduling.sleep_until timestamp with
| None -> Lwt_utils.never_ending
| Some timeout -> timeout
@ -712,13 +705,7 @@ let create
?max_priority
(delegates: public_key_hash list)
(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_priority delegates block_stream bi
in
wait_for_first_block ()
Client_baking_scheduling.wait_for_first_block
~info:cctxt#message
block_stream
(create cctxt ?max_priority delegates block_stream)

31
src/proto_alpha/lib_delegate/client_baking_scheduling.ml Normal file
View File

@ -0,0 +1,31 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
let sleep_until time =
let delay = Time.diff time (Time.now ()) in
if delay < 0L then
None
else
Some (Lwt_unix.sleep (Int64.to_float delay))
let wait_for_first_block
?(info = fun (_: (unit Lwt.t, unit) Client_context.lwt_format) -> Lwt.return_unit)
(block_stream: Client_baking_blocks.block_info tzresult Lwt_stream.t)
k =
let rec wait_for_first_block () =
Lwt_stream.get block_stream >>= function
| None | Some (Error _) ->
info "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) ->
k bi
in
wait_for_first_block ()

17
src/proto_alpha/lib_delegate/client_baking_scheduling.mli Normal file
View File

@ -0,0 +1,17 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
val sleep_until: Time.t -> unit Lwt.t option
val wait_for_first_block:
?info:((unit Lwt.t, unit) Client_context.lwt_format -> unit Lwt.t) ->
Client_baking_blocks.block_info tzresult Lwt_stream.t ->
(Client_baking_blocks.block_info -> 'a Lwt.t) ->
'a Lwt.t