Permalink
Browse files

Merge pull request #602 from samoht/content-addressable-vs-append-only

Distinguish between append-only vs. content-addressable stores
  • Loading branch information...
samoht committed Dec 28, 2018
2 parents 7e0870f + df8fc25 commit 8b207018abcbd99cdffc07ed3ff71bebe5ac9487
@@ -116,31 +116,26 @@ struct

end

module Content_addressable_ext
module Append_only_ext
(IO: IO)
(S: Config)
(K: Irmin.Hash.S)
(K: Irmin.Type.S)
(V: Irmin.Type.S) =
struct

include Read_only_ext(IO)(S)(K)(V)

let temp_dir t = t.path / "tmp"

let add t value =
let str = Irmin.Type.encode_bin V.t value in
let key = K.digest str in
let add t key value =
Log.debug (fun f -> f "add %a" pp_key key);
let file = file_of_key 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 str)
(fun e -> Lwt.fail e))
>|= fun () ->
key
IO.file_exists file >>= function
| true -> Lwt.return_unit
| false ->
let str = Irmin.Type.encode_bin V.t value in
IO.write_file ~temp_dir file str

end

@@ -263,9 +258,9 @@ module Make_ext (IO: IO) (Obj: Config) (Ref: Config)
(B: Irmin.Branch.S)
(H: Irmin.Hash.S)
= struct
module CA = Content_addressable_ext(IO)(Obj)
module AO = Append_only_ext(IO)(Obj)
module AW = Atomic_write_ext(IO)(Ref)
include Irmin.Make(CA)(AW)(M)(C)(P)(B)(H)
include Irmin.Make(Irmin.Content_addressable(AO))(AW)(M)(C)(P)(B)(H)
end

let string_chop_prefix ~prefix str =
@@ -328,7 +323,7 @@ module Links = struct

end

module Content_addressable (IO: IO) = Content_addressable_ext (IO)(Obj)
module Append_only (IO: IO) = Append_only_ext (IO)(Obj)
module Link (IO: IO) = Link_ext (IO)(Links)
module Atomic_write (IO: IO) = Atomic_write_ext (IO)(Ref)
module Make (IO: IO) = Make_ext (IO)(Obj)(Ref)
@@ -65,7 +65,7 @@ module type IO = sig

end

module Content_addressable (IO: IO): Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
module Append_only (IO: IO): Irmin.APPEND_ONLY_STORE_MAKER
module Link (IO: IO): Irmin.LINK_STORE_MAKER
module Atomic_write (IO: IO): Irmin.ATOMIC_WRITE_STORE_MAKER
module Make (IO: IO): Irmin.S_MAKER
@@ -89,8 +89,7 @@ module type Config = sig

end

module Content_addressable_ext (IO: IO) (C: Config):
Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
module Append_only_ext (IO: IO) (C: Config): Irmin.APPEND_ONLY_STORE_MAKER
module Link_ext (IO: IO) (C: Config): Irmin.LINK_STORE_MAKER
module Atomic_write_ext (IO: IO) (C: Config): Irmin.ATOMIC_WRITE_STORE_MAKER
module Make_ext (IO: IO) (Obj: Config) (Ref: Config): Irmin.S_MAKER
@@ -45,16 +45,14 @@ module Read_only (K: Irmin.Type.S) (V: Irmin.Type.S) = struct

end

module Content_addressable (K: Irmin.Hash.S) (V: Irmin.Type.S) = struct
module Append_only (K: Irmin.Type.S) (V: Irmin.Type.S) = struct

include Read_only(K)(V)

let add t value =
let str = Irmin.Type.encode_bin V.t value in
let key = K.digest str in
let add t key value =
Log.debug (fun f -> f "add -> %a" pp_key key);
t.t <- KMap.add key value t.t;
Lwt.return key
Lwt.return ()

end

@@ -134,7 +132,7 @@ end

let config () = Irmin.Private.Conf.empty

module Make = Irmin.Make(Content_addressable)(Atomic_write)
module Make = Irmin.Make(Irmin.Content_addressable(Append_only))(Atomic_write)

module KV (C: Irmin.Contents.S) =
Make
@@ -24,8 +24,8 @@
val config: unit -> Irmin.config
(** Configuration values. *)

module Content_addressable: Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
(** An in-memory store for content-adressable values. *)
module Append_only: Irmin.APPEND_ONLY_STORE_MAKER
(** An in-memory store for append-only values. *)

module Link: Irmin.LINK_STORE_MAKER
(** An in-memory store for immutable links. *)
@@ -311,11 +311,11 @@ module IO = struct

end

module Content_addressable = Irmin_fs.Content_addressable(IO)
module Append_only = Irmin_fs.Append_only(IO)
module Link = Irmin_fs.Link(IO)
module Atomic_write = Irmin_fs.Atomic_write(IO)
module Make = Irmin_fs.Make(IO)
module KV = Irmin_fs.KV(IO)
module Content_addressable_ext = Irmin_fs.Content_addressable_ext(IO)
module Append_only_ext = Irmin_fs.Append_only_ext(IO)
module Atomic_write_ext = Irmin_fs.Atomic_write_ext(IO)
module Make_ext = Irmin_fs.Make_ext(IO)
@@ -14,15 +14,12 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)

module Content_addressable: Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
module Append_only: Irmin.APPEND_ONLY_STORE_MAKER
module Link: Irmin.LINK_STORE_MAKER
module Atomic_write: Irmin.ATOMIC_WRITE_STORE_MAKER
module Make: Irmin.S_MAKER
module KV: Irmin.KV_MAKER

module Content_addressable_ext (C: Irmin_fs.Config)
: Irmin.CONTENT_ADDRESSABLE_STORE_MAKER

module Append_only_ext (C: Irmin_fs.Config): Irmin.APPEND_ONLY_STORE_MAKER
module Atomic_write_ext (C: Irmin_fs.Config): Irmin.ATOMIC_WRITE_STORE_MAKER

module Make_ext (Obj: Irmin_fs.Config) (Ref: Irmin_fs.Config): Irmin.S_MAKER
@@ -48,8 +48,8 @@ module FS: sig

(** {1 File-system Store} *)

module Content_addressable: Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
(** Content-addressable store maker. *)
module Append_only: Irmin.APPEND_ONLY_STORE_MAKER
(** Append-only store maker. *)

module Link: Irmin.LINK_STORE_MAKER
(** Immutable store for links. *)
@@ -64,9 +64,8 @@ module FS: sig
(** Irmin store make, where only the Contents have to be specified:
branches are strings and paths are string lists. *)

module Content_addressable_ext (C: Irmin_fs.Config)
: Irmin.CONTENT_ADDRESSABLE_STORE_MAKER
(** Content-addressable store maker, with control over the filenames shapes. *)
module Append_only_ext (C: Irmin_fs.Config): Irmin.APPEND_ONLY_STORE_MAKER
(** Append-only store maker, with control over the filenames shapes. *)

module Atomic_write_ext (C: Irmin_fs.Config): Irmin.ATOMIC_WRITE_STORE_MAKER
(** Read-write store maker, with control over the filename shapes. *)
@@ -41,6 +41,44 @@ module Path = struct
module type S = S.PATH
end


module type APPEND_ONLY_STORE = sig
include S.READ_ONLY_STORE
val add: t -> key -> value -> unit Lwt.t
end

module type APPEND_ONLY_STORE_MAKER = functor (K: Type.S) (V: Type.S) ->
sig
include APPEND_ONLY_STORE with type key = K.t and type value = V.t
val v: Conf.t -> t Lwt.t
end

module Content_addressable (AO: APPEND_ONLY_STORE_MAKER)
(K: S.HASH) (V: Type.S) =
struct
include AO(K)(V)

let pp_key = Type.pp K.t

let digest v = K.digest (Type.encode_bin V.t v)

let find t k =
find t k >>= function
| None -> Lwt.return None
| Some v as r ->
let k' = digest v in
if Type.equal K.t k k' then Lwt.return r
else
Fmt.kstrf Lwt.fail_invalid_arg
"corrupted value: got %a, expecting %a" pp_key k' pp_key k

let add t v =
let k = digest v in
add t k v >|= fun () ->
k

end

module Make_ext
(CA: S.CONTENT_ADDRESSABLE_STORE_MAKER)
(AW: S.ATOMIC_WRITE_STORE_MAKER)
@@ -836,6 +836,21 @@ module type CONTENT_ADDRESSABLE_STORE = sig

end

(** Append-onlye backend store. *)
module type APPEND_ONLY_STORE = sig

(** {1 Append-only stores}
Append-onlye stores are store where it is possible to read
and add new values. *)

include READ_ONLY_STORE

val add: t -> key -> value -> unit Lwt.t
(** Write the contents of a value to the store. *)

end

(** Immutable Link store. *)
module type LINK_STORE = sig

@@ -3321,7 +3336,20 @@ end
}
*)

(** [CONTENT_ADDRESSABLE_STORE_MAKER] is the signature exposed by
(** [APPEND_ONLY_STORE_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 APPEND_ONLY_STORE_MAKER = functor (K: Type.S) (V: Type.S) ->
sig

include APPEND_ONLY_STORE with type key = K.t and type value = V.t

val v: config -> t Lwt.t
(** [v config] is a function returning fresh store handles, with the
configuration [config], which is provided by the backend. *)
end

(** [CONTENT_ADDRESSABLE_STOREMAKER] is the signature exposed by
content-addressable store backends. [K] is the implementation of keys
and [V] is the implementation of values. *)
module type CONTENT_ADDRESSABLE_STORE_MAKER = functor (K: Hash.S) (V: Type.S) ->
@@ -3334,6 +3362,9 @@ sig
configuration [config], which is provided by the backend. *)
end

module Content_addressable (S: APPEND_ONLY_STORE_MAKER):
CONTENT_ADDRESSABLE_STORE_MAKER

(** [LINK_MAKER] is the signature exposed by store which enable adding
relation between keys. This is used to decouple the way keys are
manipulated by the Irmin runtime and the keys used for
@@ -37,21 +37,22 @@ module type S = sig
val create: unit -> t Lwt.t
end

module Content_addressable = Irmin.Content_addressable(Irmin_mem.Append_only)

module Mem = struct
include Irmin_mem.Content_addressable(Key)(Value)
include Content_addressable(Key)(Value)
let create () = v @@ Irmin_mem.config ()
end

module MemChunk = struct
include Irmin_chunk.Content_addressable
(Irmin_mem.Content_addressable)(Key)(Value)
include Content_addressable(Key)(Value)
let small_config = Irmin_chunk.config ~min_size:44 ~size:44 ()
let create () = v small_config
end

module MemChunkStable = struct
include Irmin_chunk.Stable_content_addressable
(Irmin_mem.Link)(Irmin_mem.Content_addressable)(Key)(Value)
(Irmin_mem.Link)(Content_addressable)(Key)(Value)
let small_config = Irmin_chunk.config ~min_size:44 ~size:44 ()
let create () = v small_config
end
@@ -61,7 +62,7 @@ let init () =

let store = Irmin_test.store
(module Irmin.Make
(Irmin_chunk.Content_addressable(Irmin_mem.Content_addressable))
(Irmin_chunk.Content_addressable(Content_addressable))
(Irmin_mem.Atomic_write))
(module Irmin.Metadata.None)

@@ -52,7 +52,7 @@ end
module Generic = struct

include Irmin_git.Generic_KV
(Irmin_mem.Content_addressable)
(Irmin.Content_addressable(Irmin_mem.Append_only))
(Irmin_mem.Atomic_write)
(Irmin.Contents.String)

0 comments on commit 8b20701

Please sign in to comment.