type nick_key = Nick_key of string [@@unboxed] let nick_key n = Nick_key (String.lowercase_ascii n) (* TODO: "scandinavian" lowercase *) let unset = Nick_key "" type t = { users : (nick_key, user) Hashtbl.t (* TODO: channels *) } and user = { router : t; hostname : string; mutable key : nick_key; mutable nick : Irc.nick; mutable userinfo : Irc.userinfo option; mutable mode : Irc.Mode.t; inbox : Irc.Msg.t Lwt_stream.t; push_inbox : (Irc.Msg.t option -> unit); } let make () = { users = Hashtbl.create 4096 } let find_user t nick = Hashtbl.find_opt t.users (nick_key nick) module User = struct type t = user let make router ~hostname = let inbox, push_inbox = Lwt_stream.create () in { router; hostname; key = unset; nick = "*"; userinfo = None; mode = Irc.Mode.of_string "iw"; inbox; push_inbox; } let nick t = t.nick let prefix t = Irc.Msg.User_prefix (t.nick, t.userinfo, Some t.hostname) let inbox t = t.inbox let send t msg = try t.push_inbox (Some msg) with Lwt_stream.Closed -> () let close t = try t.push_inbox None with Lwt_stream.Closed -> () let is_registered t = t.key <> unset let unregister t = Hashtbl.remove t.router.users t.key; t.key <- unset let set_nick t new_nick = let key = nick_key new_nick in if Hashtbl.mem t.router.users key then `nick_in_use else begin ((* TODO: relay NICK message *)); unregister t; Hashtbl.add t.router.users key t; t.key <- key; t.nick <- new_nick; `nick_set end let cleanup t = (* TODO: relay QUIT message *) unregister t; close t end let privmsg src dst txt = let prefix = User.prefix src in match dst with | `user dst -> let msg = Irc.Msg.make "PRIVMSG" [User.nick dst; txt] ~prefix in User.send dst msg