Source file fs_intf.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2020,2021 DaiLambda, Inc. <contact@dailambda.jp>            *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module type NAME = sig
  (** Type of file and directory names *)
  type t

  val equal : t -> t -> bool
  val to_string : t -> string
  val pp : Format.formatter -> t -> unit
  val to_segment : t -> Segment.t
  val of_segment : Segment.t -> t option

  val test : string -> unit
end

module type PATH =  sig
  type name

  (** Path, a list of names *)
  type t = name list

  (** Length of the names of a path *)
  val length : t -> int

  val equal : t -> t -> bool

  val to_string : t -> string

  val pp : Format.formatter -> t -> unit

  val to_segments : t -> Segment.t list

  val of_segments : Segment.t list -> t option

  (** [is_prefix_of p1 p2] checks [p1] is a prefix of [p2].
      If it is, it returns [Some p2'] such that [p1 @ p2' = p2].
      Otherwise it returns [None].
  *)
  val is_prefix_of : t -> t -> t option
end

(** File system over Plebeia tree.

    Here, a `cursor` is a zipper over a Plebeia tree.
*)
module type S = sig

  (** Type of file name *)
  type name

  (** Path name, a list of names *)
  module Path : PATH with type name = name

  (** Type for the underlying cursor *)
  type raw_cursor

  (** type for the pointer to a directory/file *)
  type cursor

  (** Type of Plebeia tree of a file or a directory *)
  type view

  (** Hash of a file or a directory *)
  type hash

  (** Errors.  The first parameter is the name of the failed API function *)
  type error =
    | Is_file of string * Path.t
    | Is_directory of string * Path.t
    | No_such_file_or_directory of string * Path.t
    | File_or_directory_exists of string * Path.t
    | Path_decode_failure of Segment.t
    | Other of string * string

  type Error.t += FS_error of error

  (** [make raw_cursor path] wraps [raw_cursor] which points to [path]
      and returns a cursor *)
  val make : raw_cursor -> Path.t -> cursor

  (** [empty context] returns a cursor pointing the empty file system *)
  val empty : Context.t -> cursor

  (** Returns the underlying context of the given cursor *)
  val context : cursor -> Context.t

  (** Get the underlying cursor *)
  val get_raw_cursor : cursor -> raw_cursor

  module Op : sig
    (** Monad for synchronous file system operations *)
    type 'a t = cursor -> (cursor * 'a, Error.t) result

    include Monad.S1 with type 'a t := 'a t

    val lift_result : ('a, Error.t) Result.t -> 'a t

    (** Fail with the given error *)
    val fail : error -> 'a t

    (** Get the current underlying cursor *)
    val raw_cursor : raw_cursor t

    (** Moves the cursor up 1 directory level.
        If the cursor is already at the root, it does nothing. *)
    val chdir_parent : unit t

    (** Moves the cursor up to the root directory.
        If the cursor is already at the root, it does nothing. *)
    val chdir_root : unit t

    (** Moves the cursor to a sub-directory specified by the path.
        If [dig=true], subdirectories are created if necessary. *)
    val chdir : ?dig:bool -> Path.t -> unit t

    (** Get the current path of the cursor *)
    val path : Path.t t

    (** File and directory access.  It returns the current cursor and its view.
    *)
    val get : Path.t -> (cursor * view) t

    (** [set path cursor] sets the tree pointed by the [cursor]
        at the specified path.

        The path must not be empty.  *)
    val set : Path.t -> cursor -> unit t

    (** [copy src dst] sets the tree at [src] to [dst].
        [dst] must not be empty. *)
    val copy : Path.t -> Path.t -> unit t

    (** Regular file read access. *)
    val cat : Path.t -> Value.t t

    (** Create or update a regular file.  Directories are created if necessary.
        The path must not be empty. *)
    val write : Path.t -> Value.t -> unit t

    (** Remove a regular file or a directory, then returns [Ok true].
        The path must not be empty.

        recursive=false : fails when the target is a directory
        recursive=true : removes the target recursively if it is a directory
        ignore_error=false : fails when the target does not exist
        ignore_error=true : does not fail even if the target does not exist

        Returns [true] if the target is really removed.
        Returns [false] if the target does not exist.
    *)
    val rm : ?recursive:bool -> ?ignore_error:bool -> Path.t -> bool t

    (** Recursive removal of a directory
        The path must not be empty.

        ignore_error=false : fails when the target does not exist
        ignore_error=true : does not fail even if the target does not exist

        Returns [true] if the target is really removed.
        Returns [false] if the target does not exist.
    *)
    val rmdir : ?ignore_error:bool -> Path.t -> bool t

    (** Compute the Merkle hash of the cursor *)
    val compute_hash : hash t

    (** Clear the memory cache of the tree under the current cursor,
        if it is already persisted on the disk.
    *)
    val may_forget: unit t

    (** Monad runner *)
    val run : cursor -> 'a t -> (cursor * 'a, Error.t) result

    (** For debugging. [do_then f op] executes [f] against the current cursor,
        then performs [op]. *)
    val do_then : (cursor -> unit) -> 'a t -> 'a t
  end

  module Op_lwt : sig
    (** Monad for asynchronous file system operations *)
    type 'a t = cursor -> (cursor * 'a, Error.t) result Lwt.t

    include Monad.S1 with type 'a t := 'a t

    (** Convert Op monad to Op_lwt *)
    val lift : 'a Op.t -> 'a t
    val lift_op : 'a Op.t -> 'a t

    val lift_lwt : 'a Lwt.t -> 'a t
    val lift_result : ('a, Error.t) Result.t -> 'a t
    val lift_result_lwt : ('a, Error.t) Result_lwt.t -> 'a t

    (** Fail with the given error *)
    val fail : error -> 'a t

    (** Get the current underlying cursor *)
    val raw_cursor : raw_cursor t

    (** Moves the cursor up 1 directory level.
        If the cursor is already at the root, it does nothing. *)
    val chdir_parent : unit t

    (** Moves the cursor up to the root directory.
        If the cursor is already at the root, it does nothing. *)
    val chdir_root : unit t

    (** Moves the cursor to a sub-directory specified by the path.
        If [dig=true], subdirectories are created if necessary. *)
    val chdir : ?dig:bool -> Path.t -> unit t

    (** Get the current path of the cursor *)
    val path : Path.t t

    (** File and directory access.  It returns the current cursor and its view.
    *)
    val get : Path.t -> (cursor * view) t

    (** Set the tree pointed by the [cursor] at the specified path.

        The path must not be empty.

        Note: there is no loop detection.  It is the user's responsibility
        not to introduce a loop by this function. *)
    val set : Path.t -> cursor -> unit t

    (** [copy src dst] sets the tree at [src] to [dst].
        [dst] must not be empty.

        If the copy creates a loop, the function fails. *)
    val copy : Path.t -> Path.t -> unit t

    (** Regular file read access. *)
    val cat : Path.t -> Value.t t

    (** Create or update a regular file.  Directories are created if necessary.
        The path must not be empty.
    *)
    val write : Path.t -> Value.t -> unit t

    (** Remove a regular file or a directory, then returns [Ok true].
        The path must not be empty.

        recursive=false : fails when the target is a directory
        recursive=true : removes the target recursively if it is a directory
        ignore_error=false : fails when the target does not exist
        ignore_error=true : does not fail even if the target does not exist

        Returns [true] if the target is really removed.
        Returns [false] if the target does not exist.
    *)
    val rm : ?recursive:bool -> ?ignore_error:bool -> Path.t -> bool t

    (** Recursive removal of a directory
        The path must not be empty.

        ignore_error=false : fails when the target does not exist
        ignore_error=true : does not fail even if the target does not exist

        Returns [true] if the target is really removed.
        Returns [false] if the target does not exist.
    *)
    val rmdir : ?ignore_error:bool -> Path.t -> bool t

    (** Compute the Merkle hash of the cursor *)
    val compute_hash : hash t

    (** Clear the memory cache of the tree under the current cursor,
        if it is already persisted on the disk.
    *)
    val may_forget: unit t

    (** [do_then f op] executes [f] against the current cursor,
        then performs [op]. *)
    val do_then : (cursor -> unit) -> 'a t -> 'a t

    (** Monad runner *)
    val run : cursor -> 'a t -> (cursor * 'a, Error.t) result Lwt.t

    (** folding

        - `Continue: if the item is a directory, its items are recursively folded
        - `Up: if the item is a directory, its items are skipped
        - `Exit: terminate the folding immediately and returns the accumulator
                 as the final result of [fold]
    *)
    val fold
      : 'a
      -> Path.t
      -> ('a
          -> Path.t
          -> cursor
          -> ([`Continue | `Exit | `Up] * 'a, Error.t) result Lwt.t)
      -> 'a t

    (** folding with a depth specification *)
    val fold'
      : ?depth:[`Eq of int | `Ge of int | `Gt of int | `Le of int | `Lt of int ]
      -> 'a
      -> Path.t
      -> ('a -> Path.t -> cursor -> ('a, Error.t) result Lwt.t)
      -> 'a t

    (** List the directory specified by the path *)
    val ls : Path.t -> (name * cursor) list t
  end

  (** Version control *)
  module Vc : sig
    (** Type of version controller *)
    type t = Vc.t

    (** Create an empty commit store *)
    val create :
      ?hashcons: Hashcons.config
      -> ?node_cache: Index.t Node_cache.t
      -> ?lock: bool
      -> ?bytes_per_cell:int
      -> ?hash_func:[ `Blake2B | `Blake3 ]
      -> ?bytes_per_hash:int
      -> ?resize_step_bytes:int
      -> ?auto_flush_seconds: int
      -> string
      -> (t, Error.t) Result_lwt.t

    (** Opens a commit store of the given name if it exists.
        Otherwise, it creates a new store. *)
    val open_ :
      mode: Storage.mode
      -> ?hashcons: Hashcons.config
      -> ?node_cache: Index.t Node_cache.t
      -> ?bytes_per_cell:int
      -> ?hash_func:[ `Blake2B | `Blake3 ]
      -> ?bytes_per_hash:int
      -> ?resize_step_bytes:int
      -> ?auto_flush_seconds: int
      -> string
      -> (t, Error.t) Result_lwt.t

    (** Close the version control.
        Once closed, further uses of [t] are unspecified. *)
    val close : t -> (unit, Error.t) result Lwt.t

    (** Returns a cursor pointing to an empty tree *)
    val empty : t -> cursor

    (** Returns a cursor pointing to a leaf with the value specified
        by the given bytes *)
    val of_value : t -> bytes -> cursor

    (** Checkout the commit of the given commit hash *)
    val checkout : t -> Commit_hash.t -> cursor option Lwt.t

    (** Same as [checkout] but returns the commit information together *)
    val checkout' : t -> Commit_hash.t -> (Commit.t * cursor) option Lwt.t

    (** Check the given commit hash is known *)
    val mem : t -> Commit_hash.t -> bool Lwt.t

    (** Compute the commit hash for the root of the current tree.
        The cursor is moved to the root.

        Note that the commit hash is NOT the top Merkle hash of the cursor.
        It is computed from the top Merkle hash and the parent commit hash
    *)
    val compute_commit_hash :
      t -> parent: Commit_hash.t option -> cursor -> cursor * Commit_hash.t

    (** Commit the contents of the cursor at the root.
        It then returns the updated cursor, the hash,
        and the commit information.

        If [override] is [false] (by default), hash collision fails
        the function.  If it is [true], it overwrites the hash.

        The commit will be persisted to the disk eventually, but may be
        lost if the program crashes.  To make it surely persisted,
        [sync] must be called explicitly.
    *)
    val commit :
      ?allow_missing_parent: bool
      -> t
      -> parent: Commit_hash.t option
      -> hash_override: Commit_hash.t option
      -> (Hash.Prefix.t * Commit.t) Op_lwt.t

    (** Synchronize the commits to the disk.  Commits after the last call of
        this [flush] may be lost when the program crashes.

        Too frequent call of this function may slow down the system.
    *)
    val flush : t -> unit Lwt.t

    (** Underlying commit database *)
    val commit_db : t -> Commit_db.t

    (** Underlying context *)
    val context : t -> Context.t
  end

  module Merkle_proof : sig
    type t = Merkle_proof.t
    type detail = Path.t * Segment.segment list * Node_type.node option

    val encoding : Vc.t -> t Data_encoding.t

    val pp : Format.formatter -> t -> unit

    (** Build a Merkle proof of the given paths under the current cursor.
        It also returns the objects at the paths.
    *)
    val make : Path.t list -> (t * detail list) Op.t

    (** Compute the top hash of the given Merkle proof.  It also returns
        the objects at the paths attached with the proof.
    *)
    val check : Vc.t -> t -> (Hash.Prefix.t * detail list, Error.t) result
  end
end