move MODE handling above JOIN, make set_or_unset a polyvar

lib/irc/mode.ml

@@ -158,26 +158,27 @@ module Parse = struct
       ~add:(fun ms m -> Set.{ add = add m ms.add; rem = remove m ms.rem })
       ~rem:(fun ms m -> Set.{ add = remove m ms.add; rem = add m ms.rem })
 
-  type ('a, 'b) set_or_unset =
+  type 'a set_or_unset = [
-    | Set of 'a
+    | `set of 'a
-    | Unset of 'b
+    | `unset
+  ]
 
   type chan_modes = {
     chan_modes : Set.change;
-    chan_key : (string, string) set_or_unset option;
+    chan_key : string set_or_unset option;
-    chan_limit : (int, unit) set_or_unset option;
+    chan_limit : int set_or_unset option;
   }
 
   let chan_modes_add (args, modes) = function
     | `k ->
       (* type B *)
       let key, args = take args in
-      let chan_key = Some (Set key) in
+      let chan_key = Some (`set key) in
       args, { modes with chan_key }
     | `l ->
       (* type C *)
-      let lim, args = take_int args in
+      let limit, args = take_int args in
-      let chan_limit = Some (Set lim) in
+      let chan_limit = Some (`set limit) in
       args, { modes with chan_limit }
     | `b | `o | `v -> fail "TODO: + ban/op/voice"
     | #chan_d as m ->
@@ -190,12 +191,12 @@ module Parse = struct
   let chan_modes_rem (args, modes) = function
     | `k ->
       (* type B *)
-      let key, args = take args in
+      let _key, args = take args in
-      let chan_key = Some (Unset key) in
+      let chan_key = Some `unset in
       args, { modes with chan_key }
     | `l ->
       (* type C *)
-      let chan_limit = Some (Unset ()) in
+      let chan_limit = Some `unset in
       args, { modes with chan_limit }
     | `b | `o | `v -> fail "TODO: - ban/op/voice"
     | #chan_d as m ->

lib/irc/mode.mli

@@ -73,15 +73,16 @@ module Parse : sig
 
   type user_modes = Set.change
 
-  type ('a, 'b) set_or_unset =
+  type 'a set_or_unset = [
-    | Set of 'a
+    | `set of 'a
-    | Unset of 'b
+    | `unset
+  ]
 
   type chan_modes = {
     chan_modes : Set.change;
-    chan_key : (string, string) set_or_unset option;
+    chan_key : string set_or_unset option;
-    chan_limit : (int, unit) set_or_unset option;
+    chan_limit : int set_or_unset option;
-    (* TODO: bad, op, voice *)
+    (* TODO: ban, op, voice *)
   }
 
   val user_modes : string -> user_modes

lib/server/connection.ml

@@ -125,113 +125,6 @@ let on_msg_quit t reason =
   Ok ()
 
 
-(* messages and channels *)
-
-let on_msg_privmsg t name txt =
-  let* me = require_registered t in
-  let* tgt =
-    try
-      match Irc.name_type name with
-      | `chan -> Ok (`chan (Router.find_chan t.router name))
-      | _     -> Ok (`user (Router.find_user t.router name))
-    with Not_found ->
-      Error (nosuchnick name)
-  in
-  (* TODO: check if user is away *)
-  (* TODO: check if channel is +n and user is not a member *)
-  (* TODO: check if channel is +m and user is not priviledged *)
-  (* TODO: check if channel is +b <user> *)
-  let name, dst =
-    match tgt with
-    | `chan c -> Chan.name c, [`to_chan c]
-    | `user u -> User.nick u, [`to_user u]
-  in
-  let msg = Irc.Msg.make "PRIVMSG" [name; txt] ~always_trailing:true in
-  Router.relay msg ~from:me dst;
-  Ok ()
-
-let list_names t chan =
-  begin
-    List.iter
-      (fun user ->
-         (* TODO: check if user is +i and not in channel with them *)
-         reply t ("353", ["@"; Chan.name chan; User.nick user]))
-      (Chan.members chan);
-    reply t ("366", [Chan.name chan; "End of NAMES list"])
-  end
-
-let on_msg_names t name =
-  let* _me = require_registered t in
-  let* chan =
-    try
-      match Irc.name_type name with
-      | `chan -> Ok (Router.find_chan t.router name)
-      | _     -> Error (nosuchchannel name)
-    with Not_found ->
-      Error (nosuchchannel name)
-  in
-  (* TODO: check if channel is +s and user not member of channel *)
-  list_names t chan;
-  Ok ()
-
-let on_msg_join t name ~set_chan_mode =
-  let* me = require_registered t in
-  (* TODO: keys parameter *)
-  (* TODO: "0" parameter means part from all channels *)
-  let* chan =
-    try
-      match Irc.name_type name with
-      | `chan -> Ok (Router.find_chan t.router name)
-      | _     -> Error (nosuchchannel name)
-    with Not_found ->
-      debug (fun m -> m "making new channel %S" name);
-      Ok (Chan.make ~name)
-  in
-
-  (* TODO: check channel mode +k, +l *)
-
-  let msg = Irc.Msg.make "JOIN" [name] in
-  Router.relay msg ~from:me [`to_chan chan; `to_self];
-  Chan.join chan me;
-
-  if not (Chan.is_registered chan ~router:t.router) then
-    (* set up newly created channel *)
-    begin
-      Chan.register chan ~router:t.router;
-      set_chan_mode chan ~from:me
-        Irc.Mode.Set.{
-          add = of_string initial_chan_modestr;
-          rem = empty;
-        };
-      (* TODO: make founder +o / +q etc. *)
-    end;
-
-  (* TODO: send channel topic *)
-  list_names t chan;
-  Ok ()
-
-let on_msg_part t name =
-  let* me = require_registered t in
-  (* TODO: part reason *)
-  let* chan =
-    try
-      match Irc.name_type name with
-      | `chan -> Ok (Router.find_chan t.router name)
-      | `nick | `invalid -> raise Not_found
-    with Not_found ->
-      Error (nosuchchannel name)
-  in
-  let* () = if Chan.is_member chan me then Ok () else Error (notonchannel name) in
-  let msg = Irc.Msg.make "PART" [name] in
-  Router.relay msg ~from:me [`to_chan chan; `to_self];
-  Chan.part chan me;
-  if Chan.no_members chan then begin
-    debug (fun m -> m "recycling channel %S" name);
-    Chan.unregister chan ~router:t.router;
-  end;
-  Ok ()
-
-
 (* modes *)
 
 let set_user_mode user chg =
@@ -259,13 +152,13 @@ let set_chan_mode chan ~from chg =
     end
 
 let set_chan_key chan ~from = function
-  | Irc.Mode.Parse.Set key ->
+  | `set key ->
     let msg = Irc.Msg.make "MODE" [Chan.name chan; "+k"; key] ~always_trailing:true in
     begin
       Router.relay msg ~from [`to_chan chan; `to_self];
       Chan.set_key chan (Some key);
     end
-  | Irc.Mode.Parse.Unset _key ->
+  | `unset ->
     if Chan.key chan <> None then
       let msg = Irc.Msg.make "MODE" [Chan.name chan; "-k"; "*"] in
       begin
@@ -274,14 +167,14 @@ let set_chan_key chan ~from = function
       end
 
 let set_chan_limit chan ~from = function
-  | Irc.Mode.Parse.Set lim ->
+  | `set lim ->
     if Chan.limit chan <> Some lim then
       let msg = Irc.Msg.make "MODE" [Chan.name chan; "+l"; string_of_int lim] in
       begin
         Router.relay msg ~from [`to_chan chan; `to_self];
         Chan.set_limit chan (Some lim);
       end
-  | Irc.Mode.Parse.Unset () ->
+  | `unset ->
     if Chan.limit chan <> None then
       let msg = Irc.Msg.make "MODE" [Chan.name chan; "-l"] in
       begin
@@ -296,7 +189,7 @@ let on_get_user_mode user me =
   ]
 
 let on_set_user_mode user me modestr _args =
-  let* () = if user != me then Error usersdontmatch_set else Ok () in
+  let* () = if user == me then Ok () else Error usersdontmatch_set in
   let* chg = try Ok (Irc.Mode.Parse.user_modes modestr)
     with Irc.Mode.Parse.Error ->
       (* TODO: "If one or more modes sent are not implemented on the server, the server
@@ -308,7 +201,7 @@ let on_set_user_mode user me modestr _args =
   Ok []
 
 let on_get_chan_mode chan _me =
-  let rpls =[
+  let rpls = [
     ["324", [Chan.name chan; Fmt.str "+%a" Irc.Mode.Set.pp (Chan.mode chan)]];
 
     begin match Chan.limit chan with
@@ -371,7 +264,111 @@ let on_msg_mode t name args =
   in
   List.iter (reply t) rpls
 
-let on_msg_join = on_msg_join ~set_chan_mode
+
+(* messages and channels *)
+
+let on_msg_privmsg t name txt =
+  let* me = require_registered t in
+  let* tgt =
+    try
+      match Irc.name_type name with
+      | `chan -> Ok (`chan (Router.find_chan t.router name))
+      | _     -> Ok (`user (Router.find_user t.router name))
+    with Not_found ->
+      Error (nosuchnick name)
+  in
+  (* TODO: check if user is away *)
+  (* TODO: check if channel is +n and user is not a member *)
+  (* TODO: check if channel is +m and user is not priviledged *)
+  (* TODO: check if channel is +b <user> *)
+  let name, dst =
+    match tgt with
+    | `chan c -> Chan.name c, [`to_chan c]
+    | `user u -> User.nick u, [`to_user u]
+  in
+  let msg = Irc.Msg.make "PRIVMSG" [name; txt] ~always_trailing:true in
+  Router.relay msg ~from:me dst;
+  Ok ()
+
+let list_names t chan =
+  begin
+    List.iter
+      (fun user ->
+         (* TODO: check if user is +i and not in channel with them *)
+         reply t ("353", ["@"; Chan.name chan; User.nick user]))
+      (Chan.members chan);
+    reply t ("366", [Chan.name chan; "End of NAMES list"])
+  end
+
+let on_msg_names t name =
+  let* _me = require_registered t in
+  let* chan =
+    try
+      match Irc.name_type name with
+      | `chan -> Ok (Router.find_chan t.router name)
+      | _     -> Error (nosuchchannel name)
+    with Not_found ->
+      Error (nosuchchannel name)
+  in
+  (* TODO: check if channel is +s and user not member of channel *)
+  list_names t chan;
+  Ok ()
+
+let on_msg_join t name =
+  let* me = require_registered t in
+  (* TODO: keys parameter *)
+  (* TODO: "0" parameter means part from all channels *)
+  let* chan =
+    try
+      match Irc.name_type name with
+      | `chan -> Ok (Router.find_chan t.router name)
+      | _     -> Error (nosuchchannel name)
+    with Not_found ->
+      debug (fun m -> m "making new channel %S" name);
+      Ok (Chan.make ~name)
+  in
+
+  (* TODO: check channel mode +k, +l *)
+
+  let msg = Irc.Msg.make "JOIN" [name] in
+  Router.relay msg ~from:me [`to_chan chan; `to_self];
+  Chan.join chan me;
+
+  if not (Chan.is_registered chan ~router:t.router) then
+    (* set up newly created channel *)
+    begin
+      Chan.register chan ~router:t.router;
+      set_chan_mode chan ~from:me {
+        add = Irc.Mode.Set.of_string initial_chan_modestr;
+        rem = Irc.Mode.Set.empty;
+      };
+      (* TODO: make founder +o / +q etc. *)
+    end;
+
+  (* TODO: send channel topic *)
+  list_names t chan;
+  Ok ()
+
+let on_msg_part t name =
+  let* me = require_registered t in
+  (* TODO: part reason *)
+  let* chan =
+    try
+      match Irc.name_type name with
+      | `chan -> Ok (Router.find_chan t.router name)
+      | `nick | `invalid -> raise Not_found
+    with Not_found ->
+      Error (nosuchchannel name)
+  in
+  let* () = if Chan.is_member chan me then Ok () else Error (notonchannel name) in
+  let msg = Irc.Msg.make "PART" [name] in
+  Router.relay msg ~from:me [`to_chan chan; `to_self];
+  Chan.part chan me;
+  if Chan.no_members chan then begin
+    debug (fun m -> m "recycling channel %S" name);
+    Chan.unregister chan ~router:t.router;
+  end;
+  Ok ()
 
 
 (* user registration *)