* refactor nss/protocol.(ml/mli)/Encoder and add comments

* rename 'decoder_from' to more conventional 'of_string'
* add safer version of peek pkt
	that also support git wire protocol v2 pkts:
	delim-pkt and response-end-pkt
* move 'prompt_pkt' to 'decoder.mli'
	to reuse it in git wire proto v2
* add 'read_pkt'
* add 'junk_chars' fn to 'Decoder' to
	increase 'decoder.pos' by 'n'
* move 'bind' and '>>='
	from nss/protocol.ml to pkt_line.decoder
* [wip] support wire proto v2 capabilities
* add 'Ls_refs', 'Fetch_command' modules to
  represent commands 'ls-refs' and 'fetch' respectively;
* add 'Encoder' module to wire-proto-v2 with support for encoding
  command requests and copy-paste NSS's 'encode_proto_request'
* add some comments to better define parts of a packet line:
  specific names for 4 bytes that encode packet length,
  the bytes that follow the length bytes, etc.
* rename length calculating function 'pkt_len' to
  'encoded_pkt_len' that returns the value hex-encoded in the
  first 4 bytes of the packet line and 'pkt_len_at_least_4'
  returns 'max 4 (encoded_pkt_len pkt)'
* copy-paste 'Proto_request' module from NSS
* update 'response' type in proto-v2 'Protocol'
* add 'Extended_pkt_line_decoder' that provides
	more functionality than 'Pkt_line.Decoder' but not specific to the protocol
* add decoding for all commands of wire proto v2
* reflect changes after 'mimic' lib introduction
* make 'smart_flow' more understandable
* reduce dup code, e.g., (>>=)
* reorganize stuff closer to its use
* rename stuff for more clarity
* move smart protocol (wire proto v1)-based 'fetch'
	code to separate modules
* functorize 'Smart_flow'
* rename 'Smart_flow' to 'State_flow'
* add mli file to 'State_flow'
* improve 'nss/state.ml' API:
	- it improves cases when we want to "open" the module to get infix/syntax operators
	- it also make the API more uniform and rich, e.g., adds "map" fn
* rename "fail" to "io_raise":
	  1) avoid clash with "fail" from "smart"/"wire_proto_v2"
	  2) to highlight that it causes "exception"al behavior
* add support for "ls-refs" command (without args)
* fix log.debug use and its message

src/carton/dune

@@ -2,12 +2,30 @@
  (name carton)
  (modules carton dec enc h idx sigs zh)
  (public_name carton)
- (libraries ke duff optint checkseum decompress.de decompress.zl bigstringaf
-   bigarray-compat psq fmt))
+ (libraries
+  ke
+  duff
+  optint
+  checkseum
+  decompress.de
+  decompress.zl
+  bigstringaf
+  bigarray-compat
+  psq
+  fmt))
 
 (library
  (name thin)
  (modules thin)
  (public_name carton.thin)
- (libraries bigarray-compat optint checkseum decompress.de decompress.zl
-   bigstringaf logs carton cstruct ke))
+ (libraries
+  bigarray-compat
+  optint
+  checkseum
+  decompress.de
+  decompress.zl
+  bigstringaf
+  logs
+  carton
+  cstruct
+  ke))

src/not-so-smart/capability_v2.ml

@@ -0,0 +1,32 @@
+open Astring
+
+type t =
+  [ `Atom of string
+  | `Key_value of string * string
+  | `Command_features of string * string list ]
+
+(* TODO: integrate better support for known capabilities and commands
+   e.g., ls-refs, etc. *)
+let of_string s =
+  match String.cut ?rev:None ~sep:"=" s with
+  | None -> `Atom s
+  | Some (k, v) -> (
+      match String.cuts ?rev:None ?empty:None ~sep:" " v with
+      | [] -> raise @@ Invalid_argument s
+      | [ v ] -> `Key_value (k, v)
+      | command :: features -> `Command_features (command, features))
+
+let to_string = function
+  | `Atom s -> s
+  | `Key_value (k, v) -> Fmt.str "%s=%s" k v
+  | `Command_features (s, s_lst) ->
+      Fmt.str "%s=%s" s (String.concat ~sep:" " s_lst)
+
+let equal t1 t2 =
+  match t1, t2 with
+  | `Atom s1, `Atom s2 -> String.equal s1 s2
+  | `Key_value (k1, v1), `Key_value (k2, v2) ->
+      String.equal k1 k2 && String.equal v1 v2
+  | `Command_features (c1, fs1), `Command_features (c2, fs2) ->
+      String.equal c1 c2 && List.for_all2 String.equal fs1 fs2
+  | _ -> false

src/not-so-smart/capability_v2.mli

@@ -0,0 +1,9 @@
+type t =
+  private
+  [ `Atom of string
+  | `Key_value of string * string
+  | `Command_features of string * string list ]
+
+val of_string : string -> t
+val to_string : t -> string
+val equal : t -> t -> bool

src/not-so-smart/decoder.ml

@@ -1,9 +1,12 @@
+module Log = (val let src = Logs.Src.create "nss/decoder" in
+                  Logs.src_log src : Logs.LOG)
+
 type decoder = { buffer : Bytes.t; mutable pos : int; mutable max : int }
 
 let io_buffer_size = 65536
 let create () = { buffer = Bytes.create io_buffer_size; pos = 0; max = 0 }
 
-let decoder_from x =
+let of_string x =
   let max = String.length x in
   let buffer = Bytes.of_string x in
   { buffer; pos = 0; max }
@@ -53,6 +56,17 @@ exception Leave of error info
 
 let return (type v) (v : v) _ : (v, 'err) state = Done v
 
+let rec bind x ~f =
+  match x with
+  | Done v -> f v
+  | Read { buffer; off; len; continue; eof } ->
+      let continue len = bind (continue len) ~f in
+      let eof () = bind (eof ()) ~f in
+      Read { buffer; off; len; continue; eof }
+  | Error _ as err -> err
+
+let ( >>= ) x f = bind x ~f
+
 let safe :
     (decoder -> ('v, ([> error ] as 'err)) state) -> decoder -> ('v, 'err) state
     =
@@ -254,11 +268,62 @@ let peek_pkt decoder =
   if len >= 4 then decoder.buffer, decoder.pos + 4, len - 4
   else decoder.buffer, decoder.pos + 4, 0
 
+type pkt =
+  | Flush_pkt  (** length in hex 0000 *)
+  | Delim_pkt  (** 0001 *)
+  | Response_end_pkt  (** 0002 *)
+  | Invalid_len_pkt of int  (** 0003 or 0004 *)
+  | Pkt of (int * string)
+      (** e.g., 0008done is represented as (8, "done");
+        we want to keep length to avoid calling [pkt_len_unsafe] several times;
+        we can't do [String.length str] + 4 because there may be LF, which is trimmed away,
+        so we should rely on the length encoded in the pkt *)
+
+let peek_pkt' ?(trim = true) ({ buffer; pos; _ } as decoder) =
+  match pkt_len_unsafe decoder with
+  | 0 -> Flush_pkt
+  | 1 -> Delim_pkt
+  | 2 -> Response_end_pkt
+  | (3 | 4) as i -> Invalid_len_pkt i
+  | i when i < 0 -> Invalid_len_pkt i
+  | pkt_len ->
+      let pkt_content_len = pkt_len - 4 in
+      let pkt_content (* pkt excluding 1st 4 bytes, ie pkt len *) =
+        Bytes.create pkt_content_len
+      in
+      Bytes.blit buffer (pos + 4) pkt_content 0 pkt_content_len;
+      let pkt_content = if trim then Bytes.trim pkt_content else pkt_content in
+      Pkt (pkt_len, Bytes.to_string pkt_content)
+  | exception Invalid_argument s ->
+      Fmt.failwith
+        "peek_pkt: decoder.buffer didn't contain 4 'length' bytes: %s" s
+
+let encoded_pkt_len = function
+  | Flush_pkt -> 0
+  | Delim_pkt -> 1
+  | Response_end_pkt -> 2
+  | Invalid_len_pkt i -> i
+  | Pkt (l, _) -> l
+
+let pkt_len_at_least_4 pkt = max 4 (encoded_pkt_len pkt)
+
+let read_pkt ?(trim = true) ({ pos; _ } as decoder) =
+  let pkt = peek_pkt' ~trim decoder in
+  let advance_n_bytes = pkt_len_at_least_4 pkt in
+  decoder.pos <- pos + advance_n_bytes;
+  pkt
+
+let is_flush_pkt = function Flush_pkt -> true | _ -> false
+
 let junk_pkt decoder =
   let len = pkt_len_unsafe decoder in
   if len < 4 then decoder.pos <- decoder.pos + 4
   else decoder.pos <- decoder.pos + len
 
+let junk_chars n ({ pos; _ } as decoder) =
+  assert (n >= 4);
+  decoder.pos <- pos + n
+
 let peek_while_eol decoder =
   let idx = ref decoder.pos in
   let chr = ref '\000' in
@@ -297,3 +362,7 @@ let peek_while_eol_or_space decoder =
   if !idx < end_of_input decoder && ((!chr = '\n' && !has_cr) || !chr = ' ')
   then decoder.buffer, decoder.pos, !idx + 1 - decoder.pos
   else leave_with decoder `Expected_eol_or_space
+
+let rec prompt_pkt ?strict k decoder =
+  if at_least_one_pkt decoder then k decoder
+  else prompt ?strict (prompt_pkt ?strict k) decoder

src/not-so-smart/decoder.mli

@@ -1,13 +1,27 @@
 (** Module for decoding Git pkt lines, as specified at
     https://github.com/git/git/blob/master/Documentation/technical/protocol-common.txt
 
+    We define a "packet line" (aka a "packet") as
+
+      |   4 bytes   || (enc-pkt-len)-4 |
+      [ enc-pkt-len ][   pkt-content   ]
+      |-------    pkt-len        ------|
+
+    Example: "0009done\n" where [enc-pkt-len = 4] and [pkt-content = "done"] given we
+    usually trim LF ("\n").
+
+    "Encoded" packet length, [enc-pkt-len], is the first 4 bytes in the packet
+    that encode the length of the packet in hex. It can have specific values of 0, 1, 2
+    to encode flush, delimiter, and message (response end) packets respectively.
+    Otherwise, it should be >= 4, i.e., 4 length bytes + the length of the packet content.
+
     In the docs, we define [min_pkt_len = 4] as in specs. *)
 
 type decoder = { buffer : bytes; mutable pos : int; mutable max : int }
 
 val io_buffer_size : int
 val create : unit -> decoder
-val decoder_from : string -> decoder
+val of_string : string -> decoder
 val end_of_input : decoder -> int
 
 type error =
@@ -39,6 +53,10 @@ type ('v, 'err) state =
     }
   | Error of 'err info
 
+val return : 'v -> decoder -> ('v, 'err) state
+val bind : ('a, 'b) state -> f:('a -> ('c, 'b) state) -> ('c, 'b) state
+val ( >>= ) : ('a, 'b) state -> ('a -> ('c, 'b) state) -> ('c, 'b) state
+
 val leave_with : decoder -> error -> 'never
 (** [leave_with d error] raises [Leave { error; buffer = d.buffer; committed = d.pos }]
 
@@ -50,7 +68,6 @@ val safe :
     if exception [Leave err] is raised, the function returns [Error of err] *)
 
 val fail : decoder -> ([> error ] as 'err) -> ('v, 'err) state
-val return : 'v -> decoder -> ('v, 'err) state
 val peek_char : decoder -> char option
 val string : string -> decoder -> unit
 val junk_char : decoder -> unit
@@ -74,9 +91,43 @@ val peek_while_eol : decoder -> bytes * int * int
 val peek_while_eol_or_space : decoder -> bytes * int * int
 val peek_pkt : decoder -> bytes * int * int
 
+type pkt =
+  | Flush_pkt  (** length in hex 0000 *)
+  | Delim_pkt  (** 0001 *)
+  | Response_end_pkt  (** 0002 *)
+  | Invalid_len_pkt of int  (** 0003 or 0004; the latter is meaningless *)
+  | Pkt of (int * string)
+      (** (enc-pkt-len, pkt-content) e.g., 0008done is represented as (8, "done") *)
+
+val is_flush_pkt : pkt -> bool
+
+val encoded_pkt_len : pkt -> int
+(** returns the length of packet encoded in first 4 bytes of the packet
+    e.g., for a packet "0008done", 8 is returned *)
+
+val pkt_len_at_least_4 : pkt -> int
+(** [pkt_len pkt] returns [max 4 (encoded_pkt_len pkt)],
+    i.e., the returned value >= 4 *)
+
+val peek_pkt' : ?trim:bool -> decoder -> pkt
+
+val read_pkt : ?trim:bool -> decoder -> pkt
+(** returns the packet and advances [decoder.pos] to packet's full length *)
+
 val junk_pkt : decoder -> unit
 (** increase [decoder.pos] by [max min_pkt_len pkt_len], where [pkt_len] is the length
     of the pkt line starting at the current value of [decoder.pos] (before increasing) and
     [min_pkt_len = 4].
 
     @raise Invalid_argument if there aren't 4 bytes representing the length *)
+
+val junk_chars : int -> decoder -> unit
+(** [junk_chars n d] increases [d.pos] by [n];
+    can be used similar to [junk_pkt] when the length of a packet line is known from
+    [peek_pkt], for example. *)
+
+val prompt_pkt :
+  ?strict:bool ->
+  (decoder -> ('a, ([> error ] as 'b)) state) ->
+  decoder ->
+  ('a, 'b) state

src/not-so-smart/dune

@@ -2,13 +2,38 @@
  (name pkt_line)
  (public_name git.nss.pkt-line)
  (modules decoder encoder)
- (libraries astring fmt))
+ (libraries astring fmt logs))
+
+(library
+ (name state)
+ (public_name git.nss.state)
+ (modules state)
+ (libraries git.nss.pkt-line fmt))
 
 (library
  (name smart)
  (public_name git.nss.smart)
- (modules smart filter capability state protocol)
- (libraries git.nss.pkt-line result rresult ipaddr domain-name astring fmt))
+ (modules smart filter capability protocol)
+ (libraries git.nss.pkt-line git.nss.state result rresult ipaddr
+   domain-name astring fmt))
+
+(library
+ (name wire_proto_v2)
+ (public_name git.nss.wire-proto-v2)
+ (modules capability_v2 proto_vals_v2 wire_proto_v2)
+ (libraries
+  astring
+  domain-name
+  emile
+  fmt
+  git.nss.pkt-line
+  git.nss.sigs
+  git.nss.state
+  logs
+  mimic
+  result
+  rresult
+  uri))
 
 (library
  (name sigs)
@@ -17,10 +42,10 @@
  (libraries fmt cstruct))
 
 (library
- (name smart_flow)
- (public_name git.nss.smart-flow)
- (modules smart_flow)
- (libraries cstruct fmt git.nss.sigs git.nss.smart logs))
+ (name state_flow)
+ (public_name git.nss.state-flow)
+ (modules state_flow)
+ (libraries cstruct fmt git.nss.sigs git.nss.state git.nss.smart logs))
 
 (library
  (name hkt)
@@ -32,7 +57,7 @@
  (name neg)
  (public_name git.nss.neg)
  (modules neg find_common default)
- (libraries fmt rresult cstruct sigs logs psq smart git.nss.smart-flow))
+ (libraries fmt rresult cstruct sigs logs psq smart git.nss.state-flow))
 
 (library
  (name pck)
@@ -45,7 +70,7 @@
  (public_name git.nss)
  (modules nss fetch push)
  (libraries fmt result rresult logs ipaddr domain-name smart sigs neg pck
-   git.nss.smart-flow))
+   git.nss.state-flow git.nss.state wire_proto_v2))
 
 (library
  (name unixiz)

src/not-so-smart/encoder.ml

@@ -42,17 +42,14 @@ let flush k0 encoder =
     k1 0
   else k0 encoder
 
-let write encoder s =
-  let max = Bytes.length encoder.payload in
-  let go j l encoder =
-    let rem = max - encoder.pos in
-    let len = if l > rem then rem else l in
-    Bytes.blit_string s j encoder.payload encoder.pos len;
-    encoder.pos <- encoder.pos + len;
-    if len < l then leave_with encoder `No_enough_space
-  in
-  (* XXX(dinosaure): should never appear, but avoid continuation allocation. *)
-  go 0 (String.length s) encoder
+let write ({ pos; payload } as encoder) s =
+  let max = Bytes.length payload in
+  let s_len = String.length s in
+  let rem = max - pos in
+  let wr_n_bytes = min rem s_len in
+  Bytes.blit_string s 0 payload pos wr_n_bytes;
+  encoder.pos <- pos + wr_n_bytes;
+  if wr_n_bytes < s_len then leave_with encoder `No_enough_space
 
 let blit encoder ~buf ~off ~len =
   let max = Bytes.length encoder.payload in

src/not-so-smart/encoder.mli

@@ -19,5 +19,11 @@ type 'err state =
 
 val safe : (encoder -> ([> error ] as 'err) state) -> encoder -> 'err state
 val flush : (encoder -> ([> error ] as 'err) state) -> encoder -> 'err state
+
 val write : encoder -> string -> unit
+(** [write e s] writes [s] into [e.payload] if there is enough space, i.e.,
+    [Bytes.length e e.payload - e.pos > String.length s]. Otherwise, raises.
+
+    @raise Leave `No_enough_space if [String.length ]*)
+
 val blit : encoder -> buf:string -> off:int -> len:int -> unit