···
16
-
last_river_post_date: float option; (** Timestamp of last River post for this user *)
(** Parse a user registration from JSON-like string format *)
let user_registration_of_string s : user_registration option =
22
-
(* Format: "email|zulip_id|full_name|timestamp|is_admin|last_river_post_date" *)
21
+
(* Format: "email|zulip_id|full_name|timestamp|is_admin" *)
match String.split_on_char '|' s with
24
-
| [email; zulip_id_str; full_name; timestamp_str; is_admin_str; last_river_str] ->
25
-
let last_river_post_date =
26
-
if last_river_str = "" || last_river_str = "none" then None
27
-
else Some (float_of_string last_river_str)
31
-
zulip_id = int_of_string zulip_id_str;
33
-
registered_at = float_of_string timestamp_str;
34
-
is_admin = bool_of_string is_admin_str;
35
-
last_river_post_date;
| [email; zulip_id_str; full_name; timestamp_str; is_admin_str] ->
38
-
(* Backward compatibility - old format without last_river_post_date *)
zulip_id = int_of_string zulip_id_str;
registered_at = float_of_string timestamp_str;
is_admin = bool_of_string is_admin_str;
45
-
last_river_post_date = None;
| [email; zulip_id_str; full_name; timestamp_str] ->
48
-
(* Backward compatibility - old format without is_admin and last_river_post_date *)
32
+
(* Backward compatibility - old format without is_admin *)
zulip_id = int_of_string zulip_id_str;
registered_at = float_of_string timestamp_str;
55
-
last_river_post_date = None;
(** Convert a user registration to string format *)
let user_registration_to_string (reg : user_registration) : string =
62
-
let last_river_str = match reg.last_river_post_date with
64
-
| Some t -> string_of_float t
66
-
Printf.sprintf "%s|%d|%s|%f|%b|%s"
45
+
Printf.sprintf "%s|%d|%s|%f|%b"
(** Storage key for a user registration by Zulip ID - this is the only storage key we use *)
let storage_key_for_id zulip_id = Printf.sprintf "user:id:%d" zulip_id
···
| None -> is_admin || (zulip_id = default_admin_id)
153
-
(* Preserve last_river_post_date if user already exists *)
154
-
let last_river_post_date = match existing_by_id with
155
-
| Some existing -> existing.last_river_post_date
registered_at = Unix.gettimeofday ();
is_admin = final_is_admin;
165
-
last_river_post_date;
let reg_str = user_registration_to_string reg in
···
String.contains domain '.'
210
-
(** {1 River Integration Helper Functions} *)
212
-
(** Configuration storage keys for River *)
213
-
let river_feeds_key = "river:feeds:list"
214
-
let river_channel_key = "river:channel"
215
-
let river_polling_enabled_key = "river:polling:enabled"
216
-
let river_last_sync_key = "river:last_sync"
217
-
let river_default_channel = "Sandbox-test"
219
-
(** Feed source codec *)
220
-
let feed_source_jsont =
221
-
let make name url = { River.name; url } in
222
-
Jsont.Object.map ~kind:"FeedSource" make
223
-
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun s -> s.River.name)
224
-
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun s -> s.River.url)
225
-
|> Jsont.Object.finish
227
-
(** Load feed sources from bot storage *)
228
-
let load_feed_sources storage =
229
-
match Bot_storage.get storage ~key:river_feeds_key with
230
-
| Some json_str when json_str <> "" ->
231
-
(match Jsont_bytesrw.decode_string' (Jsont.list feed_source_jsont) json_str with
233
-
Log.debug (fun m -> m "Loaded %d feed sources" (List.length feeds));
236
-
Log.err (fun m -> m "Failed to parse feed sources: %s" (Jsont.Error.to_string err));
239
-
Log.debug (fun m -> m "No feed sources configured");
242
-
(** Save feed sources to bot storage *)
243
-
let save_feed_sources storage feeds =
244
-
match Jsont_bytesrw.encode_string' ~format:Jsont.Indent (Jsont.list feed_source_jsont) feeds with
246
-
Bot_storage.put storage ~key:river_feeds_key ~value:json_str
248
-
let msg = Printf.sprintf "Failed to encode feed sources: %s" (Jsont.Error.to_string err) in
249
-
Error (Zulip.create_error ~code:(Other "encoding_error") ~msg ())
251
-
(** Add a feed source *)
252
-
let add_feed storage ~name ~url =
253
-
let feeds = load_feed_sources storage in
254
-
if List.exists (fun f -> f.River.url = url) feeds then
255
-
Error (Zulip.create_error ~code:(Other "already_exists")
256
-
~msg:(Printf.sprintf "Feed with URL %s already exists" url) ())
258
-
let new_feed = { River.name; url } in
259
-
save_feed_sources storage (new_feed :: feeds)
261
-
(** Remove a feed source *)
262
-
let remove_feed storage ~name =
263
-
let feeds = load_feed_sources storage in
264
-
let updated_feeds = List.filter (fun f -> f.River.name <> name) feeds in
265
-
if List.length updated_feeds = List.length feeds then
266
-
Error (Zulip.create_error ~code:(Other "not_found")
267
-
~msg:(Printf.sprintf "Feed '%s' not found" name) ())
269
-
save_feed_sources storage updated_feeds
271
-
(** Get target Zulip channel *)
272
-
let get_river_channel storage =
273
-
match Bot_storage.get storage ~key:river_channel_key with
274
-
| Some ch when ch <> "" -> ch
275
-
| _ -> river_default_channel
277
-
(** Set target Zulip channel *)
278
-
let set_river_channel storage channel =
279
-
Bot_storage.put storage ~key:river_channel_key ~value:channel
281
-
(** Check if polling is enabled *)
282
-
let is_river_polling_enabled storage =
283
-
match Bot_storage.get storage ~key:river_polling_enabled_key with
284
-
| Some "true" -> true
287
-
(** Enable polling *)
288
-
let enable_river_polling storage =
289
-
Bot_storage.put storage ~key:river_polling_enabled_key ~value:"true"
291
-
(** Disable polling *)
292
-
let disable_river_polling storage =
293
-
Bot_storage.put storage ~key:river_polling_enabled_key ~value:"false"
295
-
(** Get last sync timestamp *)
296
-
let get_river_last_sync storage =
297
-
match Bot_storage.get storage ~key:river_last_sync_key with
298
-
| Some ts_str when ts_str <> "" ->
299
-
(try Some (float_of_string ts_str) with _ -> None)
302
-
(** Update last sync timestamp *)
303
-
let update_river_last_sync storage timestamp =
304
-
Bot_storage.put storage ~key:river_last_sync_key ~value:(string_of_float timestamp)
306
-
(** {1 Command Handlers} *)
(** Handle the 'register' command *)
let handle_register storage sender_email sender_id sender_name custom_email_opt =
(* First, try to fetch the user's profile from the Zulip API to get delivery_email and email *)
···
(String.concat "\n" user_lines)
498
-
(** Handle River 'feeds' command *)
499
-
let handle_river_feeds storage =
500
-
let feeds = load_feed_sources storage in
502
-
"📡 No River feeds configured yet.\n\nUse `river add-feed <name> <url>` to add a feed."
504
-
let feed_lines = List.mapi (fun i feed ->
505
-
Printf.sprintf "%d. **%s**\n URL: `%s`" (i + 1) feed.River.name feed.River.url
507
-
Printf.sprintf "📡 Configured River feeds (%d):\n\n%s\n\nChannel: #%s"
508
-
(List.length feeds)
509
-
(String.concat "\n\n" feed_lines)
510
-
(get_river_channel storage)
512
-
(** Handle River 'add-feed' command *)
513
-
let handle_river_add_feed storage args =
514
-
match String.split_on_char ' ' args |> List.filter (fun s -> s <> "") with
515
-
| name :: url_parts ->
516
-
let url = String.concat " " url_parts in
517
-
(match add_feed storage ~name ~url with
519
-
Printf.sprintf "✅ Added feed **%s**\n URL: `%s`\n\nUse `river sync` to fetch posts." name url
521
-
Printf.sprintf "❌ Failed to add feed: %s" (Zulip.error_message e))
523
-
"Usage: `river add-feed <name> <url>`\n\nExample: `river add-feed \"OCaml Blog\" https://ocaml.org/blog/feed.xml`"
525
-
(** Handle River 'remove-feed' command *)
526
-
let handle_river_remove_feed storage args =
527
-
let name = String.trim args in
529
-
"Usage: `river remove-feed <name>`\n\nExample: `river remove-feed \"OCaml Blog\"`"
531
-
match remove_feed storage ~name with
533
-
Printf.sprintf "✅ Removed feed: **%s**" name
535
-
Printf.sprintf "❌ Failed to remove feed: %s" (Zulip.error_message e)
537
-
(** Handle River 'set-channel' command *)
538
-
let handle_river_set_channel storage args =
539
-
let channel = String.trim args in
540
-
if channel = "" then
541
-
Printf.sprintf "Current channel: #%s\n\nUsage: `river set-channel <channel-name>`\n\nExample: `river set-channel general`"
542
-
(get_river_channel storage)
544
-
match set_river_channel storage channel with
546
-
Printf.sprintf "✅ River posts will now go to #%s" channel
548
-
Printf.sprintf "❌ Failed to set channel: %s" (Zulip.error_message e)
550
-
(** Handle River 'start' command *)
551
-
let handle_river_start storage =
552
-
match enable_river_polling storage with
553
-
| Ok () -> "✅ River polling enabled. Feeds will be checked every 5 minutes."
554
-
| Error e -> Printf.sprintf "❌ Failed to enable polling: %s" (Zulip.error_message e)
556
-
(** Handle River 'stop' command *)
557
-
let handle_river_stop storage =
558
-
match disable_river_polling storage with
559
-
| Ok () -> "⏸️ River polling disabled. Use `river start` to resume."
560
-
| Error e -> Printf.sprintf "❌ Failed to disable polling: %s" (Zulip.error_message e)
562
-
(** Handle River 'status' command *)
563
-
let handle_river_status storage =
564
-
let feeds = load_feed_sources storage in
565
-
let polling_status = if is_river_polling_enabled storage then "✅ Enabled" else "⏸️ Disabled" in
566
-
let last_sync = match get_river_last_sync storage with
567
-
| Some ts -> format_timestamp ts
570
-
Printf.sprintf "📊 River Feed Integration Status:\n\
572
-
• Target channel: #%s\n\
573
-
• Feeds configured: %d\n\
576
-
(get_river_channel storage)
577
-
(List.length feeds)
(** Handle the 'help' command *)
let handle_help sender_name sender_email =
582
-
Printf.sprintf "👋 Hi %s! I'm **Vicuna**, your user registration and feed aggregation assistant.\n\n\
583
-
**User Registration Commands:**\n\
373
+
Printf.sprintf "👋 Hi %s! I'm **Vicuna**, your user registration assistant.\n\n\
374
+
**Available Commands:**\n\
• `register` - Auto-detect your real email or use Zulip email\n\
• `register <your-email@example.com>` - Register with a specific email\n\
• `whoami` - Show your registration status\n\
• `whois <email|id>` - Look up a registered user\n\
588
-
• `list` - List all registered users\n\n\
589
-
**River Feed Commands:**\n\
590
-
• `river feeds` - List all configured feeds\n\
591
-
• `river add-feed <name> <url>` - Add a new feed\n\
592
-
• `river remove-feed <name>` - Remove a feed\n\
593
-
• `river sync` - Force immediate feed sync\n\
594
-
• `river status` - Show River integration status\n\
595
-
• `river set-channel <name>` - Set target Zulip channel\n\
596
-
• `river start` - Enable automatic polling\n\
597
-
• `river stop` - Disable automatic polling\n\
379
+
• `list` - List all registered users\n\
• `help` - Show this help message\n\n\
• `register` - Auto-detect your email (your Zulip email is `%s`)\n\
601
-
• `river add-feed \"OCaml Weekly\" https://ocaml.org/feed.xml`\n\
602
-
• `river set-channel sandbox-test`\n\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\
Send me a direct message to get started!"
···
handle_whois storage args
671
-
(* Parse river subcommand *)
672
-
let (subcmd, subargs) = parse_command args in
673
-
let subcmd_lower = String.lowercase_ascii subcmd in
674
-
(match subcmd_lower with
675
-
| "" | "feeds" | "list" ->
676
-
handle_river_feeds storage
677
-
| "add-feed" | "add" ->
678
-
handle_river_add_feed storage subargs
679
-
| "remove-feed" | "remove" | "rm" ->
680
-
handle_river_remove_feed storage subargs
681
-
| "set-channel" | "channel" ->
682
-
handle_river_set_channel storage subargs
683
-
| "start" | "enable" ->
684
-
handle_river_start storage
685
-
| "stop" | "disable" ->
686
-
handle_river_stop storage
688
-
handle_river_status storage
690
-
"⏳ Syncing River feeds... (Note: sync requires environment access, use CLI for now)"
692
-
Printf.sprintf "Unknown river command: `%s`\n\nAvailable: feeds, add-feed, remove-feed, set-channel, start, stop, status, sync" subcmd)
Printf.sprintf "Unknown command: `%s`. Use `help` to see available commands." command
···
| Ok () -> Bot_storage.remove storage ~key
734
-
(** Normalize a name for fuzzy matching *)
735
-
let normalize_name name =
737
-
|> String.lowercase_ascii
739
-
|> Str.global_replace (Str.regexp "[ \t\n\r]+") " "
741
-
(** Match user by exact name *)
742
-
let lookup_user_by_name_exact storage name =
743
-
let all_ids = get_all_user_ids storage in
744
-
List.find_map (fun id ->
745
-
match lookup_user_by_id storage id with
746
-
| Some user when user.full_name = name -> Some user
750
-
(** Match user by fuzzy name *)
751
-
let lookup_user_by_name_fuzzy storage name =
752
-
let normalized_query = normalize_name name in
753
-
let all_ids = get_all_user_ids storage in
754
-
List.find_map (fun id ->
755
-
match lookup_user_by_id storage id with
756
-
| Some user when normalize_name user.full_name = normalized_query -> Some user
760
-
(** Smart user matching for a River post *)
761
-
let match_user_for_post storage (post : River.post) =
762
-
let author_email = River.email post in
763
-
let author_name = River.author post in
764
-
Log.debug (fun m -> m "Matching user for post by %s (%s)" author_name author_email);
765
-
(* Try email → name exact → name fuzzy *)
766
-
match lookup_user_by_email storage author_email with
768
-
Log.debug (fun m -> m "Matched by email: %s" user.email);
771
-
(match lookup_user_by_name_exact storage author_name with
773
-
Log.debug (fun m -> m "Matched by exact name: %s" user.full_name);
776
-
match lookup_user_by_name_fuzzy storage author_name with
778
-
Log.debug (fun m -> m "Matched by fuzzy name: %s" user.full_name);
781
-
Log.debug (fun m -> m "No user match found");
784
-
(** Convert HTML content to markdown summary *)
785
-
let content_to_summary content_html ~max_length =
786
-
let markdown = Markdown_converter.to_markdown content_html in
787
-
if String.length markdown <= max_length then markdown
788
-
else String.sub markdown 0 (max_length - 3) ^ "..."
790
-
(** Format a River post for Zulip *)
791
-
let format_river_post ~user_match (post : River.post) =
793
-
match River.summary post with
795
-
| None -> content_to_summary (River.content post) ~max_length:200
798
-
match user_match with
799
-
| Some user -> Printf.sprintf "By @**%s**" user.full_name
800
-
| None -> Printf.sprintf "By %s" (River.author post)
803
-
match River.link post with
804
-
| Some uri -> Printf.sprintf "\n\n[Read more](%s)" (Uri.to_string uri)
807
-
Printf.sprintf "%s\n\n%s%s" author_line summary link_line
809
-
(** Update user's last_river_post_date *)
810
-
let update_user_river_date storage user new_date =
811
-
let updated = { user with last_river_post_date = Some new_date } in
812
-
let reg_str = user_registration_to_string updated in
813
-
Bot_storage.put storage ~key:(storage_key_for_id user.zulip_id) ~value:reg_str
815
-
(** Get latest post date from a list of posts *)
816
-
let get_latest_post_date posts =
817
-
List.fold_left (fun acc post ->
818
-
match River.date post with
820
-
let timestamp = Ptime.to_float_s ptime in
822
-
| None -> Some timestamp
823
-
| Some existing -> Some (max existing timestamp))
827
-
(** Filter posts newer than a timestamp *)
828
-
let filter_posts_since posts since_opt =
829
-
match since_opt with
832
-
List.filter (fun post ->
833
-
match River.date post with
835
-
Ptime.to_float_s ptime > since
839
-
(** Post to Zulip channel *)
840
-
let post_to_zulip client ~channel ~topic ~content =
841
-
let stream_message = Zulip.Message.create ~type_:`Channel ~to_:[channel] ~topic ~content () in
842
-
Zulip.Messages.send client stream_message
844
-
(** Sync feeds and post new items *)
845
-
let sync_river_and_post ~env ~storage ~client () =
846
-
Log.info (fun m -> m "Starting River feed sync");
847
-
let feeds = load_feed_sources storage in
848
-
if feeds = [] then (
849
-
Log.info (fun m -> m "No feeds configured, skipping sync");
853
-
River.with_session env (fun session ->
854
-
Log.debug (fun m -> m "Fetching %d feeds" (List.length feeds));
855
-
let fetched_feeds = List.map (fun source ->
856
-
Log.debug (fun m -> m "Fetching: %s" source.River.name);
857
-
River.fetch session source
859
-
let all_posts = River.posts fetched_feeds in
860
-
Log.info (fun m -> m "Fetched %d total posts" (List.length all_posts));
862
-
(* Post new items *)
863
-
let users = List.filter_map (lookup_user_by_id storage) (get_all_user_ids storage) in
864
-
let posted_count = ref 0 in
865
-
let channel = get_river_channel storage in
867
-
List.iter (fun user ->
868
-
let new_posts = filter_posts_since all_posts user.last_river_post_date in
869
-
List.iter (fun post ->
870
-
let user_match = match_user_for_post storage post in
871
-
let topic = River.title post in
872
-
let content = format_river_post ~user_match post in
873
-
Log.info (fun m -> m "Posting to #%s: %s" channel topic);
874
-
match post_to_zulip client ~channel ~topic ~content with
875
-
| Ok _response -> incr posted_count
876
-
| Error e -> Log.err (fun m -> m "Failed to post: %s" (Zulip.error_message e))
879
-
match get_latest_post_date all_posts with
880
-
| Some latest -> let _ = update_user_river_date storage user latest in ()
884
-
let _ = update_river_last_sync storage (Unix.gettimeofday ()) in
885
-
Log.info (fun m -> m "Sync complete, posted %d items" !posted_count);
889
-
let msg = Printf.sprintf "Sync failed: %s" (Printexc.to_string exn) in
890
-
Log.err (fun m -> m "%s" msg);
891
-
Error (Zulip.create_error ~code:(Other "sync_error") ~msg ())
(** Create the bot handler instance *)
let create_handler config storage identity =
anil.recoil.org