fix logic for setting modes, initial mode, get mode reply

lib/irc/mode.ml

@@ -93,6 +93,24 @@ module Set = struct
       | _ -> invalid_arg "Irc.Mode.Set.of_string"
     in
     String.fold_left (fun s c -> add (chr c) s) empty s
+
+  type change = {
+    add : t;
+    rem : t;
+  }
+
+  let pp_change ppf { add; rem } =
+    if rem = 0 then
+      Format.fprintf ppf "+%a" pp add
+    else if add = 0 then
+      Format.fprintf ppf "-%a" pp rem
+    else
+      Format.fprintf ppf "+%a-%a" pp add pp rem
+
+  let normalize t { add; rem } =
+    let add = diff add t in
+    let rem = inter rem t in
+    diff (union t add) rem, { add; rem }
 end
 
 
@@ -102,16 +120,6 @@ module Parse = struct
   let fail fmt =
     Format.kasprintf (fun _ -> raise Error) fmt
 
-  type user_mode_set = {
-    add : Set.t;
-    rem : Set.t;
-  }
-
-  let pp_user_mode_set ppf { add; rem } = match add, rem with
-    | _, 0 -> Format.fprintf ppf "+%a" Set.pp add
-    | 0, _ -> Format.fprintf ppf "-%a" Set.pp rem
-    | _, _ -> Format.fprintf ppf "+%a-%a" Set.pp add Set.pp rem
-
   let parse_mode_set str ~of_char ~add ~rem ~init =
     let rec loop dir acc i =
       if i >= String.length str then acc
@@ -130,12 +138,12 @@ module Parse = struct
     in
     loop `none init 0
 
-  let user str =
+  let user_modes str =
     parse_mode_set str
       ~of_char:of_char_user
-      ~init:{ add = Set.empty; rem = Set.empty }
+      ~init:Set.{ add = empty; rem = empty }
-      ~add:(fun ms m -> { add = Set.add m ms.add; rem = Set.remove m ms.rem })
+      ~add:(fun ms m -> Set.{ add = add m ms.add; rem = remove m ms.rem })
-      ~rem:(fun ms m -> { add = Set.remove m ms.add; rem = Set.add m ms.rem })
+      ~rem:(fun ms m -> Set.{ add = remove m ms.add; rem = add m ms.rem })
 end
 
 
@@ -162,6 +170,7 @@ let%expect_test _ =
 
   let print_set_nl s = Printf.printf "[%s]\n" (Set.to_string s) in
   let print_bool_nl b = print_endline (if b then "true" else "false") in
+  let print_change_nl c = Format.printf "%a\n" Set.pp_change c in
 
   print_set_nl Set.empty; [%expect {| [] |}];
   print_set_nl Set.(of_string "i"); [%expect {| [i] |}];
@@ -173,21 +182,21 @@ let%expect_test _ =
   print_bool_nl Set.(mem `w (of_string "wwww")); [%expect "true"];
   print_bool_nl Set.(mem `t (of_string "imnosw")); [%expect "false"];
 
-  let print_user_mode_set_nl um =
-    Format.printf "%a\n" Parse.pp_user_mode_set um
-  in
-
   let expect_parse_error f =
     try f () |> ignore; print_endline "no error"
     with Parse.Error -> ()
        | e -> print_endline (Printexc.to_string e)
   in
 
-  print_user_mode_set_nl (Parse.user "+iw"); [%expect {| +iw |}];
+  print_change_nl (Parse.user_modes "+iw"); [%expect {| +iw |}];
-  print_user_mode_set_nl (Parse.user "-wo"); [%expect {| -ow |}];
+  print_change_nl (Parse.user_modes "-wo"); [%expect {| -ow |}];
-  print_user_mode_set_nl (Parse.user "+i-w"); [%expect {| +i-w |}];
+  print_change_nl (Parse.user_modes "+i-w"); [%expect {| +i-w |}];
-  print_user_mode_set_nl (Parse.user "-i+w"); [%expect {| +w-i |}];
+  print_change_nl (Parse.user_modes "-i+w"); [%expect {| +w-i |}];
-  print_user_mode_set_nl (Parse.user "+i-i"); [%expect {| -i |}];
+  print_change_nl (Parse.user_modes "+i-i"); [%expect {| -i |}];
-  print_user_mode_set_nl (Parse.user "-o+o"); [%expect {| +o |}];
+  print_change_nl (Parse.user_modes "-o+o"); [%expect {| +o |}];
-  expect_parse_error (fun () -> Parse.user "+b");
+  expect_parse_error (fun () -> Parse.user_modes "+b");
-  expect_parse_error (fun () -> Parse.user "w");
+  expect_parse_error (fun () -> Parse.user_modes "w");
+
+  let m, c = Set.normalize (Set.of_string "iw") (Parse.user_modes "-w+io") in
+  Format.printf "%a -> [%a]" Set.pp_change c Set.pp m;
+  [%expect {| +o-w -> [io] |}];

lib/irc/mode.mli

@@ -56,19 +56,21 @@ module Set : sig
   val of_string : string -> t
   (* val to_list  : t -> elt list *)
   (* val of_list : [< elt] list -> t *)
+
+  type change = {
+    add : t;
+    rem : t;
+  }
+
+  val pp_change : Format.formatter -> change -> unit
+
+  val normalize : t -> change -> t * change
 end
 
 module Parse : sig
   exception Error
 
-  type user_mode_set = {
+  val user_modes : string -> Set.change
-    add : Set.t;
-    rem : Set.t;
-  }
-
-  val pp_user_mode_set : Format.formatter -> user_mode_set -> unit
-
-  val user : string -> user_mode_set
 
   (* type ('a, 'b) add_rem = Add of 'a | Rem of 'b *)
   (* type chan_mode_set = *)

lib/server/connection.ml

@@ -42,6 +42,9 @@ let srv_motd_lines = [
   "meowmeowmeowmeowmeowmeow";
 ]
 
+let initial_user_modestr = "iw"
+(* let initial_chan_modestr = "nst" *)
+
 
 (* numeric replies *)
 
@@ -91,7 +94,8 @@ let attempt_to_register ~welcome t =
       | `nick_in_use -> Error (nicknameinuse nick)
       | `nick_set ->
         t.user <- Some me;
-        welcome t me
+        welcome t me;
+        Ok ()
     end
   | _, _ ->
     Ok ()
@@ -228,66 +232,70 @@ let on_msg_part t name =
 
 (* modes *)
 
-let user_get_mode user me =
+let set_user_mode from user chg =
-  let modestr = Fmt.str "+%a" Irc.Mode.Set.pp (User.mode user) in
+  let mode, chg = Irc.Mode.Set.normalize (User.mode user) chg in
+  let modestr = Fmt.str "%a" Irc.Mode.Set.pp_change chg in
   let msg = Irc.Msg.make "MODE" [User.nick user; modestr] ~always_trailing:true in
-  Router.relay msg ~from:me [`to_self];
+  Router.relay msg ~from [`to_user user; `to_self];
-  Ok ()
+  User.set_mode user mode
 
-let user_set_mode user me modestr _args =
+let on_get_user_mode user _me =
-  (* TODO: only +o can set modes for users besides themselves *)
+  (* TODO: only +o can get/set modes for users besides themselves *)
-  let* set = try Ok (Irc.Mode.Parse.user modestr)
+  Ok [
+    "221", [Fmt.str "+%a" Irc.Mode.Set.pp (User.mode user)]
+  ]
+
+let on_set_user_mode user me modestr _args =
+  (* TODO: only +o can get/set modes for users besides themselves *)
+  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
+         MUST apply the modes that are implemented, and then send the ERR_UMODEUNKNOWNFLAG
+         (501) in reply along with the MODE message." *)
       Error modeunknownflag
   in
-  let mode = User.mode user in
   (* TODO: only +o can set +o mode *)
-  let mode, modestr =
+  set_user_mode me user chg;
-    let open Irc.Mode.Set in
-    let add = diff set.add mode in
-    let rem = inter set.rem mode in
-    let mode = union mode add in
-    let mode = diff mode rem in
-    mode, Fmt.str "%a" Irc.Mode.Parse.pp_user_mode_set { add; rem }
-  in
-  let msg = Irc.Msg.make "MODE" [User.nick user; modestr] ~always_trailing:true in
-  Router.relay msg ~from:me [`to_user user; `to_self];
-  User.set_mode user mode;
   Ok ()
 
-let chan_get_mode chan me =
+let on_get_chan_mode chan me =
   let _ = me, chan in
-  (* TODO *)
+  (* If <modestring> is not given, the RPL_CHANNELMODEIS (324) numeric is returned. Servers
+     MAY choose to hide sensitive information such as channel keys when sending the current
+     modes. Servers MAY also return the RPL_CREATIONTIME (329) numeric following
+     RPL_CHANNELMODEIS.  *)
   Error (tryagain "MODE")
 
-let chan_set_mode chan me modestr args =
+let on_set_chan_mode chan me modestr args =
   let _ = me, chan, modestr, args in
   (* TODO *)
   Error (tryagain "MODE")
 
 let on_msg_mode t name args =
   let* me = require_registered t in
-  let* set, get =
+  let* on_set, on_get =
     try
       match Irc.name_type name with
       | `nick ->
         let u = Router.find_user t.router name in
-        Ok (user_set_mode u, user_get_mode u)
+        Ok (on_set_user_mode u, on_get_user_mode u)
       | `chan ->
         let c = Router.find_chan t.router name in
-        Ok (chan_set_mode c, chan_get_mode c)
+        Ok (on_set_chan_mode c, on_get_chan_mode c)
       | `invalid -> raise Not_found
     with Not_found ->
       Error (nosuchnick name)
   in
   match args with
-  | [] -> get me
+  | [] ->
-  | modestr :: args -> set me modestr args
+    let+ rpls = on_get me in
-
+    List.iter (reply t) rpls
+  | modestr :: args ->
+    on_set me modestr args
 
 (* misc *)
 
-let about t me =
+let about t me : unit =
   let who = Irc.Msg.prefix_string (User.prefix me) in
   begin
     reply t ("001", [Fmt.str "Welcome to the tali IRC network %s" who]);
@@ -311,7 +319,10 @@ let motd t =
 let welcome t me =
   about t me;
   motd t;
-  user_get_mode me me
+  set_user_mode me me {
+    add = Irc.Mode.Set.of_string initial_user_modestr;
+    rem = Irc.Mode.Set.empty;
+  }
 
 let on_msg_nick = on_msg_nick ~welcome
 let on_msg_user = on_msg_user ~welcome

lib/server/router.ml

@@ -83,7 +83,7 @@ module User = struct
       userinfo;
       nick = "*";
       nick_key = empty_string_ci;
-      user_mode = Irc.Mode.Set.of_string "iw";
+      user_mode = Irc.Mode.Set.empty;
       membership = Dllist.create ();
     }