type env = string -> string option type defaults = { timeout_span : float; login_timeout_span : float; logout_timeout_span : float; list_title_max_display_width : int; root_dir : Cli_primitive.path; ws_url : Cli_primitive.url; http_base : Cli_primitive.url; } type t = { graph : Cli_primitive.graph option; repo : Cli_primitive.repo option; root_dir : Cli_primitive.path; config_path : Cli_primitive.path; timeout_span : float; login_timeout_span : float; logout_timeout_span : float; list_title_max_display_width : int; output_format : Output.Mode.packed option; verbose : bool; profile : bool; ws_url : Cli_primitive.url option; http_base : Cli_primitive.url option; auth_path : Cli_primitive.path option; id_token : string option; access_token : string option; refresh_token : string option; base_url : Cli_primitive.url option; owner_source : Cli_primitive.owner_source; project_dir : Cli_primitive.path option; raw_file_config : Melange_edn_melange.any option; profile_session : Profile_types.session option; } type source = Defaults | Env | File of Cli_primitive.path | Argv type resolved = { config : t; sources : source Rrbvec.t } let default_root_dir () = Filename.concat (Sys.getenv_opt "HOME" |> Option.value ~default:".") "logseq" let default_config_path root_dir = Filename.concat root_dir "cli.edn" let defaults () = { timeout_span = Time.span_of_ms 10_000L; login_timeout_span = Time.span_of_ms 300_000L; logout_timeout_span = Time.span_of_ms 120_000L; list_title_max_display_width = 40; root_dir = default_root_dir (); ws_url = "wss://api.logseq.io/sync/%s"; http_base = "https://api.logseq.io"; } let db_version_prefix = "logseq_db_" let starts_with ~prefix value = let prefix_len = String.length prefix in String.length value >= prefix_len && String.sub value 0 prefix_len = prefix let strip_db_version_prefix value = if starts_with ~prefix:db_version_prefix value then String.sub value (String.length db_version_prefix) (String.length value - String.length db_version_prefix) else value let graph_to_repo graph = let stripped = let rec loop value = if starts_with ~prefix:db_version_prefix value then loop (strip_db_version_prefix value) else value in loop (Cli_primitive.string_of_graph graph) in Cli_primitive.create_repo stripped let repo_to_graph repo = Cli_primitive.create_graph (strip_db_version_prefix (Cli_primitive.string_of_repo repo)) let value_of_edn edn = edn let edn_of_value = Melange_edn_melange.to_edn_string let read_file = Cli_unix.read_text_file let read_config_file path = if not (Cli_unix.file_exists path) then Ok None else let content = read_file path in if String.trim content = "" then Ok None else try Ok (Some (Melange_edn_melange.of_edn_string content |> value_of_edn)) with exn -> Error (Error.make Error.Invalid_config ("invalid config file: " ^ path ^ " (" ^ Printexc.to_string exn ^ ")")) let invalid_config message = Error.make Error.Invalid_config message let parse_int_value value = let value = String.trim value in if value = "" then None else Option.map Edn_util.int64 (Int64.of_string_opt value) let env_string key env value_key fields = match env key with | Some value when String.trim value <> "" -> Vec.push_back fields (Edn_util.keyword value_key, Edn_util.string value) | _ -> fields let env_int key env value_key fields = match Option.bind (env key) parse_int_value with | Some value -> Vec.push_back fields (Edn_util.keyword value_key, value) | None -> fields let env_config env = let fields = Vec.empty |> env_string "LOGSEQ_CLI_GRAPH" env "graph" |> env_string "LOGSEQ_CLI_ROOT_DIR" env "root-dir" |> env_string "LOGSEQ_CLI_CONFIG" env "config-path" |> env_int "LOGSEQ_CLI_TIMEOUT_MS" env "timeout-ms" |> env_int "LOGSEQ_CLI_LOGIN_TIMEOUT_MS" env "login-timeout-ms" |> env_int "LOGSEQ_CLI_LOGOUT_TIMEOUT_MS" env "logout-timeout-ms" |> env_string "LOGSEQ_CLI_OUTPUT" env "output-format" |> env_string "LOGSEQ_CLI_WS_URL" env "ws-url" |> env_string "LOGSEQ_CLI_HTTP_BASE" env "http-base" in Edn_util.map_t_vec fields let validate_env_int_value key env = match env key with | Some value when String.trim value <> "" -> ( let value = String.trim value in match Int64.of_string_opt value with | Some _ -> Ok () | None -> Error (invalid_config ("invalid env " ^ key ^ ": " ^ value ^ ". Expected integer"))) | _ -> Ok () let checked_env_config env = Error.bind (validate_env_int_value "LOGSEQ_CLI_TIMEOUT_MS" env) (fun () -> Error.bind (validate_env_int_value "LOGSEQ_CLI_LOGIN_TIMEOUT_MS" env) (fun () -> Error.bind (validate_env_int_value "LOGSEQ_CLI_LOGOUT_TIMEOUT_MS" env) (fun () -> Ok (env_config env)))) let sanitize_file_config value = match Edn_util.as_map value with | Some fields -> Edn_util.map_vec (fields |> Vec.filter (fun (key, _) -> match Edn_util.as_string_like key with | Some ("auth-token" | "retries" | "e2ee-password") -> false | _ -> true)) | None -> value let assoc_opt key value fields = match value with | None -> fields | Some value -> Vec.push_front (Vec.remove_assoc (Edn_util.keyword key) fields) (Edn_util.keyword key, Edn_util.string value) let map_fields value = Option.value (Edn_util.as_map value) ~default:Vec.empty let rec mkdir_p path = if path = "" || path = Filename.dirname path || Cli_unix.file_exists path then () else ( mkdir_p (Filename.dirname path); Cli_unix.mkdir path 0o755) let write_config_file path value = mkdir_p (Filename.dirname path); Cli_unix.write_text_file path (edn_of_value value ^ "\n") let pick_graph config globals = match globals.Global_opts.graph with Some _ as g -> g | None -> config.graph let value_string key value = Edn_util.get_string value key let value_int key value = Edn_util.get_int value key let value_int64 key value = Edn_util.get_int64 value key let normalize_output_string value = let value = String.trim value in if value <> "" && value.[0] = ':' then String.sub value 1 (String.length value - 1) else value let value_output key value = Option.bind (value_string key value) (fun value -> Output.Mode.of_string (normalize_output_string value)) let edn_value_text value = Melange_edn_melange.to_edn_string value let validate_int64_config_value ~source key value = match Edn_util.get value key with | None -> Ok () | Some raw -> ( match Edn_util.as_int64 raw with | Some _ -> Ok () | None -> Error (invalid_config ("invalid " ^ source ^ " config " ^ key ^ ": " ^ edn_value_text raw ^ ". Expected integer"))) let validate_int_config_value ~source key value = match Edn_util.get value key with | None -> Ok () | Some raw -> ( match Edn_util.as_int raw with | Some _ -> Ok () | None -> Error (invalid_config ("invalid " ^ source ^ " config " ^ key ^ ": " ^ edn_value_text raw ^ ". Expected integer"))) let validate_output_config_value ~source key value = match Edn_util.get value key with | None -> Ok () | Some raw -> ( match Edn_util.as_string_like raw with | Some output when Option.is_some (Output.Mode.of_string (normalize_output_string output)) -> Ok () | _ -> Error (invalid_config ("invalid " ^ source ^ " config " ^ key ^ ": " ^ edn_value_text raw ^ ". Expected one of human, json, edn"))) let validate_config_values ~source value = Error.bind (validate_int64_config_value ~source "timeout-ms" value) (fun () -> Error.bind (validate_int64_config_value ~source "login-timeout-ms" value) (fun () -> Error.bind (validate_int64_config_value ~source "logout-timeout-ms" value) (fun () -> Error.bind (validate_int_config_value ~source "list-title-max-display-width" value) (fun () -> Error.bind (validate_output_config_value ~source "output-format" value) (fun () -> validate_output_config_value ~source "output" value))))) let first_some values = Vec.find_map (fun value -> value) values let positive_or_default value default = match value with Some value when value > 0 -> value | _ -> default let span_option_of_ms value = Option.map Time.span_of_ms value let resolve ~(defaults : defaults) ~env (globals : Global_opts.t) = match checked_env_config env with | Error _ as err -> Cli_effect.pure err | Ok env_config -> ( let env_config = Edn_util.any env_config in let initial_root_dir = first_some (Vec.of_array [| globals.root_dir; value_string "root-dir" env_config; Some defaults.root_dir; |]) |> Option.value ~default:defaults.root_dir in let config_path = first_some (Vec.of_array [| globals.config_path; value_string "config-path" env_config; Some (default_config_path initial_root_dir); |]) |> Option.value ~default:(default_config_path initial_root_dir) in match read_config_file config_path with | Error _ as err -> Cli_effect.pure err | Ok raw_file_config -> ( let raw_file_config = Option.map sanitize_file_config raw_file_config in match Error.bind (validate_config_values ~source:"env" env_config) (fun () -> match raw_file_config with | None -> Ok () | Some file_config -> validate_config_values ~source:"file" file_config) with | Error _ as err -> Cli_effect.pure err | Ok () -> let base_url = env "LOGSEQ_CLI_BASE_URL" in let file_graph = Option.bind raw_file_config (value_string "graph") |> Option.map Cli_primitive.create_graph in let env_graph = value_string "graph" env_config |> Option.map Cli_primitive.create_graph in let root_dir = first_some (Vec.of_array [| globals.root_dir; value_string "root-dir" env_config; Option.bind raw_file_config (value_string "root-dir"); Some initial_root_dir; |]) |> Option.value ~default:initial_root_dir in let graph = first_some (Vec.of_array [| globals.graph; env_graph; file_graph |]) in let repo = Option.map graph_to_repo graph in let file_ws_url = Option.bind raw_file_config (fun value -> Edn_util.get_string value "ws-url") in let file_http_base = Option.bind raw_file_config (fun value -> Edn_util.get_string value "http-base") in let file_auth_path = Option.bind raw_file_config (fun value -> Edn_util.get_string value "auth-path") in let file_id_token = Option.bind raw_file_config (fun value -> Edn_util.get_string value "id-token") in let file_access_token = Option.bind raw_file_config (fun value -> Edn_util.get_string value "access-token") in let file_refresh_token = Option.bind raw_file_config (fun value -> Edn_util.get_string value "refresh-token") in let env_ws_url = Edn_util.get_string env_config "ws-url" in let env_http_base = Edn_util.get_string env_config "http-base" in let output_format = first_some (Vec.of_array [| globals.output_format; value_output "output-format" env_config; Option.bind raw_file_config (value_output "output-format"); Option.bind raw_file_config (value_output "output"); |]) in let timeout_span = first_some (Vec.of_array [| globals.timeout_span; span_option_of_ms (value_int64 "timeout-ms" env_config); span_option_of_ms (Option.bind raw_file_config (value_int64 "timeout-ms")); Some defaults.timeout_span; |]) |> Option.value ~default:defaults.timeout_span in let login_timeout_span = first_some (Vec.of_array [| span_option_of_ms (value_int64 "login-timeout-ms" env_config); span_option_of_ms (Option.bind raw_file_config (value_int64 "login-timeout-ms")); Some defaults.login_timeout_span; |]) |> Option.value ~default:defaults.login_timeout_span in let logout_timeout_span = first_some (Vec.of_array [| span_option_of_ms (value_int64 "logout-timeout-ms" env_config); span_option_of_ms (Option.bind raw_file_config (value_int64 "logout-timeout-ms")); Some defaults.logout_timeout_span; |]) |> Option.value ~default:defaults.logout_timeout_span in let list_title_max_display_width = positive_or_default (Option.bind raw_file_config (value_int "list-title-max-display-width")) defaults.list_title_max_display_width in let config = { graph; repo; root_dir; config_path; timeout_span; login_timeout_span; logout_timeout_span; list_title_max_display_width; output_format; verbose = globals.verbose; profile = globals.profile; ws_url = Some (Option.value env_ws_url ~default: (Option.value file_ws_url ~default:defaults.ws_url)); http_base = Some (Option.value env_http_base ~default: (Option.value file_http_base ~default:defaults.http_base)); auth_path = file_auth_path; id_token = file_id_token; access_token = file_access_token; refresh_token = file_refresh_token; base_url; owner_source = Cli_primitive.Cli; project_dir = None; raw_file_config; profile_session = None; } in Cli_effect.pure (Ok { config; sources = Vec.of_array [| Defaults; File config_path; Env; Argv |]; }))) let update_config config patch = let original = match config.raw_file_config with | Some value -> value | None -> Edn_util.map_vec Vec.empty in let fields = map_fields original in let fields = fields |> assoc_opt "ws-url" (Edn_util.get_string patch "ws-url") |> assoc_opt "http-base" (Edn_util.get_string patch "http-base") |> assoc_opt "graph" (Edn_util.get_string patch "graph") in let fields = match Edn_util.get patch "ws-url" with | Some value when Edn_util.is_null value -> Vec.remove_assoc (Edn_util.keyword "ws-url") fields | _ -> fields in let fields = match Edn_util.get patch "http-base" with | Some value when Edn_util.is_null value -> Vec.remove_assoc (Edn_util.keyword "http-base") fields | _ -> fields in let fields = match Edn_util.get patch "graph" with | Some value when Edn_util.is_null value -> Vec.remove_assoc (Edn_util.keyword "graph") fields | _ -> fields in let value = Edn_util.map_t_vec (fields |> Vec.rev) in try write_config_file config.config_path (Edn_util.any value); Cli_effect.pure (Ok value) with exn -> Cli_effect.pure (Error (Error.make Error.Config_write_failed ("failed to write config file: " ^ Printexc.to_string exn)))