Alpha/Baker: outsource retry to lwt-utils

This commit is contained in:
Raphaël Proust 2018-06-19 16:43:47 +08:00
parent a5cb2c1a5d
commit bde05da36a
3 changed files with 28 additions and 15 deletions

View File

@ -381,3 +381,18 @@ module Socket = struct
return message return message
end 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

View File

@ -75,3 +75,10 @@ module Socket : sig
Lwt_unix.file_descr -> 'a Data_encoding.t -> 'a tzresult Lwt.t Lwt_unix.file_descr -> 'a Data_encoding.t -> 'a tzresult Lwt.t
end end
val retry:
?log:('error -> unit Lwt.t) ->
?n:int ->
?sleep:float ->
(unit -> ('a, 'error) result Lwt.t) -> ('a, 'error) result Lwt.t

View File

@ -54,19 +54,6 @@ let generate_seed_nonce () =
| Error _errs -> assert false | Error _errs -> assert false
| Ok nonce -> nonce | 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 let forge_block_header
(cctxt : #Proto_alpha.full) (cctxt : #Proto_alpha.full)
?(chain = `Main) block delegate_sk shell priority seed_nonce_hash = ?(chain = `Main) block delegate_sk shell priority seed_nonce_hash =
@ -621,12 +608,16 @@ let bake_slot
errs >>= fun () -> errs >>= fun () ->
return None return None
| Ok operations -> | 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 () -> (fun () ->
Alpha_block_services.Helpers.Preapply.block Alpha_block_services.Helpers.Preapply.block
cctxt ~chain ~block cctxt ~chain ~block
~timestamp ~sort:true ~protocol_data operations) ~timestamp ~sort:true ~protocol_data operations)
~msg:"Error while prevalidating operations" ()
>>= function >>= function
| Error errs -> | Error errs ->
lwt_log_error "Error while prevalidating operations:@\n%a" lwt_log_error "Error while prevalidating operations:@\n%a"