anil.recoil.org
Zulip bots with Eio
fill
+831
-2
+1
-2
lib/zulip/dune
+1
-2
lib/zulip/dune
+7
lib/zulip/encode.ml
+7
lib/zulip/encode.ml
···
54
54
| Error e -> failwith ("Failed to re-encode json: " ^ Jsont.Error.to_string e)
55
55
in
56
56
from_json_string codec json_str
57
+
58
+
(** Convert a value to Jsont.json using a codec *)
59
+
let to_json : 'a Jsont.t -> 'a -> (Jsont.json, string) result = fun codec value ->
60
+
let json_str = to_json_string codec value in
61
+
match Jsont_bytesrw.decode_string' Jsont.json json_str with
62
+
| Ok json -> Ok json
63
+
| Error e -> Error (Jsont.Error.to_string e)
+3
lib/zulip/encode.mli
+3
lib/zulip/encode.mli
+175
lib/zulip/presence.ml
+175
lib/zulip/presence.ml
···
1
+
type status = Active | Idle | Offline
2
+
3
+
type client_presence = {
4
+
status : status;
5
+
timestamp : float;
6
+
client : string;
7
+
pushable : bool;
8
+
}
9
+
10
+
type user_presence = {
11
+
aggregated : client_presence option;
12
+
clients : (string * client_presence) list;
13
+
}
14
+
15
+
let status_to_string = function
16
+
| Active -> "active"
17
+
| Idle -> "idle"
18
+
| Offline -> "offline"
19
+
20
+
let status_of_string = function
21
+
| "active" -> Some Active
22
+
| "idle" -> Some Idle
23
+
| "offline" -> Some Offline
24
+
| _ -> None
25
+
26
+
let pp_status fmt s = Format.fprintf fmt "%s" (status_to_string s)
27
+
28
+
let pp_user_presence fmt p =
29
+
let agg =
30
+
Option.fold ~none:"none"
31
+
~some:(fun c -> Printf.sprintf "%s" (status_to_string c.status))
32
+
p.aggregated
33
+
in
34
+
Format.fprintf fmt "UserPresence{aggregated=%s, clients=%d}" agg
35
+
(List.length p.clients)
36
+
37
+
let status_jsont =
38
+
let of_string s =
39
+
match status_of_string s with
40
+
| Some s -> Ok s
41
+
| None -> Error (Printf.sprintf "Unknown status: %s" s)
42
+
in
43
+
Jsont.of_of_string ~kind:"Presence.status" of_string ~enc:status_to_string
44
+
45
+
let client_presence_jsont =
46
+
Jsont.Object.(
47
+
map ~kind:"ClientPresence"
48
+
(fun status timestamp client pushable ->
49
+
{ status; timestamp; client; pushable })
50
+
|> mem "status" status_jsont ~enc:(fun p -> p.status)
51
+
|> mem "timestamp" Jsont.number ~enc:(fun p -> p.timestamp)
52
+
|> mem "client" Jsont.string ~dec_absent:"" ~enc:(fun p -> p.client)
53
+
|> mem "pushable" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.pushable)
54
+
|> finish)
55
+
56
+
let parse_user_presence_from_json json =
57
+
match json with
58
+
| Jsont.Object (fields, _) ->
59
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
60
+
let aggregated =
61
+
match List.assoc_opt "aggregated" assoc with
62
+
| Some agg_json -> Encode.from_json client_presence_jsont agg_json |> Result.to_option
63
+
| None -> None
64
+
in
65
+
let clients =
66
+
List.filter_map
67
+
(fun (name, json) ->
68
+
if name = "aggregated" then None
69
+
else
70
+
match Encode.from_json client_presence_jsont json with
71
+
| Ok cp -> Some (name, cp)
72
+
| Error _ -> None)
73
+
assoc
74
+
in
75
+
{ aggregated; clients }
76
+
| _ -> { aggregated = None; clients = [] }
77
+
78
+
let user_presence_jsont =
79
+
Jsont.map ~kind:"UserPresence" Jsont.json
80
+
~dec:parse_user_presence_from_json
81
+
~enc:(fun p ->
82
+
let agg_field =
83
+
match p.aggregated with
84
+
| Some agg -> (
85
+
match Encode.to_json client_presence_jsont agg with
86
+
| Ok json -> [ (("aggregated", Jsont.Meta.none), json) ]
87
+
| Error _ -> [])
88
+
| None -> []
89
+
in
90
+
let client_fields =
91
+
List.filter_map
92
+
(fun (name, cp) ->
93
+
match Encode.to_json client_presence_jsont cp with
94
+
| Ok json -> Some ((name, Jsont.Meta.none), json)
95
+
| Error _ -> None)
96
+
p.clients
97
+
in
98
+
Jsont.Object (agg_field @ client_fields, Jsont.Meta.none))
99
+
100
+
let parse_presence_response json =
101
+
match json with
102
+
| Jsont.Object (fields, _) -> (
103
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
104
+
match List.assoc_opt "presence" assoc with
105
+
| Some pres -> (
106
+
match Encode.from_json user_presence_jsont pres with
107
+
| Ok p -> p
108
+
| Error msg ->
109
+
Error.raise_with_context
110
+
(Error.make ~code:(Other "json_parse") ~message:msg ())
111
+
"parsing presence")
112
+
| None ->
113
+
Error.raise_with_context
114
+
(Error.make ~code:(Other "missing_field")
115
+
~message:"Missing presence field" ())
116
+
"parsing presence response")
117
+
| _ ->
118
+
Error.raise_with_context
119
+
(Error.make ~code:(Other "json_parse")
120
+
~message:"Expected JSON object for presence" ())
121
+
"parsing presence response"
122
+
123
+
let get_user client ~user_id =
124
+
let json =
125
+
Client.request client ~method_:`GET
126
+
~path:("/api/v1/users/" ^ string_of_int user_id ^ "/presence")
127
+
()
128
+
in
129
+
parse_presence_response json
130
+
131
+
let get_user_by_email client ~email =
132
+
let json =
133
+
Client.request client ~method_:`GET
134
+
~path:("/api/v1/users/" ^ email ^ "/presence")
135
+
()
136
+
in
137
+
parse_presence_response json
138
+
139
+
let get_all client =
140
+
let json =
141
+
Client.request client ~method_:`GET ~path:"/api/v1/realm/presence" ()
142
+
in
143
+
match json with
144
+
| Jsont.Object (fields, _) -> (
145
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
146
+
match List.assoc_opt "presences" assoc with
147
+
| Some (Jsont.Object (pres_fields, _)) ->
148
+
List.filter_map
149
+
(fun ((user_id_str, _), pres_json) ->
150
+
match int_of_string_opt user_id_str with
151
+
| Some user_id -> (
152
+
match Encode.from_json user_presence_jsont pres_json with
153
+
| Ok p -> Some (user_id, p)
154
+
| Error _ -> None)
155
+
| None -> None)
156
+
pres_fields
157
+
| _ -> [])
158
+
| _ -> []
159
+
160
+
let update client ~status ?ping_only ?new_user_input () =
161
+
let params =
162
+
[ ("status", status_to_string status) ]
163
+
@ List.filter_map Fun.id
164
+
[
165
+
Option.map (fun v -> ("ping_only", string_of_bool v)) ping_only;
166
+
Option.map
167
+
(fun v -> ("new_user_input", string_of_bool v))
168
+
new_user_input;
169
+
]
170
+
in
171
+
let _response =
172
+
Client.request client ~method_:`POST ~path:"/api/v1/users/me/presence"
173
+
~params ()
174
+
in
175
+
()
+406
lib/zulip/server.ml
+406
lib/zulip/server.ml
···
1
+
type authentication_method = {
2
+
password : bool;
3
+
dev : bool;
4
+
email : bool;
5
+
ldap : bool;
6
+
remoteuser : bool;
7
+
github : bool;
8
+
azuread : bool;
9
+
gitlab : bool;
10
+
apple : bool;
11
+
google : bool;
12
+
saml : bool;
13
+
openid_connect : bool;
14
+
}
15
+
16
+
type emoji = {
17
+
id : string;
18
+
name : string;
19
+
source_url : string;
20
+
deactivated : bool;
21
+
author_id : int option;
22
+
}
23
+
24
+
(* Define types with conflicting fields after types they might conflict with *)
25
+
type external_authentication_method = {
26
+
name : string;
27
+
display_name : string;
28
+
display_icon : string option;
29
+
login_url : string;
30
+
signup_url : string;
31
+
}
32
+
33
+
type linkifier = { id : int; pattern : string; url_template : string }
34
+
35
+
type t = {
36
+
zulip_version : string;
37
+
zulip_feature_level : int;
38
+
zulip_merge_base : string option;
39
+
push_notifications_enabled : bool;
40
+
is_incompatible : bool;
41
+
email_auth_enabled : bool;
42
+
require_email_format_usernames : bool;
43
+
realm_uri : string;
44
+
realm_name : string;
45
+
realm_icon : string;
46
+
realm_description : string;
47
+
realm_web_public_access_enabled : bool;
48
+
authentication_methods : authentication_method;
49
+
external_authentication_methods : external_authentication_method list;
50
+
}
51
+
52
+
(* Codecs for authentication methods *)
53
+
let authentication_method_jsont =
54
+
Jsont.Object.(
55
+
map ~kind:"AuthenticationMethod"
56
+
(fun password dev email ldap remoteuser github azuread gitlab apple
57
+
google saml openid_connect ->
58
+
{
59
+
password;
60
+
dev;
61
+
email;
62
+
ldap;
63
+
remoteuser;
64
+
github;
65
+
azuread;
66
+
gitlab;
67
+
apple;
68
+
google;
69
+
saml;
70
+
openid_connect;
71
+
})
72
+
|> mem "Password" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.password)
73
+
|> mem "Dev" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.dev)
74
+
|> mem "Email" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.email)
75
+
|> mem "LDAP" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.ldap)
76
+
|> mem "RemoteUser" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.remoteuser)
77
+
|> mem "GitHub" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.github)
78
+
|> mem "AzureAD" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.azuread)
79
+
|> mem "GitLab" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.gitlab)
80
+
|> mem "Apple" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.apple)
81
+
|> mem "Google" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.google)
82
+
|> mem "SAML" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.saml)
83
+
|> mem "OpenID Connect" Jsont.bool ~dec_absent:false ~enc:(fun a ->
84
+
a.openid_connect)
85
+
|> finish)
86
+
87
+
let external_authentication_method_jsont =
88
+
Jsont.Object.(
89
+
map ~kind:"ExternalAuthenticationMethod"
90
+
(fun name display_name display_icon login_url signup_url ->
91
+
{ name; display_name; display_icon; login_url; signup_url })
92
+
|> mem "name" Jsont.string ~enc:(fun e -> e.name)
93
+
|> mem "display_name" Jsont.string ~enc:(fun e -> e.display_name)
94
+
|> opt_mem "display_icon" Jsont.string ~enc:(fun e -> e.display_icon)
95
+
|> mem "login_url" Jsont.string ~enc:(fun e -> e.login_url)
96
+
|> mem "signup_url" Jsont.string ~enc:(fun e -> e.signup_url)
97
+
|> finish)
98
+
99
+
let jsont =
100
+
Jsont.Object.(
101
+
map ~kind:"ServerSettings"
102
+
(fun zulip_version zulip_feature_level zulip_merge_base
103
+
push_notifications_enabled is_incompatible email_auth_enabled
104
+
require_email_format_usernames realm_uri realm_name realm_icon
105
+
realm_description realm_web_public_access_enabled
106
+
authentication_methods external_authentication_methods ->
107
+
{
108
+
zulip_version;
109
+
zulip_feature_level;
110
+
zulip_merge_base;
111
+
push_notifications_enabled;
112
+
is_incompatible;
113
+
email_auth_enabled;
114
+
require_email_format_usernames;
115
+
realm_uri;
116
+
realm_name;
117
+
realm_icon;
118
+
realm_description;
119
+
realm_web_public_access_enabled;
120
+
authentication_methods;
121
+
external_authentication_methods;
122
+
})
123
+
|> mem "zulip_version" Jsont.string ~enc:(fun s -> s.zulip_version)
124
+
|> mem "zulip_feature_level" Jsont.int ~enc:(fun s -> s.zulip_feature_level)
125
+
|> opt_mem "zulip_merge_base" Jsont.string ~enc:(fun s -> s.zulip_merge_base)
126
+
|> mem "push_notifications_enabled" Jsont.bool ~dec_absent:false
127
+
~enc:(fun s -> s.push_notifications_enabled)
128
+
|> mem "is_incompatible" Jsont.bool ~dec_absent:false ~enc:(fun s ->
129
+
s.is_incompatible)
130
+
|> mem "email_auth_enabled" Jsont.bool ~dec_absent:true ~enc:(fun s ->
131
+
s.email_auth_enabled)
132
+
|> mem "require_email_format_usernames" Jsont.bool ~dec_absent:true
133
+
~enc:(fun s -> s.require_email_format_usernames)
134
+
|> mem "realm_uri" Jsont.string ~enc:(fun s -> s.realm_uri)
135
+
|> mem "realm_name" Jsont.string ~dec_absent:"" ~enc:(fun s -> s.realm_name)
136
+
|> mem "realm_icon" Jsont.string ~dec_absent:"" ~enc:(fun s -> s.realm_icon)
137
+
|> mem "realm_description" Jsont.string ~dec_absent:"" ~enc:(fun s ->
138
+
s.realm_description)
139
+
|> mem "realm_web_public_access_enabled" Jsont.bool ~dec_absent:false
140
+
~enc:(fun s -> s.realm_web_public_access_enabled)
141
+
|> mem "authentication_methods" authentication_method_jsont ~enc:(fun s ->
142
+
s.authentication_methods)
143
+
|> mem "external_authentication_methods"
144
+
(Jsont.list external_authentication_method_jsont)
145
+
~dec_absent:[]
146
+
~enc:(fun s -> s.external_authentication_methods)
147
+
|> finish)
148
+
149
+
let get_settings_json client =
150
+
Client.request client ~method_:`GET ~path:"/api/v1/server_settings" ()
151
+
152
+
let get_settings client =
153
+
let json = get_settings_json client in
154
+
Error.decode_or_raise jsont json "parsing server settings"
155
+
156
+
let feature_level client =
157
+
let settings = get_settings client in
158
+
settings.zulip_feature_level
159
+
160
+
let supports_feature client ~level = feature_level client >= level
161
+
162
+
(* Linkifier codec *)
163
+
let linkifier_jsont =
164
+
Jsont.Object.(
165
+
map ~kind:"Linkifier" (fun id pattern url_template ->
166
+
{ id; pattern; url_template })
167
+
|> mem "id" Jsont.int ~enc:(fun l -> l.id)
168
+
|> mem "pattern" Jsont.string ~enc:(fun l -> l.pattern)
169
+
|> mem "url_template" Jsont.string ~enc:(fun l -> l.url_template)
170
+
|> finish)
171
+
172
+
let get_linkifiers client =
173
+
let response_codec =
174
+
Jsont.Object.(
175
+
map ~kind:"LinkifiersResponse" Fun.id
176
+
|> mem "linkifiers" (Jsont.list linkifier_jsont) ~enc:Fun.id
177
+
|> finish)
178
+
in
179
+
let json =
180
+
Client.request client ~method_:`GET ~path:"/api/v1/realm/linkifiers" ()
181
+
in
182
+
Error.decode_or_raise response_codec json "getting linkifiers"
183
+
184
+
let add_linkifier client ~pattern ~url_template =
185
+
let params = [ ("pattern", pattern); ("url_template", url_template) ] in
186
+
let response_codec =
187
+
Jsont.Object.(
188
+
map ~kind:"AddLinkifierResponse" Fun.id
189
+
|> mem "id" Jsont.int ~enc:Fun.id
190
+
|> finish)
191
+
in
192
+
let json =
193
+
Client.request client ~method_:`POST ~path:"/api/v1/realm/filters" ~params
194
+
()
195
+
in
196
+
Error.decode_or_raise response_codec json "adding linkifier"
197
+
198
+
let update_linkifier client ~filter_id ~pattern ~url_template =
199
+
let params = [ ("pattern", pattern); ("url_template", url_template) ] in
200
+
let _response =
201
+
Client.request client ~method_:`PATCH
202
+
~path:("/api/v1/realm/filters/" ^ string_of_int filter_id)
203
+
~params ()
204
+
in
205
+
()
206
+
207
+
let delete_linkifier client ~filter_id =
208
+
let _response =
209
+
Client.request client ~method_:`DELETE
210
+
~path:("/api/v1/realm/filters/" ^ string_of_int filter_id)
211
+
()
212
+
in
213
+
()
214
+
215
+
(* Emoji codec *)
216
+
let emoji_jsont : emoji Jsont.t =
217
+
Jsont.Object.(
218
+
map ~kind:"Emoji" (fun id name source_url deactivated author_id : emoji ->
219
+
{ id; name; source_url; deactivated; author_id })
220
+
|> mem "id" Jsont.string ~enc:(fun (e : emoji) -> e.id)
221
+
|> mem "name" Jsont.string ~enc:(fun (e : emoji) -> e.name)
222
+
|> mem "source_url" Jsont.string ~enc:(fun (e : emoji) -> e.source_url)
223
+
|> mem "deactivated" Jsont.bool ~dec_absent:false ~enc:(fun (e : emoji) ->
224
+
e.deactivated)
225
+
|> opt_mem "author_id" Jsont.int ~enc:(fun (e : emoji) -> e.author_id)
226
+
|> finish)
227
+
228
+
let get_emoji client =
229
+
let json =
230
+
Client.request client ~method_:`GET ~path:"/api/v1/realm/emoji" ()
231
+
in
232
+
match json with
233
+
| Jsont.Object (fields, _) -> (
234
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
235
+
match List.assoc_opt "emoji" assoc with
236
+
| Some (Jsont.Object (emoji_fields, _)) ->
237
+
List.filter_map
238
+
(fun ((name, _), emoji_json) ->
239
+
(* Add name to the emoji JSON before parsing *)
240
+
let emoji_with_name =
241
+
match emoji_json with
242
+
| Jsont.Object (e_fields, meta) ->
243
+
let name_field = (("name", Jsont.Meta.none), Jsont.String (name, Jsont.Meta.none)) in
244
+
Jsont.Object (name_field :: e_fields, meta)
245
+
| _ -> emoji_json
246
+
in
247
+
match Encode.from_json emoji_jsont emoji_with_name with
248
+
| Ok e -> Some e
249
+
| Error _ -> None)
250
+
emoji_fields
251
+
| _ -> [])
252
+
| _ -> []
253
+
254
+
let upload_emoji _client ~name:_ ~filename:_ =
255
+
(* TODO: Implement file upload using multipart/form-data *)
256
+
Error.raise
257
+
(Error.make ~code:(Other "not_implemented")
258
+
~message:"Emoji upload not yet implemented" ())
259
+
260
+
let deactivate_emoji client ~name =
261
+
let _response =
262
+
Client.request client ~method_:`DELETE
263
+
~path:("/api/v1/realm/emoji/" ^ name)
264
+
()
265
+
in
266
+
()
267
+
268
+
type profile_field_type =
269
+
| Short_text
270
+
| Long_text
271
+
| Choice
272
+
| Date
273
+
| Link
274
+
| User
275
+
| External_account
276
+
| Pronouns
277
+
278
+
type profile_field = {
279
+
id : int;
280
+
field_type : profile_field_type;
281
+
order : int;
282
+
name : string;
283
+
hint : string;
284
+
field_data : Jsont.json;
285
+
display_in_profile_summary : bool option;
286
+
}
287
+
288
+
(* Profile field type codec *)
289
+
let profile_field_type_to_int = function
290
+
| Short_text -> 1
291
+
| Long_text -> 2
292
+
| Choice -> 3
293
+
| Date -> 4
294
+
| Link -> 5
295
+
| User -> 6
296
+
| External_account -> 7
297
+
| Pronouns -> 8
298
+
299
+
let profile_field_type_of_int = function
300
+
| 1 -> Some Short_text
301
+
| 2 -> Some Long_text
302
+
| 3 -> Some Choice
303
+
| 4 -> Some Date
304
+
| 5 -> Some Link
305
+
| 6 -> Some User
306
+
| 7 -> Some External_account
307
+
| 8 -> Some Pronouns
308
+
| _ -> None
309
+
310
+
let profile_field_type_jsont =
311
+
Jsont.map ~kind:"ProfileFieldType" Jsont.int
312
+
~dec:(fun i ->
313
+
match profile_field_type_of_int i with
314
+
| Some t -> t
315
+
| None -> Short_text)
316
+
~enc:profile_field_type_to_int
317
+
318
+
let profile_field_jsont =
319
+
Jsont.Object.(
320
+
map ~kind:"ProfileField"
321
+
(fun id field_type order name hint field_data display_in_profile_summary ->
322
+
{ id; field_type; order; name; hint; field_data; display_in_profile_summary })
323
+
|> mem "id" Jsont.int ~enc:(fun p -> p.id)
324
+
|> mem "type" profile_field_type_jsont ~enc:(fun p -> p.field_type)
325
+
|> mem "order" Jsont.int ~enc:(fun p -> p.order)
326
+
|> mem "name" Jsont.string ~enc:(fun p -> p.name)
327
+
|> mem "hint" Jsont.string ~dec_absent:"" ~enc:(fun p -> p.hint)
328
+
|> mem "field_data" Jsont.json ~dec_absent:(Jsont.Null ((), Jsont.Meta.none)) ~enc:(fun p ->
329
+
p.field_data)
330
+
|> opt_mem "display_in_profile_summary" Jsont.bool ~enc:(fun p ->
331
+
p.display_in_profile_summary)
332
+
|> finish)
333
+
334
+
let get_profile_fields client =
335
+
let response_codec =
336
+
Jsont.Object.(
337
+
map ~kind:"ProfileFieldsResponse" Fun.id
338
+
|> mem "custom_profile_fields" (Jsont.list profile_field_jsont) ~enc:Fun.id
339
+
|> finish)
340
+
in
341
+
let json =
342
+
Client.request client ~method_:`GET ~path:"/api/v1/realm/profile_fields" ()
343
+
in
344
+
Error.decode_or_raise response_codec json "getting profile fields"
345
+
346
+
let create_profile_field client ~field_type ~name ?hint ?field_data () =
347
+
let params =
348
+
[
349
+
("field_type", string_of_int (profile_field_type_to_int field_type));
350
+
("name", name);
351
+
]
352
+
@ List.filter_map Fun.id
353
+
[
354
+
Option.map (fun h -> ("hint", h)) hint;
355
+
Option.map
356
+
(fun d -> ("field_data", Encode.to_json_string Jsont.json d))
357
+
field_data;
358
+
]
359
+
in
360
+
let response_codec =
361
+
Jsont.Object.(
362
+
map ~kind:"CreateProfileFieldResponse" Fun.id
363
+
|> mem "id" Jsont.int ~enc:Fun.id
364
+
|> finish)
365
+
in
366
+
let json =
367
+
Client.request client ~method_:`POST ~path:"/api/v1/realm/profile_fields"
368
+
~params ()
369
+
in
370
+
Error.decode_or_raise response_codec json "creating profile field"
371
+
372
+
let update_profile_field client ~field_id ?name ?hint ?field_data () =
373
+
let params =
374
+
List.filter_map Fun.id
375
+
[
376
+
Option.map (fun n -> ("name", n)) name;
377
+
Option.map (fun h -> ("hint", h)) hint;
378
+
Option.map
379
+
(fun d -> ("field_data", Encode.to_json_string Jsont.json d))
380
+
field_data;
381
+
]
382
+
in
383
+
let _response =
384
+
Client.request client ~method_:`PATCH
385
+
~path:("/api/v1/realm/profile_fields/" ^ string_of_int field_id)
386
+
~params ()
387
+
in
388
+
()
389
+
390
+
let delete_profile_field client ~field_id =
391
+
let _response =
392
+
Client.request client ~method_:`DELETE
393
+
~path:("/api/v1/realm/profile_fields/" ^ string_of_int field_id)
394
+
()
395
+
in
396
+
()
397
+
398
+
let reorder_profile_fields client ~order =
399
+
let params =
400
+
[ ("order", Encode.to_json_string (Jsont.list Jsont.int) order) ]
401
+
in
402
+
let _response =
403
+
Client.request client ~method_:`PATCH ~path:"/api/v1/realm/profile_fields"
404
+
~params ()
405
+
in
406
+
()
+35
lib/zulip/typing.ml
+35
lib/zulip/typing.ml
···
1
+
type op = Start | Stop
2
+
3
+
let op_to_string = function Start -> "start" | Stop -> "stop"
4
+
5
+
let set_dm client ~op ~user_ids =
6
+
let params =
7
+
[
8
+
("op", op_to_string op);
9
+
("type", "direct");
10
+
("to", Encode.to_json_string (Jsont.list Jsont.int) user_ids);
11
+
]
12
+
in
13
+
let _response =
14
+
Client.request client ~method_:`POST ~path:"/api/v1/typing" ~params ()
15
+
in
16
+
()
17
+
18
+
let set_channel client ~op ~stream_id ~topic =
19
+
let params =
20
+
[
21
+
("op", op_to_string op);
22
+
("type", "stream");
23
+
("stream_id", string_of_int stream_id);
24
+
("topic", topic);
25
+
]
26
+
in
27
+
let _response =
28
+
Client.request client ~method_:`POST ~path:"/api/v1/typing" ~params ()
29
+
in
30
+
()
31
+
32
+
let set client ~op ~to_ =
33
+
match to_ with
34
+
| `User_ids user_ids -> set_dm client ~op ~user_ids
35
+
| `Stream (stream_id, topic) -> set_channel client ~op ~stream_id ~topic
+204
lib/zulip/user_group.ml
+204
lib/zulip/user_group.ml
···
1
+
type t = {
2
+
id : int;
3
+
name : string;
4
+
description : string;
5
+
members : int list;
6
+
direct_subgroup_ids : int list;
7
+
is_system_group : bool;
8
+
can_mention_group : int;
9
+
}
10
+
11
+
let pp fmt g =
12
+
Format.fprintf fmt "UserGroup{id=%d, name=%s, members=%d}" g.id g.name
13
+
(List.length g.members)
14
+
15
+
let jsont =
16
+
Jsont.Object.(
17
+
map ~kind:"UserGroup"
18
+
(fun id name description members direct_subgroup_ids is_system_group
19
+
can_mention_group ->
20
+
{
21
+
id;
22
+
name;
23
+
description;
24
+
members;
25
+
direct_subgroup_ids;
26
+
is_system_group;
27
+
can_mention_group;
28
+
})
29
+
|> mem "id" Jsont.int ~enc:(fun g -> g.id)
30
+
|> mem "name" Jsont.string ~enc:(fun g -> g.name)
31
+
|> mem "description" Jsont.string ~enc:(fun g -> g.description)
32
+
|> mem "members" (Jsont.list Jsont.int) ~dec_absent:[] ~enc:(fun g ->
33
+
g.members)
34
+
|> mem "direct_subgroup_ids" (Jsont.list Jsont.int) ~dec_absent:[]
35
+
~enc:(fun g -> g.direct_subgroup_ids)
36
+
|> mem "is_system_group" Jsont.bool ~dec_absent:false ~enc:(fun g ->
37
+
g.is_system_group)
38
+
|> mem "can_mention_group" Jsont.int ~dec_absent:0 ~enc:(fun g ->
39
+
g.can_mention_group)
40
+
|> finish)
41
+
42
+
let list client =
43
+
let response_codec =
44
+
Jsont.Object.(
45
+
map ~kind:"UserGroupsResponse" Fun.id
46
+
|> mem "user_groups" (Jsont.list jsont) ~enc:Fun.id
47
+
|> finish)
48
+
in
49
+
let json =
50
+
Client.request client ~method_:`GET ~path:"/api/v1/user_groups" ()
51
+
in
52
+
Error.decode_or_raise response_codec json "getting user groups"
53
+
54
+
let create client ~name ~description ~members ?can_mention_group () =
55
+
let params =
56
+
[
57
+
("name", name);
58
+
("description", description);
59
+
("members", Encode.to_json_string (Jsont.list Jsont.int) members);
60
+
]
61
+
@ List.filter_map Fun.id
62
+
[
63
+
Option.map
64
+
(fun g -> ("can_mention_group", string_of_int g))
65
+
can_mention_group;
66
+
]
67
+
in
68
+
let response_codec =
69
+
Jsont.Object.(
70
+
map ~kind:"CreateUserGroupResponse" Fun.id
71
+
|> mem "id" Jsont.int ~enc:Fun.id
72
+
|> finish)
73
+
in
74
+
let json =
75
+
Client.request client ~method_:`POST ~path:"/api/v1/user_groups/create"
76
+
~params ()
77
+
in
78
+
Error.decode_or_raise response_codec json "creating user group"
79
+
80
+
let update client ~group_id ?name ?description ?can_mention_group () =
81
+
let params =
82
+
List.filter_map Fun.id
83
+
[
84
+
Option.map (fun n -> ("name", n)) name;
85
+
Option.map (fun d -> ("description", d)) description;
86
+
Option.map
87
+
(fun g -> ("can_mention_group", string_of_int g))
88
+
can_mention_group;
89
+
]
90
+
in
91
+
let _response =
92
+
Client.request client ~method_:`PATCH
93
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id)
94
+
~params ()
95
+
in
96
+
()
97
+
98
+
let update_members client ~group_id ?add ?remove () =
99
+
let params =
100
+
List.filter_map Fun.id
101
+
[
102
+
Option.map
103
+
(fun ids -> ("add", Encode.to_json_string (Jsont.list Jsont.int) ids))
104
+
add;
105
+
Option.map
106
+
(fun ids ->
107
+
("delete", Encode.to_json_string (Jsont.list Jsont.int) ids))
108
+
remove;
109
+
]
110
+
in
111
+
let _response =
112
+
Client.request client ~method_:`POST
113
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id ^ "/members")
114
+
~params ()
115
+
in
116
+
()
117
+
118
+
let update_subgroups client ~group_id ?add ?remove () =
119
+
let params =
120
+
List.filter_map Fun.id
121
+
[
122
+
Option.map
123
+
(fun ids -> ("add", Encode.to_json_string (Jsont.list Jsont.int) ids))
124
+
add;
125
+
Option.map
126
+
(fun ids ->
127
+
("delete", Encode.to_json_string (Jsont.list Jsont.int) ids))
128
+
remove;
129
+
]
130
+
in
131
+
let _response =
132
+
Client.request client ~method_:`POST
133
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id ^ "/subgroups")
134
+
~params ()
135
+
in
136
+
()
137
+
138
+
let delete client ~group_id =
139
+
let _response =
140
+
Client.request client ~method_:`DELETE
141
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id)
142
+
()
143
+
in
144
+
()
145
+
146
+
let get_members client ~group_id =
147
+
let response_codec =
148
+
Jsont.Object.(
149
+
map ~kind:"MembersResponse" Fun.id
150
+
|> mem "members" (Jsont.list Jsont.int) ~enc:Fun.id
151
+
|> finish)
152
+
in
153
+
let json =
154
+
Client.request client ~method_:`GET
155
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id ^ "/members")
156
+
()
157
+
in
158
+
Error.decode_or_raise response_codec json "getting group members"
159
+
160
+
let is_member client ~group_id ~user_id =
161
+
let response_codec =
162
+
Jsont.Object.(
163
+
map ~kind:"IsMemberResponse" Fun.id
164
+
|> mem "is_user_group_member" Jsont.bool ~enc:Fun.id
165
+
|> finish)
166
+
in
167
+
let json =
168
+
Client.request client ~method_:`GET
169
+
~path:
170
+
("/api/v1/user_groups/" ^ string_of_int group_id ^ "/members/"
171
+
^ string_of_int user_id)
172
+
()
173
+
in
174
+
Error.decode_or_raise response_codec json "checking group membership"
175
+
176
+
let get_subgroups client ~group_id =
177
+
let response_codec =
178
+
Jsont.Object.(
179
+
map ~kind:"SubgroupsResponse" Fun.id
180
+
|> mem "subgroups" (Jsont.list Jsont.int) ~enc:Fun.id
181
+
|> finish)
182
+
in
183
+
let json =
184
+
Client.request client ~method_:`GET
185
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id ^ "/subgroups")
186
+
()
187
+
in
188
+
Error.decode_or_raise response_codec json "getting subgroups"
189
+
190
+
let is_subgroup client ~group_id ~subgroup_id =
191
+
let response_codec =
192
+
Jsont.Object.(
193
+
map ~kind:"IsSubgroupResponse" Fun.id
194
+
|> mem "is_subgroup" Jsont.bool ~enc:Fun.id
195
+
|> finish)
196
+
in
197
+
let json =
198
+
Client.request client ~method_:`GET
199
+
~path:
200
+
("/api/v1/user_groups/" ^ string_of_int group_id ^ "/subgroups/"
201
+
^ string_of_int subgroup_id)
202
+
()
203
+
in
204
+
Error.decode_or_raise response_codec json "checking subgroup membership"