Matrix protocol in OCaml, Eio specialised
Add DM room support and encrypted room creation
Rooms module:
- Add find_dm_rooms to look up m.direct account data
- Add get_or_create_dm for DM room lifecycle management
- Add encrypted parameter to create/create_room for E2E rooms
Client module:
- Extend session handling and HTTP helpers
Auth module:
- Refactor login flow structure
Messages module:
- Minor cleanup
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+304
-54
+46
-34
lib/matrix_client/auth.ml
+46
-34
lib/matrix_client/auth.ml
···
1
1
(** Authentication operations. *)
2
2
3
+
let src = Logs.Src.create "matrix.auth" ~doc:"Matrix authentication"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
3
6
(* Login flow types *)
4
7
type login_flow =
5
8
| Password
···
71
74
} [@@warning "-69"]
72
75
73
76
let login_identifier_jsont =
74
-
Jsont.Object.map
75
-
~kind:"login_identifier"
76
-
(fun id_type user -> { id_type; user })
77
-
|> Jsont.Object.mem "type" Jsont.string
78
-
|> Jsont.Object.opt_mem "user" Jsont.string
79
-
|> Jsont.Object.finish
77
+
Jsont.Object.(
78
+
map ~kind:"login_identifier"
79
+
(fun id_type user -> { id_type; user })
80
+
|> mem "type" Jsont.string ~enc:(fun t -> t.id_type)
81
+
|> opt_mem "user" Jsont.string ~enc:(fun t -> t.user)
82
+
|> finish)
80
83
81
84
let login_request_jsont =
82
-
Jsont.Object.map
83
-
~kind:"login_request"
84
-
(fun req_type identifier password token device_id initial_device_display_name ->
85
-
{ req_type; identifier; password; token; device_id; initial_device_display_name })
86
-
|> Jsont.Object.mem "type" Jsont.string
87
-
|> Jsont.Object.mem "identifier" login_identifier_jsont
88
-
|> Jsont.Object.opt_mem "password" Jsont.string
89
-
|> Jsont.Object.opt_mem "token" Jsont.string
90
-
|> Jsont.Object.opt_mem "device_id" Jsont.string
91
-
|> Jsont.Object.opt_mem "initial_device_display_name" Jsont.string
92
-
|> Jsont.Object.finish
85
+
Jsont.Object.(
86
+
map ~kind:"login_request"
87
+
(fun req_type identifier password token device_id initial_device_display_name ->
88
+
{ req_type; identifier; password; token; device_id; initial_device_display_name })
89
+
|> mem "type" Jsont.string ~enc:(fun t -> t.req_type)
90
+
|> mem "identifier" login_identifier_jsont ~enc:(fun t -> t.identifier)
91
+
|> opt_mem "password" Jsont.string ~enc:(fun t -> t.password)
92
+
|> opt_mem "token" Jsont.string ~enc:(fun t -> t.token)
93
+
|> opt_mem "device_id" Jsont.string ~enc:(fun t -> t.device_id)
94
+
|> opt_mem "initial_device_display_name" Jsont.string
95
+
~enc:(fun t -> t.initial_device_display_name)
96
+
|> finish)
93
97
94
98
(* Login response codec *)
95
99
type login_response = {
···
118
122
}
119
123
120
124
let login_password client ~user ~password ?(params = default_login_params) () =
125
+
Log.info (fun m -> m "Logging in as %s" user);
121
126
let request = {
122
127
req_type = "m.login.password";
123
128
identifier = { id_type = "m.id.user"; user = Some user };
···
130
135
| Error e -> Error e
131
136
| Ok body ->
132
137
match Client.post_unauthenticated client ~path:"/login" ~body () with
133
-
| Error e -> Error e
138
+
| Error e ->
139
+
Log.err (fun m -> m "Login failed for user %s" user);
140
+
Error e
134
141
| Ok body ->
135
142
match Client.decode_response login_response_jsont body with
136
143
| Error e -> Error e
137
-
| Ok resp -> Ok (response_to_session resp)
144
+
| Ok resp ->
145
+
Log.info (fun m -> m "Login successful: user_id=%s device_id=%s"
146
+
(Matrix_proto.Id.User_id.to_string resp.user_id)
147
+
(Matrix_proto.Id.Device_id.to_string resp.device_id));
148
+
Ok (response_to_session resp)
138
149
139
150
let login_token client ~token ?(params = default_login_params) () =
140
151
let request = {
···
161
172
} [@@warning "-69"]
162
173
163
174
let refresh_request_jsont =
164
-
Jsont.Object.map
165
-
~kind:"refresh_request"
166
-
(fun refresh_token -> { refresh_token })
167
-
|> Jsont.Object.mem "refresh_token" Jsont.string
168
-
|> Jsont.Object.finish
175
+
Jsont.Object.(
176
+
map ~kind:"refresh_request"
177
+
(fun refresh_token -> { refresh_token })
178
+
|> mem "refresh_token" Jsont.string ~enc:(fun t -> t.refresh_token)
179
+
|> finish)
169
180
170
181
type refresh_response = {
171
182
access_token : string;
···
218
229
} [@@warning "-69"]
219
230
220
231
let register_request_jsont =
221
-
Jsont.Object.map
222
-
~kind:"register_request"
223
-
(fun username password device_id initial_device_display_name inhibit_login ->
224
-
{ kind = None; username; password; device_id; initial_device_display_name; inhibit_login })
225
-
|> Jsont.Object.opt_mem "username" Jsont.string
226
-
|> Jsont.Object.opt_mem "password" Jsont.string
227
-
|> Jsont.Object.opt_mem "device_id" Jsont.string
228
-
|> Jsont.Object.opt_mem "initial_device_display_name" Jsont.string
229
-
|> Jsont.Object.opt_mem "inhibit_login" Jsont.bool
230
-
|> Jsont.Object.finish
232
+
Jsont.Object.(
233
+
map ~kind:"register_request"
234
+
(fun username password device_id initial_device_display_name inhibit_login ->
235
+
{ kind = None; username; password; device_id; initial_device_display_name; inhibit_login })
236
+
|> opt_mem "username" Jsont.string ~enc:(fun t -> t.username)
237
+
|> opt_mem "password" Jsont.string ~enc:(fun t -> t.password)
238
+
|> opt_mem "device_id" Jsont.string ~enc:(fun t -> t.device_id)
239
+
|> opt_mem "initial_device_display_name" Jsont.string
240
+
~enc:(fun t -> t.initial_device_display_name)
241
+
|> opt_mem "inhibit_login" Jsont.bool ~enc:(fun t -> t.inhibit_login)
242
+
|> finish)
231
243
232
244
type register_response = {
233
245
user_id : Matrix_proto.Id.User_id.t;
+38
-8
lib/matrix_client/client.ml
+38
-8
lib/matrix_client/client.ml
···
1
+
let src = Logs.Src.create "matrix.client" ~doc:"Matrix client HTTP"
2
+
module Log = (val Logs.src_log src : Logs.LOG)
3
+
1
4
type config = {
2
5
homeserver : Uri.t;
3
6
user_agent : string option;
···
59
62
let handle_response response =
60
63
let status = Requests.Response.status_code response in
61
64
let body = Requests.Response.text response in
65
+
Log.debug (fun m -> m "Response: status=%d" status);
66
+
Log.debug (fun m -> m "Response body: %s" body);
62
67
if status >= 200 && status < 300 then
63
68
Ok body
64
-
else
69
+
else begin
70
+
Log.warn (fun m -> m "HTTP error: status=%d body=%s" status body);
65
71
(* Try to parse as Matrix error *)
66
72
match Jsont_bytesrw.decode_string Error.matrix_error_jsont body with
67
73
| Ok matrix_err -> Error (Error.Matrix_error matrix_err)
68
74
| Error _ -> Error (Error.Http_error { status; body })
75
+
end
69
76
70
77
let get t ~path ?query () =
71
78
try
72
79
let url = make_url t path query |> Uri.to_string in
80
+
Log.debug (fun m -> m "GET %s" url);
73
81
let headers = auth_headers t |> add_user_agent t in
74
82
let response = Requests.get t.http ~headers url in
75
83
handle_response response
76
84
with
77
-
| exn -> Error (Error.Network_error (Printexc.to_string exn))
85
+
| exn ->
86
+
Log.err (fun m -> m "GET %s failed: %s" path (Printexc.to_string exn));
87
+
Error (Error.Network_error (Printexc.to_string exn))
78
88
79
89
let post t ~path ?query ~body () =
80
90
try
81
91
let url = make_url t path query |> Uri.to_string in
92
+
Log.debug (fun m -> m "POST %s" url);
93
+
Log.debug (fun m -> m "Request body: %s" body);
82
94
let headers = auth_headers t |> add_user_agent t |> json_content_type in
83
95
let body = Requests.Body.of_string Requests.Mime.json body in
84
96
let response = Requests.post t.http ~headers ~body url in
85
97
handle_response response
86
98
with
87
-
| exn -> Error (Error.Network_error (Printexc.to_string exn))
99
+
| exn ->
100
+
Log.err (fun m -> m "POST %s failed: %s" path (Printexc.to_string exn));
101
+
Error (Error.Network_error (Printexc.to_string exn))
88
102
89
103
let put t ~path ?query ~body () =
90
104
try
91
105
let url = make_url t path query |> Uri.to_string in
106
+
Log.debug (fun m -> m "PUT %s" url);
107
+
Log.debug (fun m -> m "Request body: %s" body);
92
108
let headers = auth_headers t |> add_user_agent t |> json_content_type in
93
109
let body = Requests.Body.of_string Requests.Mime.json body in
94
110
let response = Requests.put t.http ~headers ~body url in
95
111
handle_response response
96
112
with
97
-
| exn -> Error (Error.Network_error (Printexc.to_string exn))
113
+
| exn ->
114
+
Log.err (fun m -> m "PUT %s failed: %s" path (Printexc.to_string exn));
115
+
Error (Error.Network_error (Printexc.to_string exn))
98
116
99
117
let delete t ~path ?query ?body () =
100
118
try
101
119
let url = make_url t path query |> Uri.to_string in
120
+
Log.debug (fun m -> m "DELETE %s" url);
102
121
let headers = auth_headers t |> add_user_agent t in
103
122
let headers, body =
104
123
match body with
105
124
| Some b ->
125
+
Log.debug (fun m -> m "Request body: %s" b);
106
126
(json_content_type headers,
107
127
Some (Requests.Body.of_string Requests.Mime.json b))
108
128
| None -> (headers, None)
···
110
130
let response = Requests.request t.http ~headers ?body ~method_:`DELETE url in
111
131
handle_response response
112
132
with
113
-
| exn -> Error (Error.Network_error (Printexc.to_string exn))
133
+
| exn ->
134
+
Log.err (fun m -> m "DELETE %s failed: %s" path (Printexc.to_string exn));
135
+
Error (Error.Network_error (Printexc.to_string exn))
114
136
115
137
let post_unauthenticated t ~path ?query ~body () =
116
138
try
117
139
let url = make_url t path query |> Uri.to_string in
140
+
Log.debug (fun m -> m "POST (unauth) %s" url);
141
+
Log.debug (fun m -> m "Request body: %s" body);
118
142
let headers =
119
143
Requests.Headers.empty
120
144
|> add_user_agent t
···
124
148
let response = Requests.post t.http ~headers ~body url in
125
149
handle_response response
126
150
with
127
-
| exn -> Error (Error.Network_error (Printexc.to_string exn))
151
+
| exn ->
152
+
Log.err (fun m -> m "POST (unauth) %s failed: %s" path (Printexc.to_string exn));
153
+
Error (Error.Network_error (Printexc.to_string exn))
128
154
129
155
let decode_response jsont body =
130
156
match Jsont_bytesrw.decode_string jsont body with
131
157
| Ok v -> Ok v
132
-
| Error e -> Error (Error.Json_error e)
158
+
| Error e ->
159
+
Log.err (fun m -> m "JSON decode error: %s" e);
160
+
Error (Error.Json_error e)
133
161
134
162
let encode_body jsont value =
135
163
match Jsont_bytesrw.encode_string jsont value with
136
164
| Ok s -> Ok s
137
-
| Error e -> Error (Error.Json_error e)
165
+
| Error e ->
166
+
Log.err (fun m -> m "JSON encode error: %s" e);
167
+
Error (Error.Json_error e)
+5
-5
lib/matrix_client/messages.ml
+5
-5
lib/matrix_client/messages.ml
···
49
49
Jsont.Object.(
50
50
map (fun msgtype body format formatted_body ->
51
51
{ msgtype; body; format; formatted_body })
52
-
|> mem "msgtype" Jsont.string
53
-
|> mem "body" Jsont.string
52
+
|> mem "msgtype" Jsont.string ~enc:(fun t -> t.msgtype)
53
+
|> mem "body" Jsont.string ~enc:(fun t -> t.body)
54
54
|> opt_mem "format" Jsont.string ~enc:(fun t -> t.format)
55
55
|> opt_mem "formatted_body" Jsont.string ~enc:(fun t -> t.formatted_body)
56
56
|> finish)
···
94
94
Jsont.Object.(
95
95
map (fun msgtype body url info ->
96
96
{ msgtype; body; url; info })
97
-
|> mem "msgtype" Jsont.string
98
-
|> mem "body" Jsont.string
99
-
|> mem "url" Jsont.string
97
+
|> mem "msgtype" Jsont.string ~enc:(fun t -> t.msgtype)
98
+
|> mem "body" Jsont.string ~enc:(fun t -> t.body)
99
+
|> mem "url" Jsont.string ~enc:(fun t -> t.url)
100
100
|> opt_mem "info" Jsont.json ~enc:(fun t -> t.info)
101
101
|> finish)
102
102
+164
-4
lib/matrix_client/rooms.ml
+164
-4
lib/matrix_client/rooms.ml
···
1
1
(** Room operations. *)
2
2
3
+
let src = Logs.Src.create "matrix.rooms" ~doc:"Matrix room operations"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
3
6
type visibility = [ `Public | `Private ]
4
7
5
8
type preset =
···
12
15
| Public_chat -> "public_chat"
13
16
| Trusted_private_chat -> "trusted_private_chat"
14
17
18
+
(* State event for initial_state *)
19
+
type state_event = {
20
+
ev_type : string;
21
+
state_key : string;
22
+
content : Jsont.json;
23
+
} [@@warning "-69"]
24
+
25
+
let state_event_jsont =
26
+
Jsont.Object.(
27
+
map (fun ev_type state_key content -> { ev_type; state_key; content })
28
+
|> mem "type" Jsont.string ~enc:(fun t -> t.ev_type)
29
+
|> mem "state_key" Jsont.string ~enc:(fun t -> t.state_key)
30
+
|> mem "content" Jsont.json ~enc:(fun t -> t.content)
31
+
|> finish)
32
+
15
33
(* Create room *)
16
34
type create_request = {
17
35
name : string option;
···
23
41
is_direct : bool option;
24
42
room_type : string option;
25
43
creation_content : Jsont.json option;
44
+
initial_state : state_event list;
26
45
} [@@warning "-69"]
27
46
28
47
let create_request_jsont : create_request Jsont.t =
29
48
let open Jsont.Object in
30
-
map (fun name topic visibility preset room_alias_local_part invite is_direct room_type creation_content ->
31
-
({ name; topic; visibility; preset; room_alias_local_part; invite; is_direct; room_type; creation_content } : create_request))
49
+
map (fun name topic visibility preset room_alias_local_part invite is_direct room_type creation_content initial_state ->
50
+
({ name; topic; visibility; preset; room_alias_local_part; invite; is_direct; room_type; creation_content; initial_state } : create_request))
32
51
|> opt_mem "name" Jsont.string ~enc:(fun (t : create_request) -> t.name)
33
52
|> opt_mem "topic" Jsont.string ~enc:(fun (t : create_request) -> t.topic)
34
53
|> opt_mem "visibility" Jsont.string ~enc:(fun (t : create_request) -> t.visibility)
···
38
57
|> opt_mem "is_direct" Jsont.bool ~enc:(fun (t : create_request) -> t.is_direct)
39
58
|> opt_mem "room_type" Jsont.string ~enc:(fun (t : create_request) -> t.room_type)
40
59
|> opt_mem "creation_content" Jsont.json ~enc:(fun (t : create_request) -> t.creation_content)
60
+
|> mem "initial_state" (Jsont.list state_event_jsont) ~dec_absent:[] ~enc:(fun (t : create_request) -> t.initial_state)
41
61
|> finish
42
62
43
63
type create_response = {
···
50
70
|> mem "room_id" Matrix_proto.Id.Room_id.jsont
51
71
|> finish)
52
72
53
-
let create client ?name ?topic ?visibility ?preset ?room_alias_local_part ?invite ?is_direct ?room_type () =
73
+
(** Default encryption algorithm for E2EE rooms. *)
74
+
let default_encryption_algorithm = "m.megolm.v1.aes-sha2"
75
+
76
+
(** Build encryption state event for initial_state. *)
77
+
let encryption_state_event algorithm =
78
+
let content = Jsont.Object (
79
+
[(("algorithm", Jsont.Meta.none), Jsont.String (algorithm, Jsont.Meta.none))],
80
+
Jsont.Meta.none
81
+
) in
82
+
{ ev_type = "m.room.encryption"; state_key = ""; content }
83
+
84
+
let create client ?name ?topic ?visibility ?preset ?room_alias_local_part ?invite ?is_direct ?room_type ?encrypted () =
54
85
let visibility_str = match visibility with
55
86
| Some `Public -> Some "public"
56
87
| Some `Private -> Some "private"
···
61
92
| Some ids -> List.map Matrix_proto.Id.User_id.to_string ids
62
93
| None -> []
63
94
in
95
+
(* Build initial_state with encryption if requested *)
96
+
let initial_state = match encrypted with
97
+
| Some true -> [encryption_state_event default_encryption_algorithm]
98
+
| _ -> []
99
+
in
64
100
let request = {
65
101
name; topic;
66
102
visibility = visibility_str;
···
70
106
is_direct;
71
107
room_type;
72
108
creation_content = None;
109
+
initial_state;
73
110
} in
111
+
Log.debug (fun m -> m "Creating room with%s encryption"
112
+
(if initial_state <> [] then "" else "out"));
74
113
match Client.encode_body create_request_jsont request with
75
114
| Error e -> Error e
76
115
| Ok body ->
···
79
118
| Ok body ->
80
119
match Client.decode_response create_response_jsont body with
81
120
| Error e -> Error e
82
-
| Ok resp -> Ok resp.room_id
121
+
| Ok resp ->
122
+
Log.info (fun m -> m "Created room %s"
123
+
(Matrix_proto.Id.Room_id.to_string resp.room_id));
124
+
Ok resp.room_id
83
125
84
126
(** Alias for create with room_type support *)
85
127
let create_room = create
···
459
501
let users = (user_id_str, level) :: users in
460
502
let power_levels = { pl with users } in
461
503
set_power_levels client ~room_id ~power_levels
504
+
505
+
(* Direct message room helpers *)
506
+
507
+
(** m.direct account data is a map from user_id to list of room_ids *)
508
+
let m_direct_jsont =
509
+
let module StringMap = Map.Make(String) in
510
+
Jsont.Object.as_string_map (Jsont.list Jsont.string)
511
+
|> Jsont.map
512
+
~dec:(fun m -> StringMap.bindings m)
513
+
~enc:(fun l -> List.to_seq l |> StringMap.of_seq)
514
+
515
+
(** Get the m.direct account data mapping user IDs to DM room IDs. *)
516
+
let get_direct_rooms client =
517
+
match Account.get_account_data client ~event_type:"m.direct" with
518
+
| Error (Error.Matrix_error { errcode = Error.M_NOT_FOUND; _ }) ->
519
+
Log.debug (fun m -> m "No m.direct account data found");
520
+
Ok []
521
+
| Error e -> Error e
522
+
| Ok json ->
523
+
(* Re-encode and decode with our typed codec *)
524
+
match Jsont_bytesrw.encode_string Jsont.json json with
525
+
| Error e -> Error (Error.Json_error e)
526
+
| Ok json_str ->
527
+
match Jsont_bytesrw.decode_string m_direct_jsont json_str with
528
+
| Error e ->
529
+
Log.warn (fun m -> m "Failed to parse m.direct: %s" e);
530
+
Ok []
531
+
| Ok bindings ->
532
+
Log.debug (fun m -> m "Found m.direct with %d users" (List.length bindings));
533
+
Ok bindings
534
+
535
+
(** Find existing DM rooms with a specific user. *)
536
+
let find_dm_rooms client ~user_id =
537
+
match get_direct_rooms client with
538
+
| Error e -> Error e
539
+
| Ok bindings ->
540
+
let user_id_str = Matrix_proto.Id.User_id.to_string user_id in
541
+
let room_strs = match List.assoc_opt user_id_str bindings with
542
+
| Some rooms -> rooms
543
+
| None -> []
544
+
in
545
+
let room_ids = List.filter_map (fun s ->
546
+
match Matrix_proto.Id.Room_id.of_string s with
547
+
| Ok id -> Some id
548
+
| Error _ -> None
549
+
) room_strs in
550
+
Log.debug (fun m -> m "Found %d existing DM rooms with %s"
551
+
(List.length room_ids) user_id_str);
552
+
Ok room_ids
553
+
554
+
(** Update m.direct account data to add a room for a user. *)
555
+
let add_direct_room client ~user_id ~room_id =
556
+
match get_direct_rooms client with
557
+
| Error e -> Error e
558
+
| Ok bindings ->
559
+
let user_id_str = Matrix_proto.Id.User_id.to_string user_id in
560
+
let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
561
+
(* Get existing rooms for this user or empty list *)
562
+
let existing = match List.assoc_opt user_id_str bindings with
563
+
| Some rooms -> rooms
564
+
| None -> []
565
+
in
566
+
(* Add the new room if not already present *)
567
+
let new_rooms =
568
+
if List.mem room_id_str existing then existing
569
+
else room_id_str :: existing
570
+
in
571
+
(* Update the bindings *)
572
+
let new_bindings =
573
+
(user_id_str, new_rooms) ::
574
+
List.filter (fun (k, _) -> k <> user_id_str) bindings
575
+
in
576
+
(* Encode and save *)
577
+
match Jsont_bytesrw.encode_string m_direct_jsont new_bindings with
578
+
| Error e -> Error (Error.Json_error e)
579
+
| Ok json_str ->
580
+
match Jsont_bytesrw.decode_string Jsont.json json_str with
581
+
| Error e -> Error (Error.Json_error e)
582
+
| Ok json ->
583
+
Log.debug (fun m -> m "Updating m.direct for %s" user_id_str);
584
+
Account.set_account_data client ~event_type:"m.direct" ~content:json
585
+
586
+
(** Get or create a DM room with a user.
587
+
588
+
If an existing DM room is found, returns that room ID.
589
+
Otherwise creates a new DM room, updates m.direct, and returns the new room ID.
590
+
591
+
@param encrypted If true, enables E2E encryption on new rooms.
592
+
@return The room ID (existing or newly created). *)
593
+
let get_or_create_dm client ~user_id ?encrypted () =
594
+
Log.info (fun m -> m "Getting or creating DM with %s"
595
+
(Matrix_proto.Id.User_id.to_string user_id));
596
+
match find_dm_rooms client ~user_id with
597
+
| Error e -> Error e
598
+
| Ok (room_id :: _) ->
599
+
(* Found existing DM room *)
600
+
Log.info (fun m -> m "Using existing DM room %s"
601
+
(Matrix_proto.Id.Room_id.to_string room_id));
602
+
Ok room_id
603
+
| Ok [] ->
604
+
(* No existing DM room, create one *)
605
+
Log.info (fun m -> m "Creating new DM room");
606
+
match create client
607
+
~preset:Trusted_private_chat
608
+
~is_direct:true
609
+
~invite:[user_id]
610
+
?encrypted
611
+
()
612
+
with
613
+
| Error e -> Error e
614
+
| Ok room_id ->
615
+
(* Update m.direct to track this as a DM room *)
616
+
(match add_direct_room client ~user_id ~room_id with
617
+
| Error e ->
618
+
Log.warn (fun m -> m "Failed to update m.direct: %a" Error.pp e);
619
+
(* Room was created, return it even if m.direct update failed *)
620
+
Ok room_id
621
+
| Ok () -> Ok room_id)
+32
-1
lib/matrix_client/rooms.mli
+32
-1
lib/matrix_client/rooms.mli
···
13
13
14
14
(** Create a new room.
15
15
16
-
Returns the room ID of the newly created room. *)
16
+
@param encrypted If [true], enables end-to-end encryption using Megolm.
17
+
@return The room ID of the newly created room. *)
17
18
val create :
18
19
Client.t ->
19
20
?name:string ->
···
24
25
?invite:Matrix_proto.Id.User_id.t list ->
25
26
?is_direct:bool ->
26
27
?room_type:string ->
28
+
?encrypted:bool ->
27
29
unit ->
28
30
(Matrix_proto.Id.Room_id.t, Error.t) result
29
31
···
38
40
?invite:Matrix_proto.Id.User_id.t list ->
39
41
?is_direct:bool ->
40
42
?room_type:string ->
43
+
?encrypted:bool ->
41
44
unit ->
42
45
(Matrix_proto.Id.Room_id.t, Error.t) result
43
46
···
226
229
user_id:Matrix_proto.Id.User_id.t ->
227
230
level:int ->
228
231
(unit, Error.t) result
232
+
233
+
(** {1 Direct Messages} *)
234
+
235
+
(** Find existing DM rooms with a user.
236
+
237
+
Looks up the [m.direct] account data to find rooms marked as direct
238
+
messages with the specified user.
239
+
240
+
@return List of room IDs (may be empty if no DM rooms exist). *)
241
+
val find_dm_rooms :
242
+
Client.t ->
243
+
user_id:Matrix_proto.Id.User_id.t ->
244
+
(Matrix_proto.Id.Room_id.t list, Error.t) result
245
+
246
+
(** Get or create a DM room with a user.
247
+
248
+
If an existing DM room is found in [m.direct], returns that room ID.
249
+
Otherwise creates a new private room with [is_direct:true], invites
250
+
the user, updates [m.direct], and returns the new room ID.
251
+
252
+
@param encrypted If [true], enables E2E encryption on newly created rooms.
253
+
@return The room ID (existing or newly created). *)
254
+
val get_or_create_dm :
255
+
Client.t ->
256
+
user_id:Matrix_proto.Id.User_id.t ->
257
+
?encrypted:bool ->
258
+
unit ->
259
+
(Matrix_proto.Id.Room_id.t, Error.t) result
+19
-2
lib/matrix_eio/rooms.ml
+19
-2
lib/matrix_eio/rooms.ml
···
22
22
@param room_alias_local_part Local part of a room alias
23
23
@param visibility Public or Private
24
24
@param room_type Optional room type (e.g., "m.space")
25
+
@param encrypted If true, enable E2E encryption
25
26
@return The new room ID
26
27
@raise Eio.Io on failure *)
27
-
let create client ?name ?topic ?visibility ?preset ?room_alias_local_part ?invite ?is_direct ?room_type () =
28
+
let create client ?name ?topic ?visibility ?preset ?room_alias_local_part ?invite ?is_direct ?room_type ?encrypted () =
28
29
Error.unwrap (Matrix_client.Rooms.create (Client.base client)
29
-
?name ?topic ?visibility ?preset ?room_alias_local_part ?invite ?is_direct ?room_type ())
30
+
?name ?topic ?visibility ?preset ?room_alias_local_part ?invite ?is_direct ?room_type ?encrypted ())
30
31
31
32
(** Join a room by ID or alias.
32
33
@raise Eio.Io on failure *)
···
138
139
let set_user_power_level client ~room_id ~user_id ~level =
139
140
Error.unwrap (Matrix_client.Rooms.set_user_power_level (Client.base client)
140
141
~room_id ~user_id ~level)
142
+
143
+
(** Find existing DM rooms with a user.
144
+
@raise Eio.Io on failure *)
145
+
let find_dm_rooms client ~user_id =
146
+
Error.unwrap (Matrix_client.Rooms.find_dm_rooms (Client.base client) ~user_id)
147
+
148
+
(** Get or create a DM room with a user.
149
+
150
+
If an existing DM room is found, returns that room ID.
151
+
Otherwise creates a new DM room, updates m.direct, and returns the new room ID.
152
+
153
+
@param encrypted If true, enable E2E encryption on new rooms
154
+
@raise Eio.Io on failure *)
155
+
let get_or_create_dm client ~user_id ?encrypted () =
156
+
Error.unwrap (Matrix_client.Rooms.get_or_create_dm (Client.base client)
157
+
~user_id ?encrypted ())