big squish

src/virtual/make_config_lib.ml

@@ -0,0 +1,217 @@
+let ( let* ) o f =
+  match o with
+  | Ok v -> f v
+  | Error (`Msg e) ->
+    Fmt.epr "config error, %s" e;
+    exit 1
+
+let unwrap param_name opt =
+  match opt with
+  | None -> Fmt.error_msg "parameter `%s` not found" param_name
+  | Some v -> Ok v
+
+let print k v =
+  Fmt.pr {|let %s = "%s"@.|} k v;
+  ()
+
+let print_b k v =
+  Fmt.pr "let %s = %b@." k v;
+  ()
+
+let print_int k v =
+  Fmt.pr "let %s = %#d@." k v;
+  ()
+
+let print_int_opt k v =
+  let s = match v with None -> "None" | Some v -> Fmt.str "Some %#d" v in
+  Fmt.pr "let %s = %s@." k s;
+  ()
+
+let print_l k l =
+  let l = List.map (Fmt.str {|"%s"|}) l in
+  Fmt.pr "let %s = [%s]@." k (String.concat "; " l);
+  ()
+
+let print_arr k arr =
+  let l = Array.map (Fmt.str {|"%s"|}) arr |> Array.to_list in
+  Fmt.pr "let %s = [|%s|]@." k (String.concat "; " l);
+  ()
+
+let print_fpath k v =
+  Fmt.pr {|let %s = Result.get_ok (Fpath.of_string "%s")@.|} k
+    (Fpath.to_string v);
+  ()
+
+let print_uri k v =
+  Fmt.pr {|let %s = Uri.of_string "%s"@.|} k (Uri.to_string v);
+  ()
+
+let config_path =
+  let* config_dir =
+    Dir.config
+    |> Option.to_result ~none:(`Msg "can't compute configuration directory")
+  in
+  let config_path = Fpath.(config_dir / "config.scfg") in
+  config_path
+
+let config =
+  let* exists = Bos.OS.File.exists config_path in
+  let* config =
+    match exists with
+    | false ->
+      Fmt.error_msg "configuration file `%a` does not exist, please create it"
+        Fpath.pp config_path
+    | true -> Scfg.Parse.from_file config_path
+  in
+  config
+
+let get_dir param_name =
+  let* dir = unwrap param_name @@ Scfg.Query.get_dir param_name config in
+  dir
+
+let mk_str param_name =
+  let* v = Scfg.Query.get_param 0 (get_dir param_name) in
+  print param_name v;
+  ()
+
+let mk_bool param_name =
+  let* v = Scfg.Query.get_param_bool 0 (get_dir param_name) in
+  print_b param_name v;
+  ()
+
+let mk_int ?min param_name =
+  let min = Option.value ~default:0 min in
+  let* n = Scfg.Query.get_param_int 0 (get_dir param_name) in
+  let* () =
+    match n with
+    | _ when n < 0 -> Fmt.error_msg "negative `%s` value" param_name
+    | _ when n < min ->
+      Fmt.error_msg "less than minimum (`%d`) `%s` value" min param_name
+    | _ -> Ok ()
+  in
+  print_int param_name n;
+  ()
+
+(* we use -1 in config file for None *)
+let mk_int_opt param_name =
+  let* opt =
+    match Scfg.Query.get_dir param_name config with
+    | None -> Ok None
+    | Some dir -> (
+      let* n = Scfg.Query.get_param_int 0 dir in
+      match n with
+      | -1 -> Ok None
+      | n when n < 0 -> Fmt.error_msg "negative `%s` value" param_name
+      | n -> Ok (Some n) )
+  in
+  print_int_opt param_name opt;
+  ()
+
+let mk_str_l param_name =
+  let dirs = Scfg.Query.get_dirs param_name config in
+  let l =
+    List.map
+      (fun dir ->
+        let* v = Scfg.Query.get_param 0 dir in
+        v )
+      dirs
+  in
+  print_l (Fmt.str "%s_l" param_name) l;
+  ()
+
+(* server config *)
+let print_config_serv () =
+  let () =
+    print_fpath "config_path" config_path;
+    ()
+  in
+
+  let () =
+    let* data_dir =
+      Dir.data |> Option.to_result ~none:(`Msg "can't compute data directory")
+    in
+    (* create data_dir *)
+    let* () =
+      match Bos.OS.Dir.create data_dir with
+      | Ok true -> Ok ()
+      | Ok false -> Ok ()
+      | Error (`Msg _) ->
+        Fmt.error_msg "error when creating %a" Fpath.pp data_dir
+    in
+    let db_path = Fpath.(data_dir / "permap.db") in
+    let s = Uri.of_string @@ Fmt.str "sqlite3://%a" Fpath.pp db_path in
+    print_uri "db_uri" s;
+    ()
+  in
+
+  let () = mk_bool "default_logger" in
+
+  let () = mk_bool "custom_logger" in
+
+  (* TODO add temporary password hash + email for first connection? *)
+  let () = mk_str_l "admin" in
+
+  ()
+
+(* config (server & client) *)
+let print_config () =
+  let () = mk_str "source_code_url" in
+
+  let () = mk_str "hostname" in
+
+  let () = mk_int "port" in
+
+  let () = mk_int "csrf_lifetime" in
+
+  let () = mk_int "session_lifetime" in
+
+  let () = mk_bool "open_registration" in
+
+  let () = mk_int "thread_max_count" in
+
+  let () = mk_int "thread_alive_max_count" in
+
+  let () = mk_int "thread_replies_max_count" in
+
+  let () = mk_int "subject_max_length" in
+
+  let () = mk_int_opt "subject_min_length" in
+
+  let () = mk_int "comment_max_length" in
+
+  let () = mk_int_opt "comment_min_length" in
+
+  let () = mk_int "report_max_length" in
+
+  let () = mk_int "nick_max_length" in
+
+  let () = mk_int ~min:1 "nick_min_length" in
+
+  let () = mk_int "biography_max_length" in
+
+  let () = mk_int "password_max_length" in
+
+  let () = mk_int ~min:1 "password_min_length" in
+
+  let () = mk_int "image_name_max_length" in
+
+  let () = mk_int "image_description_max_length" in
+
+  let () = mk_int "image_max_size" in
+  print_arr "supported_mime_type"
+    [| "image/jpeg"; "image/png"; "image/webp"; "image/gif" |];
+
+  ()
+
+let () =
+  let* arg =
+    if Array.length Sys.argv > 1 then Ok Sys.argv.(1)
+    else Fmt.error_msg "make config failure, no argument provided"
+  in
+  let* () =
+    match arg with
+    | "--config-serv" -> Ok (print_config_serv ())
+    | "--config" -> Ok (print_config ())
+    | _ -> Fmt.error_msg "make config failure, invalid argument `%s`" arg
+  in
+  ()