Merge pull request #558 from samoht/client-namespace

client: create a Datakit_client namespace

Makefile

@@ -56,7 +56,7 @@ clean:
 	rm -f com.docker.db
 
 test:
-	jbuilder runtest
+	jbuilder runtest --dev
 
 bundle:
 	opam remove tls ssl -y

api/ocaml/9p/datakit_client_9p.ml

@@ -1,6 +1,7 @@
 open Result
 open Astring
 open Lwt.Infix
+open Datakit_client
 
 let src = Logs.Src.create "datakit.client" ~doc:"DataKit client bindings"
 module Log = (val Logs.src_log src: Logs.LOG)
@@ -22,7 +23,7 @@ let symlink =
     ~owner:rwx ~group:rx ~other:rx ~is_symlink:true ()
 
 let ( / ) dir leaf = dir @ [leaf]
-let ( /@ ) dir user_path = dir @ Datakit_path.unwrap user_path
+let ( /@ ) dir user_path = dir @ Path.unwrap user_path
 let pp_path = Fmt.Dump.list String.dump
 
 let rec last = function
@@ -157,7 +158,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct
           match String.cut ~sep:" " line with
           | None            -> err "missing space"
           | Some (op, path) ->
-            match Datakit_path.of_string path with
+            match Path.of_string path with
             | Error e -> err e
             | Ok path -> match op with
               | "+" -> (`Added path  ) :: acc
@@ -343,7 +344,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct
         else if List.mem `Execute mode.FileMode.owner then `Exec
         else `File in
       ok (Some {
-        Datakit_S.kind;
+        kind;
         size = info.Stat.length;
       })
 
@@ -354,12 +355,12 @@ module Make(P9p : Protocol_9p.Client.S) = struct
 
     let exists_dir t path =
       stat t path >|*= function
-      | Some { Datakit_S.kind = `Dir; _ } -> true
+      | Some { kind = `Dir; _ } -> true
       | _ -> false
 
     let exists_file t path =
       stat t path >|*= function
-      | None | Some { Datakit_S.kind = `Dir; _ } -> false
+      | None | Some { kind = `Dir; _ } -> false
       | _ -> true
 
     let set_executable t path exec =
@@ -418,7 +419,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct
 
     (* Ensure that [base @ path] exists (assuming that [base] already exists). *)
     let make_dirs t ~base path =
-      let path = Datakit_path.unwrap path in
+      let path = Path.unwrap path in
       let rec aux user_path =
         Log.debug (fun f -> f "make_dirs.aux(%a)" (Fmt.Dump.list String.dump) user_path);
         match rdecons user_path with
@@ -447,20 +448,20 @@ module Make(P9p : Protocol_9p.Client.S) = struct
   module Tree = struct
 
     type value = [ `Dir of string list | `File of Cstruct.t | `Link of string ]
-    type 'a cache = ('a, error) Result.result Datakit_path.Map.t ref
+    type 'a cache = ('a, error) Result.result Path.Map.t ref
 
     type t = {
       fs   : FS.t;
       path : string list;
       reads: value cache;
-      stats: Datakit_S.stat option cache;
+      stats: stat option cache;
     }
 
     let find_cache c p =
-      try Some (Datakit_path.Map.find p !c) with Not_found -> None
+      try Some (Path.Map.find p !c) with Not_found -> None
 
-    let empty () = ref Datakit_path.Map.empty
-    let add_cache c p v = c := Datakit_path.Map.add p v !c
+    let empty () = ref Path.Map.empty
+    let add_cache c p v = c := Path.Map.add p v !c
     let v fs path = { fs; reads = empty () ; stats = empty (); path }
     let of_id fs id = v fs ["trees"; id]
 
@@ -491,14 +492,14 @@ module Make(P9p : Protocol_9p.Client.S) = struct
 
     let exists_dir t path =
       stat t path >|= function
-      | Ok (Some { Datakit_S.kind = `Dir; _ }) -> Ok true
+      | Ok (Some { kind = `Dir; _ }) -> Ok true
       | Ok Some _    -> Ok false
       | Ok None      -> Ok false
       | Error _ as e -> e
 
     let exists_file t path =
       stat t path >|= function
-      | Ok (Some { Datakit_S.kind = `File; _ }) -> Ok true
+      | Ok (Some { kind = `File; _ }) -> Ok true
       | Ok Some _    -> Ok false
       | Ok None      -> Ok false
       | Error _ as e -> e
@@ -568,7 +569,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct
       t.path / "rw" /@ path
 
     let split_for_create path =
-      match Datakit_path.pop path with
+      match Path.pop path with
       | Some x -> x
       | None -> raise (Invalid_argument "Can't create '/'!")
 
@@ -616,7 +617,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct
       let rec aux = function
         | [] -> Ok []
         | x :: xs ->
-          match Datakit_path.of_string x with
+          match Path.of_string x with
           | Error e -> Error (`Internal (Fmt.strf "Invalid path in conflicts: %s" e))
           | Ok path ->
             match aux xs with
@@ -737,7 +738,7 @@ module Make(P9p : Protocol_9p.Client.S) = struct
         (fun hash -> fn (commit_of_hash t hash))
 
     let wait_for_path t ?switch path fn =
-      let path = Datakit_path.unwrap path in
+      let path = Path.unwrap path in
       let path = List.map (fun x -> x ^ ".node") path in
       FS.wait_for t.fs ?switch (branch_dir t / "watch" @ (path / "tree.live"))
         (fun hash -> node_of_hash t hash >>*= fn)

api/ocaml/9p/datakit_client_9p.mli

@@ -1,8 +1,7 @@
 (** A DataKit client that connects to the server over a 9p connection. *)
 
 module Make(P9p : Protocol_9p.Client.S) : sig
-  include Datakit_S.CLIENT
-
+  include Datakit_client.S
   val connect : P9p.t -> t
   (** [connect c] is a Datakit connection using the 9p connection [c]. *)
 end

api/ocaml/datakit_client.ml

@@ -0,0 +1,186 @@
+type stat = {
+  kind: [`File | `Dir | `Link | `Exec];
+  size: int64;
+}
+
+type status_state =
+  [ `Pending
+  | `Success
+  | `Error
+  | `Failure ]
+
+type 'a diff = [ `Added of 'a | `Removed of 'a | `Updated of 'a ]
+type value = [`File of Cstruct.t | `Dir of string list | `Link of string]
+
+module Path = struct
+
+  open Result
+
+  type t = string list
+
+  let empty = []
+
+  let validate = function
+    | "" | "." | ".." as x -> Error (Fmt.strf "Invalid path component %S" x)
+    | x when String.contains x '/' -> Error (Fmt.strf "'/' in path step %S" x)
+    | _ -> Ok ()
+
+  let of_steps steps =
+    let rec aux = function
+      | [] -> Ok steps
+      | x :: xs ->
+        match validate x with
+        | Ok () -> aux xs
+        | Error _ as e -> e in
+    aux steps
+
+  let of_string path =
+    of_steps (Astring.String.cuts ~sep:"/" path)
+
+  let of_string_exn path =
+    match of_string path with
+    | Ok x -> x
+    | Error msg -> raise (Invalid_argument msg)
+
+  let pp = Fmt.(list ~sep:(const string "/") string)
+
+  let of_steps_exn steps =
+    match of_steps steps with
+    | Ok x -> x
+    | Error msg ->
+      raise (Invalid_argument (Fmt.strf "Bad path %a: %s" pp steps msg))
+
+  let unwrap x = x
+
+  let to_hum = Fmt.to_to_string pp
+
+  let compare = compare
+
+  let dirname t = match List.rev t with
+    | []   -> []
+    | _::t -> List.rev t
+
+  let basename t = match List.rev t with
+    | []   -> None
+    | h::_ -> Some h
+
+  let pop = function
+    | [] -> None
+    | x::xs ->
+      let rec aux dir this = function
+        | [] -> Some (List.rev dir, this)
+        | x::xs -> aux (this :: dir) x xs
+      in
+      aux [] x xs
+
+  module Set = Set.Make(struct type t = string list let compare = compare end)
+  module Map = Map.Make(struct type t = string list let compare = compare end)
+
+  module Infix = struct
+
+    let ( / ) path s =
+      match validate s with
+      | Ok () -> path @ [s]
+      | Error msg -> raise (Invalid_argument msg)
+
+    let ( /@ ) = ( @ )
+
+  end
+
+end
+
+module type READABLE_TREE = sig
+  type t
+  type +'a result
+  val read: t -> Path.t -> value result
+  val stat: t -> Path.t -> stat option result
+  val exists: t -> Path.t -> bool result
+  val exists_file: t -> Path.t -> bool result
+  val exists_dir: t -> Path.t -> bool result
+  val read_file: t -> Path.t -> Cstruct.t result
+  val read_dir: t -> Path.t -> string list result
+  val read_link: t -> Path.t -> string result
+end
+
+module type S = sig
+  type t
+  type error = private
+    [>`Already_exists
+    | `Does_not_exist
+    | `Is_dir
+    | `Not_dir
+    | `Not_file
+    | `Not_symlink]
+
+  val pp_error: error Fmt.t
+  type +'a result = ('a, error) Result.result Lwt.t
+  module Infix: sig
+    val (>>=): 'a result -> ('a -> 'b result) -> 'b result
+    val (>|=): 'a result -> ('a -> 'b) -> 'b result
+  end
+  module Tree: READABLE_TREE with type 'a result := 'a result
+  module Commit: sig
+    type t
+    val pp: t Fmt.t
+    val compare: t -> t -> int
+    val id: t -> string
+    val tree: t -> Tree.t result
+    val message: t -> string result
+    val parents: t -> t list result
+    val diff: t -> t -> Path.t diff list result
+  end
+
+  module Transaction: sig
+    include READABLE_TREE with type 'a result := 'a result
+    val create_dir: t -> Path.t -> unit result
+    val create_file: t -> Path.t -> ?executable:bool ->
+      Cstruct.t -> unit result
+    val create_symlink: t -> Path.t -> string -> unit result
+    val replace_file: t -> Path.t -> Cstruct.t -> unit result
+    val create_or_replace_file: t -> Path.t -> Cstruct.t -> unit result
+    val set_executable: t -> Path.t -> bool -> unit result
+    val remove: t -> Path.t -> unit result
+    val rename: t -> Path.t -> string -> unit result
+    val truncate: t -> Path.t -> int64 -> unit result
+    val make_dirs: t -> Path.t -> unit result
+    val commit: t -> message:string -> unit result
+    val abort: t -> unit result
+    type merge_inputs = {
+      ours: Tree.t;
+      theirs: Tree.t;
+      base: Tree.t;
+    }
+    val merge: t -> Commit.t -> (merge_inputs * Path.t list) result
+    val parents: t -> Commit.t list result
+    val set_parents: t -> Commit.t list -> unit result
+    val conflicts: t -> Path.t list result
+    val diff: t -> Commit.t -> Path.t diff list result
+    val closed: t -> bool
+  end
+
+  module Branch: sig
+    type t
+    val name: t -> string
+    val remove: t -> unit result
+    val rename: t -> string -> unit result
+    val head: t -> Commit.t option result
+    val wait_for_head: t -> ?switch:Lwt_switch.t ->
+      (Commit.t option -> [`Finish of 'a | `Again | `Abort] result) ->
+      [`Abort | `Finish of 'a] result
+    val wait_for_path: t -> ?switch:Lwt_switch.t -> Path.t ->
+      ([`File of Cstruct.t | `Dir of Tree.t
+       | `Link of string | `Exec of Cstruct.t] option ->
+       [`Finish of 'a | `Again | `Abort] result) ->
+      [`Abort | `Finish of 'a] result
+    val fast_forward: t -> Commit.t -> unit result
+    val with_transaction: t -> (Transaction.t -> 'a result) -> 'a result
+    val transaction: t -> Transaction.t result
+  end
+  val branches: t -> string list result
+  val remove_branch: t -> string -> unit result
+  val branch: t -> string -> Branch.t result
+  val commit: t -> string -> Commit.t result
+  val tree: t -> string -> Tree.t result
+  val fetch: t -> url:string -> branch:string -> Commit.t result
+  val disconnect: t -> unit result
+end