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

Merge pull request 'Functorize with PCLOCK' (#15) from functorize-pclock into main

Browse source 
Reviewed-on: https://git.robur.io/robur/git-kv/pulls/15
This commit is contained in:
dinosaure 2022-10-19 13:20:09 +00:00
commit 781bc5b2d9
8 changed files with 330 additions and 245 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
.gitignore vendored Normal file
View file

@ -0,0 +1,11 @@
_build
setup.data
setup.log
doc/*.html
*.native
*.byte
*.so
*.tar.gz
_tests
*.merlin
*.install

17
.ocamlformat Normal file
View file

@ -0,0 +1,17 @@
version=0.23.0
profile=conventional
break-struct=natural
break-infix=fit-or-vertical
break-sequences=false
break-collection-expressions=wrap
break-separators=before
exp-grouping=preserve
parens-tuple=multi-line-only
space-around-lists=false
space-around-records=false
space-around-arrays=false
break-fun-decl=smart
cases-exp-indent=2
sequence-style=before
field-space=tight
break-before-in=auto

2
app/dune
View file

@ -1,4 +1,4 @@
(executable
(name mgit)
(public_name mgit)
(libraries logs.fmt fmt.tty git-unix git-kv))
(libraries mirage-clock-unix logs.fmt fmt.tty git-unix git-kv))

9
app/mgit.ml
View file

@ -1,4 +1,5 @@
let () = Printexc.record_backtrace true
module Store = Git_kv.Make (Pclock)
let reporter ppf =
let report src level ~over k msgf =
@ -25,17 +26,17 @@ open Rresult
open Lwt.Infix
let get ~quiet store key =
Git_kv.get store key >>= function
Store.get store key >>= function
| Ok contents when not quiet ->
Fmt.pr "@[<hov>%a@]\n%!" (Hxd_string.pp Hxd.default) contents ;
Lwt.return (Ok 0)
| Ok _ -> Lwt.return (Ok 0)
| Error err ->
if not quiet then Fmt.epr "%a.\n%!" Git_kv.pp_error err ;
if not quiet then Fmt.epr "%a.\n%!" Store.pp_error err ;
Lwt.return (Ok 1)
let list ~quiet store key =
Git_kv.list store key >>= function
Store.list store key >>= function
| Ok lst when not quiet ->
List.iter (fun (name, k) -> match k with
| `Dictionary -> Fmt.pr "d %s\n%!" name
@ -43,7 +44,7 @@ let list ~quiet store key =
Lwt.return (Ok 0)
| Ok _ -> Lwt.return (Ok 0)
| Error err ->
if not quiet then Fmt.epr "%a.\n%!" Git_kv.pp_error err ;
if not quiet then Fmt.epr "%a.\n%!" Store.pp_error err ;
Lwt.return (Ok 1)
let pull ~quiet store =

10
git-kv.opam
View file

@ -7,11 +7,13 @@ bug-reports: "https://git.robur.io/robur/git-kv"
synopsis: "A Mirage_kv implementation using git"
depends: [
"ocaml" {>= "4.08.0"}
"dune" {>= "2.0.0"}
"git" {>= "3.9.0"}
"mirage-kv" {>= "4.0.0"}
"ocaml" {>= "4.08.0"}
"dune" {>= "2.0.0"}
"git" {>= "3.9.0"}
"mirage-kv" {>= "4.0.0"}
"git-unix"
"mirage-clock-unix"
"mirage-clock"
"ptime"
]

2
src/dune
View file

@ -2,4 +2,4 @@
(name git_kv)
(public_name git-kv)
(flags (-w -32))
(libraries git ptime mirage-kv))
(libraries git ptime mirage-clock mirage-kv))

437
src/git_kv.ml
View file

@ -116,21 +116,6 @@ type change = [
| `Change of key
]
type error = Mirage_kv.error
type write_error = [ `Msg of string
| `Hash_not_found of Digestif.SHA1.t
| `Reference_not_found of Git.Reference.t
| Mirage_kv.write_error ]
let pp_error ppf = Mirage_kv.pp_error ppf
let pp_write_error ppf = function
| #Mirage_kv.write_error as err -> Mirage_kv.pp_write_error ppf err
| `Reference_not_found _ | `Msg _ as err -> Store.pp_error ppf err
| `Hash_not_found hash -> Store.pp_error ppf (`Not_found hash)
let disconnect _t = Lwt.return_unit
module SHA1 = struct
include Digestif.SHA1
@ -356,218 +341,240 @@ let of_octets ctx ~remote data =
(Printexc.raw_backtrace_to_string (Printexc.get_raw_backtrace ())) ;
Lwt.return_error (`Msg "Invalid PACK file"))
let exists t key =
let open Lwt.Infix in
match t.head with
| 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
| Blob _ -> Lwt.return (Ok (Some `Value))
| Tree _ | Commit _ | Tag _ -> Lwt.return (Ok (Some `Dictionary))
module Make (Pclock : Mirage_clock.PCLOCK) = struct
type nonrec t = t
type key = Mirage_kv.Key.t
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
| None -> Lwt.return (Error (`Not_found key))
| Some blob ->
Store.read_exn t.store blob >|= function
| Blob b -> Ok (Git.Blob.to_string b)
| _ -> Error (`Value_expected key)
type error = Mirage_kv.error
type write_error = [ `Msg of string
| `Hash_not_found of Digestif.SHA1.t
| `Reference_not_found of Git.Reference.t
| Mirage_kv.write_error ]
let get_partial t key ~offset ~length =
let open Lwt_result.Infix in
get t key >|= fun data ->
if String.length data < offset then
""
else
let l = min length (String.length data - offset) in
String.sub data offset l
let pp_error ppf = Mirage_kv.pp_error ppf
let disconnect _t = Lwt.return_unit
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
| None -> Lwt.return (Error (`Not_found key))
| Some tree ->
Store.read_exn t.store tree >>= function
| Tree t ->
Lwt_list.map_p (fun { Git.Tree.perm; name; _ } -> match perm with
| `Commit | `Dir -> Lwt.return (name, `Dictionary)
| `Everybody | `Exec | `Normal -> Lwt.return (name, `Value)
| `Link -> failwith "Unimplemented link follow")
(Store.Value.Tree.to_list t) >|= Result.ok
| _ -> Lwt.return (Error (`Dictionary_expected key))
let pp_write_error ppf = function
| #Mirage_kv.write_error as err -> Mirage_kv.pp_write_error ppf err
| `Reference_not_found _ | `Msg _ as err -> Store.pp_error ppf err
| `Hash_not_found hash -> Store.pp_error ppf (`Not_found hash)
let last_modified t key =
let open Lwt.Infix in
Option.fold
~none:(Lwt.return (Error (`Not_found key)))
~some:(fun head ->
Store.read_exn t.store head >|= function
| Commit c ->
let author = Git_commit.author c in
let secs, tz_offset = author.Git.User.date in
let secs =
Option.fold ~none:secs
~some:(fun { Git.User.sign ; hours ; minutes } ->
let tz_off = Int64.(mul (add (mul (of_int hours) 60L) (of_int minutes)) 60L) in
match sign with
| `Plus -> Int64.(sub secs tz_off)
| `Minus -> Int64.(add secs tz_off))
tz_offset
in
let ts =
Option.fold ~none:Ptime.epoch ~some:Fun.id (Ptime.of_float_s (Int64.to_float secs))
in
Ok (Ptime.(Span.to_d_ps (to_span ts)))
| _ -> assert false)
t.head
let digest t key =
Option.fold
~none:(Error (`Not_found key))
~some:(fun x -> Ok (Store.Hash.to_hex x))
t.head |> Lwt.return
let size t key =
let open Lwt_result.Infix in
get t key >|= fun data ->
String.length data
let author ~now =
{ Git.User.name= "Git KV"
; email= "git@mirage.io"
; date= now (), None }
let rec unroll_tree t ?head (pred_name, pred_hash) rpath =
let open Lwt.Infix in
let ( >>? ) = Lwt_result.bind in
let ( >>! ) x f = match x with
| Some x -> f x
| None -> Lwt.return_none in
match rpath with
| [] ->
( match head with
| None ->
let tree = Git.Tree.(v [ entry ~name:pred_name `Dir pred_hash ]) in
Store.write t.store (Git.Value.Tree tree) >>? fun (hash, _) -> Lwt.return_ok hash
let exists t key =
let open Lwt.Infix in
match t.head with
| None -> Lwt.return (Ok None)
| Some head ->
Search.find t.store head (`Commit (`Path [])) >|= Option.get >>= fun tree_root_hash ->
( Store.read_exn t.store tree_root_hash >>= function
| Git.Value.Tree tree ->
let tree = Git.Tree.(add (entry ~name:pred_name `Dir pred_hash) (remove ~name:pred_name tree)) in
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
| 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
| None -> Lwt.return (Error (`Not_found key))
| Some blob ->
Store.read_exn t.store blob >|= function
| Blob b -> Ok (Git.Blob.to_string b)
| _ -> Error (`Value_expected key)
let get_partial t key ~offset ~length =
let open Lwt_result.Infix in
get t key >|= fun data ->
if String.length data < offset then
""
else
let l = min length (String.length data - offset) in
String.sub data offset l
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
| None -> Lwt.return (Error (`Not_found key))
| Some tree ->
Store.read_exn t.store tree >>= function
| Tree t ->
Lwt_list.map_p (fun { Git.Tree.perm; name; _ } -> match perm with
| `Commit | `Dir -> Lwt.return (name, `Dictionary)
| `Everybody | `Exec | `Normal -> Lwt.return (name, `Value)
| `Link -> failwith "Unimplemented link follow")
(Store.Value.Tree.to_list t) >|= Result.ok
| _ -> Lwt.return (Error (`Dictionary_expected key))
let last_modified t key =
let open Lwt.Infix in
Option.fold
~none:(Lwt.return (Error (`Not_found key)))
~some:(fun head ->
Store.read_exn t.store head >|= function
| Commit c ->
let author = Git_commit.author c in
let secs, tz_offset = author.Git.User.date in
let secs =
Option.fold ~none:secs
~some:(fun { Git.User.sign ; hours ; minutes } ->
let tz_off = Int64.(mul (add (mul (of_int hours) 60L) (of_int minutes)) 60L) in
match sign with
| `Plus -> Int64.(sub secs tz_off)
| `Minus -> Int64.(add secs tz_off))
tz_offset
in
let ts =
Option.fold ~none:Ptime.epoch ~some:Fun.id (Ptime.of_float_s (Int64.to_float secs))
in
Ok (Ptime.(Span.to_d_ps (to_span ts)))
| _ -> assert false)
t.head
let digest t key =
Option.fold
~none:(Error (`Not_found key))
~some:(fun x -> Ok (Store.Hash.to_hex x))
t.head |> Lwt.return
let size t key =
let open Lwt_result.Infix in
get t key >|= fun data ->
String.length data
let author ~now =
{ Git.User.name= "Git KV"
; email= "git@mirage.io"
; date= now (), None }
let rec unroll_tree t ?head (pred_name, pred_hash) rpath =
let open Lwt.Infix in
let ( >>? ) = Lwt_result.bind in
let ( >>! ) x f = match x with
| Some x -> f x
| None -> Lwt.return_none in
match rpath with
| [] ->
( match head with
| None ->
let tree = Git.Tree.(v [ entry ~name:pred_name `Dir pred_hash ]) in
Store.write t.store (Git.Value.Tree tree) >>? fun (hash, _) -> Lwt.return_ok hash
| _ -> assert false ) )
| name :: rest ->
(head >>! fun head -> Search.find t.store head (`Commit (`Path (List.rev rpath)))) >>= function
| None ->
let tree = Git.Tree.(v [ entry ~name:pred_name `Dir pred_hash ]) in
Store.write t.store (Git.Value.Tree tree) >>? fun (hash, _) ->
unroll_tree t ?head (name, hash) rest
| Some tree_hash ->
( Store.read_exn t.store tree_hash >>= function
| Git.Value.Tree tree ->
let tree = Git.Tree.(add (entry ~name:pred_name `Dir pred_hash) (remove ~name:pred_name tree)) in
| Some head ->
Search.find t.store head (`Commit (`Path [])) >|= Option.get >>= fun tree_root_hash ->
( Store.read_exn t.store tree_root_hash >>= function
| Git.Value.Tree tree ->
let tree = Git.Tree.(add (entry ~name:pred_name `Dir pred_hash) (remove ~name:pred_name tree)) in
Store.write t.store (Git.Value.Tree tree) >>? fun (hash, _) -> Lwt.return_ok hash
| _ -> assert false ) )
| name :: rest ->
(head >>! fun head -> Search.find t.store head (`Commit (`Path (List.rev rpath)))) >>= function
| None ->
let tree = Git.Tree.(v [ entry ~name:pred_name `Dir pred_hash ]) in
Store.write t.store (Git.Value.Tree tree) >>? fun (hash, _) ->
unroll_tree t ?head (name, hash) rest
| _ -> assert false )
| Some tree_hash ->
( Store.read_exn t.store tree_hash >>= function
| Git.Value.Tree tree ->
let tree = Git.Tree.(add (entry ~name:pred_name `Dir pred_hash) (remove ~name:pred_name tree)) in
Store.write t.store (Git.Value.Tree tree) >>? fun (hash, _) ->
unroll_tree t ?head (name, hash) rest
| _ -> assert false )
let set t key contents =
let segs = Mirage_kv.Key.segments key in
let now () = 0L (* TODO(dinosaure): functorize? *) in
match segs with
| [] -> assert false
| path ->
let blob = Git.Blob.of_string contents in
let rpath = List.rev path in
let name = List.hd rpath in
let open Lwt_result.Infix in
Store.write t.store (Git.Value.Blob blob) >>= fun (hash, _) ->
unroll_tree t ?head:t.head (name, hash) (List.tl rpath) >>= fun tree_root_hash ->
let committer = author ~now in
let author = author ~now in
let parents = Option.value ~default:[] (Option.map (fun head -> [ head ]) 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, _) ->
t.head <- Some hash ; Lwt.return_ok ()
let set 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
| [] -> assert false
| path ->
let blob = Git.Blob.of_string contents in
let rpath = List.rev path in
let name = List.hd rpath in
let open Lwt_result.Infix in
Store.write t.store (Git.Value.Blob blob) >>= fun (hash, _) ->
unroll_tree t ?head:t.head (name, hash) (List.tl rpath) >>= fun tree_root_hash ->
let committer = author ~now in
let author = author ~now in
let parents = Option.value ~default:[] (Option.map (fun head -> [ head ]) 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, _) ->
Lwt.Infix.(Store.shallow t.store hash >|= Result.ok) >>= fun () ->
t.head <- Some hash ; Lwt.return_ok ()
let to_write_error (error : Store.error) = match error with
| `Not_found hash -> `Hash_not_found hash
| `Reference_not_found ref -> `Reference_not_found ref
| `Msg err -> `Msg err
| err -> Rresult.R.msgf "%a" Store.pp_error err
let to_write_error (error : Store.error) = match error with
| `Not_found hash -> `Hash_not_found hash
| `Reference_not_found ref -> `Reference_not_found ref
| `Msg err -> `Msg err
| err -> Rresult.R.msgf "%a" Store.pp_error err
let set t key contents =
let open Lwt.Infix in
set t key contents >|= Rresult.R.reword_error to_write_error
let set_partial t key ~offset chunk =
let open Lwt_result.Infix in
get t key >>= fun contents ->
let len = String.length contents in
let add = String.length chunk in
let res = Bytes.make (max len (offset + add)) '\000' in
Bytes.blit_string contents 0 res 0 len ;
Bytes.blit_string chunk 0 res offset add ;
set t key (Bytes.unsafe_to_string res)
let batch t ?retries:_ f = f t
let remove t key =
let segs = Mirage_kv.Key.segments key in
let now () = 0L (* TODO(dinosaure): functorize? *) in
match List.rev segs, t.head with
| [], _ -> assert false
| _, None -> Lwt.return_ok () (* XXX(dinosaure): or [`Not_found]? *)
| name :: [], Some head ->
let set t key contents =
let open Lwt.Infix in
Search.find t.store head (`Commit (`Path [])) >|= Option.get >>= fun tree_root_hash ->
Store.read_exn t.store tree_root_hash >>= fun tree_root ->
let[@warning "-8"] Git.Value.Tree tree_root = tree_root in
let tree_root = Git.Tree.remove ~name tree_root in
set t key contents >|= Rresult.R.reword_error to_write_error
let set_partial t key ~offset chunk =
let open Lwt_result.Infix in
Store.write t.store (Git.Value.Tree tree_root) >>= fun (tree_root_hash, _) ->
let committer = author ~now in
let author = author ~now in
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, _) ->
t.head <- Some hash ; Lwt.return_ok ()
| name :: pred_name :: rest, Some head ->
get t key >>= fun contents ->
let len = String.length contents in
let add = String.length chunk in
let res = Bytes.make (max len (offset + add)) '\000' in
Bytes.blit_string contents 0 res 0 len ;
Bytes.blit_string chunk 0 res offset add ;
set t key (Bytes.unsafe_to_string res)
let batch t ?retries:_ f = f t
let remove 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
| [], _ -> assert false
| _, None -> Lwt.return_ok () (* XXX(dinosaure): or [`Not_found]? *)
| name :: [], Some head ->
let open Lwt.Infix in
Search.find t.store head (`Commit (`Path [])) >|= Option.get >>= fun tree_root_hash ->
Store.read_exn t.store tree_root_hash >>= fun tree_root ->
let[@warning "-8"] Git.Value.Tree tree_root = tree_root in
let tree_root = Git.Tree.remove ~name tree_root in
let open Lwt_result.Infix in
Store.write t.store (Git.Value.Tree tree_root) >>= fun (tree_root_hash, _) ->
let committer = author ~now in
let author = author ~now in
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.(Store.shallow t.store hash >|= Result.ok) >>= fun () ->
t.head <- Some hash ; Lwt.return_ok ()
| name :: pred_name :: rest, Some head ->
let open Lwt.Infix in
Search.find t.store head (`Commit (`Path (List.rev (pred_name :: rest)))) >>= function
| None -> Lwt.return_ok ()
| Some hash -> Store.read_exn t.store hash >>= function
| Git.Value.Tree tree ->
let tree = Git.Tree.remove ~name tree in
let open Lwt_result.Infix in
Store.write t.store (Git.Value.Tree tree) >>= fun (pred_hash, _) ->
unroll_tree t ~head (pred_name, pred_hash) rest >>= fun tree_root_hash ->
let committer = author ~now in
let author = author ~now in
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.(Store.shallow t.store hash >|= Result.ok) >>= fun () ->
t.head <- Some hash ; Lwt.return_ok ()
| _ -> Lwt.return_ok ()
let remove t key =
let open Lwt.Infix in
Search.find t.store head (`Commit (`Path (List.rev (pred_name :: rest)))) >>= function
| None -> Lwt.return_ok ()
| Some hash -> Store.read_exn t.store hash >>= function
| Git.Value.Tree tree ->
let tree = Git.Tree.remove ~name tree in
let open Lwt_result.Infix in
Store.write t.store (Git.Value.Tree tree) >>= fun (pred_hash, _) ->
unroll_tree t ~head (pred_name, pred_hash) rest >>= fun tree_root_hash ->
let committer = author ~now in
let author = author ~now in
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, _) ->
t.head <- Some hash ; Lwt.return_ok ()
| _ -> Lwt.return_ok ()
remove t key >|= Rresult.R.reword_error to_write_error
let remove t key =
let open Lwt.Infix in
remove t key >|= Rresult.R.reword_error to_write_error
let rename 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 () ->
set t dest contents
let rename 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 () ->
set t dest contents
end

75
src/git_kv.mli
View file

@ -1,26 +1,73 @@
(* The idea is to provide a Mirage_kv.RW interface that is backed by a git
repository. The git repository is always (manually) kept in sync with the
remote one: either this is the only writer (and thus only set/remove
operations need to be pushed, or the API client receives a callback that
some update was done, and proceeds with a pull. *)
(** {1: A Git key-value store.}
include Mirage_kv.RW
with type write_error = [ `Msg of string
| `Hash_not_found of Digestif.SHA1.t
| `Reference_not_found of Git.Reference.t
| Mirage_kv.write_error ]
This module implements the ability to manipulate a Git repository as a
Key-Value store. It allows you to create a local (in-memory) Git repository
that can come from either:
- a remote Git repository
- a state serialized by the {!val:to_octets} function
The first case is interesting if you want to be synchronised with the
remote repository. The second case can be interesting if we {b don't} want
to create a connection at the beginning and desynchronisation between our
local and remote repositories {b is not} a problem.
In the second case, the synchronisation can be done later with {!val:pull}.
As far as {!val:push} is concerned, a synchronisation with the remote
repository is necessary before {b changing} and sending the new information
(a use of {!val:Make.set}/{!val:Make.rename} should be preceded by a
{!val:pull}). This is because we do not handle conflicts that may exist
between your local repository and the remote repository - in other words,
if you want to ensure consistency between reading ({!val:pull}) and writing
({!val:push}) to a remote repository, the instance that uses this code
should be the only one to handle said remote repository. *)
type t
(** The type of the Git store. *)
val connect : Mimic.ctx -> string -> t Lwt.t
(** [connect ctx remote] creates a new Git store which synchronizes
with [remote] {i via} protocols available into the given [ctx].
@raise [Invalid_argument _] if we can not initialize the store, or if
we can not fetch the given [remote]. *)
val to_octets : t -> string Lwt.t
(** [to_octets store] returns a serialized version of the given [store]. *)
val of_octets : Mimic.ctx -> remote:string -> string ->
(t, [> `Msg of string]) result Lwt.t
(** [of_octets ctx ~remote contents] tries to re-create a {!type:t} from its
serialized version [contents]. This function does not do I/O and the
returned {!type:t} can be out of sync with the given [remote]. We advise
to call {!val:pull} to be in-sync with [remote]. *)
type change = [ `Add of key
| `Remove of key
| `Change of key ]
type change = [ `Add of Mirage_kv.Key.t
| `Remove of Mirage_kv.Key.t
| `Change of Mirage_kv.Key.t ]
val pull : t -> (change list, [> `Msg of string ]) result Lwt.t
(** [pull store] tries to synchronize the remote Git repository with your local
[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
val size : t -> key -> (int, error) 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
and type write_error = [ `Msg of string
| `Hash_not_found of Digestif.SHA1.t
| `Reference_not_found of Git.Reference.t
| Mirage_kv.write_error ]
val size : t -> key -> (int, error) result Lwt.t
end