From bde05da36ac0c4da54ba02e91bc0a77e1656f963 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= <code@bnwr.net>
Date: Tue, 19 Jun 2018 16:43:47 +0800
Subject: [PATCH] Alpha/Baker: outsource `retry` to lwt-utils

---
 src/lib_stdlib_unix/lwt_utils_unix.ml         | 15 +++++++++++++
 src/lib_stdlib_unix/lwt_utils_unix.mli        |  7 +++++++
 .../lib_delegate/client_baking_forge.ml       | 21 ++++++-------------
 3 files changed, 28 insertions(+), 15 deletions(-)

diff --git a/src/lib_stdlib_unix/lwt_utils_unix.ml b/src/lib_stdlib_unix/lwt_utils_unix.ml
index b01056e05..dbfe9ce50 100644
--- a/src/lib_stdlib_unix/lwt_utils_unix.ml
+++ b/src/lib_stdlib_unix/lwt_utils_unix.ml
@@ -381,3 +381,18 @@ module Socket = struct
           return message
 
 end
+
+
+let rec retry ?(log=(fun _ -> Lwt.return ())) ?(n=5) ?(sleep=1.) f =
+  f () >>= function
+  | Ok r -> Lwt.return (Ok r)
+  | (Error error) as x ->
+      if n > 0 then
+        begin
+          log error >>= fun () ->
+          Lwt_unix.sleep sleep >>= fun () ->
+          retry ~log ~n:(n-1) ~sleep f
+        end
+      else
+        Lwt.return x
+
diff --git a/src/lib_stdlib_unix/lwt_utils_unix.mli b/src/lib_stdlib_unix/lwt_utils_unix.mli
index 86bce8771..03340b8b2 100644
--- a/src/lib_stdlib_unix/lwt_utils_unix.mli
+++ b/src/lib_stdlib_unix/lwt_utils_unix.mli
@@ -75,3 +75,10 @@ module Socket : sig
     Lwt_unix.file_descr -> 'a Data_encoding.t -> 'a tzresult Lwt.t
 
 end
+
+val retry:
+  ?log:('error -> unit Lwt.t) ->
+  ?n:int ->
+  ?sleep:float ->
+  (unit -> ('a, 'error) result Lwt.t) -> ('a, 'error) result Lwt.t
+
diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml
index 1c1b0247f..b560bb9a7 100644
--- a/src/proto_alpha/lib_delegate/client_baking_forge.ml
+++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml
@@ -54,19 +54,6 @@ let generate_seed_nonce () =
   | Error _errs -> assert false
   | Ok nonce -> nonce
 
-let rec retry_call f ?(msg="Call error") ?(n=5) () =
-  f () >>= function
-  | Ok r -> return r
-  | (Error errs) as x ->
-      if n > 0 then
-        begin
-          lwt_log_error "%s\n%a\nRetrying..."
-            msg pp_print_error errs >>= fun () ->
-          Lwt_unix.sleep 1. >>= retry_call f ~msg ~n:(n-1)
-        end
-      else
-        Lwt.return x
-
 let forge_block_header
     (cctxt : #Proto_alpha.full)
     ?(chain = `Main) block delegate_sk shell priority seed_nonce_hash =
@@ -621,12 +608,16 @@ let bake_slot
         errs >>= fun () ->
       return None
   | Ok operations ->
-      retry_call
+      Tezos_stdlib_unix.Lwt_utils_unix.retry
+        ~log:(fun errs ->
+          lwt_log_error
+            "Error while prevalidating operations\n%a\nRetrying..."
+            pp_print_error errs
+          )
         (fun () ->
            Alpha_block_services.Helpers.Preapply.block
              cctxt ~chain ~block
              ~timestamp ~sort:true ~protocol_data operations)
-        ~msg:"Error while prevalidating operations" ()
       >>= function
       | Error errs ->
           lwt_log_error "Error while prevalidating operations:@\n%a"