this repo has no description
Add River RSS/Atom feed aggregation to Vicuna bot
This commit integrates River feed aggregation into Vicuna, enabling the bot to:
- Fetch RSS/Atom feeds and post new items to Zulip channels
- Match post authors with registered Vicuna users via smart matching
- Provide both message-based and CLI commands for feed management
- Poll feeds automatically every 5 minutes when enabled
## Key Features
### User Registration Enhancement
- Extended user_registration type with last_river_post_date field
- Backward-compatible serialization/deserialization
- Tracks last posted date per user for deduplication
### River Integration (vicuna_bot.ml)
- Feed source management (add/remove/list feeds)
- Configuration storage (channel, polling status)
- Smart user matching: email exact → name exact → name fuzzy
- Post formatting with markdown conversion and author attribution
- Complete sync-and-post workflow
### Bot Message Commands
All users can use these commands:
- `river feeds` - List configured feeds
- `river add-feed <name> <url>` - Add a feed
- `river remove-feed <name>` - Remove a feed
- `river set-channel <channel>` - Set target Zulip channel
- `river start` - Enable automatic polling
- `river stop` - Disable automatic polling
- `river status` - Show integration status
### CLI Commands
- `vicuna river list` - List configured feeds
- `vicuna river add <name> <url>` - Add a feed
- `vicuna river remove <name>` - Remove a feed
- `vicuna river set-channel <channel>` - Configure target channel
- `vicuna river start` - Enable polling
- `vicuna river stop` - Disable polling
### Automatic Polling
- Background fiber polls feeds every 5 minutes
- Only posts items newer than user's last_river_post_date
- Controlled via --enable-river-polling CLI flag or bot commands
- Graceful error handling with logging
### Post Format
- Topic: Post title
- Body: "By @**User**" (if matched) or "By Author Name"
Summary (200 chars) + [Read more](link)
## Implementation Details
- Uses River library for feed fetching and parsing
- Stores feed config in bot_storage as JSON
- Markdown conversion via River's Markdown_converter
- Jsont-based JSON encoding/decoding
- Fully integrated with existing Vicuna bot infrastructure
## Usage
Start bot with River polling:
```
./vicuna --enable-river-polling
```
Add a feed via CLI:
```
./vicuna river add "OCaml Blog" https://ocaml.org/blog/feed.xml
```
Or via bot message:
```
@vicuna river add-feed "OCaml Blog" https://ocaml.org/blog/feed.xml
```
🤖 Generated with [Claude Code](https://claude.com/claude-code)
Co-Authored-By: Claude <noreply@anthropic.com>
+727
-21
+261
-5
stack/vicuna/bin/main.ml
+261
-5
stack/vicuna/bin/main.ml
···
6
6
let src = Logs.Src.create "vicuna" ~doc:"Vicuna User Registration Bot"
7
7
module Log = (val Logs.src_log src : Logs.LOG)
8
8
9
-
let run_vicuna_bot config_file verbosity env =
9
+
let run_vicuna_bot config_file verbosity enable_river env =
10
10
(* Set up logging based on verbosity *)
11
11
Logs.set_reporter (Logs_fmt.reporter ());
12
12
let log_level = match verbosity with
···
17
17
Logs.set_level (Some log_level);
18
18
Logs.Src.set_level src (Some log_level);
19
19
20
-
Log.app (fun m -> m "Starting Vicuna Bot - User Registration Manager");
20
+
Log.app (fun m -> m "Starting Vicuna Bot - User Registration & Feed Aggregation");
21
21
Log.app (fun m -> m "Log level: %s" (Logs.level_to_string (Some log_level)));
22
22
Log.app (fun m -> m "========================================\n");
23
23
···
57
57
(Bot_handler.Identity.full_name identity)
58
58
(Bot_handler.Identity.email identity));
59
59
60
+
(* Enable River polling if CLI flag is set *)
61
+
if enable_river then (
62
+
Log.info (fun m -> m "Enabling River polling (CLI flag)");
63
+
match Vicuna_bot.enable_river_polling storage with
64
+
| Ok () -> ()
65
+
| Error e -> Log.warn (fun m -> m "Failed to enable River polling: %s" (Zulip.error_message e))
66
+
);
67
+
68
+
(* Start River polling fiber if enabled *)
69
+
let river_polling_enabled = Vicuna_bot.is_river_polling_enabled storage in
70
+
if river_polling_enabled then (
71
+
Log.app (fun m -> m "📡 River polling enabled - syncing feeds every 5 minutes");
72
+
Eio.Fiber.fork ~sw (fun () ->
73
+
let rec poll_loop () =
74
+
try
75
+
(* Sleep for 5 minutes (300 seconds) *)
76
+
Eio.Time.sleep env#clock 300.0;
77
+
78
+
(* Check if polling is still enabled *)
79
+
if Vicuna_bot.is_river_polling_enabled storage then (
80
+
Log.info (fun m -> m "River: Starting scheduled feed sync");
81
+
match Vicuna_bot.sync_river_and_post ~env ~storage ~client () with
82
+
| Ok count ->
83
+
if count > 0 then
84
+
Log.info (fun m -> m "River: Posted %d new items" count)
85
+
else
86
+
Log.debug (fun m -> m "River: No new items")
87
+
| Error e ->
88
+
Log.err (fun m -> m "River sync failed: %s" (Zulip.error_message e))
89
+
) else (
90
+
Log.info (fun m -> m "River: Polling disabled, stopping fiber");
91
+
() (* Exit the fiber *)
92
+
);
93
+
poll_loop ()
94
+
with exn ->
95
+
Log.err (fun m -> m "River polling fiber error: %s" (Printexc.to_string exn));
96
+
(* Continue polling despite errors *)
97
+
poll_loop ()
98
+
in
99
+
poll_loop ()
100
+
)
101
+
);
102
+
60
103
(* Create the bot handler using the Vicuna bot library *)
61
104
Log.debug (fun m -> m "Creating Vicuna bot handler");
62
105
let handler = Vicuna_bot.create_handler config storage identity in
···
66
109
67
110
Log.app (fun m -> m "✨ Vicuna bot is running!");
68
111
Log.app (fun m -> m "📬 Send me a direct message to get started.");
69
-
Log.app (fun m -> m "🤖 Commands: 'register', 'whoami', 'whois', 'list', 'help'");
112
+
Log.app (fun m -> m "🤖 Commands: 'register', 'whoami', 'whois', 'list', 'river', 'help'");
70
113
Log.app (fun m -> m "⛔ Press Ctrl+C to stop.\n");
71
114
72
115
(* Run in real-time mode *)
···
96
139
97
140
let verbosity_term =
98
141
Term.(const List.length $ verbosity)
142
+
143
+
let enable_river_flag =
144
+
let doc = "Enable automatic River feed polling (sync every 5 minutes)" in
145
+
Arg.(value & flag & info ["enable-river-polling"] ~doc)
99
146
100
147
(* CLI management commands *)
101
148
let cli_add_user config_file user_id email full_name is_admin env =
···
359
406
exit 1
360
407
)
361
408
409
+
(* River CLI commands *)
410
+
let cli_river_list config_file env =
411
+
Logs.set_reporter (Logs_fmt.reporter ());
412
+
Logs.set_level (Some Logs.Warning);
413
+
414
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
415
+
| Ok a -> a
416
+
| Error e ->
417
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
418
+
exit 1
419
+
in
420
+
421
+
Eio.Switch.run @@ fun sw ->
422
+
let client = Zulip.Client.create ~sw env auth in
423
+
let bot_email = Zulip.Auth.email auth in
424
+
let storage = Bot_storage.create client ~bot_email in
425
+
426
+
let feeds = Vicuna_bot.load_feed_sources storage in
427
+
if feeds = [] then (
428
+
Printf.printf "No River feeds configured.\n";
429
+
exit 0
430
+
) else (
431
+
Printf.printf "River feeds (%d):\n" (List.length feeds);
432
+
List.iteri (fun i feed ->
433
+
Printf.printf " %d. %s\n %s\n" (i + 1) feed.River.name feed.River.url
434
+
) feeds;
435
+
Printf.printf "\nTarget channel: #%s\n" (Vicuna_bot.get_river_channel storage);
436
+
exit 0
437
+
)
438
+
439
+
let cli_river_add config_file name url env =
440
+
Logs.set_reporter (Logs_fmt.reporter ());
441
+
Logs.set_level (Some Logs.Info);
442
+
443
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
444
+
| Ok a -> a
445
+
| Error e ->
446
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
447
+
exit 1
448
+
in
449
+
450
+
Eio.Switch.run @@ fun sw ->
451
+
let client = Zulip.Client.create ~sw env auth in
452
+
let bot_email = Zulip.Auth.email auth in
453
+
let storage = Bot_storage.create client ~bot_email in
454
+
455
+
match Vicuna_bot.add_feed storage ~name ~url with
456
+
| Ok () ->
457
+
Printf.printf "✅ Added feed: %s\n URL: %s\n" name url;
458
+
exit 0
459
+
| Error e ->
460
+
Printf.eprintf "❌ Failed to add feed: %s\n" (Zulip.error_message e);
461
+
exit 1
462
+
463
+
let cli_river_remove config_file name env =
464
+
Logs.set_reporter (Logs_fmt.reporter ());
465
+
Logs.set_level (Some Logs.Info);
466
+
467
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
468
+
| Ok a -> a
469
+
| Error e ->
470
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
471
+
exit 1
472
+
in
473
+
474
+
Eio.Switch.run @@ fun sw ->
475
+
let client = Zulip.Client.create ~sw env auth in
476
+
let bot_email = Zulip.Auth.email auth in
477
+
let storage = Bot_storage.create client ~bot_email in
478
+
479
+
match Vicuna_bot.remove_feed storage ~name with
480
+
| Ok () ->
481
+
Printf.printf "✅ Removed feed: %s\n" name;
482
+
exit 0
483
+
| Error e ->
484
+
Printf.eprintf "❌ Failed to remove feed: %s\n" (Zulip.error_message e);
485
+
exit 1
486
+
487
+
let cli_river_set_channel config_file channel env =
488
+
Logs.set_reporter (Logs_fmt.reporter ());
489
+
Logs.set_level (Some Logs.Info);
490
+
491
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
492
+
| Ok a -> a
493
+
| Error e ->
494
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
495
+
exit 1
496
+
in
497
+
498
+
Eio.Switch.run @@ fun sw ->
499
+
let client = Zulip.Client.create ~sw env auth in
500
+
let bot_email = Zulip.Auth.email auth in
501
+
let storage = Bot_storage.create client ~bot_email in
502
+
503
+
match Vicuna_bot.set_river_channel storage channel with
504
+
| Ok () ->
505
+
Printf.printf "✅ River channel set to: #%s\n" channel;
506
+
exit 0
507
+
| Error e ->
508
+
Printf.eprintf "❌ Failed to set channel: %s\n" (Zulip.error_message e);
509
+
exit 1
510
+
511
+
let cli_river_start config_file env =
512
+
Logs.set_reporter (Logs_fmt.reporter ());
513
+
Logs.set_level (Some Logs.Info);
514
+
515
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
516
+
| Ok a -> a
517
+
| Error e ->
518
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
519
+
exit 1
520
+
in
521
+
522
+
Eio.Switch.run @@ fun sw ->
523
+
let client = Zulip.Client.create ~sw env auth in
524
+
let bot_email = Zulip.Auth.email auth in
525
+
let storage = Bot_storage.create client ~bot_email in
526
+
527
+
match Vicuna_bot.enable_river_polling storage with
528
+
| Ok () ->
529
+
Printf.printf "✅ River polling enabled\n";
530
+
exit 0
531
+
| Error e ->
532
+
Printf.eprintf "❌ Failed to enable polling: %s\n" (Zulip.error_message e);
533
+
exit 1
534
+
535
+
let cli_river_stop config_file env =
536
+
Logs.set_reporter (Logs_fmt.reporter ());
537
+
Logs.set_level (Some Logs.Info);
538
+
539
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
540
+
| Ok a -> a
541
+
| Error e ->
542
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
543
+
exit 1
544
+
in
545
+
546
+
Eio.Switch.run @@ fun sw ->
547
+
let client = Zulip.Client.create ~sw env auth in
548
+
let bot_email = Zulip.Auth.email auth in
549
+
let storage = Bot_storage.create client ~bot_email in
550
+
551
+
match Vicuna_bot.disable_river_polling storage with
552
+
| Ok () ->
553
+
Printf.printf "⏸️ River polling disabled\n";
554
+
exit 0
555
+
| Error e ->
556
+
Printf.eprintf "❌ Failed to disable polling: %s\n" (Zulip.error_message e);
557
+
exit 1
558
+
362
559
(* CLI command definitions *)
363
560
let user_id_arg =
364
561
let doc = "Zulip user ID" in
···
447
644
] in
448
645
Cmd.group info ~default:default_term cmds
449
646
647
+
(* River command arguments *)
648
+
let feed_name_arg =
649
+
let doc = "Feed name" in
650
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"NAME" ~doc)
651
+
652
+
let feed_url_arg =
653
+
let doc = "Feed URL" in
654
+
Arg.(required & pos 1 (some string) None & info [] ~docv:"URL" ~doc)
655
+
656
+
let channel_arg =
657
+
let doc = "Zulip channel name" in
658
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"CHANNEL" ~doc)
659
+
660
+
(* River subcommands *)
661
+
let river_list_cmd eio_env =
662
+
let doc = "List all configured River feeds" in
663
+
let info = Cmd.info "list" ~doc in
664
+
Cmd.v info Term.(const cli_river_list $ config_file $ const eio_env)
665
+
666
+
let river_add_cmd eio_env =
667
+
let doc = "Add a new River feed" in
668
+
let info = Cmd.info "add" ~doc in
669
+
Cmd.v info Term.(const cli_river_add $ config_file $ feed_name_arg $ feed_url_arg $ const eio_env)
670
+
671
+
let river_remove_cmd eio_env =
672
+
let doc = "Remove a River feed" in
673
+
let info = Cmd.info "remove" ~doc in
674
+
Cmd.v info Term.(const cli_river_remove $ config_file $ feed_name_arg $ const eio_env)
675
+
676
+
let river_set_channel_cmd eio_env =
677
+
let doc = "Set the target Zulip channel for River posts" in
678
+
let info = Cmd.info "set-channel" ~doc in
679
+
Cmd.v info Term.(const cli_river_set_channel $ config_file $ channel_arg $ const eio_env)
680
+
681
+
let river_start_cmd eio_env =
682
+
let doc = "Enable automatic River polling" in
683
+
let info = Cmd.info "start" ~doc in
684
+
Cmd.v info Term.(const cli_river_start $ config_file $ const eio_env)
685
+
686
+
let river_stop_cmd eio_env =
687
+
let doc = "Disable automatic River polling" in
688
+
let info = Cmd.info "stop" ~doc in
689
+
Cmd.v info Term.(const cli_river_stop $ config_file $ const eio_env)
690
+
691
+
let river_group eio_env =
692
+
let doc = "Manage River feed aggregation" in
693
+
let info = Cmd.info "river" ~doc in
694
+
let default_term = Term.(ret (const (`Help (`Auto, None)))) in
695
+
let cmds = [
696
+
river_list_cmd eio_env;
697
+
river_add_cmd eio_env;
698
+
river_remove_cmd eio_env;
699
+
river_set_channel_cmd eio_env;
700
+
river_start_cmd eio_env;
701
+
river_stop_cmd eio_env;
702
+
] in
703
+
Cmd.group info ~default:default_term cmds
704
+
450
705
let main_group eio_env =
451
-
let default_info = Cmd.info "vicuna" ~version:"1.0.0" ~doc:"Vicuna - User Registration and Management Bot for Zulip" in
452
-
let default_term = Term.(const run_vicuna_bot $ config_file $ verbosity_term $ const eio_env) in
706
+
let default_info = Cmd.info "vicuna" ~version:"1.0.0" ~doc:"Vicuna - User Registration and Feed Aggregation Bot for Zulip" in
707
+
let default_term = Term.(const run_vicuna_bot $ config_file $ verbosity_term $ enable_river_flag $ const eio_env) in
453
708
let cmds = [
454
709
user_add_cmd eio_env;
455
710
user_remove_cmd eio_env;
···
457
712
admin_remove_cmd eio_env;
458
713
user_list_cmd eio_env;
459
714
storage_group eio_env;
715
+
river_group eio_env;
460
716
] in
461
717
Cmd.group default_info ~default:default_term cmds
462
718
+1
-1
stack/vicuna/lib/dune
+1
-1
stack/vicuna/lib/dune
+408
-15
stack/vicuna/lib/vicuna_bot.ml
+408
-15
stack/vicuna/lib/vicuna_bot.ml
···
13
13
full_name: string;
14
14
registered_at: float;
15
15
is_admin: bool;
16
+
last_river_post_date: float option; (** Timestamp of last River post for this user *)
16
17
}
17
18
18
19
(** Parse a user registration from JSON-like string format *)
19
20
let user_registration_of_string s : user_registration option =
20
21
try
21
-
(* Format: "email|zulip_id|full_name|timestamp|is_admin" *)
22
+
(* Format: "email|zulip_id|full_name|timestamp|is_admin|last_river_post_date" *)
22
23
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)
28
+
in
29
+
Some {
30
+
email;
31
+
zulip_id = int_of_string zulip_id_str;
32
+
full_name;
33
+
registered_at = float_of_string timestamp_str;
34
+
is_admin = bool_of_string is_admin_str;
35
+
last_river_post_date;
36
+
}
23
37
| [email; zulip_id_str; full_name; timestamp_str; is_admin_str] ->
38
+
(* Backward compatibility - old format without last_river_post_date *)
24
39
Some {
25
40
email;
26
41
zulip_id = int_of_string zulip_id_str;
27
42
full_name;
28
43
registered_at = float_of_string timestamp_str;
29
44
is_admin = bool_of_string is_admin_str;
45
+
last_river_post_date = None;
30
46
}
31
47
| [email; zulip_id_str; full_name; timestamp_str] ->
32
-
(* Backward compatibility - old format without is_admin *)
48
+
(* Backward compatibility - old format without is_admin and last_river_post_date *)
33
49
Some {
34
50
email;
35
51
zulip_id = int_of_string zulip_id_str;
36
52
full_name;
37
53
registered_at = float_of_string timestamp_str;
38
54
is_admin = false;
55
+
last_river_post_date = None;
39
56
}
40
57
| _ -> None
41
58
with _ -> None
42
59
43
60
(** Convert a user registration to string format *)
44
61
let user_registration_to_string (reg : user_registration) : string =
45
-
Printf.sprintf "%s|%d|%s|%f|%b"
62
+
let last_river_str = match reg.last_river_post_date with
63
+
| None -> "none"
64
+
| Some t -> string_of_float t
65
+
in
66
+
Printf.sprintf "%s|%d|%s|%f|%b|%s"
46
67
reg.email
47
68
reg.zulip_id
48
69
reg.full_name
49
70
reg.registered_at
50
71
reg.is_admin
72
+
last_river_str
51
73
52
74
(** Storage key for a user registration by Zulip ID - this is the only storage key we use *)
53
75
let storage_key_for_id zulip_id = Printf.sprintf "user:id:%d" zulip_id
···
128
150
| None -> is_admin || (zulip_id = default_admin_id)
129
151
in
130
152
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
156
+
| None -> None
157
+
in
158
+
131
159
let reg = {
132
160
email;
133
161
zulip_id;
134
162
full_name;
135
163
registered_at = Unix.gettimeofday ();
136
164
is_admin = final_is_admin;
165
+
last_river_post_date;
137
166
} in
138
167
let reg_str = user_registration_to_string reg in
139
168
···
178
207
String.contains domain '.'
179
208
| _ -> false
180
209
210
+
(** {1 River Integration Helper Functions} *)
211
+
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"
218
+
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
226
+
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
232
+
| Ok feeds ->
233
+
Log.debug (fun m -> m "Loaded %d feed sources" (List.length feeds));
234
+
feeds
235
+
| Error err ->
236
+
Log.err (fun m -> m "Failed to parse feed sources: %s" (Jsont.Error.to_string err));
237
+
[])
238
+
| _ ->
239
+
Log.debug (fun m -> m "No feed sources configured");
240
+
[]
241
+
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
245
+
| Ok json_str ->
246
+
Bot_storage.put storage ~key:river_feeds_key ~value:json_str
247
+
| Error err ->
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 ())
250
+
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) ())
257
+
else
258
+
let new_feed = { River.name; url } in
259
+
save_feed_sources storage (new_feed :: feeds)
260
+
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) ())
268
+
else
269
+
save_feed_sources storage updated_feeds
270
+
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
276
+
277
+
(** Set target Zulip channel *)
278
+
let set_river_channel storage channel =
279
+
Bot_storage.put storage ~key:river_channel_key ~value:channel
280
+
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
285
+
| _ -> false
286
+
287
+
(** Enable polling *)
288
+
let enable_river_polling storage =
289
+
Bot_storage.put storage ~key:river_polling_enabled_key ~value:"true"
290
+
291
+
(** Disable polling *)
292
+
let disable_river_polling storage =
293
+
Bot_storage.put storage ~key:river_polling_enabled_key ~value:"false"
294
+
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)
300
+
| _ -> None
301
+
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)
305
+
306
+
(** {1 Command Handlers} *)
307
+
181
308
(** Handle the 'register' command *)
182
309
let handle_register storage sender_email sender_id sender_name custom_email_opt =
183
310
(* First, try to fetch the user's profile from the Zulip API to get delivery_email and email *)
···
368
495
(List.length user_lines)
369
496
(String.concat "\n" user_lines)
370
497
498
+
(** Handle River 'feeds' command *)
499
+
let handle_river_feeds storage =
500
+
let feeds = load_feed_sources storage in
501
+
if feeds = [] then
502
+
"📡 No River feeds configured yet.\n\nUse `river add-feed <name> <url>` to add a feed."
503
+
else
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
506
+
) feeds in
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)
511
+
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
518
+
| Ok () ->
519
+
Printf.sprintf "✅ Added feed **%s**\n URL: `%s`\n\nUse `river sync` to fetch posts." name url
520
+
| Error e ->
521
+
Printf.sprintf "❌ Failed to add feed: %s" (Zulip.error_message e))
522
+
| _ ->
523
+
"Usage: `river add-feed <name> <url>`\n\nExample: `river add-feed \"OCaml Blog\" https://ocaml.org/blog/feed.xml`"
524
+
525
+
(** Handle River 'remove-feed' command *)
526
+
let handle_river_remove_feed storage args =
527
+
let name = String.trim args in
528
+
if name = "" then
529
+
"Usage: `river remove-feed <name>`\n\nExample: `river remove-feed \"OCaml Blog\"`"
530
+
else
531
+
match remove_feed storage ~name with
532
+
| Ok () ->
533
+
Printf.sprintf "✅ Removed feed: **%s**" name
534
+
| Error e ->
535
+
Printf.sprintf "❌ Failed to remove feed: %s" (Zulip.error_message e)
536
+
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)
543
+
else
544
+
match set_river_channel storage channel with
545
+
| Ok () ->
546
+
Printf.sprintf "✅ River posts will now go to #%s" channel
547
+
| Error e ->
548
+
Printf.sprintf "❌ Failed to set channel: %s" (Zulip.error_message e)
549
+
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)
555
+
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)
561
+
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
568
+
| None -> "Never"
569
+
in
570
+
Printf.sprintf "📊 River Feed Integration Status:\n\
571
+
• Polling: %s\n\
572
+
• Target channel: #%s\n\
573
+
• Feeds configured: %d\n\
574
+
• Last sync: %s"
575
+
polling_status
576
+
(get_river_channel storage)
577
+
(List.length feeds)
578
+
last_sync
579
+
371
580
(** Handle the 'help' command *)
372
581
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\
582
+
Printf.sprintf "👋 Hi %s! I'm **Vicuna**, your user registration and feed aggregation assistant.\n\n\
583
+
**User Registration Commands:**\n\
375
584
• `register` - Auto-detect your real email or use Zulip email\n\
376
585
• `register <your-email@example.com>` - Register with a specific email\n\
377
586
• `whoami` - Show your registration status\n\
378
587
• `whois <email|id>` - Look up a registered user\n\
379
-
• `list` - List all registered users\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\
380
598
• `help` - Show this help message\n\n\
381
599
**Examples:**\n\
382
600
• `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\
601
+
• `river add-feed \"OCaml Weekly\" https://ocaml.org/feed.xml`\n\
602
+
• `river set-channel sandbox-test`\n\n\
392
603
Send me a direct message to get started!"
393
604
sender_name sender_email
394
605
···
456
667
handle_whois storage args
457
668
| "list" ->
458
669
handle_list storage
670
+
| "river" ->
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
687
+
| "status" ->
688
+
handle_river_status storage
689
+
| "sync" ->
690
+
"⏳ Syncing River feeds... (Note: sync requires environment access, use CLI for now)"
691
+
| _ ->
692
+
Printf.sprintf "Unknown river command: `%s`\n\nAvailable: feeds, add-feed, remove-feed, set-channel, start, stop, status, sync" subcmd)
459
693
| _ ->
460
694
Printf.sprintf "Unknown command: `%s`. Use `help` to see available commands." command
461
695
in
···
496
730
| Error _ as err -> err
497
731
| Ok () -> Bot_storage.remove storage ~key
498
732
) (Ok ()) keys
733
+
734
+
(** Normalize a name for fuzzy matching *)
735
+
let normalize_name name =
736
+
name
737
+
|> String.lowercase_ascii
738
+
|> String.trim
739
+
|> Str.global_replace (Str.regexp "[ \t\n\r]+") " "
740
+
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
747
+
| _ -> None
748
+
) all_ids
749
+
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
757
+
| _ -> None
758
+
) all_ids
759
+
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
767
+
| Some user ->
768
+
Log.debug (fun m -> m "Matched by email: %s" user.email);
769
+
Some user
770
+
| None ->
771
+
(match lookup_user_by_name_exact storage author_name with
772
+
| Some user ->
773
+
Log.debug (fun m -> m "Matched by exact name: %s" user.full_name);
774
+
Some user
775
+
| None ->
776
+
match lookup_user_by_name_fuzzy storage author_name with
777
+
| Some user ->
778
+
Log.debug (fun m -> m "Matched by fuzzy name: %s" user.full_name);
779
+
Some user
780
+
| None ->
781
+
Log.debug (fun m -> m "No user match found");
782
+
None)
783
+
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) ^ "..."
789
+
790
+
(** Format a River post for Zulip *)
791
+
let format_river_post ~user_match (post : River.post) =
792
+
let summary =
793
+
match River.summary post with
794
+
| Some s -> s
795
+
| None -> content_to_summary (River.content post) ~max_length:200
796
+
in
797
+
let author_line =
798
+
match user_match with
799
+
| Some user -> Printf.sprintf "By @**%s**" user.full_name
800
+
| None -> Printf.sprintf "By %s" (River.author post)
801
+
in
802
+
let link_line =
803
+
match River.link post with
804
+
| Some uri -> Printf.sprintf "\n\n[Read more](%s)" (Uri.to_string uri)
805
+
| None -> ""
806
+
in
807
+
Printf.sprintf "%s\n\n%s%s" author_line summary link_line
808
+
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
814
+
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
819
+
| Some ptime ->
820
+
let timestamp = Ptime.to_float_s ptime in
821
+
(match acc with
822
+
| None -> Some timestamp
823
+
| Some existing -> Some (max existing timestamp))
824
+
| None -> acc
825
+
) None posts
826
+
827
+
(** Filter posts newer than a timestamp *)
828
+
let filter_posts_since posts since_opt =
829
+
match since_opt with
830
+
| None -> posts
831
+
| Some since ->
832
+
List.filter (fun post ->
833
+
match River.date post with
834
+
| Some ptime ->
835
+
Ptime.to_float_s ptime > since
836
+
| None -> true
837
+
) posts
838
+
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
843
+
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");
850
+
Ok 0
851
+
) else
852
+
try
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
858
+
) feeds in
859
+
let all_posts = River.posts fetched_feeds in
860
+
Log.info (fun m -> m "Fetched %d total posts" (List.length all_posts));
861
+
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
866
+
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))
877
+
) new_posts;
878
+
879
+
match get_latest_post_date all_posts with
880
+
| Some latest -> let _ = update_user_river_date storage user latest in ()
881
+
| None -> ()
882
+
) users;
883
+
884
+
let _ = update_river_last_sync storage (Unix.gettimeofday ()) in
885
+
Log.info (fun m -> m "Sync complete, posted %d items" !posted_count);
886
+
Ok !posted_count
887
+
)
888
+
with exn ->
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 ())
499
892
500
893
(** Create the bot handler instance *)
501
894
let create_handler config storage identity =
+57
stack/vicuna/lib/vicuna_bot.mli
+57
stack/vicuna/lib/vicuna_bot.mli
···
52
52
full_name: string;
53
53
registered_at: float;
54
54
is_admin: bool;
55
+
last_river_post_date: float option; (** Timestamp of last River post for this user *)
55
56
}
56
57
57
58
val lookup_user_by_id :
···
82
83
val clear_storage :
83
84
Zulip_bot.Bot_storage.t ->
84
85
(unit, Zulip.zerror) result
86
+
87
+
(** {1 River Feed Integration} *)
88
+
89
+
(** Load configured River feed sources *)
90
+
val load_feed_sources :
91
+
Zulip_bot.Bot_storage.t ->
92
+
River.source list
93
+
94
+
(** Add a River feed source *)
95
+
val add_feed :
96
+
Zulip_bot.Bot_storage.t ->
97
+
name:string ->
98
+
url:string ->
99
+
(unit, Zulip.zerror) result
100
+
101
+
(** Remove a River feed source *)
102
+
val remove_feed :
103
+
Zulip_bot.Bot_storage.t ->
104
+
name:string ->
105
+
(unit, Zulip.zerror) result
106
+
107
+
(** Get the target Zulip channel for River posts *)
108
+
val get_river_channel :
109
+
Zulip_bot.Bot_storage.t ->
110
+
string
111
+
112
+
(** Set the target Zulip channel for River posts *)
113
+
val set_river_channel :
114
+
Zulip_bot.Bot_storage.t ->
115
+
string ->
116
+
(unit, Zulip.zerror) result
117
+
118
+
(** Check if River polling is enabled *)
119
+
val is_river_polling_enabled :
120
+
Zulip_bot.Bot_storage.t ->
121
+
bool
122
+
123
+
(** Enable automatic River polling *)
124
+
val enable_river_polling :
125
+
Zulip_bot.Bot_storage.t ->
126
+
(unit, Zulip.zerror) result
127
+
128
+
(** Disable automatic River polling *)
129
+
val disable_river_polling :
130
+
Zulip_bot.Bot_storage.t ->
131
+
(unit, Zulip.zerror) result
132
+
133
+
(** Sync River feeds and post new items to Zulip *)
134
+
val sync_river_and_post :
135
+
env:< clock : float Eio.Time.clock_ty Eio.Resource.t;
136
+
fs : Eio.Fs.dir_ty Eio.Path.t;
137
+
net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t; .. > ->
138
+
storage:Zulip_bot.Bot_storage.t ->
139
+
client:Zulip.Client.t ->
140
+
unit ->
141
+
(int, Zulip.zerror) result