Abstract digest serialization

src/irmin-fs/irmin_fs.ml

@@ -81,7 +81,7 @@ struct
     IO.file_exists file
 
   let value v =
-    match V.of_string (Cstruct.to_string v) with
+    match Irmin.Type.decode_cstruct V.t v with
     | Ok v           -> Some v
     | Error (`Msg e) ->
       Log.err (fun l -> l "Irmin_fs.value %s" e);
@@ -115,7 +115,7 @@ struct
 end
 
 module AO_ext (IO: IO) (S: Config)
-    (K: Irmin.Hash.S) (V: Irmin.Contents.Raw) =
+    (K: Irmin.Hash.S) (V: Irmin.Contents.Conv) =
 struct
 
   include RO_ext(IO)(S)(K)(V)
@@ -124,8 +124,8 @@ struct
 
   let add t value =
     Log.debug (fun f -> f "add");
-    let value = V.raw value in
-    let key = K.digest value in
+    let value = Irmin.Type.encode_cstruct V.t value in
+    let key = K.digest Irmin.Type.cstruct value in
     let file = file_of_key t key in
     let temp_dir = temp_dir t in
     (IO.file_exists file >>= function
@@ -148,13 +148,13 @@ module Link_ext (IO: IO) (S: Config) (K:Irmin.Hash.S) = struct
  let add t index key =
    Log.debug (fun f -> f "add link");
    let file = file_of_key t index in
-   let value = Fmt.to_to_string K.pp key in
+   let value = Irmin.Type.encode_cstruct K.t key in
    let temp_dir = temp_dir t in
    IO.file_exists file >>= function
    | true  -> Lwt.return_unit
    | false ->
      Lwt.catch
-       (fun () -> IO.write_file ~temp_dir file @@ Cstruct.of_string value)
+       (fun () -> IO.write_file ~temp_dir file value)
        (fun e -> Lwt.fail e)
 
 end
@@ -217,7 +217,7 @@ struct
     stop () >>= fun () ->
     W.unwatch t.w id
 
-  let raw_value v = Cstruct.of_string (Fmt.to_to_string V.pp v)
+  let raw_value v = Irmin.Type.encode_cstruct V.t v
 
   let set t key value =
     Log.debug (fun f -> f "update");

src/irmin-git/irmin_git.ml

@@ -91,7 +91,7 @@ module Hash (G: VALUE_STORE) = struct
   type t = Git.Hash.t
   let digest_size = 20 (* FIXME: expose Git.Hash.digest_size *)
   let t = Irmin.Type.(like string) SHA_IO.of_hex Git.Hash.to_hex
-  let digest = G.Digest.cstruct
+  let digest t x = G.Digest.cstruct (Irmin.Type.encode_cstruct t x)
   let to_raw t = Cstruct.of_string (Git.Hash.to_raw t)
   let of_raw t = Git.Hash.of_raw (Cstruct.to_string t)
   let has_kind = function `SHA1 -> true | _ -> false
@@ -852,9 +852,9 @@ end
 module Digest (H: Irmin.Hash.S): Git.Hash.DIGEST = struct
   (* FIXME: lots of allocations ... *)
   let cstruct buf =
-    Git.Hash.of_raw (Cstruct.to_string (H.to_raw (H.digest buf)))
+    Git.Hash.of_raw (Cstruct.to_string (H.to_raw (H.digest Irmin.Type.cstruct buf)))
   let string str = cstruct (Cstruct.of_string str)
-  let length = Cstruct.len @@ H.to_raw (H.digest (Cstruct.of_string ""))
+  let length = Cstruct.len @@ H.to_raw (H.digest Irmin.Type.cstruct (Cstruct.of_string ""))
 end
 
 module FS = struct

src/irmin-mem/irmin_mem.ml

@@ -43,12 +43,12 @@ module RO (K: Irmin.Contents.Conv) (V: Irmin.Contents.Conv) = struct
 
 end
 
-module AO (K: Irmin.Hash.S) (V: Irmin.Contents.Raw) = struct
+module AO (K: Irmin.Hash.S) (V: Irmin.Contents.Conv) = struct
 
   include RO(K)(V)
 
   let add t value =
-    let key = K.digest (V.raw value) in
+    let key = K.digest V.t value in
     Log.debug (fun f -> f "add -> %a" K.pp key);
     t.t <- KMap.add key value t.t;
     Lwt.return key

src/irmin/hash.ml

@@ -154,7 +154,9 @@ module SHA1 = struct
 
   let t = Type.(like string) of_hex to_hex
 
-  let digest = sha_1
+  let digest t x =
+    sha_1 (Type.encode_cstruct t x)
+
   let pp ppf x = Fmt.string ppf (to_hex x)
 
   let of_string x =

src/irmin/irmin.ml

@@ -22,7 +22,6 @@ module Diff = Diff
 module Contents = struct
   include Contents
   module type S0 = S.S0
-  module type Raw = S.RAW
   module type Conv = S.CONV
   module type S = S.CONTENTS
   module type STORE = S.CONTENTS_STORE
@@ -44,20 +43,11 @@ module Path = struct
   module type S = S.PATH
 end
 
-module Conv2Raw (C: Contents.Conv): Contents.Raw with type t = C.t =
+module S02Conv (C: Contents.S0): Contents.Conv with type t = C.t =
 struct
   include C
-  let raw t = Cstruct.of_string (Fmt.to_to_string C.pp t)
-end
-
-module S02Raw (C: Contents.S0): Contents.Raw with type t = C.t =
-struct
-  module C = struct
-    include C
-    let pp = Type.pp_json C.t
-    let of_string j = Type.decode_json C.t (Jsonm.decoder (`String j))
-  end
-  include Conv2Raw(C)
+  let pp = Type.pp_json C.t
+  let of_string j = Type.decode_json C.t (Jsonm.decoder (`String j))
 end
 
 module Make
@@ -72,7 +62,7 @@ struct
 
   module X = struct
     module XContents = struct
-      include AO(H)(Conv2Raw(C))
+      include AO(H)(C)
       module Key = H
       module Val = C
     end
@@ -81,7 +71,7 @@ struct
       module AO = struct
         module Key = H
         module Val = Node.Make (H)(H)(P)(M)
-        include AO (Key)(S02Raw(Val))
+        include AO (Key)(S02Conv(Val))
       end
       include Node.Store(Contents)(P)(M)(AO)
       let v = AO.v
@@ -90,7 +80,7 @@ struct
       module AO = struct
         module Key = H
         module Val = Commit.Make (H)(H)
-        include AO (Key)(S02Raw(Val))
+        include AO (Key)(S02Conv(Val))
       end
       include Commit.Store(Node)(AO)
       let v = AO.v

src/irmin/irmin.mli

@@ -372,6 +372,9 @@ module Type: sig
   (** [decode_json_lexemes] is similar to {!decode_json} but use an
       already decoded list of JSON lexemes instead of a decoder. *)
 
+  val encode_cstruct: 'a t -> 'a -> Cstruct.t
+  val decode_cstruct: 'a t -> Cstruct.t -> ('a, [`Msg of string]) result
+
 end
 
 (** Commit info are used to keep track of the origin of write
@@ -908,7 +911,7 @@ module Hash: sig
     val of_string: string -> (t, [`Msg of string]) result
     (** [of_string] parses paths. *)
 
-    val digest: Cstruct.t -> t
+    val digest: 'a Type.t -> 'a -> t
     (** Compute a deterministic store key from a {!Cstruct.t} value. *)
 
     val has_kind: [> `SHA1] -> bool
@@ -984,17 +987,6 @@ module Contents: sig
 
   end
 
-  (** [Raw] is the signature for contents. *)
-  module type Raw = sig
-
-    include Conv
-
-    val raw: t -> Cstruct.t
-    (** [raw t] is the raw contents of [t] to be used for computing
-        stable digests. *)
-
-  end
-
   module type S = sig
 
     (** {1 Signature for store contents} *)
@@ -3006,7 +2998,7 @@ end
 (** [AO_MAKER] is the signature exposed by append-only store
     backends. [K] is the implementation of keys and [V] is the
     implementation of values. *)
-module type AO_MAKER = functor (K: Hash.S) -> functor (V: Contents.Raw) -> sig
+module type AO_MAKER = functor (K: Hash.S) -> functor (V: Contents.Conv) -> sig
 
   include AO with type key = K.t and type value = V.t
 

src/irmin/s.ml

@@ -29,11 +29,6 @@ module type CONV = sig
   val of_string: string -> (t, [`Msg of string]) result
 end
 
-module type RAW = sig
-  include CONV
-  val raw: t -> Cstruct.t
-end
-
 module type PATH = sig
   type t
   val pp: t Fmt.t
@@ -57,7 +52,7 @@ module type HASH = sig
   type t
   val pp: t Fmt.t
   val of_string: string -> (t, [`Msg of string]) result
-  val digest: Cstruct.t -> t
+  val digest: 'a Type.t -> 'a -> t
   val has_kind: [> `SHA1] -> bool
   val to_raw: t -> Cstruct.t
   val of_raw: Cstruct.t -> t
@@ -88,7 +83,7 @@ module type AO = sig
   val add: t -> value -> key Lwt.t
 end
 
-module type AO_MAKER = functor (K: HASH) -> functor (V: RAW) ->
+module type AO_MAKER = functor (K: HASH) -> functor (V: CONV) ->
 sig
   include AO with type key = K.t and type value = V.t
   val v: Conf.t -> t Lwt.t