geochan/src/virtual/make_config_lib.ml

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 / "geochan.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
  ()