diff --git a/src/lib_shell/block_validator.ml b/src/lib_shell/block_validator.ml index 4d0731457..b7cc39722 100644 --- a/src/lib_shell/block_validator.ml +++ b/src/lib_shell/block_validator.ml @@ -44,7 +44,7 @@ module Request = struct hash: Block_hash.t ; header: Block_header.t ; operations: Operation.t list list ; - } -> State.Block.t tzresult t + } -> State.Block.t option tzresult t let view : type a. a t -> view = fun (Request_validation { chain_db ; peer ; hash }) -> @@ -240,7 +240,7 @@ let on_request bv.protocol_validator ?peer ~timeout:bv.limits.protocol_timeout block ; - return (Ok block) + return (Ok None) | None -> State.Block.read_invalid chain_state hash >>= function | Some { errors } -> @@ -268,7 +268,7 @@ let on_request ?peer ~timeout:bv.limits.protocol_timeout block ; notify_new_block block ; - return (Ok block) + return (Ok (Some block)) (* TODO catch other temporary error (e.g. system errors) and do not 'commit' them on disk... *) | 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 = fun w (Request.Request_validation _ as r) v st -> match v with - | Ok _ -> + | Ok (Some _) -> Worker.record_event w (Event.Validation_success (Request.view r, st)) ; Lwt.return () + | Ok None -> + Lwt.return () | Error errs -> Worker.record_event w (Event.Validation_failure (Request.view r, st, errs)) ; @@ -336,7 +338,7 @@ let validate w bv.protocol_validator ?peer ~timeout:bv.limits.protocol_timeout block ; - return block + return None | None -> map_p (map_p (fun op -> let op_hash = Operation.hash op in diff --git a/src/lib_shell/block_validator.mli b/src/lib_shell/block_validator.mli index cd346293b..47776a06a 100644 --- a/src/lib_shell/block_validator.mli +++ b/src/lib_shell/block_validator.mli @@ -26,7 +26,7 @@ val validate: ?notify_new_block:(State.Block.t -> unit) -> Distributed_db.chain_db -> 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: t -> diff --git a/src/lib_shell/chain_validator.mli b/src/lib_shell/chain_validator.mli index e64d48ca8..6b1aa3262 100644 --- a/src/lib_shell/chain_validator.mli +++ b/src/lib_shell/chain_validator.mli @@ -37,7 +37,7 @@ val validate_block: t -> ?force:bool -> 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 diff --git a/src/lib_shell/validator.mli b/src/lib_shell/validator.mli index 2fd9d4aaa..8d24a130c 100644 --- a/src/lib_shell/validator.mli +++ b/src/lib_shell/validator.mli @@ -36,7 +36,7 @@ val validate_block: ?force:bool -> ?chain_id:Chain_id.t -> 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). *) val watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper diff --git a/src/lib_shell_services/peer_validator_worker_state.ml b/src/lib_shell_services/peer_validator_worker_state.ml index f07faedab..3da7942ec 100644 --- a/src/lib_shell_services/peer_validator_worker_state.ml +++ b/src/lib_shell_services/peer_validator_worker_state.ml @@ -44,8 +44,8 @@ module Event = struct let level req = match req with - | Debug _ -> Logging.Info - | Request _ -> Logging.Notice + | Debug _ -> Logging.Debug + | Request _ -> Logging.Info let encoding = let open Data_encoding in