diff --git a/irmin-lavyek.opam b/irmin-lavyek.opam new file mode 100644 index 0000000000..3075aba22c --- /dev/null +++ b/irmin-lavyek.opam @@ -0,0 +1,32 @@ +opam-version: "2.0" +maintainer: "thomas@gazagnaire.org" +authors: ["Vincent Balat"] +license: "ISC" +homepage: "https://github.com/mirage/irmin" +bug-reports: "https://github.com/mirage/irmin/issues" +dev-repo: "git+https://github.com/mirage/irmin.git" +doc: "https://mirage.github.io/irmin/" + +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] + +depends: [ + "ocaml" {>= "5.1.0"} + "dune" {>= "3.5.0"} + "irmin" {= version} + "logs" + "lavyek" + "eio" {>= "1.0"} + "alcotest" {with-test} + "irmin-test" {with-test & = version} +] + +pin-depends: [ + [ "irmin-watcher.dev" "git+https://github.com/patricoferris/irmin-watcher#d0e92b4ba5631b5f4dc0f3c00d97e79542dba45d" ] +] + +synopsis: "Generic lavyek backend for Irmin" +x-maintenance-intent: [ "(latest)" ] diff --git a/src/irmin-lavyek/conf.ml b/src/irmin-lavyek/conf.ml new file mode 100644 index 0000000000..297eedeca6 --- /dev/null +++ b/src/irmin-lavyek/conf.ml @@ -0,0 +1,67 @@ +module Default = struct + let fresh = false + let sync = false +end + +open Irmin.Backend.Conf + +let sw_typ : Eio.Switch.t Typ.t = Typ.create () +let fs_typ : Eio.Fs.dir_ty Eio.Path.t Typ.t = Typ.create () +let spec = Spec.v "lavyek" + +module Key = struct + let fresh = + key ~spec ~doc:"Start with a fresh disk." "fresh" Irmin.Type.bool + Default.fresh + + let root = root spec + + let sync = + key ~spec ~doc:"Whether lavyek should sync additions on disk" "use-sync" + Irmin.Type.bool Default.sync +end + +let fresh config = get config Key.fresh + +let root config = + match find_root config with + | None -> + failwith + "unintialised root, call [Irmin_pack.Conf.init root] before opening \ + the store" + | Some root -> root + +let sync config = get config Key.sync +let switch config = find_key config "sw" sw_typ +let fs config = find_key config "fs" fs_typ + +let spec ~sw ~fs = + let spec = Spec.copy spec in + let _sw_key = + let to_string _ = "Eio.Switch.t" in + let of_string _ = Ok sw in + let of_json_string _ = Ok sw in + serialized_key ~typ:sw_typ ~spec ~typename:"Eio.Switch.t" ~to_string + ~of_string ~of_json_string "sw" sw + in + let fs = (fs :> Eio.Fs.dir_ty Eio.Path.t) in + let _fs_key = + let to_string fs = Eio.Path.native_exn fs in + let of_string str = Ok Eio.Path.(fs / str) in + let of_json_string str = + match Irmin.Type.(of_json_string string) str with + | Ok str -> Ok Eio.Path.(fs / str) + | Error e -> Error e + in + serialized_key ~typ:fs_typ ~spec ~typename:"_ Eio.Path.t" ~to_string + ~of_string ~of_json_string "fs" fs + in + spec + +let init ~sw ~fs ?(fresh = Default.fresh) ?(sync = Default.sync) root = + let root = Eio.Path.native_exn root in + let config = empty (spec ~sw ~fs) in + let config = add config Key.root root in + let config = add config Key.fresh fresh in + let config = add config Key.sync sync in + verify config diff --git a/src/irmin-lavyek/conf.mli b/src/irmin-lavyek/conf.mli new file mode 100644 index 0000000000..ccc93daf73 --- /dev/null +++ b/src/irmin-lavyek/conf.mli @@ -0,0 +1,50 @@ +(* + * Copyright (c) 2018-2022 Tarides + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +val spec : sw:Eio.Switch.t -> fs:_ Eio.Path.t -> Irmin.Backend.Conf.Spec.t + +module Key : sig + val fresh : bool Irmin.Backend.Conf.key + val root : string Irmin.Backend.Conf.key + val sync : bool Irmin.Backend.Conf.key +end + +val fresh : Irmin.Backend.Conf.t -> bool +(** Flag to indicate that the store will start with fresh data on disk. Warning: + setting this to [true] will delete existing data. Default is [false]. *) + +val root : Irmin.Backend.Conf.t -> string +(** Location of directory for saving data on disk. *) + +val sync : Irmin.Backend.Conf.t -> bool +(** Flag to indicate that sync should be used to enforce lavyek's flush to disk. + Default [false]. *) + +val switch : Irmin.Backend.Conf.t -> Eio.Switch.t +(** Eio switch *) + +val fs : Irmin.Backend.Conf.t -> Eio.Fs.dir_ty Eio.Path.t +(** Eio filesystem *) + +val init : + sw:Eio.Switch.t -> + fs:_ Eio.Path.t -> + ?fresh:bool -> + ?sync:bool -> + Eio.Fs.dir_ty Eio.Path.t -> + Irmin.config +(** [init root] creates a backend configuration for storing data with default + configuration parameters and stored at [root]. *) diff --git a/src/irmin-lavyek/dune b/src/irmin-lavyek/dune new file mode 100644 index 0000000000..8816b757b2 --- /dev/null +++ b/src/irmin-lavyek/dune @@ -0,0 +1,6 @@ +(library + (name irmin_lavyek) + (public_name irmin-lavyek) + (libraries irmin logs lavyek) + (preprocess + (pps ppx_irmin.internal))) diff --git a/src/irmin-lavyek/import.ml b/src/irmin-lavyek/import.ml new file mode 100644 index 0000000000..71053e21ba --- /dev/null +++ b/src/irmin-lavyek/import.ml @@ -0,0 +1,18 @@ +(* + * Copyright (c) 2021 Craig Ferguson + * Copyright (c) 2018-2022 Tarides + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +include Irmin.Export_for_backends diff --git a/src/irmin-lavyek/irmin_lavyek.ml b/src/irmin-lavyek/irmin_lavyek.ml new file mode 100644 index 0000000000..f26dd353d2 --- /dev/null +++ b/src/irmin-lavyek/irmin_lavyek.ml @@ -0,0 +1,214 @@ +include Irmin.Export_for_backends + +let src = Logs.Src.create "irmin.lavyek" ~doc:"Irmin Lavyek store" + +module Log = (val Logs.src_log src : Logs.LOG) +module Conf = Conf + +let config = Conf.init + +module Read_only (K : Irmin.Type.S) (V : Irmin.Type.S) = struct + type key = K.t + type value = V.t + type 'a t = { t : Lavyek.t; config : Irmin.config } + + let create ~sw path = + [%log.debug "create store at %s" (Eio.Path.native_exn path)]; + Lavyek.create ~sw path + + let open_ ~sw path = + [%log.debug "opening store at %s" (Eio.Path.native_exn path)]; + Lavyek.open_out ~sw path + + let v config = + let root = Conf.root config in + let path = Eio.Path.(Conf.fs config / root) in + let sw = Conf.switch config in + let fresh = Conf.fresh config in + let t = if fresh then create ~sw path else open_ ~sw path in + { t; config } + + let close t = + [%log.debug "close"]; + Lavyek.close t.t + + let clear _t = + [%log.debug "clear store"]; + failwith "not implemented list" + + let cast t = (t :> read_write t) + let batch t f = f (cast t) + let of_bin_string = Irmin.Type.(unstage (of_bin_string V.t)) + let pp_key = Irmin.Type.pp K.t + + let find t key = + [%log.debug "find %a" pp_key key]; + Option.map + (fun v -> Result.get_ok (of_bin_string v)) + (Lavyek.find t.t ~key:(Repr.to_string K.t key)) + + let mem t key = + [%log.debug "mem %a" pp_key key]; + Lavyek.find t.t ~key:(Repr.to_string K.t key) <> None +end + +module Append_only (K : Irmin.Type.S) (V : Irmin.Type.S) = struct + include Read_only (K) (V) + + let to_bin_string = Irmin.Type.(unstage (to_bin_string V.t)) + + let add t key value = + [%log.debug "add %a" pp_key key]; + let sync = Conf.sync t.config in + Lavyek.put t.t ~sync (Repr.to_string K.t key) (to_bin_string value) +end + +module Atomic_write (K : Irmin.Type.S) (V : Irmin.Type.S) = struct + module RO = Read_only (K) (V) + module W = Irmin.Backend.Watch.Make (K) (V) + + type t = { t : unit RO.t; w : W.t } + type key = RO.key + type value = RO.value + type watch = W.watch + + let watches = W.v () + + let v config = + let t = RO.v config in + { t; w = watches } + + let close t = + W.clear t.w; + RO.close t.t + + let find t = RO.find t.t + let mem t = RO.mem t.t + let watch_key t = W.watch_key t.w + let watch t = W.watch t.w + let unwatch t = W.unwatch t.w + + let list t = + [%log.debug "list"]; + let keys, _ = List.split @@ Lavyek.list t.t.t in + List.map (fun k -> Result.get_ok @@ Repr.of_string K.t k) keys + + let to_bin_string = Irmin.Type.(unstage (to_bin_string V.t)) + + let set t key value = + [%log.debug "update %a" RO.pp_key key]; + let sync = Conf.sync t.t.config in + + Lavyek.put ~sync t.t.t (Repr.to_string K.t key) (to_bin_string value) + + let remove t key = + [%log.debug "remove %a" RO.pp_key key]; + let sync = Conf.sync t.t.config in + Lavyek.remove ~sync t.t.t (Repr.to_string K.t key) + + let equal_v_opt = Irmin.Type.(unstage (equal (option V.t))) + + let test_and_set t key ~test ~set:set_value = + [%log.debug "test_and_set"]; + let updated = + let v = find t key in + if equal_v_opt test v then + let () = + match set_value with None -> remove t key | Some v -> set t key v + in + true + else false + in + if updated then W.notify t.w key set_value; + updated + + let clear t = RO.clear t.t +end + +module Content_addressable = Irmin.Content_addressable.Make (Append_only) + +module Make + (CA : Irmin.Content_addressable.Maker) + (AW : Irmin.Atomic_write.Maker) = +struct + module type Config = sig + val suffix : string + end + + module Indexable_store (S : Config) = struct + type 'h key = 'h + + module Key = Irmin.Key.Of_hash + + module Make (Hash : Irmin.Hash.S) (Value : Irmin.Type.S) = struct + module CA = Irmin.Content_addressable.Check_closed (CA) (Hash) (Value) + include Irmin.Indexable.Of_content_addressable (Hash) (CA) + + let v config = + let root = Irmin.Backend.Conf.get config Conf.Key.root in + let suffix = S.suffix in + let config = + Irmin.Backend.Conf.add config Conf.Key.root (root ^ "/" ^ suffix) + in + CA.v config + end + end + + module Atomic_write (S : Config) (Hash : Irmin.Type.S) (Value : Irmin.Type.S) = + struct + module AW = Irmin.Atomic_write.Check_closed (AW) (Hash) (Value) + include AW + + let v config = + let root = Irmin.Backend.Conf.get config Conf.Key.root in + let suffix = S.suffix in + let config = + Irmin.Backend.Conf.add config Conf.Key.root (root ^ "/" ^ suffix) + in + AW.v config + end + + module Maker_args = struct + module Contents_store = + Irmin.Indexable.Maker_concrete_key2_of_1 (Indexable_store (struct + let suffix = "contents" + end)) + + module Node_store = Indexable_store (struct + let suffix = "node" + end) + + module Commit_store = Indexable_store (struct + let suffix = "commit" + end) + + module Branch_store = Atomic_write (struct + let suffix = "branch" + end) + end + + include Irmin.Generic_key.Maker (Maker_args) +end + +module Maker = Make (Content_addressable) (Atomic_write) + +module KV_maker + (CA : Irmin.Content_addressable.Maker) + (AW : Irmin.Atomic_write.Maker) = +struct + type metadata = unit + type hash = Irmin.Schema.default_hash + type info = Irmin.Info.default + + module Maker = Maker + include Maker + module Make (C : Irmin.Contents.S) = Maker.Make (Irmin.Schema.KV (C)) +end + +module KV = KV_maker (Content_addressable) (Atomic_write) + +(* Enforce that {!S} is a sub-type of {!Irmin.Maker}. *) +module Maker_is_a_maker : Irmin.Maker = Maker + +(* Enforce that {!KV} is a sub-type of {!Irmin.KV_maker}. *) +module KV_is_a_KV : Irmin.KV_maker = KV diff --git a/src/irmin-lavyek/irmin_lavyek.mli b/src/irmin-lavyek/irmin_lavyek.mli new file mode 100644 index 0000000000..78ed1b31db --- /dev/null +++ b/src/irmin-lavyek/irmin_lavyek.mli @@ -0,0 +1,34 @@ +(* + * Copyright (c) 2013-2022 Thomas Gazagnaire + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +module Maker : Irmin.Maker +module KV : Irmin.KV_maker with type info = Irmin.Info.default + +(** {1 Configuration} *) + +module Conf = Conf + +val config : + sw:Eio.Switch.t -> + fs:[> Eio.Fs.dir_ty ] Eio.Path.t -> + ?fresh:bool -> + ?sync:bool -> + Eio.Fs.dir_ty Eio.Path.t -> + Irmin.config + +(** {1 Configuration} *) + +(* TODO: add stats for benchmarking ? *) diff --git a/test/irmin-lavyek/dune b/test/irmin-lavyek/dune new file mode 100644 index 0000000000..a91b9eaca3 --- /dev/null +++ b/test/irmin-lavyek/dune @@ -0,0 +1,15 @@ +(library + (name test_lavyek) + (modules test_lavyek) + (libraries irmin-lavyek irmin-test irmin-watcher)) + +(executable + (name test) + (modules test) + (libraries alcotest eio_main irmin irmin-test test_lavyek)) + +(rule + (alias runtest) + (package irmin-lavyek) + (action + (run %{exe:test.exe} -q --color=always))) diff --git a/test/irmin-lavyek/test.ml b/test/irmin-lavyek/test.ml new file mode 100644 index 0000000000..f2af4116d7 --- /dev/null +++ b/test/irmin-lavyek/test.ml @@ -0,0 +1,23 @@ +(* + * Copyright (c) 2013-2022 Thomas Gazagnaire + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +let () = + Eio_main.run @@ fun env -> + Irmin_watcher.run @@ fun () -> + Eio.Switch.run @@ fun sw -> + let fs = Eio.Stdenv.fs env in + Irmin_test.Store.run "irmin-lavyek" ~slow:false ~sleep:Eio_unix.sleep ~misc:[] + [ (`Quick, Test_lavyek.suite ~sw ~fs) ] diff --git a/test/irmin-lavyek/test_lavyek.ml b/test/irmin-lavyek/test_lavyek.ml new file mode 100644 index 0000000000..59e2ee9aff --- /dev/null +++ b/test/irmin-lavyek/test_lavyek.ml @@ -0,0 +1,46 @@ +(* + * Copyright (c) 2022 Tarides + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + +let stats () = + let stats = Irmin_watcher.stats () in + (stats.Irmin_watcher.watchdogs, Irmin.Backend.Watch.workers ()) + +let test_db = Filename.concat "_build" "test-db" + +let store = + Irmin_test.store (module Irmin_lavyek.Maker) (module Irmin.Metadata.None) + +let clean_dirs config = + let test_db = + Irmin.Backend.Conf.find_root config |> Option.value ~default:test_db + in + if Sys.file_exists test_db then + let cmd = Printf.sprintf "rm -rf %s" test_db in + let _ = Sys.command cmd in + () + +let init ~config = + clean_dirs config; + Irmin.Backend.Watch.set_listen_dir_hook Irmin_watcher.hook + +let clean ~config = + clean_dirs config; + Irmin.Backend.Watch.(set_listen_dir_hook none) + +let suite ~sw ~fs = + let path = Eio.Path.(fs / test_db) in + let config = Irmin_lavyek.config ~sw ~fs path in + Irmin_test.Suite.create ~name:"LAVYEK" ~init ~store ~config ~clean ~stats ()