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

Alpha/endorser: minor simplifications and cosmetics

Browse Source
This commit is contained in:
Raphaël Proust 2018-06-13 11:35:26 +08:00 committed by Grégoire Henry
parent 28abac0fb9
commit a63584ad63
1 changed files with 58 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -53,16 +53,13 @@ end = struct
load wallet >>=? fun l -> load wallet >>=? fun l ->
let delegate_key = Signature.Public_key_hash.to_short_b58check delegate let delegate_key = Signature.Public_key_hash.to_short_b58check delegate
in in
let rec remove_old acc = function let remove_old l =
| [] -> List.rev acc List.filter
| ((_,lvl) as hd)::tl -> (fun (_, lvl) -> Raw_level.diff new_lvl lvl < 50l (* FIXME: magic constant*))
if Raw_level.diff new_lvl lvl < 50l (*?*) then l
remove_old (hd::acc) tl
else
List.rev acc
in in
save wallet ((delegate_key, new_lvl):: save wallet ((delegate_key, new_lvl)::
List.remove_assoc delegate_key (remove_old [] l)) List.remove_assoc delegate_key (remove_old l))
end) end)
end end
end end
@ -71,10 +68,9 @@ let get_signing_slots cctxt ?(chain = `Main) block delegate level =
Alpha_services.Delegate.Endorsing_rights.get cctxt Alpha_services.Delegate.Endorsing_rights.get cctxt
~levels:[level] ~levels:[level]
~delegates:[delegate] ~delegates:[delegate]
(chain, block) >>=? fun possibilities -> (chain, block) >>=? function
match possibilities with
| [{ slots }] -> return slots | [{ slots }] -> return slots
| _ -> return [] | _ -> (* TODO? log this case *) return []
let inject_endorsement let inject_endorsement
(cctxt : #Proto_alpha.full) (cctxt : #Proto_alpha.full)
@ -108,7 +104,7 @@ let previously_endorsed_level cctxt pkh new_lvl =
State.get_endorsement cctxt pkh >>=? function State.get_endorsement cctxt pkh >>=? function
| None -> return false | None -> return false
| Some last_lvl -> | Some last_lvl ->
return (not Raw_level.(last_lvl < new_lvl)) return (Raw_level.(last_lvl >= new_lvl))
let forge_endorsement (cctxt : #Proto_alpha.full) let forge_endorsement (cctxt : #Proto_alpha.full)
?(chain = `Main) block ?async ?(chain = `Main) block ?async
@ -187,10 +183,9 @@ let endorse_for cctxt = function
name name
Operation_hash.pp_short oph >>= return Operation_hash.pp_short oph >>= return
let prepare_endorsement (cctxt : #Proto_alpha.full) ~(max_past:int64) state bi = let allowed_to_endorse cctxt state (block: Client_baking_blocks.block_info) delegate time =
let may_endorse (block: Client_baking_blocks.block_info) delegate time =
Client_keys.Public_key_hash.name cctxt delegate >>=? fun name -> Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
lwt_log_info "May endorse block %a for %s" lwt_log_info "Checking if allowed to endorse block %a for %s"
Block_hash.pp_short block.hash name >>= fun () -> Block_hash.pp_short block.hash name >>= fun () ->
let b = `Hash (block.hash, 0) in let b = `Hash (block.hash, 0) in
let level = block.level.level in let level = block.level.level in
@ -199,17 +194,23 @@ let prepare_endorsement (cctxt : #Proto_alpha.full) ~(max_past:int64) state bi
Block_hash.pp_short block.hash name (List.length slots) >>= fun () -> Block_hash.pp_short block.hash name (List.length slots) >>= fun () ->
previously_endorsed_level cctxt delegate level >>=? function previously_endorsed_level cctxt delegate level >>=? function
| true -> | true ->
lwt_debug "Level %a : previously endorsed." lwt_debug "Level %a (or higher) previously endorsed: do not endorse."
Raw_level.pp level >>= return Raw_level.pp level >>= return
| false -> | false ->
return let neu = {time ; delegate ; block; slots} in
(match state.to_endorse with match state.to_endorse with
| None -> | None ->
state.to_endorse <- Some {time ; delegate ; block; slots} state.to_endorse <- Some neu;
return ()
| Some old -> | Some old ->
if Fitness.compare old.block.fitness block.fitness < 0 then if Fitness.compare old.block.fitness neu.block.fitness < 0 then begin
state.to_endorse <- Some {time ; delegate ; block; slots}) state.to_endorse <- Some neu;
in return ()
end else
lwt_debug "Block %a is not the fittest: do not endorse."
Block_hash.pp_short neu.block.hash >>= return
let prepare_endorsement (cctxt : #Proto_alpha.full) ~(max_past:int64) state bi =
get_delegates cctxt state >>=? fun delegates -> get_delegates cctxt state >>=? fun delegates ->
iter_p iter_p
(fun delegate -> (fun delegate ->
@ -222,7 +223,7 @@ let prepare_endorsement (cctxt : #Proto_alpha.full) ~(max_past:int64) state bi
Block_hash.pp_short bi.hash >>= return Block_hash.pp_short bi.hash >>= return
else else
let time = Time.(add (now ()) state.delay) in let time = Time.(add (now ()) state.delay) in
may_endorse bi delegate time allowed_to_endorse cctxt state bi delegate time
) )
delegates delegates
@ -239,37 +240,15 @@ let compute_timeout state =
let check_error f = let check_error f =
f >>= function f >>= function
| Ok () -> Lwt.return_unit | Ok () -> Lwt.return_unit
| Error errs -> | Error errs -> lwt_log_error "Error while endorsing:@\n%a" pp_print_error errs
lwt_log_error "Error while endorsing:@\n%a"
pp_print_error
errs >>= fun () ->
Lwt.return_unit
let compute_timeout state =
match state.to_endorse with
| None -> Lwt_utils.never_ending
| Some {time} ->
let delay = (Time.diff time (Time.now ())) in
if delay <= 0L then
Lwt.return_unit
else
Lwt_unix.sleep (Int64.to_float delay)
let check_error f =
f >>= function
| Ok () -> Lwt.return_unit
| Error errs ->
lwt_log_error "Error while endorsing:@\n%a"
pp_print_error
errs >>= fun () ->
Lwt.return_unit
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=110L) ~delay contracts (block_stream : Client_baking_blocks.block_info tzresult Lwt_stream.t) =
lwt_log_info "Starting endorsement daemon" >>= fun () -> lwt_log_info "Preparing endorsement daemon" >>= fun () ->
Lwt_stream.get block_stream >>= function Lwt_stream.get block_stream >>= function
| None | Some (Error _) -> | None | Some (Error _) ->
cctxt#error "Can't fetch the current block head." cctxt#error "Can't fetch the current block head."
| Some (Ok head) -> | Some (Ok head) ->
let last_get_block = ref None in let last_get_block = ref None in
let get_block () = let get_block () =
match !last_get_block with match !last_get_block with
@ -279,19 +258,25 @@ let create (cctxt : #Proto_alpha.full) ?(max_past=110L) ~delay contracts (block_
t t
| Some t -> t in | Some t -> t in
let state = create_state contracts (Int64.of_int delay) in let state = create_state contracts (Int64.of_int delay) in
let rec worker_loop () = let rec worker_loop () =
begin
let timeout = compute_timeout state in let timeout = compute_timeout state in
Lwt.choose [ (timeout >|= fun () -> `Timeout) ; Lwt.choose [ (timeout >|= fun () -> `Timeout) ;
(get_block () >|= fun b -> `Hash b) ] >>= function (get_block () >|= fun b -> `Hash b) ] >>= function
| `Hash (None | Some (Error _)) -> | `Hash (None | Some (Error _)) ->
Lwt.cancel timeout;
last_get_block := None;
Lwt.return_unit Lwt.return_unit
| `Hash (Some (Ok bi)) -> | `Hash (Some (Ok bi)) ->
Lwt.cancel timeout; Lwt.cancel timeout;
last_get_block := None; last_get_block := None;
check_error (prepare_endorsement cctxt ~max_past state bi) >>= fun () -> check_error (prepare_endorsement cctxt ~max_past state bi)
worker_loop ()
| `Timeout -> | `Timeout ->
check_error (endorse_for cctxt state.to_endorse) >>= fun () -> check_error (endorse_for cctxt state.to_endorse)
end >>= fun () ->
worker_loop () in worker_loop () in
check_error (prepare_endorsement cctxt ~max_past state head) >>= fun () -> check_error (prepare_endorsement cctxt ~max_past state head) >>= fun () ->
lwt_log_info "Starting endorsement daemon" >>= fun () ->
worker_loop () worker_loop ()