diff --git a/manifest/main.ml b/manifest/main.ml index 79919f7cf4a7ddff269568a0d17f32b03d885746..234aa273e1c80f03633bc67296dd11ae6ad2f196 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 0000000000000000000000000000000000000000..a2d3860de4ae3aa16c439768baec0b481e655cef --- /dev/null +++ b/src/lib_base/bounded.ml @@ -0,0 +1,69 @@ +(*****************************************************************************) +(* *) +(* 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 + + val encoding : t Data_encoding.t + + val to_int32 : t -> int32 + + val of_int32 : int32 -> t option + end + + module Make (B : BOUNDS) = struct + include Compare.Int32 (* This includes [type t = int32] *) + + include B + + let to_int32 x = x + + let of_int32 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 -> + 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 new file mode 100644 index 0000000000000000000000000000000000000000..46539808d0884e20c02aa453b83a4f157c4de1e4 --- /dev/null +++ b/src/lib_base/bounded.mli @@ -0,0 +1,70 @@ +(*****************************************************************************) +(* *) +(* 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 + + val encoding : t Data_encoding.t + + val to_int32 : t -> int32 + + val of_int32 : int32 -> t option + 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 af73eed523fb1dc9574512da0608074f696cff16..17c2866544b4f6b67e0b3054781ff8703fd289db 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 0000000000000000000000000000000000000000..5619a9e37976f8b1ab251bdb13439afa6ac871d7 --- /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 + | None -> failwith "Out of bounds" + | Some 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 = None)); + test_case "123 not in empty" `Quick (fun () -> + assert (Empty.of_int32 123l = None)); + test_case "Int32.min_int not in empty" `Quick (fun () -> + assert (Empty.of_int32 Int32.min_int = None)); + test_case "0 not in Small" `Quick (fun () -> + assert (Small.of_int32 0l = None)); + test_case "1 in Small" `Quick (fun () -> + assert (Option.map Small.to_int32 (Small.of_int32 1l) = Some 1l)); + test_case "2 in Small" `Quick (fun () -> + 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 = None)); + test_case "0 in full" `Quick (fun () -> + assert (Option.map Full.to_int32 (Full.of_int32 0l) = Some 0l)); + test_case "123 in full" `Quick (fun () -> + assert (Option.map Full.to_int32 (Full.of_int32 123l) = Some 123l)); + test_case "Int32.min_int in full" `Quick (fun () -> + assert ( + 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 ( + Option.map Full.to_int32 (Full.of_int32 Int32.max_int) + = Some 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); + ]