anil.recoil.org
Zulip bots with Eio
cleanup
+2186
-1086
+17
-2
.gitignore
+17
-2
.gitignore
···
1
-
_build
2
-
third_party
1
+
# OCaml build artifacts
2
+
_build/
3
+
*.install
4
+
*.merlin
5
+
6
+
# Third-party sources (fetch locally with opam source)
7
+
third_party/
8
+
9
+
# Editor and OS files
10
+
.DS_Store
11
+
*.swp
12
+
*~
13
+
.vscode/
14
+
.idea/
15
+
16
+
# Opam local switch
17
+
_opam/
+53
-43
README.md
+53
-43
README.md
···
1
-
# OCaml Zulip Library with Requests
1
+
# OCaml Zulip Library
2
2
3
-
A complete OCaml implementation of the Zulip REST API using the `requests` HTTP library.
3
+
A complete OCaml implementation of the Zulip REST API using the `requests` HTTP library and Eio for async operations.
4
4
5
5
## Features
6
6
7
-
- ✅ Full Zulip REST API client implementation
8
-
- ✅ Uses the modern `requests` library for HTTP communication
9
-
- ✅ EIO-based asynchronous operations
10
-
- ✅ Bot framework for building interactive bots
11
-
- ✅ Support for Atom/RSS feed bots
7
+
- Full Zulip REST API client implementation
8
+
- Uses the modern `requests` library for HTTP communication
9
+
- Eio-based asynchronous operations
10
+
- Bot framework for building interactive bots (`zulip.bot` subpackage)
11
+
- Support for Atom/RSS feed bots
12
12
13
13
## Installation
14
+
15
+
```bash
16
+
opam install zulip
17
+
```
18
+
19
+
Or from source:
14
20
15
21
```bash
16
22
dune build
···
33
39
### Basic Client
34
40
35
41
```ocaml
36
-
open Eio_main
37
-
38
42
let () =
39
-
run @@ fun env ->
43
+
Eio_main.run @@ fun env ->
44
+
Eio.Switch.run @@ fun sw ->
40
45
41
46
(* Load authentication *)
42
-
let auth = Zulip.Auth.from_zuliprc () |> Result.get_ok in
47
+
let auth = Zulip.Auth.from_zuliprc () in
43
48
44
49
(* Create client *)
45
-
Eio.Switch.run @@ fun sw ->
46
50
let client = Zulip.Client.create ~sw env auth in
47
51
48
52
(* Send a message *)
···
53
57
~content:"Hello from OCaml!"
54
58
()
55
59
in
60
+
let response = Zulip.Messages.send client message in
61
+
Printf.printf "Sent message %d\n" (Zulip.Message_response.id response)
62
+
```
56
63
57
-
match Zulip.Messages.send client message with
58
-
| Ok response -> Printf.printf "Sent message %d\n" (Zulip.Message_response.id response)
59
-
| Error e -> Printf.eprintf "Error: %s\n" (Zulip.Error.message e)
64
+
### Bot Framework
65
+
66
+
The `zulip.bot` subpackage provides a fiber-based framework for building Zulip bots:
67
+
68
+
```ocaml
69
+
open Zulip_bot
70
+
71
+
let echo_handler ~storage:_ ~identity:_ msg =
72
+
Response.reply ("Echo: " ^ Message.content msg)
73
+
74
+
let () =
75
+
Eio_main.run @@ fun env ->
76
+
Eio.Switch.run @@ fun sw ->
77
+
let fs = Eio.Stdenv.fs env in
78
+
let config = Config.load ~fs "echo-bot" in
79
+
Bot.run ~sw ~env ~config ~handler:echo_handler
60
80
```
61
81
62
82
### Atom Feed Bot
···
99
119
- **Users**: User management
100
120
- **Events**: Real-time event handling
101
121
102
-
### Bot Framework (`zulip_bot`)
122
+
### Bot Framework (`zulip.bot`)
103
123
104
-
- **Bot_handler**: Interface for bot logic
105
-
- **Bot_runner**: Manages bot lifecycle
106
-
- **Bot_storage**: State persistence
107
-
- **Bot_config**: Configuration management
108
-
109
-
## Key Changes from Original Implementation
110
-
111
-
1. **HTTP Library**: Migrated from `cohttp-eio` to the `requests` library
112
-
2. **Configuration**: Removed `toml` dependency, uses simple INI parser
113
-
3. **Type Safety**: Made Client.t parametric over environment types
114
-
4. **Authentication**: Simplified auth handling with built-in INI parser
124
+
- **Bot**: Fiber-based bot runner
125
+
- **Config**: XDG-compliant configuration management
126
+
- **Message**: Bot message parsing
127
+
- **Response**: Response types for bot handlers
128
+
- **Storage**: Key-value state persistence via Zulip API
115
129
116
130
## Examples
117
131
118
132
See the `examples/` directory for:
119
133
- `test_client.ml` - Basic client functionality test
134
+
- `echo_bot.ml` - Echo bot with storage commands
120
135
- `atom_feed_bot.ml` - Complete Atom/RSS feed bot implementation
121
136
122
-
## Testing
123
-
124
-
```bash
125
-
# Build the library
126
-
dune build
127
-
128
-
# Run the test client
129
-
dune exec test_client
130
-
131
-
# Run the atom feed bot
132
-
dune exec atom_feed_bot
133
-
```
134
-
135
137
## Requirements
136
138
137
-
- OCaml 4.08+
139
+
- OCaml 5.0+
138
140
- Dune 3.0+
139
141
- eio
140
142
- requests
141
-
- jsonm
143
+
- jsont
142
144
- uri
143
-
- base64
145
+
- base64
146
+
- init
147
+
- logs
148
+
- fmt
149
+
- xdge
150
+
151
+
## License
152
+
153
+
ISC License. See LICENSE.md for details.
+18
-20
dune-project
+18
-20
dune-project
···
1
1
(lang dune 3.0)
2
2
3
-
(name ocaml-zulip)
3
+
(name zulip)
4
4
5
5
(generate_opam_files true)
6
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
+
7
13
(package
8
14
(name zulip)
9
-
(synopsis "OCaml bindings for the Zulip REST API")
10
-
(description "High-quality OCaml bindings to the Zulip REST API using EIO for async operations")
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.")
11
18
(depends
12
-
ocaml
13
-
dune
19
+
(ocaml (>= 5.1.0))
20
+
(dune (>= 3.0))
14
21
eio
15
22
requests
16
23
uri
17
24
base64
18
25
init
19
-
(alcotest :with-test)
20
-
(eio_main :with-test)))
21
-
22
-
(package
23
-
(name zulip_bot)
24
-
(synopsis "OCaml bot framework for Zulip")
25
-
(description "Fiber-based bot framework for Zulip with XDG configuration support")
26
-
(depends
27
-
ocaml
28
-
dune
29
-
zulip
30
-
eio
31
-
xdge
32
26
jsont
33
27
logs
34
28
fmt
35
-
init
36
-
(alcotest :with-test)))
29
+
xdge
30
+
(odoc :with-doc)
31
+
(alcotest :with-test)
32
+
(eio_main :with-test)
33
+
(cmdliner :with-test)
34
+
(mirage-crypto-rng :with-test)))
+24
-13
examples/atom_feed_bot.ml
+24
-13
examples/atom_feed_bot.ml
···
36
36
in
37
37
match pattern_start with
38
38
| None -> None
39
-
| Some _ ->
39
+
| Some _ -> (
40
40
let rec find_substring str sub start =
41
41
if start + String.length sub > String.length str then None
42
42
else if String.sub str start (String.length sub) = sub then
43
43
Some start
44
44
else find_substring str sub (start + 1)
45
45
in
46
-
(match find_substring xml open_tag 0 with
46
+
match find_substring xml open_tag 0 with
47
47
| None -> None
48
48
| Some start_pos -> (
49
49
let content_start = start_pos + String.length open_tag in
···
74
74
let rec extract_entries str pos =
75
75
try
76
76
let entry_start =
77
-
try String.index_from str pos '<' with Not_found -> String.length str
77
+
try String.index_from str pos '<'
78
+
with Not_found -> String.length str
78
79
in
79
80
if entry_start >= String.length str then ()
80
81
else
···
162
163
| None -> lines
163
164
in
164
165
let lines =
165
-
match entry.summary with
166
-
| Some s -> lines @ [ ""; s ]
167
-
| None -> lines
166
+
match entry.summary with Some s -> lines @ [ ""; s ] | None -> lines
168
167
in
169
168
String.concat "\n" lines
170
169
···
234
233
| name :: url :: topic ->
235
234
let topic_str = String.concat " " topic in
236
235
Hashtbl.replace bot_state.feeds name (url, topic_str);
237
-
Printf.sprintf "Added feed '%s' -> %s (topic: %s)" name url topic_str
236
+
Printf.sprintf "Added feed '%s' -> %s (topic: %s)" name url
237
+
topic_str
238
238
| _ -> "Usage: !feed add <name> <url> <topic>")
239
239
| "remove" -> (
240
240
match args with
···
268
268
bot_state.default_channel <- channel;
269
269
Printf.sprintf "Default channel set to: %s" channel
270
270
| _ ->
271
-
Printf.sprintf "Current default channel: %s" bot_state.default_channel)
271
+
Printf.sprintf "Current default channel: %s"
272
+
bot_state.default_channel)
272
273
| "help" | _ ->
273
274
String.concat "\n"
274
275
[
···
302
303
let run_interactive verbosity env =
303
304
Logs.set_reporter (Logs_fmt.reporter ());
304
305
Logs.set_level
305
-
(Some (match verbosity with 0 -> Logs.Info | 1 -> Logs.Debug | _ -> Logs.Debug));
306
+
(Some
307
+
(match verbosity with
308
+
| 0 -> Logs.Info
309
+
| 1 -> Logs.Debug
310
+
| _ -> Logs.Debug));
306
311
307
312
Log.info (fun m -> m "Starting interactive Atom feed bot...");
308
313
···
318
323
Eio.Switch.run @@ fun sw ->
319
324
let config =
320
325
Zulip_bot.Config.create ~name:"atom-feed-bot"
321
-
~site:(Zulip.Auth.server_url auth) ~email:(Zulip.Auth.email auth)
322
-
~api_key:(Zulip.Auth.api_key auth)
326
+
~site:(Zulip.Auth.server_url auth)
327
+
~email:(Zulip.Auth.email auth) ~api_key:(Zulip.Auth.api_key auth)
323
328
~description:"Bot for managing and posting Atom/RSS feeds to Zulip" ()
324
329
in
325
330
···
332
337
let run_scheduled verbosity env =
333
338
Logs.set_reporter (Logs_fmt.reporter ());
334
339
Logs.set_level
335
-
(Some (match verbosity with 0 -> Logs.Info | 1 -> Logs.Debug | _ -> Logs.Debug));
340
+
(Some
341
+
(match verbosity with
342
+
| 0 -> Logs.Info
343
+
| 1 -> Logs.Debug
344
+
| _ -> Logs.Debug));
336
345
337
346
Log.info (fun m -> m "Starting scheduled Atom feed fetcher...");
338
347
···
363
372
let doc = "Bot mode (interactive or scheduled)" in
364
373
let modes = [ ("interactive", `Interactive); ("scheduled", `Scheduled) ] in
365
374
Arg.(
366
-
value & opt (enum modes) `Interactive & info [ "m"; "mode" ] ~docv:"MODE" ~doc)
375
+
value
376
+
& opt (enum modes) `Interactive
377
+
& info [ "m"; "mode" ] ~docv:"MODE" ~doc)
367
378
368
379
let main_cmd =
369
380
let doc = "Atom feed bot for Zulip" in
+1
-1
examples/atom_feed_bot.mli
+1
-1
examples/atom_feed_bot.mli
+23
-18
examples/bot_example.ml
+23
-18
examples/bot_example.ml
···
1
1
(* Simple Bot Example using core Zulip library *)
2
2
3
-
let () = Eio_main.run @@ fun env ->
3
+
let () =
4
+
Eio_main.run @@ fun env ->
4
5
Eio.Switch.run @@ fun sw ->
5
-
6
6
Printf.printf "OCaml Zulip Bot Example\n";
7
7
Printf.printf "=======================\n\n";
8
8
9
9
(* Create test authentication *)
10
-
let auth = Zulip.Auth.create
11
-
~server_url:"https://example.zulipchat.com"
12
-
~email:"bot@example.com"
13
-
~api_key:"example-api-key" in
10
+
let auth =
11
+
Zulip.Auth.create ~server_url:"https://example.zulipchat.com"
12
+
~email:"bot@example.com" ~api_key:"example-api-key"
13
+
in
14
14
15
15
Printf.printf "✅ Created authentication for: %s\n" (Zulip.Auth.email auth);
16
16
Printf.printf "✅ Server URL: %s\n" (Zulip.Auth.server_url auth);
···
21
21
Printf.printf "✅ Created client: %s\n" client_str;
22
22
23
23
(* Test message creation *)
24
-
let message = Zulip.Message.create
25
-
~type_:`Channel
26
-
~to_:["general"]
27
-
~content:"Hello from OCaml bot!"
28
-
~topic:"Bot Testing"
29
-
() in
24
+
let message =
25
+
Zulip.Message.create ~type_:`Channel ~to_:[ "general" ]
26
+
~content:"Hello from OCaml bot!" ~topic:"Bot Testing" ()
27
+
in
30
28
31
-
Printf.printf "✅ Created message to: %s\n" (String.concat ", " (Zulip.Message.to_ message));
29
+
Printf.printf "✅ Created message to: %s\n"
30
+
(String.concat ", " (Zulip.Message.to_ message));
32
31
Printf.printf "✅ Message content: %s\n" (Zulip.Message.content message);
33
-
Printf.printf "✅ Message topic: %s\n" (match Zulip.Message.topic message with Some t -> t | None -> "none");
32
+
Printf.printf "✅ Message topic: %s\n"
33
+
(match Zulip.Message.topic message with Some t -> t | None -> "none");
34
34
35
35
(* Test API call (mock) *)
36
36
(try
37
-
let response = Zulip.Client.request client ~method_:`GET ~path:"/users/me" () in
37
+
let response =
38
+
Zulip.Client.request client ~method_:`GET ~path:"/users/me" ()
39
+
in
38
40
Printf.printf "✅ API request successful: %s\n"
39
41
(match response with
40
-
| Jsont.Object (fields, _) -> String.concat ", " (List.map (fun ((k, _), _) -> k) fields)
41
-
| _ -> "unknown format")
42
+
| Jsont.Object (fields, _) ->
43
+
String.concat ", " (List.map (fun ((k, _), _) -> k) fields)
44
+
| _ -> "unknown format")
42
45
with Eio.Exn.Io _ as e ->
43
46
Printf.printf "❌ API request failed: %s\n" (Printexc.to_string e));
44
47
45
48
Printf.printf "\n🎉 Bot example completed successfully!\n";
46
-
Printf.printf "Note: This uses mock responses since we're not connected to a real Zulip server.\n"
49
+
Printf.printf
50
+
"Note: This uses mock responses since we're not connected to a real Zulip \
51
+
server.\n"
+1
-1
examples/bot_example.mli
+1
-1
examples/bot_example.mli
+12
-6
examples/dune
+12
-6
examples/dune
···
13
13
(executable
14
14
(public_name echo_bot)
15
15
(name echo_bot)
16
-
(package zulip_bot)
16
+
(package zulip)
17
17
(libraries
18
18
zulip
19
-
zulip_bot
19
+
zulip.bot
20
20
eio_main
21
21
cmdliner
22
22
logs
···
26
26
(executable
27
27
(public_name test_realtime_bot)
28
28
(name test_realtime_bot)
29
-
(package zulip_bot)
30
-
(libraries zulip zulip_bot eio_main cmdliner logs logs.fmt))
29
+
(package zulip)
30
+
(libraries zulip zulip.bot eio_main cmdliner logs logs.fmt))
31
31
32
32
(executable
33
33
(public_name atom_feed_bot)
34
34
(name atom_feed_bot)
35
-
(package zulip_bot)
36
-
(libraries zulip zulip_bot eio_main cmdliner logs logs.fmt))
35
+
(package zulip)
36
+
(libraries zulip zulip.bot eio_main cmdliner logs logs.fmt))
37
37
38
38
(executable
39
39
(public_name example)
···
46
46
(name toml_example)
47
47
(package zulip)
48
48
(libraries zulip eio_main))
49
+
50
+
(executable
51
+
(public_name regression_test)
52
+
(name regression_test)
53
+
(package zulip)
54
+
(libraries zulip zulip.bot eio_main cmdliner logs logs.fmt unix))
+42
-75
examples/echo_bot.ml
+42
-75
examples/echo_bot.ml
···
1
-
(* Enhanced Echo Bot for Zulip with Logging and CLI
2
-
Responds to direct messages and mentions by echoing back the message
3
-
Uses the new functional Zulip_bot API *)
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. *)
4
10
5
11
open Zulip_bot
6
12
7
-
(* Set up logging *)
8
13
let src = Logs.Src.create "echo_bot" ~doc:"Zulip Echo Bot"
9
14
10
15
module Log = (val Logs.src_log src : Logs.LOG)
11
16
12
17
(* The handler is now just a function *)
13
18
let echo_handler ~storage ~identity msg =
14
-
Log.debug (fun m -> m "@[<h>Received: %a@]" (Message.pp_ansi ~show_json:false) msg);
19
+
Log.debug (fun m ->
20
+
m "@[<h>Received: %a@]" (Message.pp_ansi ~show_json:false) msg);
15
21
16
22
let bot_email = identity.Bot.email in
17
23
let sender_email = Message.sender_email msg in
···
44
50
else if lower_msg = "ping" then (
45
51
Log.info (fun m -> m "Responding to ping from %s" sender_name);
46
52
Printf.sprintf "Pong! (from %s)" sender_name)
47
-
else if String.starts_with ~prefix:"store " lower_msg then (
53
+
else if String.starts_with ~prefix:"store " lower_msg then
48
54
let parts =
49
55
String.sub cleaned_msg 6 (String.length cleaned_msg - 6)
50
56
|> String.trim
51
57
in
52
58
match String.index_opt parts ' ' with
53
-
| Some idx ->
59
+
| Some idx -> (
54
60
let key = String.sub parts 0 idx |> String.trim in
55
61
let value =
56
62
String.sub parts (idx + 1) (String.length parts - idx - 1)
57
63
|> String.trim
58
64
in
59
-
(try
60
-
Storage.set storage key value;
61
-
Log.info (fun m ->
62
-
m "Stored key=%s value=%s for user %s" key value sender_name);
63
-
Printf.sprintf "Stored: `%s` = `%s`" key value
64
-
with Eio.Exn.Io _ as e ->
65
-
Log.err (fun m ->
66
-
m "Failed to store key=%s: %s" key (Printexc.to_string e));
67
-
Printf.sprintf "Failed to store: %s" (Printexc.to_string e))
68
-
| None -> "Usage: `store <key> <value>` - Example: `store name John`")
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`"
69
75
else if String.starts_with ~prefix:"get " lower_msg then (
70
76
let key =
71
-
String.sub cleaned_msg 4 (String.length cleaned_msg - 4) |> String.trim
77
+
String.sub cleaned_msg 4 (String.length cleaned_msg - 4)
78
+
|> String.trim
72
79
in
73
80
match Storage.get storage key with
74
81
| Some value ->
···
80
87
Printf.sprintf "Key not found: `%s`" key)
81
88
else if String.starts_with ~prefix:"delete " lower_msg then (
82
89
let key =
83
-
String.sub cleaned_msg 7 (String.length cleaned_msg - 7) |> String.trim
90
+
String.sub cleaned_msg 7 (String.length cleaned_msg - 7)
91
+
|> String.trim
84
92
in
85
93
try
86
94
Storage.remove storage key;
···
90
98
Log.err (fun m ->
91
99
m "Failed to delete key=%s: %s" key (Printexc.to_string e));
92
100
Printf.sprintf "Failed to delete: %s" (Printexc.to_string e))
93
-
else if lower_msg = "list" then (
101
+
else if lower_msg = "list" then
94
102
try
95
103
let keys = Storage.keys storage in
96
104
if keys = [] then
···
99
107
let key_list =
100
108
String.concat "\n" (List.map (fun k -> "* `" ^ k ^ "`") keys)
101
109
in
102
-
Printf.sprintf "Stored keys:\n%s\n\nUse `get <key>` to retrieve values."
103
-
key_list
110
+
Printf.sprintf
111
+
"Stored keys:\n%s\n\nUse `get <key>` to retrieve values." key_list
104
112
with Eio.Exn.Io _ as e ->
105
-
Printf.sprintf "Failed to list keys: %s" (Printexc.to_string e))
113
+
Printf.sprintf "Failed to list keys: %s" (Printexc.to_string e)
106
114
else Printf.sprintf "Echo from %s: %s" sender_name cleaned_msg
107
115
in
108
116
Log.debug (fun m -> m "Generated response: %s" response_content);
109
117
Response.reply response_content
110
118
111
-
let run_echo_bot config_path verbosity env =
112
-
(* Set up logging based on verbosity *)
113
-
Logs.set_reporter (Logs_fmt.reporter ());
114
-
let log_level =
115
-
match verbosity with 0 -> Logs.Info | 1 -> Logs.Debug | _ -> Logs.Debug
116
-
in
117
-
Logs.set_level (Some log_level);
118
-
Logs.Src.set_level src (Some log_level);
119
-
119
+
let run_echo_bot config env =
120
120
Log.app (fun m -> m "Starting Zulip Echo Bot");
121
-
Log.app (fun m -> m "Log level: %s" (Logs.level_to_string (Some log_level)));
122
121
Log.app (fun m -> m "=============================\n");
123
122
124
123
Eio.Switch.run @@ fun sw ->
125
-
let fs = Eio.Stdenv.fs env in
126
-
127
-
(* Load configuration - either from XDG or from provided path *)
128
-
let config =
129
-
match config_path with
130
-
| Some path ->
131
-
(* Load from .zuliprc style file for backwards compatibility *)
132
-
let auth = Zulip.Auth.from_zuliprc ~path () in
133
-
Config.create ~name:"echo-bot" ~site:(Zulip.Auth.server_url auth)
134
-
~email:(Zulip.Auth.email auth) ~api_key:(Zulip.Auth.api_key auth)
135
-
~description:"A simple echo bot that repeats messages" ()
136
-
| None -> (
137
-
(* Try XDG config first, fall back to ~/.zuliprc *)
138
-
try Config.load ~fs "echo-bot"
139
-
with _ ->
140
-
let auth = Zulip.Auth.from_zuliprc () in
141
-
Config.create ~name:"echo-bot" ~site:(Zulip.Auth.server_url auth)
142
-
~email:(Zulip.Auth.email auth) ~api_key:(Zulip.Auth.api_key auth)
143
-
~description:"A simple echo bot that repeats messages" ())
144
-
in
145
-
146
-
Log.info (fun m -> m "Loaded configuration for: %s" config.email);
147
-
Log.info (fun m -> m "Server: %s" config.site);
124
+
Log.info (fun m -> m "Loaded configuration for: %s" config.Config.email);
125
+
Log.info (fun m -> m "Server: %s" config.Config.site);
148
126
149
127
Log.app (fun m -> m "Echo bot is running!");
150
128
Log.app (fun m -> m "Send a direct message or mention the bot in a channel.");
151
129
Log.app (fun m -> m "Commands: 'help', 'ping', or any message to echo");
152
130
Log.app (fun m -> m "Press Ctrl+C to stop.\n");
153
131
154
-
(* Run the bot - this is now just a simple function call *)
155
-
try Bot.run ~sw ~env ~config ~handler:echo_handler
156
-
with
157
-
| Sys.Break -> Log.info (fun m -> m "Received interrupt signal, shutting down")
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")
158
135
| exn ->
159
-
Log.err (fun m -> m "Bot crashed with exception: %s" (Printexc.to_string exn));
136
+
Log.err (fun m ->
137
+
m "Bot crashed with exception: %s" (Printexc.to_string exn));
160
138
Log.debug (fun m -> m "Backtrace: %s" (Printexc.get_backtrace ()));
161
139
raise exn
162
140
163
-
(* Command-line interface *)
164
141
open Cmdliner
165
142
166
-
let config_file =
167
-
let doc = "Path to .zuliprc configuration file" in
168
-
Arg.(value & opt (some string) None & info [ "c"; "config" ] ~docv:"FILE" ~doc)
169
-
170
-
let verbosity =
171
-
let doc = "Increase verbosity. Use multiple times for more verbose output." in
172
-
Arg.(value & flag_all & info [ "v"; "verbose" ] ~doc)
173
-
174
-
let verbosity_term = Term.(const List.length $ verbosity)
175
-
176
143
let bot_cmd eio_env =
177
144
let doc = "Zulip Echo Bot with verbose logging" in
178
145
let man =
···
186
153
"The bot reads configuration from XDG config directory \
187
154
(~/.config/zulip-bot/echo-bot/config) or from a .zuliprc file.";
188
155
`S "LOGGING";
189
-
`P "Use -v for info level logging, -vv for debug level logging.";
156
+
`P "Use -v for debug level logging, --verbose-http for HTTP-level details.";
190
157
`S "COMMANDS";
191
158
`P "The bot responds to:";
192
159
`P "- 'help' - Show usage information";
···
199
166
]
200
167
in
201
168
let info = Cmd.info "echo_bot" ~version:"2.0.0" ~doc ~man in
202
-
Cmd.v info
203
-
Term.(const run_echo_bot $ config_file $ verbosity_term $ const eio_env)
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)
204
171
205
172
let () =
206
173
Mirage_crypto_rng_unix.use_default ();
+11
-13
examples/example.ml
+11
-13
examples/example.ml
···
1
1
open Zulip
2
2
3
-
let () = Eio_main.run @@ fun env ->
3
+
let () =
4
+
Eio_main.run @@ fun env ->
4
5
Eio.Switch.run @@ fun sw ->
5
-
6
6
Printf.printf "OCaml Zulip Library Example\n";
7
7
Printf.printf "===========================\n\n";
8
8
9
9
(* Create authentication *)
10
-
let auth = Auth.create
11
-
~server_url:"https://example.zulipchat.com"
12
-
~email:"bot@example.com"
13
-
~api_key:"your-api-key" in
10
+
let auth =
11
+
Auth.create ~server_url:"https://example.zulipchat.com"
12
+
~email:"bot@example.com" ~api_key:"your-api-key"
13
+
in
14
14
15
15
Printf.printf "Created auth for: %s\n" (Auth.email auth);
16
16
Printf.printf "Server URL: %s\n" (Auth.server_url auth);
17
17
18
18
(* Create a message *)
19
-
let message = Message.create
20
-
~type_:`Channel
21
-
~to_:["general"]
22
-
~content:"Hello from OCaml Zulip library!"
23
-
~topic:"Test"
24
-
() in
19
+
let message =
20
+
Message.create ~type_:`Channel ~to_:[ "general" ]
21
+
~content:"Hello from OCaml Zulip library!" ~topic:"Test" ()
22
+
in
25
23
26
24
Printf.printf "\nCreated message:\n";
27
25
Printf.printf "- Type: %s\n" (Message_type.to_string (Message.type_ message));
···
41
39
with Eio.Exn.Io _ as e ->
42
40
Printf.printf "Mock request failed: %s\n" (Printexc.to_string e));
43
41
44
-
Printf.printf "\nLibrary is working correctly!\n"
42
+
Printf.printf "\nLibrary is working correctly!\n"
+1
-1
examples/example.mli
+1
-1
examples/example.mli
+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))
+18
-21
examples/test_client.ml
+18
-21
examples/test_client.ml
···
11
11
with Eio.Exn.Io _ as e ->
12
12
Printf.eprintf "Failed to load auth: %s\n" (Printexc.to_string e);
13
13
(* Create a test auth *)
14
-
Zulip.Auth.create
15
-
~server_url:"https://example.zulipchat.com"
16
-
~email:"bot@example.com"
17
-
~api_key:"test_api_key"
14
+
Zulip.Auth.create ~server_url:"https://example.zulipchat.com"
15
+
~email:"bot@example.com" ~api_key:"test_api_key"
18
16
19
17
let test_message_send env auth =
20
18
Printf.printf "\nTesting message send...\n";
···
23
21
let client = Zulip.Client.create ~sw env auth in
24
22
25
23
(* Create a test message *)
26
-
let message = Zulip.Message.create
27
-
~type_:`Channel
28
-
~to_:["general"]
29
-
~topic:"Test Topic"
30
-
~content:"Hello from OCaml Zulip client using requests library!"
31
-
()
24
+
let message =
25
+
Zulip.Message.create ~type_:`Channel ~to_:[ "general" ] ~topic:"Test Topic"
26
+
~content:"Hello from OCaml Zulip client using requests library!" ()
32
27
in
33
28
34
29
try
···
45
40
let client = Zulip.Client.create ~sw env auth in
46
41
47
42
try
48
-
let json = Zulip.Messages.get_messages client ~num_before:5 ~num_after:0 () in
43
+
let json =
44
+
Zulip.Messages.get_messages client ~anchor:Newest ~num_before:5
45
+
~num_after:0 ()
46
+
in
49
47
Printf.printf "Fetched messages successfully!\n";
50
-
(match json with
51
-
| Jsont.Object (fields, _) ->
52
-
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
53
-
(match List.assoc_opt "messages" assoc with
54
-
| Some (Jsont.Array (messages, _)) ->
55
-
Printf.printf "Got %d messages\n" (List.length messages)
56
-
| _ -> Printf.printf "No messages field found\n")
57
-
| _ -> Printf.printf "Unexpected JSON format\n")
48
+
match json with
49
+
| Jsont.Object (fields, _) -> (
50
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
51
+
match List.assoc_opt "messages" assoc with
52
+
| Some (Jsont.Array (messages, _)) ->
53
+
Printf.printf "Got %d messages\n" (List.length messages)
54
+
| _ -> Printf.printf "No messages field found\n")
55
+
| _ -> Printf.printf "Unexpected JSON format\n"
58
56
with Eio.Exn.Io _ as e ->
59
57
Printf.eprintf "Failed to fetch messages: %s\n" (Printexc.to_string e)
60
58
···
63
61
Printf.printf "========================\n\n";
64
62
65
63
Eio_main.run @@ fun env ->
66
-
67
64
(* Test authentication *)
68
65
let auth = test_auth () in
69
66
···
73
70
(* Test fetching messages *)
74
71
test_fetch_messages env auth;
75
72
76
-
Printf.printf "\nAll tests completed!\n"
73
+
Printf.printf "\nAll tests completed!\n"
+7
-2
examples/test_realtime_bot.ml
+7
-2
examples/test_realtime_bot.ml
···
33
33
(* Setup logging *)
34
34
Logs.set_reporter (Logs_fmt.reporter ());
35
35
Logs.set_level
36
-
(Some (match verbosity with 0 -> Logs.Info | 1 -> Logs.Debug | _ -> Logs.Debug));
36
+
(Some
37
+
(match verbosity with
38
+
| 0 -> Logs.Info
39
+
| 1 -> Logs.Debug
40
+
| _ -> Logs.Debug));
37
41
38
42
Log.info (fun m -> m "Real-time Bot Test");
39
43
Log.info (fun m -> m "==================");
···
53
57
Eio.Switch.run @@ fun sw ->
54
58
(* Create configuration from auth *)
55
59
let config =
56
-
Config.create ~name:"test-bot" ~site:(Zulip.Auth.server_url auth)
60
+
Config.create ~name:"test-bot"
61
+
~site:(Zulip.Auth.server_url auth)
57
62
~email:(Zulip.Auth.email auth) ~api_key:(Zulip.Auth.api_key auth)
58
63
~description:"A test bot that logs all messages received" ()
59
64
in
+42
-32
examples/toml_example.ml
+42
-32
examples/toml_example.ml
···
3
3
let () =
4
4
Printf.printf "OCaml Zulip TOML Support Demo\n";
5
5
Printf.printf "=============================\n\n";
6
-
6
+
7
7
(* Example 1: Create a sample zuliprc TOML file *)
8
-
let zuliprc_content = {|
8
+
let zuliprc_content =
9
+
{|
9
10
# Zulip API Configuration
10
11
[api]
11
12
email = "demo@example.com"
···
15
16
# Optional settings
16
17
insecure = false
17
18
cert_bundle = "/etc/ssl/certs/ca-certificates.crt"
18
-
|} in
19
-
19
+
|}
20
+
in
21
+
20
22
let zuliprc_file = "demo_zuliprc.toml" in
21
23
let oc = open_out zuliprc_file in
22
24
output_string oc zuliprc_content;
23
25
close_out oc;
24
-
26
+
25
27
Printf.printf "Created sample zuliprc.toml file:\n%s\n" zuliprc_content;
26
-
28
+
27
29
(* Test loading auth from TOML *)
28
30
(try
29
31
let auth = Auth.from_zuliprc ~path:zuliprc_file () in
···
39
41
Printf.printf "✅ Created client successfully\n\n";
40
42
41
43
(* Test basic functionality *)
42
-
(try
43
-
let _ = Client.request client ~method_:`GET ~path:"/users/me" () in
44
-
Printf.printf "✅ Mock API request succeeded\n"
45
-
with Eio.Exn.Io _ as e ->
46
-
Printf.printf "❌ API request failed: %s\n" (Printexc.to_string e))
44
+
try
45
+
let _ = Client.request client ~method_:`GET ~path:"/users/me" () in
46
+
Printf.printf "✅ Mock API request succeeded\n"
47
+
with Eio.Exn.Io _ as e ->
48
+
Printf.printf "❌ API request failed: %s\n" (Printexc.to_string e)
47
49
with Eio.Exn.Io _ as e ->
48
-
Printf.printf "❌ Failed to load auth from TOML: %s\n" (Printexc.to_string e));
49
-
50
+
Printf.printf "❌ Failed to load auth from TOML: %s\n"
51
+
(Printexc.to_string e));
52
+
50
53
(* Example 2: Root-level TOML configuration *)
51
-
let root_toml_content = {|
54
+
let root_toml_content =
55
+
{|
52
56
email = "root-user@example.com"
53
57
key = "root-api-key-67890"
54
58
site = "https://root.zulipchat.com"
55
-
|} in
56
-
59
+
|}
60
+
in
61
+
57
62
let root_file = "demo_root.toml" in
58
63
let oc = open_out root_file in
59
64
output_string oc root_toml_content;
60
65
close_out oc;
61
-
66
+
62
67
Printf.printf "\nTesting root-level TOML configuration:\n";
63
68
(try
64
69
let auth = Auth.from_zuliprc ~path:root_file () in
···
66
71
Printf.printf " Email: %s\n" (Auth.email auth);
67
72
Printf.printf " Server: %s\n" (Auth.server_url auth)
68
73
with Eio.Exn.Io _ as e ->
69
-
Printf.printf "❌ Failed to parse root-level TOML: %s\n" (Printexc.to_string e));
70
-
74
+
Printf.printf "❌ Failed to parse root-level TOML: %s\n"
75
+
(Printexc.to_string e));
76
+
71
77
(* Example 3: Test error handling with invalid TOML *)
72
-
let invalid_toml = {|
78
+
let invalid_toml =
79
+
{|
73
80
[api
74
81
email = "invalid@example.com" # Missing closing bracket
75
-
|} in
76
-
82
+
|}
83
+
in
84
+
77
85
let invalid_file = "demo_invalid.toml" in
78
86
let oc = open_out invalid_file in
79
87
output_string oc invalid_toml;
80
88
close_out oc;
81
-
89
+
82
90
Printf.printf "\nTesting error handling with invalid TOML:\n";
83
91
(try
84
92
let _ = Auth.from_zuliprc ~path:invalid_file () in
85
93
Printf.printf "❌ Should have failed with invalid TOML\n"
86
94
with Eio.Exn.Io _ as e ->
87
-
Printf.printf "✅ Correctly handled invalid TOML: %s\n" (Printexc.to_string e));
88
-
95
+
Printf.printf "✅ Correctly handled invalid TOML: %s\n"
96
+
(Printexc.to_string e));
97
+
89
98
(* Example 4: Test missing file handling *)
90
99
Printf.printf "\nTesting missing file handling:\n";
91
100
(try
92
101
let _ = Auth.from_zuliprc ~path:"nonexistent.toml" () in
93
102
Printf.printf "❌ Should have failed with missing file\n"
94
103
with Eio.Exn.Io _ as e ->
95
-
Printf.printf "✅ Correctly handled missing file: %s\n" (Printexc.to_string e));
96
-
104
+
Printf.printf "✅ Correctly handled missing file: %s\n"
105
+
(Printexc.to_string e));
106
+
97
107
(* Clean up *)
98
-
List.iter (fun file ->
99
-
if Sys.file_exists file then Sys.remove file
100
-
) [zuliprc_file; root_file; invalid_file];
101
-
108
+
List.iter
109
+
(fun file -> if Sys.file_exists file then Sys.remove file)
110
+
[ zuliprc_file; root_file; invalid_file ];
111
+
102
112
Printf.printf "\n🎉 TOML support demonstration complete!\n";
103
113
Printf.printf "\nFeatures demonstrated:\n";
104
114
Printf.printf "• Parse TOML files with [api] section\n";
105
115
Printf.printf "• Parse TOML files with root-level configuration\n";
106
116
Printf.printf "• Proper error handling for invalid TOML syntax\n";
107
117
Printf.printf "• Proper error handling for missing files\n";
108
-
Printf.printf "• Integration with existing Zulip client\n"
118
+
Printf.printf "• Integration with existing Zulip client\n"
+1
-1
examples/toml_example.mli
+1
-1
examples/toml_example.mli
+20
-19
lib/zulip/auth.ml
+20
-19
lib/zulip/auth.ml
···
1
-
type t = {
2
-
server_url : string;
3
-
email : string;
4
-
api_key : string;
5
-
}
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 }
6
7
7
8
let create ~server_url ~email ~api_key = { server_url; email; api_key }
8
9
9
-
(** INI section record for parsing the [api] section of zuliprc *)
10
10
type zuliprc_api = {
11
11
zuliprc_email : string;
12
12
zuliprc_key : string;
13
13
zuliprc_site : string;
14
14
}
15
+
(** INI section record for parsing the [api] section of zuliprc *)
15
16
16
-
(** Codec for parsing the [api] section of zuliprc.
17
-
Note: zuliprc uses "key" not "api_key" *)
17
+
(** Codec for parsing the [api] section of zuliprc. Note: zuliprc uses "key" not
18
+
"api_key" *)
18
19
let api_section_codec =
19
20
Init.Section.(
20
21
obj (fun email key site ->
···
22
23
|> mem "email" Init.string ~enc:(fun c -> c.zuliprc_email)
23
24
|> mem "key" Init.string ~enc:(fun c -> c.zuliprc_key)
24
25
|> mem "site" Init.string ~enc:(fun c -> c.zuliprc_site)
25
-
|> skip_unknown
26
-
|> finish)
26
+
|> skip_unknown |> finish)
27
27
28
28
(** Document codec for zuliprc with [api] section *)
29
29
let zuliprc_codec =
30
30
Init.Document.(
31
31
obj (fun api -> api)
32
32
|> section "api" api_section_codec ~enc:Fun.id
33
-
|> skip_unknown
34
-
|> finish)
33
+
|> skip_unknown |> finish)
35
34
36
35
(** Codec for zuliprc without section headers (bare key=value pairs) *)
37
36
let zuliprc_bare_codec =
38
37
Init.Document.(
39
38
obj (fun defaults -> defaults)
40
39
|> defaults api_section_codec ~enc:Fun.id
41
-
|> skip_unknown
42
-
|> finish)
40
+
|> skip_unknown |> finish)
43
41
44
42
let from_zuliprc ?(path = "~/.zuliprc") () =
45
43
try
···
63
61
let api =
64
62
match Init_bytesrw.decode_string zuliprc_codec content with
65
63
| Ok c -> c
66
-
| Error _ ->
64
+
| Error _ -> (
67
65
(* Try bare config format (no section headers) *)
68
66
match Init_bytesrw.decode_string zuliprc_bare_codec content with
69
67
| Ok c -> c
70
68
| Error msg ->
71
69
Error.raise_with_context
72
70
(Error.make ~code:(Other "parse_error")
73
-
~message:("Error parsing zuliprc: " ^ msg) ())
74
-
"reading %s" path
71
+
~message:("Error parsing zuliprc: " ^ msg)
72
+
())
73
+
"reading %s" path)
75
74
in
76
75
77
76
(* Ensure server_url has proper protocol *)
···
88
87
| Sys_error msg ->
89
88
Error.raise_with_context
90
89
(Error.make ~code:(Other "file_error")
91
-
~message:("Cannot read zuliprc file: " ^ msg) ())
90
+
~message:("Cannot read zuliprc file: " ^ msg)
91
+
())
92
92
"reading %s" path
93
93
| exn ->
94
94
Error.raise_with_context
95
95
(Error.make ~code:(Other "parse_error")
96
-
~message:("Error parsing zuliprc: " ^ Printexc.to_string exn) ())
96
+
~message:("Error parsing zuliprc: " ^ Printexc.to_string exn)
97
+
())
97
98
"reading %s" path
98
99
99
100
let server_url t = t.server_url
+7
-1
lib/zulip/auth.mli
+7
-1
lib/zulip/auth.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Authentication for the Zulip API.
2
7
3
-
This module handles authentication credentials for connecting to a Zulip server.
8
+
This module handles authentication credentials for connecting to a Zulip
9
+
server.
4
10
@raise Eio.Io with [Error.E error] on authentication/config errors *)
5
11
6
12
type t
+35
-37
lib/zulip/channel.ml
+35
-37
lib/zulip/channel.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
type t = {
2
7
name : string;
3
8
stream_id : int option;
···
43
48
let stream_post_policy t = t.stream_post_policy
44
49
45
50
let pp fmt t =
46
-
Format.fprintf fmt "Channel{name=%s, stream_id=%s, description=%s}"
47
-
t.name
51
+
Format.fprintf fmt "Channel{name=%s, stream_id=%s, description=%s}" t.name
48
52
(match t.stream_id with Some id -> string_of_int id | None -> "none")
49
53
t.description
50
54
···
111
115
Jsont.Object.map ~kind ~doc make
112
116
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun t -> t.channel.name)
113
117
|> Jsont.Object.opt_mem "stream_id" Jsont.int ~enc:(fun t ->
114
-
t.channel.stream_id)
115
-
|> Jsont.Object.mem "description" Jsont.string
116
-
~dec_absent:""
117
-
~enc:(fun t -> t.channel.description)
118
-
|> Jsont.Object.mem "invite_only" Jsont.bool
119
-
~dec_absent:false
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
120
122
~enc:(fun t -> t.channel.invite_only)
121
-
|> Jsont.Object.mem "is_web_public" Jsont.bool
122
-
~dec_absent:false
123
+
|> Jsont.Object.mem "is_web_public" Jsont.bool ~dec_absent:false
123
124
~enc:(fun t -> t.channel.is_web_public)
124
125
|> Jsont.Object.mem "history_public_to_subscribers" Jsont.bool
125
-
~dec_absent:true
126
-
~enc:(fun t -> t.channel.history_public_to_subscribers)
127
-
|> Jsont.Object.mem "is_default" Jsont.bool
128
-
~dec_absent:false
129
-
~enc:(fun t -> t.channel.is_default)
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
130
|> Jsont.Object.opt_mem "message_retention_days" (Jsont.option Jsont.int)
131
131
~enc:(fun t -> t.channel.message_retention_days)
132
132
|> Jsont.Object.opt_mem "first_message_id" Jsont.int ~enc:(fun t ->
133
-
t.channel.first_message_id)
133
+
t.channel.first_message_id)
134
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
137
-
~dec_absent:1
135
+
t.channel.date_created)
136
+
|> Jsont.Object.mem "stream_post_policy" Jsont.int ~dec_absent:1
138
137
~enc:(fun t -> t.channel.stream_post_policy)
139
138
|> Jsont.Object.opt_mem "color" Jsont.string ~enc:color
140
139
|> Jsont.Object.mem "is_muted" Jsont.bool ~dec_absent:false ~enc:is_muted
141
-
|> Jsont.Object.mem "pin_to_top" Jsont.bool ~dec_absent:false ~enc:pin_to_top
142
-
|> Jsont.Object.opt_mem "desktop_notifications" Jsont.bool
143
-
~enc:desktop_notifications
144
-
|> Jsont.Object.opt_mem "audible_notifications" Jsont.bool
145
-
~enc:audible_notifications
146
-
|> Jsont.Object.opt_mem "push_notifications" Jsont.bool
147
-
~enc:push_notifications
148
-
|> Jsont.Object.opt_mem "email_notifications" Jsont.bool
149
-
~enc:email_notifications
150
-
|> Jsont.Object.opt_mem "wildcard_mentions_notify" Jsont.bool
151
-
~enc:wildcard_mentions_notify
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
152
|> Jsont.Object.finish
153
153
end
154
154
···
177
177
|> Jsont.Object.mem "name" Jsont.string ~enc:name
178
178
|> Jsont.Object.opt_mem "stream_id" Jsont.int ~enc:stream_id
179
179
|> Jsont.Object.mem "description" Jsont.string ~dec_absent:"" ~enc:description
180
-
|> Jsont.Object.mem "invite_only" Jsont.bool ~dec_absent:false ~enc:invite_only
181
-
|> Jsont.Object.mem "is_web_public" Jsont.bool
182
-
~dec_absent:false
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
183
~enc:is_web_public
184
184
|> Jsont.Object.mem "history_public_to_subscribers" Jsont.bool
185
-
~dec_absent:true
186
-
~enc:history_public_to_subscribers
185
+
~dec_absent:true ~enc:history_public_to_subscribers
187
186
|> Jsont.Object.mem "is_default" Jsont.bool ~dec_absent:false ~enc:is_default
188
187
|> Jsont.Object.opt_mem "message_retention_days" (Jsont.option Jsont.int)
189
188
~enc:message_retention_days
190
189
|> Jsont.Object.opt_mem "first_message_id" Jsont.int ~enc:first_message_id
191
190
|> Jsont.Object.opt_mem "date_created" Jsont.number ~enc:date_created
192
-
|> Jsont.Object.mem "stream_post_policy" Jsont.int
193
-
~dec_absent:1
191
+
|> Jsont.Object.mem "stream_post_policy" Jsont.int ~dec_absent:1
194
192
~enc:stream_post_policy
195
193
|> Jsont.Object.finish
+15
-8
lib/zulip/channel.mli
+15
-8
lib/zulip/channel.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Zulip channels (streams).
2
7
3
-
This module represents channel/stream information from the Zulip API.
4
-
Use {!jsont} with Bytesrw-eio for wire serialization.
8
+
This module represents channel/stream information from the Zulip API. Use
9
+
{!jsont} with Bytesrw-eio for wire serialization.
5
10
6
-
Note: Zulip uses "stream" in the API but "channel" in the UI.
7
-
This library uses "channel" to match the current Zulip terminology. *)
11
+
Note: Zulip uses "stream" in the API but "channel" in the UI. This library
12
+
uses "channel" to match the current Zulip terminology. *)
8
13
9
14
(** {1 Channel Type} *)
10
15
···
34
39
@param description Channel description
35
40
@param invite_only Whether the channel is private
36
41
@param is_web_public Whether the channel is web-public
37
-
@param history_public_to_subscribers Whether history is visible to new subscribers
42
+
@param history_public_to_subscribers
43
+
Whether history is visible to new subscribers
38
44
@param is_default Whether this is a default channel for new users
39
45
@param message_retention_days Message retention policy (None = forever)
40
46
@param first_message_id ID of the first message in the channel
41
47
@param date_created Unix timestamp of creation
42
-
@param stream_post_policy Who can post (1=any, 2=admins, 3=full members, 4=moderators) *)
48
+
@param stream_post_policy
49
+
Who can post (1=any, 2=admins, 3=full members, 4=moderators) *)
43
50
44
51
(** {1 Accessors} *)
45
52
···
75
82
(** Unix timestamp when the channel was created. *)
76
83
77
84
val stream_post_policy : t -> int
78
-
(** Who can post to the channel.
79
-
1 = any member, 2 = admins only, 3 = full members, 4 = moderators only. *)
85
+
(** Who can post to the channel. 1 = any member, 2 = admins only, 3 = full
86
+
members, 4 = moderators only. *)
80
87
81
88
(** {1 Subscription Info}
82
89
+89
-46
lib/zulip/channels.ml
+89
-46
lib/zulip/channels.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
let streams_codec =
2
7
Jsont.Object.(
3
8
map ~kind:"StreamsResponse" Fun.id
···
13
18
let params =
14
19
List.filter_map Fun.id
15
20
[
16
-
Option.map (fun v -> ("include_public", string_of_bool v)) include_public;
17
-
Option.map (fun v -> ("include_web_public", string_of_bool v)) include_web_public;
18
-
Option.map (fun v -> ("include_subscribed", string_of_bool v)) include_subscribed;
19
-
Option.map (fun v -> ("include_all_active", string_of_bool v)) include_all_active;
20
-
Option.map (fun v -> ("include_default", string_of_bool v)) include_default;
21
-
Option.map (fun v -> ("include_owner_subscribed", string_of_bool v)) include_owner_subscribed;
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;
22
39
]
23
40
in
24
41
let json =
···
39
56
~path:("/api/v1/get_stream_id?stream=" ^ encoded_name)
40
57
()
41
58
in
42
-
Error.decode_or_raise response_codec json (Printf.sprintf "getting stream id for %s" name)
59
+
Error.decode_or_raise response_codec json
60
+
(Printf.sprintf "getting stream id for %s" name)
43
61
44
62
let get_by_id client ~stream_id =
45
63
let response_codec =
···
53
71
~path:("/api/v1/streams/" ^ string_of_int stream_id)
54
72
()
55
73
in
56
-
Error.decode_or_raise response_codec json (Printf.sprintf "getting stream %d" stream_id)
74
+
Error.decode_or_raise response_codec json
75
+
(Printf.sprintf "getting stream %d" stream_id)
57
76
58
77
type create_options = {
59
78
name : string;
···
69
88
let make_string s = Jsont.String (s, Jsont.Meta.none) in
70
89
let subs =
71
90
Jsont.Array
72
-
([
73
-
Jsont.Object
74
-
(List.filter_map Fun.id
75
-
[
76
-
Some (("name", Jsont.Meta.none), make_string opts.name);
77
-
Option.map (fun d -> (("description", Jsont.Meta.none), make_string d)) opts.description;
78
-
], Jsont.Meta.none);
79
-
], Jsont.Meta.none)
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 )
80
103
in
81
104
let params =
82
105
[ ("subscriptions", Encode.to_json_string Jsont.json subs) ]
···
96
119
let response_codec =
97
120
Jsont.Object.(
98
121
map ~kind:"CreateResponse" (fun created -> created)
99
-
|> mem "subscribed" Jsont.json ~enc:(fun _ -> Jsont.Object ([], Jsont.Meta.none))
122
+
|> mem "subscribed" Jsont.json ~enc:(fun _ ->
123
+
Jsont.Object ([], Jsont.Meta.none))
100
124
|> finish)
101
125
in
102
126
let json =
···
186
210
let make_string s = Jsont.String (s, Jsont.Meta.none) in
187
211
let subs_json =
188
212
Jsont.Array
189
-
(List.map
190
-
(fun s ->
191
-
Jsont.Object
192
-
(List.filter_map Fun.id
193
-
[
194
-
Some (("name", Jsont.Meta.none), make_string s.name);
195
-
Option.map (fun c -> (("color", Jsont.Meta.none), make_string c)) s.color;
196
-
Option.map (fun d -> (("description", Jsont.Meta.none), make_string d)) s.description;
197
-
], Jsont.Meta.none))
198
-
subscriptions, Jsont.Meta.none)
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 )
199
230
in
200
231
let params =
201
232
[ ("subscriptions", Encode.to_json_string Jsont.json subs_json) ]
···
232
263
233
264
let unsubscribe client ~subscriptions ?principals () =
234
265
let params =
235
-
[ ("subscriptions", Encode.to_json_string (Jsont.list Jsont.string) subscriptions) ]
266
+
[
267
+
( "subscriptions",
268
+
Encode.to_json_string (Jsont.list Jsont.string) subscriptions );
269
+
]
236
270
@ List.filter_map Fun.id
237
271
[
238
272
Option.map
···
287
321
?email_notifications ?wildcard_mentions_notify () =
288
322
let data =
289
323
[
290
-
{|[{"stream_id":|}
291
-
^ string_of_int stream_id
324
+
{|[{"stream_id":|} ^ string_of_int stream_id
292
325
^ (List.filter_map Fun.id
293
326
[
294
-
Option.map (fun v -> Printf.sprintf {|,"property":"color","value":"%s"|} v) color;
327
+
Option.map
328
+
(fun v -> Printf.sprintf {|,"property":"color","value":"%s"|} v)
329
+
color;
295
330
Option.map
296
331
(fun v -> Printf.sprintf {|,"property":"is_muted","value":%b|} v)
297
332
is_muted;
298
333
Option.map
299
-
(fun v -> Printf.sprintf {|,"property":"pin_to_top","value":%b|} v)
334
+
(fun v ->
335
+
Printf.sprintf {|,"property":"pin_to_top","value":%b|} v)
300
336
pin_to_top;
301
337
Option.map
302
338
(fun v ->
303
-
Printf.sprintf {|,"property":"desktop_notifications","value":%b|} v)
339
+
Printf.sprintf
340
+
{|,"property":"desktop_notifications","value":%b|} v)
304
341
desktop_notifications;
305
342
Option.map
306
343
(fun v ->
307
-
Printf.sprintf {|,"property":"audible_notifications","value":%b|} v)
344
+
Printf.sprintf
345
+
{|,"property":"audible_notifications","value":%b|} v)
308
346
audible_notifications;
309
347
Option.map
310
348
(fun v ->
311
-
Printf.sprintf {|,"property":"push_notifications","value":%b|} v)
349
+
Printf.sprintf {|,"property":"push_notifications","value":%b|}
350
+
v)
312
351
push_notifications;
313
352
Option.map
314
353
(fun v ->
315
-
Printf.sprintf {|,"property":"email_notifications","value":%b|} v)
354
+
Printf.sprintf {|,"property":"email_notifications","value":%b|}
355
+
v)
316
356
email_notifications;
317
357
Option.map
318
358
(fun v ->
···
357
397
~path:("/api/v1/users/me/" ^ string_of_int stream_id ^ "/topics")
358
398
()
359
399
in
360
-
Error.decode_or_raise response_codec json (Printf.sprintf "getting topics for stream %d" stream_id)
400
+
Error.decode_or_raise response_codec json
401
+
(Printf.sprintf "getting topics for stream %d" stream_id)
361
402
362
403
let delete_topic client ~stream_id ~topic =
363
404
let params = [ ("topic_name", topic) ] in
···
390
431
map ~kind:"MutedTopicsResponse" Fun.id
391
432
|> mem "muted_topics"
392
433
(Jsont.list
393
-
(Jsont.Object.(
394
-
map ~kind:"MutedTopic" (fun stream_id topic _ts ->
395
-
(stream_id, topic))
396
-
|> mem "stream_id" Jsont.int ~enc:fst
397
-
|> mem "topic_name" Jsont.string ~enc:snd
398
-
|> mem "date_muted" Jsont.int ~dec_absent:0 ~enc:(Fun.const 0)
399
-
|> finish)))
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))
400
441
~enc:Fun.id
401
442
|> finish)
402
443
in
···
418
459
~path:("/api/v1/streams/" ^ string_of_int stream_id ^ "/members")
419
460
()
420
461
in
421
-
Error.decode_or_raise response_codec json (Printf.sprintf "getting subscribers for stream %d" stream_id)
462
+
Error.decode_or_raise response_codec json
463
+
(Printf.sprintf "getting subscribers for stream %d" stream_id)
422
464
423
465
let get_email_address client ~stream_id =
424
466
let response_codec =
···
432
474
~path:("/api/v1/streams/" ^ string_of_int stream_id ^ "/email_address")
433
475
()
434
476
in
435
-
Error.decode_or_raise response_codec json (Printf.sprintf "getting email address for stream %d" stream_id)
477
+
Error.decode_or_raise response_codec json
478
+
(Printf.sprintf "getting email address for stream %d" stream_id)
+19
-11
lib/zulip/channels.mli
+19
-11
lib/zulip/channels.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Channel (stream) operations for the Zulip API.
2
7
3
-
All functions raise [Eio.Io] with [Error.E error] on failure.
4
-
Context is automatically added indicating the operation being performed. *)
8
+
All functions raise [Eio.Io] with [Error.E error] on failure. Context is
9
+
automatically added indicating the operation being performed. *)
5
10
6
11
(** {1 Listing Channels} *)
7
12
···
41
46
42
47
(** {1 Creating Channels} *)
43
48
44
-
(** Options for creating a channel. *)
45
49
type create_options = {
46
50
name : string; (** Channel name (required) *)
47
51
description : string option; (** Channel description *)
···
54
58
can_remove_subscribers_group : int option;
55
59
(** User group that can remove subscribers *)
56
60
}
61
+
(** Options for creating a channel. *)
57
62
58
63
val create : Client.t -> create_options -> int
59
64
(** Create a new channel.
···
61
66
@raise Eio.Io on failure *)
62
67
63
68
val create_simple :
64
-
Client.t -> name:string -> ?description:string -> ?invite_only:bool -> unit -> int
69
+
Client.t ->
70
+
name:string ->
71
+
?description:string ->
72
+
?invite_only:bool ->
73
+
unit ->
74
+
int
65
75
(** Create a new channel with common options.
66
76
@return The stream_id of the created channel
67
77
@raise Eio.Io on failure *)
···
105
115
106
116
(** {1 Subscriptions} *)
107
117
108
-
(** Subscription request for a single channel. *)
109
118
type subscription_request = {
110
119
name : string; (** Channel name *)
111
120
color : string option; (** Color preference (hex string) *)
112
121
description : string option; (** Description (for new channels) *)
113
122
}
123
+
(** Subscription request for a single channel. *)
114
124
115
125
val subscribe :
116
126
Client.t ->
···
130
140
@param announce Whether to announce new subscriptions
131
141
@param invite_only For new channels: whether they should be private
132
142
@param history_public_to_subscribers For new channels: history visibility
133
-
@return JSON with "subscribed", "already_subscribed", and "unauthorized" fields
143
+
@return
144
+
JSON with "subscribed", "already_subscribed", and "unauthorized" fields
134
145
@raise Eio.Io on failure *)
135
146
136
147
val subscribe_simple : Client.t -> channels:string list -> unit
···
198
209
@raise Eio.Io on failure *)
199
210
200
211
val delete_topic : Client.t -> stream_id:int -> topic:string -> unit
201
-
(** Delete a topic and all its messages.
202
-
Requires admin privileges.
212
+
(** Delete a topic and all its messages. Requires admin privileges.
203
213
@raise Eio.Io on failure *)
204
214
205
215
(** {1 Topic Muting} *)
206
216
207
-
type mute_op =
208
-
| Mute (** Mute the topic *)
209
-
| Unmute (** Unmute the topic *)
217
+
type mute_op = Mute (** Mute the topic *) | Unmute (** Unmute the topic *)
210
218
211
219
val set_topic_mute :
212
220
Client.t -> stream_id:int -> topic:string -> op:mute_op -> unit
+36
-26
lib/zulip/client.ml
+36
-26
lib/zulip/client.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(* Logging setup *)
2
7
let src = Logs.Src.create "zulip.client" ~doc:"Zulip API client"
3
8
4
9
module Log = (val Logs.src_log src : Logs.LOG)
5
10
6
-
type t = {
7
-
auth : Auth.t;
8
-
session : Requests.t;
9
-
}
11
+
type t = { auth : Auth.t; session : Requests.t }
10
12
11
13
let create ~sw env auth =
12
14
Log.info (fun m -> m "Creating Zulip client for %s" (Auth.server_url auth));
···
43
45
params
44
46
|> Option.map (fun p ->
45
47
Uri.of_string url
46
-
|> Fun.flip (List.fold_left (fun u (k, v) -> Uri.add_query_param' u (k, v))) p
48
+
|> Fun.flip
49
+
(List.fold_left (fun u (k, v) -> Uri.add_query_param' u (k, v)))
50
+
p
47
51
|> Uri.to_string)
48
52
|> Option.value ~default:url
49
53
in
50
54
51
55
(* Prepare request body if provided *)
52
56
let body_opt =
53
-
body |> Option.map (fun body_str ->
54
-
let mime =
55
-
match content_type with
56
-
| Some ct when String.starts_with ~prefix:"multipart/form-data" ct ->
57
-
Requests.Mime.of_string ct
58
-
| Some "application/json" -> Requests.Mime.json
59
-
| Some "application/x-www-form-urlencoded" | None ->
60
-
if String.contains body_str '=' && not (String.contains body_str '{')
61
-
then Requests.Mime.form
62
-
else Requests.Mime.json
63
-
| Some ct -> Requests.Mime.of_string ct
64
-
in
65
-
Requests.Body.of_string mime body_str)
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)
66
73
in
67
74
68
75
(* Make the request *)
···
99
106
100
107
(* Check for Zulip error response *)
101
108
match json with
102
-
| Jsont.Object (fields, _) ->
109
+
| Jsont.Object (fields, _) -> (
103
110
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
104
-
(match List.assoc_opt "result" assoc with
111
+
match List.assoc_opt "result" assoc with
105
112
| Some (Jsont.String ("error", _)) ->
106
113
let msg =
107
114
match List.assoc_opt "msg" assoc with
···
126
133
(fun (k, _) -> k <> "code" && k <> "msg" && k <> "result")
127
134
assoc
128
135
in
129
-
Log.warn (fun m -> m "API error: %s (code: %a)" msg Error.pp_code code);
136
+
Log.warn (fun m ->
137
+
m "API error: %s (code: %a)" msg Error.pp_code code);
130
138
Error.raise_with_context
131
139
(Error.make ~code ~message:msg ~extra ())
132
140
"%s %s" (method_to_string method_) path
···
135
143
else (
136
144
Log.warn (fun m -> m "HTTP error: %d" status);
137
145
Error.raise_with_context
138
-
(Error.make ~code:(Other (string_of_int status))
139
-
~message:("HTTP error: " ^ string_of_int status) ())
146
+
(Error.make
147
+
~code:(Other (string_of_int status))
148
+
~message:("HTTP error: " ^ string_of_int status)
149
+
())
140
150
"%s %s" (method_to_string method_) path))
141
151
| _ ->
142
152
if status >= 200 && status < 300 then json
143
153
else (
144
154
Log.err (fun m -> m "Invalid JSON response");
145
155
Error.raise_with_context
146
-
(Error.make ~code:(Other "json_parse") ~message:"Invalid JSON response" ())
156
+
(Error.make ~code:(Other "json_parse")
157
+
~message:"Invalid JSON response" ())
147
158
"%s %s" (method_to_string method_) path)
148
159
149
-
let pp fmt t =
150
-
Format.fprintf fmt "Client(server=%s)" (Auth.server_url t.auth)
160
+
let pp fmt t = Format.fprintf fmt "Client(server=%s)" (Auth.server_url t.auth)
+16
-9
lib/zulip/client.mli
+16
-9
lib/zulip/client.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** HTTP client for making requests to the Zulip API.
2
7
3
-
This module provides the low-level HTTP client for communicating with
4
-
the Zulip API. All API errors are raised as [Eio.Io] exceptions with
5
-
[Error.E] error codes, following the Eio error pattern.
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.
6
11
7
12
@raise Eio.Io with [Error.E error] for API errors *)
8
13
···
28
33
Auth.t ->
29
34
(t -> 'a) ->
30
35
'a
31
-
(** Resource-safe client management using structured concurrency.
32
-
The environment must have clock, net, and fs capabilities. *)
36
+
(** Resource-safe client management using structured concurrency. The
37
+
environment must have clock, net, and fs capabilities. *)
33
38
34
39
val request :
35
40
t ->
···
41
46
unit ->
42
47
Jsont.json
43
48
(** Make an HTTP request to the Zulip API.
44
-
@param content_type Optional Content-Type header
45
-
(default: application/x-www-form-urlencoded for POST/PUT, none for GET/DELETE)
46
-
@raise Eio.Io with [Error.E error] on API errors. The exception
47
-
includes context about the request method and path. *)
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. *)
48
55
49
56
val pp : Format.formatter -> t -> unit
50
57
(** Pretty printer for client (shows server URL only, not credentials) *)
+10
-1
lib/zulip/dune
+10
-1
lib/zulip/dune
+41
-20
lib/zulip/encode.ml
+41
-20
lib/zulip/encode.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Encoding utilities for Zulip API requests *)
2
7
3
8
(** Convert a jsont-encoded value to JSON string *)
4
-
let to_json_string : 'a Jsont.t -> 'a -> string = fun codec value ->
9
+
let to_json_string : 'a Jsont.t -> 'a -> string =
10
+
fun codec value ->
5
11
match Jsont_bytesrw.encode_string' codec value with
6
12
| Ok s -> s
7
13
| Error e -> failwith ("JSON encoding error: " ^ Jsont.Error.to_string e)
8
14
9
15
(** Convert a jsont-encoded value to form-urlencoded string *)
10
-
let to_form_urlencoded : 'a Jsont.t -> 'a -> string = fun codec value ->
16
+
let to_form_urlencoded : 'a Jsont.t -> 'a -> string =
17
+
fun codec value ->
11
18
(* First encode to JSON, then extract fields *)
12
19
let json_str = to_json_string codec value in
13
20
match Jsont_bytesrw.decode_string' Jsont.json json_str with
···
21
28
| Jsont.Null _ -> None
22
29
| Jsont.Array (items, _) ->
23
30
(* For arrays, encode as JSON array string *)
24
-
let array_str = "[" ^ String.concat "," (List.filter_map (function
25
-
| Jsont.String (s, _) -> Some ("\"" ^ String.escaped s ^ "\"")
26
-
| Jsont.Number (n, _) -> Some (string_of_float n)
27
-
| Jsont.Bool (b, _) -> Some (string_of_bool b)
28
-
| _ -> None
29
-
) items) ^ "]" in
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
30
44
Some array_str
31
45
| Jsont.Object _ -> None (* Skip nested objects *)
32
46
in
33
47
34
-
let params = List.filter_map (fun ((key, _), value) ->
35
-
match encode_value value with
36
-
| Some encoded -> Some (key ^ "=" ^ encoded)
37
-
| None -> None
38
-
) fields in
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
39
56
40
57
String.concat "&" params
41
-
| Ok _ ->
42
-
failwith "Expected JSON object for form encoding"
58
+
| Ok _ -> failwith "Expected JSON object for form encoding"
43
59
44
60
(** Parse JSON string using a jsont codec *)
45
-
let from_json_string : 'a Jsont.t -> string -> ('a, string) result = fun codec json_str ->
61
+
let from_json_string : 'a Jsont.t -> string -> ('a, string) result =
62
+
fun codec json_str ->
46
63
match Jsont_bytesrw.decode_string' codec json_str with
47
64
| Ok v -> Ok v
48
65
| Error e -> Error (Jsont.Error.to_string e)
49
66
50
67
(** Parse a Jsont.json value using a codec *)
51
-
let from_json : 'a Jsont.t -> Jsont.json -> ('a, string) result = fun codec json ->
52
-
let json_str = match Jsont_bytesrw.encode_string' Jsont.json json with
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
53
72
| Ok s -> s
54
-
| Error e -> failwith ("Failed to re-encode json: " ^ Jsont.Error.to_string e)
73
+
| Error e ->
74
+
failwith ("Failed to re-encode json: " ^ Jsont.Error.to_string e)
55
75
in
56
76
from_json_string codec json_str
57
77
58
78
(** Convert a value to Jsont.json using a codec *)
59
-
let to_json : 'a Jsont.t -> 'a -> (Jsont.json, string) result = fun codec value ->
79
+
let to_json : 'a Jsont.t -> 'a -> (Jsont.json, string) result =
80
+
fun codec value ->
60
81
let json_str = to_json_string codec value in
61
82
match Jsont_bytesrw.decode_string' Jsont.json json_str with
62
83
| Ok json -> Ok json
+14
-7
lib/zulip/encode.mli
+14
-7
lib/zulip/encode.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Encoding utilities for Zulip API requests *)
2
7
8
+
val to_json_string : 'a Jsont.t -> 'a -> string
3
9
(** Convert a value to JSON string using its jsont codec *)
4
-
val to_json_string : 'a Jsont.t -> 'a -> string
5
10
6
-
(** Convert a value to application/x-www-form-urlencoded string using its jsont codec
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
7
14
8
-
The codec should represent a JSON object. Fields will be converted to key=value pairs:
15
+
The codec should represent a JSON object. Fields will be converted to
16
+
key=value pairs:
9
17
- Strings: URL-encoded
10
18
- Booleans: "true"/"false"
11
19
- Numbers: string representation
12
20
- Arrays: JSON array string "[...]"
13
21
- Null: omitted
14
22
- Nested objects: omitted *)
15
-
val to_form_urlencoded : 'a Jsont.t -> 'a -> string
16
23
17
-
(** Parse JSON string using a jsont codec *)
18
24
val from_json_string : 'a Jsont.t -> string -> ('a, string) result
25
+
(** Parse JSON string using a jsont codec *)
19
26
27
+
val from_json : 'a Jsont.t -> Jsont.json -> ('a, string) result
20
28
(** Parse a Jsont.json value using a codec *)
21
-
val from_json : 'a Jsont.t -> Jsont.json -> ('a, string) result
22
29
23
-
(** Convert a value to Jsont.json using a codec *)
24
30
val to_json : 'a Jsont.t -> 'a -> (Jsont.json, string) result
31
+
(** Convert a value to Jsont.json using a codec *)
+13
-9
lib/zulip/error.ml
+13
-9
lib/zulip/error.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
type code =
2
7
| Invalid_api_key
3
8
| Request_variable_missing
···
7
12
| Rate_limit_hit
8
13
| Other of string
9
14
10
-
type t = {
11
-
code : code;
12
-
message : string;
13
-
extra : (string * Jsont.json) list;
14
-
}
15
-
15
+
type t = { code : code; message : string; extra : (string * Jsont.json) list }
16
16
type Eio.Exn.err += E of t
17
17
18
18
let pp_code fmt = function
···
58
58
let raise e = Stdlib.raise (Eio.Exn.create (E e))
59
59
60
60
let raise_with_context e fmt =
61
-
Format.kasprintf (fun context ->
61
+
Format.kasprintf
62
+
(fun context ->
62
63
Stdlib.raise (Eio.Exn.add_context (Eio.Exn.create (E e)) "%s" context))
63
64
fmt
64
65
···
68
69
69
70
let jsont =
70
71
let kind = "ZulipError" in
71
-
let make' code msg = { code = code_of_api_string code; message = msg; extra = [] } in
72
+
let make' code msg =
73
+
{ code = code_of_api_string code; message = msg; extra = [] }
74
+
in
72
75
let code' t = code_to_api_string t.code in
73
76
let msg t = t.message in
74
77
Jsont.Object.(
···
86
89
let extra =
87
90
fields
88
91
|> List.map (fun ((k, _), v) -> (k, v))
89
-
|> List.filter (fun (k, _) -> k <> "code" && k <> "msg" && k <> "result")
92
+
|> List.filter (fun (k, _) ->
93
+
k <> "code" && k <> "msg" && k <> "result")
90
94
in
91
95
{ err with extra }
92
96
| _ -> err)
+24
-18
lib/zulip/error.mli
+24
-18
lib/zulip/error.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Zulip API error handling.
2
7
3
-
This module defines protocol-level errors for the Zulip API,
4
-
following the Eio error pattern for context-aware error handling.
8
+
This module defines protocol-level errors for the Zulip API, following the
9
+
Eio error pattern for context-aware error handling.
5
10
6
11
Errors are raised as [Eio.Io] exceptions:
7
12
{[
8
-
try
9
-
Zulip.Messages.send client msg
10
-
with
13
+
try Zulip.Messages.send client msg with
11
14
| Eio.Io (Zulip.Error.E { code = Invalid_api_key; message; _ }, _) ->
12
15
Printf.eprintf "Authentication failed: %s\n" message
13
16
| Eio.Io (Zulip.Error.E err, _) ->
···
16
19
17
20
(** {1 Error Codes}
18
21
19
-
These error codes correspond to the error codes returned by the Zulip API
20
-
in the "code" field of error responses. *)
22
+
These error codes correspond to the error codes returned by the Zulip API in
23
+
the "code" field of error responses. *)
21
24
22
25
type code =
23
26
| Invalid_api_key (** Authentication failure - invalid API key *)
···
33
36
type t = {
34
37
code : code; (** The error code from the API *)
35
38
message : string; (** Human-readable error message *)
36
-
extra : (string * Jsont.json) list; (** Additional fields from the error response *)
39
+
extra : (string * Jsont.json) list;
40
+
(** Additional fields from the error response *)
37
41
}
38
42
(** The protocol-level error type. *)
39
43
40
44
(** {1 Eio Integration} *)
41
45
42
-
type Eio.Exn.err += E of t
43
-
(** Extend [Eio.Exn.err] with Zulip protocol errors. *)
46
+
type Eio.Exn.err +=
47
+
| E of t (** Extend [Eio.Exn.err] with Zulip protocol errors. *)
44
48
45
49
val raise : t -> 'a
46
-
(** [raise e] raises an [Eio.Io] exception for error [e].
47
-
Equivalent to [Stdlib.raise (Eio.Exn.create (E e))]. *)
50
+
(** [raise e] raises an [Eio.Io] exception for error [e]. Equivalent to
51
+
[Stdlib.raise (Eio.Exn.create (E e))]. *)
48
52
49
53
val raise_with_context : t -> ('a, Format.formatter, unit, 'b) format4 -> 'a
50
54
(** [raise_with_context e fmt ...] raises an [Eio.Io] exception with context.
51
-
Equivalent to [Stdlib.raise (Eio.Exn.add_context (Eio.Exn.create (E e)) fmt ...)]. *)
55
+
Equivalent to
56
+
[Stdlib.raise (Eio.Exn.add_context (Eio.Exn.create (E e)) fmt ...)]. *)
52
57
53
58
(** {1 Error Construction} *)
54
59
55
-
val make : code:code -> message:string -> ?extra:(string * Jsont.json) list -> unit -> t
60
+
val make :
61
+
code:code -> message:string -> ?extra:(string * Jsont.json) list -> unit -> t
56
62
(** [make ~code ~message ?extra ()] creates an error value. *)
57
63
58
64
(** {1 Accessors} *)
···
75
81
(** Jsont codec for errors. *)
76
82
77
83
val of_json : Jsont.json -> t option
78
-
(** [of_json json] attempts to parse a Zulip API error response.
79
-
Returns [None] if the JSON does not represent an error. *)
84
+
(** [of_json json] attempts to parse a Zulip API error response. Returns [None]
85
+
if the JSON does not represent an error. *)
80
86
81
87
val decode_or_raise : 'a Jsont.t -> Jsont.json -> string -> 'a
82
-
(** [decode_or_raise codec json context] decodes JSON using the codec,
83
-
or raises a Zulip error with the given context if decoding fails. *)
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. *)
+7
-8
lib/zulip/event.ml
+7
-8
lib/zulip/event.ml
···
1
-
type t = {
2
-
id : int;
3
-
type_ : Event_type.t;
4
-
data : Jsont.json;
5
-
}
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 }
6
7
7
8
let id t = t.id
8
9
let type_ t = t.type_
···
21
22
let jsont =
22
23
let kind = "Event" in
23
24
let doc = "A Zulip event from the event queue" in
24
-
let make id type_ (data : Jsont.json) =
25
-
{ id; type_; data }
26
-
in
25
+
let make id type_ (data : Jsont.json) = { id; type_; data } in
27
26
let enc_data t = t.data in
28
27
Jsont.Object.map ~kind ~doc make
29
28
|> Jsont.Object.mem "id" Jsont.int ~enc:id
+8
-3
lib/zulip/event.mli
+8
-3
lib/zulip/event.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Zulip events.
2
7
3
-
This module represents events received from the Zulip event queue.
4
-
Use {!jsont} with Bytesrw-eio for wire deserialization. *)
8
+
This module represents events received from the Zulip event queue. Use
9
+
{!jsont} with Bytesrw-eio for wire deserialization. *)
5
10
6
11
type t
7
12
···
9
14
val type_ : t -> Event_type.t
10
15
val data : t -> Jsont.json
11
16
12
-
(** Jsont codec for event *)
13
17
val jsont : t Jsont.t
18
+
(** Jsont codec for event *)
14
19
15
20
val pp : Format.formatter -> t -> unit
+41
-32
lib/zulip/event_queue.ml
+41
-32
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
+
1
6
(* Logging setup *)
2
7
let src = Logs.Src.create "zulip.event_queue" ~doc:"Zulip event queue"
3
8
···
5
10
6
11
type t = { id : string; mutable last_event_id : int }
7
12
8
-
(* Request/response codecs *)
9
-
module Register_request = struct
10
-
type t = { event_types : string list option }
11
-
12
-
let _codec =
13
-
Jsont.Object.(
14
-
map ~kind:"RegisterRequest" (fun event_types -> { event_types })
15
-
|> opt_mem "event_types" (Jsont.list Jsont.string)
16
-
~enc:(fun r -> r.event_types)
17
-
|> finish)
18
-
end
19
-
20
13
module Register_response = struct
21
14
type t = { queue_id : string; last_event_id : int }
22
15
···
26
19
{ queue_id; last_event_id })
27
20
|> mem "queue_id" Jsont.string ~enc:(fun r -> r.queue_id)
28
21
|> mem "last_event_id" Jsont.int ~dec_absent:(-1) ~enc:(fun r ->
29
-
r.last_event_id)
22
+
r.last_event_id)
30
23
|> finish)
31
24
end
32
25
33
-
let register client ?event_types ?narrow ?all_public_streams ?include_subscribers
34
-
?client_capabilities ?fetch_event_types ?client_gravatar ?slim_presence () =
26
+
let register client ?event_types ?narrow ?all_public_streams
27
+
?include_subscribers ?client_capabilities ?fetch_event_types
28
+
?client_gravatar ?slim_presence () =
35
29
let event_types_str =
36
30
Option.map (List.map Event_type.to_string) event_types
37
31
in
···
43
37
[
44
38
Option.map
45
39
(fun types ->
46
-
("event_types", Encode.to_json_string (Jsont.list Jsont.string) types))
40
+
( "event_types",
41
+
Encode.to_json_string (Jsont.list Jsont.string) types ))
47
42
event_types_str;
48
43
Option.map
49
44
(fun n -> ("narrow", Encode.to_json_string Narrow.list_jsont n))
···
69
64
]
70
65
in
71
66
72
-
Option.iter (fun types ->
73
-
Log.debug (fun m -> m "Registering with event_types: %s" (String.concat "," types)))
67
+
Option.iter
68
+
(fun types ->
69
+
Log.debug (fun m ->
70
+
m "Registering with event_types: %s" (String.concat "," types)))
74
71
event_types_str;
75
72
76
73
let json =
77
74
Client.request client ~method_:`POST ~path:"/api/v1/register" ~params ()
78
75
in
79
-
let response = Error.decode_or_raise Register_response.codec json "parsing register response" in
76
+
let response =
77
+
Error.decode_or_raise Register_response.codec json
78
+
"parsing register response"
79
+
in
80
80
{ id = response.queue_id; last_event_id = response.last_event_id }
81
81
82
82
let id t = t.id
···
89
89
let codec =
90
90
let make raw_json =
91
91
match raw_json with
92
-
| Jsont.Object (fields, _) ->
92
+
| Jsont.Object (fields, _) -> (
93
93
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
94
-
(match List.assoc_opt "events" assoc with
94
+
match List.assoc_opt "events" assoc with
95
95
| Some (Jsont.Array (items, _)) ->
96
96
let events =
97
-
items |> List.filter_map (fun item ->
98
-
Encode.from_json Event.jsont item |> Result.to_option)
97
+
items
98
+
|> List.filter_map (fun item ->
99
+
Encode.from_json Event.jsont item |> Result.to_option)
99
100
in
100
101
{ events }
101
102
| Some _ -> { events = [] }
···
103
104
| _ -> { events = [] }
104
105
in
105
106
Jsont.Object.map ~kind:"EventsResponse" make
106
-
|> Jsont.Object.keep_unknown Jsont.json_mems
107
-
~enc:(fun _ -> Jsont.Object ([], Jsont.Meta.none))
107
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun _ ->
108
+
Jsont.Object ([], Jsont.Meta.none))
108
109
|> Jsont.Object.finish
109
110
end
110
111
···
112
113
let event_id = Option.value last_event_id ~default:t.last_event_id in
113
114
let params =
114
115
[ ("queue_id", t.id); ("last_event_id", string_of_int event_id) ]
115
-
@ (if dont_block = Some true then [ ("dont_block", "true") ] else [])
116
+
@ if dont_block = Some true then [ ("dont_block", "true") ] else []
116
117
in
117
118
let json =
118
119
Client.request client ~method_:`GET ~path:"/api/v1/events" ~params ()
119
120
in
120
-
let response = Error.decode_or_raise Events_response.codec json (Printf.sprintf "parsing events from queue %s" t.id) 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
121
125
Log.debug (fun m -> m "Got %d events from API" (List.length response.events));
122
126
(* Update internal last_event_id *)
123
127
(match response.events with
124
-
| [] -> ()
125
-
| events ->
126
-
let max_id = List.fold_left (fun acc e -> max acc (Event.id e)) event_id events in
128
+
| [] -> ()
129
+
| events ->
130
+
let max_id =
131
+
List.fold_left (fun acc e -> max acc (Event.id e)) event_id events
132
+
in
127
133
t.last_event_id <- max_id);
128
134
response.events
129
135
···
141
147
List.iter
142
148
(fun event ->
143
149
(* Filter out heartbeat events *)
144
-
match Event.type_ event with Event_type.Heartbeat -> () | _ -> callback event)
150
+
match Event.type_ event with
151
+
| Event_type.Heartbeat -> ()
152
+
| _ -> callback event)
145
153
events;
146
154
loop ()
147
155
in
···
169
177
in
170
178
next
171
179
172
-
let pp fmt t = Format.fprintf fmt "EventQueue{id=%s, last_event_id=%d}" t.id t.last_event_id
180
+
let pp fmt t =
181
+
Format.fprintf fmt "EventQueue{id=%s, last_event_id=%d}" t.id t.last_event_id
+21
-13
lib/zulip/event_queue.mli
+21
-13
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
+
1
6
(** Event queue for receiving Zulip events in real-time.
2
7
3
-
Event queues provide real-time notifications of changes in Zulip.
4
-
Register a queue to receive events, then poll for updates.
8
+
Event queues provide real-time notifications of changes in Zulip. Register a
9
+
queue to receive events, then poll for updates.
5
10
6
11
All functions raise [Eio.Io] with [Error.E error] on failure. *)
7
12
···
47
52
(** {1 Polling for Events} *)
48
53
49
54
val get_events :
50
-
t -> Client.t -> ?last_event_id:int -> ?dont_block:bool -> unit -> Event.t list
55
+
t ->
56
+
Client.t ->
57
+
?last_event_id:int ->
58
+
?dont_block:bool ->
59
+
unit ->
60
+
Event.t list
51
61
(** Get events from the queue.
52
62
53
63
@param last_event_id Event ID to resume from (default: use queue's state)
···
64
74
65
75
(** {1 High-Level Event Processing}
66
76
67
-
These functions provide convenient callback-based patterns for
68
-
processing events. They handle queue management and reconnection
69
-
automatically. *)
77
+
These functions provide convenient callback-based patterns for processing
78
+
events. They handle queue management and reconnection automatically. *)
70
79
71
80
val call_on_each_event :
72
81
Client.t ->
···
77
86
unit
78
87
(** Process events with a callback.
79
88
80
-
Registers a queue and continuously polls for events, calling the
81
-
callback for each event. Automatically handles reconnection if
82
-
the queue expires.
89
+
Registers a queue and continuously polls for events, calling the callback
90
+
for each event. Automatically handles reconnection if the queue expires.
83
91
84
92
This function runs indefinitely until cancelled via [Eio.Cancel].
85
93
···
97
105
unit
98
106
(** Process message events with a callback.
99
107
100
-
Convenience wrapper around [call_on_each_event] that filters
101
-
for message events and extracts the message data.
108
+
Convenience wrapper around [call_on_each_event] that filters for message
109
+
events and extracts the message data.
102
110
103
111
@param narrow Narrow filter for messages
104
112
@param callback Function called with each message's JSON data *)
···
108
116
For use with Eio's streaming patterns. *)
109
117
110
118
val events : t -> Client.t -> Event.t Seq.t
111
-
(** Create a lazy sequence of events from the queue.
112
-
The sequence polls the server as needed.
119
+
(** Create a lazy sequence of events from the queue. The sequence polls the
120
+
server as needed.
113
121
114
122
Note: This sequence is infinite - use [Seq.take] or similar to limit. *)
115
123
+5
lib/zulip/event_type.ml
+5
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
+
1
6
type t =
2
7
| Message
3
8
| Heartbeat
+10
-5
lib/zulip/event_type.mli
+10
-5
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
+
1
6
(** Zulip event types.
2
7
3
-
This module defines the event types that can be received from the
4
-
Zulip event queue. These correspond to the "type" field in event
5
-
objects returned by the /events endpoint. *)
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. *)
6
11
7
12
(** {1 Event Types} *)
8
13
···
32
37
(** Convert an event type to its wire format string. *)
33
38
34
39
val of_string : string -> t
35
-
(** Parse an event type from its wire format string.
36
-
Unknown types are wrapped in [Other]. *)
40
+
(** Parse an event type from its wire format string. Unknown types are wrapped
41
+
in [Other]. *)
37
42
38
43
(** {1 Pretty Printing} *)
39
44
+11
-6
lib/zulip/message.ml
+11
-6
lib/zulip/message.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
type t = {
2
7
type_ : Message_type.t;
3
8
to_ : string list;
···
8
13
read_by_sender : bool;
9
14
}
10
15
11
-
let create ~type_ ~to_ ~content ?topic ?queue_id ?local_id ?(read_by_sender = true) () =
16
+
let create ~type_ ~to_ ~content ?topic ?queue_id ?local_id
17
+
?(read_by_sender = true) () =
12
18
{ type_; to_; content; topic; queue_id; local_id; read_by_sender }
13
19
14
20
let type_ t = t.type_
···
20
26
let read_by_sender t = t.read_by_sender
21
27
22
28
let pp fmt t =
23
-
Format.fprintf fmt "Message{type=%a, to=%s, content=%s}"
24
-
Message_type.pp t.type_
25
-
(String.concat "," t.to_)
26
-
t.content
29
+
Format.fprintf fmt "Message{type=%a, to=%s, content=%s}" Message_type.pp
30
+
t.type_ (String.concat "," t.to_) t.content
27
31
28
32
(* Jsont codec for Message_type.t *)
29
33
let message_type_jsont =
···
32
36
| Some t -> Ok t
33
37
| None -> Error (Format.sprintf "Invalid message type: %s" s)
34
38
in
35
-
Jsont.of_of_string ~kind:"Message_type.t" of_string ~enc:Message_type.to_string
39
+
Jsont.of_of_string ~kind:"Message_type.t" of_string
40
+
~enc:Message_type.to_string
36
41
37
42
(* Jsont codec for the message *)
38
43
let jsont =
+8
-3
lib/zulip/message.mli
+8
-3
lib/zulip/message.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Outgoing Zulip messages.
2
7
3
-
This module represents messages to be sent via the Zulip API.
4
-
Use {!jsont} with Bytesrw-eio for wire serialization. *)
8
+
This module represents messages to be sent via the Zulip API. Use {!jsont}
9
+
with Bytesrw-eio for wire serialization. *)
5
10
6
11
type t
7
12
···
24
29
val local_id : t -> string option
25
30
val read_by_sender : t -> bool
26
31
27
-
(** Jsont codec for the message type *)
28
32
val jsont : t Jsont.t
33
+
(** Jsont codec for the message type *)
29
34
30
35
val pp : Format.formatter -> t -> unit
+6
-3
lib/zulip/message_flag.ml
+6
-3
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
+
1
6
type modifiable = [ `Read | `Starred | `Collapsed ]
2
7
3
8
type t =
···
5
10
| `Mentioned
6
11
| `Wildcard_mentioned
7
12
| `Has_alert_word
8
-
| `Historical
9
-
]
13
+
| `Historical ]
10
14
11
15
let to_string = function
12
16
| `Read -> "read"
···
36
40
type op = Add | Remove
37
41
38
42
let op_to_string = function Add -> "add" | Remove -> "remove"
39
-
40
43
let pp fmt t = Format.fprintf fmt "%s" (to_string t)
41
44
42
45
let jsont =
+9
-7
lib/zulip/message_flag.mli
+9
-7
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
+
1
6
(** Message flags in Zulip.
2
7
3
-
Message flags indicate read/unread status, starred messages,
4
-
mentions, and other message properties. *)
8
+
Message flags indicate read/unread status, starred messages, mentions, and
9
+
other message properties. *)
5
10
6
11
(** {1 Flag Types} *)
7
12
8
13
type modifiable =
9
14
[ `Read (** Message has been read *)
10
15
| `Starred (** Message is starred/bookmarked *)
11
-
| `Collapsed (** Message content is collapsed *)
12
-
]
16
+
| `Collapsed (** Message content is collapsed *) ]
13
17
(** Flags that can be directly modified by the user. *)
14
18
15
19
type t =
···
17
21
| `Mentioned (** User was @-mentioned in the message *)
18
22
| `Wildcard_mentioned (** User was mentioned via @all/@everyone *)
19
23
| `Has_alert_word (** Message contains one of user's alert words *)
20
-
| `Historical (** Message predates user joining the stream *)
21
-
]
24
+
| `Historical (** Message predates user joining the stream *) ]
22
25
(** All possible message flags. *)
23
26
24
27
(** {1 Conversion} *)
···
47
50
(** {1 JSON Codec} *)
48
51
49
52
val jsont : t Jsont.t
50
-
51
53
val modifiable_jsont : modifiable Jsont.t
+6
-5
lib/zulip/message_response.ml
+6
-5
lib/zulip/message_response.ml
···
1
-
type t = {
2
-
id : int;
3
-
automatic_new_visibility_policy : string option;
4
-
}
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 }
5
7
6
8
let id t = t.id
7
9
let automatic_new_visibility_policy t = t.automatic_new_visibility_policy
8
-
9
10
let pp fmt t = Format.fprintf fmt "MessageResponse{id=%d}" t.id
10
11
11
12
(* Jsont codec for message response *)
+8
-3
lib/zulip/message_response.mli
+8
-3
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
+
1
6
(** Response from sending a Zulip message.
2
7
3
-
This module represents the response returned when a message is sent.
4
-
Use {!jsont} with Bytesrw-eio for wire serialization. *)
8
+
This module represents the response returned when a message is sent. Use
9
+
{!jsont} with Bytesrw-eio for wire serialization. *)
5
10
6
11
type t
7
12
8
13
val id : t -> int
9
14
val automatic_new_visibility_policy : t -> string option
10
15
11
-
(** Jsont codec for message response *)
12
16
val jsont : t Jsont.t
17
+
(** Jsont codec for message response *)
13
18
14
19
val pp : Format.formatter -> t -> unit
+7
-4
lib/zulip/message_type.ml
+7
-4
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
+
1
6
type t = [ `Direct | `Channel ]
2
7
3
-
let to_string = function
4
-
| `Direct -> "direct"
5
-
| `Channel -> "stream"
8
+
let to_string = function `Direct -> "direct" | `Channel -> "stream"
6
9
7
10
let of_string = function
8
11
| "direct" -> Some `Direct
9
12
| "stream" -> Some `Channel
10
13
| _ -> None
11
14
12
-
let pp fmt t = Format.fprintf fmt "%s" (to_string t)
15
+
let pp fmt t = Format.fprintf fmt "%s" (to_string t)
+6
-1
lib/zulip/message_type.mli
+6
-1
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
+
1
6
type t = [ `Direct | `Channel ]
2
7
3
8
val to_string : t -> string
4
9
val of_string : string -> t option
5
-
val pp : Format.formatter -> t -> unit
10
+
val pp : Format.formatter -> t -> unit
+23
-17
lib/zulip/messages.ml
+23
-17
lib/zulip/messages.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
let send client message =
2
7
let body = Encode.to_form_urlencoded Message.jsont message in
3
8
let content_type = "application/x-www-form-urlencoded" in
···
5
10
Client.request client ~method_:`POST ~path:"/api/v1/messages" ~body
6
11
~content_type ()
7
12
in
8
-
Error.decode_or_raise Message_response.jsont response "parsing message response"
13
+
Error.decode_or_raise Message_response.jsont response
14
+
"parsing message response"
9
15
10
16
let get client ~message_id =
11
17
Client.request client ~method_:`GET
···
25
31
~params:[ ("apply_markdown", "false") ]
26
32
()
27
33
in
28
-
Error.decode_or_raise response_codec json (Printf.sprintf "getting raw message %d" message_id)
34
+
Error.decode_or_raise response_codec json
35
+
(Printf.sprintf "getting raw message %d" message_id)
29
36
30
37
type anchor = Newest | Oldest | First_unread | Message_id of int
31
38
···
35
42
| First_unread -> "first_unread"
36
43
| Message_id id -> string_of_int id
37
44
38
-
let get_messages client ?anchor ?num_before ?num_after ?narrow ?include_anchor
45
+
let get_messages client ~anchor ?num_before ?num_after ?narrow ?include_anchor
39
46
() =
40
47
let params =
41
-
List.filter_map Fun.id
42
-
[
43
-
Option.map (fun a -> ("anchor", anchor_to_string a)) anchor;
44
-
Option.map (fun n -> ("num_before", string_of_int n)) num_before;
45
-
Option.map (fun n -> ("num_after", string_of_int n)) num_after;
46
-
Option.map
47
-
(fun n -> ("narrow", Encode.to_json_string Narrow.list_jsont n))
48
-
narrow;
49
-
Option.map
50
-
(fun v -> ("include_anchor", string_of_bool v))
51
-
include_anchor;
52
-
]
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
+
]
53
60
in
54
61
Client.request client ~method_:`GET ~path:"/api/v1/messages" ~params ()
55
62
···
219
226
let delete_scheduled client ~scheduled_message_id =
220
227
let _response =
221
228
Client.request client ~method_:`DELETE
222
-
~path:
223
-
("/api/v1/scheduled_messages/" ^ string_of_int scheduled_message_id)
229
+
~path:("/api/v1/scheduled_messages/" ^ string_of_int scheduled_message_id)
224
230
()
225
231
in
226
232
()
+20
-15
lib/zulip/messages.mli
+20
-15
lib/zulip/messages.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Message operations for the Zulip API.
2
7
3
-
All functions raise [Eio.Io] with [Error.E error] on failure.
4
-
Context is automatically added indicating the operation being performed. *)
8
+
All functions raise [Eio.Io] with [Error.E error] on failure. Context is
9
+
automatically added indicating the operation being performed. *)
5
10
6
11
(** {1 Sending Messages} *)
7
12
···
12
17
(** {1 Reading Messages} *)
13
18
14
19
val get : Client.t -> message_id:int -> Jsont.json
15
-
(** Get a single message by ID.
16
-
Returns the full message object.
20
+
(** Get a single message by ID. Returns the full message object.
17
21
@raise Eio.Io on failure *)
18
22
19
23
val get_raw : Client.t -> message_id:int -> string
···
29
33
30
34
val get_messages :
31
35
Client.t ->
32
-
?anchor:anchor ->
36
+
anchor:anchor ->
33
37
?num_before:int ->
34
38
?num_after:int ->
35
39
?narrow:Narrow.t list ->
···
38
42
Jsont.json
39
43
(** Get multiple messages with optional filtering.
40
44
41
-
@param anchor Where to start fetching (default: [Newest])
45
+
@param anchor Where to start fetching (required)
42
46
@param num_before Number of messages before anchor (default: 0)
43
47
@param num_after Number of messages after anchor (default: 0)
44
48
@param narrow Filter criteria (see {!Narrow})
···
47
51
48
52
val check_messages_match_narrow :
49
53
Client.t -> message_ids:int list -> narrow:Narrow.t list -> Jsont.json
50
-
(** Check if messages match a narrow filter.
51
-
Returns which of the given messages match the narrow.
54
+
(** Check if messages match a narrow filter. Returns which of the given messages
55
+
match the narrow.
52
56
@raise Eio.Io on failure *)
53
57
54
58
(** {1 Message History} *)
···
110
114
{b Example:}
111
115
{[
112
116
(* Mark messages as read *)
113
-
Messages.update_flags client
114
-
~messages:[123; 456; 789]
115
-
~op:Add
117
+
Messages.update_flags client ~messages:[ 123; 456; 789 ] ~op:Add
116
118
~flag:`Read
117
119
]} *)
118
120
···
170
172
(** {1 Rendering} *)
171
173
172
174
val render : Client.t -> content:string -> string
173
-
(** Render message content as HTML.
174
-
Useful for previewing how a message will appear.
175
+
(** Render message content as HTML. Useful for previewing how a message will
176
+
appear.
175
177
@return The rendered HTML
176
178
@raise Eio.Io on failure *)
177
179
···
187
189
{b Example:}
188
190
{[
189
191
let uri = Messages.upload_file client ~filename:"/path/to/image.png" in
190
-
let msg = Message.create ~type_:`Channel ~to_:["general"]
191
-
~content:("Check out this image: " ^ uri) () in
192
+
let msg =
193
+
Message.create ~type_:`Channel ~to_:[ "general" ]
194
+
~content:("Check out this image: " ^ uri)
195
+
()
196
+
in
192
197
Messages.send client msg
193
198
]} *)
194
199
+30
-25
lib/zulip/narrow.ml
+30
-25
lib/zulip/narrow.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
type t = {
2
7
operator : string;
3
8
operand : [ `String of string | `Int of int | `Strings of string list ];
···
5
10
}
6
11
7
12
let make ?(negated = false) operator operand = { operator; operand; negated }
8
-
9
13
let stream name = make "stream" (`String name)
10
14
let stream_id id = make "stream" (`Int id)
11
15
let topic name = make "topic" (`String name)
12
16
let channel = stream
13
-
14
17
let sender email = make "sender" (`String email)
15
18
let sender_id id = make "sender" (`Int id)
16
19
···
37
40
| `Reaction -> "reaction"
38
41
39
42
let has operand = make "has" (`String (has_operand_to_string operand))
40
-
41
43
let search query = make "search" (`String query)
42
-
43
44
let id msg_id = make "id" (`Int msg_id)
44
45
let near msg_id = make "near" (`Int msg_id)
45
-
46
46
let dm emails = make "dm" (`Strings emails)
47
47
let dm_including email = make "dm-including" (`String email)
48
48
let group_pm_with = dm_including
49
-
50
49
let not_ filter = { filter with negated = true }
51
50
52
51
let to_json filters =
···
54
53
let make_string s = Jsont.String (s, meta) in
55
54
let make_member name value = ((name, meta), value) in
56
55
Jsont.Array
57
-
(List.map
58
-
(fun f ->
59
-
let operand_json =
60
-
match f.operand with
61
-
| `String s -> make_string s
62
-
| `Int i -> Jsont.Number (float_of_int i, meta)
63
-
| `Strings ss -> Jsont.Array (List.map make_string ss, meta)
64
-
in
65
-
let fields =
66
-
[ make_member "operator" (make_string f.operator);
67
-
make_member "operand" operand_json ]
68
-
in
69
-
let fields =
70
-
if f.negated then make_member "negated" (Jsont.Bool (true, meta)) :: fields else fields
71
-
in
72
-
Jsont.Object (fields, meta))
73
-
filters, meta)
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 )
74
78
75
79
let operand_to_json = function
76
80
| `String s -> Jsont.String (s, Jsont.Meta.none)
77
81
| `Int i -> Jsont.Number (float_of_int i, Jsont.Meta.none)
78
82
| `Strings ss ->
79
83
Jsont.Array
80
-
(List.map (fun s -> Jsont.String (s, Jsont.Meta.none)) ss, Jsont.Meta.none)
84
+
( List.map (fun s -> Jsont.String (s, Jsont.Meta.none)) ss,
85
+
Jsont.Meta.none )
81
86
82
87
let operand_of_json = function
83
88
| Jsont.String (s, _) -> `String s
···
100
105
|> Jsont.Object.mem "operator" Jsont.string ~enc:(fun t -> t.operator)
101
106
|> Jsont.Object.mem "operand" operand_jsont ~enc:(fun t -> t.operand)
102
107
|> Jsont.Object.mem "negated" Jsont.bool ~dec_absent:false ~enc:(fun t ->
103
-
t.negated)
108
+
t.negated)
104
109
|> Jsont.Object.finish
105
110
106
111
let list_jsont = Jsont.list jsont
+16
-15
lib/zulip/narrow.mli
+16
-15
lib/zulip/narrow.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Type-safe narrow filters for message queries.
2
7
3
8
Narrow filters constrain which messages are returned by the
4
-
[Messages.get_messages] endpoint. This module provides a type-safe
5
-
interface for constructing these filters.
9
+
[Messages.get_messages] endpoint. This module provides a type-safe interface
10
+
for constructing these filters.
6
11
7
12
Example:
8
13
{[
9
-
let narrow = Narrow.[
10
-
stream "general";
11
-
topic "greetings";
12
-
is `Unread;
13
-
] in
14
+
let narrow = Narrow.[ stream "general"; topic "greetings"; is `Unread ] in
14
15
Messages.get_messages client ~narrow ()
15
16
]} *)
16
17
···
39
40
(** [sender email] filters to messages from the given sender. *)
40
41
41
42
val sender_id : int -> t
42
-
(** [sender_id id] filters to messages from the sender with the given user ID. *)
43
+
(** [sender_id id] filters to messages from the sender with the given user ID.
44
+
*)
43
45
44
46
(** {1 Message Property Filters} *)
45
47
···
50
52
| `Private (** Alias for [`Dm] *)
51
53
| `Resolved (** Topics marked as resolved *)
52
54
| `Starred (** Starred messages *)
53
-
| `Unread (** Unread messages *)
54
-
]
55
+
| `Unread (** Unread messages *) ]
55
56
56
57
val is : is_operand -> t
57
58
(** [is operand] filters by message property. *)
···
60
61
[ `Attachment (** Messages with file attachments *)
61
62
| `Image (** Messages containing images *)
62
63
| `Link (** Messages containing links *)
63
-
| `Reaction (** Messages with emoji reactions *)
64
-
]
64
+
| `Reaction (** Messages with emoji reactions *) ]
65
65
66
66
val has : has_operand -> t
67
67
(** [has operand] filters to messages that have the given content type. *)
···
88
88
(** [dm_including email] filters to direct messages that include this user. *)
89
89
90
90
val group_pm_with : string -> t
91
-
(** [group_pm_with email] filters to group DMs including this user (deprecated, use [dm_including]). *)
91
+
(** [group_pm_with email] filters to group DMs including this user (deprecated,
92
+
use [dm_including]). *)
92
93
93
94
(** {1 Negation} *)
94
95
95
96
val not_ : t -> t
96
-
(** [not_ filter] negates a filter.
97
-
Example: [not_ (stream "general")] excludes the "general" stream. *)
97
+
(** [not_ filter] negates a filter. Example: [not_ (stream "general")] excludes
98
+
the "general" stream. *)
98
99
99
100
(** {1 Encoding} *)
100
101
+9
-5
lib/zulip/presence.ml
+9
-5
lib/zulip/presence.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
type status = Active | Idle | Offline
2
7
3
8
type client_presence = {
···
44
49
45
50
let client_presence_jsont =
46
51
Jsont.Object.(
47
-
map ~kind:"ClientPresence"
48
-
(fun status timestamp client pushable ->
52
+
map ~kind:"ClientPresence" (fun status timestamp client pushable ->
49
53
{ status; timestamp; client; pushable })
50
54
|> mem "status" status_jsont ~enc:(fun p -> p.status)
51
55
|> mem "timestamp" Jsont.number ~enc:(fun p -> p.timestamp)
···
59
63
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
60
64
let aggregated =
61
65
match List.assoc_opt "aggregated" assoc with
62
-
| Some agg_json -> Encode.from_json client_presence_jsont agg_json |> Result.to_option
66
+
| Some agg_json ->
67
+
Encode.from_json client_presence_jsont agg_json |> Result.to_option
63
68
| None -> None
64
69
in
65
70
let clients =
···
76
81
| _ -> { aggregated = None; clients = [] }
77
82
78
83
let user_presence_jsont =
79
-
Jsont.map ~kind:"UserPresence" Jsont.json
80
-
~dec:parse_user_presence_from_json
84
+
Jsont.map ~kind:"UserPresence" Jsont.json ~dec:parse_user_presence_from_json
81
85
~enc:(fun p ->
82
86
let agg_field =
83
87
match p.aggregated with
+9
-7
lib/zulip/presence.mli
+9
-7
lib/zulip/presence.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** User presence information for the Zulip API.
2
7
3
8
Track online/offline status of users in the organization. *)
···
18
23
(** Presence information from a single client. *)
19
24
20
25
type user_presence = {
21
-
aggregated : client_presence option; (** Aggregated presence across clients *)
26
+
aggregated : client_presence option;
27
+
(** Aggregated presence across clients *)
22
28
clients : (string * client_presence) list; (** Per-client presence *)
23
29
}
24
30
(** A user's presence information. *)
···
34
40
@raise Eio.Io on failure *)
35
41
36
42
val get_all : Client.t -> (int * user_presence) list
37
-
(** Get presence information for all users in the organization.
38
-
Returns a list of (user_id, presence) pairs.
43
+
(** Get presence information for all users in the organization. Returns a list
44
+
of (user_id, presence) pairs.
39
45
@raise Eio.Io on failure *)
40
46
41
47
(** {1 Updating Presence} *)
···
57
63
(** {1 JSON Codecs} *)
58
64
59
65
val status_jsont : status Jsont.t
60
-
61
66
val client_presence_jsont : client_presence Jsont.t
62
-
63
67
val user_presence_jsont : user_presence Jsont.t
64
68
65
69
(** {1 Conversion} *)
66
70
67
71
val status_to_string : status -> string
68
-
69
72
val status_of_string : string -> status option
70
73
71
74
(** {1 Pretty Printing} *)
72
75
73
76
val pp_status : Format.formatter -> status -> unit
74
-
75
77
val pp_user_presence : Format.formatter -> user_presence -> unit
+69
-27
lib/zulip/server.ml
+69
-27
lib/zulip/server.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
type authentication_method = {
2
7
password : bool;
3
8
dev : bool;
···
53
58
let authentication_method_jsont =
54
59
Jsont.Object.(
55
60
map ~kind:"AuthenticationMethod"
56
-
(fun password dev email ldap remoteuser github azuread gitlab apple
57
-
google saml openid_connect ->
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
+
->
58
75
{
59
76
password;
60
77
dev;
···
73
90
|> mem "Dev" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.dev)
74
91
|> mem "Email" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.email)
75
92
|> mem "LDAP" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.ldap)
76
-
|> mem "RemoteUser" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.remoteuser)
93
+
|> mem "RemoteUser" Jsont.bool ~dec_absent:false ~enc:(fun a ->
94
+
a.remoteuser)
77
95
|> mem "GitHub" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.github)
78
96
|> mem "AzureAD" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.azuread)
79
97
|> mem "GitLab" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.gitlab)
···
81
99
|> mem "Google" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.google)
82
100
|> mem "SAML" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.saml)
83
101
|> mem "OpenID Connect" Jsont.bool ~dec_absent:false ~enc:(fun a ->
84
-
a.openid_connect)
102
+
a.openid_connect)
85
103
|> finish)
86
104
87
105
let external_authentication_method_jsont =
···
99
117
let jsont =
100
118
Jsont.Object.(
101
119
map ~kind:"ServerSettings"
102
-
(fun zulip_version zulip_feature_level zulip_merge_base
103
-
push_notifications_enabled is_incompatible email_auth_enabled
104
-
require_email_format_usernames realm_uri realm_name realm_icon
105
-
realm_description realm_web_public_access_enabled
106
-
authentication_methods external_authentication_methods ->
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
+
->
107
136
{
108
137
zulip_version;
109
138
zulip_feature_level;
···
122
151
})
123
152
|> mem "zulip_version" Jsont.string ~enc:(fun s -> s.zulip_version)
124
153
|> mem "zulip_feature_level" Jsont.int ~enc:(fun s -> s.zulip_feature_level)
125
-
|> opt_mem "zulip_merge_base" Jsont.string ~enc:(fun s -> s.zulip_merge_base)
154
+
|> opt_mem "zulip_merge_base" Jsont.string ~enc:(fun s ->
155
+
s.zulip_merge_base)
126
156
|> mem "push_notifications_enabled" Jsont.bool ~dec_absent:false
127
157
~enc:(fun s -> s.push_notifications_enabled)
128
158
|> mem "is_incompatible" Jsont.bool ~dec_absent:false ~enc:(fun s ->
129
-
s.is_incompatible)
159
+
s.is_incompatible)
130
160
|> mem "email_auth_enabled" Jsont.bool ~dec_absent:true ~enc:(fun s ->
131
-
s.email_auth_enabled)
161
+
s.email_auth_enabled)
132
162
|> mem "require_email_format_usernames" Jsont.bool ~dec_absent:true
133
163
~enc:(fun s -> s.require_email_format_usernames)
134
164
|> mem "realm_uri" Jsont.string ~enc:(fun s -> s.realm_uri)
135
165
|> mem "realm_name" Jsont.string ~dec_absent:"" ~enc:(fun s -> s.realm_name)
136
166
|> mem "realm_icon" Jsont.string ~dec_absent:"" ~enc:(fun s -> s.realm_icon)
137
167
|> mem "realm_description" Jsont.string ~dec_absent:"" ~enc:(fun s ->
138
-
s.realm_description)
168
+
s.realm_description)
139
169
|> mem "realm_web_public_access_enabled" Jsont.bool ~dec_absent:false
140
170
~enc:(fun s -> s.realm_web_public_access_enabled)
141
171
|> mem "authentication_methods" authentication_method_jsont ~enc:(fun s ->
142
-
s.authentication_methods)
172
+
s.authentication_methods)
143
173
|> mem "external_authentication_methods"
144
-
(Jsont.list external_authentication_method_jsont)
145
-
~dec_absent:[]
174
+
(Jsont.list external_authentication_method_jsont) ~dec_absent:[]
146
175
~enc:(fun s -> s.external_authentication_methods)
147
176
|> finish)
148
177
···
221
250
|> mem "name" Jsont.string ~enc:(fun (e : emoji) -> e.name)
222
251
|> mem "source_url" Jsont.string ~enc:(fun (e : emoji) -> e.source_url)
223
252
|> mem "deactivated" Jsont.bool ~dec_absent:false ~enc:(fun (e : emoji) ->
224
-
e.deactivated)
253
+
e.deactivated)
225
254
|> opt_mem "author_id" Jsont.int ~enc:(fun (e : emoji) -> e.author_id)
226
255
|> finish)
227
256
···
240
269
let emoji_with_name =
241
270
match emoji_json with
242
271
| Jsont.Object (e_fields, meta) ->
243
-
let name_field = (("name", Jsont.Meta.none), Jsont.String (name, Jsont.Meta.none)) in
272
+
let name_field =
273
+
( ("name", Jsont.Meta.none),
274
+
Jsont.String (name, Jsont.Meta.none) )
275
+
in
244
276
Jsont.Object (name_field :: e_fields, meta)
245
277
| _ -> emoji_json
246
278
in
···
310
342
let profile_field_type_jsont =
311
343
Jsont.map ~kind:"ProfileFieldType" Jsont.int
312
344
~dec:(fun i ->
313
-
match profile_field_type_of_int i with
314
-
| Some t -> t
315
-
| None -> Short_text)
345
+
match profile_field_type_of_int i with Some t -> t | None -> Short_text)
316
346
~enc:profile_field_type_to_int
317
347
318
348
let profile_field_jsont =
319
349
Jsont.Object.(
320
350
map ~kind:"ProfileField"
321
-
(fun id field_type order name hint field_data display_in_profile_summary ->
322
-
{ id; field_type; order; name; hint; field_data; display_in_profile_summary })
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
+
})
323
362
|> mem "id" Jsont.int ~enc:(fun p -> p.id)
324
363
|> mem "type" profile_field_type_jsont ~enc:(fun p -> p.field_type)
325
364
|> mem "order" Jsont.int ~enc:(fun p -> p.order)
326
365
|> mem "name" Jsont.string ~enc:(fun p -> p.name)
327
366
|> mem "hint" Jsont.string ~dec_absent:"" ~enc:(fun p -> p.hint)
328
-
|> mem "field_data" Jsont.json ~dec_absent:(Jsont.Null ((), Jsont.Meta.none)) ~enc:(fun p ->
329
-
p.field_data)
367
+
|> mem "field_data" Jsont.json
368
+
~dec_absent:(Jsont.Null ((), Jsont.Meta.none))
369
+
~enc:(fun p -> p.field_data)
330
370
|> opt_mem "display_in_profile_summary" Jsont.bool ~enc:(fun p ->
331
-
p.display_in_profile_summary)
371
+
p.display_in_profile_summary)
332
372
|> finish)
333
373
334
374
let get_profile_fields client =
335
375
let response_codec =
336
376
Jsont.Object.(
337
377
map ~kind:"ProfileFieldsResponse" Fun.id
338
-
|> mem "custom_profile_fields" (Jsont.list profile_field_jsont) ~enc:Fun.id
378
+
|> mem "custom_profile_fields"
379
+
(Jsont.list profile_field_jsont)
380
+
~enc:Fun.id
339
381
|> finish)
340
382
in
341
383
let json =
+8
-4
lib/zulip/server.mli
+8
-4
lib/zulip/server.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Server information and settings for the Zulip API.
2
7
3
-
This module provides access to server-level information including
4
-
version, feature level, and authentication methods. *)
8
+
This module provides access to server-level information including version,
9
+
feature level, and authentication methods. *)
5
10
6
11
(** {1 Server Settings} *)
7
12
···
59
64
(** {1 Feature Level Checks} *)
60
65
61
66
val feature_level : Client.t -> int
62
-
(** Get the server's feature level.
63
-
Useful for checking API compatibility.
67
+
(** Get the server's feature level. Useful for checking API compatibility.
64
68
@raise Eio.Io on failure *)
65
69
66
70
val supports_feature : Client.t -> level:int -> bool
+5
lib/zulip/typing.ml
+5
lib/zulip/typing.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
type op = Start | Stop
2
7
3
8
let op_to_string = function Start -> "start" | Stop -> "stop"
+10
-9
lib/zulip/typing.mli
+10
-9
lib/zulip/typing.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Typing notifications for the Zulip API.
2
7
3
-
Send typing start/stop notifications to indicate that the user
4
-
is composing a message. *)
8
+
Send typing start/stop notifications to indicate that the user is composing
9
+
a message. *)
5
10
6
11
(** {1 Typing Status Operations} *)
7
12
8
-
type op =
9
-
| Start (** User started typing *)
10
-
| Stop (** User stopped typing *)
13
+
type op = Start (** User started typing *) | Stop (** User stopped typing *)
11
14
12
15
(** {1 Direct Messages} *)
13
16
14
-
val set_dm :
15
-
Client.t -> op:op -> user_ids:int list -> unit
17
+
val set_dm : Client.t -> op:op -> user_ids:int list -> unit
16
18
(** Set typing status for a direct message conversation.
17
19
18
20
@param op Whether typing has started or stopped
···
21
23
22
24
(** {1 Channel Messages} *)
23
25
24
-
val set_channel :
25
-
Client.t -> op:op -> stream_id:int -> topic:string -> unit
26
+
val set_channel : Client.t -> op:op -> stream_id:int -> topic:string -> unit
26
27
(** Set typing status in a channel topic.
27
28
28
29
@param op Whether typing has started or stopped
+11
-4
lib/zulip/user.ml
+11
-4
lib/zulip/user.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
type t = {
2
7
email : string;
3
8
full_name : string;
···
102
107
|> Jsont.Object.mem "is_admin" Jsont.bool ~dec_absent:false ~enc:is_admin
103
108
|> Jsont.Object.mem "is_owner" Jsont.bool ~dec_absent:false ~enc:is_owner
104
109
|> Jsont.Object.mem "is_guest" Jsont.bool ~dec_absent:false ~enc:is_guest
105
-
|> Jsont.Object.mem "is_billing_admin" Jsont.bool
106
-
~dec_absent:false
110
+
|> Jsont.Object.mem "is_billing_admin" Jsont.bool ~dec_absent:false
107
111
~enc:is_billing_admin
108
112
|> Jsont.Object.mem "is_bot" Jsont.bool ~dec_absent:false ~enc:is_bot
109
113
|> Jsont.Object.opt_mem "bot_type" Jsont.int ~enc:bot_type
110
114
|> Jsont.Object.opt_mem "bot_owner_id" Jsont.int ~enc:bot_owner_id
111
-
|> Jsont.Object.opt_mem "avatar_url" Jsont.string ~enc:avatar_url
115
+
|> Jsont.Object.mem "avatar_url" (Jsont.option Jsont.string) ~dec_absent:None
116
+
~enc:avatar_url
112
117
|> Jsont.Object.opt_mem "avatar_version" Jsont.int ~enc:avatar_version
113
118
|> Jsont.Object.opt_mem "timezone" Jsont.string ~enc:timezone
114
119
|> Jsont.Object.opt_mem "date_joined" Jsont.string ~enc:date_joined
···
117
122
118
123
let pp fmt t =
119
124
let delivery =
120
-
Option.fold ~none:"" ~some:(Printf.sprintf ", delivery_email=%s") t.delivery_email
125
+
Option.fold ~none:""
126
+
~some:(Printf.sprintf ", delivery_email=%s")
127
+
t.delivery_email
121
128
in
122
129
let uid =
123
130
Option.fold ~none:"" ~some:(Printf.sprintf ", user_id=%d") t.user_id
+7
-2
lib/zulip/user.mli
+7
-2
lib/zulip/user.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Zulip user records.
2
7
3
-
This module represents user information from the Zulip API.
4
-
Use {!jsont} with Bytesrw-eio for wire serialization. *)
8
+
This module represents user information from the Zulip API. Use {!jsont}
9
+
with Bytesrw-eio for wire serialization. *)
5
10
6
11
(** {1 User Type} *)
7
12
+17
-5
lib/zulip/user_group.ml
+17
-5
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
+
1
6
type t = {
2
7
id : int;
3
8
name : string;
···
15
20
let jsont =
16
21
Jsont.Object.(
17
22
map ~kind:"UserGroup"
18
-
(fun id name description members direct_subgroup_ids is_system_group
19
-
can_mention_group ->
23
+
(fun
24
+
id
25
+
name
26
+
description
27
+
members
28
+
direct_subgroup_ids
29
+
is_system_group
30
+
can_mention_group
31
+
->
20
32
{
21
33
id;
22
34
name;
···
30
42
|> mem "name" Jsont.string ~enc:(fun g -> g.name)
31
43
|> mem "description" Jsont.string ~enc:(fun g -> g.description)
32
44
|> mem "members" (Jsont.list Jsont.int) ~dec_absent:[] ~enc:(fun g ->
33
-
g.members)
45
+
g.members)
34
46
|> mem "direct_subgroup_ids" (Jsont.list Jsont.int) ~dec_absent:[]
35
47
~enc:(fun g -> g.direct_subgroup_ids)
36
48
|> mem "is_system_group" Jsont.bool ~dec_absent:false ~enc:(fun g ->
37
-
g.is_system_group)
49
+
g.is_system_group)
38
50
|> mem "can_mention_group" Jsont.int ~dec_absent:0 ~enc:(fun g ->
39
-
g.can_mention_group)
51
+
g.can_mention_group)
40
52
|> finish)
41
53
42
54
let list client =
+5
lib/zulip/user_group.mli
+5
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
+
1
6
(** User groups for the Zulip API.
2
7
3
8
User groups allow organizing users and setting permissions. *)
+30
-21
lib/zulip/users.ml
+30
-21
lib/zulip/users.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
let list client =
2
7
let response_codec =
3
8
Jsont.Object.(
···
12
17
let params =
13
18
List.filter_map Fun.id
14
19
[
15
-
Option.map (fun v -> ("client_gravatar", string_of_bool v)) client_gravatar;
16
-
Option.map (fun v -> ("include_custom_profile_fields", string_of_bool v)) include_custom_profile_fields;
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;
17
26
]
18
27
in
19
28
let response_codec =
···
38
47
Client.request client ~method_:`GET ~path:("/api/v1/users/" ^ email) ()
39
48
in
40
49
Encode.from_json user_response_codec json
41
-
|> Result.fold
42
-
~ok:Fun.id
43
-
~error:(fun _ ->
44
-
Error.decode_or_raise User.jsont json (Printf.sprintf "parsing user %s" email))
50
+
|> Result.fold ~ok:Fun.id ~error:(fun _ ->
51
+
Error.decode_or_raise User.jsont json
52
+
(Printf.sprintf "parsing user %s" email))
45
53
46
54
let get_by_id client ~user_id ?include_custom_profile_fields () =
47
55
let params =
48
56
List.filter_map Fun.id
49
57
[
50
-
Option.map (fun v -> ("include_custom_profile_fields", string_of_bool v)) include_custom_profile_fields;
58
+
Option.map
59
+
(fun v -> ("include_custom_profile_fields", string_of_bool v))
60
+
include_custom_profile_fields;
51
61
]
52
62
in
53
63
let json =
···
56
66
~params ()
57
67
in
58
68
Encode.from_json user_response_codec json
59
-
|> Result.fold
60
-
~ok:Fun.id
61
-
~error:(fun _ ->
62
-
Error.decode_or_raise User.jsont json (Printf.sprintf "parsing user id %d" user_id))
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))
63
72
64
73
let me client =
65
74
let json = Client.request client ~method_:`GET ~path:"/api/v1/users/me" () in
···
202
211
?enable_offline_email_notifications ?enable_offline_push_notifications
203
212
?enable_online_push_notifications ?enable_digest_emails
204
213
?enable_marketing_emails ?enable_login_emails
205
-
?message_content_in_email_notifications
206
-
?pm_content_in_desktop_notifications ?wildcard_mentions_notify
207
-
?desktop_icon_count_display ?realm_name_in_notifications ?presence_enabled
208
-
?enter_sends () =
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 () =
209
217
let params =
210
218
List.filter_map Fun.id
211
219
[
···
283
291
(fun v -> ("enable_login_emails", string_of_bool v))
284
292
enable_login_emails;
285
293
Option.map
286
-
(fun v -> ("message_content_in_email_notifications", string_of_bool v))
294
+
(fun v ->
295
+
("message_content_in_email_notifications", string_of_bool v))
287
296
message_content_in_email_notifications;
288
297
Option.map
289
298
(fun v -> ("pm_content_in_desktop_notifications", string_of_bool v))
···
322
331
map ~kind:"MutedUsersResponse" Fun.id
323
332
|> mem "muted_users"
324
333
(Jsont.list
325
-
(Jsont.Object.(
326
-
map ~kind:"MutedUser" (fun id _ts -> id)
327
-
|> mem "id" Jsont.int ~enc:Fun.id
328
-
|> mem "timestamp" Jsont.int ~dec_absent:0 ~enc:(Fun.const 0)
329
-
|> finish)))
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))
330
339
~enc:Fun.id
331
340
|> finish)
332
341
in
+15
-15
lib/zulip/users.mli
+15
-15
lib/zulip/users.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** User operations for the Zulip API.
2
7
3
-
All functions raise [Eio.Io] with [Error.E error] on failure.
4
-
Context is automatically added indicating the operation being performed. *)
8
+
All functions raise [Eio.Io] with [Error.E error] on failure. Context is
9
+
automatically added indicating the operation being performed. *)
5
10
6
11
(** {1 Listing Users} *)
7
12
···
28
33
@raise Eio.Io on failure *)
29
34
30
35
val get_by_id :
31
-
Client.t -> user_id:int -> ?include_custom_profile_fields:bool -> unit -> User.t
36
+
Client.t ->
37
+
user_id:int ->
38
+
?include_custom_profile_fields:bool ->
39
+
unit ->
40
+
User.t
32
41
(** Get a user by their numeric ID.
33
42
@raise Eio.Io on failure *)
34
43
···
49
58
(** {1 Creating Users} *)
50
59
51
60
val create :
52
-
Client.t ->
53
-
email:string ->
54
-
full_name:string ->
55
-
password:string ->
56
-
unit
61
+
Client.t -> email:string -> full_name:string -> password:string -> unit
57
62
(** Create a new user.
58
63
@raise Eio.Io on failure *)
59
64
60
65
(** {1 Updating Users} *)
61
66
62
67
val update :
63
-
Client.t ->
64
-
user_id:int ->
65
-
?full_name:string ->
66
-
?role:int ->
67
-
unit ->
68
-
unit
68
+
Client.t -> user_id:int -> ?full_name:string -> ?role:int -> unit -> unit
69
69
(** Update a user's profile.
70
70
@raise Eio.Io on failure *)
71
71
···
97
97
98
98
(** {1 User Status} *)
99
99
100
-
(** User status types. *)
101
100
type status_emoji = {
102
101
emoji_name : string;
103
102
emoji_code : string option;
104
103
reaction_type : string option;
105
104
}
105
+
(** User status types. *)
106
106
107
107
val get_status : Client.t -> user_id:int -> Jsont.json
108
108
(** Get a user's status.
+7
-1
lib/zulip/zulip.ml
+7
-1
lib/zulip/zulip.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Main module for Zulip OCaml API bindings *)
2
7
3
8
type json = Jsont.json
4
9
10
+
module Error = Error
5
11
(** Re-export all submodules *)
6
-
module Error = Error
12
+
7
13
module Auth = Auth
8
14
module Client = Client
9
15
module Message = Message
+13
-11
lib/zulip/zulip.mli
+13
-11
lib/zulip/zulip.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Zulip API client library for OCaml.
2
7
3
-
This module provides a comprehensive interface to the Zulip REST API,
4
-
with support for messages, channels, users, and real-time events.
8
+
This module provides a comprehensive interface to the Zulip REST API, with
9
+
support for messages, channels, users, and real-time events.
5
10
6
11
{1 Quick Start}
7
12
···
27
32
28
33
{1 Error Handling}
29
34
30
-
Errors are raised as [Eio.Io] exceptions with [Error.E error],
31
-
following the Eio error pattern (like [Eio.Net.E] and [Eio.Fs.E]).
32
-
This provides context-aware error handling with automatic context
33
-
accumulation as errors propagate up the call stack.
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.
34
39
35
40
Example:
36
41
{[
37
-
try
38
-
Client.request client ~method_:`GET ~path:"/api/v1/users" ()
39
-
with
42
+
try Client.request client ~method_:`GET ~path:"/api/v1/users" () with
40
43
| Eio.Io (Error.E { code = Invalid_api_key; message; _ }, _) ->
41
44
(* Handle authentication error *)
42
45
Log.err (fun m -> m "Auth failed: %s" message)
···
44
47
(* Re-raise with additional context *)
45
48
let bt = Printexc.get_raw_backtrace () in
46
49
Eio.Exn.reraise_with_context ex bt "fetching user list"
47
-
]}
48
-
*)
50
+
]} *)
49
51
50
52
(** {1 Core Types} *)
51
53
+24
-22
lib/zulip_bot/bot.ml
+24
-22
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
+
1
6
let src = Logs.Src.create "zulip_bot.bot" ~doc:"Zulip bot runner"
2
7
3
8
module Log = (val Logs.src_log src : Logs.LOG)
···
13
18
Zulip.Client.create ~sw env auth
14
19
15
20
let fetch_identity client =
16
-
let json = Zulip.Client.request client ~method_:`GET ~path:"/api/v1/users/me" () in
17
-
match json with
18
-
| Jsont.Object (fields, _) ->
19
-
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
20
-
let get_int key =
21
-
List.assoc_opt key assoc
22
-
|> Option.fold ~none:0 ~some:(function Jsont.Number (f, _) -> int_of_float f | _ -> 0)
23
-
in
24
-
let get_string key =
25
-
List.assoc_opt key assoc
26
-
|> Option.fold ~none:"" ~some:(function Jsont.String (s, _) -> s | _ -> "")
27
-
in
28
-
{ user_id = get_int "user_id"; email = get_string "email"; full_name = get_string "full_name" }
29
-
| _ ->
30
-
Log.warn (fun m -> m "Unexpected response format from /users/me");
31
-
{ user_id = 0; email = ""; full_name = "" }
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
+
}
32
27
33
28
let send_response client ~in_reply_to response =
34
29
match response with
···
77
72
match event_data with
78
73
| Jsont.Object (fields, _) ->
79
74
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
80
-
let msg = List.assoc_opt "message" assoc |> Option.value ~default:event_data in
75
+
let msg =
76
+
List.assoc_opt "message" assoc |> Option.value ~default:event_data
77
+
in
81
78
let flgs =
82
79
List.assoc_opt "flags" assoc
83
-
|> Option.fold ~none:[] ~some:(function Jsont.Array (f, _) -> f | _ -> [])
80
+
|> Option.fold ~none:[] ~some:(function
81
+
| Jsont.Array (f, _) -> f
82
+
| _ -> [])
84
83
in
85
84
(msg, flgs)
86
85
| _ -> (event_data, [])
···
89
88
| Error err ->
90
89
Log.err (fun m -> m "Failed to parse message JSON: %s" err);
91
90
Log.debug (fun m -> m "@[%a@]" Message.pp_json_debug message_json)
92
-
| Ok message -> (
91
+
| Ok message ->
93
92
Log.info (fun m ->
94
93
m "@[<h>%a@]" (Message.pp_ansi ~show_json:false) message);
95
94
let is_mentioned =
···
99
98
|| Message.is_mentioned message ~user_email:identity.email
100
99
in
101
100
let is_private = Message.is_private message in
102
-
let is_from_self = Message.is_from_email message ~email:identity.email in
101
+
let is_from_self =
102
+
Message.is_from_email message ~email:identity.email
103
+
in
103
104
Log.debug (fun m ->
104
105
m "Message check: mentioned=%b, private=%b, from_self=%b"
105
106
is_mentioned is_private is_from_self);
···
112
113
Log.err (fun m -> m "Error handling message: %a" Eio.Exn.pp_err e))
113
114
else
114
115
Log.debug (fun m ->
115
-
m "Not processing (not mentioned and not private)")))
116
+
m "Not processing (not mentioned and not private)"))
116
117
| _ -> ()
117
118
118
119
let run ~sw ~env ~config ~handler =
···
128
129
~event_types:[ Zulip.Event_type.Message ]
129
130
()
130
131
in
131
-
Log.info (fun m -> m "Event queue registered: %s" (Zulip.Event_queue.id queue));
132
+
Log.info (fun m ->
133
+
m "Event queue registered: %s" (Zulip.Event_queue.id queue));
132
134
let rec event_loop last_event_id =
133
135
try
134
136
let events =
+40
-27
lib/zulip_bot/bot.mli
+40
-27
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
+
1
6
(** Fiber-based Zulip bot execution.
2
7
3
8
A bot is simply a function that processes messages. The [run] function
···
24
29
Eio.Switch.run @@ fun sw ->
25
30
let fs = Eio.Stdenv.fs env in
26
31
27
-
Eio.Fiber.all [
28
-
(fun () -> Bot.run ~sw ~env
29
-
~config:(Config.load ~fs "echo-bot")
30
-
~handler:echo_handler);
31
-
(fun () -> Bot.run ~sw ~env
32
-
~config:(Config.load ~fs "help-bot")
33
-
~handler:help_handler);
34
-
]
35
-
]}
36
-
*)
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
+
]} *)
37
44
38
45
(** {1 Types} *)
39
46
···
58
65
59
66
val run :
60
67
sw:Eio.Switch.t ->
61
-
env:< clock : float Eio.Time.clock_ty Eio.Resource.t
62
-
; net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t
63
-
; fs : Eio.Fs.dir_ty Eio.Path.t
64
-
; .. > ->
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
+
; .. > ->
65
73
config:Config.t ->
66
74
handler:handler ->
67
75
unit
···
86
94
87
95
val handle_webhook :
88
96
sw:Eio.Switch.t ->
89
-
env:< clock : float Eio.Time.clock_ty Eio.Resource.t
90
-
; net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t
91
-
; fs : Eio.Fs.dir_ty Eio.Path.t
92
-
; .. > ->
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
+
; .. > ->
93
102
config:Config.t ->
94
103
handler:handler ->
95
104
payload:string ->
96
105
Response.t option
97
-
(** [handle_webhook ~sw ~env ~config ~handler ~payload] processes a single webhook payload.
106
+
(** [handle_webhook ~sw ~env ~config ~handler ~payload] processes a single
107
+
webhook payload.
98
108
99
109
For webhook-based deployments, provide your own HTTP server and call this
100
110
function to process incoming webhook payloads from Zulip.
···
104
114
105
115
val send_response :
106
116
Zulip.Client.t -> in_reply_to:Message.t -> Response.t -> unit
107
-
(** [send_response client ~in_reply_to response] sends a response via the Zulip API.
117
+
(** [send_response client ~in_reply_to response] sends a response via the Zulip
118
+
API.
108
119
109
-
Utility function for webhook mode to send responses after processing.
110
-
The [in_reply_to] message is used to determine the reply context (stream/topic
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
111
122
or private message recipients). *)
112
123
113
124
(** {1 Utilities} *)
114
125
115
126
val create_client :
116
127
sw:Eio.Switch.t ->
117
-
env:< clock : float Eio.Time.clock_ty Eio.Resource.t
118
-
; net : [ `Generic | `Unix ] Eio.Net.ty Eio.Resource.t
119
-
; fs : Eio.Fs.dir_ty Eio.Path.t
120
-
; .. > ->
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
+
; .. > ->
121
133
config:Config.t ->
122
134
Zulip.Client.t
123
-
(** [create_client ~sw ~env ~config] creates a Zulip client from bot configuration.
135
+
(** [create_client ~sw ~env ~config] creates a Zulip client from bot
136
+
configuration.
124
137
125
138
Useful when you need direct access to the Zulip API beyond what the bot
126
139
framework provides. *)
+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. *)
+20
-14
lib/zulip_bot/config.ml
+20
-14
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
+
1
6
let src = Logs.Src.create "zulip_bot.config" ~doc:"Zulip bot configuration"
2
7
3
8
module Log = (val Logs.src_log src : Logs.LOG)
···
14
19
let create ~name ~site ~email ~api_key ?description ?usage () =
15
20
{ name; site; email; api_key; description; usage }
16
21
17
-
(** Convert bot name to environment variable prefix.
18
-
"my-bot" -> "ZULIP_MY_BOT" *)
22
+
(** Convert bot name to environment variable prefix. "my-bot" -> "ZULIP_MY_BOT"
23
+
*)
19
24
let env_prefix name =
20
25
let upper = String.uppercase_ascii name in
21
26
let replaced = String.map (fun c -> if c = '-' then '_' else c) upper in
22
27
"ZULIP_" ^ replaced ^ "_"
23
28
24
-
(** INI section record for parsing (without name field) *)
25
29
type ini_config = {
26
30
ini_site : string;
27
31
ini_email : string;
···
29
33
ini_description : string option;
30
34
ini_usage : string option;
31
35
}
36
+
(** INI section record for parsing (without name field) *)
32
37
33
38
(** Codec for parsing the bot section of the config file *)
34
39
let ini_section_codec =
35
40
Init.Section.(
36
41
obj (fun site email api_key description usage ->
37
-
{ ini_site = site; ini_email = email; ini_api_key = api_key;
38
-
ini_description = description; ini_usage = 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
+
})
39
49
|> mem "site" Init.string ~enc:(fun c -> c.ini_site)
40
50
|> mem "email" Init.string ~enc:(fun c -> c.ini_email)
41
51
|> mem "api_key" Init.string ~enc:(fun c -> c.ini_api_key)
42
52
|> opt_mem "description" Init.string ~enc:(fun c -> c.ini_description)
43
53
|> opt_mem "usage" Init.string ~enc:(fun c -> c.ini_usage)
44
-
|> skip_unknown
45
-
|> finish)
54
+
|> skip_unknown |> finish)
46
55
47
56
(** Document codec that accepts a [bot] section or bare options at top level *)
48
57
let ini_doc_codec =
49
58
Init.Document.(
50
59
obj (fun bot -> bot)
51
60
|> section "bot" ini_section_codec ~enc:Fun.id
52
-
|> skip_unknown
53
-
|> finish)
61
+
|> skip_unknown |> finish)
54
62
55
63
(** Codec for configs without section headers (bare key=value pairs) *)
56
64
let bare_section_codec =
57
65
Init.Document.(
58
66
obj (fun defaults -> defaults)
59
67
|> defaults ini_section_codec ~enc:Fun.id
60
-
|> skip_unknown
61
-
|> finish)
68
+
|> skip_unknown |> finish)
62
69
63
70
let load ~fs name =
64
71
Log.info (fun m -> m "Loading config for bot: %s" name);
···
69
76
let ini_config =
70
77
match Init_eio.decode_path ini_doc_codec config_file with
71
78
| Ok c -> c
72
-
| Error _ ->
79
+
| Error _ -> (
73
80
(* Try bare config format (no section headers) *)
74
81
match Init_eio.decode_path bare_section_codec config_file with
75
82
| Ok c -> c
76
-
| Error e ->
77
-
raise (Init_eio.err e)
83
+
| Error e -> raise (Init_eio.err e))
78
84
in
79
85
{
80
86
name;
+18
-9
lib/zulip_bot/config.mli
+18
-9
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
+
1
6
(** Bot configuration with XDG Base Directory support.
2
7
3
-
Configuration is loaded from XDG-compliant locations using the bot's name
4
-
to locate the appropriate configuration file. The configuration file should
5
-
be in INI format with the following structure:
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:
6
11
7
12
{v
8
13
[bot]
···
16
21
v}
17
22
18
23
Configuration files are searched in XDG config directories:
19
-
- [$XDG_CONFIG_HOME/zulip-bot/<name>/config] (typically [~/.config/zulip-bot/<name>/config])
24
+
- [$XDG_CONFIG_HOME/zulip-bot/<name>/config] (typically
25
+
[~/.config/zulip-bot/<name>/config])
20
26
- System directories as fallback
21
27
22
28
Environment variables can override file configuration:
23
29
- [ZULIP_<NAME>_SITE], [ZULIP_<NAME>_EMAIL], [ZULIP_<NAME>_API_KEY]
24
30
25
-
Where [<NAME>] is the uppercase version of the bot name with hyphens replaced by underscores. *)
31
+
Where [<NAME>] is the uppercase version of the bot name with hyphens
32
+
replaced by underscores. *)
26
33
27
34
type t = {
28
35
name : string; (** Bot name (used for XDG paths and identification) *)
···
47
54
configuration programmatically. *)
48
55
49
56
val load : fs:Eio.Fs.dir_ty Eio.Path.t -> string -> t
50
-
(** [load ~fs name] loads configuration for a named bot from XDG config directory.
57
+
(** [load ~fs name] loads configuration for a named bot from XDG config
58
+
directory.
51
59
52
60
Searches for configuration in:
53
61
- [$XDG_CONFIG_HOME/zulip-bot/<name>/config]
···
61
69
val from_env : string -> t
62
70
(** [from_env name] loads configuration from environment variables.
63
71
64
-
Reads the following environment variables (where [NAME] is the uppercase
65
-
bot name with hyphens replaced by underscores):
72
+
Reads the following environment variables (where [NAME] is the uppercase bot
73
+
name with hyphens replaced by underscores):
66
74
- [ZULIP_<NAME>_SITE] (required)
67
75
- [ZULIP_<NAME>_EMAIL] (required)
68
76
- [ZULIP_<NAME>_API_KEY] (required)
···
72
80
@raise Failure if required environment variables are not set *)
73
81
74
82
val load_or_env : fs:Eio.Fs.dir_ty Eio.Path.t -> string -> t
75
-
(** [load_or_env ~fs name] loads config from XDG location, falling back to environment.
83
+
(** [load_or_env ~fs name] loads config from XDG location, falling back to
84
+
environment.
76
85
77
86
Attempts to load from the XDG config file first. If that fails (file not
78
87
found or unreadable), falls back to environment variables.
+13
-2
lib/zulip_bot/dune
+13
-2
lib/zulip_bot/dune
···
1
1
(library
2
-
(public_name zulip_bot)
2
+
(public_name zulip.bot)
3
3
(name zulip_bot)
4
4
(wrapped true)
5
-
(libraries zulip eio jsont jsont.bytesrw logs fmt xdge init init.eio)
5
+
(libraries
6
+
zulip
7
+
eio
8
+
jsont
9
+
jsont.bytesrw
10
+
logs
11
+
logs.fmt
12
+
fmt
13
+
xdge
14
+
init
15
+
init.eio
16
+
cmdliner)
6
17
(flags
7
18
(:standard -warn-error -3)))
+243
-210
lib/zulip_bot/message.ml
+243
-210
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
+
1
6
(* Message parsing using Jsont codecs *)
2
7
3
8
let logs_src = Logs.Src.create "zulip_bot.message"
9
+
4
10
module Log = (val Logs.src_log logs_src : Logs.LOG)
5
11
6
12
(** User representation *)
7
13
module User = struct
8
14
type t = {
9
-
user_id: int;
10
-
email: string;
11
-
full_name: string;
12
-
short_name: string option;
13
-
unknown: Jsont.json; (** Unknown/extra JSON fields preserved during parsing *)
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 *)
14
21
}
15
22
16
23
let user_id t = t.user_id
···
21
28
(* Jsont codec for User - handles both user_id and id fields *)
22
29
let jsont : t Jsont.t =
23
30
let make email full_name short_name unknown =
24
-
(* user_id will be extracted in a custom way from the object *)
25
-
fun user_id_opt id_opt ->
26
-
let user_id = match user_id_opt, id_opt with
27
-
| Some uid, _ -> uid
28
-
| None, Some id -> id
29
-
| None, None -> Jsont.Error.msgf Jsont.Meta.none "Missing user_id or id field"
30
-
in
31
-
{ user_id; 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 }
32
41
in
33
42
Jsont.Object.map ~kind:"User" make
34
43
|> Jsont.Object.mem "email" Jsont.string ~enc:email
···
46
55
(** Reaction representation *)
47
56
module Reaction = struct
48
57
type t = {
49
-
emoji_name: string;
50
-
emoji_code: string;
51
-
reaction_type: string;
52
-
user_id: int;
53
-
unknown: Jsont.json; (** Unknown/extra JSON fields preserved during parsing *)
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 *)
54
64
}
55
65
56
66
let emoji_name t = t.emoji_name
···
67
77
|> Jsont.Object.finish
68
78
in
69
79
let make emoji_name emoji_code reaction_type unknown =
70
-
fun user_id_direct user_obj_nested ->
71
-
let user_id = match user_id_direct, user_obj_nested with
72
-
| Some uid, _ -> uid
73
-
| None, Some uid -> uid
74
-
| None, None -> Jsont.Error.msgf Jsont.Meta.none "Missing user_id field"
75
-
in
76
-
{ emoji_name; emoji_code; reaction_type; user_id; 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 }
77
88
in
78
89
Jsont.Object.map ~kind:"Reaction" make
79
90
|> Jsont.Object.mem "emoji_name" Jsont.string ~enc:emoji_name
···
91
102
let parse_reaction_json json = Reaction.of_json json
92
103
let parse_user_json json = User.of_json json
93
104
94
-
(** Common message fields *)
95
105
type common = {
96
-
id: int;
97
-
sender_id: int;
98
-
sender_email: string;
99
-
sender_full_name: string;
100
-
sender_short_name: string option;
101
-
timestamp: float;
102
-
content: string;
103
-
content_type: string;
104
-
reactions: Reaction.t list;
105
-
submessages: Zulip.json list;
106
-
flags: string list;
107
-
is_me_message: bool;
108
-
client: string;
109
-
gravatar_hash: string;
110
-
avatar_url: string option;
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;
111
121
}
122
+
(** Common message fields *)
112
123
113
124
(** Message types *)
114
125
type t =
115
-
| Private of {
116
-
common: common;
117
-
display_recipient: User.t list;
118
-
}
126
+
| Private of { common : common; display_recipient : User.t list }
119
127
| Stream of {
120
-
common: common;
121
-
display_recipient: string;
122
-
stream_id: int;
123
-
subject: string;
124
-
}
125
-
| Unknown of {
126
-
common: common;
127
-
raw_json: Zulip.json;
128
+
common : common;
129
+
display_recipient : string;
130
+
stream_id : int;
131
+
subject : string;
128
132
}
133
+
| Unknown of { common : common; raw_json : Zulip.json }
129
134
130
135
(** Helper function to parse common fields *)
131
136
let parse_common json =
132
137
match json with
133
-
| Jsont.Object (fields, _) ->
138
+
| Jsont.Object (fields, _) -> (
134
139
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
135
140
let get_int key =
136
141
List.assoc_opt key assoc
137
-
|> Option.fold ~none:None ~some:(function Jsont.Number (f, _) -> Some (int_of_float f) | _ -> None)
142
+
|> Option.fold ~none:None ~some:(function
143
+
| Jsont.Number (f, _) -> Some (int_of_float f)
144
+
| _ -> None)
138
145
in
139
146
let get_string key =
140
147
List.assoc_opt key assoc
141
-
|> Option.fold ~none:None ~some:(function Jsont.String (s, _) -> Some s | _ -> None)
148
+
|> Option.fold ~none:None ~some:(function
149
+
| Jsont.String (s, _) -> Some s
150
+
| _ -> None)
142
151
in
143
152
let get_float key default =
144
153
List.assoc_opt key assoc
145
-
|> Option.fold ~none:default ~some:(function Jsont.Number (f, _) -> f | _ -> default)
154
+
|> Option.fold ~none:default ~some:(function
155
+
| Jsont.Number (f, _) -> f
156
+
| _ -> default)
146
157
in
147
158
let get_bool key default =
148
159
List.assoc_opt key assoc
149
-
|> Option.fold ~none:default ~some:(function Jsont.Bool (b, _) -> b | _ -> default)
160
+
|> Option.fold ~none:default ~some:(function
161
+
| Jsont.Bool (b, _) -> b
162
+
| _ -> default)
150
163
in
151
164
let get_array key =
152
165
List.assoc_opt key assoc
153
-
|> Option.fold ~none:None ~some:(function Jsont.Array (arr, _) -> Some arr | _ -> None)
166
+
|> Option.fold ~none:None ~some:(function
167
+
| Jsont.Array (arr, _) -> Some arr
168
+
| _ -> None)
154
169
in
155
170
156
-
(match (get_int "id", get_int "sender_id", get_string "sender_email", get_string "sender_full_name") with
157
-
| (Some id, Some sender_id, Some sender_email, Some sender_full_name) ->
158
-
let sender_short_name = get_string "sender_short_name" in
159
-
let timestamp = get_float "timestamp" 0.0 in
160
-
let content = get_string "content" |> Option.value ~default:"" in
161
-
let content_type = get_string "content_type" |> Option.value ~default:"text/html" in
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
162
184
163
-
let reactions =
164
-
get_array "reactions"
165
-
|> Option.fold ~none:[] ~some:(List.filter_map (fun r ->
166
-
parse_reaction_json r
167
-
|> Result.fold ~ok:Option.some ~error:(fun msg ->
168
-
Log.warn (fun m -> m "Failed to parse reaction: %s" msg);
169
-
None)))
170
-
in
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
171
196
172
-
let submessages = get_array "submessages" |> Option.value ~default:[] in
197
+
let submessages =
198
+
get_array "submessages" |> Option.value ~default:[]
199
+
in
173
200
174
-
let flags =
175
-
get_array "flags"
176
-
|> Option.fold ~none:[] ~some:(List.filter_map (function
177
-
| Jsont.String (s, _) -> Some s
178
-
| _ -> None))
179
-
in
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
180
209
181
-
let is_me_message = get_bool "is_me_message" false in
182
-
let client = get_string "client" |> Option.value ~default:"" in
183
-
let gravatar_hash = get_string "gravatar_hash" |> Option.value ~default:"" in
184
-
let avatar_url = get_string "avatar_url" in
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
185
216
186
-
Ok {
187
-
id; sender_id; sender_email; sender_full_name; sender_short_name;
188
-
timestamp; content; content_type; reactions; submessages;
189
-
flags; is_me_message; client; gravatar_hash; avatar_url
190
-
}
191
-
| _ -> Error "Missing required message fields")
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")
192
236
| _ -> Error "Expected JSON object for message"
193
237
194
238
(** JSON parsing *)
···
203
247
204
248
match parse_common json with
205
249
| Error msg -> Error msg
206
-
| Ok common ->
250
+
| Ok common -> (
207
251
match json with
208
-
| Jsont.Object (fields, _) ->
252
+
| Jsont.Object (fields, _) -> (
209
253
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
210
254
let msg_type =
211
255
match List.assoc_opt "type" assoc with
212
256
| Some (Jsont.String (s, _)) -> Some s
213
257
| _ -> None
214
258
in
215
-
(match msg_type with
216
-
| Some "private" ->
217
-
(match List.assoc_opt "display_recipient" assoc with
218
-
| Some (Jsont.Array (recipient_json, _)) ->
219
-
let users = List.filter_map (fun u ->
220
-
match parse_user_json u with
221
-
| Ok user -> Some user
222
-
| Error msg ->
223
-
Log.warn (fun m -> m "Failed to parse user in display_recipient: %s" msg);
224
-
None
225
-
) recipient_json 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
226
277
227
-
if List.length users = 0 && List.length recipient_json > 0 then
228
-
Error "Failed to parse any users in display_recipient"
229
-
else
230
-
Ok (Private { common; display_recipient = users })
231
-
| _ ->
232
-
Log.warn (fun m -> m "display_recipient is not an array for private message");
233
-
Ok (Unknown { common; raw_json = json }))
234
-
235
-
| Some "stream" ->
236
-
let display_recipient =
237
-
match List.assoc_opt "display_recipient" assoc with
238
-
| Some (Jsont.String (s, _)) -> Some s
239
-
| _ -> None
240
-
in
241
-
let stream_id =
242
-
match List.assoc_opt "stream_id" assoc with
243
-
| Some (Jsont.Number (f, _)) -> Some (int_of_float f)
244
-
| _ -> None
245
-
in
246
-
let subject =
247
-
match List.assoc_opt "subject" assoc with
248
-
| Some (Jsont.String (s, _)) -> Some s
249
-
| _ -> None
250
-
in
251
-
(match (display_recipient, stream_id, subject) with
252
-
| (Some display_recipient, Some stream_id, Some subject) ->
253
-
Ok (Stream { common; display_recipient; stream_id; subject })
254
-
| _ ->
255
-
Log.warn (fun m -> m "Missing required fields for stream message");
256
-
Ok (Unknown { common; raw_json = json }))
257
-
258
-
| Some unknown_type ->
259
-
Log.warn (fun m -> m "Unknown message type: %s" unknown_type);
260
-
Ok (Unknown { common; raw_json = json })
261
-
262
-
| None ->
263
-
Log.warn (fun m -> m "No message type field found");
264
-
Ok (Unknown { common; raw_json = json }))
265
-
| _ -> Error "Expected JSON object for message"
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")
266
315
267
316
(** Accessor functions *)
268
317
let get_common = function
···
287
336
let avatar_url msg = (get_common msg).avatar_url
288
337
289
338
(** Helper functions *)
290
-
let is_private = function
291
-
| Private _ -> true
292
-
| _ -> false
293
-
294
-
let is_stream = function
295
-
| Stream _ -> true
296
-
| _ -> false
339
+
let is_private = function Private _ -> true | _ -> false
297
340
298
-
let is_from_self msg ~bot_user_id =
299
-
sender_id msg = bot_user_id
300
-
301
-
let is_from_email msg ~email =
302
-
sender_email msg = email
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
303
344
304
345
let get_reply_to = function
305
346
| Private { display_recipient; _ } ->
306
-
display_recipient
307
-
|> List.map User.email
308
-
|> String.concat ", "
347
+
display_recipient |> List.map User.email |> String.concat ", "
309
348
| Stream { display_recipient; _ } -> display_recipient
310
349
| Unknown _ -> ""
311
350
···
323
362
let username_mention = "@**" ^ username ^ "**" in
324
363
325
364
let contains text pattern =
326
-
if String.length pattern = 0 || String.length pattern > String.length text then
327
-
false
365
+
if String.length pattern = 0 || String.length pattern > String.length text
366
+
then false
328
367
else
329
368
let rec search_from pos =
330
-
if pos > String.length text - String.length pattern then
331
-
false
332
-
else if String.sub text pos (String.length pattern) = pattern then
333
-
true
334
-
else
335
-
search_from (pos + 1)
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)
336
372
in
337
373
search_from 0
338
374
in
···
352
388
(* Remove whichever mention pattern is found at the start *)
353
389
let without_mention =
354
390
if String.starts_with ~prefix:email_mention content_text then
355
-
String.sub content_text (String.length email_mention)
391
+
String.sub content_text
392
+
(String.length email_mention)
356
393
(String.length content_text - String.length email_mention)
357
394
else if String.starts_with ~prefix:username_mention content_text then
358
-
String.sub content_text (String.length username_mention)
395
+
String.sub content_text
396
+
(String.length username_mention)
359
397
(String.length content_text - String.length username_mention)
360
-
else
361
-
content_text
398
+
else content_text
362
399
in
363
400
String.trim without_mention
364
401
···
366
403
let content_text = String.trim (content msg) in
367
404
if String.length content_text > 0 && content_text.[0] = '!' then
368
405
Some (String.sub content_text 1 (String.length content_text - 1))
369
-
else
370
-
None
406
+
else None
371
407
372
408
let parse_command msg =
373
409
match extract_command msg with
374
410
| None -> None
375
-
| Some cmd_string ->
376
-
let parts = String.split_on_char ' ' (String.trim cmd_string) in
377
-
match parts with
378
-
| [] -> None
379
-
| cmd :: args -> Some (cmd, args)
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))
380
414
381
415
(** Pretty printing *)
382
416
let pp_user fmt user =
···
385
419
386
420
let _pp_reaction fmt reaction =
387
421
Format.fprintf fmt "{ emoji_name=%s; user_id=%d }"
388
-
(Reaction.emoji_name reaction) (Reaction.user_id reaction)
422
+
(Reaction.emoji_name reaction)
423
+
(Reaction.user_id reaction)
389
424
390
425
let pp fmt = function
391
426
| Private { common; display_recipient } ->
392
-
Format.fprintf fmt "Private { id=%d; sender=%s; recipients=[%a]; content=%S }"
393
-
common.id common.sender_email
394
-
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ") pp_user)
395
-
display_recipient
396
-
common.content
397
-
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
398
434
| Stream { common; display_recipient; subject; _ } ->
399
-
Format.fprintf fmt "Stream { id=%d; sender=%s; stream=%s; subject=%s; content=%S }"
400
-
common.id common.sender_email display_recipient subject common.content
401
-
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
402
438
| Unknown { common; _ } ->
403
-
Format.fprintf fmt "Unknown { id=%d; sender=%s; content=%S }"
404
-
common.id common.sender_email common.content
439
+
Format.fprintf fmt "Unknown { id=%d; sender=%s; content=%S }" common.id
440
+
common.sender_email common.content
405
441
406
442
(** ANSI colored pretty printing for debugging *)
407
-
let pp_ansi ?(show_json=false) ppf msg =
443
+
let pp_ansi ?(show_json = false) ppf msg =
408
444
let open Fmt in
409
445
let blue = styled `Blue string in
410
446
let green = styled `Green string in
···
415
451
416
452
match msg with
417
453
| Private { common; display_recipient } ->
418
-
pf ppf "%a %a %a %a %a"
419
-
(styled `Bold blue) "DM"
420
-
dim (Printf.sprintf "[#%d]" common.id)
421
-
(styled `Cyan string) common.sender_email
422
-
dim "→"
423
-
green (Printf.sprintf "%S" common.content);
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);
424
458
if show_json then
425
459
pf ppf "@. %a %a" dim "Recipients:"
426
460
(list ~sep:(const string ", ") (fun fmt u -> cyan fmt (User.email u)))
427
461
display_recipient
428
-
429
462
| Stream { common; display_recipient; subject; _ } ->
430
-
pf ppf "%a %a %a%a%a %a %a"
431
-
(styled `Bold yellow) "STREAM"
432
-
dim (Printf.sprintf "[#%d]" common.id)
433
-
magenta display_recipient
434
-
dim "/"
435
-
cyan subject
436
-
(styled `Cyan string) common.sender_email
437
-
green (Printf.sprintf "%S" common.content)
438
-
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)
439
468
| Unknown { common; _ } ->
440
469
pf ppf "%a %a %a %a"
441
-
(styled `Bold (styled (`Fg `Red) string)) "UNKNOWN"
442
-
dim (Printf.sprintf "[#%d]" common.id)
470
+
(styled `Bold (styled (`Fg `Red) string))
471
+
"UNKNOWN" dim
472
+
(Printf.sprintf "[#%d]" common.id)
443
473
(styled `Cyan string) common.sender_email
444
-
(styled (`Fg `Red) string) (Printf.sprintf "%S" common.content)
474
+
(styled (`Fg `Red) string)
475
+
(Printf.sprintf "%S" common.content)
445
476
446
477
(** Pretty print JSON for debugging *)
447
478
let pp_json_debug ppf json =
···
452
483
| Error _ -> "<error encoding json>"
453
484
in
454
485
pf ppf "@[<v>%a@.%a@]"
455
-
(styled `Bold (styled (`Fg `Blue) string)) "Raw JSON:"
456
-
(styled (`Fg `Black) string) json_str
486
+
(styled `Bold (styled (`Fg `Blue) string))
487
+
"Raw JSON:"
488
+
(styled (`Fg `Black) string)
489
+
json_str
+10
-5
lib/zulip_bot/message.mli
+10
-5
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
+
1
6
(** Zulip message types and utilities for bots *)
2
7
3
8
(** User representation *)
···
15
20
val full_name : t -> string
16
21
val short_name : t -> string option
17
22
18
-
(** Jsont codec for User *)
19
23
val jsont : t Jsont.t
24
+
(** Jsont codec for User *)
20
25
end
21
26
22
27
(** Reaction representation *)
···
34
39
val reaction_type : t -> string
35
40
val user_id : t -> int
36
41
42
+
val jsont : t Jsont.t
37
43
(** Jsont codec for Reaction *)
38
-
val jsont : t Jsont.t
39
44
end
40
45
41
-
(** Common message fields *)
42
46
type common = {
43
47
id : int;
44
48
sender_id : int;
···
56
60
gravatar_hash : string;
57
61
avatar_url : string option;
58
62
}
63
+
(** Common message fields *)
59
64
60
65
(** Message types *)
61
66
type t =
···
109
114
110
115
val pp : Format.formatter -> t -> unit
111
116
112
-
(** ANSI colored pretty printing for debugging *)
113
117
val pp_ansi : ?show_json:bool -> Format.formatter -> t -> unit
118
+
(** ANSI colored pretty printing for debugging *)
114
119
115
-
(** Pretty print JSON for debugging *)
116
120
val pp_json_debug : Format.formatter -> Zulip.json -> unit
121
+
(** Pretty print JSON for debugging *)
+5
lib/zulip_bot/response.ml
+5
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
+
1
6
type t =
2
7
| Reply of string
3
8
| Direct of { recipients : string list; content : string }
+14
-10
lib/zulip_bot/response.mli
+14
-10
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
+
1
6
(** Response types that bot handlers can return.
2
7
3
-
A handler processes a message and returns a response indicating what
4
-
action to take. The bot runner then executes the appropriate Zulip
5
-
API calls to send the response. *)
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. *)
6
11
7
12
type t =
8
13
| Reply of string
9
-
(** Reply in the same context as the incoming message.
10
-
For stream messages, replies to the same stream and topic.
11
-
For private messages, replies to the sender. *)
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. *)
12
17
| Direct of { recipients : string list; content : string }
13
-
(** Send a direct (private) message to specific users.
14
-
Recipients are specified by email address. *)
18
+
(** Send a direct (private) message to specific users. Recipients are
19
+
specified by email address. *)
15
20
| Stream of { stream : string; topic : string; content : string }
16
21
(** Send a message to a stream with a specific topic. *)
17
-
| Silent
18
-
(** No response - the bot acknowledges but does not reply. *)
22
+
| Silent (** No response - the bot acknowledges but does not reply. *)
19
23
20
24
(** {1 Constructors} *)
21
25
+11
-8
lib/zulip_bot/storage.ml
+11
-8
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
+
1
6
let src = Logs.Src.create "zulip_bot.storage" ~doc:"Zulip bot storage"
2
7
3
8
module Log = (val Logs.src_log src : Logs.LOG)
4
9
module String_map = Map.Make (String)
5
10
6
-
type t = {
7
-
client : Zulip.Client.t;
8
-
cache : (string, string) Hashtbl.t;
9
-
}
11
+
type t = { client : Zulip.Client.t; cache : (string, string) Hashtbl.t }
10
12
11
-
(** Storage response type - {"storage": {...}} *)
12
13
type storage_response = { storage : string String_map.t; unknown : Jsont.json }
14
+
(** Storage response type - {"storage": {...}} *)
13
15
14
16
let storage_response_jsont : storage_response Jsont.t =
15
17
let make storage unknown = { storage; unknown } in
···
21
23
|> Jsont.Object.finish
22
24
in
23
25
Jsont.Object.map ~kind:"StorageResponse" make
24
-
|> Jsont.Object.mem "storage" storage_map_jsont ~enc:(fun r -> r.storage)
26
+
|> Jsont.Object.mem "storage" storage_map_jsont
27
+
~enc:(fun r -> r.storage)
25
28
~dec_absent:String_map.empty
26
29
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)
27
30
|> Jsont.Object.finish
···
70
73
let params = [ ("keys", "[\"" ^ key ^ "\"]") ] in
71
74
try
72
75
let json =
73
-
Zulip.Client.request t.client ~method_:`GET ~path:"/api/v1/bot_storage"
74
-
~params ()
76
+
Zulip.Client.request t.client ~method_:`GET
77
+
~path:"/api/v1/bot_storage" ~params ()
75
78
in
76
79
match Zulip.Encode.from_json storage_response_jsont json with
77
80
| Ok response -> (
+7
-2
lib/zulip_bot/storage.mli
+7
-2
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
+
1
6
(** Bot storage - key-value storage via the Zulip bot storage API.
2
7
3
8
Provides persistent storage for bots using Zulip's built-in bot storage
···
17
22
val get : t -> string -> string option
18
23
(** [get t key] retrieves a value from storage.
19
24
20
-
Returns [Some value] if the key exists, [None] otherwise.
21
-
Checks the local cache first, then queries the server if not found. *)
25
+
Returns [Some value] if the key exists, [None] otherwise. Checks the local
26
+
cache first, then queries the server if not found. *)
22
27
23
28
val set : t -> string -> string -> unit
24
29
(** [set t key value] stores a value.
+16
-5
zulip.opam
+16
-5
zulip.opam
···
1
1
# This file is generated by dune, edit dune-project instead
2
2
opam-version: "2.0"
3
-
synopsis: "OCaml bindings for the Zulip REST API"
3
+
synopsis: "OCaml bindings for the Zulip REST API with bot framework"
4
4
description:
5
-
"High-quality OCaml bindings to the Zulip REST API using EIO for async operations"
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"
6
11
depends: [
7
-
"ocaml"
8
-
"dune" {>= "3.0"}
12
+
"ocaml" {>= "5.1.0"}
13
+
"dune" {>= "3.0" & >= "3.0"}
9
14
"eio"
10
15
"requests"
11
16
"uri"
12
17
"base64"
13
18
"init"
19
+
"jsont"
20
+
"logs"
21
+
"fmt"
22
+
"xdge"
23
+
"odoc" {with-doc}
14
24
"alcotest" {with-test}
15
25
"eio_main" {with-test}
16
-
"odoc" {with-doc}
26
+
"cmdliner" {with-test}
27
+
"mirage-crypto-rng" {with-test}
17
28
]
18
29
build: [
19
30
["dune" "subst"] {dev}
-32
zulip_bot.opam
-32
zulip_bot.opam
···
1
-
# This file is generated by dune, edit dune-project instead
2
-
opam-version: "2.0"
3
-
synopsis: "OCaml bot framework for Zulip"
4
-
description:
5
-
"Fiber-based bot framework for Zulip with XDG configuration support"
6
-
depends: [
7
-
"ocaml"
8
-
"dune" {>= "3.0"}
9
-
"zulip"
10
-
"eio"
11
-
"xdge"
12
-
"jsont"
13
-
"logs"
14
-
"fmt"
15
-
"init"
16
-
"alcotest" {with-test}
17
-
"odoc" {with-doc}
18
-
]
19
-
build: [
20
-
["dune" "subst"] {dev}
21
-
[
22
-
"dune"
23
-
"build"
24
-
"-p"
25
-
name
26
-
"-j"
27
-
jobs
28
-
"@install"
29
-
"@runtest" {with-test}
30
-
"@doc" {with-doc}
31
-
]
32
-
]