From f221e2144441a12956ba1375cf7d930eadd58530 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= <code@bnwr.net>
Date: Thu, 14 Jun 2018 14:02:25 +0800
Subject: [PATCH] Alpha/Baker: keeping future slot for each delegate
---
.../lib_delegate/client_baking_forge.ml | 78 ++++++++++++-------
1 file changed, 48 insertions(+), 30 deletions(-)
diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml
index 9bb60e4a1..2a0bd0ca2 100644
--- a/src/proto_alpha/lib_delegate/client_baking_forge.ml
+++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml
@@ -344,16 +344,23 @@ let get_baking_slot cctxt
| Error errs ->
log_error "Error while fetching baking possibilities:\n%a"
pp_print_error errs ;
- Lwt.return_none
+ Lwt.return []
| Ok [] ->
- Lwt.return_none
- | Ok ((slot : Alpha_services.Delegate.Baking_rights.t) :: _) ->
- match slot.timestamp with
- | None -> Lwt.return_none
- | Some timestamp ->
- Lwt.return_some (timestamp, (bi, slot.priority, slot.delegate))
+ Lwt.return []
+ | Ok slots ->
+ let slots =
+ List.filter_map
+ (function
+ | { Alpha_services.Delegate.Baking_rights.timestamp = None } -> None
+ | { timestamp = Some timestamp ; priority ; delegate } ->
+ Some (timestamp, (bi, priority, delegate))
+ )
+ slots
+ in
+ Lwt.return slots
let rec insert_baking_slot slot = function
+ (* This is just a sorted-insert *)
| [] -> [slot]
| ((timestamp,_) :: _) as slots when Time.(fst slot < timestamp) ->
slot :: slots
@@ -380,20 +387,22 @@ 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, _) :: _ ->
- let now = Time.now () in
- let delay = Time.diff timestamp now in
- if delay <= 0L then
- if delay <= -1800L then
- Lwt_unix.sleep 10.
- else
- Lwt.return_unit
- else
- Lwt_unix.sleep (Int64.to_float delay)
+ match compute_timeout timestamp with
+ | None -> Lwt_utils.never_ending
+ | Some timeout -> timeout
let get_unrevealed_nonces
(cctxt : #Proto_alpha.full) ?(force = false) ?(chain = `Main) block =
@@ -459,18 +468,26 @@ let insert_block
end ;
get_delegates cctxt state >>=? fun delegates ->
get_baking_slot cctxt ?max_priority bi delegates >>= function
- | None ->
+ | [] ->
lwt_debug
- "Can't compute slot for %a" Block_hash.pp_short bi.hash >>= fun () ->
- return ()
- | Some ((timestamp, (_,_,delegate)) as slot) ->
- Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
- lwt_log_info "New baking slot at %a for %s after %a"
- Time.pp_hum timestamp
- name
- Block_hash.pp_short bi.hash >>= fun () ->
- state.future_slots <- insert_baking_slot slot state.future_slots ;
+ "Can't compute slots for %a" Block_hash.pp_short bi.hash >>= fun () ->
return ()
+ | (_ :: _) as slots ->
+ iter_p
+ (fun ((timestamp, (_, _, delegate)) as slot) ->
+ Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
+ lwt_log_info "New baking slot at %a for %s after %a"
+ Time.pp_hum timestamp
+ name
+ Block_hash.pp_short bi.hash >>= fun () ->
+ (* FIXME: the timestamp returned by [get_baking_slot] is always now.
+ This needs a proper fix, but in the meantime, we artifically
+ increase this time to be able to work on the rest of the code. *)
+ let slot = (Time.(max (add (now ()) 60L) (fst slot)), snd slot) in
+ state.future_slots <- insert_baking_slot slot state.future_slots ;
+ return ()
+ )
+ slots
let pop_baking_slots state =
let now = Time.now () in
@@ -568,12 +585,16 @@ let pp_operation_list_list =
information (e.g., slot) is available in the [state]. *)
let bake (cctxt : #Proto_alpha.full) state =
let slots = pop_baking_slots state in
+ lwt_log_info "Found %d current slots and %d future slots."
+ (List.length slots)
+ (List.length state.future_slots) >>= fun () ->
let seed_nonce = generate_seed_nonce () in
let seed_nonce_hash = Nonce.hash seed_nonce in
(* baking for each slot *)
filter_map_s (bake_slot cctxt state seed_nonce_hash) slots >>=? fun candidates ->
+ (* FIXME: pick one block per-delegate *)
(* selecting the candidate baked block *)
let candidates = List.sort fittest candidates in
match candidates with
@@ -698,9 +719,6 @@ let create
(* 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
+ create cctxt ?max_priority delegates block_stream bi
in
wait_for_first_block ()
-