Merge branch '#4-multi-file-dest'

_env/config.example.json

@@ -32,9 +32,22 @@
   , "log_namespace" : "Source" }
 
 , "rdb_dest" : 
-  { // Absolute path to where the video and thumbnail files should be
-    // downloaded to within the Docker container. 
-    "files_path" : "/data/files"
+  { // Where to store files. Multiple locations can be specified to accomodate 
+    // spanning multiple volumes. The system distributes files based on order
+    // of location definition (first to last), available space, and max allowed
+    // usage. 
+    //
+    // Each location is defined by a "path" and "max_usage". Path should be
+    // absolute. Max usage follows the PHP-style suffixes of K, M, G, and T 
+    // (kilo-, mega-, giga-, and terabytes respectively). Case-insensitive. If
+    // no suffix is given, then the number will be taken as bytes. Setting 
+    // "max_usage" to `null` means use as much storage as is available.
+    // 
+    // See https://www.php.net/manual/en/faq.using.php#faq.using.shorthandbytes
+    "file_stores" : 
+    [ {"path": "/data/files/volume_a", "max_usage": "3G"}
+    , {"path": "/data/files/volume_b", "max_usage": "4G"}
+    , {"path": "/data/files/volume_c", "max_usage": null} ]
   , "log_level" : "info"
   , "log_namespace" : "Dest" }
 

app/Makefile

@@ -36,6 +36,8 @@ define atdgen
 	$(env) atdgen -$(type) $1
 endef
 
+# These rules make use of "static patterns".
+# See http://www.gnu.org/software/make/manual/html_node/Static-Usage.html
 $(filter %_t.ml,$(atd_ml_files)): %_t.ml: %.atd switch-export.opam
 	$(call atdgen,$<,$@)
 

app/bin/config/dune

@@ -1,3 +1,3 @@
 (library
  (name config)
- (libraries atdgen batteries))
+ (libraries atdgen batteries re re.perl))

app/bin/config/rdb_dest.atd

@@ -2,6 +2,6 @@
 type log_level <ocaml from="Log_level" t="t"> = abstract
 
 type t =
-  { files_path : string
+  { file_stores : string list
   ; log_level : log_level
   ; log_namespace : string }

app/bin/make_sync.ml

@@ -179,6 +179,7 @@ let make
       ; file_uri
       ; filename = get_filename vid ~fallback:slug
       ; md5 = vid.md5
+      ; size = Some vid.size
       ; width
       ; height
       ; duration = parse_duration vid.duration

app/bin/sync_conf.ml

@@ -43,7 +43,7 @@ let make_rdb_dest db_pool log_level (conf : Config.Rdb_dest.t) =
 
   let module Dest = Rdb_dest.Make(Log)(struct
     let db_pool = db_pool
-    let files_path = conf.files_path
+    let file_stores = conf.file_stores
   end) in
 
   (module Dest : Rdb_dest.Made)

app/lib/lib/result_lwt.mli

@@ -9,8 +9,7 @@
     failure up into the {!type:result}. This way, to the extent this monad is
     used, all exceptions should be caught and rolled into the {!type:result}. 
 
-    Opening {!Just_let_syntax} to use with [ppx_let].
-    *)
+    Open {!Just_let_syntax} to use with [ppx_let]. *)
 
 
 type 'a t = ('a, exn) Base.Result.t Lwt.t
@@ -34,7 +33,7 @@ module Let_syntax : sig
 
   val both : 'a t -> 'b t -> ('a * 'b) t
   (** [both a b] combines the unwrapped values of [a] and [b] into the tuple 
-      [(a, b)] and returns it wrapped up in {!type:t} unless [a] or [b] are 
+      [(a, b)] and returns it wrapped up in {!type:t} unless [a] or [b] 
       evaluate to an error, in which case the wrapped error of [a] (first) or
       [b] (second) is returned. *)
 

app/lib/logger/logger.ml

@@ -17,7 +17,7 @@ module Level = struct
     |   `Off -> ( 0,   "off", "🔳")
     | `Fatal -> (10, "fatal", "🛑")
     | `Error -> (20, "error", "❌")
-    |  `Warn -> (30,  "warn", "⚠️")
+    |  `Warn -> (30,  "warn", "☢️")
     |  `Info -> (40,  "info", "ℹ️")
     | `Debug -> (50, "debug", "♒️")
     | `Trace -> (60, "trace", "🔎")
@@ -45,8 +45,8 @@ end
 module type Sig = sig
   val level : Level.t
 
-  val log : Level.t -> string -> unit Lwt.t
-  val logf : Level.t -> ('a, unit, string, unit Lwt.t) format4 -> 'a
+  val log : Level.t -> ?exn:exn -> string -> unit Lwt.t
+  val logf : Level.t -> ?exn:exn -> ('a, unit, string, unit Lwt.t) format4 -> 'a
   val fatal : ?exn:exn -> string -> unit Lwt.t
   val fatalf : ?exn:exn -> ('a, unit, string, unit Lwt.t) format4 -> 'a
   val error : ?exn:exn -> string -> unit Lwt.t
@@ -99,7 +99,7 @@ module Make (Conf : Config) : Sig = struct
       Lwt.return ()
 
 
-  let log (level : Level.t) message =
+  let log (level : Level.t) ?exn message =
     if Level.compare Conf.level level < 0 then Lwt.return ()
     else
     let now = Unix.time () in
@@ -110,29 +110,29 @@ module Make (Conf : Config) : Sig = struct
     let time = time_string_of_timestamp now in
     let lvl = Level.to_symbol level in
 
-    Lwt_io.printlf "%s %s %s  %s" time Conf.prefix lvl message
-
+    let message = 
+      match exn with
+      | None -> message
+      | Some e -> message ^ " Exception: " ^ (Printexc.to_string e)
+    in
 
-  let logf (level : Level.t) fmt =
-    ksprintf (log level) fmt
+    Lwt_io.printlf "%s %s %s  %s" time Conf.prefix lvl message
 
 
-  let add_exn_to_message exn message =
-    message ^ match exn with
-    | None -> ""
-    | Some e -> " Exception: " ^ (Printexc.to_string e)
+  let logf (level : Level.t) ?exn fmt =
+    ksprintf (log level ?exn)  fmt
 
 
   let fatal ?exn message =
-    log `Fatal (add_exn_to_message exn message)
+    log `Fatal ?exn message
   let fatalf ?exn fmt =
     ksprintf (fatal ?exn) fmt
   let error ?exn message =
-    log `Error (add_exn_to_message exn message)
+    log `Error ?exn message
   let errorf ?exn fmt =
     ksprintf (error ?exn) fmt
   let warn ?exn message =
-    log `Warn (add_exn_to_message exn message)
+    log `Warn ?exn message
   let warnf ?exn fmt =
     ksprintf (warn ?exn) fmt
   let info message =