this repo has no description
vicuna
+1571
+32
stack/vicuna/.gitignore
+32
stack/vicuna/.gitignore
···
1
+
# Dune build artifacts
2
+
_build/
3
+
*.install
4
+
*.merlin
5
+
6
+
# OCaml artifacts
7
+
*.cmi
8
+
*.cmo
9
+
*.cmx
10
+
*.cma
11
+
*.cmxa
12
+
*.cmxs
13
+
*.o
14
+
*.a
15
+
*.so
16
+
*.annot
17
+
*.cmt
18
+
*.cmti
19
+
20
+
# Editor files
21
+
*.swp
22
+
*~
23
+
.vscode/
24
+
.idea/
25
+
26
+
# Configuration files with credentials
27
+
.zuliprc
28
+
*.zuliprc
29
+
30
+
# OS files
31
+
.DS_Store
32
+
Thumbs.db
+14
stack/vicuna/.zuliprc.example
+14
stack/vicuna/.zuliprc.example
···
1
+
# Example Zulip configuration file for Vicuna bot
2
+
# Copy this to ~/.zuliprc and fill in your bot's credentials
3
+
4
+
[api]
5
+
email=vicuna-bot@your-domain.zulipchat.com
6
+
key=your-bot-api-key-here
7
+
site=https://your-domain.zulipchat.com
8
+
9
+
# To get your bot's API key:
10
+
# 1. Go to your Zulip instance's settings
11
+
# 2. Navigate to Settings > Your bots
12
+
# 3. Create a new bot or select an existing one
13
+
# 4. Copy the API key and email address
14
+
# 5. Update the values above
+265
stack/vicuna/README.md
+265
stack/vicuna/README.md
···
1
+
# Vicuna Bot
2
+
3
+
A Zulip bot for user registration and management. Vicuna helps users register their email addresses and Zulip IDs, creating a persistent directory for easy @mentions and user tracking.
4
+
5
+
## Features
6
+
7
+
- **User Registration**: Users can register themselves by sending a simple command
8
+
- **Custom Email Support**: Register with your actual email address (not just the auto-generated Zulip email)
9
+
- **Persistent Storage**: All registrations are stored on the server using Zulip's bot storage API
10
+
- **Bidirectional Lookup**: Look up users by email address or Zulip ID
11
+
- **Message-based Configuration**: All configuration happens via messages to the bot
12
+
- **User Directory**: List all registered users
13
+
14
+
## OAuth/SSO Email Issue & Solution
15
+
16
+
**Problem:** Many Zulip instances that use OAuth, SSO, or other authentication methods assign auto-generated emails to users like `user123@zulipchat.com` instead of their actual email addresses.
17
+
18
+
**Smart Solution:** Vicuna automatically tries to find your real email address!
19
+
20
+
When you type `register`, the bot uses this priority:
21
+
1. **Custom email** you provide: `register alice@company.com` (highest priority)
22
+
2. **delivery_email** from your Zulip profile (the real email associated with your account)
23
+
3. **user.email** from your Zulip profile API (may differ from message sender email)
24
+
4. **Zulip message email** as a last resort (the internal `user@zulipchat.com` style)
25
+
26
+
This means **most users can just type `register`** and the bot will automatically use their real email address!
27
+
28
+
### Manual Email Registration
29
+
30
+
If needed, you can still manually specify your email:
31
+
32
+
```bash
33
+
register your-actual-email@example.com
34
+
```
35
+
36
+
The bot will:
37
+
- Store your actual email for lookups
38
+
- Still track your Zulip ID for @mentions
39
+
- Show you both your registered email and your Zulip-internal email
40
+
41
+
This way, colleagues can find you by your real email address while the bot maintains the proper Zulip ID mapping.
42
+
43
+
## Installation
44
+
45
+
```bash
46
+
# Build the bot
47
+
cd vicuna
48
+
dune build
49
+
50
+
# Install (optional)
51
+
dune install
52
+
```
53
+
54
+
## Configuration
55
+
56
+
Create a `~/.zuliprc` file with your bot credentials:
57
+
58
+
```ini
59
+
[api]
60
+
email=vicuna-bot@your-domain.zulipchat.com
61
+
key=your-bot-api-key
62
+
site=https://your-domain.zulipchat.com
63
+
```
64
+
65
+
## Usage
66
+
67
+
### Running the Bot
68
+
69
+
```bash
70
+
# Run with default configuration
71
+
vicuna
72
+
73
+
# Run with verbose logging
74
+
vicuna -v
75
+
76
+
# Run with debug logging
77
+
vicuna -vv
78
+
79
+
# Run with custom config file
80
+
vicuna -c /path/to/.zuliprc
81
+
```
82
+
83
+
### Bot Commands
84
+
85
+
Send these commands to the bot via direct message or by mentioning it in a channel:
86
+
87
+
#### `register` or `register <your-email@example.com>`
88
+
Register your email and Zulip ID in the system.
89
+
90
+
**Smart auto-detection** (recommended - just type `register`):
91
+
```
92
+
> register
93
+
✅ Successfully registered!
94
+
• Email: `alice@mycompany.com`
95
+
• Zulip ID: `12345`
96
+
• Full Name: `Alice Smith`
97
+
98
+
💡 Your Zulip email is: `user123@zulipchat.com`
99
+
📧 Using your delivery email from your profile
100
+
You can now be @mentioned by your email or Zulip ID!
101
+
```
102
+
103
+
The bot automatically fetched `alice@mycompany.com` from your Zulip profile's `delivery_email` field!
104
+
105
+
**Manual registration** (if you want to override):
106
+
```
107
+
> register alice@different-email.com
108
+
✅ Successfully registered!
109
+
• Email: `alice@different-email.com`
110
+
• Zulip ID: `12345`
111
+
• Full Name: `Alice Smith`
112
+
113
+
💡 Your Zulip email is: `user123@zulipchat.com`
114
+
📝 Using the custom email you provided
115
+
You can now be @mentioned by your email or Zulip ID!
116
+
```
117
+
118
+
**Note:** The bot tries four sources in order:
119
+
1. Custom email you provide (highest priority)
120
+
2. `delivery_email` from your Zulip profile (auto-detected)
121
+
3. `user.email` from your Zulip profile API (may be real email depending on permissions)
122
+
4. Zulip message sender email (fallback)
123
+
124
+
#### `whoami`
125
+
Check your registration status.
126
+
127
+
```
128
+
> whoami
129
+
📋 Your registration info:
130
+
• Email: `alice@example.com`
131
+
• Zulip ID: `12345`
132
+
• Full Name: `Alice Smith`
133
+
• Registered: 2025-01-15 10:30:45
134
+
```
135
+
136
+
#### `whois <email|id>`
137
+
Look up a registered user by their email or Zulip ID.
138
+
139
+
```
140
+
> whois bob@example.com
141
+
👤 User found:
142
+
• Email: `bob@example.com`
143
+
• Zulip ID: `67890`
144
+
• Full Name: `Bob Jones`
145
+
• Registered: 2025-01-14 09:15:22
146
+
147
+
> whois 67890
148
+
👤 User found:
149
+
• Email: `bob@example.com`
150
+
• Zulip ID: `67890`
151
+
• Full Name: `Bob Jones`
152
+
• Registered: 2025-01-14 09:15:22
153
+
```
154
+
155
+
#### `list`
156
+
List all registered users.
157
+
158
+
```
159
+
> list
160
+
📋 Registered users (3):
161
+
• **Alice Smith** (`alice@example.com`) - ID: 12345
162
+
• **Bob Jones** (`bob@example.com`) - ID: 67890
163
+
• **Carol White** (`carol@example.com`) - ID: 54321
164
+
```
165
+
166
+
#### `help`
167
+
Show available commands and usage information.
168
+
169
+
```
170
+
> help
171
+
👋 Hi Alice! I'm **Vicuna**, your user registration assistant.
172
+
173
+
Available Commands:
174
+
• `register` - Register with your Zulip email
175
+
• `register <your-email@example.com>` - Register with a custom email
176
+
• `whoami` - Show your registration status
177
+
• `whois <email|id>` - Look up a registered user
178
+
• `list` - List all registered users
179
+
• `help` - Show this help message
180
+
181
+
Examples:
182
+
• `register` - Register with Zulip email (`user123@zulipchat.com`)
183
+
• `register alice@mycompany.com` - Register with your actual email
184
+
• `whois alice@example.com` - Look up Alice by email
185
+
• `whois 12345` - Look up user by Zulip ID
186
+
187
+
Note: Many Zulip instances use auto-generated emails like `user@zulipchat.com`.
188
+
You can provide your actual email address during registration!
189
+
190
+
Send me a direct message to get started!
191
+
```
192
+
193
+
## Architecture
194
+
195
+
### Libraries Used
196
+
197
+
- **zulip**: OCaml bindings for the Zulip REST API
198
+
- **zulip_bot**: Bot framework for building interactive Zulip bots
199
+
- **eio**: Effects-based I/O for async operations
200
+
- **logs**: Structured logging
201
+
- **cmdliner**: Command-line interface
202
+
203
+
### Storage
204
+
205
+
Vicuna uses Zulip's bot storage API to persist user registrations. The storage format is:
206
+
207
+
- **User by email**: `user:email:<email>` → `<email>|<zulip_id>|<full_name>|<timestamp>`
208
+
- **User by ID**: `user:id:<zulip_id>` → `<email>|<zulip_id>|<full_name>|<timestamp>`
209
+
- **User list**: `users:all` → `<email1>,<email2>,<email3>,...`
210
+
211
+
This allows for efficient bidirectional lookups and maintains a master list of all registered users.
212
+
213
+
## Development
214
+
215
+
### Project Structure
216
+
217
+
```
218
+
vicuna/
219
+
├── dune-project # Project definition
220
+
├── README.md # This file
221
+
├── lib/ # Bot library
222
+
│ ├── dune # Library build config
223
+
│ ├── vicuna_bot.ml # Bot implementation
224
+
│ └── vicuna_bot.mli # Bot interface
225
+
└── bin/ # Executable
226
+
├── dune # Executable build config
227
+
└── main.ml # Main entry point
228
+
```
229
+
230
+
### Building
231
+
232
+
```bash
233
+
# Build the project
234
+
dune build
235
+
236
+
# Build with verbose output
237
+
dune build --verbose
238
+
239
+
# Clean build artifacts
240
+
dune clean
241
+
```
242
+
243
+
### Testing
244
+
245
+
You can test the bot by running it and sending messages to it in your Zulip instance:
246
+
247
+
1. Create a bot account in your Zulip instance
248
+
2. Download the bot's `.zuliprc` file
249
+
3. Run `vicuna -c path/to/.zuliprc -vv`
250
+
4. Send a direct message to the bot with `help`
251
+
252
+
## License
253
+
254
+
This project is part of the knot/slop/stack collection.
255
+
256
+
## Dependencies
257
+
258
+
- OCaml 4.08+
259
+
- Dune 3.0+
260
+
- eio
261
+
- zulip (from ../zulip)
262
+
- zulip_bot (from ../zulip)
263
+
- logs
264
+
- cmdliner
265
+
- mirage-crypto-rng-unix
+170
stack/vicuna/USAGE.md
+170
stack/vicuna/USAGE.md
···
1
+
# Vicuna Bot - Quick Usage Guide
2
+
3
+
## The Email Problem
4
+
5
+
When you authenticate to Zulip using OAuth, SSO, or other third-party authentication methods, Zulip often assigns you an auto-generated email address like:
6
+
7
+
- `user123@zulipchat.com`
8
+
- `person456@zulip.example.com`
9
+
10
+
This isn't your actual email address - it's just an internal identifier.
11
+
12
+
## The Smart Solution
13
+
14
+
**Good news!** Vicuna now automatically detects your real email address from your Zulip profile!
15
+
16
+
Most users can simply type `register` and the bot will try multiple sources:
17
+
1. Your `delivery_email` from Zulip profile (the real email associated with your account)
18
+
2. Your `user.email` from Zulip profile API (may be your real email depending on server config)
19
+
3. Your Zulip message sender email as a fallback
20
+
21
+
**No need to manually provide your email in most cases!**
22
+
23
+
## Registration Options
24
+
25
+
### Option 1: Smart Auto-Detection (RECOMMENDED - Just type `register`)
26
+
27
+
```
28
+
> register
29
+
```
30
+
31
+
The bot will automatically fetch your real email from your Zulip profile!
32
+
33
+
**Response (when delivery_email is available):**
34
+
```
35
+
✅ Successfully registered!
36
+
• Email: `alice@mycompany.com`
37
+
• Zulip ID: `12345`
38
+
• Full Name: `Alice Smith`
39
+
40
+
💡 Your Zulip email is: `user123@zulipchat.com`
41
+
📧 Using your delivery email from your profile
42
+
You can now be @mentioned by your email or Zulip ID!
43
+
```
44
+
45
+
The bot automatically found `alice@mycompany.com` from your profile!
46
+
47
+
**Response (when delivery_email is NOT available):**
48
+
```
49
+
✅ Successfully registered!
50
+
• Email: `user123@zulipchat.com`
51
+
• Zulip ID: `12345`
52
+
• Full Name: `Alice Smith`
53
+
54
+
💡 Your Zulip email is: `user123@zulipchat.com`
55
+
You can now be @mentioned by your email or Zulip ID!
56
+
```
57
+
58
+
Falls back to Zulip email if delivery_email isn't available.
59
+
60
+
### Option 2: Manual Email Override
61
+
62
+
```
63
+
> register alice@mycompany.com
64
+
```
65
+
66
+
Manually specify a custom email (overrides auto-detection).
67
+
68
+
**Response:**
69
+
```
70
+
✅ Successfully registered!
71
+
• Email: `alice@mycompany.com`
72
+
• Zulip ID: `12345`
73
+
• Full Name: `Alice Smith`
74
+
75
+
💡 Your Zulip email is: `user123@zulipchat.com`
76
+
📝 Using the custom email you provided
77
+
You can now be @mentioned by your email or Zulip ID!
78
+
```
79
+
80
+
## Lookup Examples
81
+
82
+
### Find Someone by Email
83
+
84
+
```
85
+
> whois alice@mycompany.com
86
+
87
+
👤 User found:
88
+
• Email: `alice@mycompany.com`
89
+
• Zulip ID: `12345`
90
+
• Full Name: `Alice Smith`
91
+
• Registered: 2025-01-15 10:30:45
92
+
```
93
+
94
+
### Find Someone by Zulip ID
95
+
96
+
```
97
+
> whois 12345
98
+
99
+
👤 User found:
100
+
• Email: `alice@mycompany.com`
101
+
• Zulip ID: `12345`
102
+
• Full Name: `Alice Smith`
103
+
• Registered: 2025-01-15 10:30:45
104
+
```
105
+
106
+
## Check Your Status
107
+
108
+
```
109
+
> whoami
110
+
111
+
📋 Your registration info:
112
+
• Email: `alice@mycompany.com`
113
+
• Zulip ID: `12345`
114
+
• Full Name: `Alice Smith`
115
+
• Registered: 2025-01-15 10:30:45
116
+
```
117
+
118
+
## List All Users
119
+
120
+
```
121
+
> list
122
+
123
+
📋 Registered users (3):
124
+
• **Alice Smith** (`alice@mycompany.com`) - ID: 12345
125
+
• **Bob Jones** (`bob@company.org`) - ID: 67890
126
+
• **Carol White** (`carol@example.com`) - ID: 54321
127
+
```
128
+
129
+
## Get Help
130
+
131
+
```
132
+
> help
133
+
```
134
+
135
+
Shows all available commands and examples.
136
+
137
+
## Pro Tips
138
+
139
+
1. **Just type `register`** - In most cases, the bot will automatically find your real email from your profile!
140
+
2. **Check if it worked** - Use `whoami` after registering to see which email was used
141
+
3. **Manual override if needed** - If the auto-detection didn't work, use `register your-email@example.com`
142
+
4. **Encourage your team to register** - The more people registered, the more useful the directory
143
+
5. **Update your registration** - If your email changes, just register again with the new one
144
+
6. **The bot stores both emails** - It knows your registered email AND your Zulip internal email
145
+
146
+
## How Smart Detection Works
147
+
148
+
The bot uses this priority order:
149
+
150
+
1. **Custom email** (if you provide one): `register alice@company.com` - Highest priority
151
+
2. **delivery_email** (from Zulip profile API): Your real email address associated with the account
152
+
3. **user.email** (from Zulip profile API): Email from profile (if different from message sender)
153
+
4. **Message sender email** (fallback): The internal `user@zulipchat.com` style email
154
+
155
+
This means the bot will use the best available email automatically!
156
+
157
+
### Why Multiple Sources?
158
+
159
+
- **delivery_email**: The most reliable source for real email, but may be `null` depending on permissions
160
+
- **user.email**: Another source from the API that may contain the real email depending on server configuration
161
+
- **Message sender email**: Always available but often an auto-generated internal identifier
162
+
163
+
The bot tries each in order until it finds a usable email address.
164
+
165
+
## Admin Considerations
166
+
167
+
- **No admin permissions needed** - Users can register themselves
168
+
- **Server-side storage** - All data is stored using Zulip's bot storage API
169
+
- **No custom profile fields required** - Works out of the box on any Zulip instance
170
+
- **Privacy** - Only registered users appear in the directory (opt-in)
+14
stack/vicuna/bin/dune
+14
stack/vicuna/bin/dune
+467
stack/vicuna/bin/main.ml
+467
stack/vicuna/bin/main.ml
···
1
+
(* Vicuna Bot - User Registration and Management Bot for Zulip *)
2
+
3
+
open Zulip_bot
4
+
5
+
(* Set up logging *)
6
+
let src = Logs.Src.create "vicuna" ~doc:"Vicuna User Registration Bot"
7
+
module Log = (val Logs.src_log src : Logs.LOG)
8
+
9
+
let run_vicuna_bot config_file verbosity env =
10
+
(* Set up logging based on verbosity *)
11
+
Logs.set_reporter (Logs_fmt.reporter ());
12
+
let log_level = match verbosity with
13
+
| 0 -> Logs.Info
14
+
| 1 -> Logs.Debug
15
+
| _ -> Logs.Debug (* Cap at debug level *)
16
+
in
17
+
Logs.set_level (Some log_level);
18
+
Logs.Src.set_level src (Some log_level);
19
+
20
+
Log.app (fun m -> m "Starting Vicuna Bot - User Registration Manager");
21
+
Log.app (fun m -> m "Log level: %s" (Logs.level_to_string (Some log_level)));
22
+
Log.app (fun m -> m "========================================\n");
23
+
24
+
(* Load authentication from .zuliprc file *)
25
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
26
+
| Ok a ->
27
+
Log.info (fun m -> m "Loaded authentication for: %s" (Zulip.Auth.email a));
28
+
Log.info (fun m -> m "Server: %s" (Zulip.Auth.server_url a));
29
+
a
30
+
| Error e ->
31
+
Log.err (fun m -> m "Failed to load .zuliprc: %s" (Zulip.error_message e));
32
+
Log.app (fun m -> m "\nPlease create a ~/.zuliprc file with:");
33
+
Log.app (fun m -> m "[api]");
34
+
Log.app (fun m -> m "email=bot@example.com");
35
+
Log.app (fun m -> m "key=your-api-key");
36
+
Log.app (fun m -> m "site=https://your-domain.zulipchat.com");
37
+
exit 1
38
+
in
39
+
40
+
Eio.Switch.run @@ fun sw ->
41
+
Log.debug (fun m -> m "Creating Zulip client");
42
+
let client = Zulip.Client.create ~sw env auth in
43
+
44
+
(* Create bot configuration *)
45
+
let config = Bot_config.create [] in
46
+
let bot_email = Zulip.Auth.email auth in
47
+
48
+
Log.debug (fun m -> m "Creating bot storage for %s" bot_email);
49
+
let storage = Bot_storage.create client ~bot_email in
50
+
51
+
let identity = Bot_handler.Identity.create
52
+
~full_name:"Vicuna Bot"
53
+
~email:bot_email
54
+
~mention_name:"vicuna"
55
+
in
56
+
Log.info (fun m -> m "Bot identity created: %s (%s)"
57
+
(Bot_handler.Identity.full_name identity)
58
+
(Bot_handler.Identity.email identity));
59
+
60
+
(* Create the bot handler using the Vicuna bot library *)
61
+
Log.debug (fun m -> m "Creating Vicuna bot handler");
62
+
let handler = Vicuna_bot.create_handler config storage identity in
63
+
64
+
Log.debug (fun m -> m "Creating bot runner");
65
+
let runner = Bot_runner.create ~env ~client ~handler in
66
+
67
+
Log.app (fun m -> m "✨ Vicuna bot is running!");
68
+
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'");
70
+
Log.app (fun m -> m "⛔ Press Ctrl+C to stop.\n");
71
+
72
+
(* Run in real-time mode *)
73
+
Log.info (fun m -> m "Starting real-time event loop");
74
+
try
75
+
Bot_runner.run_realtime runner;
76
+
Log.info (fun m -> m "Bot runner exited normally")
77
+
with
78
+
| Sys.Break ->
79
+
Log.info (fun m -> m "Received interrupt signal, shutting down");
80
+
Bot_runner.shutdown runner
81
+
| exn ->
82
+
Log.err (fun m -> m "Bot crashed with exception: %s" (Printexc.to_string exn));
83
+
Log.debug (fun m -> m "Backtrace: %s" (Printexc.get_backtrace ()));
84
+
raise exn
85
+
86
+
(* Command-line interface *)
87
+
open Cmdliner
88
+
89
+
let config_file =
90
+
let doc = "Path to .zuliprc configuration file" in
91
+
Arg.(value & opt (some string) None & info ["c"; "config"] ~docv:"FILE" ~doc)
92
+
93
+
let verbosity =
94
+
let doc = "Increase verbosity. Use multiple times for more verbose output." in
95
+
Arg.(value & flag_all & info ["v"; "verbose"] ~doc)
96
+
97
+
let verbosity_term =
98
+
Term.(const List.length $ verbosity)
99
+
100
+
(* CLI management commands *)
101
+
let cli_add_user config_file user_id email full_name is_admin env =
102
+
Logs.set_reporter (Logs_fmt.reporter ());
103
+
Logs.set_level (Some Logs.Info);
104
+
105
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
106
+
| Ok a -> a
107
+
| Error e ->
108
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
109
+
exit 1
110
+
in
111
+
112
+
Eio.Switch.run @@ fun sw ->
113
+
let client = Zulip.Client.create ~sw env auth in
114
+
let bot_email = Zulip.Auth.email auth in
115
+
let storage = Bot_storage.create client ~bot_email in
116
+
117
+
match Vicuna_bot.register_user ~is_admin storage email user_id full_name with
118
+
| Ok () ->
119
+
let admin_str = if is_admin then " (admin)" else "" in
120
+
Printf.printf "✅ User added%s:\n" admin_str;
121
+
Printf.printf " • Email: %s\n" email;
122
+
Printf.printf " • Zulip ID: %d\n" user_id;
123
+
Printf.printf " • Name: %s\n" full_name;
124
+
exit 0
125
+
| Error e ->
126
+
Printf.eprintf "❌ Failed to add user: %s\n" (Zulip.error_message e);
127
+
exit 1
128
+
129
+
let cli_remove_user config_file user_id env =
130
+
Logs.set_reporter (Logs_fmt.reporter ());
131
+
Logs.set_level (Some Logs.Info);
132
+
133
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
134
+
| Ok a -> a
135
+
| Error e ->
136
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
137
+
exit 1
138
+
in
139
+
140
+
Eio.Switch.run @@ fun sw ->
141
+
let client = Zulip.Client.create ~sw env auth in
142
+
let bot_email = Zulip.Auth.email auth in
143
+
let storage = Bot_storage.create client ~bot_email in
144
+
145
+
match Vicuna_bot.delete_user storage user_id with
146
+
| Ok () ->
147
+
Printf.printf "✅ User %d removed\n" user_id;
148
+
exit 0
149
+
| Error e ->
150
+
Printf.eprintf "❌ Failed to remove user: %s\n" (Zulip.error_message e);
151
+
exit 1
152
+
153
+
let cli_set_admin config_file user_id is_admin env =
154
+
Logs.set_reporter (Logs_fmt.reporter ());
155
+
Logs.set_level (Some Logs.Info);
156
+
157
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
158
+
| Ok a -> a
159
+
| Error e ->
160
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
161
+
exit 1
162
+
in
163
+
164
+
Eio.Switch.run @@ fun sw ->
165
+
let client = Zulip.Client.create ~sw env auth in
166
+
let bot_email = Zulip.Auth.email auth in
167
+
let storage = Bot_storage.create client ~bot_email in
168
+
169
+
match Vicuna_bot.set_admin storage user_id is_admin with
170
+
| Ok () ->
171
+
let action = if is_admin then "granted to" else "removed from" in
172
+
Printf.printf "✅ Admin privileges %s user %d\n" action user_id;
173
+
exit 0
174
+
| Error e ->
175
+
Printf.eprintf "❌ Failed to set admin: %s\n" (Zulip.error_message e);
176
+
exit 1
177
+
178
+
let cli_list_users config_file show_admins_only env =
179
+
Logs.set_reporter (Logs_fmt.reporter ());
180
+
Logs.set_level (Some Logs.Warning);
181
+
182
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
183
+
| Ok a -> a
184
+
| Error e ->
185
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
186
+
exit 1
187
+
in
188
+
189
+
Eio.Switch.run @@ fun sw ->
190
+
let client = Zulip.Client.create ~sw env auth in
191
+
let bot_email = Zulip.Auth.email auth in
192
+
let storage = Bot_storage.create client ~bot_email in
193
+
194
+
let user_ids = Vicuna_bot.get_all_user_ids storage in
195
+
let users = List.filter_map (fun id ->
196
+
match Vicuna_bot.lookup_user_by_id storage id with
197
+
| Some (user : Vicuna_bot.user_registration) when (not show_admins_only) || user.is_admin -> Some user
198
+
| _ -> None
199
+
) user_ids in
200
+
201
+
if users = [] then (
202
+
if show_admins_only then
203
+
Printf.printf "No admin users found.\n"
204
+
else
205
+
Printf.printf "No users registered.\n";
206
+
exit 0
207
+
) else (
208
+
let title = if show_admins_only then "Admin users" else "Registered users" in
209
+
Printf.printf "%s (%d):\n" title (List.length users);
210
+
List.iter (fun (user : Vicuna_bot.user_registration) ->
211
+
let admin_badge = if user.is_admin then " 👑" else "" in
212
+
Printf.printf " • %s (%s) - ID: %d%s\n"
213
+
user.full_name user.email user.zulip_id admin_badge
214
+
) users;
215
+
exit 0
216
+
)
217
+
218
+
(* Storage management commands *)
219
+
let cli_storage_list config_file show_all env =
220
+
Logs.set_reporter (Logs_fmt.reporter ());
221
+
Logs.set_level (Some Logs.Warning);
222
+
223
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
224
+
| Ok a -> a
225
+
| Error e ->
226
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
227
+
exit 1
228
+
in
229
+
230
+
Eio.Switch.run @@ fun sw ->
231
+
let client = Zulip.Client.create ~sw env auth in
232
+
let bot_email = Zulip.Auth.email auth in
233
+
let storage = Bot_storage.create client ~bot_email in
234
+
235
+
if show_all then (
236
+
(* Show ALL keys including deleted (empty) ones *)
237
+
match Bot_storage.keys storage with
238
+
| Ok keys ->
239
+
if keys = [] then (
240
+
Printf.printf "No storage keys found.\n";
241
+
exit 0
242
+
) else (
243
+
Printf.printf "All storage keys including deleted (%d):\n" (List.length keys);
244
+
List.iter (fun key ->
245
+
match Vicuna_bot.get_storage_value storage key with
246
+
| Some value when value = "" ->
247
+
Printf.printf " • %s [DELETED]\n" key
248
+
| Some _ ->
249
+
Printf.printf " • %s\n" key
250
+
| None ->
251
+
Printf.printf " • %s [NOT FOUND]\n" key
252
+
) keys;
253
+
exit 0
254
+
)
255
+
| Error e ->
256
+
Printf.eprintf "❌ Failed to list storage keys: %s\n" (Zulip.error_message e);
257
+
exit 1
258
+
) else (
259
+
(* Normal list - only non-empty keys *)
260
+
match Vicuna_bot.get_storage_keys storage with
261
+
| Ok keys ->
262
+
if keys = [] then (
263
+
Printf.printf "No storage keys found.\n";
264
+
exit 0
265
+
) else (
266
+
Printf.printf "Storage keys (%d):\n" (List.length keys);
267
+
List.iter (fun key ->
268
+
Printf.printf " • %s\n" key
269
+
) keys;
270
+
exit 0
271
+
)
272
+
| Error e ->
273
+
Printf.eprintf "❌ Failed to list storage keys: %s\n" (Zulip.error_message e);
274
+
exit 1
275
+
)
276
+
277
+
let cli_storage_view config_file key env =
278
+
Logs.set_reporter (Logs_fmt.reporter ());
279
+
Logs.set_level (Some Logs.Warning);
280
+
281
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
282
+
| Ok a -> a
283
+
| Error e ->
284
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
285
+
exit 1
286
+
in
287
+
288
+
Eio.Switch.run @@ fun sw ->
289
+
let client = Zulip.Client.create ~sw env auth in
290
+
let bot_email = Zulip.Auth.email auth in
291
+
let storage = Bot_storage.create client ~bot_email in
292
+
293
+
match Vicuna_bot.get_storage_value storage key with
294
+
| Some value ->
295
+
Printf.printf "Key: %s\n" key;
296
+
Printf.printf "Value:\n%s\n" value;
297
+
exit 0
298
+
| None ->
299
+
Printf.eprintf "❌ Key not found: %s\n" key;
300
+
exit 1
301
+
302
+
let cli_storage_delete config_file key env =
303
+
Logs.set_reporter (Logs_fmt.reporter ());
304
+
Logs.set_level (Some Logs.Info);
305
+
306
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
307
+
| Ok a -> a
308
+
| Error e ->
309
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
310
+
exit 1
311
+
in
312
+
313
+
Eio.Switch.run @@ fun sw ->
314
+
let client = Zulip.Client.create ~sw env auth in
315
+
let bot_email = Zulip.Auth.email auth in
316
+
let storage = Bot_storage.create client ~bot_email in
317
+
318
+
match Vicuna_bot.delete_storage_key storage key with
319
+
| Ok () ->
320
+
Printf.printf "✅ Deleted storage key: %s\n" key;
321
+
exit 0
322
+
| Error e ->
323
+
Printf.eprintf "❌ Failed to delete storage key: %s\n" (Zulip.error_message e);
324
+
exit 1
325
+
326
+
let cli_storage_clear config_file env =
327
+
Logs.set_reporter (Logs_fmt.reporter ());
328
+
Logs.set_level (Some Logs.Info);
329
+
330
+
let auth = match Zulip.Auth.from_zuliprc ?path:config_file () with
331
+
| Ok a -> a
332
+
| Error e ->
333
+
Printf.eprintf "Error loading config: %s\n" (Zulip.error_message e);
334
+
exit 1
335
+
in
336
+
337
+
Eio.Switch.run @@ fun sw ->
338
+
let client = Zulip.Client.create ~sw env auth in
339
+
let bot_email = Zulip.Auth.email auth in
340
+
let storage = Bot_storage.create client ~bot_email in
341
+
342
+
(* Get count before clearing *)
343
+
match Vicuna_bot.get_storage_keys storage with
344
+
| Error e ->
345
+
Printf.eprintf "❌ Failed to list storage keys: %s\n" (Zulip.error_message e);
346
+
exit 1
347
+
| Ok keys ->
348
+
let count = List.length keys in
349
+
if count = 0 then (
350
+
Printf.printf "Storage is already empty.\n";
351
+
exit 0
352
+
) else (
353
+
match Vicuna_bot.clear_storage storage with
354
+
| Ok () ->
355
+
Printf.printf "✅ Cleared all storage (%d keys deleted)\n" count;
356
+
exit 0
357
+
| Error e ->
358
+
Printf.eprintf "❌ Failed to clear storage: %s\n" (Zulip.error_message e);
359
+
exit 1
360
+
)
361
+
362
+
(* CLI command definitions *)
363
+
let user_id_arg =
364
+
let doc = "Zulip user ID" in
365
+
Arg.(required & pos 0 (some int) None & info [] ~docv:"USER_ID" ~doc)
366
+
367
+
let email_arg =
368
+
let doc = "User's email address" in
369
+
Arg.(required & pos 1 (some string) None & info [] ~docv:"EMAIL" ~doc)
370
+
371
+
let full_name_arg =
372
+
let doc = "User's full name" in
373
+
Arg.(required & pos 2 (some string) None & info [] ~docv:"FULL_NAME" ~doc)
374
+
375
+
let admin_flag =
376
+
let doc = "Grant admin privileges" in
377
+
Arg.(value & flag & info ["admin"] ~doc)
378
+
379
+
let admins_only_flag =
380
+
let doc = "Show only admin users" in
381
+
Arg.(value & flag & info ["admins-only"] ~doc)
382
+
383
+
let user_add_cmd eio_env =
384
+
let doc = "Add a user to the bot's registry" in
385
+
let info = Cmd.info "user-add" ~doc in
386
+
Cmd.v info Term.(const cli_add_user $ config_file $ user_id_arg $ email_arg $ full_name_arg $ admin_flag $ const eio_env)
387
+
388
+
let user_remove_cmd eio_env =
389
+
let doc = "Remove a user from the bot's registry" in
390
+
let info = Cmd.info "user-remove" ~doc in
391
+
Cmd.v info Term.(const cli_remove_user $ config_file $ user_id_arg $ const eio_env)
392
+
393
+
let admin_add_cmd eio_env =
394
+
let doc = "Grant admin privileges to a user" in
395
+
let info = Cmd.info "admin-add" ~doc in
396
+
Cmd.v info Term.(const cli_set_admin $ config_file $ user_id_arg $ const true $ const eio_env)
397
+
398
+
let admin_remove_cmd eio_env =
399
+
let doc = "Remove admin privileges from a user" in
400
+
let info = Cmd.info "admin-remove" ~doc in
401
+
Cmd.v info Term.(const cli_set_admin $ config_file $ user_id_arg $ const false $ const eio_env)
402
+
403
+
let user_list_cmd eio_env =
404
+
let doc = "List all registered users" in
405
+
let info = Cmd.info "user-list" ~doc in
406
+
Cmd.v info Term.(const cli_list_users $ config_file $ admins_only_flag $ const eio_env)
407
+
408
+
(* Storage command arguments *)
409
+
let storage_key_arg =
410
+
let doc = "Storage key" in
411
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"KEY" ~doc)
412
+
413
+
let storage_all_flag =
414
+
let doc = "Show all keys including deleted ones (with empty values)" in
415
+
Arg.(value & flag & info ["all"] ~doc)
416
+
417
+
(* Storage subcommands *)
418
+
let storage_list_cmd eio_env =
419
+
let doc = "List all storage keys" in
420
+
let info = Cmd.info "list" ~doc in
421
+
Cmd.v info Term.(const cli_storage_list $ config_file $ storage_all_flag $ const eio_env)
422
+
423
+
let storage_view_cmd eio_env =
424
+
let doc = "View the value of a specific storage key" in
425
+
let info = Cmd.info "view" ~doc in
426
+
Cmd.v info Term.(const cli_storage_view $ config_file $ storage_key_arg $ const eio_env)
427
+
428
+
let storage_delete_cmd eio_env =
429
+
let doc = "Delete a specific storage key" in
430
+
let info = Cmd.info "delete" ~doc in
431
+
Cmd.v info Term.(const cli_storage_delete $ config_file $ storage_key_arg $ const eio_env)
432
+
433
+
let storage_clear_cmd eio_env =
434
+
let doc = "Clear all storage (delete all keys)" in
435
+
let info = Cmd.info "clear" ~doc in
436
+
Cmd.v info Term.(const cli_storage_clear $ config_file $ const eio_env)
437
+
438
+
let storage_group eio_env =
439
+
let doc = "Manage bot storage" in
440
+
let info = Cmd.info "storage" ~doc in
441
+
let default_term = Term.(ret (const (`Help (`Auto, None)))) in
442
+
let cmds = [
443
+
storage_list_cmd eio_env;
444
+
storage_view_cmd eio_env;
445
+
storage_delete_cmd eio_env;
446
+
storage_clear_cmd eio_env;
447
+
] in
448
+
Cmd.group info ~default:default_term cmds
449
+
450
+
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
453
+
let cmds = [
454
+
user_add_cmd eio_env;
455
+
user_remove_cmd eio_env;
456
+
admin_add_cmd eio_env;
457
+
admin_remove_cmd eio_env;
458
+
user_list_cmd eio_env;
459
+
storage_group eio_env;
460
+
] in
461
+
Cmd.group default_info ~default:default_term cmds
462
+
463
+
let () =
464
+
(* Initialize the cryptographic RNG for the application *)
465
+
Mirage_crypto_rng_unix.use_default ();
466
+
Eio_main.run @@ fun env ->
467
+
exit (Cmd.eval (main_group env))
+19
stack/vicuna/dune-project
+19
stack/vicuna/dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name vicuna)
4
+
5
+
(package
6
+
(name vicuna)
7
+
(synopsis "Vicuna - A user registration and management bot for Zulip")
8
+
(description "A Zulip bot that manages user registrations, mapping email addresses to Zulip IDs for easy @mentions and user tracking")
9
+
(depends
10
+
ocaml
11
+
dune
12
+
eio
13
+
eio_main
14
+
zulip
15
+
zulip_bot
16
+
logs
17
+
fmt
18
+
cmdliner
19
+
mirage-crypto-rng))
+4
stack/vicuna/lib/dune
+4
stack/vicuna/lib/dune
+502
stack/vicuna/lib/vicuna_bot.ml
+502
stack/vicuna/lib/vicuna_bot.ml
···
1
+
(* Vicuna Bot - User Registration and Management Bot for Zulip *)
2
+
3
+
open Zulip_bot
4
+
5
+
(* Set up logging *)
6
+
let src = Logs.Src.create "vicuna_bot" ~doc:"Vicuna User Registration Bot"
7
+
module Log = (val Logs.src_log src : Logs.LOG)
8
+
9
+
(** User registration record *)
10
+
type 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 *)
19
+
let 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 *)
44
+
let 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 *)
53
+
let 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 *)
56
+
let all_users_key = "users:all"
57
+
58
+
(** Default admin user ID *)
59
+
let default_admin_id = 939008
60
+
61
+
(** Get all registered user IDs from storage *)
62
+
let get_all_user_ids storage =
63
+
match Bot_storage.get storage ~key:all_users_key with
64
+
| Some s when s <> "" ->
65
+
String.split_on_char ',' s
66
+
|> List.filter_map (fun id_str ->
67
+
try Some (int_of_string (String.trim id_str))
68
+
with _ -> None)
69
+
| _ -> []
70
+
71
+
(** Add a user ID to the list of all users (ensures uniqueness) *)
72
+
let add_user_id_to_list storage zulip_id =
73
+
let existing = get_all_user_ids storage in
74
+
if List.mem zulip_id existing then
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 *)
82
+
let remove_user_id_from_list storage zulip_id =
83
+
let existing = get_all_user_ids storage in
84
+
let new_list = List.filter ((<>) zulip_id) existing in
85
+
let value = String.concat "," (List.map string_of_int new_list) in
86
+
Bot_storage.put storage ~key:all_users_key ~value
87
+
88
+
(** Look up a user by Zulip ID *)
89
+
let lookup_user_by_id storage zulip_id =
90
+
match Bot_storage.get storage ~key:(storage_key_for_id zulip_id) with
91
+
| Some s -> user_registration_of_string s
92
+
| None -> None
93
+
94
+
(** Look up a user by email - scans through all users *)
95
+
let lookup_user_by_email storage email =
96
+
let user_ids = get_all_user_ids storage in
97
+
List.find_map (fun zulip_id ->
98
+
match lookup_user_by_id storage zulip_id with
99
+
| Some reg when reg.email = email -> Some reg
100
+
| _ -> None
101
+
) user_ids
102
+
103
+
(** Check if user is admin *)
104
+
let is_admin storage zulip_id =
105
+
match lookup_user_by_id storage zulip_id with
106
+
| Some reg -> reg.is_admin
107
+
| None -> zulip_id = default_admin_id (* Default admin always has admin rights *)
108
+
109
+
(** Set admin status for a user *)
110
+
let set_admin storage zulip_id is_admin_flag =
111
+
match lookup_user_by_id storage zulip_id with
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) *)
121
+
let register_user ?(is_admin=false) storage email zulip_id full_name =
122
+
(* Check if user already exists by ID to prevent duplicates *)
123
+
let existing_by_id = lookup_user_by_id storage zulip_id in
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 *)
148
+
let 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 *)
159
+
let format_timestamp timestamp =
160
+
let tm = Unix.localtime timestamp in
161
+
Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"
162
+
(tm.tm_year + 1900)
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) *)
170
+
let is_valid_email email =
171
+
let email = String.trim email in
172
+
String.length email > 0 &&
173
+
String.contains email '@' &&
174
+
match String.split_on_char '@' email with
175
+
| [local; domain] ->
176
+
String.length local > 0 &&
177
+
String.length domain > 0 &&
178
+
String.contains domain '.'
179
+
| _ -> false
180
+
181
+
(** Handle the 'register' command *)
182
+
let handle_register storage sender_email sender_id sender_name custom_email_opt =
183
+
(* First, try to fetch the user's profile from the Zulip API to get delivery_email and email *)
184
+
let client = Bot_storage.client storage in
185
+
let (delivery_email_from_api, user_email_from_api) =
186
+
match Zulip.Users.get_by_id client ~user_id:sender_id with
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 *)
302
+
let 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 *)
318
+
let 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 *)
354
+
let handle_list storage =
355
+
let user_ids = get_all_user_ids storage in
356
+
if user_ids = [] then
357
+
"📋 No users registered yet."
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 *)
372
+
let handle_help sender_name sender_email =
373
+
Printf.sprintf "👋 Hi %s! I'm **Vicuna**, your user registration assistant.\n\n\
374
+
**Available Commands:**\n\
375
+
• `register` - Auto-detect your real email or use Zulip email\n\
376
+
• `register <your-email@example.com>` - Register with a specific email\n\
377
+
• `whoami` - Show your registration status\n\
378
+
• `whois <email|id>` - Look up a registered user\n\
379
+
• `list` - List all registered users\n\
380
+
• `help` - Show this help message\n\n\
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 *)
396
+
let 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 *)
406
+
module 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)
464
+
end
465
+
466
+
(** {1 Storage Management Functions} *)
467
+
468
+
(** Get all storage keys (excluding deleted keys with empty values) *)
469
+
let get_storage_keys storage =
470
+
match Bot_storage.keys storage with
471
+
| Error e -> Error e
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 *)
482
+
let get_storage_value storage key =
483
+
Bot_storage.get storage ~key
484
+
485
+
(** Delete a specific storage key *)
486
+
let delete_storage_key storage key =
487
+
Bot_storage.remove storage ~key
488
+
489
+
(** Clear all storage (delete all keys) *)
490
+
let 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 *)
501
+
let create_handler config storage identity =
502
+
Bot_handler.create (module Vicuna_handler) ~config ~storage ~identity
+84
stack/vicuna/lib/vicuna_bot.mli
+84
stack/vicuna/lib/vicuna_bot.mli
···
1
+
(** Vicuna Bot - User Registration and Management Bot for Zulip *)
2
+
3
+
(** Create a Vicuna bot handler instance *)
4
+
val create_handler :
5
+
Zulip_bot.Bot_config.t ->
6
+
Zulip_bot.Bot_storage.t ->
7
+
Zulip_bot.Bot_handler.Identity.t ->
8
+
Zulip_bot.Bot_handler.t
9
+
10
+
(** {1 CLI Management Functions} *)
11
+
12
+
(** Default admin user ID *)
13
+
val default_admin_id : int
14
+
15
+
(** Register a user with optional admin flag *)
16
+
val register_user :
17
+
?is_admin:bool ->
18
+
Zulip_bot.Bot_storage.t ->
19
+
string ->
20
+
int ->
21
+
string ->
22
+
(unit, Zulip.zerror) result
23
+
24
+
(** Delete a user by Zulip ID *)
25
+
val delete_user :
26
+
Zulip_bot.Bot_storage.t ->
27
+
int ->
28
+
(unit, Zulip.zerror) result
29
+
30
+
(** Check if a user is an admin *)
31
+
val is_admin :
32
+
Zulip_bot.Bot_storage.t ->
33
+
int ->
34
+
bool
35
+
36
+
(** Set admin status for a user *)
37
+
val set_admin :
38
+
Zulip_bot.Bot_storage.t ->
39
+
int ->
40
+
bool ->
41
+
(unit, Zulip.zerror) result
42
+
43
+
(** Get all registered user IDs *)
44
+
val get_all_user_ids :
45
+
Zulip_bot.Bot_storage.t ->
46
+
int list
47
+
48
+
(** Look up a user by Zulip ID *)
49
+
type user_registration = {
50
+
email: string;
51
+
zulip_id: int;
52
+
full_name: string;
53
+
registered_at: float;
54
+
is_admin: bool;
55
+
}
56
+
57
+
val lookup_user_by_id :
58
+
Zulip_bot.Bot_storage.t ->
59
+
int ->
60
+
user_registration option
61
+
62
+
(** {1 Storage Management Functions} *)
63
+
64
+
(** Get all storage keys *)
65
+
val get_storage_keys :
66
+
Zulip_bot.Bot_storage.t ->
67
+
(string list, Zulip.zerror) result
68
+
69
+
(** Get the value of a specific storage key *)
70
+
val get_storage_value :
71
+
Zulip_bot.Bot_storage.t ->
72
+
string ->
73
+
string option
74
+
75
+
(** Delete a specific storage key *)
76
+
val delete_storage_key :
77
+
Zulip_bot.Bot_storage.t ->
78
+
string ->
79
+
(unit, Zulip.zerror) result
80
+
81
+
(** Clear all storage (delete all keys) *)
82
+
val clear_storage :
83
+
Zulip_bot.Bot_storage.t ->
84
+
(unit, Zulip.zerror) result