anil.recoil.org
Zulip bots with Eio
rename
+1586
+127
lib/zulip_bot/bot_config.ml
+127
lib/zulip_bot/bot_config.ml
···
1
+
type t = (string, string) Hashtbl.t
2
+
3
+
let create pairs =
4
+
let config = Hashtbl.create (List.length pairs) in
5
+
List.iter (fun (k, v) -> Hashtbl.replace config k v) pairs;
6
+
config
7
+
8
+
let from_file path =
9
+
try
10
+
let content =
11
+
let ic = open_in path in
12
+
let content = really_input_string ic (in_channel_length ic) in
13
+
close_in ic;
14
+
content
15
+
in
16
+
17
+
(* Simple INI-style parser for config files *)
18
+
let lines = String.split_on_char '\n' content in
19
+
let config = Hashtbl.create 16 in
20
+
let current_section = ref "" in
21
+
22
+
List.iter
23
+
(fun line ->
24
+
let line = String.trim line in
25
+
if String.length line > 0 && line.[0] <> '#' && line.[0] <> ';' then
26
+
if
27
+
String.length line > 2
28
+
&& line.[0] = '['
29
+
&& line.[String.length line - 1] = ']'
30
+
then
31
+
(* Section header *)
32
+
current_section := String.sub line 1 (String.length line - 2)
33
+
else
34
+
(* Key-value pair *)
35
+
match String.index_opt line '=' with
36
+
| Some idx ->
37
+
let key = String.trim (String.sub line 0 idx) in
38
+
let value =
39
+
String.trim
40
+
(String.sub line (idx + 1) (String.length line - idx - 1))
41
+
in
42
+
(* Remove quotes if present *)
43
+
let value =
44
+
if
45
+
String.length value >= 2
46
+
&& ((value.[0] = '"' && value.[String.length value - 1] = '"')
47
+
|| (value.[0] = '\''
48
+
&& value.[String.length value - 1] = '\''))
49
+
then String.sub value 1 (String.length value - 2)
50
+
else value
51
+
in
52
+
let full_key =
53
+
if !current_section = "" then key
54
+
else if
55
+
!current_section = "bot" || !current_section = "features"
56
+
then (* For bot and features sections, use flat keys *)
57
+
key
58
+
else !current_section ^ "." ^ key
59
+
in
60
+
Hashtbl.replace config full_key value
61
+
| None -> ())
62
+
lines;
63
+
64
+
config
65
+
with
66
+
| Eio.Exn.Io _ as ex -> raise ex
67
+
| Sys_error msg ->
68
+
let err =
69
+
Zulip.create_error ~code:(Other "file_error")
70
+
~msg:("Cannot read config file: " ^ msg)
71
+
()
72
+
in
73
+
raise (Eio.Exn.add_context (Zulip.err err) "reading config from %s" path)
74
+
| exn ->
75
+
let err =
76
+
Zulip.create_error ~code:(Other "parse_error")
77
+
~msg:("Error parsing config: " ^ Printexc.to_string exn)
78
+
()
79
+
in
80
+
raise (Eio.Exn.add_context (Zulip.err err) "parsing config from %s" path)
81
+
82
+
let from_env ~prefix =
83
+
try
84
+
let config = Hashtbl.create 16 in
85
+
let env_vars = Array.to_list (Unix.environment ()) in
86
+
87
+
List.iter
88
+
(fun env_var ->
89
+
match String.split_on_char '=' env_var with
90
+
| key :: value_parts
91
+
when String.length key > String.length prefix
92
+
&& String.sub key 0 (String.length prefix) = prefix ->
93
+
let config_key =
94
+
String.sub key (String.length prefix)
95
+
(String.length key - String.length prefix)
96
+
in
97
+
let value = String.concat "=" value_parts in
98
+
Hashtbl.replace config config_key value
99
+
| _ -> ())
100
+
env_vars;
101
+
102
+
config
103
+
with
104
+
| Eio.Exn.Io _ as ex -> raise ex
105
+
| exn ->
106
+
let err =
107
+
Zulip.create_error ~code:(Other "env_error")
108
+
~msg:("Error reading environment: " ^ Printexc.to_string exn)
109
+
()
110
+
in
111
+
raise (Eio.Exn.add_context (Zulip.err err) "reading env with prefix %s" prefix)
112
+
113
+
let get t ~key = Hashtbl.find_opt t key
114
+
115
+
let get_required t ~key =
116
+
match Hashtbl.find_opt t key with
117
+
| Some value -> value
118
+
| None ->
119
+
let err =
120
+
Zulip.create_error ~code:(Other "config_missing")
121
+
~msg:("Required config key missing: " ^ key)
122
+
()
123
+
in
124
+
raise (Zulip.err err)
125
+
126
+
let has_key t ~key = Hashtbl.mem t key
127
+
let keys t = Hashtbl.fold (fun k _ acc -> k :: acc) t []
+29
lib/zulip_bot/bot_config.mli
+29
lib/zulip_bot/bot_config.mli
···
1
+
(** Configuration management for bots.
2
+
3
+
All functions that can fail raise [Eio.Io] with [Zulip.E error]. *)
4
+
5
+
type t
6
+
7
+
val create : (string * string) list -> t
8
+
(** Create configuration from key-value pairs *)
9
+
10
+
val from_file : string -> t
11
+
(** Load configuration from file.
12
+
@raise Eio.Io on file read or parse errors *)
13
+
14
+
val from_env : prefix:string -> t
15
+
(** Load configuration from environment variables with prefix.
16
+
@raise Eio.Io if no matching variables found *)
17
+
18
+
val get : t -> key:string -> string option
19
+
(** Get a configuration value *)
20
+
21
+
val get_required : t -> key:string -> string
22
+
(** Get a required configuration value.
23
+
@raise Eio.Io if key not present *)
24
+
25
+
val has_key : t -> key:string -> bool
26
+
(** Check if a key exists in configuration *)
27
+
28
+
val keys : t -> string list
29
+
(** Get all configuration keys *)
+70
lib/zulip_bot/bot_handler.ml
+70
lib/zulip_bot/bot_handler.ml
···
1
+
module Response = struct
2
+
type t =
3
+
| Reply of string
4
+
| DirectMessage of { to_ : string; content : string }
5
+
| ChannelMessage of { channel : string; topic : string; content : string }
6
+
| None
7
+
8
+
let none = None
9
+
let reply content = Reply content
10
+
let direct_message ~to_ ~content = DirectMessage { to_; content }
11
+
12
+
let channel_message ~channel ~topic ~content =
13
+
ChannelMessage { channel; topic; content }
14
+
end
15
+
16
+
module Identity = struct
17
+
type t = {
18
+
full_name : string;
19
+
email : string;
20
+
mention_name : string;
21
+
}
22
+
23
+
let create ~full_name ~email ~mention_name = { full_name; email; mention_name }
24
+
let full_name t = t.full_name
25
+
let email t = t.email
26
+
let mention_name t = t.mention_name
27
+
end
28
+
29
+
(** Module signature for bot implementations *)
30
+
module type Bot_handler = sig
31
+
val initialize : Bot_config.t -> unit
32
+
val usage : unit -> string
33
+
val description : unit -> string
34
+
35
+
val handle_message :
36
+
config:Bot_config.t ->
37
+
storage:Bot_storage.t ->
38
+
identity:Identity.t ->
39
+
message:Message.t ->
40
+
env:_ ->
41
+
Response.t
42
+
end
43
+
44
+
module type S = Bot_handler
45
+
46
+
type t = {
47
+
module_impl : (module Bot_handler);
48
+
config : Bot_config.t;
49
+
storage : Bot_storage.t;
50
+
identity : Identity.t;
51
+
}
52
+
53
+
let create module_impl ~config ~storage ~identity =
54
+
{ module_impl; config; storage; identity }
55
+
56
+
(* Main message handling function - requires environment for proper EIO operations *)
57
+
let handle_message_with_env t env message =
58
+
let module Handler = (val t.module_impl) in
59
+
Handler.handle_message ~config:t.config ~storage:t.storage
60
+
~identity:t.identity ~message ~env
61
+
62
+
let identity t = t.identity
63
+
64
+
let usage t =
65
+
let module Handler = (val t.module_impl) in
66
+
Handler.usage ()
67
+
68
+
let description t =
69
+
let module Handler = (val t.module_impl) in
70
+
Handler.description ()
+77
lib/zulip_bot/bot_handler.mli
+77
lib/zulip_bot/bot_handler.mli
···
1
+
(** Bot handler framework for Zulip bots.
2
+
3
+
Functions that can fail raise [Eio.Io] with [Zulip.E error]. *)
4
+
5
+
(** Response types that bots can return *)
6
+
module Response : sig
7
+
type t =
8
+
| Reply of string
9
+
| DirectMessage of { to_ : string; content : string }
10
+
| ChannelMessage of { channel : string; topic : string; content : string }
11
+
| None
12
+
13
+
val none : t
14
+
val reply : string -> t
15
+
val direct_message : to_:string -> content:string -> t
16
+
val channel_message : channel:string -> topic:string -> content:string -> t
17
+
end
18
+
19
+
(** Bot identity information *)
20
+
module Identity : sig
21
+
type t
22
+
23
+
val create : full_name:string -> email:string -> mention_name:string -> t
24
+
val full_name : t -> string
25
+
val email : t -> string
26
+
val mention_name : t -> string
27
+
end
28
+
29
+
(** Module signature for bot implementations *)
30
+
module type Bot_handler = sig
31
+
val initialize : Bot_config.t -> unit
32
+
(** Initialize the bot (called once on startup).
33
+
@raise Eio.Io on failure *)
34
+
35
+
val usage : unit -> string
36
+
(** Provide usage/help text *)
37
+
38
+
val description : unit -> string
39
+
(** Provide bot description *)
40
+
41
+
val handle_message :
42
+
config:Bot_config.t ->
43
+
storage:Bot_storage.t ->
44
+
identity:Identity.t ->
45
+
message:Message.t ->
46
+
env:_ ->
47
+
Response.t
48
+
(** Handle an incoming message with EIO environment.
49
+
@raise Eio.Io on failure *)
50
+
end
51
+
52
+
(** Shorter alias for Bot_handler *)
53
+
module type S = Bot_handler
54
+
55
+
(** Abstract bot handler *)
56
+
type t
57
+
58
+
val create :
59
+
(module Bot_handler) ->
60
+
config:Bot_config.t ->
61
+
storage:Bot_storage.t ->
62
+
identity:Identity.t ->
63
+
t
64
+
(** Create a bot handler from a module *)
65
+
66
+
val handle_message_with_env : t -> _ -> Message.t -> Response.t
67
+
(** Process an incoming message with EIO environment.
68
+
@raise Eio.Io on failure *)
69
+
70
+
val identity : t -> Identity.t
71
+
(** Get bot identity *)
72
+
73
+
val usage : t -> string
74
+
(** Get bot usage text *)
75
+
76
+
val description : t -> string
77
+
(** Get bot description *)
+280
lib/zulip_bot/bot_runner.ml
+280
lib/zulip_bot/bot_runner.ml
···
1
+
(* Logging setup *)
2
+
let src = Logs.Src.create "zulip_bot.runner" ~doc:"Zulip bot runner"
3
+
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
(* Initialize crypto RNG - now done at module load time via Mirage_crypto_rng_unix *)
7
+
let () =
8
+
try
9
+
let _ =
10
+
Mirage_crypto_rng.generate ~g:(Mirage_crypto_rng.default_generator ()) 0
11
+
in
12
+
()
13
+
with _ ->
14
+
(* Generator not initialized - this will be done by applications using the library *)
15
+
()
16
+
17
+
type 'env t = {
18
+
client : Zulip.Client.t;
19
+
handler : Bot_handler.t;
20
+
mutable running : bool;
21
+
storage : Bot_storage.t;
22
+
env : 'env;
23
+
}
24
+
25
+
let create ~env ~client ~handler =
26
+
let bot_email =
27
+
(* Get bot email from handler identity *)
28
+
Bot_handler.Identity.email (Bot_handler.identity handler)
29
+
in
30
+
Log.info (fun m -> m "Creating bot runner for %s" bot_email);
31
+
let storage = Bot_storage.create client ~bot_email in
32
+
{ client; handler; running = false; storage; env }
33
+
34
+
(* Helper to extract clock from environment *)
35
+
(* The environment should have a #clock method *)
36
+
let get_clock (env : < clock : float Eio.Time.clock_ty Eio.Resource.t ; .. >) =
37
+
env#clock
38
+
39
+
let process_event t event =
40
+
(* Check if this is a message event *)
41
+
Log.debug (fun m ->
42
+
m "Processing event type: %s"
43
+
(Zulip.Event_type.to_string (Zulip.Event.type_ event)));
44
+
match Zulip.Event.type_ event with
45
+
| Zulip.Event_type.Message -> (
46
+
(* Get the message data from the event *)
47
+
let event_data = Zulip.Event.data event in
48
+
49
+
(* Extract the actual message from the event *)
50
+
let message_json, flags =
51
+
match event_data with
52
+
| Jsont.Object (fields, _) ->
53
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
54
+
let msg =
55
+
match List.assoc_opt "message" assoc with
56
+
| Some m -> m
57
+
| None -> event_data (* Fallback if structure is different *)
58
+
in
59
+
let flgs =
60
+
match List.assoc_opt "flags" assoc with
61
+
| Some (Jsont.Array (f, _)) -> f
62
+
| _ -> []
63
+
in
64
+
(msg, flgs)
65
+
| _ -> (event_data, [])
66
+
in
67
+
68
+
(* Parse the message JSON into Message.t *)
69
+
match Message.of_json message_json with
70
+
| Error err ->
71
+
Log.err (fun m -> m "Failed to parse message JSON: %s" err);
72
+
(* Show raw JSON for debugging *)
73
+
Log.debug (fun m -> m "@[%a@]" Message.pp_json_debug message_json)
74
+
| Ok message -> (
75
+
(* Log the parsed message with colors *)
76
+
Log.info (fun m ->
77
+
m "@[<h>%a@]" (Message.pp_ansi ~show_json:false) message);
78
+
79
+
(* Get bot identity for checking mentions *)
80
+
let bot_email =
81
+
Bot_handler.Identity.email (Bot_handler.identity t.handler)
82
+
in
83
+
84
+
(* Check if mentioned *)
85
+
let is_mentioned =
86
+
List.exists
87
+
(function Jsont.String ("mentioned", _) -> true | _ -> false)
88
+
flags
89
+
|| Message.is_mentioned message ~user_email:bot_email
90
+
in
91
+
92
+
(* Check if it's a private message *)
93
+
let is_private = Message.is_private message in
94
+
95
+
(* Don't respond to our own messages *)
96
+
let is_from_self = Message.is_from_email message ~email:bot_email in
97
+
98
+
(* Log what we found *)
99
+
Log.debug (fun m ->
100
+
m "Message check: mentioned=%b, private=%b, from_self=%b"
101
+
is_mentioned is_private is_from_self);
102
+
103
+
(* Only process if bot was mentioned or it's a private message, and not from self *)
104
+
if (is_mentioned || is_private) && not is_from_self then (
105
+
Log.info (fun m -> m "Bot should respond to this message");
106
+
107
+
(* Handle the message using exception-based handling *)
108
+
try
109
+
let response =
110
+
Bot_handler.handle_message_with_env t.handler t.env message
111
+
in
112
+
match response with
113
+
| Bot_handler.Response.Reply content ->
114
+
Log.debug (fun m -> m "Bot is sending reply: %s" content);
115
+
(* Send reply back using Message utilities *)
116
+
let message_to_send =
117
+
if Message.is_private message then (
118
+
(* Reply to private message *)
119
+
let sender = Message.sender_email message in
120
+
Log.debug (fun m -> m "Replying to sender: %s" sender);
121
+
Zulip.Message.create ~type_:`Direct ~to_:[ sender ]
122
+
~content ())
123
+
else
124
+
(* Reply to stream message *)
125
+
let reply_to = Message.get_reply_to message in
126
+
let topic =
127
+
match message with
128
+
| Message.Stream { subject; _ } -> Some subject
129
+
| _ -> None
130
+
in
131
+
Zulip.Message.create ~type_:`Channel ~to_:[ reply_to ]
132
+
~content ?topic ()
133
+
in
134
+
(try
135
+
let resp = Zulip.Messages.send t.client message_to_send in
136
+
Log.info (fun m ->
137
+
m "Reply sent successfully (id: %d)"
138
+
(Zulip.Message_response.id resp))
139
+
with Eio.Exn.Io (e, _) ->
140
+
Log.err (fun m ->
141
+
m "Error sending reply: %a" Eio.Exn.pp_err e))
142
+
| Bot_handler.Response.DirectMessage { to_; content } ->
143
+
Log.debug (fun m ->
144
+
m "Bot is sending direct message to: %s" to_);
145
+
let message_to_send =
146
+
Zulip.Message.create ~type_:`Direct ~to_:[ to_ ] ~content ()
147
+
in
148
+
(try
149
+
let resp = Zulip.Messages.send t.client message_to_send in
150
+
Log.info (fun m ->
151
+
m "Direct message sent successfully (id: %d)"
152
+
(Zulip.Message_response.id resp))
153
+
with Eio.Exn.Io (e, _) ->
154
+
Log.err (fun m ->
155
+
m "Error sending direct message: %a" Eio.Exn.pp_err e))
156
+
| Bot_handler.Response.ChannelMessage { channel; topic; content }
157
+
->
158
+
Log.debug (fun m ->
159
+
m "Bot is sending channel message to #%s - %s" channel
160
+
topic);
161
+
let message_to_send =
162
+
Zulip.Message.create ~type_:`Channel ~to_:[ channel ] ~topic
163
+
~content ()
164
+
in
165
+
(try
166
+
let resp = Zulip.Messages.send t.client message_to_send in
167
+
Log.info (fun m ->
168
+
m "Channel message sent successfully (id: %d)"
169
+
(Zulip.Message_response.id resp))
170
+
with Eio.Exn.Io (e, _) ->
171
+
Log.err (fun m ->
172
+
m "Error sending channel message: %a" Eio.Exn.pp_err e))
173
+
| Bot_handler.Response.None ->
174
+
Log.info (fun m -> m "Bot handler returned no response")
175
+
with Eio.Exn.Io (e, _) ->
176
+
Log.err (fun m -> m "Error handling message: %a" Eio.Exn.pp_err e))
177
+
else Log.info (fun m ->
178
+
m "Not processing message (not mentioned and not private)")))
179
+
| _ -> () (* Ignore non-message events for now *)
180
+
181
+
let run_realtime t =
182
+
t.running <- true;
183
+
Log.info (fun m -> m "Starting bot in real-time mode");
184
+
185
+
(* Get clock from environment *)
186
+
let clock = get_clock t.env in
187
+
188
+
(* Register for message events *)
189
+
try
190
+
let queue =
191
+
Zulip.Event_queue.register t.client
192
+
~event_types:[ Zulip.Event_type.Message ]
193
+
()
194
+
in
195
+
Log.info (fun m ->
196
+
m "Event queue registered: %s" (Zulip.Event_queue.id queue));
197
+
198
+
(* Main event loop *)
199
+
let rec event_loop last_event_id =
200
+
if not t.running then (
201
+
Log.info (fun m -> m "Bot stopping");
202
+
(* Clean up event queue *)
203
+
try
204
+
Zulip.Event_queue.delete queue t.client;
205
+
Log.info (fun m -> m "Event queue deleted")
206
+
with Eio.Exn.Io (e, _) ->
207
+
Log.err (fun m -> m "Error deleting queue: %a" Eio.Exn.pp_err e))
208
+
else
209
+
(* Get events from Zulip *)
210
+
try
211
+
let events =
212
+
Zulip.Event_queue.get_events queue t.client ~last_event_id ()
213
+
in
214
+
if List.length events > 0 then begin
215
+
Log.info (fun m -> m "Received %d event(s)" (List.length events));
216
+
List.iter
217
+
(fun event ->
218
+
Log.info (fun m ->
219
+
m "Event id=%d, type=%s" (Zulip.Event.id event)
220
+
(Zulip.Event_type.to_string (Zulip.Event.type_ event))))
221
+
events
222
+
end;
223
+
224
+
(* Process each event *)
225
+
List.iter (process_event t) events;
226
+
227
+
(* Get the highest event ID for next poll *)
228
+
let new_last_id =
229
+
List.fold_left
230
+
(fun max_id event -> max (Zulip.Event.id event) max_id)
231
+
last_event_id events
232
+
in
233
+
234
+
(* Continue polling *)
235
+
event_loop new_last_id
236
+
with Eio.Exn.Io (e, _) ->
237
+
(* Handle errors with exponential backoff *)
238
+
Log.warn (fun m ->
239
+
m "Error getting events: %a (retrying in 2s)" Eio.Exn.pp_err e);
240
+
241
+
(* Sleep using EIO clock *)
242
+
Eio.Time.sleep clock 2.0;
243
+
244
+
(* For now, treat all errors as recoverable *)
245
+
event_loop last_event_id
246
+
in
247
+
248
+
(* Start with last_event_id = -1 to get all events *)
249
+
event_loop (-1)
250
+
with Eio.Exn.Io (e, _) ->
251
+
Log.err (fun m -> m "Failed to register event queue: %a" Eio.Exn.pp_err e);
252
+
t.running <- false
253
+
254
+
let run_webhook t =
255
+
t.running <- true;
256
+
Log.info (fun m -> m "Bot started in webhook mode");
257
+
(* Webhook mode would wait for HTTP callbacks *)
258
+
(* Not implemented yet - would need HTTP server *)
259
+
()
260
+
261
+
let handle_webhook t ~webhook_data =
262
+
(* Process webhook data and route to handler *)
263
+
(* Parse the webhook data into Message.t first *)
264
+
match Message.of_json webhook_data with
265
+
| Error err ->
266
+
let e =
267
+
Zulip.create_error ~code:(Zulip.Other "parse_error")
268
+
~msg:("Failed to parse webhook message: " ^ err)
269
+
()
270
+
in
271
+
raise (Zulip.err e)
272
+
| Ok message ->
273
+
let response =
274
+
Bot_handler.handle_message_with_env t.handler t.env message
275
+
in
276
+
Some response
277
+
278
+
let shutdown t =
279
+
t.running <- false;
280
+
Log.info (fun m -> m "Bot shutting down")
+24
lib/zulip_bot/bot_runner.mli
+24
lib/zulip_bot/bot_runner.mli
···
1
+
(** Bot execution and lifecycle management.
2
+
3
+
Functions that can fail raise [Eio.Io] with [Zulip.E error]. *)
4
+
5
+
type 'env t
6
+
7
+
val create : env:'env -> client:Zulip.Client.t -> handler:Bot_handler.t -> 'env t
8
+
(** Create a bot runner *)
9
+
10
+
val run_realtime :
11
+
< clock : float Eio.Time.clock_ty Eio.Resource.t ; .. > t -> unit
12
+
(** Run the bot in real-time mode (using Zulip events API).
13
+
@raise Eio.Io on failure *)
14
+
15
+
val run_webhook : 'env t -> unit
16
+
(** Run the bot in webhook mode (for use with bot server) *)
17
+
18
+
val handle_webhook :
19
+
'env t -> webhook_data:Zulip.json -> Bot_handler.Response.t option
20
+
(** Process a single webhook event.
21
+
@raise Eio.Io on failure *)
22
+
23
+
val shutdown : 'env t -> unit
24
+
(** Gracefully shutdown the bot *)
+205
lib/zulip_bot/bot_storage.ml
+205
lib/zulip_bot/bot_storage.ml
···
1
+
(* Logging setup *)
2
+
let src = Logs.Src.create "zulip_bot.storage" ~doc:"Zulip bot storage"
3
+
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
type t = {
7
+
client : Zulip.Client.t;
8
+
bot_email : string;
9
+
cache : (string, string) Hashtbl.t;
10
+
mutable dirty_keys : string list;
11
+
}
12
+
13
+
(** {1 JSON Codecs for Bot Storage} *)
14
+
15
+
(* String map for storage values *)
16
+
module String_map = Map.Make (String)
17
+
18
+
(* Storage response type - {"storage": {...}} *)
19
+
type storage_response = {
20
+
storage : string String_map.t;
21
+
unknown : Jsont.json;
22
+
}
23
+
24
+
(* Codec for storage response using Jsont.Object with keep_unknown *)
25
+
let storage_response_jsont : storage_response Jsont.t =
26
+
let make storage unknown = { storage; unknown } in
27
+
let storage_map_jsont =
28
+
Jsont.Object.map ~kind:"StorageMap" Fun.id
29
+
|> Jsont.Object.keep_unknown
30
+
(Jsont.Object.Mems.string_map Jsont.string)
31
+
~enc:Fun.id
32
+
|> Jsont.Object.finish
33
+
in
34
+
Jsont.Object.map ~kind:"StorageResponse" make
35
+
|> Jsont.Object.mem "storage" storage_map_jsont ~enc:(fun r -> r.storage)
36
+
~dec_absent:String_map.empty
37
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)
38
+
|> Jsont.Object.finish
39
+
40
+
let create client ~bot_email =
41
+
Log.info (fun m -> m "Creating bot storage for %s" bot_email);
42
+
let cache = Hashtbl.create 16 in
43
+
44
+
(* Fetch all existing storage from server to populate cache *)
45
+
(try
46
+
let json =
47
+
Zulip.Client.request client ~method_:`GET ~path:"/api/v1/bot_storage" ()
48
+
in
49
+
match Zulip.Encode.from_json storage_response_jsont json with
50
+
| Ok response ->
51
+
String_map.iter
52
+
(fun k v ->
53
+
Log.debug (fun m -> m "Loaded key from server: %s" k);
54
+
Hashtbl.add cache k v)
55
+
response.storage
56
+
| Error msg ->
57
+
Log.warn (fun m -> m "Failed to parse storage response: %s" msg)
58
+
with Eio.Exn.Io (e, _) ->
59
+
Log.warn (fun m ->
60
+
m "Failed to load existing storage: %a" Eio.Exn.pp_err e));
61
+
62
+
{ client; bot_email; cache; dirty_keys = [] }
63
+
64
+
(* Helper to encode storage data as form-encoded body for the API *)
65
+
let encode_storage_update keys_values =
66
+
(* Build the storage object as JSON - the API expects storage={"key": "value"} *)
67
+
let storage_obj =
68
+
List.map
69
+
(fun (k, v) ->
70
+
((k, Jsont.Meta.none), Jsont.String (v, Jsont.Meta.none)))
71
+
keys_values
72
+
in
73
+
let json_obj = Jsont.Object (storage_obj, Jsont.Meta.none) in
74
+
75
+
(* Convert to JSON string using Jsont_bytesrw *)
76
+
let json_str =
77
+
Jsont_bytesrw.encode_string' Jsont.json json_obj |> Result.get_ok
78
+
in
79
+
80
+
(* Return as form-encoded body: storage=<url-encoded-json> *)
81
+
"storage=" ^ Uri.pct_encode json_str
82
+
83
+
let get t ~key =
84
+
Log.debug (fun m -> m "Getting value for key: %s" key);
85
+
(* First check cache *)
86
+
match Hashtbl.find_opt t.cache key with
87
+
| Some value ->
88
+
Log.debug (fun m -> m "Found key in cache: %s" key);
89
+
Some value
90
+
| None -> (
91
+
(* Fetch from Zulip API - keys parameter should be a JSON array *)
92
+
let params = [ ("keys", "[\"" ^ key ^ "\"]") ] in
93
+
try
94
+
let json =
95
+
Zulip.Client.request t.client ~method_:`GET ~path:"/api/v1/bot_storage"
96
+
~params ()
97
+
in
98
+
match Zulip.Encode.from_json storage_response_jsont json with
99
+
| Ok response -> (
100
+
match String_map.find_opt key response.storage with
101
+
| Some value ->
102
+
(* Cache the value *)
103
+
Log.debug (fun m -> m "Retrieved key from API: %s" key);
104
+
Hashtbl.add t.cache key value;
105
+
Some value
106
+
| None ->
107
+
Log.debug (fun m -> m "Key not found in API: %s" key);
108
+
None)
109
+
| Error msg ->
110
+
Log.warn (fun m -> m "Failed to parse storage response: %s" msg);
111
+
None
112
+
with Eio.Exn.Io (e, _) ->
113
+
Log.warn (fun m ->
114
+
m "Error fetching key %s: %a" key Eio.Exn.pp_err e);
115
+
None)
116
+
117
+
let put t ~key ~value =
118
+
Log.debug (fun m -> m "Storing key: %s with value: %s" key value);
119
+
(* Update cache *)
120
+
Hashtbl.replace t.cache key value;
121
+
122
+
(* Mark as dirty if not already *)
123
+
if not (List.mem key t.dirty_keys) then t.dirty_keys <- key :: t.dirty_keys;
124
+
125
+
(* Use the helper to properly encode as form data *)
126
+
let body = encode_storage_update [ (key, value) ] in
127
+
128
+
Log.debug (fun m -> m "Sending storage update with body: %s" body);
129
+
130
+
let _response =
131
+
Zulip.Client.request t.client ~method_:`PUT ~path:"/api/v1/bot_storage"
132
+
~body ()
133
+
in
134
+
(* Remove from dirty list on success *)
135
+
Log.debug (fun m -> m "Successfully stored key: %s" key);
136
+
t.dirty_keys <- List.filter (( <> ) key) t.dirty_keys
137
+
138
+
let contains t ~key =
139
+
(* Check cache first *)
140
+
if Hashtbl.mem t.cache key then true
141
+
else
142
+
(* Check API *)
143
+
match get t ~key with Some _ -> true | None -> false
144
+
145
+
let remove t ~key =
146
+
Log.debug (fun m -> m "Removing key: %s" key);
147
+
(* Remove from cache *)
148
+
Hashtbl.remove t.cache key;
149
+
150
+
(* Remove from dirty list *)
151
+
t.dirty_keys <- List.filter (( <> ) key) t.dirty_keys;
152
+
153
+
(* Delete from Zulip API by setting to empty *)
154
+
(* Note: Zulip API doesn't have a delete endpoint, so we set to empty string *)
155
+
put t ~key ~value:""
156
+
157
+
let keys t =
158
+
(* Fetch all storage from API to get complete key list *)
159
+
let json =
160
+
Zulip.Client.request t.client ~method_:`GET ~path:"/api/v1/bot_storage" ()
161
+
in
162
+
match Zulip.Encode.from_json storage_response_jsont json with
163
+
| Ok response ->
164
+
let api_keys =
165
+
String_map.fold (fun k _ acc -> k :: acc) response.storage []
166
+
in
167
+
(* Merge with cache keys *)
168
+
let cache_keys =
169
+
Hashtbl.fold (fun k _ acc -> k :: acc) t.cache []
170
+
in
171
+
List.sort_uniq String.compare (api_keys @ cache_keys)
172
+
| Error msg ->
173
+
Log.warn (fun m -> m "Failed to parse storage response: %s" msg);
174
+
[]
175
+
176
+
(* Flush all dirty keys to API *)
177
+
let flush t =
178
+
if t.dirty_keys = [] then ()
179
+
else begin
180
+
Log.info (fun m ->
181
+
m "Flushing %d dirty keys to API" (List.length t.dirty_keys));
182
+
let updates =
183
+
List.fold_left
184
+
(fun acc key ->
185
+
match Hashtbl.find_opt t.cache key with
186
+
| Some value -> (key, value) :: acc
187
+
| None -> acc)
188
+
[] t.dirty_keys
189
+
in
190
+
191
+
if updates = [] then ()
192
+
else
193
+
(* Use the helper to properly encode all updates as form data *)
194
+
let body = encode_storage_update updates in
195
+
196
+
let _response =
197
+
Zulip.Client.request t.client ~method_:`PUT ~path:"/api/v1/bot_storage"
198
+
~body ()
199
+
in
200
+
Log.info (fun m -> m "Successfully flushed storage to API");
201
+
t.dirty_keys <- []
202
+
end
203
+
204
+
(* Get the underlying client *)
205
+
let client t = t.client
+33
lib/zulip_bot/bot_storage.mli
+33
lib/zulip_bot/bot_storage.mli
···
1
+
(** Persistent storage interface for bots.
2
+
3
+
All mutation functions raise [Eio.Io] with [Zulip.E error] on failure. *)
4
+
5
+
type t
6
+
7
+
val create : Zulip.Client.t -> bot_email:string -> t
8
+
(** Create a new storage instance for a bot *)
9
+
10
+
val get : t -> key:string -> string option
11
+
(** Get a value from storage *)
12
+
13
+
val put : t -> key:string -> value:string -> unit
14
+
(** Store a value in storage.
15
+
@raise Eio.Io on failure *)
16
+
17
+
val contains : t -> key:string -> bool
18
+
(** Check if a key exists in storage *)
19
+
20
+
val remove : t -> key:string -> unit
21
+
(** Remove a key from storage.
22
+
@raise Eio.Io on failure *)
23
+
24
+
val keys : t -> string list
25
+
(** List all keys in storage.
26
+
@raise Eio.Io on failure *)
27
+
28
+
val flush : t -> unit
29
+
(** Flush all dirty keys to the API.
30
+
@raise Eio.Io on failure *)
31
+
32
+
val client : t -> Zulip.Client.t
33
+
(** Get the underlying Zulip client *)
+6
lib/zulip_bot/dune
+6
lib/zulip_bot/dune
+469
lib/zulip_bot/message.ml
+469
lib/zulip_bot/message.ml
···
1
+
(* Message parsing using Jsont codecs *)
2
+
3
+
let logs_src = Logs.Src.create "zulip_bot.message"
4
+
module Log = (val Logs.src_log logs_src : Logs.LOG)
5
+
6
+
(** User representation *)
7
+
module User = struct
8
+
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 *)
14
+
}
15
+
16
+
let user_id t = t.user_id
17
+
let email t = t.email
18
+
let full_name t = t.full_name
19
+
let short_name t = t.short_name
20
+
21
+
(* Jsont codec for User - handles both user_id and id fields *)
22
+
let jsont : t Jsont.t =
23
+
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 }
32
+
in
33
+
Jsont.Object.map ~kind:"User" make
34
+
|> Jsont.Object.mem "email" Jsont.string ~enc:email
35
+
|> Jsont.Object.mem "full_name" Jsont.string ~enc:full_name
36
+
|> Jsont.Object.opt_mem "short_name" Jsont.string ~enc:short_name
37
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)
38
+
|> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)
39
+
|> Jsont.Object.opt_mem "id" Jsont.int ~enc:(fun _ -> None)
40
+
|> Jsont.Object.finish
41
+
42
+
let of_json (json : Zulip.json) : (t, string) result =
43
+
Zulip.Encode.from_json jsont json
44
+
end
45
+
46
+
(** Reaction representation *)
47
+
module Reaction = struct
48
+
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 *)
54
+
}
55
+
56
+
let emoji_name t = t.emoji_name
57
+
let emoji_code t = t.emoji_code
58
+
let reaction_type t = t.reaction_type
59
+
let user_id t = t.user_id
60
+
61
+
(* Jsont codec for Reaction - handles user_id in different locations *)
62
+
let jsont : t Jsont.t =
63
+
(* Helper codec for nested user object - extracts just the user_id *)
64
+
let user_obj_codec =
65
+
Jsont.Object.map ~kind:"ReactionUser" Fun.id
66
+
|> Jsont.Object.mem "user_id" Jsont.int ~enc:Fun.id
67
+
|> Jsont.Object.finish
68
+
in
69
+
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 }
77
+
in
78
+
Jsont.Object.map ~kind:"Reaction" make
79
+
|> Jsont.Object.mem "emoji_name" Jsont.string ~enc:emoji_name
80
+
|> Jsont.Object.mem "emoji_code" Jsont.string ~enc:emoji_code
81
+
|> Jsont.Object.mem "reaction_type" Jsont.string ~enc:reaction_type
82
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)
83
+
|> Jsont.Object.opt_mem "user_id" Jsont.int ~enc:(fun t -> Some t.user_id)
84
+
|> Jsont.Object.opt_mem "user" user_obj_codec ~enc:(fun _ -> None)
85
+
|> Jsont.Object.finish
86
+
87
+
let of_json (json : Zulip.json) : (t, string) result =
88
+
Zulip.Encode.from_json jsont json
89
+
end
90
+
91
+
let parse_reaction_json json = Reaction.of_json json
92
+
let parse_user_json json = User.of_json json
93
+
94
+
(** Common message fields *)
95
+
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;
111
+
}
112
+
113
+
(** Message types *)
114
+
type t =
115
+
| Private of {
116
+
common: common;
117
+
display_recipient: User.t list;
118
+
}
119
+
| 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
+
}
129
+
130
+
(** Helper function to parse common fields *)
131
+
let parse_common json =
132
+
match json with
133
+
| Jsont.Object (fields, _) ->
134
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
135
+
let get_int key =
136
+
match List.assoc_opt key assoc with
137
+
| Some (Jsont.Number (f, _)) -> Some (int_of_float f)
138
+
| _ -> None
139
+
in
140
+
let get_string key =
141
+
match List.assoc_opt key assoc with
142
+
| Some (Jsont.String (s, _)) -> Some s
143
+
| _ -> None
144
+
in
145
+
let get_float key default =
146
+
match List.assoc_opt key assoc with
147
+
| Some (Jsont.Number (f, _)) -> f
148
+
| _ -> default
149
+
in
150
+
let get_bool key default =
151
+
match List.assoc_opt key assoc with
152
+
| Some (Jsont.Bool (b, _)) -> b
153
+
| _ -> default
154
+
in
155
+
let get_array key =
156
+
match List.assoc_opt key assoc with
157
+
| Some (Jsont.Array (arr, _)) -> Some arr
158
+
| _ -> None
159
+
in
160
+
161
+
(match (get_int "id", get_int "sender_id", get_string "sender_email", get_string "sender_full_name") with
162
+
| (Some id, Some sender_id, Some sender_email, Some sender_full_name) ->
163
+
let sender_short_name = get_string "sender_short_name" in
164
+
let timestamp = get_float "timestamp" 0.0 in
165
+
let content = get_string "content" |> Option.value ~default:"" in
166
+
let content_type = get_string "content_type" |> Option.value ~default:"text/html" in
167
+
168
+
let reactions =
169
+
match get_array "reactions" with
170
+
| Some reactions_json ->
171
+
List.filter_map (fun r ->
172
+
match parse_reaction_json r with
173
+
| Ok reaction -> Some reaction
174
+
| Error msg ->
175
+
Log.warn (fun m -> m "Failed to parse reaction: %s" msg);
176
+
None
177
+
) reactions_json
178
+
| None -> []
179
+
in
180
+
181
+
let submessages = get_array "submessages" |> Option.value ~default:[] in
182
+
183
+
let flags =
184
+
match get_array "flags" with
185
+
| Some flags_json ->
186
+
List.filter_map (fun f ->
187
+
match f with
188
+
| Jsont.String (s, _) -> Some s
189
+
| _ -> None
190
+
) flags_json
191
+
| None -> []
192
+
in
193
+
194
+
let is_me_message = get_bool "is_me_message" false in
195
+
let client = get_string "client" |> Option.value ~default:"" in
196
+
let gravatar_hash = get_string "gravatar_hash" |> Option.value ~default:"" in
197
+
let avatar_url = get_string "avatar_url" in
198
+
199
+
Ok {
200
+
id; sender_id; sender_email; sender_full_name; sender_short_name;
201
+
timestamp; content; content_type; reactions; submessages;
202
+
flags; is_me_message; client; gravatar_hash; avatar_url
203
+
}
204
+
| _ -> Error "Missing required message fields")
205
+
| _ -> Error "Expected JSON object for message"
206
+
207
+
(** JSON parsing *)
208
+
let of_json json =
209
+
(* Helper to pretty print JSON without using jsonu *)
210
+
let json_str =
211
+
match Jsont_bytesrw.encode_string' Jsont.json json with
212
+
| Ok s -> s
213
+
| Error _ -> "<error encoding json>"
214
+
in
215
+
Log.debug (fun m -> m "Parsing message JSON: %s" json_str);
216
+
217
+
match parse_common json with
218
+
| Error msg -> Error msg
219
+
| Ok common ->
220
+
match json with
221
+
| Jsont.Object (fields, _) ->
222
+
let assoc = List.map (fun ((k, _), v) -> (k, v)) fields in
223
+
let msg_type =
224
+
match List.assoc_opt "type" assoc with
225
+
| Some (Jsont.String (s, _)) -> Some s
226
+
| _ -> None
227
+
in
228
+
(match msg_type with
229
+
| Some "private" ->
230
+
(match List.assoc_opt "display_recipient" assoc with
231
+
| Some (Jsont.Array (recipient_json, _)) ->
232
+
let users = List.filter_map (fun u ->
233
+
match parse_user_json u with
234
+
| Ok user -> Some user
235
+
| Error msg ->
236
+
Log.warn (fun m -> m "Failed to parse user in display_recipient: %s" msg);
237
+
None
238
+
) recipient_json in
239
+
240
+
if List.length users = 0 && List.length recipient_json > 0 then
241
+
Error "Failed to parse any users in display_recipient"
242
+
else
243
+
Ok (Private { common; display_recipient = users })
244
+
| _ ->
245
+
Log.warn (fun m -> m "display_recipient is not an array for private message");
246
+
Ok (Unknown { common; raw_json = json }))
247
+
248
+
| Some "stream" ->
249
+
let display_recipient =
250
+
match List.assoc_opt "display_recipient" assoc with
251
+
| Some (Jsont.String (s, _)) -> Some s
252
+
| _ -> None
253
+
in
254
+
let stream_id =
255
+
match List.assoc_opt "stream_id" assoc with
256
+
| Some (Jsont.Number (f, _)) -> Some (int_of_float f)
257
+
| _ -> None
258
+
in
259
+
let subject =
260
+
match List.assoc_opt "subject" assoc with
261
+
| Some (Jsont.String (s, _)) -> Some s
262
+
| _ -> None
263
+
in
264
+
(match (display_recipient, stream_id, subject) with
265
+
| (Some display_recipient, Some stream_id, Some subject) ->
266
+
Ok (Stream { common; display_recipient; stream_id; subject })
267
+
| _ ->
268
+
Log.warn (fun m -> m "Missing required fields for stream message");
269
+
Ok (Unknown { common; raw_json = json }))
270
+
271
+
| Some unknown_type ->
272
+
Log.warn (fun m -> m "Unknown message type: %s" unknown_type);
273
+
Ok (Unknown { common; raw_json = json })
274
+
275
+
| None ->
276
+
Log.warn (fun m -> m "No message type field found");
277
+
Ok (Unknown { common; raw_json = json }))
278
+
| _ -> Error "Expected JSON object for message"
279
+
280
+
(** Accessor functions *)
281
+
let get_common = function
282
+
| Private { common; _ } -> common
283
+
| Stream { common; _ } -> common
284
+
| Unknown { common; _ } -> common
285
+
286
+
let id msg = (get_common msg).id
287
+
let sender_id msg = (get_common msg).sender_id
288
+
let sender_email msg = (get_common msg).sender_email
289
+
let sender_full_name msg = (get_common msg).sender_full_name
290
+
let sender_short_name msg = (get_common msg).sender_short_name
291
+
let timestamp msg = (get_common msg).timestamp
292
+
let content msg = (get_common msg).content
293
+
let content_type msg = (get_common msg).content_type
294
+
let reactions msg = (get_common msg).reactions
295
+
let submessages msg = (get_common msg).submessages
296
+
let flags msg = (get_common msg).flags
297
+
let is_me_message msg = (get_common msg).is_me_message
298
+
let client msg = (get_common msg).client
299
+
let gravatar_hash msg = (get_common msg).gravatar_hash
300
+
let avatar_url msg = (get_common msg).avatar_url
301
+
302
+
(** Helper functions *)
303
+
let is_private = function
304
+
| Private _ -> true
305
+
| _ -> false
306
+
307
+
let is_stream = function
308
+
| Stream _ -> true
309
+
| _ -> false
310
+
311
+
let is_from_self msg ~bot_user_id =
312
+
sender_id msg = bot_user_id
313
+
314
+
let is_from_email msg ~email =
315
+
sender_email msg = email
316
+
317
+
let get_reply_to = function
318
+
| Private { display_recipient; _ } ->
319
+
display_recipient
320
+
|> List.map User.email
321
+
|> String.concat ", "
322
+
| Stream { display_recipient; _ } -> display_recipient
323
+
| Unknown _ -> ""
324
+
325
+
(** Utility functions *)
326
+
let is_mentioned msg ~user_email =
327
+
let content_text = content msg in
328
+
(* Check for both email and username mentions *)
329
+
let email_mention = "@**" ^ user_email ^ "**" in
330
+
(* Also check for username mention (part before @ in email) *)
331
+
let username =
332
+
match String.index_opt user_email '@' with
333
+
| Some idx -> String.sub user_email 0 idx
334
+
| None -> user_email
335
+
in
336
+
let username_mention = "@**" ^ username ^ "**" in
337
+
338
+
let contains text pattern =
339
+
if String.length pattern = 0 || String.length pattern > String.length text then
340
+
false
341
+
else
342
+
let rec search_from pos =
343
+
if pos > String.length text - String.length pattern then
344
+
false
345
+
else if String.sub text pos (String.length pattern) = pattern then
346
+
true
347
+
else
348
+
search_from (pos + 1)
349
+
in
350
+
search_from 0
351
+
in
352
+
contains content_text email_mention || contains content_text username_mention
353
+
354
+
let strip_mention msg ~user_email =
355
+
let content_text = content msg in
356
+
(* Check for both email and username mentions *)
357
+
let email_mention = "@**" ^ user_email ^ "**" in
358
+
let username =
359
+
match String.index_opt user_email '@' with
360
+
| Some idx -> String.sub user_email 0 idx
361
+
| None -> user_email
362
+
in
363
+
let username_mention = "@**" ^ username ^ "**" in
364
+
365
+
(* Remove whichever mention pattern is found at the start *)
366
+
let without_mention =
367
+
if String.starts_with ~prefix:email_mention content_text then
368
+
String.sub content_text (String.length email_mention)
369
+
(String.length content_text - String.length email_mention)
370
+
else if String.starts_with ~prefix:username_mention content_text then
371
+
String.sub content_text (String.length username_mention)
372
+
(String.length content_text - String.length username_mention)
373
+
else
374
+
content_text
375
+
in
376
+
String.trim without_mention
377
+
378
+
let extract_command msg =
379
+
let content_text = String.trim (content msg) in
380
+
if String.length content_text > 0 && content_text.[0] = '!' then
381
+
Some (String.sub content_text 1 (String.length content_text - 1))
382
+
else
383
+
None
384
+
385
+
let parse_command msg =
386
+
match extract_command msg with
387
+
| None -> None
388
+
| Some cmd_string ->
389
+
let parts = String.split_on_char ' ' (String.trim cmd_string) in
390
+
match parts with
391
+
| [] -> None
392
+
| cmd :: args -> Some (cmd, args)
393
+
394
+
(** Pretty printing *)
395
+
let pp_user fmt user =
396
+
Format.fprintf fmt "{ user_id=%d; email=%s; full_name=%s }"
397
+
(User.user_id user) (User.email user) (User.full_name user)
398
+
399
+
let _pp_reaction fmt reaction =
400
+
Format.fprintf fmt "{ emoji_name=%s; user_id=%d }"
401
+
(Reaction.emoji_name reaction) (Reaction.user_id reaction)
402
+
403
+
let pp fmt = function
404
+
| Private { common; display_recipient } ->
405
+
Format.fprintf fmt "Private { id=%d; sender=%s; recipients=[%a]; content=%S }"
406
+
common.id common.sender_email
407
+
(Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ") pp_user)
408
+
display_recipient
409
+
common.content
410
+
411
+
| Stream { common; display_recipient; subject; _ } ->
412
+
Format.fprintf fmt "Stream { id=%d; sender=%s; stream=%s; subject=%s; content=%S }"
413
+
common.id common.sender_email display_recipient subject common.content
414
+
415
+
| Unknown { common; _ } ->
416
+
Format.fprintf fmt "Unknown { id=%d; sender=%s; content=%S }"
417
+
common.id common.sender_email common.content
418
+
419
+
(** ANSI colored pretty printing for debugging *)
420
+
let pp_ansi ?(show_json=false) ppf msg =
421
+
let open Fmt in
422
+
let blue = styled `Blue string in
423
+
let green = styled `Green string in
424
+
let yellow = styled `Yellow string in
425
+
let magenta = styled `Magenta string in
426
+
let cyan = styled `Cyan string in
427
+
let dim = styled (`Fg `Black) string in
428
+
429
+
match msg with
430
+
| Private { common; display_recipient } ->
431
+
pf ppf "%a %a %a %a %a"
432
+
(styled `Bold blue) "DM"
433
+
dim (Printf.sprintf "[#%d]" common.id)
434
+
(styled `Cyan string) common.sender_email
435
+
dim "→"
436
+
green (Printf.sprintf "%S" common.content);
437
+
if show_json then
438
+
pf ppf "@. %a %a" dim "Recipients:"
439
+
(list ~sep:(const string ", ") (fun fmt u -> cyan fmt (User.email u)))
440
+
display_recipient
441
+
442
+
| Stream { common; display_recipient; subject; _ } ->
443
+
pf ppf "%a %a %a%a%a %a %a"
444
+
(styled `Bold yellow) "STREAM"
445
+
dim (Printf.sprintf "[#%d]" common.id)
446
+
magenta display_recipient
447
+
dim "/"
448
+
cyan subject
449
+
(styled `Cyan string) common.sender_email
450
+
green (Printf.sprintf "%S" common.content)
451
+
452
+
| Unknown { common; _ } ->
453
+
pf ppf "%a %a %a %a"
454
+
(styled `Bold (styled (`Fg `Red) string)) "UNKNOWN"
455
+
dim (Printf.sprintf "[#%d]" common.id)
456
+
(styled `Cyan string) common.sender_email
457
+
(styled (`Fg `Red) string) (Printf.sprintf "%S" common.content)
458
+
459
+
(** Pretty print JSON for debugging *)
460
+
let pp_json_debug ppf json =
461
+
let open Fmt in
462
+
let json_str =
463
+
match Jsont_bytesrw.encode_string' Jsont.json json with
464
+
| Ok s -> s
465
+
| Error _ -> "<error encoding json>"
466
+
in
467
+
pf ppf "@[<v>%a@.%a@]"
468
+
(styled `Bold (styled (`Fg `Blue) string)) "Raw JSON:"
469
+
(styled (`Fg `Black) string) json_str
+116
lib/zulip_bot/message.mli
+116
lib/zulip_bot/message.mli
···
1
+
(** Zulip message types and utilities for bots *)
2
+
3
+
(** User representation *)
4
+
module User : sig
5
+
type t = {
6
+
user_id : int;
7
+
email : string;
8
+
full_name : string;
9
+
short_name : string option;
10
+
unknown : Jsont.json;
11
+
}
12
+
13
+
val user_id : t -> int
14
+
val email : t -> string
15
+
val full_name : t -> string
16
+
val short_name : t -> string option
17
+
18
+
(** Jsont codec for User *)
19
+
val jsont : t Jsont.t
20
+
end
21
+
22
+
(** Reaction representation *)
23
+
module Reaction : sig
24
+
type t = {
25
+
emoji_name : string;
26
+
emoji_code : string;
27
+
reaction_type : string;
28
+
user_id : int;
29
+
unknown : Jsont.json;
30
+
}
31
+
32
+
val emoji_name : t -> string
33
+
val emoji_code : t -> string
34
+
val reaction_type : t -> string
35
+
val user_id : t -> int
36
+
37
+
(** Jsont codec for Reaction *)
38
+
val jsont : t Jsont.t
39
+
end
40
+
41
+
(** Common message fields *)
42
+
type common = {
43
+
id : int;
44
+
sender_id : int;
45
+
sender_email : string;
46
+
sender_full_name : string;
47
+
sender_short_name : string option;
48
+
timestamp : float;
49
+
content : string;
50
+
content_type : string;
51
+
reactions : Reaction.t list;
52
+
submessages : Zulip.json list;
53
+
flags : string list;
54
+
is_me_message : bool;
55
+
client : string;
56
+
gravatar_hash : string;
57
+
avatar_url : string option;
58
+
}
59
+
60
+
(** Message types *)
61
+
type t =
62
+
| Private of { common : common; display_recipient : User.t list }
63
+
| Stream of {
64
+
common : common;
65
+
display_recipient : string;
66
+
stream_id : int;
67
+
subject : string;
68
+
}
69
+
| Unknown of { common : common; raw_json : Zulip.json }
70
+
71
+
(** Accessor functions *)
72
+
73
+
val id : t -> int
74
+
val sender_id : t -> int
75
+
val sender_email : t -> string
76
+
val sender_full_name : t -> string
77
+
val sender_short_name : t -> string option
78
+
val timestamp : t -> float
79
+
val content : t -> string
80
+
val content_type : t -> string
81
+
val reactions : t -> Reaction.t list
82
+
val submessages : t -> Zulip.json list
83
+
val flags : t -> string list
84
+
val is_me_message : t -> bool
85
+
val client : t -> string
86
+
val gravatar_hash : t -> string
87
+
val avatar_url : t -> string option
88
+
89
+
(** Helper functions *)
90
+
91
+
val is_private : t -> bool
92
+
val is_stream : t -> bool
93
+
val is_from_self : t -> bot_user_id:int -> bool
94
+
val is_from_email : t -> email:string -> bool
95
+
val get_reply_to : t -> string
96
+
97
+
(** Utility functions *)
98
+
99
+
val is_mentioned : t -> user_email:string -> bool
100
+
val strip_mention : t -> user_email:string -> string
101
+
val extract_command : t -> string option
102
+
val parse_command : t -> (string * string list) option
103
+
104
+
(** JSON parsing *)
105
+
106
+
val of_json : Zulip.json -> (t, string) result
107
+
108
+
(** Pretty printing *)
109
+
110
+
val pp : Format.formatter -> t -> unit
111
+
112
+
(** ANSI colored pretty printing for debugging *)
113
+
val pp_ansi : ?show_json:bool -> Format.formatter -> t -> unit
114
+
115
+
(** Pretty print JSON for debugging *)
116
+
val pp_json_debug : Format.formatter -> Zulip.json -> unit
+41
lib/zulip_botserver/bot_registry.mli
+41
lib/zulip_botserver/bot_registry.mli
···
1
+
(** Registry for managing multiple bots *)
2
+
3
+
(** Bot module definition *)
4
+
module Bot_module : sig
5
+
type t
6
+
7
+
val create :
8
+
name:string ->
9
+
handler:(module Zulip_bot.Bot_handler.Bot_handler) ->
10
+
create_config:(Server_config.Bot_config.t -> Zulip_bot.Bot_config.t) ->
11
+
t
12
+
(** Create a bot module. The [create_config] function raises [Eio.Io] on failure. *)
13
+
14
+
val name : t -> string
15
+
16
+
val create_handler : t -> Server_config.Bot_config.t -> Zulip.Client.t -> Zulip_bot.Bot_handler.t
17
+
(** Create handler from bot module.
18
+
@raise Eio.Io on failure *)
19
+
end
20
+
21
+
type t
22
+
23
+
(** Create a new bot registry *)
24
+
val create : unit -> t
25
+
26
+
(** Register a bot module *)
27
+
val register : t -> Bot_module.t -> unit
28
+
29
+
(** Get a bot handler by email *)
30
+
val get_bot : t -> email:string -> Zulip_bot.Bot_handler.t option
31
+
32
+
(** Load a bot module from file.
33
+
@raise Eio.Io on failure *)
34
+
val load_from_file : string -> Bot_module.t
35
+
36
+
(** Load bot modules from directory.
37
+
@raise Eio.Io on failure *)
38
+
val load_from_directory : string -> Bot_module.t list
39
+
40
+
(** List all registered bot emails *)
41
+
val list_bots : t -> string list
+24
lib/zulip_botserver/bot_server.mli
+24
lib/zulip_botserver/bot_server.mli
···
1
+
(** Main bot server implementation *)
2
+
3
+
type t
4
+
5
+
(** Create a bot server.
6
+
@raise Eio.Io on failure *)
7
+
val create :
8
+
config:Server_config.t ->
9
+
registry:Bot_registry.t ->
10
+
t
11
+
12
+
(** Start the bot server *)
13
+
val run : t -> unit
14
+
15
+
(** Stop the bot server gracefully *)
16
+
val shutdown : t -> unit
17
+
18
+
(** Resource-safe server management.
19
+
@raise Eio.Io on failure *)
20
+
val with_server :
21
+
config:Server_config.t ->
22
+
registry:Bot_registry.t ->
23
+
(t -> 'a) ->
24
+
'a
+5
lib/zulip_botserver/dune
+5
lib/zulip_botserver/dune
+45
lib/zulip_botserver/server_config.mli
+45
lib/zulip_botserver/server_config.mli
···
1
+
(** Bot server configuration *)
2
+
3
+
(** Configuration for a single bot *)
4
+
module Bot_config : sig
5
+
type t
6
+
7
+
val create :
8
+
email:string ->
9
+
api_key:string ->
10
+
server_url:string ->
11
+
token:string ->
12
+
config_path:string option ->
13
+
t
14
+
15
+
val email : t -> string
16
+
val api_key : t -> string
17
+
val server_url : t -> string
18
+
val token : t -> string
19
+
val config_path : t -> string option
20
+
val pp : Format.formatter -> t -> unit
21
+
end
22
+
23
+
(** Server configuration *)
24
+
type t
25
+
26
+
val create :
27
+
?host:string ->
28
+
?port:int ->
29
+
bots:Bot_config.t list ->
30
+
unit ->
31
+
t
32
+
33
+
val from_file : string -> t
34
+
(** Load configuration from file.
35
+
@raise Eio.Io on failure *)
36
+
37
+
val from_env : unit -> t
38
+
(** Load configuration from environment variables.
39
+
@raise Eio.Io on failure *)
40
+
41
+
val host : t -> string
42
+
val port : t -> int
43
+
val bots : t -> Bot_config.t list
44
+
45
+
val pp : Format.formatter -> t -> unit
+35
lib/zulip_botserver/webhook_handler.mli
+35
lib/zulip_botserver/webhook_handler.mli
···
1
+
(** Webhook processing for bot server *)
2
+
3
+
(** Webhook event data *)
4
+
module Webhook_event : sig
5
+
type trigger = [`Direct_message | `Mention]
6
+
7
+
type t
8
+
9
+
val create :
10
+
bot_email:string ->
11
+
token:string ->
12
+
message:Zulip.json ->
13
+
trigger:trigger ->
14
+
t
15
+
16
+
val bot_email : t -> string
17
+
val token : t -> string
18
+
val message : t -> Zulip.json
19
+
val trigger : t -> trigger
20
+
val pp : Format.formatter -> t -> unit
21
+
end
22
+
23
+
(** Parse webhook data from HTTP request.
24
+
@raise Eio.Io on failure *)
25
+
val parse_webhook : string -> Webhook_event.t
26
+
27
+
(** Process webhook with bot registry.
28
+
@raise Eio.Io on failure *)
29
+
val handle_webhook :
30
+
Bot_registry.t ->
31
+
Webhook_event.t ->
32
+
Zulip_bot.Bot_handler.Response.t option
33
+
34
+
(** Validate webhook token *)
35
+
val validate_token : Server_config.Bot_config.t -> string -> bool