diff --git a/src/client/client_blocks.ml b/src/client/client_blocks.ml index aeb805ed4..9f3ef8003 100644 --- a/src/client/client_blocks.ml +++ b/src/client/client_blocks.ml @@ -7,6 +7,10 @@ (* *) (**************************************************************************) +let genesis = + Block_hash.of_b58check + "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z" + let get_block_hash cctxt = function | `Hash hash -> Lwt.return hash | `Genesis | `Head _ | `Test_head _ as block -> diff --git a/src/client/client_blocks.mli b/src/client/client_blocks.mli index 7aa55429a..dcf0cfb3d 100644 --- a/src/client/client_blocks.mli +++ b/src/client/client_blocks.mli @@ -7,6 +7,8 @@ (* *) (**************************************************************************) +val genesis: Block_hash.t + val get_block_hash: Client_commands.context -> Client_node_rpcs.Blocks.block -> diff --git a/src/client/client_keys.ml b/src/client/client_keys.ml index dac0a2d73..4c370223d 100644 --- a/src/client/client_keys.ml +++ b/src/client/client_keys.ml @@ -53,6 +53,19 @@ let get_key cctxt pkh = Secret_key.find cctxt n >>= fun sk -> return (n, pk, sk) +let get_keys cctxt = + Secret_key.load cctxt >>= + Lwt_list.filter_map_p begin fun (name, sk) -> + Lwt.catch begin fun () -> + Public_key.find cctxt name >>= fun pk -> + Public_key_hash.find cctxt name >>= fun pkh -> + Lwt.return (Some (name, pkh, pk, sk)) + end begin fun _ -> + Lwt.return_none + end + end + + let group = { Cli_entries.name = "keys" ; title = "Commands for managing cryptographic keys" } diff --git a/src/client/client_keys.mli b/src/client/client_keys.mli index 3c8b063b1..ecdc9f48e 100644 --- a/src/client/client_keys.mli +++ b/src/client/client_keys.mli @@ -19,5 +19,8 @@ val get_key: Public_key_hash.t -> ( string * Public_key.t * Secret_key.t ) tzresult Lwt.t +val get_keys: + Client_commands.context -> + ( string * Public_key_hash.t * Public_key.t * Secret_key.t ) list Lwt.t val commands: unit -> Client_commands.command list diff --git a/src/client/embedded/alpha/baker/client_mining_blocks.ml b/src/client/embedded/alpha/baker/client_mining_blocks.ml index 0d25c8bba..c084dc8da 100644 --- a/src/client/embedded/alpha/baker/client_mining_blocks.ml +++ b/src/client/embedded/alpha/baker/client_mining_blocks.ml @@ -50,8 +50,7 @@ let compare (bi1 : block_info) (bi2 : block_info) = | x -> x let sort_blocks cctxt ?(compare = compare) blocks = - Lwt_list.map_p (convert_block_info cctxt) blocks >|= fun blocks -> - let blocks = Utils.unopt_list blocks in + Lwt_list.filter_map_p (convert_block_info cctxt) blocks >|= fun blocks -> List.sort compare blocks let monitor cctxt diff --git a/src/client/embedded/alpha/baker/client_mining_endorsement.ml b/src/client/embedded/alpha/baker/client_mining_endorsement.ml index 43df7fe9c..4007a07ba 100644 --- a/src/client/embedded/alpha/baker/client_mining_endorsement.ml +++ b/src/client/embedded/alpha/baker/client_mining_endorsement.ml @@ -200,6 +200,11 @@ let rec insert ({time} as e) = function e :: l | e' :: l -> e' :: insert e l +let get_delegates cctxt state = + match state.delegates with + | [] -> Client_keys.get_keys cctxt >|= List.map (fun (_,pkh,_,_) -> pkh) + | _ :: _ as delegates -> Lwt.return delegates + let drop_old_endorsement ~before state = state.to_endorse <- List.filter @@ -268,12 +273,13 @@ let schedule_endorsements cctxt state bis = return ()) slots in let time = Time.(add (now ()) state.delay) in + get_delegates cctxt state >>= fun delegates -> iter_p (fun delegate -> iter_p (fun bi -> may_endorse bi delegate time) bis) - state.delegates >>= function + delegates >>= function | Error exns -> lwt_log_error "@[Error(s) while scheduling endorsements@,%a@]" diff --git a/src/client/embedded/alpha/baker/client_mining_forge.ml b/src/client/embedded/alpha/baker/client_mining_forge.ml index cda0d2197..aef5c5f2c 100644 --- a/src/client/embedded/alpha/baker/client_mining_forge.ml +++ b/src/client/embedded/alpha/baker/client_mining_forge.ml @@ -333,10 +333,23 @@ let get_unrevealed_nonces cctxt ?(force = false) block = | Revealed _ -> return None) blocks +let safe_get_unrevealed_nonces cctxt block = + get_unrevealed_nonces cctxt block >>= function + | Ok r -> Lwt.return r + | Error err -> + lwt_warn "Cannot read nonces: %a@." pp_print_error err >>= fun () -> + Lwt.return [] + + +let get_delegates cctxt state = + match state.delegates with + | [] -> Client_keys.get_keys cctxt >|= List.map (fun (_,pkh,_,_) -> pkh) + | _ :: _ as delegates -> Lwt.return delegates + let insert_block cctxt ?max_priority state (bi: Client_mining_blocks.block_info) = begin - get_unrevealed_nonces cctxt (`Hash bi.hash) >>=? fun nonces -> + safe_get_unrevealed_nonces cctxt (`Hash bi.hash) >>= fun nonces -> Client_mining_revelation.forge_seed_nonce_revelation cctxt ~force:true (`Hash bi.hash) (List.map snd nonces) end >>= fun _ignore_error -> @@ -345,7 +358,8 @@ let insert_block drop_old_slots ~before:(Time.add state.best.timestamp (-1800L)) state ; end ; - get_mining_slot cctxt ?max_priority bi state.delegates >>= function + get_delegates cctxt state >>= fun delegates -> + get_mining_slot cctxt ?max_priority bi delegates >>= function | None -> lwt_debug "Can't compute slot for %a" Block_hash.pp_short bi.hash >>= fun () -> diff --git a/src/client/embedded/alpha/client_proto_rpcs.ml b/src/client/embedded/alpha/client_proto_rpcs.ml index bb1c10f10..8ac00eccc 100644 --- a/src/client/embedded/alpha/client_proto_rpcs.ml +++ b/src/client/embedded/alpha/client_proto_rpcs.ml @@ -27,12 +27,20 @@ let call_service1 cctxt s block a1 = Client_node_rpcs.call_service1 cctxt (s Node_rpc_services.Blocks.proto_path) block a1 let call_error_service1 cctxt s block a1 = - call_service1 cctxt s block a1 >|= wrap_error + Lwt.catch begin fun () -> + call_service1 cctxt s block a1 >|= wrap_error + end begin fun exn -> + Lwt.return (Error [Exn exn]) + end let call_service2 cctxt s block a1 a2 = Client_node_rpcs.call_service2 cctxt (s Node_rpc_services.Blocks.proto_path) block a1 a2 let call_error_service2 cctxt s block a1 a2 = - call_service2 cctxt s block a1 a2 >|= wrap_error + Lwt.catch begin fun () -> + call_service2 cctxt s block a1 a2 >|= wrap_error + end begin fun exn -> + Lwt.return (Error [Exn exn]) + end module Constants = struct let errors cctxt block = @@ -58,7 +66,12 @@ end module Context = struct let level cctxt block = - call_error_service1 cctxt Services.Context.level block () + match block with + | `Genesis -> return Level.root + | `Hash h when Block_hash.equal Client_blocks.genesis h -> + return Level.root + | _ -> call_error_service1 cctxt Services.Context.level block () + let next_level cctxt block = call_error_service1 cctxt Services.Context.next_level block () diff --git a/src/client/embedded/genesis/client_proto_main.ml b/src/client/embedded/genesis/client_proto_main.ml index 25b30876b..14c325bfe 100644 --- a/src/client/embedded/genesis/client_proto_main.ml +++ b/src/client/embedded/genesis/client_proto_main.ml @@ -52,10 +52,9 @@ let commands () = ~desc:"Hardcoded fitness of the first block (integer)" (fun _ p -> Lwt.return (Int64.of_string p)) @@ prefixes [ "and" ; "key" ] @@ - param ~name:"password" ~desc:"Dictator's key" - (fun _ key -> - Lwt.return (Environment.Ed25519.Secret_key.of_b58check key)) - stop + Client_keys.Secret_key.source_param + ~name:"password" ~desc:"Dictator's key" @@ + stop end (fun hash fitness seckey cctxt -> let block = Client_config.block () in