···
1
+
(* Vicuna Bot - User Registration and Management Bot for Zulip *)
6
+
let src = Logs.Src.create "vicuna_bot" ~doc:"Vicuna User Registration Bot"
7
+
module Log = (val Logs.src_log src : Logs.LOG)
9
+
(** User registration record *)
10
+
type user_registration = {
14
+
registered_at: float;
18
+
(** Parse a user registration from JSON-like string format *)
19
+
let user_registration_of_string s : user_registration option =
21
+
(* Format: "email|zulip_id|full_name|timestamp|is_admin" *)
22
+
match String.split_on_char '|' s with
23
+
| [email; zulip_id_str; full_name; timestamp_str; is_admin_str] ->
26
+
zulip_id = int_of_string zulip_id_str;
28
+
registered_at = float_of_string timestamp_str;
29
+
is_admin = bool_of_string is_admin_str;
31
+
| [email; zulip_id_str; full_name; timestamp_str] ->
32
+
(* Backward compatibility - old format without is_admin *)
35
+
zulip_id = int_of_string zulip_id_str;
37
+
registered_at = float_of_string timestamp_str;
43
+
(** Convert a user registration to string format *)
44
+
let user_registration_to_string (reg : user_registration) : string =
45
+
Printf.sprintf "%s|%d|%s|%f|%b"
52
+
(** Storage key for a user registration by Zulip ID - this is the only storage key we use *)
53
+
let storage_key_for_id zulip_id = Printf.sprintf "user:id:%d" zulip_id
55
+
(** Storage key for the list of all registered user IDs *)
56
+
let all_users_key = "users:all"
58
+
(** Default admin user ID *)
59
+
let default_admin_id = 939008
61
+
(** Get all registered user IDs from storage *)
62
+
let get_all_user_ids storage =
63
+
match Bot_storage.get storage ~key:all_users_key with
64
+
| Some s when s <> "" ->
65
+
String.split_on_char ',' s
66
+
|> List.filter_map (fun id_str ->
67
+
try Some (int_of_string (String.trim id_str))
71
+
(** Add a user ID to the list of all users (ensures uniqueness) *)
72
+
let add_user_id_to_list storage zulip_id =
73
+
let existing = get_all_user_ids storage in
74
+
if List.mem zulip_id existing then
77
+
let new_list = zulip_id :: existing in
78
+
let value = String.concat "," (List.map string_of_int new_list) in
79
+
Bot_storage.put storage ~key:all_users_key ~value
81
+
(** Remove a user ID from the list of all users *)
82
+
let remove_user_id_from_list storage zulip_id =
83
+
let existing = get_all_user_ids storage in
84
+
let new_list = List.filter ((<>) zulip_id) existing in
85
+
let value = String.concat "," (List.map string_of_int new_list) in
86
+
Bot_storage.put storage ~key:all_users_key ~value
88
+
(** Look up a user by Zulip ID *)
89
+
let lookup_user_by_id storage zulip_id =
90
+
match Bot_storage.get storage ~key:(storage_key_for_id zulip_id) with
91
+
| Some s -> user_registration_of_string s
94
+
(** Look up a user by email - scans through all users *)
95
+
let lookup_user_by_email storage email =
96
+
let user_ids = get_all_user_ids storage in
97
+
List.find_map (fun zulip_id ->
98
+
match lookup_user_by_id storage zulip_id with
99
+
| Some reg when reg.email = email -> Some reg
103
+
(** Check if user is admin *)
104
+
let is_admin storage zulip_id =
105
+
match lookup_user_by_id storage zulip_id with
106
+
| Some reg -> reg.is_admin
107
+
| None -> zulip_id = default_admin_id (* Default admin always has admin rights *)
109
+
(** Set admin status for a user *)
110
+
let set_admin storage zulip_id is_admin_flag =
111
+
match lookup_user_by_id storage zulip_id with
113
+
let updated_reg = { reg with is_admin = is_admin_flag } in
114
+
let reg_str = user_registration_to_string updated_reg in
115
+
(* Update ID storage key only *)
116
+
Bot_storage.put storage ~key:(storage_key_for_id zulip_id) ~value:reg_str
118
+
Error (Zulip.create_error ~code:(Other "user_not_found") ~msg:"User not registered" ())
120
+
(** Register a new user in storage (with optional admin flag) *)
121
+
let register_user ?(is_admin=false) storage email zulip_id full_name =
122
+
(* Check if user already exists by ID to prevent duplicates *)
123
+
let existing_by_id = lookup_user_by_id storage zulip_id in
125
+
(* Preserve admin status if user already exists, unless explicitly setting *)
126
+
let final_is_admin = match existing_by_id with
127
+
| Some existing -> existing.is_admin || is_admin
128
+
| None -> is_admin || (zulip_id = default_admin_id)
135
+
registered_at = Unix.gettimeofday ();
136
+
is_admin = final_is_admin;
138
+
let reg_str = user_registration_to_string reg in
140
+
(* Store only by ID - we'll use in-memory scanning for email lookups *)
141
+
match Bot_storage.put storage ~key:(storage_key_for_id zulip_id) ~value:reg_str with
142
+
| Error e -> Error e
144
+
(* Add to all users list (by ID, ensures uniqueness) *)
145
+
add_user_id_to_list storage zulip_id
147
+
(** Delete a user from storage by Zulip ID *)
148
+
let delete_user storage zulip_id =
149
+
match lookup_user_by_id storage zulip_id with
151
+
(* Remove from ID key only *)
152
+
let _ = Bot_storage.remove storage ~key:(storage_key_for_id zulip_id) in
153
+
(* Remove from all users list *)
154
+
remove_user_id_from_list storage zulip_id
156
+
Error (Zulip.create_error ~code:(Other "user_not_found") ~msg:"User not found" ())
158
+
(** Format a timestamp as a human-readable date *)
159
+
let format_timestamp timestamp =
160
+
let tm = Unix.localtime timestamp in
161
+
Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"
162
+
(tm.tm_year + 1900)
169
+
(** Validate email format (basic check) *)
170
+
let is_valid_email email =
171
+
let email = String.trim email in
172
+
String.length email > 0 &&
173
+
String.contains email '@' &&
174
+
match String.split_on_char '@' email with
175
+
| [local; domain] ->
176
+
String.length local > 0 &&
177
+
String.length domain > 0 &&
178
+
String.contains domain '.'
181
+
(** Handle the 'register' command *)
182
+
let handle_register storage sender_email sender_id sender_name custom_email_opt =
183
+
(* First, try to fetch the user's profile from the Zulip API to get delivery_email and email *)
184
+
let client = Bot_storage.client storage in
185
+
let (delivery_email_from_api, user_email_from_api) =
186
+
match Zulip.Users.get_by_id client ~user_id:sender_id with
188
+
let delivery = match Zulip.User.delivery_email user with
189
+
| Some email when email <> "" ->
190
+
Log.info (fun m -> m "Found delivery_email from API: %s" email);
193
+
Log.debug (fun m -> m "No delivery_email available from API");
196
+
let user_email = Zulip.User.email user in
197
+
(* Check if the user.email from API is different from sender_email (message context) *)
199
+
if user_email <> "" && user_email <> sender_email then (
200
+
Log.info (fun m -> m "Found user.email from API: %s (differs from message sender: %s)" user_email sender_email);
203
+
Log.debug (fun m -> m "API user.email same as sender_email or empty");
207
+
(delivery, api_email)
209
+
Log.warn (fun m -> m "Failed to fetch user profile: %s" (Zulip.error_message e));
213
+
(* Determine the email to register with priority:
214
+
1. Custom email provided by user
215
+
2. delivery_email from API
216
+
3. user.email from API (if different from sender_email)
217
+
4. Zulip sender email (fallback) *)
218
+
let email_to_register = match custom_email_opt with
220
+
let email = String.trim email in
221
+
if is_valid_email email then
224
+
Log.warn (fun m -> m "Invalid email format provided: %s, trying API emails or falling back to sender email" email);
225
+
match delivery_email_from_api with
226
+
| Some email -> email
228
+
(match user_email_from_api with
229
+
| Some email -> email
230
+
| None -> sender_email)
233
+
(* No custom email provided, try delivery_email first, then user.email, then fallback *)
234
+
(match delivery_email_from_api with
235
+
| Some email -> email
237
+
(match user_email_from_api with
238
+
| Some email -> email
239
+
| None -> sender_email))
242
+
Log.info (fun m -> m "Registering user: %s (ID: %d)" email_to_register sender_id);
244
+
(* Build info message about email source *)
245
+
let email_source_note =
246
+
if custom_email_opt <> None then
247
+
"\n📝 Using the custom email you provided"
248
+
else if custom_email_opt = None && delivery_email_from_api <> None then
249
+
"\n📧 Using your delivery email from your profile"
250
+
else if custom_email_opt = None && user_email_from_api <> None then
251
+
"\n📧 Using your email from your profile (user.email)"
256
+
(* Check if already registered *)
257
+
match lookup_user_by_email storage email_to_register with
259
+
if existing.zulip_id = sender_id then (
260
+
(* Ensure user is in the master list (idempotent) *)
261
+
let _ = add_user_id_to_list storage sender_id in
262
+
Printf.sprintf "You are already registered!\n\
264
+
• Zulip ID: `%d`\n\
265
+
• Registered: %s\n\n\
266
+
💡 Your Zulip email is: `%s`%s"
269
+
(format_timestamp existing.registered_at)
273
+
(* Email exists but different ID - update it *)
274
+
(match register_user storage email_to_register sender_id sender_name with
276
+
Log.info (fun m -> m "Updated registration for %s" email_to_register);
277
+
Printf.sprintf "✅ Updated your registration!\n\
279
+
• Zulip ID: `%d`\n\n\
280
+
💡 Your Zulip email is: `%s`%s"
281
+
email_to_register sender_id sender_email email_source_note
283
+
Log.err (fun m -> m "Failed to update registration: %s" (Zulip.error_message e));
284
+
Printf.sprintf "❌ Failed to update registration: %s" (Zulip.error_message e))
286
+
(* New registration *)
287
+
(match register_user storage email_to_register sender_id sender_name with
289
+
Log.info (fun m -> m "Successfully registered %s" email_to_register);
290
+
Printf.sprintf "✅ Successfully registered!\n\
292
+
• Zulip ID: `%d`\n\
293
+
• Full Name: `%s`\n\n\
294
+
💡 Your Zulip email is: `%s`%s\n\
295
+
You can now be @mentioned by your email or Zulip ID!"
296
+
email_to_register sender_id sender_name sender_email email_source_note
298
+
Log.err (fun m -> m "Failed to register user: %s" (Zulip.error_message e));
299
+
Printf.sprintf "❌ Failed to register: %s" (Zulip.error_message e))
301
+
(** Handle the 'whoami' command *)
302
+
let handle_whoami storage sender_email _sender_id =
303
+
match lookup_user_by_email storage sender_email with
305
+
Printf.sprintf "📋 Your registration info:\n\
307
+
• Zulip ID: `%d`\n\
308
+
• Full Name: `%s`\n\
313
+
(format_timestamp reg.registered_at)
315
+
Printf.sprintf "You are not registered yet. Use `register` to register yourself!"
317
+
(** Handle the 'whois' command *)
318
+
let handle_whois storage query =
319
+
(* Try to parse as email or ID *)
320
+
match int_of_string_opt query with
322
+
(* Query is a number, look up by ID *)
323
+
(match lookup_user_by_id storage id with
325
+
Printf.sprintf "👤 User found:\n\
327
+
• Zulip ID: `%d`\n\
328
+
• Full Name: `%s`\n\
333
+
(format_timestamp reg.registered_at)
335
+
Printf.sprintf "❓ No user found with ID: %d" id)
337
+
(* Query is not a number, treat as email *)
338
+
let email = String.trim query in
339
+
(match lookup_user_by_email storage email with
341
+
Printf.sprintf "👤 User found:\n\
343
+
• Zulip ID: `%d`\n\
344
+
• Full Name: `%s`\n\
349
+
(format_timestamp reg.registered_at)
351
+
Printf.sprintf "❓ No user found with email: %s" email)
353
+
(** Handle the 'list' command *)
354
+
let handle_list storage =
355
+
let user_ids = get_all_user_ids storage in
356
+
if user_ids = [] then
357
+
"📋 No users registered yet."
359
+
let user_lines = List.filter_map (fun zulip_id ->
360
+
match lookup_user_by_id storage zulip_id with
362
+
let admin_badge = if reg.is_admin then " 👑" else "" in
363
+
Some (Printf.sprintf "• **%s** (`%s`) - ID: %d%s"
364
+
reg.full_name reg.email reg.zulip_id admin_badge)
367
+
Printf.sprintf "📋 Registered users (%d):\n%s"
368
+
(List.length user_lines)
369
+
(String.concat "\n" user_lines)
371
+
(** Handle the 'help' command *)
372
+
let handle_help sender_name sender_email =
373
+
Printf.sprintf "👋 Hi %s! I'm **Vicuna**, your user registration assistant.\n\n\
374
+
**Available Commands:**\n\
375
+
• `register` - Auto-detect your real email or use Zulip email\n\
376
+
• `register <your-email@example.com>` - Register with a specific email\n\
377
+
• `whoami` - Show your registration status\n\
378
+
• `whois <email|id>` - Look up a registered user\n\
379
+
• `list` - List all registered users\n\
380
+
• `help` - Show this help message\n\n\
382
+
• `register` - Auto-detect your email (your Zulip email is `%s`)\n\
383
+
• `register alice@mycompany.com` - Register with a specific email\n\
384
+
• `whois alice@example.com` - Look up Alice by email\n\
385
+
• `whois 12345` - Look up user by Zulip ID\n\n\
386
+
**Smart Email Detection:**\n\
387
+
When you use `register` without an email, I'll try to:\n\
388
+
1. Find your delivery email from your Zulip profile (delivery_email)\n\
389
+
2. Use your profile email if available (user.email)\n\
390
+
3. Fall back to your Zulip message email if needed\n\n\
391
+
This means you usually don't need to manually provide your email!\n\n\
392
+
Send me a direct message to get started!"
393
+
sender_name sender_email
395
+
(** Parse command from message content *)
396
+
let parse_command content =
397
+
let trimmed = String.trim content in
398
+
match String.index_opt trimmed ' ' with
399
+
| None -> (trimmed, "")
401
+
let cmd = String.sub trimmed 0 idx in
402
+
let args = String.sub trimmed (idx + 1) (String.length trimmed - idx - 1) |> String.trim in
405
+
(** Main bot handler implementation *)
406
+
module Vicuna_handler : Bot_handler.S = struct
407
+
let initialize _config =
408
+
Log.info (fun m -> m "Initializing Vicuna bot handler");
412
+
"Vicuna - User Registration and Management Bot"
414
+
let description () =
415
+
"A bot that helps users register and manage their email to Zulip ID mappings. \
416
+
Register with 'register', check your status with 'whoami', and look up others with 'whois'."
418
+
let handle_message ~config:_ ~storage ~identity ~message ~env:_ =
419
+
(* Log the message *)
420
+
Log.debug (fun m -> m "@[<h>Received: %a@]" (Message.pp_ansi ~show_json:false) message);
422
+
(* Get sender information *)
423
+
let sender_email = Message.sender_email message in
424
+
let sender_id = Message.sender_id message in
425
+
let sender_name = Message.sender_full_name message in
426
+
let bot_email = Bot_handler.Identity.email identity in
428
+
(* Ignore our own messages *)
429
+
if sender_email = bot_email then (
430
+
Log.debug (fun m -> m "Ignoring own message");
431
+
Ok Bot_handler.Response.None
433
+
(* Clean the message content *)
434
+
let cleaned_msg = Message.strip_mention message ~user_email:bot_email in
435
+
let (command, args) = parse_command cleaned_msg in
436
+
let command_lower = String.lowercase_ascii command in
438
+
Log.info (fun m -> m "Command: %s, Args: %s" command_lower args);
440
+
(* Handle commands *)
441
+
let response_content =
442
+
match command_lower with
443
+
| "" | "hi" | "hello" ->
444
+
handle_help sender_name sender_email
446
+
handle_help sender_name sender_email
448
+
let custom_email = if args = "" then None else Some args in
449
+
handle_register storage sender_email sender_id sender_name custom_email
451
+
handle_whoami storage sender_email sender_id
454
+
"Usage: `whois <email|id>` - Example: `whois alice@example.com` or `whois 12345`"
456
+
handle_whois storage args
458
+
handle_list storage
460
+
Printf.sprintf "Unknown command: `%s`. Use `help` to see available commands." command
463
+
Ok (Bot_handler.Response.Reply response_content)
466
+
(** {1 Storage Management Functions} *)
468
+
(** Get all storage keys (excluding deleted keys with empty values) *)
469
+
let get_storage_keys storage =
470
+
match Bot_storage.keys storage with
471
+
| Error e -> Error e
473
+
(* Filter out keys with empty values (these are deleted keys) *)
474
+
let non_empty_keys = List.filter (fun key ->
475
+
match Bot_storage.get storage ~key with
476
+
| Some value when value <> "" -> true
481
+
(** Get the value of a specific storage key *)
482
+
let get_storage_value storage key =
483
+
Bot_storage.get storage ~key
485
+
(** Delete a specific storage key *)
486
+
let delete_storage_key storage key =
487
+
Bot_storage.remove storage ~key
489
+
(** Clear all storage (delete all keys) *)
490
+
let clear_storage storage =
491
+
match Bot_storage.keys storage with
492
+
| Error e -> Error e
494
+
List.fold_left (fun acc key ->
496
+
| Error _ as err -> err
497
+
| Ok () -> Bot_storage.remove storage ~key
500
+
(** Create the bot handler instance *)
501
+
let create_handler config storage identity =
502
+
Bot_handler.create (module Vicuna_handler) ~config ~storage ~identity
anil.recoil.org