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
6(** Authentication method for Immich. *)
7type auth_method =
8 | Jwt of { access_token : string; user_id : string; email : string }
9 | Api_key of { key : string; name : string option }
10
11type t = {
12 server_url : string;
13 auth : auth_method;
14 created_at : string;
15}
16
17let auth_method_jsont =
18 let jwt_jsont =
19 Jsont.Object.map ~kind:"Jwt"
20 (fun access_token user_id email ->
21 Jwt { access_token; user_id; email })
22 |> Jsont.Object.mem "access_token" Jsont.string ~enc:(function
23 | Jwt { access_token; _ } -> access_token
24 | Api_key _ -> "")
25 |> Jsont.Object.mem "user_id" Jsont.string ~enc:(function
26 | Jwt { user_id; _ } -> user_id
27 | Api_key _ -> "")
28 |> Jsont.Object.mem "email" Jsont.string ~enc:(function
29 | Jwt { email; _ } -> email
30 | Api_key _ -> "")
31 |> Jsont.Object.finish
32 in
33 let api_key_jsont =
34 Jsont.Object.map ~kind:"ApiKey"
35 (fun key name -> Api_key { key; name })
36 |> Jsont.Object.mem "key" Jsont.string ~enc:(function
37 | Api_key { key; _ } -> key
38 | Jwt _ -> "")
39 |> Jsont.Object.opt_mem "name" Jsont.string ~enc:(function
40 | Api_key { name; _ } -> name
41 | Jwt _ -> None)
42 |> Jsont.Object.finish
43 in
44 Jsont.Object.map ~kind:"AuthMethod"
45 (fun type_ jwt api_key ->
46 match type_ with
47 | "jwt" -> Option.get jwt
48 | "api_key" -> Option.get api_key
49 | _ -> failwith ("Unknown auth type: " ^ type_))
50 |> Jsont.Object.mem "type" Jsont.string ~enc:(function
51 | Jwt _ -> "jwt"
52 | Api_key _ -> "api_key")
53 |> Jsont.Object.opt_mem "jwt" jwt_jsont ~enc:(function
54 | Jwt _ as j -> Some j
55 | Api_key _ -> None)
56 |> Jsont.Object.opt_mem "api_key" api_key_jsont ~enc:(function
57 | Api_key _ as a -> Some a
58 | Jwt _ -> None)
59 |> Jsont.Object.finish
60
61let jsont =
62 Jsont.Object.map ~kind:"Session"
63 (fun server_url auth created_at -> { server_url; auth; created_at })
64 |> Jsont.Object.mem "server_url" Jsont.string ~enc:(fun s -> s.server_url)
65 |> Jsont.Object.mem "auth" auth_method_jsont ~enc:(fun s -> s.auth)
66 |> Jsont.Object.mem "created_at" Jsont.string ~enc:(fun s -> s.created_at)
67 |> Jsont.Object.finish
68
69(* App config stores the current profile *)
70type app_config = { current_profile : string }
71
72let app_config_jsont =
73 Jsont.Object.map ~kind:"AppConfig" (fun current_profile ->
74 { current_profile })
75 |> Jsont.Object.mem "current_profile" Jsont.string ~enc:(fun c ->
76 c.current_profile)
77 |> Jsont.Object.finish
78
79let default_profile = "default"
80let app_name = "immich"
81
82(* Base config directory for the app *)
83let base_config_dir fs =
84 let home = Sys.getenv "HOME" in
85 let config_path = Eio.Path.(fs / home / ".config" / app_name) in
86 (try Eio.Path.mkdir ~perm:0o700 config_path
87 with Eio.Io (Eio.Fs.E (Eio.Fs.Already_exists _), _) -> ());
88 config_path
89
90(* Profiles directory *)
91let profiles_dir fs =
92 let base = base_config_dir fs in
93 let profiles = Eio.Path.(base / "profiles") in
94 (try Eio.Path.mkdir ~perm:0o700 profiles
95 with Eio.Io (Eio.Fs.E (Eio.Fs.Already_exists _), _) -> ());
96 profiles
97
98(* Config directory for a specific profile *)
99let config_dir fs ?profile () =
100 let profile_name = Option.value ~default:default_profile profile in
101 let profiles = profiles_dir fs in
102 let profile_dir = Eio.Path.(profiles / profile_name) in
103 (try Eio.Path.mkdir ~perm:0o700 profile_dir
104 with Eio.Io (Eio.Fs.E (Eio.Fs.Already_exists _), _) -> ());
105 profile_dir
106
107(* App config file (stores current profile) *)
108let app_config_file fs =
109 Eio.Path.(base_config_dir fs / "config.json")
110
111let load_app_config fs =
112 let path = app_config_file fs in
113 try
114 Eio.Path.load path
115 |> Jsont_bytesrw.decode_string app_config_jsont
116 |> Result.to_option
117 with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> None
118
119let save_app_config fs config =
120 let path = app_config_file fs in
121 match
122 Jsont_bytesrw.encode_string ~format:Jsont.Indent app_config_jsont config
123 with
124 | Ok content -> Eio.Path.save ~create:(`Or_truncate 0o600) path content
125 | Error e -> failwith ("Failed to encode app config: " ^ e)
126
127(* Get the current profile name *)
128let get_current_profile fs =
129 match load_app_config fs with
130 | Some config -> config.current_profile
131 | None -> default_profile
132
133(* Set the current profile *)
134let set_current_profile fs profile =
135 save_app_config fs { current_profile = profile }
136
137(* List all available profiles *)
138let list_profiles fs =
139 let profiles = profiles_dir fs in
140 try
141 Eio.Path.read_dir profiles
142 |> List.filter (fun name ->
143 (* Check if it's a directory with a session.json *)
144 let dir = Eio.Path.(profiles / name) in
145 let session = Eio.Path.(dir / "session.json") in
146 try
147 ignore (Eio.Path.load session);
148 true
149 with _ -> false)
150 |> List.sort String.compare
151 with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> []
152
153(* Session file within a profile directory *)
154let session_file fs ?profile () =
155 Eio.Path.(config_dir fs ?profile () / "session.json")
156
157let load fs ?profile () =
158 let profile =
159 match profile with
160 | Some p -> Some p
161 | None ->
162 (* Use current profile if none specified *)
163 let current = get_current_profile fs in
164 Some current
165 in
166 let path = session_file fs ?profile () in
167 try
168 Eio.Path.load path |> Jsont_bytesrw.decode_string jsont |> Result.to_option
169 with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> None
170
171let save fs ?profile session =
172 let profile =
173 match profile with
174 | Some p -> Some p
175 | None -> Some (get_current_profile fs)
176 in
177 let path = session_file fs ?profile () in
178 match Jsont_bytesrw.encode_string ~format:Jsont.Indent jsont session with
179 | Ok content -> Eio.Path.save ~create:(`Or_truncate 0o600) path content
180 | Error e -> failwith ("Failed to encode session: " ^ e)
181
182let clear fs ?profile () =
183 let profile =
184 match profile with
185 | Some p -> Some p
186 | None -> Some (get_current_profile fs)
187 in
188 let path = session_file fs ?profile () in
189 try Eio.Path.unlink path
190 with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> ()
191
192(* JWT payload type for expiration check *)
193type jwt_payload = { exp : float option }
194
195let jwt_payload_jsont =
196 Jsont.Object.map ~kind:"JwtPayload" (fun exp -> { exp })
197 |> Jsont.Object.opt_mem "exp" Jsont.number ~enc:(fun p -> p.exp)
198 |> Jsont.Object.skip_unknown
199 |> Jsont.Object.finish
200
201(* JWT expiration check using base64 decoding *)
202let is_jwt_expired ?(leeway = 60) token =
203 try
204 let parts = String.split_on_char '.' token in
205 if List.length parts < 2 then true
206 else begin
207 let payload = List.nth parts 1 in
208 (* Add padding if needed *)
209 let padding = String.length payload mod 4 in
210 let padded =
211 if padding > 0 then payload ^ String.make (4 - padding) '='
212 else payload
213 in
214 let decoded = Base64.decode_exn ~alphabet:Base64.uri_safe_alphabet padded in
215 (* Parse the JSON payload to find exp *)
216 match Jsont_bytesrw.decode_string jwt_payload_jsont decoded with
217 | Ok { exp = Some exp_time } ->
218 let now = Ptime.to_float_s (Ptime_clock.now ()) in
219 now >= exp_time -. (Float.of_int leeway)
220 | Ok { exp = None } -> true
221 | Error _ -> true
222 end
223 with _ -> true
224
225let is_expired ?leeway session =
226 match session.auth with
227 | Jwt { access_token; _ } -> is_jwt_expired ?leeway access_token
228 | Api_key _ -> false (* API keys don't expire *)
229
230(* Styled output helpers *)
231let label_style = Fmt.(styled `Faint string)
232let value_style = Fmt.(styled (`Fg `Cyan) string)
233let auth_type_style = Fmt.(styled (`Fg `Green) string)
234
235let pp ppf session =
236 match session.auth with
237 | Jwt { user_id; email; _ } ->
238 Fmt.pf ppf "@[<v>%a %a@,%a %a@,%a %a@,%a %a@,%a %a@]"
239 label_style "Email:" value_style email
240 label_style "User ID:" value_style user_id
241 label_style "Server:" value_style session.server_url
242 label_style "Created:" value_style session.created_at
243 label_style "Auth:" auth_type_style "JWT"
244 | Api_key { name; _ } ->
245 let name_str = Option.value ~default:"<unnamed>" name in
246 Fmt.pf ppf "@[<v>%a %a@,%a %a@,%a %a@,%a %a@]"
247 label_style "API Key:" value_style name_str
248 label_style "Server:" value_style session.server_url
249 label_style "Created:" value_style session.created_at
250 label_style "Auth:" auth_type_style "API Key"
251
252let server_url t = t.server_url
253let auth t = t.auth
254let created_at t = t.created_at
255
256let create ~server_url ~auth () =
257 { server_url; auth; created_at = Ptime.to_rfc3339 (Ptime_clock.now ()) }