My aggregated monorepo of OCaml code, automaintained
Squashed 'ocaml-zulip/' content from commit 3f1a08e
git-subtree-dir: ocaml-zulip
git-subtree-split: 3f1a08e0d40d3fd1b20a8d1e26ec1037051b64e8
+8641
+17
.gitignore
+17
.gitignore
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version=0.28.1
+53
.tangled/workflows/build.yml
+53
.tangled/workflows/build.yml
···
1
+
when:
2
+
- event: ["push", "pull_request"]
3
+
branch: ["main"]
4
+
5
+
engine: nixery
6
+
7
+
dependencies:
8
+
nixpkgs:
9
+
- shell
10
+
- stdenv
11
+
- findutils
12
+
- binutils
13
+
- libunwind
14
+
- ncurses
15
+
- opam
16
+
- git
17
+
- gawk
18
+
- gnupatch
19
+
- gnum4
20
+
- gnumake
21
+
- gnutar
22
+
- gnused
23
+
- gnugrep
24
+
- diffutils
25
+
- gzip
26
+
- bzip2
27
+
- gcc
28
+
- ocaml
29
+
- pkg-config
30
+
31
+
steps:
32
+
- name: opam
33
+
command: |
34
+
opam init --disable-sandboxing -a -y
35
+
- name: repo
36
+
command: |
37
+
opam repo add aoah https://tangled.org/anil.recoil.org/aoah-opam-repo.git
38
+
- name: switch
39
+
command: |
40
+
opam install . --confirm-level=unsafe-yes --deps-only
41
+
- name: build
42
+
command: |
43
+
opam exec -- dune build -p zulip
44
+
- name: switch-test
45
+
command: |
46
+
opam install . --confirm-level=unsafe-yes --deps-only --with-test
47
+
- name: test
48
+
command: |
49
+
opam exec -- dune runtest --verbose
50
+
- name: doc
51
+
command: |
52
+
opam install -y odoc
53
+
opam exec -- dune build @doc
+15
LICENSE.md
+15
LICENSE.md
···
1
+
ISC License
2
+
3
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>
4
+
5
+
Permission to use, copy, modify, and distribute this software for any
6
+
purpose with or without fee is hereby granted, provided that the above
7
+
copyright notice and this permission notice appear in all copies.
8
+
9
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+85
README.md
+85
README.md
···
1
+
# OCaml Zulip Library
2
+
3
+
A complete OCaml implementation of the Zulip REST API using the `requests` HTTP
4
+
library and Eio for async operations.
5
+
6
+
## Features
7
+
8
+
- Full Zulip REST API client implementation
9
+
- Uses the modern `requests` library for HTTP communication
10
+
- Eio-based asynchronous operations
11
+
- Bot framework for building interactive bots (`zulip.bot` subpackage)
12
+
- Support for Atom/RSS feed bots
13
+
14
+
## Installation
15
+
16
+
```bash
17
+
opam install zulip
18
+
```
19
+
20
+
Or from source:
21
+
22
+
```bash
23
+
dune build
24
+
dune install
25
+
```
26
+
27
+
## Configuration
28
+
29
+
Create a `~/.zuliprc` file with your Zulip credentials:
30
+
31
+
```ini
32
+
[api]
33
+
email = bot@example.com
34
+
key = your-api-key-here
35
+
site = https://your-domain.zulipchat.com
36
+
```
37
+
38
+
## Usage
39
+
40
+
### Basic Client
41
+
42
+
```ocaml
43
+
let () =
44
+
Eio_main.run @@ fun env ->
45
+
Eio.Switch.run @@ fun sw ->
46
+
47
+
(* Load authentication *)
48
+
let auth = Zulip.Auth.from_zuliprc () in
49
+
50
+
(* Create client *)
51
+
let client = Zulip.Client.create ~sw env auth in
52
+
53
+
(* Send a message *)
54
+
let message = Zulip.Message.create
55
+
~type_:`Channel
56
+
~to_:["general"]
57
+
~topic:"Hello"
58
+
~content:"Hello from OCaml!"
59
+
()
60
+
in
61
+
let response = Zulip.Messages.send client message in
62
+
Printf.printf "Sent message %d\n" (Zulip.Message_response.id response)
63
+
```
64
+
65
+
### Bot Framework
66
+
67
+
The `zulip.bot` subpackage provides a fiber-based framework for building Zulip bots:
68
+
69
+
```ocaml
70
+
open Zulip_bot
71
+
72
+
let echo_handler ~storage:_ ~identity:_ msg =
73
+
Response.reply ("Echo: " ^ Message.content msg)
74
+
75
+
let () =
76
+
Eio_main.run @@ fun env ->
77
+
Eio.Switch.run @@ fun sw ->
78
+
let fs = Eio.Stdenv.fs env in
79
+
let config = Config.load ~fs "echo-bot" in
80
+
Bot.run ~sw ~env ~config ~handler:echo_handler
81
+
```
82
+
83
+
## License
84
+
85
+
ISC License. See LICENSE.md for details.
+1
dune
+1
dune
···
1
+
(data_only_dirs third_party)
+33
dune-project
+33
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name zulip)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license ISC)
8
+
(authors "Anil Madhavapeddy")
9
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
10
+
(homepage "https://tangled.org/@anil.recoil.org/ocaml-zulip")
11
+
(bug_reports "https://tangled.org/@anil.recoil.org/ocaml-zulip/issues")
12
+
13
+
(package
14
+
(name zulip)
15
+
(synopsis "OCaml bindings for the Zulip REST API with bot framework")
16
+
(description
17
+
"High-quality OCaml bindings to the Zulip REST API using Eio for async operations. Includes a fiber-based bot framework (zulip.bot) with XDG configuration support.")
18
+
(depends
19
+
(ocaml (>= 5.1.0))
20
+
eio
21
+
requests
22
+
uri
23
+
base64
24
+
init
25
+
jsont
26
+
logs
27
+
fmt
28
+
xdge
29
+
eio_main
30
+
cmdliner
31
+
(odoc :with-doc)
32
+
(alcotest :with-test)
33
+
(mirage-crypto-rng :with-test)))
+230
examples/README_ECHO_BOT.md
+230
examples/README_ECHO_BOT.md
···
1
+
# Zulip Echo Bot with Verbose Logging
2
+
3
+
An enhanced echo bot that demonstrates the Zulip bot framework with comprehensive logging and CLI configuration. The bot responds to direct messages and mentions by echoing back the message content, with detailed logging at every step.
4
+
5
+
## Features
6
+
7
+
- **Responds to direct messages and @mentions in channels**
8
+
- **Comprehensive logging** with multiple verbosity levels
9
+
- **Command-line interface** with help and configuration options
10
+
- **Detailed message tracing** for debugging
11
+
- **Structured logging** using the OCaml logs library
12
+
- **Built-in commands**: help, ping, and echo
13
+
- **Avoids infinite loops** by ignoring its own messages
14
+
15
+
## Prerequisites
16
+
17
+
1. A Zulip account and server
18
+
2. A bot user created in Zulip (Settings → Bots → Add a new bot)
19
+
3. OCaml and dependencies installed
20
+
21
+
## Setup
22
+
23
+
### 1. Create a Bot in Zulip
24
+
25
+
1. Go to your Zulip settings
26
+
2. Navigate to "Bots" section
27
+
3. Click "Add a new bot"
28
+
4. Choose "Generic bot" type
29
+
5. Give it a name (e.g., "Echo Bot")
30
+
6. Note down the bot email and API key
31
+
32
+
### 2. Configure Authentication
33
+
34
+
Create a `~/.zuliprc` file with your bot's credentials:
35
+
36
+
```ini
37
+
[api]
38
+
email=echo-bot@your-domain.zulipchat.com
39
+
key=your-bot-api-key
40
+
site=https://your-domain.zulipchat.com
41
+
```
42
+
43
+
Replace the values with your actual bot credentials.
44
+
45
+
### 3. Build the Bot
46
+
47
+
```bash
48
+
# From the zulip directory
49
+
dune build
50
+
51
+
# Or build just the echo bot
52
+
dune build zulip/examples/echo_bot.exe
53
+
```
54
+
55
+
## Running the Bot
56
+
57
+
### Basic Usage
58
+
59
+
```bash
60
+
# Show help and available options
61
+
dune exec echo_bot -- --help
62
+
63
+
# Run with default settings (info level logging)
64
+
dune exec echo_bot
65
+
66
+
# Run with verbose logging (shows all info messages)
67
+
dune exec echo_bot -- -v
68
+
69
+
# Run with debug logging (shows everything)
70
+
dune exec echo_bot -- -vv
71
+
72
+
# Use custom config file
73
+
dune exec echo_bot -- -c /path/to/bot.zuliprc
74
+
75
+
# Combine options
76
+
dune exec echo_bot -- -vv -c ~/my-bot.zuliprc
77
+
```
78
+
79
+
### Example Output with Different Verbosity Levels
80
+
81
+
**Default (no flags) - Info level:**
82
+
```
83
+
echo_bot: [INFO] Starting Zulip Echo Bot
84
+
echo_bot: [INFO] Log level: Info
85
+
echo_bot: [INFO] =============================
86
+
87
+
echo_bot: [INFO] Echo bot is running!
88
+
echo_bot: [INFO] Send a direct message or mention @echobot in a channel.
89
+
echo_bot: [INFO] Commands: 'help', 'ping', or any message to echo
90
+
echo_bot: [INFO] Press Ctrl+C to stop.
91
+
```
92
+
93
+
**Verbose (-v) - Info level with more details:**
94
+
```
95
+
echo_bot: [INFO] Starting Zulip Echo Bot
96
+
echo_bot: [INFO] Log level: Info
97
+
echo_bot: [INFO] =============================
98
+
99
+
echo_bot: [INFO] Loaded authentication for: echo-bot@your-domain.zulipchat.com
100
+
echo_bot: [INFO] Server: https://your-domain.zulipchat.com
101
+
echo_bot: [INFO] Bot identity created: Echo Bot (echo-bot@your-domain.zulipchat.com)
102
+
echo_bot: [INFO] Echo bot is running!
103
+
echo_bot: [INFO] Processing message with 12 fields
104
+
echo_bot: [INFO] Message metadata: type=private, sender=John Doe (john@example.com), id=12345
105
+
echo_bot: [INFO] Processing message from John Doe (ID: 123): Hello bot!
106
+
echo_bot: [INFO] Sending private reply: Echo from John Doe: Hello bot!
107
+
```
108
+
109
+
**Debug (-vv) - Full debug output:**
110
+
```
111
+
echo_bot: [INFO] Starting Zulip Echo Bot
112
+
echo_bot: [DEBUG] Creating Zulip client
113
+
echo_bot: [DEBUG] Creating bot storage for echo-bot@your-domain.zulipchat.com
114
+
echo_bot: [DEBUG] Creating bot handler
115
+
echo_bot: [DEBUG] Creating bot runner
116
+
echo_bot: [DEBUG] Received message for processing
117
+
echo_bot: [DEBUG] Extracted field content: Hello bot!
118
+
echo_bot: [DEBUG] Extracted field sender_email: john@example.com
119
+
echo_bot: [DEBUG] Extracted field sender_full_name: John Doe
120
+
echo_bot: [DEBUG] Extracted field type: private
121
+
echo_bot: [DEBUG] Extracted field sender_id: 123
122
+
echo_bot: [DEBUG] Extracted field id: 12345
123
+
echo_bot: [DEBUG] No bot mention to remove
124
+
echo_bot: [DEBUG] Generated response: Echo from John Doe: Hello bot!
125
+
```
126
+
127
+
## Testing the Bot
128
+
129
+
### Direct Message Test
130
+
1. Open Zulip
131
+
2. Send a direct message to your bot
132
+
3. Type: `Hello bot!`
133
+
4. The bot should respond: `Echo from [Your Name]: Hello bot!`
134
+
135
+
### Channel Mention Test
136
+
1. In any channel, type: `@echobot Hello everyone!`
137
+
2. The bot should respond: `Echo from [Your Name]: Hello everyone!`
138
+
139
+
### Special Commands
140
+
141
+
- **`help`** - Get usage information
142
+
- **`ping`** - Bot responds with "Pong! 🏓"
143
+
- Any other text - Bot echoes it back
144
+
145
+
## How It Works
146
+
147
+
The echo bot:
148
+
1. **Initializes logging** based on CLI verbosity flags
149
+
2. **Connects to Zulip** using the real-time events API
150
+
3. **Listens for messages** where it's mentioned or direct messaged
151
+
4. **Logs message details** at various verbosity levels
152
+
5. **Extracts fields** with debug logging for each field
153
+
6. **Processes content** and removes bot mentions
154
+
7. **Generates responses** with appropriate logging
155
+
8. **Sends back echo** with type-appropriate reply
156
+
9. **Ignores own messages** to prevent loops
157
+
158
+
## Code Structure
159
+
160
+
- **Logging Setup**: Creates a custom log source `echo_bot` for structured logging
161
+
- **Bot Handler Module**: Implements the `Bot_handler.S` signature with comprehensive logging
162
+
- **Field Extraction**: Helper functions with debug logging for each field
163
+
- **Message Processing**: Detailed logging of message metadata and content
164
+
- **Response Generation**: Logs response creation and type determination
165
+
- **CLI Interface**: Cmdliner-based argument parsing with help text
166
+
- **Verbosity Control**: Maps CLI flags to log levels (Info/Debug)
167
+
- **Error Handling**: Catches and logs exceptions with backtraces
168
+
169
+
## Customization
170
+
171
+
You can modify the echo bot to:
172
+
- Add more commands (parse for specific keywords)
173
+
- Store conversation history (use `Bot_storage`)
174
+
- Integrate with external APIs
175
+
- Format responses differently
176
+
- Add emoji reactions
177
+
178
+
## Troubleshooting
179
+
180
+
### Bot doesn't respond
181
+
- Check that the bot is actually running (look for console output)
182
+
- Verify the bot has permissions in the channel
183
+
- Check that you're mentioning the bot correctly (@botname)
184
+
- Look for error messages in the console
185
+
186
+
### Authentication errors
187
+
- Verify your `.zuliprc` file has the correct credentials
188
+
- Ensure the API key hasn't been regenerated
189
+
- Check that the bot user is active in Zulip
190
+
191
+
### Build errors
192
+
- Make sure all dependencies are installed: `opam install zulip zulip_bot eio_main`
193
+
- Clean and rebuild: `dune clean && dune build`
194
+
195
+
## Next Steps
196
+
197
+
Once you have the echo bot working, you can:
198
+
1. Extend it with more complex command parsing
199
+
2. Add persistent storage for user preferences
200
+
3. Integrate with external services
201
+
4. Build more sophisticated bots using the same framework
202
+
203
+
## Example Extensions
204
+
205
+
### Adding a Command Parser
206
+
```ocaml
207
+
let parse_command content =
208
+
match String.split_on_char ' ' content with
209
+
| "!echo" :: rest -> Some ("echo", String.concat " " rest)
210
+
| "!reverse" :: rest -> Some ("reverse", String.concat " " rest)
211
+
| _ -> None
212
+
```
213
+
214
+
### Using Bot Storage
215
+
```ocaml
216
+
(* Store user preferences *)
217
+
let _ = Bot_storage.put storage ~key:"user_prefs" ~value:"{...}" in
218
+
219
+
(* Retrieve later *)
220
+
let prefs = Bot_storage.get storage ~key:"user_prefs" in
221
+
```
222
+
223
+
### Sending to Specific Channels
224
+
```ocaml
225
+
Bot_handler.Response.ChannelMessage {
226
+
channel = "general";
227
+
topic = "Bot Updates";
228
+
content = "Echo bot is online!";
229
+
}
230
+
```
+408
examples/atom_feed_bot.ml
+408
examples/atom_feed_bot.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Atom Feed Bot for Zulip.
7
+
8
+
Posts Atom/RSS feed entries to Zulip channels organized by topic.
9
+
Supports both interactive mode (responds to !feed commands) and
10
+
scheduled mode (periodically fetches configured feeds). *)
11
+
12
+
(* Logging setup *)
13
+
let src = Logs.Src.create "atom_feed_bot" ~doc:"Atom feed bot for Zulip"
14
+
15
+
module Log = (val Logs.src_log src : Logs.LOG)
16
+
17
+
module Feed_parser = struct
18
+
type entry = {
19
+
title : string;
20
+
link : string;
21
+
summary : string option;
22
+
published : string option;
23
+
author : string option;
24
+
}
25
+
26
+
type feed = { title : string; entries : entry list }
27
+
28
+
(* Simple XML parser for Atom/RSS feeds *)
29
+
let parse_xml_element xml element_name =
30
+
let open_tag = "<" ^ element_name ^ ">" in
31
+
let close_tag = "</" ^ element_name ^ ">" in
32
+
try
33
+
match String.index_opt xml '<' with
34
+
| None -> None
35
+
| Some _ -> (
36
+
let pattern = open_tag in
37
+
let pattern_start =
38
+
try
39
+
Some
40
+
(String.index
41
+
(String.lowercase_ascii xml)
42
+
(String.lowercase_ascii pattern).[0])
43
+
with Not_found -> None
44
+
in
45
+
match pattern_start with
46
+
| None -> None
47
+
| Some _ -> (
48
+
let rec find_substring str sub start =
49
+
if start + String.length sub > String.length str then None
50
+
else if String.sub str start (String.length sub) = sub then
51
+
Some start
52
+
else find_substring str sub (start + 1)
53
+
in
54
+
match find_substring xml open_tag 0 with
55
+
| None -> None
56
+
| Some start_pos -> (
57
+
let content_start = start_pos + String.length open_tag in
58
+
match find_substring xml close_tag content_start with
59
+
| None -> None
60
+
| Some end_pos ->
61
+
let content =
62
+
String.sub xml content_start (end_pos - content_start)
63
+
in
64
+
Some (String.trim content))))
65
+
with _ -> None
66
+
67
+
let parse_entry entry_xml =
68
+
let title = parse_xml_element entry_xml "title" in
69
+
let link = parse_xml_element entry_xml "link" in
70
+
let summary = parse_xml_element entry_xml "summary" in
71
+
let published = parse_xml_element entry_xml "published" in
72
+
let author = parse_xml_element entry_xml "author" in
73
+
match (title, link) with
74
+
| Some t, Some l -> Some { title = t; link = l; summary; published; author }
75
+
| _ -> None
76
+
77
+
let _parse_feed xml =
78
+
let feed_title =
79
+
parse_xml_element xml "title" |> Option.value ~default:"Unknown Feed"
80
+
in
81
+
let entries = ref [] in
82
+
let rec extract_entries str pos =
83
+
try
84
+
let entry_start =
85
+
try String.index_from str pos '<'
86
+
with Not_found -> String.length str
87
+
in
88
+
if entry_start >= String.length str then ()
89
+
else
90
+
let tag_end = String.index_from str entry_start '>' in
91
+
let tag =
92
+
String.sub str (entry_start + 1) (tag_end - entry_start - 1)
93
+
in
94
+
if tag = "entry" || tag = "item" then (
95
+
let entry_end =
96
+
try String.index_from str tag_end '<'
97
+
with Not_found -> String.length str
98
+
in
99
+
let entry_xml =
100
+
String.sub str entry_start (entry_end - entry_start)
101
+
in
102
+
(match parse_entry entry_xml with
103
+
| Some e -> entries := e :: !entries
104
+
| None -> ());
105
+
extract_entries str entry_end)
106
+
else extract_entries str (tag_end + 1)
107
+
with _ -> ()
108
+
in
109
+
extract_entries xml 0;
110
+
{ title = feed_title; entries = List.rev !entries }
111
+
end
112
+
113
+
module Feed_bot = struct
114
+
type config = {
115
+
feeds : (string * string * string) list;
116
+
refresh_interval : float;
117
+
state_file : string;
118
+
}
119
+
120
+
type state = { last_seen : (string, string) Hashtbl.t }
121
+
122
+
let load_state path =
123
+
try
124
+
let ic = open_in path in
125
+
let state = { last_seen = Hashtbl.create 10 } in
126
+
(try
127
+
while true do
128
+
let line = input_line ic in
129
+
match String.split_on_char '|' line with
130
+
| [ url; id ] -> Hashtbl.add state.last_seen url id
131
+
| _ -> ()
132
+
done
133
+
with End_of_file -> ());
134
+
close_in ic;
135
+
state
136
+
with _ -> { last_seen = Hashtbl.create 10 }
137
+
138
+
let save_state path state =
139
+
let oc = open_out path in
140
+
Hashtbl.iter
141
+
(fun url id -> output_string oc (url ^ "|" ^ id ^ "\n"))
142
+
state.last_seen;
143
+
close_out oc
144
+
145
+
let fetch_feed _url =
146
+
Feed_parser.
147
+
{
148
+
title = "Mock Feed";
149
+
entries =
150
+
[
151
+
{
152
+
title = "Test Entry";
153
+
link = "https://example.com/1";
154
+
summary = Some "This is a test entry";
155
+
published = Some "2024-01-01T00:00:00Z";
156
+
author = Some "Test Author";
157
+
};
158
+
];
159
+
}
160
+
161
+
let format_entry (entry : Feed_parser.entry) =
162
+
let lines = [ Printf.sprintf "**[%s](%s)**" entry.title entry.link ] in
163
+
let lines =
164
+
match entry.author with
165
+
| Some a -> lines @ [ Printf.sprintf "*By %s*" a ]
166
+
| None -> lines
167
+
in
168
+
let lines =
169
+
match entry.published with
170
+
| Some p -> lines @ [ Printf.sprintf "*Published: %s*" p ]
171
+
| None -> lines
172
+
in
173
+
let lines =
174
+
match entry.summary with Some s -> lines @ [ ""; s ] | None -> lines
175
+
in
176
+
String.concat "\n" lines
177
+
178
+
let post_entry client channel topic entry =
179
+
let open Feed_parser in
180
+
let message =
181
+
Zulip.Message.create ~type_:`Channel ~to_:[ channel ] ~topic
182
+
~content:(format_entry entry) ()
183
+
in
184
+
try
185
+
let _ = Zulip.Messages.send client message in
186
+
Printf.printf "Posted: %s\n" entry.title
187
+
with Eio.Exn.Io _ as e ->
188
+
Printf.eprintf "Error posting: %s\n" (Printexc.to_string e)
189
+
190
+
let process_feed client state (url, channel, topic) =
191
+
Printf.printf "Processing feed: %s -> #%s/%s\n" url channel topic;
192
+
let feed = fetch_feed url in
193
+
let last_id = Hashtbl.find_opt state.last_seen url in
194
+
let new_entries =
195
+
match last_id with
196
+
| Some id ->
197
+
List.filter (fun e -> Feed_parser.(e.link <> id)) feed.entries
198
+
| None -> feed.entries
199
+
in
200
+
List.iter (post_entry client channel topic) new_entries;
201
+
match feed.entries with
202
+
| h :: _ -> Hashtbl.replace state.last_seen url Feed_parser.(h.link)
203
+
| [] -> ()
204
+
205
+
let run_bot env config =
206
+
let auth =
207
+
try Zulip.Auth.from_zuliprc ()
208
+
with Eio.Exn.Io _ as e ->
209
+
Printf.eprintf "Failed to load auth: %s\n" (Printexc.to_string e);
210
+
exit 1
211
+
in
212
+
Eio.Switch.run @@ fun sw ->
213
+
let client = Zulip.Client.create ~sw env auth in
214
+
let state = load_state config.state_file in
215
+
let rec loop () =
216
+
Printf.printf "Checking feeds...\n";
217
+
List.iter (process_feed client state) config.feeds;
218
+
save_state config.state_file state;
219
+
Printf.printf "Sleeping for %.0f seconds...\n" config.refresh_interval;
220
+
Eio.Time.sleep (Eio.Stdenv.clock env) config.refresh_interval;
221
+
loop ()
222
+
in
223
+
loop ()
224
+
end
225
+
226
+
(* Interactive bot that responds to commands *)
227
+
module Interactive_feed_bot = struct
228
+
open Zulip_bot
229
+
230
+
type t = {
231
+
feeds : (string, string * string) Hashtbl.t;
232
+
mutable default_channel : string;
233
+
}
234
+
235
+
let create () = { feeds = Hashtbl.create 10; default_channel = "general" }
236
+
237
+
let handle_command bot_state command args =
238
+
match command with
239
+
| "add" -> (
240
+
match args with
241
+
| name :: url :: topic ->
242
+
let topic_str = String.concat " " topic in
243
+
Hashtbl.replace bot_state.feeds name (url, topic_str);
244
+
Printf.sprintf "Added feed '%s' -> %s (topic: %s)" name url
245
+
topic_str
246
+
| _ -> "Usage: !feed add <name> <url> <topic>")
247
+
| "remove" -> (
248
+
match args with
249
+
| name :: _ ->
250
+
if Hashtbl.mem bot_state.feeds name then (
251
+
Hashtbl.remove bot_state.feeds name;
252
+
Printf.sprintf "Removed feed '%s'" name)
253
+
else Printf.sprintf "Feed '%s' not found" name
254
+
| _ -> "Usage: !feed remove <name>")
255
+
| "list" ->
256
+
if Hashtbl.length bot_state.feeds = 0 then "No feeds configured"
257
+
else
258
+
let lines =
259
+
Hashtbl.fold
260
+
(fun name (url, topic) acc ->
261
+
Printf.sprintf "* **%s**: %s -> topic: %s" name url topic :: acc)
262
+
bot_state.feeds []
263
+
in
264
+
String.concat "\n" lines
265
+
| "fetch" -> (
266
+
match args with
267
+
| name :: _ -> (
268
+
match Hashtbl.find_opt bot_state.feeds name with
269
+
| Some (url, _topic) ->
270
+
Printf.sprintf "Fetching feed '%s' from %s..." name url
271
+
| None -> Printf.sprintf "Feed '%s' not found" name)
272
+
| _ -> "Usage: !feed fetch <name>")
273
+
| "channel" -> (
274
+
match args with
275
+
| channel :: _ ->
276
+
bot_state.default_channel <- channel;
277
+
Printf.sprintf "Default channel set to: %s" channel
278
+
| _ ->
279
+
Printf.sprintf "Current default channel: %s"
280
+
bot_state.default_channel)
281
+
| "help" | _ ->
282
+
String.concat "\n"
283
+
[
284
+
"**Atom Feed Bot Commands:**";
285
+
"* `!feed add <name> <url> <topic>` - Add a new feed";
286
+
"* `!feed remove <name>` - Remove a feed";
287
+
"* `!feed list` - List all configured feeds";
288
+
"* `!feed fetch <name>` - Manually fetch a feed";
289
+
"* `!feed channel <name>` - Set default channel";
290
+
"* `!feed help` - Show this help message";
291
+
]
292
+
293
+
(* Create a handler function for the bot *)
294
+
let create_handler bot_state ~storage:_ ~identity message =
295
+
let content = Message.content message in
296
+
let bot_email = identity.Bot.email in
297
+
if Message.is_from_email message ~email:bot_email then Response.silent
298
+
else if String.starts_with ~prefix:"!feed" content then
299
+
let parts = String.split_on_char ' ' (String.trim content) in
300
+
match parts with
301
+
| _ :: command :: args ->
302
+
let response = handle_command bot_state command args in
303
+
Response.reply response
304
+
| _ ->
305
+
let response = handle_command bot_state "help" [] in
306
+
Response.reply response
307
+
else Response.silent
308
+
end
309
+
310
+
(* Run interactive bot mode *)
311
+
let run_interactive verbosity env =
312
+
Logs.set_reporter (Logs_fmt.reporter ());
313
+
Logs.set_level
314
+
(Some
315
+
(match verbosity with
316
+
| 0 -> Logs.Info
317
+
| 1 -> Logs.Debug
318
+
| _ -> Logs.Debug));
319
+
320
+
Log.info (fun m -> m "Starting interactive Atom feed bot...");
321
+
322
+
let bot_state = Interactive_feed_bot.create () in
323
+
324
+
let auth =
325
+
try Zulip.Auth.from_zuliprc ()
326
+
with Eio.Exn.Io _ as e ->
327
+
Log.err (fun m -> m "Failed to load auth: %s" (Printexc.to_string e));
328
+
exit 1
329
+
in
330
+
331
+
Eio.Switch.run @@ fun sw ->
332
+
let config =
333
+
Zulip_bot.Config.create ~name:"atom-feed-bot"
334
+
~site:(Zulip.Auth.server_url auth)
335
+
~email:(Zulip.Auth.email auth) ~api_key:(Zulip.Auth.api_key auth)
336
+
~description:"Bot for managing and posting Atom/RSS feeds to Zulip" ()
337
+
in
338
+
339
+
Log.info (fun m -> m "Feed bot is running! Use !feed help for commands.");
340
+
341
+
Zulip_bot.Bot.run ~sw ~env ~config
342
+
~handler:(Interactive_feed_bot.create_handler bot_state)
343
+
344
+
(* Run scheduled fetcher mode *)
345
+
let run_scheduled verbosity env =
346
+
Logs.set_reporter (Logs_fmt.reporter ());
347
+
Logs.set_level
348
+
(Some
349
+
(match verbosity with
350
+
| 0 -> Logs.Info
351
+
| 1 -> Logs.Debug
352
+
| _ -> Logs.Debug));
353
+
354
+
Log.info (fun m -> m "Starting scheduled Atom feed fetcher...");
355
+
356
+
let config =
357
+
Feed_bot.
358
+
{
359
+
feeds =
360
+
[
361
+
("https://example.com/feed.xml", "general", "News");
362
+
("https://blog.example.com/atom.xml", "general", "Blog Posts");
363
+
];
364
+
refresh_interval = 300.0;
365
+
state_file = "feed_bot_state.txt";
366
+
}
367
+
in
368
+
369
+
Feed_bot.run_bot env config
370
+
371
+
(* Command-line interface *)
372
+
open Cmdliner
373
+
374
+
let verbosity =
375
+
let doc = "Increase verbosity (can be used multiple times)" in
376
+
let verbosity_flags = Arg.(value & flag_all & info [ "v"; "verbose" ] ~doc) in
377
+
Term.(const List.length $ verbosity_flags)
378
+
379
+
let mode =
380
+
let doc = "Bot mode (interactive or scheduled)" in
381
+
let modes = [ ("interactive", `Interactive); ("scheduled", `Scheduled) ] in
382
+
Arg.(
383
+
value
384
+
& opt (enum modes) `Interactive
385
+
& info [ "m"; "mode" ] ~docv:"MODE" ~doc)
386
+
387
+
let main_cmd =
388
+
let doc = "Atom feed bot for Zulip" in
389
+
let man =
390
+
[
391
+
`S Manpage.s_description;
392
+
`P "This bot can run in two modes:";
393
+
`P "- Interactive mode: Responds to !feed commands in Zulip";
394
+
`P "- Scheduled mode: Periodically fetches configured feeds";
395
+
`P "The bot requires a configured ~/.zuliprc file with API credentials.";
396
+
]
397
+
in
398
+
let info = Cmd.info "atom_feed_bot" ~version:"2.0.0" ~doc ~man in
399
+
let run verbosity mode =
400
+
Eio_main.run @@ fun env ->
401
+
match mode with
402
+
| `Interactive -> run_interactive verbosity env
403
+
| `Scheduled -> run_scheduled verbosity env
404
+
in
405
+
let term = Term.(const run $ verbosity $ mode) in
406
+
Cmd.v info term
407
+
408
+
let () = exit (Cmd.eval main_cmd)
+10
examples/atom_feed_bot.mli
+10
examples/atom_feed_bot.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Atom Feed Bot for Zulip.
7
+
8
+
Posts Atom/RSS feed entries to Zulip channels. Supports both interactive
9
+
mode (responds to !feed commands) and scheduled mode (periodically fetches
10
+
configured feeds). *)
+24
examples/dune
+24
examples/dune
···
1
+
(executable
2
+
(public_name echo_bot)
3
+
(name echo_bot)
4
+
(package zulip)
5
+
(libraries
6
+
zulip
7
+
zulip.bot
8
+
eio_main
9
+
cmdliner
10
+
logs
11
+
logs.fmt
12
+
mirage-crypto-rng.unix))
13
+
14
+
(executable
15
+
(public_name atom_feed_bot)
16
+
(name atom_feed_bot)
17
+
(package zulip)
18
+
(libraries zulip zulip.bot eio_main cmdliner logs logs.fmt))
19
+
20
+
(executable
21
+
(public_name regression_test)
22
+
(name regression_test)
23
+
(package zulip)
24
+
(libraries zulip zulip.bot eio_main cmdliner logs logs.fmt unix))
+174
examples/echo_bot.ml
+174
examples/echo_bot.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Enhanced Echo Bot for Zulip with Logging and CLI.
7
+
8
+
Responds to direct messages and mentions by echoing back the message. Uses
9
+
the Zulip_bot API with cmdliner integration. *)
10
+
11
+
open Zulip_bot
12
+
13
+
let src = Logs.Src.create "echo_bot" ~doc:"Zulip Echo Bot"
14
+
15
+
module Log = (val Logs.src_log src : Logs.LOG)
16
+
17
+
(* The handler is now just a function *)
18
+
let echo_handler ~storage ~identity msg =
19
+
Log.debug (fun m ->
20
+
m "@[<h>Received: %a@]" (Message.pp_ansi ~show_json:false) msg);
21
+
22
+
let bot_email = identity.Bot.email in
23
+
let sender_email = Message.sender_email msg in
24
+
let sender_name = Message.sender_full_name msg in
25
+
26
+
(* Ignore our own messages *)
27
+
if sender_email = bot_email then Response.silent
28
+
else
29
+
(* Remove bot mention *)
30
+
let cleaned_msg = Message.strip_mention msg ~user_email:bot_email in
31
+
Log.debug (fun m -> m "Cleaned message: %s" cleaned_msg);
32
+
33
+
(* Process command or echo *)
34
+
let lower_msg = String.lowercase_ascii cleaned_msg in
35
+
let response_content =
36
+
if cleaned_msg = "" then
37
+
Printf.sprintf "Hello %s! Send me a message and I'll echo it back!"
38
+
sender_name
39
+
else if lower_msg = "help" then
40
+
Printf.sprintf
41
+
"Hi %s! I'm an echo bot with storage. Commands:\n\
42
+
• `help` - Show this help\n\
43
+
• `ping` - Test if I'm alive\n\
44
+
• `store <key> <value>` - Store a value\n\
45
+
• `get <key>` - Retrieve a value\n\
46
+
• `delete <key>` - Delete a stored value\n\
47
+
• `list` - List all stored keys\n\
48
+
• Any other message - I'll echo it back!"
49
+
sender_name
50
+
else if lower_msg = "ping" then (
51
+
Log.info (fun m -> m "Responding to ping from %s" sender_name);
52
+
Printf.sprintf "Pong! (from %s)" sender_name)
53
+
else if String.starts_with ~prefix:"store " lower_msg then
54
+
let parts =
55
+
String.sub cleaned_msg 6 (String.length cleaned_msg - 6)
56
+
|> String.trim
57
+
in
58
+
match String.index_opt parts ' ' with
59
+
| Some idx -> (
60
+
let key = String.sub parts 0 idx |> String.trim in
61
+
let value =
62
+
String.sub parts (idx + 1) (String.length parts - idx - 1)
63
+
|> String.trim
64
+
in
65
+
try
66
+
Storage.set storage key value;
67
+
Log.info (fun m ->
68
+
m "Stored key=%s value=%s for user %s" key value sender_name);
69
+
Printf.sprintf "Stored: `%s` = `%s`" key value
70
+
with Eio.Exn.Io _ as e ->
71
+
Log.err (fun m ->
72
+
m "Failed to store key=%s: %s" key (Printexc.to_string e));
73
+
Printf.sprintf "Failed to store: %s" (Printexc.to_string e))
74
+
| None -> "Usage: `store <key> <value>` - Example: `store name John`"
75
+
else if String.starts_with ~prefix:"get " lower_msg then (
76
+
let key =
77
+
String.sub cleaned_msg 4 (String.length cleaned_msg - 4)
78
+
|> String.trim
79
+
in
80
+
match Storage.get storage key with
81
+
| Some value ->
82
+
Log.info (fun m ->
83
+
m "Retrieved key=%s value=%s for user %s" key value sender_name);
84
+
Printf.sprintf "`%s` = `%s`" key value
85
+
| None ->
86
+
Log.info (fun m -> m "Key not found: %s" key);
87
+
Printf.sprintf "Key not found: `%s`" key)
88
+
else if String.starts_with ~prefix:"delete " lower_msg then (
89
+
let key =
90
+
String.sub cleaned_msg 7 (String.length cleaned_msg - 7)
91
+
|> String.trim
92
+
in
93
+
try
94
+
Storage.remove storage key;
95
+
Log.info (fun m -> m "Deleted key=%s for user %s" key sender_name);
96
+
Printf.sprintf "Deleted key: `%s`" key
97
+
with Eio.Exn.Io _ as e ->
98
+
Log.err (fun m ->
99
+
m "Failed to delete key=%s: %s" key (Printexc.to_string e));
100
+
Printf.sprintf "Failed to delete: %s" (Printexc.to_string e))
101
+
else if lower_msg = "list" then
102
+
try
103
+
let keys = Storage.keys storage in
104
+
if keys = [] then
105
+
"No keys stored yet. Use `store <key> <value>` to add data!"
106
+
else
107
+
let key_list =
108
+
String.concat "\n" (List.map (fun k -> "* `" ^ k ^ "`") keys)
109
+
in
110
+
Printf.sprintf
111
+
"Stored keys:\n%s\n\nUse `get <key>` to retrieve values." key_list
112
+
with Eio.Exn.Io _ as e ->
113
+
Printf.sprintf "Failed to list keys: %s" (Printexc.to_string e)
114
+
else Printf.sprintf "Echo from %s: %s" sender_name cleaned_msg
115
+
in
116
+
Log.debug (fun m -> m "Generated response: %s" response_content);
117
+
Response.reply response_content
118
+
119
+
let run_echo_bot config env =
120
+
Log.app (fun m -> m "Starting Zulip Echo Bot");
121
+
Log.app (fun m -> m "=============================\n");
122
+
123
+
Eio.Switch.run @@ fun sw ->
124
+
Log.info (fun m -> m "Loaded configuration for: %s" config.Config.email);
125
+
Log.info (fun m -> m "Server: %s" config.Config.site);
126
+
127
+
Log.app (fun m -> m "Echo bot is running!");
128
+
Log.app (fun m -> m "Send a direct message or mention the bot in a channel.");
129
+
Log.app (fun m -> m "Commands: 'help', 'ping', or any message to echo");
130
+
Log.app (fun m -> m "Press Ctrl+C to stop.\n");
131
+
132
+
try Bot.run ~sw ~env ~config ~handler:echo_handler with
133
+
| Sys.Break ->
134
+
Log.info (fun m -> m "Received interrupt signal, shutting down")
135
+
| exn ->
136
+
Log.err (fun m ->
137
+
m "Bot crashed with exception: %s" (Printexc.to_string exn));
138
+
Log.debug (fun m -> m "Backtrace: %s" (Printexc.get_backtrace ()));
139
+
raise exn
140
+
141
+
open Cmdliner
142
+
143
+
let bot_cmd eio_env =
144
+
let doc = "Zulip Echo Bot with verbose logging" in
145
+
let man =
146
+
[
147
+
`S Manpage.s_description;
148
+
`P
149
+
"A simple echo bot for Zulip that responds to messages by echoing them \
150
+
back. Features verbose logging for debugging and development.";
151
+
`S "CONFIGURATION";
152
+
`P
153
+
"The bot reads configuration from XDG config directory \
154
+
(~/.config/zulip-bot/echo-bot/config) or from a .zuliprc file.";
155
+
`S "LOGGING";
156
+
`P "Use -v for debug level logging, --verbose-http for HTTP-level details.";
157
+
`S "COMMANDS";
158
+
`P "The bot responds to:";
159
+
`P "- 'help' - Show usage information";
160
+
`P "- 'ping' - Respond with 'Pong!'";
161
+
`P "- 'store <key> <value>' - Store a value";
162
+
`P "- 'get <key>' - Retrieve a value";
163
+
`P "- 'delete <key>' - Delete a stored value";
164
+
`P "- 'list' - List all stored keys";
165
+
`P "- Any other message - Echo it back";
166
+
]
167
+
in
168
+
let info = Cmd.info "echo_bot" ~version:"2.0.0" ~doc ~man in
169
+
let config_term = Zulip_bot.Cmd.config_term "echo-bot" eio_env in
170
+
Cmd.v info Term.(const (fun config -> run_echo_bot config eio_env) $ config_term)
171
+
172
+
let () =
173
+
Mirage_crypto_rng_unix.use_default ();
174
+
Eio_main.run @@ fun env -> exit (Cmd.eval (bot_cmd env))
+10
examples/echo_bot.mli
+10
examples/echo_bot.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Echo Bot for Zulip.
7
+
8
+
A simple bot that echoes messages back to the sender, with support for
9
+
storage commands (store, get, delete, list). See {!README_ECHO_BOT.md}
10
+
for full documentation. *)
+9
examples/example_zuliprc.toml
+9
examples/example_zuliprc.toml
+379
examples/regression_test.ml
+379
examples/regression_test.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Zulip API Regression Test Bot
7
+
8
+
This bot exercises many features of the Zulip OCaml API to verify
9
+
the protocol implementation works correctly. Send a DM with "regress"
10
+
to trigger the tests.
11
+
12
+
Usage:
13
+
dune exec regression_test -- --channel "Sandbox-test"
14
+
*)
15
+
16
+
open Zulip_bot
17
+
18
+
let src = Logs.Src.create "regression_test" ~doc:"Zulip API Regression Test"
19
+
20
+
module Log = (val Logs.src_log src : Logs.LOG)
21
+
22
+
(** Test result tracking *)
23
+
type test_result = {
24
+
name : string;
25
+
passed : bool;
26
+
message : string;
27
+
duration_ms : float;
28
+
}
29
+
30
+
let results : test_result list ref = ref []
31
+
32
+
let record_result name passed message duration_ms =
33
+
results := { name; passed; message; duration_ms } :: !results;
34
+
if passed then Log.info (fun m -> m "PASS: %s (%s)" name message)
35
+
else Log.err (fun m -> m "FAIL: %s (%s)" name message)
36
+
37
+
(** Run a test with timing and error handling *)
38
+
let run_test name f =
39
+
let start = Unix.gettimeofday () in
40
+
try
41
+
let result = f () in
42
+
let duration = (Unix.gettimeofday () -. start) *. 1000.0 in
43
+
record_result name true result duration
44
+
with
45
+
| Eio.Exn.Io (Zulip.Error.E err, _) ->
46
+
let duration = (Unix.gettimeofday () -. start) *. 1000.0 in
47
+
record_result name false
48
+
(Printf.sprintf "API Error: %s" (Zulip.Error.message err))
49
+
duration
50
+
| exn ->
51
+
let duration = (Unix.gettimeofday () -. start) *. 1000.0 in
52
+
record_result name false
53
+
(Printf.sprintf "Exception: %s" (Printexc.to_string exn))
54
+
duration
55
+
56
+
(** Format results as markdown table *)
57
+
let format_results () =
58
+
let passed = List.filter (fun r -> r.passed) !results in
59
+
let failed = List.filter (fun r -> not r.passed) !results in
60
+
let total = List.length !results in
61
+
let pass_count = List.length passed in
62
+
let buf = Buffer.create 1024 in
63
+
Buffer.add_string buf
64
+
(Printf.sprintf "## Regression Test Results\n\n**%d/%d tests passed**\n\n" pass_count total);
65
+
Buffer.add_string buf "| Test | Status | Details | Time (ms) |\n";
66
+
Buffer.add_string buf "|------|--------|---------|----------|\n";
67
+
List.iter
68
+
(fun r ->
69
+
let status = if r.passed then ":check:" else ":x:" in
70
+
Buffer.add_string buf
71
+
(Printf.sprintf "| %s | %s | %s | %.1f |\n" r.name status r.message r.duration_ms))
72
+
(List.rev !results);
73
+
if List.length failed > 0 then (
74
+
Buffer.add_string buf "\n### Failed Tests\n\n";
75
+
List.iter
76
+
(fun r -> Buffer.add_string buf (Printf.sprintf "- **%s**: %s\n" r.name r.message))
77
+
failed);
78
+
Buffer.contents buf
79
+
80
+
(** Test: Get current user *)
81
+
let test_get_me client =
82
+
let user = Zulip.Users.me client in
83
+
Printf.sprintf "Got user: %s <%s>" (Zulip.User.full_name user) (Zulip.User.email user)
84
+
85
+
(** Test: List users *)
86
+
let test_list_users client =
87
+
let users = Zulip.Users.list client in
88
+
Printf.sprintf "Found %d users" (List.length users)
89
+
90
+
(** Test: List channels *)
91
+
let test_list_channels client =
92
+
let channels = Zulip.Channels.list client in
93
+
Printf.sprintf "Found %d channels" (List.length channels)
94
+
95
+
(** Test: Get subscriptions *)
96
+
let test_get_subscriptions client =
97
+
let subs = Zulip.Channels.get_subscriptions client in
98
+
Printf.sprintf "Subscribed to %d channels" (List.length subs)
99
+
100
+
(** Test: Get message history *)
101
+
let test_get_messages client =
102
+
let _json =
103
+
Zulip.Messages.get_messages client ~anchor:Newest ~num_before:5 ~num_after:0
104
+
()
105
+
in
106
+
"Retrieved recent messages"
107
+
108
+
(** Test: Edit a message *)
109
+
let test_edit_message client ~message_id ~new_content =
110
+
Zulip.Messages.edit client ~message_id ~content:new_content ();
111
+
Printf.sprintf "Edited message %d" message_id
112
+
113
+
(** Test: Add reaction *)
114
+
let test_add_reaction client ~message_id ~emoji =
115
+
Zulip.Messages.add_reaction client ~message_id ~emoji_name:emoji ();
116
+
Printf.sprintf "Added :%s: reaction to message %d" emoji message_id
117
+
118
+
(** Test: Remove reaction *)
119
+
let test_remove_reaction client ~message_id ~emoji =
120
+
Zulip.Messages.remove_reaction client ~message_id ~emoji_name:emoji ();
121
+
Printf.sprintf "Removed :%s: reaction from message %d" emoji message_id
122
+
123
+
(** Test: Mark message as read *)
124
+
let test_mark_read client ~message_id =
125
+
Zulip.Messages.update_flags client ~messages:[ message_id ]
126
+
~op:Zulip.Message_flag.Add ~flag:`Read;
127
+
Printf.sprintf "Marked message %d as read" message_id
128
+
129
+
(** Test: Star a message *)
130
+
let test_star_message client ~message_id =
131
+
Zulip.Messages.update_flags client ~messages:[ message_id ]
132
+
~op:Zulip.Message_flag.Add ~flag:`Starred;
133
+
Printf.sprintf "Starred message %d" message_id
134
+
135
+
(** Test: Unstar a message *)
136
+
let test_unstar_message client ~message_id =
137
+
Zulip.Messages.update_flags client ~messages:[ message_id ]
138
+
~op:Zulip.Message_flag.Remove ~flag:`Starred;
139
+
Printf.sprintf "Unstarred message %d" message_id
140
+
141
+
(** Test: Send typing notification *)
142
+
let test_typing client ~env ~stream_id ~topic =
143
+
Zulip.Typing.set_channel client ~op:Start ~stream_id ~topic;
144
+
Eio.Time.sleep env#clock 0.1;
145
+
Zulip.Typing.set_channel client ~op:Stop ~stream_id ~topic;
146
+
Printf.sprintf "Sent typing start/stop to stream %d topic %s" stream_id topic
147
+
148
+
(** Test: Get alert words *)
149
+
let test_get_alert_words client =
150
+
let words = Zulip.Users.get_alert_words client in
151
+
Printf.sprintf "Got %d alert words" (List.length words)
152
+
153
+
(** Test: Add and remove alert word *)
154
+
let test_alert_words client =
155
+
let test_word = "zulip_api_test_word_" ^ string_of_int (Random.int 10000) in
156
+
let _ = Zulip.Users.add_alert_words client ~words:[ test_word ] in
157
+
let _ = Zulip.Users.remove_alert_words client ~words:[ test_word ] in
158
+
Printf.sprintf "Added and removed alert word: %s" test_word
159
+
160
+
(** Test: Get server settings *)
161
+
let test_server_settings client =
162
+
let _settings = Zulip.Server.get_settings client in
163
+
"Retrieved server settings"
164
+
165
+
(** Test: Render message content *)
166
+
let test_render_message client =
167
+
let html = Zulip.Messages.render client ~content:"**bold** and _italic_" in
168
+
Printf.sprintf "Rendered %d bytes of HTML" (String.length html)
169
+
170
+
(** Test: Get channel topics *)
171
+
let test_get_topics client ~stream_id =
172
+
let topics = Zulip.Channels.get_topics client ~stream_id in
173
+
Printf.sprintf "Found %d topics" (List.length topics)
174
+
175
+
(** Test: Get channel subscribers *)
176
+
let test_get_subscribers client ~stream_id =
177
+
let subs = Zulip.Channels.get_subscribers client ~stream_id in
178
+
Printf.sprintf "Found %d subscribers" (List.length subs)
179
+
180
+
(** Test: Send a direct message *)
181
+
let test_send_dm client ~recipient ~content =
182
+
let msg = Zulip.Message.create ~type_:`Direct ~to_:[ recipient ] ~content () in
183
+
let resp = Zulip.Messages.send client msg in
184
+
Printf.sprintf "Sent DM (ID %d) to %s" (Zulip.Message_response.id resp) recipient
185
+
186
+
(** Test: Get presence for all users *)
187
+
let test_get_all_presence client =
188
+
let presence = Zulip.Presence.get_all client in
189
+
Printf.sprintf "Got presence for %d users" (List.length presence)
190
+
191
+
(** Run all regression tests *)
192
+
let run_tests ~env ~client ~channel ~trigger_user =
193
+
(* Clear previous results *)
194
+
results := [];
195
+
196
+
Log.app (fun m -> m "Starting Zulip API Regression Tests");
197
+
Log.app (fun m -> m "Test channel: %s" channel);
198
+
Log.app (fun m -> m "Triggered by: %s" trigger_user);
199
+
Log.app (fun m -> m "========================================\n");
200
+
201
+
(* Get stream_id for test channel *)
202
+
let stream_id =
203
+
try Some (Zulip.Channels.get_id client ~name:channel)
204
+
with _ ->
205
+
Log.warn (fun m -> m "Could not find channel %s" channel);
206
+
None
207
+
in
208
+
209
+
let topic = "regression-test-" ^ string_of_int (Random.int 10000) in
210
+
211
+
(* Run basic user/channel tests *)
212
+
run_test "Get current user" (fun () -> test_get_me client);
213
+
run_test "List users" (fun () -> test_list_users client);
214
+
run_test "List channels" (fun () -> test_list_channels client);
215
+
run_test "Get subscriptions" (fun () -> test_get_subscriptions client);
216
+
run_test "Get alert words" (fun () -> test_get_alert_words client);
217
+
run_test "Add/remove alert word" (fun () -> test_alert_words client);
218
+
run_test "Get server settings" (fun () -> test_server_settings client);
219
+
(* Note: get_user_settings, get_muted_users, and update_presence don't work with bots *)
220
+
run_test "Get all presence" (fun () -> test_get_all_presence client);
221
+
run_test "Render message" (fun () -> test_render_message client);
222
+
223
+
(* Test message operations if we have a test channel *)
224
+
(match stream_id with
225
+
| Some sid ->
226
+
run_test "Get channel topics" (fun () -> test_get_topics client ~stream_id:sid);
227
+
run_test "Get channel subscribers" (fun () -> test_get_subscribers client ~stream_id:sid);
228
+
229
+
(* Send test message *)
230
+
let test_msg_id = ref None in
231
+
run_test "Send channel message" (fun () ->
232
+
let content =
233
+
Printf.sprintf
234
+
"**Regression Test Started**\n\nTriggered by: %s\nTest run at: %s\n\nThis message will be edited and have reactions added."
235
+
trigger_user
236
+
(string_of_float (Unix.gettimeofday ()))
237
+
in
238
+
let msg =
239
+
Zulip.Message.create ~type_:`Channel ~to_:[ channel ] ~topic ~content ()
240
+
in
241
+
let resp = Zulip.Messages.send client msg in
242
+
test_msg_id := Some (Zulip.Message_response.id resp);
243
+
Printf.sprintf "Sent message ID %d" (Zulip.Message_response.id resp));
244
+
245
+
(match !test_msg_id with
246
+
| Some mid ->
247
+
run_test "Add reaction (robot)" (fun () ->
248
+
test_add_reaction client ~message_id:mid ~emoji:"robot");
249
+
run_test "Add reaction (thumbs_up)" (fun () ->
250
+
test_add_reaction client ~message_id:mid ~emoji:"thumbs_up");
251
+
run_test "Remove reaction" (fun () ->
252
+
test_remove_reaction client ~message_id:mid ~emoji:"thumbs_up");
253
+
run_test "Mark as read" (fun () -> test_mark_read client ~message_id:mid);
254
+
run_test "Star message" (fun () -> test_star_message client ~message_id:mid);
255
+
run_test "Unstar message" (fun () -> test_unstar_message client ~message_id:mid);
256
+
run_test "Edit message" (fun () ->
257
+
test_edit_message client ~message_id:mid
258
+
~new_content:
259
+
"**Regression Test - EDITED**\n\nThis message was successfully edited.\n\nPlease react with :tada: to verify reactions work!");
260
+
run_test "Typing indicator" (fun () ->
261
+
test_typing client ~env ~stream_id:sid ~topic)
262
+
| None -> Log.warn (fun m -> m "Skipping message-specific tests - no message ID"))
263
+
| None -> Log.warn (fun m -> m "Skipping channel tests - no stream ID"));
264
+
265
+
run_test "Get messages" (fun () -> test_get_messages client);
266
+
267
+
(* Send DM to trigger user *)
268
+
run_test "Send DM reply" (fun () ->
269
+
test_send_dm client ~recipient:trigger_user
270
+
~content:
271
+
("Regression test in progress! I'll send you the results shortly.\n\n"
272
+
^ "Test run: "
273
+
^ string_of_float (Unix.gettimeofday ())));
274
+
275
+
(* Post results summary to channel *)
276
+
let summary = format_results () in
277
+
Log.app (fun m -> m "\n%s" summary);
278
+
279
+
(match stream_id with
280
+
| Some _sid ->
281
+
run_test "Post results to channel" (fun () ->
282
+
let msg =
283
+
Zulip.Message.create ~type_:`Channel ~to_:[ channel ] ~topic
284
+
~content:(format_results ())
285
+
()
286
+
in
287
+
let resp = Zulip.Messages.send client msg in
288
+
Printf.sprintf "Posted results (message ID %d)" (Zulip.Message_response.id resp))
289
+
| None -> ());
290
+
291
+
let passed = List.filter (fun r -> r.passed) !results in
292
+
let total = List.length !results in
293
+
Log.app (fun m -> m "\n========================================");
294
+
Log.app (fun m -> m "SUMMARY: %d/%d tests passed" (List.length passed) total);
295
+
296
+
(* Return summary for DM *)
297
+
format_results ()
298
+
299
+
(** Bot handler - triggers on "regress" DM *)
300
+
let make_handler ~env ~channel =
301
+
fun ~storage ~identity:_ msg ->
302
+
let content = String.lowercase_ascii (String.trim (Message.content msg)) in
303
+
let sender_email = Message.sender_email msg in
304
+
305
+
(* Only respond to DMs containing "regress" *)
306
+
if Message.is_private msg && String.sub content 0 (min 7 (String.length content)) = "regress"
307
+
then (
308
+
Log.info (fun m -> m "Regression test triggered by %s" sender_email);
309
+
310
+
(* Get the client from storage *)
311
+
let client = Storage.client storage in
312
+
313
+
(* Run the tests *)
314
+
let summary = run_tests ~env ~client ~channel ~trigger_user:sender_email in
315
+
316
+
(* Reply with results *)
317
+
Response.reply summary)
318
+
else if Message.is_private msg then
319
+
Response.reply
320
+
"Send me `regress` to trigger the Zulip API regression test suite."
321
+
else Response.silent
322
+
323
+
(** Main entry point *)
324
+
let run_bot ~env ~channel config =
325
+
Log.app (fun m -> m "Starting Regression Test Bot");
326
+
Log.app (fun m -> m "Test channel: %s" channel);
327
+
Log.app (fun m -> m "Send a DM with 'regress' to trigger tests");
328
+
Log.app (fun m -> m "========================================\n");
329
+
330
+
Random.self_init ();
331
+
Eio.Switch.run @@ fun sw ->
332
+
let handler = make_handler ~env ~channel in
333
+
Bot.run ~sw ~env ~config ~handler
334
+
335
+
open Cmdliner
336
+
337
+
let channel_arg =
338
+
let doc = "Channel name for test messages (default: Sandbox-test)" in
339
+
Arg.(
340
+
value
341
+
& opt string "Sandbox-test"
342
+
& info [ "channel" ] ~docv:"CHANNEL" ~doc)
343
+
344
+
let run_cmd eio_env =
345
+
let doc = "Zulip API Regression Test Bot" in
346
+
let man =
347
+
[
348
+
`S Manpage.s_description;
349
+
`P
350
+
"A bot that runs comprehensive regression tests against the Zulip API. \
351
+
Send a DM with 'regress' to trigger the test suite.";
352
+
`S "TESTS";
353
+
`P "The following API features are tested:";
354
+
`P "- User operations (get self, list users)";
355
+
`P "- Channel operations (list, get topics, get subscribers)";
356
+
`P "- Message operations (send, edit)";
357
+
`P "- Reactions (add, remove)";
358
+
`P "- Message flags (read, starred)";
359
+
`P "- Typing indicators";
360
+
`P "- Presence updates";
361
+
`P "- Alert words";
362
+
`P "- Direct messages";
363
+
`S "USAGE";
364
+
`P "1. Start the bot: dune exec regression_test -- --channel 'Sandbox-test'";
365
+
`P "2. Send a DM to the bot containing 'regress'";
366
+
`P "3. The bot will run tests and post results to the channel and DM you";
367
+
]
368
+
in
369
+
let info = Cmd.info "regression_test" ~version:"1.0.0" ~doc ~man in
370
+
let config_term = Zulip_bot.Cmd.config_term "regression-test" eio_env in
371
+
Cmd.v info
372
+
Term.(
373
+
const (fun channel config -> run_bot ~env:eio_env ~channel config)
374
+
$ channel_arg
375
+
$ config_term)
376
+
377
+
let () =
378
+
Eio_main.run @@ fun env ->
379
+
exit (Cmd.eval (run_cmd env))
+10
examples/regression_test.mli
+10
examples/regression_test.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Zulip API Regression Test Bot.
7
+
8
+
Exercises many features of the Zulip OCaml API to verify the protocol
9
+
implementation works correctly. Send a DM with "regress" to trigger
10
+
the tests. *)
+1
lib/dune
+1
lib/dune
···
1
+
(dirs zulip zulip_bot)
+110
lib/zulip/auth.ml
+110
lib/zulip/auth.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = { server_url : string; email : string; api_key : string }
7
+
8
+
let create ~server_url ~email ~api_key = { server_url; email; api_key }
9
+
10
+
type zuliprc_api = {
11
+
zuliprc_email : string;
12
+
zuliprc_key : string;
13
+
zuliprc_site : string;
14
+
}
15
+
(** INI section record for parsing the [api] section of zuliprc *)
16
+
17
+
(** Codec for parsing the [api] section of zuliprc. Note: zuliprc uses "key" not
18
+
"api_key" *)
19
+
let api_section_codec =
20
+
Init.Section.(
21
+
obj (fun email key site ->
22
+
{ zuliprc_email = email; zuliprc_key = key; zuliprc_site = site })
23
+
|> mem "email" Init.string ~enc:(fun c -> c.zuliprc_email)
24
+
|> mem "key" Init.string ~enc:(fun c -> c.zuliprc_key)
25
+
|> mem "site" Init.string ~enc:(fun c -> c.zuliprc_site)
26
+
|> skip_unknown |> finish)
27
+
28
+
(** Document codec for zuliprc with [api] section *)
29
+
let zuliprc_codec =
30
+
Init.Document.(
31
+
obj (fun api -> api)
32
+
|> section "api" api_section_codec ~enc:Fun.id
33
+
|> skip_unknown |> finish)
34
+
35
+
(** Codec for zuliprc without section headers (bare key=value pairs) *)
36
+
let zuliprc_bare_codec =
37
+
Init.Document.(
38
+
obj (fun defaults -> defaults)
39
+
|> defaults api_section_codec ~enc:Fun.id
40
+
|> skip_unknown |> finish)
41
+
42
+
let from_zuliprc ?(path = "~/.zuliprc") () =
43
+
try
44
+
(* Expand ~ to home directory *)
45
+
let expanded_path =
46
+
if String.length path > 0 && path.[0] = '~' then
47
+
let home = try Sys.getenv "HOME" with Not_found -> "" in
48
+
home ^ String.sub path 1 (String.length path - 1)
49
+
else path
50
+
in
51
+
52
+
(* Read file content *)
53
+
let content =
54
+
let ic = open_in expanded_path in
55
+
let content = really_input_string ic (in_channel_length ic) in
56
+
close_in ic;
57
+
content
58
+
in
59
+
60
+
(* Parse using Init library *)
61
+
let api =
62
+
match Init_bytesrw.decode_string zuliprc_codec content with
63
+
| Ok c -> c
64
+
| Error _ -> (
65
+
(* Try bare config format (no section headers) *)
66
+
match Init_bytesrw.decode_string zuliprc_bare_codec content with
67
+
| Ok c -> c
68
+
| Error msg ->
69
+
Error.raise_with_context
70
+
(Error.make ~code:(Other "parse_error")
71
+
~message:("Error parsing zuliprc: " ^ msg)
72
+
())
73
+
"reading %s" path)
74
+
in
75
+
76
+
(* Ensure server_url has proper protocol *)
77
+
let server_url =
78
+
if
79
+
String.starts_with ~prefix:"http://" api.zuliprc_site
80
+
|| String.starts_with ~prefix:"https://" api.zuliprc_site
81
+
then api.zuliprc_site
82
+
else "https://" ^ api.zuliprc_site
83
+
in
84
+
{ server_url; email = api.zuliprc_email; api_key = api.zuliprc_key }
85
+
with
86
+
| Eio.Exn.Io _ as ex -> raise ex
87
+
| Sys_error msg ->
88
+
Error.raise_with_context
89
+
(Error.make ~code:(Other "file_error")
90
+
~message:("Cannot read zuliprc file: " ^ msg)
91
+
())
92
+
"reading %s" path
93
+
| exn ->
94
+
Error.raise_with_context
95
+
(Error.make ~code:(Other "parse_error")
96
+
~message:("Error parsing zuliprc: " ^ Printexc.to_string exn)
97
+
())
98
+
"reading %s" path
99
+
100
+
let server_url t = t.server_url
101
+
let email t = t.email
102
+
let api_key t = t.api_key
103
+
104
+
let to_basic_auth_header t =
105
+
match Base64.encode (t.email ^ ":" ^ t.api_key) with
106
+
| Ok encoded -> "Basic " ^ encoded
107
+
| Error (`Msg msg) -> failwith ("Base64 encoding failed: " ^ msg)
108
+
109
+
let pp fmt t =
110
+
Format.fprintf fmt "Auth{server=%s, email=%s}" t.server_url t.email
+26
lib/zulip/auth.mli
+26
lib/zulip/auth.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Authentication for the Zulip API.
7
+
8
+
This module handles authentication credentials for connecting to a Zulip
9
+
server.
10
+
@raise Eio.Io with [Error.E error] on authentication/config errors *)
11
+
12
+
type t
13
+
14
+
val create : server_url:string -> email:string -> api_key:string -> t
15
+
(** Create authentication credentials directly. *)
16
+
17
+
val from_zuliprc : ?path:string -> unit -> t
18
+
(** Load credentials from a zuliprc file.
19
+
@param path Path to zuliprc file (default: ~/.zuliprc)
20
+
@raise Eio.Io on file read or parse errors *)
21
+
22
+
val server_url : t -> string
23
+
val email : t -> string
24
+
val api_key : t -> string
25
+
val to_basic_auth_header : t -> string
26
+
val pp : Format.formatter -> t -> unit
+193
lib/zulip/channel.ml
+193
lib/zulip/channel.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
name : string;
8
+
stream_id : int option;
9
+
description : string;
10
+
invite_only : bool;
11
+
is_web_public : bool;
12
+
history_public_to_subscribers : bool;
13
+
is_default : bool;
14
+
message_retention_days : int option option;
15
+
first_message_id : int option;
16
+
date_created : float option;
17
+
stream_post_policy : int;
18
+
}
19
+
20
+
let create ~name ?stream_id ?(description = "") ?(invite_only = false)
21
+
?(is_web_public = false) ?(history_public_to_subscribers = true)
22
+
?(is_default = false) ?message_retention_days ?first_message_id
23
+
?date_created ?(stream_post_policy = 1) () =
24
+
{
25
+
name;
26
+
stream_id;
27
+
description;
28
+
invite_only;
29
+
is_web_public;
30
+
history_public_to_subscribers;
31
+
is_default;
32
+
message_retention_days;
33
+
first_message_id;
34
+
date_created;
35
+
stream_post_policy;
36
+
}
37
+
38
+
let name t = t.name
39
+
let stream_id t = t.stream_id
40
+
let description t = t.description
41
+
let invite_only t = t.invite_only
42
+
let is_web_public t = t.is_web_public
43
+
let history_public_to_subscribers t = t.history_public_to_subscribers
44
+
let is_default t = t.is_default
45
+
let message_retention_days t = t.message_retention_days
46
+
let first_message_id t = t.first_message_id
47
+
let date_created t = t.date_created
48
+
let stream_post_policy t = t.stream_post_policy
49
+
50
+
let pp fmt t =
51
+
Format.fprintf fmt "Channel{name=%s, stream_id=%s, description=%s}" t.name
52
+
(match t.stream_id with Some id -> string_of_int id | None -> "none")
53
+
t.description
54
+
55
+
module Subscription = struct
56
+
type channel = t
57
+
58
+
type t = {
59
+
channel : channel;
60
+
color : string option;
61
+
is_muted : bool;
62
+
pin_to_top : bool;
63
+
desktop_notifications : bool option;
64
+
audible_notifications : bool option;
65
+
push_notifications : bool option;
66
+
email_notifications : bool option;
67
+
wildcard_mentions_notify : bool option;
68
+
}
69
+
70
+
let channel t = t.channel
71
+
let color t = t.color
72
+
let is_muted t = t.is_muted
73
+
let pin_to_top t = t.pin_to_top
74
+
let desktop_notifications t = t.desktop_notifications
75
+
let audible_notifications t = t.audible_notifications
76
+
let push_notifications t = t.push_notifications
77
+
let email_notifications t = t.email_notifications
78
+
let wildcard_mentions_notify t = t.wildcard_mentions_notify
79
+
80
+
let jsont =
81
+
let kind = "Subscription" in
82
+
let doc = "A Zulip channel subscription" in
83
+
let make name stream_id description invite_only is_web_public
84
+
history_public_to_subscribers is_default message_retention_days
85
+
first_message_id date_created stream_post_policy color is_muted
86
+
pin_to_top desktop_notifications audible_notifications
87
+
push_notifications email_notifications wildcard_mentions_notify =
88
+
let channel =
89
+
{
90
+
name;
91
+
stream_id;
92
+
description;
93
+
invite_only;
94
+
is_web_public;
95
+
history_public_to_subscribers;
96
+
is_default;
97
+
message_retention_days;
98
+
first_message_id;
99
+
date_created;
100
+
stream_post_policy;
101
+
}
102
+
in
103
+
{
104
+
channel;
105
+
color;
106
+
is_muted;
107
+
pin_to_top;
108
+
desktop_notifications;
109
+
audible_notifications;
110
+
push_notifications;
111
+
email_notifications;
112
+
wildcard_mentions_notify;
113
+
}
114
+
in
115
+
Jsont.Object.map ~kind ~doc make
116
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun t -> t.channel.name)
117
+
|> Jsont.Object.opt_mem "stream_id" Jsont.int ~enc:(fun t ->
118
+
t.channel.stream_id)
119
+
|> Jsont.Object.mem "description" Jsont.string ~dec_absent:"" ~enc:(fun t ->
120
+
t.channel.description)
121
+
|> Jsont.Object.mem "invite_only" Jsont.bool ~dec_absent:false
122
+
~enc:(fun t -> t.channel.invite_only)
123
+
|> Jsont.Object.mem "is_web_public" Jsont.bool ~dec_absent:false
124
+
~enc:(fun t -> t.channel.is_web_public)
125
+
|> Jsont.Object.mem "history_public_to_subscribers" Jsont.bool
126
+
~dec_absent:true ~enc:(fun t ->
127
+
t.channel.history_public_to_subscribers)
128
+
|> Jsont.Object.mem "is_default" Jsont.bool ~dec_absent:false ~enc:(fun t ->
129
+
t.channel.is_default)
130
+
|> Jsont.Object.opt_mem "message_retention_days" (Jsont.option Jsont.int)
131
+
~enc:(fun t -> t.channel.message_retention_days)
132
+
|> Jsont.Object.opt_mem "first_message_id" Jsont.int ~enc:(fun t ->
133
+
t.channel.first_message_id)
134
+
|> Jsont.Object.opt_mem "date_created" Jsont.number ~enc:(fun t ->
135
+
t.channel.date_created)
136
+
|> Jsont.Object.mem "stream_post_policy" Jsont.int ~dec_absent:1
137
+
~enc:(fun t -> t.channel.stream_post_policy)
138
+
|> Jsont.Object.opt_mem "color" Jsont.string ~enc:color
139
+
|> Jsont.Object.mem "is_muted" Jsont.bool ~dec_absent:false ~enc:is_muted
140
+
|> Jsont.Object.mem "pin_to_top" Jsont.bool ~dec_absent:false
141
+
~enc:pin_to_top
142
+
|> Jsont.Object.mem "desktop_notifications" (Jsont.option Jsont.bool)
143
+
~dec_absent:None ~enc:desktop_notifications
144
+
|> Jsont.Object.mem "audible_notifications" (Jsont.option Jsont.bool)
145
+
~dec_absent:None ~enc:audible_notifications
146
+
|> Jsont.Object.mem "push_notifications" (Jsont.option Jsont.bool)
147
+
~dec_absent:None ~enc:push_notifications
148
+
|> Jsont.Object.mem "email_notifications" (Jsont.option Jsont.bool)
149
+
~dec_absent:None ~enc:email_notifications
150
+
|> Jsont.Object.mem "wildcard_mentions_notify" (Jsont.option Jsont.bool)
151
+
~dec_absent:None ~enc:wildcard_mentions_notify
152
+
|> Jsont.Object.finish
153
+
end
154
+
155
+
(* Jsont codec for channel *)
156
+
let jsont =
157
+
let kind = "Channel" in
158
+
let doc = "A Zulip channel (stream)" in
159
+
let make name stream_id description invite_only is_web_public
160
+
history_public_to_subscribers is_default message_retention_days
161
+
first_message_id date_created stream_post_policy =
162
+
{
163
+
name;
164
+
stream_id;
165
+
description;
166
+
invite_only;
167
+
is_web_public;
168
+
history_public_to_subscribers;
169
+
is_default;
170
+
message_retention_days;
171
+
first_message_id;
172
+
date_created;
173
+
stream_post_policy;
174
+
}
175
+
in
176
+
Jsont.Object.map ~kind ~doc make
177
+
|> Jsont.Object.mem "name" Jsont.string ~enc:name
178
+
|> Jsont.Object.opt_mem "stream_id" Jsont.int ~enc:stream_id
179
+
|> Jsont.Object.mem "description" Jsont.string ~dec_absent:"" ~enc:description
180
+
|> Jsont.Object.mem "invite_only" Jsont.bool ~dec_absent:false
181
+
~enc:invite_only
182
+
|> Jsont.Object.mem "is_web_public" Jsont.bool ~dec_absent:false
183
+
~enc:is_web_public
184
+
|> Jsont.Object.mem "history_public_to_subscribers" Jsont.bool
185
+
~dec_absent:true ~enc:history_public_to_subscribers
186
+
|> Jsont.Object.mem "is_default" Jsont.bool ~dec_absent:false ~enc:is_default
187
+
|> Jsont.Object.opt_mem "message_retention_days" (Jsont.option Jsont.int)
188
+
~enc:message_retention_days
189
+
|> Jsont.Object.opt_mem "first_message_id" Jsont.int ~enc:first_message_id
190
+
|> Jsont.Object.opt_mem "date_created" Jsont.number ~enc:date_created
191
+
|> Jsont.Object.mem "stream_post_policy" Jsont.int ~dec_absent:1
192
+
~enc:stream_post_policy
193
+
|> Jsont.Object.finish
+137
lib/zulip/channel.mli
+137
lib/zulip/channel.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Zulip channels (streams).
7
+
8
+
This module represents channel/stream information from the Zulip API. Use
9
+
{!jsont} with Bytesrw-eio for wire serialization.
10
+
11
+
Note: Zulip uses "stream" in the API but "channel" in the UI. This library
12
+
uses "channel" to match the current Zulip terminology. *)
13
+
14
+
(** {1 Channel Type} *)
15
+
16
+
type t
17
+
(** A Zulip channel/stream. *)
18
+
19
+
(** {1 Construction} *)
20
+
21
+
val create :
22
+
name:string ->
23
+
?stream_id:int ->
24
+
?description:string ->
25
+
?invite_only:bool ->
26
+
?is_web_public:bool ->
27
+
?history_public_to_subscribers:bool ->
28
+
?is_default:bool ->
29
+
?message_retention_days:int option ->
30
+
?first_message_id:int ->
31
+
?date_created:float ->
32
+
?stream_post_policy:int ->
33
+
unit ->
34
+
t
35
+
(** Create a channel record.
36
+
37
+
@param name Channel name (required)
38
+
@param stream_id Server-assigned channel ID
39
+
@param description Channel description
40
+
@param invite_only Whether the channel is private
41
+
@param is_web_public Whether the channel is web-public
42
+
@param history_public_to_subscribers
43
+
Whether history is visible to new subscribers
44
+
@param is_default Whether this is a default channel for new users
45
+
@param message_retention_days Message retention policy (None = forever)
46
+
@param first_message_id ID of the first message in the channel
47
+
@param date_created Unix timestamp of creation
48
+
@param stream_post_policy
49
+
Who can post (1=any, 2=admins, 3=full members, 4=moderators) *)
50
+
51
+
(** {1 Accessors} *)
52
+
53
+
val name : t -> string
54
+
(** Channel name. *)
55
+
56
+
val stream_id : t -> int option
57
+
(** Server-assigned channel ID. *)
58
+
59
+
val description : t -> string
60
+
(** Channel description. *)
61
+
62
+
val invite_only : t -> bool
63
+
(** Whether the channel is private (invite-only). *)
64
+
65
+
val is_web_public : t -> bool
66
+
(** Whether the channel is web-public (visible without authentication). *)
67
+
68
+
val history_public_to_subscribers : t -> bool
69
+
(** Whether new subscribers can see message history. *)
70
+
71
+
val is_default : t -> bool
72
+
(** Whether new users are automatically subscribed. *)
73
+
74
+
val message_retention_days : t -> int option option
75
+
(** Message retention policy. [None] if not set (use organization default),
76
+
[Some None] for unlimited retention, [Some (Some n)] for n days. *)
77
+
78
+
val first_message_id : t -> int option
79
+
(** ID of the first message in the channel. *)
80
+
81
+
val date_created : t -> float option
82
+
(** Unix timestamp when the channel was created. *)
83
+
84
+
val stream_post_policy : t -> int
85
+
(** Who can post to the channel. 1 = any member, 2 = admins only, 3 = full
86
+
members, 4 = moderators only. *)
87
+
88
+
(** {1 Subscription Info}
89
+
90
+
When retrieved via subscriptions API, channels include additional
91
+
subscription-specific fields. *)
92
+
93
+
module Subscription : sig
94
+
type channel := t
95
+
96
+
type t
97
+
(** A channel subscription with user-specific settings. *)
98
+
99
+
val channel : t -> channel
100
+
(** The underlying channel. *)
101
+
102
+
val color : t -> string option
103
+
(** User's color preference for the channel (hex string). *)
104
+
105
+
val is_muted : t -> bool
106
+
(** Whether the user has muted this channel. *)
107
+
108
+
val pin_to_top : t -> bool
109
+
(** Whether the channel is pinned. *)
110
+
111
+
val desktop_notifications : t -> bool option
112
+
(** Desktop notification setting (None = use global default). *)
113
+
114
+
val audible_notifications : t -> bool option
115
+
(** Sound notification setting. *)
116
+
117
+
val push_notifications : t -> bool option
118
+
(** Push notification setting. *)
119
+
120
+
val email_notifications : t -> bool option
121
+
(** Email notification setting. *)
122
+
123
+
val wildcard_mentions_notify : t -> bool option
124
+
(** Whether to notify on @all/@everyone mentions. *)
125
+
126
+
val jsont : t Jsont.t
127
+
(** Jsont codec for subscription. *)
128
+
end
129
+
130
+
(** {1 JSON Codec} *)
131
+
132
+
val jsont : t Jsont.t
133
+
(** Jsont codec for the channel type. *)
134
+
135
+
(** {1 Pretty Printing} *)
136
+
137
+
val pp : Format.formatter -> t -> unit
+478
lib/zulip/channels.ml
+478
lib/zulip/channels.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let streams_codec =
7
+
Jsont.Object.(
8
+
map ~kind:"StreamsResponse" Fun.id
9
+
|> mem "streams" (Jsont.list Channel.jsont) ~enc:Fun.id
10
+
|> finish)
11
+
12
+
let list client =
13
+
let json = Client.request client ~method_:`GET ~path:"/api/v1/streams" () in
14
+
Error.decode_or_raise streams_codec json "parsing channels list"
15
+
16
+
let list_all client ?include_public ?include_web_public ?include_subscribed
17
+
?include_all_active ?include_default ?include_owner_subscribed () =
18
+
let params =
19
+
List.filter_map Fun.id
20
+
[
21
+
Option.map
22
+
(fun v -> ("include_public", string_of_bool v))
23
+
include_public;
24
+
Option.map
25
+
(fun v -> ("include_web_public", string_of_bool v))
26
+
include_web_public;
27
+
Option.map
28
+
(fun v -> ("include_subscribed", string_of_bool v))
29
+
include_subscribed;
30
+
Option.map
31
+
(fun v -> ("include_all_active", string_of_bool v))
32
+
include_all_active;
33
+
Option.map
34
+
(fun v -> ("include_default", string_of_bool v))
35
+
include_default;
36
+
Option.map
37
+
(fun v -> ("include_owner_subscribed", string_of_bool v))
38
+
include_owner_subscribed;
39
+
]
40
+
in
41
+
let json =
42
+
Client.request client ~method_:`GET ~path:"/api/v1/streams" ~params ()
43
+
in
44
+
Error.decode_or_raise streams_codec json "parsing channels list"
45
+
46
+
let get_id client ~name =
47
+
let encoded_name = Uri.pct_encode name in
48
+
let response_codec =
49
+
Jsont.Object.(
50
+
map ~kind:"StreamIdResponse" Fun.id
51
+
|> mem "stream_id" Jsont.int ~enc:Fun.id
52
+
|> finish)
53
+
in
54
+
let json =
55
+
Client.request client ~method_:`GET
56
+
~path:("/api/v1/get_stream_id?stream=" ^ encoded_name)
57
+
()
58
+
in
59
+
Error.decode_or_raise response_codec json
60
+
(Printf.sprintf "getting stream id for %s" name)
61
+
62
+
let get_by_id client ~stream_id =
63
+
let response_codec =
64
+
Jsont.Object.(
65
+
map ~kind:"StreamResponse" Fun.id
66
+
|> mem "stream" Channel.jsont ~enc:Fun.id
67
+
|> finish)
68
+
in
69
+
let json =
70
+
Client.request client ~method_:`GET
71
+
~path:("/api/v1/streams/" ^ string_of_int stream_id)
72
+
()
73
+
in
74
+
Error.decode_or_raise response_codec json
75
+
(Printf.sprintf "getting stream %d" stream_id)
76
+
77
+
type create_options = {
78
+
name : string;
79
+
description : string option;
80
+
invite_only : bool option;
81
+
is_web_public : bool option;
82
+
history_public_to_subscribers : bool option;
83
+
message_retention_days : int option option;
84
+
can_remove_subscribers_group : int option;
85
+
}
86
+
87
+
let create client opts =
88
+
let make_string s = Jsont.String (s, Jsont.Meta.none) in
89
+
let subs =
90
+
Jsont.Array
91
+
( [
92
+
Jsont.Object
93
+
( List.filter_map Fun.id
94
+
[
95
+
Some (("name", Jsont.Meta.none), make_string opts.name);
96
+
Option.map
97
+
(fun d -> (("description", Jsont.Meta.none), make_string d))
98
+
opts.description;
99
+
],
100
+
Jsont.Meta.none );
101
+
],
102
+
Jsont.Meta.none )
103
+
in
104
+
let params =
105
+
[ ("subscriptions", Encode.to_json_string Jsont.json subs) ]
106
+
@ List.filter_map Fun.id
107
+
[
108
+
Option.map
109
+
(fun v -> ("invite_only", string_of_bool v))
110
+
opts.invite_only;
111
+
Option.map
112
+
(fun v -> ("is_web_public", string_of_bool v))
113
+
opts.is_web_public;
114
+
Option.map
115
+
(fun v -> ("history_public_to_subscribers", string_of_bool v))
116
+
opts.history_public_to_subscribers;
117
+
]
118
+
in
119
+
let response_codec =
120
+
Jsont.Object.(
121
+
map ~kind:"CreateResponse" (fun created -> created)
122
+
|> mem "subscribed" Jsont.json ~enc:(fun _ ->
123
+
Jsont.Object ([], Jsont.Meta.none))
124
+
|> finish)
125
+
in
126
+
let json =
127
+
Client.request client ~method_:`POST ~path:"/api/v1/users/me/subscriptions"
128
+
~params ()
129
+
in
130
+
ignore (Encode.from_json response_codec json);
131
+
(* Return the stream_id - we need to look it up *)
132
+
get_id client ~name:opts.name
133
+
134
+
let create_simple client ~name ?description ?invite_only () =
135
+
create client
136
+
{
137
+
name;
138
+
description;
139
+
invite_only;
140
+
is_web_public = None;
141
+
history_public_to_subscribers = None;
142
+
message_retention_days = None;
143
+
can_remove_subscribers_group = None;
144
+
}
145
+
146
+
let update client ~stream_id ?description ?new_name ?is_private ?is_web_public
147
+
?history_public_to_subscribers ?message_retention_days ?stream_post_policy
148
+
() =
149
+
let params =
150
+
List.filter_map Fun.id
151
+
[
152
+
Option.map (fun v -> ("description", v)) description;
153
+
Option.map (fun v -> ("new_name", v)) new_name;
154
+
Option.map (fun v -> ("is_private", string_of_bool v)) is_private;
155
+
Option.map (fun v -> ("is_web_public", string_of_bool v)) is_web_public;
156
+
Option.map
157
+
(fun v -> ("history_public_to_subscribers", string_of_bool v))
158
+
history_public_to_subscribers;
159
+
Option.map
160
+
(fun v ->
161
+
( "message_retention_days",
162
+
match v with None -> "unlimited" | Some d -> string_of_int d ))
163
+
message_retention_days;
164
+
Option.map
165
+
(fun v -> ("stream_post_policy", string_of_int v))
166
+
stream_post_policy;
167
+
]
168
+
in
169
+
let _response =
170
+
Client.request client ~method_:`PATCH
171
+
~path:("/api/v1/streams/" ^ string_of_int stream_id)
172
+
~params ()
173
+
in
174
+
()
175
+
176
+
let delete client ~stream_id =
177
+
let _response =
178
+
Client.request client ~method_:`DELETE
179
+
~path:("/api/v1/streams/" ^ string_of_int stream_id)
180
+
()
181
+
in
182
+
()
183
+
184
+
let archive = delete
185
+
186
+
let add_default client ~stream_id =
187
+
let params = [ ("stream_id", string_of_int stream_id) ] in
188
+
let _response =
189
+
Client.request client ~method_:`POST ~path:"/api/v1/default_streams" ~params
190
+
()
191
+
in
192
+
()
193
+
194
+
let remove_default client ~stream_id =
195
+
let params = [ ("stream_id", string_of_int stream_id) ] in
196
+
let _response =
197
+
Client.request client ~method_:`DELETE ~path:"/api/v1/default_streams"
198
+
~params ()
199
+
in
200
+
()
201
+
202
+
type subscription_request = {
203
+
name : string;
204
+
color : string option;
205
+
description : string option;
206
+
}
207
+
208
+
let subscribe client ~subscriptions ?principals ?authorization_errors_fatal
209
+
?announce ?invite_only ?history_public_to_subscribers () =
210
+
let make_string s = Jsont.String (s, Jsont.Meta.none) in
211
+
let subs_json =
212
+
Jsont.Array
213
+
( List.map
214
+
(fun s ->
215
+
Jsont.Object
216
+
( List.filter_map Fun.id
217
+
[
218
+
Some (("name", Jsont.Meta.none), make_string s.name);
219
+
Option.map
220
+
(fun c -> (("color", Jsont.Meta.none), make_string c))
221
+
s.color;
222
+
Option.map
223
+
(fun d ->
224
+
(("description", Jsont.Meta.none), make_string d))
225
+
s.description;
226
+
],
227
+
Jsont.Meta.none ))
228
+
subscriptions,
229
+
Jsont.Meta.none )
230
+
in
231
+
let params =
232
+
[ ("subscriptions", Encode.to_json_string Jsont.json subs_json) ]
233
+
@ List.filter_map Fun.id
234
+
[
235
+
Option.map
236
+
(fun p ->
237
+
( "principals",
238
+
match p with
239
+
| `Emails emails ->
240
+
Encode.to_json_string (Jsont.list Jsont.string) emails
241
+
| `User_ids ids ->
242
+
Encode.to_json_string (Jsont.list Jsont.int) ids ))
243
+
principals;
244
+
Option.map
245
+
(fun v -> ("authorization_errors_fatal", string_of_bool v))
246
+
authorization_errors_fatal;
247
+
Option.map (fun v -> ("announce", string_of_bool v)) announce;
248
+
Option.map (fun v -> ("invite_only", string_of_bool v)) invite_only;
249
+
Option.map
250
+
(fun v -> ("history_public_to_subscribers", string_of_bool v))
251
+
history_public_to_subscribers;
252
+
]
253
+
in
254
+
Client.request client ~method_:`POST ~path:"/api/v1/users/me/subscriptions"
255
+
~params ()
256
+
257
+
let subscribe_simple client ~channels =
258
+
let subscriptions =
259
+
List.map (fun name -> { name; color = None; description = None }) channels
260
+
in
261
+
let _ = subscribe client ~subscriptions () in
262
+
()
263
+
264
+
let unsubscribe client ~subscriptions ?principals () =
265
+
let params =
266
+
[
267
+
( "subscriptions",
268
+
Encode.to_json_string (Jsont.list Jsont.string) subscriptions );
269
+
]
270
+
@ List.filter_map Fun.id
271
+
[
272
+
Option.map
273
+
(fun p ->
274
+
( "principals",
275
+
match p with
276
+
| `Emails emails ->
277
+
Encode.to_json_string (Jsont.list Jsont.string) emails
278
+
| `User_ids ids ->
279
+
Encode.to_json_string (Jsont.list Jsont.int) ids ))
280
+
principals;
281
+
]
282
+
in
283
+
Client.request client ~method_:`DELETE ~path:"/api/v1/users/me/subscriptions"
284
+
~params ()
285
+
286
+
let unsubscribe_simple client ~channels =
287
+
let _ = unsubscribe client ~subscriptions:channels () in
288
+
()
289
+
290
+
let get_subscriptions client =
291
+
let response_codec =
292
+
Jsont.Object.(
293
+
map ~kind:"SubscriptionsResponse" Fun.id
294
+
|> mem "subscriptions" (Jsont.list Channel.Subscription.jsont) ~enc:Fun.id
295
+
|> finish)
296
+
in
297
+
let json =
298
+
Client.request client ~method_:`GET ~path:"/api/v1/users/me/subscriptions"
299
+
()
300
+
in
301
+
Error.decode_or_raise response_codec json "parsing subscriptions"
302
+
303
+
let get_subscription_status client ~user_id ~stream_id =
304
+
let response_codec =
305
+
Jsont.Object.(
306
+
map ~kind:"SubscriptionStatusResponse" Fun.id
307
+
|> mem "is_subscribed" Jsont.bool ~enc:Fun.id
308
+
|> finish)
309
+
in
310
+
let json =
311
+
Client.request client ~method_:`GET
312
+
~path:
313
+
("/api/v1/users/" ^ string_of_int user_id ^ "/subscriptions/"
314
+
^ string_of_int stream_id)
315
+
()
316
+
in
317
+
Error.decode_or_raise response_codec json "checking subscription status"
318
+
319
+
let update_subscription_settings client ~stream_id ?color ?is_muted ?pin_to_top
320
+
?desktop_notifications ?audible_notifications ?push_notifications
321
+
?email_notifications ?wildcard_mentions_notify () =
322
+
let data =
323
+
[
324
+
{|[{"stream_id":|} ^ string_of_int stream_id
325
+
^ (List.filter_map Fun.id
326
+
[
327
+
Option.map
328
+
(fun v -> Printf.sprintf {|,"property":"color","value":"%s"|} v)
329
+
color;
330
+
Option.map
331
+
(fun v -> Printf.sprintf {|,"property":"is_muted","value":%b|} v)
332
+
is_muted;
333
+
Option.map
334
+
(fun v ->
335
+
Printf.sprintf {|,"property":"pin_to_top","value":%b|} v)
336
+
pin_to_top;
337
+
Option.map
338
+
(fun v ->
339
+
Printf.sprintf
340
+
{|,"property":"desktop_notifications","value":%b|} v)
341
+
desktop_notifications;
342
+
Option.map
343
+
(fun v ->
344
+
Printf.sprintf
345
+
{|,"property":"audible_notifications","value":%b|} v)
346
+
audible_notifications;
347
+
Option.map
348
+
(fun v ->
349
+
Printf.sprintf {|,"property":"push_notifications","value":%b|}
350
+
v)
351
+
push_notifications;
352
+
Option.map
353
+
(fun v ->
354
+
Printf.sprintf {|,"property":"email_notifications","value":%b|}
355
+
v)
356
+
email_notifications;
357
+
Option.map
358
+
(fun v ->
359
+
Printf.sprintf
360
+
{|,"property":"wildcard_mentions_notify","value":%b|} v)
361
+
wildcard_mentions_notify;
362
+
]
363
+
|> String.concat "")
364
+
^ "}]";
365
+
]
366
+
in
367
+
let params = [ ("subscription_data", String.concat "" data) ] in
368
+
let _response =
369
+
Client.request client ~method_:`POST
370
+
~path:"/api/v1/users/me/subscriptions/properties" ~params ()
371
+
in
372
+
()
373
+
374
+
module Topic = struct
375
+
type t = { name : string; max_id : int }
376
+
377
+
let name t = t.name
378
+
let max_id t = t.max_id
379
+
380
+
let jsont =
381
+
Jsont.Object.(
382
+
map ~kind:"Topic" (fun name max_id -> { name; max_id })
383
+
|> mem "name" Jsont.string ~enc:name
384
+
|> mem "max_id" Jsont.int ~enc:max_id
385
+
|> finish)
386
+
end
387
+
388
+
let get_topics client ~stream_id =
389
+
let response_codec =
390
+
Jsont.Object.(
391
+
map ~kind:"TopicsResponse" Fun.id
392
+
|> mem "topics" (Jsont.list Topic.jsont) ~enc:Fun.id
393
+
|> finish)
394
+
in
395
+
let json =
396
+
Client.request client ~method_:`GET
397
+
~path:("/api/v1/users/me/" ^ string_of_int stream_id ^ "/topics")
398
+
()
399
+
in
400
+
Error.decode_or_raise response_codec json
401
+
(Printf.sprintf "getting topics for stream %d" stream_id)
402
+
403
+
let delete_topic client ~stream_id ~topic =
404
+
let params = [ ("topic_name", topic) ] in
405
+
let _response =
406
+
Client.request client ~method_:`POST
407
+
~path:("/api/v1/streams/" ^ string_of_int stream_id ^ "/delete_topic")
408
+
~params ()
409
+
in
410
+
()
411
+
412
+
type mute_op = Mute | Unmute
413
+
414
+
let set_topic_mute client ~stream_id ~topic ~op =
415
+
let params =
416
+
[
417
+
("stream_id", string_of_int stream_id);
418
+
("topic", topic);
419
+
("op", match op with Mute -> "add" | Unmute -> "remove");
420
+
]
421
+
in
422
+
let _response =
423
+
Client.request client ~method_:`PATCH
424
+
~path:"/api/v1/users/me/subscriptions/muted_topics" ~params ()
425
+
in
426
+
()
427
+
428
+
let get_muted_topics client =
429
+
let response_codec =
430
+
Jsont.Object.(
431
+
map ~kind:"MutedTopicsResponse" Fun.id
432
+
|> mem "muted_topics"
433
+
(Jsont.list
434
+
Jsont.Object.(
435
+
map ~kind:"MutedTopic" (fun stream_id topic _ts ->
436
+
(stream_id, topic))
437
+
|> mem "stream_id" Jsont.int ~enc:fst
438
+
|> mem "topic_name" Jsont.string ~enc:snd
439
+
|> mem "date_muted" Jsont.int ~dec_absent:0 ~enc:(Fun.const 0)
440
+
|> finish))
441
+
~enc:Fun.id
442
+
|> finish)
443
+
in
444
+
let json =
445
+
Client.request client ~method_:`GET
446
+
~path:"/api/v1/users/me/subscriptions/muted_topics" ()
447
+
in
448
+
Error.decode_or_raise response_codec json "getting muted topics"
449
+
450
+
let get_subscribers client ~stream_id =
451
+
let response_codec =
452
+
Jsont.Object.(
453
+
map ~kind:"SubscribersResponse" Fun.id
454
+
|> mem "subscribers" (Jsont.list Jsont.int) ~enc:Fun.id
455
+
|> finish)
456
+
in
457
+
let json =
458
+
Client.request client ~method_:`GET
459
+
~path:("/api/v1/streams/" ^ string_of_int stream_id ^ "/members")
460
+
()
461
+
in
462
+
Error.decode_or_raise response_codec json
463
+
(Printf.sprintf "getting subscribers for stream %d" stream_id)
464
+
465
+
let get_email_address client ~stream_id =
466
+
let response_codec =
467
+
Jsont.Object.(
468
+
map ~kind:"EmailAddressResponse" Fun.id
469
+
|> mem "email" Jsont.string ~enc:Fun.id
470
+
|> finish)
471
+
in
472
+
let json =
473
+
Client.request client ~method_:`GET
474
+
~path:("/api/v1/streams/" ^ string_of_int stream_id ^ "/email_address")
475
+
()
476
+
in
477
+
Error.decode_or_raise response_codec json
478
+
(Printf.sprintf "getting email address for stream %d" stream_id)
+238
lib/zulip/channels.mli
+238
lib/zulip/channels.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Channel (stream) operations for the Zulip API.
7
+
8
+
All functions raise [Eio.Io] with [Error.E error] on failure. Context is
9
+
automatically added indicating the operation being performed. *)
10
+
11
+
(** {1 Listing Channels} *)
12
+
13
+
val list : Client.t -> Channel.t list
14
+
(** List all channels in the organization.
15
+
@raise Eio.Io on failure *)
16
+
17
+
val list_all :
18
+
Client.t ->
19
+
?include_public:bool ->
20
+
?include_web_public:bool ->
21
+
?include_subscribed:bool ->
22
+
?include_all_active:bool ->
23
+
?include_default:bool ->
24
+
?include_owner_subscribed:bool ->
25
+
unit ->
26
+
Channel.t list
27
+
(** List channels with filtering options.
28
+
29
+
@param include_public Include public channels (default: true)
30
+
@param include_web_public Include web-public channels
31
+
@param include_subscribed Include subscribed channels
32
+
@param include_all_active Include all active channels (admin only)
33
+
@param include_default Include default channels
34
+
@param include_owner_subscribed Include channels the owner is subscribed to
35
+
@raise Eio.Io on failure *)
36
+
37
+
(** {1 Channel Lookup} *)
38
+
39
+
val get_id : Client.t -> name:string -> int
40
+
(** Get the stream ID for a channel by name.
41
+
@raise Eio.Io if the channel doesn't exist or on failure *)
42
+
43
+
val get_by_id : Client.t -> stream_id:int -> Channel.t
44
+
(** Get channel information by ID.
45
+
@raise Eio.Io on failure *)
46
+
47
+
(** {1 Creating Channels} *)
48
+
49
+
type create_options = {
50
+
name : string; (** Channel name (required) *)
51
+
description : string option; (** Channel description *)
52
+
invite_only : bool option; (** Whether the channel is private *)
53
+
is_web_public : bool option; (** Whether the channel is web-public *)
54
+
history_public_to_subscribers : bool option;
55
+
(** Whether history is visible to new subscribers *)
56
+
message_retention_days : int option option;
57
+
(** Message retention (None = default, Some None = forever) *)
58
+
can_remove_subscribers_group : int option;
59
+
(** User group that can remove subscribers *)
60
+
}
61
+
(** Options for creating a channel. *)
62
+
63
+
val create : Client.t -> create_options -> int
64
+
(** Create a new channel.
65
+
@return The stream_id of the created channel
66
+
@raise Eio.Io on failure *)
67
+
68
+
val create_simple :
69
+
Client.t ->
70
+
name:string ->
71
+
?description:string ->
72
+
?invite_only:bool ->
73
+
unit ->
74
+
int
75
+
(** Create a new channel with common options.
76
+
@return The stream_id of the created channel
77
+
@raise Eio.Io on failure *)
78
+
79
+
(** {1 Updating Channels} *)
80
+
81
+
val update :
82
+
Client.t ->
83
+
stream_id:int ->
84
+
?description:string ->
85
+
?new_name:string ->
86
+
?is_private:bool ->
87
+
?is_web_public:bool ->
88
+
?history_public_to_subscribers:bool ->
89
+
?message_retention_days:int option ->
90
+
?stream_post_policy:int ->
91
+
unit ->
92
+
unit
93
+
(** Update channel properties.
94
+
@raise Eio.Io on failure *)
95
+
96
+
(** {1 Deleting Channels} *)
97
+
98
+
val delete : Client.t -> stream_id:int -> unit
99
+
(** Delete a channel by ID.
100
+
@raise Eio.Io on failure *)
101
+
102
+
val archive : Client.t -> stream_id:int -> unit
103
+
(** Archive a channel (soft delete).
104
+
@raise Eio.Io on failure *)
105
+
106
+
(** {1 Default Channels} *)
107
+
108
+
val add_default : Client.t -> stream_id:int -> unit
109
+
(** Add a channel to the list of default channels for new users.
110
+
@raise Eio.Io on failure *)
111
+
112
+
val remove_default : Client.t -> stream_id:int -> unit
113
+
(** Remove a channel from the list of default channels.
114
+
@raise Eio.Io on failure *)
115
+
116
+
(** {1 Subscriptions} *)
117
+
118
+
type subscription_request = {
119
+
name : string; (** Channel name *)
120
+
color : string option; (** Color preference (hex string) *)
121
+
description : string option; (** Description (for new channels) *)
122
+
}
123
+
(** Subscription request for a single channel. *)
124
+
125
+
val subscribe :
126
+
Client.t ->
127
+
subscriptions:subscription_request list ->
128
+
?principals:[ `Emails of string list | `User_ids of int list ] ->
129
+
?authorization_errors_fatal:bool ->
130
+
?announce:bool ->
131
+
?invite_only:bool ->
132
+
?history_public_to_subscribers:bool ->
133
+
unit ->
134
+
Jsont.json
135
+
(** Subscribe users to channels.
136
+
137
+
@param subscriptions List of channels to subscribe to
138
+
@param principals Users to subscribe (default: current user)
139
+
@param authorization_errors_fatal Whether to abort on permission errors
140
+
@param announce Whether to announce new subscriptions
141
+
@param invite_only For new channels: whether they should be private
142
+
@param history_public_to_subscribers For new channels: history visibility
143
+
@return
144
+
JSON with "subscribed", "already_subscribed", and "unauthorized" fields
145
+
@raise Eio.Io on failure *)
146
+
147
+
val subscribe_simple : Client.t -> channels:string list -> unit
148
+
(** Subscribe the current user to channels by name.
149
+
@raise Eio.Io on failure *)
150
+
151
+
val unsubscribe :
152
+
Client.t ->
153
+
subscriptions:string list ->
154
+
?principals:[ `Emails of string list | `User_ids of int list ] ->
155
+
unit ->
156
+
Jsont.json
157
+
(** Unsubscribe users from channels.
158
+
159
+
@param subscriptions List of channel names to unsubscribe from
160
+
@param principals Users to unsubscribe (default: current user)
161
+
@return JSON with "removed" and "not_removed" fields
162
+
@raise Eio.Io on failure *)
163
+
164
+
val unsubscribe_simple : Client.t -> channels:string list -> unit
165
+
(** Unsubscribe the current user from channels by name.
166
+
@raise Eio.Io on failure *)
167
+
168
+
val get_subscriptions : Client.t -> Channel.Subscription.t list
169
+
(** Get the current user's channel subscriptions.
170
+
@raise Eio.Io on failure *)
171
+
172
+
val get_subscription_status : Client.t -> user_id:int -> stream_id:int -> bool
173
+
(** Check if a user is subscribed to a channel.
174
+
@raise Eio.Io on failure *)
175
+
176
+
val update_subscription_settings :
177
+
Client.t ->
178
+
stream_id:int ->
179
+
?color:string ->
180
+
?is_muted:bool ->
181
+
?pin_to_top:bool ->
182
+
?desktop_notifications:bool ->
183
+
?audible_notifications:bool ->
184
+
?push_notifications:bool ->
185
+
?email_notifications:bool ->
186
+
?wildcard_mentions_notify:bool ->
187
+
unit ->
188
+
unit
189
+
(** Update subscription settings for a channel.
190
+
@raise Eio.Io on failure *)
191
+
192
+
(** {1 Topics} *)
193
+
194
+
(** A topic within a channel. *)
195
+
module Topic : sig
196
+
type t
197
+
198
+
val name : t -> string
199
+
(** Topic name. *)
200
+
201
+
val max_id : t -> int
202
+
(** ID of the latest message in the topic. *)
203
+
204
+
val jsont : t Jsont.t
205
+
end
206
+
207
+
val get_topics : Client.t -> stream_id:int -> Topic.t list
208
+
(** Get all topics in a channel.
209
+
@raise Eio.Io on failure *)
210
+
211
+
val delete_topic : Client.t -> stream_id:int -> topic:string -> unit
212
+
(** Delete a topic and all its messages. Requires admin privileges.
213
+
@raise Eio.Io on failure *)
214
+
215
+
(** {1 Topic Muting} *)
216
+
217
+
type mute_op = Mute (** Mute the topic *) | Unmute (** Unmute the topic *)
218
+
219
+
val set_topic_mute :
220
+
Client.t -> stream_id:int -> topic:string -> op:mute_op -> unit
221
+
(** Mute or unmute a topic.
222
+
@raise Eio.Io on failure *)
223
+
224
+
val get_muted_topics : Client.t -> (int * string) list
225
+
(** Get list of muted topics as (stream_id, topic_name) pairs.
226
+
@raise Eio.Io on failure *)
227
+
228
+
(** {1 Subscribers} *)
229
+
230
+
val get_subscribers : Client.t -> stream_id:int -> int list
231
+
(** Get list of user IDs subscribed to a channel.
232
+
@raise Eio.Io on failure *)
233
+
234
+
(** {1 Email Address} *)
235
+
236
+
val get_email_address : Client.t -> stream_id:int -> string
237
+
(** Get the email address for posting to a channel.
238
+
@raise Eio.Io on failure *)
+160
lib/zulip/client.ml
+160
lib/zulip/client.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Logging setup *)
7
+
let src = Logs.Src.create "zulip.client" ~doc:"Zulip API client"
8
+
9
+
module Log = (val Logs.src_log src : Logs.LOG)
10
+
11
+
type t = { auth : Auth.t; session : Requests.t }
12
+
13
+
let create ~sw env auth =
14
+
Log.info (fun m -> m "Creating Zulip client for %s" (Auth.server_url auth));
15
+
let session =
16
+
Requests.create ~sw
17
+
~default_headers:
18
+
(Requests.Headers.of_list
19
+
[
20
+
("Authorization", Auth.to_basic_auth_header auth);
21
+
("User-Agent", "OCaml-Zulip/1.0");
22
+
])
23
+
~follow_redirects:true ~verify_tls:true env
24
+
in
25
+
{ auth; session }
26
+
27
+
let with_client env auth f =
28
+
Eio.Switch.run @@ fun sw ->
29
+
let client = create ~sw env auth in
30
+
f client
31
+
32
+
let method_to_string = function
33
+
| `GET -> "GET"
34
+
| `POST -> "POST"
35
+
| `PUT -> "PUT"
36
+
| `DELETE -> "DELETE"
37
+
| `PATCH -> "PATCH"
38
+
39
+
let request t ~method_ ~path ?params ?body ?content_type () =
40
+
let url = Auth.server_url t.auth ^ path in
41
+
Log.debug (fun m -> m "Request: %s %s" (method_to_string method_) path);
42
+
43
+
(* Convert params to URL query string if provided *)
44
+
let url =
45
+
params
46
+
|> Option.map (fun p ->
47
+
Uri.of_string url
48
+
|> Fun.flip
49
+
(List.fold_left (fun u (k, v) -> Uri.add_query_param' u (k, v)))
50
+
p
51
+
|> Uri.to_string)
52
+
|> Option.value ~default:url
53
+
in
54
+
55
+
(* Prepare request body if provided *)
56
+
let body_opt =
57
+
body
58
+
|> Option.map (fun body_str ->
59
+
let mime =
60
+
match content_type with
61
+
| Some ct when String.starts_with ~prefix:"multipart/form-data" ct ->
62
+
Requests.Mime.of_string ct
63
+
| Some "application/json" -> Requests.Mime.json
64
+
| Some "application/x-www-form-urlencoded" | None ->
65
+
if
66
+
String.contains body_str '='
67
+
&& not (String.contains body_str '{')
68
+
then Requests.Mime.form
69
+
else Requests.Mime.json
70
+
| Some ct -> Requests.Mime.of_string ct
71
+
in
72
+
Requests.Body.of_string mime body_str)
73
+
in
74
+
75
+
(* Make the request *)
76
+
let response =
77
+
match method_ with
78
+
| `GET -> Requests.get t.session url
79
+
| `POST -> Requests.post t.session ?body:body_opt url
80
+
| `PUT -> Requests.put t.session ?body:body_opt url
81
+
| `DELETE -> Requests.delete t.session url
82
+
| `PATCH -> Requests.patch t.session ?body:body_opt url
83
+
in
84
+
85
+
(* Parse response *)
86
+
let status = Requests.Response.status_code response in
87
+
Log.debug (fun m -> m "Response status: %d" status);
88
+
let body_str =
89
+
let body_flow = Requests.Response.body response in
90
+
let buf = Buffer.create 4096 in
91
+
Eio.Flow.copy body_flow (Eio.Flow.buffer_sink buf);
92
+
Buffer.contents buf
93
+
in
94
+
95
+
(* Parse JSON response using Jsont_bytesrw *)
96
+
let json =
97
+
match Jsont_bytesrw.decode_string' Jsont.json body_str with
98
+
| Ok j -> j
99
+
| Error e ->
100
+
let msg = Jsont.Error.to_string e in
101
+
Log.err (fun m -> m "JSON parse error: %s" msg);
102
+
Error.raise_with_context
103
+
(Error.make ~code:(Other "json_parse") ~message:msg ())
104
+
"%s %s" (method_to_string method_) path
105
+
in
106
+
107
+
(* Check for Zulip error response *)
108
+
match json with
109
+
| Jsont.Object (fields, _) -> (
110
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
111
+
match List.assoc_opt "result" assoc with
112
+
| Some (Jsont.String ("error", _)) ->
113
+
let msg =
114
+
match List.assoc_opt "msg" assoc with
115
+
| Some (Jsont.String (s, _)) -> s
116
+
| _ -> "Unknown error"
117
+
in
118
+
let code : Error.code =
119
+
match List.assoc_opt "code" assoc with
120
+
| Some (Jsont.String (s, _)) -> (
121
+
match s with
122
+
| "INVALID_API_KEY" -> Invalid_api_key
123
+
| "REQUEST_VARIABLE_MISSING" -> Request_variable_missing
124
+
| "BAD_REQUEST" -> Bad_request
125
+
| "USER_DEACTIVATED" -> User_deactivated
126
+
| "REALM_DEACTIVATED" -> Realm_deactivated
127
+
| "RATE_LIMIT_HIT" -> Rate_limit_hit
128
+
| s -> Other s)
129
+
| _ -> Other "unknown"
130
+
in
131
+
let extra =
132
+
List.filter
133
+
(fun (k, _) -> k <> "code" && k <> "msg" && k <> "result")
134
+
assoc
135
+
in
136
+
Log.warn (fun m ->
137
+
m "API error: %s (code: %a)" msg Error.pp_code code);
138
+
Error.raise_with_context
139
+
(Error.make ~code ~message:msg ~extra ())
140
+
"%s %s" (method_to_string method_) path
141
+
| _ ->
142
+
if status >= 200 && status < 300 then json
143
+
else (
144
+
Log.warn (fun m -> m "HTTP error: %d" status);
145
+
Error.raise_with_context
146
+
(Error.make
147
+
~code:(Other (string_of_int status))
148
+
~message:("HTTP error: " ^ string_of_int status)
149
+
())
150
+
"%s %s" (method_to_string method_) path))
151
+
| _ ->
152
+
if status >= 200 && status < 300 then json
153
+
else (
154
+
Log.err (fun m -> m "Invalid JSON response");
155
+
Error.raise_with_context
156
+
(Error.make ~code:(Other "json_parse")
157
+
~message:"Invalid JSON response" ())
158
+
"%s %s" (method_to_string method_) path)
159
+
160
+
let pp fmt t = Format.fprintf fmt "Client(server=%s)" (Auth.server_url t.auth)
+57
lib/zulip/client.mli
+57
lib/zulip/client.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** HTTP client for making requests to the Zulip API.
7
+
8
+
This module provides the low-level HTTP client for communicating with the
9
+
Zulip API. All API errors are raised as [Eio.Io] exceptions with [Error.E]
10
+
error codes, following the Eio error pattern.
11
+
12
+
@raise Eio.Io with [Error.E error] for API errors *)
13
+
14
+
type t
15
+
(** Type representing a Zulip HTTP client *)
16
+
17
+
val create :
18
+
sw:Eio.Switch.t ->
19
+
< clock : float Eio.Time.clock_ty Eio.Resource.t
20
+
; net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t
21
+
; fs : Eio.Fs.dir_ty Eio.Path.t
22
+
; .. > ->
23
+
Auth.t ->
24
+
t
25
+
(** Create a new client with the given switch, environment and authentication.
26
+
The environment must have clock, net, and fs capabilities. *)
27
+
28
+
val with_client :
29
+
< clock : float Eio.Time.clock_ty Eio.Resource.t
30
+
; net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t
31
+
; fs : Eio.Fs.dir_ty Eio.Path.t
32
+
; .. > ->
33
+
Auth.t ->
34
+
(t -> 'a) ->
35
+
'a
36
+
(** Resource-safe client management using structured concurrency. The
37
+
environment must have clock, net, and fs capabilities. *)
38
+
39
+
val request :
40
+
t ->
41
+
method_:[ `GET | `POST | `PUT | `DELETE | `PATCH ] ->
42
+
path:string ->
43
+
?params:(string * string) list ->
44
+
?body:string ->
45
+
?content_type:string ->
46
+
unit ->
47
+
Jsont.json
48
+
(** Make an HTTP request to the Zulip API.
49
+
@param content_type
50
+
Optional Content-Type header (default: application/x-www-form-urlencoded
51
+
for POST/PUT, none for GET/DELETE)
52
+
@raise Eio.Io
53
+
with [Error.E error] on API errors. The exception includes context about
54
+
the request method and path. *)
55
+
56
+
val pp : Format.formatter -> t -> unit
57
+
(** Pretty printer for client (shows server URL only, not credentials) *)
+13
lib/zulip/dune
+13
lib/zulip/dune
+84
lib/zulip/encode.ml
+84
lib/zulip/encode.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Encoding utilities for Zulip API requests *)
7
+
8
+
(** Convert a jsont-encoded value to JSON string *)
9
+
let to_json_string : 'a Jsont.t -> 'a -> string =
10
+
fun codec value ->
11
+
match Jsont_bytesrw.encode_string' codec value with
12
+
| Ok s -> s
13
+
| Error e -> failwith ("JSON encoding error: " ^ Jsont.Error.to_string e)
14
+
15
+
(** Convert a jsont-encoded value to form-urlencoded string *)
16
+
let to_form_urlencoded : 'a Jsont.t -> 'a -> string =
17
+
fun codec value ->
18
+
(* First encode to JSON, then extract fields *)
19
+
let json_str = to_json_string codec value in
20
+
match Jsont_bytesrw.decode_string' Jsont.json json_str with
21
+
| Error e -> failwith ("JSON decode error: " ^ Jsont.Error.to_string e)
22
+
| Ok (Jsont.Object (fields, _)) ->
23
+
(* Convert object fields to form-urlencoded *)
24
+
let encode_value = function
25
+
| Jsont.String (s, _) -> Some (Uri.pct_encode ~component:`Query_value s)
26
+
| Jsont.Bool (b, _) -> Some (string_of_bool b)
27
+
| Jsont.Number (n, _) -> Some (string_of_float n)
28
+
| Jsont.Null _ -> None
29
+
| Jsont.Array (items, _) ->
30
+
(* For arrays, encode as JSON array string *)
31
+
let array_str =
32
+
"["
33
+
^ String.concat ","
34
+
(List.filter_map
35
+
(function
36
+
| Jsont.String (s, _) ->
37
+
Some ("\"" ^ String.escaped s ^ "\"")
38
+
| Jsont.Number (n, _) -> Some (string_of_float n)
39
+
| Jsont.Bool (b, _) -> Some (string_of_bool b)
40
+
| _ -> None)
41
+
items)
42
+
^ "]"
43
+
in
44
+
Some array_str
45
+
| Jsont.Object _ -> None (* Skip nested objects *)
46
+
in
47
+
48
+
let params =
49
+
List.filter_map
50
+
(fun ((key, _), value) ->
51
+
match encode_value value with
52
+
| Some encoded -> Some (key ^ "=" ^ encoded)
53
+
| None -> None)
54
+
fields
55
+
in
56
+
57
+
String.concat "&" params
58
+
| Ok _ -> failwith "Expected JSON object for form encoding"
59
+
60
+
(** Parse JSON string using a jsont codec *)
61
+
let from_json_string : 'a Jsont.t -> string -> ('a, string) result =
62
+
fun codec json_str ->
63
+
match Jsont_bytesrw.decode_string' codec json_str with
64
+
| Ok v -> Ok v
65
+
| Error e -> Error (Jsont.Error.to_string e)
66
+
67
+
(** Parse a Jsont.json value using a codec *)
68
+
let from_json : 'a Jsont.t -> Jsont.json -> ('a, string) result =
69
+
fun codec json ->
70
+
let json_str =
71
+
match Jsont_bytesrw.encode_string' Jsont.json json with
72
+
| Ok s -> s
73
+
| Error e ->
74
+
failwith ("Failed to re-encode json: " ^ Jsont.Error.to_string e)
75
+
in
76
+
from_json_string codec json_str
77
+
78
+
(** Convert a value to Jsont.json using a codec *)
79
+
let to_json : 'a Jsont.t -> 'a -> (Jsont.json, string) result =
80
+
fun codec value ->
81
+
let json_str = to_json_string codec value in
82
+
match Jsont_bytesrw.decode_string' Jsont.json json_str with
83
+
| Ok json -> Ok json
84
+
| Error e -> Error (Jsont.Error.to_string e)
+31
lib/zulip/encode.mli
+31
lib/zulip/encode.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Encoding utilities for Zulip API requests *)
7
+
8
+
val to_json_string : 'a Jsont.t -> 'a -> string
9
+
(** Convert a value to JSON string using its jsont codec *)
10
+
11
+
val to_form_urlencoded : 'a Jsont.t -> 'a -> string
12
+
(** Convert a value to application/x-www-form-urlencoded string using its jsont
13
+
codec
14
+
15
+
The codec should represent a JSON object. Fields will be converted to
16
+
key=value pairs:
17
+
- Strings: URL-encoded
18
+
- Booleans: "true"/"false"
19
+
- Numbers: string representation
20
+
- Arrays: JSON array string "[...]"
21
+
- Null: omitted
22
+
- Nested objects: omitted *)
23
+
24
+
val from_json_string : 'a Jsont.t -> string -> ('a, string) result
25
+
(** Parse JSON string using a jsont codec *)
26
+
27
+
val from_json : 'a Jsont.t -> Jsont.json -> ('a, string) result
28
+
(** Parse a Jsont.json value using a codec *)
29
+
30
+
val to_json : 'a Jsont.t -> 'a -> (Jsont.json, string) result
31
+
(** Convert a value to Jsont.json using a codec *)
+104
lib/zulip/error.ml
+104
lib/zulip/error.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type code =
7
+
| Invalid_api_key
8
+
| Request_variable_missing
9
+
| Bad_request
10
+
| User_deactivated
11
+
| Realm_deactivated
12
+
| Rate_limit_hit
13
+
| Other of string
14
+
15
+
type t = { code : code; message : string; extra : (string * Jsont.json) list }
16
+
type Eio.Exn.err += E of t
17
+
18
+
let pp_code fmt = function
19
+
| Invalid_api_key -> Format.fprintf fmt "Invalid_api_key"
20
+
| Request_variable_missing -> Format.fprintf fmt "Request_variable_missing"
21
+
| Bad_request -> Format.fprintf fmt "Bad_request"
22
+
| User_deactivated -> Format.fprintf fmt "User_deactivated"
23
+
| Realm_deactivated -> Format.fprintf fmt "Realm_deactivated"
24
+
| Rate_limit_hit -> Format.fprintf fmt "Rate_limit_hit"
25
+
| Other s -> Format.fprintf fmt "Other(%s)" s
26
+
27
+
let pp fmt t = Format.fprintf fmt "%a: %s" pp_code t.code t.message
28
+
29
+
let () =
30
+
Eio.Exn.register_pp (fun f -> function
31
+
| E e ->
32
+
Format.fprintf f "Zulip %a" pp e;
33
+
true
34
+
| _ -> false)
35
+
36
+
let code_to_api_string = function
37
+
| Invalid_api_key -> "INVALID_API_KEY"
38
+
| Request_variable_missing -> "REQUEST_VARIABLE_MISSING"
39
+
| Bad_request -> "BAD_REQUEST"
40
+
| User_deactivated -> "USER_DEACTIVATED"
41
+
| Realm_deactivated -> "REALM_DEACTIVATED"
42
+
| Rate_limit_hit -> "RATE_LIMIT_HIT"
43
+
| Other s -> s
44
+
45
+
let code_of_api_string = function
46
+
| "INVALID_API_KEY" -> Invalid_api_key
47
+
| "REQUEST_VARIABLE_MISSING" -> Request_variable_missing
48
+
| "BAD_REQUEST" -> Bad_request
49
+
| "USER_DEACTIVATED" -> User_deactivated
50
+
| "REALM_DEACTIVATED" -> Realm_deactivated
51
+
| "RATE_LIMIT_HIT" -> Rate_limit_hit
52
+
| s -> Other s
53
+
54
+
let make ~code ~message ?(extra = []) () = { code; message; extra }
55
+
let code t = t.code
56
+
let message t = t.message
57
+
let extra t = t.extra
58
+
let raise e = Stdlib.raise (Eio.Exn.create (E e))
59
+
60
+
let raise_with_context e fmt =
61
+
Format.kasprintf
62
+
(fun context ->
63
+
Stdlib.raise (Eio.Exn.add_context (Eio.Exn.create (E e)) "%s" context))
64
+
fmt
65
+
66
+
let code_jsont =
67
+
let of_string s = Ok (code_of_api_string s) in
68
+
Jsont.of_of_string ~kind:"ErrorCode" of_string ~enc:code_to_api_string
69
+
70
+
let jsont =
71
+
let kind = "ZulipError" in
72
+
let make' code msg =
73
+
{ code = code_of_api_string code; message = msg; extra = [] }
74
+
in
75
+
let code' t = code_to_api_string t.code in
76
+
let msg t = t.message in
77
+
Jsont.Object.(
78
+
map ~kind make'
79
+
|> mem "code" Jsont.string ~enc:code'
80
+
|> mem "msg" Jsont.string ~enc:msg
81
+
|> finish)
82
+
83
+
let of_json json =
84
+
Encode.from_json jsont json
85
+
|> Result.to_option
86
+
|> Option.map (fun err ->
87
+
match json with
88
+
| Jsont.Object (fields, _) ->
89
+
let extra =
90
+
fields
91
+
|> List.map (fun ((k, _), v) -> (k, v))
92
+
|> List.filter (fun (k, _) ->
93
+
k <> "code" && k <> "msg" && k <> "result")
94
+
in
95
+
{ err with extra }
96
+
| _ -> err)
97
+
98
+
let decode_or_raise codec json context =
99
+
match Encode.from_json codec json with
100
+
| Ok v -> v
101
+
| Error msg ->
102
+
raise_with_context
103
+
(make ~code:(Other "json_parse") ~message:msg ())
104
+
"%s" context
+89
lib/zulip/error.mli
+89
lib/zulip/error.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Zulip API error handling.
7
+
8
+
This module defines protocol-level errors for the Zulip API, following the
9
+
Eio error pattern for context-aware error handling.
10
+
11
+
Errors are raised as [Eio.Io] exceptions:
12
+
{[
13
+
try Zulip.Messages.send client msg with
14
+
| Eio.Io (Zulip.Error.E { code = Invalid_api_key; message; _ }, _) ->
15
+
Printf.eprintf "Authentication failed: %s\n" message
16
+
| Eio.Io (Zulip.Error.E err, _) ->
17
+
Printf.eprintf "API error: %a\n" Zulip.Error.pp err
18
+
]} *)
19
+
20
+
(** {1 Error Codes}
21
+
22
+
These error codes correspond to the error codes returned by the Zulip API in
23
+
the "code" field of error responses. *)
24
+
25
+
type code =
26
+
| Invalid_api_key (** Authentication failure - invalid API key *)
27
+
| Request_variable_missing (** Required parameter is missing *)
28
+
| Bad_request (** Malformed request *)
29
+
| User_deactivated (** User account has been deactivated *)
30
+
| Realm_deactivated (** Organization (realm) has been deactivated *)
31
+
| Rate_limit_hit (** API rate limit exceeded *)
32
+
| Other of string (** Other/unknown error code *)
33
+
34
+
(** {1 Error Type} *)
35
+
36
+
type t = {
37
+
code : code; (** The error code from the API *)
38
+
message : string; (** Human-readable error message *)
39
+
extra : (string * Jsont.json) list;
40
+
(** Additional fields from the error response *)
41
+
}
42
+
(** The protocol-level error type. *)
43
+
44
+
(** {1 Eio Integration} *)
45
+
46
+
type Eio.Exn.err +=
47
+
| E of t (** Extend [Eio.Exn.err] with Zulip protocol errors. *)
48
+
49
+
val raise : t -> 'a
50
+
(** [raise e] raises an [Eio.Io] exception for error [e]. Equivalent to
51
+
[Stdlib.raise (Eio.Exn.create (E e))]. *)
52
+
53
+
val raise_with_context : t -> ('a, Format.formatter, unit, 'b) format4 -> 'a
54
+
(** [raise_with_context e fmt ...] raises an [Eio.Io] exception with context.
55
+
Equivalent to
56
+
[Stdlib.raise (Eio.Exn.add_context (Eio.Exn.create (E e)) fmt ...)]. *)
57
+
58
+
(** {1 Error Construction} *)
59
+
60
+
val make :
61
+
code:code -> message:string -> ?extra:(string * Jsont.json) list -> unit -> t
62
+
(** [make ~code ~message ?extra ()] creates an error value. *)
63
+
64
+
(** {1 Accessors} *)
65
+
66
+
val code : t -> code
67
+
val message : t -> string
68
+
val extra : t -> (string * Jsont.json) list
69
+
70
+
(** {1 Pretty Printing} *)
71
+
72
+
val pp_code : Format.formatter -> code -> unit
73
+
val pp : Format.formatter -> t -> unit
74
+
75
+
(** {1 JSON Parsing} *)
76
+
77
+
val code_jsont : code Jsont.t
78
+
(** Jsont codec for error codes. *)
79
+
80
+
val jsont : t Jsont.t
81
+
(** Jsont codec for errors. *)
82
+
83
+
val of_json : Jsont.json -> t option
84
+
(** [of_json json] attempts to parse a Zulip API error response. Returns [None]
85
+
if the JSON does not represent an error. *)
86
+
87
+
val decode_or_raise : 'a Jsont.t -> Jsont.json -> string -> 'a
88
+
(** [decode_or_raise codec json context] decodes JSON using the codec, or raises
89
+
a Zulip error with the given context if decoding fails. *)
+31
lib/zulip/event.ml
+31
lib/zulip/event.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = { id : int; type_ : Event_type.t; data : Jsont.json }
7
+
8
+
let id t = t.id
9
+
let type_ t = t.type_
10
+
let data t = t.data
11
+
12
+
let pp fmt t =
13
+
Format.fprintf fmt "Event{id=%d, type=%a}" t.id Event_type.pp t.type_
14
+
15
+
(* Jsont codec for event_type *)
16
+
let event_type_jsont =
17
+
let of_string s = Ok (Event_type.of_string s) in
18
+
Jsont.of_of_string ~kind:"Event_type.t" of_string ~enc:Event_type.to_string
19
+
20
+
(* Jsont codec for event.
21
+
We decode id and type, and use keep_unknown to preserve all other fields as data *)
22
+
let jsont =
23
+
let kind = "Event" in
24
+
let doc = "A Zulip event from the event queue" in
25
+
let make id type_ (data : Jsont.json) = { id; type_; data } in
26
+
let enc_data t = t.data in
27
+
Jsont.Object.map ~kind ~doc make
28
+
|> Jsont.Object.mem "id" Jsont.int ~enc:id
29
+
|> Jsont.Object.mem "type" event_type_jsont ~enc:type_
30
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:enc_data
31
+
|> Jsont.Object.finish
+20
lib/zulip/event.mli
+20
lib/zulip/event.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Zulip events.
7
+
8
+
This module represents events received from the Zulip event queue. Use
9
+
{!jsont} with Bytesrw-eio for wire deserialization. *)
10
+
11
+
type t
12
+
13
+
val id : t -> int
14
+
val type_ : t -> Event_type.t
15
+
val data : t -> Jsont.json
16
+
17
+
val jsont : t Jsont.t
18
+
(** Jsont codec for event *)
19
+
20
+
val pp : Format.formatter -> t -> unit
+181
lib/zulip/event_queue.ml
+181
lib/zulip/event_queue.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Logging setup *)
7
+
let src = Logs.Src.create "zulip.event_queue" ~doc:"Zulip event queue"
8
+
9
+
module Log = (val Logs.src_log src : Logs.LOG)
10
+
11
+
type t = { id : string; mutable last_event_id : int }
12
+
13
+
module Register_response = struct
14
+
type t = { queue_id : string; last_event_id : int }
15
+
16
+
let codec =
17
+
Jsont.Object.(
18
+
map ~kind:"RegisterResponse" (fun queue_id last_event_id ->
19
+
{ queue_id; last_event_id })
20
+
|> mem "queue_id" Jsont.string ~enc:(fun r -> r.queue_id)
21
+
|> mem "last_event_id" Jsont.int ~dec_absent:(-1) ~enc:(fun r ->
22
+
r.last_event_id)
23
+
|> finish)
24
+
end
25
+
26
+
let register client ?event_types ?narrow ?all_public_streams
27
+
?include_subscribers ?client_capabilities ?fetch_event_types
28
+
?client_gravatar ?slim_presence () =
29
+
let event_types_str =
30
+
Option.map (List.map Event_type.to_string) event_types
31
+
in
32
+
let fetch_event_types_str =
33
+
Option.map (List.map Event_type.to_string) fetch_event_types
34
+
in
35
+
let params =
36
+
List.filter_map Fun.id
37
+
[
38
+
Option.map
39
+
(fun types ->
40
+
( "event_types",
41
+
Encode.to_json_string (Jsont.list Jsont.string) types ))
42
+
event_types_str;
43
+
Option.map
44
+
(fun n -> ("narrow", Encode.to_json_string Narrow.list_jsont n))
45
+
narrow;
46
+
Option.map
47
+
(fun v -> ("all_public_streams", string_of_bool v))
48
+
all_public_streams;
49
+
Option.map
50
+
(fun v -> ("include_subscribers", string_of_bool v))
51
+
include_subscribers;
52
+
Option.map
53
+
(fun v -> ("client_capabilities", Encode.to_json_string Jsont.json v))
54
+
client_capabilities;
55
+
Option.map
56
+
(fun types ->
57
+
( "fetch_event_types",
58
+
Encode.to_json_string (Jsont.list Jsont.string) types ))
59
+
fetch_event_types_str;
60
+
Option.map
61
+
(fun v -> ("client_gravatar", string_of_bool v))
62
+
client_gravatar;
63
+
Option.map (fun v -> ("slim_presence", string_of_bool v)) slim_presence;
64
+
]
65
+
in
66
+
67
+
Option.iter
68
+
(fun types ->
69
+
Log.debug (fun m ->
70
+
m "Registering with event_types: %s" (String.concat "," types)))
71
+
event_types_str;
72
+
73
+
let json =
74
+
Client.request client ~method_:`POST ~path:"/api/v1/register" ~params ()
75
+
in
76
+
let response =
77
+
Error.decode_or_raise Register_response.codec json
78
+
"parsing register response"
79
+
in
80
+
{ id = response.queue_id; last_event_id = response.last_event_id }
81
+
82
+
let id t = t.id
83
+
let last_event_id t = t.last_event_id
84
+
85
+
(* Events response codec - events field is optional (may not be present) *)
86
+
module Events_response = struct
87
+
type t = { events : Event.t list }
88
+
89
+
let codec =
90
+
let make raw_json =
91
+
match raw_json with
92
+
| Jsont.Object (fields, _) -> (
93
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
94
+
match List.assoc_opt "events" assoc with
95
+
| Some (Jsont.Array (items, _)) ->
96
+
let events =
97
+
items
98
+
|> List.filter_map (fun item ->
99
+
Encode.from_json Event.jsont item |> Result.to_option)
100
+
in
101
+
{ events }
102
+
| Some _ -> { events = [] }
103
+
| None -> { events = [] })
104
+
| _ -> { events = [] }
105
+
in
106
+
Jsont.Object.map ~kind:"EventsResponse" make
107
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun _ ->
108
+
Jsont.Object ([], Jsont.Meta.none))
109
+
|> Jsont.Object.finish
110
+
end
111
+
112
+
let get_events t client ?last_event_id ?dont_block () =
113
+
let event_id = Option.value last_event_id ~default:t.last_event_id in
114
+
let params =
115
+
[ ("queue_id", t.id); ("last_event_id", string_of_int event_id) ]
116
+
@ if dont_block = Some true then [ ("dont_block", "true") ] else []
117
+
in
118
+
let json =
119
+
Client.request client ~method_:`GET ~path:"/api/v1/events" ~params ()
120
+
in
121
+
let response =
122
+
Error.decode_or_raise Events_response.codec json
123
+
(Printf.sprintf "parsing events from queue %s" t.id)
124
+
in
125
+
Log.debug (fun m -> m "Got %d events from API" (List.length response.events));
126
+
(* Update internal last_event_id *)
127
+
(match response.events with
128
+
| [] -> ()
129
+
| events ->
130
+
let max_id =
131
+
List.fold_left (fun acc e -> max acc (Event.id e)) event_id events
132
+
in
133
+
t.last_event_id <- max_id);
134
+
response.events
135
+
136
+
let delete t client =
137
+
let params = [ ("queue_id", t.id) ] in
138
+
let _response =
139
+
Client.request client ~method_:`DELETE ~path:"/api/v1/events" ~params ()
140
+
in
141
+
()
142
+
143
+
let call_on_each_event client ?event_types ?narrow ~callback () =
144
+
let queue = register client ?event_types ?narrow () in
145
+
let rec loop () =
146
+
let events = get_events queue client () in
147
+
List.iter
148
+
(fun event ->
149
+
(* Filter out heartbeat events *)
150
+
match Event.type_ event with
151
+
| Event_type.Heartbeat -> ()
152
+
| _ -> callback event)
153
+
events;
154
+
loop ()
155
+
in
156
+
loop ()
157
+
158
+
let call_on_each_message client ?narrow ~callback () =
159
+
call_on_each_event client ~event_types:[ Event_type.Message ] ?narrow
160
+
~callback:(fun event ->
161
+
match Event.type_ event with
162
+
| Event_type.Message -> callback (Event.data event)
163
+
| _ -> ())
164
+
()
165
+
166
+
let events t client =
167
+
let rec next () =
168
+
let events = get_events t client ~dont_block:true () in
169
+
match events with
170
+
| [] ->
171
+
(* No events available, wait a bit and try again *)
172
+
Seq.Cons (List.hd (get_events t client ()), next)
173
+
| e :: rest ->
174
+
(* Return events one by one *)
175
+
let rest_seq = List.to_seq rest in
176
+
Seq.Cons (e, fun () -> Seq.append rest_seq next ())
177
+
in
178
+
next
179
+
180
+
let pp fmt t =
181
+
Format.fprintf fmt "EventQueue{id=%s, last_event_id=%d}" t.id t.last_event_id
+126
lib/zulip/event_queue.mli
+126
lib/zulip/event_queue.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Event queue for receiving Zulip events in real-time.
7
+
8
+
Event queues provide real-time notifications of changes in Zulip. Register a
9
+
queue to receive events, then poll for updates.
10
+
11
+
All functions raise [Eio.Io] with [Error.E error] on failure. *)
12
+
13
+
(** {1 Event Queue Type} *)
14
+
15
+
type t
16
+
(** An opaque event queue handle. *)
17
+
18
+
(** {1 Registration} *)
19
+
20
+
val register :
21
+
Client.t ->
22
+
?event_types:Event_type.t list ->
23
+
?narrow:Narrow.t list ->
24
+
?all_public_streams:bool ->
25
+
?include_subscribers:bool ->
26
+
?client_capabilities:Jsont.json ->
27
+
?fetch_event_types:Event_type.t list ->
28
+
?client_gravatar:bool ->
29
+
?slim_presence:bool ->
30
+
unit ->
31
+
t
32
+
(** Register a new event queue with the server.
33
+
34
+
@param event_types Event types to subscribe to (default: all)
35
+
@param narrow Narrow filter for message events
36
+
@param all_public_streams Include events from all public streams
37
+
@param include_subscribers Include subscriber lists in stream events
38
+
@param client_capabilities Client capability flags
39
+
@param fetch_event_types Types to return initial data for
40
+
@param client_gravatar Whether client handles gravatar URLs
41
+
@param slim_presence Use compact presence format
42
+
@raise Eio.Io on failure *)
43
+
44
+
(** {1 Queue Properties} *)
45
+
46
+
val id : t -> string
47
+
(** Get the queue ID. *)
48
+
49
+
val last_event_id : t -> int
50
+
(** Get the last event ID received. *)
51
+
52
+
(** {1 Polling for Events} *)
53
+
54
+
val get_events :
55
+
t ->
56
+
Client.t ->
57
+
?last_event_id:int ->
58
+
?dont_block:bool ->
59
+
unit ->
60
+
Event.t list
61
+
(** Get events from the queue.
62
+
63
+
@param last_event_id Event ID to resume from (default: use queue's state)
64
+
@param dont_block Return immediately even if no events (default: long-poll)
65
+
@raise Eio.Io on failure
66
+
67
+
Note: This function updates the queue's internal last_event_id. *)
68
+
69
+
(** {1 Cleanup} *)
70
+
71
+
val delete : t -> Client.t -> unit
72
+
(** Delete the event queue from the server.
73
+
@raise Eio.Io on failure *)
74
+
75
+
(** {1 High-Level Event Processing}
76
+
77
+
These functions provide convenient callback-based patterns for processing
78
+
events. They handle queue management and reconnection automatically. *)
79
+
80
+
val call_on_each_event :
81
+
Client.t ->
82
+
?event_types:Event_type.t list ->
83
+
?narrow:Narrow.t list ->
84
+
callback:(Event.t -> unit) ->
85
+
unit ->
86
+
unit
87
+
(** Process events with a callback.
88
+
89
+
Registers a queue and continuously polls for events, calling the callback
90
+
for each event. Automatically handles reconnection if the queue expires.
91
+
92
+
This function runs indefinitely until cancelled via [Eio.Cancel].
93
+
94
+
@param event_types Event types to subscribe to
95
+
@param narrow Narrow filter for message events
96
+
@param callback Function called for each event
97
+
98
+
Note: Heartbeat events are filtered out automatically. *)
99
+
100
+
val call_on_each_message :
101
+
Client.t ->
102
+
?narrow:Narrow.t list ->
103
+
callback:(Jsont.json -> unit) ->
104
+
unit ->
105
+
unit
106
+
(** Process message events with a callback.
107
+
108
+
Convenience wrapper around [call_on_each_event] that filters for message
109
+
events and extracts the message data.
110
+
111
+
@param narrow Narrow filter for messages
112
+
@param callback Function called with each message's JSON data *)
113
+
114
+
(** {1 Event Stream}
115
+
116
+
For use with Eio's streaming patterns. *)
117
+
118
+
val events : t -> Client.t -> Event.t Seq.t
119
+
(** Create a lazy sequence of events from the queue. The sequence polls the
120
+
server as needed.
121
+
122
+
Note: This sequence is infinite - use [Seq.take] or similar to limit. *)
123
+
124
+
(** {1 Pretty Printing} *)
125
+
126
+
val pp : Format.formatter -> t -> unit
+71
lib/zulip/event_type.ml
+71
lib/zulip/event_type.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t =
7
+
| Message
8
+
| Heartbeat
9
+
| Presence
10
+
| Typing
11
+
| Reaction
12
+
| Subscription
13
+
| Stream
14
+
| Realm
15
+
| Realm_user
16
+
| Realm_emoji
17
+
| Realm_linkifiers
18
+
| User_group
19
+
| User_status
20
+
| Update_message
21
+
| Delete_message
22
+
| Update_message_flags
23
+
| Restart
24
+
| Other of string
25
+
26
+
let to_string = function
27
+
| Message -> "message"
28
+
| Heartbeat -> "heartbeat"
29
+
| Presence -> "presence"
30
+
| Typing -> "typing"
31
+
| Reaction -> "reaction"
32
+
| Subscription -> "subscription"
33
+
| Stream -> "stream"
34
+
| Realm -> "realm"
35
+
| Realm_user -> "realm_user"
36
+
| Realm_emoji -> "realm_emoji"
37
+
| Realm_linkifiers -> "realm_linkifiers"
38
+
| User_group -> "user_group"
39
+
| User_status -> "user_status"
40
+
| Update_message -> "update_message"
41
+
| Delete_message -> "delete_message"
42
+
| Update_message_flags -> "update_message_flags"
43
+
| Restart -> "restart"
44
+
| Other s -> s
45
+
46
+
let of_string = function
47
+
| "message" -> Message
48
+
| "heartbeat" -> Heartbeat
49
+
| "presence" -> Presence
50
+
| "typing" -> Typing
51
+
| "reaction" -> Reaction
52
+
| "subscription" -> Subscription
53
+
| "stream" -> Stream
54
+
| "realm" -> Realm
55
+
| "realm_user" -> Realm_user
56
+
| "realm_emoji" -> Realm_emoji
57
+
| "realm_linkifiers" -> Realm_linkifiers
58
+
| "user_group" -> User_group
59
+
| "user_status" -> User_status
60
+
| "update_message" -> Update_message
61
+
| "delete_message" -> Delete_message
62
+
| "update_message_flags" -> Update_message_flags
63
+
| "restart" -> Restart
64
+
| s -> Other s
65
+
66
+
let pp fmt t = Format.fprintf fmt "%s" (to_string t)
67
+
68
+
let jsont =
69
+
let encode t = to_string t in
70
+
let decode s = of_string s in
71
+
Jsont.string |> Jsont.map ~dec:decode ~enc:encode
+49
lib/zulip/event_type.mli
+49
lib/zulip/event_type.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Zulip event types.
7
+
8
+
This module defines the event types that can be received from the Zulip
9
+
event queue. These correspond to the "type" field in event objects returned
10
+
by the /events endpoint. *)
11
+
12
+
(** {1 Event Types} *)
13
+
14
+
type t =
15
+
| Message (** New message received *)
16
+
| Heartbeat (** Keep-alive heartbeat (internal protocol) *)
17
+
| Presence (** User presence update *)
18
+
| Typing (** User typing notification *)
19
+
| Reaction (** Emoji reaction added/removed *)
20
+
| Subscription (** Stream subscription change *)
21
+
| Stream (** Stream created/deleted/updated *)
22
+
| Realm (** Realm settings changed *)
23
+
| Realm_user (** User added/removed/updated in realm *)
24
+
| Realm_emoji (** Custom emoji added/removed *)
25
+
| Realm_linkifiers (** Linkifier rules changed *)
26
+
| User_group (** User group modified *)
27
+
| User_status (** User status (away/active) changed *)
28
+
| Update_message (** Message edited *)
29
+
| Delete_message (** Message deleted *)
30
+
| Update_message_flags (** Message flags (read/starred) changed *)
31
+
| Restart (** Server restart notification *)
32
+
| Other of string (** Unknown/custom event type *)
33
+
34
+
(** {1 Conversion} *)
35
+
36
+
val to_string : t -> string
37
+
(** Convert an event type to its wire format string. *)
38
+
39
+
val of_string : string -> t
40
+
(** Parse an event type from its wire format string. Unknown types are wrapped
41
+
in [Other]. *)
42
+
43
+
(** {1 Pretty Printing} *)
44
+
45
+
val pp : Format.formatter -> t -> unit
46
+
47
+
(** {1 JSON Codec} *)
48
+
49
+
val jsont : t Jsont.t
+57
lib/zulip/message.ml
+57
lib/zulip/message.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
type_ : Message_type.t;
8
+
to_ : string list;
9
+
content : string;
10
+
topic : string option;
11
+
queue_id : string option;
12
+
local_id : string option;
13
+
read_by_sender : bool;
14
+
}
15
+
16
+
let create ~type_ ~to_ ~content ?topic ?queue_id ?local_id
17
+
?(read_by_sender = true) () =
18
+
{ type_; to_; content; topic; queue_id; local_id; read_by_sender }
19
+
20
+
let type_ t = t.type_
21
+
let to_ t = t.to_
22
+
let content t = t.content
23
+
let topic t = t.topic
24
+
let queue_id t = t.queue_id
25
+
let local_id t = t.local_id
26
+
let read_by_sender t = t.read_by_sender
27
+
28
+
let pp fmt t =
29
+
Format.fprintf fmt "Message{type=%a, to=%s, content=%s}" Message_type.pp
30
+
t.type_ (String.concat "," t.to_) t.content
31
+
32
+
(* Jsont codec for Message_type.t *)
33
+
let message_type_jsont =
34
+
let of_string s =
35
+
match Message_type.of_string s with
36
+
| Some t -> Ok t
37
+
| None -> Error (Format.sprintf "Invalid message type: %s" s)
38
+
in
39
+
Jsont.of_of_string ~kind:"Message_type.t" of_string
40
+
~enc:Message_type.to_string
41
+
42
+
(* Jsont codec for the message *)
43
+
let jsont =
44
+
let kind = "Message" in
45
+
let doc = "A Zulip message to be sent" in
46
+
let make type_ to_ content topic queue_id local_id read_by_sender =
47
+
{ type_; to_; content; topic; queue_id; local_id; read_by_sender }
48
+
in
49
+
Jsont.Object.map ~kind ~doc make
50
+
|> Jsont.Object.mem "type" message_type_jsont ~enc:type_
51
+
|> Jsont.Object.mem "to" (Jsont.list Jsont.string) ~enc:to_
52
+
|> Jsont.Object.mem "content" Jsont.string ~enc:content
53
+
|> Jsont.Object.opt_mem "topic" Jsont.string ~enc:topic
54
+
|> Jsont.Object.opt_mem "queue_id" Jsont.string ~enc:queue_id
55
+
|> Jsont.Object.opt_mem "local_id" Jsont.string ~enc:local_id
56
+
|> Jsont.Object.mem "read_by_sender" Jsont.bool ~enc:read_by_sender
57
+
|> Jsont.Object.finish
+35
lib/zulip/message.mli
+35
lib/zulip/message.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Outgoing Zulip messages.
7
+
8
+
This module represents messages to be sent via the Zulip API. Use {!jsont}
9
+
with Bytesrw-eio for wire serialization. *)
10
+
11
+
type t
12
+
13
+
val create :
14
+
type_:Message_type.t ->
15
+
to_:string list ->
16
+
content:string ->
17
+
?topic:string ->
18
+
?queue_id:string ->
19
+
?local_id:string ->
20
+
?read_by_sender:bool ->
21
+
unit ->
22
+
t
23
+
24
+
val type_ : t -> Message_type.t
25
+
val to_ : t -> string list
26
+
val content : t -> string
27
+
val topic : t -> string option
28
+
val queue_id : t -> string option
29
+
val local_id : t -> string option
30
+
val read_by_sender : t -> bool
31
+
32
+
val jsont : t Jsont.t
33
+
(** Jsont codec for the message type *)
34
+
35
+
val pp : Format.formatter -> t -> unit
+61
lib/zulip/message_flag.ml
+61
lib/zulip/message_flag.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type modifiable = [ `Read | `Starred | `Collapsed ]
7
+
8
+
type t =
9
+
[ modifiable
10
+
| `Mentioned
11
+
| `Wildcard_mentioned
12
+
| `Has_alert_word
13
+
| `Historical ]
14
+
15
+
let to_string = function
16
+
| `Read -> "read"
17
+
| `Starred -> "starred"
18
+
| `Collapsed -> "collapsed"
19
+
| `Mentioned -> "mentioned"
20
+
| `Wildcard_mentioned -> "wildcard_mentioned"
21
+
| `Has_alert_word -> "has_alert_word"
22
+
| `Historical -> "historical"
23
+
24
+
let of_string = function
25
+
| "read" -> Some `Read
26
+
| "starred" -> Some `Starred
27
+
| "collapsed" -> Some `Collapsed
28
+
| "mentioned" -> Some `Mentioned
29
+
| "wildcard_mentioned" -> Some `Wildcard_mentioned
30
+
| "has_alert_word" -> Some `Has_alert_word
31
+
| "historical" -> Some `Historical
32
+
| _ -> None
33
+
34
+
let modifiable_of_string = function
35
+
| "read" -> Some `Read
36
+
| "starred" -> Some `Starred
37
+
| "collapsed" -> Some `Collapsed
38
+
| _ -> None
39
+
40
+
type op = Add | Remove
41
+
42
+
let op_to_string = function Add -> "add" | Remove -> "remove"
43
+
let pp fmt t = Format.fprintf fmt "%s" (to_string t)
44
+
45
+
let jsont =
46
+
let encode t = to_string t in
47
+
let decode s =
48
+
match of_string s with
49
+
| Some t -> t
50
+
| None -> failwith ("Unknown message flag: " ^ s)
51
+
in
52
+
Jsont.string |> Jsont.map ~dec:decode ~enc:encode
53
+
54
+
let modifiable_jsont =
55
+
let encode t = to_string t in
56
+
let decode s =
57
+
match modifiable_of_string s with
58
+
| Some t -> t
59
+
| None -> failwith ("Unknown modifiable message flag: " ^ s)
60
+
in
61
+
Jsont.string |> Jsont.map ~dec:decode ~enc:encode
+53
lib/zulip/message_flag.mli
+53
lib/zulip/message_flag.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Message flags in Zulip.
7
+
8
+
Message flags indicate read/unread status, starred messages, mentions, and
9
+
other message properties. *)
10
+
11
+
(** {1 Flag Types} *)
12
+
13
+
type modifiable =
14
+
[ `Read (** Message has been read *)
15
+
| `Starred (** Message is starred/bookmarked *)
16
+
| `Collapsed (** Message content is collapsed *) ]
17
+
(** Flags that can be directly modified by the user. *)
18
+
19
+
type t =
20
+
[ modifiable
21
+
| `Mentioned (** User was @-mentioned in the message *)
22
+
| `Wildcard_mentioned (** User was mentioned via @all/@everyone *)
23
+
| `Has_alert_word (** Message contains one of user's alert words *)
24
+
| `Historical (** Message predates user joining the stream *) ]
25
+
(** All possible message flags. *)
26
+
27
+
(** {1 Conversion} *)
28
+
29
+
val to_string : [< t ] -> string
30
+
(** Convert a flag to its wire format string. *)
31
+
32
+
val of_string : string -> t option
33
+
(** Parse a flag from its wire format string. *)
34
+
35
+
val modifiable_of_string : string -> modifiable option
36
+
(** Parse a modifiable flag from its wire format string. *)
37
+
38
+
(** {1 Flag Update Operations} *)
39
+
40
+
type op =
41
+
| Add (** Add the flag to messages *)
42
+
| Remove (** Remove the flag from messages *)
43
+
44
+
val op_to_string : op -> string
45
+
46
+
(** {1 Pretty Printing} *)
47
+
48
+
val pp : Format.formatter -> t -> unit
49
+
50
+
(** {1 JSON Codec} *)
51
+
52
+
val jsont : t Jsont.t
53
+
val modifiable_jsont : modifiable Jsont.t
+23
lib/zulip/message_response.ml
+23
lib/zulip/message_response.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = { id : int; automatic_new_visibility_policy : string option }
7
+
8
+
let id t = t.id
9
+
let automatic_new_visibility_policy t = t.automatic_new_visibility_policy
10
+
let pp fmt t = Format.fprintf fmt "MessageResponse{id=%d}" t.id
11
+
12
+
(* Jsont codec for message response *)
13
+
let jsont =
14
+
let kind = "MessageResponse" in
15
+
let doc = "A Zulip message response" in
16
+
let make id automatic_new_visibility_policy =
17
+
{ id; automatic_new_visibility_policy }
18
+
in
19
+
Jsont.Object.map ~kind ~doc make
20
+
|> Jsont.Object.mem "id" Jsont.int ~enc:id
21
+
|> Jsont.Object.opt_mem "automatic_new_visibility_policy" Jsont.string
22
+
~enc:automatic_new_visibility_policy
23
+
|> Jsont.Object.finish
+19
lib/zulip/message_response.mli
+19
lib/zulip/message_response.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Response from sending a Zulip message.
7
+
8
+
This module represents the response returned when a message is sent. Use
9
+
{!jsont} with Bytesrw-eio for wire serialization. *)
10
+
11
+
type t
12
+
13
+
val id : t -> int
14
+
val automatic_new_visibility_policy : t -> string option
15
+
16
+
val jsont : t Jsont.t
17
+
(** Jsont codec for message response *)
18
+
19
+
val pp : Format.formatter -> t -> unit
+15
lib/zulip/message_type.ml
+15
lib/zulip/message_type.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = [ `Direct | `Channel ]
7
+
8
+
let to_string = function `Direct -> "direct" | `Channel -> "stream"
9
+
10
+
let of_string = function
11
+
| "direct" -> Some `Direct
12
+
| "stream" -> Some `Channel
13
+
| _ -> None
14
+
15
+
let pp fmt t = Format.fprintf fmt "%s" (to_string t)
+10
lib/zulip/message_type.mli
+10
lib/zulip/message_type.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = [ `Direct | `Channel ]
7
+
8
+
val to_string : t -> string
9
+
val of_string : string -> t option
10
+
val pp : Format.formatter -> t -> unit
+232
lib/zulip/messages.ml
+232
lib/zulip/messages.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let send client message =
7
+
let body = Encode.to_form_urlencoded Message.jsont message in
8
+
let content_type = "application/x-www-form-urlencoded" in
9
+
let response =
10
+
Client.request client ~method_:`POST ~path:"/api/v1/messages" ~body
11
+
~content_type ()
12
+
in
13
+
Error.decode_or_raise Message_response.jsont response
14
+
"parsing message response"
15
+
16
+
let get client ~message_id =
17
+
Client.request client ~method_:`GET
18
+
~path:("/api/v1/messages/" ^ string_of_int message_id)
19
+
()
20
+
21
+
let get_raw client ~message_id =
22
+
let response_codec =
23
+
Jsont.Object.(
24
+
map ~kind:"RawMessageResponse" Fun.id
25
+
|> mem "raw_content" Jsont.string ~enc:Fun.id
26
+
|> finish)
27
+
in
28
+
let json =
29
+
Client.request client ~method_:`GET
30
+
~path:("/api/v1/messages/" ^ string_of_int message_id)
31
+
~params:[ ("apply_markdown", "false") ]
32
+
()
33
+
in
34
+
Error.decode_or_raise response_codec json
35
+
(Printf.sprintf "getting raw message %d" message_id)
36
+
37
+
type anchor = Newest | Oldest | First_unread | Message_id of int
38
+
39
+
let anchor_to_string = function
40
+
| Newest -> "newest"
41
+
| Oldest -> "oldest"
42
+
| First_unread -> "first_unread"
43
+
| Message_id id -> string_of_int id
44
+
45
+
let get_messages client ~anchor ?num_before ?num_after ?narrow ?include_anchor
46
+
() =
47
+
let params =
48
+
[ ("anchor", anchor_to_string anchor) ]
49
+
@ List.filter_map Fun.id
50
+
[
51
+
Option.map (fun n -> ("num_before", string_of_int n)) num_before;
52
+
Option.map (fun n -> ("num_after", string_of_int n)) num_after;
53
+
Option.map
54
+
(fun n -> ("narrow", Encode.to_json_string Narrow.list_jsont n))
55
+
narrow;
56
+
Option.map
57
+
(fun v -> ("include_anchor", string_of_bool v))
58
+
include_anchor;
59
+
]
60
+
in
61
+
Client.request client ~method_:`GET ~path:"/api/v1/messages" ~params ()
62
+
63
+
let check_messages_match_narrow client ~message_ids ~narrow =
64
+
let params =
65
+
[
66
+
("msg_ids", Encode.to_json_string (Jsont.list Jsont.int) message_ids);
67
+
("narrow", Encode.to_json_string Narrow.list_jsont narrow);
68
+
]
69
+
in
70
+
Client.request client ~method_:`GET ~path:"/api/v1/messages/matches_narrow"
71
+
~params ()
72
+
73
+
let get_history client ~message_id =
74
+
Client.request client ~method_:`GET
75
+
~path:("/api/v1/messages/" ^ string_of_int message_id ^ "/history")
76
+
()
77
+
78
+
type propagate_mode = Change_one | Change_later | Change_all
79
+
80
+
let propagate_mode_to_string = function
81
+
| Change_one -> "change_one"
82
+
| Change_later -> "change_later"
83
+
| Change_all -> "change_all"
84
+
85
+
let edit client ~message_id ?content ?topic ?stream_id ?propagate_mode
86
+
?send_notification_to_old_thread ?send_notification_to_new_thread () =
87
+
let params =
88
+
List.filter_map Fun.id
89
+
[
90
+
Option.map (fun c -> ("content", c)) content;
91
+
Option.map (fun t -> ("topic", t)) topic;
92
+
Option.map (fun id -> ("stream_id", string_of_int id)) stream_id;
93
+
Option.map
94
+
(fun m -> ("propagate_mode", propagate_mode_to_string m))
95
+
propagate_mode;
96
+
Option.map
97
+
(fun v -> ("send_notification_to_old_thread", string_of_bool v))
98
+
send_notification_to_old_thread;
99
+
Option.map
100
+
(fun v -> ("send_notification_to_new_thread", string_of_bool v))
101
+
send_notification_to_new_thread;
102
+
]
103
+
in
104
+
let _response =
105
+
Client.request client ~method_:`PATCH
106
+
~path:("/api/v1/messages/" ^ string_of_int message_id)
107
+
~params ()
108
+
in
109
+
()
110
+
111
+
let delete client ~message_id =
112
+
let _response =
113
+
Client.request client ~method_:`DELETE
114
+
~path:("/api/v1/messages/" ^ string_of_int message_id)
115
+
()
116
+
in
117
+
()
118
+
119
+
let update_flags client ~messages ~op ~flag =
120
+
let op_str = Message_flag.op_to_string op in
121
+
let flag_str = Message_flag.to_string flag in
122
+
let params =
123
+
[
124
+
("messages", Encode.to_json_string (Jsont.list Jsont.int) messages);
125
+
("op", op_str);
126
+
("flag", flag_str);
127
+
]
128
+
in
129
+
let _response =
130
+
Client.request client ~method_:`POST ~path:"/api/v1/messages/flags" ~params
131
+
()
132
+
in
133
+
()
134
+
135
+
let mark_all_as_read client =
136
+
let _response =
137
+
Client.request client ~method_:`POST ~path:"/api/v1/mark_all_as_read" ()
138
+
in
139
+
()
140
+
141
+
let mark_stream_as_read client ~stream_id =
142
+
let params = [ ("stream_id", string_of_int stream_id) ] in
143
+
let _response =
144
+
Client.request client ~method_:`POST ~path:"/api/v1/mark_stream_as_read"
145
+
~params ()
146
+
in
147
+
()
148
+
149
+
let mark_topic_as_read client ~stream_id ~topic =
150
+
let params =
151
+
[ ("stream_id", string_of_int stream_id); ("topic_name", topic) ]
152
+
in
153
+
let _response =
154
+
Client.request client ~method_:`POST ~path:"/api/v1/mark_topic_as_read"
155
+
~params ()
156
+
in
157
+
()
158
+
159
+
type emoji_type = Unicode_emoji | Realm_emoji | Zulip_extra_emoji
160
+
161
+
let emoji_type_to_string = function
162
+
| Unicode_emoji -> "unicode_emoji"
163
+
| Realm_emoji -> "realm_emoji"
164
+
| Zulip_extra_emoji -> "zulip_extra_emoji"
165
+
166
+
let add_reaction client ~message_id ~emoji_name ?emoji_code ?reaction_type () =
167
+
let params =
168
+
[ ("emoji_name", emoji_name) ]
169
+
@ List.filter_map Fun.id
170
+
[
171
+
Option.map (fun c -> ("emoji_code", c)) emoji_code;
172
+
Option.map
173
+
(fun t -> ("reaction_type", emoji_type_to_string t))
174
+
reaction_type;
175
+
]
176
+
in
177
+
let _response =
178
+
Client.request client ~method_:`POST
179
+
~path:("/api/v1/messages/" ^ string_of_int message_id ^ "/reactions")
180
+
~params ()
181
+
in
182
+
()
183
+
184
+
let remove_reaction client ~message_id ~emoji_name ?emoji_code ?reaction_type ()
185
+
=
186
+
let params =
187
+
[ ("emoji_name", emoji_name) ]
188
+
@ List.filter_map Fun.id
189
+
[
190
+
Option.map (fun c -> ("emoji_code", c)) emoji_code;
191
+
Option.map
192
+
(fun t -> ("reaction_type", emoji_type_to_string t))
193
+
reaction_type;
194
+
]
195
+
in
196
+
let _response =
197
+
Client.request client ~method_:`DELETE
198
+
~path:("/api/v1/messages/" ^ string_of_int message_id ^ "/reactions")
199
+
~params ()
200
+
in
201
+
()
202
+
203
+
let render client ~content =
204
+
let params = [ ("content", content) ] in
205
+
let response_codec =
206
+
Jsont.Object.(
207
+
map ~kind:"RenderResponse" Fun.id
208
+
|> mem "rendered" Jsont.string ~enc:Fun.id
209
+
|> finish)
210
+
in
211
+
let json =
212
+
Client.request client ~method_:`POST ~path:"/api/v1/messages/render" ~params
213
+
()
214
+
in
215
+
Error.decode_or_raise response_codec json "rendering message"
216
+
217
+
let upload_file _client ~filename:_ =
218
+
(* TODO: Implement file upload using multipart/form-data *)
219
+
Error.raise
220
+
(Error.make ~code:(Other "not_implemented")
221
+
~message:"File upload not yet implemented" ())
222
+
223
+
let get_scheduled client =
224
+
Client.request client ~method_:`GET ~path:"/api/v1/scheduled_messages" ()
225
+
226
+
let delete_scheduled client ~scheduled_message_id =
227
+
let _response =
228
+
Client.request client ~method_:`DELETE
229
+
~path:("/api/v1/scheduled_messages/" ^ string_of_int scheduled_message_id)
230
+
()
231
+
in
232
+
()
+208
lib/zulip/messages.mli
+208
lib/zulip/messages.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Message operations for the Zulip API.
7
+
8
+
All functions raise [Eio.Io] with [Error.E error] on failure. Context is
9
+
automatically added indicating the operation being performed. *)
10
+
11
+
(** {1 Sending Messages} *)
12
+
13
+
val send : Client.t -> Message.t -> Message_response.t
14
+
(** Send a message.
15
+
@raise Eio.Io on failure *)
16
+
17
+
(** {1 Reading Messages} *)
18
+
19
+
val get : Client.t -> message_id:int -> Jsont.json
20
+
(** Get a single message by ID. Returns the full message object.
21
+
@raise Eio.Io on failure *)
22
+
23
+
val get_raw : Client.t -> message_id:int -> string
24
+
(** Get the raw Markdown content of a message.
25
+
@raise Eio.Io on failure *)
26
+
27
+
(** Anchor points for message pagination. *)
28
+
type anchor =
29
+
| Newest (** Start from the newest message *)
30
+
| Oldest (** Start from the oldest message *)
31
+
| First_unread (** Start from first unread message *)
32
+
| Message_id of int (** Start from a specific message ID *)
33
+
34
+
val get_messages :
35
+
Client.t ->
36
+
anchor:anchor ->
37
+
?num_before:int ->
38
+
?num_after:int ->
39
+
?narrow:Narrow.t list ->
40
+
?include_anchor:bool ->
41
+
unit ->
42
+
Jsont.json
43
+
(** Get multiple messages with optional filtering.
44
+
45
+
@param anchor Where to start fetching (required)
46
+
@param num_before Number of messages before anchor (default: 0)
47
+
@param num_after Number of messages after anchor (default: 0)
48
+
@param narrow Filter criteria (see {!Narrow})
49
+
@param include_anchor Include the anchor message in results
50
+
@raise Eio.Io on failure *)
51
+
52
+
val check_messages_match_narrow :
53
+
Client.t -> message_ids:int list -> narrow:Narrow.t list -> Jsont.json
54
+
(** Check if messages match a narrow filter. Returns which of the given messages
55
+
match the narrow.
56
+
@raise Eio.Io on failure *)
57
+
58
+
(** {1 Message History} *)
59
+
60
+
val get_history : Client.t -> message_id:int -> Jsont.json
61
+
(** Get the edit history of a message.
62
+
@raise Eio.Io on failure *)
63
+
64
+
(** {1 Editing Messages} *)
65
+
66
+
(** Propagation mode for topic/stream changes. *)
67
+
type propagate_mode =
68
+
| Change_one (** Only change this message *)
69
+
| Change_later (** Change this and subsequent messages *)
70
+
| Change_all (** Change all messages in the topic *)
71
+
72
+
val edit :
73
+
Client.t ->
74
+
message_id:int ->
75
+
?content:string ->
76
+
?topic:string ->
77
+
?stream_id:int ->
78
+
?propagate_mode:propagate_mode ->
79
+
?send_notification_to_old_thread:bool ->
80
+
?send_notification_to_new_thread:bool ->
81
+
unit ->
82
+
unit
83
+
(** Edit a message's content, topic, or stream.
84
+
85
+
@param content New message content
86
+
@param topic New topic name
87
+
@param stream_id Move message to this stream
88
+
@param propagate_mode How to handle topic/stream changes for other messages
89
+
@param send_notification_to_old_thread Notify in old location
90
+
@param send_notification_to_new_thread Notify in new location
91
+
@raise Eio.Io on failure *)
92
+
93
+
(** {1 Deleting Messages} *)
94
+
95
+
val delete : Client.t -> message_id:int -> unit
96
+
(** Delete a message.
97
+
@raise Eio.Io on failure *)
98
+
99
+
(** {1 Message Flags} *)
100
+
101
+
val update_flags :
102
+
Client.t ->
103
+
messages:int list ->
104
+
op:Message_flag.op ->
105
+
flag:Message_flag.modifiable ->
106
+
unit
107
+
(** Update flags on a list of messages.
108
+
109
+
@param messages List of message IDs to update
110
+
@param op Whether to add or remove the flag
111
+
@param flag The flag to update
112
+
@raise Eio.Io on failure
113
+
114
+
{b Example:}
115
+
{[
116
+
(* Mark messages as read *)
117
+
Messages.update_flags client ~messages:[ 123; 456; 789 ] ~op:Add
118
+
~flag:`Read
119
+
]} *)
120
+
121
+
val mark_all_as_read : Client.t -> unit
122
+
(** Mark all messages as read.
123
+
@raise Eio.Io on failure *)
124
+
125
+
val mark_stream_as_read : Client.t -> stream_id:int -> unit
126
+
(** Mark all messages in a stream as read.
127
+
@raise Eio.Io on failure *)
128
+
129
+
val mark_topic_as_read : Client.t -> stream_id:int -> topic:string -> unit
130
+
(** Mark all messages in a topic as read.
131
+
@raise Eio.Io on failure *)
132
+
133
+
(** {1 Reactions} *)
134
+
135
+
(** Type of emoji for reactions. *)
136
+
type emoji_type =
137
+
| Unicode_emoji (** Standard Unicode emoji *)
138
+
| Realm_emoji (** Custom organization emoji *)
139
+
| Zulip_extra_emoji (** Zulip-specific emoji *)
140
+
141
+
val add_reaction :
142
+
Client.t ->
143
+
message_id:int ->
144
+
emoji_name:string ->
145
+
?emoji_code:string ->
146
+
?reaction_type:emoji_type ->
147
+
unit ->
148
+
unit
149
+
(** Add an emoji reaction to a message.
150
+
151
+
@param emoji_name The emoji name (e.g., "thumbs_up", "heart")
152
+
@param emoji_code The emoji code (optional, required for realm emoji)
153
+
@param reaction_type The type of emoji (default: [Unicode_emoji])
154
+
@raise Eio.Io on failure
155
+
156
+
{b Example:}
157
+
{[
158
+
Messages.add_reaction client ~message_id:12345 ~emoji_name:"thumbs_up" ()
159
+
]} *)
160
+
161
+
val remove_reaction :
162
+
Client.t ->
163
+
message_id:int ->
164
+
emoji_name:string ->
165
+
?emoji_code:string ->
166
+
?reaction_type:emoji_type ->
167
+
unit ->
168
+
unit
169
+
(** Remove an emoji reaction from a message.
170
+
@raise Eio.Io on failure *)
171
+
172
+
(** {1 Rendering} *)
173
+
174
+
val render : Client.t -> content:string -> string
175
+
(** Render message content as HTML. Useful for previewing how a message will
176
+
appear.
177
+
@return The rendered HTML
178
+
@raise Eio.Io on failure *)
179
+
180
+
(** {1 File Uploads} *)
181
+
182
+
val upload_file : Client.t -> filename:string -> string
183
+
(** Upload a file to Zulip.
184
+
185
+
@param filename The path to the file to upload
186
+
@return The Zulip URL for the uploaded file
187
+
@raise Eio.Io on failure
188
+
189
+
{b Example:}
190
+
{[
191
+
let uri = Messages.upload_file client ~filename:"/path/to/image.png" in
192
+
let msg =
193
+
Message.create ~type_:`Channel ~to_:[ "general" ]
194
+
~content:("Check out this image: " ^ uri)
195
+
()
196
+
in
197
+
Messages.send client msg
198
+
]} *)
199
+
200
+
(** {1 Scheduled Messages} *)
201
+
202
+
val get_scheduled : Client.t -> Jsont.json
203
+
(** Get all scheduled messages for the current user.
204
+
@raise Eio.Io on failure *)
205
+
206
+
val delete_scheduled : Client.t -> scheduled_message_id:int -> unit
207
+
(** Delete a scheduled message.
208
+
@raise Eio.Io on failure *)
+121
lib/zulip/narrow.ml
+121
lib/zulip/narrow.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
operator : string;
8
+
operand : [ `String of string | `Int of int | `Strings of string list ];
9
+
negated : bool;
10
+
}
11
+
12
+
let make ?(negated = false) operator operand = { operator; operand; negated }
13
+
let stream name = make "stream" (`String name)
14
+
let stream_id id = make "stream" (`Int id)
15
+
let topic name = make "topic" (`String name)
16
+
let channel = stream
17
+
let sender email = make "sender" (`String email)
18
+
let sender_id id = make "sender" (`Int id)
19
+
20
+
type is_operand =
21
+
[ `Alerted | `Dm | `Mentioned | `Private | `Resolved | `Starred | `Unread ]
22
+
23
+
let is_operand_to_string = function
24
+
| `Alerted -> "alerted"
25
+
| `Dm -> "dm"
26
+
| `Mentioned -> "mentioned"
27
+
| `Private -> "private"
28
+
| `Resolved -> "resolved"
29
+
| `Starred -> "starred"
30
+
| `Unread -> "unread"
31
+
32
+
let is operand = make "is" (`String (is_operand_to_string operand))
33
+
34
+
type has_operand = [ `Attachment | `Image | `Link | `Reaction ]
35
+
36
+
let has_operand_to_string = function
37
+
| `Attachment -> "attachment"
38
+
| `Image -> "image"
39
+
| `Link -> "link"
40
+
| `Reaction -> "reaction"
41
+
42
+
let has operand = make "has" (`String (has_operand_to_string operand))
43
+
let search query = make "search" (`String query)
44
+
let id msg_id = make "id" (`Int msg_id)
45
+
let near msg_id = make "near" (`Int msg_id)
46
+
let dm emails = make "dm" (`Strings emails)
47
+
let dm_including email = make "dm-including" (`String email)
48
+
let group_pm_with = dm_including
49
+
let not_ filter = { filter with negated = true }
50
+
51
+
let to_json filters =
52
+
let meta = Jsont.Meta.none in
53
+
let make_string s = Jsont.String (s, meta) in
54
+
let make_member name value = ((name, meta), value) in
55
+
Jsont.Array
56
+
( List.map
57
+
(fun f ->
58
+
let operand_json =
59
+
match f.operand with
60
+
| `String s -> make_string s
61
+
| `Int i -> Jsont.Number (float_of_int i, meta)
62
+
| `Strings ss -> Jsont.Array (List.map make_string ss, meta)
63
+
in
64
+
let fields =
65
+
[
66
+
make_member "operator" (make_string f.operator);
67
+
make_member "operand" operand_json;
68
+
]
69
+
in
70
+
let fields =
71
+
if f.negated then
72
+
make_member "negated" (Jsont.Bool (true, meta)) :: fields
73
+
else fields
74
+
in
75
+
Jsont.Object (fields, meta))
76
+
filters,
77
+
meta )
78
+
79
+
let operand_to_json = function
80
+
| `String s -> Jsont.String (s, Jsont.Meta.none)
81
+
| `Int i -> Jsont.Number (float_of_int i, Jsont.Meta.none)
82
+
| `Strings ss ->
83
+
Jsont.Array
84
+
( List.map (fun s -> Jsont.String (s, Jsont.Meta.none)) ss,
85
+
Jsont.Meta.none )
86
+
87
+
let operand_of_json = function
88
+
| Jsont.String (s, _) -> `String s
89
+
| Jsont.Number (f, _) -> `Int (int_of_float f)
90
+
| Jsont.Array (items, _) ->
91
+
`Strings
92
+
(List.filter_map
93
+
(function Jsont.String (s, _) -> Some s | _ -> None)
94
+
items)
95
+
| _ -> `String ""
96
+
97
+
let operand_jsont =
98
+
Jsont.json |> Jsont.map ~dec:operand_of_json ~enc:operand_to_json
99
+
100
+
let jsont =
101
+
let kind = "Narrow" in
102
+
let doc = "A narrow filter" in
103
+
let make operator operand negated = { operator; operand; negated } in
104
+
Jsont.Object.map ~kind ~doc make
105
+
|> Jsont.Object.mem "operator" Jsont.string ~enc:(fun t -> t.operator)
106
+
|> Jsont.Object.mem "operand" operand_jsont ~enc:(fun t -> t.operand)
107
+
|> Jsont.Object.mem "negated" Jsont.bool ~dec_absent:false ~enc:(fun t ->
108
+
t.negated)
109
+
|> Jsont.Object.finish
110
+
111
+
let list_jsont = Jsont.list jsont
112
+
113
+
let pp fmt t =
114
+
let neg = if t.negated then "-" else "" in
115
+
let operand =
116
+
match t.operand with
117
+
| `String s -> s
118
+
| `Int i -> string_of_int i
119
+
| `Strings ss -> String.concat "," ss
120
+
in
121
+
Format.fprintf fmt "%s%s:%s" neg t.operator operand
+113
lib/zulip/narrow.mli
+113
lib/zulip/narrow.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Type-safe narrow filters for message queries.
7
+
8
+
Narrow filters constrain which messages are returned by the
9
+
[Messages.get_messages] endpoint. This module provides a type-safe interface
10
+
for constructing these filters.
11
+
12
+
Example:
13
+
{[
14
+
let narrow = Narrow.[ stream "general"; topic "greetings"; is `Unread ] in
15
+
Messages.get_messages client ~narrow ()
16
+
]} *)
17
+
18
+
(** {1 Filter Type} *)
19
+
20
+
type t
21
+
(** A single narrow filter clause. *)
22
+
23
+
(** {1 Stream/Channel Filters} *)
24
+
25
+
val stream : string -> t
26
+
(** [stream name] filters to messages in the given stream/channel. *)
27
+
28
+
val stream_id : int -> t
29
+
(** [stream_id id] filters to messages in the stream with the given ID. *)
30
+
31
+
val topic : string -> t
32
+
(** [topic name] filters to messages with the given topic/subject. *)
33
+
34
+
val channel : string -> t
35
+
(** Alias for [stream]. *)
36
+
37
+
(** {1 Sender Filters} *)
38
+
39
+
val sender : string -> t
40
+
(** [sender email] filters to messages from the given sender. *)
41
+
42
+
val sender_id : int -> t
43
+
(** [sender_id id] filters to messages from the sender with the given user ID.
44
+
*)
45
+
46
+
(** {1 Message Property Filters} *)
47
+
48
+
type is_operand =
49
+
[ `Alerted (** Messages containing alert words *)
50
+
| `Dm (** Direct messages (private messages) *)
51
+
| `Mentioned (** Messages where user is mentioned *)
52
+
| `Private (** Alias for [`Dm] *)
53
+
| `Resolved (** Topics marked as resolved *)
54
+
| `Starred (** Starred messages *)
55
+
| `Unread (** Unread messages *) ]
56
+
57
+
val is : is_operand -> t
58
+
(** [is operand] filters by message property. *)
59
+
60
+
type has_operand =
61
+
[ `Attachment (** Messages with file attachments *)
62
+
| `Image (** Messages containing images *)
63
+
| `Link (** Messages containing links *)
64
+
| `Reaction (** Messages with emoji reactions *) ]
65
+
66
+
val has : has_operand -> t
67
+
(** [has operand] filters to messages that have the given content type. *)
68
+
69
+
(** {1 Search} *)
70
+
71
+
val search : string -> t
72
+
(** [search query] full-text search within messages. *)
73
+
74
+
(** {1 Message ID Filters} *)
75
+
76
+
val id : int -> t
77
+
(** [id msg_id] filters to the specific message with the given ID. *)
78
+
79
+
val near : int -> t
80
+
(** [near msg_id] centers results around the given message ID. *)
81
+
82
+
(** {1 Direct Message Filters} *)
83
+
84
+
val dm : string list -> t
85
+
(** [dm emails] filters to direct messages with exactly these participants. *)
86
+
87
+
val dm_including : string -> t
88
+
(** [dm_including email] filters to direct messages that include this user. *)
89
+
90
+
val group_pm_with : string -> t
91
+
(** [group_pm_with email] filters to group DMs including this user (deprecated,
92
+
use [dm_including]). *)
93
+
94
+
(** {1 Negation} *)
95
+
96
+
val not_ : t -> t
97
+
(** [not_ filter] negates a filter. Example: [not_ (stream "general")] excludes
98
+
the "general" stream. *)
99
+
100
+
(** {1 Encoding} *)
101
+
102
+
val to_json : t list -> Jsont.json
103
+
(** Encode a list of filters to JSON for the API request. *)
104
+
105
+
val jsont : t Jsont.t
106
+
(** Jsont codec for a single filter. *)
107
+
108
+
val list_jsont : t list Jsont.t
109
+
(** Jsont codec for a list of filters. *)
110
+
111
+
(** {1 Pretty Printing} *)
112
+
113
+
val pp : Format.formatter -> t -> unit
+179
lib/zulip/presence.ml
+179
lib/zulip/presence.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type status = Active | Idle | Offline
7
+
8
+
type client_presence = {
9
+
status : status;
10
+
timestamp : float;
11
+
client : string;
12
+
pushable : bool;
13
+
}
14
+
15
+
type user_presence = {
16
+
aggregated : client_presence option;
17
+
clients : (string * client_presence) list;
18
+
}
19
+
20
+
let status_to_string = function
21
+
| Active -> "active"
22
+
| Idle -> "idle"
23
+
| Offline -> "offline"
24
+
25
+
let status_of_string = function
26
+
| "active" -> Some Active
27
+
| "idle" -> Some Idle
28
+
| "offline" -> Some Offline
29
+
| _ -> None
30
+
31
+
let pp_status fmt s = Format.fprintf fmt "%s" (status_to_string s)
32
+
33
+
let pp_user_presence fmt p =
34
+
let agg =
35
+
Option.fold ~none:"none"
36
+
~some:(fun c -> Printf.sprintf "%s" (status_to_string c.status))
37
+
p.aggregated
38
+
in
39
+
Format.fprintf fmt "UserPresence{aggregated=%s, clients=%d}" agg
40
+
(List.length p.clients)
41
+
42
+
let status_jsont =
43
+
let of_string s =
44
+
match status_of_string s with
45
+
| Some s -> Ok s
46
+
| None -> Error (Printf.sprintf "Unknown status: %s" s)
47
+
in
48
+
Jsont.of_of_string ~kind:"Presence.status" of_string ~enc:status_to_string
49
+
50
+
let client_presence_jsont =
51
+
Jsont.Object.(
52
+
map ~kind:"ClientPresence" (fun status timestamp client pushable ->
53
+
{ status; timestamp; client; pushable })
54
+
|> mem "status" status_jsont ~enc:(fun p -> p.status)
55
+
|> mem "timestamp" Jsont.number ~enc:(fun p -> p.timestamp)
56
+
|> mem "client" Jsont.string ~dec_absent:"" ~enc:(fun p -> p.client)
57
+
|> mem "pushable" Jsont.bool ~dec_absent:false ~enc:(fun p -> p.pushable)
58
+
|> finish)
59
+
60
+
let parse_user_presence_from_json json =
61
+
match json with
62
+
| Jsont.Object (fields, _) ->
63
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
64
+
let aggregated =
65
+
match List.assoc_opt "aggregated" assoc with
66
+
| Some agg_json ->
67
+
Encode.from_json client_presence_jsont agg_json |> Result.to_option
68
+
| None -> None
69
+
in
70
+
let clients =
71
+
List.filter_map
72
+
(fun (name, json) ->
73
+
if name = "aggregated" then None
74
+
else
75
+
match Encode.from_json client_presence_jsont json with
76
+
| Ok cp -> Some (name, cp)
77
+
| Error _ -> None)
78
+
assoc
79
+
in
80
+
{ aggregated; clients }
81
+
| _ -> { aggregated = None; clients = [] }
82
+
83
+
let user_presence_jsont =
84
+
Jsont.map ~kind:"UserPresence" Jsont.json ~dec:parse_user_presence_from_json
85
+
~enc:(fun p ->
86
+
let agg_field =
87
+
match p.aggregated with
88
+
| Some agg -> (
89
+
match Encode.to_json client_presence_jsont agg with
90
+
| Ok json -> [ (("aggregated", Jsont.Meta.none), json) ]
91
+
| Error _ -> [])
92
+
| None -> []
93
+
in
94
+
let client_fields =
95
+
List.filter_map
96
+
(fun (name, cp) ->
97
+
match Encode.to_json client_presence_jsont cp with
98
+
| Ok json -> Some ((name, Jsont.Meta.none), json)
99
+
| Error _ -> None)
100
+
p.clients
101
+
in
102
+
Jsont.Object (agg_field @ client_fields, Jsont.Meta.none))
103
+
104
+
let parse_presence_response json =
105
+
match json with
106
+
| Jsont.Object (fields, _) -> (
107
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
108
+
match List.assoc_opt "presence" assoc with
109
+
| Some pres -> (
110
+
match Encode.from_json user_presence_jsont pres with
111
+
| Ok p -> p
112
+
| Error msg ->
113
+
Error.raise_with_context
114
+
(Error.make ~code:(Other "json_parse") ~message:msg ())
115
+
"parsing presence")
116
+
| None ->
117
+
Error.raise_with_context
118
+
(Error.make ~code:(Other "missing_field")
119
+
~message:"Missing presence field" ())
120
+
"parsing presence response")
121
+
| _ ->
122
+
Error.raise_with_context
123
+
(Error.make ~code:(Other "json_parse")
124
+
~message:"Expected JSON object for presence" ())
125
+
"parsing presence response"
126
+
127
+
let get_user client ~user_id =
128
+
let json =
129
+
Client.request client ~method_:`GET
130
+
~path:("/api/v1/users/" ^ string_of_int user_id ^ "/presence")
131
+
()
132
+
in
133
+
parse_presence_response json
134
+
135
+
let get_user_by_email client ~email =
136
+
let json =
137
+
Client.request client ~method_:`GET
138
+
~path:("/api/v1/users/" ^ email ^ "/presence")
139
+
()
140
+
in
141
+
parse_presence_response json
142
+
143
+
let get_all client =
144
+
let json =
145
+
Client.request client ~method_:`GET ~path:"/api/v1/realm/presence" ()
146
+
in
147
+
match json with
148
+
| Jsont.Object (fields, _) -> (
149
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
150
+
match List.assoc_opt "presences" assoc with
151
+
| Some (Jsont.Object (pres_fields, _)) ->
152
+
List.filter_map
153
+
(fun ((user_id_str, _), pres_json) ->
154
+
match int_of_string_opt user_id_str with
155
+
| Some user_id -> (
156
+
match Encode.from_json user_presence_jsont pres_json with
157
+
| Ok p -> Some (user_id, p)
158
+
| Error _ -> None)
159
+
| None -> None)
160
+
pres_fields
161
+
| _ -> [])
162
+
| _ -> []
163
+
164
+
let update client ~status ?ping_only ?new_user_input () =
165
+
let params =
166
+
[ ("status", status_to_string status) ]
167
+
@ List.filter_map Fun.id
168
+
[
169
+
Option.map (fun v -> ("ping_only", string_of_bool v)) ping_only;
170
+
Option.map
171
+
(fun v -> ("new_user_input", string_of_bool v))
172
+
new_user_input;
173
+
]
174
+
in
175
+
let _response =
176
+
Client.request client ~method_:`POST ~path:"/api/v1/users/me/presence"
177
+
~params ()
178
+
in
179
+
()
+77
lib/zulip/presence.mli
+77
lib/zulip/presence.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** User presence information for the Zulip API.
7
+
8
+
Track online/offline status of users in the organization. *)
9
+
10
+
(** {1 Presence Types} *)
11
+
12
+
type status =
13
+
| Active (** User is currently active *)
14
+
| Idle (** User is idle *)
15
+
| Offline (** User is offline *)
16
+
17
+
type client_presence = {
18
+
status : status;
19
+
timestamp : float;
20
+
client : string; (** Client name (e.g., "website", "ZulipMobile") *)
21
+
pushable : bool; (** Whether push notifications can be sent *)
22
+
}
23
+
(** Presence information from a single client. *)
24
+
25
+
type user_presence = {
26
+
aggregated : client_presence option;
27
+
(** Aggregated presence across clients *)
28
+
clients : (string * client_presence) list; (** Per-client presence *)
29
+
}
30
+
(** A user's presence information. *)
31
+
32
+
(** {1 Querying Presence} *)
33
+
34
+
val get_user : Client.t -> user_id:int -> user_presence
35
+
(** Get presence information for a specific user.
36
+
@raise Eio.Io on failure *)
37
+
38
+
val get_user_by_email : Client.t -> email:string -> user_presence
39
+
(** Get presence information for a user by email.
40
+
@raise Eio.Io on failure *)
41
+
42
+
val get_all : Client.t -> (int * user_presence) list
43
+
(** Get presence information for all users in the organization. Returns a list
44
+
of (user_id, presence) pairs.
45
+
@raise Eio.Io on failure *)
46
+
47
+
(** {1 Updating Presence} *)
48
+
49
+
val update :
50
+
Client.t ->
51
+
status:status ->
52
+
?ping_only:bool ->
53
+
?new_user_input:bool ->
54
+
unit ->
55
+
unit
56
+
(** Update the current user's presence status.
57
+
58
+
@param status The presence status to set
59
+
@param ping_only Only send a ping without changing status
60
+
@param new_user_input Whether there was new user input
61
+
@raise Eio.Io on failure *)
62
+
63
+
(** {1 JSON Codecs} *)
64
+
65
+
val status_jsont : status Jsont.t
66
+
val client_presence_jsont : client_presence Jsont.t
67
+
val user_presence_jsont : user_presence Jsont.t
68
+
69
+
(** {1 Conversion} *)
70
+
71
+
val status_to_string : status -> string
72
+
val status_of_string : string -> status option
73
+
74
+
(** {1 Pretty Printing} *)
75
+
76
+
val pp_status : Format.formatter -> status -> unit
77
+
val pp_user_presence : Format.formatter -> user_presence -> unit
+448
lib/zulip/server.ml
+448
lib/zulip/server.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type authentication_method = {
7
+
password : bool;
8
+
dev : bool;
9
+
email : bool;
10
+
ldap : bool;
11
+
remoteuser : bool;
12
+
github : bool;
13
+
azuread : bool;
14
+
gitlab : bool;
15
+
apple : bool;
16
+
google : bool;
17
+
saml : bool;
18
+
openid_connect : bool;
19
+
}
20
+
21
+
type emoji = {
22
+
id : string;
23
+
name : string;
24
+
source_url : string;
25
+
deactivated : bool;
26
+
author_id : int option;
27
+
}
28
+
29
+
(* Define types with conflicting fields after types they might conflict with *)
30
+
type external_authentication_method = {
31
+
name : string;
32
+
display_name : string;
33
+
display_icon : string option;
34
+
login_url : string;
35
+
signup_url : string;
36
+
}
37
+
38
+
type linkifier = { id : int; pattern : string; url_template : string }
39
+
40
+
type t = {
41
+
zulip_version : string;
42
+
zulip_feature_level : int;
43
+
zulip_merge_base : string option;
44
+
push_notifications_enabled : bool;
45
+
is_incompatible : bool;
46
+
email_auth_enabled : bool;
47
+
require_email_format_usernames : bool;
48
+
realm_uri : string;
49
+
realm_name : string;
50
+
realm_icon : string;
51
+
realm_description : string;
52
+
realm_web_public_access_enabled : bool;
53
+
authentication_methods : authentication_method;
54
+
external_authentication_methods : external_authentication_method list;
55
+
}
56
+
57
+
(* Codecs for authentication methods *)
58
+
let authentication_method_jsont =
59
+
Jsont.Object.(
60
+
map ~kind:"AuthenticationMethod"
61
+
(fun
62
+
password
63
+
dev
64
+
email
65
+
ldap
66
+
remoteuser
67
+
github
68
+
azuread
69
+
gitlab
70
+
apple
71
+
google
72
+
saml
73
+
openid_connect
74
+
->
75
+
{
76
+
password;
77
+
dev;
78
+
email;
79
+
ldap;
80
+
remoteuser;
81
+
github;
82
+
azuread;
83
+
gitlab;
84
+
apple;
85
+
google;
86
+
saml;
87
+
openid_connect;
88
+
})
89
+
|> mem "Password" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.password)
90
+
|> mem "Dev" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.dev)
91
+
|> mem "Email" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.email)
92
+
|> mem "LDAP" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.ldap)
93
+
|> mem "RemoteUser" Jsont.bool ~dec_absent:false ~enc:(fun a ->
94
+
a.remoteuser)
95
+
|> mem "GitHub" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.github)
96
+
|> mem "AzureAD" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.azuread)
97
+
|> mem "GitLab" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.gitlab)
98
+
|> mem "Apple" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.apple)
99
+
|> mem "Google" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.google)
100
+
|> mem "SAML" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.saml)
101
+
|> mem "OpenID Connect" Jsont.bool ~dec_absent:false ~enc:(fun a ->
102
+
a.openid_connect)
103
+
|> finish)
104
+
105
+
let external_authentication_method_jsont =
106
+
Jsont.Object.(
107
+
map ~kind:"ExternalAuthenticationMethod"
108
+
(fun name display_name display_icon login_url signup_url ->
109
+
{ name; display_name; display_icon; login_url; signup_url })
110
+
|> mem "name" Jsont.string ~enc:(fun e -> e.name)
111
+
|> mem "display_name" Jsont.string ~enc:(fun e -> e.display_name)
112
+
|> opt_mem "display_icon" Jsont.string ~enc:(fun e -> e.display_icon)
113
+
|> mem "login_url" Jsont.string ~enc:(fun e -> e.login_url)
114
+
|> mem "signup_url" Jsont.string ~enc:(fun e -> e.signup_url)
115
+
|> finish)
116
+
117
+
let jsont =
118
+
Jsont.Object.(
119
+
map ~kind:"ServerSettings"
120
+
(fun
121
+
zulip_version
122
+
zulip_feature_level
123
+
zulip_merge_base
124
+
push_notifications_enabled
125
+
is_incompatible
126
+
email_auth_enabled
127
+
require_email_format_usernames
128
+
realm_uri
129
+
realm_name
130
+
realm_icon
131
+
realm_description
132
+
realm_web_public_access_enabled
133
+
authentication_methods
134
+
external_authentication_methods
135
+
->
136
+
{
137
+
zulip_version;
138
+
zulip_feature_level;
139
+
zulip_merge_base;
140
+
push_notifications_enabled;
141
+
is_incompatible;
142
+
email_auth_enabled;
143
+
require_email_format_usernames;
144
+
realm_uri;
145
+
realm_name;
146
+
realm_icon;
147
+
realm_description;
148
+
realm_web_public_access_enabled;
149
+
authentication_methods;
150
+
external_authentication_methods;
151
+
})
152
+
|> mem "zulip_version" Jsont.string ~enc:(fun s -> s.zulip_version)
153
+
|> mem "zulip_feature_level" Jsont.int ~enc:(fun s -> s.zulip_feature_level)
154
+
|> opt_mem "zulip_merge_base" Jsont.string ~enc:(fun s ->
155
+
s.zulip_merge_base)
156
+
|> mem "push_notifications_enabled" Jsont.bool ~dec_absent:false
157
+
~enc:(fun s -> s.push_notifications_enabled)
158
+
|> mem "is_incompatible" Jsont.bool ~dec_absent:false ~enc:(fun s ->
159
+
s.is_incompatible)
160
+
|> mem "email_auth_enabled" Jsont.bool ~dec_absent:true ~enc:(fun s ->
161
+
s.email_auth_enabled)
162
+
|> mem "require_email_format_usernames" Jsont.bool ~dec_absent:true
163
+
~enc:(fun s -> s.require_email_format_usernames)
164
+
|> mem "realm_uri" Jsont.string ~enc:(fun s -> s.realm_uri)
165
+
|> mem "realm_name" Jsont.string ~dec_absent:"" ~enc:(fun s -> s.realm_name)
166
+
|> mem "realm_icon" Jsont.string ~dec_absent:"" ~enc:(fun s -> s.realm_icon)
167
+
|> mem "realm_description" Jsont.string ~dec_absent:"" ~enc:(fun s ->
168
+
s.realm_description)
169
+
|> mem "realm_web_public_access_enabled" Jsont.bool ~dec_absent:false
170
+
~enc:(fun s -> s.realm_web_public_access_enabled)
171
+
|> mem "authentication_methods" authentication_method_jsont ~enc:(fun s ->
172
+
s.authentication_methods)
173
+
|> mem "external_authentication_methods"
174
+
(Jsont.list external_authentication_method_jsont) ~dec_absent:[]
175
+
~enc:(fun s -> s.external_authentication_methods)
176
+
|> finish)
177
+
178
+
let get_settings_json client =
179
+
Client.request client ~method_:`GET ~path:"/api/v1/server_settings" ()
180
+
181
+
let get_settings client =
182
+
let json = get_settings_json client in
183
+
Error.decode_or_raise jsont json "parsing server settings"
184
+
185
+
let feature_level client =
186
+
let settings = get_settings client in
187
+
settings.zulip_feature_level
188
+
189
+
let supports_feature client ~level = feature_level client >= level
190
+
191
+
(* Linkifier codec *)
192
+
let linkifier_jsont =
193
+
Jsont.Object.(
194
+
map ~kind:"Linkifier" (fun id pattern url_template ->
195
+
{ id; pattern; url_template })
196
+
|> mem "id" Jsont.int ~enc:(fun l -> l.id)
197
+
|> mem "pattern" Jsont.string ~enc:(fun l -> l.pattern)
198
+
|> mem "url_template" Jsont.string ~enc:(fun l -> l.url_template)
199
+
|> finish)
200
+
201
+
let get_linkifiers client =
202
+
let response_codec =
203
+
Jsont.Object.(
204
+
map ~kind:"LinkifiersResponse" Fun.id
205
+
|> mem "linkifiers" (Jsont.list linkifier_jsont) ~enc:Fun.id
206
+
|> finish)
207
+
in
208
+
let json =
209
+
Client.request client ~method_:`GET ~path:"/api/v1/realm/linkifiers" ()
210
+
in
211
+
Error.decode_or_raise response_codec json "getting linkifiers"
212
+
213
+
let add_linkifier client ~pattern ~url_template =
214
+
let params = [ ("pattern", pattern); ("url_template", url_template) ] in
215
+
let response_codec =
216
+
Jsont.Object.(
217
+
map ~kind:"AddLinkifierResponse" Fun.id
218
+
|> mem "id" Jsont.int ~enc:Fun.id
219
+
|> finish)
220
+
in
221
+
let json =
222
+
Client.request client ~method_:`POST ~path:"/api/v1/realm/filters" ~params
223
+
()
224
+
in
225
+
Error.decode_or_raise response_codec json "adding linkifier"
226
+
227
+
let update_linkifier client ~filter_id ~pattern ~url_template =
228
+
let params = [ ("pattern", pattern); ("url_template", url_template) ] in
229
+
let _response =
230
+
Client.request client ~method_:`PATCH
231
+
~path:("/api/v1/realm/filters/" ^ string_of_int filter_id)
232
+
~params ()
233
+
in
234
+
()
235
+
236
+
let delete_linkifier client ~filter_id =
237
+
let _response =
238
+
Client.request client ~method_:`DELETE
239
+
~path:("/api/v1/realm/filters/" ^ string_of_int filter_id)
240
+
()
241
+
in
242
+
()
243
+
244
+
(* Emoji codec *)
245
+
let emoji_jsont : emoji Jsont.t =
246
+
Jsont.Object.(
247
+
map ~kind:"Emoji" (fun id name source_url deactivated author_id : emoji ->
248
+
{ id; name; source_url; deactivated; author_id })
249
+
|> mem "id" Jsont.string ~enc:(fun (e : emoji) -> e.id)
250
+
|> mem "name" Jsont.string ~enc:(fun (e : emoji) -> e.name)
251
+
|> mem "source_url" Jsont.string ~enc:(fun (e : emoji) -> e.source_url)
252
+
|> mem "deactivated" Jsont.bool ~dec_absent:false ~enc:(fun (e : emoji) ->
253
+
e.deactivated)
254
+
|> opt_mem "author_id" Jsont.int ~enc:(fun (e : emoji) -> e.author_id)
255
+
|> finish)
256
+
257
+
let get_emoji client =
258
+
let json =
259
+
Client.request client ~method_:`GET ~path:"/api/v1/realm/emoji" ()
260
+
in
261
+
match json with
262
+
| Jsont.Object (fields, _) -> (
263
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
264
+
match List.assoc_opt "emoji" assoc with
265
+
| Some (Jsont.Object (emoji_fields, _)) ->
266
+
List.filter_map
267
+
(fun ((name, _), emoji_json) ->
268
+
(* Add name to the emoji JSON before parsing *)
269
+
let emoji_with_name =
270
+
match emoji_json with
271
+
| Jsont.Object (e_fields, meta) ->
272
+
let name_field =
273
+
( ("name", Jsont.Meta.none),
274
+
Jsont.String (name, Jsont.Meta.none) )
275
+
in
276
+
Jsont.Object (name_field :: e_fields, meta)
277
+
| _ -> emoji_json
278
+
in
279
+
match Encode.from_json emoji_jsont emoji_with_name with
280
+
| Ok e -> Some e
281
+
| Error _ -> None)
282
+
emoji_fields
283
+
| _ -> [])
284
+
| _ -> []
285
+
286
+
let upload_emoji _client ~name:_ ~filename:_ =
287
+
(* TODO: Implement file upload using multipart/form-data *)
288
+
Error.raise
289
+
(Error.make ~code:(Other "not_implemented")
290
+
~message:"Emoji upload not yet implemented" ())
291
+
292
+
let deactivate_emoji client ~name =
293
+
let _response =
294
+
Client.request client ~method_:`DELETE
295
+
~path:("/api/v1/realm/emoji/" ^ name)
296
+
()
297
+
in
298
+
()
299
+
300
+
type profile_field_type =
301
+
| Short_text
302
+
| Long_text
303
+
| Choice
304
+
| Date
305
+
| Link
306
+
| User
307
+
| External_account
308
+
| Pronouns
309
+
310
+
type profile_field = {
311
+
id : int;
312
+
field_type : profile_field_type;
313
+
order : int;
314
+
name : string;
315
+
hint : string;
316
+
field_data : Jsont.json;
317
+
display_in_profile_summary : bool option;
318
+
}
319
+
320
+
(* Profile field type codec *)
321
+
let profile_field_type_to_int = function
322
+
| Short_text -> 1
323
+
| Long_text -> 2
324
+
| Choice -> 3
325
+
| Date -> 4
326
+
| Link -> 5
327
+
| User -> 6
328
+
| External_account -> 7
329
+
| Pronouns -> 8
330
+
331
+
let profile_field_type_of_int = function
332
+
| 1 -> Some Short_text
333
+
| 2 -> Some Long_text
334
+
| 3 -> Some Choice
335
+
| 4 -> Some Date
336
+
| 5 -> Some Link
337
+
| 6 -> Some User
338
+
| 7 -> Some External_account
339
+
| 8 -> Some Pronouns
340
+
| _ -> None
341
+
342
+
let profile_field_type_jsont =
343
+
Jsont.map ~kind:"ProfileFieldType" Jsont.int
344
+
~dec:(fun i ->
345
+
match profile_field_type_of_int i with Some t -> t | None -> Short_text)
346
+
~enc:profile_field_type_to_int
347
+
348
+
let profile_field_jsont =
349
+
Jsont.Object.(
350
+
map ~kind:"ProfileField"
351
+
(fun
352
+
id field_type order name hint field_data display_in_profile_summary ->
353
+
{
354
+
id;
355
+
field_type;
356
+
order;
357
+
name;
358
+
hint;
359
+
field_data;
360
+
display_in_profile_summary;
361
+
})
362
+
|> mem "id" Jsont.int ~enc:(fun p -> p.id)
363
+
|> mem "type" profile_field_type_jsont ~enc:(fun p -> p.field_type)
364
+
|> mem "order" Jsont.int ~enc:(fun p -> p.order)
365
+
|> mem "name" Jsont.string ~enc:(fun p -> p.name)
366
+
|> mem "hint" Jsont.string ~dec_absent:"" ~enc:(fun p -> p.hint)
367
+
|> mem "field_data" Jsont.json
368
+
~dec_absent:(Jsont.Null ((), Jsont.Meta.none))
369
+
~enc:(fun p -> p.field_data)
370
+
|> opt_mem "display_in_profile_summary" Jsont.bool ~enc:(fun p ->
371
+
p.display_in_profile_summary)
372
+
|> finish)
373
+
374
+
let get_profile_fields client =
375
+
let response_codec =
376
+
Jsont.Object.(
377
+
map ~kind:"ProfileFieldsResponse" Fun.id
378
+
|> mem "custom_profile_fields"
379
+
(Jsont.list profile_field_jsont)
380
+
~enc:Fun.id
381
+
|> finish)
382
+
in
383
+
let json =
384
+
Client.request client ~method_:`GET ~path:"/api/v1/realm/profile_fields" ()
385
+
in
386
+
Error.decode_or_raise response_codec json "getting profile fields"
387
+
388
+
let create_profile_field client ~field_type ~name ?hint ?field_data () =
389
+
let params =
390
+
[
391
+
("field_type", string_of_int (profile_field_type_to_int field_type));
392
+
("name", name);
393
+
]
394
+
@ List.filter_map Fun.id
395
+
[
396
+
Option.map (fun h -> ("hint", h)) hint;
397
+
Option.map
398
+
(fun d -> ("field_data", Encode.to_json_string Jsont.json d))
399
+
field_data;
400
+
]
401
+
in
402
+
let response_codec =
403
+
Jsont.Object.(
404
+
map ~kind:"CreateProfileFieldResponse" Fun.id
405
+
|> mem "id" Jsont.int ~enc:Fun.id
406
+
|> finish)
407
+
in
408
+
let json =
409
+
Client.request client ~method_:`POST ~path:"/api/v1/realm/profile_fields"
410
+
~params ()
411
+
in
412
+
Error.decode_or_raise response_codec json "creating profile field"
413
+
414
+
let update_profile_field client ~field_id ?name ?hint ?field_data () =
415
+
let params =
416
+
List.filter_map Fun.id
417
+
[
418
+
Option.map (fun n -> ("name", n)) name;
419
+
Option.map (fun h -> ("hint", h)) hint;
420
+
Option.map
421
+
(fun d -> ("field_data", Encode.to_json_string Jsont.json d))
422
+
field_data;
423
+
]
424
+
in
425
+
let _response =
426
+
Client.request client ~method_:`PATCH
427
+
~path:("/api/v1/realm/profile_fields/" ^ string_of_int field_id)
428
+
~params ()
429
+
in
430
+
()
431
+
432
+
let delete_profile_field client ~field_id =
433
+
let _response =
434
+
Client.request client ~method_:`DELETE
435
+
~path:("/api/v1/realm/profile_fields/" ^ string_of_int field_id)
436
+
()
437
+
in
438
+
()
439
+
440
+
let reorder_profile_fields client ~order =
441
+
let params =
442
+
[ ("order", Encode.to_json_string (Jsont.list Jsont.int) order) ]
443
+
in
444
+
let _response =
445
+
Client.request client ~method_:`PATCH ~path:"/api/v1/realm/profile_fields"
446
+
~params ()
447
+
in
448
+
()
+180
lib/zulip/server.mli
+180
lib/zulip/server.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Server information and settings for the Zulip API.
7
+
8
+
This module provides access to server-level information including version,
9
+
feature level, and authentication methods. *)
10
+
11
+
(** {1 Server Settings} *)
12
+
13
+
type authentication_method = {
14
+
password : bool; (** Password authentication enabled *)
15
+
dev : bool; (** Development authentication enabled *)
16
+
email : bool; (** Email authentication enabled *)
17
+
ldap : bool; (** LDAP authentication enabled *)
18
+
remoteuser : bool; (** Remote user authentication enabled *)
19
+
github : bool; (** GitHub OAuth enabled *)
20
+
azuread : bool; (** Azure AD OAuth enabled *)
21
+
gitlab : bool; (** GitLab OAuth enabled *)
22
+
apple : bool; (** Apple OAuth enabled *)
23
+
google : bool; (** Google OAuth enabled *)
24
+
saml : bool; (** SAML SSO enabled *)
25
+
openid_connect : bool; (** OpenID Connect enabled *)
26
+
}
27
+
(** Enabled authentication methods on the server. *)
28
+
29
+
type external_authentication_method = {
30
+
name : string; (** Method name *)
31
+
display_name : string; (** Display name for UI *)
32
+
display_icon : string option; (** Icon URL *)
33
+
login_url : string; (** Login URL *)
34
+
signup_url : string; (** Signup URL *)
35
+
}
36
+
(** External authentication method configuration. *)
37
+
38
+
type t = {
39
+
zulip_version : string; (** Server version string *)
40
+
zulip_feature_level : int; (** API feature level *)
41
+
zulip_merge_base : string option; (** Git merge base (for dev servers) *)
42
+
push_notifications_enabled : bool; (** Push notifications available *)
43
+
is_incompatible : bool; (** Client incompatible with server *)
44
+
email_auth_enabled : bool; (** Email auth enabled *)
45
+
require_email_format_usernames : bool; (** Usernames must be emails *)
46
+
realm_uri : string; (** Organization URL *)
47
+
realm_name : string; (** Organization name *)
48
+
realm_icon : string; (** Organization icon URL *)
49
+
realm_description : string; (** Organization description *)
50
+
realm_web_public_access_enabled : bool; (** Web public access enabled *)
51
+
authentication_methods : authentication_method;
52
+
external_authentication_methods : external_authentication_method list;
53
+
}
54
+
(** Server settings response. *)
55
+
56
+
val get_settings : Client.t -> t
57
+
(** Get server settings.
58
+
@raise Eio.Io on failure *)
59
+
60
+
val get_settings_json : Client.t -> Jsont.json
61
+
(** Get server settings as raw JSON.
62
+
@raise Eio.Io on failure *)
63
+
64
+
(** {1 Feature Level Checks} *)
65
+
66
+
val feature_level : Client.t -> int
67
+
(** Get the server's feature level. Useful for checking API compatibility.
68
+
@raise Eio.Io on failure *)
69
+
70
+
val supports_feature : Client.t -> level:int -> bool
71
+
(** Check if the server supports a given feature level.
72
+
@raise Eio.Io on failure *)
73
+
74
+
(** {1 Linkifiers} *)
75
+
76
+
type linkifier = {
77
+
id : int; (** Linkifier ID *)
78
+
pattern : string; (** Regex pattern *)
79
+
url_template : string; (** URL template *)
80
+
}
81
+
(** A realm linkifier (auto-link rule). *)
82
+
83
+
val get_linkifiers : Client.t -> linkifier list
84
+
(** Get all linkifiers for the organization.
85
+
@raise Eio.Io on failure *)
86
+
87
+
val add_linkifier : Client.t -> pattern:string -> url_template:string -> int
88
+
(** Add a new linkifier.
89
+
@return The ID of the created linkifier
90
+
@raise Eio.Io on failure *)
91
+
92
+
val update_linkifier :
93
+
Client.t -> filter_id:int -> pattern:string -> url_template:string -> unit
94
+
(** Update an existing linkifier.
95
+
@raise Eio.Io on failure *)
96
+
97
+
val delete_linkifier : Client.t -> filter_id:int -> unit
98
+
(** Delete a linkifier.
99
+
@raise Eio.Io on failure *)
100
+
101
+
(** {1 Custom Emoji} *)
102
+
103
+
type emoji = {
104
+
id : string; (** Emoji ID *)
105
+
name : string; (** Emoji name *)
106
+
source_url : string; (** Source image URL *)
107
+
deactivated : bool; (** Whether emoji is deactivated *)
108
+
author_id : int option; (** User ID of uploader *)
109
+
}
110
+
(** A custom realm emoji. *)
111
+
112
+
val get_emoji : Client.t -> emoji list
113
+
(** Get all custom emoji for the organization.
114
+
@raise Eio.Io on failure *)
115
+
116
+
val upload_emoji : Client.t -> name:string -> filename:string -> unit
117
+
(** Upload a new custom emoji.
118
+
@raise Eio.Io on failure *)
119
+
120
+
val deactivate_emoji : Client.t -> name:string -> unit
121
+
(** Deactivate a custom emoji.
122
+
@raise Eio.Io on failure *)
123
+
124
+
(** {1 Profile Fields} *)
125
+
126
+
type profile_field_type =
127
+
| Short_text (** Single line text *)
128
+
| Long_text (** Multi-line text *)
129
+
| Choice (** Select from options *)
130
+
| Date (** Date picker *)
131
+
| Link (** URL *)
132
+
| User (** User reference *)
133
+
| External_account (** External account link *)
134
+
| Pronouns (** Pronouns field *)
135
+
136
+
type profile_field = {
137
+
id : int;
138
+
field_type : profile_field_type;
139
+
order : int;
140
+
name : string;
141
+
hint : string;
142
+
field_data : Jsont.json;
143
+
display_in_profile_summary : bool option;
144
+
}
145
+
(** A custom profile field definition. *)
146
+
147
+
val get_profile_fields : Client.t -> profile_field list
148
+
(** Get all custom profile fields.
149
+
@raise Eio.Io on failure *)
150
+
151
+
val create_profile_field :
152
+
Client.t ->
153
+
field_type:profile_field_type ->
154
+
name:string ->
155
+
?hint:string ->
156
+
?field_data:Jsont.json ->
157
+
unit ->
158
+
int
159
+
(** Create a new custom profile field.
160
+
@return The ID of the created field
161
+
@raise Eio.Io on failure *)
162
+
163
+
val update_profile_field :
164
+
Client.t ->
165
+
field_id:int ->
166
+
?name:string ->
167
+
?hint:string ->
168
+
?field_data:Jsont.json ->
169
+
unit ->
170
+
unit
171
+
(** Update a custom profile field.
172
+
@raise Eio.Io on failure *)
173
+
174
+
val delete_profile_field : Client.t -> field_id:int -> unit
175
+
(** Delete a custom profile field.
176
+
@raise Eio.Io on failure *)
177
+
178
+
val reorder_profile_fields : Client.t -> order:int list -> unit
179
+
(** Reorder custom profile fields.
180
+
@raise Eio.Io on failure *)
+40
lib/zulip/typing.ml
+40
lib/zulip/typing.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type op = Start | Stop
7
+
8
+
let op_to_string = function Start -> "start" | Stop -> "stop"
9
+
10
+
let set_dm client ~op ~user_ids =
11
+
let params =
12
+
[
13
+
("op", op_to_string op);
14
+
("type", "direct");
15
+
("to", Encode.to_json_string (Jsont.list Jsont.int) user_ids);
16
+
]
17
+
in
18
+
let _response =
19
+
Client.request client ~method_:`POST ~path:"/api/v1/typing" ~params ()
20
+
in
21
+
()
22
+
23
+
let set_channel client ~op ~stream_id ~topic =
24
+
let params =
25
+
[
26
+
("op", op_to_string op);
27
+
("type", "stream");
28
+
("stream_id", string_of_int stream_id);
29
+
("topic", topic);
30
+
]
31
+
in
32
+
let _response =
33
+
Client.request client ~method_:`POST ~path:"/api/v1/typing" ~params ()
34
+
in
35
+
()
36
+
37
+
let set client ~op ~to_ =
38
+
match to_ with
39
+
| `User_ids user_ids -> set_dm client ~op ~user_ids
40
+
| `Stream (stream_id, topic) -> set_channel client ~op ~stream_id ~topic
+45
lib/zulip/typing.mli
+45
lib/zulip/typing.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Typing notifications for the Zulip API.
7
+
8
+
Send typing start/stop notifications to indicate that the user is composing
9
+
a message. *)
10
+
11
+
(** {1 Typing Status Operations} *)
12
+
13
+
type op = Start (** User started typing *) | Stop (** User stopped typing *)
14
+
15
+
(** {1 Direct Messages} *)
16
+
17
+
val set_dm : Client.t -> op:op -> user_ids:int list -> unit
18
+
(** Set typing status for a direct message conversation.
19
+
20
+
@param op Whether typing has started or stopped
21
+
@param user_ids List of user IDs in the conversation
22
+
@raise Eio.Io on failure *)
23
+
24
+
(** {1 Channel Messages} *)
25
+
26
+
val set_channel : Client.t -> op:op -> stream_id:int -> topic:string -> unit
27
+
(** Set typing status in a channel topic.
28
+
29
+
@param op Whether typing has started or stopped
30
+
@param stream_id The channel's stream ID
31
+
@param topic The topic name
32
+
@raise Eio.Io on failure *)
33
+
34
+
(** {1 Legacy API} *)
35
+
36
+
val set :
37
+
Client.t ->
38
+
op:op ->
39
+
to_:[ `User_ids of int list | `Stream of int * string ] ->
40
+
unit
41
+
(** Set typing status (unified interface).
42
+
43
+
@param op Whether typing has started or stopped
44
+
@param to_ Either user IDs for DM or (stream_id, topic) for channel
45
+
@raise Eio.Io on failure *)
+133
lib/zulip/user.ml
+133
lib/zulip/user.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
email : string;
8
+
full_name : string;
9
+
user_id : int option;
10
+
delivery_email : string option;
11
+
is_active : bool;
12
+
is_admin : bool;
13
+
is_owner : bool;
14
+
is_guest : bool;
15
+
is_billing_admin : bool;
16
+
is_bot : bool;
17
+
bot_type : int option;
18
+
bot_owner_id : int option;
19
+
avatar_url : string option;
20
+
avatar_version : int option;
21
+
timezone : string option;
22
+
date_joined : string option;
23
+
role : int option;
24
+
}
25
+
26
+
let role_owner = 100
27
+
let role_admin = 200
28
+
let role_moderator = 300
29
+
let role_member = 400
30
+
let role_guest = 600
31
+
32
+
let create ~email ~full_name ?user_id ?delivery_email ?(is_active = true)
33
+
?(is_admin = false) ?(is_owner = false) ?(is_guest = false)
34
+
?(is_billing_admin = false) ?(is_bot = false) ?bot_type ?bot_owner_id
35
+
?avatar_url ?avatar_version ?timezone ?date_joined ?role () =
36
+
{
37
+
email;
38
+
full_name;
39
+
user_id;
40
+
delivery_email;
41
+
is_active;
42
+
is_admin;
43
+
is_owner;
44
+
is_guest;
45
+
is_billing_admin;
46
+
is_bot;
47
+
bot_type;
48
+
bot_owner_id;
49
+
avatar_url;
50
+
avatar_version;
51
+
timezone;
52
+
date_joined;
53
+
role;
54
+
}
55
+
56
+
let email t = t.email
57
+
let full_name t = t.full_name
58
+
let user_id t = t.user_id
59
+
let delivery_email t = t.delivery_email
60
+
let is_active t = t.is_active
61
+
let is_admin t = t.is_admin
62
+
let is_owner t = t.is_owner
63
+
let is_guest t = t.is_guest
64
+
let is_billing_admin t = t.is_billing_admin
65
+
let is_bot t = t.is_bot
66
+
let bot_type t = t.bot_type
67
+
let bot_owner_id t = t.bot_owner_id
68
+
let avatar_url t = t.avatar_url
69
+
let avatar_version t = t.avatar_version
70
+
let timezone t = t.timezone
71
+
let date_joined t = t.date_joined
72
+
let role t = t.role
73
+
74
+
(* Jsont codec for user *)
75
+
let jsont =
76
+
let kind = "User" in
77
+
let doc = "A Zulip user" in
78
+
let make email full_name user_id delivery_email is_active is_admin is_owner
79
+
is_guest is_billing_admin is_bot bot_type bot_owner_id avatar_url
80
+
avatar_version timezone date_joined role =
81
+
{
82
+
email;
83
+
full_name;
84
+
user_id;
85
+
delivery_email;
86
+
is_active;
87
+
is_admin;
88
+
is_owner;
89
+
is_guest;
90
+
is_billing_admin;
91
+
is_bot;
92
+
bot_type;
93
+
bot_owner_id;
94
+
avatar_url;
95
+
avatar_version;
96
+
timezone;
97
+
date_joined;
98
+
role;
99
+
}
100
+
in
101
+
Jsont.Object.map ~kind ~doc make
102
+
|> Jsont.Object.mem "email" Jsont.string ~enc:email
103
+
|> Jsont.Object.mem "full_name" Jsont.string ~enc:full_name
104
+
|> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:user_id
105
+
|> Jsont.Object.opt_mem "delivery_email" Jsont.string ~enc:delivery_email
106
+
|> Jsont.Object.mem "is_active" Jsont.bool ~dec_absent:true ~enc:is_active
107
+
|> Jsont.Object.mem "is_admin" Jsont.bool ~dec_absent:false ~enc:is_admin
108
+
|> Jsont.Object.mem "is_owner" Jsont.bool ~dec_absent:false ~enc:is_owner
109
+
|> Jsont.Object.mem "is_guest" Jsont.bool ~dec_absent:false ~enc:is_guest
110
+
|> Jsont.Object.mem "is_billing_admin" Jsont.bool ~dec_absent:false
111
+
~enc:is_billing_admin
112
+
|> Jsont.Object.mem "is_bot" Jsont.bool ~dec_absent:false ~enc:is_bot
113
+
|> Jsont.Object.opt_mem "bot_type" Jsont.int ~enc:bot_type
114
+
|> Jsont.Object.opt_mem "bot_owner_id" Jsont.int ~enc:bot_owner_id
115
+
|> Jsont.Object.mem "avatar_url" (Jsont.option Jsont.string) ~dec_absent:None
116
+
~enc:avatar_url
117
+
|> Jsont.Object.opt_mem "avatar_version" Jsont.int ~enc:avatar_version
118
+
|> Jsont.Object.opt_mem "timezone" Jsont.string ~enc:timezone
119
+
|> Jsont.Object.opt_mem "date_joined" Jsont.string ~enc:date_joined
120
+
|> Jsont.Object.opt_mem "role" Jsont.int ~enc:role
121
+
|> Jsont.Object.finish
122
+
123
+
let pp fmt t =
124
+
let delivery =
125
+
Option.fold ~none:""
126
+
~some:(Printf.sprintf ", delivery_email=%s")
127
+
t.delivery_email
128
+
in
129
+
let uid =
130
+
Option.fold ~none:"" ~some:(Printf.sprintf ", user_id=%d") t.user_id
131
+
in
132
+
Format.fprintf fmt "User{email=%s, full_name=%s%s%s}" t.email t.full_name uid
133
+
delivery
+107
lib/zulip/user.mli
+107
lib/zulip/user.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Zulip user records.
7
+
8
+
This module represents user information from the Zulip API. Use {!jsont}
9
+
with Bytesrw-eio for wire serialization. *)
10
+
11
+
(** {1 User Type} *)
12
+
13
+
type t
14
+
(** A Zulip user. *)
15
+
16
+
(** {1 Construction} *)
17
+
18
+
val create :
19
+
email:string ->
20
+
full_name:string ->
21
+
?user_id:int ->
22
+
?delivery_email:string ->
23
+
?is_active:bool ->
24
+
?is_admin:bool ->
25
+
?is_owner:bool ->
26
+
?is_guest:bool ->
27
+
?is_billing_admin:bool ->
28
+
?is_bot:bool ->
29
+
?bot_type:int ->
30
+
?bot_owner_id:int ->
31
+
?avatar_url:string ->
32
+
?avatar_version:int ->
33
+
?timezone:string ->
34
+
?date_joined:string ->
35
+
?role:int ->
36
+
unit ->
37
+
t
38
+
39
+
(** {1 Accessors} *)
40
+
41
+
val email : t -> string
42
+
(** User's email address (may be delivery_email if visible). *)
43
+
44
+
val full_name : t -> string
45
+
(** User's full display name. *)
46
+
47
+
val user_id : t -> int option
48
+
(** Server-assigned user ID. *)
49
+
50
+
val delivery_email : t -> string option
51
+
(** User's actual email (if visible to current user). *)
52
+
53
+
val is_active : t -> bool
54
+
(** Whether the user account is active. *)
55
+
56
+
val is_admin : t -> bool
57
+
(** Whether the user is an organization admin. *)
58
+
59
+
val is_owner : t -> bool
60
+
(** Whether the user is an organization owner. *)
61
+
62
+
val is_guest : t -> bool
63
+
(** Whether the user is a guest. *)
64
+
65
+
val is_billing_admin : t -> bool
66
+
(** Whether the user is a billing admin. *)
67
+
68
+
val is_bot : t -> bool
69
+
(** Whether the user is a bot. *)
70
+
71
+
val bot_type : t -> int option
72
+
(** Bot type (1=generic, 2=incoming webhook, 3=outgoing webhook, 4=embedded). *)
73
+
74
+
val bot_owner_id : t -> int option
75
+
(** User ID of the bot's owner. *)
76
+
77
+
val avatar_url : t -> string option
78
+
(** URL for the user's avatar. *)
79
+
80
+
val avatar_version : t -> int option
81
+
(** Version number of the avatar (for cache busting). *)
82
+
83
+
val timezone : t -> string option
84
+
(** User's timezone string. *)
85
+
86
+
val date_joined : t -> string option
87
+
(** ISO 8601 datetime when user joined. *)
88
+
89
+
val role : t -> int option
90
+
(** User's role (100=owner, 200=admin, 300=moderator, 400=member, 600=guest). *)
91
+
92
+
(** {1 Role Constants} *)
93
+
94
+
val role_owner : int
95
+
val role_admin : int
96
+
val role_moderator : int
97
+
val role_member : int
98
+
val role_guest : int
99
+
100
+
(** {1 JSON Codec} *)
101
+
102
+
val jsont : t Jsont.t
103
+
(** Jsont codec for the user type. *)
104
+
105
+
(** {1 Pretty Printing} *)
106
+
107
+
val pp : Format.formatter -> t -> unit
+216
lib/zulip/user_group.ml
+216
lib/zulip/user_group.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
id : int;
8
+
name : string;
9
+
description : string;
10
+
members : int list;
11
+
direct_subgroup_ids : int list;
12
+
is_system_group : bool;
13
+
can_mention_group : int;
14
+
}
15
+
16
+
let pp fmt g =
17
+
Format.fprintf fmt "UserGroup{id=%d, name=%s, members=%d}" g.id g.name
18
+
(List.length g.members)
19
+
20
+
let jsont =
21
+
Jsont.Object.(
22
+
map ~kind:"UserGroup"
23
+
(fun
24
+
id
25
+
name
26
+
description
27
+
members
28
+
direct_subgroup_ids
29
+
is_system_group
30
+
can_mention_group
31
+
->
32
+
{
33
+
id;
34
+
name;
35
+
description;
36
+
members;
37
+
direct_subgroup_ids;
38
+
is_system_group;
39
+
can_mention_group;
40
+
})
41
+
|> mem "id" Jsont.int ~enc:(fun g -> g.id)
42
+
|> mem "name" Jsont.string ~enc:(fun g -> g.name)
43
+
|> mem "description" Jsont.string ~enc:(fun g -> g.description)
44
+
|> mem "members" (Jsont.list Jsont.int) ~dec_absent:[] ~enc:(fun g ->
45
+
g.members)
46
+
|> mem "direct_subgroup_ids" (Jsont.list Jsont.int) ~dec_absent:[]
47
+
~enc:(fun g -> g.direct_subgroup_ids)
48
+
|> mem "is_system_group" Jsont.bool ~dec_absent:false ~enc:(fun g ->
49
+
g.is_system_group)
50
+
|> mem "can_mention_group" Jsont.int ~dec_absent:0 ~enc:(fun g ->
51
+
g.can_mention_group)
52
+
|> finish)
53
+
54
+
let list client =
55
+
let response_codec =
56
+
Jsont.Object.(
57
+
map ~kind:"UserGroupsResponse" Fun.id
58
+
|> mem "user_groups" (Jsont.list jsont) ~enc:Fun.id
59
+
|> finish)
60
+
in
61
+
let json =
62
+
Client.request client ~method_:`GET ~path:"/api/v1/user_groups" ()
63
+
in
64
+
Error.decode_or_raise response_codec json "getting user groups"
65
+
66
+
let create client ~name ~description ~members ?can_mention_group () =
67
+
let params =
68
+
[
69
+
("name", name);
70
+
("description", description);
71
+
("members", Encode.to_json_string (Jsont.list Jsont.int) members);
72
+
]
73
+
@ List.filter_map Fun.id
74
+
[
75
+
Option.map
76
+
(fun g -> ("can_mention_group", string_of_int g))
77
+
can_mention_group;
78
+
]
79
+
in
80
+
let response_codec =
81
+
Jsont.Object.(
82
+
map ~kind:"CreateUserGroupResponse" Fun.id
83
+
|> mem "id" Jsont.int ~enc:Fun.id
84
+
|> finish)
85
+
in
86
+
let json =
87
+
Client.request client ~method_:`POST ~path:"/api/v1/user_groups/create"
88
+
~params ()
89
+
in
90
+
Error.decode_or_raise response_codec json "creating user group"
91
+
92
+
let update client ~group_id ?name ?description ?can_mention_group () =
93
+
let params =
94
+
List.filter_map Fun.id
95
+
[
96
+
Option.map (fun n -> ("name", n)) name;
97
+
Option.map (fun d -> ("description", d)) description;
98
+
Option.map
99
+
(fun g -> ("can_mention_group", string_of_int g))
100
+
can_mention_group;
101
+
]
102
+
in
103
+
let _response =
104
+
Client.request client ~method_:`PATCH
105
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id)
106
+
~params ()
107
+
in
108
+
()
109
+
110
+
let update_members client ~group_id ?add ?remove () =
111
+
let params =
112
+
List.filter_map Fun.id
113
+
[
114
+
Option.map
115
+
(fun ids -> ("add", Encode.to_json_string (Jsont.list Jsont.int) ids))
116
+
add;
117
+
Option.map
118
+
(fun ids ->
119
+
("delete", Encode.to_json_string (Jsont.list Jsont.int) ids))
120
+
remove;
121
+
]
122
+
in
123
+
let _response =
124
+
Client.request client ~method_:`POST
125
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id ^ "/members")
126
+
~params ()
127
+
in
128
+
()
129
+
130
+
let update_subgroups client ~group_id ?add ?remove () =
131
+
let params =
132
+
List.filter_map Fun.id
133
+
[
134
+
Option.map
135
+
(fun ids -> ("add", Encode.to_json_string (Jsont.list Jsont.int) ids))
136
+
add;
137
+
Option.map
138
+
(fun ids ->
139
+
("delete", Encode.to_json_string (Jsont.list Jsont.int) ids))
140
+
remove;
141
+
]
142
+
in
143
+
let _response =
144
+
Client.request client ~method_:`POST
145
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id ^ "/subgroups")
146
+
~params ()
147
+
in
148
+
()
149
+
150
+
let delete client ~group_id =
151
+
let _response =
152
+
Client.request client ~method_:`DELETE
153
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id)
154
+
()
155
+
in
156
+
()
157
+
158
+
let get_members client ~group_id =
159
+
let response_codec =
160
+
Jsont.Object.(
161
+
map ~kind:"MembersResponse" Fun.id
162
+
|> mem "members" (Jsont.list Jsont.int) ~enc:Fun.id
163
+
|> finish)
164
+
in
165
+
let json =
166
+
Client.request client ~method_:`GET
167
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id ^ "/members")
168
+
()
169
+
in
170
+
Error.decode_or_raise response_codec json "getting group members"
171
+
172
+
let is_member client ~group_id ~user_id =
173
+
let response_codec =
174
+
Jsont.Object.(
175
+
map ~kind:"IsMemberResponse" Fun.id
176
+
|> mem "is_user_group_member" Jsont.bool ~enc:Fun.id
177
+
|> finish)
178
+
in
179
+
let json =
180
+
Client.request client ~method_:`GET
181
+
~path:
182
+
("/api/v1/user_groups/" ^ string_of_int group_id ^ "/members/"
183
+
^ string_of_int user_id)
184
+
()
185
+
in
186
+
Error.decode_or_raise response_codec json "checking group membership"
187
+
188
+
let get_subgroups client ~group_id =
189
+
let response_codec =
190
+
Jsont.Object.(
191
+
map ~kind:"SubgroupsResponse" Fun.id
192
+
|> mem "subgroups" (Jsont.list Jsont.int) ~enc:Fun.id
193
+
|> finish)
194
+
in
195
+
let json =
196
+
Client.request client ~method_:`GET
197
+
~path:("/api/v1/user_groups/" ^ string_of_int group_id ^ "/subgroups")
198
+
()
199
+
in
200
+
Error.decode_or_raise response_codec json "getting subgroups"
201
+
202
+
let is_subgroup client ~group_id ~subgroup_id =
203
+
let response_codec =
204
+
Jsont.Object.(
205
+
map ~kind:"IsSubgroupResponse" Fun.id
206
+
|> mem "is_subgroup" Jsont.bool ~enc:Fun.id
207
+
|> finish)
208
+
in
209
+
let json =
210
+
Client.request client ~method_:`GET
211
+
~path:
212
+
("/api/v1/user_groups/" ^ string_of_int group_id ^ "/subgroups/"
213
+
^ string_of_int subgroup_id)
214
+
()
215
+
in
216
+
Error.decode_or_raise response_codec json "checking subgroup membership"
+105
lib/zulip/user_group.mli
+105
lib/zulip/user_group.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** User groups for the Zulip API.
7
+
8
+
User groups allow organizing users and setting permissions. *)
9
+
10
+
(** {1 User Group Type} *)
11
+
12
+
type t = {
13
+
id : int; (** Group ID *)
14
+
name : string; (** Group name *)
15
+
description : string; (** Group description *)
16
+
members : int list; (** User IDs of group members *)
17
+
direct_subgroup_ids : int list; (** IDs of direct subgroups *)
18
+
is_system_group : bool; (** Whether this is a system-managed group *)
19
+
can_mention_group : int; (** Group ID that can mention this group *)
20
+
}
21
+
(** A user group. *)
22
+
23
+
(** {1 Listing Groups} *)
24
+
25
+
val list : Client.t -> t list
26
+
(** Get all user groups in the organization.
27
+
@raise Eio.Io on failure *)
28
+
29
+
(** {1 Creating Groups} *)
30
+
31
+
val create :
32
+
Client.t ->
33
+
name:string ->
34
+
description:string ->
35
+
members:int list ->
36
+
?can_mention_group:int ->
37
+
unit ->
38
+
int
39
+
(** Create a new user group.
40
+
@return The ID of the created group
41
+
@raise Eio.Io on failure *)
42
+
43
+
(** {1 Updating Groups} *)
44
+
45
+
val update :
46
+
Client.t ->
47
+
group_id:int ->
48
+
?name:string ->
49
+
?description:string ->
50
+
?can_mention_group:int ->
51
+
unit ->
52
+
unit
53
+
(** Update a user group's properties.
54
+
@raise Eio.Io on failure *)
55
+
56
+
val update_members :
57
+
Client.t -> group_id:int -> ?add:int list -> ?remove:int list -> unit -> unit
58
+
(** Update user group membership.
59
+
60
+
@param add User IDs to add to the group
61
+
@param remove User IDs to remove from the group
62
+
@raise Eio.Io on failure *)
63
+
64
+
val update_subgroups :
65
+
Client.t -> group_id:int -> ?add:int list -> ?remove:int list -> unit -> unit
66
+
(** Update user group subgroups.
67
+
68
+
@param add Subgroup IDs to add
69
+
@param remove Subgroup IDs to remove
70
+
@raise Eio.Io on failure *)
71
+
72
+
(** {1 Deleting Groups} *)
73
+
74
+
val delete : Client.t -> group_id:int -> unit
75
+
(** Delete a user group.
76
+
@raise Eio.Io on failure *)
77
+
78
+
(** {1 Membership Queries} *)
79
+
80
+
val get_members : Client.t -> group_id:int -> int list
81
+
(** Get the members of a user group.
82
+
@raise Eio.Io on failure *)
83
+
84
+
val is_member : Client.t -> group_id:int -> user_id:int -> bool
85
+
(** Check if a user is a member of a group.
86
+
@raise Eio.Io on failure *)
87
+
88
+
(** {1 Subgroup Queries} *)
89
+
90
+
val get_subgroups : Client.t -> group_id:int -> int list
91
+
(** Get the direct subgroups of a user group.
92
+
@raise Eio.Io on failure *)
93
+
94
+
val is_subgroup : Client.t -> group_id:int -> subgroup_id:int -> bool
95
+
(** Check if a group is a subgroup of another.
96
+
@raise Eio.Io on failure *)
97
+
98
+
(** {1 JSON Codec} *)
99
+
100
+
val jsont : t Jsont.t
101
+
(** Jsont codec for user groups. *)
102
+
103
+
(** {1 Pretty Printing} *)
104
+
105
+
val pp : Format.formatter -> t -> unit
+361
lib/zulip/users.ml
+361
lib/zulip/users.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let list client =
7
+
let response_codec =
8
+
Jsont.Object.(
9
+
map ~kind:"UsersResponse" Fun.id
10
+
|> mem "members" (Jsont.list User.jsont) ~enc:Fun.id
11
+
|> finish)
12
+
in
13
+
let json = Client.request client ~method_:`GET ~path:"/api/v1/users" () in
14
+
Error.decode_or_raise response_codec json "parsing users list"
15
+
16
+
let list_all client ?client_gravatar ?include_custom_profile_fields () =
17
+
let params =
18
+
List.filter_map Fun.id
19
+
[
20
+
Option.map
21
+
(fun v -> ("client_gravatar", string_of_bool v))
22
+
client_gravatar;
23
+
Option.map
24
+
(fun v -> ("include_custom_profile_fields", string_of_bool v))
25
+
include_custom_profile_fields;
26
+
]
27
+
in
28
+
let response_codec =
29
+
Jsont.Object.(
30
+
map ~kind:"UsersResponse" Fun.id
31
+
|> mem "members" (Jsont.list User.jsont) ~enc:Fun.id
32
+
|> finish)
33
+
in
34
+
let json =
35
+
Client.request client ~method_:`GET ~path:"/api/v1/users" ~params ()
36
+
in
37
+
Error.decode_or_raise response_codec json "parsing users list"
38
+
39
+
let user_response_codec =
40
+
Jsont.Object.(
41
+
map ~kind:"UserResponse" Fun.id
42
+
|> mem "user" User.jsont ~enc:Fun.id
43
+
|> finish)
44
+
45
+
let get client ~email =
46
+
let json =
47
+
Client.request client ~method_:`GET ~path:("/api/v1/users/" ^ email) ()
48
+
in
49
+
Encode.from_json user_response_codec json
50
+
|> Result.fold ~ok:Fun.id ~error:(fun _ ->
51
+
Error.decode_or_raise User.jsont json
52
+
(Printf.sprintf "parsing user %s" email))
53
+
54
+
let get_by_id client ~user_id ?include_custom_profile_fields () =
55
+
let params =
56
+
List.filter_map Fun.id
57
+
[
58
+
Option.map
59
+
(fun v -> ("include_custom_profile_fields", string_of_bool v))
60
+
include_custom_profile_fields;
61
+
]
62
+
in
63
+
let json =
64
+
Client.request client ~method_:`GET
65
+
~path:("/api/v1/users/" ^ string_of_int user_id)
66
+
~params ()
67
+
in
68
+
Encode.from_json user_response_codec json
69
+
|> Result.fold ~ok:Fun.id ~error:(fun _ ->
70
+
Error.decode_or_raise User.jsont json
71
+
(Printf.sprintf "parsing user id %d" user_id))
72
+
73
+
let me client =
74
+
let json = Client.request client ~method_:`GET ~path:"/api/v1/users/me" () in
75
+
Error.decode_or_raise User.jsont json "parsing current user"
76
+
77
+
let me_pointer client =
78
+
let response_codec =
79
+
Jsont.Object.(
80
+
map ~kind:"PointerResponse" Fun.id
81
+
|> mem "pointer" Jsont.int ~enc:Fun.id
82
+
|> finish)
83
+
in
84
+
let json =
85
+
Client.request client ~method_:`GET ~path:"/api/v1/users/me/pointer" ()
86
+
in
87
+
Error.decode_or_raise response_codec json "getting pointer"
88
+
89
+
let update_me_pointer client ~pointer =
90
+
let params = [ ("pointer", string_of_int pointer) ] in
91
+
let _response =
92
+
Client.request client ~method_:`POST ~path:"/api/v1/users/me/pointer"
93
+
~params ()
94
+
in
95
+
()
96
+
97
+
let create client ~email ~full_name ~password =
98
+
let params =
99
+
[ ("email", email); ("full_name", full_name); ("password", password) ]
100
+
in
101
+
let _response =
102
+
Client.request client ~method_:`POST ~path:"/api/v1/users" ~params ()
103
+
in
104
+
()
105
+
106
+
let update client ~user_id ?full_name ?role () =
107
+
let params =
108
+
List.filter_map Fun.id
109
+
[
110
+
Option.map (fun v -> ("full_name", v)) full_name;
111
+
Option.map (fun v -> ("role", string_of_int v)) role;
112
+
]
113
+
in
114
+
let _response =
115
+
Client.request client ~method_:`PATCH
116
+
~path:("/api/v1/users/" ^ string_of_int user_id)
117
+
~params ()
118
+
in
119
+
()
120
+
121
+
let deactivate client ~user_id =
122
+
let _response =
123
+
Client.request client ~method_:`DELETE
124
+
~path:("/api/v1/users/" ^ string_of_int user_id)
125
+
()
126
+
in
127
+
()
128
+
129
+
let reactivate client ~user_id =
130
+
let _response =
131
+
Client.request client ~method_:`POST
132
+
~path:("/api/v1/users/" ^ string_of_int user_id ^ "/reactivate")
133
+
()
134
+
in
135
+
()
136
+
137
+
let alert_words_codec =
138
+
Jsont.Object.(
139
+
map ~kind:"AlertWordsResponse" Fun.id
140
+
|> mem "alert_words" (Jsont.list Jsont.string) ~enc:Fun.id
141
+
|> finish)
142
+
143
+
let get_alert_words client =
144
+
let json =
145
+
Client.request client ~method_:`GET ~path:"/api/v1/users/me/alert_words" ()
146
+
in
147
+
Error.decode_or_raise alert_words_codec json "getting alert words"
148
+
149
+
let add_alert_words client ~words =
150
+
let params =
151
+
[ ("alert_words", Encode.to_json_string (Jsont.list Jsont.string) words) ]
152
+
in
153
+
let json =
154
+
Client.request client ~method_:`POST ~path:"/api/v1/users/me/alert_words"
155
+
~params ()
156
+
in
157
+
Error.decode_or_raise alert_words_codec json "adding alert words"
158
+
159
+
let remove_alert_words client ~words =
160
+
let params =
161
+
[ ("alert_words", Encode.to_json_string (Jsont.list Jsont.string) words) ]
162
+
in
163
+
let json =
164
+
Client.request client ~method_:`DELETE ~path:"/api/v1/users/me/alert_words"
165
+
~params ()
166
+
in
167
+
Error.decode_or_raise alert_words_codec json "removing alert words"
168
+
169
+
type status_emoji = {
170
+
emoji_name : string;
171
+
emoji_code : string option;
172
+
reaction_type : string option;
173
+
}
174
+
175
+
let get_status client ~user_id =
176
+
Client.request client ~method_:`GET
177
+
~path:("/api/v1/users/" ^ string_of_int user_id ^ "/status")
178
+
()
179
+
180
+
let update_status client ?status_text ?away ?emoji () =
181
+
let params =
182
+
List.filter_map Fun.id
183
+
[
184
+
Option.map (fun v -> ("status_text", v)) status_text;
185
+
Option.map (fun v -> ("away", string_of_bool v)) away;
186
+
Option.map (fun e -> ("emoji_name", e.emoji_name)) emoji;
187
+
Option.bind emoji (fun e ->
188
+
Option.map (fun c -> ("emoji_code", c)) e.emoji_code);
189
+
Option.bind emoji (fun e ->
190
+
Option.map (fun t -> ("reaction_type", t)) e.reaction_type);
191
+
]
192
+
in
193
+
let _response =
194
+
Client.request client ~method_:`POST ~path:"/api/v1/users/me/status" ~params
195
+
()
196
+
in
197
+
()
198
+
199
+
let get_settings client =
200
+
Client.request client ~method_:`GET ~path:"/api/v1/settings" ()
201
+
202
+
let update_settings client ?full_name ?email ?old_password ?new_password
203
+
?twenty_four_hour_time ?dense_mode ?starred_message_counts
204
+
?fluid_layout_width ?high_contrast_mode ?color_scheme ?translate_emoticons
205
+
?default_language ?default_view ?escape_navigates_to_default_view
206
+
?left_side_userlist ?emojiset ?demote_inactive_streams ?timezone
207
+
?enable_stream_desktop_notifications ?enable_stream_email_notifications
208
+
?enable_stream_push_notifications ?enable_stream_audible_notifications
209
+
?notification_sound ?enable_desktop_notifications ?enable_sounds
210
+
?email_notifications_batching_period_seconds
211
+
?enable_offline_email_notifications ?enable_offline_push_notifications
212
+
?enable_online_push_notifications ?enable_digest_emails
213
+
?enable_marketing_emails ?enable_login_emails
214
+
?message_content_in_email_notifications ?pm_content_in_desktop_notifications
215
+
?wildcard_mentions_notify ?desktop_icon_count_display
216
+
?realm_name_in_notifications ?presence_enabled ?enter_sends () =
217
+
let params =
218
+
List.filter_map Fun.id
219
+
[
220
+
Option.map (fun v -> ("full_name", v)) full_name;
221
+
Option.map (fun v -> ("email", v)) email;
222
+
Option.map (fun v -> ("old_password", v)) old_password;
223
+
Option.map (fun v -> ("new_password", v)) new_password;
224
+
Option.map
225
+
(fun v -> ("twenty_four_hour_time", string_of_bool v))
226
+
twenty_four_hour_time;
227
+
Option.map (fun v -> ("dense_mode", string_of_bool v)) dense_mode;
228
+
Option.map
229
+
(fun v -> ("starred_message_counts", string_of_bool v))
230
+
starred_message_counts;
231
+
Option.map
232
+
(fun v -> ("fluid_layout_width", string_of_bool v))
233
+
fluid_layout_width;
234
+
Option.map
235
+
(fun v -> ("high_contrast_mode", string_of_bool v))
236
+
high_contrast_mode;
237
+
Option.map (fun v -> ("color_scheme", string_of_int v)) color_scheme;
238
+
Option.map
239
+
(fun v -> ("translate_emoticons", string_of_bool v))
240
+
translate_emoticons;
241
+
Option.map (fun v -> ("default_language", v)) default_language;
242
+
Option.map (fun v -> ("default_view", v)) default_view;
243
+
Option.map
244
+
(fun v -> ("escape_navigates_to_default_view", string_of_bool v))
245
+
escape_navigates_to_default_view;
246
+
Option.map
247
+
(fun v -> ("left_side_userlist", string_of_bool v))
248
+
left_side_userlist;
249
+
Option.map (fun v -> ("emojiset", v)) emojiset;
250
+
Option.map
251
+
(fun v -> ("demote_inactive_streams", string_of_int v))
252
+
demote_inactive_streams;
253
+
Option.map (fun v -> ("timezone", v)) timezone;
254
+
Option.map
255
+
(fun v -> ("enable_stream_desktop_notifications", string_of_bool v))
256
+
enable_stream_desktop_notifications;
257
+
Option.map
258
+
(fun v -> ("enable_stream_email_notifications", string_of_bool v))
259
+
enable_stream_email_notifications;
260
+
Option.map
261
+
(fun v -> ("enable_stream_push_notifications", string_of_bool v))
262
+
enable_stream_push_notifications;
263
+
Option.map
264
+
(fun v -> ("enable_stream_audible_notifications", string_of_bool v))
265
+
enable_stream_audible_notifications;
266
+
Option.map (fun v -> ("notification_sound", v)) notification_sound;
267
+
Option.map
268
+
(fun v -> ("enable_desktop_notifications", string_of_bool v))
269
+
enable_desktop_notifications;
270
+
Option.map (fun v -> ("enable_sounds", string_of_bool v)) enable_sounds;
271
+
Option.map
272
+
(fun v ->
273
+
("email_notifications_batching_period_seconds", string_of_int v))
274
+
email_notifications_batching_period_seconds;
275
+
Option.map
276
+
(fun v -> ("enable_offline_email_notifications", string_of_bool v))
277
+
enable_offline_email_notifications;
278
+
Option.map
279
+
(fun v -> ("enable_offline_push_notifications", string_of_bool v))
280
+
enable_offline_push_notifications;
281
+
Option.map
282
+
(fun v -> ("enable_online_push_notifications", string_of_bool v))
283
+
enable_online_push_notifications;
284
+
Option.map
285
+
(fun v -> ("enable_digest_emails", string_of_bool v))
286
+
enable_digest_emails;
287
+
Option.map
288
+
(fun v -> ("enable_marketing_emails", string_of_bool v))
289
+
enable_marketing_emails;
290
+
Option.map
291
+
(fun v -> ("enable_login_emails", string_of_bool v))
292
+
enable_login_emails;
293
+
Option.map
294
+
(fun v ->
295
+
("message_content_in_email_notifications", string_of_bool v))
296
+
message_content_in_email_notifications;
297
+
Option.map
298
+
(fun v -> ("pm_content_in_desktop_notifications", string_of_bool v))
299
+
pm_content_in_desktop_notifications;
300
+
Option.map
301
+
(fun v -> ("wildcard_mentions_notify", string_of_bool v))
302
+
wildcard_mentions_notify;
303
+
Option.map
304
+
(fun v -> ("desktop_icon_count_display", string_of_int v))
305
+
desktop_icon_count_display;
306
+
Option.map
307
+
(fun v -> ("realm_name_in_notifications", string_of_bool v))
308
+
realm_name_in_notifications;
309
+
Option.map
310
+
(fun v -> ("presence_enabled", string_of_bool v))
311
+
presence_enabled;
312
+
Option.map (fun v -> ("enter_sends", string_of_bool v)) enter_sends;
313
+
]
314
+
in
315
+
Client.request client ~method_:`PATCH ~path:"/api/v1/settings" ~params ()
316
+
317
+
let get_attachments client =
318
+
Client.request client ~method_:`GET ~path:"/api/v1/attachments" ()
319
+
320
+
let delete_attachment client ~attachment_id =
321
+
let _response =
322
+
Client.request client ~method_:`DELETE
323
+
~path:("/api/v1/attachments/" ^ string_of_int attachment_id)
324
+
()
325
+
in
326
+
()
327
+
328
+
let get_muted_users client =
329
+
let response_codec =
330
+
Jsont.Object.(
331
+
map ~kind:"MutedUsersResponse" Fun.id
332
+
|> mem "muted_users"
333
+
(Jsont.list
334
+
Jsont.Object.(
335
+
map ~kind:"MutedUser" (fun id _ts -> id)
336
+
|> mem "id" Jsont.int ~enc:Fun.id
337
+
|> mem "timestamp" Jsont.int ~dec_absent:0 ~enc:(Fun.const 0)
338
+
|> finish))
339
+
~enc:Fun.id
340
+
|> finish)
341
+
in
342
+
let json =
343
+
Client.request client ~method_:`GET ~path:"/api/v1/users/me/muted_users" ()
344
+
in
345
+
Error.decode_or_raise response_codec json "getting muted users"
346
+
347
+
let mute_user client ~user_id =
348
+
let _response =
349
+
Client.request client ~method_:`POST
350
+
~path:("/api/v1/users/me/muted_users/" ^ string_of_int user_id)
351
+
()
352
+
in
353
+
()
354
+
355
+
let unmute_user client ~user_id =
356
+
let _response =
357
+
Client.request client ~method_:`DELETE
358
+
~path:("/api/v1/users/me/muted_users/" ^ string_of_int user_id)
359
+
()
360
+
in
361
+
()
+196
lib/zulip/users.mli
+196
lib/zulip/users.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** User operations for the Zulip API.
7
+
8
+
All functions raise [Eio.Io] with [Error.E error] on failure. Context is
9
+
automatically added indicating the operation being performed. *)
10
+
11
+
(** {1 Listing Users} *)
12
+
13
+
val list : Client.t -> User.t list
14
+
(** List all users in the organization.
15
+
@raise Eio.Io on failure *)
16
+
17
+
val list_all :
18
+
Client.t ->
19
+
?client_gravatar:bool ->
20
+
?include_custom_profile_fields:bool ->
21
+
unit ->
22
+
User.t list
23
+
(** List all users with additional options.
24
+
25
+
@param client_gravatar Whether to include gravatar URLs
26
+
@param include_custom_profile_fields Whether to include custom profile data
27
+
@raise Eio.Io on failure *)
28
+
29
+
(** {1 User Lookup} *)
30
+
31
+
val get : Client.t -> email:string -> User.t
32
+
(** Get a user by email address.
33
+
@raise Eio.Io on failure *)
34
+
35
+
val get_by_id :
36
+
Client.t ->
37
+
user_id:int ->
38
+
?include_custom_profile_fields:bool ->
39
+
unit ->
40
+
User.t
41
+
(** Get a user by their numeric ID.
42
+
@raise Eio.Io on failure *)
43
+
44
+
(** {1 Current User} *)
45
+
46
+
val me : Client.t -> User.t
47
+
(** Get the currently authenticated user's profile.
48
+
@raise Eio.Io on failure *)
49
+
50
+
val me_pointer : Client.t -> int
51
+
(** Get the current user's message read pointer.
52
+
@raise Eio.Io on failure *)
53
+
54
+
val update_me_pointer : Client.t -> pointer:int -> unit
55
+
(** Update the current user's message read pointer.
56
+
@raise Eio.Io on failure *)
57
+
58
+
(** {1 Creating Users} *)
59
+
60
+
val create :
61
+
Client.t -> email:string -> full_name:string -> password:string -> unit
62
+
(** Create a new user.
63
+
@raise Eio.Io on failure *)
64
+
65
+
(** {1 Updating Users} *)
66
+
67
+
val update :
68
+
Client.t -> user_id:int -> ?full_name:string -> ?role:int -> unit -> unit
69
+
(** Update a user's profile.
70
+
@raise Eio.Io on failure *)
71
+
72
+
(** {1 Deactivating/Reactivating Users} *)
73
+
74
+
val deactivate : Client.t -> user_id:int -> unit
75
+
(** Deactivate a user account by user ID.
76
+
@raise Eio.Io on failure *)
77
+
78
+
val reactivate : Client.t -> user_id:int -> unit
79
+
(** Reactivate a deactivated user account.
80
+
@raise Eio.Io on failure *)
81
+
82
+
(** {1 Alert Words} *)
83
+
84
+
val get_alert_words : Client.t -> string list
85
+
(** Get the current user's alert words.
86
+
@raise Eio.Io on failure *)
87
+
88
+
val add_alert_words : Client.t -> words:string list -> string list
89
+
(** Add alert words for the current user.
90
+
@return The updated list of alert words
91
+
@raise Eio.Io on failure *)
92
+
93
+
val remove_alert_words : Client.t -> words:string list -> string list
94
+
(** Remove alert words for the current user.
95
+
@return The updated list of alert words
96
+
@raise Eio.Io on failure *)
97
+
98
+
(** {1 User Status} *)
99
+
100
+
type status_emoji = {
101
+
emoji_name : string;
102
+
emoji_code : string option;
103
+
reaction_type : string option;
104
+
}
105
+
(** User status types. *)
106
+
107
+
val get_status : Client.t -> user_id:int -> Jsont.json
108
+
(** Get a user's status.
109
+
@raise Eio.Io on failure *)
110
+
111
+
val update_status :
112
+
Client.t ->
113
+
?status_text:string ->
114
+
?away:bool ->
115
+
?emoji:status_emoji ->
116
+
unit ->
117
+
unit
118
+
(** Update the current user's status.
119
+
@raise Eio.Io on failure *)
120
+
121
+
(** {1 User Settings} *)
122
+
123
+
val get_settings : Client.t -> Jsont.json
124
+
(** Get the current user's settings.
125
+
@raise Eio.Io on failure *)
126
+
127
+
val update_settings :
128
+
Client.t ->
129
+
?full_name:string ->
130
+
?email:string ->
131
+
?old_password:string ->
132
+
?new_password:string ->
133
+
?twenty_four_hour_time:bool ->
134
+
?dense_mode:bool ->
135
+
?starred_message_counts:bool ->
136
+
?fluid_layout_width:bool ->
137
+
?high_contrast_mode:bool ->
138
+
?color_scheme:int ->
139
+
?translate_emoticons:bool ->
140
+
?default_language:string ->
141
+
?default_view:string ->
142
+
?escape_navigates_to_default_view:bool ->
143
+
?left_side_userlist:bool ->
144
+
?emojiset:string ->
145
+
?demote_inactive_streams:int ->
146
+
?timezone:string ->
147
+
?enable_stream_desktop_notifications:bool ->
148
+
?enable_stream_email_notifications:bool ->
149
+
?enable_stream_push_notifications:bool ->
150
+
?enable_stream_audible_notifications:bool ->
151
+
?notification_sound:string ->
152
+
?enable_desktop_notifications:bool ->
153
+
?enable_sounds:bool ->
154
+
?email_notifications_batching_period_seconds:int ->
155
+
?enable_offline_email_notifications:bool ->
156
+
?enable_offline_push_notifications:bool ->
157
+
?enable_online_push_notifications:bool ->
158
+
?enable_digest_emails:bool ->
159
+
?enable_marketing_emails:bool ->
160
+
?enable_login_emails:bool ->
161
+
?message_content_in_email_notifications:bool ->
162
+
?pm_content_in_desktop_notifications:bool ->
163
+
?wildcard_mentions_notify:bool ->
164
+
?desktop_icon_count_display:int ->
165
+
?realm_name_in_notifications:bool ->
166
+
?presence_enabled:bool ->
167
+
?enter_sends:bool ->
168
+
unit ->
169
+
Jsont.json
170
+
(** Update the current user's settings.
171
+
@return JSON with the updated settings
172
+
@raise Eio.Io on failure *)
173
+
174
+
(** {1 Attachments} *)
175
+
176
+
val get_attachments : Client.t -> Jsont.json
177
+
(** Get all attachments uploaded by the current user.
178
+
@raise Eio.Io on failure *)
179
+
180
+
val delete_attachment : Client.t -> attachment_id:int -> unit
181
+
(** Delete an attachment.
182
+
@raise Eio.Io on failure *)
183
+
184
+
(** {1 Muted Users} *)
185
+
186
+
val get_muted_users : Client.t -> int list
187
+
(** Get the list of muted user IDs.
188
+
@raise Eio.Io on failure *)
189
+
190
+
val mute_user : Client.t -> user_id:int -> unit
191
+
(** Mute a user.
192
+
@raise Eio.Io on failure *)
193
+
194
+
val unmute_user : Client.t -> user_id:int -> unit
195
+
(** Unmute a user.
196
+
@raise Eio.Io on failure *)
+32
lib/zulip/zulip.ml
+32
lib/zulip/zulip.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Main module for Zulip OCaml API bindings *)
7
+
8
+
type json = Jsont.json
9
+
10
+
module Error = Error
11
+
(** Re-export all submodules *)
12
+
13
+
module Auth = Auth
14
+
module Client = Client
15
+
module Message = Message
16
+
module Message_type = Message_type
17
+
module Message_response = Message_response
18
+
module Message_flag = Message_flag
19
+
module Messages = Messages
20
+
module Narrow = Narrow
21
+
module Channel = Channel
22
+
module Channels = Channels
23
+
module User = User
24
+
module Users = Users
25
+
module User_group = User_group
26
+
module Presence = Presence
27
+
module Event = Event
28
+
module Event_type = Event_type
29
+
module Event_queue = Event_queue
30
+
module Typing = Typing
31
+
module Server = Server
32
+
module Encode = Encode
+142
lib/zulip/zulip.mli
+142
lib/zulip/zulip.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Zulip API client library for OCaml.
7
+
8
+
This module provides a comprehensive interface to the Zulip REST API, with
9
+
support for messages, channels, users, and real-time events.
10
+
11
+
{1 Quick Start}
12
+
13
+
{[
14
+
(* Create a client *)
15
+
let auth = Zulip.Auth.from_zuliprc () in
16
+
Zulip.Client.with_client env auth (fun client ->
17
+
(* Send a message *)
18
+
let msg = Zulip.Message.create
19
+
~type_:`Channel ~to_:["general"]
20
+
~content:"Hello from OCaml!" ~topic:"greetings" ()
21
+
in
22
+
let _ = Zulip.Messages.send client msg in
23
+
24
+
(* Get recent messages *)
25
+
let narrow = Zulip.Narrow.[stream "general"; topic "greetings"] in
26
+
let messages = Zulip.Messages.get_messages client
27
+
~anchor:Newest ~num_before:10 ~narrow ()
28
+
in
29
+
(* ... *)
30
+
)
31
+
]}
32
+
33
+
{1 Error Handling}
34
+
35
+
Errors are raised as [Eio.Io] exceptions with [Error.E error], following the
36
+
Eio error pattern (like [Eio.Net.E] and [Eio.Fs.E]). This provides
37
+
context-aware error handling with automatic context accumulation as errors
38
+
propagate up the call stack.
39
+
40
+
Example:
41
+
{[
42
+
try Client.request client ~method_:`GET ~path:"/api/v1/users" () with
43
+
| Eio.Io (Error.E { code = Invalid_api_key; message; _ }, _) ->
44
+
(* Handle authentication error *)
45
+
Log.err (fun m -> m "Auth failed: %s" message)
46
+
| Eio.Io _ as ex ->
47
+
(* Re-raise with additional context *)
48
+
let bt = Printexc.get_raw_backtrace () in
49
+
Eio.Exn.reraise_with_context ex bt "fetching user list"
50
+
]} *)
51
+
52
+
(** {1 Core Types} *)
53
+
54
+
type json = Jsont.json
55
+
(** JSON type used throughout the API. *)
56
+
57
+
(** {1 Error Handling} *)
58
+
59
+
module Error = Error
60
+
(** API error types and handling. *)
61
+
62
+
(** {1 Authentication} *)
63
+
64
+
module Auth = Auth
65
+
(** Authentication credentials management. *)
66
+
67
+
(** {1 Client} *)
68
+
69
+
module Client = Client
70
+
(** HTTP client for making API requests. *)
71
+
72
+
(** {1 Messages} *)
73
+
74
+
module Message = Message
75
+
(** Outgoing message construction. *)
76
+
77
+
module Message_type = Message_type
78
+
(** Message type (channel vs direct). *)
79
+
80
+
module Message_response = Message_response
81
+
(** Response from sending a message. *)
82
+
83
+
module Message_flag = Message_flag
84
+
(** Message flags (read, starred, etc.). *)
85
+
86
+
module Messages = Messages
87
+
(** Message operations (send, get, edit, delete, reactions). *)
88
+
89
+
(** {1 Narrow Filters} *)
90
+
91
+
module Narrow = Narrow
92
+
(** Type-safe message query filters. *)
93
+
94
+
(** {1 Channels (Streams)} *)
95
+
96
+
module Channel = Channel
97
+
(** Channel/stream type and properties. *)
98
+
99
+
module Channels = Channels
100
+
(** Channel operations (create, subscribe, topics). *)
101
+
102
+
(** {1 Users} *)
103
+
104
+
module User = User
105
+
(** User type and properties. *)
106
+
107
+
module Users = Users
108
+
(** User operations (list, get, create, status). *)
109
+
110
+
module User_group = User_group
111
+
(** User groups and membership. *)
112
+
113
+
(** {1 Presence} *)
114
+
115
+
module Presence = Presence
116
+
(** User presence/online status. *)
117
+
118
+
(** {1 Events} *)
119
+
120
+
module Event = Event
121
+
(** Event records from the event queue. *)
122
+
123
+
module Event_type = Event_type
124
+
(** Event type enumeration. *)
125
+
126
+
module Event_queue = Event_queue
127
+
(** Event queue management and polling. *)
128
+
129
+
(** {1 Typing Notifications} *)
130
+
131
+
module Typing = Typing
132
+
(** Typing start/stop notifications. *)
133
+
134
+
(** {1 Server Information} *)
135
+
136
+
module Server = Server
137
+
(** Server settings, linkifiers, emoji, profile fields. *)
138
+
139
+
(** {1 Utilities} *)
140
+
141
+
module Encode = Encode
142
+
(** JSON encoding/decoding utilities. *)
+177
lib/zulip_bot/bot.ml
+177
lib/zulip_bot/bot.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let src = Logs.Src.create "zulip_bot.bot" ~doc:"Zulip bot runner"
7
+
8
+
module Log = (val Logs.src_log src : Logs.LOG)
9
+
10
+
type identity = { user_id : int; email : string; full_name : string }
11
+
type handler = storage:Storage.t -> identity:identity -> Message.t -> Response.t
12
+
13
+
let create_client ~sw ~env ~config =
14
+
let auth =
15
+
Zulip.Auth.create ~server_url:config.Config.site ~email:config.Config.email
16
+
~api_key:config.Config.api_key
17
+
in
18
+
Zulip.Client.create ~sw env auth
19
+
20
+
let fetch_identity client =
21
+
let user = Zulip.Users.me client in
22
+
{
23
+
user_id = Zulip.User.user_id user |> Option.value ~default:0;
24
+
email = Zulip.User.email user;
25
+
full_name = Zulip.User.full_name user;
26
+
}
27
+
28
+
let send_response client ~in_reply_to response =
29
+
match response with
30
+
| Response.Reply content ->
31
+
let message_to_send =
32
+
if Message.is_private in_reply_to then
33
+
let sender = Message.sender_email in_reply_to in
34
+
Zulip.Message.create ~type_:`Direct ~to_:[ sender ] ~content ()
35
+
else
36
+
let reply_to = Message.get_reply_to in_reply_to in
37
+
let topic =
38
+
match in_reply_to with
39
+
| Message.Stream { subject; _ } -> Some subject
40
+
| _ -> None
41
+
in
42
+
Zulip.Message.create ~type_:`Channel ~to_:[ reply_to ] ~content ?topic
43
+
()
44
+
in
45
+
let resp = Zulip.Messages.send client message_to_send in
46
+
Log.info (fun m ->
47
+
m "Reply sent (id: %d)" (Zulip.Message_response.id resp))
48
+
| Response.Direct { recipients; content } ->
49
+
let message_to_send =
50
+
Zulip.Message.create ~type_:`Direct ~to_:recipients ~content ()
51
+
in
52
+
let resp = Zulip.Messages.send client message_to_send in
53
+
Log.info (fun m ->
54
+
m "Direct message sent (id: %d)" (Zulip.Message_response.id resp))
55
+
| Response.Stream { stream; topic; content } ->
56
+
let message_to_send =
57
+
Zulip.Message.create ~type_:`Channel ~to_:[ stream ] ~topic ~content ()
58
+
in
59
+
let resp = Zulip.Messages.send client message_to_send in
60
+
Log.info (fun m ->
61
+
m "Stream message sent (id: %d)" (Zulip.Message_response.id resp))
62
+
| Response.Silent -> Log.debug (fun m -> m "Handler returned silent response")
63
+
64
+
let process_event ~client ~storage ~identity ~handler event =
65
+
Log.debug (fun m ->
66
+
m "Processing event type: %s"
67
+
(Zulip.Event_type.to_string (Zulip.Event.type_ event)));
68
+
match Zulip.Event.type_ event with
69
+
| Zulip.Event_type.Message -> (
70
+
let event_data = Zulip.Event.data event in
71
+
let message_json, flags =
72
+
match event_data with
73
+
| Jsont.Object (fields, _) ->
74
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
75
+
let msg =
76
+
List.assoc_opt "message" assoc |> Option.value ~default:event_data
77
+
in
78
+
let flgs =
79
+
List.assoc_opt "flags" assoc
80
+
|> Option.fold ~none:[] ~some:(function
81
+
| Jsont.Array (f, _) -> f
82
+
| _ -> [])
83
+
in
84
+
(msg, flgs)
85
+
| _ -> (event_data, [])
86
+
in
87
+
match Message.of_json message_json with
88
+
| Error err ->
89
+
Log.err (fun m -> m "Failed to parse message JSON: %s" err);
90
+
Log.debug (fun m -> m "@[%a@]" Message.pp_json_debug message_json)
91
+
| Ok message ->
92
+
Log.info (fun m ->
93
+
m "@[<h>%a@]" (Message.pp_ansi ~show_json:false) message);
94
+
let is_mentioned =
95
+
List.exists
96
+
(function Jsont.String ("mentioned", _) -> true | _ -> false)
97
+
flags
98
+
|| Message.is_mentioned message ~user_email:identity.email
99
+
in
100
+
let is_private = Message.is_private message in
101
+
let is_from_self =
102
+
Message.is_from_email message ~email:identity.email
103
+
in
104
+
Log.debug (fun m ->
105
+
m "Message check: mentioned=%b, private=%b, from_self=%b"
106
+
is_mentioned is_private is_from_self);
107
+
if (is_mentioned || is_private) && not is_from_self then (
108
+
Log.info (fun m -> m "Bot should respond to this message");
109
+
try
110
+
let response = handler ~storage ~identity message in
111
+
send_response client ~in_reply_to:message response
112
+
with Eio.Exn.Io (e, _) ->
113
+
Log.err (fun m -> m "Error handling message: %a" Eio.Exn.pp_err e))
114
+
else
115
+
Log.debug (fun m ->
116
+
m "Not processing (not mentioned and not private)"))
117
+
| _ -> ()
118
+
119
+
let run ~sw ~env ~config ~handler =
120
+
Log.info (fun m -> m "Starting bot: %s" config.Config.name);
121
+
let client = create_client ~sw ~env ~config in
122
+
let identity = fetch_identity client in
123
+
let storage = Storage.create client in
124
+
Log.info (fun m ->
125
+
m "Bot identity: %s <%s> (id: %d)" identity.full_name identity.email
126
+
identity.user_id);
127
+
let queue =
128
+
Zulip.Event_queue.register client
129
+
~event_types:[ Zulip.Event_type.Message ]
130
+
()
131
+
in
132
+
Log.info (fun m ->
133
+
m "Event queue registered: %s" (Zulip.Event_queue.id queue));
134
+
let rec event_loop last_event_id =
135
+
try
136
+
let events =
137
+
Zulip.Event_queue.get_events queue client ~last_event_id ()
138
+
in
139
+
if List.length events > 0 then
140
+
Log.info (fun m -> m "Received %d event(s)" (List.length events));
141
+
List.iter
142
+
(fun event ->
143
+
Log.debug (fun m ->
144
+
m "Event id=%d, type=%s" (Zulip.Event.id event)
145
+
(Zulip.Event_type.to_string (Zulip.Event.type_ event)));
146
+
process_event ~client ~storage ~identity ~handler event)
147
+
events;
148
+
let new_last_id =
149
+
List.fold_left
150
+
(fun max_id event -> max (Zulip.Event.id event) max_id)
151
+
last_event_id events
152
+
in
153
+
event_loop new_last_id
154
+
with Eio.Exn.Io (e, _) ->
155
+
Log.warn (fun m ->
156
+
m "Error getting events: %a (retrying in 2s)" Eio.Exn.pp_err e);
157
+
Eio.Time.sleep env#clock 2.0;
158
+
event_loop last_event_id
159
+
in
160
+
event_loop (-1)
161
+
162
+
let handle_webhook ~sw ~env ~config ~handler ~payload =
163
+
let client = create_client ~sw ~env ~config in
164
+
let identity = fetch_identity client in
165
+
let storage = Storage.create client in
166
+
match Jsont_bytesrw.decode_string Jsont.json payload with
167
+
| Error _ ->
168
+
Log.err (fun m -> m "Failed to parse webhook payload as JSON");
169
+
None
170
+
| Ok json -> (
171
+
match Message.of_json json with
172
+
| Error err ->
173
+
Log.err (fun m -> m "Failed to parse webhook message: %s" err);
174
+
None
175
+
| Ok message ->
176
+
let response = handler ~storage ~identity message in
177
+
Some response)
+144
lib/zulip_bot/bot.mli
+144
lib/zulip_bot/bot.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Fiber-based Zulip bot execution.
7
+
8
+
A bot is simply a function that processes messages. The [run] function
9
+
executes the bot as an Eio fiber, making it easy to compose multiple bots
10
+
using standard Eio concurrency primitives.
11
+
12
+
{b Example: Single bot}
13
+
{[
14
+
let echo_handler ~storage:_ ~identity:_ msg =
15
+
Response.reply ("Echo: " ^ Message.content msg)
16
+
17
+
let () =
18
+
Eio_main.run @@ fun env ->
19
+
Eio.Switch.run @@ fun sw ->
20
+
let fs = Eio.Stdenv.fs env in
21
+
let config = Config.load ~fs "echo-bot" in
22
+
Bot.run ~sw ~env ~config ~handler:echo_handler
23
+
]}
24
+
25
+
{b Example: Multiple bots}
26
+
{[
27
+
let () =
28
+
Eio_main.run @@ fun env ->
29
+
Eio.Switch.run @@ fun sw ->
30
+
let fs = Eio.Stdenv.fs env in
31
+
32
+
Eio.Fiber.all
33
+
[
34
+
(fun () ->
35
+
Bot.run ~sw ~env
36
+
~config:(Config.load ~fs "echo-bot")
37
+
~handler:echo_handler);
38
+
(fun () ->
39
+
Bot.run ~sw ~env
40
+
~config:(Config.load ~fs "help-bot")
41
+
~handler:help_handler);
42
+
]
43
+
]} *)
44
+
45
+
(** {1 Types} *)
46
+
47
+
type identity = {
48
+
user_id : int; (** Bot's user ID on the server *)
49
+
email : string; (** Bot's email address *)
50
+
full_name : string; (** Bot's display name *)
51
+
}
52
+
(** Bot identity information retrieved from Zulip. *)
53
+
54
+
type handler = storage:Storage.t -> identity:identity -> Message.t -> Response.t
55
+
(** Handler function signature.
56
+
57
+
A handler receives:
58
+
- [storage]: Key-value storage via Zulip's bot storage API
59
+
- [identity]: The bot's identity (email, name, user_id)
60
+
- The incoming [Message.t]
61
+
62
+
And returns a [Response.t] indicating what action to take. *)
63
+
64
+
(** {1 Running Bots} *)
65
+
66
+
val run :
67
+
sw:Eio.Switch.t ->
68
+
env:
69
+
< clock : float Eio.Time.clock_ty Eio.Resource.t
70
+
; net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t
71
+
; fs : Eio.Fs.dir_ty Eio.Path.t
72
+
; .. > ->
73
+
config:Config.t ->
74
+
handler:handler ->
75
+
unit
76
+
(** [run ~sw ~env ~config ~handler] runs a bot as a fiber.
77
+
78
+
The bot connects to Zulip's real-time events API and processes incoming
79
+
messages. It runs until the switch is cancelled.
80
+
81
+
The bot will:
82
+
- Register for message events with Zulip
83
+
- Process private messages and messages that mention the bot
84
+
- Ignore messages from itself
85
+
- Send responses back via the Zulip API
86
+
- Automatically reconnect with exponential backoff on errors
87
+
88
+
@param sw Eio switch controlling the bot's lifetime
89
+
@param env Eio environment with clock, net, and fs capabilities
90
+
@param config Bot configuration (credentials and metadata)
91
+
@param handler Function to process incoming messages *)
92
+
93
+
(** {1 Webhook Mode} *)
94
+
95
+
val handle_webhook :
96
+
sw:Eio.Switch.t ->
97
+
env:
98
+
< clock : float Eio.Time.clock_ty Eio.Resource.t
99
+
; net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t
100
+
; fs : Eio.Fs.dir_ty Eio.Path.t
101
+
; .. > ->
102
+
config:Config.t ->
103
+
handler:handler ->
104
+
payload:string ->
105
+
Response.t option
106
+
(** [handle_webhook ~sw ~env ~config ~handler ~payload] processes a single
107
+
webhook payload.
108
+
109
+
For webhook-based deployments, provide your own HTTP server and call this
110
+
function to process incoming webhook payloads from Zulip.
111
+
112
+
Returns [Some response] if the message was processed, [None] if the payload
113
+
could not be parsed or should not be handled. *)
114
+
115
+
val send_response :
116
+
Zulip.Client.t -> in_reply_to:Message.t -> Response.t -> unit
117
+
(** [send_response client ~in_reply_to response] sends a response via the Zulip
118
+
API.
119
+
120
+
Utility function for webhook mode to send responses after processing. The
121
+
[in_reply_to] message is used to determine the reply context (stream/topic
122
+
or private message recipients). *)
123
+
124
+
(** {1 Utilities} *)
125
+
126
+
val create_client :
127
+
sw:Eio.Switch.t ->
128
+
env:
129
+
< clock : float Eio.Time.clock_ty Eio.Resource.t
130
+
; net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t
131
+
; fs : Eio.Fs.dir_ty Eio.Path.t
132
+
; .. > ->
133
+
config:Config.t ->
134
+
Zulip.Client.t
135
+
(** [create_client ~sw ~env ~config] creates a Zulip client from bot
136
+
configuration.
137
+
138
+
Useful when you need direct access to the Zulip API beyond what the bot
139
+
framework provides. *)
140
+
141
+
val fetch_identity : Zulip.Client.t -> identity
142
+
(** [fetch_identity client] retrieves the bot's identity from the Zulip server.
143
+
144
+
@raise Eio.Io on API errors *)
+194
lib/zulip_bot/cmd.ml
+194
lib/zulip_bot/cmd.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Cmdliner
7
+
8
+
let src = Logs.Src.create "zulip_bot.cmd" ~doc:"Zulip bot cmdliner integration"
9
+
10
+
module Log = (val Logs.src_log src : Logs.LOG)
11
+
12
+
type source = Default | Env of string | Config | Cmdline
13
+
type 'a with_source = { value : 'a; source : source }
14
+
15
+
let pp_source ppf = function
16
+
| Default -> Format.fprintf ppf "default"
17
+
| Env var -> Format.fprintf ppf "env(%s)" var
18
+
| Config -> Format.fprintf ppf "config"
19
+
| Cmdline -> Format.fprintf ppf "cmdline"
20
+
21
+
let pp_with_source pp_val ppf ws =
22
+
Format.fprintf ppf "%a [%a]" pp_val ws.value pp_source ws.source
23
+
24
+
(** Check environment variable and track source *)
25
+
let check_env_bool ~env_var ~default =
26
+
match Sys.getenv_opt env_var with
27
+
| Some v
28
+
when String.lowercase_ascii v = "1" || String.lowercase_ascii v = "true" ->
29
+
{ value = true; source = Env env_var }
30
+
| Some v
31
+
when String.lowercase_ascii v = "0" || String.lowercase_ascii v = "false" ->
32
+
{ value = false; source = Env env_var }
33
+
| Some _ | None -> { value = default; source = Default }
34
+
35
+
let parse_log_level s =
36
+
match String.lowercase_ascii s with
37
+
| "debug" -> Some Logs.Debug
38
+
| "info" -> Some Logs.Info
39
+
| "warning" | "warn" -> Some Logs.Warning
40
+
| "error" | "err" -> Some Logs.Error
41
+
| "app" -> Some Logs.App
42
+
| _ -> None
43
+
44
+
(* Individual terms *)
45
+
46
+
let name_term default_name =
47
+
let doc = "Bot name (used for XDG paths and identification)" in
48
+
Arg.(value & opt string default_name & info [ "n"; "name" ] ~docv:"NAME" ~doc)
49
+
50
+
let config_file_term =
51
+
let doc = "Path to .zuliprc configuration file" in
52
+
Arg.(
53
+
value & opt (some string) None & info [ "c"; "config" ] ~docv:"FILE" ~doc)
54
+
55
+
let verbosity_term =
56
+
let doc =
57
+
"Increase verbosity (-v for debug). Can also use ZULIP_LOG_LEVEL env var."
58
+
in
59
+
let cmdline_arg = Arg.(value & flag_all & info [ "v"; "verbose" ] ~doc) in
60
+
Term.(
61
+
const (fun flags ->
62
+
match List.length flags with
63
+
| 0 -> (
64
+
(* Check environment *)
65
+
match Sys.getenv_opt "ZULIP_LOG_LEVEL" with
66
+
| Some v -> (
67
+
match parse_log_level v with
68
+
| Some lvl -> { value = lvl; source = Env "ZULIP_LOG_LEVEL" }
69
+
| None -> { value = Logs.Info; source = Default })
70
+
| None -> { value = Logs.Info; source = Default })
71
+
| _ -> { value = Logs.Debug; source = Cmdline })
72
+
$ cmdline_arg)
73
+
74
+
let verbose_http_term app_name =
75
+
let doc = "Enable verbose HTTP-level logging (hexdumps, TLS details)" in
76
+
let env_name = String.uppercase_ascii app_name ^ "_VERBOSE_HTTP" in
77
+
let env_info = Cmdliner.Cmd.Env.info env_name in
78
+
let cmdline_arg =
79
+
Arg.(value & flag & info [ "verbose-http" ] ~env:env_info ~doc)
80
+
in
81
+
Term.(
82
+
const (fun cmdline ->
83
+
if cmdline then { value = true; source = Cmdline }
84
+
else check_env_bool ~env_var:env_name ~default:false)
85
+
$ cmdline_arg)
86
+
87
+
(* Logging setup *)
88
+
89
+
let setup_logging ?(verbose_http = false) level =
90
+
Logs.set_reporter (Logs_fmt.reporter ());
91
+
Logs.set_level (Some level);
92
+
93
+
(* Set bot-level sources *)
94
+
Logs.Src.set_level src (Some level);
95
+
96
+
(* Set zulip_bot sources based on level *)
97
+
List.iter
98
+
(fun s ->
99
+
if
100
+
String.starts_with ~prefix:"zulip_bot" (Logs.Src.name s)
101
+
|| String.starts_with ~prefix:"zulip" (Logs.Src.name s)
102
+
then Logs.Src.set_level s (Some level))
103
+
(Logs.Src.list ());
104
+
105
+
(* HTTP-level verbose logging (if requested) *)
106
+
if verbose_http then (
107
+
(* Enable requests library debug logging *)
108
+
List.iter
109
+
(fun s ->
110
+
if String.starts_with ~prefix:"requests" (Logs.Src.name s) then
111
+
Logs.Src.set_level s (Some Logs.Debug))
112
+
(Logs.Src.list ());
113
+
(* Enable TLS tracing if available *)
114
+
match
115
+
List.find_opt
116
+
(fun s -> Logs.Src.name s = "tls.tracing")
117
+
(Logs.Src.list ())
118
+
with
119
+
| Some tls_src -> Logs.Src.set_level tls_src (Some Logs.Debug)
120
+
| None -> ())
121
+
else
122
+
(* Suppress noisy HTTP logging when not verbose *)
123
+
List.iter
124
+
(fun s ->
125
+
if
126
+
String.starts_with ~prefix:"requests" (Logs.Src.name s)
127
+
|| Logs.Src.name s = "tls.tracing"
128
+
then Logs.Src.set_level s (Some Logs.Warning))
129
+
(Logs.Src.list ())
130
+
131
+
(* Load configuration from various sources *)
132
+
let load_config ~fs ~name ~config_file =
133
+
match config_file with
134
+
| Some path ->
135
+
(* Load from .zuliprc style file for backwards compatibility *)
136
+
let auth = Zulip.Auth.from_zuliprc ~path () in
137
+
Config.create ~name
138
+
~site:(Zulip.Auth.server_url auth)
139
+
~email:(Zulip.Auth.email auth)
140
+
~api_key:(Zulip.Auth.api_key auth)
141
+
()
142
+
| None -> (
143
+
(* Try XDG config first, fall back to ~/.zuliprc *)
144
+
try Config.load ~fs name
145
+
with _ ->
146
+
let auth = Zulip.Auth.from_zuliprc () in
147
+
Config.create ~name
148
+
~site:(Zulip.Auth.server_url auth)
149
+
~email:(Zulip.Auth.email auth)
150
+
~api_key:(Zulip.Auth.api_key auth)
151
+
())
152
+
153
+
(* Combined terms *)
154
+
155
+
let config_term default_name env =
156
+
let fs = env#fs in
157
+
Term.(
158
+
const (fun name config_file verbosity verbose_http ->
159
+
setup_logging ~verbose_http:verbose_http.value verbosity.value;
160
+
load_config ~fs ~name ~config_file)
161
+
$ name_term default_name
162
+
$ config_file_term
163
+
$ verbosity_term
164
+
$ verbose_http_term default_name)
165
+
166
+
let run_term default_name eio_env _sw f =
167
+
let open Cmdliner in
168
+
Term.(const f $ config_term default_name eio_env)
169
+
170
+
(* Documentation *)
171
+
172
+
let env_docs app_name =
173
+
let app_upper = String.uppercase_ascii app_name in
174
+
Printf.sprintf
175
+
"## ENVIRONMENT\n\n\
176
+
The following environment variables affect %s:\n\n\
177
+
### Credentials\n\n\
178
+
**ZULIP_%s_SITE**\n\
179
+
: Zulip server URL (e.g., https://chat.zulip.org)\n\n\
180
+
**ZULIP_%s_EMAIL**\n\
181
+
: Bot email address\n\n\
182
+
**ZULIP_%s_API_KEY**\n\
183
+
: Bot API key\n\n\
184
+
### Logging\n\n\
185
+
**ZULIP_LOG_LEVEL**\n\
186
+
: Log level: debug, info, warning, error (default: info)\n\n\
187
+
**%s_VERBOSE_HTTP**\n\
188
+
: Set to '1' to enable verbose HTTP-level logging\n\n\
189
+
### XDG Directories\n\n\
190
+
Configuration is loaded from XDG config directory:\n\
191
+
- [$XDG_CONFIG_HOME/zulip-bot/%s/config] (typically \
192
+
[~/.config/zulip-bot/%s/config])\n\n\
193
+
Or from a legacy [.zuliprc] file in the home directory.\n"
194
+
app_name app_upper app_upper app_upper app_upper app_name app_name
+122
lib/zulip_bot/cmd.mli
+122
lib/zulip_bot/cmd.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Cmdliner integration for Zulip bots.
7
+
8
+
This module provides command-line argument handling for Zulip bot
9
+
configuration, including bot name, credentials, logging levels, and HTTP
10
+
settings.
11
+
12
+
{b Configuration Sources (in precedence order):}
13
+
+ Command-line arguments (highest priority)
14
+
+ Application-specific environment variables (e.g., [ZULIP_MYBOT_SITE])
15
+
+ XDG configuration file ([~/.config/zulip-bot/<name>/config])
16
+
+ Legacy [.zuliprc] file
17
+
+ Default values
18
+
19
+
{b Example usage:}
20
+
{[
21
+
let my_handler ~storage:_ ~identity:_ msg =
22
+
Response.reply ("Hello: " ^ Message.content msg)
23
+
24
+
let () =
25
+
Eio_main.run @@ fun env ->
26
+
Eio.Switch.run @@ fun sw ->
27
+
let run config = Bot.run ~sw ~env ~config ~handler:my_handler in
28
+
let cmd = Cmd.v info Term.(const run $ Zulip_bot.Cmd.config_term "mybot" env) in
29
+
Cmdliner.Cmd.eval cmd
30
+
]} *)
31
+
32
+
(** {1 Source Tracking} *)
33
+
34
+
type source =
35
+
| Default (** Value from hardcoded default *)
36
+
| Env of string (** Value from environment variable (stores var name) *)
37
+
| Config (** Value from XDG config file or .zuliprc *)
38
+
| Cmdline (** Value from command-line argument *)
39
+
40
+
type 'a with_source = { value : 'a; source : source }
41
+
(** Wrapper for values with source tracking. *)
42
+
43
+
(** {1 Individual Terms} *)
44
+
45
+
val name_term : string -> string Cmdliner.Term.t
46
+
(** [name_term default_name] creates a term for [--name NAME].
47
+
48
+
The bot name is used to locate XDG configuration files and for logging. *)
49
+
50
+
val config_file_term : string option Cmdliner.Term.t
51
+
(** Term for [--config FILE] option.
52
+
53
+
Provides a path to a [.zuliprc]-style configuration file. If not provided,
54
+
the bot will use XDG configuration or environment variables. *)
55
+
56
+
val verbosity_term : Logs.level with_source Cmdliner.Term.t
57
+
(** Term for [-v] / [--verbose] flags.
58
+
59
+
- No flag: [Logs.Info]
60
+
- One [-v]: [Logs.Debug]
61
+
- Two or more [-v]: [Logs.Debug]
62
+
63
+
Env var: [ZULIP_LOG_LEVEL] (values: debug, info, warning, error) *)
64
+
65
+
val verbose_http_term : string -> bool with_source Cmdliner.Term.t
66
+
(** [verbose_http_term app_name] creates a term for [--verbose-http] flag.
67
+
68
+
Enables verbose HTTP-level logging including hexdumps, TLS details, and
69
+
low-level protocol information. Default is [false] (off).
70
+
71
+
Env var: [{APP_NAME}_VERBOSE_HTTP] *)
72
+
73
+
(** {1 Combined Terms} *)
74
+
75
+
val config_term :
76
+
string ->
77
+
< fs : Eio.Fs.dir_ty Eio.Path.t ; .. > ->
78
+
Config.t Cmdliner.Term.t
79
+
(** [config_term default_name env] creates a complete configuration term.
80
+
81
+
This term combines:
82
+
- Bot name (with default)
83
+
- Optional config file path
84
+
- XDG/environment configuration loading
85
+
- Logging setup
86
+
87
+
The returned [Config.t] is ready to use with [Bot.run]. *)
88
+
89
+
val run_term :
90
+
string ->
91
+
< fs : Eio.Fs.dir_ty Eio.Path.t ; .. > ->
92
+
Eio.Switch.t ->
93
+
(Config.t -> unit) ->
94
+
unit Cmdliner.Term.t
95
+
(** [run_term default_name env sw f] creates a term that runs a bot function.
96
+
97
+
This is a convenience for the common pattern of loading configuration and
98
+
running a bot. The function [f] is called with the loaded configuration. *)
99
+
100
+
(** {1 Logging Setup} *)
101
+
102
+
val setup_logging : ?verbose_http:bool -> Logs.level -> unit
103
+
(** [setup_logging ?verbose_http level] configures the Logs reporter and levels.
104
+
105
+
@param verbose_http If [true], enables verbose HTTP-level logging including
106
+
hexdumps and TLS details. Default is [false].
107
+
@param level The minimum log level to display. *)
108
+
109
+
(** {1 Documentation} *)
110
+
111
+
val pp_source : Format.formatter -> source -> unit
112
+
(** Pretty-print a source type. *)
113
+
114
+
val pp_with_source :
115
+
(Format.formatter -> 'a -> unit) -> Format.formatter -> 'a with_source -> unit
116
+
(** Pretty-print a value with its source. *)
117
+
118
+
val env_docs : string -> string
119
+
(** [env_docs app_name] generates documentation for environment variables.
120
+
121
+
Returns a formatted string documenting all environment variables that affect
122
+
bot configuration for the given application name. *)
+125
lib/zulip_bot/config.ml
+125
lib/zulip_bot/config.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let src = Logs.Src.create "zulip_bot.config" ~doc:"Zulip bot configuration"
7
+
8
+
module Log = (val Logs.src_log src : Logs.LOG)
9
+
10
+
type t = {
11
+
name : string;
12
+
site : string;
13
+
email : string;
14
+
api_key : string;
15
+
description : string option;
16
+
usage : string option;
17
+
}
18
+
19
+
let create ~name ~site ~email ~api_key ?description ?usage () =
20
+
{ name; site; email; api_key; description; usage }
21
+
22
+
(** Convert bot name to environment variable prefix. "my-bot" -> "ZULIP_MY_BOT"
23
+
*)
24
+
let env_prefix name =
25
+
let upper = String.uppercase_ascii name in
26
+
let replaced = String.map (fun c -> if c = '-' then '_' else c) upper in
27
+
"ZULIP_" ^ replaced ^ "_"
28
+
29
+
type ini_config = {
30
+
ini_site : string;
31
+
ini_email : string;
32
+
ini_api_key : string;
33
+
ini_description : string option;
34
+
ini_usage : string option;
35
+
}
36
+
(** INI section record for parsing (without name field) *)
37
+
38
+
(** Codec for parsing the bot section of the config file *)
39
+
let ini_section_codec =
40
+
Init.Section.(
41
+
obj (fun site email api_key description usage ->
42
+
{
43
+
ini_site = site;
44
+
ini_email = email;
45
+
ini_api_key = api_key;
46
+
ini_description = description;
47
+
ini_usage = usage;
48
+
})
49
+
|> mem "site" Init.string ~enc:(fun c -> c.ini_site)
50
+
|> mem "email" Init.string ~enc:(fun c -> c.ini_email)
51
+
|> mem "api_key" Init.string ~enc:(fun c -> c.ini_api_key)
52
+
|> opt_mem "description" Init.string ~enc:(fun c -> c.ini_description)
53
+
|> opt_mem "usage" Init.string ~enc:(fun c -> c.ini_usage)
54
+
|> skip_unknown |> finish)
55
+
56
+
(** Document codec that accepts a [bot] section or bare options at top level *)
57
+
let ini_doc_codec =
58
+
Init.Document.(
59
+
obj (fun bot -> bot)
60
+
|> section "bot" ini_section_codec ~enc:Fun.id
61
+
|> skip_unknown |> finish)
62
+
63
+
(** Codec for configs without section headers (bare key=value pairs) *)
64
+
let bare_section_codec =
65
+
Init.Document.(
66
+
obj (fun defaults -> defaults)
67
+
|> defaults ini_section_codec ~enc:Fun.id
68
+
|> skip_unknown |> finish)
69
+
70
+
let load ~fs name =
71
+
Log.info (fun m -> m "Loading config for bot: %s" name);
72
+
let xdg = Xdge.create fs ("zulip-bot/" ^ name) in
73
+
let config_file = Eio.Path.(Xdge.config_dir xdg / "config") in
74
+
Log.debug (fun m -> m "Looking for config at: %a" Eio.Path.pp config_file);
75
+
(* Try parsing with [bot] section first, fall back to bare config *)
76
+
let ini_config =
77
+
match Init_eio.decode_path ini_doc_codec config_file with
78
+
| Ok c -> c
79
+
| Error _ -> (
80
+
(* Try bare config format (no section headers) *)
81
+
match Init_eio.decode_path bare_section_codec config_file with
82
+
| Ok c -> c
83
+
| Error e -> raise (Init_eio.err e))
84
+
in
85
+
{
86
+
name;
87
+
site = ini_config.ini_site;
88
+
email = ini_config.ini_email;
89
+
api_key = ini_config.ini_api_key;
90
+
description = ini_config.ini_description;
91
+
usage = ini_config.ini_usage;
92
+
}
93
+
94
+
let from_env name =
95
+
Log.info (fun m -> m "Loading config for bot %s from environment" name);
96
+
let prefix = env_prefix name in
97
+
let get_env key = Sys.getenv_opt (prefix ^ key) in
98
+
let get_required key =
99
+
match get_env key with
100
+
| Some v -> v
101
+
| None ->
102
+
failwith
103
+
(Printf.sprintf "Missing required environment variable: %s%s" prefix
104
+
key)
105
+
in
106
+
{
107
+
name;
108
+
site = get_required "SITE";
109
+
email = get_required "EMAIL";
110
+
api_key = get_required "API_KEY";
111
+
description = get_env "DESCRIPTION";
112
+
usage = get_env "USAGE";
113
+
}
114
+
115
+
let load_or_env ~fs name =
116
+
try load ~fs name
117
+
with _ ->
118
+
Log.debug (fun m ->
119
+
m "Config file not found, falling back to environment variables");
120
+
from_env name
121
+
122
+
let xdg ~fs config = Xdge.create fs ("zulip-bot/" ^ config.name)
123
+
let data_dir ~fs config = Xdge.data_dir (xdg ~fs config)
124
+
let state_dir ~fs config = Xdge.state_dir (xdg ~fs config)
125
+
let cache_dir ~fs config = Xdge.cache_dir (xdg ~fs config)
+112
lib/zulip_bot/config.mli
+112
lib/zulip_bot/config.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Bot configuration with XDG Base Directory support.
7
+
8
+
Configuration is loaded from XDG-compliant locations using the bot's name to
9
+
locate the appropriate configuration file. The configuration file should be
10
+
in INI format with the following structure:
11
+
12
+
{v
13
+
[bot]
14
+
site = https://chat.zulip.org
15
+
email = my-bot@chat.zulip.org
16
+
api_key = your_api_key_here
17
+
18
+
# Optional fields
19
+
description = A helpful bot
20
+
usage = @bot help
21
+
v}
22
+
23
+
Configuration files are searched in XDG config directories:
24
+
- [$XDG_CONFIG_HOME/zulip-bot/<name>/config] (typically
25
+
[~/.config/zulip-bot/<name>/config])
26
+
- System directories as fallback
27
+
28
+
Environment variables can override file configuration:
29
+
- [ZULIP_<NAME>_SITE], [ZULIP_<NAME>_EMAIL], [ZULIP_<NAME>_API_KEY]
30
+
31
+
Where [<NAME>] is the uppercase version of the bot name with hyphens
32
+
replaced by underscores. *)
33
+
34
+
type t = {
35
+
name : string; (** Bot name (used for XDG paths and identification) *)
36
+
site : string; (** Zulip server URL *)
37
+
email : string; (** Bot email address *)
38
+
api_key : string; (** Bot API key *)
39
+
description : string option; (** Optional bot description *)
40
+
usage : string option; (** Optional usage help text *)
41
+
}
42
+
(** Bot configuration record. *)
43
+
44
+
val create :
45
+
name:string ->
46
+
site:string ->
47
+
email:string ->
48
+
api_key:string ->
49
+
?description:string ->
50
+
?usage:string ->
51
+
unit ->
52
+
t
53
+
(** [create ~name ~site ~email ~api_key ?description ?usage ()] creates a
54
+
configuration programmatically. *)
55
+
56
+
val load : fs:Eio.Fs.dir_ty Eio.Path.t -> string -> t
57
+
(** [load ~fs name] loads configuration for a named bot from XDG config
58
+
directory.
59
+
60
+
Searches for configuration in:
61
+
- [$XDG_CONFIG_HOME/zulip-bot/<name>/config]
62
+
- System config directories as fallback
63
+
64
+
@param fs The Eio filesystem
65
+
@param name The bot name
66
+
@raise Eio.Io if configuration file cannot be read or parsed
67
+
@raise Failure if required fields are missing *)
68
+
69
+
val from_env : string -> t
70
+
(** [from_env name] loads configuration from environment variables.
71
+
72
+
Reads the following environment variables (where [NAME] is the uppercase bot
73
+
name with hyphens replaced by underscores):
74
+
- [ZULIP_<NAME>_SITE] (required)
75
+
- [ZULIP_<NAME>_EMAIL] (required)
76
+
- [ZULIP_<NAME>_API_KEY] (required)
77
+
- [ZULIP_<NAME>_DESCRIPTION] (optional)
78
+
- [ZULIP_<NAME>_USAGE] (optional)
79
+
80
+
@raise Failure if required environment variables are not set *)
81
+
82
+
val load_or_env : fs:Eio.Fs.dir_ty Eio.Path.t -> string -> t
83
+
(** [load_or_env ~fs name] loads config from XDG location, falling back to
84
+
environment.
85
+
86
+
Attempts to load from the XDG config file first. If that fails (file not
87
+
found or unreadable), falls back to environment variables.
88
+
89
+
@raise Failure if neither source provides valid configuration *)
90
+
91
+
val xdg : fs:Eio.Fs.dir_ty Eio.Path.t -> t -> Xdge.t
92
+
(** [xdg ~fs config] returns the XDG context for this bot.
93
+
94
+
Useful for accessing data and state directories for the bot:
95
+
- [Xdge.data_dir (xdg ~fs config)] for persistent data
96
+
- [Xdge.state_dir (xdg ~fs config)] for runtime state
97
+
- [Xdge.cache_dir (xdg ~fs config)] for cached data *)
98
+
99
+
val data_dir : fs:Eio.Fs.dir_ty Eio.Path.t -> t -> Eio.Fs.dir_ty Eio.Path.t
100
+
(** [data_dir ~fs config] returns the XDG data directory for this bot.
101
+
102
+
Returns [$XDG_DATA_HOME/zulip-bot/<name>], creating it if necessary. *)
103
+
104
+
val state_dir : fs:Eio.Fs.dir_ty Eio.Path.t -> t -> Eio.Fs.dir_ty Eio.Path.t
105
+
(** [state_dir ~fs config] returns the XDG state directory for this bot.
106
+
107
+
Returns [$XDG_STATE_HOME/zulip-bot/<name>], creating it if necessary. *)
108
+
109
+
val cache_dir : fs:Eio.Fs.dir_ty Eio.Path.t -> t -> Eio.Fs.dir_ty Eio.Path.t
110
+
(** [cache_dir ~fs config] returns the XDG cache directory for this bot.
111
+
112
+
Returns [$XDG_CACHE_HOME/zulip-bot/<name>], creating it if necessary. *)
+18
lib/zulip_bot/dune
+18
lib/zulip_bot/dune
+489
lib/zulip_bot/message.ml
+489
lib/zulip_bot/message.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Message parsing using Jsont codecs *)
7
+
8
+
let logs_src = Logs.Src.create "zulip_bot.message"
9
+
10
+
module Log = (val Logs.src_log logs_src : Logs.LOG)
11
+
12
+
(** User representation *)
13
+
module User = struct
14
+
type t = {
15
+
user_id : int;
16
+
email : string;
17
+
full_name : string;
18
+
short_name : string option;
19
+
unknown : Jsont.json;
20
+
(** Unknown/extra JSON fields preserved during parsing *)
21
+
}
22
+
23
+
let user_id t = t.user_id
24
+
let email t = t.email
25
+
let full_name t = t.full_name
26
+
let short_name t = t.short_name
27
+
28
+
(* Jsont codec for User - handles both user_id and id fields *)
29
+
let jsont : t Jsont.t =
30
+
let make email full_name short_name unknown =
31
+
(* user_id will be extracted in a custom way from the object *)
32
+
fun user_id_opt id_opt ->
33
+
let user_id =
34
+
match (user_id_opt, id_opt) with
35
+
| Some uid, _ -> uid
36
+
| None, Some id -> id
37
+
| None, None ->
38
+
Jsont.Error.msgf Jsont.Meta.none "Missing user_id or id field"
39
+
in
40
+
{ user_id; email; full_name; short_name; unknown }
41
+
in
42
+
Jsont.Object.map ~kind:"User" make
43
+
|> Jsont.Object.mem "email" Jsont.string ~enc:email
44
+
|> Jsont.Object.mem "full_name" Jsont.string ~enc:full_name
45
+
|> Jsont.Object.opt_mem "short_name" Jsont.string ~enc:short_name
46
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)
47
+
|> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)
48
+
|> Jsont.Object.opt_mem "id" Jsont.int ~enc:(fun _ -> None)
49
+
|> Jsont.Object.finish
50
+
51
+
let of_json (json : Zulip.json) : (t, string) result =
52
+
Zulip.Encode.from_json jsont json
53
+
end
54
+
55
+
(** Reaction representation *)
56
+
module Reaction = struct
57
+
type t = {
58
+
emoji_name : string;
59
+
emoji_code : string;
60
+
reaction_type : string;
61
+
user_id : int;
62
+
unknown : Jsont.json;
63
+
(** Unknown/extra JSON fields preserved during parsing *)
64
+
}
65
+
66
+
let emoji_name t = t.emoji_name
67
+
let emoji_code t = t.emoji_code
68
+
let reaction_type t = t.reaction_type
69
+
let user_id t = t.user_id
70
+
71
+
(* Jsont codec for Reaction - handles user_id in different locations *)
72
+
let jsont : t Jsont.t =
73
+
(* Helper codec for nested user object - extracts just the user_id *)
74
+
let user_obj_codec =
75
+
Jsont.Object.map ~kind:"ReactionUser" Fun.id
76
+
|> Jsont.Object.mem "user_id" Jsont.int ~enc:Fun.id
77
+
|> Jsont.Object.finish
78
+
in
79
+
let make emoji_name emoji_code reaction_type unknown =
80
+
fun user_id_direct user_obj_nested ->
81
+
let user_id =
82
+
match (user_id_direct, user_obj_nested) with
83
+
| Some uid, _ -> uid
84
+
| None, Some uid -> uid
85
+
| None, None -> Jsont.Error.msgf Jsont.Meta.none "Missing user_id field"
86
+
in
87
+
{ emoji_name; emoji_code; reaction_type; user_id; unknown }
88
+
in
89
+
Jsont.Object.map ~kind:"Reaction" make
90
+
|> Jsont.Object.mem "emoji_name" Jsont.string ~enc:emoji_name
91
+
|> Jsont.Object.mem "emoji_code" Jsont.string ~enc:emoji_code
92
+
|> Jsont.Object.mem "reaction_type" Jsont.string ~enc:reaction_type
93
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)
94
+
|> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)
95
+
|> Jsont.Object.opt_mem "user" user_obj_codec ~enc:(fun _ -> None)
96
+
|> Jsont.Object.finish
97
+
98
+
let of_json (json : Zulip.json) : (t, string) result =
99
+
Zulip.Encode.from_json jsont json
100
+
end
101
+
102
+
let parse_reaction_json json = Reaction.of_json json
103
+
let parse_user_json json = User.of_json json
104
+
105
+
type common = {
106
+
id : int;
107
+
sender_id : int;
108
+
sender_email : string;
109
+
sender_full_name : string;
110
+
sender_short_name : string option;
111
+
timestamp : float;
112
+
content : string;
113
+
content_type : string;
114
+
reactions : Reaction.t list;
115
+
submessages : Zulip.json list;
116
+
flags : string list;
117
+
is_me_message : bool;
118
+
client : string;
119
+
gravatar_hash : string;
120
+
avatar_url : string option;
121
+
}
122
+
(** Common message fields *)
123
+
124
+
(** Message types *)
125
+
type t =
126
+
| Private of { common : common; display_recipient : User.t list }
127
+
| Stream of {
128
+
common : common;
129
+
display_recipient : string;
130
+
stream_id : int;
131
+
subject : string;
132
+
}
133
+
| Unknown of { common : common; raw_json : Zulip.json }
134
+
135
+
(** Helper function to parse common fields *)
136
+
let parse_common json =
137
+
match json with
138
+
| Jsont.Object (fields, _) -> (
139
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
140
+
let get_int key =
141
+
List.assoc_opt key assoc
142
+
|> Option.fold ~none:None ~some:(function
143
+
| Jsont.Number (f, _) -> Some (int_of_float f)
144
+
| _ -> None)
145
+
in
146
+
let get_string key =
147
+
List.assoc_opt key assoc
148
+
|> Option.fold ~none:None ~some:(function
149
+
| Jsont.String (s, _) -> Some s
150
+
| _ -> None)
151
+
in
152
+
let get_float key default =
153
+
List.assoc_opt key assoc
154
+
|> Option.fold ~none:default ~some:(function
155
+
| Jsont.Number (f, _) -> f
156
+
| _ -> default)
157
+
in
158
+
let get_bool key default =
159
+
List.assoc_opt key assoc
160
+
|> Option.fold ~none:default ~some:(function
161
+
| Jsont.Bool (b, _) -> b
162
+
| _ -> default)
163
+
in
164
+
let get_array key =
165
+
List.assoc_opt key assoc
166
+
|> Option.fold ~none:None ~some:(function
167
+
| Jsont.Array (arr, _) -> Some arr
168
+
| _ -> None)
169
+
in
170
+
171
+
match
172
+
( get_int "id",
173
+
get_int "sender_id",
174
+
get_string "sender_email",
175
+
get_string "sender_full_name" )
176
+
with
177
+
| Some id, Some sender_id, Some sender_email, Some sender_full_name ->
178
+
let sender_short_name = get_string "sender_short_name" in
179
+
let timestamp = get_float "timestamp" 0.0 in
180
+
let content = get_string "content" |> Option.value ~default:"" in
181
+
let content_type =
182
+
get_string "content_type" |> Option.value ~default:"text/html"
183
+
in
184
+
185
+
let reactions =
186
+
get_array "reactions"
187
+
|> Option.fold ~none:[]
188
+
~some:
189
+
(List.filter_map (fun r ->
190
+
parse_reaction_json r
191
+
|> Result.fold ~ok:Option.some ~error:(fun msg ->
192
+
Log.warn (fun m ->
193
+
m "Failed to parse reaction: %s" msg);
194
+
None)))
195
+
in
196
+
197
+
let submessages =
198
+
get_array "submessages" |> Option.value ~default:[]
199
+
in
200
+
201
+
let flags =
202
+
get_array "flags"
203
+
|> Option.fold ~none:[]
204
+
~some:
205
+
(List.filter_map (function
206
+
| Jsont.String (s, _) -> Some s
207
+
| _ -> None))
208
+
in
209
+
210
+
let is_me_message = get_bool "is_me_message" false in
211
+
let client = get_string "client" |> Option.value ~default:"" in
212
+
let gravatar_hash =
213
+
get_string "gravatar_hash" |> Option.value ~default:""
214
+
in
215
+
let avatar_url = get_string "avatar_url" in
216
+
217
+
Ok
218
+
{
219
+
id;
220
+
sender_id;
221
+
sender_email;
222
+
sender_full_name;
223
+
sender_short_name;
224
+
timestamp;
225
+
content;
226
+
content_type;
227
+
reactions;
228
+
submessages;
229
+
flags;
230
+
is_me_message;
231
+
client;
232
+
gravatar_hash;
233
+
avatar_url;
234
+
}
235
+
| _ -> Error "Missing required message fields")
236
+
| _ -> Error "Expected JSON object for message"
237
+
238
+
(** JSON parsing *)
239
+
let of_json json =
240
+
(* Helper to pretty print JSON without using jsonu *)
241
+
let json_str =
242
+
match Jsont_bytesrw.encode_string' Jsont.json json with
243
+
| Ok s -> s
244
+
| Error _ -> "<error encoding json>"
245
+
in
246
+
Log.debug (fun m -> m "Parsing message JSON: %s" json_str);
247
+
248
+
match parse_common json with
249
+
| Error msg -> Error msg
250
+
| Ok common -> (
251
+
match json with
252
+
| Jsont.Object (fields, _) -> (
253
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
254
+
let msg_type =
255
+
match List.assoc_opt "type" assoc with
256
+
| Some (Jsont.String (s, _)) -> Some s
257
+
| _ -> None
258
+
in
259
+
match msg_type with
260
+
| Some "private" -> (
261
+
match List.assoc_opt "display_recipient" assoc with
262
+
| Some (Jsont.Array (recipient_json, _)) ->
263
+
let users =
264
+
List.filter_map
265
+
(fun u ->
266
+
match parse_user_json u with
267
+
| Ok user -> Some user
268
+
| Error msg ->
269
+
Log.warn (fun m ->
270
+
m
271
+
"Failed to parse user in display_recipient: \
272
+
%s"
273
+
msg);
274
+
None)
275
+
recipient_json
276
+
in
277
+
278
+
if List.length users = 0 && List.length recipient_json > 0
279
+
then Error "Failed to parse any users in display_recipient"
280
+
else Ok (Private { common; display_recipient = users })
281
+
| _ ->
282
+
Log.warn (fun m ->
283
+
m "display_recipient is not an array for private message");
284
+
Ok (Unknown { common; raw_json = json }))
285
+
| Some "stream" -> (
286
+
let display_recipient =
287
+
match List.assoc_opt "display_recipient" assoc with
288
+
| Some (Jsont.String (s, _)) -> Some s
289
+
| _ -> None
290
+
in
291
+
let stream_id =
292
+
match List.assoc_opt "stream_id" assoc with
293
+
| Some (Jsont.Number (f, _)) -> Some (int_of_float f)
294
+
| _ -> None
295
+
in
296
+
let subject =
297
+
match List.assoc_opt "subject" assoc with
298
+
| Some (Jsont.String (s, _)) -> Some s
299
+
| _ -> None
300
+
in
301
+
match (display_recipient, stream_id, subject) with
302
+
| Some display_recipient, Some stream_id, Some subject ->
303
+
Ok (Stream { common; display_recipient; stream_id; subject })
304
+
| _ ->
305
+
Log.warn (fun m ->
306
+
m "Missing required fields for stream message");
307
+
Ok (Unknown { common; raw_json = json }))
308
+
| Some unknown_type ->
309
+
Log.warn (fun m -> m "Unknown message type: %s" unknown_type);
310
+
Ok (Unknown { common; raw_json = json })
311
+
| None ->
312
+
Log.warn (fun m -> m "No message type field found");
313
+
Ok (Unknown { common; raw_json = json }))
314
+
| _ -> Error "Expected JSON object for message")
315
+
316
+
(** Accessor functions *)
317
+
let get_common = function
318
+
| Private { common; _ } -> common
319
+
| Stream { common; _ } -> common
320
+
| Unknown { common; _ } -> common
321
+
322
+
let id msg = (get_common msg).id
323
+
let sender_id msg = (get_common msg).sender_id
324
+
let sender_email msg = (get_common msg).sender_email
325
+
let sender_full_name msg = (get_common msg).sender_full_name
326
+
let sender_short_name msg = (get_common msg).sender_short_name
327
+
let timestamp msg = (get_common msg).timestamp
328
+
let content msg = (get_common msg).content
329
+
let content_type msg = (get_common msg).content_type
330
+
let reactions msg = (get_common msg).reactions
331
+
let submessages msg = (get_common msg).submessages
332
+
let flags msg = (get_common msg).flags
333
+
let is_me_message msg = (get_common msg).is_me_message
334
+
let client msg = (get_common msg).client
335
+
let gravatar_hash msg = (get_common msg).gravatar_hash
336
+
let avatar_url msg = (get_common msg).avatar_url
337
+
338
+
(** Helper functions *)
339
+
let is_private = function Private _ -> true | _ -> false
340
+
341
+
let is_stream = function Stream _ -> true | _ -> false
342
+
let is_from_self msg ~bot_user_id = sender_id msg = bot_user_id
343
+
let is_from_email msg ~email = sender_email msg = email
344
+
345
+
let get_reply_to = function
346
+
| Private { display_recipient; _ } ->
347
+
display_recipient |> List.map User.email |> String.concat ", "
348
+
| Stream { display_recipient; _ } -> display_recipient
349
+
| Unknown _ -> ""
350
+
351
+
(** Utility functions *)
352
+
let is_mentioned msg ~user_email =
353
+
let content_text = content msg in
354
+
(* Check for both email and username mentions *)
355
+
let email_mention = "@**" ^ user_email ^ "**" in
356
+
(* Also check for username mention (part before @ in email) *)
357
+
let username =
358
+
match String.index_opt user_email '@' with
359
+
| Some idx -> String.sub user_email 0 idx
360
+
| None -> user_email
361
+
in
362
+
let username_mention = "@**" ^ username ^ "**" in
363
+
364
+
let contains text pattern =
365
+
if String.length pattern = 0 || String.length pattern > String.length text
366
+
then false
367
+
else
368
+
let rec search_from pos =
369
+
if pos > String.length text - String.length pattern then false
370
+
else if String.sub text pos (String.length pattern) = pattern then true
371
+
else search_from (pos + 1)
372
+
in
373
+
search_from 0
374
+
in
375
+
contains content_text email_mention || contains content_text username_mention
376
+
377
+
let strip_mention msg ~user_email =
378
+
let content_text = content msg in
379
+
(* Check for both email and username mentions *)
380
+
let email_mention = "@**" ^ user_email ^ "**" in
381
+
let username =
382
+
match String.index_opt user_email '@' with
383
+
| Some idx -> String.sub user_email 0 idx
384
+
| None -> user_email
385
+
in
386
+
let username_mention = "@**" ^ username ^ "**" in
387
+
388
+
(* Remove whichever mention pattern is found at the start *)
389
+
let without_mention =
390
+
if String.starts_with ~prefix:email_mention content_text then
391
+
String.sub content_text
392
+
(String.length email_mention)
393
+
(String.length content_text - String.length email_mention)
394
+
else if String.starts_with ~prefix:username_mention content_text then
395
+
String.sub content_text
396
+
(String.length username_mention)
397
+
(String.length content_text - String.length username_mention)
398
+
else content_text
399
+
in
400
+
String.trim without_mention
401
+
402
+
let extract_command msg =
403
+
let content_text = String.trim (content msg) in
404
+
if String.length content_text > 0 && content_text.[0] = '!' then
405
+
Some (String.sub content_text 1 (String.length content_text - 1))
406
+
else None
407
+
408
+
let parse_command msg =
409
+
match extract_command msg with
410
+
| None -> None
411
+
| Some cmd_string -> (
412
+
let parts = String.split_on_char ' ' (String.trim cmd_string) in
413
+
match parts with [] -> None | cmd :: args -> Some (cmd, args))
414
+
415
+
(** Pretty printing *)
416
+
let pp_user fmt user =
417
+
Format.fprintf fmt "{ user_id=%d; email=%s; full_name=%s }"
418
+
(User.user_id user) (User.email user) (User.full_name user)
419
+
420
+
let _pp_reaction fmt reaction =
421
+
Format.fprintf fmt "{ emoji_name=%s; user_id=%d }"
422
+
(Reaction.emoji_name reaction)
423
+
(Reaction.user_id reaction)
424
+
425
+
let pp fmt = function
426
+
| Private { common; display_recipient } ->
427
+
Format.fprintf fmt
428
+
"Private { id=%d; sender=%s; recipients=[%a]; content=%S }" common.id
429
+
common.sender_email
430
+
(Format.pp_print_list
431
+
~pp_sep:(fun fmt () -> Format.fprintf fmt "; ")
432
+
pp_user)
433
+
display_recipient common.content
434
+
| Stream { common; display_recipient; subject; _ } ->
435
+
Format.fprintf fmt
436
+
"Stream { id=%d; sender=%s; stream=%s; subject=%s; content=%S }"
437
+
common.id common.sender_email display_recipient subject common.content
438
+
| Unknown { common; _ } ->
439
+
Format.fprintf fmt "Unknown { id=%d; sender=%s; content=%S }" common.id
440
+
common.sender_email common.content
441
+
442
+
(** ANSI colored pretty printing for debugging *)
443
+
let pp_ansi ?(show_json = false) ppf msg =
444
+
let open Fmt in
445
+
let blue = styled `Blue string in
446
+
let green = styled `Green string in
447
+
let yellow = styled `Yellow string in
448
+
let magenta = styled `Magenta string in
449
+
let cyan = styled `Cyan string in
450
+
let dim = styled (`Fg `Black) string in
451
+
452
+
match msg with
453
+
| Private { common; display_recipient } ->
454
+
pf ppf "%a %a %a %a %a" (styled `Bold blue) "DM" dim
455
+
(Printf.sprintf "[#%d]" common.id)
456
+
(styled `Cyan string) common.sender_email dim "→" green
457
+
(Printf.sprintf "%S" common.content);
458
+
if show_json then
459
+
pf ppf "@. %a %a" dim "Recipients:"
460
+
(list ~sep:(const string ", ") (fun fmt u -> cyan fmt (User.email u)))
461
+
display_recipient
462
+
| Stream { common; display_recipient; subject; _ } ->
463
+
pf ppf "%a %a %a%a%a %a %a" (styled `Bold yellow) "STREAM" dim
464
+
(Printf.sprintf "[#%d]" common.id)
465
+
magenta display_recipient dim "/" cyan subject (styled `Cyan string)
466
+
common.sender_email green
467
+
(Printf.sprintf "%S" common.content)
468
+
| Unknown { common; _ } ->
469
+
pf ppf "%a %a %a %a"
470
+
(styled `Bold (styled (`Fg `Red) string))
471
+
"UNKNOWN" dim
472
+
(Printf.sprintf "[#%d]" common.id)
473
+
(styled `Cyan string) common.sender_email
474
+
(styled (`Fg `Red) string)
475
+
(Printf.sprintf "%S" common.content)
476
+
477
+
(** Pretty print JSON for debugging *)
478
+
let pp_json_debug ppf json =
479
+
let open Fmt in
480
+
let json_str =
481
+
match Jsont_bytesrw.encode_string' Jsont.json json with
482
+
| Ok s -> s
483
+
| Error _ -> "<error encoding json>"
484
+
in
485
+
pf ppf "@[<v>%a@.%a@]"
486
+
(styled `Bold (styled (`Fg `Blue) string))
487
+
"Raw JSON:"
488
+
(styled (`Fg `Black) string)
489
+
json_str
+121
lib/zulip_bot/message.mli
+121
lib/zulip_bot/message.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Zulip message types and utilities for bots *)
7
+
8
+
(** User representation *)
9
+
module User : sig
10
+
type t = {
11
+
user_id : int;
12
+
email : string;
13
+
full_name : string;
14
+
short_name : string option;
15
+
unknown : Jsont.json;
16
+
}
17
+
18
+
val user_id : t -> int
19
+
val email : t -> string
20
+
val full_name : t -> string
21
+
val short_name : t -> string option
22
+
23
+
val jsont : t Jsont.t
24
+
(** Jsont codec for User *)
25
+
end
26
+
27
+
(** Reaction representation *)
28
+
module Reaction : sig
29
+
type t = {
30
+
emoji_name : string;
31
+
emoji_code : string;
32
+
reaction_type : string;
33
+
user_id : int;
34
+
unknown : Jsont.json;
35
+
}
36
+
37
+
val emoji_name : t -> string
38
+
val emoji_code : t -> string
39
+
val reaction_type : t -> string
40
+
val user_id : t -> int
41
+
42
+
val jsont : t Jsont.t
43
+
(** Jsont codec for Reaction *)
44
+
end
45
+
46
+
type common = {
47
+
id : int;
48
+
sender_id : int;
49
+
sender_email : string;
50
+
sender_full_name : string;
51
+
sender_short_name : string option;
52
+
timestamp : float;
53
+
content : string;
54
+
content_type : string;
55
+
reactions : Reaction.t list;
56
+
submessages : Zulip.json list;
57
+
flags : string list;
58
+
is_me_message : bool;
59
+
client : string;
60
+
gravatar_hash : string;
61
+
avatar_url : string option;
62
+
}
63
+
(** Common message fields *)
64
+
65
+
(** Message types *)
66
+
type t =
67
+
| Private of { common : common; display_recipient : User.t list }
68
+
| Stream of {
69
+
common : common;
70
+
display_recipient : string;
71
+
stream_id : int;
72
+
subject : string;
73
+
}
74
+
| Unknown of { common : common; raw_json : Zulip.json }
75
+
76
+
(** Accessor functions *)
77
+
78
+
val id : t -> int
79
+
val sender_id : t -> int
80
+
val sender_email : t -> string
81
+
val sender_full_name : t -> string
82
+
val sender_short_name : t -> string option
83
+
val timestamp : t -> float
84
+
val content : t -> string
85
+
val content_type : t -> string
86
+
val reactions : t -> Reaction.t list
87
+
val submessages : t -> Zulip.json list
88
+
val flags : t -> string list
89
+
val is_me_message : t -> bool
90
+
val client : t -> string
91
+
val gravatar_hash : t -> string
92
+
val avatar_url : t -> string option
93
+
94
+
(** Helper functions *)
95
+
96
+
val is_private : t -> bool
97
+
val is_stream : t -> bool
98
+
val is_from_self : t -> bot_user_id:int -> bool
99
+
val is_from_email : t -> email:string -> bool
100
+
val get_reply_to : t -> string
101
+
102
+
(** Utility functions *)
103
+
104
+
val is_mentioned : t -> user_email:string -> bool
105
+
val strip_mention : t -> user_email:string -> string
106
+
val extract_command : t -> string option
107
+
val parse_command : t -> (string * string list) option
108
+
109
+
(** JSON parsing *)
110
+
111
+
val of_json : Zulip.json -> (t, string) result
112
+
113
+
(** Pretty printing *)
114
+
115
+
val pp : Format.formatter -> t -> unit
116
+
117
+
val pp_ansi : ?show_json:bool -> Format.formatter -> t -> unit
118
+
(** ANSI colored pretty printing for debugging *)
119
+
120
+
val pp_json_debug : Format.formatter -> Zulip.json -> unit
121
+
(** Pretty print JSON for debugging *)
+15
lib/zulip_bot/response.ml
+15
lib/zulip_bot/response.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t =
7
+
| Reply of string
8
+
| Direct of { recipients : string list; content : string }
9
+
| Stream of { stream : string; topic : string; content : string }
10
+
| Silent
11
+
12
+
let reply content = Reply content
13
+
let direct ~recipients ~content = Direct { recipients; content }
14
+
let stream ~stream ~topic ~content = Stream { stream; topic; content }
15
+
let silent = Silent
+36
lib/zulip_bot/response.mli
+36
lib/zulip_bot/response.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Response types that bot handlers can return.
7
+
8
+
A handler processes a message and returns a response indicating what action
9
+
to take. The bot runner then executes the appropriate Zulip API calls to
10
+
send the response. *)
11
+
12
+
type t =
13
+
| Reply of string
14
+
(** Reply in the same context as the incoming message. For stream
15
+
messages, replies to the same stream and topic. For private messages,
16
+
replies to the sender. *)
17
+
| Direct of { recipients : string list; content : string }
18
+
(** Send a direct (private) message to specific users. Recipients are
19
+
specified by email address. *)
20
+
| Stream of { stream : string; topic : string; content : string }
21
+
(** Send a message to a stream with a specific topic. *)
22
+
| Silent (** No response - the bot acknowledges but does not reply. *)
23
+
24
+
(** {1 Constructors} *)
25
+
26
+
val reply : string -> t
27
+
(** [reply content] creates a reply response. *)
28
+
29
+
val direct : recipients:string list -> content:string -> t
30
+
(** [direct ~recipients ~content] creates a direct message response. *)
31
+
32
+
val stream : stream:string -> topic:string -> content:string -> t
33
+
(** [stream ~stream ~topic ~content] creates a stream message response. *)
34
+
35
+
val silent : t
36
+
(** [silent] is a response that produces no output. *)
+132
lib/zulip_bot/storage.ml
+132
lib/zulip_bot/storage.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let src = Logs.Src.create "zulip_bot.storage" ~doc:"Zulip bot storage"
7
+
8
+
module Log = (val Logs.src_log src : Logs.LOG)
9
+
module String_map = Map.Make (String)
10
+
11
+
type t = { client : Zulip.Client.t; cache : (string, string) Hashtbl.t }
12
+
13
+
type storage_response = { storage : string String_map.t; unknown : Jsont.json }
14
+
(** Storage response type - {"storage": {...}} *)
15
+
16
+
let storage_response_jsont : storage_response Jsont.t =
17
+
let make storage unknown = { storage; unknown } in
18
+
let storage_map_jsont =
19
+
Jsont.Object.map ~kind:"StorageMap" Fun.id
20
+
|> Jsont.Object.keep_unknown
21
+
(Jsont.Object.Mems.string_map Jsont.string)
22
+
~enc:Fun.id
23
+
|> Jsont.Object.finish
24
+
in
25
+
Jsont.Object.map ~kind:"StorageResponse" make
26
+
|> Jsont.Object.mem "storage" storage_map_jsont
27
+
~enc:(fun r -> r.storage)
28
+
~dec_absent:String_map.empty
29
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)
30
+
|> Jsont.Object.finish
31
+
32
+
let create client =
33
+
Log.info (fun m -> m "Creating bot storage");
34
+
let cache = Hashtbl.create 16 in
35
+
(* Fetch all existing storage from server to populate cache *)
36
+
(try
37
+
let json =
38
+
Zulip.Client.request client ~method_:`GET ~path:"/api/v1/bot_storage" ()
39
+
in
40
+
match Zulip.Encode.from_json storage_response_jsont json with
41
+
| Ok response ->
42
+
String_map.iter
43
+
(fun k v ->
44
+
Log.debug (fun m -> m "Loaded key from server: %s" k);
45
+
Hashtbl.add cache k v)
46
+
response.storage
47
+
| Error msg ->
48
+
Log.warn (fun m -> m "Failed to parse storage response: %s" msg)
49
+
with Eio.Exn.Io (e, _) ->
50
+
Log.warn (fun m ->
51
+
m "Failed to load existing storage: %a" Eio.Exn.pp_err e));
52
+
{ client; cache }
53
+
54
+
let encode_storage_update keys_values =
55
+
let storage_obj =
56
+
List.map
57
+
(fun (k, v) -> ((k, Jsont.Meta.none), Jsont.String (v, Jsont.Meta.none)))
58
+
keys_values
59
+
in
60
+
let json_obj = Jsont.Object (storage_obj, Jsont.Meta.none) in
61
+
let json_str =
62
+
Jsont_bytesrw.encode_string' Jsont.json json_obj |> Result.get_ok
63
+
in
64
+
"storage=" ^ Uri.pct_encode json_str
65
+
66
+
let get t key =
67
+
Log.debug (fun m -> m "Getting value for key: %s" key);
68
+
match Hashtbl.find_opt t.cache key with
69
+
| Some value ->
70
+
Log.debug (fun m -> m "Found key in cache: %s" key);
71
+
Some value
72
+
| None -> (
73
+
let params = [ ("keys", "[\"" ^ key ^ "\"]") ] in
74
+
try
75
+
let json =
76
+
Zulip.Client.request t.client ~method_:`GET
77
+
~path:"/api/v1/bot_storage" ~params ()
78
+
in
79
+
match Zulip.Encode.from_json storage_response_jsont json with
80
+
| Ok response -> (
81
+
match String_map.find_opt key response.storage with
82
+
| Some value ->
83
+
Log.debug (fun m -> m "Retrieved key from API: %s" key);
84
+
Hashtbl.add t.cache key value;
85
+
Some value
86
+
| None ->
87
+
Log.debug (fun m -> m "Key not found in API: %s" key);
88
+
None)
89
+
| Error msg ->
90
+
Log.warn (fun m -> m "Failed to parse storage response: %s" msg);
91
+
None
92
+
with Eio.Exn.Io (e, _) ->
93
+
Log.warn (fun m -> m "Error fetching key %s: %a" key Eio.Exn.pp_err e);
94
+
None)
95
+
96
+
let set t key value =
97
+
Log.debug (fun m -> m "Storing key: %s" key);
98
+
Hashtbl.replace t.cache key value;
99
+
let body = encode_storage_update [ (key, value) ] in
100
+
Log.debug (fun m -> m "Sending storage update");
101
+
let _response =
102
+
Zulip.Client.request t.client ~method_:`PUT ~path:"/api/v1/bot_storage"
103
+
~body ()
104
+
in
105
+
Log.debug (fun m -> m "Successfully stored key: %s" key)
106
+
107
+
let remove t key =
108
+
Log.debug (fun m -> m "Removing key: %s" key);
109
+
Hashtbl.remove t.cache key;
110
+
(* Zulip API doesn't have a delete endpoint, so we set to empty string *)
111
+
set t key ""
112
+
113
+
let mem t key =
114
+
if Hashtbl.mem t.cache key then true
115
+
else match get t key with Some _ -> true | None -> false
116
+
117
+
let keys t =
118
+
let json =
119
+
Zulip.Client.request t.client ~method_:`GET ~path:"/api/v1/bot_storage" ()
120
+
in
121
+
match Zulip.Encode.from_json storage_response_jsont json with
122
+
| Ok response ->
123
+
let api_keys =
124
+
String_map.fold (fun k _ acc -> k :: acc) response.storage []
125
+
in
126
+
let cache_keys = Hashtbl.fold (fun k _ acc -> k :: acc) t.cache [] in
127
+
List.sort_uniq String.compare (api_keys @ cache_keys)
128
+
| Error msg ->
129
+
Log.warn (fun m -> m "Failed to parse storage response: %s" msg);
130
+
[]
131
+
132
+
let client t = t.client
+48
lib/zulip_bot/storage.mli
+48
lib/zulip_bot/storage.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Bot storage - key-value storage via the Zulip bot storage API.
7
+
8
+
Provides persistent storage for bots using Zulip's built-in bot storage
9
+
mechanism. Values are cached locally and synchronized with the server.
10
+
11
+
All mutation functions raise [Eio.Io] with [Zulip.E error] on failure. *)
12
+
13
+
type t
14
+
(** An opaque storage handle. *)
15
+
16
+
val create : Zulip.Client.t -> t
17
+
(** [create client] creates a new storage instance.
18
+
19
+
The storage is initialized by fetching all existing keys from the server
20
+
into a local cache. *)
21
+
22
+
val get : t -> string -> string option
23
+
(** [get t key] retrieves a value from storage.
24
+
25
+
Returns [Some value] if the key exists, [None] otherwise. Checks the local
26
+
cache first, then queries the server if not found. *)
27
+
28
+
val set : t -> string -> string -> unit
29
+
(** [set t key value] stores a value.
30
+
31
+
The value is cached locally and immediately written to the server.
32
+
@raise Eio.Io on server communication failure *)
33
+
34
+
val remove : t -> string -> unit
35
+
(** [remove t key] removes a key from storage.
36
+
37
+
@raise Eio.Io on server communication failure *)
38
+
39
+
val mem : t -> string -> bool
40
+
(** [mem t key] checks if a key exists in storage. *)
41
+
42
+
val keys : t -> string list
43
+
(** [keys t] returns all keys in storage.
44
+
45
+
@raise Eio.Io on server communication failure *)
46
+
47
+
val client : t -> Zulip.Client.t
48
+
(** [client t] returns the underlying Zulip client. *)
+42
zulip.opam
+42
zulip.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "OCaml bindings for the Zulip REST API with bot framework"
4
+
description:
5
+
"High-quality OCaml bindings to the Zulip REST API using Eio for async operations. Includes a fiber-based bot framework (zulip.bot) with XDG configuration support."
6
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
7
+
authors: ["Anil Madhavapeddy"]
8
+
license: "ISC"
9
+
homepage: "https://tangled.org/@anil.recoil.org/ocaml-zulip"
10
+
bug-reports: "https://tangled.org/@anil.recoil.org/ocaml-zulip/issues"
11
+
depends: [
12
+
"dune" {>= "3.0"}
13
+
"ocaml" {>= "5.1.0"}
14
+
"eio"
15
+
"requests"
16
+
"uri"
17
+
"base64"
18
+
"init"
19
+
"jsont"
20
+
"logs"
21
+
"fmt"
22
+
"xdge"
23
+
"eio_main"
24
+
"cmdliner"
25
+
"odoc" {with-doc}
26
+
"alcotest" {with-test}
27
+
"mirage-crypto-rng" {with-test}
28
+
]
29
+
build: [
30
+
["dune" "subst"] {dev}
31
+
[
32
+
"dune"
33
+
"build"
34
+
"-p"
35
+
name
36
+
"-j"
37
+
jobs
38
+
"@install"
39
+
"@runtest" {with-test}
40
+
"@doc" {with-doc}
41
+
]
42
+
]