From c068e27cd2263e5885dba4cc5023ce01fe341e81 Mon Sep 17 00:00:00 2001 From: Hans Hoglund Date: Wed, 19 Jan 2022 22:05:35 +0000 Subject: [PATCH 1/2] lib_base: Add Bounded module --- manifest/main.ml | 3 +- src/lib_base/bounded.ml | 75 +++++++++++++++++ src/lib_base/bounded.mli | 74 +++++++++++++++++ src/lib_base/test/dune | 4 +- src/lib_base/test/test_bounded.ml | 134 ++++++++++++++++++++++++++++++ 5 files changed, 287 insertions(+), 3 deletions(-) create mode 100644 src/lib_base/bounded.ml create mode 100644 src/lib_base/bounded.mli create mode 100644 src/lib_base/test/test_bounded.ml diff --git a/manifest/main.ml b/manifest/main.ml index 79919f7cf4a7..234aa273e1c8 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -895,7 +895,8 @@ let lib_base_tests ?dep_files names = ~opens:["Tezos_base"; "Tezos_error_monad"] ~modules:names -let _tezos_base_tests_1 = lib_base_tests ["test_time"; "test_protocol"] +let _tezos_base_tests_1 = + lib_base_tests ["test_bounded"; "test_time"; "test_protocol"] let _tezos_base_tests_2 = lib_base_tests ["test_p2p_addr"] ~dep_files:["points.ok"; "points.ko"] diff --git a/src/lib_base/bounded.ml b/src/lib_base/bounded.ml new file mode 100644 index 000000000000..346ef348ccbe --- /dev/null +++ b/src/lib_base/bounded.ml @@ -0,0 +1,75 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Trili Tech, *) +(* *) +(* 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 Int32 = struct + module type BOUNDS = sig + val min_int : int32 + + val max_int : int32 + end + + module type S = sig + type t + + include BOUNDS + + include Compare.S with type t := t + + type bound_error = Out_of_bounds + + val bound_error_to_string : bound_error -> string + + val encoding : t Data_encoding.t + + val to_int32 : t -> int32 + + val of_int32 : int32 -> (t, bound_error) result + end + + module Make (B : BOUNDS) = struct + include Compare.Int32 (* This includes [type t = int32] *) + + include B + + type bound_error = Out_of_bounds + + let bound_error_to_string x = + match x with Out_of_bounds -> "Out_of_bounds" + + let to_int32 x = x + + let of_int32 n = + if Compare.Int32.(n < B.min_int) then Error Out_of_bounds + else if Compare.Int32.(n > B.max_int) then Error Out_of_bounds + else Ok n + + let encoding = + Data_encoding.( + conv_with_guard + to_int32 + (fun x -> Result.map_error bound_error_to_string @@ of_int32 x) + int32) + end +end diff --git a/src/lib_base/bounded.mli b/src/lib_base/bounded.mli new file mode 100644 index 000000000000..00c1f1c348be --- /dev/null +++ b/src/lib_base/bounded.mli @@ -0,0 +1,74 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Trili Tech, *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(** This module implements bounded (or refined) versions of data types. *) + +(** Bounded [int32]. *) +module Int32 : sig + (** Bounds. + + Formally each [B : BOUND] represents the interval of all integers + between [B.min_int] and [B.max_int]. This is a closed interval, e.g. + the endpoints are included. + + Intervals can be empty, for example [struct let min_int = 1; let max_int + 0 end] is empty. + *) + module type BOUNDS = sig + val min_int : int32 + + val max_int : int32 + end + + module type S = sig + type t + + include BOUNDS + + include Compare.S with type t := t + + type bound_error = Out_of_bounds + + val bound_error_to_string : bound_error -> string + + val encoding : t Data_encoding.t + + val to_int32 : t -> int32 + + val of_int32 : int32 -> (t, bound_error) result + end + + (** Produce a module [_ : S] of bounded integers. + + If the given interval is empty, [S.t] is the empty type, and [of_int32] + returns [Error] for all inputs. + + {4 Encoding} + [(Make B).encoding] is based on the underlying [int32] encoding. This + allow future compatiblity with larger bounds, at the price of addding 1-3 + redundant bytes to each message. + *) + module Make (_ : BOUNDS) : S +end diff --git a/src/lib_base/test/dune b/src/lib_base/test/dune index af73eed523fb..17c2866544b4 100644 --- a/src/lib_base/test/dune +++ b/src/lib_base/test/dune @@ -2,7 +2,7 @@ ; Edit file manifest/main.ml instead. (tests - (names test_time test_protocol) + (names test_bounded test_time test_protocol) (package tezos-base) (libraries tezos-base @@ -11,7 +11,7 @@ qcheck-alcotest tezos-test-helpers) (flags (:standard -open Tezos_base -open Tezos_error_monad)) - (modules test_time test_protocol)) + (modules test_bounded test_time test_protocol)) (test (name test_p2p_addr) diff --git a/src/lib_base/test/test_bounded.ml b/src/lib_base/test/test_bounded.ml new file mode 100644 index 000000000000..7219748a4057 --- /dev/null +++ b/src/lib_base/test/test_bounded.ml @@ -0,0 +1,134 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Trili Tech, *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(* Testing + ------- + Component: Base + Invocation: dune exec src/lib_base/test/test_bounded.exe + Subject: Test the [Bounded] module. +*) + +module Make_test_bounded_int32 (B : Bounded.Int32.BOUNDS) = struct + include Bounded.Int32.Make (B) + + let gen : t QCheck2.Gen.t = + let open QCheck2.Gen in + let* n = QCheck2.Gen.int32 in + let size = + Tezos_stdlib.Compare.Int32.max + 1l + (Int32.add (Int32.sub max_int min_int) 1l) + in + let in_bounds = Int32.add min_int (Int32.unsigned_rem n size) in + match of_int32 in_bounds with + | Error e -> failwith (bound_error_to_string e) + | Ok x -> return x + + let print (x : t) : string = Int32.to_string (to_int32 x) + + let roundtrips_json : QCheck2.Test.t = + QCheck2.Test.make + ~name:"Bounded.Int32 roundtrips in JSON" + ~print + gen + (fun t -> + let b = Data_encoding.Json.construct encoding t in + let tt = Data_encoding.Json.destruct encoding b in + t = tt) + + let roundtrips_binary : QCheck2.Test.t = + QCheck2.Test.make + ~name:"Bounded.Int32 roundtrips in binary" + ~print + gen + (fun t -> + let b = Data_encoding.Binary.to_bytes_exn encoding t in + let tt = Data_encoding.Binary.of_bytes_exn encoding b in + t = tt) + + let tests = [roundtrips_binary; roundtrips_json] +end + +module Empty = Make_test_bounded_int32 (struct + let min_int = 1l + + let max_int = 0l +end) + +module Small = Make_test_bounded_int32 (struct + let min_int = 1l + + let max_int = 3l +end) + +module Small_with_neg = Make_test_bounded_int32 (struct + let min_int = -10l + + let max_int = 10l +end) + +module Full = Make_test_bounded_int32 (Int32) + +let int32_checks = + let open Alcotest in + [ + test_case "0 not in empty" `Quick (fun () -> + assert (Empty.of_int32 0l = Error Empty.Out_of_bounds)); + test_case "123 not in empty" `Quick (fun () -> + assert (Empty.of_int32 123l = Error Empty.Out_of_bounds)); + test_case "Int32.min_int not in empty" `Quick (fun () -> + assert (Empty.of_int32 Int32.min_int = Error Empty.Out_of_bounds)); + test_case "0 not in Small" `Quick (fun () -> + assert (Small.of_int32 0l = Error Small.Out_of_bounds)); + test_case "1 in Small" `Quick (fun () -> + assert (Result.map Small.to_int32 (Small.of_int32 1l) = Ok 1l)); + test_case "2 in Small" `Quick (fun () -> + assert (Result.map Small.to_int32 (Small.of_int32 2l) = Ok 2l)); + test_case "4 not in Small" `Quick (fun () -> + assert (Small.of_int32 4l = Error Small.Out_of_bounds)); + test_case "0 in full" `Quick (fun () -> + assert (Result.map Full.to_int32 (Full.of_int32 0l) = Ok 0l)); + test_case "123 in full" `Quick (fun () -> + assert (Result.map Full.to_int32 (Full.of_int32 123l) = Ok 123l)); + test_case "Int32.min_int in full" `Quick (fun () -> + assert ( + Result.map Full.to_int32 (Full.of_int32 Int32.min_int) + = Ok Int32.min_int)); + test_case "Int32.max_int in full" `Quick (fun () -> + assert ( + Result.map Full.to_int32 (Full.of_int32 Int32.max_int) + = Ok Int32.max_int)); + ] + +let () = + Alcotest.run + "Bounded" + [ + ("Int32", int32_checks); + ("Int32 Small", Lib_test.Qcheck2_helpers.qcheck_wrap Small.tests); + ( "Int32 Small_with_neg", + Lib_test.Qcheck2_helpers.qcheck_wrap Small_with_neg.tests ); + ("Int32 Full", Lib_test.Qcheck2_helpers.qcheck_wrap Full.tests); + ] -- GitLab From 8f1f106fa2989fa7c4d4f71a10d12c86881259fe Mon Sep 17 00:00:00 2001 From: Hans Hoglund Date: Wed, 26 Jan 2022 11:31:23 +0000 Subject: [PATCH 2/2] lib_base: Bounded: Use Option instead of Result There was only one possible error. --- src/lib_base/bounded.ml | 22 ++++++++-------------- src/lib_base/bounded.mli | 6 +----- src/lib_base/test/test_bounded.ml | 30 +++++++++++++++--------------- 3 files changed, 24 insertions(+), 34 deletions(-) diff --git a/src/lib_base/bounded.ml b/src/lib_base/bounded.ml index 346ef348ccbe..a2d3860de4ae 100644 --- a/src/lib_base/bounded.ml +++ b/src/lib_base/bounded.ml @@ -37,15 +37,11 @@ module Int32 = struct include Compare.S with type t := t - type bound_error = Out_of_bounds - - val bound_error_to_string : bound_error -> string - val encoding : t Data_encoding.t val to_int32 : t -> int32 - val of_int32 : int32 -> (t, bound_error) result + val of_int32 : int32 -> t option end module Make (B : BOUNDS) = struct @@ -53,23 +49,21 @@ module Int32 = struct include B - type bound_error = Out_of_bounds - - let bound_error_to_string x = - match x with Out_of_bounds -> "Out_of_bounds" - let to_int32 x = x let of_int32 n = - if Compare.Int32.(n < B.min_int) then Error Out_of_bounds - else if Compare.Int32.(n > B.max_int) then Error Out_of_bounds - else Ok n + if Compare.Int32.(n < B.min_int) then None + else if Compare.Int32.(n > B.max_int) then None + else Some n let encoding = Data_encoding.( conv_with_guard to_int32 - (fun x -> Result.map_error bound_error_to_string @@ of_int32 x) + (fun x -> + match of_int32 x with + | None -> Error "Out of bounds" + | Some x -> Ok x) int32) end end diff --git a/src/lib_base/bounded.mli b/src/lib_base/bounded.mli index 00c1f1c348be..46539808d088 100644 --- a/src/lib_base/bounded.mli +++ b/src/lib_base/bounded.mli @@ -49,15 +49,11 @@ module Int32 : sig include Compare.S with type t := t - type bound_error = Out_of_bounds - - val bound_error_to_string : bound_error -> string - val encoding : t Data_encoding.t val to_int32 : t -> int32 - val of_int32 : int32 -> (t, bound_error) result + val of_int32 : int32 -> t option end (** Produce a module [_ : S] of bounded integers. diff --git a/src/lib_base/test/test_bounded.ml b/src/lib_base/test/test_bounded.ml index 7219748a4057..5619a9e37976 100644 --- a/src/lib_base/test/test_bounded.ml +++ b/src/lib_base/test/test_bounded.ml @@ -43,8 +43,8 @@ module Make_test_bounded_int32 (B : Bounded.Int32.BOUNDS) = struct in let in_bounds = Int32.add min_int (Int32.unsigned_rem n size) in match of_int32 in_bounds with - | Error e -> failwith (bound_error_to_string e) - | Ok x -> return x + | None -> failwith "Out of bounds" + | Some x -> return x let print (x : t) : string = Int32.to_string (to_int32 x) @@ -95,31 +95,31 @@ let int32_checks = let open Alcotest in [ test_case "0 not in empty" `Quick (fun () -> - assert (Empty.of_int32 0l = Error Empty.Out_of_bounds)); + assert (Empty.of_int32 0l = None)); test_case "123 not in empty" `Quick (fun () -> - assert (Empty.of_int32 123l = Error Empty.Out_of_bounds)); + assert (Empty.of_int32 123l = None)); test_case "Int32.min_int not in empty" `Quick (fun () -> - assert (Empty.of_int32 Int32.min_int = Error Empty.Out_of_bounds)); + assert (Empty.of_int32 Int32.min_int = None)); test_case "0 not in Small" `Quick (fun () -> - assert (Small.of_int32 0l = Error Small.Out_of_bounds)); + assert (Small.of_int32 0l = None)); test_case "1 in Small" `Quick (fun () -> - assert (Result.map Small.to_int32 (Small.of_int32 1l) = Ok 1l)); + assert (Option.map Small.to_int32 (Small.of_int32 1l) = Some 1l)); test_case "2 in Small" `Quick (fun () -> - assert (Result.map Small.to_int32 (Small.of_int32 2l) = Ok 2l)); + assert (Option.map Small.to_int32 (Small.of_int32 2l) = Some 2l)); test_case "4 not in Small" `Quick (fun () -> - assert (Small.of_int32 4l = Error Small.Out_of_bounds)); + assert (Small.of_int32 4l = None)); test_case "0 in full" `Quick (fun () -> - assert (Result.map Full.to_int32 (Full.of_int32 0l) = Ok 0l)); + assert (Option.map Full.to_int32 (Full.of_int32 0l) = Some 0l)); test_case "123 in full" `Quick (fun () -> - assert (Result.map Full.to_int32 (Full.of_int32 123l) = Ok 123l)); + assert (Option.map Full.to_int32 (Full.of_int32 123l) = Some 123l)); test_case "Int32.min_int in full" `Quick (fun () -> assert ( - Result.map Full.to_int32 (Full.of_int32 Int32.min_int) - = Ok Int32.min_int)); + Option.map Full.to_int32 (Full.of_int32 Int32.min_int) + = Some Int32.min_int)); test_case "Int32.max_int in full" `Quick (fun () -> assert ( - Result.map Full.to_int32 (Full.of_int32 Int32.max_int) - = Ok Int32.max_int)); + Option.map Full.to_int32 (Full.of_int32 Int32.max_int) + = Some Int32.max_int)); ] let () = -- GitLab