From 7de4ed5622fa53e0498747f3925747de61d0e608 Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Wed, 28 Feb 2018 18:26:06 +0100 Subject: [PATCH] Alpha: fix the baker and endorser --- .../lib_baking/client_baking_endorsement.ml | 14 ++++----- .../lib_baking/client_baking_forge.ml | 30 +++++++++++-------- 2 files changed, 25 insertions(+), 19 deletions(-) diff --git a/src/proto_alpha/lib_baking/client_baking_endorsement.ml b/src/proto_alpha/lib_baking/client_baking_endorsement.ml index 80bbe1252..f39f2da42 100644 --- a/src/proto_alpha/lib_baking/client_baking_endorsement.ml +++ b/src/proto_alpha/lib_baking/client_baking_endorsement.ml @@ -195,7 +195,7 @@ let schedule_endorsements (cctxt : #Proto_alpha.full) state bis = lwt_log_info "May endorse block %a for %s" Block_hash.pp_short block.hash name >>= fun () -> let b = `Hash block.hash in - let level = Raw_level.succ block.level.level in + let level = block.level.level in get_signing_slots cctxt b delegate level >>=? fun slots -> lwt_debug "Found slots for %a/%s (%d)" Block_hash.pp_short block.hash name (List.length slots) >>= fun () -> @@ -218,7 +218,7 @@ let schedule_endorsements (cctxt : #Proto_alpha.full) state bis = then begin lwt_log_info "Schedule endorsement for block %a \ - \ (level %a, slot %d, time %a) (replace block %a)" + (level %a, slot %d, time %a) (replace block %a)" Block_hash.pp_short block.hash Raw_level.pp level slot @@ -241,7 +241,7 @@ let schedule_endorsements (cctxt : #Proto_alpha.full) state bis = with Not_found -> lwt_log_info "Schedule endorsement for block %a \ - \ (level %a, slot %d, time %a)" + (level %a, slot %d, time %a)" Block_hash.pp_short block.hash Raw_level.pp level slot @@ -284,7 +284,7 @@ let endorse cctxt state = (fun { delegate ; block ; slot } -> let hash = block.hash in let b = `Hash hash in - let level = Raw_level.succ block.level.level in + let level = block.level.level in previously_endorsed_slot cctxt level slot >>=? function | true -> return () | false -> @@ -292,11 +292,11 @@ let endorse cctxt state = lwt_debug "Endorsing %a for %s (slot %d)!" Block_hash.pp_short hash name slot >>= fun () -> inject_endorsement cctxt - b level ~async:true + b level sk [slot] >>=? fun oph -> cctxt#message "Injected endorsement for block '%a' \ - \ (level %a, slot %d, contract %s) '%a'" + (level %a, slot %d, contract %s) '%a'" Block_hash.pp_short hash Raw_level.pp level slot name @@ -345,7 +345,7 @@ let create (cctxt : #Proto_alpha.full) ~delay contracts block_stream = endorse cctxt state >>= function | Ok () -> Lwt.return_unit | Error errs -> - lwt_log_error "Error while endorsing:\n%a" + lwt_log_error "Error while endorsing:@\n%a" pp_print_error errs >>= fun () -> Lwt.return_unit diff --git a/src/proto_alpha/lib_baking/client_baking_forge.ml b/src/proto_alpha/lib_baking/client_baking_forge.ml index 705c81b09..d9432c960 100644 --- a/src/proto_alpha/lib_baking/client_baking_forge.ml +++ b/src/proto_alpha/lib_baking/client_baking_forge.ml @@ -458,8 +458,7 @@ let insert_blocks cctxt ?max_priority state bis = | Ok () -> Lwt.return_unit | Error err -> - Format.eprintf "Error: %a" pp_print_error err ; - Lwt.return_unit + lwt_log_error "Error: %a" pp_print_error err let bake (cctxt : #Proto_alpha.full) state = let slots = pop_baking_slots state in @@ -491,18 +490,22 @@ let bake (cctxt : #Proto_alpha.full) state = Block_services.preapply cctxt block ~timestamp ~sort:true ~protocol_data operations >>= function | Error errs -> - lwt_log_error "Error while prevalidating operations:\n%a" + lwt_log_error "Error while prevalidating operations:@\n%a" pp_print_error errs >>= fun () -> return None | Ok { operations ; shell_header } -> - let operations = List.hd operations in lwt_debug - "Computed condidate block after %a (slot %d): %d/%d fitness: %a" + "Computed candidate block after %a (slot %d): %a/%d fitness: %a" Block_hash.pp_short bi.hash priority - (List.length operations.applied) request - Fitness.pp shell_header.fitness - >>= fun () -> + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "+") + (fun ppf operations -> Format.fprintf ppf "%d" (List.length operations.Preapply_result.applied))) + operations + request + Fitness.pp shell_header.fitness >>= fun () -> + let operations = + List.map (fun l -> List.map snd l.Preapply_result.applied) operations in return (Some (bi, priority, shell_header, operations, delegate))) slots >>=? fun candidates -> @@ -530,20 +533,23 @@ let bake (cctxt : #Proto_alpha.full) state = inject_block cctxt ~force:true ~chain_id:bi.chain_id ~shell_header ~priority ~seed_nonce_hash ~src_sk - [List.map snd operations.applied] + operations |> trace_exn (Failure "Error while injecting block") >>=? fun block_hash -> State.record_block cctxt level block_hash seed_nonce |> trace_exn (Failure "Error while recording block") >>=? fun () -> Client_keys.Public_key_hash.name cctxt delegate >>=? fun name -> cctxt#message "Injected block %a for %s after %a \ - \ (level %a, slot %d, fitness %a, operations %d)" + \ (level %a, slot %d, fitness %a, operations %a)" Block_hash.pp_short block_hash name Block_hash.pp_short bi.hash Raw_level.pp level priority Fitness.pp shell_header.fitness - (List.length operations.applied) >>= fun () -> + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf "+") + (fun ppf operations -> Format.fprintf ppf "%d" (List.length operations))) + operations >>= fun () -> return () end | _ -> @@ -614,7 +620,7 @@ let create bake cctxt state >>= function | Ok () -> Lwt.return_unit | Error errs -> - lwt_log_error "Error while baking:\n%a" + lwt_log_error "Error while baking:@\n%a" pp_print_error errs >>= fun () -> Lwt.return_unit