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

Add the compression level argument into to_octets

Browse source
This commit is contained in:
Calascibetta Romain 2023-06-13 14:48:31 +02:00 committed by Hannes Mehnert
parent 033c6bb800
commit 1264fdad0a
3 changed files with 14 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
git-kv.opam
View file

@ -13,6 +13,7 @@ depends: [
"git" {>= "3.10.0"} "git" {>= "3.10.0"}
"mirage-kv" {>= "6.0.0"} "mirage-kv" {>= "6.0.0"}
"carton" {>= "0.6.0"} "carton" {>= "0.6.0"}
"carton-lwt" {>= "0.6.0"}
"fmt" {>= "0.8.7"} "fmt" {>= "0.8.7"}
"mirage-clock" {>= "2.0.0"} "mirage-clock" {>= "2.0.0"}
"ptime" "ptime"
@ -27,3 +28,8 @@ build: [
["dune" "build" "-p" name "-j" jobs] ["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test} ["dune" "runtest" "-p" name "-j" jobs] {with-test}
] ]
pin-depends: [
[ "carton.dev" "git+https://github.com/mirage/ocaml-git.git#98e15fda0b3f0d51fa215a56ffee808a83849765" ]
[ "carton-lwt.dev" "git+https://github.com/mirage/ocaml-git.git#98e15fda0b3f0d51fa215a56ffee808a83849765" ]
]

8
src/git_kv.ml
View file

@ -183,7 +183,7 @@ let ( >>? ) x f = let open Lwt.Infix in match x with
| None -> Lwt.return_none | None -> Lwt.return_none
let ( >>! ) x f = Lwt.Infix.(x >>= f) let ( >>! ) x f = Lwt.Infix.(x >>= f)
let pack t ~commit stream = let pack t ?(level= 4) ~commit stream =
let open Lwt.Infix in let open Lwt.Infix in
let load t hash = let load t hash =
Store.read_inflated t hash >|= function Store.read_inflated t hash >|= function
@ -227,7 +227,7 @@ let pack t ~commit stream =
| Some None -> failwith "Try to encode an OBJ_REF object" (* XXX(dinosaure): should never occur! *) | Some None -> failwith "Try to encode an OBJ_REF object" (* XXX(dinosaure): should never occur! *)
| Some (Some (_ (* offset *) : int)) | None -> | Some (Some (_ (* offset *) : int)) | None ->
Hashtbl.add offsets (Carton.Enc.target_uid targets.(idx)) !cursor ; Hashtbl.add offsets (Carton.Enc.target_uid targets.(idx)) !cursor ;
Carton_lwt.Enc.encode_target ~b ~find ~load:(load t) ~uid targets.(idx) ~cursor:(Int64.to_int !cursor) Carton_lwt.Enc.encode_target ~level ~b ~find ~load:(load t) ~uid targets.(idx) ~cursor:(Int64.to_int !cursor)
>>= fun (len, encoder) -> >>= fun (len, encoder) ->
let payload = Bigstringaf.substring b.o ~off:0 ~len in let payload = Bigstringaf.substring b.o ~off:0 ~len in
stream (Some payload) ; stream (Some payload) ;
@ -254,7 +254,7 @@ let pack t ~commit stream =
stream None ; stream None ;
Lwt.return_unit Lwt.return_unit
let to_octets t = match t.head with let to_octets ?level t = match t.head with
| None -> | None ->
Lwt.return "PACK\000\000\000\002\000\000\000\000\ Lwt.return "PACK\000\000\000\002\000\000\000\000\
\x02\x9d\x08\x82\x3b\xd8\xa8\xea\xb5\x10\xad\x6a\xc7\x5c\x82\x3c\xfd\x3e\xd3\x1e" \x02\x9d\x08\x82\x3b\xd8\xa8\xea\xb5\x10\xad\x6a\xc7\x5c\x82\x3c\xfd\x3e\xd3\x1e"
@ -262,7 +262,7 @@ let to_octets t = match t.head with
let buf = Buffer.create 0x100 in let buf = Buffer.create 0x100 in
let stream = Option.iter (Buffer.add_string buf) in let stream = Option.iter (Buffer.add_string buf) in
let open Lwt.Infix in let open Lwt.Infix in
pack t.store ~commit stream >|= fun () -> pack ?level t.store ~commit stream >|= fun () ->
Buffer.contents buf Buffer.contents buf
(* XXX(dinosaure): we have the full-control between [to_octets]/[of_octets] (* XXX(dinosaure): we have the full-control between [to_octets]/[of_octets]

6
src/git_kv.mli
View file

@ -43,8 +43,10 @@ val connect : Mimic.ctx -> string -> t Lwt.t
val branch : t -> Git.Reference.t val branch : t -> Git.Reference.t
(** [branch t] returns the branch used by the given [t]. *) (** [branch t] returns the branch used by the given [t]. *)
val to_octets : t -> string Lwt.t val to_octets : ?level:int -> t -> string Lwt.t
(** [to_octets store] returns a serialized version of the given [store]. *) (** [to_octets ?level store] returns a serialized version of the given [store].
[level] is the {i zlib} level compression used for Git object (between [0]
and [9] including). *)
val of_octets : Mimic.ctx -> remote:string -> string -> val of_octets : Mimic.ctx -> remote:string -> string ->
(t, [> `Msg of string]) result Lwt.t (t, [> `Msg of string]) result Lwt.t