Add v1 serialisation formats

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

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

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

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

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

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

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

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

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

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

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

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", [