anil.recoil.org
Matrix protocol in OCaml, Eio specialised
1(** Message sending and retrieval. *)
2
3(* Transaction ID generator *)
4let next_txn_id =
5 let counter = ref 0 in
6 fun () ->
7 incr counter;
8 Printf.sprintf "%d_%f" !counter (Unix.gettimeofday ())
9
10(* Send event response *)
11type send_response = {
12 event_id : Matrix_proto.Id.Event_id.t;
13}
14
15let send_response_jsont =
16 Jsont.Object.(
17 map (fun event_id -> { event_id })
18 |> mem "event_id" Matrix_proto.Id.Event_id.jsont
19 |> finish)
20
21(* Generic send event *)
22let send_event client ~room_id ~event_type ~content =
23 let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
24 let txn_id = next_txn_id () in
25 let path = Printf.sprintf "/rooms/%s/send/%s/%s"
26 (Uri.pct_encode room_id_str)
27 (Uri.pct_encode event_type)
28 (Uri.pct_encode txn_id)
29 in
30 match Client.encode_body Jsont.json content with
31 | Error e -> Error e
32 | Ok body ->
33 match Client.put client ~path ~body () with
34 | Error e -> Error e
35 | Ok body ->
36 match Client.decode_response send_response_jsont body with
37 | Error e -> Error e
38 | Ok resp -> Ok resp.event_id
39
40(* Text message content *)
41type text_content = {
42 msgtype : string;
43 body : string;
44 format : string option;
45 formatted_body : string option;
46} [@@warning "-69"]
47
48let text_content_jsont =
49 Jsont.Object.(
50 map (fun msgtype body format formatted_body ->
51 { msgtype; body; format; formatted_body })
52 |> mem "msgtype" Jsont.string ~enc:(fun t -> t.msgtype)
53 |> mem "body" Jsont.string ~enc:(fun t -> t.body)
54 |> opt_mem "format" Jsont.string ~enc:(fun t -> t.format)
55 |> opt_mem "formatted_body" Jsont.string ~enc:(fun t -> t.formatted_body)
56 |> finish)
57
58let send_text client ~room_id ~body ?format ?formatted_body () =
59 let content = { msgtype = "m.text"; body; format; formatted_body } in
60 match Client.encode_body text_content_jsont content with
61 | Error e -> Error e
62 | Ok json_str ->
63 match Client.decode_response Jsont.json json_str with
64 | Error e -> Error e
65 | Ok json -> send_event client ~room_id ~event_type:"m.room.message" ~content:json
66
67let send_emote client ~room_id ~body () =
68 let content = { msgtype = "m.emote"; body; format = None; formatted_body = None } in
69 match Client.encode_body text_content_jsont content with
70 | Error e -> Error e
71 | Ok json_str ->
72 match Client.decode_response Jsont.json json_str with
73 | Error e -> Error e
74 | Ok json -> send_event client ~room_id ~event_type:"m.room.message" ~content:json
75
76let send_notice client ~room_id ~body () =
77 let content = { msgtype = "m.notice"; body; format = None; formatted_body = None } in
78 match Client.encode_body text_content_jsont content with
79 | Error e -> Error e
80 | Ok json_str ->
81 match Client.decode_response Jsont.json json_str with
82 | Error e -> Error e
83 | Ok json -> send_event client ~room_id ~event_type:"m.room.message" ~content:json
84
85(* Media message content *)
86type media_content = {
87 msgtype : string;
88 body : string;
89 url : string;
90 info : Jsont.json option;
91} [@@warning "-69"]
92
93let media_content_jsont =
94 Jsont.Object.(
95 map (fun msgtype body url info ->
96 { msgtype; body; url; info })
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 |> opt_mem "info" Jsont.json ~enc:(fun t -> t.info)
101 |> finish)
102
103let send_image client ~room_id ~body ~url ?info () =
104 let content = { msgtype = "m.image"; body; url; info } in
105 match Client.encode_body media_content_jsont content with
106 | Error e -> Error e
107 | Ok json_str ->
108 match Client.decode_response Jsont.json json_str with
109 | Error e -> Error e
110 | Ok json -> send_event client ~room_id ~event_type:"m.room.message" ~content:json
111
112let send_file client ~room_id ~body ~url ?info () =
113 let content = { msgtype = "m.file"; body; url; info } in
114 match Client.encode_body media_content_jsont content with
115 | Error e -> Error e
116 | Ok json_str ->
117 match Client.decode_response Jsont.json json_str with
118 | Error e -> Error e
119 | Ok json -> send_event client ~room_id ~event_type:"m.room.message" ~content:json
120
121(* Redaction *)
122type redact_request = {
123 reason : string option;
124} [@@warning "-69"]
125
126let redact_request_jsont =
127 Jsont.Object.(
128 map (fun reason -> { reason })
129 |> opt_mem "reason" Jsont.string ~enc:(fun t -> t.reason)
130 |> finish)
131
132let redact client ~room_id ~event_id ?reason () =
133 let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
134 let event_id_str = Matrix_proto.Id.Event_id.to_string event_id in
135 let txn_id = next_txn_id () in
136 let path = Printf.sprintf "/rooms/%s/redact/%s/%s"
137 (Uri.pct_encode room_id_str)
138 (Uri.pct_encode event_id_str)
139 (Uri.pct_encode txn_id)
140 in
141 let request = { reason } in
142 match Client.encode_body redact_request_jsont request with
143 | Error e -> Error e
144 | Ok body ->
145 match Client.put client ~path ~body () with
146 | Error e -> Error e
147 | Ok body ->
148 match Client.decode_response send_response_jsont body with
149 | Error e -> Error e
150 | Ok resp -> Ok resp.event_id
151
152(* Get messages *)
153type direction = Forward | Backward
154
155type messages_response = {
156 start : string;
157 end_ : string option;
158 chunk : Matrix_proto.Event.Raw_event.t list;
159 state : Matrix_proto.Event.Raw_event.t list;
160}
161
162let messages_response_jsont =
163 Jsont.Object.(
164 map (fun start end_ chunk state ->
165 { start; end_; chunk; state })
166 |> mem "start" Jsont.string
167 |> opt_mem "end" Jsont.string ~enc:(fun t -> t.end_)
168 |> mem "chunk" (Jsont.list Matrix_proto.Event.Raw_event.jsont) ~dec_absent:[]
169 |> mem "state" (Jsont.list Matrix_proto.Event.Raw_event.jsont) ~dec_absent:[]
170 |> finish)
171
172let get_messages client ~room_id ~from ~dir ?limit ?filter () =
173 let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
174 let path = Printf.sprintf "/rooms/%s/messages" (Uri.pct_encode room_id_str) in
175 let dir_str = match dir with Forward -> "f" | Backward -> "b" in
176 let query =
177 [("from", from); ("dir", dir_str)]
178 |> (fun q -> match limit with Some l -> ("limit", string_of_int l) :: q | None -> q)
179 |> (fun q -> match filter with Some f -> ("filter", f) :: q | None -> q)
180 in
181 match Client.get client ~path ~query () with
182 | Error e -> Error e
183 | Ok body -> Client.decode_response messages_response_jsont body
184
185(* Get single event *)
186let get_event client ~room_id ~event_id =
187 let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
188 let event_id_str = Matrix_proto.Id.Event_id.to_string event_id in
189 let path = Printf.sprintf "/rooms/%s/event/%s"
190 (Uri.pct_encode room_id_str)
191 (Uri.pct_encode event_id_str)
192 in
193 match Client.get client ~path () with
194 | Error e -> Error e
195 | Ok body -> Client.decode_response Matrix_proto.Event.Raw_event.jsont body
196
197(* Get context *)
198type context = {
199 start : string;
200 end_ : string;
201 event : Matrix_proto.Event.Raw_event.t;
202 events_before : Matrix_proto.Event.Raw_event.t list;
203 events_after : Matrix_proto.Event.Raw_event.t list;
204 state : Matrix_proto.Event.Raw_event.t list;
205}
206
207let context_jsont =
208 Jsont.Object.(
209 map (fun start end_ event events_before events_after state ->
210 { start; end_; event; events_before; events_after; state })
211 |> mem "start" Jsont.string
212 |> mem "end" Jsont.string
213 |> mem "event" Matrix_proto.Event.Raw_event.jsont
214 |> mem "events_before" (Jsont.list Matrix_proto.Event.Raw_event.jsont) ~dec_absent:[]
215 |> mem "events_after" (Jsont.list Matrix_proto.Event.Raw_event.jsont) ~dec_absent:[]
216 |> mem "state" (Jsont.list Matrix_proto.Event.Raw_event.jsont) ~dec_absent:[]
217 |> finish)
218
219let get_context client ~room_id ~event_id ?limit () =
220 let room_id_str = Matrix_proto.Id.Room_id.to_string room_id in
221 let event_id_str = Matrix_proto.Id.Event_id.to_string event_id in
222 let path = Printf.sprintf "/rooms/%s/context/%s"
223 (Uri.pct_encode room_id_str)
224 (Uri.pct_encode event_id_str)
225 in
226 let query = match limit with
227 | Some l -> Some [("limit", string_of_int l)]
228 | None -> None
229 in
230 match Client.get client ~path ?query () with
231 | Error e -> Error e
232 | Ok body -> Client.decode_response context_jsont body