anil.recoil.org
Matrix protocol in OCaml, Eio specialised
1(** Push notification operations. *)
2
3(** Push rule kinds *)
4type rule_kind =
5 | Override
6 | Underride
7 | Sender
8 | Room
9 | Content
10
11let rule_kind_to_string = function
12 | Override -> "override"
13 | Underride -> "underride"
14 | Sender -> "sender"
15 | Room -> "room"
16 | Content -> "content"
17
18let rule_kind_of_string = function
19 | "override" -> Ok Override
20 | "underride" -> Ok Underride
21 | "sender" -> Ok Sender
22 | "room" -> Ok Room
23 | "content" -> Ok Content
24 | s -> Error ("Unknown rule kind: " ^ s)
25
26let rule_kind_jsont =
27 Jsont.of_of_string ~kind:"rule_kind"
28 ~enc:rule_kind_to_string
29 rule_kind_of_string
30
31(** Push rule action *)
32type action =
33 | Notify
34 | Dont_notify
35 | Coalesce
36 | Set_tweak of string * Jsont.json
37
38(* For actions, we use a string codec as a simplification *)
39let action_jsont : action Jsont.t =
40 Jsont.string
41 |> Jsont.map
42 ~dec:(function
43 | "notify" -> Notify
44 | "dont_notify" -> Dont_notify
45 | "coalesce" -> Coalesce
46 | _ -> Dont_notify)
47 ~enc:(function
48 | Notify -> "notify"
49 | Dont_notify -> "dont_notify"
50 | Coalesce -> "coalesce"
51 | Set_tweak _ -> "notify")
52
53(** Push rule condition *)
54type condition = {
55 kind : string;
56 key : string option;
57 pattern : string option;
58 is_ : string option;
59}
60
61let condition_jsont =
62 Jsont.Object.(
63 map (fun kind key pattern is_ -> { kind; key; pattern; is_ })
64 |> mem "kind" Jsont.string ~enc:(fun t -> t.kind)
65 |> opt_mem "key" Jsont.string ~enc:(fun t -> t.key)
66 |> opt_mem "pattern" Jsont.string ~enc:(fun t -> t.pattern)
67 |> opt_mem "is" Jsont.string ~enc:(fun t -> t.is_)
68 |> finish)
69
70(** Push rule *)
71type rule = {
72 rule_id : string;
73 default : bool;
74 enabled : bool;
75 actions : action list;
76 conditions : condition list option;
77 pattern : string option;
78}
79
80let rule_jsont =
81 Jsont.Object.(
82 map (fun rule_id default enabled actions conditions pattern ->
83 { rule_id; default; enabled; actions; conditions; pattern })
84 |> mem "rule_id" Jsont.string ~enc:(fun t -> t.rule_id)
85 |> mem "default" Jsont.bool ~dec_absent:false ~enc:(fun t -> t.default)
86 |> mem "enabled" Jsont.bool ~dec_absent:true ~enc:(fun t -> t.enabled)
87 |> mem "actions" (Jsont.list action_jsont) ~dec_absent:[] ~enc:(fun t -> t.actions)
88 |> opt_mem "conditions" (Jsont.list condition_jsont) ~enc:(fun t -> t.conditions)
89 |> opt_mem "pattern" Jsont.string ~enc:(fun t -> t.pattern)
90 |> finish)
91
92(** Push ruleset *)
93type ruleset = {
94 override : rule list;
95 underride : rule list;
96 sender : rule list;
97 room : rule list;
98 content : rule list;
99}
100
101let ruleset_jsont =
102 Jsont.Object.(
103 map (fun override underride sender room content ->
104 { override; underride; sender; room; content })
105 |> mem "override" (Jsont.list rule_jsont) ~dec_absent:[] ~enc:(fun t -> t.override)
106 |> mem "underride" (Jsont.list rule_jsont) ~dec_absent:[] ~enc:(fun t -> t.underride)
107 |> mem "sender" (Jsont.list rule_jsont) ~dec_absent:[] ~enc:(fun t -> t.sender)
108 |> mem "room" (Jsont.list rule_jsont) ~dec_absent:[] ~enc:(fun t -> t.room)
109 |> mem "content" (Jsont.list rule_jsont) ~dec_absent:[] ~enc:(fun t -> t.content)
110 |> finish)
111
112type push_rules_response = {
113 global : ruleset;
114}
115
116let push_rules_response_jsont =
117 Jsont.Object.(
118 map (fun global -> { global })
119 |> mem "global" ruleset_jsont ~enc:(fun t -> t.global)
120 |> finish)
121
122(** Get all push rules. *)
123let get_push_rules client =
124 match Client.get client ~path:"/pushrules/" () with
125 | Error e -> Error e
126 | Ok body -> Client.decode_response push_rules_response_jsont body
127
128(** Get a specific push rule. *)
129let get_push_rule client ~scope ~kind ~rule_id =
130 let kind_str = rule_kind_to_string kind in
131 let path = Printf.sprintf "/pushrules/%s/%s/%s"
132 (Uri.pct_encode scope)
133 (Uri.pct_encode kind_str)
134 (Uri.pct_encode rule_id)
135 in
136 match Client.get client ~path () with
137 | Error e -> Error e
138 | Ok body -> Client.decode_response rule_jsont body
139
140(** Delete a push rule. *)
141let delete_push_rule client ~scope ~kind ~rule_id =
142 let kind_str = rule_kind_to_string kind in
143 let path = Printf.sprintf "/pushrules/%s/%s/%s"
144 (Uri.pct_encode scope)
145 (Uri.pct_encode kind_str)
146 (Uri.pct_encode rule_id)
147 in
148 match Client.delete client ~path () with
149 | Error e -> Error e
150 | Ok _ -> Ok ()
151
152(** Add or update a push rule. *)
153type add_rule_request = {
154 actions : action list;
155 conditions : condition list option;
156 pattern : string option;
157} [@@warning "-69"]
158
159let add_rule_request_jsont =
160 Jsont.Object.(
161 map (fun actions conditions pattern ->
162 { actions; conditions; pattern })
163 |> mem "actions" (Jsont.list action_jsont) ~enc:(fun t -> t.actions)
164 |> opt_mem "conditions" (Jsont.list condition_jsont) ~enc:(fun t -> t.conditions)
165 |> opt_mem "pattern" Jsont.string ~enc:(fun t -> t.pattern)
166 |> finish)
167
168let set_push_rule client ~scope ~kind ~rule_id
169 ~actions ?conditions ?pattern ?before ?after () =
170 let kind_str = rule_kind_to_string kind in
171 let path = Printf.sprintf "/pushrules/%s/%s/%s"
172 (Uri.pct_encode scope)
173 (Uri.pct_encode kind_str)
174 (Uri.pct_encode rule_id)
175 in
176 let query =
177 []
178 |> (fun q -> match before with Some b -> ("before", b) :: q | None -> q)
179 |> (fun q -> match after with Some a -> ("after", a) :: q | None -> q)
180 in
181 let query = if query = [] then None else Some query in
182 let request = { actions; conditions; pattern } in
183 match Client.encode_body add_rule_request_jsont request with
184 | Error e -> Error e
185 | Ok body ->
186 match Client.put client ~path ~body ?query () with
187 | Error e -> Error e
188 | Ok _ -> Ok ()
189
190(** Enable or disable a push rule. *)
191type enabled_request = {
192 enabled : bool;
193} [@@warning "-69"]
194
195let enabled_request_jsont =
196 Jsont.Object.(
197 map (fun enabled -> { enabled })
198 |> mem "enabled" Jsont.bool ~enc:(fun t -> t.enabled)
199 |> finish)
200
201let set_push_rule_enabled client ~scope ~kind ~rule_id ~enabled =
202 let kind_str = rule_kind_to_string kind in
203 let path = Printf.sprintf "/pushrules/%s/%s/%s/enabled"
204 (Uri.pct_encode scope)
205 (Uri.pct_encode kind_str)
206 (Uri.pct_encode rule_id)
207 in
208 let request = { enabled } in
209 match Client.encode_body enabled_request_jsont request with
210 | Error e -> Error e
211 | Ok body ->
212 match Client.put client ~path ~body () with
213 | Error e -> Error e
214 | Ok _ -> Ok ()
215
216(** Set the actions for a push rule. *)
217type actions_request = {
218 actions : action list;
219} [@@warning "-69"]
220
221let actions_request_jsont =
222 Jsont.Object.(
223 map (fun actions -> { actions })
224 |> mem "actions" (Jsont.list action_jsont) ~enc:(fun t -> t.actions)
225 |> finish)
226
227let set_push_rule_actions client ~scope ~kind ~rule_id ~actions =
228 let kind_str = rule_kind_to_string kind in
229 let path = Printf.sprintf "/pushrules/%s/%s/%s/actions"
230 (Uri.pct_encode scope)
231 (Uri.pct_encode kind_str)
232 (Uri.pct_encode rule_id)
233 in
234 let request = { actions } in
235 match Client.encode_body actions_request_jsont request with
236 | Error e -> Error e
237 | Ok body ->
238 match Client.put client ~path ~body () with
239 | Error e -> Error e
240 | Ok _ -> Ok ()
241
242(** Pusher types *)
243type pusher_kind =
244 | Http
245 | Email
246
247let pusher_kind_to_string = function
248 | Http -> "http"
249 | Email -> "email"
250
251let pusher_kind_of_string = function
252 | "http" -> Ok Http
253 | "email" -> Ok Email
254 | s -> Error ("Unknown pusher kind: " ^ s)
255
256let pusher_kind_jsont =
257 Jsont.of_of_string ~kind:"pusher_kind"
258 ~enc:pusher_kind_to_string
259 pusher_kind_of_string
260
261type pusher_data = {
262 url : string option;
263 format : string option;
264}
265
266let pusher_data_jsont =
267 Jsont.Object.(
268 map (fun url format -> { url; format })
269 |> opt_mem "url" Jsont.string ~enc:(fun t -> t.url)
270 |> opt_mem "format" Jsont.string ~enc:(fun t -> t.format)
271 |> finish)
272
273type pusher = {
274 pushkey : string;
275 kind : pusher_kind;
276 app_id : string;
277 app_display_name : string;
278 device_display_name : string;
279 profile_tag : string option;
280 lang : string;
281 data : pusher_data;
282}
283
284let pusher_jsont =
285 Jsont.Object.(
286 map (fun pushkey kind app_id app_display_name device_display_name
287 profile_tag lang data ->
288 { pushkey; kind; app_id; app_display_name; device_display_name;
289 profile_tag; lang; data })
290 |> mem "pushkey" Jsont.string ~enc:(fun t -> t.pushkey)
291 |> mem "kind" pusher_kind_jsont ~enc:(fun t -> t.kind)
292 |> mem "app_id" Jsont.string ~enc:(fun t -> t.app_id)
293 |> mem "app_display_name" Jsont.string ~enc:(fun t -> t.app_display_name)
294 |> mem "device_display_name" Jsont.string ~enc:(fun t -> t.device_display_name)
295 |> opt_mem "profile_tag" Jsont.string ~enc:(fun t -> t.profile_tag)
296 |> mem "lang" Jsont.string ~enc:(fun t -> t.lang)
297 |> mem "data" pusher_data_jsont ~enc:(fun t -> t.data)
298 |> finish)
299
300type pushers_response = {
301 pushers : pusher list;
302}
303
304let pushers_response_jsont =
305 Jsont.Object.(
306 map (fun pushers -> { pushers })
307 |> mem "pushers" (Jsont.list pusher_jsont) ~dec_absent:[] ~enc:(fun t -> t.pushers)
308 |> finish)
309
310(** Get all pushers for the current user. *)
311let get_pushers client =
312 match Client.get client ~path:"/pushers" () with
313 | Error e -> Error e
314 | Ok body ->
315 match Client.decode_response pushers_response_jsont body with
316 | Error e -> Error e
317 | Ok resp -> Ok resp.pushers
318
319(** Set a pusher. *)
320type set_pusher_request = {
321 pushkey : string;
322 kind : pusher_kind;
323 app_id : string;
324 app_display_name : string;
325 device_display_name : string;
326 profile_tag : string option;
327 lang : string;
328 data : pusher_data;
329 append : bool option;
330} [@@warning "-69"]
331
332let set_pusher_request_jsont =
333 Jsont.Object.(
334 map (fun pushkey kind app_id app_display_name device_display_name
335 profile_tag lang data append ->
336 { pushkey; kind; app_id; app_display_name; device_display_name;
337 profile_tag; lang; data; append })
338 |> mem "pushkey" Jsont.string
339 |> mem "kind" pusher_kind_jsont
340 |> mem "app_id" Jsont.string
341 |> mem "app_display_name" Jsont.string
342 |> mem "device_display_name" Jsont.string
343 |> opt_mem "profile_tag" Jsont.string ~enc:(fun t -> t.profile_tag)
344 |> mem "lang" Jsont.string
345 |> mem "data" pusher_data_jsont
346 |> opt_mem "append" Jsont.bool ~enc:(fun t -> t.append)
347 |> finish)
348
349let set_pusher client ~pushkey ~kind ~app_id ~app_display_name
350 ~device_display_name ?profile_tag ~lang ~data ?append () =
351 let request = {
352 pushkey; kind; app_id; app_display_name; device_display_name;
353 profile_tag; lang; data; append
354 } in
355 match Client.encode_body set_pusher_request_jsont request with
356 | Error e -> Error e
357 | Ok body ->
358 match Client.post client ~path:"/pushers/set" ~body () with
359 | Error e -> Error e
360 | Ok _ -> Ok ()
361
362(** Delete a pusher by setting kind to null. *)
363let delete_pusher client ~pushkey ~app_id =
364 (* Use raw json for the special null kind *)
365 let body = Printf.sprintf {|{"pushkey":"%s","kind":null,"app_id":"%s"}|} pushkey app_id in
366 match Client.post client ~path:"/pushers/set" ~body () with
367 | Error e -> Error e
368 | Ok _ -> Ok ()