irmin-server: remove store/branch state

Instead of setting/getting a current branch from the server, use the
status of the store on the client to create it when needed on the
server.

src/irmin-client/client.ml

@@ -161,19 +161,10 @@ struct
     t.conn <- conn.conn;
     t.closed <- false
 
-  let current_branch repo =
-    request repo (module Commands.Get_current_branch) ()
-    >|= Error.unwrap "current_branch"
-
   let dup client =
     let* c = connect ~ctx:client.Client.ctx client.Client.config in
-    if client.closed then
-      let () = c.closed <- true in
-      Lwt.return c
-    else
-      let* branch = current_branch client in
-      let* _ = request c (module Commands.Set_current_branch) branch in
-      Lwt.return c
+    let () = if client.closed then c.closed <- true in
+    Lwt.return c
 
   let uri t = Conf.get t.Client.config Conf.uri
 
@@ -423,12 +414,6 @@ struct
     let conf = config ?tls ?hostname uri in
     Repo.v conf
 
-  let current_branch t = current_branch (repo t)
-
-  let set_current_branch (repo : repo) b =
-    request repo (module Commands.Set_current_branch) b
-    >|= Error.unwrap "set_current_branch"
-
   let request_store store =
     match status store with
     | `Empty -> `Empty
@@ -540,14 +525,6 @@ struct
         x
   end
 
-  let main repo =
-    let* () = set_current_branch repo Store.Branch.main in
-    main repo
-
-  let of_branch repo branch =
-    let* () = set_current_branch repo branch in
-    of_branch repo branch
-
   let clone ~src ~dst =
     let repo = repo src in
     let* repo = dup repo in
@@ -558,25 +535,35 @@ struct
     in
     of_branch repo dst
 
+  let request_store store =
+    match status store with
+    | `Empty -> `Empty
+    | `Branch b -> `Branch b
+    | `Commit c -> `Commit (Commit.key c)
+
   let mem store path =
     let repo = repo store in
-    request repo (module Commands.Store.Mem) path >|= Error.unwrap "mem"
+    request repo (module Commands.Store.Mem) (request_store store, path)
+    >|= Error.unwrap "mem"
 
   let mem_tree store path =
     let repo = repo store in
-    request repo (module Commands.Store.Mem_tree) path
+    request repo (module Commands.Store.Mem_tree) (request_store store, path)
     >|= Error.unwrap "mem_tree"
 
   let find store path =
     let repo = repo store in
-    request repo (module Commands.Store.Find) path >|= Error.unwrap "find"
+    request repo (module Commands.Store.Find) (request_store store, path)
+    >|= Error.unwrap "find"
 
   let remove_exn ?clear ?retries ?allow_empty ?parents ~info store path =
     let parents = Option.map (List.map (fun c -> Commit.hash c)) parents in
     let repo = repo store in
     request repo
       (module Commands.Store.Remove)
-      (((clear, retries), (allow_empty, parents)), path, info ())
+      ( ((clear, retries), (allow_empty, parents)),
+        (request_store store, path),
+        info () )
     >|= Error.unwrap "remove"
 
   let remove ?clear ?retries ?allow_empty ?parents ~info store path =
@@ -588,7 +575,7 @@ struct
   let find_tree store path =
     let repo = repo store in
     let+ concrete =
-      request repo (module Commands.Store.Find_tree) path
+      request repo (module Commands.Store.Find_tree) (request_store store, path)
       >|= Error.unwrap "find_tree"
     in
     Option.map Tree.of_concrete concrete

src/irmin-client/client_intf.ml

@@ -53,7 +53,6 @@ module type S = sig
 
   val export : ?depth:int -> repo -> slice Lwt.t
   val import : repo -> slice -> unit Lwt.t
-  val current_branch : t -> branch Lwt.t
 
   (** The batch API is used to have better control of when data is sent between
       the client and server when manipulating trees. *)

src/irmin-server/command.ml

@@ -28,30 +28,29 @@ struct
 
   type t = (module CMD)
 
-  let resolve_tree (ctx : context) tree =
-    let* id, tree =
-      match tree with
-      | Tree.Key x -> Store.Tree.of_key ctx.repo x >|= fun x -> (None, x)
-      | Concrete x -> Lwt.return (None, Some (Store.Tree.of_concrete x))
-    in
-    match tree with
-    | Some t -> Lwt.return (id, t)
-    | None -> Error.raise_error "unknown tree"
-
-  type store = [ `Empty | `Branch of Store.branch | `Commit of Store.commit_key ]
-  [@@deriving irmin]
-
-  let resolve_store ctx = function
-    | `Empty -> Store.empty ctx.repo
-    | `Branch b -> Store.of_branch ctx.repo b
-    | `Commit key -> (
-        let* commit = Store.Commit.of_key ctx.repo key in
-        match commit with
-        | None -> Error.raise_error "Cannot find commit"
-        | Some commit -> Store.of_commit commit)
-
   module Commands = struct
-    type nonrec store = store [@@deriving irmin]
+    let resolve_tree (ctx : context) tree =
+      let* id, tree =
+        match tree with
+        | Tree.Key x -> Store.Tree.of_key ctx.repo x >|= fun x -> (None, x)
+        | Concrete x -> Lwt.return (None, Some (Store.Tree.of_concrete x))
+      in
+      match tree with
+      | Some t -> Lwt.return (id, t)
+      | None -> Error.raise_error "unknown tree"
+
+    type store =
+      [ `Empty | `Branch of Store.branch | `Commit of Store.commit_key ]
+    [@@deriving irmin]
+
+    let resolve_store ctx = function
+      | `Empty -> Store.empty ctx.repo
+      | `Branch b -> Store.of_branch ctx.repo b
+      | `Commit key -> (
+          let* commit = Store.Commit.of_key ctx.repo key in
+          match commit with
+          | None -> Error.raise_error "Cannot find commit"
+          | Some commit -> Store.of_commit commit)
 
     module Ping = struct
       let name = "ping"
@@ -62,27 +61,6 @@ struct
       let run conn _ctx _ () = Return.ok conn
     end
 
-    module Set_current_branch = struct
-      type req = Store.Branch.t [@@deriving irmin]
-      type res = unit [@@deriving irmin]
-
-      let name = "set_current_branch"
-
-      let run conn ctx _ branch =
-        let* store = Store.of_branch ctx.repo branch in
-        ctx.branch <- branch;
-        ctx.store <- store;
-        Return.ok conn
-    end
-
-    module Get_current_branch = struct
-      type req = unit [@@deriving irmin]
-      type res = Store.Branch.t [@@deriving irmin]
-
-      let name = "get_current_branch"
-      let run conn ctx _ () = Return.v conn Store.Branch.t ctx.branch
-    end
-
     module Export = struct
       type req = int option [@@deriving irmin]
       type res = Store.slice [@@deriving irmin]
@@ -615,46 +593,50 @@ struct
       type t = store [@@deriving irmin]
 
       module Mem = struct
-        type req = Store.path [@@deriving irmin]
+        type req = t * Store.path [@@deriving irmin]
         type res = bool [@@deriving irmin]
 
         let name = "store.mem"
 
-        let run conn ctx _ path =
-          let* res = Store.mem ctx.store path in
+        let run conn ctx _ (store, path) =
+          let* store = resolve_store ctx store in
+          let* res = Store.mem store path in
           Return.v conn res_t res
       end
 
       module Mem_tree = struct
-        type req = Store.path [@@deriving irmin]
+        type req = t * Store.path [@@deriving irmin]
         type res = bool [@@deriving irmin]
 
         let name = "store.mem_tree"
 
-        let run conn ctx _ path =
-          let* res = Store.mem_tree ctx.store path in
+        let run conn ctx _ (store, path) =
+          let* store = resolve_store ctx store in
+          let* res = Store.mem_tree store path in
           Return.v conn res_t res
       end
 
       module Find = struct
-        type req = Store.path [@@deriving irmin]
+        type req = t * Store.path [@@deriving irmin]
         type res = Store.contents option [@@deriving irmin]
 
         let name = "store.find"
 
-        let run conn ctx _ path =
-          let* x = Store.find ctx.store path in
+        let run conn ctx _ (store, path) =
+          let* store = resolve_store ctx store in
+          let* x = Store.find store path in
           Return.v conn res_t x
       end
 
       module Find_tree = struct
-        type req = Store.path [@@deriving irmin]
+        type req = t * Store.path [@@deriving irmin]
         type res = Store.Tree.concrete option [@@deriving irmin]
 
         let name = "store.find_tree"
 
-        let run conn ctx _ path =
-          let* x = Store.find_tree ctx.store path in
+        let run conn ctx _ (store, path) =
+          let* store = resolve_store ctx store in
+          let* x = Store.find_tree store path in
           match x with
           | None -> Return.v conn res_t None
           | Some x ->
@@ -678,17 +660,20 @@ struct
             Lwt.return_some parents
 
       module Remove = struct
-        type req = write_options * Store.path * Store.Info.t [@@deriving irmin]
+        type req = write_options * (t * Store.path) * Store.Info.t
+        [@@deriving irmin]
+
         type res = unit [@@deriving irmin]
 
         let name = "store.remove"
 
         let run conn ctx _
-            (((clear, retries), (allow_empty, parents)), path, info) =
+            (((clear, retries), (allow_empty, parents)), (store, path), info) =
           let* parents = mk_parents ctx parents in
+          let* store = resolve_store ctx store in
           let* () =
-            Store.remove_exn ?clear ?retries ?allow_empty ?parents ctx.store
-              path ~info:(fun () -> info)
+            Store.remove_exn ?clear ?retries ?allow_empty ?parents store path
+              ~info:(fun () -> info)
           in
           Return.v conn res_t ()
       end
@@ -700,8 +685,6 @@ struct
     [
       cmd (module Batch.Apply);
       cmd (module Ping);
-      cmd (module Set_current_branch);
-      cmd (module Get_current_branch);
       cmd (module Import);
       cmd (module Export);
       cmd (module Contents.Mem);

src/irmin-server/command_intf.ml

@@ -44,8 +44,6 @@ module type S = sig
     conn : Conn.t;
     config : Irmin.Backend.Conf.t;
     repo : Store.Repo.t;
-    mutable branch : Store.branch;
-    mutable store : Store.t;
     mutable watch : Store.watch option;
     mutable branch_watch : Store.Backend.Branch.watch option;
   }
@@ -157,16 +155,6 @@ module type S = sig
     (** Check connectivity *)
     module Ping : CMD with type req = unit and type res = unit
 
-    (* Branch *)
-
-    (** Set the current branch for a client *)
-    module Set_current_branch :
-      CMD with type req = Store.branch and type res = unit
-
-    (** Get the current branch for a client *)
-    module Get_current_branch :
-      CMD with type req = unit and type res = Store.branch
-
     (** Export repo *)
     module Export : CMD with type req = int option and type res = Store.slice
 
@@ -204,27 +192,25 @@ module type S = sig
 
       (** Find a value in the store *)
       module Find :
-        CMD with type req = Store.path and type res = Store.contents option
+        CMD with type req = t * Store.path and type res = Store.contents option
 
       (** Remove a value from the store *)
       module Remove :
         CMD
-          with type req =
-            ((bool option * int option)
-            * (bool option * Store.hash list option))
-            * Store.path
-            * Store.Info.t
+          with type req = write_options * (t * Store.path) * Store.Info.t
            and type res = unit
 
       (** Get a tree from the store *)
       module Find_tree :
-        CMD with type req = Store.path and type res = Store.Tree.concrete option
+        CMD
+          with type req = t * Store.path
+           and type res = Store.Tree.concrete option
 
       (** Check for the existence of a value in the store *)
-      module Mem : CMD with type req = Store.path and type res = bool
+      module Mem : CMD with type req = t * Store.path and type res = bool
 
       (** Check for the existence of a tree in the store *)
-      module Mem_tree : CMD with type req = Store.path and type res = bool
+      module Mem_tree : CMD with type req = t * Store.path and type res = bool
     end
   end
 end

src/irmin-server/context.ml

@@ -28,8 +28,6 @@ struct
     conn : Conn.t;
     config : Irmin.Backend.Conf.t;
     repo : Store.Repo.t;
-    mutable branch : Store.branch;
-    mutable store : Store.t;
     mutable watch : Store.watch option;
     mutable branch_watch : Store.Backend.Branch.watch option;
   }

src/irmin-server/unix/server.ml

@@ -153,19 +153,8 @@ module Make (Codec : Conn.Codec.S) (Store : Irmin.Generic_key.S) = struct
       Lwt_io.close ic
     else
       (* Handshake ok *)
-      let branch = Store.Branch.main in
-      let* store = Store.of_branch repo branch in
       let client =
-        Command.
-          {
-            conn;
-            repo;
-            branch;
-            store;
-            watch = None;
-            branch_watch = None;
-            config;
-          }
+        Command.{ conn; repo; watch = None; branch_watch = None; config }
       in
       loop repo conn client info