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

Alpha: even simpler endorser

Browse Source
This commit is contained in:
Grégoire Henry 2018-06-19 02:46:20 +02:00
parent c55a462233
commit ee2a126f3e
2 changed files with 58 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -54,7 +54,7 @@ let previously_endorsed_level cctxt pkh new_lvl =
let forge_endorsement (cctxt : #Proto_alpha.full) let forge_endorsement (cctxt : #Proto_alpha.full)
?(chain = `Main) block ?async ?(chain = `Main) block ?async
~src_sk ?slots src_pk = ~src_sk src_pk =
let src_pkh = Signature.Public_key.hash src_pk in let src_pkh = Signature.Public_key.hash src_pk in
Alpha_block_services.metadata cctxt Alpha_block_services.metadata cctxt
~chain ~block () >>=? fun { protocol_data = { level = { level } } } -> ~chain ~block () >>=? fun { protocol_data = { level = { level } } } ->
@ -64,43 +64,33 @@ let forge_endorsement (cctxt : #Proto_alpha.full)
cctxt#error "Level %a : previously endorsed." cctxt#error "Level %a : previously endorsed."
Raw_level.pp level Raw_level.pp level
| false -> | false ->
begin
match slots with
| Some slots -> return slots
| None ->
get_signing_slots
cctxt ~chain block src_pkh level >>=? function
| None -> cctxt#error "No slot found at level %a" Raw_level.pp level
| Some slots -> return slots
end >>=? fun slots ->
Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash -> Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
inject_endorsement cctxt ~chain ?async block hash level src_sk src_pkh >>=? fun oph -> inject_endorsement cctxt ~chain ?async block hash level src_sk src_pkh >>=? fun oph ->
Client_keys.get_key cctxt src_pkh >>=? fun (name, _pk, _sk) -> Client_keys.get_key cctxt src_pkh >>=? fun (name, _pk, _sk) ->
cctxt#message cctxt#message
"Injected endorsement level %a, contract %s '%a', slots @[<h>%a@]" "Injected endorsement level %a, contract %s '%a'"
Raw_level.pp level Raw_level.pp level
name name
Operation_hash.pp_short oph Operation_hash.pp_short oph >>= fun () ->
(Format.pp_print_list Format.pp_print_int) slots return oph
>>=
fun () -> return oph
(** Worker *) (** Worker *)
type state = { type state = {
delegates: public_key_hash list ; delegates: public_key_hash list ;
delay: int64 ; delay: int64 ;
to_endorse : endorsement Signature.Public_key_hash.Table.t ; mutable pending: endorsements option ;
} }
and endorsement = {
and endorsements = {
time: Time.t ; time: Time.t ;
timeout: unit Lwt.t ; timeout: unit Lwt.t ;
delegate: public_key_hash ; delegates: public_key_hash list ;
block: Client_baking_blocks.block_info ; block: Client_baking_blocks.block_info ;
} }
let create_state delegates delay = let create_state delegates delay =
{ delegates ; delay ; to_endorse = Signature.Public_key_hash.Table.create 5 } { delegates ; delay ; pending = None }
let get_delegates cctxt state = let get_delegates cctxt state =
match state.delegates with match state.delegates with
@ -110,7 +100,7 @@ let get_delegates cctxt state =
| _ :: _ as delegates -> | _ :: _ as delegates ->
return delegates return delegates
let endorse_for_delegate cctxt { delegate ; block } = let endorse_for_delegate cctxt block delegate =
let { Client_baking_blocks.hash ; level } = block in let { Client_baking_blocks.hash ; level } = block in
let b = `Hash (hash, 0) in let b = `Hash (hash, 0) in
Client_keys.get_key cctxt delegate >>=? fun (name, _pk, sk) -> Client_keys.get_key cctxt delegate >>=? fun (name, _pk, sk) ->
@ -127,80 +117,61 @@ let endorse_for_delegate cctxt { delegate ; block } =
Raw_level.pp level Raw_level.pp level
name name
Operation_hash.pp_short oph >>= fun () -> Operation_hash.pp_short oph >>= fun () ->
lwt_log_info
"Injected endorsement level %a, contract %s '%a'"
Raw_level.pp level
name
Operation_hash.pp_short oph >>= fun () ->
return () return ()
let endorse_for cctxt table = let allowed_to_endorse cctxt bi delegate =
let done_waiting = ref [] in
Signature.Public_key_hash.Table.filter_map_inplace
(fun _ ({ timeout } as endorsement) ->
match Lwt.state timeout with
| Lwt.Return () ->
done_waiting := endorsement :: !done_waiting ;
None
| Lwt.Sleep ->
Some endorsement
| Lwt.Fail exn ->
log_error "Endorsement failure: %s" (Printexc.to_string exn) ;
None)
table ;
iter_p (endorse_for_delegate cctxt) !done_waiting
let allowed_to_endorse cctxt state (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 "Checking if allowed to endorse block %a for %s" lwt_debug "Checking if allowed to endorse block %a for %s"
Block_hash.pp_short block.hash name >>= fun () -> Block_hash.pp_short bi.Client_baking_blocks.hash name >>= fun () ->
let b = `Hash (block.hash, 0) in let b = `Hash (bi.hash, 0) in
let level = block.level in let level = bi.level in
get_signing_slots cctxt b delegate level >>=? function get_signing_slots cctxt b delegate level >>=? function
| None -> | None | Some [] ->
lwt_debug "No slot found for %a/%s" lwt_debug "No slot found for %a/%s"
Block_hash.pp_short block.hash name >>= fun () -> Block_hash.pp_short bi.hash name >>= fun () ->
return () return false
| Some slots -> | Some (_ :: _ as slots) ->
lwt_debug "Found slots for %a/%s (%d)" lwt_debug "Found slots for %a/%s (%d)"
Block_hash.pp_short block.hash name (List.length slots) >>= fun () -> Block_hash.pp_short bi.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 (or higher) previously endorsed: do not endorse." lwt_debug "Level %a (or higher) previously endorsed: do not endorse."
Raw_level.pp level >>= fun () -> Raw_level.pp level >>= fun () ->
return () return false
| false -> | false ->
match Client_baking_scheduling.sleep_until time with return true
| None ->
lwt_debug "Endorsment opportunity is passed." >>= fun () ->
return ()
| Some timeout ->
let neu = { time ; timeout ; delegate ; block } in
Signature.Public_key_hash.Table.add state.to_endorse delegate neu ;
return ()
let prepare_endorsement (cctxt : #Proto_alpha.full) ~(max_past:int64) state bi = let prepare_endorsement (cctxt : #Proto_alpha.full) ~(max_past:int64) state bi =
get_delegates cctxt state >>=? fun delegates -> if Time.diff (Time.now ()) bi.Client_baking_blocks.timestamp > max_past then
Signature.Public_key_hash.Table.clear state.to_endorse ; lwt_log_info "Ignore block %a: forged too far the past"
iter_p Block_hash.pp_short bi.hash >>= fun () ->
(fun delegate -> return ()
let open Client_baking_blocks in else
if Time.diff (Time.now ()) bi.timestamp > max_past then lwt_log_info "Received new block %a"
lwt_log_info "Ignore block %a: forged too far the past" Block_hash.pp_short bi.hash >>= fun () ->
Block_hash.pp_short bi.hash >>= return let time = Time.(add (now ()) state.delay) in
else let timeout = Lwt_unix.sleep (Int64.to_float state.delay) in
let time = Time.(add (now ()) state.delay) in get_delegates cctxt state >>=? fun delegates ->
allowed_to_endorse cctxt state bi delegate time filter_map_p
) (fun delegate ->
delegates allowed_to_endorse cctxt bi delegate >>=? function
| true -> return (Some delegate)
| false -> return None)
delegates >>=? fun delegates ->
state.pending <- Some {
time ;
timeout ;
block = bi ;
delegates ;
} ;
return ()
let compute_timeout state = let compute_timeout state =
match Signature.Public_key_hash.Table.fold match state.pending with
(fun _ v acc -> v :: acc) | None -> Lwt_utils.never_ending ()
state.to_endorse [] with | Some { timeout ; block ; delegates } ->
| [] -> Lwt_utils.never_ending () timeout >>= fun () ->
| to_ends -> Lwt.return (`Timeout (block, delegates))
Lwt.choose (List.map (fun to_end -> to_end.timeout) to_ends)
let check_error f = let check_error f =
f >>= function f >>= function
@ -229,25 +200,22 @@ let create
(* main loop *) (* main loop *)
let rec worker_loop () = let rec worker_loop () =
begin begin
let timeout = compute_timeout state in Lwt.choose [ compute_timeout state ;
Lwt.choose [ (timeout >|= fun () -> `Timeout) ;
(get_block () >|= fun b -> `Hash b) ] >>= function (get_block () >|= fun b -> `Hash b) ] >>= function
| `Hash None -> | `Hash None ->
last_get_block := None; last_get_block := None ;
lwt_log_error "Connection to node lost, exiting." >>= fun () -> lwt_log_error "Connection to node lost, exiting." >>= fun () ->
exit 1 exit 1
| `Hash (Some (Error _)) -> | `Hash (Some (Error _)) ->
last_get_block := None; last_get_block := None ;
Lwt.return_unit Lwt.return_unit
| `Hash (Some (Ok bi)) -> | `Hash (Some (Ok bi)) ->
last_get_block := None; last_get_block := None ;
state.pending <- None ;
check_error @@ prepare_endorsement cctxt ~max_past state bi check_error @@ prepare_endorsement cctxt ~max_past state bi
| `Timeout -> | `Timeout (block, delegates) ->
endorse_for cctxt state.to_endorse >>= function state.pending <- None ;
| Ok () -> check_error @@ iter_p (endorse_for_delegate cctxt block) delegates
Lwt.return_unit
| Error errs ->
lwt_log_error "Error while endorsing:@\n%a" pp_print_error errs
end >>= fun () -> end >>= fun () ->
worker_loop () in worker_loop () in

1
src/proto_alpha/lib_delegate/client_baking_endorsement.mli
View File

@ -16,7 +16,6 @@ val forge_endorsement:
Block_services.block -> Block_services.block ->
?async: bool -> ?async: bool ->
src_sk:Client_keys.sk_uri -> src_sk:Client_keys.sk_uri ->
?slots:int list ->
public_key -> public_key ->
Operation_hash.t tzresult Lwt.t Operation_hash.t tzresult Lwt.t