this repo has no description
sync
+41
-729
+5
-261
stack/vicuna/bin/main.ml
+5
-261
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 enable_river env =
9
+
let run_vicuna_bot config_file verbosity 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 & Feed Aggregation");
20
+
Log.app (fun m -> m "Starting Vicuna Bot - User Registration Manager");
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
-
103
60
(* Create the bot handler using the Vicuna bot library *)
104
61
Log.debug (fun m -> m "Creating Vicuna bot handler");
105
62
let handler = Vicuna_bot.create_handler config storage identity in
···
109
66
110
67
Log.app (fun m -> m "✨ Vicuna bot is running!");
111
68
Log.app (fun m -> m "📬 Send me a direct message to get started.");
112
-
Log.app (fun m -> m "🤖 Commands: 'register', 'whoami', 'whois', 'list', 'river', 'help'");
69
+
Log.app (fun m -> m "🤖 Commands: 'register', 'whoami', 'whois', 'list', 'help'");
113
70
Log.app (fun m -> m "⛔ Press Ctrl+C to stop.\n");
114
71
115
72
(* Run in real-time mode *)
···
139
96
140
97
let verbosity_term =
141
98
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)
146
99
147
100
(* CLI management commands *)
148
101
let cli_add_user config_file user_id email full_name is_admin env =
···
406
359
exit 1
407
360
)
408
361
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
-
559
362
(* CLI command definitions *)
560
363
let user_id_arg =
561
364
let doc = "Zulip user ID" in
···
644
447
] in
645
448
Cmd.group info ~default:default_term cmds
646
449
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
-
705
450
let main_group eio_env =
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
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
708
453
let cmds = [
709
454
user_add_cmd eio_env;
710
455
user_remove_cmd eio_env;
···
712
457
admin_remove_cmd eio_env;
713
458
user_list_cmd eio_env;
714
459
storage_group eio_env;
715
-
river_group eio_env;
716
460
] in
717
461
Cmd.group default_info ~default:default_term cmds
718
462
+1
-1
stack/vicuna/lib/dune
+1
-1
stack/vicuna/lib/dune
+15
-408
stack/vicuna/lib/vicuna_bot.ml
+15
-408
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 *)
17
16
}
18
17
19
18
(** Parse a user registration from JSON-like string format *)
20
19
let user_registration_of_string s : user_registration option =
21
20
try
22
-
(* Format: "email|zulip_id|full_name|timestamp|is_admin|last_river_post_date" *)
21
+
(* Format: "email|zulip_id|full_name|timestamp|is_admin" *)
23
22
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
-
}
37
23
| [email; zulip_id_str; full_name; timestamp_str; is_admin_str] ->
38
-
(* Backward compatibility - old format without last_river_post_date *)
39
24
Some {
40
25
email;
41
26
zulip_id = int_of_string zulip_id_str;
42
27
full_name;
43
28
registered_at = float_of_string timestamp_str;
44
29
is_admin = bool_of_string is_admin_str;
45
-
last_river_post_date = None;
46
30
}
47
31
| [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 *)
49
33
Some {
50
34
email;
51
35
zulip_id = int_of_string zulip_id_str;
52
36
full_name;
53
37
registered_at = float_of_string timestamp_str;
54
38
is_admin = false;
55
-
last_river_post_date = None;
56
39
}
57
40
| _ -> None
58
41
with _ -> None
59
42
60
43
(** Convert a user registration to string format *)
61
44
let user_registration_to_string (reg : user_registration) : string =
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"
45
+
Printf.sprintf "%s|%d|%s|%f|%b"
67
46
reg.email
68
47
reg.zulip_id
69
48
reg.full_name
70
49
reg.registered_at
71
50
reg.is_admin
72
-
last_river_str
73
51
74
52
(** Storage key for a user registration by Zulip ID - this is the only storage key we use *)
75
53
let storage_key_for_id zulip_id = Printf.sprintf "user:id:%d" zulip_id
···
150
128
| None -> is_admin || (zulip_id = default_admin_id)
151
129
in
152
130
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
-
159
131
let reg = {
160
132
email;
161
133
zulip_id;
162
134
full_name;
163
135
registered_at = Unix.gettimeofday ();
164
136
is_admin = final_is_admin;
165
-
last_river_post_date;
166
137
} in
167
138
let reg_str = user_registration_to_string reg in
168
139
···
207
178
String.contains domain '.'
208
179
| _ -> false
209
180
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
-
308
181
(** Handle the 'register' command *)
309
182
let handle_register storage sender_email sender_id sender_name custom_email_opt =
310
183
(* First, try to fetch the user's profile from the Zulip API to get delivery_email and email *)
···
495
368
(List.length user_lines)
496
369
(String.concat "\n" user_lines)
497
370
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
-
580
371
(** Handle the 'help' command *)
581
372
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\
584
375
• `register` - Auto-detect your real email or use Zulip email\n\
585
376
• `register <your-email@example.com>` - Register with a specific email\n\
586
377
• `whoami` - Show your registration status\n\
587
378
• `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\
598
380
• `help` - Show this help message\n\n\
599
381
**Examples:**\n\
600
382
• `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\
603
392
Send me a direct message to get started!"
604
393
sender_name sender_email
605
394
···
667
456
handle_whois storage args
668
457
| "list" ->
669
458
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)
693
459
| _ ->
694
460
Printf.sprintf "Unknown command: `%s`. Use `help` to see available commands." command
695
461
in
···
730
496
| Error _ as err -> err
731
497
| Ok () -> Bot_storage.remove storage ~key
732
498
) (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 ())
892
499
893
500
(** Create the bot handler instance *)
894
501
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 *)
56
55
}
57
56
58
57
val lookup_user_by_id :
···
83
82
val clear_storage :
84
83
Zulip_bot.Bot_storage.t ->
85
84
(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
+20
-2
stack/zulip/lib/zulip_bot/lib/bot_runner.ml
+20
-2
stack/zulip/lib/zulip_bot/lib/bot_runner.ml
···
120
120
| Error e ->
121
121
Log.err (fun m -> m "Error sending reply: %s" (Zulip.error_message e)))
122
122
123
+
| Ok (Bot_handler.Response.DirectMessage { to_; content }) ->
124
+
Log.debug (fun m -> m "Bot is sending direct message to: %s" to_);
125
+
let message_to_send = Zulip.Message.create ~type_:`Direct ~to_:[to_] ~content () in
126
+
(match Zulip.Messages.send t.client message_to_send with
127
+
| Ok resp ->
128
+
Log.info (fun m -> m "Direct message sent successfully (id: %d)"
129
+
(Zulip.Message_response.id resp))
130
+
| Error e ->
131
+
Log.err (fun m -> m "Error sending direct message: %s" (Zulip.error_message e)))
132
+
133
+
| Ok (Bot_handler.Response.ChannelMessage { channel; topic; content }) ->
134
+
Log.debug (fun m -> m "Bot is sending channel message to #%s - %s" channel topic);
135
+
let message_to_send = Zulip.Message.create ~type_:`Channel ~to_:[channel] ~topic ~content () in
136
+
(match Zulip.Messages.send t.client message_to_send with
137
+
| Ok resp ->
138
+
Log.info (fun m -> m "Channel message sent successfully (id: %d)"
139
+
(Zulip.Message_response.id resp))
140
+
| Error e ->
141
+
Log.err (fun m -> m "Error sending channel message: %s" (Zulip.error_message e)))
142
+
123
143
| Ok (Bot_handler.Response.None) ->
124
144
Log.info (fun m -> m "Bot handler returned no response")
125
-
| Ok _ ->
126
-
Log.info (fun m -> m "Bot handler returned unhandled response type")
127
145
| Error e ->
128
146
Log.err (fun m -> m "Error handling message: %s" (Zulip.error_message e))
129
147
) else (