bin_node: sanity check on node identity file

src/bin_node/node_identity_file.ml

@@ -25,13 +25,21 @@
 
 type error += No_identity_file of string
 type error += Insufficient_proof_of_work of { expected: float }
+type error += Identity_mismatch of {
+    filename: string ;
+    peer_id: Crypto_box.Public_key_hash.t ;
+  }
+type error += Identity_keys_mismatch of {
+    filename: string ;
+    expected_key:Crypto_box.public_key ;
+  }
 
 let () =
   register_error_kind
     `Permanent
     ~id:"main.identity.no_file"
-    ~title:"TODO"
+    ~title:"No identity file"
-    ~description:"TODO"
+    ~description:"The node identity file cannot be found"
     ~pp:(fun ppf file ->
         Format.fprintf ppf
           "Cannot read the identity file: `%s`. \
@@ -45,8 +53,8 @@ let () =
   register_error_kind
     `Permanent
     ~id:"main.identity.insufficient_proof_of_work"
-    ~title:"TODO"
+    ~title:"Insufficient proof of work"
-    ~description:"TODO"
+    ~description:"The proof of work embeded by the current identity is not sufficient"
     ~pp:(fun ppf expected ->
         Format.fprintf ppf
           "The current identity does not embed a sufficient stamp of proof-of-work. \
@@ -57,22 +65,72 @@ let () =
     (function Insufficient_proof_of_work { expected } -> Some expected | _ -> None)
     (fun expected -> Insufficient_proof_of_work { expected })
 
-let read ?expected_pow file =
+
-  Lwt_unix.file_exists file >>= function
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"main.identity.identity_mismatch"
+    ~title:"Identity mismatch"
+    ~description:"The identity (public key hash) does not match the keys provided with it"
+    ~pp:(fun ppf (file, public_key_hash) ->
+        Format.fprintf ppf
+          "The current identity (public key hash) does not match the keys in %s.
+           Expected identity %a."
+          file
+          Crypto_box.Public_key_hash.pp
+          public_key_hash)
+    Data_encoding.(obj2 (req "file" string) (req "public_key_hash" Crypto_box.Public_key_hash.encoding))
+    (function Identity_mismatch { filename ; peer_id } ->
+       Some (filename, peer_id) | _ -> None)
+    (fun (filename,peer_id) -> Identity_mismatch { filename ; peer_id })
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"main.identity.identity_keys_mismatch"
+    ~title:"Identity keys mismatch"
+    ~description:"The current identity file has non-matching keys (secret key/ public key pair is not valid)"
+    ~pp:(fun ppf (file, public_key) ->
+        Format.fprintf ppf
+          "The current identity file %s has non-matching keys (secret key/ public key pair is not valid).
+           Expected public key %a."
+          file
+          Crypto_box.pp_pk
+          public_key)
+    Data_encoding.(obj2 (req "file" string) (req "public_key" Crypto_box.public_key_encoding))
+    (function
+      | Identity_keys_mismatch { filename ; expected_key } ->
+          Some (filename, expected_key)
+      | _ -> None)
+    (fun (filename, expected_key) ->
+       Identity_keys_mismatch { filename ; expected_key })
+
+let read ?expected_pow filename =
+  Lwt_unix.file_exists filename >>= function
   | false ->
-      fail (No_identity_file file)
+      fail (No_identity_file filename)
   | true ->
-      Lwt_utils_unix.Json.read_file file >>=? fun json ->
+      Lwt_utils_unix.Json.read_file filename >>=? fun json ->
       let id = Data_encoding.Json.destruct P2p_identity.encoding json in
+      let pkh = Crypto_box.hash id.public_key in
+      (* check public_key hash *)
+      if not (Crypto_box.Public_key_hash.equal pkh id.peer_id) then
+        fail (Identity_mismatch { filename ; peer_id = pkh })
+        (* check public/private keys correspondance *)
+      else if not Crypto_box.(equal (neuterize id.secret_key) id.public_key) then
+        fail (Identity_keys_mismatch { filename ; expected_key = id.public_key })
+      else (* check PoW level *)
         match expected_pow with
         | None -> return id
         | Some expected ->
             let target = Crypto_box.make_target expected in
-          if (Crypto_box.check_proof_of_work
+            if
-                id.public_key id.proof_of_work_stamp target) then
+              not (Crypto_box.check_proof_of_work
-            return id
+                     id.public_key id.proof_of_work_stamp target)
-          else
+            then
               fail (Insufficient_proof_of_work { expected })
+            else
+              return id
 
 type error += Existent_identity_file of string
 
@@ -80,8 +138,8 @@ let () =
   register_error_kind
     `Permanent
     ~id:"main.identity.existent_file"
-    ~title:"TODO"
+    ~title:"Cannot overwrite identity file"
-    ~description:"TODO"
+    ~description:"Cannot implicitely overwrite the current identity file"
     ~pp:(fun ppf file ->
         Format.fprintf ppf
           "Cannot implicitely overwrite the current identity file: '%s'. \