Revision aafa6548915ec3fc78fc364fd2aad8e56597a901 authored by Raphaël Proust on 21 December 2021, 09:47:25 UTC, committed by Raphaël Proust on 21 December 2021, 09:47:25 UTC
Clean up code See merge request nomadic-labs/data-encoding!65
versioned.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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. *)
(* *)
(*****************************************************************************)
(**
Tests for the {!Data_encoding.With_version} module.
*)
(** This module is a simple example of use of {!With_version}. *)
module Documented_example = struct
(** Here we show how to {i "versionize"} a given random encoding (which
just happens to be very similar to {!Internal_event.Debug_event}). *)
(** We are going to provide successive versions of a module
implementing {!INTENDED_SIGNATURE} (which is similar to a
simplified {!Internal_event.EVENT_DEFINITION}): *)
module type INTENDED_SIGNATURE = sig
type t
val encoding : t Data_encoding.t
val pp : Format.formatter -> t -> unit
end
(** The name, once used with {!With_version.encoding}, appears in
the serialized values, it has to remain constant across versions: *)
let name = "versioned-documented-example"
(** The first version has a [(string * string) list] field. *)
module V0 = struct
type t = {message : string; attachment : (string * string) list}
(** This is the "naked" (i.e. non-versioned) encoding of version-0: *)
let encoding =
let open Data_encoding in
conv
(fun {message; attachment} -> (message, attachment))
(fun (message, attachment) -> {message; attachment})
(obj2 (req "message" string) (req "attach" (list (tup2 string string))))
end
(** The versioned implementation of {!INTENDED_SIGNATURE}: *)
module First_version : INTENDED_SIGNATURE with type t = V0.t = struct
include V0
(** The encoding with the version tagging: *)
let encoding =
Data_encoding.With_version.(encoding ~name (first_version V0.encoding))
let pp ppf {message; attachment} =
let open Format in
fprintf ppf "%s:@ %s@ [" name message ;
pp_open_box ppf 2 ;
pp_print_list
~pp_sep:(fun fmt () -> fprintf fmt ";@ ")
(fun fmt (k, v) -> fprintf fmt "%s: %S" k v)
ppf
attachment ;
pp_close_box ppf () ;
fprintf ppf "]" ;
()
end
(** In a later version we want the attachment to be any piece of
Json and not just a key-value list: *)
module V1 = struct
(** Version 1 is very similar to {!Internal_event.Debug_event}: *)
type t = {message : string; attachment : Data_encoding.Json.t}
let make ?(attach = `Null) message () = {message; attachment = attach}
(** Note the "upgrade" function which can make a {!V1.t} from a {!V0.t}: *)
let of_v0 {V0.message; attachment} =
{
message;
attachment = `O (List.map (fun (k, v) -> (k, `String v)) attachment);
}
(** Again we build first a version-free encoding: *)
let encoding =
let open Data_encoding in
conv
(fun {message; attachment} -> (message, attachment))
(fun (message, attachment) -> {message; attachment})
(obj2 (req "message" string) (req "attachment" json))
end
(** The second version exports {!V1.t} while being able to parse
(and upgrade from) {!First_version.t} values. *)
module Second_version : INTENDED_SIGNATURE with type t = V1.t = struct
include V1
(** Here is the interesting use of {!Data_encoding.With_version}: the
encoding uses both {!V0.encoding} and {!V1.encoding} and
provides {!V1.of_v0} as an upgrade function. *)
let encoding =
Data_encoding.With_version.(
encoding
~name
(first_version V0.encoding |> next_version V1.encoding V1.of_v0))
let pp ppf {message; attachment} =
let open Format in
fprintf ppf "%s:@ %s@ %a" name message Data_encoding.Json.pp attachment
end
(** This test "serializes" successively using
{!First_version.encoding} and {!Second_version.encoding}, and then
shows that the former's output can be parsed with the later. *)
let actual_test () =
let v0_thing : First_version.t =
{V0.message = "The v0 message"; attachment = [("k1", "v1"); ("k2", "v2")]}
in
let json_v0 =
Data_encoding.Json.construct First_version.encoding v0_thing
in
let expected_json_v0 =
`O
[
( name ^ ".v0",
(* -> here we see how the [~name] is used. *)
`O
[
("message", `String v0_thing.V0.message);
( "attach",
`A
(List.map
(fun (k, v) -> `A [`String k; `String v])
v0_thing.V0.attachment) );
] );
]
in
if json_v0 <> expected_json_v0 then
Alcotest.failf
"Json-v0: %a@ Vs@ %a"
Data_encoding.Json.pp
json_v0
Data_encoding.Json.pp
expected_json_v0 ;
(* Up to here we only used the {!First_version} module. Now the
same process with {!Second_version}: *)
let v1_thing : Second_version.t =
{
V1.message = "The v1 message";
attachment = `O [("k1", `String "v1"); ("kn", `Float 42.)];
}
in
let json_v1 =
Data_encoding.Json.construct Second_version.encoding v1_thing
in
let expected_json_v1 =
`O
[
( name ^ ".v1",
`O
[
("message", `String v1_thing.V1.message);
("attachment", v1_thing.V1.attachment);
] );
]
in
if json_v1 <> expected_json_v1 then
Alcotest.failf
"Json-v1: %a@ Vs@ %a"
Data_encoding.Json.pp
json_v1
Data_encoding.Json.pp
expected_json_v1 ;
(* Now the {b interesting part}, we decode ("destruct") the JSON from
{!First_version} with {!Second_version}: *)
let v0_decoded_later : Second_version.t =
Data_encoding.Json.destruct Second_version.encoding json_v0
in
(* And we check that going through JSON is equivalent to just
calling the upgrade function directly on the {!First_version.t}
value: *)
let expected_v1 = V1.of_v0 v0_thing in
if v0_decoded_later <> expected_v1 then
Alcotest.failf
"Parsing v0 with v1: %a@ Vs@ %a"
Second_version.pp
v0_decoded_later
Second_version.pp
expected_v1 ;
()
end
(** This test builds a few successive versions of encodings and tries
out parsing/printing with successive encapsulated
versioned-encodings.
Check out ["_build/_tests/versioned.001.output"] to see how they look.
*)
let test_n_encapsulated_versions () =
let open Data_encoding in
let name = "test0" in
let version_0 = obj2 (req "left" string) (req "right" string) in
let versioned_0 = With_version.(encoding ~name @@ first_version version_0) in
let value_0 = ("v0", "k0") in
let json_0 = Json.construct versioned_0 value_0 in
Helpers.no_exception (fun () ->
let result = Json.destruct versioned_0 json_0 in
if result <> value_0 then Alcotest.failf "value-0") ;
let module Ex = struct
type v0 = string * string
type t =
| Hide : 'a Data_encoding.t * 'a With_version.t * 'a * (v0 -> 'a) -> t
end in
let make_next (Ex.Hide (enc, versioned, example, from_v0)) index =
let new_tag = Printf.sprintf "left-%d" index in
let version_n = obj2 (req new_tag string) (req "right" enc) in
let upgrade vn = ("some-random-extra-string", vn) in
let versioned_n = With_version.(next_version version_n upgrade versioned) in
let encoding = With_version.(encoding ~name versioned_n) in
let example_n = ("val4" ^ new_tag, example) in
let json_example_n = Json.construct encoding example_n in
Helpers.no_exception (fun () ->
let result = Json.destruct encoding json_example_n in
if result <> example_n then Alcotest.failf "value-%d" index) ;
let json_example_p =
Json.construct With_version.(encoding ~name versioned) example
in
Helpers.no_exception (fun () ->
let result = Json.destruct encoding json_example_p in
if result <> upgrade example then
Alcotest.failf "value-%d-previous-encoding" index) ;
let next_upgrade x = upgrade (from_v0 x) in
Helpers.no_exception (fun () ->
let result = Json.destruct encoding json_0 in
if result <> next_upgrade value_0 then
Alcotest.failf "value-%d-from-v0-encoding" index) ;
Format.eprintf "json_example_%d:@ %a\n%!" index Json.pp json_example_n ;
Format.eprintf
"json_example_%d-from-v0:@ %a\n%!"
index
Json.pp
(Json.construct encoding (next_upgrade value_0)) ;
Ex.Hide (version_n, versioned_n, example_n, next_upgrade)
in
let (Ex.Hide _) =
ListLabels.fold_left
(List.init 10 (( + ) 1))
~init:
(Ex.Hide
( version_0,
With_version.(first_version version_0),
value_0,
fun x -> x ))
~f:make_next
in
()
let tests =
[
("example-test", `Quick, Documented_example.actual_test);
("test-encapsulated-versions", `Quick, test_n_encapsulated_versions);
]
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...