From 4d06b31ba54193d3cbc47f87663304f9a249e6de Mon Sep 17 00:00:00 2001
From: Victor Allombert <victor.allombert@nomadic-labs.com>
Date: Thu, 3 Oct 2024 16:23:32 +0200
Subject: [PATCH] Stdlib_unix: improve error message when failing to load
 stored_data

---
 src/lib_stdlib_unix/stored_data.ml  | 46 ++++++++++++++++-------------
 src/lib_stdlib_unix/stored_data.mli |  2 +-
 2 files changed, 27 insertions(+), 21 deletions(-)

diff --git a/src/lib_stdlib_unix/stored_data.ml b/src/lib_stdlib_unix/stored_data.ml
index 6183c55c766c..dba1966799e2 100644
--- a/src/lib_stdlib_unix/stored_data.ml
+++ b/src/lib_stdlib_unix/stored_data.ml
@@ -25,22 +25,20 @@
 
 open Error_monad
 
-type error += Missing_stored_data of string
+type error += Cannot_load_stored_data of string * string
 
 let () =
   register_error_kind
     `Permanent
-    ~id:"stdlib_unix.missing_stored_data"
-    ~title:"Missing stored data"
+    ~id:"stdlib_unix.cannot_load_stored_data"
+    ~title:"Cannod load stored data"
     ~description:"Failed to load stored data"
-    ~pp:(fun ppf path ->
-      Format.fprintf
-        ppf
-        "Failed to load on-disk data: no corresponding data found in file %s."
-        path)
-    Data_encoding.(obj1 (req "path" string))
-    (function Missing_stored_data path -> Some path | _ -> None)
-    (fun path -> Missing_stored_data path)
+    ~pp:(fun ppf (path, msg) ->
+      Format.fprintf ppf "Failed to load on-disk data from %s: %s." path msg)
+    Data_encoding.(obj2 (req "path" string) (req "msg" string))
+    (function
+      | Cannot_load_stored_data (path, msg) -> Some (path, msg) | _ -> None)
+    (fun (path, msg) -> Cannot_load_stored_data (path, msg))
 
 type 'a file = {
   encoding : 'a Data_encoding.t;
@@ -67,14 +65,15 @@ let read_json_file file =
       match r with
       | Ok json ->
           Lwt.return_some (Data_encoding.Json.destruct file.encoding json)
-      | _ -> Lwt.return_none)
+      | Error errs ->
+          Lwt.fail_with (Format.asprintf "%a" Error_monad.pp_print_trace errs))
 
 let read_file file =
   Lwt.try_bind
     (fun () -> Lwt_utils_unix.read_file file.path)
     (fun str ->
-      Lwt.return (Data_encoding.Binary.of_string_opt file.encoding str))
-    (fun _ -> Lwt.return_none)
+      Lwt.return_some (Data_encoding.Binary.of_string_exn file.encoding str))
+    (fun exn -> Lwt.fail exn)
 
 let get (Stored_data v) =
   Lwt_idle_waiter.task v.scheduler (fun () -> Lwt.return v.cache)
@@ -125,12 +124,19 @@ let update_with (Stored_data v) f =
 
 let load file =
   let open Lwt_result_syntax in
-  let*! o = if file.json then read_json_file file else read_file file in
-  match o with
-  | Some cache ->
-      let scheduler = Lwt_idle_waiter.create () in
-      return (Stored_data {cache; file; scheduler})
-  | None -> tzfail (Missing_stored_data file.path)
+  Lwt.catch
+    (fun () ->
+      let*! o = if file.json then read_json_file file else read_file file in
+      match o with
+      | Some cache ->
+          let scheduler = Lwt_idle_waiter.create () in
+          return (Stored_data {cache; file; scheduler})
+      | None -> tzfail (Cannot_load_stored_data (file.path, "cannot read file")))
+    (function
+      | exn ->
+          tzfail
+            (Cannot_load_stored_data
+               (file.path, Format.sprintf "%s" (Printexc.to_string exn))))
 
 let init file ~initial_data =
   let open Lwt_syntax in
diff --git a/src/lib_stdlib_unix/stored_data.mli b/src/lib_stdlib_unix/stored_data.mli
index d0389b4d29b8..52ce38c1d5ad 100644
--- a/src/lib_stdlib_unix/stored_data.mli
+++ b/src/lib_stdlib_unix/stored_data.mli
@@ -44,7 +44,7 @@ type 'a eq := 'a -> 'a -> bool
 type 'a t
 
 (** This error is returned when the requested data is not found. *)
-type error += Missing_stored_data of string
+type error += Cannot_load_stored_data of string * string
 
 (** [make_file ?(json=false) ~filepath encoding] represents a file
     located at [filepath]. The content of this value is encoded using
-- 
GitLab