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
8(* Styled output helpers *)
9let header_style = Fmt.(styled `Bold string)
10let label_style = Fmt.(styled `Faint string)
11let value_style = Fmt.(styled (`Fg `Cyan) string)
12let version_style = Fmt.(styled (`Fg `Green) string)
13let success_style = Fmt.(styled (`Fg `Green) string)
14let error_style = Fmt.(styled (`Fg `Red) string)
15
16let percent_style pct =
17 if pct >= 90.0 then Fmt.(styled (`Fg `Red) (fun ppf -> Fmt.pf ppf "%.1f%%"))
18 else if pct >= 70.0 then Fmt.(styled (`Fg `Yellow) (fun ppf -> Fmt.pf ppf "%.1f%%"))
19 else Fmt.(styled (`Fg `Green) (fun ppf -> Fmt.pf ppf "%.1f%%"))
20
21(* Ping command - can work with or without auth *)
22
23let ping_action ~requests_config ~server ~profile env =
24 Immich_auth.Error.wrap (fun () ->
25 Eio.Switch.run @@ fun sw ->
26 let fs = env#fs in
27 let server_url =
28 match server with
29 | Some url -> url
30 | None ->
31 (* Try to get from session *)
32 let profile = match profile with
33 | Some p -> Some p
34 | None -> Some (Immich_auth.Session.get_current_profile fs)
35 in
36 match Immich_auth.Session.load fs ?profile () with
37 | Some session -> Immich_auth.Session.server_url session
38 | None ->
39 Fmt.epr "%a No server specified and not logged in.@." error_style "Error:";
40 Fmt.epr "Use --server or login first.@.";
41 raise (Immich_auth.Error.Exit_code 1)
42 in
43 (* Create session using requests config *)
44 let session = Requests.Cmd.create requests_config env sw in
45 (* Resolve the API URL from .well-known/immich if available *)
46 let server_url = Immich_auth.Client.resolve_api_url ~session server_url in
47 let client = Immich.create ~session ~sw env ~base_url:server_url in
48 let resp = Immich.ServerPing.ping_server client () in
49 Fmt.pr "%a %a@." success_style "Server:" value_style (Immich.ServerPing.Response.res resp)
50 )
51
52let ping_cmd env fs =
53 let doc = "Ping the Immich server." in
54 let info = Cmd.info "ping" ~doc in
55 let ping' (style_renderer, level) requests_config server profile =
56 Immich_auth.Cmd.setup_logging_with_config style_renderer level requests_config;
57 ping_action ~requests_config ~server ~profile env
58 in
59 Cmd.v info Term.(const ping' $ Immich_auth.Cmd.setup_logging $ Immich_auth.Cmd.requests_config_term fs $ Immich_auth.Cmd.server_opt $ Immich_auth.Cmd.profile_arg)
60
61(* Status command - requires auth *)
62
63let status_action ~requests_config ~profile env =
64 Immich_auth.Error.wrap (fun () ->
65 Immich_auth.Cmd.with_client ~requests_config ?profile (fun _fs client ->
66 let api = Immich_auth.Client.client client in
67 (* Get server version *)
68 let version = Immich.ServerVersion.get_server_version api () in
69 Fmt.pr "%a %a@." header_style "Server Version:"
70 version_style (Printf.sprintf "%d.%d.%d"
71 (Immich.ServerVersion.ResponseDto.major version)
72 (Immich.ServerVersion.ResponseDto.minor version)
73 (Immich.ServerVersion.ResponseDto.patch version));
74 (* Get server about *)
75 let about = Immich.ServerAbout.get_about_info api () in
76 let full_version = Immich.ServerAbout.ResponseDto.version about in
77 if full_version <> "" then
78 Fmt.pr " %a %a@." label_style "Full version:" value_style full_version;
79 (match Immich.ServerAbout.ResponseDto.build about with
80 | Some b -> Fmt.pr " %a %a@." label_style "Build:" value_style b
81 | None -> ());
82 (* Get storage info *)
83 let storage = Immich.ServerStorage.get_storage api () in
84 let pct = Immich.ServerStorage.ResponseDto.disk_usage_percentage storage in
85 Fmt.pr "%a@." header_style "Storage:";
86 Fmt.pr " %a %a@." label_style "Disk size:" value_style (Immich.ServerStorage.ResponseDto.disk_size storage);
87 Fmt.pr " %a %a@." label_style "Disk used:" value_style (Immich.ServerStorage.ResponseDto.disk_use storage);
88 Fmt.pr " %a %a@." label_style "Disk available:" value_style (Immich.ServerStorage.ResponseDto.disk_available storage);
89 Fmt.pr " %a %a@." label_style "Usage:" (percent_style pct) pct
90 ) env
91 )
92
93let status_cmd env fs =
94 let doc = "Show server status." in
95 let info = Cmd.info "status" ~doc in
96 let status' (style_renderer, level) requests_config profile =
97 Immich_auth.Cmd.setup_logging_with_config style_renderer level requests_config;
98 status_action ~requests_config ~profile env
99 in
100 Cmd.v info Term.(const status' $ Immich_auth.Cmd.setup_logging $ Immich_auth.Cmd.requests_config_term fs $ Immich_auth.Cmd.profile_arg)
101
102(* Server command group *)
103
104let server_cmd env fs =
105 let doc = "Server information commands." in
106 let info = Cmd.info "server" ~doc in
107 Cmd.group info
108 [ ping_cmd env fs
109 ; status_cmd env fs
110 ]