From 8d2e302f1aafdd3aedfd49925a02f55d1623cb8a Mon Sep 17 00:00:00 2001
From: Vincent Botbol <vincent.botbol@tezcore.com>
Date: Mon, 8 Oct 2018 15:54:01 +0200
Subject: [PATCH] Alpha/Baker: add a context's consistency check before
 starting the baker

---
 .../lib_delegate/client_baking_forge.ml       |  1 +
 .../lib_delegate/client_baking_simulator.ml   | 34 +++++++++++++++----
 .../lib_delegate/client_baking_simulator.mli  |  3 ++
 3 files changed, 32 insertions(+), 6 deletions(-)

diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml
index 275f53b79..3f09c777f 100644
--- a/src/proto_alpha/lib_delegate/client_baking_forge.ml
+++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml
@@ -991,6 +991,7 @@ let create
     let constants =
       tzlazy (fun () -> Alpha_services.Constants.all cctxt (`Main, `Hash (bi.Client_baking_blocks.hash, 0))) in
     Client_baking_simulator.load_context ~context_path >>= fun index ->
+    Client_baking_simulator.check_context_consistency index bi.context >>=? fun () ->
     let state = create_state ?fee_threshold  ~max_waiting_time genesis_hash  context_path index delegates constants in
     return state
   in
diff --git a/src/proto_alpha/lib_delegate/client_baking_simulator.ml b/src/proto_alpha/lib_delegate/client_baking_simulator.ml
index 7f58f6b64..8123dae2c 100644
--- a/src/proto_alpha/lib_delegate/client_baking_simulator.ml
+++ b/src/proto_alpha/lib_delegate/client_baking_simulator.ml
@@ -26,21 +26,33 @@
 open Proto_alpha
 open Alpha_context
 
-type error +=
-  | Failed_to_checkout_context
+type error += Failed_to_checkout_context
+type error += Invalid_context
 
 let () =
   register_error_kind
     `Permanent
     ~id:"Client_baking_simulator.failed_to_checkout_context"
-    ~title: "Fail during checkout context"
-    ~description: ""
-    ~pp:(fun ppf () -> Format.fprintf ppf "@[Failed to checkout the context@]")
+    ~title: "Failed to checkout context"
+    ~description: "The given context hash does not exists in the context."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Failed to checkout the context")
     Data_encoding.unit
     (function
       | Failed_to_checkout_context -> Some ()
       | _ -> None)
-    (fun () -> Failed_to_checkout_context)
+    (fun () -> Failed_to_checkout_context) ;
+  register_error_kind
+    `Permanent
+    ~id:"Client_baking_simulator.invalid_context"
+    ~title: "Invalid context"
+    ~description: "Occurs when the context is inconsistent."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "The given context is invalid.")
+    Data_encoding.unit
+    (function
+      | Invalid_context -> Some ()
+      | _ -> None)
+    (fun () -> Invalid_context)
 
 type incremental = {
   predecessor: Client_baking_blocks.block_info ;
@@ -53,6 +65,16 @@ type incremental = {
 let load_context ~context_path =
   Context.init ~readonly:true context_path
 
+let check_context_consistency index context_hash =
+  (* Hypothesis : the version key exists *)
+  let version_key = ["version"] in
+  Context.checkout index context_hash >>= function
+  | None -> fail Failed_to_checkout_context
+  | Some context ->
+      Context.mem context version_key >>= function
+      | true -> return_unit
+      | false -> fail Invalid_context
+
 let begin_construction ~timestamp ?protocol_data index predecessor =
   let { Client_baking_blocks.context } = predecessor in
   Context.checkout index context >>= function
diff --git a/src/proto_alpha/lib_delegate/client_baking_simulator.mli b/src/proto_alpha/lib_delegate/client_baking_simulator.mli
index 4733f1d20..f2c2b91bb 100644
--- a/src/proto_alpha/lib_delegate/client_baking_simulator.mli
+++ b/src/proto_alpha/lib_delegate/client_baking_simulator.mli
@@ -36,6 +36,9 @@ type incremental = {
 
 val load_context : context_path:string -> Context.index Lwt.t
 
+(** Make sure that the given context is consistent by trying to read in it *)
+val check_context_consistency : Context.index -> Context_hash.t -> unit tzresult Lwt.t
+
 val begin_construction : timestamp:Time.t -> ?protocol_data: block_header_data -> Context.index -> Client_baking_blocks.block_info -> incremental tzresult Lwt.t
 
 val add_operation : incremental -> Operation.packed -> incremental tzresult Lwt.t