Debug: unmark invalid block

src/lib_client_base/client_debug.ml

@@ -107,12 +107,23 @@ let stuck_node_report cctxt file =
 
 let commands () =
   let open Cli_entries in
+  let group = { name = "debug" ;
+                title = "commands to debug and fix problems with the node" } in
   [
-    command ~desc: "debug report"
+    command ~group ~desc: "debug report"
       no_options
       (prefixes [ "debug" ; "stuck" ; "node" ]
        @@ string ~name:"file" ~desc:"file in which to save report"
        @@ stop)
-      (fun () file cctxt ->
+      (fun () file (cctxt : Client_commands.full_context) ->
-         stuck_node_report cctxt file)
+         stuck_node_report cctxt file) ;
+    command ~group ~desc: "unmark invalid"
+      no_options
+      (prefixes [ "debug" ; "unmark" ; "invalid" ]
+       @@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list"
+       @@ stop)
+      (fun () block (cctxt : Client_commands.full_context) ->
+         Client_rpcs.call_err_service0 cctxt Node_rpc_services.Blocks.unmark_invalid block >>=? fun () ->
+         cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return
+      )
   ]

src/lib_client_base/client_debug.mli

@@ -8,4 +8,4 @@
 (**************************************************************************)
 
 
-val commands : unit -> (#Client_commands.logging_rpcs, unit) Cli_entries.command list
+val commands : unit -> (Client_commands.full_context, unit) Cli_entries.command list

src/lib_node_services/node_rpc_services.ml

@@ -467,6 +467,16 @@ module Blocks = struct
       ~error: Data_encoding.empty
       RPC_path.(root / "invalid_blocks")
 
+  let unmark_invalid =
+    RPC_service.post_service
+      ~description:
+        "Unmark an invalid block"
+      ~query: RPC_query.empty
+      ~input:Data_encoding.(obj1 (req "block" Block_hash.encoding))
+      ~output:(Error.wrap Data_encoding.empty)
+      ~error: Data_encoding.empty
+      RPC_path.(root / "unmark_invalid")
+
 end
 
 module Protocols = struct

src/lib_node_services/node_rpc_services.mli

@@ -122,6 +122,9 @@ module Blocks : sig
      unit, unit, unit,
      (Block_hash.t * int32 * error list) list, unit) RPC_service.t
 
+  val unmark_invalid:
+    ([ `POST ], unit, unit, unit, Block_hash.t, unit tzresult, unit) RPC_service.t
+
   type preapply_param = {
     timestamp: Time.t ;
     proto_header: MBytes.t ;

src/lib_node_shell/node.ml

@@ -606,6 +606,9 @@ module RPC = struct
   let list_invalid node =
     State.Block.list_invalid (Net_validator.net_state node.mainnet_validator)
 
+  let unmark_invalid node block =
+    State.Block.unmark_invalid (Net_validator.net_state node.mainnet_validator) block
+
   let block_header_watcher node =
     Distributed_db.watch_block_header node.distributed_db
 

src/lib_node_shell/node.mli

@@ -67,6 +67,9 @@ module RPC : sig
   val list_invalid:
     t -> (Block_hash.t * int32 * error list) list Lwt.t
 
+  val unmark_invalid:
+    t -> Block_hash.t -> unit tzresult Lwt.t
+
   val block_info:
     t -> block -> block_info Lwt.t
 

src/lib_node_shell/node_rpc.ml

@@ -333,6 +333,10 @@ let list_invalid node () () =
   Node.RPC.list_invalid node >>= fun l ->
   RPC_answer.return l
 
+let unmark_invalid node () block =
+  Node.RPC.unmark_invalid node block >>= fun x ->
+  RPC_answer.return x
+
 let list_protocols node () {Services.Protocols.monitor; contents} =
   let monitor = match monitor with None -> false | Some x -> x in
   let include_contents = match contents with None -> false | Some x -> x in
@@ -377,6 +381,9 @@ let build_rpc_directory node =
   let dir =
     RPC_directory.register0 dir Services.Blocks.list_invalid
       (list_invalid node) in
+  let dir =
+    RPC_directory.register0 dir Services.Blocks.unmark_invalid
+      (unmark_invalid node) in
   let dir = register_bi_dir node dir in
   let dir =
     let implementation block =

src/lib_node_shell/state.ml

@@ -14,8 +14,11 @@ type error +=
 
 type error += Bad_data_dir
 
+type error += Block_not_invalid of Block_hash.t
+
 let () =
-  Error_monad.register_error_kind
+  let open Error_monad in
+  register_error_kind
     `Temporary
     ~id:"state.unknown_network"
     ~title:"Unknown network"
@@ -25,7 +28,7 @@ let () =
     Data_encoding.(obj1 (req "net" Net_id.encoding))
     (function Unknown_network x -> Some x | _ -> None)
     (fun x -> Unknown_network x) ;
-  Error_monad.register_error_kind
+  register_error_kind
     `Permanent
     ~id:"badDataDir"
     ~title:"Bad data directory"
@@ -37,6 +40,17 @@ let () =
     Data_encoding.empty
     (function Bad_data_dir -> Some () | _ -> None)
     (fun () -> Bad_data_dir) ;
+  register_error_kind
+    `Permanent
+    ~id:"blockNotInvalid"
+    ~title:"Block not invalid"
+    ~description:"The invalid block to be unmarked was not actually invalid."
+    ~pp:(fun ppf block ->
+        Format.fprintf ppf "Block %a was expected to be invalid, but was not actually invalid."
+          Block_hash.pp block)
+    Data_encoding.(obj1 (req "block" Block_hash.encoding))
+    (function Block_not_invalid block -> Some block | _ -> None)
+    (fun block -> Block_not_invalid block) ;
 
   (** *)
 
@@ -397,6 +411,13 @@ module Block = struct
         ~f:(fun hash { level ; errors } acc ->
             Lwt.return ((hash, level, errors) :: acc))
     end
+  let unmark_invalid net_state block =
+    Shared.use net_state.block_store begin fun store ->
+      Store.Block.Invalid_block.known store block >>= fun mem ->
+      if mem
+      then Store.Block.Invalid_block.remove store block >>= return
+      else fail (Block_not_invalid block)
+    end
 
   let known net_state hash =
     Shared.use net_state.block_store begin fun store ->

src/lib_node_shell/state.mli

@@ -99,6 +99,7 @@ module Block : sig
   val known_invalid: Net.t -> Block_hash.t -> bool Lwt.t
   val read_invalid: Net.t -> Block_hash.t -> Store.Block.invalid_block option Lwt.t
   val list_invalid: Net.t -> (Block_hash.t * int32 * error list) list Lwt.t
+  val unmark_invalid: Net.t -> Block_hash.t -> unit tzresult Lwt.t
 
   val read: Net.t -> Block_hash.t -> block tzresult Lwt.t
   val read_opt: Net.t -> Block_hash.t -> block option Lwt.t