diff --git a/src/irmin-git/irmin_git.ml b/src/irmin-git/irmin_git.ml index 9cd9384001b..2c4dcc4819c 100644 --- a/src/irmin-git/irmin_git.ml +++ b/src/irmin-git/irmin_git.ml @@ -210,6 +210,7 @@ module Make_private let metadata_t = Metadata.t let hash_t = Key.t let step_t = Path.step_t + let default = Metadata.default let value_t = let open Irmin.Type in diff --git a/src/irmin/commit.ml b/src/irmin/commit.ml index 13857092884..83531d3ba14 100644 --- a/src/irmin/commit.ml +++ b/src/irmin/commit.ml @@ -445,3 +445,45 @@ module History (S: S.COMMIT_STORE) = struct | Some c -> lca t ~info ?max_depth ?n (c::cs) end + +module V1 (C: S.COMMIT) = struct + + module K = struct + + let h = Type.string_of `Int64 + + let size_of x = + Type.size_of h (Type.to_bin_string C.hash_t x) + + let encode_bin buf off e = + Type.encode_bin h buf off (Type.to_bin_string C.hash_t e) + + let decode_bin buf off = + let n, v = Type.decode_bin h buf off in + n, match Type.of_bin_string C.hash_t v with + | Ok v -> v + | Error (`Msg e) -> Fmt.failwith "decode_bin: %s" e + + let t = Type.like C.hash_t ~bin:(encode_bin, decode_bin, size_of) + + end + + include C + + let info_t: Info.t Type.t = + let open Type in + record "info" (fun date author message -> Info.v ~date ~author message) + |+ field "date" int64 (fun t -> Info.date t) + |+ field "author" (string_of `Int64) (fun t -> Info.author t) + |+ field "message" (string_of `Int64) (fun t -> Info.message t) + |> sealr + + let t: t Type.t = + let open Type in + record "commit" (fun node parents info -> v ~info ~node ~parents) + |+ field "node" K.t node + |+ field "parents" (list ~len:`Int64 K.t) parents + |+ field "info" info_t info + |> sealr + +end diff --git a/src/irmin/commit.mli b/src/irmin/commit.mli index c64b87d12a6..0a1645f53ef 100644 --- a/src/irmin/commit.mli +++ b/src/irmin/commit.mli @@ -16,8 +16,7 @@ (** Manage the database history. *) -module Make (K: Type.S): - S.COMMIT with type hash = K.t +module Make (K: Type.S): S.COMMIT with type hash = K.t module Store (N: S.NODE_STORE) @@ -39,3 +38,5 @@ module History (C: S.COMMIT_STORE): and type v = C.Val.t and type node = C.Node.key and type commit = C.key + +module V1 (C: S.COMMIT): S.COMMIT with type hash = C.hash diff --git a/src/irmin/contents.ml b/src/irmin/contents.ml index 7e4e179f85c..1153ebfac3e 100644 --- a/src/irmin/contents.ml +++ b/src/irmin/contents.ml @@ -298,3 +298,15 @@ struct Merge.like_lwt Type.(option Key.t) Val.merge (read_opt t) (add_opt t) end + +module V1 = struct + + module String = struct + include String + + let t = + Type.(like_map (pair unit (string_of `Int64))) + (fun (_, x) -> x) (fun x -> (), x) + end + +end diff --git a/src/irmin/contents.mli b/src/irmin/contents.mli index 392c7a336c7..4c7b378bb3d 100644 --- a/src/irmin/contents.mli +++ b/src/irmin/contents.mli @@ -39,6 +39,10 @@ module Json_tree(Store: S.STORE with type contents = json): sig val set : Store.t -> Store.key -> json -> info:Info.f -> unit Lwt.t end +module V1: sig + module String: S.CONTENTS with type t = string +end + module Store (C: sig include S.CONTENT_ADDRESSABLE_STORE diff --git a/src/irmin/hash.ml b/src/irmin/hash.ml index eda5e8b0b14..c1edec5c0ad 100644 --- a/src/irmin/hash.ml +++ b/src/irmin/hash.ml @@ -49,3 +49,28 @@ module With_digest (K: S.HASH) (V: Type.S) = struct include K let digest v = K.digest (Type.to_bin_string V.t v) end + +module V1 (K: S.HASH): S.HASH with type t = K.t = struct + + type t = K.t + let hash = K.hash + let digest = K.digest + let digest_size = K.digest_size + + let h = Type.string_of `Int64 + + let size_of x = + Type.size_of h (Type.to_bin_string K.t x) + + let encode_bin buf off e = + Type.encode_bin h buf off (Type.to_bin_string K.t e) + + let decode_bin buf off = + let n, v = Type.decode_bin h buf off in + n, match Type.of_bin_string K.t v with + | Ok v -> v + | Error (`Msg e) -> Fmt.failwith "decode_bin: %s" e + + let t = Type.like K.t ~bin:(encode_bin, decode_bin, size_of) + +end diff --git a/src/irmin/hash.mli b/src/irmin/hash.mli index e6a9b16e686..b07d225ef65 100644 --- a/src/irmin/hash.mli +++ b/src/irmin/hash.mli @@ -31,3 +31,5 @@ module With_digest (K: S.HASH) (V: Type.S): sig include S.HASH with type t = K.t val digest: V.t -> t end + +module V1 (H: S.HASH): S.HASH with type t = H.t diff --git a/src/irmin/irmin.mli b/src/irmin/irmin.mli index 0cac51db50b..1ee1ba7a0fb 100644 --- a/src/irmin/irmin.mli +++ b/src/irmin/irmin.mli @@ -1044,6 +1044,9 @@ module Hash: sig module BLAKE2B: S module BLAKE2S: S + module V1 (H: S): S with type t = H.t + (** v1 serialisation *) + end (** [Metadata] defines metadata that is attached to contents but stored in @@ -1136,6 +1139,13 @@ module Contents: sig module Json_value: S with type t = json (** [Json_value] allows any kind of json value to be stored, not only objects. *) + module V1: sig + + module String: S with type t = string + (** Same as {!String} but use v1 serialisation format. *) + + end + (** Contents store. *) module type STORE = sig @@ -1532,6 +1542,9 @@ module Private: sig val t: t Type.t (** [t] is the value type for {!t}. *) + val default: metadata + (** [default] is the default metadata value. *) + val metadata_t: metadata Type.t (** [metadata_t] is the value type for {!metadata}. *) @@ -1546,13 +1559,19 @@ module Private: sig end - (** [Node] provides a simple node implementation, parameterized by + (** [Make] provides a simple node implementation, parameterized by the contents and notes keys [K], paths [P] and metadata [M]. *) module Make (K: Type.S) (P: Path.S) (M: Metadata.S): S with type hash = K.t and type step = P.step and type metadata = M.t + (** v1 serialisation *) + module V1 (S: S): + S with type hash = S.hash + and type step = S.step + and type metadata = S.metadata + (** [STORE] specifies the signature for node stores. *) module type STORE = sig @@ -1747,8 +1766,10 @@ module Private: sig (** [Make] provides a simple implementation of commit values, parameterized by the commit and node keys [K]. *) - module Make (K: Type.S): - S with type hash = K.t + module Make (K: Type.S): S with type hash = K.t + + module V1 (S: S): S with type hash = S.hash + (** V1 serialisation. *) (** [STORE] specifies the signature for commit stores. *) module type STORE = sig diff --git a/src/irmin/node.ml b/src/irmin/node.ml index b30d82bf8c8..4876abdb061 100644 --- a/src/irmin/node.ml +++ b/src/irmin/node.ml @@ -98,6 +98,7 @@ struct let step_t = P.step_t let hash_t = K.t let metadata_t = M.t + let default = M.default let value_t = let open Type in @@ -366,3 +367,61 @@ module Graph (S: S.NODE_STORE) = struct |> sealv end + +module V1 (N: S.NODE) = struct + + module K = struct + + let h = Type.string_of `Int64 + + let size_of x = + Type.size_of h (Type.to_bin_string N.hash_t x) + + let encode_bin buf off e = + Type.encode_bin h buf off (Type.to_bin_string N.hash_t e) + + let decode_bin buf off = + let n, v = Type.decode_bin h buf off in + n, match Type.of_bin_string N.hash_t v with + | Ok v -> v + | Error (`Msg e) -> Fmt.failwith "decode_bin: %s" e + + let t = Type.like N.hash_t ~bin:(encode_bin, decode_bin, size_of) + + end + + include N + + let step_t: step Type.t = + let to_string p = Type.to_bin_string N.step_t p in + let of_string s = + Type.of_bin_string N.step_t s |> function + | Ok x -> x + | Error (`Msg e) -> Fmt.failwith "Step.of_string: %s" e + in + Type.(like_map (string_of `Int64)) of_string to_string + + let value_t = + let open Type in + record "node" (fun contents metadata node -> + match contents, metadata, node with + | Some c, None , None -> `Contents (c, N.default) + | Some c, Some m, None -> `Contents (c, m) + | None , None , Some n -> `Node n + | _ -> failwith "invalid node") + |+ field "contents" (option K.t) (function + | `Contents (x, _) -> Some x + | _ -> None) + |+ field "metadata" (option N.metadata_t) (function + | `Contents (_, x) when not (equal N.metadata_t N.default x) -> Some x + | _ -> None) + |+ field "node" (option K.t) (function + | `Node n -> Some n + | _ -> None) + |> sealr + + + let t: t Type.t = + Type.like_map Type.(list ~len:`Int64 (pair step_t value_t)) v list + +end diff --git a/src/irmin/node.mli b/src/irmin/node.mli index 2f36c5a4bc4..22d80522e01 100644 --- a/src/irmin/node.mli +++ b/src/irmin/node.mli @@ -52,3 +52,8 @@ module Graph (N: S.NODE_STORE): and type node = N.key and type step = N.Path.step and type path = N.Path.t + +module V1 (N: S.NODE): S.NODE + with type hash = N.hash + and type step = N.step + and type metadata = N.metadata diff --git a/src/irmin/s.ml b/src/irmin/s.ml index 7906bbc7068..49558dc6db2 100644 --- a/src/irmin/s.ml +++ b/src/irmin/s.ml @@ -90,6 +90,7 @@ module type NODE = sig val update: t -> step -> value -> t val remove: t -> step -> t val t: t Type.t + val default: metadata val metadata_t: metadata Type.t val hash_t: hash Type.t val step_t: step Type.t diff --git a/test/irmin/test.ml b/test/irmin/test.ml index 45e02d7d83a..e2a37cffc9f 100644 --- a/test/irmin/test.ml +++ b/test/irmin/test.ml @@ -220,10 +220,20 @@ let test_size () = module Hash = Irmin.Hash.SHA1 module Path = Irmin.Path.String_list module Metadata = Irmin.Metadata.None + module Node = Irmin.Private.Node.Make(Hash)(Path)(Metadata) +module Node_v1 = Irmin.Private.Node.V1(Node) + module Commit = Irmin.Private.Commit.Make(Hash) +module Commit_v1 = Irmin.Private.Commit.V1(Commit) + +module Hash_v1 = Irmin.Hash.V1(Hash) -let hash c = Hash.digest (Irmin.Type.to_bin_string Irmin.Contents.String.t c) +let hash c = + Hash.digest (Irmin.Type.to_bin_string Irmin.Contents.String.t c) + +let hash_v1 c = + Hash_v1.digest (Irmin.Type.to_bin_string Irmin.Contents.V1.String.t c) let test_hashes () = let digest t x = @@ -234,39 +244,60 @@ let test_hashes () = Alcotest.(check string) "empty contents" "da39a3ee5e6b4b0d3255bfef95601890afd80709" (digest Irmin.Contents.String.t ""); + Alcotest.(check string) "empty v1 contents" + "05fe405753166f125559e7c9ac558654f107c7e9" + (digest Irmin.Contents.V1.String.t ""); Alcotest.(check string) "empty bytes" "da39a3ee5e6b4b0d3255bfef95601890afd80709" (digest Irmin.Contents.Bytes.t (Bytes.of_string "")); Alcotest.(check string) "contents" "b60d121b438a380c343d5ec3c2037564b82ffef3" (digest Irmin.Contents.String.t "xxx"); + Alcotest.(check string) "empty node" "5ba93c9db0cff93f52b521d7420e43f6eda2784f" (digest Node.t Node.empty); + Alcotest.(check string) "empty v1 node" + "05fe405753166f125559e7c9ac558654f107c7e9" + (digest Node_v1.t Node_v1.empty); + + let n1 v hash = v [ + "bar", `Node (hash "bar"); + "foo", `Contents (hash "", Metadata.default); + ] + in + Alcotest.(check string) "node" "38920183f8b667f6b643b1c4e524a95b55b20d31" - (digest Node.t (Node.v [ - "foo", `Contents (hash "", Metadata.default); - "bar", `Node (hash "bar"); - ])); - let v1 = - Commit.v + (digest Node.t (n1 Node.v hash)); + + Alcotest.(check string) "node v1" + "64e7d8efb7e7aff974959e929c5585d45fd628ad" + (digest Node_v1.t (n1 Node_v1.v hash_v1)); + + let v1 v hash = v ~info:(Irmin.Info.empty) ~node:(hash "toto") ~parents:[] in - let v2 = - Commit.v + let v2 v hash = v ~info:(Irmin.Info.v ~date:42L ~author:"yay" "\bfoo\bar") ~node:(hash "toto") ~parents:[hash "xxx"; hash"yyy"] in - Alcotest.(check string) "commit v1" + Alcotest.(check string) "commit 1" "31c7871af72105ccf25e527fc00c14c9cafbd280" - (digest Commit.t v1); - Alcotest.(check string) "commit v2" + (digest Commit.t (v1 Commit.v hash)); + Alcotest.(check string) "commit v1 1" + "d37cc867cc6eca1b6818b0bc36fef3ffed5cc6d2" + (digest Commit_v1.t (v1 Commit_v1.v hash_v1)); + + Alcotest.(check string) "commit 2" "2311a8c81b36dd2360a6c3a581c5699940423470" - (digest Commit.t v2) + (digest Commit.t (v2 Commit.v hash)); + Alcotest.(check string) "commit v1 2" + "7ae8e01d625c5f8e375264f0be4f63fc5d9d1fc1" + (digest Commit_v1.t (v2 Commit_v1.v hash_v1)) let suite = [ "type", [