Baking/Test: fix ci

src/lib_client_base_unix/client_context_unix.ml

@@ -11,61 +11,61 @@ open Client_context
 
 class unix_wallet ~base_dir : wallet = object (self)
 
-    method private filename alias_name =
+  method private filename alias_name =
-      Filename.concat
+    Filename.concat
-        base_dir
+      base_dir
-        (Str.(global_replace (regexp_string " ") "_" alias_name) ^ "s")
+      (Str.(global_replace (regexp_string " ") "_" alias_name) ^ "s")
 
-    method with_lock : type a. ( unit -> a Lwt.t) -> a Lwt.t =
+  method with_lock : type a. ( unit -> a Lwt.t) -> a Lwt.t =
-      (fun f ->
+    (fun f ->
-         let unlock fd =
+       let unlock fd =
-           let fd = Lwt_unix.unix_file_descr fd in
+         let fd = Lwt_unix.unix_file_descr fd in
-           Unix.lockf fd Unix.F_ULOCK 0;
+         Unix.lockf fd Unix.F_ULOCK 0;
-           Unix.close fd
+         Unix.close fd
-         in
+       in
-         let lock () =
+       let lock () =
-           Lwt_unix.openfile (Filename.concat base_dir "wallet_lock") 
+         Lwt_unix.openfile (Filename.concat base_dir "wallet_lock")
-             Lwt_unix.[O_CREAT; O_WRONLY] 0o644 >>= fun fd ->
+           Lwt_unix.[O_CREAT; O_WRONLY] 0o644 >>= fun fd ->
-           Lwt_unix.lockf fd Unix.F_LOCK 0 >>= fun () ->
+         Lwt_unix.lockf fd Unix.F_LOCK 0 >>= fun () ->
-           Lwt.return (fd,(Lwt_unix.on_signal Sys.sigint
+         Lwt.return (fd,(Lwt_unix.on_signal Sys.sigint
-                             (fun _s ->
+                           (fun _s ->
-                                unlock fd;
+                              unlock fd;
-                                exit 0 (* exit code? *)  )))
+                              exit 0 (* exit code? *)  )))
-         in
+       in
-         lock () >>= fun (fd,sh) ->
+       lock () >>= fun (fd,sh) ->
-         (* catch might be useless if f always uses the error monad *)
+       (* catch might be useless if f always uses the error monad *)
-         Lwt.catch f  (function e -> Lwt.return (unlock fd; raise e))  >>= fun res ->
+       Lwt.catch f  (function e -> Lwt.return (unlock fd; raise e))  >>= fun res ->
-         Lwt.return (unlock fd) >>= fun () ->
+       Lwt.return (unlock fd) >>= fun () ->
-         Lwt_unix.disable_signal_handler sh;
+       Lwt_unix.disable_signal_handler sh;
-         Lwt.return res)
+       Lwt.return res)
 
-    method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t =
+  method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t =
-      fun alias_name ~default encoding ->
+    fun alias_name ~default encoding ->
-        let filename = self#filename alias_name in
+      let filename = self#filename alias_name in
-        if not (Sys.file_exists filename) then
+      if not (Sys.file_exists filename) then
-          return default
+        return default
-        else
+      else
-          Lwt_utils_unix.Json.read_file filename
+        Lwt_utils_unix.Json.read_file filename
-          |> generic_trace
+        |> generic_trace
-            "could not read the %s alias file" alias_name >>=? fun json ->
+          "could not read the %s alias file" alias_name >>=? fun json ->
-          match Data_encoding.Json.destruct encoding json with
+        match Data_encoding.Json.destruct encoding json with
-          | exception _ -> (* TODO print_error *)
+        | exception _ -> (* TODO print_error *)
-              failwith "did not understand the %s alias file" alias_name
+            failwith "did not understand the %s alias file" alias_name
-          | data ->
+        | data ->
-              return data
+            return data
 
-    method write :
+  method write :
-      type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t =
+    type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t =
-      fun alias_name list encoding ->
+    fun alias_name list encoding ->
-        Lwt.catch
+      Lwt.catch
-          (fun () ->
+        (fun () ->
-             Lwt_utils_unix.create_dir base_dir >>= fun () ->
+           Lwt_utils_unix.create_dir base_dir >>= fun () ->
-             let filename = self#filename alias_name in
+           let filename = self#filename alias_name in
-             let json = Data_encoding.Json.construct encoding list in
+           let json = Data_encoding.Json.construct encoding list in
-             Lwt_utils_unix.Json.write_file filename json)
+           Lwt_utils_unix.Json.write_file filename json)
-          (fun exn -> Lwt.return (error_exn exn))
+        (fun exn -> Lwt.return (error_exn exn))
-        |> generic_trace "could not write the %s alias file." alias_name
+      |> generic_trace "could not write the %s alias file." alias_name
-  end
+end
 
 class unix_prompter = object
   method prompt : type a. (a, string tzresult) lwt_format -> a =

src/proto_alpha/lib_baking/client_baking_nonces.ml

@@ -37,26 +37,26 @@ let mem (wallet : #Client_context.wallet) block_hash =
 
 let find (wallet : #Client_context.wallet) block_hash =
   wallet#with_lock ( fun () ->
-    load wallet >>|? fun data ->
+      load wallet >>|? fun data ->
-    try Some (List.assoc block_hash data)
+      try Some (List.assoc block_hash data)
-    with Not_found -> None)
+      with Not_found -> None)
 
 
 let add (wallet : #Client_context.wallet) block_hash nonce =
   wallet#with_lock ( fun () ->
-  load wallet >>=? fun data ->
+      load wallet >>=? fun data ->
-  save wallet ((block_hash, nonce) ::
+      save wallet ((block_hash, nonce) ::
-               List.remove_assoc block_hash data))
+                   List.remove_assoc block_hash data))
 
 let del (wallet : #Client_context.wallet) block_hash =
   wallet#with_lock ( fun () ->
-    load wallet >>=? fun data ->
+      load wallet >>=? fun data ->
-    save wallet (List.remove_assoc block_hash data))
+      save wallet (List.remove_assoc block_hash data))
 
 let dels (wallet : #Client_context.wallet) hashes =
   wallet#with_lock ( fun () ->
-  load wallet >>=? fun data ->
+      load wallet >>=? fun data ->
-  save wallet @@
+      save wallet @@
-  List.fold_left
+      List.fold_left
-    (fun data hash -> List.remove_assoc hash data)
+        (fun data hash -> List.remove_assoc hash data)
-    data hashes)
+        data hashes)

src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml

@@ -37,6 +37,7 @@ let no_write_context ?(block = `Head 0) config : #Client_context.full = object
     a ->
     a Data_encoding.encoding -> unit Error_monad.tzresult Lwt.t =
     fun _ _ _ -> return ()
+  method with_lock : type a. (unit -> a Lwt.t) -> a Lwt.t = fun f -> f ()
   method block = block
   method confirmations = None
   method prompt : type a. (a, string tzresult) Client_context.lwt_format -> a =