Shell: reduce default logging a little bit

This commit is contained in:
Grégoire Henry 2018-04-20 20:42:44 +02:00 committed by Benjamin Canou
parent caa764f0ff
commit 6e4b2eab47
5 changed files with 12 additions and 10 deletions

View File

@ -44,7 +44,7 @@ module Request = struct
hash: Block_hash.t ; hash: Block_hash.t ;
header: Block_header.t ; header: Block_header.t ;
operations: Operation.t list list ; operations: Operation.t list list ;
} -> State.Block.t tzresult t } -> State.Block.t option tzresult t
let view let view
: type a. a t -> view : type a. a t -> view
= fun (Request_validation { chain_db ; peer ; hash }) -> = fun (Request_validation { chain_db ; peer ; hash }) ->
@ -240,7 +240,7 @@ let on_request
bv.protocol_validator bv.protocol_validator
?peer ~timeout:bv.limits.protocol_timeout ?peer ~timeout:bv.limits.protocol_timeout
block ; block ;
return (Ok block) return (Ok None)
| None -> | None ->
State.Block.read_invalid chain_state hash >>= function State.Block.read_invalid chain_state hash >>= function
| Some { errors } -> | Some { errors } ->
@ -268,7 +268,7 @@ let on_request
?peer ~timeout:bv.limits.protocol_timeout ?peer ~timeout:bv.limits.protocol_timeout
block ; block ;
notify_new_block block ; notify_new_block block ;
return (Ok block) return (Ok (Some block))
(* TODO catch other temporary error (e.g. system errors) (* TODO catch other temporary error (e.g. system errors)
and do not 'commit' them on disk... *) and do not 'commit' them on disk... *)
| Error [Canceled | Unavailable_protocol _] as err -> | Error [Canceled | Unavailable_protocol _] as err ->
@ -293,10 +293,12 @@ let on_completion
: type a. t -> a Request.t -> a -> Worker_types.request_status -> unit Lwt.t : type a. t -> a Request.t -> a -> Worker_types.request_status -> unit Lwt.t
= fun w (Request.Request_validation _ as r) v st -> = fun w (Request.Request_validation _ as r) v st ->
match v with match v with
| Ok _ -> | Ok (Some _) ->
Worker.record_event w Worker.record_event w
(Event.Validation_success (Request.view r, st)) ; (Event.Validation_success (Request.view r, st)) ;
Lwt.return () Lwt.return ()
| Ok None ->
Lwt.return ()
| Error errs -> | Error errs ->
Worker.record_event w Worker.record_event w
(Event.Validation_failure (Request.view r, st, errs)) ; (Event.Validation_failure (Request.view r, st, errs)) ;
@ -336,7 +338,7 @@ let validate w
bv.protocol_validator bv.protocol_validator
?peer ~timeout:bv.limits.protocol_timeout ?peer ~timeout:bv.limits.protocol_timeout
block ; block ;
return block return None
| None -> | None ->
map_p (map_p (fun op -> map_p (map_p (fun op ->
let op_hash = Operation.hash op in let op_hash = Operation.hash op in

View File

@ -26,7 +26,7 @@ val validate:
?notify_new_block:(State.Block.t -> unit) -> ?notify_new_block:(State.Block.t -> unit) ->
Distributed_db.chain_db -> Distributed_db.chain_db ->
Block_hash.t -> Block_header.t -> Operation.t list list -> Block_hash.t -> Block_header.t -> Operation.t list list ->
State.Block.t tzresult Lwt.t State.Block.t option tzresult Lwt.t
val fetch_and_compile_protocol: val fetch_and_compile_protocol:
t -> t ->

View File

@ -37,7 +37,7 @@ val validate_block:
t -> t ->
?force:bool -> ?force:bool ->
Block_hash.t -> Block_header.t -> Operation.t list list -> Block_hash.t -> Block_header.t -> Operation.t list list ->
State.Block.t tzresult Lwt.t State.Block.t option tzresult Lwt.t
val shutdown: t -> unit Lwt.t val shutdown: t -> unit Lwt.t

View File

@ -36,7 +36,7 @@ val validate_block:
?force:bool -> ?force:bool ->
?chain_id:Chain_id.t -> ?chain_id:Chain_id.t ->
MBytes.t -> Operation.t list list -> MBytes.t -> Operation.t list list ->
(Block_hash.t * State.Block.t tzresult Lwt.t) tzresult Lwt.t (Block_hash.t * State.Block.t option tzresult Lwt.t) tzresult Lwt.t
(** Monitor all the valid block (for all activate chains). *) (** Monitor all the valid block (for all activate chains). *)
val watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper val watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper

View File

@ -44,8 +44,8 @@ module Event = struct
let level req = let level req =
match req with match req with
| Debug _ -> Logging.Info | Debug _ -> Logging.Debug
| Request _ -> Logging.Notice | Request _ -> Logging.Info
let encoding = let encoding =
let open Data_encoding in let open Data_encoding in