git-kv.opam

@@ -21,6 +21,8 @@ depends: [
   "conf-git"          {with-test}
   "mirage-clock-unix" {with-test}
   "git-unix"          {>= "3.10.0" & with-test}
+  "alcotest"          {>= "1.8.0" & with-test}
+  "bos"               {>= "0.2.1" & with-test}
 ]
 
 build: [

src/dune

@@ -1,5 +1,4 @@
 (library
   (name git_kv)
   (public_name git-kv)
-  (flags (-w -32))
   (libraries git ptime mirage-clock mirage-kv fmt))

src/git_kv.ml

@@ -8,8 +8,8 @@ type t =
   ; edn : Smart_git.Endpoint.t
   ; branch : Git.Reference.t
   ; store : Store.t
-  ; mutable committed : (Digestif.SHA1.t * unit Lwt.t) option
-  ; in_closure : bool
+  ; mutable committed : Digestif.SHA1.t option
+  ; mutex : Lwt_mutex.t
   ; mutable head : Store.hash option }
 
 let init_store () =
@@ -102,7 +102,7 @@ let connect ctx endpoint =
   init_store () >>= fun store ->
   let store = to_invalid store in
   let edn, branch = split_url endpoint in
-  let t = { ctx ; edn ; branch ; store ; committed= None; in_closure= false; head= None } in
+  let t = { ctx ; edn ; branch ; store ; committed= None; mutex= Lwt_mutex.create (); head= None } in
   pull t >>= fun r ->
   let _r = to_invalid r in
   Lwt.return t
@@ -370,8 +370,8 @@ let of_octets ctx ~remote data =
        Result.fold ~ok:Fun.id ~error:(function `Msg msg -> failwith msg) >>= fun store ->
        analyze store data >>= fun head ->
        let edn, branch = split_url remote in
-       Lwt.return_ok { ctx ; edn ; branch ; store ; committed= None; in_closure= false; head; })
-    (fun exn ->
+       Lwt.return_ok { ctx ; edn ; branch ; store ; committed= None; mutex= Lwt_mutex.create (); head; })
+    (fun _exn ->
        Lwt.return_error (`Msg "Invalid PACK file"))
 
 module Make (Pclock : Mirage_clock.PCLOCK) = struct
@@ -395,25 +395,28 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
     | `Reference_not_found _ | `Msg _ as err -> Store.pp_error ppf err
     | `Hash_not_found hash -> Store.pp_error ppf (`Not_found hash)
 
+  let now () = Int64.of_float (Ptime.to_float_s (Ptime.v (Pclock.now_d_ps ())))
+
+  let find_blob t key =
+    match t.committed, t.head with
+    | None, None -> Lwt.return None
+    | Some tree_root_hash, _ ->
+      Search.find t.store tree_root_hash (`Path (Mirage_kv.Key.segments key))
+    | None, Some commit ->
+      Search.find t.store commit (`Commit (`Path (Mirage_kv.Key.segments key)))
+
   let exists t key =
     let open Lwt.Infix in
-    match t.head with
+    find_blob t key >>= function
     | None -> Lwt.return (Ok None)
-    | Some head ->
-      Search.mem t.store head (`Commit (`Path (Mirage_kv.Key.segments key))) >>= function
-      | false -> Lwt.return (Ok None)
-      | true ->
-        Search.find t.store head (`Commit (`Path (Mirage_kv.Key.segments key)))
-        >|= Option.get >>= Store.read_exn t.store >>= function
+    | Some tree_hash ->
+      Store.read_exn t.store tree_hash >>= function
         | Blob _ -> Lwt.return (Ok (Some `Value))
         | Tree _ | Commit _ | Tag _ -> Lwt.return (Ok (Some `Dictionary))
 
   let get t key =
     let open Lwt.Infix in
-    match t.head with
-    | None -> Lwt.return (Error (`Not_found key))
-    | Some head ->
-      Search.find t.store head (`Commit (`Path (Mirage_kv.Key.segments key))) >>= function
+    find_blob t key >>= function
       | None -> Lwt.return (Error (`Not_found key))
       | Some blob ->
         Store.read_exn t.store blob >|= function
@@ -434,10 +437,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
 
   let list t key =
     let open Lwt.Infix in
-    match t.head with
-    | None -> Lwt.return (Error (`Not_found key))
-    | Some head ->
-      Search.find t.store head (`Commit (`Path (Mirage_kv.Key.segments key))) >>= function
+    find_blob t key >>= function
       | None -> Lwt.return (Error (`Not_found key))
       | Some tree ->
         Store.read_exn t.store tree >>= function
@@ -455,6 +455,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
 
   let last_modified t key =
     let open Lwt.Infix in
+    find_blob t key >>=
     Option.fold
       ~none:(Lwt.return (Error (`Not_found key)))
       ~some:(fun head ->
@@ -477,21 +478,24 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
                 ~some:Fun.id (Ptime.of_float_s (Int64.to_float secs))
             in
             Ok ts
-          | _ -> assert false)
-      t.head
+          | _ ->
+            Ok (Option.fold
+              ~none:Ptime.epoch
+              ~some:Fun.id (Ptime.of_float_s (Int64.to_float (now ())))))
 
   let digest t key =
+    let open Lwt.Infix in
+    find_blob t key >>=
     Option.fold
-      ~none:(Error (`Not_found key))
-      ~some:(fun x -> Ok (Store.Hash.to_raw_string x))
-      t.head |> Lwt.return
+      ~none:(Lwt.return (Error (`Not_found key)))
+      ~some:(fun x -> Lwt.return (Ok (Store.Hash.to_raw_string x)))
 
   let size t key =
     let open Lwt_result.Infix in
     get t key >|= fun data ->
     Optint.Int63.of_int (String.length data)
 
-  let author ?(name = "Git KV") ?(email = "git@mirage.io") now =
+  let author ?(name = "Git KV") ?(email = "git-noreply@robur.coop") now =
     { Git.User.name ; email ; date = now (), None }
 
   let rec unroll_tree t ~tree_root_hash (pred_perm, pred_name, pred_hash) rpath =
@@ -520,7 +524,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
 
   let tree_root_hash_of_store t =
     match t.committed, t.head with
-    | Some (tree_root_hash, _), _ -> Lwt.return_ok tree_root_hash
+    | Some tree_root_hash, _ -> Lwt.return_ok tree_root_hash
     | None, None ->
       let open Lwt_result.Infix in
       let tree = Store.Value.Tree.v [] in
@@ -533,7 +537,6 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
       | _ -> Lwt.return_error (`Msg (Fmt.str "The current HEAD value (%a) is not a commit" Digestif.SHA1.pp commit))
 
   let ( >>? ) = Lwt_result.bind
-  let now () = Int64.of_float (Ptime.to_float_s (Ptime.v (Pclock.now_d_ps ())))
 
   let set ?and_commit t key contents =
     let segs = Mirage_kv.Key.segments key in
@@ -548,14 +551,14 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
       tree_root_hash_of_store t >>= fun tree_root_hash ->
       unroll_tree t ~tree_root_hash (`Normal, name, hash) (List.tl rpath) >>= fun tree_root_hash ->
       match and_commit with
-      | Some (_old_tree_root_hash, th) ->
-        t.committed <- Some (tree_root_hash, th) ;
+      | Some _old_tree_root_hash ->
+        t.committed <- Some tree_root_hash ;
         Lwt.return_ok ()
       | None ->
         let committer = author now in
         let author    = author now in
         let action    = Option.fold ~none:(`Create t.branch) ~some:(fun _ -> `Update (t.branch, t.branch)) t.head in
-        let parents   = Option.value ~default:[] (Option.map (fun head -> [ head ]) t.head) in
+        let parents   = Option.to_list t.head in
         let commit    = Store.Value.Commit.make ~tree:tree_root_hash ~author ~committer
           ~parents (Some "Committed by git-kv") in
         Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) ->
@@ -593,10 +596,9 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
 
   let remove ?and_commit t key =
     let segs = Mirage_kv.Key.segments key in
-    match List.rev segs, t.head with
-    | [], _ -> assert false
-    | _, None -> Lwt.return_ok () (* XXX(dinosaure): or [`Not_found]? *)
-    | name :: [], Some head ->
+    match List.rev segs with
+    | [] -> assert false
+    | name :: [] ->
       let open Lwt_result.Infix in
       tree_root_hash_of_store t >>= fun tree_root_hash ->
       Store.read_exn t.store tree_root_hash >>! fun tree_root ->
@@ -605,12 +607,13 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
       let open Lwt_result.Infix in
       Store.write t.store (Git.Value.Tree tree_root) >>= fun (tree_root_hash, _) ->
       ( match and_commit with
-      | Some (_old_tree_root_hash, th) -> t.committed <- Some (tree_root_hash, th) ; Lwt.return_ok ()
+      | Some _old_tree_root_hash -> t.committed <- Some tree_root_hash ; Lwt.return_ok ()
       | None ->
         let committer = author now in
         let author    = author now in
+        let parents = Option.to_list t.head in
         let commit    = Store.Value.Commit.make ~tree:tree_root_hash ~author ~committer
-          ~parents:[ head ] (Some "Committed by git-kv") in
+          ~parents (Some "Committed by git-kv") in
         Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) ->
         Store.Ref.write t.store t.branch (Git.Reference.uid hash) >>= fun () ->
         Lwt.Infix.(Sync.push ~capabilities ~ctx:t.ctx t.edn t.store [ `Update (t.branch, t.branch) ]
@@ -618,7 +621,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
             Git.Reference.pp t.branch Sync.pp_error err))
           >>? fun () -> Store.shallow t.store hash >|= Result.ok)
         >>= fun () -> t.head <- Some hash ; Lwt.return_ok () )
-    | name :: pred_name :: rest, Some head ->
+    | name :: pred_name :: rest ->
       let open Lwt_result.Infix in
       tree_root_hash_of_store t >>= fun tree_root_hash ->
       Search.find t.store tree_root_hash (`Path (List.rev (pred_name :: rest))) >>! function
@@ -629,12 +632,13 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
           Store.write t.store (Git.Value.Tree tree) >>= fun (pred_hash, _) ->
           unroll_tree t ~tree_root_hash (`Dir, pred_name, pred_hash) rest >>= fun tree_root_hash ->
           ( match and_commit with
-          | Some (_old_tree_root_hash, th) -> t.committed <- Some (tree_root_hash, th) ; Lwt.return_ok ()
+          | Some _old_tree_root_hash -> t.committed <- Some tree_root_hash ; Lwt.return_ok ()
           | None ->
             let committer = author now in
             let author    = author now in
+            let parents = Option.to_list t.head in
             let commit    = Store.Value.Commit.make ~tree:tree_root_hash ~author ~committer
-              ~parents:[ head ] (Some "Committed by git-kv") in
+              ~parents (Some "Committed by git-kv") in
             Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) ->
             Store.Ref.write t.store t.branch (Git.Reference.uid hash) >>= fun () ->
             Lwt.Infix.(Sync.push ~capabilities ~ctx:t.ctx t.edn t.store [ `Update (t.branch, t.branch) ]
@@ -670,36 +674,30 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
 
   let change_and_push t ?author:name ?author_email:email ?(message = "Committed by git-kv") f =
     let open Lwt.Infix in
-    if t.in_closure then
-      Lwt.return_error (`Msg "Nested change_and_push")
-    else
-      (* XXX(dinosaure): serialize [change_and_push]. If we do
-         [Lwt.both (change_and_push ..) (change_and_push ..)], they can not run
-         concurrently! The second will waiting the first to finish. *)
-      ( match t.committed with
-        | None -> Lwt.return_unit
-        | Some (_tree_root_hash, th) -> th ) >>= fun () ->
-      let th, wk = Lwt.wait () in
-      ( let open Lwt_result.Infix in
+    match t.committed with
+    | Some _ -> Lwt.return_error (`Msg "Nested change_and_push")
+    | None ->
+      Lwt_mutex.with_lock t.mutex (fun () ->
+          (let open Lwt_result.Infix in
            tree_root_hash_of_store t >>= fun tree_root_hash ->
-        t.committed <- Some (tree_root_hash, th) ;
-        let t' = { t with in_closure= true } in
+           let t' = { t with committed = Some tree_root_hash } in
            f t' >>! fun res ->
            (* XXX(dinosaure): we assume that only [change_and_push] can reset [t.committed] to [None] and
               we ensured that [change_and_push] can not be called into [f]. So we are sure that [t'.committed]
               must be [Some _] in anyway. *)
-        let[@warning "-8"] Some (new_tree_root_hash, _) = t'.committed in
+           let[@warning "-8"] Some new_tree_root_hash = t'.committed in
            if Digestif.SHA1.equal new_tree_root_hash tree_root_hash
            then Lwt.return_ok res (* XXX(dinosaure): nothing to send! *)
+           else if not (Option.equal Digestif.SHA1.equal t.head t'.head) then
+             Lwt.return (Error (`Msg "store was modified outside of change_and_push, please retry"))
            else
              let action    = Option.fold ~none:(`Create t.branch) ~some:(fun _ -> `Update (t.branch, t.branch)) t.head in
-          let parents   = Option.value ~default:[] (Option.map (fun head -> [ head ]) t.head) in
+             let parents   = Option.to_list t.head in
              let author    = author ?name ?email now in
              let committer = author in
              let commit    = Store.Value.Commit.make ~tree:new_tree_root_hash ~author ~committer
                  ~parents (Some message) in
              Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) ->
-          t.head <- Some hash ;
              Store.Ref.write t.store t.branch (Git.Reference.uid hash) >>= fun () ->
              Lwt.Infix.(Sync.push ~capabilities ~ctx:t.ctx t.edn t.store [ action ]
                         >|= Result.map_error (fun err ->
@@ -707,11 +705,8 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
                                     Git.Reference.pp t.branch Sync.pp_error err))
                         >>? fun () ->
                         Store.shallow t.store hash >|= Result.ok) >>= fun () ->
-          Lwt.return_ok res )
+             t.head <- Some hash ;
+             Lwt.return_ok res)
           >|= Result.map_error
-        (fun err -> `Msg (Fmt.str "error pushing %a" Store.pp_error err))
-      >>= fun res ->
-      Lwt.wakeup_later wk () ;
-      t.committed <- None ;
-      Lwt.return res
+            (fun err -> `Msg (Fmt.str "error pushing %a" Store.pp_error err)))
 end

test/dune

@@ -1,14 +1,21 @@
+(env (_ (binaries (../app/mgit.exe as mgit))))
 (cram
  (package git-kv)
  (applies_to simple)
  (locks p9418)
- (deps %{exe:../app/mgit.exe}))
+ (deps %{bin:mgit}))
 
 (cram
  (package git-kv)
  (applies_to fold)
  (locks p9418)
- (deps %{exe:../app/mgit.exe}))
+ (deps %{bin:mgit}))
+
+(cram
+ (package git-kv)
+ (applies_to fold2)
+ (locks p9418)
+ (deps %{bin:mgit}))
 
 (executable
  (name git_daemon_exists)
@@ -18,3 +25,8 @@
  (with-stdout-to
   git-daemon
   (run ./git_daemon_exists.exe)))
+
+(test
+ (name tests)
+ (libraries git-kv alcotest bos mirage-clock-unix lwt.unix git-unix)
+ (modules tests))

test/fold.t

@@ -11,18 +11,20 @@ Batch operation
   > exists /bar
   > quit
   > quit
-  /bar does not exists
+  > EOF
+  /bar exists as a value
   $ mgit git://localhost/simple#main <<EOF
   > list /
   > get /bar
   > get /foo
   > quit
+  > EOF
   - /bar
   - /foo
   00000000: 4769 7420 726f 636b 7321                 Git rocks!
   00000000: 4865 6c6c 6f20 576f 726c 6421            Hello World!
   $ cd simple
-  $ git log main --pretty=oneline | wc -l
+  $ git log main --pretty=oneline | wc -l | tr -d ' '
   1
   $ cd ..
   $ kill $(cat pid)

test/fold2.t

@@ -0,0 +1,19 @@
+Reading during batch operation
+  $ mkdir simple
+  $ git init --bare -q simple 2> /dev/null
+  $ git daemon --base-path=. --export-all --enable=receive-pack --reuseaddr --pid-file=pid --detach
+  $ mgit git://localhost/simple#main << EOF
+  > fold
+  > set /bar "Git rocks!"
+  > list /
+  > get /bar
+  > quit
+  > quit
+  > EOF
+  - /bar
+  00000000: 4769 7420 726f 636b 7321                 Git rocks!
+  $ cd simple
+  $ git log main --pretty=oneline | wc -l | tr -d ' '
+  1
+  $ cd ..
+  $ kill $(cat pid)

test/simple.t

@@ -17,6 +17,7 @@ Simple test of our Git Key-Value store
   > get /foo
   > save db.pack
   > quit
+  > EOF
   00000000: 4865 6c6c 6f20 576f 726c 6421 0a         Hello World!.
   $ tail -c20 db.pack | hxd.xxd
   00000000: e4b2 3437 2e7e 3d7e 8508 3912 3d87 11cd  ..47.~=~..9.=...
@@ -24,6 +25,7 @@ Simple test of our Git Key-Value store
   $ mgit git://localhost/simple db.pack <<EOF
   > get /foo
   > quit
+  > EOF
   00000000: 4865 6c6c 6f20 576f 726c 6421 0a         Hello World!.
   $ cd simple
   $ echo "Git rocks!" > bar
@@ -35,6 +37,7 @@ Simple test of our Git Key-Value store
   > get /bar
   > get /foo
   > quit
+  > EOF
   + /bar
   * /
   00000000: 4769 7420 726f 636b 7321 0a              Git rocks!.

test/tests.ml

@@ -0,0 +1,269 @@
+let ( let* ) = Result.bind
+
+let run_it cmd =
+  let* status = Bos.OS.Cmd.run_status cmd in
+  if status = `Exited 0 then Ok () else
+    Error (`Msg ("status not 0, but " ^ Fmt.to_to_string Bos.OS.Cmd.pp_status status))
+
+let empty_repo () =
+  let* cwd = Bos.OS.Dir.current () in
+  let* tmpdir = Bos.OS.Dir.tmp ~dir:cwd "git-kv-%s" in
+  let* () = Bos.OS.Dir.set_current tmpdir in
+  let cmd = Bos.Cmd.(v "git" % "init" % "--bare" % "-q") in
+  let* () = run_it cmd in
+  let* () = Bos.OS.Dir.set_current cwd in
+  let cmd = Bos.Cmd.(v "git" % "daemon" % "--base-path=." % "--export-all" % "--reuseaddr" % "--pid-file=pid" % "--detach" % "--port=9419" % "--enable=receive-pack") in
+  let* () = run_it cmd in
+  let pid = Result.get_ok (Bos.OS.File.read (Fpath.v "pid")) in
+  Ok (Fpath.basename tmpdir, String.trim pid)
+
+let kill_git pid =
+  Unix.kill (int_of_string pid) Sys.sigterm
+
+module Store = Git_kv.Make (Pclock)
+
+open Lwt.Infix
+
+let read_in_change_and_push () =
+  match
+    let* (tmpdir, pid) = empty_repo () in
+    Fun.protect ~finally:(fun () -> kill_git pid) (fun () ->
+    Lwt_main.run
+      (
+        Git_unix.ctx (Happy_eyeballs_lwt.create ()) >>= fun ctx ->
+        Git_kv.connect ctx ("git://localhost:9419/" ^ tmpdir) >>= fun t ->
+        Store.change_and_push t (fun t ->
+          Store.set t (Mirage_kv.Key.v "/foo") "value" >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure writing";
+          Store.get t (Mirage_kv.Key.v "/foo") >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure reading";
+          Alcotest.(check string) "Store.get" "value" (Result.get_ok r);
+          Lwt.return_unit) >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure change_and_push";
+        Store.get t (Mirage_kv.Key.v "/foo") >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure reading outside";
+        Alcotest.(check string) "Store.get" "value" (Result.get_ok r);
+        Lwt.return_unit));
+    Ok ()
+  with
+  | Ok () -> ()
+  | Error `Msg msg ->
+    print_endline ("got an error from bos: " ^ msg)
+
+let set_outside_change_and_push () =
+  match
+    let* (tmpdir, pid) = empty_repo () in
+    Fun.protect ~finally:(fun () -> kill_git pid) (fun () ->
+    Lwt_main.run
+      (
+        Git_unix.ctx (Happy_eyeballs_lwt.create ()) >>= fun ctx ->
+        Git_kv.connect ctx ("git://localhost:9419/" ^ tmpdir) >>= fun t ->
+        Store.change_and_push t (fun t' ->
+          Store.set t' (Mirage_kv.Key.v "/foo") "value" >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure writing foo";
+          Store.set t (Mirage_kv.Key.v "/bar") "other value" >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure writing bar";
+          Lwt.return_unit) >>= fun r ->
+        if Result.is_ok r then Alcotest.fail "expected change_and_push failure";
+        Store.get t (Mirage_kv.Key.v "/foo") >>= fun r ->
+        if Result.is_ok r then Alcotest.fail "expected failure reading foo";
+        Store.get t (Mirage_kv.Key.v "/bar") >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure reading outside bar";
+        Alcotest.(check string) "Store.get bar" "other value" (Result.get_ok r);
+        Lwt.return_unit));
+    Ok ()
+  with
+  | Ok () -> ()
+  | Error `Msg msg ->
+    print_endline ("got an error from bos: " ^ msg)
+
+let remove_in_change_and_push () =
+  match
+    let* (tmpdir, pid) = empty_repo () in
+    Fun.protect ~finally:(fun () -> kill_git pid) (fun () ->
+    Lwt_main.run
+      (
+        Git_unix.ctx (Happy_eyeballs_lwt.create ()) >>= fun ctx ->
+        Git_kv.connect ctx ("git://localhost:9419/" ^ tmpdir) >>= fun t ->
+        Store.set t (Mirage_kv.Key.v "/foo") "value" >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure writing";
+        Store.change_and_push t (fun t' ->
+          Store.get t' (Mirage_kv.Key.v "/foo") >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure reading inside";
+          Alcotest.(check string) "Store.get" "value" (Result.get_ok r);
+          Store.remove t' (Mirage_kv.Key.v "/foo") >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure removing";
+          Store.get t (Mirage_kv.Key.v "/foo") >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure reading the outer t";
+          Alcotest.(check string) "Store.get" "value" (Result.get_ok r);
+          Lwt.return_unit) >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure change_and_push";
+        Store.get t (Mirage_kv.Key.v "/foo") >>= fun r ->
+        if Result.is_ok r then Alcotest.fail "expected failure reading outside";
+        Lwt.return_unit));
+    Ok ()
+  with
+  | Ok () -> ()
+  | Error `Msg msg ->
+    print_endline ("got an error from bos: " ^ msg)
+
+let last_modified_in_change_and_push () =
+  match
+    let* (tmpdir, pid) = empty_repo () in
+    Fun.protect ~finally:(fun () -> kill_git pid) (fun () ->
+    Lwt_main.run
+      (
+        Git_unix.ctx (Happy_eyeballs_lwt.create ()) >>= fun ctx ->
+        Git_kv.connect ctx ("git://localhost:9419/" ^ tmpdir) >>= fun t ->
+        Store.set t (Mirage_kv.Key.v "/foo") "value" >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure writing";
+        Store.last_modified t (Mirage_kv.Key.v "/foo") >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure last_modified";
+        let lm = Result.get_ok r in
+        Store.change_and_push t (fun t' ->
+            Store.last_modified t' (Mirage_kv.Key.v "/foo") >>= fun r ->
+            if Result.is_error r then Alcotest.fail "failure last_modified inside";
+            let lm' = Result.get_ok r in
+            Alcotest.(check bool) "last modified is later or equal" true (Ptime.is_later ~than:lm lm' || Ptime.equal lm lm');
+            Store.set t' (Mirage_kv.Key.v "/foo") "new value" >>= fun r ->
+            if Result.is_error r then Alcotest.fail "failure writing inside";
+            Store.last_modified t' (Mirage_kv.Key.v "/foo") >>= fun r ->
+            if Result.is_error r then Alcotest.fail "failure last_modified inside after set";
+            let lm2 = Result.get_ok r in
+            Alcotest.(check bool) "last modified is later" true (Ptime.is_later ~than:lm' lm2 || Ptime.equal lm' lm2);
+            Lwt.return lm2) >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure change_and_push";
+        let lm2 = Result.get_ok r in
+        Store.last_modified t (Mirage_kv.Key.v "/foo") >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure last_modified after change_and_push";
+        let lm3 = Result.get_ok r in
+        Alcotest.(check bool) "last modified is later" true (Ptime.is_later ~than:lm lm3 || Ptime.equal lm lm3);
+        Alcotest.(check bool) "last modified is later outside than inside" true (Ptime.is_later ~than:lm2 lm3 || Ptime.equal lm2 lm3);
+        Lwt.return_unit));
+    Ok ()
+  with
+  | Ok () -> ()
+  | Error `Msg msg ->
+    print_endline ("got an error from bos: " ^ msg)
+
+let digest_in_change_and_push () =
+  match
+    let* (tmpdir, pid) = empty_repo () in
+    Fun.protect ~finally:(fun () -> kill_git pid) (fun () ->
+    Lwt_main.run
+      (
+        Git_unix.ctx (Happy_eyeballs_lwt.create ()) >>= fun ctx ->
+        Git_kv.connect ctx ("git://localhost:9419/" ^ tmpdir) >>= fun t ->
+        Store.set t (Mirage_kv.Key.v "/foo") "value" >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure writing";
+        Store.digest t (Mirage_kv.Key.v "/foo") >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure digest";
+        let digest = Result.get_ok r in
+        Store.change_and_push t (fun t' ->
+          Store.digest t' (Mirage_kv.Key.v "/foo") >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure digest inside";
+          Alcotest.(check string) "Store.digest" digest (Result.get_ok r);
+          Store.set t' (Mirage_kv.Key.v "/foo") "something else" >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure set";
+          Store.digest t' (Mirage_kv.Key.v "/foo") >>= fun r ->
+          if Result.is_error r then Alcotest.fail "failure digest inside";
+          Alcotest.(check bool) "Store.digest" false (String.equal digest (Result.get_ok r));
+          Lwt.return_unit) >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure change_and_push";
+        Store.digest t (Mirage_kv.Key.v "/foo") >>= fun r ->
+        if Result.is_error r then Alcotest.fail "failure digest outside";
+        Alcotest.(check bool) "Store.digest" false (String.equal digest (Result.get_ok r));
+        Lwt.return_unit));
+    Ok ()
+  with
+  | Ok () -> ()
+  | Error `Msg msg ->
+    print_endline ("got an error from bos: " ^ msg)
+
+let multiple_change_and_push () =
+  match
+    let* (tmpdir, pid) = empty_repo () in
+    Fun.protect ~finally:(fun () -> kill_git pid) (fun () ->
+    Lwt_main.run
+      (
+        Git_unix.ctx (Happy_eyeballs_lwt.create ()) >>= fun ctx ->
+        Git_kv.connect ctx ("git://localhost:9419/" ^ tmpdir) >>= fun t ->
+        let wait = Lwt_mvar.create_empty () in
+        let task_c () =
+          Store.change_and_push t (fun t''' ->
+              print_endline "running 3";
+              print_endline "running 3 - now get";
+              Store.get t''' (Mirage_kv.Key.v "/foo") >>= fun r ->
+              if Result.is_error r then failwith "failure reading foo in third change_and_push";
+              assert (String.equal "value 2" (Result.get_ok r));
+              print_endline "running 3 - now set";
+              Store.set t''' (Mirage_kv.Key.v "/foo") "value 3" >>= fun r ->
+              if Result.is_error r then failwith "failure writing foo in third change_and_push";
+              print_endline "running 3 - now get again";
+              Store.get t''' (Mirage_kv.Key.v "/foo") >>= fun r ->
+              if Result.is_error r then failwith "failure reading foo in third change_and_push adter the write";
+              assert (String.equal "value 3" (Result.get_ok r));
+              print_endline "running 3 - now finished";
+              Lwt.return_unit) >>= fun r ->
+          if Result.is_error r then failwith "failure second change_and_push";
+          Lwt_mvar.put wait ()
+        in
+        let task_b () =
+          Store.change_and_push t (fun t'' ->
+              print_endline "running 2";
+              Lwt.async task_c;
+              print_endline "running 2 - now get";
+              Store.get t'' (Mirage_kv.Key.v "/foo") >>= fun r ->
+              if Result.is_error r then failwith "failure reading foo in second change_and_push";
+              assert (String.equal "value" (Result.get_ok r));
+              print_endline "running 2 - now set";
+              Store.set t'' (Mirage_kv.Key.v "/foo") "value 2" >>= fun r ->
+              if Result.is_error r then failwith "failure writing foo in second change_and_push";
+              print_endline "running 2 - now get again";
+              Store.get t'' (Mirage_kv.Key.v "/foo") >>= fun r ->
+              if Result.is_error r then failwith "failure reading foo in second change_and_push adter the write";
+              assert (String.equal "value 2" (Result.get_ok r));
+              print_endline "running 2 - finished";
+              Lwt.return_unit) >|= fun r ->
+          if Result.is_error r then failwith "failure second change_and_push"
+        in
+        let task_a () =
+          Store.change_and_push t (fun t' ->
+               print_endline "running 1";
+               Lwt.async task_b;
+               print_endline "running 1 - now set";
+               Store.set t' (Mirage_kv.Key.v "/foo") "value" >>= fun r ->
+               if Result.is_error r then Alcotest.fail "failure writing foo in first change_and_push";
+               print_endline "running 1 - now get";
+               Store.get t' (Mirage_kv.Key.v "/foo") >>= fun r ->
+               if Result.is_error r then Alcotest.fail "failure reading foo in first change_and_push, after the write";
+               Alcotest.(check string) "Store.get foo" "value" (Result.get_ok r);
+               print_endline "running 1 - finished";
+               Lwt.return_unit) >|= fun r ->
+          if Result.is_error r then Alcotest.fail "failure first change_and_push"
+        in
+        task_a () >>= fun () ->
+        Lwt_mvar.take wait >>= fun () ->
+        Store.get t (Mirage_kv.Key.v "/foo") >|= fun r ->
+        if Result.is_error r then Alcotest.fail "failure reading outside foo";
+        Alcotest.(check string) "Store.get bar" "value 3" (Result.get_ok r)));
+    Ok ()
+  with
+  | Ok () -> ()
+  | Error `Msg msg ->
+    print_endline ("got an error from bos: " ^ msg)
+
+let basic_tests = [
+  "Read in change_and_push", `Quick, read_in_change_and_push ;
+  "Set outside change_and_push", `Quick, set_outside_change_and_push ;
+  "Remove in change_and_push", `Quick, remove_in_change_and_push ;
+  "Last modified in change_and_push", `Quick, last_modified_in_change_and_push ;
+  "Digest in change_and_push", `Quick, digest_in_change_and_push ;
+  "Multiple change_and_push", `Quick, multiple_change_and_push ;
+]
+
+let tests = [
+  "Basic tests", basic_tests ;
+]
+
+let () = Alcotest.run "Git-KV alcotest tests" tests