Alpha/Baker: outsource retry
to lwt-utils
This commit is contained in:
parent
a5cb2c1a5d
commit
bde05da36a
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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"
|
||||||
|
Loading…
Reference in New Issue
Block a user