From 555bf2f88c6e2f016cc51ad7e13eb00d691be2b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 23 Apr 2021 09:28:08 +0200 Subject: [PATCH 1/5] Lwtreslib: provide exception-catching functions --- src/lib_lwt_result_stdlib/bare/sigs/option.ml | 34 +++++++++++++++++++ src/lib_lwt_result_stdlib/bare/sigs/result.ml | 26 ++++++++++++++ .../bare/structs/option.ml | 11 ++++++ .../bare/structs/result.ml | 11 ++++++ 4 files changed, 82 insertions(+) diff --git a/src/lib_lwt_result_stdlib/bare/sigs/option.ml b/src/lib_lwt_result_stdlib/bare/sigs/option.ml index 946a8adf657f..ee50543e21f2 100644 --- a/src/lib_lwt_result_stdlib/bare/sigs/option.ml +++ b/src/lib_lwt_result_stdlib/bare/sigs/option.ml @@ -206,4 +206,38 @@ module type S = sig val to_list : 'a option -> 'a list val to_seq : 'a option -> 'a Stdlib.Seq.t + + (** [catch f] is [Some (f ())] if [f] does not raise an exception, it is + [None] otherwise. + + You should only use [catch] when you truly do not care about + what exception may be raised during the evaluation of [f ()]. If you need + to inspect the raised exception, or if you need to pass it along, consider + {!Result.catch} instead. + + If [catch_only] is set, then only exceptions [e] such that [catch_only e] + is [true] are caught. + + Whether [catch_only] is set or not, this function never catches + non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} + and {!Out_of_memory}. *) + val catch : ?catch_only:(exn -> bool) -> (unit -> 'a) -> 'a option + + (** [catch_s f] is a promise that resolves to [Some x] if and when [f ()] + resolves to [x]. Alternatively, it resolves to [None] if and when [f ()] + is rejected. + + You should only use [catch] when you truly do not care about + what exception may be raised during the evaluation of [f ()]. If you need + to inspect the raised exception, or if you need to pass it along, consider + {!Result.catch_s} instead. + + If [catch_only] is set, then only exceptions [e] such that [catch_only e] + is [true] are caught. + + Whether [catch_only] is set or not, this function never catches + non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} + and {!Out_of_memory}. *) + val catch_s : + ?catch_only:(exn -> bool) -> (unit -> 'a Lwt.t) -> 'a option Lwt.t end diff --git a/src/lib_lwt_result_stdlib/bare/sigs/result.ml b/src/lib_lwt_result_stdlib/bare/sigs/result.ml index 2c675bd33f2b..c21809a49216 100644 --- a/src/lib_lwt_result_stdlib/bare/sigs/result.ml +++ b/src/lib_lwt_result_stdlib/bare/sigs/result.ml @@ -114,4 +114,30 @@ module type S = sig val to_list : ('a, 'e) result -> 'a list val to_seq : ('a, 'e) result -> 'a Stdlib.Seq.t + + (** [catch f] is [try Ok (f ()) with e -> Error e]: it is [Ok x] if [f ()] + evaluates to [x], and it is [Error e] if [f ()] raises [e]. + + See {!WithExceptions.S.Result.to_exn} for a converse function. + + If [catch_only] is set, then only exceptions [e] such that [catch_only e] + is [true] are caught. + + Whether [catch_only] is set or not, this function never catches + non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} + and {!Out_of_memory}. *) + val catch : ?catch_only:(exn -> bool) -> (unit -> 'a) -> ('a, exn) result + + (** [catch_s] is [catch] but for Lwt promises. Specifically, [catch_s f] + returns a promise that resolves to [Ok x] if and when [f ()] resolves to + [x], or to [Error exc] if and when [f ()] is rejected with [exc]. + + If [catch_only] is set, then only exceptions [e] such that [catch_only e] + is [true] are caught. + + Whether [catch_only] is set or not, this function never catches + non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} + and {!Out_of_memory}. *) + val catch_s : + ?catch_only:(exn -> bool) -> (unit -> 'a Lwt.t) -> ('a, exn) result Lwt.t end diff --git a/src/lib_lwt_result_stdlib/bare/structs/option.ml b/src/lib_lwt_result_stdlib/bare/structs/option.ml index 7a763970bd0c..b058010935ea 100644 --- a/src/lib_lwt_result_stdlib/bare/structs/option.ml +++ b/src/lib_lwt_result_stdlib/bare/structs/option.ml @@ -153,3 +153,14 @@ let iter_e f = function None -> Ok () | Some v -> f v let iter_es f = function None -> Lwt.return_ok () | Some v -> f v let of_result = function Ok v -> Some v | Error _ -> None + +let catch ?(catch_only = fun _ -> true) f = + match f () with + | v -> Some v + | exception ((Stack_overflow | Out_of_memory) as e) -> raise e + | exception e -> if catch_only e then None else raise e + +let catch_s ?(catch_only = fun _ -> true) f = + Lwt.try_bind f Lwt.return_some (function + | (Stack_overflow | Out_of_memory) as e -> raise e + | e -> if catch_only e then Lwt.return_none else raise e) diff --git a/src/lib_lwt_result_stdlib/bare/structs/result.ml b/src/lib_lwt_result_stdlib/bare/structs/result.ml index 1dae94b67c7e..864bc9aa4928 100644 --- a/src/lib_lwt_result_stdlib/bare/structs/result.ml +++ b/src/lib_lwt_result_stdlib/bare/structs/result.ml @@ -109,3 +109,14 @@ let to_list = function Ok v -> [v] | Error _ -> [] let to_seq = function | Ok v -> Stdlib.Seq.return v | Error _ -> Stdlib.Seq.empty + +let catch ?(catch_only = fun _ -> true) f = + match f () with + | v -> Ok v + | exception ((Stack_overflow | Out_of_memory) as e) -> raise e + | exception e -> if catch_only e then Error e else raise e + +let catch_s ?(catch_only = fun _ -> true) f = + Lwt.try_bind f Lwt.return_ok (function + | (Stack_overflow | Out_of_memory) as e -> raise e + | e -> if catch_only e then Lwt.return_error e else raise e) -- GitLab From bae6405157ebb59127e6d892db34d6b148a713d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Fri, 23 Apr 2021 09:44:50 +0200 Subject: [PATCH 2/5] Error_monad: help handle exceptions --- src/lib_error_monad/error_monad.ml | 8 +++++ src/lib_error_monad/error_monad.mli | 46 +++++++++++++++++++++++++++-- 2 files changed, 52 insertions(+), 2 deletions(-) diff --git a/src/lib_error_monad/error_monad.ml b/src/lib_error_monad/error_monad.ml index ba02d198c2f7..a62400ebfe80 100644 --- a/src/lib_error_monad/error_monad.ml +++ b/src/lib_error_monad/error_monad.ml @@ -60,6 +60,8 @@ let error_of_exn e = TzTrace.make @@ Exn e let error_exn s = Error (TzTrace.make @@ Exn s) +let tzresult_of_exn_result r = Result.map_error error_of_exn r + let trace_exn exn f = trace (Exn exn) f let generic_trace fmt = @@ -156,3 +158,9 @@ let cancel_with_exceptions canceler = Lwt_canceler.cancel canceler >>= function | Ok () | Error [] -> Lwt.return_unit | Error (h :: _) -> raise h + +let catch ?catch_only f = + TzLwtreslib.Result.catch ?catch_only f |> Result.map_error error_of_exn + +let catch_s ?catch_only f = + TzLwtreslib.Result.catch_s ?catch_only f >|= Result.map_error error_of_exn diff --git a/src/lib_error_monad/error_monad.mli b/src/lib_error_monad/error_monad.mli index 71e751a0d56e..1ec869194d93 100644 --- a/src/lib_error_monad/error_monad.mli +++ b/src/lib_error_monad/error_monad.mli @@ -65,13 +65,23 @@ val error_exn : exn -> 'a tzresult {[ try - Ok (make_some_call parameter) + Ok (make_some_call parameter) with | (Not_found | Failure _) as e -> - Error (error_of_exn e) + Error (error_of_exn e) ]} *) val error_of_exn : exn -> error trace +(** [tzresult_of_exn_result r] wraps the payload construction of the [Error] + constructor of a result into a [tzresult]. This is intended for use when + interacting with code that uses exceptions wrapped in a [result]. E.g., + +{[ +let p : int Lwt.t = … in +Lwt_result.catch p >|= tzresult_of_exn_result +]} *) +val tzresult_of_exn_result : ('a, exn) result -> 'a tzresult + val record_trace_exn : exn -> 'a tzresult -> 'a tzresult val trace_exn : exn -> 'b tzresult Lwt.t -> 'b tzresult Lwt.t @@ -111,6 +121,38 @@ val protect : (unit -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t +(** [catch f] executes [f] within a try-with block and wraps exceptions within + a [tzresult]. [catch f] is equivalent to + [try Ok (f ()) with e -> Error (error_of_exn e)]. + + If [catch_only] is set, then only exceptions [e] such that [catch_only e] is + [true] are caught. + + Whether [catch_only] is set or not, this function never catches + non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} and + {!Out_of_memory}. + *) +val catch : ?catch_only:(exn -> bool) -> (unit -> 'a) -> 'a tzresult + +(** [catch_s] is like [catch] but when [f] returns a promise. It is equivalent + to + +{[ +Lwt.try_bind f + (fun v -> Lwt.return (Ok v)) + (fun e -> Lwt.return (Error (error_of_exn e))) +]} + + If [catch_only] is set, then only exceptions [e] such that [catch_only e] is + [true] are caught. + + Whether [catch_only] is set or not, this function never catches + non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} and + {!Out_of_memory}. + *) +val catch_s : + ?catch_only:(exn -> bool) -> (unit -> 'a Lwt.t) -> 'a tzresult Lwt.t + type error += Timeout val with_timeout : -- GitLab From 751ae4dca3c3814c3484d464431cb1a255585333 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 19 May 2021 10:09:52 +0200 Subject: [PATCH 3/5] Doc: basic exception guidelines in developer doc --- docs/developer/guidelines.rst | 54 ++++++++++++++++++++++++++++++++++- 1 file changed, 53 insertions(+), 1 deletion(-) diff --git a/docs/developer/guidelines.rst b/docs/developer/guidelines.rst index 0e78feed6e80..05855302139a 100644 --- a/docs/developer/guidelines.rst +++ b/docs/developer/guidelines.rst @@ -267,10 +267,62 @@ Example: module Mycache = Mycache end +Exceptions and errors +--------------------- + +The following pieces of advice should be applied in general, although exceptions apply (pun intended). + +- Only use exceptions locally and don't let them escape: raise them and catch them within the same function or the same module. + + - If a function that is exported can fail, return a ``result`` or a ``tzresult``. + + - If you cannot (or for another reason do not) handle an exception and it may escape you **must** document it. + +- Never catch ``Stack_overflow`` nor ``Out_of_memory`` which are exceptions from + the OCaml runtime rather than the code itself. In other words, when one of + these exception is raised in one process, the same exception may or may not be + raised in another process executing the same code on other machines. When you + catch this exception, you make a branching in the code that is decided not + based on properties of the code, but properties of the process executing the + code. Consequently, the same branching may differ on two distinct runs of the + same code. This is, in essence, non-determinism. + + - If you are in one of the small cases where non-determinism is ok and you + have a compelling reason to catch either ``Stack_overflow`` or + ``Out_of_memory``, you **must** include a comment explaining why. + + - Note that catch-all patterns (such as wildcard (`| _ ->`) and variable + (`| exn ->`) include ``Stack_overflow`` and ``Out_of_memory``. + +- Do not let low-level, implementation-dependent exceptions and errors bubble up + to high-level code. For example, you should catch ``Unix_error`` near the + syscall sites (ideally, within the same module) and handle it there. If you + cannot handle it (e.g., if the error is non-recoverable) you should translate + it into an error that is more relevant to the high-level code. + + - E.g., If a file-writing call to a library function raises + ``Unix_error(ENOSPC, _, _)``, the caller of that library function should + + - catch the exception, + + - attempt to recover (if possible; e.g., by removing other old files before attempting it again), + + - and if the recovery does not work (e.g., does not release sufficient + space) or is impossible (e.g., there are no references to old files in + scope) then it should fail in a more meaningful way than by forwarding the + exception (e.g., indicating what operation it was trying to carry). + + - In the rare case that the underlying exception/error is satisfactory to the + higher level code, then you may propagate it as is. + +The ``Lwtreslib`` and the ``Error_monad`` libraries provide functions that can +help you follow these guidelines. Notably, ``traces`` allow callers to +contextualise the errors produced by its callees. + Coding conventions ------------------ -Other than the formatting rules above, there are currently no coding +Other than the guidelines above, there are currently no coding conventions enforced in the codebase. However, Tezos developers should be aware of general `OCaml programming guidelines `_, which recommend formatting, naming conventions, -- GitLab From cf875e4f0e5b3156b45cc498777083b6c7fb9a68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 16 Jun 2021 09:53:58 +0200 Subject: [PATCH 4/5] Env-v3: prevent catching of Unix_error --- .../environment_V3.ml | 32 +++++++++++++++++++ .../sigs/v3/error_monad.mli | 30 +++++++++++++++++ 2 files changed, 62 insertions(+) diff --git a/src/lib_protocol_environment/environment_V3.ml b/src/lib_protocol_environment/environment_V3.ml index e7d2f14966ee..eccab0d62fb5 100644 --- a/src/lib_protocol_environment/environment_V3.ml +++ b/src/lib_protocol_environment/environment_V3.ml @@ -588,6 +588,38 @@ struct let pp_trace = pp_print_error type 'err trace = 'err TzTrace.trace + + (* Shadowing catch to prevent catching system exceptions *) + type error += Exn of exn + + let () = + register_error_kind + `Temporary + ~id:"failure" + ~title:"Exception" + ~description:"Exception safely wrapped in an error" + ~pp:(fun ppf s -> + Format.fprintf ppf "@[%a@]" Format.pp_print_text s) + Data_encoding.(obj1 (req "msg" string)) + (function + | Exn (Failure msg) -> Some msg + | Exn exn -> Some (Printexc.to_string exn) + | _ -> None) + (fun msg -> Exn (Failure msg)) + + let error_of_exn e = TzTrace.make @@ Exn e + + let catch ?(catch_only = fun _ -> true) f = + match f () with + | v -> Ok v + | exception ((Stack_overflow | Out_of_memory | Unix.Unix_error _) as e) -> + raise e + | exception e -> if catch_only e then Error (error_of_exn e) else raise e + + let catch_s ?(catch_only = fun _ -> true) f = + Lwt.try_bind f return (function + | (Stack_overflow | Out_of_memory | Unix.Unix_error _) as e -> raise e + | e -> if catch_only e then fail (Exn e) else raise e) end let () = diff --git a/src/lib_protocol_environment/sigs/v3/error_monad.mli b/src/lib_protocol_environment/sigs/v3/error_monad.mli index 669b428234ae..797a55633717 100644 --- a/src/lib_protocol_environment/sigs/v3/error_monad.mli +++ b/src/lib_protocol_environment/sigs/v3/error_monad.mli @@ -172,6 +172,36 @@ val dont_wait : (unit -> (unit, 'trace) result Lwt.t) -> unit +(** [catch f] executes [f] within a try-with block and wraps exceptions within + a [tzresult]. [catch f] is equivalent to + [try Ok (f ()) with e -> Error (error_of_exn e)]. + + If [catch_only] is set, then only exceptions [e] such that [catch_only e] is + [true] are caught. + + Whether [catch_only] is set or not, this function never catches + non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} and + {!Out_of_memory} nor system-exceptions such as {!Unix.Unix_error}. *) +val catch : ?catch_only:(exn -> bool) -> (unit -> 'a) -> 'a tzresult + +(** [catch_s] is like [catch] but when [f] returns a promise. It is equivalent + to + +{[ +Lwt.try_bind f + (fun v -> Lwt.return (Ok v)) + (fun e -> Lwt.return (Error (error_of_exn e))) +]} + + If [catch_only] is set, then only exceptions [e] such that [catch_only e] is + [true] are caught. + + Whether [catch_only] is set or not, this function never catches + non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} and + {!Out_of_memory} nor system-exceptions such as {!Unix.Unix_error}. *) +val catch_s : + ?catch_only:(exn -> bool) -> (unit -> 'a Lwt.t) -> 'a tzresult Lwt.t + (* Synchronisation *) val join_e : (unit, 'err trace) result list -> (unit, 'err trace) result -- GitLab From bd5b0abad4faf8d1162b99f8124261995b69b364 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Thu, 1 Jul 2021 11:46:09 +0200 Subject: [PATCH 5/5] Proto-env-V3: be more strict about no-catch exceptions in helpers --- src/lib_protocol_environment/environment_V3.ml | 8 ++++++-- src/lib_protocol_environment/sigs/v3/error_monad.mli | 6 ++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/lib_protocol_environment/environment_V3.ml b/src/lib_protocol_environment/environment_V3.ml index eccab0d62fb5..62577c6473e9 100644 --- a/src/lib_protocol_environment/environment_V3.ml +++ b/src/lib_protocol_environment/environment_V3.ml @@ -612,13 +612,17 @@ struct let catch ?(catch_only = fun _ -> true) f = match f () with | v -> Ok v - | exception ((Stack_overflow | Out_of_memory | Unix.Unix_error _) as e) -> + | exception + (( Stack_overflow | Out_of_memory | Unix.Unix_error _ + | UnixLabels.Unix_error _ | Sys_error _ ) as e) -> raise e | exception e -> if catch_only e then Error (error_of_exn e) else raise e let catch_s ?(catch_only = fun _ -> true) f = Lwt.try_bind f return (function - | (Stack_overflow | Out_of_memory | Unix.Unix_error _) as e -> raise e + | ( Stack_overflow | Out_of_memory | Unix.Unix_error _ + | UnixLabels.Unix_error _ | Sys_error _ ) as e -> + raise e | e -> if catch_only e then fail (Exn e) else raise e) end diff --git a/src/lib_protocol_environment/sigs/v3/error_monad.mli b/src/lib_protocol_environment/sigs/v3/error_monad.mli index 797a55633717..49902aee10a8 100644 --- a/src/lib_protocol_environment/sigs/v3/error_monad.mli +++ b/src/lib_protocol_environment/sigs/v3/error_monad.mli @@ -181,7 +181,8 @@ val dont_wait : Whether [catch_only] is set or not, this function never catches non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} and - {!Out_of_memory} nor system-exceptions such as {!Unix.Unix_error}. *) + {!Out_of_memory} nor system-exceptions such as {!Unix.Unix_error} and + {!Sys_error}. *) val catch : ?catch_only:(exn -> bool) -> (unit -> 'a) -> 'a tzresult (** [catch_s] is like [catch] but when [f] returns a promise. It is equivalent @@ -198,7 +199,8 @@ Lwt.try_bind f Whether [catch_only] is set or not, this function never catches non-deterministic runtime exceptions of OCaml such as {!Stack_overflow} and - {!Out_of_memory} nor system-exceptions such as {!Unix.Unix_error}. *) + {!Out_of_memory} nor system-exceptions such as {!Unix.Unix_error} and + {!Sys_error}. *) val catch_s : ?catch_only:(exn -> bool) -> (unit -> 'a Lwt.t) -> 'a tzresult Lwt.t -- GitLab