From 71fb78c9ee35030bd15b54d4b8790a00ff1ed8da Mon Sep 17 00:00:00 2001 From: metanivek Date: Tue, 6 Jun 2023 13:56:29 -0400 Subject: [PATCH 1/3] irmin-mirage-git: add batch to interface It has been removed in the latest mirage-kv, but keep it here for backwards compatibility. Doc comment copied from previous version in mirage-kv. --- src/irmin-mirage/git/irmin_mirage_git_intf.ml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/irmin-mirage/git/irmin_mirage_git_intf.ml b/src/irmin-mirage/git/irmin_mirage_git_intf.ml index 983aa5913f..ac3554617c 100644 --- a/src/irmin-mirage/git/irmin_mirage_git_intf.ml +++ b/src/irmin-mirage/git/irmin_mirage_git_intf.ml @@ -83,6 +83,18 @@ module type KV_RW = sig include Mirage_kv.RW + val batch : t -> ?retries:int -> (t -> 'a Lwt.t) -> 'a Lwt.t + (** [batch t f] run [f] in batch. Ensure the durability of operations. + + Since a batch is applied at once, the readings inside a batch will return + the state before the entire batch. Concurrent operations will not affect + other ones executed during the batch. + + Batch applications can fail to apply if other operations are happening + concurrently. In case of failure, [f] will run again with the most recent + version of [t]. The result is [Error `Too_many_retries] if [f] is run for + more then [retries] attemps (default is [42]). *) + val connect : ?depth:int -> ?branch:string -> From 2bb12cd1785377c82630febe96cf2e155cf547aa Mon Sep 17 00:00:00 2001 From: metanivek Date: Tue, 6 Jun 2023 13:55:46 -0400 Subject: [PATCH 2/3] irmin-mirage-git: adapt to latest mirage-kv --- irmin-mirage-git.opam | 2 +- src/irmin-mirage/git/irmin_mirage_git.ml | 57 +++++++++++++++++++++++- 2 files changed, 56 insertions(+), 3 deletions(-) diff --git a/irmin-mirage-git.opam b/irmin-mirage-git.opam index 78246be9a8..2625da8f05 100644 --- a/irmin-mirage-git.opam +++ b/irmin-mirage-git.opam @@ -16,7 +16,7 @@ depends: [ "dune" {>= "2.9.0"} "irmin-mirage" {= version} "irmin-git" {= version} - "mirage-kv" {>= "3.0.0" & < "5.0.0"} + "mirage-kv" {>= "6.0.0"} "fmt" "git" {>= "3.7.0"} "lwt" {>= "5.3.0"} diff --git a/src/irmin-mirage/git/irmin_mirage_git.ml b/src/irmin-mirage/git/irmin_mirage_git.ml index 141b0d90d6..dbbedfdd89 100644 --- a/src/irmin-mirage/git/irmin_mirage_git.ml +++ b/src/irmin-mirage/git/irmin_mirage_git.ml @@ -120,7 +120,7 @@ module KV_RO (G : Git.S) = struct let l = List.map (fun (s, k) -> - ( s, + ( Mirage_kv.Key.v s, match S.Tree.destruct k with | `Contents _ -> `Value | `Node _ -> `Dictionary )) @@ -138,6 +138,20 @@ module KV_RO (G : Git.S) = struct S.Tree.find t.tree (path key) >|= function | None -> err_not_found key | Some v -> Ok v + + let get_partial t key ~offset ~length = + let open Lwt_result.Infix in + get t key >|= fun data -> + let len = String.length data in + let off = Optint.Int63.to_int offset in + if off >= len || off < 0 || length < 0 then "" + else + let l = min length (len - off) in + String.sub data off l + + let size t key = + let open Lwt_result.Infix in + get t key >|= fun data -> Optint.Int63.of_int (String.length data) end type t = { root : S.path; t : S.t } @@ -154,7 +168,7 @@ module KV_RO (G : Git.S) = struct let key' = path key in S.last_modified t.t key' >|= function | [] -> Error (`Not_found key) - | h :: _ -> Ok (0, S.Info.date (S.Commit.info h)) + | h :: _ -> Ok (Ptime.v (0, S.Info.date (S.Commit.info h))) let connect ?depth ?(branch = "main") ?(root = Mirage_kv.Key.empty) ?ctx ?headers t uri = @@ -175,8 +189,13 @@ module KV_RO (G : Git.S) = struct let exists t k = tree t >>= fun t -> Tree.exists t k let get t k = tree t >>= fun t -> Tree.get t k + + let get_partial t k ~offset ~length = + tree t >>= fun t -> Tree.get_partial t k ~offset ~length + let list t k = tree t >>= fun t -> Tree.list t k let digest t k = tree t >>= fun t -> Tree.digest t k + let size t k = tree t >>= fun t -> Tree.size t k let get t k = match Key.segments k with @@ -243,8 +262,13 @@ module KV_RW (G : Irmin_git.G) (C : Mirage_clock.PCLOCK) = struct | Batch b -> Lwt.return { Tree.tree = b.tree; repo = repo t } let digest t k = tree t >>= fun t -> Tree.digest t k + let size t k = tree t >>= fun t -> Tree.size t k let exists t k = tree t >>= fun t -> Tree.exists t k let get t k = tree t >>= fun t -> Tree.get t k + + let get_partial t k ~offset ~length = + tree t >>= fun t -> Tree.get_partial t k ~offset ~length + let list t k = tree t >>= fun t -> Tree.list t k type write_error = [ RO.error | Mirage_kv.write_error | RO.Sync.push_error ] @@ -273,6 +297,23 @@ module KV_RW (G : Irmin_git.G) (C : Mirage_clock.PCLOCK) = struct b.tree <- tree; Ok () + let ( >?= ) r f = + r >>= function + | Error e -> Lwt.return_error (e :> write_error) + | Ok r -> f r + + let set_partial t k ~offset v = + let off = Optint.Int63.to_int offset in + if off < 0 then Lwt.return_ok () + else + get t k >?= fun data -> + let data_len = String.length data in + let v_len = String.length v in + let buf = Bytes.make (max data_len (off + v_len)) '\000' in + Bytes.blit_string data 0 buf 0 data_len; + Bytes.blit_string v 0 buf off v_len; + set t k (Bytes.unsafe_to_string buf) + let remove t k = let info = info t (`Remove k) in match t.store with @@ -285,6 +326,18 @@ module KV_RW (G : Irmin_git.G) (C : Mirage_clock.PCLOCK) = struct b.tree <- tree; Ok () + let rename t ~source ~dest = + get t source >?= fun data -> + remove t source >?= fun () -> set t dest data + + let allocate t k ?last_modified:_ size = + let size = Optint.Int63.to_int size in + if size < 0 then Lwt.return_ok () + else + exists t k >?= function + | Some _ -> Lwt.return_error (`Already_present k) + | None -> set t k (String.make size '\000') + let get_store_tree (t : RO.t) = S.Head.find t.t >>= function | None -> Lwt.return_none From 3f3a51ad970718d468c76c62bc8341502b8294a5 Mon Sep 17 00:00:00 2001 From: metanivek Date: Tue, 6 Jun 2023 14:08:14 -0400 Subject: [PATCH 3/3] irmin-mirage-git: clean up write error handling --- src/irmin-mirage/git/irmin_mirage_git.ml | 28 ++++++++++-------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/src/irmin-mirage/git/irmin_mirage_git.ml b/src/irmin-mirage/git/irmin_mirage_git.ml index dbbedfdd89..324137be28 100644 --- a/src/irmin-mirage/git/irmin_mirage_git.ml +++ b/src/irmin-mirage/git/irmin_mirage_git.ml @@ -273,10 +273,6 @@ module KV_RW (G : Irmin_git.G) (C : Mirage_clock.PCLOCK) = struct type write_error = [ RO.error | Mirage_kv.write_error | RO.Sync.push_error ] - let write_error = function - | Ok _ -> Ok () - | Error e -> Error (e :> write_error) - let pp_write_error ppf = function | #RO.error as e -> RO.pp_error ppf e | #RO.Sync.push_error as e -> RO.Sync.pp_push_error ppf e @@ -285,23 +281,22 @@ module KV_RW (G : Irmin_git.G) (C : Mirage_clock.PCLOCK) = struct let info t op = Info.f ~author:(t.author ()) "%s" (t.msg op) let path = RO.path + let ( >?= ) r f = + r >>= function + | Error e -> Lwt.return_error (e :> write_error) + | Ok r -> f r + let set t k v = let info = info t (`Set k) in match t.store with - | Store s -> ( - S.set ~info s.t (path k) v >>= function - | Ok _ -> RO.Sync.push s.t t.remote >|= write_error - | Error e -> Lwt.return (Error (e :> write_error))) + | Store s -> + S.set ~info s.t (path k) v >?= fun () -> + RO.Sync.push s.t t.remote >?= fun _ -> Lwt.return_ok () | Batch b -> S.Tree.add b.tree (path k) v >|= fun tree -> b.tree <- tree; Ok () - let ( >?= ) r f = - r >>= function - | Error e -> Lwt.return_error (e :> write_error) - | Ok r -> f r - let set_partial t k ~offset v = let off = Optint.Int63.to_int offset in if off < 0 then Lwt.return_ok () @@ -317,10 +312,9 @@ module KV_RW (G : Irmin_git.G) (C : Mirage_clock.PCLOCK) = struct let remove t k = let info = info t (`Remove k) in match t.store with - | Store s -> ( - S.remove ~info s.t (path k) >>= function - | Ok _ -> RO.Sync.push s.t t.remote >|= write_error - | Error e -> Lwt.return (Error (e :> write_error))) + | Store s -> + S.remove ~info s.t (path k) >?= fun () -> + RO.Sync.push s.t t.remote >?= fun _ -> Lwt.return_ok () | Batch b -> S.Tree.remove b.tree (path k) >|= fun tree -> b.tree <- tree;