My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(* Vicuna Bot - User Registration and Management Bot for Zulip *)
2
3open Zulip_bot
4
5(* Set up logging *)
6let src = Logs.Src.create "vicuna_bot" ~doc:"Vicuna User Registration Bot"
7module Log = (val Logs.src_log src : Logs.LOG)
8
9(** User registration record *)
10type user_registration = {
11 email: string;
12 zulip_id: int;
13 full_name: string;
14 registered_at: float;
15 is_admin: bool;
16}
17
18(** Parse a user registration from JSON-like string format *)
19let user_registration_of_string s : user_registration option =
20 try
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] ->
24 Some {
25 email;
26 zulip_id = int_of_string zulip_id_str;
27 full_name;
28 registered_at = float_of_string timestamp_str;
29 is_admin = bool_of_string is_admin_str;
30 }
31 | [email; zulip_id_str; full_name; timestamp_str] ->
32 (* Backward compatibility - old format without is_admin *)
33 Some {
34 email;
35 zulip_id = int_of_string zulip_id_str;
36 full_name;
37 registered_at = float_of_string timestamp_str;
38 is_admin = false;
39 }
40 | _ -> None
41 with _ -> None
42
43(** Convert a user registration to string format *)
44let user_registration_to_string (reg : user_registration) : string =
45 Printf.sprintf "%s|%d|%s|%f|%b"
46 reg.email
47 reg.zulip_id
48 reg.full_name
49 reg.registered_at
50 reg.is_admin
51
52(** Storage key for a user registration by Zulip ID - this is the only storage key we use *)
53let storage_key_for_id zulip_id = Printf.sprintf "user:id:%d" zulip_id
54
55(** Storage key for the list of all registered user IDs *)
56let all_users_key = "users:all"
57
58(** Default admin user ID *)
59let default_admin_id = 939008
60
61(** Get all registered user IDs from storage *)
62let 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))
68 with _ -> None)
69 | _ -> []
70
71(** Add a user ID to the list of all users (ensures uniqueness) *)
72let 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
75 Ok ()
76 else
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
80
81(** Remove a user ID from the list of all users *)
82let 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
87
88(** Look up a user by Zulip ID *)
89let 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
92 | None -> None
93
94(** Look up a user by email - scans through all users *)
95let 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
100 | _ -> None
101 ) user_ids
102
103(** Check if user is admin *)
104let 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 *)
108
109(** Set admin status for a user *)
110let set_admin storage zulip_id is_admin_flag =
111 match lookup_user_by_id storage zulip_id with
112 | Some reg ->
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
117 | None ->
118 Error (Zulip.create_error ~code:(Other "user_not_found") ~msg:"User not registered" ())
119
120(** Register a new user in storage (with optional admin flag) *)
121let 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
124
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)
129 in
130
131 let reg = {
132 email;
133 zulip_id;
134 full_name;
135 registered_at = Unix.gettimeofday ();
136 is_admin = final_is_admin;
137 } in
138 let reg_str = user_registration_to_string reg in
139
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
143 | Ok () ->
144 (* Add to all users list (by ID, ensures uniqueness) *)
145 add_user_id_to_list storage zulip_id
146
147(** Delete a user from storage by Zulip ID *)
148let delete_user storage zulip_id =
149 match lookup_user_by_id storage zulip_id with
150 | Some _reg ->
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
155 | None ->
156 Error (Zulip.create_error ~code:(Other "user_not_found") ~msg:"User not found" ())
157
158(** Format a timestamp as a human-readable date *)
159let format_timestamp timestamp =
160 let tm = Unix.localtime timestamp in
161 Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"
162 (tm.tm_year + 1900)
163 (tm.tm_mon + 1)
164 tm.tm_mday
165 tm.tm_hour
166 tm.tm_min
167 tm.tm_sec
168
169(** Validate email format (basic check) *)
170let 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 '.'
179 | _ -> false
180
181(** Handle the 'register' command *)
182let 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
187 | Ok user ->
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);
191 Some email
192 | _ ->
193 Log.debug (fun m -> m "No delivery_email available from API");
194 None
195 in
196 let user_email = Zulip.User.email user in
197 (* Check if the user.email from API is different from sender_email (message context) *)
198 let api_email =
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);
201 Some user_email
202 ) else (
203 Log.debug (fun m -> m "API user.email same as sender_email or empty");
204 None
205 )
206 in
207 (delivery, api_email)
208 | Error e ->
209 Log.warn (fun m -> m "Failed to fetch user profile: %s" (Zulip.error_message e));
210 (None, None)
211 in
212
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
219 | Some email ->
220 let email = String.trim email in
221 if is_valid_email email then
222 email
223 else (
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
227 | None ->
228 (match user_email_from_api with
229 | Some email -> email
230 | None -> sender_email)
231 )
232 | None ->
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
236 | None ->
237 (match user_email_from_api with
238 | Some email -> email
239 | None -> sender_email))
240 in
241
242 Log.info (fun m -> m "Registering user: %s (ID: %d)" email_to_register sender_id);
243
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)"
252 else
253 ""
254 in
255
256 (* Check if already registered *)
257 match lookup_user_by_email storage email_to_register with
258 | Some existing ->
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\
263 • Email: `%s`\n\
264 • Zulip ID: `%d`\n\
265 • Registered: %s\n\n\
266 💡 Your Zulip email is: `%s`%s"
267 existing.email
268 existing.zulip_id
269 (format_timestamp existing.registered_at)
270 sender_email
271 email_source_note
272 ) else
273 (* Email exists but different ID - update it *)
274 (match register_user storage email_to_register sender_id sender_name with
275 | Ok () ->
276 Log.info (fun m -> m "Updated registration for %s" email_to_register);
277 Printf.sprintf "✅ Updated your registration!\n\
278 • Email: `%s`\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
282 | Error e ->
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))
285 | None ->
286 (* New registration *)
287 (match register_user storage email_to_register sender_id sender_name with
288 | Ok () ->
289 Log.info (fun m -> m "Successfully registered %s" email_to_register);
290 Printf.sprintf "✅ Successfully registered!\n\
291 • Email: `%s`\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
297 | Error e ->
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))
300
301(** Handle the 'whoami' command *)
302let handle_whoami storage sender_email _sender_id =
303 match lookup_user_by_email storage sender_email with
304 | Some reg ->
305 Printf.sprintf "📋 Your registration info:\n\
306 • Email: `%s`\n\
307 • Zulip ID: `%d`\n\
308 • Full Name: `%s`\n\
309 • Registered: %s"
310 reg.email
311 reg.zulip_id
312 reg.full_name
313 (format_timestamp reg.registered_at)
314 | None ->
315 Printf.sprintf "You are not registered yet. Use `register` to register yourself!"
316
317(** Handle the 'whois' command *)
318let handle_whois storage query =
319 (* Try to parse as email or ID *)
320 match int_of_string_opt query with
321 | Some id ->
322 (* Query is a number, look up by ID *)
323 (match lookup_user_by_id storage id with
324 | Some reg ->
325 Printf.sprintf "👤 User found:\n\
326 • Email: `%s`\n\
327 • Zulip ID: `%d`\n\
328 • Full Name: `%s`\n\
329 • Registered: %s"
330 reg.email
331 reg.zulip_id
332 reg.full_name
333 (format_timestamp reg.registered_at)
334 | None ->
335 Printf.sprintf "❓ No user found with ID: %d" id)
336 | None ->
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
340 | Some reg ->
341 Printf.sprintf "👤 User found:\n\
342 • Email: `%s`\n\
343 • Zulip ID: `%d`\n\
344 • Full Name: `%s`\n\
345 • Registered: %s"
346 reg.email
347 reg.zulip_id
348 reg.full_name
349 (format_timestamp reg.registered_at)
350 | None ->
351 Printf.sprintf "❓ No user found with email: %s" email)
352
353(** Handle the 'list' command *)
354let handle_list storage =
355 let user_ids = get_all_user_ids storage in
356 if user_ids = [] then
357 "📋 No users registered yet."
358 else
359 let user_lines = List.filter_map (fun zulip_id ->
360 match lookup_user_by_id storage zulip_id with
361 | Some reg ->
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)
365 | None -> None
366 ) user_ids in
367 Printf.sprintf "📋 Registered users (%d):\n%s"
368 (List.length user_lines)
369 (String.concat "\n" user_lines)
370
371(** Handle the 'help' command *)
372let 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\
381 **Examples:**\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
394
395(** Parse command from message content *)
396let parse_command content =
397 let trimmed = String.trim content in
398 match String.index_opt trimmed ' ' with
399 | None -> (trimmed, "")
400 | Some idx ->
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
403 (cmd, args)
404
405(** Main bot handler implementation *)
406module Vicuna_handler : Bot_handler.S = struct
407 let initialize _config =
408 Log.info (fun m -> m "Initializing Vicuna bot handler");
409 Ok ()
410
411 let usage () =
412 "Vicuna - User Registration and Management Bot"
413
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'."
417
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);
421
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
427
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
432 ) else
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
437
438 Log.info (fun m -> m "Command: %s, Args: %s" command_lower args);
439
440 (* Handle commands *)
441 let response_content =
442 match command_lower with
443 | "" | "hi" | "hello" ->
444 handle_help sender_name sender_email
445 | "help" ->
446 handle_help sender_name sender_email
447 | "register" ->
448 let custom_email = if args = "" then None else Some args in
449 handle_register storage sender_email sender_id sender_name custom_email
450 | "whoami" ->
451 handle_whoami storage sender_email sender_id
452 | "whois" ->
453 if args = "" then
454 "Usage: `whois <email|id>` - Example: `whois alice@example.com` or `whois 12345`"
455 else
456 handle_whois storage args
457 | "list" ->
458 handle_list storage
459 | _ ->
460 Printf.sprintf "Unknown command: `%s`. Use `help` to see available commands." command
461 in
462
463 Ok (Bot_handler.Response.Reply response_content)
464end
465
466(** {1 Storage Management Functions} *)
467
468(** Get all storage keys (excluding deleted keys with empty values) *)
469let get_storage_keys storage =
470 match Bot_storage.keys storage with
471 | Error e -> Error e
472 | Ok keys ->
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
477 | _ -> false
478 ) keys in
479 Ok non_empty_keys
480
481(** Get the value of a specific storage key *)
482let get_storage_value storage key =
483 Bot_storage.get storage ~key
484
485(** Delete a specific storage key *)
486let delete_storage_key storage key =
487 Bot_storage.remove storage ~key
488
489(** Clear all storage (delete all keys) *)
490let clear_storage storage =
491 match Bot_storage.keys storage with
492 | Error e -> Error e
493 | Ok keys ->
494 List.fold_left (fun acc key ->
495 match acc with
496 | Error _ as err -> err
497 | Ok () -> Bot_storage.remove storage ~key
498 ) (Ok ()) keys
499
500(** Create the bot handler instance *)
501let create_handler config storage identity =
502 Bot_handler.create (module Vicuna_handler) ~config ~storage ~identity