Client: allow the baker te re-read keys.

Is a new key is added, the baker will start baking for this key.
No need to relauch the baker anymore.

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 ->

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 ->

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" }

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

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

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
         "@[<v 2>Error(s) while scheduling endorsements@,%a@]"

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 () ->

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 ()
 

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