robur/git-kv
4
0
Fork 0
Code Issues Pull requests 1 Projects Releases Packages Wiki Activity Actions

Don't try to push if the tree_root still is the same

Browse source 
If the user just read into the batched function and does not change anything,
we just return the result.
This commit is contained in:
Romain Calascibetta 2022-10-29 22:30:12 +02:00
parent b5fa25d9a5
commit 64fc2402ab
1 changed files with 20 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
src/git_kv.ml
View file

@ -630,23 +630,26 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
(* XXX(dinosaure): we assume that only [batch] can reset [t.committed] to [None] and (* XXX(dinosaure): we assume that only [batch] can reset [t.committed] to [None] and
we ensured that [batch] can not be called into [f]. So we are sure that [t'.committed] we ensured that [batch] can not be called into [f]. So we are sure that [t'.committed]
must be [Some _] in anyway. *) must be [Some _] in anyway. *)
let[@warning "-8"] Some (tree_root_hash, _) = t'.committed in let[@warning "-8"] Some (new_tree_root_hash, _) = t'.committed in
let action = Option.fold ~none:(`Create t.branch) ~some:(fun _ -> `Update (t.branch, t.branch)) t.head in if Digestif.SHA1.equal new_tree_root_hash tree_root_hash
let parents = Option.value ~default:[] (Option.map (fun head -> [ head ]) t.head) in then Lwt.return_ok res (* XXX(dinosaure): nothing to send! *)
let committer = author ~now in else
let author = author ~now in let action = Option.fold ~none:(`Create t.branch) ~some:(fun _ -> `Update (t.branch, t.branch)) t.head in
let commit = Store.Value.Commit.make ~tree:tree_root_hash ~author ~committer let parents = Option.value ~default:[] (Option.map (fun head -> [ head ]) t.head) in
~parents (Some "Committed by git-kv") in let committer = author ~now in
Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) -> let author = author ~now in
t.head <- Some hash ; let commit = Store.Value.Commit.make ~tree:new_tree_root_hash ~author ~committer
Store.Ref.write t.store t.branch (Git.Reference.uid hash) >>= fun () -> ~parents (Some "Committed by git-kv") in
Lwt.Infix.(Sync.push ~capabilities ~ctx:t.ctx t.edn t.store [ action ] Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) ->
>|= Result.map_error (fun err -> t.head <- Some hash ;
`Msg (Fmt.str "error pushing branch %a: %a" Store.Ref.write t.store t.branch (Git.Reference.uid hash) >>= fun () ->
Git.Reference.pp t.branch Sync.pp_error err)) Lwt.Infix.(Sync.push ~capabilities ~ctx:t.ctx t.edn t.store [ action ]
>>? fun () -> >|= Result.map_error (fun err ->
Store.shallow t.store hash >|= Result.ok) >>= fun () -> `Msg (Fmt.str "error pushing branch %a: %a"
Lwt.return_ok res ) Git.Reference.pp t.branch Sync.pp_error err))
>>? fun () ->
Store.shallow t.store hash >|= Result.ok) >>= fun () ->
Lwt.return_ok res )
>|= Rresult.R.reword_error (msgf "%a" Store.pp_error) >|= Rresult.R.reword_error (msgf "%a" Store.pp_error)
>|= Rresult.R.failwith_error_msg >>= fun res -> >|= Rresult.R.failwith_error_msg >>= fun res ->
Lwt.wakeup_later wk () ; Lwt.wakeup_later wk () ;