we want 'state_flow.ml' (previously 'smart_flow.ml'),

a module that translates state read-write monad into 'flow' operations,
to be usable both by 'Smart' and 'Wire_proto_v2'; hence, they
shouldn't have own copies of Context

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)

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 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/not-so-smart/dune

@@ -8,14 +8,20 @@
  (name state)
  (public_name git.nss.state)
  (modules state)
- (libraries git.nss.pkt-line fmt))
+ (libraries git.nss.capability git.nss.pkt-line fmt))
+
+(library
+ (name capability)
+ (public_name git.nss.capability)
+ (modules capability)
+ (libraries astring fmt))
 
 (library
  (name smart)
  (public_name git.nss.smart)
- (modules smart filter capability protocol)
- (libraries git.nss.pkt-line git.nss.state result rresult ipaddr domain-name
-   astring fmt))
+ (modules smart filter protocol)
+ (libraries git.nss.pkt-line git.nss.state capability result rresult ipaddr
+   domain-name astring fmt))
 
 (library
  (name wire_proto_v2)
@@ -52,14 +58,14 @@
  (name pck)
  (public_name git.nss.pck)
  (modules pck)
- (libraries sigs psq logs smart))
+ (libraries sigs capability psq logs smart))
 
 (library
  (name nss)
  (public_name git.nss)
  (modules nss fetch push)
  (libraries fmt result rresult logs ipaddr domain-name smart sigs neg pck
-   git.nss.state-flow git.nss.state wire_proto_v2))
+   capability git.nss.state-flow git.nss.state wire_proto_v2))
 
 (library
  (name unixiz)
@@ -72,6 +78,7 @@
  (name smart_git)
  (public_name git.nss.git)
  (modules smart_git smart_git_intf)
- (libraries bigarray-compat mimic mirage-flow unixiz ipaddr decompress.de
-   decompress.zl cstruct logs astring result rresult bigstringaf fmt emile
-   lwt domain-name uri sigs smart pck nss digestif carton carton-lwt))
+ (libraries bigarray-compat capability mimic mirage-flow unixiz ipaddr
+   decompress.de decompress.zl cstruct logs astring result rresult
+   bigstringaf fmt emile lwt domain-name uri sigs smart pck nss digestif
+   carton carton-lwt))

src/not-so-smart/fetch.mli

@@ -44,7 +44,7 @@ module Make
       ?uses_git_transport:bool ->
       host:[ `host ] Domain_name.t ->
       path:string ->
-      Wire_proto_v2.Context.capabilities State.Context.t ->
+      State.Context.t ->
       Flow.t ->
       Wire_proto_v2.Proto_vals_v2.Ls_refs.request ->
       Wire_proto_v2.Proto_vals_v2.Ls_refs.response IO.t

src/not-so-smart/smart.ml

@@ -110,31 +110,7 @@ type ('a, 'err) t = ('a, 'err) State.t =
   | Return of 'a
   | Error of 'err
 
-module Context = struct
-  type capabilities = {
-    client_caps : Capability.t list;
-    server_caps : Capability.t list;
-  }
-
-  let pp_capabilities _ppf _v = ()
-
-  include State.Context
-
-  type nonrec t = capabilities t
-
-  let make ~client_caps = make { client_caps; server_caps = [] }
-  let pp ppf v = pp pp_capabilities ppf v
-  let capabilities ctx = context ctx
-
-  let replace_server_caps ctx caps =
-    update ~f:(fun ~old_ctx -> { old_ctx with server_caps = caps }) ctx
-
-  let is_cap_shared ctx cap =
-    let { client_caps; server_caps } = capabilities ctx in
-    let is_cap_in caps = List.exists (fun c -> Capability.equal c cap) caps in
-    is_cap_in client_caps && is_cap_in server_caps
-end
-
+module Context = State.Context
 include Witness
 
 let proto_request = Proto_request
@@ -159,7 +135,7 @@ let send_pack ?(stateless = false) side_band =
 let packet ~trim = Packet trim
 let send_advertised_refs : _ send = Advertised_refs
 
-include State.Scheduler (Context) (Value)
+include State.Scheduler (Value)
 
 let pp_error ppf = function
   | #Protocol.Encoder.error as err -> Protocol.Encoder.pp_error ppf err

src/not-so-smart/state.ml

@@ -34,33 +34,43 @@ module type VALUE = sig
 end
 
 module Context = struct
-  open Pkt_line
+  type capabilities = {
+    client_caps : Capability.t list;
+    server_caps : Capability.t list;
+  }
 
-  type 'ctx t = {
-    encoder : Encoder.encoder;
-    decoder : Decoder.decoder;
-    mutable ctx : 'ctx;
+  type t = {
+    encoder : Pkt_line.Encoder.encoder;
+    decoder : Pkt_line.Decoder.decoder;
+    mutable capabilities : capabilities;
   }
 
-  type encoder = Encoder.encoder
-  type decoder = Decoder.decoder
+  type encoder = Pkt_line.Encoder.encoder
+  type decoder = Pkt_line.Decoder.decoder
 
   let pp _pp_ctx _ppf _t = ()
 
-  let make ctx =
-    { encoder = Encoder.create (); decoder = Decoder.create (); ctx }
+  let make ~client_caps =
+    let capabilities = { client_caps; server_caps = [] } in
+    {
+      encoder = Pkt_line.Encoder.create ();
+      decoder = Pkt_line.Decoder.create ();
+      capabilities;
+    }
 
   let encoder { encoder; _ } = encoder
   let decoder { decoder; _ } = decoder
-  let context { ctx; _ } = ctx
+  let capabilities { capabilities; _ } = capabilities
+
+  let replace_server_caps ctx server_caps =
+    ctx.capabilities <- { ctx.capabilities with server_caps }
 
-  let update t ~(f : old_ctx:'ctx -> 'ctx) =
-    let new_ctx = f ~old_ctx:t.ctx in
-    t.ctx <- new_ctx
+  let is_cap_shared { capabilities = { client_caps; server_caps }; _ } cap =
+    let is_cap_in caps = List.exists (fun c -> Capability.equal c cap) caps in
+    is_cap_in client_caps && is_cap_in server_caps
 end
 
 module Scheduler
-    (Context : CONTEXT)
     (Value : VALUE
                with type encoder = Context.encoder
                 and type decoder = Context.decoder) =

src/not-so-smart/state.mli

@@ -33,20 +33,25 @@ module type VALUE = sig
 end
 
 module Context : sig
-  type 'ctx t
+  type t
   type encoder = Pkt_line.Encoder.encoder
   type decoder = Pkt_line.Decoder.decoder
 
-  val pp : 'ctx Fmt.t -> 'ctx t Fmt.t
-  val encoder : 'ctx t -> encoder
-  val decoder : 'ctx t -> decoder
-  val make : 'ctx -> 'ctx t
-  val context : 'ctx t -> 'ctx
-  val update : 'ctx t -> f:(old_ctx:'ctx -> 'ctx) -> unit
+  type capabilities = {
+    client_caps : Capability.t list;
+    server_caps : Capability.t list;
+  }
+
+  val pp : Capability.t Fmt.t -> t Fmt.t
+  val make : client_caps:Capability.t list -> t
+  val encoder : t -> encoder
+  val decoder : t -> decoder
+  val capabilities : t -> capabilities
+  val replace_server_caps : t -> Capability.t list -> unit
+  val is_cap_shared : t -> Capability.t -> bool
 end
 
 module Scheduler
-    (Context : CONTEXT)
     (Value : VALUE
                with type encoder = Context.encoder
                 and type decoder = Context.decoder) : sig

src/not-so-smart/state_flow.ml

@@ -24,7 +24,7 @@ struct
       fl ->
       ('res, [ `Protocol of error ]) Read_write.t ->
       ('res, s) io =
-   fun scheduler io_raise _Flow flow state ->
+   fun scheduler io_raise flow_ops flow state ->
     let { bind; return } = scheduler in
     let ( >>= ) = bind in
 
@@ -45,7 +45,7 @@ struct
       | Read { k; buffer; off; len; eof } -> (
           let rd_n_bytes = min (Cstruct.len cbuff) len in
           Log.debug (fun m -> m "Start to read %d byte(s)." rd_n_bytes);
-          _Flow.recv flow (Cstruct.sub cbuff 0 rd_n_bytes) >>= function
+          flow_ops.recv flow (Cstruct.sub cbuff 0 rd_n_bytes) >>= function
           | Ok `End_of_flow ->
               Log.debug (fun m -> m "Got end of input.");
               unwrap (eof ())
@@ -54,20 +54,20 @@ struct
               Cstruct.blit_to_bytes cbuff 0 buffer off len;
               unwrap (k len)
           | Error err ->
-              Log.err (fun m -> m "Got an error: %a." _Flow.pp_error err);
-              failwithf "%a" _Flow.pp_error err)
+              Log.err (fun m -> m "Got an error: %a." flow_ops.pp_error err);
+              failwithf "%a" flow_ops.pp_error err)
       | Write { k; buffer; off; len } ->
-          (* TODO: Avoid writing by loop if we can;
-             otherwise, the loop writes once and terminates *)
+          (* TODO: almost always we can write in one go instead of calling a loop,
+                   so we should try writing and call loop if we aren't done *)
           let rec loop tmp =
             if Cstruct.is_empty tmp then unwrap (k len)
             else
-              _Flow.send flow tmp >>= function
+              flow_ops.send flow tmp >>= function
               | Ok shift ->
                   Log.debug (fun m ->
                       m "Wrote %d byte(s). %s" shift (Cstruct.to_string tmp));
                   loop (Cstruct.shift tmp shift)
-              | Error err -> failwithf "%a" _Flow.pp_error err
+              | Error err -> failwithf "%a" flow_ops.pp_error err
           in
           Cstruct.of_string buffer ~off ~len |> loop
     in

src/not-so-smart/wire_proto_v2.ml

@@ -18,31 +18,7 @@ module Witness = struct
     | Ls_refs_res : Proto_vals_v2.Ls_refs.response recv
 end
 
-(* TODO: copy of Smart.Context; remove duplication *)
-module Context = struct
-  type capabilities = {
-    client_caps : Capability.t list;
-    server_caps : Capability.t list;
-  }
-
-  let pp_capabilities _ppf _v = ()
-
-  include State.Context
-
-  type nonrec t = capabilities t
-
-  let make ~client_caps = make { client_caps; server_caps = [] }
-  let pp ppf v = pp pp_capabilities ppf v
-  let capabilities ctx = context ctx
-
-  let replace_server_caps ctx caps =
-    update ~f:(fun ~old_ctx -> { old_ctx with server_caps = caps }) ctx
-
-  let is_cap_shared ctx cap =
-    let { client_caps; server_caps } = capabilities ctx in
-    let is_cap_in caps = List.exists (fun c -> Capability.equal c cap) caps in
-    is_cap_in client_caps && is_cap_in server_caps
-end
+module Context = State.Context
 
 type ('a, 'err) t = ('a, 'err) State.t =
   | Read of {
@@ -102,7 +78,7 @@ module Value = struct
       | Ls_refs_res -> Proto_vals_v2.Decoder.decode_ls_refs_response decoder)
 end
 
-include State.Scheduler (Context) (Value)
+include State.Scheduler (Value)
 
 let pp_error ppf = function
   | #Proto_vals_v2.Encoder.error as err ->

test/smart/dune

@@ -2,12 +2,12 @@
  (name test)
  (modules append fifo hTTP loopback lwt_backend ref store_backend test uid
    unix_backend pipe)
- (libraries bigarray-compat mirage-flow mimic git.nss.unixiz git git-unix
-   result curl.lwt mirage-crypto-rng.unix digestif digestif.c domain-name
-   git.nss git.nss.wire-proto-v2 git.nss.git bos fpath carton-lwt bigstringaf
-   git.nss.sigs git.nss.hkt fmt git.nss.pck carton rresult alcotest
-   git.nss.smart lwt.unix mmap astring lwt cstruct uri fmt.tty logs.fmt
-   alcotest-lwt cohttp-lwt-unix git-cohttp-unix))
+ (libraries bigarray-compat capability git.nss.state mirage-flow mimic
+   git.nss.unixiz git git-unix result curl.lwt mirage-crypto-rng.unix
+   digestif digestif.c domain-name git.nss git.nss.wire-proto-v2 git.nss.git
+   bos fpath carton-lwt bigstringaf git.nss.sigs git.nss.hkt fmt git.nss.pck
+   carton rresult alcotest git.nss.smart lwt.unix mmap astring lwt cstruct
+   uri fmt.tty logs.fmt alcotest-lwt cohttp-lwt-unix git-cohttp-unix))
 
 (executable
  (name test_edn)