Implement {set,remove,rename}_and_push and delete push function

All of these actions "shallow" the last commit. A subsequent `push`
will do nothing due to that incapacity to walk through the history
due to the shallowed commit. To be able to push the last change,
we must provide {set,remove,rename} functions with an explicit
call to push **before** the "shallow".

src/git_kv.ml

@@ -92,12 +92,6 @@ let pull t =
     t.head <- Some head;
     Lwt.return (Ok diff)
 
-let push t =
-  let open Lwt.Infix in
-  Sync.push ~capabilities ~ctx:t.ctx t.edn t.store [ `Update (t.branch, t.branch) ]
-  >|= Result.map_error (fun err -> `Msg (Fmt.str "error pushing branch %a: %a"
-    Git.Reference.pp t.branch Sync.pp_error err))
-
 let connect ctx endpoint =
   let open Lwt.Infix in
   init_store () >>= fun store ->
@@ -486,7 +480,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
           unroll_tree t ?head (name, hash) rest
           | _ -> assert false )
   
-  let set t key contents =
+  let set ?(push= false) t key contents =
     let segs = Mirage_kv.Key.segments key in
     let now () = Int64.of_float (Ptime.to_float_s (Ptime.v (Pclock.now_d_ps ()))) in
     match segs with
@@ -504,6 +498,11 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
       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, _) ->
+      Lwt.Infix.(if push then 
+        Sync.push ~capabilities ~ctx:t.ctx t.edn t.store [ `Update (t.branch, t.branch) ]
+        >|= Result.map_error (fun err -> `Msg (Fmt.str "error pushing branch %a: %a"
+          Git.Reference.pp t.branch Sync.pp_error err))
+        else Lwt.return_ok ()) >>= fun () ->
       Lwt.Infix.(Store.shallow t.store hash >|= Result.ok) >>= fun () ->
       t.head <- Some hash ; Lwt.return_ok ()
   
@@ -513,9 +512,9 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
     | `Msg err -> `Msg err
     | err -> Rresult.R.msgf "%a" Store.pp_error err
   
-  let set t key contents =
+  let set ?push t key contents =
     let open Lwt.Infix in
-    set t key contents >|= Rresult.R.reword_error to_write_error
+    set ?push t key contents >|= Rresult.R.reword_error to_write_error
   
   let set_partial t key ~offset chunk =
     let open Lwt_result.Infix in
@@ -529,7 +528,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
   
   let batch t ?retries:_ f = f t
   
-  let remove t key =
+  let remove ?(push= false) t key =
     let segs = Mirage_kv.Key.segments key in
     let now () = Int64.of_float (Ptime.to_float_s (Ptime.v (Pclock.now_d_ps ()))) in
     match List.rev segs, t.head with
@@ -548,6 +547,11 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
       let commit = Store.Value.Commit.make ~tree:tree_root_hash ~author ~committer
         ~parents:[ head ] (Some "Committed by git-kv") in
       Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) ->
+      Lwt.Infix.(if push then 
+        Sync.push ~capabilities ~ctx:t.ctx t.edn t.store [ `Update (t.branch, t.branch) ]
+        >|= Result.map_error (fun err -> `Msg (Fmt.str "error pushing branch %a: %a"
+          Git.Reference.pp t.branch Sync.pp_error err))
+        else Lwt.return_ok ()) >>= fun () ->
       Lwt.Infix.(Store.shallow t.store hash >|= Result.ok) >>= fun () ->
       t.head <- Some hash ; Lwt.return_ok ()
     | name :: pred_name :: rest, Some head ->
@@ -565,18 +569,30 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
           let commit = Store.Value.Commit.make ~tree:tree_root_hash ~author ~committer
             ~parents:[ head ] (Some "Committed by git-kv") in
           Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) ->
+          Lwt.Infix.(if push then 
+            Sync.push ~capabilities ~ctx:t.ctx t.edn t.store [ `Update (t.branch, t.branch) ]
+            >|= Result.map_error (fun err -> `Msg (Fmt.str "error pushing branch %a: %a"
+              Git.Reference.pp t.branch Sync.pp_error err))
+            else Lwt.return_ok ()) >>= fun () ->
           Lwt.Infix.(Store.shallow t.store hash >|= Result.ok) >>= fun () ->
           t.head <- Some hash ; Lwt.return_ok ()
         | _ -> Lwt.return_ok ()
   
-  let remove t key =
+  let remove ?push t key =
     let open Lwt.Infix in
-    remove t key >|= Rresult.R.reword_error to_write_error
+    remove ?push t key >|= Rresult.R.reword_error to_write_error
   
-  let rename t ~source ~dest =
+  let rename ?(push= false) t ~source ~dest =
     (* TODO(dinosaure): optimize it! It was done on the naive way. *)
     let open Lwt_result.Infix in
     get t source >>= fun contents ->
-    remove t source >>= fun () ->
+    remove ~push t source >>= fun () ->
-    set t dest contents
+    set ~push t dest contents
+
+  let set_and_push t k v = set ~push:true t k v
+  let set t k v = set ~push:false t k v
+  let remove_and_push t k = remove ~push:true t k
+  let remove t k = remove ~push:false t k
+  let rename_and_push t ~source ~dest = rename ~push:true t ~source ~dest
+  let rename t ~source ~dest = rename ~push:false t ~source ~dest
 end

src/git_kv.mli

@@ -51,16 +51,6 @@ val pull : t -> (change list, [> `Msg of string ]) result Lwt.t
     [store] Git repository. It returns a list of changes between the old state
     of your store and what you have remotely. *)
 
-val push : t -> (unit, [> `Msg of string ]) result Lwt.t
-(** [push store] tries to push any changes from your local Git repository
-    [store] to the remoe Git repository. The [push] function can fails for many
-    reasons. Currently, we don't handle merge politics and how we can resolve
-    conflicts between local and remote Git repositories. That mostly means that
-    if you are the only one who push to the Git repository (into a specific
-    branch), everything should be fine. But, if someone else push into the same
-    remote Git repository, your change can be discarded by the remote server
-    (due to conflicts). *)
-
 module Make (Pclock : Mirage_clock.PCLOCK) : sig
   include Mirage_kv.RW
     with type t = t
@@ -68,4 +58,8 @@ module Make (Pclock : Mirage_clock.PCLOCK) : sig
                             | `Hash_not_found of Digestif.SHA1.t
                             | `Reference_not_found of Git.Reference.t
                             | Mirage_kv.write_error ]
+
+  val set_and_push : t -> key -> string -> (unit, write_error) result Lwt.t
+  val remove_and_push : t -> key -> (unit, write_error) result Lwt.t
+  val rename_and_push : t -> source:key -> dest:key -> (unit, write_error) result Lwt.t
 end