P2p: better logging on failing "Swap".

This commit is contained in:
Grégoire Henry 2017-11-08 14:49:54 +01:00 committed by Benjamin Canou
parent ee2cb59731
commit dad0793353
2 changed files with 17 additions and 2 deletions

View File

@ -1031,8 +1031,13 @@ and swap pool conn current_peer_id new_point =
| Error err -> begin
pool.latest_accepted_swap <- pool.latest_succesfull_swap ;
log pool (Swap_failure { source = source_peer_id }) ;
lwt_log_error "Swap to %a failed: %a"
Point.pp new_point pp_print_error err
match err with
| [ Lwt_utils.Timeout ] ->
lwt_debug "Swap to %a was interupted: %a"
Point.pp new_point pp_print_error err
| _ ->
lwt_log_error "Swap to %a failed: %a"
Point.pp new_point pp_print_error err
end
let accept pool fd point =

View File

@ -472,6 +472,16 @@ let protect ?on_error ?canceler t =
type error += Timeout
let () =
Error_monad.register_error_kind
`Temporary
~id:"utils.Timeout"
~title:"Timeout"
~description:"Timeout"
Data_encoding.unit
(function Timeout -> Some () | _ -> None)
(fun () -> Timeout)
let with_timeout ?(canceler = Canceler.create ()) timeout f =
let t = Lwt_unix.sleep timeout in
Lwt.choose [