From 276ad887da54bba8fe08fe4f86dd77ec49a39400 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 1 Sep 2020 09:46:39 +0200 Subject: [PATCH 1/8] Lwtreslib: add Option, Result, Unsafe modules --- src/lib_lwt_result_stdlib/functors/option.ml | 85 ++++++++++++ src/lib_lwt_result_stdlib/functors/option.mli | 26 ++++ src/lib_lwt_result_stdlib/functors/result.ml | 128 ++++++++++++++++++ .../functors/withExceptions.ml | 85 ++++++++++++ .../functors/withExceptions.mli | 26 ++++ src/lib_lwt_result_stdlib/lib/option.ml | 26 ++++ src/lib_lwt_result_stdlib/lib/option.mli | 26 ++++ src/lib_lwt_result_stdlib/lib/result.ml | 26 ++++ src/lib_lwt_result_stdlib/lib/result.mli | 26 ++++ .../lib/withExceptions.ml | 26 ++++ .../lib/withExceptions.mli | 26 ++++ src/lib_lwt_result_stdlib/lwtreslib.ml | 3 + src/lib_lwt_result_stdlib/lwtreslib.mli | 9 +- src/lib_lwt_result_stdlib/sigs/list.ml | 3 +- src/lib_lwt_result_stdlib/sigs/option.ml | 114 ++++++++++++++++ src/lib_lwt_result_stdlib/sigs/result.ml | 119 ++++++++++++++++ .../sigs/withExceptions.ml | 59 ++++++++ .../test/test_list_basic.ml | 2 +- 18 files changed, 811 insertions(+), 4 deletions(-) create mode 100644 src/lib_lwt_result_stdlib/functors/option.ml create mode 100644 src/lib_lwt_result_stdlib/functors/option.mli create mode 100644 src/lib_lwt_result_stdlib/functors/result.ml create mode 100644 src/lib_lwt_result_stdlib/functors/withExceptions.ml create mode 100644 src/lib_lwt_result_stdlib/functors/withExceptions.mli create mode 100644 src/lib_lwt_result_stdlib/lib/option.ml create mode 100644 src/lib_lwt_result_stdlib/lib/option.mli create mode 100644 src/lib_lwt_result_stdlib/lib/result.ml create mode 100644 src/lib_lwt_result_stdlib/lib/result.mli create mode 100644 src/lib_lwt_result_stdlib/lib/withExceptions.ml create mode 100644 src/lib_lwt_result_stdlib/lib/withExceptions.mli create mode 100644 src/lib_lwt_result_stdlib/sigs/option.ml create mode 100644 src/lib_lwt_result_stdlib/sigs/result.ml create mode 100644 src/lib_lwt_result_stdlib/sigs/withExceptions.ml diff --git a/src/lib_lwt_result_stdlib/functors/option.ml b/src/lib_lwt_result_stdlib/functors/option.ml new file mode 100644 index 000000000000..cdf2fe687a8d --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/option.ml @@ -0,0 +1,85 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module M : Sigs.Option.S = struct + open Lwt.Infix + include Stdlib.Option + + let some_unit = Some () + + let some_nil = Some [] + + let some_e v = Ok (Some v) + + let some_s v = Lwt.return (Some v) + + let some_es v = Lwt.return (Ok (Some v)) + + let none_e = Ok None + + let none_s = Lwt.return None + + let none_es = Lwt.return none_e + + let value_e o ~error = to_result ~none:error o + + let value_f o ~default = match o with None -> default () | Some v -> v + + let value_fe o ~error = + match o with None -> Error (error ()) | Some v -> Ok v + + let either oa ob = match oa with Some _ -> oa | None -> ob + + let map_s f o = + match o with None -> Lwt.return_none | Some v -> f v >>= Lwt.return_some + + let map_e f o = + match o with None -> none_e | Some v -> Result.M.map some (f v) + + let map_es f o = + match o with + | None -> + none_es + | Some v -> + (* TODO: when the monad becomes independent from the functors + applications, use a monad-like bind ([>|=?]).*) + Lwt.map (Result.M.map some) (f v) + + let fold_s ~none ~some = function + | None -> + Lwt.return none + | Some v -> + some v + + let fold_f ~none ~some = function None -> none () | Some v -> some v + + let iter_s f = function None -> Lwt.return_unit | Some v -> f v + + 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 +end diff --git a/src/lib_lwt_result_stdlib/functors/option.mli b/src/lib_lwt_result_stdlib/functors/option.mli new file mode 100644 index 000000000000..381be8e6bbb3 --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/option.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module M : Sigs.Option.S diff --git a/src/lib_lwt_result_stdlib/functors/result.ml b/src/lib_lwt_result_stdlib/functors/result.ml new file mode 100644 index 000000000000..e7467ddeb3eb --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/result.ml @@ -0,0 +1,128 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module M : Sigs.Result.S = struct + open Lwt.Infix + + type ('a, 'e) t = ('a, 'e) result = Ok of 'a | Error of 'e + + let ok x = Ok x + + let ok_s x = Lwt.return (Ok x) + + let error x = Error x + + let error_s x = Lwt.return (Error x) + + let value r ~default = match r with Ok v -> v | Error _ -> default + + let value_f r ~default = match r with Ok v -> v | Error _ -> default () + + let bind r f = match r with Ok v -> f v | Error _ as error -> error + + let bind_s r f = + match r with Ok v -> f v | Error _ as error -> Lwt.return error + + let bind_error r f = match r with Ok _ as ok -> ok | Error e -> f e + + let bind_error_s r f = + match r with Ok _ as ok -> Lwt.return ok | Error e -> f e + + let join = function + | (Error _ as error) | Ok (Error _ as error) -> + error + | Ok (Ok _ as ok) -> + ok + + let map f = function Ok v -> Ok (f v) | Error _ as error -> error + + let map_e f r = bind r f + + let map_s f = function + | Ok v -> + f v >>= fun v -> Lwt.return (Ok v) + | Error _ as error -> + Lwt.return error + + let map_es f r = bind_s r f + + let map_error f = function Ok _ as ok -> ok | Error e -> Error (f e) + + let map_error_e f r = bind_error r f + + let map_error_s f = function + | Ok v -> + Lwt.return (Ok v) + | Error e -> + f e >>= fun e -> Lwt.return (Error e) + + let map_error_es f r = bind_error_s r f + + let fold ~ok ~error = function Ok v -> ok v | Error e -> error e + + let iter f = function Ok v -> f v | Error _ -> () + + let iter_s f = function Ok v -> f v | Error _ -> Lwt.return_unit + + let iter_error f = function Ok _ -> () | Error e -> f e + + let iter_error_s f = function Ok _ -> Lwt.return_unit | Error e -> f e + + let is_ok = function Ok _ -> true | Error _ -> false + + let is_error = function Ok _ -> false | Error _ -> true + + let equal ~ok ~error x y = + match (x, y) with + | (Ok x, Ok y) -> + ok x y + | (Error x, Error y) -> + error x y + | (Ok _, Error _) | (Error _, Ok _) -> + false + + let compare ~ok ~error x y = + match (x, y) with + | (Ok x, Ok y) -> + ok x y + | (Error x, Error y) -> + error x y + | (Ok _, Error _) -> + -1 + | (Error _, Ok _) -> + 1 + + let to_option = function Ok v -> Some v | Error _ -> None + + let of_option ~error = function Some v -> Ok v | None -> Error error + + let to_list = function Ok v -> [v] | Error _ -> [] + + let to_seq = function + | Ok v -> + Stdlib.Seq.return v + | Error _ -> + Stdlib.Seq.empty +end diff --git a/src/lib_lwt_result_stdlib/functors/withExceptions.ml b/src/lib_lwt_result_stdlib/functors/withExceptions.ml new file mode 100644 index 000000000000..5113bad2c2fa --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/withExceptions.ml @@ -0,0 +1,85 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module M = struct + let invalid name loc = + Invalid_argument (Printf.sprintf "%s called from %s" name loc) + + module Option = struct + let get ~loc = function + | Some v -> + v + | None -> + raise (invalid "Lwtreslib.WithExceptions.Option.get" loc) + + let to_exn ~none = function Some v -> v | None -> raise none + + let to_exn_f ~none = function Some v -> v | None -> raise (none ()) + end + + module Result = struct + let get_ok ~loc = function + | Ok v -> + v + | Error _ -> + raise (invalid "Lwtreslib.WithExceptions.Result.get_ok" loc) + + let get_error ~loc = function + | Error e -> + e + | Ok _ -> + raise (invalid "Lwtreslib.WithExceptions.Result.get_error" loc) + + let to_exn = function Ok v -> v | Error exc -> raise exc + + let to_exn_f ~error = function Ok v -> v | Error b -> raise (error b) + end + + module List = struct + let rev_combine ~loc xs ys = + let rec aux acc xs ys = + match (xs, ys) with + | ([], []) -> + acc + | (x :: xs, y :: ys) -> + aux ((x, y) :: acc) xs ys + | ([], _ :: _) | (_ :: _, []) -> + raise (invalid "Lwtreslib.WithExceptions.List.rev_combine" loc) + in + aux [] xs ys + + let combine ~loc xs ys = + let rec aux acc xs ys = + match (xs, ys) with + | ([], []) -> + acc + | (x :: xs, y :: ys) -> + aux ((x, y) :: acc) xs ys + | ([], _ :: _) | (_ :: _, []) -> + raise (invalid "Lwtreslib.WithExceptions.List.combine" loc) + in + Stdlib.List.rev (aux [] xs ys) + end +end diff --git a/src/lib_lwt_result_stdlib/functors/withExceptions.mli b/src/lib_lwt_result_stdlib/functors/withExceptions.mli new file mode 100644 index 000000000000..7647f40b33fa --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/withExceptions.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module M : Sigs.WithExceptions.S diff --git a/src/lib_lwt_result_stdlib/lib/option.ml b/src/lib_lwt_result_stdlib/lib/option.ml new file mode 100644 index 000000000000..0d3338c7c2ba --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/option.ml @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Functors.Option.M diff --git a/src/lib_lwt_result_stdlib/lib/option.mli b/src/lib_lwt_result_stdlib/lib/option.mli new file mode 100644 index 000000000000..056121c7d12e --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/option.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Sigs.Option.S diff --git a/src/lib_lwt_result_stdlib/lib/result.ml b/src/lib_lwt_result_stdlib/lib/result.ml new file mode 100644 index 000000000000..88089399b002 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/result.ml @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Functors.Result.M diff --git a/src/lib_lwt_result_stdlib/lib/result.mli b/src/lib_lwt_result_stdlib/lib/result.mli new file mode 100644 index 000000000000..08d556fa6395 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/result.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Sigs.Result.S diff --git a/src/lib_lwt_result_stdlib/lib/withExceptions.ml b/src/lib_lwt_result_stdlib/lib/withExceptions.ml new file mode 100644 index 000000000000..7767b748556c --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/withExceptions.ml @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Functors.WithExceptions.M diff --git a/src/lib_lwt_result_stdlib/lib/withExceptions.mli b/src/lib_lwt_result_stdlib/lib/withExceptions.mli new file mode 100644 index 000000000000..f12ce6db3352 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/withExceptions.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Sigs.WithExceptions.S diff --git a/src/lib_lwt_result_stdlib/lwtreslib.ml b/src/lib_lwt_result_stdlib/lwtreslib.ml index 3128b884eed2..b0ac6449d6ac 100644 --- a/src/lib_lwt_result_stdlib/lwtreslib.ml +++ b/src/lib_lwt_result_stdlib/lwtreslib.ml @@ -28,3 +28,6 @@ module Set = Lib.Set module Map = Lib.Map module Hashtbl = Lib.Hashtbl module List = Lib.List +module Option = Lib.Option +module Result = Lib.Result +module WithExceptions = Lib.WithExceptions diff --git a/src/lib_lwt_result_stdlib/lwtreslib.mli b/src/lib_lwt_result_stdlib/lwtreslib.mli index 155975a8c993..c31e66e540e9 100644 --- a/src/lib_lwt_result_stdlib/lwtreslib.mli +++ b/src/lib_lwt_result_stdlib/lwtreslib.mli @@ -40,8 +40,7 @@ More and more modules will be added to this Library. In particular [List] (to avoid splitting the functionality from three distinct libraries and to - provide more consistent coverage), [Array], and [Option] will be made - available. + provide more consistent coverage) and [Array] will be made available. *) @@ -54,3 +53,9 @@ module Map : module type of Lib.Map module Hashtbl : module type of Lib.Hashtbl module List : module type of Lib.List + +module Option : module type of Lib.Option + +module Result : module type of Lib.Result + +module WithExceptions : module type of Lib.WithExceptions diff --git a/src/lib_lwt_result_stdlib/sigs/list.ml b/src/lib_lwt_result_stdlib/sigs/list.ml index 11ba967312e5..86970a6e5d4f 100644 --- a/src/lib_lwt_result_stdlib/sigs/list.ml +++ b/src/lib_lwt_result_stdlib/sigs/list.ml @@ -93,7 +93,8 @@ module type S = sig (** For substituting based on the {!Sigs.Trace} type. *) type 'error trace - (** Include the legacy list. Unsafe functions are shadowed below. *) + (** Include the legacy list. Functions that raise exceptions are shadowed + below. *) include module type of Stdlib.List with type 'a t = 'a Stdlib.List.t diff --git a/src/lib_lwt_result_stdlib/sigs/option.ml b/src/lib_lwt_result_stdlib/sigs/option.ml new file mode 100644 index 000000000000..b17111e31e77 --- /dev/null +++ b/src/lib_lwt_result_stdlib/sigs/option.ml @@ -0,0 +1,114 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** A wrapper around {!Stdlib.Option} that includes lwt-, error- and + lwt-error-aware traversal functions. + + See {!Seq} for general description of traversors, the meaning of [_s], [_e], + and [_es] suffixes. *) + +module type S = sig + type 'a t = 'a option = None | Some of 'a + + val none : 'a option + + val none_e : ('a option, 'trace) result + + val none_s : 'a option Lwt.t + + val none_es : ('a option, 'trace) result Lwt.t + + val some : 'a -> 'a option + + val some_unit : unit option + + val some_nil : 'a list option + + val some_e : 'a -> ('a option, 'trace) result + + val some_s : 'a -> 'a option Lwt.t + + val some_es : 'a -> ('a option, 'trace) result Lwt.t + + val value : 'a option -> default:'a -> 'a + + val value_e : 'a option -> error:'trace -> ('a, 'trace) result + + val value_f : 'a option -> default:(unit -> 'a) -> 'a + + val value_fe : 'a option -> error:(unit -> 'trace) -> ('a, 'trace) result + + val bind : 'a option -> ('a -> 'b option) -> 'b option + + val join : 'a option option -> 'a option + + val either : 'a option -> 'a option -> 'a option + + val map : ('a -> 'b) -> 'a option -> 'b option + + val map_s : ('a -> 'b Lwt.t) -> 'a option -> 'b option Lwt.t + + val map_e : + ('a -> ('b, 'trace) result) -> 'a option -> ('b option, 'trace) result + + val map_es : + ('a -> ('b, 'trace) result Lwt.t) -> + 'a option -> + ('b option, 'trace) result Lwt.t + + val fold : none:'a -> some:('b -> 'a) -> 'b option -> 'a + + val fold_s : none:'a -> some:('b -> 'a Lwt.t) -> 'b option -> 'a Lwt.t + + val fold_f : none:(unit -> 'a) -> some:('b -> 'a) -> 'b option -> 'a + + val iter : ('a -> unit) -> 'a option -> unit + + val iter_s : ('a -> unit Lwt.t) -> 'a option -> unit Lwt.t + + val iter_e : + ('a -> (unit, 'trace) result) -> 'a option -> (unit, 'trace) result + + val iter_es : + ('a -> (unit, 'trace) result Lwt.t) -> + 'a option -> + (unit, 'trace) result Lwt.t + + val is_none : 'a option -> bool + + val is_some : 'a option -> bool + + val equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool + + val compare : ('a -> 'a -> int) -> 'a option -> 'a option -> int + + val to_result : none:'trace -> 'a option -> ('a, 'trace) result + + val of_result : ('a, 'e) result -> 'a option + + val to_list : 'a option -> 'a list + + val to_seq : 'a option -> 'a Stdlib.Seq.t +end diff --git a/src/lib_lwt_result_stdlib/sigs/result.ml b/src/lib_lwt_result_stdlib/sigs/result.ml new file mode 100644 index 000000000000..840e5b031c3b --- /dev/null +++ b/src/lib_lwt_result_stdlib/sigs/result.ml @@ -0,0 +1,119 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** A wrapper around {!Stdlib.Result} that includes lwt-, error- and + lwt-error-aware traversal functions. + + See {!Seq} for general description of traversors, the meaning of [_s], [_e], + and [_es] suffixes. *) + +module type S = sig + type ('a, 'e) t = ('a, 'e) result = Ok of 'a | Error of 'e (***) + + val ok : 'a -> ('a, 'e) result + + val ok_s : 'a -> ('a, 'e) result Lwt.t + + val error : 'e -> ('a, 'e) result + + val error_s : 'e -> ('a, 'e) result Lwt.t + + val value : ('a, 'e) result -> default:'a -> 'a + + val value_f : ('a, 'e) result -> default:(unit -> 'a) -> 'a + + val bind : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result + + val bind_s : + ('a, 'e) result -> ('a -> ('b, 'e) result Lwt.t) -> ('b, 'e) result Lwt.t + + val bind_error : + ('a, 'e) result -> ('e -> ('a, 'f) result) -> ('a, 'f) result + + val bind_error_s : + ('a, 'e) result -> ('e -> ('a, 'f) result Lwt.t) -> ('a, 'f) result Lwt.t + + val join : (('a, 'e) result, 'e) result -> ('a, 'e) result + + val map : ('a -> 'b) -> ('a, 'e) result -> ('b, 'e) result + + (* NOTE: [map_e] is [bind] *) + val map_e : ('a -> ('b, 'e) result) -> ('a, 'e) result -> ('b, 'e) result + + val map_s : ('a -> 'b Lwt.t) -> ('a, 'e) result -> ('b, 'e) result Lwt.t + + (* NOTE: [map_es] is [bind_s] *) + val map_es : + ('a -> ('b, 'e) result Lwt.t) -> ('a, 'e) result -> ('b, 'e) result Lwt.t + + val map_error : ('e -> 'f) -> ('a, 'e) result -> ('a, 'f) result + + (* NOTE: [map_error_e] is [bind_error] *) + val map_error_e : + ('e -> ('a, 'f) result) -> ('a, 'e) result -> ('a, 'f) result + + val map_error_s : + ('e -> 'f Lwt.t) -> ('a, 'e) result -> ('a, 'f) result Lwt.t + + (* NOTE: [map_error_e] is [bind_error_s] *) + val map_error_es : + ('e -> ('a, 'f) result Lwt.t) -> ('a, 'e) result -> ('a, 'f) result Lwt.t + + val fold : ok:('a -> 'c) -> error:('e -> 'c) -> ('a, 'e) result -> 'c + + val iter : ('a -> unit) -> ('a, 'e) result -> unit + + val iter_s : ('a -> unit Lwt.t) -> ('a, 'e) result -> unit Lwt.t + + val iter_error : ('e -> unit) -> ('a, 'e) result -> unit + + val iter_error_s : ('e -> unit Lwt.t) -> ('a, 'e) result -> unit Lwt.t + + val is_ok : ('a, 'e) result -> bool + + val is_error : ('a, 'e) result -> bool + + val equal : + ok:('a -> 'a -> bool) -> + error:('e -> 'e -> bool) -> + ('a, 'e) result -> + ('a, 'e) result -> + bool + + val compare : + ok:('a -> 'a -> int) -> + error:('e -> 'e -> int) -> + ('a, 'e) result -> + ('a, 'e) result -> + int + + val to_option : ('a, 'e) result -> 'a option + + val of_option : error:'e -> 'a option -> ('a, 'e) result + + val to_list : ('a, 'e) result -> 'a list + + val to_seq : ('a, 'e) result -> 'a Stdlib.Seq.t +end diff --git a/src/lib_lwt_result_stdlib/sigs/withExceptions.ml b/src/lib_lwt_result_stdlib/sigs/withExceptions.ml new file mode 100644 index 000000000000..ba3e7e0a4339 --- /dev/null +++ b/src/lib_lwt_result_stdlib/sigs/withExceptions.ml @@ -0,0 +1,59 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Functions that raise exceptions are hidden in the main modules of Lwtreslib + but available here. These functions are either: very practical or are safe + in some specific uses (e.g., [List.init] when used with a literal length). + + Functions that take a [loc] parameter raise {!Invalid_argument} with the + location included in the exception's message. +*) + +module type S = sig + module Option : sig + val get : loc:string -> 'a option -> 'a + + val to_exn : none:exn -> 'a option -> 'a + + val to_exn_f : none:(unit -> exn) -> 'a option -> 'a + end + + module Result : sig + val get_ok : loc:string -> ('a, 'trace) result -> 'a + + val get_error : loc:string -> ('a, 'trace) result -> 'trace + + (* [to_exn (Ok v)] is [v], [to_exn (Error e)] raises [e] *) + val to_exn : ('a, exn) result -> 'a + + val to_exn_f : error:('b -> exn) -> ('a, 'b) result -> 'a + end + + module List : sig + val combine : loc:string -> 'a list -> 'b list -> ('a * 'b) list + + val rev_combine : loc:string -> 'a list -> 'b list -> ('a * 'b) list + end +end diff --git a/src/lib_lwt_result_stdlib/test/test_list_basic.ml b/src/lib_lwt_result_stdlib/test/test_list_basic.ml index 26557886c24f..a014d7f049b6 100644 --- a/src/lib_lwt_result_stdlib/test/test_list_basic.ml +++ b/src/lib_lwt_result_stdlib/test/test_list_basic.ml @@ -247,7 +247,7 @@ module Combine = struct assert (combine_with_leftovers [] [] = ([], None)) ; assert ( combine_with_leftovers (up 100) (down 100) - = ( Result.get_ok + = ( Stdlib.Result.get_ok @@ init ~when_negative_length:() 101 (fun i -> (i, 100 - i)), None ) ) ; assert (combine_with_leftovers [0] [1] = ([(0, 1)], None)) ; -- GitLab From 95be579abed8722f050b72b5ef610f507088f1de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 1 Sep 2020 09:44:51 +0200 Subject: [PATCH 2/8] Stdlib: remove TzOption --- src/lib_base/tzPervasives.ml | 9 ++-- src/lib_base/tzPervasives.mli | 10 ++-- .../environment_V1.ml | 2 +- .../structs/v1.dune.inc | 1 + .../structs/v1/option.ml} | 10 +++- src/lib_stdlib/tzList.ml | 7 ++- src/lib_stdlib/tzOption.mli | 49 ------------------- 7 files changed, 23 insertions(+), 65 deletions(-) rename src/{lib_stdlib/tzOption.ml => lib_protocol_environment/structs/v1/option.ml} (92%) delete mode 100644 src/lib_stdlib/tzOption.mli diff --git a/src/lib_base/tzPervasives.ml b/src/lib_base/tzPervasives.ml index 1d43a44b04b6..15a3ba700288 100644 --- a/src/lib_base/tzPervasives.ml +++ b/src/lib_base/tzPervasives.ml @@ -34,17 +34,16 @@ module Seq = Tezos_lwt_result_stdlib.Lwtreslib.Seq module Map = Tezos_lwt_result_stdlib.Lwtreslib.Map module Set = Tezos_lwt_result_stdlib.Lwtreslib.Set module Hashtbl = Tezos_lwt_result_stdlib.Lwtreslib.Hashtbl - -module Option = struct - include Option - include Tezos_stdlib.TzOption -end +module Option = Tezos_lwt_result_stdlib.Lwtreslib.Option module List = struct include Tezos_stdlib.TzList include Tezos_lwt_result_stdlib.Lwtreslib.List end +module Result = Tezos_lwt_result_stdlib.Lwtreslib.Result +module Unsafe = Tezos_lwt_result_stdlib.Lwtreslib.Unsafe + module String = struct include String include Tezos_stdlib.TzString diff --git a/src/lib_base/tzPervasives.mli b/src/lib_base/tzPervasives.mli index 5060203ff663..2171f7dc0c4f 100644 --- a/src/lib_base/tzPervasives.mli +++ b/src/lib_base/tzPervasives.mli @@ -42,12 +42,7 @@ module Seq = Tezos_lwt_result_stdlib.Lwtreslib.Seq module Map = Tezos_lwt_result_stdlib.Lwtreslib.Map module Set = Tezos_lwt_result_stdlib.Lwtreslib.Set module Hashtbl = Tezos_lwt_result_stdlib.Lwtreslib.Hashtbl - -module Option : sig - include module type of Option - - include module type of Tezos_stdlib.TzOption -end +module Option = Tezos_lwt_result_stdlib.Lwtreslib.Option module List : sig include module type of Tezos_stdlib.TzList @@ -55,6 +50,9 @@ module List : sig include module type of Tezos_lwt_result_stdlib.Lwtreslib.List end +module Result = Tezos_lwt_result_stdlib.Lwtreslib.Result +module Unsafe = Tezos_lwt_result_stdlib.Lwtreslib.Unsafe + module String : sig include module type of String diff --git a/src/lib_protocol_environment/environment_V1.ml b/src/lib_protocol_environment/environment_V1.ml index 2f79b9b0c940..1e35280bdcee 100644 --- a/src/lib_protocol_environment/environment_V1.ml +++ b/src/lib_protocol_environment/environment_V1.ml @@ -131,7 +131,7 @@ struct module Int64 = Int64 module Buffer = Buffer module Format = Format - module Option = Tezos_base.TzPervasives.Option + module Option = Option module Raw_hashes = struct let sha256 = Hacl.Hash.SHA256.digest diff --git a/src/lib_protocol_environment/structs/v1.dune.inc b/src/lib_protocol_environment/structs/v1.dune.inc index d6ce6f22f122..68b71ab52c89 100644 --- a/src/lib_protocol_environment/structs/v1.dune.inc +++ b/src/lib_protocol_environment/structs/v1.dune.inc @@ -15,6 +15,7 @@ v1/protocol_hash.ml v1/context_hash.ml v1/error_monad_traversors.ml + v1/option.ml ) (action (with-stdout-to %{targets} (chdir %{workspace_root}} diff --git a/src/lib_stdlib/tzOption.ml b/src/lib_protocol_environment/structs/v1/option.ml similarity index 92% rename from src/lib_stdlib/tzOption.ml rename to src/lib_protocol_environment/structs/v1/option.ml index 181804470aac..73ad4acf4be6 100644 --- a/src/lib_stdlib/tzOption.ml +++ b/src/lib_protocol_environment/structs/v1/option.ml @@ -24,9 +24,15 @@ (* *) (*****************************************************************************) -let ( >>= ) x f = Option.bind x f +include Stdlib.Option -let ( >>| ) x f = Option.map f x +let ( >>= ) = bind + +let ( >>| ) x f = map f x + +let unopt ~default = function None -> default | Some x -> x + +let unopt_map ~f ~default = function None -> default | Some x -> f x let unopt_exn err = function Some x -> x | _ -> raise err diff --git a/src/lib_stdlib/tzList.ml b/src/lib_stdlib/tzList.ml index 483da423f6a7..ef589a72cde0 100644 --- a/src/lib_stdlib/tzList.ml +++ b/src/lib_stdlib/tzList.ml @@ -41,8 +41,11 @@ let rev_sub l n = let sub l n = rev_sub l n |> List.rev -let merge_filter2 ?(finalize = List.rev) ?(compare = compare) - ?(f = TzOption.first_some) l1 l2 = +let first_some o1 o2 = + match (o1, o2) with (Some _, _) -> o1 | (None, o2) -> o2 + +let merge_filter2 ?(finalize = List.rev) ?(compare = compare) ?(f = first_some) + l1 l2 = let sort = List.sort compare in let rec merge_aux acc = function | ([], []) -> diff --git a/src/lib_stdlib/tzOption.mli b/src/lib_stdlib/tzOption.mli deleted file mode 100644 index dda34e425912..000000000000 --- a/src/lib_stdlib/tzOption.mli +++ /dev/null @@ -1,49 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2019 Nomadic Labs, *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** [x >>= f] is an infix notation for [apply ~f x] *) -val ( >>= ) : 'a option -> ('a -> 'b option) -> 'b option - -(** [x >>| f] is an infix notation for [map ~f x] *) -val ( >>| ) : 'a option -> ('a -> 'b) -> 'b option - -(** [unopt_exn exn x] is [y] if [x] is [Some y], or raises [exn] if [x] is [None] *) -val unopt_exn : exn -> 'a option -> 'a - -(** [unopt_assert ~loc x] is [y] if [x] is [Some y], or raises [Assert_failure loc] if [x] is [None] *) -val unopt_assert : loc:string * int * int * 'a -> 'b option -> 'b - -(** First input of form [Some x], or [None] if both are [None] *) -val first_some : 'a option -> 'a option -> 'a option - -(** [pp ~default pp fmt x] pretty-print value [x] using [pp] - or [default] (["None"] by default) string if there is no value. *) -val pp : - ?default:string -> - (Format.formatter -> 'a -> unit) -> - Format.formatter -> - 'a option -> - unit -- GitLab From 634af765db42e75abf1fb39586ad6514ad52b9c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Tue, 1 Sep 2020 09:56:12 +0200 Subject: [PATCH 3/8] Stdlib: remove Lwt_utils.may --- src/lib_stdlib/lwt_utils.ml | 2 -- src/lib_stdlib/lwt_utils.mli | 2 -- 2 files changed, 4 deletions(-) diff --git a/src/lib_stdlib/lwt_utils.ml b/src/lib_stdlib/lwt_utils.ml index c80262f1eaba..b6d14349a890 100644 --- a/src/lib_stdlib/lwt_utils.ml +++ b/src/lib_stdlib/lwt_utils.ml @@ -25,8 +25,6 @@ open Lwt.Infix -let may ~f = Option.fold ~none:Lwt.return_unit ~some:f - let never_ending () = fst (Lwt.wait ()) (* A worker launcher, takes a cancel callback to call upon *) diff --git a/src/lib_stdlib/lwt_utils.mli b/src/lib_stdlib/lwt_utils.mli index 273b41bbea80..cc766c301ed2 100644 --- a/src/lib_stdlib/lwt_utils.mli +++ b/src/lib_stdlib/lwt_utils.mli @@ -23,8 +23,6 @@ (* *) (*****************************************************************************) -val may : f:('a -> unit Lwt.t) -> 'a option -> unit Lwt.t - val never_ending : unit -> 'a Lwt.t (** [worker name ~on_event ~run ~cancel] internally calls [run ()] (which -- GitLab From 74dde557453ec20000e126e04fa51c909067c8d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 9 Dec 2020 10:23:26 +0100 Subject: [PATCH 4/8] Clic: Adapt to new Option and Result --- src/lib_clic/clic.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib_clic/clic.ml b/src/lib_clic/clic.ml index 93f8437e4a33..dbb9513c1c06 100644 --- a/src/lib_clic/clic.ml +++ b/src/lib_clic/clic.ml @@ -2022,7 +2022,7 @@ let complete_next_tree cctxt = function >|=? fun completions -> completions @ list_command_args command | TNonTerminalSeq {autocomplete; suffix; _} -> complete_func autocomplete cctxt - >|=? fun completions -> completions @ [Option.get @@ List.hd suffix] + >|=? fun completions -> completions @ [Unsafe.Option.get ~loc:__LOC__ @@ List.hd suffix] | TParam {autocomplete; _} -> complete_func autocomplete cctxt | TStop command -> -- GitLab From 47c09f52d9bcd86c54fc828f399d07ed5cb1ff24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 9 Dec 2020 13:33:44 +0100 Subject: [PATCH 5/8] Everywhere: adapt to new Option and Result --- src/bin_client/client_rpc_commands.ml | 3 +- src/bin_node/node_config_file.ml | 16 +-- src/bin_node/node_shared_arg.ml | 2 +- src/bin_snoop/dep_graph.ml | 2 +- src/bin_snoop/display.ml | 8 +- src/lib_base/time.ml | 4 +- src/lib_base/tzPervasives.ml | 2 +- src/lib_base/tzPervasives.mli | 2 +- src/lib_benchmark/base_samplers.ml | 5 +- src/lib_benchmark/csv.ml | 2 +- src/lib_benchmark/example/blake2b.ml | 4 +- src/lib_benchmark/fixed_point_transform.ml | 5 +- src/lib_benchmark/inference.ml | 10 +- src/lib_benchmark/override.ml | 3 +- src/lib_benchmark/test/test_blake2b.ml | 10 +- src/lib_benchmark/test/test_inference.ml | 6 +- src/lib_clic/clic.ml | 3 +- src/lib_client_base/client_confirmations.ml | 3 +- src/lib_client_base_unix/client_config.ml | 18 ++- src/lib_client_commands/client_commands.ml | 2 +- src/lib_crypto/base58.ml | 4 +- src/lib_lwt_result_stdlib/functors/result.mli | 26 ++++ src/lib_lwt_result_stdlib/sigs/result.ml | 2 +- src/lib_p2p/p2p.ml | 2 +- src/lib_p2p/p2p_maintenance.ml | 8 +- src/lib_p2p/p2p_pool.ml | 3 +- src/lib_p2p/test/test_p2p_pool.ml | 32 ++--- src/lib_p2p_services/p2p_errors.ml | 8 +- .../test/test_mem_context_array_theory.ml | 6 +- src/lib_proxy/test/test_proxy.ml | 6 +- src/lib_requester/test/test_requester.ml | 17 ++- src/lib_sapling/core.ml | 4 +- src/lib_sapling/forge.ml | 23 ++-- src/lib_sapling/rustzcash.ml | 2 +- src/lib_sapling/test/example.ml | 10 +- src/lib_shell/block_directory.ml | 6 +- src/lib_shell/chain.ml | 5 +- src/lib_shell/chain_validator.ml | 9 +- src/lib_shell/monitor_directory.ml | 15 ++- src/lib_shell/peer_validator.ml | 2 +- src/lib_shell/snapshots.ml | 6 +- src/lib_shell/state.ml | 63 ++++----- src/lib_shell/test/test_locator.ml | 22 +-- src/lib_shell/test/test_node.ml | 6 +- src/lib_shell/test/test_state.ml | 7 +- src/lib_shell/test/test_state_checkpoint.ml | 7 +- src/lib_shell/worker_directory.ml | 8 +- src/lib_shell_benchmarks/io_helpers.ml | 29 ---- src/lib_shell_services/block_services.ml | 4 +- src/lib_signer_backends/encrypted.ml | 6 +- .../test/test_encrypted.ml | 6 +- src/lib_stdlib_unix/file_descriptor_sink.ml | 6 +- src/lib_stdlib_unix/file_event_sink.ml | 26 ++-- src/lib_storage/test/test_context.ml | 2 +- .../lib_client/michelson_v1_emacs.ml | 12 +- .../lib_client/operation_result.ml | 12 +- .../lib_client/michelson_v1_emacs.ml | 12 +- .../lib_client/operation_result.ml | 12 +- .../lib_client/michelson_v1_emacs.ml | 12 +- .../lib_client/michelson_v1_macros.ml | 2 +- .../lib_client/operation_result.ml | 12 +- .../lib_client/michelson_v1_emacs.ml | 12 +- .../lib_client/michelson_v1_macros.ml | 2 +- .../lib_client/operation_result.ml | 12 +- .../lib_client/michelson_v1_emacs.ml | 12 +- .../lib_client/michelson_v1_entrypoints.ml | 13 +- .../lib_client/operation_result.ml | 12 +- .../lib_client/michelson_v1_emacs.ml | 12 +- .../lib_client/michelson_v1_entrypoints.ml | 13 +- .../lib_client/operation_result.ml | 12 +- .../lib_client/michelson_v1_emacs.ml | 12 +- .../lib_client/michelson_v1_entrypoints.ml | 13 +- .../lib_client/operation_result.ml | 12 +- .../client_proto_context_commands.ml | 10 +- .../lib_delegate/client_baking_forge.ml | 48 +++++-- .../lib_protocol/test/activation.ml | 40 ++++-- .../lib_protocol/test/delegation.ml | 126 +++++++++++++----- .../lib_protocol/test/double_baking.ml | 12 +- .../lib_protocol/test/double_endorsement.ml | 8 +- .../lib_protocol/test/endorsement.ml | 9 +- .../lib_protocol/test/helpers/block.ml | 12 +- .../lib_protocol/test/helpers/context.ml | 2 +- .../lib_protocol/test/helpers/op.ml | 6 +- .../lib_protocol/test/origination.ml | 16 ++- .../lib_protocol/test/reveal.ml | 6 +- .../lib_protocol/test/seed.ml | 10 +- .../lib_protocol/test/transfer.ml | 36 +++-- .../lib_protocol/test/voting.ml | 60 ++++++--- .../lib_client/michelson_v1_emacs.ml | 12 +- .../lib_client/michelson_v1_entrypoints.ml | 13 +- .../lib_client/operation_result.ml | 12 +- .../client_proto_context_commands.ml | 10 +- .../client_sapling_commands.ml | 8 +- .../lib_client_sapling/context.ml | 26 ++-- .../lib_delegate/client_baking_blocks.ml | 2 +- .../client_baking_denunciation.ml | 3 +- .../lib_delegate/client_baking_forge.ml | 48 +++++-- .../lib_protocol/test/activation.ml | 40 ++++-- .../lib_protocol/test/baking.ml | 2 +- .../lib_protocol/test/combined_operations.ml | 22 +-- .../lib_protocol/test/delegation.ml | 126 +++++++++++++----- .../lib_protocol/test/double_baking.ml | 26 ++-- .../lib_protocol/test/double_endorsement.ml | 25 +++- .../lib_protocol/test/endorsement.ml | 17 ++- .../lib_protocol/test/helpers/block.ml | 12 +- .../lib_protocol/test/helpers/context.ml | 2 +- .../lib_protocol/test/helpers/op.ml | 6 +- .../test/helpers/sapling_helpers.ml | 2 +- .../lib_protocol/test/origination.ml | 16 ++- .../lib_protocol/test/reveal.ml | 6 +- .../lib_protocol/test/seed.ml | 10 +- .../lib_protocol/test/test_helpers_rpcs.ml | 5 +- .../lib_protocol/test/test_sapling.ml | 28 ++-- .../lib_protocol/test/transfer.ml | 44 ++++-- .../lib_protocol/test/typechecking.ml | 2 +- .../lib_protocol/test/voting.ml | 92 ++++++++----- .../lib_client/michelson_v1_emacs.ml | 12 +- .../lib_client/michelson_v1_entrypoints.ml | 13 +- .../lib_client/operation_result.ml | 12 +- .../client_proto_context_commands.ml | 10 +- .../client_sapling_commands.ml | 8 +- src/proto_alpha/lib_client_sapling/context.ml | 26 ++-- .../lib_delegate/client_baking_forge.ml | 48 +++++-- .../lib_protocol/test/helpers/block.ml | 12 +- .../lib_protocol/test/helpers/context.ml | 2 +- .../lib_protocol/test/helpers/op.ml | 6 +- .../test/helpers/sapling_helpers.ml | 2 +- .../lib_protocol/test/test_activation.ml | 40 ++++-- .../lib_protocol/test/test_baking.ml | 2 +- .../lib_protocol/test/test_delegation.ml | 126 +++++++++++++----- .../lib_protocol/test/test_double_baking.ml | 6 +- .../test/test_double_endorsement.ml | 2 +- .../lib_protocol/test/test_endorsement.ml | 9 +- .../lib_protocol/test/test_helpers_rpcs.ml | 2 +- .../lib_protocol/test/test_origination.ml | 16 ++- .../lib_protocol/test/test_reveal.ml | 6 +- .../lib_protocol/test/test_sapling.ml | 29 ++-- .../lib_protocol/test/test_seed.ml | 10 +- .../lib_protocol/test/test_transfer.ml | 36 +++-- .../lib_protocol/test/test_typechecking.ml | 2 +- .../lib_protocol/test/test_voting.ml | 92 ++++++++----- .../lib_client/client_proto_commands.ml | 4 +- 142 files changed, 1436 insertions(+), 824 deletions(-) create mode 100644 src/lib_lwt_result_stdlib/functors/result.mli diff --git a/src/bin_client/client_rpc_commands.ml b/src/bin_client/client_rpc_commands.ml index 192305cb6a63..ffa15bd5e7d8 100644 --- a/src/bin_client/client_rpc_commands.ml +++ b/src/bin_client/client_rpc_commands.ml @@ -77,7 +77,8 @@ let fill_in ?(show_optionals = true) input schema = | Combine ((One_of | Any_of), elts) -> let nb = List.length elts in input.int 0 (nb - 1) (Some "Select the schema to follow") path - >>= fun n -> element path (Option.get @@ List.nth elts n) + >>= fun n -> + element path (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth elts n) | Combine ((All_of | Not), _) -> Lwt.fail Unsupported_construct | Def_ref name -> diff --git a/src/bin_node/node_config_file.ml b/src/bin_node/node_config_file.ml index 4d1e87c53d24..941d3e2b0029 100644 --- a/src/bin_node/node_config_file.ml +++ b/src/bin_node/node_config_file.ml @@ -1132,13 +1132,13 @@ let update ?data_dir ?min_connections ?expected_connections ?max_connections max_connections = Option.value ~default:cfg.p2p.limits.max_connections max_connections; max_download_speed = - Option.first_some max_download_speed cfg.p2p.limits.max_download_speed; + Option.either max_download_speed cfg.p2p.limits.max_download_speed; max_upload_speed = - Option.first_some max_upload_speed cfg.p2p.limits.max_upload_speed; + Option.either max_upload_speed cfg.p2p.limits.max_upload_speed; max_known_points = - Option.first_some peer_table_size cfg.p2p.limits.max_known_points; + Option.either peer_table_size cfg.p2p.limits.max_known_points; max_known_peer_ids = - Option.first_some peer_table_size cfg.p2p.limits.max_known_peer_ids; + Option.either peer_table_size cfg.p2p.limits.max_known_peer_ids; binary_chunks_size = Option.map (fun x -> x lsl 10) binary_chunks_size; } in @@ -1147,8 +1147,8 @@ let update ?data_dir ?min_connections ?expected_connections ?max_connections expected_pow = Option.value ~default:cfg.p2p.expected_pow expected_pow; bootstrap_peers = Option.value ~default:cfg.p2p.bootstrap_peers bootstrap_peers; - listen_addr = Option.first_some listen_addr cfg.p2p.listen_addr; - discovery_addr = Option.first_some discovery_addr cfg.p2p.discovery_addr; + listen_addr = Option.either listen_addr cfg.p2p.listen_addr; + discovery_addr = Option.either discovery_addr cfg.p2p.discovery_addr; private_mode = cfg.p2p.private_mode || private_mode; limits; disable_mempool = cfg.p2p.disable_mempool || disable_mempool; @@ -1160,7 +1160,7 @@ let update ?data_dir ?min_connections ?expected_connections ?max_connections listen_addrs = unopt_list ~default:cfg.rpc.listen_addrs rpc_listen_addrs; cors_origins = unopt_list ~default:cfg.rpc.cors_origins cors_origins; cors_headers = unopt_list ~default:cfg.rpc.cors_headers cors_headers; - tls = Option.first_some rpc_tls cfg.rpc.tls; + tls = Option.either rpc_tls cfg.rpc.tls; } and log : Lwt_log_sink_unix.cfg = {cfg.log with output = Option.value ~default:cfg.log.output log_output} @@ -1185,7 +1185,7 @@ let update ?data_dir ?min_connections ?expected_connections ?max_connections } in {cfg.shell.chain_validator_limits with synchronisation}); - history_mode = Option.first_some history_mode cfg.shell.history_mode; + history_mode = Option.either history_mode cfg.shell.history_mode; } in (* If --network is specified it overrides the "network" entry of the diff --git a/src/bin_node/node_shared_arg.ml b/src/bin_node/node_shared_arg.ml index 0f89d222d0a4..5d210126202b 100644 --- a/src/bin_node/node_shared_arg.ml +++ b/src/bin_node/node_shared_arg.ml @@ -159,7 +159,7 @@ module Term = struct in let printer ppf ({alias; _} : Node_config_file.blockchain_network) = (* Should not fail by construction of Node_config_file.block_chain_network *) - let alias = Option.unopt_assert ~loc:__POS__ alias in + let alias = WithExceptions.Option.get ~loc:__LOC__ alias in Format.fprintf ppf "%s" alias in ( (of_string : string -> ('a, [`Msg of string]) result), diff --git a/src/bin_snoop/dep_graph.ml b/src/bin_snoop/dep_graph.ml index 40dd90482a5f..f920e7792510 100644 --- a/src/bin_snoop/dep_graph.ml +++ b/src/bin_snoop/dep_graph.ml @@ -209,7 +209,7 @@ module Solver = struct Format.eprintf "Root: %a@." Free_variable.pp - (Option.get (Fv_set.choose provides))) + (WithExceptions.Option.get ~loc:__LOC__ (Fv_set.choose provides))) roots ; (* Propagate iteratively. *) let state = {solved = []; unsolved = others} in diff --git a/src/bin_snoop/display.ml b/src/bin_snoop/display.ml index 62bbd4260548..1980356cb829 100644 --- a/src/bin_snoop/display.ml +++ b/src/bin_snoop/display.ml @@ -170,7 +170,7 @@ let empirical_data (workload_data : (Sparse_vec.String.t * float) list) = let named_columns = List.combine ~when_different_lengths:() vars columns |> (* [columns = Array.to_list (Array.init (List.length vars))] *) - Result.get_ok + WithExceptions.Result.get_ok ~loc:__LOC__ in Ok (named_columns, timings) @@ -198,7 +198,7 @@ let prune_problem problem : (Free_variable.t * Matrix.t) list * Matrix.t = let col = Matrix.column input c in (name, col)) |> (* column count cannot be negative *) - Result.get_ok + WithExceptions.Result.get_ok ~loc:__LOC__ in let columns = List.filter @@ -268,7 +268,9 @@ let validator_empirical workload_data (problem : Inference.problem) (solution : Inference.solution) : (int * (col:int -> unit Plot.t), string) result = let {Inference.mapping; _} = solution in - let valuation name = Option.get @@ List.assoc name mapping in + let valuation name = + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc name mapping + in let predicted = match problem with | Inference.Degenerate {predicted; _} -> diff --git a/src/lib_base/time.ml b/src/lib_base/time.ml index 5b8a7a9aa077..19370e9f8d7c 100644 --- a/src/lib_base/time.ml +++ b/src/lib_base/time.ml @@ -154,8 +154,8 @@ module System = struct let multiply_exn f s = let open Ptime.Span in - TzOption.unopt_exn - (Failure "Time.System.Span.multiply_exn") + WithExceptions.Option.to_exn + ~none:(Failure "Time.System.Span.multiply_exn") (of_float_s (f *. Ptime.Span.to_float_s s)) let of_seconds_exn f = diff --git a/src/lib_base/tzPervasives.ml b/src/lib_base/tzPervasives.ml index 15a3ba700288..766d6c7e7137 100644 --- a/src/lib_base/tzPervasives.ml +++ b/src/lib_base/tzPervasives.ml @@ -42,7 +42,7 @@ module List = struct end module Result = Tezos_lwt_result_stdlib.Lwtreslib.Result -module Unsafe = Tezos_lwt_result_stdlib.Lwtreslib.Unsafe +module WithExceptions = Tezos_lwt_result_stdlib.Lwtreslib.WithExceptions module String = struct include String diff --git a/src/lib_base/tzPervasives.mli b/src/lib_base/tzPervasives.mli index 2171f7dc0c4f..42aad18d2b8e 100644 --- a/src/lib_base/tzPervasives.mli +++ b/src/lib_base/tzPervasives.mli @@ -51,7 +51,7 @@ module List : sig end module Result = Tezos_lwt_result_stdlib.Lwtreslib.Result -module Unsafe = Tezos_lwt_result_stdlib.Lwtreslib.Unsafe +module WithExceptions = Tezos_lwt_result_stdlib.Lwtreslib.WithExceptions module String : sig include module type of String diff --git a/src/lib_benchmark/base_samplers.ml b/src/lib_benchmark/base_samplers.ml index 65f4808f836b..565badb7080b 100644 --- a/src/lib_benchmark/base_samplers.ml +++ b/src/lib_benchmark/base_samplers.ml @@ -125,7 +125,10 @@ module Adversarial = struct let common_prefix = string state ~size:prefix_size in let rand_suffix = salt state card in let elements = - Stdlib.List.init card (fun _ -> common_prefix ^ rand_suffix ()) + List.init ~when_negative_length:() card (fun _ -> + common_prefix ^ rand_suffix ()) + |> (* see [invalid_arg] above *) + WithExceptions.Result.get_ok ~loc:__LOC__ in (common_prefix, elements) diff --git a/src/lib_benchmark/csv.ml b/src/lib_benchmark/csv.ml index f11a91f769e7..75f7031ac5a9 100644 --- a/src/lib_benchmark/csv.ml +++ b/src/lib_benchmark/csv.ml @@ -52,7 +52,7 @@ let concat (csv1 : csv) (csv2 : csv) : csv = (fun line1 line2 -> line1 @ line2) csv1 csv2 - |> (* see top if condition *) Result.get_ok + |> (* see top if condition *) WithExceptions.Result.get_ok ~loc:__LOC__ let export ~filename ?(separator = ',') ?(linebreak = '\n') (data : csv) = Format.eprintf "Exporting to %s@." filename ; diff --git a/src/lib_benchmark/example/blake2b.ml b/src/lib_benchmark/example/blake2b.ml index 36b7046573be..eaaa6f3fb226 100644 --- a/src/lib_benchmark/example/blake2b.ml +++ b/src/lib_benchmark/example/blake2b.ml @@ -102,4 +102,6 @@ let () = Registration.register (module Blake2b_bench) let () = Registration.register_for_codegen "blake2b_codegen" - (Model.For_codegen (Option.get @@ List.assoc "blake2b" Blake2b_bench.models)) + (Model.For_codegen + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc "blake2b" Blake2b_bench.models )) diff --git a/src/lib_benchmark/fixed_point_transform.ml b/src/lib_benchmark/fixed_point_transform.ml index 22121ca3522e..42d74c3ec85e 100644 --- a/src/lib_benchmark/fixed_point_transform.ml +++ b/src/lib_benchmark/fixed_point_transform.ml @@ -219,7 +219,8 @@ module Fixed_point_arithmetic (Lang : Fixed_point_lang_sig) = struct all_bits x = [sign] @ exponent @ mantissa *) let all_bits (x : float) : int64 list = List.init ~when_negative_length:() 64 (fun i -> bit x i) - |> (* 64 >= 0 *) Result.get_ok |> List.rev + |> (* 64 >= 0 *) WithExceptions.Result.get_ok ~loc:__LOC__ + |> List.rev (* take n first elements from a list *) let take n l = @@ -286,7 +287,7 @@ module Fixed_point_arithmetic (Lang : Fixed_point_lang_sig) = struct (0, None) bits in - Option.unopt_assert ~loc:__POS__ result_opt + WithExceptions.Option.get ~loc:__LOC__ result_opt end (* ------------------------------------------------------------------------- *) diff --git a/src/lib_benchmark/inference.ml b/src/lib_benchmark/inference.ml index d437898e12a4..d386bf4dfe83 100644 --- a/src/lib_benchmark/inference.ml +++ b/src/lib_benchmark/inference.ml @@ -244,13 +244,16 @@ let to_list_of_rows (m : Scikit.Matrix.t) : float list list = let (lines, cols) = Scikit.Matrix.shape m in let init n f = List.init ~when_negative_length:() n f - |> (* lines/column count cannot be negative *) Result.get_ok + |> (* lines/column count cannot be negative *) + WithExceptions.Result.get_ok ~loc:__LOC__ in init lines (fun l -> init cols (fun c -> Scikit.Matrix.get m l c)) let of_list_of_rows (m : float list list) : Scikit.Matrix.t = let lines = List.length m in - let cols = List.length (Option.get @@ List.hd m) in + let cols = + List.length (WithExceptions.Option.get ~loc:__LOC__ @@ List.hd m) + in let mat = Scikit.Matrix.create ~lines ~cols in List.iteri (fun l row -> List.iteri (fun c elt -> Scikit.Matrix.set mat l c elt) row) @@ -262,7 +265,8 @@ let model_matrix_to_csv (m : Scikit.Matrix.t) (nmap : NMap.t) : Csv.csv = let names = List.init ~when_negative_length:() cols (fun i -> fv_to_string (NMap.nth_exn nmap i)) - |> (* number of column cannot be negative *) Result.get_ok + |> (* number of column cannot be negative *) + WithExceptions.Result.get_ok ~loc:__LOC__ in let rows = to_list_of_rows m in let rows = List.map (List.map string_of_float) rows in diff --git a/src/lib_benchmark/override.ml b/src/lib_benchmark/override.ml index 9a2e16e02987..e388e2267c4c 100644 --- a/src/lib_benchmark/override.ml +++ b/src/lib_benchmark/override.ml @@ -57,7 +57,8 @@ let load_file ~filename map = map header values - |> (* {!Csv.import} fails before this can *) Result.get_ok + |> (* {!Csv.import} fails before this can *) + WithExceptions.Result.get_ok ~loc:__LOC__ let load ~filenames : t = List.fold_left diff --git a/src/lib_benchmark/test/test_blake2b.ml b/src/lib_benchmark/test/test_blake2b.ml index f2f25f05c6a5..c7cff11d4420 100644 --- a/src/lib_benchmark/test/test_blake2b.ml +++ b/src/lib_benchmark/test/test_blake2b.ml @@ -69,7 +69,10 @@ let measurement = let solution = match measurement with | Measure.Measurement ((module Bench), {workload_data; _}) -> - let model = List.assoc "blake2b" Bench.models |> Option.get in + let model = + List.assoc "blake2b" Bench.models + |> WithExceptions.Option.get ~loc:__LOC__ + in let problem = Inference.make_problem ~data:workload_data ~model ~overrides:(fun _ -> None) @@ -89,7 +92,10 @@ let solution = let () = match measurement with | Measure.Measurement ((module Bench), _) -> ( - let model = List.assoc "blake2b" Bench.models |> Option.get in + let model = + List.assoc "blake2b" Bench.models + |> WithExceptions.Option.get ~loc:__LOC__ + in let solution = Free_variable.Map.of_seq (List.to_seq solution.mapping) in ( match Codegen.codegen model solution (module Costlang.Identity) with | None -> diff --git a/src/lib_benchmark/test/test_inference.ml b/src/lib_benchmark/test/test_inference.ml index ab2b0dec0060..84cb9380cb28 100644 --- a/src/lib_benchmark/test/test_inference.ml +++ b/src/lib_benchmark/test/test_inference.ml @@ -94,9 +94,11 @@ module T () = struct problem (Inference.Lasso {alpha = 1.0; normalize = false; positive = false}) - let const = List.assoc fv_const mapping |> Option.get + let const = + List.assoc fv_const mapping |> WithExceptions.Option.get ~loc:__LOC__ - let quadratic_term = List.assoc fv_quad mapping |> Option.get + let quadratic_term = + List.assoc fv_quad mapping |> WithExceptions.Option.get ~loc:__LOC__ end (* ------------------------------------------------------------------------- *) diff --git a/src/lib_clic/clic.ml b/src/lib_clic/clic.ml index dbb9513c1c06..b716877bf29e 100644 --- a/src/lib_clic/clic.ml +++ b/src/lib_clic/clic.ml @@ -2022,7 +2022,8 @@ let complete_next_tree cctxt = function >|=? fun completions -> completions @ list_command_args command | TNonTerminalSeq {autocomplete; suffix; _} -> complete_func autocomplete cctxt - >|=? fun completions -> completions @ [Unsafe.Option.get ~loc:__LOC__ @@ List.hd suffix] + >|=? fun completions -> + completions @ [WithExceptions.Option.get ~loc:__LOC__ @@ List.hd suffix] | TParam {autocomplete; _} -> complete_func autocomplete cctxt | TStop command -> diff --git a/src/lib_client_base/client_confirmations.ml b/src/lib_client_base/client_confirmations.ml index 0c25f0f8e0eb..491c23e966b0 100644 --- a/src/lib_client_base/client_confirmations.ml +++ b/src/lib_client_base/client_confirmations.ml @@ -87,7 +87,8 @@ let wait_for_operation_inclusion (ctxt : #Client_context.full) ~chain let block = `Hash (hash, 0) in let predecessor = header.Tezos_base.Block_header.predecessor in let pred_block = - Option.unopt_exn Not_found @@ Block_hash.Table.find blocks predecessor + WithExceptions.Option.to_exn ~none:Not_found + @@ Block_hash.Table.find blocks predecessor in match pred_block with | Some (block_with_op, n) -> diff --git a/src/lib_client_base_unix/client_config.ml b/src/lib_client_base_unix/client_config.ml index e58d58c5f61d..b745cf4b75b8 100644 --- a/src/lib_client_base_unix/client_config.ml +++ b/src/lib_client_base_unix/client_config.ml @@ -865,13 +865,12 @@ let build_endpoint addr port tls = let updatecomp updatef ov uri = match ov with Some x -> updatef uri (Some x) | None -> uri in + let scheme = Option.map (function true -> "https" | false -> "http") tls in let url = default_endpoint in url |> updatecomp Uri.with_host addr |> updatecomp Uri.with_port port - |> updatecomp - Uri.with_scheme - Option.(tls >>| function true -> "https" | false -> "http") + |> updatecomp Uri.with_scheme scheme let parse_config_args (ctx : #Client_context.full) argv = parse_global_options (global_options ()) ctx argv @@ -959,10 +958,9 @@ let parse_config_args (ctx : #Client_context.full) argv = | Some endpt -> check_absence node_addr node_port tls >>=? fun _ -> return endpt | None -> ( - let merge = Option.first_some in - let node_addr = merge node_addr cfg.node_addr in - let node_port = merge node_port cfg.node_port in - let tls = merge tls cfg.tls in + let node_addr = Option.either node_addr cfg.node_addr in + let node_port = Option.either node_port cfg.node_port in + let tls = Option.either tls cfg.tls in match cfg.endpoint with | Some endpt -> check_absence node_addr node_port tls >>=? fun _ -> return endpt @@ -984,14 +982,14 @@ let parse_config_args (ctx : #Client_context.full) argv = Tezos_signer_backends_unix.Remote.read_base_uri_from_env () >>=? fun remote_signer_env -> let remote_signer = - let open Option in - first_some remote_signer @@ first_some remote_signer_env cfg.remote_signer + Option.either remote_signer + @@ Option.either remote_signer_env cfg.remote_signer in let confirmations = Option.value ~default:cfg.confirmations confirmations in (* --password-filename has precedence over --config-file's "password-filename" json field *) let password_filename = - Option.first_some password_filename cfg.password_filename + Option.either password_filename cfg.password_filename in let cfg = { diff --git a/src/lib_client_commands/client_commands.ml b/src/lib_client_commands/client_commands.ml index 7e6926147ead..4e63cd9f38bf 100644 --- a/src/lib_client_commands/client_commands.ml +++ b/src/lib_client_commands/client_commands.ml @@ -44,5 +44,5 @@ let register name commands = commands network_opt @ previous network_opt) let commands_for_version version = - Option.unopt_exn Version_not_found + WithExceptions.Option.to_exn ~none:Version_not_found @@ Protocol_hash.Table.find versions version diff --git a/src/lib_crypto/base58.ml b/src/lib_crypto/base58.ml index 2a5da550257c..04cc297a40e8 100644 --- a/src/lib_crypto/base58.ml +++ b/src/lib_crypto/base58.ml @@ -162,8 +162,8 @@ type 'a encoding = { let prefix {prefix; _} = prefix let simple_decode ?alphabet {prefix; of_raw; _} s = - let open TzOption in - safe_decode ?alphabet s >>= TzString.remove_prefix ~prefix >>= of_raw + let ( >?? ) = Option.bind in + safe_decode ?alphabet s >?? TzString.remove_prefix ~prefix >?? of_raw let simple_encode ?alphabet {prefix; to_raw; _} d = safe_encode ?alphabet (prefix ^ to_raw d) diff --git a/src/lib_lwt_result_stdlib/functors/result.mli b/src/lib_lwt_result_stdlib/functors/result.mli new file mode 100644 index 000000000000..4a9bca781ccd --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/result.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module M : Sigs.Result.S diff --git a/src/lib_lwt_result_stdlib/sigs/result.ml b/src/lib_lwt_result_stdlib/sigs/result.ml index 840e5b031c3b..a1e9672f303f 100644 --- a/src/lib_lwt_result_stdlib/sigs/result.ml +++ b/src/lib_lwt_result_stdlib/sigs/result.ml @@ -77,7 +77,7 @@ module type S = sig val map_error_s : ('e -> 'f Lwt.t) -> ('a, 'e) result -> ('a, 'f) result Lwt.t - (* NOTE: [map_error_e] is [bind_error_s] *) + (* NOTE: [map_error_es] is [bind_error_s] *) val map_error_es : ('e -> ('a, 'f) result Lwt.t) -> ('a, 'e) result -> ('a, 'f) result Lwt.t diff --git a/src/lib_p2p/p2p.ml b/src/lib_p2p/p2p.ml index 00ecae58d70c..ec0a87f72f10 100644 --- a/src/lib_p2p/p2p.ml +++ b/src/lib_p2p/p2p.ml @@ -262,7 +262,7 @@ module Real = struct let shutdown net () = lwt_log_notice "Shutting down the p2p's welcome worker..." >>= fun () -> - Lwt_utils.may ~f:P2p_welcome.shutdown net.welcome + Option.iter_s P2p_welcome.shutdown net.welcome >>= fun () -> lwt_log_notice "Shutting down the p2p's network maintenance worker..." >>= fun () -> diff --git a/src/lib_p2p/p2p_maintenance.ml b/src/lib_p2p/p2p_maintenance.ml index 5d7294bb48a4..9969ec66f7d2 100644 --- a/src/lib_p2p/p2p_maintenance.ml +++ b/src/lib_p2p/p2p_maintenance.ml @@ -231,7 +231,11 @@ let trigger_greylist_gc t = let minus_greylist_timeout = Ptime.Span.neg t.config.greylist_timeout in let time = Ptime.add_span now minus_greylist_timeout in let older_than = - Option.unopt_exn (Failure "P2p_maintenance.maintain: time overflow") time + Option.fold_f + ~none:(fun () -> + raise (Failure "P2p_maintenance.maintain: time overflow")) + ~some:Fun.id + time in P2p_pool.gc_greylist t.pool ~older_than @@ -346,7 +350,7 @@ let maintain t = let shutdown {canceler; discovery; maintain_worker; just_maintained; _} = Lwt_canceler.cancel canceler >>= fun () -> - Lwt_utils.may ~f:P2p_discovery.shutdown discovery + Option.iter_s P2p_discovery.shutdown discovery >>= fun () -> maintain_worker >>= fun () -> diff --git a/src/lib_p2p/p2p_pool.ml b/src/lib_p2p/p2p_pool.ml index a09a263d82b5..3e1a2ed5f977 100644 --- a/src/lib_p2p/p2p_pool.ml +++ b/src/lib_p2p/p2p_pool.ml @@ -592,7 +592,8 @@ let sample best other points = else (* This is safe because we checked the value of [best] and [other] *) let list_init n f = - Result.get_ok @@ List.init ~when_negative_length:() n f + WithExceptions.Result.get_ok ~loc:__LOC__ + @@ List.init ~when_negative_length:() n f in let best_indexes = list_init best Fun.id in let other_indexes = diff --git a/src/lib_p2p/test/test_p2p_pool.ml b/src/lib_p2p/test/test_p2p_pool.ml index 8782739c180c..f53f1ef79fc2 100644 --- a/src/lib_p2p/test/test_p2p_pool.ml +++ b/src/lib_p2p/test/test_p2p_pool.ml @@ -268,9 +268,8 @@ module Overcrowded = struct let rec connect ?iter_count ~timeout connect_handler pool point = lwt_log_info "Connect%a to %a@." - (Option.pp ~default:"" (fun ppf -> - Format.pp_print_string ppf " to peer " ; - Format.pp_print_int ppf)) + (fun ppf iter_count -> + Option.iter (Format.fprintf ppf " to peer %d") iter_count) iter_count P2p_point.Id.pp point @@ -292,9 +291,8 @@ module Overcrowded = struct | Tezos_p2p_services.P2p_errors.Rejected _ ) as err ) ] -> lwt_log_info "Connection to%a %a failed (%a)@." - (Option.pp ~default:"" (fun ppf -> - Format.pp_print_string ppf " peer " ; - Format.pp_print_int ppf)) + (fun ppf iter_count -> + Option.iter (Format.fprintf ppf " peer %d") iter_count) iter_count P2p_point.Id.pp point @@ -342,7 +340,9 @@ module Overcrowded = struct ~default:0 (P2p_connect_handler.config connect_handler).listening_port in - let target = Option.get @@ List.hd trusted_points in + let target = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd trusted_points + in connect ~iter_count:0 ~timeout:(Time.System.Span.of_seconds_exn 2.) @@ -509,7 +509,8 @@ module Overcrowded = struct let node_mixed i = if i = 0 then target else client (i mod 2 = 1) let trusted i points = - if i = 0 then points else [Option.get @@ List.hd points] + if i = 0 then points + else [WithExceptions.Option.get ~loc:__LOC__ @@ List.hd points] (** Detaches a number of nodes: one of them is the target (its max_incoming_connections is set to zero), and all the rest are @@ -575,9 +576,8 @@ module No_common_network = struct let rec connect ?iter_count ~timeout connect_handler pool point = lwt_log_info "Connect%a to @[%a@]@." - (Option.pp ~default:"" (fun ppf -> - Format.pp_print_string ppf " to peer " ; - Format.pp_print_int ppf)) + (fun ppf iter_count -> + Option.iter (Format.fprintf ppf " to peer %d") iter_count) iter_count P2p_point.Id.pp point @@ -599,9 +599,8 @@ module No_common_network = struct | Tezos_p2p_services.P2p_errors.Rejected _ ) as err ) ] -> lwt_log_info "Connection to%a %a failed (%a)@." - (Option.pp ~default:"" (fun ppf -> - Format.pp_print_string ppf " peer " ; - Format.pp_print_int ppf)) + (fun ppf iter_count -> + Option.iter (Format.fprintf ppf " peer %d") iter_count) iter_count P2p_point.Id.pp point @@ -649,7 +648,7 @@ module No_common_network = struct ~timeout:(Time.System.Span.of_seconds_exn 2.) connect_handler pool - (Option.get @@ List.hd trusted_points) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.hd trusted_points) >>= function | Ok conn -> lwt_log_info @@ -691,7 +690,8 @@ module No_common_network = struct let node i = if i = 0 then target else client let trusted i points = - if i = 0 then points else [Option.get @@ List.hd points] + if i = 0 then points + else [WithExceptions.Option.get ~loc:__LOC__ @@ List.hd points] (** Running the target and the clients. All clients should have their pool populated with the list of points. diff --git a/src/lib_p2p_services/p2p_errors.ml b/src/lib_p2p_services/p2p_errors.ml index 5f290247ba21..0a987697992d 100644 --- a/src/lib_p2p_services/p2p_errors.ml +++ b/src/lib_p2p_services/p2p_errors.ml @@ -133,8 +133,12 @@ let () = proposed %a alternative peers." P2p_rejection.pp motive - (Option.pp ~default:"no" (fun ppf l -> - Format.pp_print_int ppf @@ List.length l)) + (fun ppf alt_points -> + match alt_points with + | None -> + Format.pp_print_string ppf "no" + | Some l -> + Format.pp_print_int ppf @@ List.length l) alt_points) Data_encoding.( obj2 diff --git a/src/lib_protocol_environment/test/test_mem_context_array_theory.ml b/src/lib_protocol_environment/test/test_mem_context_array_theory.ml index d963193fcd21..a67b76526404 100644 --- a/src/lib_protocol_environment/test/test_mem_context_array_theory.ml +++ b/src/lib_protocol_environment/test/test_mem_context_array_theory.ml @@ -88,7 +88,11 @@ let key_value_gen kmode = let safe_set m k v = let prefix l = if l = [] then None - else Some (List.rev l |> List.tl |> Option.get |> List.rev) + else + Some + ( List.rev l |> List.tl + |> WithExceptions.Option.get ~loc:__LOC__ + |> List.rev ) in let rec any_prefix_mem m k = let prefix = prefix k in diff --git a/src/lib_proxy/test/test_proxy.ml b/src/lib_proxy/test/test_proxy.ml index f539b47489c5..308633ba46a3 100644 --- a/src/lib_proxy/test/test_proxy.ml +++ b/src/lib_proxy/test/test_proxy.ml @@ -178,10 +178,10 @@ let test_do_rpc_no_longer_key () = "A;b;1 is mapped to tree of size 4" (nb_nodes a_b_1_tree_opt = 4) >>= fun _ -> - let a_b_1_tree = Option.get a_b_1_tree_opt in + let a_b_1_tree = WithExceptions.Option.get ~loc:__LOC__ a_b_1_tree_opt in MockedGetter.proxy_get mock_input ["A"; "b"; "1"] >>=? fun a_b_1_tree_opt' -> - let a_b_1_tree' = Option.get a_b_1_tree_opt' in + let a_b_1_tree' = WithExceptions.Option.get ~loc:__LOC__ a_b_1_tree_opt' in lwt_assert_true "Tree is physically cached" (a_b_1_tree == a_b_1_tree') >>= fun _ -> lwt_assert_true "Done one RPC" (Stack.length MockedProtoRPC.calls = 1) @@ -193,7 +193,7 @@ let test_do_rpc_no_longer_key () = (* Let's check that value mapped by A;b;1 was unaffected by getting A;b;2 *) MockedGetter.proxy_get mock_input ["A"; "b"; "1"] >>=? fun a_b_1_tree_opt' -> - let a_b_1_tree' = Option.get a_b_1_tree_opt' in + let a_b_1_tree' = WithExceptions.Option.get ~loc:__LOC__ a_b_1_tree_opt' in lwt_assert_true "Orthogonal tree stayed the same" (a_b_1_tree == a_b_1_tree') >>= fun _ -> MockedGetter.proxy_get mock_input ["A"] diff --git a/src/lib_requester/test/test_requester.ml b/src/lib_requester/test/test_requester.ml index f44fe3af00de..f5b0f3392a7a 100644 --- a/src/lib_requester/test/test_requester.ml +++ b/src/lib_requester/test/test_requester.ml @@ -301,7 +301,9 @@ let test_full_requester_fetch_timeout _ () = in do_timeout (Ptime.Span.of_int_s 0) "foo" >>= fun () -> - do_timeout (Option.unopt_exn Not_found (Ptime.Span.of_float_s 0.1)) "foo" + do_timeout + (WithExceptions.Option.to_exn ~none:Not_found (Ptime.Span.of_float_s 0.1)) + "foo" (** Creates a requester. Clears registered requests, then asserts that [!Test_request.registered_requests] is empty. Fetches the key "baz". @@ -318,7 +320,10 @@ let test_full_fetch_issues_request _ () = !Test_request.registered_requests ; let f1 = Test_Requester.fetch - ~timeout:(Option.unopt_exn Not_found (Ptime.Span.of_float_s 0.1)) + ~timeout: + (WithExceptions.Option.to_exn + ~none:Not_found + (Ptime.Span.of_float_s 0.1)) requester "baz" precheck_pass @@ -335,7 +340,8 @@ let test_full_fetch_issues_request _ () = (tuple3 unit p2p_peer_id (list testable_test_key)) "should have sent a request" ((), P2p_peer.Id.zero, ["baz"]) - (Option.get @@ List.hd !Test_request.registered_requests) ; + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.hd !Test_request.registered_requests ) ; Lwt.cancel f1 ; Lwt.return_unit @@ -425,7 +431,10 @@ let test_pending_timeout _ () = (Test_Requester.pending requester "foo") ; let f1 = Test_Requester.fetch - ~timeout:(Option.unopt_exn Not_found (Ptime.Span.of_float_s 0.001)) + ~timeout: + (WithExceptions.Option.to_exn + ~none:Not_found + (Ptime.Span.of_float_s 0.001)) requester "foo" precheck_pass diff --git a/src/lib_sapling/core.ml b/src/lib_sapling/core.ml index b84f61fd6080..fc556e5bdbfd 100644 --- a/src/lib_sapling/core.ml +++ b/src/lib_sapling/core.ml @@ -569,7 +569,7 @@ module Raw = struct let decrypt ciphertext xfvk = let ivk = Viewing_key.to_ivk xfvk in let symkey = DH.symkey_receiver ciphertext.epk ivk in - let ( >?? ) = Stdlib.Option.bind in + let ( >?? ) = Option.bind in Crypto_box.Secretbox.secretbox_open symkey ciphertext.payload_enc @@ -586,7 +586,7 @@ module Raw = struct let decrypt_ovk ciphertext ovk (cm, epk) = (* symkey for payload_out *) let symkey = DH.symkey_out ovk (ciphertext.cv, cm, epk) in - let ( >?? ) = Stdlib.Option.bind in + let ( >?? ) = Option.bind in Crypto_box.Secretbox.secretbox_open symkey ciphertext.payload_out diff --git a/src/lib_sapling/forge.ml b/src/lib_sapling/forge.ml index c35adf0ca6c6..6e4854787ead 100644 --- a/src/lib_sapling/forge.ml +++ b/src/lib_sapling/forge.ml @@ -102,9 +102,10 @@ let create_dummy_inputs n state anti_replay ctx = (* Doesn't make sense to create dummy_inputs with an empty storage *) let dummy_witness = S.get_witness state 0L in let root = S.get_root state in - List.init ~when_negative_length:() n (fun _ -> - dummy_input anti_replay ctx dummy_witness root) - |> Result.get_ok + WithExceptions.Result.get_ok ~loc:__LOC__ + @@ (* n is checked above *) + List.init ~when_negative_length:() n (fun _ -> + dummy_input anti_replay ctx dummy_witness root) else [] let dummy_output pctx ~memo_size = @@ -216,10 +217,10 @@ let forge_transaction ?(number_dummy_inputs = 0) ?(number_dummy_outputs = 0) in let inputs = real_inputs @ dummy_inputs in let dummy_outputs = - List.init ~when_negative_length:() number_dummy_outputs (fun _ -> - dummy_output ctx ~memo_size) - |> Result.get_ok - (* checked at entrance of function *) + WithExceptions.Result.get_ok ~loc:__LOC__ + @@ (* checked at entrance of function *) + List.init ~when_negative_length:() number_dummy_outputs (fun _ -> + dummy_output ctx ~memo_size) in let outputs = real_outputs @ dummy_outputs in let binding_sig = @@ -288,10 +289,10 @@ let forge_shield_transaction ?(number_dummy_inputs = 0) create_dummy_inputs number_dummy_inputs state anti_replay ctx in let dummy_outputs = - List.init ~when_negative_length:() number_dummy_outputs (fun _ -> - dummy_output ctx ~memo_size) - |> Result.get_ok - (* checked at entrance of function *) + WithExceptions.Result.get_ok ~loc:__LOC__ + @@ (* checked at entrance of function *) + List.init ~when_negative_length:() number_dummy_outputs (fun _ -> + dummy_output ctx ~memo_size) in let outputs = real_outputs @ dummy_outputs in let binding_sig = diff --git a/src/lib_sapling/rustzcash.ml b/src/lib_sapling/rustzcash.ml index 9e1e45019778..a2fef8ce882a 100644 --- a/src/lib_sapling/rustzcash.ml +++ b/src/lib_sapling/rustzcash.ml @@ -657,7 +657,7 @@ let zip32_xfvk_address xfvk j = Bytes.blit addr 11 pkd 0 32 ; let diversifier = (* This value is returned from the lib, it is a valid diversifier *) - Option.get @@ to_diversifier diversifier + WithExceptions.Option.get ~loc:__LOC__ @@ to_diversifier diversifier in Some (to_diversifier_index j_ret, diversifier, to_pkd pkd) ) else None diff --git a/src/lib_sapling/test/example.ml b/src/lib_sapling/test/example.ml index fe0a99b132d0..ded70fb5fb61 100644 --- a/src/lib_sapling/test/example.ml +++ b/src/lib_sapling/test/example.ml @@ -104,7 +104,10 @@ module Client = struct assert (Int64.add wallet.balance tez >= 0L) ; let rec gather_input to_pay balance inputs unspent_inputs = if to_pay > 0L then - let input_to_add = Option.get @@ InputSet.choose unspent_inputs in + let input_to_add = + WithExceptions.Option.get ~loc:__LOC__ + @@ InputSet.choose unspent_inputs + in let amount = Forge.Input.amount input_to_add in gather_input (Int64.sub to_pay amount) @@ -153,7 +156,10 @@ module Client = struct assert (Int64.(add wallet.balance tez) >= amount) ; let rec gather_input to_pay balance inputs unspent_input = if to_pay > 0L then - let input_to_add = Option.get @@ InputSet.choose unspent_input in + let input_to_add = + WithExceptions.Option.get ~loc:__LOC__ + @@ InputSet.choose unspent_input + in let amount = Forge.Input.amount input_to_add in gather_input (Int64.sub to_pay amount) diff --git a/src/lib_shell/block_directory.ml b/src/lib_shell/block_directory.ml index be37586e9960..8ec68e08ec03 100644 --- a/src/lib_shell/block_directory.ml +++ b/src/lib_shell/block_directory.ml @@ -247,12 +247,14 @@ let build_raw_rpc_directory ~user_activated_upgrades (fun () -> State.Block.operations block i >>= fun (ops, _path) -> - let op = Option.get @@ List.nth ops j in + let op = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth ops j in Lwt.catch (fun () -> State.Block.operations_metadata block i >>= fun metadata -> - let op_metadata = Option.get @@ List.nth metadata j in + let op_metadata = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth metadata j + in return (convert_with_metadata chain_id op op_metadata)) (fun _ -> return (convert_without_metadata chain_id op))) (fun _ -> raise Not_found)) ; diff --git a/src/lib_shell/chain.ml b/src/lib_shell/chain.ml index c8aeea9f6bc6..6620705349eb 100644 --- a/src/lib_shell/chain.ml +++ b/src/lib_shell/chain.ml @@ -28,7 +28,7 @@ module Events = State_events let genesis chain_state = let genesis = State.Chain.genesis chain_state in State.Block.read_opt chain_state genesis.block - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ let known_heads chain_state = State.read_chain_data chain_state (fun chain_store _data -> @@ -36,7 +36,8 @@ let known_heads chain_state = >>= fun hashes -> List.map_p (fun h -> - State.Block.read_opt chain_state h >|= Option.unopt_assert ~loc:__POS__) + State.Block.read_opt chain_state h + >|= WithExceptions.Option.get ~loc:__LOC__) hashes let head chain_state = diff --git a/src/lib_shell/chain_validator.ml b/src/lib_shell/chain_validator.ml index 1044b7fd8150..5334dad7f324 100644 --- a/src/lib_shell/chain_validator.ml +++ b/src/lib_shell/chain_validator.ml @@ -117,9 +117,8 @@ let table = Worker.create_table Queue let shutdown w = Worker.shutdown w let shutdown_child nv active_chains = - Lwt_utils.may - ~f: - (fun ({parameters = {chain_state; global_chains_input; _}; _}, shutdown) -> + Option.iter_s + (fun ({parameters = {chain_state; global_chains_input; _}; _}, shutdown) -> Lwt_watcher.notify global_chains_input (State.Chain.id chain_state, false) ; Chain_id.Table.remove active_chains (State.Chain.id chain_state) ; State.update_chain_data nv.parameters.chain_state (fun _ chain_data -> @@ -505,8 +504,8 @@ let on_close w = [] in Lwt.join - ( Lwt_utils.may ~f:Prevalidator.shutdown nv.prevalidator - :: Lwt_utils.may ~f:(fun (_, shutdown) -> shutdown ()) nv.child + ( Option.iter_s Prevalidator.shutdown nv.prevalidator + :: Option.iter_s (fun (_, shutdown) -> shutdown ()) nv.child :: pvs ) let may_load_protocols parameters = diff --git a/src/lib_shell/monitor_directory.ml b/src/lib_shell/monitor_directory.ml index 3ce82b98727e..16b19de48d84 100644 --- a/src/lib_shell/monitor_directory.ml +++ b/src/lib_shell/monitor_directory.ml @@ -201,13 +201,14 @@ let build_rpc_directory validator mainchain_validator = >>= fun chain_state -> let {Genesis.protocol; _} = State.Chain.genesis chain_state in let expiration_date = - Option.unopt_exn - (Invalid_argument - (Format.asprintf - "Monitor.active_chains: no expiration date for the \ - chain %a" - Chain_id.pp - chain_id)) + WithExceptions.Option.to_exn_f + ~none:(fun () -> + Invalid_argument + (Format.asprintf + "Monitor.active_chains: no expiration date for the \ + chain %a" + Chain_id.pp + chain_id)) (State.Chain.expiration chain_state) in Lwt.return diff --git a/src/lib_shell/peer_validator.ml b/src/lib_shell/peer_validator.ml index 475d7e2b315b..331a01ab4f84 100644 --- a/src/lib_shell/peer_validator.ml +++ b/src/lib_shell/peer_validator.ml @@ -400,7 +400,7 @@ let on_close w = let on_launch _ name parameters = let chain_state = Distributed_db.chain_state parameters.chain_db in State.Block.read_opt chain_state (State.Chain.genesis chain_state).block - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun genesis -> let rec pv = { diff --git a/src/lib_shell/snapshots.ml b/src/lib_shell/snapshots.ml index 4a8b1c5b537f..a6ba875cb994 100644 --- a/src/lib_shell/snapshots.ml +++ b/src/lib_shell/snapshots.ml @@ -523,7 +523,7 @@ let export ?(export_rolling = false) ~context_root ~store_root ~genesis return (State.Block.hash bh) ) | None -> Store.Chain_data.Checkpoint.read_opt chain_data_store - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun last_checkpoint -> if last_checkpoint.shell.level = 0l then fail (Wrong_block_export (Too_few_predecessors genesis.block)) @@ -1095,7 +1095,9 @@ let import ?(reconstruct = false) ?patch_context ~data_dir oldest_header_opt, rev_block_hashes, protocol_data ) -> - let oldest_header = Option.unopt_assert ~loc:__POS__ oldest_header_opt in + let oldest_header = + WithExceptions.Option.get ~loc:__LOC__ oldest_header_opt + in let block_hashes_arr = Array.of_list rev_block_hashes in let write_predecessors_table to_write = Store.with_atomic_rw store (fun () -> diff --git a/src/lib_shell/state.ml b/src/lib_shell/state.ml index 7d9604697f33..46f5611f17a3 100644 --- a/src/lib_shell/state.ml +++ b/src/lib_shell/state.ml @@ -164,10 +164,8 @@ let update_chain_data {chain_data; _} f = Shared.use chain_data (fun state -> f state.chain_data_store state.data >>= fun (data, res) -> - Lwt_utils.may data ~f:(fun data -> - state.data <- data ; - Lwt.return_unit) - >>= fun () -> Lwt.return res) + Option.iter (fun data -> state.data <- data) data ; + Lwt.return res) (** The number of predecessors stored per block. This value chosen to compute efficiently block locators that @@ -206,7 +204,7 @@ let store_predecessors (store : Store.Block.store) (b : Block_hash.t) : in (* the first predecessor is fetched from the header *) Header.read_opt (store, b) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun header -> let pred = header.shell.predecessor in if Block_hash.equal b pred then Lwt.return_unit (* genesis *) @@ -340,7 +338,7 @@ module Locked_block = struct block_store hash (Int32.to_int @@ Int32.sub header.shell.level checkpoint.shell.level) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun predecessor -> if Block_hash.equal predecessor (Block_header.hash checkpoint) then Lwt.return_true @@ -355,7 +353,7 @@ let locked_valid_heads_for_checkpoint block_store data checkpoint = Block_hash.Set.fold_s (fun head (valid_heads, invalid_heads) -> Header.read_opt (block_store, head) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun header -> Locked_block.is_valid_for_checkpoint block_store head header checkpoint >>= fun valid -> @@ -517,7 +515,7 @@ module Chain = struct ~allow_forked_chain ~current_head ~checkpoint ~chain_id global_state context_index chain_data_store block_store = Header.read_opt (block_store, current_head) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun current_block_head -> let rec chain_data = { @@ -698,7 +696,8 @@ module Chain = struct Shared.use state.global_data (fun data -> Lwt.return (Chain_id.Table.find data.chains id)) - let get_exn state id = get_opt state id >|= Option.unopt_exn Not_found + let get_exn state id = + get_opt state id >|= WithExceptions.Option.to_exn ~none:Not_found let get state id = get_opt state id @@ -744,7 +743,7 @@ module Chain = struct else Lwt.return (n_blocks, blocks) ) >>= fun (n_blocks, blocks) -> Header.read_opt (store, block_hash) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun header -> if Block_hash.equal block_hash genesis_hash then do_prune blocks else if header.shell.level = caboose_level then @@ -752,7 +751,7 @@ module Chain = struct else loop header.shell.predecessor (n_blocks + 1, block_hash :: blocks) in Header.read_opt (store, block_hash) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun header -> loop header.shell.predecessor (0, []) let purge_full chain_state (lvl, hash) = @@ -817,7 +816,7 @@ module Chain = struct (n_blocks + 1, block_hash :: blocks) in Header.read_opt (store, block_hash) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun header -> if limit = 0 then delete_loop header.shell.predecessor (0, []) @@ -1299,18 +1298,20 @@ module Block = struct List.map_p (fun n -> Store.Block.Operation_hashes.read_opt (store, hash) n - >|= Option.unopt_assert ~loc:__POS__) + >|= WithExceptions.Option.get ~loc:__LOC__) (0 -- (header.shell.validation_passes - 1)) >>= fun hashes -> let path = compute_operation_path hashes in - Lwt.return (Option.unopt_exn Not_found @@ List.nth hashes i, path i)) + Lwt.return + ( WithExceptions.Option.to_exn ~none:Not_found @@ List.nth hashes i, + path i )) let all_operation_hashes {chain_state; hash; header; _} = Shared.use chain_state.block_store (fun store -> List.map_p (fun i -> Store.Block.Operation_hashes.read_opt (store, hash) i - >|= Option.unopt_assert ~loc:__POS__) + >|= WithExceptions.Option.get ~loc:__LOC__) (0 -- (header.shell.validation_passes - 1))) let operations {chain_state; hash; header; _} i = @@ -1320,12 +1321,12 @@ module Block = struct List.map_p (fun n -> Store.Block.Operation_hashes.read_opt (store, hash) n - >|= Option.unopt_assert ~loc:__POS__) + >|= WithExceptions.Option.get ~loc:__LOC__) (0 -- (header.shell.validation_passes - 1)) >>= fun hashes -> let path = compute_operation_path hashes in Store.Block.Operations.read_opt (store, hash) i - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun ops -> Lwt.return (ops, path i)) let operations_metadata {chain_state; hash; header; _} i = @@ -1333,14 +1334,14 @@ module Block = struct invalid_arg "State.Block.operations_metadata" ; Shared.use chain_state.block_store (fun store -> Store.Block.Operations_metadata.read_opt (store, hash) i - >|= Option.unopt_assert ~loc:__POS__) + >|= WithExceptions.Option.get ~loc:__LOC__) let all_operations {chain_state; hash; header; _} = Shared.use chain_state.block_store (fun store -> List.map_p (fun i -> Store.Block.Operations.read_opt (store, hash) i - >|= Option.unopt_assert ~loc:__POS__) + >|= WithExceptions.Option.get ~loc:__LOC__) (0 -- (header.shell.validation_passes - 1))) let all_operations_metadata {chain_state; hash; header; _} = @@ -1348,7 +1349,7 @@ module Block = struct List.map_p (fun i -> Store.Block.Operations_metadata.read_opt (store, hash) i - >|= Option.unopt_assert ~loc:__POS__) + >|= WithExceptions.Option.get ~loc:__LOC__) (0 -- (header.shell.validation_passes - 1))) let metadata_hash {chain_state; hash; _} = @@ -1368,12 +1369,12 @@ module Block = struct | false -> Lwt.return_none | true -> - Lwt_list.map_p + List.map_p (fun i -> Store.Block.Operations_metadata_hashes.read_opt (store, hash) i - >|= Option.unopt_assert ~loc:__POS__) + >|= WithExceptions.Option.get ~loc:__LOC__) (0 -- (header.shell.validation_passes - 1)) >|= fun hashes -> Some hashes) @@ -1391,7 +1392,7 @@ module Block = struct (fun () -> Shared.use chain_state.block_store (fun block_store -> Store.Block.Contents.read_opt (block_store, hash)) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun {context = commit; _} -> Shared.use chain_state.context_index (fun context_index -> Context.checkout_exn context_index commit)) @@ -1400,7 +1401,7 @@ module Block = struct let context_opt {chain_state; hash; _} = Shared.use chain_state.block_store (fun block_store -> Store.Block.Contents.read_opt (block_store, hash)) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun {context = commit; _} -> Shared.use chain_state.context_index (fun context_index -> Context.checkout context_index commit) @@ -1416,7 +1417,7 @@ module Block = struct let context_exists {chain_state; hash; _} = Shared.use chain_state.block_store (fun block_store -> Store.Block.Contents.read_opt (block_store, hash)) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun {context = commit; _} -> Shared.use chain_state.context_index (fun context_index -> Context.exists context_index commit) @@ -1511,7 +1512,7 @@ module Block = struct let set_rpc_directory ({chain_state; _} as block) dir = read_opt chain_state block.header.shell.predecessor - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun pred -> protocol_hash_exn block >>= fun next_protocol -> @@ -1660,7 +1661,7 @@ let best_known_head_for_checkpoint chain_state checkpoint = else let find_valid_predecessor hash = Header.read_opt (store, hash) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun header -> if Compare.Int32.(header.shell.level < checkpoint.shell.level) then Lwt.return {hash; chain_state; header} @@ -1671,17 +1672,17 @@ let best_known_head_for_checkpoint chain_state checkpoint = ( 1 + ( Int32.to_int @@ Int32.sub header.shell.level checkpoint.shell.level ) ) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun pred -> Header.read_opt (store, pred) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun pred_header -> Lwt.return {hash = pred; chain_state; header = pred_header} in Store.Chain_data.Known_heads.read_all data.chain_data_store >>= fun heads -> Header.read_opt (store, chain_state.genesis.block) - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun genesis_header -> let genesis = { @@ -2005,7 +2006,7 @@ let init ?patch_context ?commit_genesis ?(store_mapsize = 40_960_000_000L) let history_mode {global_data; _} = Shared.use global_data (fun {global_store; _} -> Store.Configuration.History_mode.read_opt global_store - >|= Option.unopt_assert ~loc:__POS__) + >|= WithExceptions.Option.get ~loc:__LOC__) let close {global_data; _} = Shared.use global_data (fun {global_store; context_index; _} -> diff --git a/src/lib_shell/test/test_locator.ml b/src/lib_shell/test/test_locator.ml index 6482ea7a565a..8dc596078cb3 100644 --- a/src/lib_shell/test/test_locator.ml +++ b/src/lib_shell/test/test_locator.ml @@ -110,7 +110,7 @@ let zero = Bytes.create 0 (* adds n blocks on top of an initialized chain *) let make_empty_chain (chain : State.Chain.t) n : Block_hash.t Lwt.t = State.Block.read_opt chain genesis_hash - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun genesis -> State.Block.context_exn genesis >>= fun empty_context -> @@ -167,7 +167,7 @@ let make_empty_chain (chain : State.Chain.t) n : Block_hash.t Lwt.t = let make_multiple_protocol_chain (chain : State.Chain.t) ~(chain_length : int) ~fork_points = State.Block.read_opt chain genesis_hash - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun genesis -> State.Block.context_exn genesis >>= fun empty_context -> @@ -285,13 +285,13 @@ let print_block b = let print_block_h chain bh = State.Block.read_opt chain bh - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >|= fun b -> print_block b (* returns the predecessor at distance one, reading the header *) let linear_predecessor chain (bh : Block_hash.t) : Block_hash.t option Lwt.t = State.Block.read_opt chain bh - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun b -> State.Block.predecessor b >|= function None -> None | Some pred -> Some (State.Block.hash pred) @@ -333,7 +333,7 @@ let test_pred (base_dir : string) : unit tzresult Lwt.t = linear_predecessor_n chain head distance >>= fun lin_res -> State.Block.read_opt chain head - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun head_block -> State.Block.predecessor_n head_block distance >>= fun exp_res -> @@ -346,11 +346,11 @@ let test_pred (base_dir : string) : unit tzresult Lwt.t = (* check that the two results are the same *) assert (lin_res = exp_res) ; State.Block.read_opt chain lin_res - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun pred -> let level_pred = Int32.to_int (State.Block.level pred) in State.Block.read_opt chain head - >|= Option.unopt_assert ~loc:__POS__ + >|= WithExceptions.Option.get ~loc:__LOC__ >>= fun head -> let level_start = Int32.to_int (State.Block.level head) in (* check distance using the level *) @@ -603,11 +603,15 @@ let test_protocol_locator base_dir = return_unit) steps >>=? fun () -> - let last_hash = (Option.get @@ List.hd steps).predecessor in + let last_hash = + (WithExceptions.Option.get ~loc:__LOC__ @@ List.hd steps).predecessor + in Assert.is_true ~msg:"last block in locator is the checkpoint" (Block_hash.equal last_hash (State.Block.hash pred)) ; - let first_hash = (Option.get @@ List.last_opt steps).block in + let first_hash = + (WithExceptions.Option.get ~loc:__LOC__ @@ List.last_opt steps).block + in Assert.is_true ~msg:"first block in locator is the head" (Block_hash.equal first_hash head_hash) ; diff --git a/src/lib_shell/test/test_node.ml b/src/lib_shell/test/test_node.ml index f820439afee1..647336a4b530 100644 --- a/src/lib_shell/test/test_node.ml +++ b/src/lib_shell/test/test_node.ml @@ -161,7 +161,7 @@ let node_sandbox_initialization_events sandbox_parameters config _switch () = test_event "Should have an p2p_layer_disabled" (Internal_event.Notice, section, "p2p_layer_disabled") - (Option.get @@ List.nth evs 0) ; + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth evs 0) ; (* End tests *) Node.shutdown n @@ -189,11 +189,11 @@ let node_initialization_events _sandbox_parameters config _switch () = test_event "Should have a p2p bootstrapping event" (Internal_event.Notice, section, "bootstrapping") - (Option.get @@ List.nth evs 0) ; + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth evs 0) ; test_event "Should have a p2p_maintain_started event" (Internal_event.Notice, section, "p2p_maintain_started") - (Option.get @@ List.nth evs 1) ; + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth evs 1) ; (* End tests *) Node.shutdown n diff --git a/src/lib_shell/test/test_state.ml b/src/lib_shell/test/test_state.ml index b97246c679da..c8408298c1fb 100644 --- a/src/lib_shell/test/test_state.ml +++ b/src/lib_shell/test/test_state.ml @@ -186,7 +186,8 @@ type state = { chain : State.Chain.t; } -let vblock s k = Option.get @@ String.Hashtbl.find s.vblock k +let vblock s k = + WithExceptions.Option.get ~loc:__LOC__ @@ String.Hashtbl.find s.vblock k exception Found of string @@ -210,7 +211,9 @@ let build_example_tree chain = let c = ["A1"; "A2"; "A3"; "A4"; "A5"; "A6"; "A7"; "A8"] in build_valid_chain chain vtbl genesis c >>= fun () -> - let a3 = Option.get @@ String.Hashtbl.find vtbl "A3" in + let a3 = + WithExceptions.Option.get ~loc:__LOC__ @@ String.Hashtbl.find vtbl "A3" + in let c = ["B1"; "B2"; "B3"; "B4"; "B5"; "B6"; "B7"; "B8"] in build_valid_chain chain vtbl a3 c >>= fun () -> Lwt.return vtbl diff --git a/src/lib_shell/test/test_state_checkpoint.ml b/src/lib_shell/test/test_state_checkpoint.ml index 63e018fca013..8a2d74eaab8e 100644 --- a/src/lib_shell/test/test_state_checkpoint.ml +++ b/src/lib_shell/test/test_state_checkpoint.ml @@ -210,7 +210,8 @@ type state = { chain : State.Chain.t; } -let vblock s k = Option.get @@ String.Hashtbl.find s.vblock k +let vblock s k = + WithExceptions.Option.get ~loc:__LOC__ @@ String.Hashtbl.find s.vblock k exception Found of string @@ -234,7 +235,9 @@ let build_example_tree chain = let c = ["A1"; "A2"; "A3"; "A4"; "A5"] in build_valid_chain chain vtbl genesis c >>= fun () -> - let a2 = Option.get @@ String.Hashtbl.find vtbl "A2" in + let a2 = + WithExceptions.Option.get ~loc:__LOC__ @@ String.Hashtbl.find vtbl "A2" + in let c = ["B1"; "B2"; "B3"; "B4"; "B5"] in build_valid_chain chain vtbl a2 c >>= fun () -> Lwt.return vtbl diff --git a/src/lib_shell/worker_directory.ml b/src/lib_shell/worker_directory.ml index 76dc6630f3c1..7aaad619f87c 100644 --- a/src/lib_shell/worker_directory.ml +++ b/src/lib_shell/worker_directory.ml @@ -56,7 +56,7 @@ let build_rpc_directory state = (* NOTE: it is technically possible to use the Prevalidator interface to * register multiple Prevalidator for a single chain (using distinct * protocols). However, this is never done. *) - Option.unopt_exn Not_found + WithExceptions.Option.to_exn ~none:Not_found @@ List.find (fun (c, _, _) -> Chain_id.equal c chain_id) workers in let status = Prevalidator.status t in @@ -93,7 +93,7 @@ let build_rpc_directory state = Chain_directory.get_chain_id state chain >>= fun chain_id -> let w = - Option.unopt_exn Not_found + WithExceptions.Option.to_exn ~none:Not_found @@ List.assoc (chain_id, peer_id) (Peer_validator.running_workers ()) in return @@ -117,7 +117,7 @@ let build_rpc_directory state = Chain_directory.get_chain_id state chain >>= fun chain_id -> let w = - Option.unopt_exn Not_found + WithExceptions.Option.to_exn ~none:Not_found @@ List.assoc chain_id (Chain_validator.running_workers ()) in return @@ -132,7 +132,7 @@ let build_rpc_directory state = Chain_directory.get_chain_id state chain >>= fun chain_id -> let w = - Option.unopt_exn Not_found + WithExceptions.Option.to_exn ~none:Not_found @@ List.assoc chain_id (Chain_validator.running_workers ()) in return (Chain_validator.ddb_information w)) ; diff --git a/src/lib_shell_benchmarks/io_helpers.ml b/src/lib_shell_benchmarks/io_helpers.ml index e94760f90c21..04e60f73afac 100644 --- a/src/lib_shell_benchmarks/io_helpers.ml +++ b/src/lib_shell_benchmarks/io_helpers.ml @@ -104,35 +104,6 @@ let with_context ~base_dir ~context_hash f = let prepare_base_dir base_dir = Unix.unlink base_dir ; Unix.mkdir base_dir 0o700 -(* This function prepares a context of depth [depth] where each node - has a width [fan_out], with only one non-trivial recursive node - at each leave. *) -let initialize_context_with_fan_out rng_state context fan_out depth - storage_size = - assert (fan_out > 0) ; - let populate_dummy path fan_out = - List.init ~when_negative_length:() fan_out (fun i -> string_of_int i) - >>?= fun keys -> - List.fold_left_es - (fun ctxt key -> - let path = path @ [key] in - let bytes = Base_samplers.uniform_bytes rng_state ~nbytes:8 in - Tezos_storage.Context.add ctxt path bytes >>= return) - context - keys - >>=? fun context -> return (List.hd keys |> Option.get, context) - in - let rec loop context path depth = - if depth = 0 then - let bytes = Base_samplers.uniform_bytes rng_state ~nbytes:storage_size in - Tezos_storage.Context.add context path bytes - >>= fun context -> return (context, path) - else - populate_dummy path fan_out - >>=? fun (key, context) -> loop context (path @ [key]) (depth - 1) - in - loop context [] depth - (* This function updates the context with random bytes at a given depth. *) let initialize_key rng_state context path storage_size = let bytes = Base_samplers.uniform_bytes rng_state ~nbytes:storage_size in diff --git a/src/lib_shell_services/block_services.ml b/src/lib_shell_services/block_services.ml index 250e4e8a6ee2..cce1e7a8cca1 100644 --- a/src/lib_shell_services/block_services.ml +++ b/src/lib_shell_services/block_services.ml @@ -76,7 +76,9 @@ let parse_block s = | 0 -> ([s], ' ') | 1 -> - let delim = Option.unopt_assert ~loc:__POS__ @@ List.assoc 1 counts in + let delim = + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc 1 counts + in (String.split delim s, delim) | _ -> raise Exit diff --git a/src/lib_signer_backends/encrypted.ml b/src/lib_signer_backends/encrypted.ml index e2fd302ac7d9..90efb721c4cb 100644 --- a/src/lib_signer_backends/encrypted.ml +++ b/src/lib_signer_backends/encrypted.ml @@ -278,9 +278,9 @@ module Sapling_raw = struct let salt = Bytes.sub ebytes 0 salt_len in let encrypted_sk = Bytes.sub ebytes salt_len (encrypted_size - salt_len) in let key = Crypto_box.Secretbox.unsafe_of_bytes (pbkdf ~salt ~password) in - Option.( - Crypto_box.Secretbox.secretbox_open key encrypted_sk nonce - >>= Tezos_sapling.Core.Wallet.Spending_key.of_bytes) + Option.bind + (Crypto_box.Secretbox.secretbox_open key encrypted_sk nonce) + Tezos_sapling.Core.Wallet.Spending_key.of_bytes type Base58.data += Data of Tezos_sapling.Core.Wallet.Spending_key.t diff --git a/src/lib_signer_backends/test/test_encrypted.ml b/src/lib_signer_backends/test/test_encrypted.ml index e2aa02d06769..4ba3debdc871 100644 --- a/src/lib_signer_backends/test/test_encrypted.ml +++ b/src/lib_signer_backends/test/test_encrypted.ml @@ -68,11 +68,13 @@ let fake_ctx () = match distributed with | false -> distributed <- true ; - return (Option.get @@ List.nth passwords 0) + return + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth passwords 0) | true -> i <- (if i = nb_passwds - 1 then 0 else succ i) ; distributed <- false ; - return (Option.get @@ List.nth passwords i)) + return + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth passwords i)) end let make_sk_uris = diff --git a/src/lib_stdlib_unix/file_descriptor_sink.ml b/src/lib_stdlib_unix/file_descriptor_sink.ml index 4e4acb89e56c..9315c02e4e6f 100644 --- a/src/lib_stdlib_unix/file_descriptor_sink.ml +++ b/src/lib_stdlib_unix/file_descriptor_sink.ml @@ -71,9 +71,9 @@ end) : Internal_event.SINK with type t = t = struct let configure uri = let level_at_least = - TzOption.( - Uri.get_query_param uri "level-at-least" - >>= Internal_event.Level.of_string) + let ( >?? ) = Option.bind in + Uri.get_query_param uri "level-at-least" + >?? Internal_event.Level.of_string |> Option.value ~default:Internal_event.Level.default in let fail_parsing fmt = diff --git a/src/lib_stdlib_unix/file_event_sink.ml b/src/lib_stdlib_unix/file_event_sink.ml index eb545bcf33c2..5409e1646199 100644 --- a/src/lib_stdlib_unix/file_event_sink.ml +++ b/src/lib_stdlib_unix/file_event_sink.ml @@ -173,7 +173,9 @@ module Event_filter = struct fun l -> Some (l :: s)) None levels_in_order - |> TzOption.unopt_exn (Failure "level_at_least not found") + |> Option.fold_f + ~none:(fun () -> raise (Failure "level_at_least not found")) + ~some:Fun.id |> level_in end @@ -235,21 +237,21 @@ module Sink_implementation : Internal_event.SINK with type t = t = struct Uri.get_query_param' uri "name" |> Option.value ~default:[] in let levels = - TzOption.( - Uri.get_query_param uri "level-at-least" - >>= Internal_event.Level.of_string - >>= fun l -> - (* some (fun all more -> all [Event_filter.level_at_least l ; more ]) *) - Some [Event_filter.level_at_least l]) - |> Option.value ~default:[] + let ( >?? ) = Option.bind in + Uri.get_query_param uri "level-at-least" + >?? Internal_event.Level.of_string + |> Option.fold ~none:[] ~some:(fun l -> + [Event_filter.level_at_least l]) in let sections = let somes = Uri.get_query_param' uri "section" - |> Option.value ~default:[] - |> List.map (fun s -> - Internal_event.Section.make_sanitized - (String.split_on_char '.' s)) + |> Option.fold + ~none:[] + ~some: + (List.map (fun s -> + Internal_event.Section.make_sanitized + (String.split_on_char '.' s))) in let none = match Uri.get_query_param uri "no-section" with diff --git a/src/lib_storage/test/test_context.ml b/src/lib_storage/test/test_context.ml index 1594c0b68e80..f217084ae428 100644 --- a/src/lib_storage/test/test_context.ml +++ b/src/lib_storage/test/test_context.ml @@ -446,7 +446,7 @@ let test_raw {idx; genesis; _} = >>= fun ctxt -> find_tree ctxt [] >>= fun tree -> - let tree = Option.get tree in + let tree = WithExceptions.Option.get ~loc:__LOC__ tree in Tree.to_raw tree >>= fun raw -> let a = TzString.Map.singleton "toto" (`Value foo1) in diff --git a/src/proto_001_PtCJ7pwo/lib_client/michelson_v1_emacs.ml b/src/proto_001_PtCJ7pwo/lib_client/michelson_v1_emacs.ml index 2b075e6c7e6c..c38da89cfca7 100644 --- a/src/proto_001_PtCJ7pwo/lib_client/michelson_v1_emacs.ml +++ b/src/proto_001_PtCJ7pwo/lib_client/michelson_v1_emacs.ml @@ -152,10 +152,12 @@ let report_errors ppf (parsed, errs) = (fun ppf errs -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in match errs with | top :: errs -> @@ -193,10 +195,12 @@ let report_errors ppf (parsed, errs) = (Format.pp_print_list (fun ppf err -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in let loc = match err with diff --git a/src/proto_001_PtCJ7pwo/lib_client/operation_result.ml b/src/proto_001_PtCJ7pwo/lib_client/operation_result.ml index 7859d52572a6..42dd95bd5ff9 100644 --- a/src/proto_001_PtCJ7pwo/lib_client/operation_result.ml +++ b/src/proto_001_PtCJ7pwo/lib_client/operation_result.ml @@ -48,8 +48,8 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf () | Some expr -> let expr = - Option.unopt_exn - (Failure "ill-serialized argument") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized argument") (Data_encoding.force_decode expr) in Format.fprintf @@ -75,12 +75,12 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Format.fprintf ppf "@,No script (accepts all transactions)" | Some {code; storage} -> let code = - Option.unopt_exn - (Failure "ill-serialized code") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized code") (Data_encoding.force_decode code) and storage = - Option.unopt_exn - (Failure "ill-serialized storage") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized storage") (Data_encoding.force_decode storage) in Format.fprintf diff --git a/src/proto_002_PsYLVpVv/lib_client/michelson_v1_emacs.ml b/src/proto_002_PsYLVpVv/lib_client/michelson_v1_emacs.ml index 2b075e6c7e6c..c38da89cfca7 100644 --- a/src/proto_002_PsYLVpVv/lib_client/michelson_v1_emacs.ml +++ b/src/proto_002_PsYLVpVv/lib_client/michelson_v1_emacs.ml @@ -152,10 +152,12 @@ let report_errors ppf (parsed, errs) = (fun ppf errs -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in match errs with | top :: errs -> @@ -193,10 +195,12 @@ let report_errors ppf (parsed, errs) = (Format.pp_print_list (fun ppf err -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in let loc = match err with diff --git a/src/proto_002_PsYLVpVv/lib_client/operation_result.ml b/src/proto_002_PsYLVpVv/lib_client/operation_result.ml index 5adac16a870c..dfe3719a56b4 100644 --- a/src/proto_002_PsYLVpVv/lib_client/operation_result.ml +++ b/src/proto_002_PsYLVpVv/lib_client/operation_result.ml @@ -48,8 +48,8 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf () | Some expr -> let expr = - Option.unopt_exn - (Failure "ill-serialized argument") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized argument") (Data_encoding.force_decode expr) in Format.fprintf @@ -75,12 +75,12 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Format.fprintf ppf "@,No script (accepts all transactions)" | Some {code; storage} -> let code = - Option.unopt_exn - (Failure "ill-serialized code") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized code") (Data_encoding.force_decode code) and storage = - Option.unopt_exn - (Failure "ill-serialized storage") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized storage") (Data_encoding.force_decode storage) in let {Michelson_v1_parser.source} = diff --git a/src/proto_003_PsddFKi3/lib_client/michelson_v1_emacs.ml b/src/proto_003_PsddFKi3/lib_client/michelson_v1_emacs.ml index 898cfab1f92f..ffa47378f1c5 100644 --- a/src/proto_003_PsddFKi3/lib_client/michelson_v1_emacs.ml +++ b/src/proto_003_PsddFKi3/lib_client/michelson_v1_emacs.ml @@ -152,10 +152,12 @@ let report_errors ppf (parsed, errs) = (fun ppf errs -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in match errs with | top :: errs -> @@ -193,10 +195,12 @@ let report_errors ppf (parsed, errs) = (Format.pp_print_list (fun ppf err -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in let loc = match err with diff --git a/src/proto_003_PsddFKi3/lib_client/michelson_v1_macros.ml b/src/proto_003_PsddFKi3/lib_client/michelson_v1_macros.ml index ceb46037d454..c2904580d439 100644 --- a/src/proto_003_PsddFKi3/lib_client/michelson_v1_macros.ml +++ b/src/proto_003_PsddFKi3/lib_client/michelson_v1_macros.ml @@ -1012,7 +1012,7 @@ let dxiiivp_roman_of_decimal decimal = (* too short for D*P, fall back to IIIII... *) String.concat "" - ( Result.get_ok + ( WithExceptions.Result.get_ok ~loc:__LOC__ @@ List.init ~when_negative_length:() decimal (fun _ -> "I") ) else roman diff --git a/src/proto_003_PsddFKi3/lib_client/operation_result.ml b/src/proto_003_PsddFKi3/lib_client/operation_result.ml index 3ca22e865f11..ced025764859 100644 --- a/src/proto_003_PsddFKi3/lib_client/operation_result.ml +++ b/src/proto_003_PsddFKi3/lib_client/operation_result.ml @@ -48,8 +48,8 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf () | Some expr -> let expr = - Option.unopt_exn - (Failure "ill-serialized argument") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized argument") (Data_encoding.force_decode expr) in Format.fprintf @@ -82,12 +82,12 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Format.fprintf ppf "@,No script (accepts all transactions)" | Some {code; storage} -> let code = - Option.unopt_exn - (Failure "ill-serialized code") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized code") (Data_encoding.force_decode code) and storage = - Option.unopt_exn - (Failure "ill-serialized storage") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized storage") (Data_encoding.force_decode storage) in let {Michelson_v1_parser.source; _} = diff --git a/src/proto_004_Pt24m4xi/lib_client/michelson_v1_emacs.ml b/src/proto_004_Pt24m4xi/lib_client/michelson_v1_emacs.ml index 898cfab1f92f..ffa47378f1c5 100644 --- a/src/proto_004_Pt24m4xi/lib_client/michelson_v1_emacs.ml +++ b/src/proto_004_Pt24m4xi/lib_client/michelson_v1_emacs.ml @@ -152,10 +152,12 @@ let report_errors ppf (parsed, errs) = (fun ppf errs -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in match errs with | top :: errs -> @@ -193,10 +195,12 @@ let report_errors ppf (parsed, errs) = (Format.pp_print_list (fun ppf err -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in let loc = match err with diff --git a/src/proto_004_Pt24m4xi/lib_client/michelson_v1_macros.ml b/src/proto_004_Pt24m4xi/lib_client/michelson_v1_macros.ml index ceb46037d454..c2904580d439 100644 --- a/src/proto_004_Pt24m4xi/lib_client/michelson_v1_macros.ml +++ b/src/proto_004_Pt24m4xi/lib_client/michelson_v1_macros.ml @@ -1012,7 +1012,7 @@ let dxiiivp_roman_of_decimal decimal = (* too short for D*P, fall back to IIIII... *) String.concat "" - ( Result.get_ok + ( WithExceptions.Result.get_ok ~loc:__LOC__ @@ List.init ~when_negative_length:() decimal (fun _ -> "I") ) else roman diff --git a/src/proto_004_Pt24m4xi/lib_client/operation_result.ml b/src/proto_004_Pt24m4xi/lib_client/operation_result.ml index 3ca22e865f11..ced025764859 100644 --- a/src/proto_004_Pt24m4xi/lib_client/operation_result.ml +++ b/src/proto_004_Pt24m4xi/lib_client/operation_result.ml @@ -48,8 +48,8 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf () | Some expr -> let expr = - Option.unopt_exn - (Failure "ill-serialized argument") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized argument") (Data_encoding.force_decode expr) in Format.fprintf @@ -82,12 +82,12 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Format.fprintf ppf "@,No script (accepts all transactions)" | Some {code; storage} -> let code = - Option.unopt_exn - (Failure "ill-serialized code") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized code") (Data_encoding.force_decode code) and storage = - Option.unopt_exn - (Failure "ill-serialized storage") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized storage") (Data_encoding.force_decode storage) in let {Michelson_v1_parser.source; _} = diff --git a/src/proto_005_PsBabyM1/lib_client/michelson_v1_emacs.ml b/src/proto_005_PsBabyM1/lib_client/michelson_v1_emacs.ml index 337ff56bb7f3..7b41fb168dba 100644 --- a/src/proto_005_PsBabyM1/lib_client/michelson_v1_emacs.ml +++ b/src/proto_005_PsBabyM1/lib_client/michelson_v1_emacs.ml @@ -153,10 +153,12 @@ let report_errors ppf (parsed, errs) = (fun ppf errs -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in match errs with | top :: errs -> @@ -194,10 +196,12 @@ let report_errors ppf (parsed, errs) = (Format.pp_print_list (fun ppf err -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in let loc = match err with diff --git a/src/proto_005_PsBabyM1/lib_client/michelson_v1_entrypoints.ml b/src/proto_005_PsBabyM1/lib_client/michelson_v1_entrypoints.ml index 2455867d433b..9b436a87d9e6 100644 --- a/src/proto_005_PsBabyM1/lib_client/michelson_v1_entrypoints.ml +++ b/src/proto_005_PsBabyM1/lib_client/michelson_v1_entrypoints.ml @@ -98,10 +98,11 @@ let print_entrypoint_type (cctxt : #Client_context.printer) cctxt#message "@[No entrypoint named %s%a%a@]@." entrypoint - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> Format.fprintf ppf " for script %s")) + (Format.pp_print_option (fun ppf -> + Format.fprintf ppf " for script %s")) script_name >>= fun () -> return_unit | Error errs -> @@ -166,10 +167,10 @@ let print_entrypoints_list (cctxt : #Client_context.printer) else cctxt#message "@[Entrypoints%a%a: @,%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for script %s")) script_name (Format.pp_print_list @@ -210,10 +211,10 @@ let print_unreachables (cctxt : #Client_context.printer) | _ -> cctxt#message "@[Unreachable paths in the argument%a%a: @[%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of script %s")) script_name (Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf -> diff --git a/src/proto_005_PsBabyM1/lib_client/operation_result.ml b/src/proto_005_PsBabyM1/lib_client/operation_result.ml index b86516d3a9cf..9d56cc08e2bf 100644 --- a/src/proto_005_PsBabyM1/lib_client/operation_result.ml +++ b/src/proto_005_PsBabyM1/lib_client/operation_result.ml @@ -50,8 +50,8 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Format.fprintf ppf "@,Entrypoint: %s" entrypoint ) ; ( if not (Script_repr.is_unit_parameter parameters) then let expr = - Option.unopt_exn - (Failure "ill-serialized argument") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized argument") (Data_encoding.force_decode parameters) in Format.fprintf @@ -72,12 +72,12 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Tez.pp credit ; let code = - Option.unopt_exn - (Failure "ill-serialized code") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized code") (Data_encoding.force_decode code) and storage = - Option.unopt_exn - (Failure "ill-serialized storage") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized storage") (Data_encoding.force_decode storage) in let {Michelson_v1_parser.source; _} = diff --git a/src/proto_006_PsCARTHA/lib_client/michelson_v1_emacs.ml b/src/proto_006_PsCARTHA/lib_client/michelson_v1_emacs.ml index 337ff56bb7f3..7b41fb168dba 100644 --- a/src/proto_006_PsCARTHA/lib_client/michelson_v1_emacs.ml +++ b/src/proto_006_PsCARTHA/lib_client/michelson_v1_emacs.ml @@ -153,10 +153,12 @@ let report_errors ppf (parsed, errs) = (fun ppf errs -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in match errs with | top :: errs -> @@ -194,10 +196,12 @@ let report_errors ppf (parsed, errs) = (Format.pp_print_list (fun ppf err -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in let loc = match err with diff --git a/src/proto_006_PsCARTHA/lib_client/michelson_v1_entrypoints.ml b/src/proto_006_PsCARTHA/lib_client/michelson_v1_entrypoints.ml index cf10f3a426f8..73c2af021aef 100644 --- a/src/proto_006_PsCARTHA/lib_client/michelson_v1_entrypoints.ml +++ b/src/proto_006_PsCARTHA/lib_client/michelson_v1_entrypoints.ml @@ -98,10 +98,11 @@ let print_entrypoint_type (cctxt : #Client_context.printer) cctxt#message "@[No entrypoint named %s%a%a@]@." entrypoint - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> Format.fprintf ppf " for script %s")) + (Format.pp_print_option (fun ppf -> + Format.fprintf ppf " for script %s")) script_name >>= fun () -> return_unit | Error errs -> @@ -170,10 +171,10 @@ let print_entrypoints_list (cctxt : #Client_context.printer) else cctxt#message "@[Entrypoints%a%a: @,%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for script %s")) script_name (Format.pp_print_list @@ -214,10 +215,10 @@ let print_unreachables (cctxt : #Client_context.printer) | _ -> cctxt#message "@[Unreachable paths in the argument%a%a: @[%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of script %s")) script_name (Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf -> diff --git a/src/proto_006_PsCARTHA/lib_client/operation_result.ml b/src/proto_006_PsCARTHA/lib_client/operation_result.ml index 7d4dd890fe18..446ca4f81bf3 100644 --- a/src/proto_006_PsCARTHA/lib_client/operation_result.ml +++ b/src/proto_006_PsCARTHA/lib_client/operation_result.ml @@ -50,8 +50,8 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Format.fprintf ppf "@,Entrypoint: %s" entrypoint ) ; ( if not (Script_repr.is_unit_parameter parameters) then let expr = - Option.unopt_exn - (Failure "ill-serialized argument") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized argument") (Data_encoding.force_decode parameters) in Format.fprintf @@ -72,12 +72,12 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Tez.pp credit ; let code = - Option.unopt_exn - (Failure "ill-serialized code") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized code") (Data_encoding.force_decode code) and storage = - Option.unopt_exn - (Failure "ill-serialized storage") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized storage") (Data_encoding.force_decode storage) in let {Michelson_v1_parser.source; _} = diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml index 337ff56bb7f3..7b41fb168dba 100644 --- a/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_emacs.ml @@ -153,10 +153,12 @@ let report_errors ppf (parsed, errs) = (fun ppf errs -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in match errs with | top :: errs -> @@ -194,10 +196,12 @@ let report_errors ppf (parsed, errs) = (Format.pp_print_list (fun ppf err -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in let loc = match err with diff --git a/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.ml b/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.ml index cf10f3a426f8..73c2af021aef 100644 --- a/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.ml +++ b/src/proto_007_PsDELPH1/lib_client/michelson_v1_entrypoints.ml @@ -98,10 +98,11 @@ let print_entrypoint_type (cctxt : #Client_context.printer) cctxt#message "@[No entrypoint named %s%a%a@]@." entrypoint - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> Format.fprintf ppf " for script %s")) + (Format.pp_print_option (fun ppf -> + Format.fprintf ppf " for script %s")) script_name >>= fun () -> return_unit | Error errs -> @@ -170,10 +171,10 @@ let print_entrypoints_list (cctxt : #Client_context.printer) else cctxt#message "@[Entrypoints%a%a: @,%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for script %s")) script_name (Format.pp_print_list @@ -214,10 +215,10 @@ let print_unreachables (cctxt : #Client_context.printer) | _ -> cctxt#message "@[Unreachable paths in the argument%a%a: @[%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of script %s")) script_name (Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf -> diff --git a/src/proto_007_PsDELPH1/lib_client/operation_result.ml b/src/proto_007_PsDELPH1/lib_client/operation_result.ml index e1f2202a29f4..bdf1380b2abb 100644 --- a/src/proto_007_PsDELPH1/lib_client/operation_result.ml +++ b/src/proto_007_PsDELPH1/lib_client/operation_result.ml @@ -50,8 +50,8 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Format.fprintf ppf "@,Entrypoint: %s" entrypoint ) ; ( if not (Script_repr.is_unit_parameter parameters) then let expr = - Option.unopt_exn - (Failure "ill-serialized argument") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized argument") (Data_encoding.force_decode parameters) in Format.fprintf @@ -72,12 +72,12 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Tez.pp credit ; let code = - Option.unopt_exn - (Failure "ill-serialized code") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized code") (Data_encoding.force_decode code) and storage = - Option.unopt_exn - (Failure "ill-serialized storage") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized storage") (Data_encoding.force_decode storage) in let {Michelson_v1_parser.source; _} = diff --git a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml index f0358cde8fe0..ea54767df78f 100644 --- a/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_007_PsDELPH1/lib_client_commands/client_proto_context_commands.ml @@ -216,11 +216,11 @@ let prepare_batch_operation cctxt ?arg ?fee ?gas_limit ?storage_limit >>=? fun amount -> tez_of_opt_string_exn index "fee" batch.fee >>=? fun batch_fee -> - let fee = Option.first_some batch_fee fee in - let arg = Option.first_some batch.arg arg in - let gas_limit = Option.first_some batch.gas_limit gas_limit in - let storage_limit = Option.first_some batch.storage_limit storage_limit in - let entrypoint = Option.first_some batch.entrypoint entrypoint in + let fee = Option.either batch_fee fee in + let arg = Option.either batch.arg arg in + let gas_limit = Option.either batch.gas_limit gas_limit in + let storage_limit = Option.either batch.storage_limit storage_limit in + let entrypoint = Option.either batch.entrypoint entrypoint in parse_arg_transfer arg >>=? fun parameters -> ( match Contract.is_implicit source with diff --git a/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml index 74060931c20d..dd75d2508f12 100644 --- a/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml +++ b/src/proto_007_PsDELPH1/lib_delegate/client_baking_forge.ml @@ -402,7 +402,8 @@ let classify_operations (cctxt : #Protocol_client_context.full) ~chain ~block (* Retrieve the optimist maximum paying manager operations *) let manager_operations = t.(managers_index) in let {Environment.Updater.max_size; _} = - Option.get @@ List.nth Main.validation_passes managers_index + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth Main.validation_passes managers_index in sort_manager_operations ~max_size @@ -606,10 +607,21 @@ let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority state.index <- index ; return inc) >>=? fun initial_inc -> - let endorsements = Option.get @@ List.nth operations endorsements_index in - let votes = Option.get @@ List.nth operations votes_index in - let anonymous = Option.get @@ List.nth operations anonymous_index in - let managers = Option.get @@ List.nth operations managers_index in + let endorsements = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations endorsements_index + in + let votes = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth operations votes_index + in + let anonymous = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations anonymous_index + in + let managers = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations managers_index + in let validate_operation inc op = protect (fun () -> add_operation inc op) >>= function @@ -679,15 +691,17 @@ let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority let votes = retain_operations_up_to_quota (List.rev votes) - (Option.get @@ List.nth quota votes_index) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota votes_index) in let anonymous = retain_operations_up_to_quota (List.rev anonymous) - (Option.get @@ List.nth quota anonymous_index) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota anonymous_index) in trim_manager_operations - ~max_size:(Option.get @@ List.nth quota managers_index).max_size + ~max_size: + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota managers_index) + .max_size ~hard_gas_limit_per_block managers >>=? fun (accepted_managers, _overflowing_managers) -> @@ -804,21 +818,27 @@ let forge_block cctxt ?force ?operations ?(best_effort = operations = None) let quota : Environment.Updater.quota list = Main.validation_passes in let endorsements = List.sub - (Option.get @@ List.nth operations endorsements_index) + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations endorsements_index ) endorsers_per_block in let votes = retain_operations_up_to_quota - (Option.get @@ List.nth operations votes_index) - (Option.get @@ List.nth quota votes_index) + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations votes_index ) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota votes_index) in let anonymous = retain_operations_up_to_quota - (Option.get @@ List.nth operations anonymous_index) - (Option.get @@ List.nth quota anonymous_index) + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations anonymous_index ) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota anonymous_index) in (* Size/Gas check already occurred in classify operations *) - let managers = Option.get @@ List.nth operations managers_index in + let managers = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations managers_index + in let operations = [endorsements; votes; anonymous; managers] in ( match context_path with | None -> diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml b/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml index 792d4b38efb6..543e6a98fce6 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/activation.ml @@ -97,8 +97,8 @@ let secrets () = account = account.pkh; activation_code = Blinded_public_key_hash.activation_code_of_hex secret; amount = - Option.unopt_exn - (Invalid_argument "tez conversion") + WithExceptions.Option.to_exn + ~none:(Invalid_argument "tez conversion") (Tez.of_mutez (Int64.of_string amount)); }) [ ( [ "envelope"; @@ -316,7 +316,7 @@ let single_activation () = activation_init () >>=? fun (blk, _contracts, secrets) -> let ({account; activation_code; amount = expected_amount; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets in (* Contract does not exist *) Assert.balance_is @@ -383,9 +383,11 @@ let activation_and_transfer () = activation_init () >>=? fun (blk, contracts, secrets) -> let ({account; activation_code; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in - let bootstrap_contract = Option.get @@ List.hd contracts in let first_contract = Contract.implicit_contract account in Op.activation (B blk) account activation_code >>=? fun operation -> @@ -413,9 +415,11 @@ let transfer_to_unactivated_then_activate () = activation_init () >>=? fun (blk, contracts, secrets) -> let ({account; activation_code; amount} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in - let bootstrap_contract = Option.get @@ List.hd contracts in let unactivated_commitment_contract = Contract.implicit_contract account in Context.Contract.balance (B blk) bootstrap_contract >>=? fun b_amount -> @@ -455,7 +459,7 @@ let invalid_activation_with_no_commitments () = >>=? fun (blk, _) -> let secrets = secrets () in let ({account; activation_code; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets in Op.activation (B blk) account activation_code >>=? fun operation -> @@ -471,9 +475,11 @@ let invalid_activation_with_no_commitments () = let invalid_activation_wrong_secret () = activation_init () >>=? fun (blk, _, secrets) -> - let ({account; _} as _first_one) = Option.get @@ List.nth secrets 0 in + let ({account; _} as _first_one) = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth secrets 0 + in let ({activation_code; _} as _second_one) = - Option.get @@ List.nth secrets 1 + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth secrets 1 in Op.activation (B blk) account activation_code >>=? fun operation -> @@ -490,7 +496,9 @@ let invalid_activation_wrong_secret () = let invalid_activation_inexistent_pkh () = activation_init () >>=? fun (blk, _, secrets) -> - let ({activation_code; _} as _first_one) = Option.get @@ List.hd secrets in + let ({activation_code; _} as _first_one) = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in let inexistent_pkh = Signature.Public_key_hash.of_b58check_exn "tz1PeQHGKPWSpNoozvxgqLN9TFsj6rDqNV3o" @@ -511,7 +519,7 @@ let invalid_double_activation () = activation_init () >>=? fun (blk, _, secrets) -> let ({account; activation_code; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets in Incremental.begin_construction blk >>=? fun inc -> @@ -533,8 +541,12 @@ let invalid_double_activation () = let invalid_transfer_from_unactivated_account () = activation_init () >>=? fun (blk, contracts, secrets) -> - let ({account; _} as _first_one) = Option.get @@ List.hd secrets in - let bootstrap_contract = Option.get @@ List.hd contracts in + let ({account; _} as _first_one) = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts + in let unactivated_commitment_contract = Contract.implicit_contract account in (* No activation *) Op.transaction diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml b/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml index f9ddabc64207..d61f1862103e 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/delegation.ml @@ -53,7 +53,9 @@ let expect_no_change_registered_delegate_pkh pkh = function let bootstrap_manager_is_bootstrap_delegate () = Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = Option.get @@ List.hd bootstrap_contracts in + let bootstrap0 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.delegate (B b) bootstrap0 >>=? fun delegate0 -> Context.Contract.manager (B b) bootstrap0 @@ -63,8 +65,12 @@ let bootstrap_manager_is_bootstrap_delegate () = let bootstrap_delegate_cannot_change ~fee () = Context.init 2 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = Option.get @@ List.nth bootstrap_contracts 0 in - let bootstrap1 = Option.get @@ List.nth bootstrap_contracts 1 in + let bootstrap0 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bootstrap_contracts 0 + in + let bootstrap1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bootstrap_contracts 1 + in Context.Contract.pkh bootstrap0 >>=? fun pkh1 -> Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) @@ -106,7 +112,9 @@ let bootstrap_delegate_cannot_change ~fee () = let bootstrap_delegate_cannot_be_removed ~fee () = Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Incremental.begin_construction b >>=? fun i -> Context.Contract.balance (I i) bootstrap @@ -144,8 +152,12 @@ let bootstrap_delegate_cannot_be_removed ~fee () = let delegate_can_be_changed_from_unregistered_contract ~fee () = Context.init 2 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = Option.get @@ List.hd bootstrap_contracts in - let bootstrap1 = Option.get @@ List.nth bootstrap_contracts 1 in + let bootstrap0 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in + let bootstrap1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bootstrap_contracts 1 + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let unregistered = Contract.implicit_contract unregistered_pkh in @@ -197,7 +209,9 @@ let delegate_can_be_changed_from_unregistered_contract ~fee () = let delegate_can_be_removed_from_unregistered_contract ~fee () = Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let unregistered = Contract.implicit_contract unregistered_pkh in @@ -252,7 +266,9 @@ let bootstrap_manager_already_registered_delegate ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.manager (I i) bootstrap >>=? fun manager -> let pkh = manager.pkh in @@ -289,7 +305,9 @@ let delegate_to_bootstrap_by_origination ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.manager (I i) bootstrap >>=? fun manager -> Context.Contract.balance (I i) bootstrap @@ -486,7 +504,9 @@ let unregistered_delegate_key_init_origination ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in (* origination with delegate argument *) @@ -537,7 +557,9 @@ let unregistered_delegate_key_init_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -587,9 +609,11 @@ let unregistered_delegate_key_switch_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let bootstrap_pkh = - Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit bootstrap |> WithExceptions.Option.get ~loc:__LOC__ in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in @@ -646,7 +670,9 @@ let unregistered_delegate_key_init_origination_credit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -697,7 +723,9 @@ let unregistered_delegate_key_init_delegation_credit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -755,9 +783,11 @@ let unregistered_delegate_key_switch_delegation_credit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let bootstrap_pkh = - Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit bootstrap |> WithExceptions.Option.get ~loc:__LOC__ in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in @@ -823,7 +853,9 @@ let unregistered_delegate_key_init_origination_credit_debit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -881,7 +913,9 @@ let unregistered_delegate_key_init_delegation_credit_debit ~amount ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -944,9 +978,11 @@ let unregistered_delegate_key_switch_delegation_credit_debit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let bootstrap_pkh = - Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit bootstrap |> WithExceptions.Option.get ~loc:__LOC__ in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in @@ -1041,7 +1077,9 @@ let failed_self_delegation_emptied_implicit_contract amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let unregistered_pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -1075,7 +1113,9 @@ let emptying_delegated_implicit_contract_fails amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.manager (I i) bootstrap >>=? fun bootstrap_manager -> let account = Account.new_account () in @@ -1115,7 +1155,9 @@ let valid_delegate_registration_init_delegation_credit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1168,7 +1210,9 @@ let valid_delegate_registration_switch_delegation_credit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1222,7 +1266,9 @@ let valid_delegate_registration_init_delegation_credit_debit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1290,7 +1336,9 @@ let valid_delegate_registration_switch_delegation_credit_debit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1356,7 +1404,9 @@ let double_registration () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract pkh in @@ -1389,7 +1439,9 @@ let double_registration_when_empty () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract pkh in @@ -1429,7 +1481,9 @@ let double_registration_when_recredited () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract pkh in @@ -1476,7 +1530,9 @@ let unregistered_and_unrevealed_self_delegate_key_init_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let {Account.pkh; _} = Account.new_account () in let {Account.pkh = delegate_pkh; _} = Account.new_account () in let contract = Alpha_context.Contract.implicit_contract pkh in @@ -1511,7 +1567,9 @@ let unregistered_and_revealed_self_delegate_key_init_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let {Account.pkh; pk; _} = Account.new_account () in let {Account.pkh = delegate_pkh; _} = Account.new_account () in let contract = Alpha_context.Contract.implicit_contract pkh in @@ -1550,7 +1608,9 @@ let registered_self_delegate_key_init_delegation () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let {Account.pkh; _} = Account.new_account () in let {Account.pkh = delegate_pkh; pk = delegate_pk; _} = Account.new_account () diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml b/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml index 37f2bff4fe5e..8919a2f31d1f 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/double_baking.ml @@ -36,7 +36,7 @@ open Alpha_context let get_hd_hd = function x :: y :: _ -> (x, y) | _ -> assert false let get_first_different_baker baker bakers = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun baker' -> Signature.Public_key_hash.( <> ) baker baker') bakers @@ -44,8 +44,10 @@ let get_first_different_baker baker bakers = let get_first_different_bakers ctxt = Context.get_bakers ctxt >|=? fun bakers -> - let baker_1 = Option.get @@ List.hd bakers in - get_first_different_baker baker_1 (Option.get @@ List.tl bakers) + let baker_1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers in + get_first_different_baker + baker_1 + (WithExceptions.Option.get ~loc:__LOC__ @@ List.tl bakers) |> fun baker_2 -> (baker_1, baker_2) let get_first_different_endorsers ctxt = @@ -71,7 +73,9 @@ let valid_double_baking_evidence () = >>=? fun (b, contracts) -> Context.get_bakers (B b) >>=? fun bakers -> - let priority_0_baker = Option.get @@ List.hd bakers in + let priority_0_baker = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers + in block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) -> Op.double_baking (B blk_a) blk_a.header blk_b.header diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml b/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml index aade59208a04..150ba194bfed 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/double_endorsement.ml @@ -36,7 +36,7 @@ open Alpha_context let get_hd_hd = function x :: y :: _ -> (x, y) | _ -> assert false let get_first_different_baker baker bakers = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun baker' -> Signature.Public_key_hash.( <> ) baker baker') bakers @@ -44,8 +44,10 @@ let get_first_different_baker baker bakers = let get_first_different_bakers ctxt = Context.get_bakers ctxt >|=? fun bakers -> - let baker_1 = Option.get @@ List.hd bakers in - get_first_different_baker baker_1 (Option.get @@ List.tl bakers) + let baker_1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers in + get_first_different_baker + baker_1 + (WithExceptions.Option.get ~loc:__LOC__ @@ List.tl bakers) |> fun baker_2 -> (baker_1, baker_2) let get_first_different_endorsers ctxt = diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml b/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml index 58cb03542767..2a6c3f7efa7c 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/endorsement.ml @@ -332,7 +332,10 @@ let reward_retrieval_two_endorsers () = Signature.Public_key_hash.( endorser.Delegate_services.Endorsing_rights.delegate = endorser2.delegate) in - let endorser2 = Option.get @@ List.find same_endorser2 endorsers in + let endorser2 = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.find same_endorser2 endorsers + in (* No exception raised: in sandboxed mode endorsers do not change between blocks *) Tez.( endorsement_security_deposit *? Int64.of_int (List.length endorser2.slots)) @@ -494,14 +497,14 @@ let not_enough_for_deposit () = Context.get_endorser (B b) >>=? fun (endorser, _slots) -> let (_, contract_other_than_endorser) = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun (c, _) -> not (Signature.Public_key_hash.equal c.Account.pkh endorser)) managers in let (_, contract_of_endorser) = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun (c, _) -> Signature.Public_key_hash.equal c.Account.pkh endorser) managers diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml index ac1294005bcc..a874cfc86f8d 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/block.ml @@ -67,13 +67,13 @@ let get_next_baker_by_priority priority block = block >|=? fun bakers -> let {Alpha_services.Delegate.Baking_rights.delegate = pkh; timestamp; _} = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun {Alpha_services.Delegate.Baking_rights.priority = p; _} -> p = priority) bakers in - (pkh, priority, Option.unopt_exn (Failure "") timestamp) + (pkh, priority, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let get_next_baker_by_account pkh block = Alpha_services.Delegate.Baking_rights.get @@ -86,9 +86,9 @@ let get_next_baker_by_account pkh block = timestamp; priority; _ } = - Option.get @@ List.hd bakers + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers in - (pkh, priority, Option.unopt_exn (Failure "") timestamp) + (pkh, priority, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let get_next_baker_excluding excludes block = Alpha_services.Delegate.Baking_rights.get rpc_ctxt ~max_priority:256 block @@ -97,13 +97,13 @@ let get_next_baker_excluding excludes block = timestamp; priority; _ } = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun {Alpha_services.Delegate.Baking_rights.delegate; _} -> not (List.mem delegate excludes)) bakers in - (pkh, priority, Option.unopt_exn (Failure "") timestamp) + (pkh, priority, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let dispatch_policy = function | By_priority p -> diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml index 448bed932a96..353bc9afee82 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/context.ml @@ -108,7 +108,7 @@ let get_endorsers ctxt = let get_endorser ctxt = Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt >|=? fun endorsers -> - let endorser = Option.get @@ List.hd endorsers in + let endorser = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd endorsers in (endorser.delegate, endorser.slots) let get_bakers ctxt = diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml index 0ef7f64ca2cc..000b8708e324 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/helpers/op.ml @@ -67,7 +67,7 @@ let combine_operations ?public_key ?counter ?spurious_operation ~source ctxt assert (List.length packed_operations > 0) ; (* Hypothesis : each operation must have the same branch (is this really true?) *) let {Tezos_base.Operation.branch} = - (Option.get @@ List.hd packed_operations).shell + (WithExceptions.Option.get ~loc:__LOC__ @@ List.hd packed_operations).shell in assert ( List.for_all @@ -253,7 +253,9 @@ let origination ?counter ?delegate ~script ?(preorigination = None) ?public_key Context.Contract.manager ctxt source >>=? fun account -> let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in - let default_credit = Option.unopt_exn Impossible default_credit in + let default_credit = + WithExceptions.Option.to_exn ~none:Impossible default_credit + in let credit = Option.value ~default:default_credit credit in let operation = Origination {delegate; script; credit; preorigination} in manager_operation diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml b/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml index efeec384e7e8..2472e0f79a23 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/origination.ml @@ -37,7 +37,7 @@ let ten_tez = Tez.of_int 10 let register_origination ?(fee = Tez.zero) ?(credit = Tez.zero) () = Context.init 1 >>=? fun (b, contracts) -> - let source = Option.get @@ List.hd contracts in + let source = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Context.Contract.balance (B b) source >>=? fun source_balance -> Op.origination (B b) source ~fee ~credit ~script:Op.dummy_script @@ -81,7 +81,7 @@ let test_origination_balances ~loc:_ ?(fee = Tez.zero) ?(credit = Tez.zero) () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.hd contracts in + let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Context.Contract.balance (B b) contract >>=? fun balance -> Op.origination (B b) contract ~fee ~credit ~script:Op.dummy_script @@ -163,8 +163,12 @@ let pay_fee () = let not_tez_in_contract_to_pay_fee () = Context.init 2 >>=? fun (b, contracts) -> - let contract_1 = Option.get @@ List.nth contracts 0 in - let contract_2 = Option.get @@ List.nth contracts 1 in + let contract_1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract_2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 + in Incremental.begin_construction b >>=? fun inc -> (* transfer everything but one tez from 1 to 2 and check balance of 1 *) @@ -203,7 +207,7 @@ let not_tez_in_contract_to_pay_fee () = let register_contract_get_endorser () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.hd contracts in + let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Incremental.begin_construction b >>=? fun inc -> Context.get_endorser (I inc) @@ -236,7 +240,7 @@ let multiple_originations () = let counter () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.hd contracts in + let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Incremental.begin_construction b >>=? fun inc -> Op.origination (I inc) ~credit:Tez.one contract ~script:Op.dummy_script diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml b/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml index 8f3f98cb0651..2082fb989737 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/reveal.ml @@ -33,7 +33,7 @@ let ten_tez = Tez.of_int 10 let simple_reveal () = Context.init 1 >>=? fun (blk, contracts) -> - let c = Option.get @@ List.nth contracts 0 in + let c = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let new_c = Account.new_account () in let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in (* Create the contract *) @@ -57,7 +57,7 @@ let simple_reveal () = let empty_account_on_reveal () = Context.init 1 >>=? fun (blk, contracts) -> - let c = Option.get @@ List.nth contracts 0 in + let c = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let new_c = Account.new_account () in let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in let amount = Tez.one_mutez in @@ -89,7 +89,7 @@ let empty_account_on_reveal () = let not_enough_found_for_reveal () = Context.init 1 >>=? fun (blk, contracts) -> - let c = Option.get @@ List.nth contracts 0 in + let c = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let new_c = Account.new_account () in let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in (* Create the contract *) diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml b/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml index 1d18737b577f..0bd37a27d13b 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/seed.ml @@ -119,7 +119,7 @@ let revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get committed_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get committed_hash) |> fun operation -> Block.bake ~policy ~operation b >>= fun e -> @@ -139,7 +139,7 @@ let revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get wrong_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get wrong_hash) |> fun operation -> Block.bake ~operation b >>= fun e -> @@ -153,7 +153,7 @@ let revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get committed_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get committed_hash) |> fun operation -> Block.get_next_baker ~policy b >>=? fun (baker_pkh, _, _) -> @@ -194,7 +194,7 @@ let revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get wrong_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get wrong_hash) |> fun operation -> Block.bake ~operation ~policy b >>= fun e -> @@ -273,7 +273,7 @@ let revelation_missing_and_late () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get committed_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get committed_hash) |> fun operation -> Block.bake ~operation b >>= fun e -> diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml b/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml index 43d2a901d439..835dc1bff0f9 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/transfer.ml @@ -188,7 +188,7 @@ let transfer_zero_tez () = let transfer_zero_implicit () = Context.init 1 >>=? fun (b, contracts) -> - let dest = Option.get @@ List.nth contracts 0 in + let dest = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let account = Account.new_account () in Incremental.begin_construction b >>=? fun i -> @@ -211,7 +211,9 @@ let transfer_zero_implicit () = let transfer_to_originate_with_fee () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.nth contracts 0 in + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in Incremental.begin_construction b >>=? fun b -> two_nth_of_balance b contract 10L @@ -255,7 +257,9 @@ let transfer_amount_of_contract_balance () = let transfers_to_self () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.nth contracts 0 in + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in Incremental.begin_construction b >>=? fun b -> two_nth_of_balance b contract 3L @@ -304,7 +308,9 @@ let missing_transaction () = let transfer_from_implicit_to_implicit_contract () = Context.init 1 >>=? fun (b, contracts) -> - let bootstrap_contract = Option.get @@ List.nth contracts 0 in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in let account_a = Account.new_account () in let account_b = Account.new_account () in Incremental.begin_construction b @@ -345,8 +351,12 @@ let transfer_from_implicit_to_implicit_contract () = let transfer_from_implicit_to_originated_contract () = Context.init 1 >>=? fun (b, contracts) -> - let bootstrap_contract = Option.get @@ List.nth contracts 0 in - let contract = Option.get @@ List.nth contracts 0 in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in let account = Account.new_account () in let src = Contract.implicit_contract account.Account.pkh in Incremental.begin_construction b @@ -469,7 +479,7 @@ let build_a_chain () = let empty_implicit () = Context.init 1 >>=? fun (b, contracts) -> - let dest = Option.get @@ List.nth contracts 0 in + let dest = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let account = Account.new_account () in Incremental.begin_construction b >>=? fun incr -> @@ -532,9 +542,15 @@ let balance_too_low fee () = let balance_too_low_two_transfers fee () = Context.init 3 >>=? fun (b, contracts) -> - let contract_1 = Option.get @@ List.nth contracts 0 in - let contract_2 = Option.get @@ List.nth contracts 1 in - let contract_3 = Option.get @@ List.nth contracts 2 in + let contract_1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract_2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 + in + let contract_3 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 2 + in Incremental.begin_construction b >>=? fun i -> Context.Contract.balance (I i) contract_1 diff --git a/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml b/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml index 8b3b5eaa1202..acfe4721dbe5 100644 --- a/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml +++ b/src/proto_007_PsDELPH1/lib_protocol/test/voting.ml @@ -199,8 +199,12 @@ let test_successful_vote num_delegates () = | Some _ -> failwith "%s - Unexpected proposal" __LOC__) >>=? fun () -> - let del1 = Option.get @@ List.nth delegates_p1 0 in - let del2 = Option.get @@ List.nth delegates_p1 1 in + let del1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates_p1 0 + in + let del2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates_p1 1 + in let props = List.map (fun i -> protos.(i)) (2 -- Constants.max_proposals_per_delegate) in @@ -216,8 +220,8 @@ let test_successful_vote num_delegates () = (* correctly count the double proposal for zero *) (let weight = Int32.add - (Option.get @@ List.nth rolls_p1 0) - (Option.get @@ List.nth rolls_p1 1) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth rolls_p1 0) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth rolls_p1 1) in match Environment.Protocol_hash.(Map.find_opt zero ps) with | Some v -> @@ -546,7 +550,9 @@ let test_not_enough_quorum_in_testing_vote num_delegates () = | _ -> failwith "%s - Unexpected period kind" __LOC__) >>=? fun () -> - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [Protocol_hash.zero] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -572,7 +578,9 @@ let test_not_enough_quorum_in_testing_vote num_delegates () = get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 |> fun voters -> (* take the first two voters out so there cannot be quorum *) - let voters_without_quorum = Option.get @@ List.tl voters in + let voters_without_quorum = + WithExceptions.Option.get ~loc:__LOC__ @@ List.tl voters + in get_rolls b voters_without_quorum __LOC__ >>=? fun voters_rolls_in_testing_vote -> (* all voters_without_quorum vote, for yays; @@ -624,7 +632,9 @@ let test_not_enough_quorum_in_promotion_vote num_delegates () = | _ -> failwith "%s - Unexpected period kind" __LOC__) >>=? fun () -> - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [Protocol_hash.zero] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -686,7 +696,9 @@ let test_not_enough_quorum_in_promotion_vote num_delegates () = get_smallest_prefix_voters_for_quorum delegates_p4 rolls_p4 |> fun voters -> (* take the first voter out so there cannot be quorum *) - let voters_without_quorum = Option.get @@ List.tl voters in + let voters_without_quorum = + WithExceptions.Option.get ~loc:__LOC__ @@ List.tl voters + in get_rolls b voters_without_quorum __LOC__ >>=? fun voter_rolls -> (* all voters_without_quorum vote, for yays; @@ -729,7 +741,7 @@ let test_multiple_identical_proposals_count_as_one () = | _ -> failwith "%s - Unexpected period kind" __LOC__) >>=? fun () -> - let proposer = Option.get @@ List.hd delegates in + let proposer = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd delegates in Op.proposals (B b) proposer [Protocol_hash.zero; Protocol_hash.zero] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -772,28 +784,32 @@ let test_supermajority_in_proposal there_is_a_winner () = >>=? fun { parametric = {blocks_per_cycle; blocks_per_voting_period; tokens_per_roll; _}; _ } -> - let del1 = Option.get @@ List.nth delegates 0 in - let del2 = Option.get @@ List.nth delegates 1 in - let del3 = Option.get @@ List.nth delegates 2 in + let del1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 in + let del2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 1 in + let del3 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 2 in List.map_es (fun del -> Context.Contract.pkh del) [del1; del2; del3] >>=? fun pkhs -> let policy = Block.Excluding pkhs in Op.transaction (B b) - (Option.get @@ List.nth delegates 3) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 3) del1 tokens_per_roll >>=? fun op1 -> Op.transaction (B b) - (Option.get @@ List.nth delegates 4) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 4) del2 tokens_per_roll >>=? fun op2 -> ( if there_is_a_winner then Test_tez.Tez.( *? ) tokens_per_roll 3L else Test_tez.Tez.( *? ) tokens_per_roll 2L ) >>?= fun bal3 -> - Op.transaction (B b) (Option.get @@ List.nth delegates 5) del3 bal3 + Op.transaction + (B b) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 5) + del3 + bal3 >>=? fun op3 -> Block.bake ~policy ~operations:[op1; op2; op3] b >>=? fun b -> @@ -856,8 +872,8 @@ let test_quorum_in_proposal has_quorum () = min_proposal_quorum; _ }; _ } -> - let del1 = Option.get @@ List.nth delegates 0 in - let del2 = Option.get @@ List.nth delegates 1 in + let del1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 in + let del2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 1 in List.map_es (fun del -> Context.Contract.pkh del) [del1; del2] >>=? fun pkhs -> let policy = Block.Excluding pkhs in @@ -921,7 +937,7 @@ let test_supermajority_in_testing_vote supermajority () = >>=? fun (b, delegates) -> Context.get_constants (B b) >>=? fun {parametric = {blocks_per_voting_period; _}; _} -> - let del1 = Option.get @@ List.nth delegates 0 in + let del1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 in let proposal = protos.(0) in Op.proposals (B b) del1 [proposal] >>=? fun ops1 -> @@ -1044,7 +1060,9 @@ let test_quorum_capped_maximum num_delegates () = >>=? fun () -> (* propose a new protocol *) let protocol = Protocol_hash.zero in - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [protocol] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -1108,7 +1126,9 @@ let test_quorum_capped_minimum num_delegates () = >>=? fun () -> (* propose a new protocol *) let protocol = Protocol_hash.zero in - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [protocol] >>=? fun ops -> Block.bake ~operations:[ops] b diff --git a/src/proto_008_PtEdoTez/lib_client/michelson_v1_emacs.ml b/src/proto_008_PtEdoTez/lib_client/michelson_v1_emacs.ml index 07f493fc42a2..3a1612a77f88 100644 --- a/src/proto_008_PtEdoTez/lib_client/michelson_v1_emacs.ml +++ b/src/proto_008_PtEdoTez/lib_client/michelson_v1_emacs.ml @@ -155,10 +155,12 @@ let report_errors ppf (parsed, errs) = (fun ppf errs -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in match errs with | top :: errs -> @@ -196,10 +198,12 @@ let report_errors ppf (parsed, errs) = (Format.pp_print_list (fun ppf err -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in let loc = match err with diff --git a/src/proto_008_PtEdoTez/lib_client/michelson_v1_entrypoints.ml b/src/proto_008_PtEdoTez/lib_client/michelson_v1_entrypoints.ml index 881bef0a5d95..2aeeb65a6652 100644 --- a/src/proto_008_PtEdoTez/lib_client/michelson_v1_entrypoints.ml +++ b/src/proto_008_PtEdoTez/lib_client/michelson_v1_entrypoints.ml @@ -99,10 +99,11 @@ let print_entrypoint_type (cctxt : #Client_context.printer) cctxt#message "@[No entrypoint named %s%a%a@]@." entrypoint - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> Format.fprintf ppf " for script %s")) + (Format.pp_print_option (fun ppf -> + Format.fprintf ppf " for script %s")) script_name >>= fun () -> return_unit | Error errs -> @@ -177,10 +178,10 @@ let print_entrypoints_list (cctxt : #Client_context.printer) else cctxt#message "@[Entrypoints%a%a: @,%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for script %s")) script_name (Format.pp_print_list @@ -221,10 +222,10 @@ let print_unreachables (cctxt : #Client_context.printer) | _ -> cctxt#message "@[Unreachable paths in the argument%a%a: @[%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of script %s")) script_name (Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf -> diff --git a/src/proto_008_PtEdoTez/lib_client/operation_result.ml b/src/proto_008_PtEdoTez/lib_client/operation_result.ml index 0b5a1b079346..4e0085f2735a 100644 --- a/src/proto_008_PtEdoTez/lib_client/operation_result.ml +++ b/src/proto_008_PtEdoTez/lib_client/operation_result.ml @@ -50,8 +50,8 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Format.fprintf ppf "@,Entrypoint: %s" entrypoint ) ; ( if not (Script_repr.is_unit_parameter parameters) then let expr = - Option.unopt_exn - (Failure "ill-serialized argument") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized argument") (Data_encoding.force_decode parameters) in Format.fprintf @@ -72,12 +72,12 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Tez.pp credit ; let code = - Option.unopt_exn - (Failure "ill-serialized code") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized code") (Data_encoding.force_decode code) and storage = - Option.unopt_exn - (Failure "ill-serialized storage") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized storage") (Data_encoding.force_decode storage) in let {Michelson_v1_parser.source; _} = diff --git a/src/proto_008_PtEdoTez/lib_client_commands/client_proto_context_commands.ml b/src/proto_008_PtEdoTez/lib_client_commands/client_proto_context_commands.ml index 13afd73154e0..045a0af865f7 100644 --- a/src/proto_008_PtEdoTez/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_008_PtEdoTez/lib_client_commands/client_proto_context_commands.ml @@ -216,11 +216,11 @@ let prepare_batch_operation cctxt ?arg ?fee ?gas_limit ?storage_limit >>=? fun amount -> tez_of_opt_string_exn index "fee" batch.fee >>=? fun batch_fee -> - let fee = Option.first_some batch_fee fee in - let arg = Option.first_some batch.arg arg in - let gas_limit = Option.first_some batch.gas_limit gas_limit in - let storage_limit = Option.first_some batch.storage_limit storage_limit in - let entrypoint = Option.first_some batch.entrypoint entrypoint in + let fee = Option.either batch_fee fee in + let arg = Option.either batch.arg arg in + let gas_limit = Option.either batch.gas_limit gas_limit in + let storage_limit = Option.either batch.storage_limit storage_limit in + let entrypoint = Option.either batch.entrypoint entrypoint in parse_arg_transfer arg >>=? fun parameters -> ( match Contract.is_implicit source with diff --git a/src/proto_008_PtEdoTez/lib_client_sapling/client_sapling_commands.ml b/src/proto_008_PtEdoTez/lib_client_sapling/client_sapling_commands.ml index c576b4f5df02..0e87dd733e6d 100644 --- a/src/proto_008_PtEdoTez/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_008_PtEdoTez/lib_client_sapling/client_sapling_commands.ml @@ -49,7 +49,9 @@ let keys_of_implicit_account cctxt source = let viewing_key_of_string s = let exception Unknown_sapling_address in let encoding = Viewing_key.address_b58check_encoding in - Option.unopt_exn Unknown_sapling_address (Base58.simple_decode encoding s) + WithExceptions.Option.to_exn + ~none:Unknown_sapling_address + (Base58.simple_decode encoding s) (** All signatures are done with an anti-replay string. In Tezos' protocol this string is set to be chain_id + KT1. **) @@ -713,7 +715,9 @@ let commands () = path >>= fun () -> (* TODO must pass contract address for now *) - let (_, contract) = Option.unopt_assert ~loc:__POS__ contract_opt in + let (_, contract) = + WithExceptions.Option.get ~loc:__LOC__ contract_opt + in Context.Client_state.register cctxt ~default_memo_size diff --git a/src/proto_008_PtEdoTez/lib_client_sapling/context.ml b/src/proto_008_PtEdoTez/lib_client_sapling/context.ml index 700e2c3343a6..9c16c3a502aa 100644 --- a/src/proto_008_PtEdoTez/lib_client_sapling/context.ml +++ b/src/proto_008_PtEdoTez/lib_client_sapling/context.ml @@ -54,7 +54,7 @@ end = struct let of_tez t = let i = Tez.to_mutez t in assert (UTXO.valid_amount i) ; - Option.unopt_assert ~loc:__POS__ @@ of_mutez i + WithExceptions.Option.get ~loc:__LOC__ @@ of_mutez i end module Shielded_tez_contract_input = struct @@ -200,7 +200,7 @@ module Account = struct let add_unspent c input = let amount = - Option.unopt_assert ~loc:__POS__ + WithExceptions.Option.get ~loc:__LOC__ @@ Shielded_tez.of_mutez (F.Input.amount input) in match Shielded_tez.(c.balance +? amount) with @@ -212,7 +212,7 @@ module Account = struct let remove_unspent c input = let amount = - Option.unopt_assert ~loc:__POS__ + WithExceptions.Option.get ~loc:__LOC__ @@ Shielded_tez.of_mutez (F.Input.amount input) in match Shielded_tez.(c.balance -? amount) with @@ -232,11 +232,11 @@ module Account = struct account let pick_input c = - Option.( - Input_set.choose c.unspents - >>| fun unspent -> - let c = remove_unspent c unspent in - (unspent, c)) + let ( >|? ) x f = Option.map f x in + Input_set.choose c.unspents + >|? fun unspent -> + let c = remove_unspent c unspent in + (unspent, c) let pp_unspent : Format.formatter -> t -> unit = fun ppf a -> @@ -296,7 +296,7 @@ module Contract_state = struct let add_unspent vk input accounts = let account = - Accounts.find vk accounts |> Option.unopt_assert ~loc:__POS__ + Accounts.find vk accounts |> WithExceptions.Option.get ~loc:__LOC__ in let account = Account.add_unspent account input in Accounts.replace account accounts @@ -501,7 +501,7 @@ let get_shielded_amount amount account = loop rest_to_pay (next_in :: chosen_inputs) account else let change = - Option.unopt_assert ~loc:__POS__ + WithExceptions.Option.get ~loc:__LOC__ @@ Shielded_tez.of_mutez @@ Int64.abs to_pay in (chosen_inputs, change) @@ -517,7 +517,8 @@ let create_payback ~memo_size address amount = let unshield ~src ~dst ~backdst amount (state : Contract_state.t) anti_replay = let vk = Viewing_key.of_sk src in let account = - Contract_state.find_account vk state |> Option.unopt_assert ~loc:__POS__ + Contract_state.find_account vk state + |> WithExceptions.Option.get ~loc:__LOC__ in get_shielded_amount amount account >|? fun (inputs, change) -> @@ -554,7 +555,8 @@ let transfer cctxt ~src ~dst ~backdst ?message amount (state : Contract_state.t) anti_replay = let vk = Viewing_key.of_sk src in let account = - Contract_state.find_account vk state |> Option.unopt_assert ~loc:__POS__ + Contract_state.find_account vk state + |> WithExceptions.Option.get ~loc:__LOC__ in let memo_size = Storage.get_memo_size state.storage in adjust_message_length cctxt ?message memo_size diff --git a/src/proto_008_PtEdoTez/lib_delegate/client_baking_blocks.ml b/src/proto_008_PtEdoTez/lib_delegate/client_baking_blocks.ml index 8e811b0b4b9b..7760f4765174 100644 --- a/src/proto_008_PtEdoTez/lib_delegate/client_baking_blocks.ml +++ b/src/proto_008_PtEdoTez/lib_delegate/client_baking_blocks.ml @@ -202,7 +202,7 @@ let blocks_from_current_cycle cctxt ?(chain = `Main) block ?(offset = 0l) () = let blocks = List.remove (length - Int32.to_int (Raw_level.diff last first)) - (Option.get @@ List.hd blocks) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.hd blocks) in if Int32.equal level (Raw_level.to_int32 last) then return (hash :: blocks) diff --git a/src/proto_008_PtEdoTez/lib_delegate/client_baking_denunciation.ml b/src/proto_008_PtEdoTez/lib_delegate/client_baking_denunciation.ml index d13f276e1b34..a9be06eb2474 100644 --- a/src/proto_008_PtEdoTez/lib_delegate/client_baking_denunciation.ml +++ b/src/proto_008_PtEdoTez/lib_delegate/client_baking_denunciation.ml @@ -333,7 +333,8 @@ let process_new_block (cctxt : #Protocol_client_context.full) state | Ok operations -> if List.length operations > endorsements_index then let endorsements = - Option.get @@ List.nth operations endorsements_index + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations endorsements_index in process_endorsements cctxt state endorsements level else return_unit diff --git a/src/proto_008_PtEdoTez/lib_delegate/client_baking_forge.ml b/src/proto_008_PtEdoTez/lib_delegate/client_baking_forge.ml index b379a6a373b0..d30e8a168e7f 100644 --- a/src/proto_008_PtEdoTez/lib_delegate/client_baking_forge.ml +++ b/src/proto_008_PtEdoTez/lib_delegate/client_baking_forge.ml @@ -402,7 +402,8 @@ let classify_operations (cctxt : #Protocol_client_context.full) ~chain ~block (* Retrieve the optimist maximum paying manager operations *) let manager_operations = t.(managers_index) in let {Environment.Updater.max_size; _} = - Option.get @@ List.nth Main.validation_passes managers_index + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth Main.validation_passes managers_index in sort_manager_operations ~max_size @@ -606,10 +607,21 @@ let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority state.index <- index ; return inc) >>=? fun initial_inc -> - let endorsements = Option.get @@ List.nth operations endorsements_index in - let votes = Option.get @@ List.nth operations votes_index in - let anonymous = Option.get @@ List.nth operations anonymous_index in - let managers = Option.get @@ List.nth operations managers_index in + let endorsements = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations endorsements_index + in + let votes = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth operations votes_index + in + let anonymous = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations anonymous_index + in + let managers = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations managers_index + in let validate_operation inc op = protect (fun () -> add_operation inc op) >>= function @@ -675,15 +687,17 @@ let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority let votes = retain_operations_up_to_quota (List.rev votes) - (Option.get @@ List.nth quota votes_index) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota votes_index) in let anonymous = retain_operations_up_to_quota (List.rev anonymous) - (Option.get @@ List.nth quota anonymous_index) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota anonymous_index) in trim_manager_operations - ~max_size:(Option.get @@ List.nth quota managers_index).max_size + ~max_size: + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota managers_index) + .max_size ~hard_gas_limit_per_block managers >>=? fun (accepted_managers, _overflowing_managers) -> @@ -816,21 +830,27 @@ let forge_block cctxt ?force ?operations ?(best_effort = operations = None) let quota : Environment.Updater.quota list = Main.validation_passes in let endorsements = List.sub - (Option.get @@ List.nth operations endorsements_index) + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations endorsements_index ) endorsers_per_block in let votes = retain_operations_up_to_quota - (Option.get @@ List.nth operations votes_index) - (Option.get @@ List.nth quota votes_index) + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations votes_index ) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota votes_index) in let anonymous = retain_operations_up_to_quota - (Option.get @@ List.nth operations anonymous_index) - (Option.get @@ List.nth quota anonymous_index) + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations anonymous_index ) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota anonymous_index) in (* Size/Gas check already occurred in classify operations *) - let managers = Option.get @@ List.nth operations managers_index in + let managers = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations managers_index + in let operations = [endorsements; votes; anonymous; managers] in ( match context_path with | None -> diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/activation.ml b/src/proto_008_PtEdoTez/lib_protocol/test/activation.ml index 792d4b38efb6..543e6a98fce6 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/activation.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/activation.ml @@ -97,8 +97,8 @@ let secrets () = account = account.pkh; activation_code = Blinded_public_key_hash.activation_code_of_hex secret; amount = - Option.unopt_exn - (Invalid_argument "tez conversion") + WithExceptions.Option.to_exn + ~none:(Invalid_argument "tez conversion") (Tez.of_mutez (Int64.of_string amount)); }) [ ( [ "envelope"; @@ -316,7 +316,7 @@ let single_activation () = activation_init () >>=? fun (blk, _contracts, secrets) -> let ({account; activation_code; amount = expected_amount; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets in (* Contract does not exist *) Assert.balance_is @@ -383,9 +383,11 @@ let activation_and_transfer () = activation_init () >>=? fun (blk, contracts, secrets) -> let ({account; activation_code; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in - let bootstrap_contract = Option.get @@ List.hd contracts in let first_contract = Contract.implicit_contract account in Op.activation (B blk) account activation_code >>=? fun operation -> @@ -413,9 +415,11 @@ let transfer_to_unactivated_then_activate () = activation_init () >>=? fun (blk, contracts, secrets) -> let ({account; activation_code; amount} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in - let bootstrap_contract = Option.get @@ List.hd contracts in let unactivated_commitment_contract = Contract.implicit_contract account in Context.Contract.balance (B blk) bootstrap_contract >>=? fun b_amount -> @@ -455,7 +459,7 @@ let invalid_activation_with_no_commitments () = >>=? fun (blk, _) -> let secrets = secrets () in let ({account; activation_code; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets in Op.activation (B blk) account activation_code >>=? fun operation -> @@ -471,9 +475,11 @@ let invalid_activation_with_no_commitments () = let invalid_activation_wrong_secret () = activation_init () >>=? fun (blk, _, secrets) -> - let ({account; _} as _first_one) = Option.get @@ List.nth secrets 0 in + let ({account; _} as _first_one) = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth secrets 0 + in let ({activation_code; _} as _second_one) = - Option.get @@ List.nth secrets 1 + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth secrets 1 in Op.activation (B blk) account activation_code >>=? fun operation -> @@ -490,7 +496,9 @@ let invalid_activation_wrong_secret () = let invalid_activation_inexistent_pkh () = activation_init () >>=? fun (blk, _, secrets) -> - let ({activation_code; _} as _first_one) = Option.get @@ List.hd secrets in + let ({activation_code; _} as _first_one) = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in let inexistent_pkh = Signature.Public_key_hash.of_b58check_exn "tz1PeQHGKPWSpNoozvxgqLN9TFsj6rDqNV3o" @@ -511,7 +519,7 @@ let invalid_double_activation () = activation_init () >>=? fun (blk, _, secrets) -> let ({account; activation_code; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets in Incremental.begin_construction blk >>=? fun inc -> @@ -533,8 +541,12 @@ let invalid_double_activation () = let invalid_transfer_from_unactivated_account () = activation_init () >>=? fun (blk, contracts, secrets) -> - let ({account; _} as _first_one) = Option.get @@ List.hd secrets in - let bootstrap_contract = Option.get @@ List.hd contracts in + let ({account; _} as _first_one) = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts + in let unactivated_commitment_contract = Contract.implicit_contract account in (* No activation *) Op.transaction diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/baking.ml b/src/proto_008_PtEdoTez/lib_protocol/test/baking.ml index 9b750d2e33fe..2b50eb431215 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/baking.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/baking.ml @@ -256,7 +256,7 @@ let test_voting_power_cache () = >>=? fun (block, _contracts) -> Context.get_bakers (B block) >>=? fun bakers -> - let baker = Option.get @@ List.hd bakers in + let baker = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers in let assert_voting_power n block = get_voting_power block baker >>=? fun voting_power -> diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/combined_operations.ml b/src/proto_008_PtEdoTez/lib_protocol/test/combined_operations.ml index b24c8f033f4e..8f41bc81e735 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/combined_operations.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/combined_operations.ml @@ -43,9 +43,9 @@ let ten_tez = Tez.of_int 10 let multiple_transfers () = Context.init 3 >>=? fun (blk, contracts) -> - let c1 = Option.get @@ List.nth contracts 0 in - let c2 = Option.get @@ List.nth contracts 1 in - let c3 = Option.get @@ List.nth contracts 2 in + let c1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in + let c2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 in + let c3 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 2 in List.map_es (fun _ -> Op.transaction (B blk) c1 c2 Tez.one) (1 -- 10) >>=? fun ops -> Op.combine_operations ~source:c1 (B blk) ops @@ -77,8 +77,8 @@ let multiple_transfers () = let multiple_origination_and_delegation () = Context.init 2 >>=? fun (blk, contracts) -> - let c1 = Option.get @@ List.nth contracts 0 in - let c2 = Option.get @@ List.nth contracts 1 in + let c1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in + let c2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 in let n = 10 in Context.get_constants (B blk) >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} -> @@ -164,8 +164,8 @@ let expect_balance_too_low = function let failing_operation_in_the_middle () = Context.init 2 >>=? fun (blk, contracts) -> - let c1 = Option.get @@ List.nth contracts 0 in - let c2 = Option.get @@ List.nth contracts 1 in + let c1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in + let c2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 in Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one >>=? fun op1 -> Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.max_tez @@ -220,8 +220,8 @@ let failing_operation_in_the_middle () = let failing_operation_in_the_middle_with_fees () = Context.init 2 >>=? fun (blk, contracts) -> - let c1 = Option.get @@ List.nth contracts 0 in - let c2 = Option.get @@ List.nth contracts 1 in + let c1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in + let c2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 in Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one >>=? fun op1 -> Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.max_tez @@ -294,8 +294,8 @@ let expect_wrong_signature list = let wrong_signature_in_the_middle () = Context.init 2 >>=? fun (blk, contracts) -> - let c1 = Option.get @@ List.nth contracts 0 in - let c2 = Option.get @@ List.nth contracts 1 in + let c1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in + let c2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 in Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one >>=? fun op1 -> Op.transaction ~fee:Tez.one (B blk) c2 c1 Tez.one diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/delegation.ml b/src/proto_008_PtEdoTez/lib_protocol/test/delegation.ml index f9ddabc64207..d61f1862103e 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/delegation.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/delegation.ml @@ -53,7 +53,9 @@ let expect_no_change_registered_delegate_pkh pkh = function let bootstrap_manager_is_bootstrap_delegate () = Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = Option.get @@ List.hd bootstrap_contracts in + let bootstrap0 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.delegate (B b) bootstrap0 >>=? fun delegate0 -> Context.Contract.manager (B b) bootstrap0 @@ -63,8 +65,12 @@ let bootstrap_manager_is_bootstrap_delegate () = let bootstrap_delegate_cannot_change ~fee () = Context.init 2 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = Option.get @@ List.nth bootstrap_contracts 0 in - let bootstrap1 = Option.get @@ List.nth bootstrap_contracts 1 in + let bootstrap0 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bootstrap_contracts 0 + in + let bootstrap1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bootstrap_contracts 1 + in Context.Contract.pkh bootstrap0 >>=? fun pkh1 -> Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) @@ -106,7 +112,9 @@ let bootstrap_delegate_cannot_change ~fee () = let bootstrap_delegate_cannot_be_removed ~fee () = Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Incremental.begin_construction b >>=? fun i -> Context.Contract.balance (I i) bootstrap @@ -144,8 +152,12 @@ let bootstrap_delegate_cannot_be_removed ~fee () = let delegate_can_be_changed_from_unregistered_contract ~fee () = Context.init 2 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = Option.get @@ List.hd bootstrap_contracts in - let bootstrap1 = Option.get @@ List.nth bootstrap_contracts 1 in + let bootstrap0 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in + let bootstrap1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bootstrap_contracts 1 + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let unregistered = Contract.implicit_contract unregistered_pkh in @@ -197,7 +209,9 @@ let delegate_can_be_changed_from_unregistered_contract ~fee () = let delegate_can_be_removed_from_unregistered_contract ~fee () = Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let unregistered = Contract.implicit_contract unregistered_pkh in @@ -252,7 +266,9 @@ let bootstrap_manager_already_registered_delegate ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.manager (I i) bootstrap >>=? fun manager -> let pkh = manager.pkh in @@ -289,7 +305,9 @@ let delegate_to_bootstrap_by_origination ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.manager (I i) bootstrap >>=? fun manager -> Context.Contract.balance (I i) bootstrap @@ -486,7 +504,9 @@ let unregistered_delegate_key_init_origination ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in (* origination with delegate argument *) @@ -537,7 +557,9 @@ let unregistered_delegate_key_init_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -587,9 +609,11 @@ let unregistered_delegate_key_switch_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let bootstrap_pkh = - Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit bootstrap |> WithExceptions.Option.get ~loc:__LOC__ in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in @@ -646,7 +670,9 @@ let unregistered_delegate_key_init_origination_credit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -697,7 +723,9 @@ let unregistered_delegate_key_init_delegation_credit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -755,9 +783,11 @@ let unregistered_delegate_key_switch_delegation_credit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let bootstrap_pkh = - Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit bootstrap |> WithExceptions.Option.get ~loc:__LOC__ in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in @@ -823,7 +853,9 @@ let unregistered_delegate_key_init_origination_credit_debit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -881,7 +913,9 @@ let unregistered_delegate_key_init_delegation_credit_debit ~amount ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -944,9 +978,11 @@ let unregistered_delegate_key_switch_delegation_credit_debit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let bootstrap_pkh = - Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit bootstrap |> WithExceptions.Option.get ~loc:__LOC__ in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in @@ -1041,7 +1077,9 @@ let failed_self_delegation_emptied_implicit_contract amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let unregistered_pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -1075,7 +1113,9 @@ let emptying_delegated_implicit_contract_fails amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.manager (I i) bootstrap >>=? fun bootstrap_manager -> let account = Account.new_account () in @@ -1115,7 +1155,9 @@ let valid_delegate_registration_init_delegation_credit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1168,7 +1210,9 @@ let valid_delegate_registration_switch_delegation_credit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1222,7 +1266,9 @@ let valid_delegate_registration_init_delegation_credit_debit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1290,7 +1336,9 @@ let valid_delegate_registration_switch_delegation_credit_debit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1356,7 +1404,9 @@ let double_registration () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract pkh in @@ -1389,7 +1439,9 @@ let double_registration_when_empty () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract pkh in @@ -1429,7 +1481,9 @@ let double_registration_when_recredited () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract pkh in @@ -1476,7 +1530,9 @@ let unregistered_and_unrevealed_self_delegate_key_init_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let {Account.pkh; _} = Account.new_account () in let {Account.pkh = delegate_pkh; _} = Account.new_account () in let contract = Alpha_context.Contract.implicit_contract pkh in @@ -1511,7 +1567,9 @@ let unregistered_and_revealed_self_delegate_key_init_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let {Account.pkh; pk; _} = Account.new_account () in let {Account.pkh = delegate_pkh; _} = Account.new_account () in let contract = Alpha_context.Contract.implicit_contract pkh in @@ -1550,7 +1608,9 @@ let registered_self_delegate_key_init_delegation () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let {Account.pkh; _} = Account.new_account () in let {Account.pkh = delegate_pkh; pk = delegate_pk; _} = Account.new_account () diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/double_baking.ml b/src/proto_008_PtEdoTez/lib_protocol/test/double_baking.ml index e16509921a0e..7c097a91d925 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/double_baking.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/double_baking.ml @@ -34,7 +34,7 @@ open Alpha_context (****************************************************************) let get_first_different_baker baker bakers = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun baker' -> Signature.Public_key_hash.( <> ) baker baker') bakers @@ -42,16 +42,22 @@ let get_first_different_baker baker bakers = let get_first_different_bakers ctxt = Context.get_bakers ctxt >|=? fun bakers -> - let baker_1 = Option.get @@ List.hd bakers in - get_first_different_baker baker_1 (Option.get @@ List.tl bakers) + let baker_1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers in + get_first_different_baker + baker_1 + (WithExceptions.Option.get ~loc:__LOC__ @@ List.tl bakers) |> fun baker_2 -> (baker_1, baker_2) let get_first_different_endorsers ctxt = Context.get_endorsers ctxt >|=? fun endorsers -> - let endorser_1 = (Option.get @@ List.hd endorsers).delegate in + let endorser_1 = + (WithExceptions.Option.get ~loc:__LOC__ @@ List.hd endorsers).delegate + in let endorser_2 = - (Option.get @@ List.hd (Option.get @@ List.tl endorsers)).delegate + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.hd (WithExceptions.Option.get ~loc:__LOC__ @@ List.tl endorsers) ) + .delegate in (endorser_1, endorser_2) @@ -59,8 +65,10 @@ let get_first_different_endorsers ctxt = baker) *) let block_fork ?policy contracts b = let (contract_a, contract_b) = - ( Option.get @@ List.hd contracts, - Option.get @@ List.hd (Option.get @@ List.tl contracts) ) + ( WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts, + WithExceptions.Option.get ~loc:__LOC__ + @@ List.hd (WithExceptions.Option.get ~loc:__LOC__ @@ List.tl contracts) + ) in Op.transaction (B b) contract_a contract_b Alpha_context.Tez.one_cent >>=? fun operation -> @@ -78,7 +86,9 @@ let valid_double_baking_evidence () = >>=? fun (b, contracts) -> Context.get_bakers (B b) >>=? fun bakers -> - let priority_0_baker = Option.get @@ List.hd bakers in + let priority_0_baker = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers + in block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) -> Op.double_baking (B blk_a) blk_a.header blk_b.header diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/double_endorsement.ml b/src/proto_008_PtEdoTez/lib_protocol/test/double_endorsement.ml index 74a41704e664..68344b5c5e18 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/double_endorsement.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/double_endorsement.ml @@ -34,7 +34,7 @@ open Alpha_context (****************************************************************) let get_first_different_baker baker bakers = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun baker' -> Signature.Public_key_hash.( <> ) baker baker') bakers @@ -42,15 +42,22 @@ let get_first_different_baker baker bakers = let get_first_different_bakers ctxt = Context.get_bakers ctxt >|=? fun bakers -> - let baker_1 = Option.get @@ List.hd bakers in - get_first_different_baker baker_1 (Option.get @@ List.tl bakers) + let baker_1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers in + get_first_different_baker + baker_1 + (WithExceptions.Option.get ~loc:__LOC__ @@ List.tl bakers) |> fun baker_2 -> (baker_1, baker_2) let get_first_different_endorsers ctxt = Context.get_endorsers ctxt >|=? fun endorsers -> - let endorser_1 = Option.get @@ List.hd endorsers in - let endorser_2 = Option.get @@ List.hd (Option.get @@ List.tl endorsers) in + let endorser_1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd endorsers + in + let endorser_2 = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.hd (WithExceptions.Option.get ~loc:__LOC__ @@ List.tl endorsers) + in (endorser_1, endorser_2) let block_fork b = @@ -216,8 +223,12 @@ let wrong_delegate () = >>=? fun (b, contracts) -> List.map_es (Context.Contract.manager (B b)) contracts >>=? fun accounts -> - let pkh1 = (Option.get @@ List.nth accounts 0).Account.pkh in - let pkh2 = (Option.get @@ List.nth accounts 1).Account.pkh in + let pkh1 = + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth accounts 0).Account.pkh + in + let pkh2 = + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth accounts 1).Account.pkh + in block_fork b >>=? fun (blk_a, blk_b) -> Context.get_endorser (B blk_a) diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/endorsement.ml b/src/proto_008_PtEdoTez/lib_protocol/test/endorsement.ml index 97f9b35b1240..390237b7ab2b 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/endorsement.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/endorsement.ml @@ -269,8 +269,12 @@ let reward_retrieval_two_endorsers () = _ } -> Context.get_endorsers (B b) >>=? fun endorsers -> - let endorser1 = Option.get @@ List.hd endorsers in - let endorser2 = Option.get @@ List.nth endorsers 1 in + let endorser1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd endorsers + in + let endorser2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth endorsers 1 + in Context.Contract.balance (B b) (Contract.implicit_contract endorser1.delegate) @@ -332,7 +336,10 @@ let reward_retrieval_two_endorsers () = Signature.Public_key_hash.( endorser.Delegate_services.Endorsing_rights.delegate = endorser2.delegate) in - let endorser2 = Option.get @@ List.find same_endorser2 endorsers in + let endorser2 = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.find same_endorser2 endorsers + in (* No exception raised: in sandboxed mode endorsers do not change between blocks *) Tez.( endorsement_security_deposit *? Int64.of_int (List.length endorser2.slots)) @@ -494,14 +501,14 @@ let not_enough_for_deposit () = Context.get_endorser (B b) >>=? fun (endorser, _slots) -> let (_, contract_other_than_endorser) = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun (c, _) -> not (Signature.Public_key_hash.equal c.Account.pkh endorser)) managers in let (_, contract_of_endorser) = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun (c, _) -> Signature.Public_key_hash.equal c.Account.pkh endorser) managers diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/helpers/block.ml b/src/proto_008_PtEdoTez/lib_protocol/test/helpers/block.ml index dc58af43cd1c..e668412cc9b8 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/helpers/block.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/helpers/block.ml @@ -68,13 +68,13 @@ let get_next_baker_by_priority priority block = block >|=? fun bakers -> let {Alpha_services.Delegate.Baking_rights.delegate = pkh; timestamp; _} = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun {Alpha_services.Delegate.Baking_rights.priority = p; _} -> p = priority) bakers in - (pkh, priority, Option.unopt_exn (Failure "") timestamp) + (pkh, priority, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let get_next_baker_by_account pkh block = Alpha_services.Delegate.Baking_rights.get @@ -87,9 +87,9 @@ let get_next_baker_by_account pkh block = timestamp; priority; _ } = - Option.get @@ List.hd bakers + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers in - (pkh, priority, Option.unopt_exn (Failure "") timestamp) + (pkh, priority, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let get_next_baker_excluding excludes block = Alpha_services.Delegate.Baking_rights.get rpc_ctxt ~max_priority:256 block @@ -98,13 +98,13 @@ let get_next_baker_excluding excludes block = timestamp; priority; _ } = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun {Alpha_services.Delegate.Baking_rights.delegate; _} -> not (List.mem delegate excludes)) bakers in - (pkh, priority, Option.unopt_exn (Failure "") timestamp) + (pkh, priority, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let dispatch_policy = function | By_priority p -> diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/helpers/context.ml b/src/proto_008_PtEdoTez/lib_protocol/test/helpers/context.ml index 12264e667a33..2123d81ffc1d 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/helpers/context.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/helpers/context.ml @@ -108,7 +108,7 @@ let get_endorsers ctxt = let get_endorser ctxt = Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt >|=? fun endorsers -> - let endorser = Option.get @@ List.hd endorsers in + let endorser = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd endorsers in (endorser.delegate, endorser.slots) let get_voting_power = Alpha_services.Delegate.voting_power rpc_ctxt diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/helpers/op.ml b/src/proto_008_PtEdoTez/lib_protocol/test/helpers/op.ml index 1d4ec4556f27..5d3fecfd25df 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/helpers/op.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/helpers/op.ml @@ -67,7 +67,7 @@ let combine_operations ?public_key ?counter ?spurious_operation ~source ctxt assert (List.length packed_operations > 0) ; (* Hypothesis : each operation must have the same branch (is this really true?) *) let {Tezos_base.Operation.branch} = - (Option.get @@ List.hd packed_operations).shell + (WithExceptions.Option.get ~loc:__LOC__ @@ List.hd packed_operations).shell in assert ( List.for_all @@ -253,7 +253,9 @@ let origination ?counter ?delegate ~script ?(preorigination = None) ?public_key Context.Contract.manager ctxt source >>=? fun account -> let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in - let default_credit = Option.unopt_exn Impossible default_credit in + let default_credit = + WithExceptions.Option.to_exn ~none:Impossible default_credit + in let credit = Option.value ~default:default_credit credit in let operation = Origination {delegate; script; credit; preorigination} in manager_operation diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/helpers/sapling_helpers.ml b/src/proto_008_PtEdoTez/lib_protocol/test/helpers/sapling_helpers.ml index 18334b69f67d..a8115c1278d2 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/helpers/sapling_helpers.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/helpers/sapling_helpers.ml @@ -238,7 +238,7 @@ module Alpha_context_helpers = struct List.map (fun i -> Tezos_sapling.Forge.Input.get cs (Int64.of_int i) w.vk - |> Option.unopt_assert ~loc:__POS__ + |> WithExceptions.Option.get ~loc:__LOC__ |> snd) is in diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/origination.ml b/src/proto_008_PtEdoTez/lib_protocol/test/origination.ml index efeec384e7e8..2472e0f79a23 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/origination.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/origination.ml @@ -37,7 +37,7 @@ let ten_tez = Tez.of_int 10 let register_origination ?(fee = Tez.zero) ?(credit = Tez.zero) () = Context.init 1 >>=? fun (b, contracts) -> - let source = Option.get @@ List.hd contracts in + let source = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Context.Contract.balance (B b) source >>=? fun source_balance -> Op.origination (B b) source ~fee ~credit ~script:Op.dummy_script @@ -81,7 +81,7 @@ let test_origination_balances ~loc:_ ?(fee = Tez.zero) ?(credit = Tez.zero) () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.hd contracts in + let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Context.Contract.balance (B b) contract >>=? fun balance -> Op.origination (B b) contract ~fee ~credit ~script:Op.dummy_script @@ -163,8 +163,12 @@ let pay_fee () = let not_tez_in_contract_to_pay_fee () = Context.init 2 >>=? fun (b, contracts) -> - let contract_1 = Option.get @@ List.nth contracts 0 in - let contract_2 = Option.get @@ List.nth contracts 1 in + let contract_1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract_2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 + in Incremental.begin_construction b >>=? fun inc -> (* transfer everything but one tez from 1 to 2 and check balance of 1 *) @@ -203,7 +207,7 @@ let not_tez_in_contract_to_pay_fee () = let register_contract_get_endorser () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.hd contracts in + let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Incremental.begin_construction b >>=? fun inc -> Context.get_endorser (I inc) @@ -236,7 +240,7 @@ let multiple_originations () = let counter () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.hd contracts in + let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Incremental.begin_construction b >>=? fun inc -> Op.origination (I inc) ~credit:Tez.one contract ~script:Op.dummy_script diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/reveal.ml b/src/proto_008_PtEdoTez/lib_protocol/test/reveal.ml index 8f3f98cb0651..2082fb989737 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/reveal.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/reveal.ml @@ -33,7 +33,7 @@ let ten_tez = Tez.of_int 10 let simple_reveal () = Context.init 1 >>=? fun (blk, contracts) -> - let c = Option.get @@ List.nth contracts 0 in + let c = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let new_c = Account.new_account () in let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in (* Create the contract *) @@ -57,7 +57,7 @@ let simple_reveal () = let empty_account_on_reveal () = Context.init 1 >>=? fun (blk, contracts) -> - let c = Option.get @@ List.nth contracts 0 in + let c = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let new_c = Account.new_account () in let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in let amount = Tez.one_mutez in @@ -89,7 +89,7 @@ let empty_account_on_reveal () = let not_enough_found_for_reveal () = Context.init 1 >>=? fun (blk, contracts) -> - let c = Option.get @@ List.nth contracts 0 in + let c = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let new_c = Account.new_account () in let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in (* Create the contract *) diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/seed.ml b/src/proto_008_PtEdoTez/lib_protocol/test/seed.ml index 1d18737b577f..0bd37a27d13b 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/seed.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/seed.ml @@ -119,7 +119,7 @@ let revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get committed_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get committed_hash) |> fun operation -> Block.bake ~policy ~operation b >>= fun e -> @@ -139,7 +139,7 @@ let revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get wrong_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get wrong_hash) |> fun operation -> Block.bake ~operation b >>= fun e -> @@ -153,7 +153,7 @@ let revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get committed_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get committed_hash) |> fun operation -> Block.get_next_baker ~policy b >>=? fun (baker_pkh, _, _) -> @@ -194,7 +194,7 @@ let revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get wrong_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get wrong_hash) |> fun operation -> Block.bake ~operation ~policy b >>= fun e -> @@ -273,7 +273,7 @@ let revelation_missing_and_late () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get committed_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get committed_hash) |> fun operation -> Block.bake ~operation b >>= fun e -> diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/test_helpers_rpcs.ml b/src/proto_008_PtEdoTez/lib_protocol/test/test_helpers_rpcs.ml index 096a3400b2f7..4e1a56423c0d 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/test_helpers_rpcs.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/test_helpers_rpcs.ml @@ -44,8 +44,9 @@ let test_baking_rights () = assert (List.length rights = max_priority + 1) ; (* filtering by delegate *) let d = - Contract.is_implicit (Option.get @@ List.nth contracts 0) - |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0) + |> WithExceptions.Option.get ~loc:__LOC__ in get Block.rpc_ctxt b ~all:true ~delegates:[d] >>=? fun rights -> diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/test_sapling.ml b/src/proto_008_PtEdoTez/lib_protocol/test/test_sapling.ml index cbb3569bd3fd..5af867a6a7bf 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/test_sapling.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/test_sapling.ml @@ -222,7 +222,10 @@ module Raw_context_tests = struct >>=? fun result -> let expected_cm = List.map fst expected in assert (result = expected_cm) ; - test_from (Int64.succ from) until (Option.get @@ List.tl expected) + test_from + (Int64.succ from) + until + (WithExceptions.Option.get ~loc:__LOC__ @@ List.tl expected) in test_from 0L 9L list_added @@ -260,7 +263,8 @@ module Raw_context_tests = struct Sapling_storage.Commitments.add ctx id_one_by_one - [Option.get @@ List.nth list_to_add counter] + [ WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth list_to_add counter ] (Int64.of_int counter) >>= wrap (* create a new tree and add a list of cms *) @@ -278,7 +282,7 @@ module Raw_context_tests = struct ctx id_all_at_once (list_init (counter + 1) (fun i -> - Option.get @@ List.nth list_to_add i)) + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth list_to_add i)) 0L >>= wrap >>=? fun (ctx, _size) -> @@ -548,7 +552,7 @@ module Alpha_context_tests = struct (* randomize one output to fail check outputs *) (* don't randomize the ciphertext as it is not part of the proof *) let open Tezos_sapling.Core.Client.UTXO in - let o = Option.get @@ List.hd vt.outputs in + let o = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd vt.outputs in let o_wrong_cm = { o with @@ -677,7 +681,7 @@ module Interpreter_tests = struct let forge_input = snd ( Tezos_sapling.Forge.Input.get state pos wa.vk - |> Option.unopt_assert ~loc:__POS__ ) + |> WithExceptions.Option.get ~loc:__LOC__ ) in forge_input) in @@ -701,7 +705,7 @@ module Interpreter_tests = struct let hex_pkh = to_hex ( Alpha_context.Contract.is_implicit src1 - |> Option.unopt_assert ~loc:__POS__ ) + |> WithExceptions.Option.get ~loc:__LOC__ ) Signature.Public_key_hash.encoding in let string = @@ -729,7 +733,7 @@ module Interpreter_tests = struct let forge_input = snd ( Tezos_sapling.Forge.Input.get state pos wb.vk - |> Option.unopt_assert ~loc:__POS__ ) + |> WithExceptions.Option.get ~loc:__LOC__ ) in forge_input) in @@ -824,7 +828,9 @@ module Interpreter_tests = struct (Format.sprintf "(Pair 0x%s 0)") anti_replay_2 in - let transaction = Option.get @@ List.hd transactions in + let transaction = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd transactions + in let parameters = Alpha_context.Script.(lazy_expr (expression_from_string transaction)) in @@ -881,7 +887,7 @@ module Interpreter_tests = struct (Tezos_sapling.Forge.forge_transaction [ snd ( Tezos_sapling.Forge.Input.get state 0L vk - |> Option.unopt_assert ~loc:__POS__ ) ] + |> WithExceptions.Option.get ~loc:__LOC__ ) ] [output] sk anti_replay @@ -922,7 +928,7 @@ module Interpreter_tests = struct let ctx = Incremental.alpha_ctxt incr in let pkh = Alpha_context.Contract.is_implicit src - |> Option.unopt_assert ~loc:__POS__ + |> WithExceptions.Option.get ~loc:__LOC__ in Alpha_context.Contract.get_counter ctx pkh >>= wrap @@ -1103,7 +1109,7 @@ module Interpreter_tests = struct let local_state_from_disk disk_state ctx = let id = Alpha_context.Sapling.(disk_state.id) - |> Option.unopt_assert ~loc:__POS__ + |> WithExceptions.Option.get ~loc:__LOC__ in Alpha_context.Sapling.get_diff ctx diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/transfer.ml b/src/proto_008_PtEdoTez/lib_protocol/test/transfer.ml index 033b11ff65e8..c2232f16a17c 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/transfer.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/transfer.ml @@ -128,8 +128,12 @@ let ten_tez = Tez.of_int 10 let register_two_contracts () = Context.init 2 >|=? fun (b, contracts) -> - let contract_1 = Option.get @@ List.nth contracts 0 in - let contract_2 = Option.get @@ List.nth contracts 1 in + let contract_1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract_2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 + in (b, contract_1, contract_2) (** compute half of the balance and divided by nth @@ -187,7 +191,7 @@ let transfer_zero_tez () = let transfer_zero_implicit () = Context.init 1 >>=? fun (b, contracts) -> - let dest = Option.get @@ List.nth contracts 0 in + let dest = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let account = Account.new_account () in Incremental.begin_construction b >>=? fun i -> @@ -210,7 +214,9 @@ let transfer_zero_implicit () = let transfer_to_originate_with_fee () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.nth contracts 0 in + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in Incremental.begin_construction b >>=? fun b -> two_nth_of_balance b contract 10L @@ -254,7 +260,9 @@ let transfer_amount_of_contract_balance () = let transfers_to_self () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.nth contracts 0 in + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in Incremental.begin_construction b >>=? fun b -> two_nth_of_balance b contract 3L @@ -303,7 +311,9 @@ let missing_transaction () = let transfer_from_implicit_to_implicit_contract () = Context.init 1 >>=? fun (b, contracts) -> - let bootstrap_contract = Option.get @@ List.nth contracts 0 in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in let account_a = Account.new_account () in let account_b = Account.new_account () in Incremental.begin_construction b @@ -344,8 +354,12 @@ let transfer_from_implicit_to_implicit_contract () = let transfer_from_implicit_to_originated_contract () = Context.init 1 >>=? fun (b, contracts) -> - let bootstrap_contract = Option.get @@ List.nth contracts 0 in - let contract = Option.get @@ List.nth contracts 0 in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in let account = Account.new_account () in let src = Contract.implicit_contract account.Account.pkh in Incremental.begin_construction b @@ -468,7 +482,7 @@ let build_a_chain () = let empty_implicit () = Context.init 1 >>=? fun (b, contracts) -> - let dest = Option.get @@ List.nth contracts 0 in + let dest = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let account = Account.new_account () in Incremental.begin_construction b >>=? fun incr -> @@ -531,9 +545,15 @@ let balance_too_low fee () = let balance_too_low_two_transfers fee () = Context.init 3 >>=? fun (b, contracts) -> - let contract_1 = Option.get @@ List.nth contracts 0 in - let contract_2 = Option.get @@ List.nth contracts 1 in - let contract_3 = Option.get @@ List.nth contracts 2 in + let contract_1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract_2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 + in + let contract_3 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 2 + in Incremental.begin_construction b >>=? fun i -> Context.Contract.balance (I i) contract_1 diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/typechecking.ml b/src/proto_008_PtEdoTez/lib_protocol/test/typechecking.ml index 548d8a5f78eb..113fca0e37a9 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/typechecking.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/typechecking.ml @@ -35,7 +35,7 @@ let test_context () = let test_context_with_nat_nat_big_map () = Context.init 3 >>=? fun (b, contracts) -> - let source = Option.get @@ List.hd contracts in + let source = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Op.origination (B b) source ~script:Op.dummy_script >>=? fun (operation, originated) -> Block.bake ~operation b diff --git a/src/proto_008_PtEdoTez/lib_protocol/test/voting.ml b/src/proto_008_PtEdoTez/lib_protocol/test/voting.ml index f886f128c426..8a4863c0f41d 100644 --- a/src/proto_008_PtEdoTez/lib_protocol/test/voting.ml +++ b/src/proto_008_PtEdoTez/lib_protocol/test/voting.ml @@ -147,19 +147,31 @@ let assert_period ?expected_kind ?expected_index ?expected_position Context.Vote.get_current_period (B b) >>=? fun {voting_period; position; remaining} -> ( if Option.is_some expected_kind then - assert_period_kind (Option.get expected_kind) voting_period.kind loc + assert_period_kind + (WithExceptions.Option.get ~loc:__LOC__ expected_kind) + voting_period.kind + loc else return_unit ) >>=? fun () -> ( if Option.is_some expected_index then - assert_period_index (Option.get expected_index) voting_period.index loc + assert_period_index + (WithExceptions.Option.get ~loc:__LOC__ expected_index) + voting_period.index + loc else return_unit ) >>=? fun () -> ( if Option.is_some expected_position then - assert_period_position (Option.get expected_position) position loc + assert_period_position + (WithExceptions.Option.get ~loc:__LOC__ expected_position) + position + loc else return_unit ) >>=? fun () -> if Option.is_some expected_remaining then - assert_period_remaining (Option.get expected_remaining) remaining loc + assert_period_remaining + (WithExceptions.Option.get ~loc:__LOC__ expected_remaining) + remaining + loc else return_unit let mk_contracts_from_pkh pkh_list = @@ -255,8 +267,12 @@ let test_successful_vote num_delegates () = | Some _ -> failwith "%s - Unexpected proposal" __LOC__) >>=? fun () -> - let del1 = Option.get @@ List.nth delegates_p1 0 in - let del2 = Option.get @@ List.nth delegates_p1 1 in + let del1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates_p1 0 + in + let del2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates_p1 1 + in let props = List.map (fun i -> protos.(i)) (2 -- Constants.max_proposals_per_delegate) in @@ -272,8 +288,8 @@ let test_successful_vote num_delegates () = (* correctly count the double proposal for zero *) (let weight = Int32.add - (Option.get @@ List.nth rolls_p1 0) - (Option.get @@ List.nth rolls_p1 1) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth rolls_p1 0) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth rolls_p1 1) in match Environment.Protocol_hash.(Map.find_opt zero ps) with | Some v -> @@ -546,7 +562,9 @@ let test_not_enough_quorum_in_testing_vote num_delegates () = let open Alpha_context in assert_period ~expected_kind:Proposal b __LOC__ >>=? fun () -> - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [Protocol_hash.zero] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -568,7 +586,9 @@ let test_not_enough_quorum_in_testing_vote num_delegates () = get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 participation_ema |> fun voters -> (* take the first two voters out so there cannot be quorum *) - let voters_without_quorum = Option.get @@ List.tl voters in + let voters_without_quorum = + WithExceptions.Option.get ~loc:__LOC__ @@ List.tl voters + in get_rolls b voters_without_quorum __LOC__ >>=? fun voters_rolls_in_testing_vote -> (* all voters_without_quorum vote, for yays; @@ -608,7 +628,9 @@ let test_not_enough_quorum_in_promotion_vote num_delegates () = >>=? fun (b, delegates) -> assert_period ~expected_kind:Proposal b __LOC__ >>=? fun () -> - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [Protocol_hash.zero] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -661,7 +683,9 @@ let test_not_enough_quorum_in_promotion_vote num_delegates () = get_smallest_prefix_voters_for_quorum delegates_p4 rolls_p4 participation_ema |> fun voters -> (* take the first voter out so there cannot be quorum *) - let voters_without_quorum = Option.get @@ List.tl voters in + let voters_without_quorum = + WithExceptions.Option.get ~loc:__LOC__ @@ List.tl voters + in get_rolls b voters_without_quorum __LOC__ >>=? fun voter_rolls -> (* all voters_without_quorum vote, for yays; @@ -695,7 +719,7 @@ let test_multiple_identical_proposals_count_as_one () = >>=? fun (b, delegates) -> assert_period ~expected_kind:Proposal b __LOC__ >>=? fun () -> - let proposer = Option.get @@ List.hd delegates in + let proposer = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd delegates in Op.proposals (B b) proposer [Protocol_hash.zero; Protocol_hash.zero] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -738,28 +762,32 @@ let test_supermajority_in_proposal there_is_a_winner () = >>=? fun { parametric = {blocks_per_cycle; tokens_per_roll; blocks_per_voting_period; _}; _ } -> - let del1 = Option.get @@ List.nth delegates 0 in - let del2 = Option.get @@ List.nth delegates 1 in - let del3 = Option.get @@ List.nth delegates 2 in + let del1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 in + let del2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 1 in + let del3 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 2 in List.map_es (fun del -> Context.Contract.pkh del) [del1; del2; del3] >>=? fun pkhs -> let policy = Block.Excluding pkhs in Op.transaction (B b) - (Option.get @@ List.nth delegates 3) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 3) del1 tokens_per_roll >>=? fun op1 -> Op.transaction (B b) - (Option.get @@ List.nth delegates 4) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 4) del2 tokens_per_roll >>=? fun op2 -> ( if there_is_a_winner then Test_tez.Tez.( *? ) tokens_per_roll 3L else Test_tez.Tez.( *? ) tokens_per_roll 2L ) >>?= fun bal3 -> - Op.transaction (B b) (Option.get @@ List.nth delegates 5) del3 bal3 + Op.transaction + (B b) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 5) + del3 + bal3 >>=? fun op3 -> Block.bake ~policy ~operations:[op1; op2; op3] b >>=? fun b -> @@ -809,8 +837,8 @@ let test_quorum_in_proposal has_quorum () = blocks_per_voting_period; _ }; _ } -> - let del1 = Option.get @@ List.nth delegates 0 in - let del2 = Option.get @@ List.nth delegates 1 in + let del1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 in + let del2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 1 in List.map_es (fun del -> Context.Contract.pkh del) [del1; del2] >>=? fun pkhs -> let policy = Block.Excluding pkhs in @@ -858,7 +886,7 @@ let test_supermajority_in_testing_vote supermajority () = let min_proposal_quorum = Int32.(of_int @@ (100_00 / 100)) in Context.init ~min_proposal_quorum 100 >>=? fun (b, delegates) -> - let del1 = Option.get @@ List.nth delegates 0 in + let del1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 in let proposal = protos.(0) in Op.proposals (B b) del1 [proposal] >>=? fun ops1 -> @@ -948,7 +976,9 @@ let test_quorum_capped_maximum num_delegates () = >>=? fun () -> (* propose a new protocol *) let protocol = Protocol_hash.zero in - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [protocol] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -996,7 +1026,9 @@ let test_quorum_capped_minimum num_delegates () = >>=? fun () -> (* propose a new protocol *) let protocol = Protocol_hash.zero in - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [protocol] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -1042,9 +1074,9 @@ let test_voting_power_updated_each_voting_period () = ~initial_balances:[80_000_000_000L; 48_000_000_000L; 4_000_000_000_000L] 3 >>=? fun (block, contracts) -> - let con1 = Option.get @@ List.nth contracts 0 in - let con2 = Option.get @@ List.nth contracts 1 in - let con3 = Option.get @@ List.nth contracts 2 in + let con1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in + let con2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 in + let con3 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 2 in (* Retrieve balance of con1 *) Context.Contract.balance (B block) con1 >>=? fun balance1 -> @@ -1065,9 +1097,9 @@ let test_voting_power_updated_each_voting_period () = Context.get_bakers (B block) >>=? fun bakers -> (* [Context.init] and [Context.get_bakers] store the accounts in reversed orders *) - let baker1 = Option.get @@ List.nth bakers 2 in - let baker2 = Option.get @@ List.nth bakers 1 in - let baker3 = Option.get @@ List.nth bakers 0 in + let baker1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bakers 2 in + let baker2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bakers 1 in + let baker3 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bakers 0 in (* Auxiliary assert_voting_power *) let assert_voting_power ~loc n block baker = get_voting_power block baker diff --git a/src/proto_alpha/lib_client/michelson_v1_emacs.ml b/src/proto_alpha/lib_client/michelson_v1_emacs.ml index 07f493fc42a2..3a1612a77f88 100644 --- a/src/proto_alpha/lib_client/michelson_v1_emacs.ml +++ b/src/proto_alpha/lib_client/michelson_v1_emacs.ml @@ -155,10 +155,12 @@ let report_errors ppf (parsed, errs) = (fun ppf errs -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in match errs with | top :: errs -> @@ -196,10 +198,12 @@ let report_errors ppf (parsed, errs) = (Format.pp_print_list (fun ppf err -> let find_location loc = let oloc = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in - fst (Option.get @@ List.assoc oloc parsed.expansion_table) + fst + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.assoc oloc parsed.expansion_table ) in let loc = match err with diff --git a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml index 881bef0a5d95..2aeeb65a6652 100644 --- a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml +++ b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml @@ -99,10 +99,11 @@ let print_entrypoint_type (cctxt : #Client_context.printer) cctxt#message "@[No entrypoint named %s%a%a@]@." entrypoint - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> Format.fprintf ppf " for script %s")) + (Format.pp_print_option (fun ppf -> + Format.fprintf ppf " for script %s")) script_name >>= fun () -> return_unit | Error errs -> @@ -177,10 +178,10 @@ let print_entrypoints_list (cctxt : #Client_context.printer) else cctxt#message "@[Entrypoints%a%a: @,%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " for script %s")) script_name (Format.pp_print_list @@ -221,10 +222,10 @@ let print_unreachables (cctxt : #Client_context.printer) | _ -> cctxt#message "@[Unreachable paths in the argument%a%a: @[%a@]@." - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of contract %a" Contract.pp)) contract - (Option.pp ~default:"" (fun ppf -> + (Format.pp_print_option (fun ppf -> Format.fprintf ppf " of script %s")) script_name (Format.pp_print_list ~pp_sep:Format.pp_print_cut (fun ppf -> diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml index 49bf03fd295c..ad0219971e15 100644 --- a/src/proto_alpha/lib_client/operation_result.ml +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -50,8 +50,8 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Format.fprintf ppf "@,Entrypoint: %s" entrypoint ) ; ( if not (Script_repr.is_unit_parameter parameters) then let expr = - Option.unopt_exn - (Failure "ill-serialized argument") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized argument") (Data_encoding.force_decode parameters) in Format.fprintf @@ -72,12 +72,12 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf Tez.pp credit ; let code = - Option.unopt_exn - (Failure "ill-serialized code") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized code") (Data_encoding.force_decode code) and storage = - Option.unopt_exn - (Failure "ill-serialized storage") + WithExceptions.Option.to_exn + ~none:(Failure "ill-serialized storage") (Data_encoding.force_decode storage) in let {Michelson_v1_parser.source; _} = diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index 47d6f0eb2720..aaa4c356f352 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -216,11 +216,11 @@ let prepare_batch_operation cctxt ?arg ?fee ?gas_limit ?storage_limit >>=? fun amount -> tez_of_opt_string_exn index "fee" batch.fee >>=? fun batch_fee -> - let fee = Option.first_some batch_fee fee in - let arg = Option.first_some batch.arg arg in - let gas_limit = Option.first_some batch.gas_limit gas_limit in - let storage_limit = Option.first_some batch.storage_limit storage_limit in - let entrypoint = Option.first_some batch.entrypoint entrypoint in + let fee = Option.either batch_fee fee in + let arg = Option.either batch.arg arg in + let gas_limit = Option.either batch.gas_limit gas_limit in + let storage_limit = Option.either batch.storage_limit storage_limit in + let entrypoint = Option.either batch.entrypoint entrypoint in parse_arg_transfer arg >>=? fun parameters -> ( match Contract.is_implicit source with diff --git a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml index 25cadba3c89f..ca3b8647d059 100644 --- a/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml +++ b/src/proto_alpha/lib_client_sapling/client_sapling_commands.ml @@ -49,7 +49,9 @@ let keys_of_implicit_account cctxt source = let viewing_key_of_string s = let exception Unknown_sapling_address in let encoding = Viewing_key.address_b58check_encoding in - Option.unopt_exn Unknown_sapling_address (Base58.simple_decode encoding s) + WithExceptions.Option.to_exn + ~none:Unknown_sapling_address + (Base58.simple_decode encoding s) (** All signatures are done with an anti-replay string. In Tezos' protocol this string is set to be chain_id + KT1. **) @@ -713,7 +715,9 @@ let commands () = path >>= fun () -> (* TODO must pass contract address for now *) - let (_, contract) = Option.unopt_assert ~loc:__POS__ contract_opt in + let (_, contract) = + WithExceptions.Option.get ~loc:__LOC__ contract_opt + in Context.Client_state.register cctxt ~default_memo_size diff --git a/src/proto_alpha/lib_client_sapling/context.ml b/src/proto_alpha/lib_client_sapling/context.ml index 700e2c3343a6..57ad2f178395 100644 --- a/src/proto_alpha/lib_client_sapling/context.ml +++ b/src/proto_alpha/lib_client_sapling/context.ml @@ -54,7 +54,7 @@ end = struct let of_tez t = let i = Tez.to_mutez t in assert (UTXO.valid_amount i) ; - Option.unopt_assert ~loc:__POS__ @@ of_mutez i + WithExceptions.Option.get ~loc:__LOC__ @@ of_mutez i end module Shielded_tez_contract_input = struct @@ -200,7 +200,7 @@ module Account = struct let add_unspent c input = let amount = - Option.unopt_assert ~loc:__POS__ + WithExceptions.Option.get ~loc:__LOC__ @@ Shielded_tez.of_mutez (F.Input.amount input) in match Shielded_tez.(c.balance +? amount) with @@ -212,7 +212,7 @@ module Account = struct let remove_unspent c input = let amount = - Option.unopt_assert ~loc:__POS__ + WithExceptions.Option.get ~loc:__LOC__ @@ Shielded_tez.of_mutez (F.Input.amount input) in match Shielded_tez.(c.balance -? amount) with @@ -232,11 +232,11 @@ module Account = struct account let pick_input c = - Option.( - Input_set.choose c.unspents - >>| fun unspent -> - let c = remove_unspent c unspent in - (unspent, c)) + let ( >?| ) x f = Option.map f x in + Input_set.choose c.unspents + >?| fun unspent -> + let c = remove_unspent c unspent in + (unspent, c) let pp_unspent : Format.formatter -> t -> unit = fun ppf a -> @@ -296,7 +296,7 @@ module Contract_state = struct let add_unspent vk input accounts = let account = - Accounts.find vk accounts |> Option.unopt_assert ~loc:__POS__ + Accounts.find vk accounts |> WithExceptions.Option.get ~loc:__LOC__ in let account = Account.add_unspent account input in Accounts.replace account accounts @@ -501,7 +501,7 @@ let get_shielded_amount amount account = loop rest_to_pay (next_in :: chosen_inputs) account else let change = - Option.unopt_assert ~loc:__POS__ + WithExceptions.Option.get ~loc:__LOC__ @@ Shielded_tez.of_mutez @@ Int64.abs to_pay in (chosen_inputs, change) @@ -517,7 +517,8 @@ let create_payback ~memo_size address amount = let unshield ~src ~dst ~backdst amount (state : Contract_state.t) anti_replay = let vk = Viewing_key.of_sk src in let account = - Contract_state.find_account vk state |> Option.unopt_assert ~loc:__POS__ + Contract_state.find_account vk state + |> WithExceptions.Option.get ~loc:__LOC__ in get_shielded_amount amount account >|? fun (inputs, change) -> @@ -554,7 +555,8 @@ let transfer cctxt ~src ~dst ~backdst ?message amount (state : Contract_state.t) anti_replay = let vk = Viewing_key.of_sk src in let account = - Contract_state.find_account vk state |> Option.unopt_assert ~loc:__POS__ + Contract_state.find_account vk state + |> WithExceptions.Option.get ~loc:__LOC__ in let memo_size = Storage.get_memo_size state.storage in adjust_message_length cctxt ?message memo_size diff --git a/src/proto_alpha/lib_delegate/client_baking_forge.ml b/src/proto_alpha/lib_delegate/client_baking_forge.ml index c18b7a717418..b2588ead8210 100644 --- a/src/proto_alpha/lib_delegate/client_baking_forge.ml +++ b/src/proto_alpha/lib_delegate/client_baking_forge.ml @@ -402,7 +402,8 @@ let classify_operations (cctxt : #Protocol_client_context.full) ~chain ~block (* Retrieve the optimist maximum paying manager operations *) let manager_operations = t.(managers_index) in let {Environment.Updater.max_size; _} = - Option.get @@ List.nth Main.validation_passes managers_index + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth Main.validation_passes managers_index in sort_manager_operations ~max_size @@ -606,10 +607,21 @@ let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority state.index <- index ; return inc) >>=? fun initial_inc -> - let endorsements = Option.get @@ List.nth operations endorsements_index in - let votes = Option.get @@ List.nth operations votes_index in - let anonymous = Option.get @@ List.nth operations anonymous_index in - let managers = Option.get @@ List.nth operations managers_index in + let endorsements = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations endorsements_index + in + let votes = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth operations votes_index + in + let anonymous = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations anonymous_index + in + let managers = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations managers_index + in let validate_operation inc op = protect (fun () -> add_operation inc op) >>= function @@ -679,15 +691,17 @@ let filter_and_apply_operations cctxt state ~chain ~block block_info ~priority let votes = retain_operations_up_to_quota (List.rev votes) - (Option.get @@ List.nth quota votes_index) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota votes_index) in let anonymous = retain_operations_up_to_quota (List.rev anonymous) - (Option.get @@ List.nth quota anonymous_index) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota anonymous_index) in trim_manager_operations - ~max_size:(Option.get @@ List.nth quota managers_index).max_size + ~max_size: + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota managers_index) + .max_size ~hard_gas_limit_per_block managers >>=? fun (accepted_managers, _overflowing_managers) -> @@ -820,21 +834,27 @@ let forge_block cctxt ?force ?operations ?(best_effort = operations = None) let quota : Environment.Updater.quota list = Main.validation_passes in let endorsements = List.sub - (Option.get @@ List.nth operations endorsements_index) + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations endorsements_index ) endorsers_per_block in let votes = retain_operations_up_to_quota - (Option.get @@ List.nth operations votes_index) - (Option.get @@ List.nth quota votes_index) + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations votes_index ) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota votes_index) in let anonymous = retain_operations_up_to_quota - (Option.get @@ List.nth operations anonymous_index) - (Option.get @@ List.nth quota anonymous_index) + ( WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations anonymous_index ) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth quota anonymous_index) in (* Size/Gas check already occurred in classify operations *) - let managers = Option.get @@ List.nth operations managers_index in + let managers = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth operations managers_index + in let operations = [endorsements; votes; anonymous; managers] in ( match context_path with | None -> diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index 9ec37e332bb2..192b70e27b00 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -68,13 +68,13 @@ let get_next_baker_by_priority priority block = block >|=? fun bakers -> let {Alpha_services.Delegate.Baking_rights.delegate = pkh; timestamp; _} = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun {Alpha_services.Delegate.Baking_rights.priority = p; _} -> p = priority) bakers in - (pkh, priority, Option.unopt_exn (Failure "") timestamp) + (pkh, priority, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let get_next_baker_by_account pkh block = Alpha_services.Delegate.Baking_rights.get @@ -87,9 +87,9 @@ let get_next_baker_by_account pkh block = timestamp; priority; _ } = - Option.get @@ List.hd bakers + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers in - (pkh, priority, Option.unopt_exn (Failure "") timestamp) + (pkh, priority, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let get_next_baker_excluding excludes block = Alpha_services.Delegate.Baking_rights.get rpc_ctxt ~max_priority:256 block @@ -98,13 +98,13 @@ let get_next_baker_excluding excludes block = timestamp; priority; _ } = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun {Alpha_services.Delegate.Baking_rights.delegate; _} -> not (List.mem delegate excludes)) bakers in - (pkh, priority, Option.unopt_exn (Failure "") timestamp) + (pkh, priority, WithExceptions.Option.to_exn ~none:(Failure "") timestamp) let dispatch_policy = function | By_priority p -> diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.ml b/src/proto_alpha/lib_protocol/test/helpers/context.ml index 48da25bc6e9c..c25b12862c0a 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/context.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/context.ml @@ -108,7 +108,7 @@ let get_endorsers ctxt = let get_endorser ctxt = Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt >|=? fun endorsers -> - let endorser = Option.get @@ List.hd endorsers in + let endorser = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd endorsers in (endorser.delegate, endorser.slots) let get_voting_power = Alpha_services.Delegate.voting_power rpc_ctxt diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml index c7fbcbe21fec..f513cf947f68 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/op.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml @@ -67,7 +67,7 @@ let combine_operations ?public_key ?counter ?spurious_operation ~source ctxt assert (List.length packed_operations > 0) ; (* Hypothesis : each operation must have the same branch (is this really true?) *) let {Tezos_base.Operation.branch} = - (Option.get @@ List.hd packed_operations).shell + (WithExceptions.Option.get ~loc:__LOC__ @@ List.hd packed_operations).shell in assert ( List.for_all @@ -253,7 +253,9 @@ let origination ?counter ?delegate ~script ?(preorigination = None) ?public_key Context.Contract.manager ctxt source >>=? fun account -> let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in - let default_credit = Option.unopt_exn Impossible default_credit in + let default_credit = + WithExceptions.Option.to_exn ~none:Impossible default_credit + in let credit = Option.value ~default:default_credit credit in let operation = Origination {delegate; script; credit; preorigination} in manager_operation diff --git a/src/proto_alpha/lib_protocol/test/helpers/sapling_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/sapling_helpers.ml index d67e449bc976..8ba23bb86162 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/sapling_helpers.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/sapling_helpers.ml @@ -239,7 +239,7 @@ module Alpha_context_helpers = struct List.map (fun i -> Tezos_sapling.Forge.Input.get cs (Int64.of_int i) w.vk - |> Option.unopt_assert ~loc:__POS__ + |> WithExceptions.Option.get ~loc:__LOC__ |> snd) is in diff --git a/src/proto_alpha/lib_protocol/test/test_activation.ml b/src/proto_alpha/lib_protocol/test/test_activation.ml index 8c73151e9a8a..f060c7b7414c 100644 --- a/src/proto_alpha/lib_protocol/test/test_activation.ml +++ b/src/proto_alpha/lib_protocol/test/test_activation.ml @@ -102,8 +102,8 @@ let secrets () = account = account.pkh; activation_code = Blinded_public_key_hash.activation_code_of_hex secret; amount = - Option.unopt_exn - (Invalid_argument "tez conversion") + WithExceptions.Option.to_exn + ~none:(Invalid_argument "tez conversion") (Tez.of_mutez (Int64.of_string amount)); }) [ ( [ "envelope"; @@ -325,7 +325,7 @@ let test_single_activation () = activation_init () >>=? fun (blk, _contracts, secrets) -> let ({account; activation_code; amount = expected_amount; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets in (* Contract does not exist *) Assert.balance_is @@ -392,9 +392,11 @@ let test_activation_and_transfer () = activation_init () >>=? fun (blk, contracts, secrets) -> let ({account; activation_code; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in - let bootstrap_contract = Option.get @@ List.hd contracts in let first_contract = Contract.implicit_contract account in Op.activation (B blk) account activation_code >>=? fun operation -> @@ -422,9 +424,11 @@ let test_transfer_to_unactivated_then_activate () = activation_init () >>=? fun (blk, contracts, secrets) -> let ({account; activation_code; amount} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in - let bootstrap_contract = Option.get @@ List.hd contracts in let unactivated_commitment_contract = Contract.implicit_contract account in Context.Contract.balance (B blk) bootstrap_contract >>=? fun b_amount -> @@ -464,7 +468,7 @@ let test_invalid_activation_with_no_commitments () = >>=? fun (blk, _) -> let secrets = secrets () in let ({account; activation_code; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets in Op.activation (B blk) account activation_code >>=? fun operation -> @@ -480,9 +484,11 @@ let test_invalid_activation_with_no_commitments () = let test_invalid_activation_wrong_secret () = activation_init () >>=? fun (blk, _, secrets) -> - let ({account; _} as _first_one) = Option.get @@ List.nth secrets 0 in + let ({account; _} as _first_one) = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth secrets 0 + in let ({activation_code; _} as _second_one) = - Option.get @@ List.nth secrets 1 + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth secrets 1 in Op.activation (B blk) account activation_code >>=? fun operation -> @@ -499,7 +505,9 @@ let test_invalid_activation_wrong_secret () = let test_invalid_activation_inexistent_pkh () = activation_init () >>=? fun (blk, _, secrets) -> - let ({activation_code; _} as _first_one) = Option.get @@ List.hd secrets in + let ({activation_code; _} as _first_one) = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in let inexistent_pkh = Signature.Public_key_hash.of_b58check_exn "tz1PeQHGKPWSpNoozvxgqLN9TFsj6rDqNV3o" @@ -520,7 +528,7 @@ let test_invalid_double_activation () = activation_init () >>=? fun (blk, _, secrets) -> let ({account; activation_code; _} as _first_one) = - Option.get @@ List.hd secrets + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets in Incremental.begin_construction blk >>=? fun inc -> @@ -542,8 +550,12 @@ let test_invalid_double_activation () = let test_invalid_transfer_from_unactivated_account () = activation_init () >>=? fun (blk, contracts, secrets) -> - let ({account; _} as _first_one) = Option.get @@ List.hd secrets in - let bootstrap_contract = Option.get @@ List.hd contracts in + let ({account; _} as _first_one) = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd secrets + in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts + in let unactivated_commitment_contract = Contract.implicit_contract account in (* No activation *) Op.transaction diff --git a/src/proto_alpha/lib_protocol/test/test_baking.ml b/src/proto_alpha/lib_protocol/test/test_baking.ml index a3b9173285c0..5f6f7f7fff6f 100644 --- a/src/proto_alpha/lib_protocol/test/test_baking.ml +++ b/src/proto_alpha/lib_protocol/test/test_baking.ml @@ -269,7 +269,7 @@ let test_voting_power_cache () = >>=? fun (block, _contracts) -> Context.get_bakers (B block) >>=? fun bakers -> - let baker = Option.get @@ List.hd bakers in + let baker = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers in let assert_voting_power n block = let ctxt = Context.B block in Context.get_voting_power ctxt baker diff --git a/src/proto_alpha/lib_protocol/test/test_delegation.ml b/src/proto_alpha/lib_protocol/test/test_delegation.ml index 34a349036a5e..be573a2e7842 100644 --- a/src/proto_alpha/lib_protocol/test/test_delegation.ml +++ b/src/proto_alpha/lib_protocol/test/test_delegation.ml @@ -66,7 +66,9 @@ let expect_no_change_registered_delegate_pkh pkh = function let bootstrap_manager_is_bootstrap_delegate () = Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = Option.get @@ List.hd bootstrap_contracts in + let bootstrap0 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.delegate (B b) bootstrap0 >>=? fun delegate0 -> Context.Contract.manager (B b) bootstrap0 @@ -76,8 +78,12 @@ let bootstrap_manager_is_bootstrap_delegate () = let bootstrap_delegate_cannot_change ~fee () = Context.init 2 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = Option.get @@ List.nth bootstrap_contracts 0 in - let bootstrap1 = Option.get @@ List.nth bootstrap_contracts 1 in + let bootstrap0 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bootstrap_contracts 0 + in + let bootstrap1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bootstrap_contracts 1 + in Context.Contract.pkh bootstrap0 >>=? fun pkh1 -> Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) @@ -119,7 +125,9 @@ let bootstrap_delegate_cannot_change ~fee () = let bootstrap_delegate_cannot_be_removed ~fee () = Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Incremental.begin_construction b >>=? fun i -> Context.Contract.balance (I i) bootstrap @@ -158,8 +166,12 @@ let bootstrap_delegate_cannot_be_removed ~fee () = let delegate_can_be_changed_from_unregistered_contract ~fee () = Context.init 2 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = Option.get @@ List.hd bootstrap_contracts in - let bootstrap1 = Option.get @@ List.nth bootstrap_contracts 1 in + let bootstrap0 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in + let bootstrap1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bootstrap_contracts 1 + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let unregistered = Contract.implicit_contract unregistered_pkh in @@ -212,7 +224,9 @@ let delegate_can_be_changed_from_unregistered_contract ~fee () = let delegate_can_be_removed_from_unregistered_contract ~fee () = Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let unregistered = Contract.implicit_contract unregistered_pkh in @@ -267,7 +281,9 @@ let bootstrap_manager_already_registered_delegate ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.manager (I i) bootstrap >>=? fun manager -> let pkh = manager.pkh in @@ -304,7 +320,9 @@ let delegate_to_bootstrap_by_origination ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.manager (I i) bootstrap >>=? fun manager -> Context.Contract.balance (I i) bootstrap @@ -504,7 +522,9 @@ let test_unregistered_delegate_key_init_origination ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in (* origination with delegate argument *) @@ -559,7 +579,9 @@ let test_unregistered_delegate_key_init_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -613,9 +635,11 @@ let test_unregistered_delegate_key_switch_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let bootstrap_pkh = - Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit bootstrap |> WithExceptions.Option.get ~loc:__LOC__ in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in @@ -673,7 +697,9 @@ let test_unregistered_delegate_key_init_origination_credit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -726,7 +752,9 @@ let test_unregistered_delegate_key_init_delegation_credit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -786,9 +814,11 @@ let test_unregistered_delegate_key_switch_delegation_credit ~fee ~amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let bootstrap_pkh = - Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit bootstrap |> WithExceptions.Option.get ~loc:__LOC__ in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in @@ -856,7 +886,9 @@ let test_unregistered_delegate_key_init_origination_credit_debit ~fee ~amount >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -917,7 +949,9 @@ let test_unregistered_delegate_key_init_delegation_credit_debit ~amount ~fee () >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -983,9 +1017,11 @@ let test_unregistered_delegate_key_switch_delegation_credit_debit ~fee ~amount >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let bootstrap_pkh = - Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ + Contract.is_implicit bootstrap |> WithExceptions.Option.get ~loc:__LOC__ in let unregistered_account = Account.new_account () in let unregistered_pkh = Account.(unregistered_account.pkh) in @@ -1085,7 +1121,9 @@ let test_failed_self_delegation_emptied_implicit_contract amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let unregistered_pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract unregistered_pkh in @@ -1122,7 +1160,9 @@ let test_emptying_delegated_implicit_contract_fails amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in Context.Contract.manager (I i) bootstrap >>=? fun bootstrap_manager -> let account = Account.new_account () in @@ -1166,7 +1206,9 @@ let test_valid_delegate_registration_init_delegation_credit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1223,7 +1265,9 @@ let test_valid_delegate_registration_switch_delegation_credit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1278,7 +1322,9 @@ let test_valid_delegate_registration_init_delegation_credit_debit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1351,7 +1397,9 @@ let test_valid_delegate_registration_switch_delegation_credit_debit amount () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let delegate_account = Account.new_account () in let delegate_pkh = Account.(delegate_account.pkh) in let impl_contract = Contract.implicit_contract delegate_pkh in @@ -1419,7 +1467,9 @@ let test_double_registration () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract pkh in @@ -1453,7 +1503,9 @@ let test_double_registration_when_empty () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract pkh in @@ -1494,7 +1546,9 @@ let test_double_registration_when_recredited () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let account = Account.new_account () in let pkh = Account.(account.pkh) in let impl_contract = Contract.implicit_contract pkh in @@ -1542,7 +1596,9 @@ let test_unregistered_and_unrevealed_self_delegate_key_init_delegation ~fee () >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let {Account.pkh; _} = Account.new_account () in let {Account.pkh = delegate_pkh; _} = Account.new_account () in let contract = Alpha_context.Contract.implicit_contract pkh in @@ -1577,7 +1633,9 @@ let test_unregistered_and_revealed_self_delegate_key_init_delegation ~fee () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let {Account.pkh; pk; _} = Account.new_account () in let {Account.pkh = delegate_pkh; _} = Account.new_account () in let contract = Alpha_context.Contract.implicit_contract pkh in @@ -1616,7 +1674,9 @@ let test_registered_self_delegate_key_init_delegation () = >>=? fun (b, bootstrap_contracts) -> Incremental.begin_construction b >>=? fun i -> - let bootstrap = Option.get @@ List.hd bootstrap_contracts in + let bootstrap = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bootstrap_contracts + in let {Account.pkh; _} = Account.new_account () in let {Account.pkh = delegate_pkh; pk = delegate_pk; _} = Account.new_account () diff --git a/src/proto_alpha/lib_protocol/test/test_double_baking.ml b/src/proto_alpha/lib_protocol/test/test_double_baking.ml index ec7b4ad6ab09..e74f760f12da 100644 --- a/src/proto_alpha/lib_protocol/test/test_double_baking.ml +++ b/src/proto_alpha/lib_protocol/test/test_double_baking.ml @@ -41,7 +41,7 @@ open Alpha_context let get_hd_hd = function x :: y :: _ -> (x, y) | _ -> assert false let get_first_different_baker baker bakers = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun baker' -> Signature.Public_key_hash.( <> ) baker baker') bakers @@ -77,7 +77,9 @@ let test_valid_double_baking_evidence () = >>=? fun (b, contracts) -> Context.get_bakers (B b) >>=? fun bakers -> - let priority_0_baker = Option.get @@ List.hd bakers in + let priority_0_baker = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd bakers + in block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) -> Op.double_baking (B blk_a) blk_a.header blk_b.header diff --git a/src/proto_alpha/lib_protocol/test/test_double_endorsement.ml b/src/proto_alpha/lib_protocol/test/test_double_endorsement.ml index a009f9522a66..30408884d523 100644 --- a/src/proto_alpha/lib_protocol/test/test_double_endorsement.ml +++ b/src/proto_alpha/lib_protocol/test/test_double_endorsement.ml @@ -41,7 +41,7 @@ open Alpha_context let get_hd_hd = function x :: y :: _ -> (x, y) | _ -> assert false let get_first_different_baker baker bakers = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun baker' -> Signature.Public_key_hash.( <> ) baker baker') bakers diff --git a/src/proto_alpha/lib_protocol/test/test_endorsement.ml b/src/proto_alpha/lib_protocol/test/test_endorsement.ml index 54546503e2ab..59720e8bd191 100644 --- a/src/proto_alpha/lib_protocol/test/test_endorsement.ml +++ b/src/proto_alpha/lib_protocol/test/test_endorsement.ml @@ -340,7 +340,10 @@ let test_reward_retrieval_two_endorsers () = Signature.Public_key_hash.( endorser.Delegate_services.Endorsing_rights.delegate = endorser2.delegate) in - let endorser2 = Option.get @@ List.find same_endorser2 endorsers in + let endorser2 = + WithExceptions.Option.get ~loc:__LOC__ + @@ List.find same_endorser2 endorsers + in (* No exception raised: in sandboxed mode endorsers do not change between blocks *) Tez.( endorsement_security_deposit *? Int64.of_int (List.length endorser2.slots)) @@ -503,14 +506,14 @@ let test_not_enough_for_deposit () = Context.get_endorser (B b) >>=? fun (endorser, _slots) -> let (_, contract_other_than_endorser) = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun (c, _) -> not (Signature.Public_key_hash.equal c.Account.pkh endorser)) managers in let (_, contract_of_endorser) = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun (c, _) -> Signature.Public_key_hash.equal c.Account.pkh endorser) managers diff --git a/src/proto_alpha/lib_protocol/test/test_helpers_rpcs.ml b/src/proto_alpha/lib_protocol/test/test_helpers_rpcs.ml index bcb017481254..44b695c7e9c5 100644 --- a/src/proto_alpha/lib_protocol/test/test_helpers_rpcs.ml +++ b/src/proto_alpha/lib_protocol/test/test_helpers_rpcs.ml @@ -52,7 +52,7 @@ let test_baking_rights () = (* filtering by delegate *) let d = Option.bind (List.nth contracts 0) Contract.is_implicit - |> Option.unopt_assert ~loc:__POS__ + |> WithExceptions.Option.get ~loc:__LOC__ in get Block.rpc_ctxt b ~all:true ~delegates:[d] >>=? fun rights -> diff --git a/src/proto_alpha/lib_protocol/test/test_origination.ml b/src/proto_alpha/lib_protocol/test/test_origination.ml index c782e4b9801f..34201734a20d 100644 --- a/src/proto_alpha/lib_protocol/test/test_origination.ml +++ b/src/proto_alpha/lib_protocol/test/test_origination.ml @@ -44,7 +44,7 @@ let ten_tez = Tez.of_int 10 let register_origination ?(fee = Tez.zero) ?(credit = Tez.zero) () = Context.init 1 >>=? fun (b, contracts) -> - let source = Option.get @@ List.hd contracts in + let source = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Context.Contract.balance (B b) source >>=? fun source_balance -> Op.origination (B b) source ~fee ~credit ~script:Op.dummy_script @@ -88,7 +88,7 @@ let test_origination_balances ~loc:_ ?(fee = Tez.zero) ?(credit = Tez.zero) () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.hd contracts in + let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Context.Contract.balance (B b) contract >>=? fun balance -> Op.origination (B b) contract ~fee ~credit ~script:Op.dummy_script @@ -160,8 +160,12 @@ let test_pay_fee () = let test_not_tez_in_contract_to_pay_fee () = Context.init 2 >>=? fun (b, contracts) -> - let contract_1 = Option.get @@ List.nth contracts 0 in - let contract_2 = Option.get @@ List.nth contracts 1 in + let contract_1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract_2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 + in Incremental.begin_construction b >>=? fun inc -> (* transfer everything but one tez from 1 to 2 and check balance of 1 *) @@ -197,7 +201,7 @@ let test_not_tez_in_contract_to_pay_fee () = let register_contract_get_endorser () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.hd contracts in + let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Incremental.begin_construction b >>=? fun inc -> Context.get_endorser (I inc) @@ -222,7 +226,7 @@ let test_multiple_originations () = let test_counter () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.hd contracts in + let contract = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Incremental.begin_construction b >>=? fun inc -> Op.origination (I inc) ~credit:Tez.one contract ~script:Op.dummy_script diff --git a/src/proto_alpha/lib_protocol/test/test_reveal.ml b/src/proto_alpha/lib_protocol/test/test_reveal.ml index 9579c9ad00da..1f0edba9a031 100644 --- a/src/proto_alpha/lib_protocol/test/test_reveal.ml +++ b/src/proto_alpha/lib_protocol/test/test_reveal.ml @@ -40,7 +40,7 @@ let ten_tez = Tez.of_int 10 let test_simple_reveal () = Context.init 1 >>=? fun (blk, contracts) -> - let c = Option.get @@ List.hd contracts in + let c = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in let new_c = Account.new_account () in let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in (* Create the contract *) @@ -64,7 +64,7 @@ let test_simple_reveal () = let test_empty_account_on_reveal () = Context.init 1 >>=? fun (blk, contracts) -> - let c = Option.get @@ List.hd contracts in + let c = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in let new_c = Account.new_account () in let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in let amount = Tez.one_mutez in @@ -96,7 +96,7 @@ let test_empty_account_on_reveal () = let test_not_enough_found_for_reveal () = Context.init 1 >>=? fun (blk, contracts) -> - let c = Option.get @@ List.hd contracts in + let c = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in let new_c = Account.new_account () in let new_contract = Alpha_context.Contract.implicit_contract new_c.pkh in (* Create the contract *) diff --git a/src/proto_alpha/lib_protocol/test/test_sapling.ml b/src/proto_alpha/lib_protocol/test/test_sapling.ml index 727c532737e6..c458dc71005d 100644 --- a/src/proto_alpha/lib_protocol/test/test_sapling.ml +++ b/src/proto_alpha/lib_protocol/test/test_sapling.ml @@ -245,7 +245,10 @@ module Raw_context_tests = struct >>=? fun result -> let expected_cm = List.map fst expected in assert (result = expected_cm) ; - test_from (Int64.succ from) until (Option.get @@ List.tl expected) + test_from + (Int64.succ from) + until + (WithExceptions.Option.get ~loc:__LOC__ @@ List.tl expected) in test_from 0L 9L list_added @@ -286,7 +289,8 @@ module Raw_context_tests = struct Sapling_storage.Commitments.add ctx id_one_by_one - [Option.get @@ List.nth list_to_add counter] + [ WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth list_to_add counter ] (Int64.of_int counter) >>= wrap (* create a new tree and add a list of cms *) @@ -304,7 +308,8 @@ module Raw_context_tests = struct ctx id_all_at_once ( List.init ~when_negative_length:() (counter + 1) (fun i -> - Option.get @@ List.nth list_to_add i) + WithExceptions.Option.get ~loc:__LOC__ + @@ List.nth list_to_add i) |> function Error () -> assert false (* counter >= 0*) | Ok r -> r ) 0L >>= wrap @@ -585,7 +590,7 @@ module Alpha_context_tests = struct (* randomize one output to fail check outputs *) (* don't randomize the ciphertext as it is not part of the proof *) let open Tezos_sapling.Core.Client.UTXO in - let o = Option.get @@ List.hd vt.outputs in + let o = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd vt.outputs in let o_wrong_cm = { o with @@ -714,7 +719,7 @@ module Interpreter_tests = struct let forge_input = snd ( Tezos_sapling.Forge.Input.get state pos wa.vk - |> Option.unopt_assert ~loc:__POS__ ) + |> WithExceptions.Option.get ~loc:__LOC__ ) in forge_input) |> function @@ -743,7 +748,7 @@ module Interpreter_tests = struct let hex_pkh = to_hex ( Alpha_context.Contract.is_implicit src1 - |> Option.unopt_assert ~loc:__POS__ ) + |> WithExceptions.Option.get ~loc:__LOC__ ) Signature.Public_key_hash.encoding in let string = @@ -771,7 +776,7 @@ module Interpreter_tests = struct let forge_input = snd ( Tezos_sapling.Forge.Input.get state pos wb.vk - |> Option.unopt_assert ~loc:__POS__ ) + |> WithExceptions.Option.get ~loc:__LOC__ ) in forge_input) |> function @@ -871,7 +876,9 @@ module Interpreter_tests = struct (Format.sprintf "(Pair 0x%s 0)") anti_replay_2 in - let transaction = Option.get @@ List.hd transactions in + let transaction = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd transactions + in let parameters = Alpha_context.Script.(lazy_expr (expression_from_string transaction)) in @@ -928,7 +935,7 @@ module Interpreter_tests = struct (Tezos_sapling.Forge.forge_transaction [ snd ( Tezos_sapling.Forge.Input.get state 0L vk - |> Option.unopt_assert ~loc:__POS__ ) ] + |> WithExceptions.Option.get ~loc:__LOC__ ) ] [output] sk anti_replay @@ -969,7 +976,7 @@ module Interpreter_tests = struct let ctx = Incremental.alpha_ctxt incr in let pkh = Alpha_context.Contract.is_implicit src - |> Option.unopt_assert ~loc:__POS__ + |> WithExceptions.Option.get ~loc:__LOC__ in Alpha_context.Contract.get_counter ctx pkh >>= wrap @@ -1150,7 +1157,7 @@ module Interpreter_tests = struct let local_state_from_disk disk_state ctx = let id = Alpha_context.Sapling.(disk_state.id) - |> Option.unopt_assert ~loc:__POS__ + |> WithExceptions.Option.get ~loc:__LOC__ in Alpha_context.Sapling.get_diff ctx diff --git a/src/proto_alpha/lib_protocol/test/test_seed.ml b/src/proto_alpha/lib_protocol/test/test_seed.ml index bf04ca8923de..dc95d7c87614 100644 --- a/src/proto_alpha/lib_protocol/test/test_seed.ml +++ b/src/proto_alpha/lib_protocol/test/test_seed.ml @@ -122,7 +122,7 @@ let test_revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get committed_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get committed_hash) |> fun operation -> Block.bake ~policy ~operation b >>= fun e -> @@ -142,7 +142,7 @@ let test_revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get wrong_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get wrong_hash) |> fun operation -> Block.bake ~operation b >>= fun e -> @@ -156,7 +156,7 @@ let test_revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get committed_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get committed_hash) |> fun operation -> Block.get_next_baker ~policy b >>=? fun (baker_pkh, _, _) -> @@ -197,7 +197,7 @@ let test_revelation_early_wrong_right_twice () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get wrong_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get wrong_hash) |> fun operation -> Block.bake ~operation ~policy b >>= fun e -> @@ -274,7 +274,7 @@ let test_revelation_missing_and_late () = Op.seed_nonce_revelation (B b) level_commitment - (Option.unopt_exn Not_found @@ Nonce.get committed_hash) + (WithExceptions.Option.to_exn ~none:Not_found @@ Nonce.get committed_hash) |> fun operation -> Block.bake ~operation b >>= fun e -> diff --git a/src/proto_alpha/lib_protocol/test/test_transfer.ml b/src/proto_alpha/lib_protocol/test/test_transfer.ml index cd8a87420a9c..555d845191bd 100644 --- a/src/proto_alpha/lib_protocol/test/test_transfer.ml +++ b/src/proto_alpha/lib_protocol/test/test_transfer.ml @@ -185,7 +185,7 @@ let test_transfer_zero_tez () = let test_transfer_zero_implicit () = Context.init 1 >>=? fun (b, contracts) -> - let dest = Option.get @@ List.nth contracts 0 in + let dest = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let account = Account.new_account () in Incremental.begin_construction b >>=? fun i -> @@ -204,7 +204,9 @@ let test_transfer_zero_implicit () = let test_transfer_to_originate_with_fee () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.nth contracts 0 in + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in Incremental.begin_construction b >>=? fun b -> two_over_n_of_balance b contract 10L @@ -240,7 +242,9 @@ let test_transfer_amount_of_contract_balance () = let test_transfers_to_self () = Context.init 1 >>=? fun (b, contracts) -> - let contract = Option.get @@ List.nth contracts 0 in + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in Incremental.begin_construction b >>=? fun b -> two_over_n_of_balance b contract 3L @@ -284,7 +288,9 @@ let test_missing_transaction () = let test_transfer_from_implicit_to_implicit_contract () = Context.init 1 >>=? fun (b, contracts) -> - let bootstrap_contract = Option.get @@ List.nth contracts 0 in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in let account_a = Account.new_account () in let account_b = Account.new_account () in Incremental.begin_construction b @@ -324,8 +330,12 @@ let test_transfer_from_implicit_to_implicit_contract () = let test_transfer_from_implicit_to_originated_contract () = Context.init 1 >>=? fun (b, contracts) -> - let bootstrap_contract = Option.get @@ List.nth contracts 0 in - let contract = Option.get @@ List.nth contracts 0 in + let bootstrap_contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in let account = Account.new_account () in let src = Contract.implicit_contract account.Account.pkh in Incremental.begin_construction b @@ -442,7 +452,7 @@ let test_build_a_chain () = let test_empty_implicit () = Context.init 1 >>=? fun (b, contracts) -> - let dest = Option.get @@ List.nth contracts 0 in + let dest = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in let account = Account.new_account () in Incremental.begin_construction b >>=? fun incr -> @@ -501,9 +511,15 @@ let test_balance_too_low fee () = let test_balance_too_low_two_transfers fee () = Context.init 3 >>=? fun (b, contracts) -> - let contract_1 = Option.get @@ List.nth contracts 0 in - let contract_2 = Option.get @@ List.nth contracts 1 in - let contract_3 = Option.get @@ List.nth contracts 2 in + let contract_1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 + in + let contract_2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 + in + let contract_3 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 2 + in Incremental.begin_construction b >>=? fun i -> Context.Contract.balance (I i) contract_1 diff --git a/src/proto_alpha/lib_protocol/test/test_typechecking.ml b/src/proto_alpha/lib_protocol/test/test_typechecking.ml index 609c96201851..59654ce87672 100644 --- a/src/proto_alpha/lib_protocol/test/test_typechecking.ml +++ b/src/proto_alpha/lib_protocol/test/test_typechecking.ml @@ -38,7 +38,7 @@ let test_context () = let test_context_with_nat_nat_big_map () = Context.init 3 >>=? fun (b, contracts) -> - let source = Option.get @@ List.hd contracts in + let source = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd contracts in Op.origination (B b) source ~script:Op.dummy_script >>=? fun (operation, originated) -> Block.bake ~operation b diff --git a/src/proto_alpha/lib_protocol/test/test_voting.ml b/src/proto_alpha/lib_protocol/test/test_voting.ml index 8364d1a786c1..7da91f18c830 100644 --- a/src/proto_alpha/lib_protocol/test/test_voting.ml +++ b/src/proto_alpha/lib_protocol/test/test_voting.ml @@ -154,19 +154,31 @@ let assert_period ?expected_kind ?expected_index ?expected_position Context.Vote.get_current_period (B b) >>=? fun {voting_period; position; remaining} -> ( if Option.is_some expected_kind then - assert_period_kind (Option.get expected_kind) voting_period.kind loc + assert_period_kind + (WithExceptions.Option.get ~loc:__LOC__ expected_kind) + voting_period.kind + loc else return_unit ) >>=? fun () -> ( if Option.is_some expected_index then - assert_period_index (Option.get expected_index) voting_period.index loc + assert_period_index + (WithExceptions.Option.get ~loc:__LOC__ expected_index) + voting_period.index + loc else return_unit ) >>=? fun () -> ( if Option.is_some expected_position then - assert_period_position (Option.get expected_position) position loc + assert_period_position + (WithExceptions.Option.get ~loc:__LOC__ expected_position) + position + loc else return_unit ) >>=? fun () -> if Option.is_some expected_remaining then - assert_period_remaining (Option.get expected_remaining) remaining loc + assert_period_remaining + (WithExceptions.Option.get ~loc:__LOC__ expected_remaining) + remaining + loc else return_unit let mk_contracts_from_pkh pkh_list = @@ -263,8 +275,12 @@ let test_successful_vote num_delegates () = | Some _ -> failwith "%s - Unexpected proposal" __LOC__) >>=? fun () -> - let del1 = Option.get @@ List.nth delegates_p1 0 in - let del2 = Option.get @@ List.nth delegates_p1 1 in + let del1 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates_p1 0 + in + let del2 = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates_p1 1 + in let props = List.map (fun i -> protos.(i)) (2 -- Constants.max_proposals_per_delegate) in @@ -280,8 +296,8 @@ let test_successful_vote num_delegates () = (* correctly count the double proposal for zero *) (let weight = Int32.add - (Option.get @@ List.nth rolls_p1 0) - (Option.get @@ List.nth rolls_p1 1) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth rolls_p1 0) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth rolls_p1 1) in match Environment.Protocol_hash.(Map.find_opt zero ps) with | Some v -> @@ -555,7 +571,9 @@ let test_not_enough_quorum_in_testing_vote num_delegates () = let open Alpha_context in assert_period ~expected_kind:Proposal b __LOC__ >>=? fun () -> - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [Protocol_hash.zero] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -577,7 +595,9 @@ let test_not_enough_quorum_in_testing_vote num_delegates () = get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 participation_ema |> fun voters -> (* take the first two voters out so there cannot be quorum *) - let voters_without_quorum = Option.get @@ List.tl voters in + let voters_without_quorum = + WithExceptions.Option.get ~loc:__LOC__ @@ List.tl voters + in get_rolls b voters_without_quorum __LOC__ >>=? fun voters_rolls_in_testing_vote -> (* all voters_without_quorum vote, for yays; @@ -618,7 +638,9 @@ let test_not_enough_quorum_in_promotion_vote num_delegates () = >>=? fun (b, delegates) -> assert_period ~expected_kind:Proposal b __LOC__ >>=? fun () -> - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [Protocol_hash.zero] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -671,7 +693,9 @@ let test_not_enough_quorum_in_promotion_vote num_delegates () = get_smallest_prefix_voters_for_quorum delegates_p4 rolls_p4 participation_ema |> fun voters -> (* take the first voter out so there cannot be quorum *) - let voters_without_quorum = Option.get @@ List.tl voters in + let voters_without_quorum = + WithExceptions.Option.get ~loc:__LOC__ @@ List.tl voters + in get_rolls b voters_without_quorum __LOC__ >>=? fun voter_rolls -> (* all voters_without_quorum vote, for yays; @@ -707,7 +731,7 @@ let test_multiple_identical_proposals_count_as_one () = >>=? fun (b, delegates) -> assert_period ~expected_kind:Proposal b __LOC__ >>=? fun () -> - let proposer = Option.get @@ List.hd delegates in + let proposer = WithExceptions.Option.get ~loc:__LOC__ @@ List.hd delegates in Op.proposals (B b) proposer [Protocol_hash.zero; Protocol_hash.zero] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -750,28 +774,32 @@ let test_supermajority_in_proposal there_is_a_winner () = >>=? fun { parametric = {blocks_per_cycle; tokens_per_roll; blocks_per_voting_period; _}; _ } -> - let del1 = Option.get @@ List.nth delegates 0 in - let del2 = Option.get @@ List.nth delegates 1 in - let del3 = Option.get @@ List.nth delegates 2 in + let del1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 in + let del2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 1 in + let del3 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 2 in List.map_es (fun del -> Context.Contract.pkh del) [del1; del2; del3] >>=? fun pkhs -> let policy = Block.Excluding pkhs in Op.transaction (B b) - (Option.get @@ List.nth delegates 3) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 3) del1 tokens_per_roll >>=? fun op1 -> Op.transaction (B b) - (Option.get @@ List.nth delegates 4) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 4) del2 tokens_per_roll >>=? fun op2 -> ( if there_is_a_winner then Test_tez.Tez.( *? ) tokens_per_roll 3L else Test_tez.Tez.( *? ) tokens_per_roll 2L ) >>?= fun bal3 -> - Op.transaction (B b) (Option.get @@ List.nth delegates 5) del3 bal3 + Op.transaction + (B b) + (WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 5) + del3 + bal3 >>=? fun op3 -> Block.bake ~policy ~operations:[op1; op2; op3] b >>=? fun b -> @@ -824,8 +852,8 @@ let test_quorum_in_proposal has_quorum () = blocks_per_voting_period; _ }; _ } -> - let del1 = Option.get @@ List.nth delegates 0 in - let del2 = Option.get @@ List.nth delegates 1 in + let del1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 in + let del2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 1 in List.map_es (fun del -> Context.Contract.pkh del) [del1; del2] >>=? fun pkhs -> let policy = Block.Excluding pkhs in @@ -875,7 +903,7 @@ let test_supermajority_in_testing_vote supermajority () = let min_proposal_quorum = Int32.(of_int @@ (100_00 / 100)) in Context.init ~min_proposal_quorum 100 >>=? fun (b, delegates) -> - let del1 = Option.get @@ List.nth delegates 0 in + let del1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 in let proposal = protos.(0) in Op.proposals (B b) del1 [proposal] >>=? fun ops1 -> @@ -966,7 +994,9 @@ let test_quorum_capped_maximum num_delegates () = >>=? fun () -> (* propose a new protocol *) let protocol = Protocol_hash.zero in - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [protocol] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -1014,7 +1044,9 @@ let test_quorum_capped_minimum num_delegates () = >>=? fun () -> (* propose a new protocol *) let protocol = Protocol_hash.zero in - let proposer = Option.get @@ List.nth delegates 0 in + let proposer = + WithExceptions.Option.get ~loc:__LOC__ @@ List.nth delegates 0 + in Op.proposals (B b) proposer [protocol] >>=? fun ops -> Block.bake ~operations:[ops] b @@ -1060,9 +1092,9 @@ let test_voting_power_updated_each_voting_period () = ~initial_balances:[80_000_000_000L; 48_000_000_000L; 4_000_000_000_000L] 3 >>=? fun (block, contracts) -> - let con1 = Option.get @@ List.nth contracts 0 in - let con2 = Option.get @@ List.nth contracts 1 in - let con3 = Option.get @@ List.nth contracts 2 in + let con1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 0 in + let con2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 1 in + let con3 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth contracts 2 in (* Retrieve balance of con1 *) Context.Contract.balance (B block) con1 >>=? fun balance1 -> @@ -1083,9 +1115,9 @@ let test_voting_power_updated_each_voting_period () = Context.get_bakers (B block) >>=? fun bakers -> (* [Context.init] and [Context.get_bakers] store the accounts in reversed orders *) - let baker1 = Option.get @@ List.nth bakers 2 in - let baker2 = Option.get @@ List.nth bakers 1 in - let baker3 = Option.get @@ List.nth bakers 0 in + let baker1 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bakers 2 in + let baker2 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bakers 1 in + let baker3 = WithExceptions.Option.get ~loc:__LOC__ @@ List.nth bakers 0 in (* Auxiliary assert_voting_power *) let assert_voting_power ~loc n block baker = get_voting_power block baker diff --git a/src/proto_demo_counter/lib_client/client_proto_commands.ml b/src/proto_demo_counter/lib_client/client_proto_commands.ml index 524b0bc3504f..e22a12060aca 100644 --- a/src/proto_demo_counter/lib_client/client_proto_commands.ml +++ b/src/proto_demo_counter/lib_client/client_proto_commands.ml @@ -45,7 +45,9 @@ let bake (cctxt : Protocol_client_context.full) message : unit tzresult Lwt.t = let header_encoded = Data_encoding.Binary.to_bytes_exn Block_header.encoding header in - let preapply_result = Option.get @@ List.hd preapply_result in + let preapply_result = + WithExceptions.Option.get ~loc:__LOC__ @@ List.hd preapply_result + in let operations = [List.map snd preapply_result.applied] in Shell_services.Injection.block cctxt header_encoded operations >>=? fun block_hash -> -- GitLab From 96faf2972a2cd4f8b8f964f3e4d591b2ae9adc85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 9 Dec 2020 13:34:07 +0100 Subject: [PATCH 6/8] Docs: change to new Option and Result --- docs/doc_gen/rpc_doc.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/doc_gen/rpc_doc.ml b/docs/doc_gen/rpc_doc.ml index 8c2322219a77..daec4fec0067 100644 --- a/docs/doc_gen/rpc_doc.ml +++ b/docs/doc_gen/rpc_doc.ml @@ -406,7 +406,7 @@ let main node = :: protocol_dirs in let (_version, name, intro, path, dir) = - Option.get + WithExceptions.Option.get ~loc:__LOC__ @@ List.find (fun (version, _name, _intro, _path, _dir) -> version = required_version) -- GitLab From 3d43eb12376c17db419e8b4af87d958ce2d00124 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Thu, 21 Jan 2021 10:21:34 +0100 Subject: [PATCH 7/8] Stdlib_unix: avoid double indirection when querying levels --- src/lib_stdlib_unix/file_event_sink.ml | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/lib_stdlib_unix/file_event_sink.ml b/src/lib_stdlib_unix/file_event_sink.ml index 5409e1646199..1dc7653be74d 100644 --- a/src/lib_stdlib_unix/file_event_sink.ml +++ b/src/lib_stdlib_unix/file_event_sink.ml @@ -166,17 +166,19 @@ module Event_filter = struct let level_at_least lvl = List.fold_left - (function - | None -> ( - function l when l = lvl -> Some [l] | _ -> None ) - | Some s -> - fun l -> Some (l :: s)) - None + (fun acc l -> + match acc with + | [] -> + if l = lvl then [l] else [] + | _ :: _ as acc -> + l :: acc) + [] levels_in_order - |> Option.fold_f - ~none:(fun () -> raise (Failure "level_at_least not found")) - ~some:Fun.id - |> level_in + |> function + | [] -> + raise (Failure "level_at_least not found") + | _ :: _ as levels -> + level_in levels end type t = { -- GitLab From bd056fecfa157f9e44ab5140486bade48b910e9e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Thu, 28 Jan 2021 09:59:51 +0100 Subject: [PATCH 8/8] Proto-env-v2: Adapt to new `Option` --- .../environment_V2.ml | 2 +- .../structs/v2.dune.inc | 1 + .../structs/v2/option.ml | 38 +++++++++++++++++++ 3 files changed, 40 insertions(+), 1 deletion(-) create mode 100644 src/lib_protocol_environment/structs/v2/option.ml diff --git a/src/lib_protocol_environment/environment_V2.ml b/src/lib_protocol_environment/environment_V2.ml index a807b3e93673..fecad158da10 100644 --- a/src/lib_protocol_environment/environment_V2.ml +++ b/src/lib_protocol_environment/environment_V2.ml @@ -133,7 +133,7 @@ struct module Int64 = Int64 module Buffer = Buffer module Format = Format - module Option = Tezos_base.TzPervasives.Option + module Option = Option module Raw_hashes = struct let sha256 = Hacl.Hash.SHA256.digest diff --git a/src/lib_protocol_environment/structs/v2.dune.inc b/src/lib_protocol_environment/structs/v2.dune.inc index 197b6b7b7f10..e7ca1782672e 100644 --- a/src/lib_protocol_environment/structs/v2.dune.inc +++ b/src/lib_protocol_environment/structs/v2.dune.inc @@ -15,6 +15,7 @@ v2/protocol_hash.ml v2/context_hash.ml v2/error_monad_traversors.ml + v2/option.ml ) (action (with-stdout-to %{targets} (chdir %{workspace_root}} diff --git a/src/lib_protocol_environment/structs/v2/option.ml b/src/lib_protocol_environment/structs/v2/option.ml new file mode 100644 index 000000000000..198925929d0e --- /dev/null +++ b/src/lib_protocol_environment/structs/v2/option.ml @@ -0,0 +1,38 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Tezos_lwt_result_stdlib.Lwtreslib.Option + +let first_some = either + +let ( >>= ) = bind + +let ( >>| ) x f = map f x + +let pp ?(default = "None") pp fmt = function + | Some value -> + pp fmt value + | None -> + Format.pp_print_text fmt default -- GitLab