Matrix protocol in OCaml, Eio specialised
Add omatrix CLI with session persistence and cmdliner subcommands
Redesign send_dm example into a proper omatrix CLI tool with:
- login: authenticate and store session to XDG directories
- logout: clear session with optional server-side invalidation
- whoami: display current session information
- msg: send messages to rooms or DM recipients
Add reusable cmdliner terms in Matrix_client.Cmd module for building
Matrix CLI applications, with support for environment variables and
orthogonal flag design.
Add Session module for XDG-based session persistence with TOML storage
for credentials, sync state, and E2EE key material.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+1987
-1
+4
-1
dune-project
+4
-1
dune-project
+18
examples/dune
+18
examples/dune
···
1
1
(executable
2
2
(name simple_bot)
3
3
(libraries matrix_eio matrix_proto jsont eio_main uri))
4
+
5
+
(executable
6
+
(name send_dm)
7
+
(libraries matrix_eio matrix_proto eio_main uri cmdliner logs logs.cli logs.fmt fmt.tty fmt.cli))
8
+
9
+
(executable
10
+
(name omatrix)
11
+
(public_name omatrix)
12
+
(package ocaml-matrix)
13
+
(libraries
14
+
matrix_eio
15
+
matrix_client
16
+
matrix_proto
17
+
eio_main
18
+
uri
19
+
xdge
20
+
ptime.clock.os
21
+
cmdliner))
+406
examples/omatrix.ml
+406
examples/omatrix.ml
···
1
+
(** omatrix - Command-line Matrix client.
2
+
3
+
A CLI tool for interacting with Matrix homeservers, supporting
4
+
session persistence and common operations like login, messaging,
5
+
and room management.
6
+
7
+
{b Quick Start}
8
+
9
+
{[
10
+
# Login and store session
11
+
omatrix login -s https://matrix.org -u @you:matrix.org
12
+
13
+
# Send a direct message (uses stored session)
14
+
omatrix msg -t @them:matrix.org "Hello!"
15
+
16
+
# Send to a room
17
+
omatrix msg -r '!roomid:matrix.org' "Hello room!"
18
+
19
+
# Check current session
20
+
omatrix whoami
21
+
22
+
# Logout and clear session
23
+
omatrix logout
24
+
]}
25
+
26
+
Environment variables:
27
+
- [MATRIX_HOMESERVER]: Default homeserver URL
28
+
- [MATRIX_USERNAME]: Default username
29
+
- [MATRIX_PASSWORD]: Password (preferred over command-line) *)
30
+
31
+
open Cmdliner
32
+
module Cmd = Matrix_client.Cmd
33
+
module Session = Matrix_client.Session
34
+
35
+
(* ================================================================ *)
36
+
(* Shared State *)
37
+
(* ================================================================ *)
38
+
39
+
(** Application name for session metadata *)
40
+
let app_name = "omatrix"
41
+
42
+
(** Get XDG directories for session storage *)
43
+
let with_xdg ~env f =
44
+
let fs = Eio.Stdenv.fs env in
45
+
let xdg = Xdge.create fs "matrix" in
46
+
f xdg
47
+
48
+
(** Load a stored session, returning the store and session data *)
49
+
let load_session ~env ~profile =
50
+
with_xdg ~env @@ fun xdg ->
51
+
let store = Session.Store.create ~xdg ~profile in
52
+
Session.Store.load_session store |> Option.map (fun session -> (store, session))
53
+
54
+
(** Log error for missing session *)
55
+
let log_no_session ~profile =
56
+
Logs.err (fun m -> m "No session found for profile '%s'" profile);
57
+
Logs.err (fun m -> m "Use 'omatrix login' to authenticate first")
58
+
59
+
(** Create a client from stored session credentials *)
60
+
let client_from_session ~sw ~env (session : Session.Session_file.t) =
61
+
let homeserver = session.server.homeserver in
62
+
let client = Matrix_eio.Client.create ~sw ~env ~homeserver () in
63
+
(* Restore session state *)
64
+
let matrix_session : Matrix_client.Client.session = {
65
+
user_id = session.server.user_id;
66
+
device_id = session.auth.device_id;
67
+
access_token = session.auth.access_token;
68
+
refresh_token = session.auth.refresh_token;
69
+
} in
70
+
Matrix_eio.Client.with_session client matrix_session
71
+
72
+
(* ================================================================ *)
73
+
(* Login Command *)
74
+
(* ================================================================ *)
75
+
76
+
let login_run ~homeserver ~username ~password ~profile () =
77
+
Eio_main.run @@ fun env ->
78
+
Eio.Switch.run @@ fun sw ->
79
+
80
+
Logs.info (fun m -> m "Connecting to %s" homeserver);
81
+
82
+
let client =
83
+
try
84
+
Matrix_eio.login_password ~sw ~env
85
+
~homeserver:(Uri.of_string homeserver)
86
+
~user:username ~password ()
87
+
with Eio.Io (Matrix_eio.Error.E err, _) ->
88
+
Logs.err (fun m -> m "Login failed: %a" Matrix_eio.Error.pp_err err);
89
+
exit Cmd.exit_auth
90
+
in
91
+
92
+
let user_id = Matrix_eio.Client.user_id client in
93
+
let device_id = Matrix_eio.Client.device_id client in
94
+
let access_token = Matrix_eio.Client.access_token client in
95
+
96
+
Logs.info (fun m -> m "Logged in as %s"
97
+
(Matrix_proto.Id.User_id.to_string user_id));
98
+
99
+
(* Save session *)
100
+
with_xdg ~env @@ fun xdg ->
101
+
let store = Session.Store.create ~xdg ~profile in
102
+
let now = Ptime_clock.now () in
103
+
let session : Session.Session_file.t = {
104
+
server = {
105
+
homeserver = Uri.of_string homeserver;
106
+
user_id;
107
+
};
108
+
auth = {
109
+
access_token;
110
+
device_id;
111
+
refresh_token = None;
112
+
};
113
+
sync = {
114
+
next_batch = None;
115
+
filter_id = None;
116
+
};
117
+
metadata = {
118
+
created_at = now;
119
+
last_used_at = now;
120
+
client_name = app_name;
121
+
};
122
+
} in
123
+
Session.Store.save_session store session;
124
+
125
+
Logs.app (fun m -> m "Session saved to profile '%s'" profile);
126
+
Logs.app (fun m -> m "User ID: %s" (Matrix_proto.Id.User_id.to_string user_id));
127
+
Logs.app (fun m -> m "Device ID: %s" (Matrix_proto.Id.Device_id.to_string device_id));
128
+
`Ok ()
129
+
130
+
let login_term =
131
+
let run () homeserver username password profile =
132
+
login_run ~homeserver ~username ~password ~profile ()
133
+
in
134
+
Term.(ret (const run
135
+
$ Cmd.verbosity_term
136
+
$ Cmd.homeserver_term
137
+
$ Cmd.username_term
138
+
$ Cmd.password_term
139
+
$ Cmd.profile_term))
140
+
141
+
let login_cmd =
142
+
let doc = "Authenticate with a Matrix homeserver" in
143
+
let man = [
144
+
`S Manpage.s_description;
145
+
`P "Logs in to a Matrix homeserver using password authentication and \
146
+
stores the session credentials for later use. The session is saved \
147
+
to the profile directory under $(b,\\$XDG_DATA_HOME/matrix/profiles/).";
148
+
`S Manpage.s_examples;
149
+
`Pre " omatrix login -s https://matrix.org -u @you:matrix.org";
150
+
`P "Using environment variables:";
151
+
`Pre " export MATRIX_PASSWORD=secret";
152
+
`Pre " omatrix login -s https://matrix.org -u @you:matrix.org";
153
+
`P "Using a named profile:";
154
+
`Pre " omatrix login --profile work -s https://work.matrix.org -u @you:work.matrix.org";
155
+
] in
156
+
let info = Cmdliner.Cmd.info "login" ~doc ~man in
157
+
Cmdliner.Cmd.v info login_term
158
+
159
+
(* ================================================================ *)
160
+
(* Logout Command *)
161
+
(* ================================================================ *)
162
+
163
+
let logout_run ~profile ~keep_local () =
164
+
Eio_main.run @@ fun env ->
165
+
Eio.Switch.run @@ fun sw ->
166
+
167
+
match load_session ~env ~profile with
168
+
| None ->
169
+
Logs.warn (fun m -> m "No session found for profile '%s'" profile);
170
+
`Ok ()
171
+
| Some (store, session) ->
172
+
if not keep_local then begin
173
+
(* Logout from server *)
174
+
Logs.info (fun m -> m "Logging out from server...");
175
+
let client = client_from_session ~sw ~env session in
176
+
(try
177
+
Matrix_eio.Auth.logout client;
178
+
Logs.info (fun m -> m "Server logout successful")
179
+
with Eio.Io _ ->
180
+
Logs.warn (fun m -> m "Server logout failed (session may still be active)"))
181
+
end;
182
+
183
+
(* Clear local session *)
184
+
Session.Store.clear store;
185
+
Logs.app (fun m -> m "Session cleared for profile '%s'" profile);
186
+
`Ok ()
187
+
188
+
let keep_local_term =
189
+
let doc = "Only clear local session without notifying the server." in
190
+
Arg.(value & flag & info ["local"] ~doc)
191
+
192
+
let logout_term =
193
+
let run () profile keep_local =
194
+
logout_run ~profile ~keep_local ()
195
+
in
196
+
Term.(ret (const run $ Cmd.verbosity_term $ Cmd.profile_term $ keep_local_term))
197
+
198
+
let logout_cmd =
199
+
let doc = "Log out and clear stored session" in
200
+
let man = [
201
+
`S Manpage.s_description;
202
+
`P "Logs out from the Matrix homeserver and clears the stored session. \
203
+
By default, this invalidates the access token on the server.";
204
+
`S Manpage.s_examples;
205
+
`Pre " omatrix logout";
206
+
`P "Clear only the local session (keep server session active):";
207
+
`Pre " omatrix logout --local";
208
+
`P "Logout from a specific profile:";
209
+
`Pre " omatrix logout --profile work";
210
+
] in
211
+
let info = Cmdliner.Cmd.info "logout" ~doc ~man in
212
+
Cmdliner.Cmd.v info logout_term
213
+
214
+
(* ================================================================ *)
215
+
(* Whoami Command *)
216
+
(* ================================================================ *)
217
+
218
+
let whoami_run ~profile () =
219
+
Eio_main.run @@ fun env ->
220
+
221
+
match load_session ~env ~profile with
222
+
| None ->
223
+
log_no_session ~profile;
224
+
`Error (false, "Not logged in")
225
+
| Some (_store, session) ->
226
+
let user_id = Matrix_proto.Id.User_id.to_string session.server.user_id in
227
+
let device_id = Matrix_proto.Id.Device_id.to_string session.auth.device_id in
228
+
let homeserver = Uri.to_string session.server.homeserver in
229
+
230
+
Format.printf "Profile: %s@." profile;
231
+
Format.printf "User ID: %s@." user_id;
232
+
Format.printf "Device ID: %s@." device_id;
233
+
Format.printf "Homeserver: %s@." homeserver;
234
+
Format.printf "Last used: %a@." (Ptime.pp_rfc3339 ()) session.metadata.last_used_at;
235
+
`Ok ()
236
+
237
+
let whoami_term =
238
+
let run () profile =
239
+
whoami_run ~profile ()
240
+
in
241
+
Term.(ret (const run $ Cmd.verbosity_term $ Cmd.profile_term))
242
+
243
+
let whoami_cmd =
244
+
let doc = "Show current session information" in
245
+
let man = [
246
+
`S Manpage.s_description;
247
+
`P "Displays information about the currently stored session, including \
248
+
the user ID, device ID, and homeserver.";
249
+
`S Manpage.s_examples;
250
+
`Pre " omatrix whoami";
251
+
`Pre " omatrix whoami --profile work";
252
+
] in
253
+
let info = Cmdliner.Cmd.info "whoami" ~doc ~man in
254
+
Cmdliner.Cmd.v info whoami_term
255
+
256
+
(* ================================================================ *)
257
+
(* Msg Command *)
258
+
(* ================================================================ *)
259
+
260
+
let msg_run ~profile ~room ~recipient ~message ~encrypted () =
261
+
Eio_main.run @@ fun env ->
262
+
Eio.Switch.run @@ fun sw ->
263
+
264
+
(* Load session *)
265
+
let store, session = match load_session ~env ~profile with
266
+
| None -> log_no_session ~profile; exit Cmd.exit_auth
267
+
| Some s -> s
268
+
in
269
+
270
+
let client = client_from_session ~sw ~env session in
271
+
let user_id = Matrix_eio.Client.user_id client in
272
+
Logs.info (fun m -> m "Using session for %s"
273
+
(Matrix_proto.Id.User_id.to_string user_id));
274
+
275
+
(* Determine target room *)
276
+
let room_id = match room, recipient with
277
+
| Some room_str, None ->
278
+
(* Direct room ID *)
279
+
(match Matrix_proto.Id.Room_id.of_string room_str with
280
+
| Ok id -> id
281
+
| Error (`Invalid_room_id msg) ->
282
+
Logs.err (fun m -> m "Invalid room ID '%s': %s" room_str msg);
283
+
exit Cmd.exit_usage)
284
+
| None, Some recipient_str ->
285
+
(* DM - find or create room *)
286
+
let recipient_id = match Matrix_proto.Id.User_id.of_string recipient_str with
287
+
| Ok id -> id
288
+
| Error (`Invalid_user_id msg) ->
289
+
Logs.err (fun m -> m "Invalid user ID '%s': %s" recipient_str msg);
290
+
exit Cmd.exit_usage
291
+
in
292
+
Logs.info (fun m -> m "Finding or creating DM room with %s" recipient_str);
293
+
let encrypted_opt = if encrypted then Some true else None in
294
+
(try
295
+
Matrix_eio.Rooms.get_or_create_dm client ~user_id:recipient_id
296
+
?encrypted:encrypted_opt ()
297
+
with Eio.Io (Matrix_eio.Error.E err, _) ->
298
+
Logs.err (fun m -> m "Failed to get/create DM room: %a"
299
+
Matrix_eio.Error.pp_err err);
300
+
exit Cmd.exit_network)
301
+
| Some _, Some _ ->
302
+
Logs.err (fun m -> m "Cannot specify both --room and --to");
303
+
exit Cmd.exit_usage
304
+
| None, None ->
305
+
Logs.err (fun m -> m "Must specify --room or --to");
306
+
exit Cmd.exit_usage
307
+
in
308
+
309
+
Logs.info (fun m -> m "Sending to room %s"
310
+
(Matrix_proto.Id.Room_id.to_string room_id));
311
+
312
+
(* Send message *)
313
+
let event_id =
314
+
try
315
+
Matrix_eio.Messages.send_text client ~room_id ~body:message ()
316
+
with Eio.Io (Matrix_eio.Error.E err, _) ->
317
+
Logs.err (fun m -> m "Failed to send message: %a"
318
+
Matrix_eio.Error.pp_err err);
319
+
exit Cmd.exit_network
320
+
in
321
+
322
+
Logs.app (fun m -> m "Message sent (event ID: %s)"
323
+
(Matrix_proto.Id.Event_id.to_string event_id));
324
+
325
+
(* Update last_used_at *)
326
+
let updated_session = {
327
+
session with metadata = {
328
+
session.metadata with last_used_at = Ptime_clock.now ()
329
+
}
330
+
} in
331
+
Session.Store.save_session store updated_session;
332
+
333
+
`Ok ()
334
+
335
+
let msg_term =
336
+
let run () profile room recipient message encrypted =
337
+
msg_run ~profile ~room ~recipient ~message ~encrypted ()
338
+
in
339
+
Term.(ret (const run
340
+
$ Cmd.verbosity_term
341
+
$ Cmd.profile_term
342
+
$ Cmd.room_opt_term
343
+
$ Cmd.recipient_opt_term
344
+
$ Cmd.message_term
345
+
$ Cmd.encrypted_term))
346
+
347
+
let msg_cmd =
348
+
let doc = "Send a message to a room or user" in
349
+
let man = [
350
+
`S Manpage.s_description;
351
+
`P "Sends a text message to a Matrix room or directly to another user. \
352
+
Requires a stored session from $(b,omatrix login).";
353
+
`P "For direct messages (using $(b,--to)), an existing DM room is reused \
354
+
if one exists, otherwise a new room is created.";
355
+
`S Manpage.s_examples;
356
+
`P "Send a direct message:";
357
+
`Pre " omatrix msg -t @alice:matrix.org \"Hello Alice!\"";
358
+
`P "Send to a room:";
359
+
`Pre " omatrix msg -r '!roomid:matrix.org' \"Hello room!\"";
360
+
`P "Create encrypted DM (for new rooms):";
361
+
`Pre " omatrix msg -t @alice:matrix.org -e \"Secret message\"";
362
+
`P "Using a different profile:";
363
+
`Pre " omatrix msg --profile work -t @colleague:work.org \"Meeting at 3pm\"";
364
+
] in
365
+
let info = Cmdliner.Cmd.info "msg" ~doc ~man in
366
+
Cmdliner.Cmd.v info msg_term
367
+
368
+
(* ================================================================ *)
369
+
(* Main Command Group *)
370
+
(* ================================================================ *)
371
+
372
+
let main_cmd =
373
+
let doc = "Command-line Matrix client" in
374
+
let man = [
375
+
`S Manpage.s_description;
376
+
`P "$(b,omatrix) is a command-line client for the Matrix communication \
377
+
protocol. It supports session persistence, allowing you to log in \
378
+
once and perform subsequent operations without re-authenticating.";
379
+
`S Manpage.s_commands;
380
+
`P "$(b,login) Authenticate with a homeserver and store session";
381
+
`P "$(b,logout) Clear stored session and invalidate token";
382
+
`P "$(b,whoami) Show current session information";
383
+
`P "$(b,msg) Send a message to a room or user";
384
+
`S "PROFILES";
385
+
`P "$(b,omatrix) supports multiple profiles for managing different Matrix \
386
+
accounts. Each profile stores its own session data independently.";
387
+
`P "Session data is stored in $(b,\\$XDG_DATA_HOME/matrix/profiles/NAME/).";
388
+
`P "The default profile is named 'default'. Use $(b,--profile NAME) to \
389
+
use a different profile.";
390
+
`S Manpage.s_environment;
391
+
`I ("$(b,MATRIX_HOMESERVER)", "Default homeserver URL");
392
+
`I ("$(b,MATRIX_USERNAME)", "Default username");
393
+
`I ("$(b,MATRIX_PASSWORD)", "Password (preferred over command-line)");
394
+
`S Manpage.s_bugs;
395
+
`P "Report bugs at <https://github.com/ocaml-matrix/ocaml-matrix/issues>.";
396
+
] in
397
+
let default = Term.(ret (const (`Help (`Auto, None)))) in
398
+
let info = Cmdliner.Cmd.info "omatrix" ~version:"0.1.0" ~doc ~man in
399
+
Cmdliner.Cmd.group info ~default [
400
+
login_cmd;
401
+
logout_cmd;
402
+
whoami_cmd;
403
+
msg_cmd;
404
+
]
405
+
406
+
let () = exit (Cmdliner.Cmd.eval main_cmd)
+171
lib/matrix_client/cmd.ml
+171
lib/matrix_client/cmd.ml
···
1
+
(** Cmdliner terms for Matrix CLI applications. *)
2
+
3
+
open Cmdliner
4
+
5
+
(* ================================================================ *)
6
+
(* Argument Converters *)
7
+
(* ================================================================ *)
8
+
9
+
let user_id_conv =
10
+
let parse s =
11
+
Matrix_proto.Id.User_id.of_string s
12
+
|> Result.map_error (fun (`Invalid_user_id msg) -> `Msg msg)
13
+
in
14
+
let pp fmt id = Format.pp_print_string fmt (Matrix_proto.Id.User_id.to_string id) in
15
+
Arg.conv (parse, pp)
16
+
17
+
let room_id_conv =
18
+
let parse s =
19
+
Matrix_proto.Id.Room_id.of_string s
20
+
|> Result.map_error (fun (`Invalid_room_id msg) -> `Msg msg)
21
+
in
22
+
let pp fmt id = Format.pp_print_string fmt (Matrix_proto.Id.Room_id.to_string id) in
23
+
Arg.conv (parse, pp)
24
+
25
+
let uri_conv =
26
+
let pp fmt uri = Format.pp_print_string fmt (Uri.to_string uri) in
27
+
Arg.conv (Fun.compose Result.ok Uri.of_string, pp)
28
+
29
+
(* ================================================================ *)
30
+
(* Helper for optional/required string argument pairs *)
31
+
(* ================================================================ *)
32
+
33
+
(** Create a pair of optional and required terms for a string argument. *)
34
+
let string_arg_pair ?env_var ~doc ~flags ~docv () =
35
+
let env = Option.map (fun v -> Cmd.Env.info v ~doc) env_var in
36
+
let arg = Arg.(opt (some string) None & info flags ?env ~docv ~doc) in
37
+
let opt_term = Arg.(value & arg) in
38
+
let req_term = Arg.(required & arg) in
39
+
(opt_term, req_term)
40
+
41
+
(* ================================================================ *)
42
+
(* Connection Options *)
43
+
(* ================================================================ *)
44
+
45
+
let homeserver_opt_term, homeserver_term =
46
+
string_arg_pair ()
47
+
~doc:"Matrix homeserver URL (e.g., https://matrix.org). \
48
+
Can also be set via $(b,MATRIX_HOMESERVER)."
49
+
~env_var:"MATRIX_HOMESERVER"
50
+
~flags:["homeserver"; "s"]
51
+
~docv:"URL"
52
+
53
+
(* ================================================================ *)
54
+
(* Authentication Options *)
55
+
(* ================================================================ *)
56
+
57
+
let username_opt_term, username_term =
58
+
string_arg_pair ()
59
+
~doc:"Username (localpart or full @user:server format). \
60
+
Can also be set via $(b,MATRIX_USERNAME)."
61
+
~env_var:"MATRIX_USERNAME"
62
+
~flags:["username"; "u"]
63
+
~docv:"USER"
64
+
65
+
let password_opt_term, password_term =
66
+
string_arg_pair ()
67
+
~doc:"Password for authentication. For better security, prefer the \
68
+
$(b,MATRIX_PASSWORD) environment variable over this flag."
69
+
~env_var:"MATRIX_PASSWORD"
70
+
~flags:["password"; "p"]
71
+
~docv:"PASS"
72
+
73
+
(* ================================================================ *)
74
+
(* Session Management *)
75
+
(* ================================================================ *)
76
+
77
+
let profile_term =
78
+
let doc =
79
+
"Profile name for session storage. Profiles are stored in \
80
+
$(b,\\$XDG_DATA_HOME/matrix/profiles/NAME/). \
81
+
Use different profiles for multiple accounts."
82
+
in
83
+
Arg.(value & opt string "default" &
84
+
info ["profile"; "P"] ~docv:"NAME" ~doc)
85
+
86
+
(* ================================================================ *)
87
+
(* Target Options *)
88
+
(* ================================================================ *)
89
+
90
+
let room_opt_term, room_term =
91
+
string_arg_pair ()
92
+
~doc:"Room ID in !roomid:server format."
93
+
~flags:["room"; "r"]
94
+
~docv:"ROOM_ID"
95
+
96
+
let recipient_opt_term, recipient_term =
97
+
string_arg_pair ()
98
+
~doc:"Recipient user ID in @user:server format (for direct messages)."
99
+
~flags:["to"; "t"]
100
+
~docv:"USER_ID"
101
+
102
+
(* ================================================================ *)
103
+
(* Message Options *)
104
+
(* ================================================================ *)
105
+
106
+
let message_opt_term, message_term =
107
+
let doc = "Message text to send." in
108
+
let arg = Arg.(pos 0 (some string) None & info [] ~docv:"MESSAGE" ~doc) in
109
+
Arg.(value & arg), Arg.(required & arg)
110
+
111
+
(* ================================================================ *)
112
+
(* Encryption Options *)
113
+
(* ================================================================ *)
114
+
115
+
let encrypted_term =
116
+
let doc =
117
+
"Enable end-to-end encryption for newly created rooms. \
118
+
Note: Encryption requires key management; messages may not be \
119
+
decryptable without proper key backup."
120
+
in
121
+
Arg.(value & flag & info ["encrypted"; "e"] ~doc)
122
+
123
+
(* ================================================================ *)
124
+
(* Logging Options *)
125
+
(* ================================================================ *)
126
+
127
+
let setup_log style_renderer level =
128
+
Fmt_tty.setup_std_outputs ?style_renderer ();
129
+
Logs.set_level level;
130
+
Logs.set_reporter (Logs_fmt.reporter ());
131
+
()
132
+
133
+
let verbosity_term =
134
+
Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ())
135
+
136
+
(* ================================================================ *)
137
+
(* Parsed Types *)
138
+
(* ================================================================ *)
139
+
140
+
type login_credentials = {
141
+
homeserver : string;
142
+
username : string;
143
+
password : string;
144
+
profile : string;
145
+
}
146
+
147
+
let login_credentials_term =
148
+
let make homeserver username password profile =
149
+
{ homeserver; username; password; profile }
150
+
in
151
+
Term.(const make $ homeserver_term $ username_term $ password_term $ profile_term)
152
+
153
+
type message_target =
154
+
| Room of string
155
+
| Direct of string
156
+
157
+
type message_params = {
158
+
target : message_target;
159
+
body : string;
160
+
encrypted : bool;
161
+
}
162
+
163
+
(* ================================================================ *)
164
+
(* Exit Codes *)
165
+
(* ================================================================ *)
166
+
167
+
let exit_ok = Cmd.Exit.ok
168
+
let exit_usage = Cmd.Exit.cli_error
169
+
let exit_auth = 77
170
+
let exit_network = 69
171
+
let exit_internal = 70
+205
lib/matrix_client/cmd.mli
+205
lib/matrix_client/cmd.mli
···
1
+
(** Cmdliner terms for Matrix CLI applications.
2
+
3
+
This module provides reusable cmdliner terms and combinators for building
4
+
Matrix client command-line interfaces. It follows the principle of
5
+
separation: parsing logic lives here, whilst business logic should remain
6
+
in plain OCaml functions that receive already-parsed values.
7
+
8
+
{2 Design Principles}
9
+
10
+
- {b Clarity}: Each option has a single, clearly stated purpose
11
+
- {b Orthogonality}: Each flag controls one independent aspect
12
+
- {b Discoverability}: Good --help output with defaults documented
13
+
- {b Composability}: Terms can be combined for different CLI tools
14
+
15
+
{2 Example Usage}
16
+
17
+
{[
18
+
open Cmdliner
19
+
20
+
let run ~homeserver ~profile ~verbose () =
21
+
(* your implementation *)
22
+
()
23
+
24
+
let term =
25
+
let open Matrix_client.Cmd in
26
+
Term.(const run
27
+
$ homeserver_term
28
+
$ profile_term
29
+
$ verbose_term)
30
+
31
+
let cmd =
32
+
let info = Cmd.info "myapp" ~doc:"My Matrix app" in
33
+
Cmd.v info term
34
+
]} *)
35
+
36
+
open Cmdliner
37
+
38
+
(** {1 Connection Options} *)
39
+
40
+
(** Matrix homeserver URL term.
41
+
42
+
Accepts [--homeserver URL] or [-s URL], with fallback to
43
+
[MATRIX_HOMESERVER] environment variable.
44
+
45
+
@return The homeserver URL as a string *)
46
+
val homeserver_term : string Term.t
47
+
48
+
(** Matrix homeserver URL term (optional).
49
+
50
+
Like {!homeserver_term} but returns [None] if not specified.
51
+
Useful when a stored session may provide the homeserver. *)
52
+
val homeserver_opt_term : string option Term.t
53
+
54
+
(** {1 Authentication Options} *)
55
+
56
+
(** Username term.
57
+
58
+
Accepts [--username USER] or [-u USER], with fallback to
59
+
[MATRIX_USERNAME] environment variable. Accepts either a
60
+
localpart or full [@user:server] format. *)
61
+
val username_term : string Term.t
62
+
63
+
(** Username term (optional). *)
64
+
val username_opt_term : string option Term.t
65
+
66
+
(** Password term.
67
+
68
+
Accepts [--password PASS] or [-p PASS], with fallback to
69
+
[MATRIX_PASSWORD] environment variable.
70
+
71
+
{b Security note}: The environment variable is preferred
72
+
over the command-line flag to avoid password exposure in
73
+
process listings. *)
74
+
val password_term : string Term.t
75
+
76
+
(** Password term (optional). *)
77
+
val password_opt_term : string option Term.t
78
+
79
+
(** {1 Session Management} *)
80
+
81
+
(** Profile name term.
82
+
83
+
Accepts [--profile NAME] with default ["default"].
84
+
Profiles are stored in [$XDG_DATA_HOME/matrix/profiles/NAME/].
85
+
86
+
Multiple profiles allow managing several Matrix accounts
87
+
on the same machine. *)
88
+
val profile_term : string Term.t
89
+
90
+
(** {1 Target Options} *)
91
+
92
+
(** Room ID term.
93
+
94
+
Accepts [--room ROOM_ID] or [-r ROOM_ID].
95
+
The room ID should be in the format [!roomid:server]. *)
96
+
val room_term : string Term.t
97
+
98
+
(** Room ID term (optional). *)
99
+
val room_opt_term : string option Term.t
100
+
101
+
(** Recipient user ID term.
102
+
103
+
Accepts [--to USER_ID] or [-t USER_ID].
104
+
The user ID should be in the format [@user:server].
105
+
Used for direct messages. *)
106
+
val recipient_term : string Term.t
107
+
108
+
(** Recipient user ID term (optional). *)
109
+
val recipient_opt_term : string option Term.t
110
+
111
+
(** {1 Message Options} *)
112
+
113
+
(** Message body term.
114
+
115
+
A positional argument for the message text to send. *)
116
+
val message_term : string Term.t
117
+
118
+
(** Message body term (optional). *)
119
+
val message_opt_term : string option Term.t
120
+
121
+
(** {1 Encryption Options} *)
122
+
123
+
(** Encrypted flag term.
124
+
125
+
Accepts [--encrypted] or [-e].
126
+
Enables end-to-end encryption for newly created rooms. *)
127
+
val encrypted_term : bool Term.t
128
+
129
+
(** {1 Logging Options} *)
130
+
131
+
(** Verbosity level term.
132
+
133
+
Accepts [-v] (repeatable) for increasing verbosity:
134
+
- No flags: warnings and errors only
135
+
- [-v]: info messages
136
+
- [-v -v]: debug messages
137
+
138
+
Also respects [--color] for output styling.
139
+
140
+
This term returns [unit] and sets up logging as a side effect
141
+
when the term is evaluated. *)
142
+
val verbosity_term : unit Term.t
143
+
144
+
(** {1 Argument Converters} *)
145
+
146
+
(** Cmdliner converter for Matrix user IDs.
147
+
148
+
Validates that the string is a valid user ID in the format
149
+
[@localpart:server]. *)
150
+
val user_id_conv : Matrix_proto.Id.User_id.t Arg.conv
151
+
152
+
(** Cmdliner converter for Matrix room IDs.
153
+
154
+
Validates that the string is a valid room ID in the format
155
+
[!opaque_id:server]. *)
156
+
val room_id_conv : Matrix_proto.Id.Room_id.t Arg.conv
157
+
158
+
(** Cmdliner converter for URIs. *)
159
+
val uri_conv : Uri.t Arg.conv
160
+
161
+
(** {1 Parsed Types}
162
+
163
+
Record types for collecting parsed arguments, useful for
164
+
structuring command implementations. *)
165
+
166
+
(** Credentials for password-based login. *)
167
+
type login_credentials = {
168
+
homeserver : string;
169
+
username : string;
170
+
password : string;
171
+
profile : string;
172
+
}
173
+
174
+
(** Term that collects login credentials. *)
175
+
val login_credentials_term : login_credentials Term.t
176
+
177
+
(** Target for sending a message (room or DM). *)
178
+
type message_target =
179
+
| Room of string (** Room ID *)
180
+
| Direct of string (** Recipient user ID *)
181
+
182
+
(** Message parameters for sending. *)
183
+
type message_params = {
184
+
target : message_target;
185
+
body : string;
186
+
encrypted : bool;
187
+
}
188
+
189
+
(** {1 Command Builders}
190
+
191
+
Helper functions for building common command patterns. *)
192
+
193
+
(** Exit codes following standard conventions.
194
+
195
+
- [exit_ok]: Success (0)
196
+
- [exit_usage]: Usage error (64)
197
+
- [exit_auth]: Authentication failure (77)
198
+
- [exit_network]: Network error (69)
199
+
- [exit_internal]: Internal error (70) *)
200
+
201
+
val exit_ok : Cmd.Exit.code
202
+
val exit_usage : Cmd.Exit.code
203
+
val exit_auth : Cmd.Exit.code
204
+
val exit_network : Cmd.Exit.code
205
+
val exit_internal : Cmd.Exit.code
+10
lib/matrix_client/dune
+10
lib/matrix_client/dune
+8
lib/matrix_client/matrix_client.ml
+8
lib/matrix_client/matrix_client.ml
+888
lib/matrix_client/session.ml
+888
lib/matrix_client/session.ml
···
1
+
(** Session persistence for Matrix clients.
2
+
3
+
Implementation using tomlt for TOML serialization and
4
+
xdge for XDG directory management. *)
5
+
6
+
module Ed25519 = Mirage_crypto_ec.Ed25519
7
+
module X25519 = Mirage_crypto_ec.X25519
8
+
9
+
(* Helper for URI TOML codec *)
10
+
let uri_tomlt : Uri.t Tomlt.t =
11
+
Tomlt.map
12
+
~dec:Uri.of_string
13
+
~enc:Uri.to_string
14
+
Tomlt.string
15
+
16
+
(* Helper for User_id TOML codec *)
17
+
let user_id_tomlt : Matrix_proto.Id.User_id.t Tomlt.t =
18
+
Tomlt.map
19
+
~dec:(fun s ->
20
+
match Matrix_proto.Id.User_id.of_string s with
21
+
| Ok id -> id
22
+
| Error _ -> failwith ("Invalid user_id: " ^ s))
23
+
~enc:Matrix_proto.Id.User_id.to_string
24
+
Tomlt.string
25
+
26
+
(* Helper for Device_id TOML codec *)
27
+
let device_id_tomlt : Matrix_proto.Id.Device_id.t Tomlt.t =
28
+
Tomlt.map
29
+
~dec:(fun s ->
30
+
match Matrix_proto.Id.Device_id.of_string s with
31
+
| Ok id -> id
32
+
| Error _ -> failwith ("Invalid device_id: " ^ s))
33
+
~enc:Matrix_proto.Id.Device_id.to_string
34
+
Tomlt.string
35
+
36
+
(* Helper for Room_id TOML codec *)
37
+
let room_id_tomlt : Matrix_proto.Id.Room_id.t Tomlt.t =
38
+
Tomlt.map
39
+
~dec:(fun s ->
40
+
match Matrix_proto.Id.Room_id.of_string s with
41
+
| Ok id -> id
42
+
| Error _ -> failwith ("Invalid room_id: " ^ s))
43
+
~enc:Matrix_proto.Id.Room_id.to_string
44
+
Tomlt.string
45
+
46
+
(* Ptime codec using UTC *)
47
+
let ptime_tomlt : Ptime.t Tomlt.t = Tomlt.ptime ~tz_offset_s:0 ()
48
+
49
+
module Server = struct
50
+
type t = {
51
+
homeserver : Uri.t;
52
+
user_id : Matrix_proto.Id.User_id.t;
53
+
}
54
+
55
+
let tomlt : t Tomlt.t =
56
+
Tomlt.Table.(
57
+
obj (fun homeserver user_id -> { homeserver; user_id })
58
+
|> mem "homeserver" uri_tomlt ~enc:(fun t -> t.homeserver)
59
+
|> mem "user_id" user_id_tomlt ~enc:(fun t -> t.user_id)
60
+
|> finish)
61
+
end
62
+
63
+
module Auth = struct
64
+
type t = {
65
+
access_token : string;
66
+
device_id : Matrix_proto.Id.Device_id.t;
67
+
refresh_token : string option;
68
+
}
69
+
70
+
let tomlt : t Tomlt.t =
71
+
Tomlt.Table.(
72
+
obj (fun access_token device_id refresh_token ->
73
+
{ access_token; device_id; refresh_token })
74
+
|> mem "access_token" Tomlt.string ~enc:(fun t -> t.access_token)
75
+
|> mem "device_id" device_id_tomlt ~enc:(fun t -> t.device_id)
76
+
|> opt_mem "refresh_token" Tomlt.string ~enc:(fun t -> t.refresh_token)
77
+
|> finish)
78
+
end
79
+
80
+
module Sync_state = struct
81
+
type t = {
82
+
next_batch : string option;
83
+
filter_id : string option;
84
+
}
85
+
86
+
let tomlt : t Tomlt.t =
87
+
Tomlt.Table.(
88
+
obj (fun next_batch filter_id -> { next_batch; filter_id })
89
+
|> opt_mem "next_batch" Tomlt.string ~enc:(fun t -> t.next_batch)
90
+
|> opt_mem "filter_id" Tomlt.string ~enc:(fun t -> t.filter_id)
91
+
|> finish)
92
+
end
93
+
94
+
module Metadata = struct
95
+
type t = {
96
+
created_at : Ptime.t;
97
+
last_used_at : Ptime.t;
98
+
client_name : string;
99
+
}
100
+
101
+
let tomlt : t Tomlt.t =
102
+
Tomlt.Table.(
103
+
obj (fun created_at last_used_at client_name ->
104
+
{ created_at; last_used_at; client_name })
105
+
|> mem "created_at" ptime_tomlt ~enc:(fun t -> t.created_at)
106
+
|> mem "last_used_at" ptime_tomlt ~enc:(fun t -> t.last_used_at)
107
+
|> mem "client_name" Tomlt.string ~enc:(fun t -> t.client_name)
108
+
|> finish)
109
+
end
110
+
111
+
module Session_file = struct
112
+
type t = {
113
+
server : Server.t;
114
+
auth : Auth.t;
115
+
sync : Sync_state.t;
116
+
metadata : Metadata.t;
117
+
}
118
+
119
+
let tomlt : t Tomlt.t =
120
+
Tomlt.Table.(
121
+
obj (fun server auth sync metadata ->
122
+
{ server; auth; sync; metadata })
123
+
|> mem "server" Server.tomlt ~enc:(fun t -> t.server)
124
+
|> mem "auth" Auth.tomlt ~enc:(fun t -> t.auth)
125
+
|> mem "sync" Sync_state.tomlt ~enc:(fun t -> t.sync)
126
+
|> mem "metadata" Metadata.tomlt ~enc:(fun t -> t.metadata)
127
+
|> finish)
128
+
end
129
+
130
+
module Device_keys = struct
131
+
type t = {
132
+
ed25519_public : string;
133
+
ed25519_private : string;
134
+
curve25519_public : string;
135
+
curve25519_private : string;
136
+
uploaded_at : Ptime.t option;
137
+
algorithms : string list;
138
+
}
139
+
140
+
let tomlt : t Tomlt.t =
141
+
Tomlt.Table.(
142
+
obj (fun ed25519_public ed25519_private curve25519_public
143
+
curve25519_private uploaded_at algorithms ->
144
+
{ ed25519_public; ed25519_private; curve25519_public;
145
+
curve25519_private; uploaded_at; algorithms })
146
+
|> mem "ed25519_public" Tomlt.string ~enc:(fun t -> t.ed25519_public)
147
+
|> mem "ed25519_private" Tomlt.string ~enc:(fun t -> t.ed25519_private)
148
+
|> mem "curve25519_public" Tomlt.string ~enc:(fun t -> t.curve25519_public)
149
+
|> mem "curve25519_private" Tomlt.string ~enc:(fun t -> t.curve25519_private)
150
+
|> opt_mem "uploaded_at" ptime_tomlt ~enc:(fun t -> t.uploaded_at)
151
+
|> mem "algorithms" (Tomlt.list Tomlt.string) ~dec_absent:[]
152
+
~enc:(fun t -> t.algorithms)
153
+
|> finish)
154
+
end
155
+
156
+
module One_time_key = struct
157
+
type t = {
158
+
key_id : string;
159
+
public : string;
160
+
private_ : string;
161
+
created_at : Ptime.t;
162
+
}
163
+
164
+
let tomlt : t Tomlt.t =
165
+
Tomlt.Table.(
166
+
obj (fun key_id public private_ created_at ->
167
+
{ key_id; public; private_; created_at })
168
+
|> mem "key_id" Tomlt.string ~enc:(fun t -> t.key_id)
169
+
|> mem "public" Tomlt.string ~enc:(fun t -> t.public)
170
+
|> mem "private" Tomlt.string ~enc:(fun t -> t.private_)
171
+
|> mem "created_at" ptime_tomlt ~enc:(fun t -> t.created_at)
172
+
|> finish)
173
+
end
174
+
175
+
module One_time_keys_file = struct
176
+
type t = {
177
+
target_count : int;
178
+
last_upload_at : Ptime.t option;
179
+
next_key_id : int;
180
+
keys : One_time_key.t list;
181
+
fallback : One_time_key.t option;
182
+
fallback_used : bool;
183
+
}
184
+
185
+
let config_tomlt =
186
+
Tomlt.Table.(
187
+
obj (fun target_count last_upload_at next_key_id ->
188
+
(target_count, last_upload_at, next_key_id))
189
+
|> mem "target_count" Tomlt.int ~dec_absent:50
190
+
~enc:(fun (tc, _, _) -> tc)
191
+
|> opt_mem "last_upload_at" ptime_tomlt
192
+
~enc:(fun (_, lu, _) -> lu)
193
+
|> mem "next_key_id" Tomlt.int ~dec_absent:0
194
+
~enc:(fun (_, _, nk) -> nk)
195
+
|> finish)
196
+
197
+
let tomlt : t Tomlt.t =
198
+
Tomlt.Table.(
199
+
obj (fun config keys fallback fallback_used ->
200
+
let target_count, last_upload_at, next_key_id = config in
201
+
{ target_count; last_upload_at; next_key_id;
202
+
keys; fallback; fallback_used })
203
+
|> mem "config" config_tomlt
204
+
~enc:(fun t -> (t.target_count, t.last_upload_at, t.next_key_id))
205
+
|> mem "keys" (Tomlt.list One_time_key.tomlt) ~dec_absent:[]
206
+
~enc:(fun t -> t.keys)
207
+
|> opt_mem "fallback" One_time_key.tomlt ~enc:(fun t -> t.fallback)
208
+
|> mem "fallback_used" Tomlt.bool ~dec_absent:false
209
+
~enc:(fun t -> t.fallback_used)
210
+
|> finish)
211
+
end
212
+
213
+
module Olm_session = struct
214
+
type t = {
215
+
their_identity_key : string;
216
+
session_id : string;
217
+
pickle : string;
218
+
created_at : Ptime.t;
219
+
last_used_at : Ptime.t;
220
+
}
221
+
222
+
let tomlt : t Tomlt.t =
223
+
Tomlt.Table.(
224
+
obj (fun their_identity_key session_id pickle created_at last_used_at ->
225
+
{ their_identity_key; session_id; pickle; created_at; last_used_at })
226
+
|> mem "their_identity_key" Tomlt.string
227
+
~enc:(fun t -> t.their_identity_key)
228
+
|> mem "session_id" Tomlt.string ~enc:(fun t -> t.session_id)
229
+
|> mem "pickle" Tomlt.string ~enc:(fun t -> t.pickle)
230
+
|> mem "created_at" ptime_tomlt ~enc:(fun t -> t.created_at)
231
+
|> mem "last_used_at" ptime_tomlt ~enc:(fun t -> t.last_used_at)
232
+
|> finish)
233
+
end
234
+
235
+
module Olm_sessions_file = struct
236
+
type t = { sessions : Olm_session.t list }
237
+
238
+
let tomlt : t Tomlt.t =
239
+
Tomlt.Table.(
240
+
obj (fun sessions -> { sessions })
241
+
|> mem "sessions" (Tomlt.list Olm_session.tomlt) ~dec_absent:[]
242
+
~enc:(fun t -> t.sessions)
243
+
|> finish)
244
+
end
245
+
246
+
module Megolm_inbound = struct
247
+
type t = {
248
+
room_id : Matrix_proto.Id.Room_id.t;
249
+
session_id : string;
250
+
sender_key : string;
251
+
signing_key : string;
252
+
pickle : string;
253
+
first_known_index : int;
254
+
created_at : Ptime.t;
255
+
}
256
+
257
+
let tomlt : t Tomlt.t =
258
+
Tomlt.Table.(
259
+
obj (fun room_id session_id sender_key signing_key pickle
260
+
first_known_index created_at ->
261
+
{ room_id; session_id; sender_key; signing_key; pickle;
262
+
first_known_index; created_at })
263
+
|> mem "room_id" room_id_tomlt ~enc:(fun t -> t.room_id)
264
+
|> mem "session_id" Tomlt.string ~enc:(fun t -> t.session_id)
265
+
|> mem "sender_key" Tomlt.string ~enc:(fun t -> t.sender_key)
266
+
|> mem "signing_key" Tomlt.string ~enc:(fun t -> t.signing_key)
267
+
|> mem "pickle" Tomlt.string ~enc:(fun t -> t.pickle)
268
+
|> mem "first_known_index" Tomlt.int ~enc:(fun t -> t.first_known_index)
269
+
|> mem "created_at" ptime_tomlt ~enc:(fun t -> t.created_at)
270
+
|> finish)
271
+
end
272
+
273
+
module Megolm_inbound_file = struct
274
+
type t = { sessions : Megolm_inbound.t list }
275
+
276
+
let tomlt : t Tomlt.t =
277
+
Tomlt.Table.(
278
+
obj (fun sessions -> { sessions })
279
+
|> mem "sessions" (Tomlt.list Megolm_inbound.tomlt) ~dec_absent:[]
280
+
~enc:(fun t -> t.sessions)
281
+
|> finish)
282
+
end
283
+
284
+
module Shared_with = struct
285
+
type t = {
286
+
user_id : Matrix_proto.Id.User_id.t;
287
+
device_id : Matrix_proto.Id.Device_id.t;
288
+
shared_at : Ptime.t;
289
+
}
290
+
291
+
let tomlt : t Tomlt.t =
292
+
Tomlt.Table.(
293
+
obj (fun user_id device_id shared_at ->
294
+
{ user_id; device_id; shared_at })
295
+
|> mem "user_id" user_id_tomlt ~enc:(fun t -> t.user_id)
296
+
|> mem "device_id" device_id_tomlt ~enc:(fun t -> t.device_id)
297
+
|> mem "shared_at" ptime_tomlt ~enc:(fun t -> t.shared_at)
298
+
|> finish)
299
+
end
300
+
301
+
module Megolm_outbound = struct
302
+
type t = {
303
+
room_id : Matrix_proto.Id.Room_id.t;
304
+
session_id : string;
305
+
pickle : string;
306
+
message_index : int;
307
+
created_at : Ptime.t;
308
+
message_count : int;
309
+
max_age_ms : int64;
310
+
shared_with : Shared_with.t list;
311
+
}
312
+
313
+
let tomlt : t Tomlt.t =
314
+
Tomlt.Table.(
315
+
obj (fun room_id session_id pickle message_index created_at
316
+
message_count max_age_ms shared_with ->
317
+
{ room_id; session_id; pickle; message_index; created_at;
318
+
message_count; max_age_ms; shared_with })
319
+
|> mem "room_id" room_id_tomlt ~enc:(fun t -> t.room_id)
320
+
|> mem "session_id" Tomlt.string ~enc:(fun t -> t.session_id)
321
+
|> mem "pickle" Tomlt.string ~enc:(fun t -> t.pickle)
322
+
|> mem "message_index" Tomlt.int ~enc:(fun t -> t.message_index)
323
+
|> mem "created_at" ptime_tomlt ~enc:(fun t -> t.created_at)
324
+
|> mem "message_count" Tomlt.int ~enc:(fun t -> t.message_count)
325
+
|> mem "max_age_ms" Tomlt.int64 ~enc:(fun t -> t.max_age_ms)
326
+
|> mem "shared_with" (Tomlt.list Shared_with.tomlt) ~dec_absent:[]
327
+
~enc:(fun t -> t.shared_with)
328
+
|> finish)
329
+
end
330
+
331
+
module Megolm_outbound_file = struct
332
+
type t = { sessions : Megolm_outbound.t list }
333
+
334
+
let tomlt : t Tomlt.t =
335
+
Tomlt.Table.(
336
+
obj (fun sessions -> { sessions })
337
+
|> mem "sessions" (Tomlt.list Megolm_outbound.tomlt) ~dec_absent:[]
338
+
~enc:(fun t -> t.sessions)
339
+
|> finish)
340
+
end
341
+
342
+
(* ============================================================ *)
343
+
(* Pickle Functions using jsont *)
344
+
(* ============================================================ *)
345
+
346
+
module Pickle = struct
347
+
(* Base64 encoding/decoding - Matrix uses unpadded base64 *)
348
+
let base64_encode s = Base64.encode_string ~pad:false s
349
+
let base64_decode s =
350
+
match Base64.decode ~pad:false s with
351
+
| Ok s -> s
352
+
| Error _ -> failwith "Invalid base64"
353
+
354
+
(* Jsont codec for Ed25519 private key *)
355
+
let ed25519_priv_jsont : Ed25519.priv Jsont.t =
356
+
Jsont.map
357
+
~dec:(fun s ->
358
+
let octets = base64_decode s in
359
+
match Ed25519.priv_of_octets octets with
360
+
| Ok priv -> priv
361
+
| Error _ -> failwith "Invalid Ed25519 private key")
362
+
~enc:(fun priv -> Ed25519.priv_to_octets priv |> base64_encode)
363
+
Jsont.string
364
+
365
+
(* Jsont codec for Ed25519 public key *)
366
+
let ed25519_pub_jsont : Ed25519.pub Jsont.t =
367
+
Jsont.map
368
+
~dec:(fun s ->
369
+
let octets = base64_decode s in
370
+
match Ed25519.pub_of_octets octets with
371
+
| Ok pub -> pub
372
+
| Error _ -> failwith "Invalid Ed25519 public key")
373
+
~enc:(fun pub -> Ed25519.pub_to_octets pub |> base64_encode)
374
+
Jsont.string
375
+
376
+
(* Jsont codec for X25519 secret *)
377
+
let x25519_secret_jsont : X25519.secret Jsont.t =
378
+
Jsont.map
379
+
~dec:(fun s ->
380
+
let octets = base64_decode s in
381
+
match X25519.secret_of_octets octets with
382
+
| Ok (secret, _) -> secret
383
+
| Error _ -> failwith "Invalid X25519 secret key")
384
+
~enc:(fun secret -> X25519.secret_to_octets secret |> base64_encode)
385
+
Jsont.string
386
+
387
+
(* Jsont codec for Ptime.t as ISO 8601 string *)
388
+
let ptime_jsont : Ptime.t Jsont.t =
389
+
Jsont.map
390
+
~dec:(fun s ->
391
+
match Ptime.of_rfc3339 s with
392
+
| Ok (t, _, _) -> t
393
+
| Error _ -> failwith "Invalid RFC3339 timestamp")
394
+
~enc:(fun t -> Ptime.to_rfc3339 ~tz_offset_s:0 t)
395
+
Jsont.string
396
+
397
+
(* ------------------------------------------------------------ *)
398
+
(* Olm.Account pickle *)
399
+
(* ------------------------------------------------------------ *)
400
+
401
+
type account_pickle = {
402
+
ed25519_priv : Ed25519.priv;
403
+
ed25519_pub : Ed25519.pub;
404
+
curve25519_secret : X25519.secret;
405
+
curve25519_public : string;
406
+
one_time_keys : (string * string * string) list;
407
+
(* key_id, secret_b64, public_b64 *)
408
+
fallback_key : (string * string * string) option;
409
+
next_key_id : int;
410
+
max_one_time_keys : int;
411
+
}
412
+
413
+
let account_pickle_jsont : account_pickle Jsont.t =
414
+
Jsont.Object.(
415
+
map (fun ed25519_priv ed25519_pub curve25519_secret curve25519_public
416
+
one_time_keys fallback_key next_key_id max_one_time_keys ->
417
+
{ ed25519_priv; ed25519_pub; curve25519_secret; curve25519_public;
418
+
one_time_keys; fallback_key; next_key_id; max_one_time_keys })
419
+
|> mem "ed25519_priv" ed25519_priv_jsont
420
+
|> mem "ed25519_pub" ed25519_pub_jsont
421
+
|> mem "curve25519_secret" x25519_secret_jsont
422
+
|> mem "curve25519_public" Jsont.string
423
+
|> mem "one_time_keys"
424
+
(Jsont.list (Jsont.list Jsont.string |> Jsont.map
425
+
~dec:(function
426
+
| [a; b; c] -> (a, b, c)
427
+
| _ -> failwith "Expected 3 elements")
428
+
~enc:(fun (a, b, c) -> [a; b; c])))
429
+
|> opt_mem "fallback_key"
430
+
(Jsont.list Jsont.string |> Jsont.map
431
+
~dec:(function
432
+
| [a; b; c] -> (a, b, c)
433
+
| _ -> failwith "Expected 3 elements")
434
+
~enc:(fun (a, b, c) -> [a; b; c]))
435
+
|> mem "next_key_id" Jsont.int
436
+
|> mem "max_one_time_keys" Jsont.int
437
+
|> finish)
438
+
439
+
let pickle_account (account : Olm.Account.t) : string =
440
+
let one_time_keys =
441
+
List.map (fun (key_id, (secret, public)) ->
442
+
(key_id, X25519.secret_to_octets secret |> base64_encode,
443
+
base64_encode public))
444
+
account.one_time_keys
445
+
in
446
+
let fallback_key =
447
+
Option.map (fun (key_id, (secret, public)) ->
448
+
(key_id, X25519.secret_to_octets secret |> base64_encode,
449
+
base64_encode public))
450
+
account.fallback_key
451
+
in
452
+
let pickle = {
453
+
ed25519_priv = account.ed25519_priv;
454
+
ed25519_pub = account.ed25519_pub;
455
+
curve25519_secret = account.curve25519_secret;
456
+
curve25519_public = account.curve25519_public;
457
+
one_time_keys;
458
+
fallback_key;
459
+
next_key_id = account.next_key_id;
460
+
max_one_time_keys = account.max_one_time_keys;
461
+
} in
462
+
match Jsont_bytesrw.encode_string account_pickle_jsont pickle with
463
+
| Ok s -> s
464
+
| Error e -> failwith ("Failed to pickle account: " ^ e)
465
+
466
+
let unpickle_account (s : string) : (Olm.Account.t, string) result =
467
+
match Jsont_bytesrw.decode_string account_pickle_jsont s with
468
+
| Error e -> Error ("Failed to unpickle account: " ^ e)
469
+
| Ok pickle ->
470
+
let one_time_keys =
471
+
List.map (fun (key_id, secret_b64, public_b64) ->
472
+
let secret =
473
+
match X25519.secret_of_octets (base64_decode secret_b64) with
474
+
| Ok (s, _) -> s
475
+
| Error _ -> failwith "Invalid X25519 secret"
476
+
in
477
+
let public = base64_decode public_b64 in
478
+
(key_id, (secret, public)))
479
+
pickle.one_time_keys
480
+
in
481
+
let fallback_key =
482
+
Option.map (fun (key_id, secret_b64, public_b64) ->
483
+
let secret =
484
+
match X25519.secret_of_octets (base64_decode secret_b64) with
485
+
| Ok (s, _) -> s
486
+
| Error _ -> failwith "Invalid X25519 secret"
487
+
in
488
+
let public = base64_decode public_b64 in
489
+
(key_id, (secret, public)))
490
+
pickle.fallback_key
491
+
in
492
+
Ok {
493
+
Olm.Account.ed25519_priv = pickle.ed25519_priv;
494
+
ed25519_pub = pickle.ed25519_pub;
495
+
curve25519_secret = pickle.curve25519_secret;
496
+
curve25519_public = pickle.curve25519_public;
497
+
one_time_keys;
498
+
fallback_key;
499
+
next_key_id = pickle.next_key_id;
500
+
max_one_time_keys = pickle.max_one_time_keys;
501
+
}
502
+
503
+
(* ------------------------------------------------------------ *)
504
+
(* Olm.Session pickle *)
505
+
(* ------------------------------------------------------------ *)
506
+
507
+
type chain_key_pickle = {
508
+
key : string; (* base64 *)
509
+
index : int;
510
+
}
511
+
512
+
let chain_key_pickle_jsont : chain_key_pickle Jsont.t =
513
+
Jsont.Object.(
514
+
map (fun key index -> { key; index })
515
+
|> mem "key" Jsont.string
516
+
|> mem "index" Jsont.int
517
+
|> finish)
518
+
519
+
type session_pickle = {
520
+
session_id : string;
521
+
their_identity_key : string;
522
+
their_ratchet_key : string option;
523
+
our_ratchet_secret : string;
524
+
our_ratchet_public : string;
525
+
root_key : string;
526
+
sending_chain : chain_key_pickle option;
527
+
receiving_chains : (string * chain_key_pickle) list;
528
+
skipped_keys : ((string * int) * string) list;
529
+
creation_time : Ptime.t;
530
+
}
531
+
532
+
(* Encode (string, int) pair as a JSON object with "key" and "index" *)
533
+
let string_int_pair_jsont : (string * int) Jsont.t =
534
+
Jsont.Object.(
535
+
map (fun k i -> (k, i))
536
+
|> mem "key" Jsont.string
537
+
|> mem "index" Jsont.int
538
+
|> finish)
539
+
540
+
let session_pickle_jsont : session_pickle Jsont.t =
541
+
Jsont.Object.(
542
+
map (fun session_id their_identity_key their_ratchet_key
543
+
our_ratchet_secret our_ratchet_public root_key sending_chain
544
+
receiving_chains skipped_keys creation_time ->
545
+
{ session_id; their_identity_key; their_ratchet_key;
546
+
our_ratchet_secret; our_ratchet_public; root_key; sending_chain;
547
+
receiving_chains; skipped_keys; creation_time })
548
+
|> mem "session_id" Jsont.string
549
+
|> mem "their_identity_key" Jsont.string
550
+
|> opt_mem "their_ratchet_key" Jsont.string
551
+
|> mem "our_ratchet_secret" Jsont.string
552
+
|> mem "our_ratchet_public" Jsont.string
553
+
|> mem "root_key" Jsont.string
554
+
|> opt_mem "sending_chain" chain_key_pickle_jsont
555
+
|> mem "receiving_chains"
556
+
(Jsont.list (Jsont.Object.(
557
+
map (fun k v -> (k, v))
558
+
|> mem "key" Jsont.string
559
+
|> mem "chain" chain_key_pickle_jsont
560
+
|> finish)))
561
+
|> mem "skipped_keys"
562
+
(Jsont.list (Jsont.Object.(
563
+
map (fun idx_key msg_key -> (idx_key, msg_key))
564
+
|> mem "index_key" string_int_pair_jsont
565
+
|> mem "msg_key" Jsont.string
566
+
|> finish)))
567
+
|> mem "creation_time" ptime_jsont
568
+
|> finish)
569
+
570
+
let pickle_session (session : Olm.Session.t) : string =
571
+
let sending_chain = Option.map (fun (ck : Olm.Session.chain_key) ->
572
+
{ key = base64_encode ck.key; index = ck.index })
573
+
session.sending_chain
574
+
in
575
+
let receiving_chains =
576
+
List.map (fun (rk, (ck : Olm.Session.chain_key)) ->
577
+
(base64_encode rk, { key = base64_encode ck.key; index = ck.index }))
578
+
session.receiving_chains
579
+
in
580
+
let skipped_keys =
581
+
List.map (fun ((rk, idx), mk) ->
582
+
((base64_encode rk, idx), base64_encode mk))
583
+
session.skipped_keys
584
+
in
585
+
let pickle = {
586
+
session_id = session.session_id;
587
+
their_identity_key = base64_encode session.their_identity_key;
588
+
their_ratchet_key = Option.map base64_encode session.their_ratchet_key;
589
+
our_ratchet_secret = X25519.secret_to_octets session.our_ratchet_secret
590
+
|> base64_encode;
591
+
our_ratchet_public = base64_encode session.our_ratchet_public;
592
+
root_key = base64_encode session.root_key;
593
+
sending_chain;
594
+
receiving_chains;
595
+
skipped_keys;
596
+
creation_time = session.creation_time;
597
+
} in
598
+
match Jsont_bytesrw.encode_string session_pickle_jsont pickle with
599
+
| Ok s -> s
600
+
| Error e -> failwith ("Failed to pickle session: " ^ e)
601
+
602
+
let unpickle_session (s : string) : (Olm.Session.t, string) result =
603
+
match Jsont_bytesrw.decode_string session_pickle_jsont s with
604
+
| Error e -> Error ("Failed to unpickle session: " ^ e)
605
+
| Ok pickle ->
606
+
let our_ratchet_secret =
607
+
match X25519.secret_of_octets (base64_decode pickle.our_ratchet_secret) with
608
+
| Ok (s, _) -> s
609
+
| Error _ -> failwith "Invalid ratchet secret"
610
+
in
611
+
let sending_chain = Option.map (fun p ->
612
+
{ Olm.Session.key = base64_decode p.key; index = p.index })
613
+
pickle.sending_chain
614
+
in
615
+
let receiving_chains =
616
+
List.map (fun (rk_b64, p) ->
617
+
(base64_decode rk_b64,
618
+
{ Olm.Session.key = base64_decode p.key; index = p.index }))
619
+
pickle.receiving_chains
620
+
in
621
+
let skipped_keys =
622
+
List.map (fun ((rk_b64, idx), mk_b64) ->
623
+
((base64_decode rk_b64, idx), base64_decode mk_b64))
624
+
pickle.skipped_keys
625
+
in
626
+
Ok {
627
+
Olm.Session.session_id = pickle.session_id;
628
+
their_identity_key = base64_decode pickle.their_identity_key;
629
+
their_ratchet_key = Option.map base64_decode pickle.their_ratchet_key;
630
+
our_ratchet_secret;
631
+
our_ratchet_public = base64_decode pickle.our_ratchet_public;
632
+
root_key = base64_decode pickle.root_key;
633
+
sending_chain;
634
+
receiving_chains;
635
+
skipped_keys;
636
+
creation_time = pickle.creation_time;
637
+
}
638
+
639
+
(* ------------------------------------------------------------ *)
640
+
(* Megolm.Inbound pickle *)
641
+
(* ------------------------------------------------------------ *)
642
+
643
+
type megolm_inbound_pickle = {
644
+
session_id : string;
645
+
sender_key : string;
646
+
room_id : string;
647
+
ratchet : string list; (* 4 x base64 strings *)
648
+
message_index : int;
649
+
received_indices : int list;
650
+
signing_key : string;
651
+
creation_time : Ptime.t;
652
+
}
653
+
654
+
let megolm_inbound_pickle_jsont : megolm_inbound_pickle Jsont.t =
655
+
Jsont.Object.(
656
+
map (fun session_id sender_key room_id ratchet message_index
657
+
received_indices signing_key creation_time ->
658
+
{ session_id; sender_key; room_id; ratchet; message_index;
659
+
received_indices; signing_key; creation_time })
660
+
|> mem "session_id" Jsont.string
661
+
|> mem "sender_key" Jsont.string
662
+
|> mem "room_id" Jsont.string
663
+
|> mem "ratchet" (Jsont.list Jsont.string)
664
+
|> mem "message_index" Jsont.int
665
+
|> mem "received_indices" (Jsont.list Jsont.int)
666
+
|> mem "signing_key" Jsont.string
667
+
|> mem "creation_time" ptime_jsont
668
+
|> finish)
669
+
670
+
let pickle_megolm_inbound (session : Olm.Megolm.Inbound.t) : string =
671
+
let ratchet = Array.to_list session.ratchet |> List.map base64_encode in
672
+
let pickle = {
673
+
session_id = session.session_id;
674
+
sender_key = session.sender_key;
675
+
room_id = session.room_id;
676
+
ratchet;
677
+
message_index = session.message_index;
678
+
received_indices = session.received_indices;
679
+
signing_key = session.signing_key;
680
+
creation_time = session.creation_time;
681
+
} in
682
+
match Jsont_bytesrw.encode_string megolm_inbound_pickle_jsont pickle with
683
+
| Ok s -> s
684
+
| Error e -> failwith ("Failed to pickle megolm inbound: " ^ e)
685
+
686
+
let unpickle_megolm_inbound (s : string)
687
+
: (Olm.Megolm.Inbound.t, string) result =
688
+
match Jsont_bytesrw.decode_string megolm_inbound_pickle_jsont s with
689
+
| Error e -> Error ("Failed to unpickle megolm inbound: " ^ e)
690
+
| Ok pickle ->
691
+
let ratchet =
692
+
List.map base64_decode pickle.ratchet |> Array.of_list
693
+
in
694
+
Ok {
695
+
Olm.Megolm.Inbound.session_id = pickle.session_id;
696
+
sender_key = pickle.sender_key;
697
+
room_id = pickle.room_id;
698
+
ratchet;
699
+
message_index = pickle.message_index;
700
+
received_indices = pickle.received_indices;
701
+
signing_key = pickle.signing_key;
702
+
creation_time = pickle.creation_time;
703
+
}
704
+
705
+
(* ------------------------------------------------------------ *)
706
+
(* Megolm.Outbound pickle *)
707
+
(* ------------------------------------------------------------ *)
708
+
709
+
type megolm_outbound_pickle = {
710
+
session_id : string;
711
+
room_id : string;
712
+
ratchet : string list;
713
+
message_index : int;
714
+
signing_priv : Ed25519.priv;
715
+
signing_pub : Ed25519.pub;
716
+
creation_time : Ptime.t;
717
+
message_count : int;
718
+
max_messages : int;
719
+
max_age_s : int; (* stored as seconds *)
720
+
shared_with : (string * string) list; (* user_id, device_id pairs *)
721
+
}
722
+
723
+
let megolm_outbound_pickle_jsont : megolm_outbound_pickle Jsont.t =
724
+
Jsont.Object.(
725
+
map (fun session_id room_id ratchet message_index signing_priv
726
+
signing_pub creation_time message_count max_messages max_age_s
727
+
shared_with ->
728
+
{ session_id; room_id; ratchet; message_index; signing_priv;
729
+
signing_pub; creation_time; message_count; max_messages; max_age_s;
730
+
shared_with })
731
+
|> mem "session_id" Jsont.string
732
+
|> mem "room_id" Jsont.string
733
+
|> mem "ratchet" (Jsont.list Jsont.string)
734
+
|> mem "message_index" Jsont.int
735
+
|> mem "signing_priv" ed25519_priv_jsont
736
+
|> mem "signing_pub" ed25519_pub_jsont
737
+
|> mem "creation_time" ptime_jsont
738
+
|> mem "message_count" Jsont.int
739
+
|> mem "max_messages" Jsont.int
740
+
|> mem "max_age_s" Jsont.int
741
+
|> mem "shared_with"
742
+
(Jsont.list (Jsont.list Jsont.string |> Jsont.map
743
+
~dec:(function
744
+
| [a; b] -> (a, b)
745
+
| _ -> failwith "Expected 2 elements")
746
+
~enc:(fun (a, b) -> [a; b])))
747
+
|> finish)
748
+
749
+
let pickle_megolm_outbound (session : Olm.Megolm.Outbound.t) : string =
750
+
let ratchet = Array.to_list session.ratchet |> List.map base64_encode in
751
+
let max_age_s =
752
+
match Ptime.Span.to_int_s session.max_age with
753
+
| Some s -> s
754
+
| None -> 604800 (* default 1 week *)
755
+
in
756
+
let pickle = {
757
+
session_id = session.session_id;
758
+
room_id = session.room_id;
759
+
ratchet;
760
+
message_index = session.message_index;
761
+
signing_priv = session.signing_priv;
762
+
signing_pub = session.signing_pub;
763
+
creation_time = session.creation_time;
764
+
message_count = session.message_count;
765
+
max_messages = session.max_messages;
766
+
max_age_s;
767
+
shared_with = session.shared_with;
768
+
} in
769
+
match Jsont_bytesrw.encode_string megolm_outbound_pickle_jsont pickle with
770
+
| Ok s -> s
771
+
| Error e -> failwith ("Failed to pickle megolm outbound: " ^ e)
772
+
773
+
let unpickle_megolm_outbound (s : string)
774
+
: (Olm.Megolm.Outbound.t, string) result =
775
+
match Jsont_bytesrw.decode_string megolm_outbound_pickle_jsont s with
776
+
| Error e -> Error ("Failed to unpickle megolm outbound: " ^ e)
777
+
| Ok pickle ->
778
+
let ratchet =
779
+
List.map base64_decode pickle.ratchet |> Array.of_list
780
+
in
781
+
let max_age = Ptime.Span.of_int_s pickle.max_age_s in
782
+
Ok {
783
+
Olm.Megolm.Outbound.session_id = pickle.session_id;
784
+
room_id = pickle.room_id;
785
+
ratchet;
786
+
message_index = pickle.message_index;
787
+
signing_priv = pickle.signing_priv;
788
+
signing_pub = pickle.signing_pub;
789
+
creation_time = pickle.creation_time;
790
+
message_count = pickle.message_count;
791
+
max_messages = pickle.max_messages;
792
+
max_age;
793
+
shared_with = pickle.shared_with;
794
+
}
795
+
end
796
+
797
+
(* ============================================================ *)
798
+
(* Session Store *)
799
+
(* ============================================================ *)
800
+
801
+
module Store = struct
802
+
type t = {
803
+
profile_path : Eio.Fs.dir_ty Eio.Path.t;
804
+
}
805
+
806
+
let create ~xdg ~profile =
807
+
let data_dir = Xdge.data_dir xdg in
808
+
let profile_path = Eio.Path.(data_dir / "profiles" / profile) in
809
+
(* Ensure directory exists *)
810
+
Eio.Path.mkdirs ~exists_ok:true ~perm:0o700 profile_path;
811
+
{ profile_path }
812
+
813
+
let profile_dir t = t.profile_path
814
+
815
+
let exists t =
816
+
Eio.Path.is_file Eio.Path.(t.profile_path / "session.toml")
817
+
818
+
(* Helper to load a TOML file with a codec *)
819
+
let load_toml (type a) (codec : a Tomlt.t) (path : _ Eio.Path.t)
820
+
: a option =
821
+
if Eio.Path.is_file path then
822
+
match Tomlt_eio.decode_file codec path with
823
+
| Ok v -> Some v
824
+
| Error _ -> None
825
+
else
826
+
None
827
+
828
+
(* Helper to save a TOML file with a codec *)
829
+
let save_toml (type a) (codec : a Tomlt.t) (path : _ Eio.Path.t) (value : a)
830
+
: unit =
831
+
Tomlt_eio.encode_file codec value path
832
+
833
+
let load_session t =
834
+
load_toml Session_file.tomlt Eio.Path.(t.profile_path / "session.toml")
835
+
836
+
let save_session t session =
837
+
save_toml Session_file.tomlt Eio.Path.(t.profile_path / "session.toml")
838
+
session
839
+
840
+
let load_device_keys t =
841
+
load_toml Device_keys.tomlt Eio.Path.(t.profile_path / "device.toml")
842
+
843
+
let save_device_keys t keys =
844
+
save_toml Device_keys.tomlt Eio.Path.(t.profile_path / "device.toml") keys
845
+
846
+
let load_one_time_keys t =
847
+
load_toml One_time_keys_file.tomlt
848
+
Eio.Path.(t.profile_path / "one_time_keys.toml")
849
+
850
+
let save_one_time_keys t keys =
851
+
save_toml One_time_keys_file.tomlt
852
+
Eio.Path.(t.profile_path / "one_time_keys.toml") keys
853
+
854
+
let load_olm_sessions t =
855
+
load_toml Olm_sessions_file.tomlt
856
+
Eio.Path.(t.profile_path / "olm_sessions.toml")
857
+
858
+
let save_olm_sessions t sessions =
859
+
save_toml Olm_sessions_file.tomlt
860
+
Eio.Path.(t.profile_path / "olm_sessions.toml") sessions
861
+
862
+
let load_megolm_inbound t =
863
+
load_toml Megolm_inbound_file.tomlt
864
+
Eio.Path.(t.profile_path / "megolm_inbound.toml")
865
+
866
+
let save_megolm_inbound t sessions =
867
+
save_toml Megolm_inbound_file.tomlt
868
+
Eio.Path.(t.profile_path / "megolm_inbound.toml") sessions
869
+
870
+
let load_megolm_outbound t =
871
+
load_toml Megolm_outbound_file.tomlt
872
+
Eio.Path.(t.profile_path / "megolm_outbound.toml")
873
+
874
+
let save_megolm_outbound t sessions =
875
+
save_toml Megolm_outbound_file.tomlt
876
+
Eio.Path.(t.profile_path / "megolm_outbound.toml") sessions
877
+
878
+
let clear t =
879
+
let files = [
880
+
"session.toml"; "device.toml"; "one_time_keys.toml";
881
+
"olm_sessions.toml"; "megolm_inbound.toml"; "megolm_outbound.toml"
882
+
] in
883
+
List.iter (fun filename ->
884
+
let path = Eio.Path.(t.profile_path / filename) in
885
+
if Eio.Path.is_file path then
886
+
Eio.Path.unlink path)
887
+
files
888
+
end
+274
lib/matrix_client/session.mli
+274
lib/matrix_client/session.mli
···
1
+
(** Session persistence for Matrix clients.
2
+
3
+
This module provides XDG-based session persistence for Matrix clients,
4
+
enabling E2E encryption by persisting device keys and cryptographic
5
+
session state.
6
+
7
+
{2 Design Decisions}
8
+
9
+
- No encryption at rest - relies on file permissions (0600)
10
+
- Single active session - one account at a time per profile
11
+
- Device-bound sessions - no export/import of keys
12
+
- Explicit initialization - requires initialization before first use
13
+
14
+
{2 Directory Structure}
15
+
16
+
{v
17
+
$XDG_DATA_HOME/matrix/
18
+
└── profiles/
19
+
└── default/ # Profile name
20
+
├── session.toml # Auth credentials + metadata
21
+
├── device.toml # Device identity keys
22
+
├── one_time_keys.toml # One-time key pool
23
+
├── olm_sessions.toml # Olm sessions (to-device)
24
+
├── megolm_inbound.toml # Megolm inbound sessions
25
+
└── megolm_outbound.toml # Megolm outbound sessions
26
+
v}
27
+
28
+
@see <https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html>
29
+
XDG Base Directory Specification *)
30
+
31
+
(** {1 Types} *)
32
+
33
+
(** Server connection information. *)
34
+
module Server : sig
35
+
type t = {
36
+
homeserver : Uri.t;
37
+
user_id : Matrix_proto.Id.User_id.t;
38
+
}
39
+
40
+
val tomlt : t Tomlt.t
41
+
end
42
+
43
+
(** Authentication credentials. *)
44
+
module Auth : sig
45
+
type t = {
46
+
access_token : string;
47
+
device_id : Matrix_proto.Id.Device_id.t;
48
+
refresh_token : string option;
49
+
}
50
+
51
+
val tomlt : t Tomlt.t
52
+
end
53
+
54
+
(** Sync state for incremental /sync. *)
55
+
module Sync_state : sig
56
+
type t = {
57
+
next_batch : string option;
58
+
filter_id : string option;
59
+
}
60
+
61
+
val tomlt : t Tomlt.t
62
+
end
63
+
64
+
(** Session metadata. *)
65
+
module Metadata : sig
66
+
type t = {
67
+
created_at : Ptime.t;
68
+
last_used_at : Ptime.t;
69
+
client_name : string;
70
+
}
71
+
72
+
val tomlt : t Tomlt.t
73
+
end
74
+
75
+
(** Complete session file contents. *)
76
+
module Session_file : sig
77
+
type t = {
78
+
server : Server.t;
79
+
auth : Auth.t;
80
+
sync : Sync_state.t;
81
+
metadata : Metadata.t;
82
+
}
83
+
84
+
val tomlt : t Tomlt.t
85
+
end
86
+
87
+
(** Device identity keys (Ed25519 + Curve25519). *)
88
+
module Device_keys : sig
89
+
type t = {
90
+
ed25519_public : string;
91
+
ed25519_private : string;
92
+
curve25519_public : string;
93
+
curve25519_private : string;
94
+
uploaded_at : Ptime.t option;
95
+
algorithms : string list;
96
+
}
97
+
98
+
val tomlt : t Tomlt.t
99
+
end
100
+
101
+
(** A single one-time key. *)
102
+
module One_time_key : sig
103
+
type t = {
104
+
key_id : string;
105
+
public : string;
106
+
private_ : string;
107
+
created_at : Ptime.t;
108
+
}
109
+
110
+
val tomlt : t Tomlt.t
111
+
end
112
+
113
+
(** One-time keys file contents. *)
114
+
module One_time_keys_file : sig
115
+
type t = {
116
+
target_count : int;
117
+
last_upload_at : Ptime.t option;
118
+
next_key_id : int;
119
+
keys : One_time_key.t list;
120
+
fallback : One_time_key.t option;
121
+
fallback_used : bool;
122
+
}
123
+
124
+
val tomlt : t Tomlt.t
125
+
end
126
+
127
+
(** A persisted Olm session. *)
128
+
module Olm_session : sig
129
+
type t = {
130
+
their_identity_key : string;
131
+
session_id : string;
132
+
pickle : string; (** JSON-encoded session state *)
133
+
created_at : Ptime.t;
134
+
last_used_at : Ptime.t;
135
+
}
136
+
137
+
val tomlt : t Tomlt.t
138
+
end
139
+
140
+
(** Olm sessions file contents. *)
141
+
module Olm_sessions_file : sig
142
+
type t = { sessions : Olm_session.t list }
143
+
144
+
val tomlt : t Tomlt.t
145
+
end
146
+
147
+
(** A persisted Megolm inbound session. *)
148
+
module Megolm_inbound : sig
149
+
type t = {
150
+
room_id : Matrix_proto.Id.Room_id.t;
151
+
session_id : string;
152
+
sender_key : string;
153
+
signing_key : string;
154
+
pickle : string;
155
+
first_known_index : int;
156
+
created_at : Ptime.t;
157
+
}
158
+
159
+
val tomlt : t Tomlt.t
160
+
end
161
+
162
+
(** Megolm inbound sessions file contents. *)
163
+
module Megolm_inbound_file : sig
164
+
type t = { sessions : Megolm_inbound.t list }
165
+
166
+
val tomlt : t Tomlt.t
167
+
end
168
+
169
+
(** Device that has received a session key. *)
170
+
module Shared_with : sig
171
+
type t = {
172
+
user_id : Matrix_proto.Id.User_id.t;
173
+
device_id : Matrix_proto.Id.Device_id.t;
174
+
shared_at : Ptime.t;
175
+
}
176
+
177
+
val tomlt : t Tomlt.t
178
+
end
179
+
180
+
(** A persisted Megolm outbound session. *)
181
+
module Megolm_outbound : sig
182
+
type t = {
183
+
room_id : Matrix_proto.Id.Room_id.t;
184
+
session_id : string;
185
+
pickle : string;
186
+
message_index : int;
187
+
created_at : Ptime.t;
188
+
message_count : int;
189
+
max_age_ms : int64;
190
+
shared_with : Shared_with.t list;
191
+
}
192
+
193
+
val tomlt : t Tomlt.t
194
+
end
195
+
196
+
(** Megolm outbound sessions file contents. *)
197
+
module Megolm_outbound_file : sig
198
+
type t = { sessions : Megolm_outbound.t list }
199
+
200
+
val tomlt : t Tomlt.t
201
+
end
202
+
203
+
(** {1 Pickle Functions for Olm State}
204
+
205
+
These functions serialize and deserialize Olm cryptographic state
206
+
using JSON encoding (via jsont). The pickle format preserves all
207
+
necessary state for session resumption. *)
208
+
209
+
module Pickle : sig
210
+
(** Pickle an Olm.Account to a JSON string. *)
211
+
val pickle_account : Olm.Account.t -> string
212
+
213
+
(** Unpickle an Olm.Account from a JSON string. *)
214
+
val unpickle_account : string -> (Olm.Account.t, string) result
215
+
216
+
(** Pickle an Olm.Session to a JSON string. *)
217
+
val pickle_session : Olm.Session.t -> string
218
+
219
+
(** Unpickle an Olm.Session from a JSON string. *)
220
+
val unpickle_session : string -> (Olm.Session.t, string) result
221
+
222
+
(** Pickle a Megolm.Inbound session to a JSON string. *)
223
+
val pickle_megolm_inbound : Olm.Megolm.Inbound.t -> string
224
+
225
+
(** Unpickle a Megolm.Inbound session from a JSON string. *)
226
+
val unpickle_megolm_inbound : string -> (Olm.Megolm.Inbound.t, string) result
227
+
228
+
(** Pickle a Megolm.Outbound session to a JSON string. *)
229
+
val pickle_megolm_outbound : Olm.Megolm.Outbound.t -> string
230
+
231
+
(** Unpickle a Megolm.Outbound session from a JSON string. *)
232
+
val unpickle_megolm_outbound : string -> (Olm.Megolm.Outbound.t, string) result
233
+
end
234
+
235
+
(** {1 Session Store}
236
+
237
+
High-level interface for managing session persistence. *)
238
+
239
+
module Store : sig
240
+
type t
241
+
242
+
(** Create a session store for the given profile using xdge.
243
+
Creates the profile directory if it doesn't exist. *)
244
+
val create : xdg:Xdge.t -> profile:string -> t
245
+
246
+
(** Get the profile directory path. *)
247
+
val profile_dir : t -> Eio.Fs.dir_ty Eio.Path.t
248
+
249
+
(** Check if a profile exists and is initialized. *)
250
+
val exists : t -> bool
251
+
252
+
(** {2 Session File Operations} *)
253
+
254
+
val load_session : t -> Session_file.t option
255
+
val save_session : t -> Session_file.t -> unit
256
+
257
+
val load_device_keys : t -> Device_keys.t option
258
+
val save_device_keys : t -> Device_keys.t -> unit
259
+
260
+
val load_one_time_keys : t -> One_time_keys_file.t option
261
+
val save_one_time_keys : t -> One_time_keys_file.t -> unit
262
+
263
+
val load_olm_sessions : t -> Olm_sessions_file.t option
264
+
val save_olm_sessions : t -> Olm_sessions_file.t -> unit
265
+
266
+
val load_megolm_inbound : t -> Megolm_inbound_file.t option
267
+
val save_megolm_inbound : t -> Megolm_inbound_file.t -> unit
268
+
269
+
val load_megolm_outbound : t -> Megolm_outbound_file.t option
270
+
val save_megolm_outbound : t -> Megolm_outbound_file.t -> unit
271
+
272
+
(** Delete all session files for this profile. *)
273
+
val clear : t -> unit
274
+
end