[WIP] Implement Git Wire Protocol v2

fuzz/dune

@@ -11,7 +11,7 @@
 (executable
  (name smart)
  (modules smart)
- (libraries fmt crowbar digestif.c git.nss.smart))
+ (libraries capability fmt crowbar digestif.c git.nss.smart))
 
 (rule
  (alias runtest)

fuzz/smart.ml

@@ -52,7 +52,7 @@ let ( >>= ) = Crowbar.dynamic_bind
 
 let () =
   let of_string str =
-    let ctx = Smart.Context.make [] in
+    let ctx = Smart.Context.make ~client_caps:[] in
     let state =
       Smart.decode ctx (Smart.packet ~trim:false) (fun _ctx res -> Return res)
     in
@@ -85,7 +85,7 @@ let () =
 
 let () =
   let of_string str =
-    let ctx = Smart.Context.make [] in
+    let ctx = Smart.Context.make ~client_caps:[] in
     let state =
       Smart.decode ctx Smart.advertised_refs (fun _ctx res -> Return res)
     in
@@ -105,7 +105,7 @@ let () =
     go state
   in
   let to_string v =
-    let ctx = Smart.Context.make [] in
+    let ctx = Smart.Context.make ~client_caps:[] in
     let buf = Buffer.create 0x1000 in
     let state =
       Smart.encode ctx Smart.send_advertised_refs v (fun _ctx ->

src/git/dune

@@ -1,7 +1,8 @@
 (library
  (name git)
  (public_name git)
- (libraries bigarray-compat mimic rresult git.nss.sigs git.nss.pck optint
-   loose decompress.de decompress.zl result git.nss.smart logs lwt cstruct
-   angstrom bigstringaf carton ke fmt checkseum git.nss.git git.nss.hkt
-   ocamlgraph astring fpath loose_git carton-lwt carton-git digestif encore))
+ (libraries bigarray-compat git.nss.capability mimic rresult git.nss.sigs
+   git.nss.pck optint loose decompress.de decompress.zl result git.nss.smart
+   logs lwt cstruct angstrom bigstringaf carton ke fmt checkseum git.nss.git
+   git.nss.hkt ocamlgraph astring fpath loose_git carton-lwt carton-git
+   digestif encore))

src/git/sync.ml

@@ -33,7 +33,7 @@ module type S = sig
     ctx:Mimic.ctx ->
     Smart_git.Endpoint.t ->
     store ->
-    ?version:[> `V1 ] ->
+    ?version:[> `V1 | `V2 ] ->
     ?capabilities:Smart.Capability.t list ->
     ?deepen:[ `Depth of int | `Timestamp of int64 ] ->
     [ `All | `Some of (Reference.t * Reference.t) list | `None ] ->
@@ -43,7 +43,7 @@ module type S = sig
     ctx:Mimic.ctx ->
     Smart_git.Endpoint.t ->
     store ->
-    ?version:[> `V1 ] ->
+    ?version:[> `V1 | `V2 ] ->
     ?capabilities:Smart.Capability.t list ->
     [ `Create of Reference.t
     | `Delete of Reference.t

src/git/sync.mli

@@ -32,7 +32,7 @@ module type S = sig
     ctx:Mimic.ctx ->
     Smart_git.Endpoint.t ->
     store ->
-    ?version:[> `V1 ] ->
+    ?version:[> `V1 | `V2 ] ->
     ?capabilities:Smart.Capability.t list ->
     ?deepen:[ `Depth of int | `Timestamp of int64 ] ->
     [ `All | `Some of (Reference.t * Reference.t) list | `None ] ->
@@ -42,7 +42,7 @@ module type S = sig
     ctx:Mimic.ctx ->
     Smart_git.Endpoint.t ->
     store ->
-    ?version:[> `V1 ] ->
+    ?version:[> `V1 | `V2 ] ->
     ?capabilities:Smart.Capability.t list ->
     [ `Create of Reference.t
     | `Delete of Reference.t
@@ -71,7 +71,7 @@ module Make
     ctx:Mimic.ctx ->
     Smart_git.Endpoint.t ->
     store ->
-    ?version:[> `V1 ] ->
+    ?version:[> `V1 | `V2 ] ->
     ?capabilities:Smart.Capability.t list ->
     ?deepen:[ `Depth of int | `Timestamp of int64 ] ->
     [ `All
@@ -98,7 +98,7 @@ module Make
     ctx:Mimic.ctx ->
     Smart_git.Endpoint.t ->
     store ->
-    ?version:[> `V1 ] ->
+    ?version:[> `V1 | `V2 ] ->
     ?capabilities:Smart.Capability.t list ->
     [ `Create of Reference.t
     | `Delete of Reference.t

src/not-so-smart/capability.ml

@@ -1,150 +1,42 @@
-type t =
-  [ `Multi_ack
-  | `Multi_ack_detailed
-  | `No_done
-  | `Thin_pack
-  | `Side_band
-  | `Side_band_64k
-  | `Ofs_delta
-  | `Agent of string
-  | `Shallow
-  | `Deepen_since
-  | `Deepen_not
-  | `No_progress
-  | `Include_tag
-  | `Report_status
-  | `Delete_refs
-  | `Quiet
-  | `Atomic
-  | `Push_options
-  | `Allow_tip_sha1_in_want
-  | `Allow_reachable_sha1_in_want
-  | `Push_cert of string
-  | `Symref of string * string
-  | `Other of string
-  | `Parameter of string * string ]
+type t = [ Capability_v1.t | Capability_v2.t ]
+
+let filter_by ~protocol_v lst =
+  let filter =
+    match protocol_v with
+    | `V1 -> ( function #Capability_v1.t as c -> Some c | _ -> None)
+    | `V2 -> ( function #Capability_v2.t as c -> Some c | _ -> None)
+    | _ -> invalid_arg "unsupported protocol version"
+  in
+  List.filter_map filter lst
 
 let to_string = function
-  | `Multi_ack -> "multi_ack"
-  | `Multi_ack_detailed -> "multi_ack_detailed"
-  | `No_done -> "no-done"
-  | `Thin_pack -> "thin-pack"
-  | `Side_band -> "side-band"
-  | `Side_band_64k -> "side-band-64k"
-  | `Ofs_delta -> "ofs-delta"
-  | `Agent agent -> Fmt.str "agent=%s" agent
-  | `Shallow -> "shallow"
-  | `Deepen_since -> "deepen-since"
-  | `Deepen_not -> "deepen-not"
-  | `No_progress -> "no-progress"
-  | `Include_tag -> "include-tag"
-  | `Report_status -> "report-status"
-  | `Delete_refs -> "delete-refs"
-  | `Quiet -> "quiet"
-  | `Atomic -> "atomic"
-  | `Push_options -> "push-options"
-  | `Allow_tip_sha1_in_want -> "allow-tip-sha1-in-want"
-  | `Allow_reachable_sha1_in_want -> "allow-reachable-sha1-in-want"
-  | `Push_cert cert -> Fmt.str "push-cert=%s" cert
-  | `Symref (ref0, ref1) -> Fmt.str "symref=%s:%s" ref0 ref1
-  | `Other capability -> capability
-  | `Parameter (key, value) -> Fmt.str "%s=%s" key value
+  | #Capability_v1.t as c -> Capability_v1.to_string c
+  | #Capability_v2.t as c -> Capability_v2.to_string c
 
 exception Capability_expect_value of string
 
-let of_string ?value = function
-  | "multi_ack" -> `Multi_ack
-  | "multi_ack_detailed" -> `Multi_ack_detailed
-  | "no-done" -> `No_done
-  | "thin-pack" -> `Thin_pack
-  | "side-band" -> `Side_band
-  | "side-band-64k" -> `Side_band_64k
-  | "ofs-delta" -> `Ofs_delta
-  | "shallow" -> `Shallow
-  | "deepen-since" -> `Deepen_since
-  | "deepen-not" -> `Deepen_not
-  | "no-progress" -> `No_progress
-  | "include-tag" -> `Include_tag
-  | "report-status" -> `Report_status
-  | "delete-refs" -> `Delete_refs
-  | "quiet" -> `Quiet
-  | "atomic" -> `Atomic
-  | "push-options" -> `Push_options
-  | "allow-tip-sha1-in-want" -> `Allow_tip_sha1_in_want
-  | "allow-reachable-sha1-in-want" -> `Allow_reachable_sha1_in_want
-  | "push-cert" -> (
-      match value with
-      | Some value -> `Push_cert value
-      | None -> raise (Capability_expect_value "push-cert"))
-  | "agent" -> (
-      match value with
-      | Some value -> `Agent value
-      | None -> raise (Capability_expect_value "agent"))
-  | "symref" -> (
-      match Option.bind value (Astring.String.cut ~sep:":") with
-      | Some (ref0, ref1) -> `Symref (ref0, ref1)
-      | None -> raise (Capability_expect_value "symref"))
-  | capability -> (
-      match value with
-      | Some value -> `Parameter (capability, value)
-      | None -> `Other capability)
+let of_string ?(protocol_v = `V1) ?value s =
+  match protocol_v with
+  | `V1 -> (Capability_v1.of_string ?value s :> t)
+  | `V2 -> (Capability_v2.of_string s :> t)
+  | _ -> invalid_arg "unsupported protocol version"
 
 let pp ppf = function
-  | `Multi_ack -> Fmt.pf ppf "Multi-ACK"
-  | `Multi_ack_detailed -> Fmt.pf ppf "Multi-ACK-detailed"
-  | `No_done -> Fmt.pf ppf "No-done"
-  | `Thin_pack -> Fmt.pf ppf "Thin-PACK"
-  | `Side_band -> Fmt.pf ppf "Side-Band"
-  | `Side_band_64k -> Fmt.pf ppf "Side-Band-64K"
-  | `Ofs_delta -> Fmt.pf ppf "Offset-delta"
-  | `Agent agent -> Fmt.pf ppf "(Agent %s)" agent
-  | `Shallow -> Fmt.pf ppf "Shallow"
-  | `Deepen_since -> Fmt.pf ppf "Deepen-Since"
-  | `Deepen_not -> Fmt.pf ppf "Deepen-Not"
-  | `No_progress -> Fmt.pf ppf "No-Progress"
-  | `Include_tag -> Fmt.pf ppf "Include-Tag"
-  | `Report_status -> Fmt.pf ppf "Report-Status"
-  | `Delete_refs -> Fmt.pf ppf "Delete-Refs"
-  | `Quiet -> Fmt.pf ppf "Quiet"
-  | `Atomic -> Fmt.pf ppf "Atomic"
-  | `Push_options -> Fmt.pf ppf "Push-Options"
-  | `Allow_tip_sha1_in_want -> Fmt.pf ppf "Allow-Tip-SHA1-in-Want"
-  | `Allow_reachable_sha1_in_want -> Fmt.pf ppf "Allow-Reachable-SHA1-in-Want"
-  | `Push_cert cert -> Fmt.pf ppf "(Push Cert %s)" cert
-  | `Symref (ref0, ref1) -> Fmt.pf ppf "(Symref (%s, %s))" ref0 ref1
-  | `Other capability -> Fmt.pf ppf "(other %s)" capability
-  | `Parameter (key, value) -> Fmt.pf ppf "(%s %s)" key value
+  | #Capability_v1.t as c -> Capability_v1.pp ppf c
+  | #Capability_v2.t as c -> Capability_v2.pp ppf c
 
 let compare a b =
   match a, b with
-  | `Multi_ack, `Multi_ack
-  | `Multi_ack_detailed, `Multi_ack_detailed
-  | `No_done, `No_done
-  | `Thin_pack, `Thin_pack
-  | `Side_band, `Side_band
-  | `Side_band_64k, `Side_band_64k
-  | `Ofs_delta, `Ofs_delta
-  | `Shallow, `Shallow
-  | `Deepen_since, `Deepen_since
-  | `Deepen_not, `Deepen_not
-  | `No_progress, `No_progress
-  | `Include_tag, `Include_tag
-  | `Report_status, `Report_status
-  | `Delete_refs, `Delete_refs
-  | `Quiet, `Quiet
-  | `Atomic, `Atomic
-  | `Push_options, `Push_options
-  | `Allow_tip_sha1_in_want, `Allow_tip_sha1_in_want
-  | `Allow_reachable_sha1_in_want, `Allow_reachable_sha1_in_want ->
-      0
-  | `Push_cert a, `Push_cert b | `Agent a, `Agent b | `Other a, `Other b ->
-      String.compare a b
-  | `Symref (refa0, refa1), `Symref (refb0, refb1) ->
-      let res = String.compare refa0 refb0 in
-      if res = 0 then String.compare refa1 refb1 else res
-  | `Parameter (ka, va), `Parameter (kb, vb) ->
-      let res = String.compare ka kb in
-      if res = 0 then String.compare va vb else res
-  | a, b -> if a > b then 1 else -1
+  | (#Capability_v1.t as a), (#Capability_v1.t as b) ->
+      Capability_v1.compare a b
+  | (#Capability_v2.t as a), (#Capability_v2.t as b) ->
+      if Capability_v2.equal a b then 0
+      else
+        invalid_arg
+          "Capability.compare: comparison for capabilities for git wire \
+           protocol v2 is undefined"
+  | _ ->
+      invalid_arg
+        "Capability.compare: comparison between such capabilities is undefined"
 
 let equal a b = compare a b = 0