anil.recoil.org
Immich bindings and CLI in OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6open Cmdliner
7
8let app_name = "immich"
9
10(* Styled output helpers *)
11let header_style = Fmt.(styled `Bold string)
12let label_style = Fmt.(styled `Faint string)
13let value_style = Fmt.(styled (`Fg `Cyan) string)
14let success_style = Fmt.(styled (`Fg `Green) string)
15let warning_style = Fmt.(styled (`Fg `Yellow) string)
16let error_style = Fmt.(styled (`Fg `Red) string)
17let profile_style = Fmt.(styled (`Fg `Magenta) string)
18let current_style = Fmt.(styled (`Fg `Green) (styled `Bold string))
19
20(* Common Arguments *)
21
22let server_arg =
23 let doc = "Immich server URL." in
24 let env = Cmd.Env.info "IMMICH_SERVER" ~doc in
25 Arg.(required & pos 0 (some string) None & info [] ~env ~docv:"SERVER" ~doc)
26
27let server_opt =
28 let doc = "Immich server URL." in
29 let env = Cmd.Env.info "IMMICH_SERVER" ~doc in
30 Arg.(value & opt (some string) None & info ["server"; "s"] ~env ~docv:"URL" ~doc)
31
32let api_key_arg =
33 let doc = "API key (will prompt if not provided and not using password auth)." in
34 let env = Cmd.Env.info "IMMICH_API_KEY" ~doc in
35 Arg.(value & opt (some string) None & info ["api-key"; "k"] ~env ~docv:"KEY" ~doc)
36
37let email_arg =
38 let doc = "Email for password authentication." in
39 Arg.(value & opt (some string) None & info ["email"; "e"] ~docv:"EMAIL" ~doc)
40
41let password_arg =
42 let doc = "Password (will prompt if using email auth and not provided)." in
43 Arg.(value & opt (some string) None & info ["password"; "p"] ~docv:"PASSWORD" ~doc)
44
45let profile_arg =
46 let doc = "Profile name (default: current profile)." in
47 Arg.(value & opt (some string) None & info ["profile"; "P"] ~docv:"PROFILE" ~doc)
48
49let key_name_arg =
50 let doc = "Name for the API key (for display purposes)." in
51 Arg.(value & opt (some string) None & info ["name"; "n"] ~docv:"NAME" ~doc)
52
53(* Logging setup - takes requests_config to extract verbose_http *)
54
55let setup_logging_with_config style_renderer level (requests_config : Requests.Cmd.config) =
56 Fmt_tty.setup_std_outputs ?style_renderer ();
57 Logs.set_level level;
58 Logs.set_reporter (Logs_fmt.reporter ());
59 Requests.Cmd.setup_log_sources ~verbose_http:requests_config.verbose_http.value level
60
61let setup_logging_simple style_renderer level =
62 Fmt_tty.setup_std_outputs ?style_renderer ();
63 Logs.set_level level;
64 Logs.set_reporter (Logs_fmt.reporter ())
65
66let setup_logging =
67 Term.(const (fun style_renderer level -> (style_renderer, level))
68 $ Fmt_cli.style_renderer ()
69 $ Logs_cli.level ())
70
71(* Requests config term *)
72
73let requests_config_term fs =
74 Requests.Cmd.config_term app_name fs
75
76(* Session helper *)
77
78let with_session ?profile f env =
79 let fs = env#fs in
80 match Session.load fs ?profile () with
81 | None ->
82 let profile_name =
83 match profile with
84 | Some p -> p
85 | None -> Session.get_current_profile fs
86 in
87 Fmt.epr "%a Not logged in (profile: %a). Use '%a' first.@."
88 error_style "Error:"
89 profile_style profile_name
90 Fmt.(styled `Bold string) "immich auth login";
91 raise (Error.Exit_code 1)
92 | Some session -> f fs session
93
94let with_client ?requests_config ?profile f env =
95 with_session ?profile (fun fs session ->
96 Eio.Switch.run @@ fun sw ->
97 let client = Client.resume ~sw ~env ?requests_config ?profile ~session () in
98 f fs client
99 ) env
100
101(* Profile configuration for external programs *)
102
103module Profile_config = struct
104 type t = {
105 style_renderer : Fmt.style_renderer option;
106 log_level : Logs.level option;
107 requests_config : Requests.Cmd.config;
108 profile : string option;
109 }
110
111 let style_renderer t = t.style_renderer
112 let log_level t = t.log_level
113 let requests_config t = t.requests_config
114 let profile t = t.profile
115
116 let setup_logging t =
117 setup_logging_with_config t.style_renderer t.log_level t.requests_config
118end
119
120let profile_config_term fs =
121 let make (sr, ll) rc p =
122 Profile_config.{ style_renderer = sr; log_level = ll; requests_config = rc; profile = p }
123 in
124 Term.(const make $ setup_logging $ requests_config_term fs $ profile_arg)
125
126(* Login command *)
127
128let login_action ~requests_config ~server ~api_key ~email ~password ~profile ~key_name env =
129 match (api_key, email) with
130 | None, None ->
131 (* No auth method specified, prompt for API key *)
132 Fmt.pr "%a @?" label_style "API Key:";
133 let api_key = read_line () in
134 Eio.Switch.run @@ fun sw ->
135 let client = Client.login_api_key ~sw ~env ~requests_config ?profile ~server_url:server ~api_key ?key_name () in
136 let profile_name = Option.value ~default:Session.default_profile profile in
137 Fmt.pr "%a Logged in to %a (profile: %a)@."
138 success_style "Success:" value_style server profile_style profile_name;
139 ignore client
140 | Some api_key, None ->
141 Eio.Switch.run @@ fun sw ->
142 let client = Client.login_api_key ~sw ~env ~requests_config ?profile ~server_url:server ~api_key ?key_name () in
143 let profile_name = Option.value ~default:Session.default_profile profile in
144 Fmt.pr "%a Logged in to %a (profile: %a)@."
145 success_style "Success:" value_style server profile_style profile_name;
146 ignore client
147 | None, Some email ->
148 let password =
149 match password with
150 | Some p -> p
151 | None ->
152 Fmt.pr "%a @?" label_style "Password:";
153 read_line ()
154 in
155 Eio.Switch.run @@ fun sw ->
156 let client = Client.login_password ~sw ~env ~requests_config ?profile ~server_url:server ~email ~password () in
157 let profile_name = Option.value ~default:email profile in
158 Fmt.pr "%a Logged in as %a (profile: %a)@."
159 success_style "Success:" value_style email profile_style profile_name;
160 ignore client
161 | Some _, Some _ ->
162 Fmt.epr "%a Cannot specify both --api-key and --email. Choose one authentication method.@."
163 error_style "Error:";
164 raise (Error.Exit_code 1)
165
166let login_cmd env fs =
167 let doc = "Login to an Immich server." in
168 let info = Cmd.info "login" ~doc in
169 let login' (style_renderer, level) requests_config server api_key email password profile key_name =
170 setup_logging_with_config style_renderer level requests_config;
171 Error.wrap (fun () ->
172 login_action ~requests_config ~server ~api_key ~email ~password ~profile ~key_name env)
173 in
174 Cmd.v info
175 Term.(const login' $ setup_logging $ requests_config_term fs $ server_arg $ api_key_arg $ email_arg $ password_arg $ profile_arg $ key_name_arg)
176
177(* Logout command *)
178
179let logout_action ~profile env =
180 let fs = env#fs in
181 match Session.load fs ?profile () with
182 | None -> Fmt.pr "%a Not logged in.@." warning_style "Note:"
183 | Some session ->
184 Session.clear fs ?profile ();
185 let profile_name =
186 match profile with
187 | Some p -> p
188 | None -> Session.get_current_profile fs
189 in
190 Fmt.pr "%a Logged out from %a (profile: %a).@."
191 success_style "Success:"
192 value_style (Session.server_url session)
193 profile_style profile_name
194
195let logout_cmd env =
196 let doc = "Logout and clear saved session." in
197 let info = Cmd.info "logout" ~doc in
198 let logout' (style_renderer, level) profile =
199 setup_logging_simple style_renderer level;
200 logout_action ~profile env
201 in
202 Cmd.v info Term.(const logout' $ setup_logging $ profile_arg)
203
204(* Status command *)
205
206let status_action ~profile env =
207 let fs = env#fs in
208 let home = Sys.getenv "HOME" in
209 Fmt.pr "%a %a@." label_style "Config directory:" value_style (home ^ "/.config/immich");
210 let current = Session.get_current_profile fs in
211 Fmt.pr "%a %a@." label_style "Current profile:" current_style current;
212 let profiles = Session.list_profiles fs in
213 if profiles <> [] then begin
214 Fmt.pr "%a %a@." label_style "Available profiles:"
215 Fmt.(list ~sep:(any ", ") profile_style) profiles
216 end;
217 Fmt.pr "@.";
218 let profile = Option.value ~default:current profile in
219 match Session.load fs ~profile () with
220 | None ->
221 Fmt.pr "%a %a: %a@."
222 header_style "Profile"
223 profile_style profile
224 warning_style "Not logged in"
225 | Some session ->
226 Fmt.pr "%a %a:@." header_style "Profile" profile_style profile;
227 Fmt.pr " %a@." Session.pp session;
228 if Session.is_expired session then
229 Fmt.pr " %a@." warning_style "(token expired, please login again)"
230
231let auth_status_cmd env =
232 let doc = "Show authentication status." in
233 let info = Cmd.info "status" ~doc in
234 let status' (style_renderer, level) profile =
235 setup_logging_simple style_renderer level;
236 status_action ~profile env
237 in
238 Cmd.v info Term.(const status' $ setup_logging $ profile_arg)
239
240(* Profile list command *)
241
242let profile_list_action env =
243 let fs = env#fs in
244 let current = Session.get_current_profile fs in
245 let profiles = Session.list_profiles fs in
246 if profiles = [] then
247 Fmt.pr "%a No profiles found. Use '%a' to create one.@."
248 warning_style "Note:"
249 Fmt.(styled `Bold string) "immich auth login"
250 else begin
251 Fmt.pr "%a@." header_style "Profiles:";
252 List.iter
253 (fun p ->
254 let is_current = p = current in
255 match Session.load fs ~profile:p () with
256 | Some session ->
257 if is_current then
258 Fmt.pr " %a %a - %a@."
259 current_style p
260 success_style "(current)"
261 value_style (Session.server_url session)
262 else
263 Fmt.pr " %a - %a@."
264 profile_style p
265 value_style (Session.server_url session)
266 | None ->
267 if is_current then
268 Fmt.pr " %a %a@." current_style p success_style "(current)"
269 else
270 Fmt.pr " %a@." profile_style p)
271 profiles
272 end
273
274let profile_list_cmd env =
275 let doc = "List available profiles." in
276 let info = Cmd.info "list" ~doc in
277 let list' (style_renderer, level) () =
278 setup_logging_simple style_renderer level;
279 profile_list_action env
280 in
281 Cmd.v info Term.(const list' $ setup_logging $ const ())
282
283(* Profile switch command *)
284
285let profile_name_arg =
286 let doc = "Profile name to switch to." in
287 Arg.(required & pos 0 (some string) None & info [] ~docv:"PROFILE" ~doc)
288
289let profile_switch_action ~profile env =
290 let fs = env#fs in
291 let profiles = Session.list_profiles fs in
292 if List.mem profile profiles then begin
293 Session.set_current_profile fs profile;
294 Fmt.pr "%a Switched to profile: %a@."
295 success_style "Success:"
296 profile_style profile
297 end
298 else begin
299 Fmt.epr "%a Profile '%a' not found.@."
300 error_style "Error:"
301 profile_style profile;
302 if profiles <> [] then
303 Fmt.epr "%a %a@."
304 label_style "Available profiles:"
305 Fmt.(list ~sep:(any ", ") profile_style) profiles;
306 raise (Error.Exit_code 1)
307 end
308
309let profile_switch_cmd env =
310 let doc = "Switch to a different profile." in
311 let info = Cmd.info "switch" ~doc in
312 let switch' (style_renderer, level) profile =
313 setup_logging_simple style_renderer level;
314 profile_switch_action ~profile env
315 in
316 Cmd.v info Term.(const switch' $ setup_logging $ profile_name_arg)
317
318(* Profile current command *)
319
320let profile_current_action env =
321 let fs = env#fs in
322 let current = Session.get_current_profile fs in
323 Fmt.pr "%a@." current_style current
324
325let profile_current_cmd env =
326 let doc = "Show current profile name." in
327 let info = Cmd.info "current" ~doc in
328 let current' (style_renderer, level) () =
329 setup_logging_simple style_renderer level;
330 profile_current_action env
331 in
332 Cmd.v info Term.(const current' $ setup_logging $ const ())
333
334(* Profile command group *)
335
336let profile_cmd env =
337 let doc = "Profile management commands." in
338 let info = Cmd.info "profile" ~doc in
339 Cmd.group info
340 [ profile_list_cmd env
341 ; profile_switch_cmd env
342 ; profile_current_cmd env
343 ]
344
345(* Auth command group *)
346
347let auth_cmd env fs =
348 let doc = "Authentication commands." in
349 let info = Cmd.info "auth" ~doc in
350 Cmd.group info
351 [ login_cmd env fs
352 ; logout_cmd env
353 ; auth_status_cmd env
354 ; profile_cmd env
355 ]