split Router into Router_types + User + Chan

lib/server/chan.ml

@@ -0,0 +1,65 @@
+open! Import
+include Router_types
+
+type t = chan
+
+let make ~name =
+  {
+    name;
+    name_key = string_ci name;
+    topic = None;
+    members = Dllist.create ();
+    chan_mode = Irc.Mode.Set.empty;
+    chan_limit = None;
+    chan_key = None;
+  }
+
+let name t = t.name
+let topic t = t.topic
+let mode t = t.chan_mode
+let set_mode t new_mode = t.chan_mode <- new_mode
+let limit t = t.chan_limit
+let set_limit t n = t.chan_limit <- n
+let key t = t.chan_key
+let set_key t k = t.chan_key <- k
+
+let members chan =
+  Dllist.fold_r (fun m xs -> m.mem_user :: xs) chan.members []
+
+let no_members t =
+  Dllist.is_empty t.members
+
+let register t ~router =
+  Hashtbl.replace router.channels t.name_key t
+
+let unregister t ~router =
+  Hashtbl.remove router.channels t.name_key
+
+let is_registered t ~router =
+  Hashtbl.mem router.channels t.name_key
+
+let is_member t user =
+  let is_mem m = m.mem_chan == t in
+  try
+    ignore (Dllist.find_node_l is_mem user.membership);
+    true
+  with Not_found ->
+    false
+
+let join t user =
+  let m = {
+    mem_chan = t;
+    mem_user = user;
+    mem_in_chan = None;
+  } in
+  begin
+    m.mem_in_chan <- Some (Dllist.add_r m t.members);
+    ignore (Dllist.add_r m user.membership);
+  end
+
+let part t user =
+  let is_mem m = m.mem_chan == t in
+  let mem = Dllist.find_node_l is_mem user.membership in
+  Option.iter Dllist.remove (Dllist.get mem).mem_in_chan;
+  Dllist.remove mem
+

lib/server/connection.ml

@@ -1,7 +1,5 @@
 open! Import
 open Result_syntax
-module User = Router.User
-module Chan = Router.Chan
 
 include (val Logging.sublogs logger "Connection")
 

lib/server/import.ml

@@ -7,11 +7,6 @@ let pp_sockaddr ppf = function
   | Unix.ADDR_INET (adr, port) -> Fmt.pf ppf "%s:%d" (Unix.string_of_inet_addr adr) port
   | Unix.ADDR_UNIX path -> Fmt.string ppf path
 
-type string_ci = Case_insensitive of string [@@unboxed]
-let pp_string_ci ppf (Case_insensitive s) = Fmt.string ppf s
-let string_ci s = Case_insensitive (String.lowercase_ascii s)
-let empty_string_ci = Case_insensitive ""
-
 let defer f =
   Lwt.on_success (Lwt.pause ()) f
 

lib/server/router.ml

@@ -1,39 +1,7 @@
 open! Import
+include Router_types
 
-type t = {
+type t = router
-  users : (string_ci, user) Hashtbl.t;
-  channels : (string_ci, chan) Hashtbl.t;
-}
-
-and user = {
-  outbox : Outbox.t;
-  userinfo : Irc.userinfo;
-  mutable user_mode : Irc.Mode.Set.t;
-  mutable nick : Irc.name;
-  mutable nick_key : string_ci;
-  mutable membership : membership Dllist.t;
-}
-
-and chan = {
-  name : Irc.name;
-  name_key : string_ci;
-  mutable topic : string option;
-  mutable members : membership Dllist.t;
-  mutable chan_mode : Irc.Mode.Set.t; (* +imstn *)
-  mutable chan_limit : int option; (* +l *)
-  mutable chan_key : string option; (* +k *)
-  (* TODO: +b, +o, +v *)
-  (* TODO: creation time *)
-}
-
-and membership = {
-  mem_user : user;
-  mem_chan : chan;
-  mutable mem_in_chan : membership Dllist.node option;
-  (* mutable mem_of_user : membership Dllist.node option; *)
-}
-
-type router = t
 
 let make () =
   { users = Hashtbl.create 4096;
@@ -45,142 +13,20 @@ let find_user t nick =
 let find_chan t name =
   Hashtbl.find t.channels (string_ci name)
 
-let user_prefix user =
-  Irc.Msg.User_prefix (user.nick, Some user.userinfo)  
-
-let chan_members chan =
-  Dllist.fold_r (fun m xs -> m.mem_user :: xs) chan.members []
-
-let user_channels user =
-  Dllist.fold_r (fun m xs -> m.mem_chan :: xs) user.membership []
-
 let relay ~(from : user) (msg : Irc.Msg.t) tgts =
   let msg =
     if msg.prefix = No_prefix then
-      { msg with prefix = user_prefix from }
+      { msg with prefix = User.prefix from }
     else msg
   in
   let bcc u = Outbox.Bcc.add u.outbox in
   let bcc_not_self u = if u != from then bcc u in
-  let bcc_channel c = List.iter bcc_not_self (chan_members c) in
+  let bcc_channel c = List.iter bcc_not_self (Chan.members c) in
   List.iter
     (function
       | `to_self -> bcc from
       | `to_user tgt -> bcc tgt
       | `to_chan tgt -> bcc_channel tgt
-      | `to_interested -> bcc from; List.iter bcc_channel (user_channels from))
+      | `to_interested -> bcc from; List.iter bcc_channel (User.channels from))
     tgts;
   Outbox.Bcc.send_all msg
-
-(* TODO: split out [User] and [Chan] into separate files *)
-
-
-module User = struct
-  type t = user
-
-  let make ~userinfo ~outbox =
-    {
-      outbox;
-      userinfo;
-      nick = "*";
-      nick_key = empty_string_ci;
-      user_mode = Irc.Mode.Set.empty;
-      membership = Dllist.create ();
-    }
-
-  let outbox t = t.outbox
-  let nick t = t.nick
-  let mode t = t.user_mode
-  let set_mode t new_mode = t.user_mode <- new_mode
-  let channels = user_channels
-  let prefix = user_prefix
-  (* let is_registered t = t.nick_key <> empty_string_ci *)
-
-  let unregister t ~router =
-    Hashtbl.remove router.users t.nick_key;
-    t.nick_key <- empty_string_ci
-
-  let set_nick ?(success_callback = ignore) t new_nick ~router =
-    let key = string_ci new_nick in
-    if Hashtbl.mem router.users key then
-      `nick_in_use
-    else begin
-      (* hack to allow broadcasting a NICK message before nick is actually changed *)
-      success_callback ();
-      unregister t ~router;
-      Hashtbl.add router.users key t;
-      t.nick <- new_nick;
-      t.nick_key <- key;
-      `nick_set
-    end
-
-  let rec part_all t =
-    (* List.iter (fun c -> Chan.part c t) (channels t) *)
-    match Dllist.take_l t.membership with
-    | m ->
-      Option.iter Dllist.remove m.mem_in_chan;
-      part_all t
-    | exception Dllist.Empty ->
-      ()
-end
-
-
-module Chan = struct
-  type t = chan
-
-  let make ~name =
-    {
-      name;
-      name_key = string_ci name;
-      topic = None;
-      members = Dllist.create ();
-      chan_mode = Irc.Mode.Set.empty;
-      chan_limit = None;
-      chan_key = None;
-    }
-
-  let name t = t.name
-  let topic t = t.topic
-  let members = chan_members
-  let no_members t = Dllist.is_empty t.members
-  let mode t = t.chan_mode
-  let set_mode t new_mode = t.chan_mode <- new_mode
-  let limit t = t.chan_limit
-  let set_limit t n = t.chan_limit <- n
-  let key t = t.chan_key
-  let set_key t k = t.chan_key <- k
-
-  let register t ~router =
-    Hashtbl.replace router.channels t.name_key t
-
-  let unregister t ~router =
-    Hashtbl.remove router.channels t.name_key
-
-  let is_registered t ~router =
-    Hashtbl.mem router.channels t.name_key
-
-  let is_member t user =
-    let is_mem m = m.mem_chan == t in
-    try
-      ignore (Dllist.find_node_l is_mem user.membership);
-      true
-    with Not_found ->
-      false
-
-  let join t user =
-    let m = {
-      mem_chan = t;
-      mem_user = user;
-      mem_in_chan = None;
-    } in
-    begin
-      m.mem_in_chan <- Some (Dllist.add_r m t.members);
-      ignore (Dllist.add_r m user.membership);
-    end
-
-  let part t user =
-    let is_mem m = m.mem_chan == t in
-    let mem = Dllist.find_node_l is_mem user.membership in
-    Option.iter Dllist.remove (Dllist.get mem).mem_in_chan;
-    Dllist.remove mem
-end

lib/server/router_types.ml

@@ -0,0 +1,38 @@
+open! Import
+
+type string_ci = Case_insensitive of string [@@unboxed]
+let string_ci s = Case_insensitive (String.lowercase_ascii s)
+let empty_string_ci = Case_insensitive ""
+
+type user = {
+  outbox : Outbox.t;
+  userinfo : Irc.userinfo;
+  mutable user_mode : Irc.Mode.Set.t;
+  mutable nick : Irc.name;
+  mutable nick_key : string_ci;
+  mutable membership : membership Dllist.t;
+}
+
+and chan = {
+  name : Irc.name;
+  name_key : string_ci;
+  mutable topic : string option;
+  mutable members : membership Dllist.t;
+  mutable chan_mode : Irc.Mode.Set.t; (* +imstn *)
+  mutable chan_limit : int option; (* +l *)
+  mutable chan_key : string option; (* +k *)
+  (* TODO: +b, +o, +v *)
+  (* TODO: creation time *)
+}
+
+and membership = {
+  mem_user : user;
+  mem_chan : chan;
+  mutable mem_in_chan : membership Dllist.node option;
+  (* mutable mem_of_user : membership Dllist.node option; *)
+}
+
+type router = {
+  users : (string_ci, user) Hashtbl.t;
+  channels : (string_ci, chan) Hashtbl.t;
+}

lib/server/user.ml

@@ -0,0 +1,54 @@
+open! Import
+include Router_types
+
+type t = user
+
+let make ~userinfo ~outbox =
+  {
+    outbox;
+    userinfo;
+    nick = "";
+    nick_key = empty_string_ci;
+    user_mode = Irc.Mode.Set.empty;
+    membership = Dllist.create ();
+  }
+
+let outbox t = t.outbox
+let nick t = t.nick
+let mode t = t.user_mode
+let set_mode t new_mode = t.user_mode <- new_mode
+
+let prefix user =
+  Irc.Msg.User_prefix (user.nick, Some user.userinfo)  
+
+let channels user =
+  Dllist.fold_r (fun m xs -> m.mem_chan :: xs) user.membership []
+
+let register t ~router =
+  Hashtbl.add router.users t.nick_key t
+
+let unregister t ~router =
+  Hashtbl.remove router.users t.nick_key
+
+let set_nick ?(success_callback = ignore) t new_nick ~router =
+  let key = string_ci new_nick in
+  if Hashtbl.mem router.users key then
+    `nick_in_use
+  else begin
+    (* hack to allow broadcasting a NICK message before nick is actually changed *)
+    success_callback ();
+    unregister t ~router;
+    t.nick <- new_nick;
+    t.nick_key <- key;
+    register t ~router;
+    `nick_set
+  end
+
+let rec part_all t =
+  (* List.iter (fun c -> Chan.part c t) (channels t) *)
+  match Dllist.take_l t.membership with
+  | m ->
+    Option.iter Dllist.remove m.mem_in_chan;
+    part_all t
+  | exception Dllist.Empty ->
+    ()