use result monad for Connection
This commit is contained in:
parent
4e3a86d21a
commit
f47a383fa1
|
@ -1,4 +1,5 @@
|
||||||
open! Import
|
open! Import
|
||||||
|
open Result_syntax
|
||||||
module User = Router.User
|
module User = Router.User
|
||||||
module Chan = Router.Chan
|
module Chan = Router.Chan
|
||||||
|
|
||||||
|
@ -23,179 +24,11 @@ let shutdown ?reason t =
|
||||||
let reason = Option.value reason ~default:"Goot bye" in
|
let reason = Option.value reason ~default:"Goot bye" in
|
||||||
Router.relay (Irc.Msg.make "QUIT" [reason]) ~from:me (`to_interested me);
|
Router.relay (Irc.Msg.make "QUIT" [reason]) ~from:me (`to_interested me);
|
||||||
User.part_all me;
|
User.part_all me;
|
||||||
|
(* TODO: BUG: unregister empty channels *)
|
||||||
User.unregister me ~router:t.router)
|
User.unregister me ~router:t.router)
|
||||||
t.user;
|
t.user;
|
||||||
Outbox.close t.outbox
|
Outbox.close t.outbox
|
||||||
|
|
||||||
(* > user registration *)
|
|
||||||
|
|
||||||
let require_registered t f =
|
|
||||||
match t.user with
|
|
||||||
| Some me -> f me
|
|
||||||
| None -> `notregistered
|
|
||||||
|
|
||||||
let attempt_to_register t =
|
|
||||||
match t.pending_nick, t.pending_userinfo with
|
|
||||||
| Some nick, Some userinfo ->
|
|
||||||
t.pending_nick <- None;
|
|
||||||
let me = User.make ~userinfo ~outbox:t.outbox in
|
|
||||||
begin match User.set_nick me nick ~router:t.router with
|
|
||||||
| `nick_in_use -> `nicknameinuse nick
|
|
||||||
| `nick_set ->
|
|
||||||
t.user <- Some me;
|
|
||||||
|
|
||||||
(* TODO: this sucks, fix it *)
|
|
||||||
let mode_msg = Irc.Msg.make "MODE" [nick; "+iw"] in
|
|
||||||
defer (fun () -> Router.relay mode_msg ~from:me `to_self);
|
|
||||||
|
|
||||||
`welcome me
|
|
||||||
end
|
|
||||||
| _, _ -> `ok
|
|
||||||
|
|
||||||
let on_msg_nick t nick =
|
|
||||||
if Irc.name_type nick <> `nick then
|
|
||||||
(if nick = "" then `nonicknamegiven else `erroneusnickname nick)
|
|
||||||
else match t.user with
|
|
||||||
| Some me ->
|
|
||||||
begin
|
|
||||||
let msg = Irc.Msg.make "NICK" [nick] in
|
|
||||||
match
|
|
||||||
User.set_nick me nick
|
|
||||||
~router:t.router
|
|
||||||
~success_callback:(fun () -> Router.relay msg ~from:me (`to_interested me))
|
|
||||||
with
|
|
||||||
| `nick_in_use -> `nicknameinuse nick
|
|
||||||
| `nick_set -> `ok
|
|
||||||
end
|
|
||||||
| None ->
|
|
||||||
t.pending_nick <- Some nick;
|
|
||||||
attempt_to_register t
|
|
||||||
|
|
||||||
let on_msg_user t username realname =
|
|
||||||
match t.user with
|
|
||||||
| Some _me -> `alreadyregistered
|
|
||||||
| None ->
|
|
||||||
(* TODO: configure hiding hostnames *)
|
|
||||||
let hostname = match t.addr with
|
|
||||||
| ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
|
|
||||||
| ADDR_UNIX path -> path
|
|
||||||
in
|
|
||||||
t.pending_userinfo <- Some { username; realname; hostname };
|
|
||||||
attempt_to_register t
|
|
||||||
|
|
||||||
(* > messages and channels *)
|
|
||||||
|
|
||||||
let on_msg_privmsg t tgt txt me =
|
|
||||||
(* TODO: comma-separated list of targets *)
|
|
||||||
let msg = Irc.Msg.make "PRIVMSG" [tgt; txt] ~always_trailing:true in
|
|
||||||
let dst =
|
|
||||||
try
|
|
||||||
match Irc.name_type tgt with
|
|
||||||
| `chan -> `to_chan (Router.find_chan t.router tgt)
|
|
||||||
| `nick -> `to_user (Router.find_user t.router tgt)
|
|
||||||
| `invalid -> `not_found
|
|
||||||
with Not_found -> `not_found
|
|
||||||
in
|
|
||||||
match dst with
|
|
||||||
| `not_found -> `nosuchnick tgt
|
|
||||||
| (`to_user _ | `to_chan _) as dst ->
|
|
||||||
(* 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> *)
|
|
||||||
Router.relay msg ~from:me dst;
|
|
||||||
`ok
|
|
||||||
|
|
||||||
let list_names chan =
|
|
||||||
let names =
|
|
||||||
List.map
|
|
||||||
(fun u -> "", User.nick u)
|
|
||||||
(Chan.members chan)
|
|
||||||
in
|
|
||||||
`names ("@", Chan.name chan, names)
|
|
||||||
|
|
||||||
let on_msg_names t name _me =
|
|
||||||
(* TODO: comma-separated list of channels *)
|
|
||||||
match Irc.name_type name with
|
|
||||||
| `nick | `invalid ->
|
|
||||||
if name = "" then `needmoreparams else `nosuchchannel name
|
|
||||||
| `chan ->
|
|
||||||
let chan = try Some (Router.find_chan t.router name)
|
|
||||||
with Not_found -> None
|
|
||||||
in
|
|
||||||
(* TODO: check if channel is +s and user is not a member *)
|
|
||||||
(* TODO: check if user in channel is +i and user is not a member *)
|
|
||||||
match chan with
|
|
||||||
| None -> `nosuchchannel name
|
|
||||||
| Some chan -> list_names chan
|
|
||||||
|
|
||||||
let on_msg_join t name me =
|
|
||||||
(* TODO: comma-separated list of channels *)
|
|
||||||
(* TODO: "0" parameter means part from all channels *)
|
|
||||||
match Irc.name_type name with
|
|
||||||
| `nick | `invalid ->
|
|
||||||
if name = "" then `needmoreparams else `nosuchchannel name
|
|
||||||
| `chan ->
|
|
||||||
let chan = try Router.find_chan t.router name
|
|
||||||
with Not_found ->
|
|
||||||
Logs.debug (fun m -> m "making new channel %S" name);
|
|
||||||
let chan = Chan.make ~name in
|
|
||||||
(* TODO: make user +o *)
|
|
||||||
Chan.register chan ~router:t.router;
|
|
||||||
chan
|
|
||||||
in
|
|
||||||
if Chan.is_member chan me then
|
|
||||||
`ok
|
|
||||||
else begin
|
|
||||||
(* TODO: check if channel is +k, get associated key from parameters *)
|
|
||||||
Chan.join chan me;
|
|
||||||
let msg = Irc.Msg.make "JOIN" [name] in
|
|
||||||
Router.relay msg ~from:me `to_self;
|
|
||||||
Router.relay msg ~from:me (`to_chan chan);
|
|
||||||
list_names chan
|
|
||||||
end
|
|
||||||
|
|
||||||
let on_msg_part t name me =
|
|
||||||
(* TODO: comma-separated list of channels *)
|
|
||||||
(* TODO: part reason *)
|
|
||||||
match Irc.name_type name with
|
|
||||||
| `nick | `invalid ->
|
|
||||||
if name = "" then `needmoreparams else `nosuchchannel name
|
|
||||||
| `chan ->
|
|
||||||
let chan = try Some (Router.find_chan t.router name)
|
|
||||||
with Not_found -> None
|
|
||||||
in
|
|
||||||
(* TODO: check if allowed to list names *)
|
|
||||||
match chan with
|
|
||||||
| None -> `nosuchchannel name
|
|
||||||
| Some chan ->
|
|
||||||
if not (Chan.is_member chan me) then `notonchannel name
|
|
||||||
else begin
|
|
||||||
let msg = Irc.Msg.make "PART" [name] in
|
|
||||||
Router.relay msg ~from:me `to_self;
|
|
||||||
Router.relay msg ~from:me (`to_chan chan);
|
|
||||||
Chan.part chan me;
|
|
||||||
if Chan.no_members chan then
|
|
||||||
Chan.unregister chan ~router:t.router;
|
|
||||||
`ok
|
|
||||||
end
|
|
||||||
|
|
||||||
let on_msg_privmsg t tgt msg = require_registered t (on_msg_privmsg t tgt msg)
|
|
||||||
let on_msg_names t name = require_registered t (on_msg_names t name)
|
|
||||||
let on_msg_join t name = require_registered t (on_msg_join t name)
|
|
||||||
let on_msg_part t name = require_registered t (on_msg_part t name)
|
|
||||||
|
|
||||||
(* > misc *)
|
|
||||||
|
|
||||||
let on_msg_quit t reason =
|
|
||||||
(* TODO: '''When connections are terminated by a client-sent QUIT command, servers
|
|
||||||
SHOULD prepend <reason> with the ASCII string "Quit: " when sending QUIT messages to
|
|
||||||
other clients''' *)
|
|
||||||
let reason = String.concat " " reason in
|
|
||||||
shutdown t ~reason;
|
|
||||||
`ok
|
|
||||||
|
|
||||||
(* message sending *)
|
|
||||||
|
|
||||||
(* TODO: configure these *)
|
(* TODO: configure these *)
|
||||||
let srv_host = "irc.tali.software"
|
let srv_host = "irc.tali.software"
|
||||||
|
@ -207,57 +40,227 @@ let srv_motd_lines = [
|
||||||
"meowmeowmeowmeowmeowmeow";
|
"meowmeowmeowmeowmeowmeow";
|
||||||
]
|
]
|
||||||
|
|
||||||
let rpl t cmd params =
|
|
||||||
|
(* numeric replies *)
|
||||||
|
|
||||||
|
type reply = string * string list
|
||||||
|
|
||||||
|
let reply t (num, params) =
|
||||||
let prefix = Irc.Msg.Server_prefix srv_host in
|
let prefix = Irc.Msg.Server_prefix srv_host in
|
||||||
let target = match t.user with
|
let target = match t.user with
|
||||||
| Some me -> User.nick me
|
| Some me -> User.nick me
|
||||||
| None -> "*"
|
| None -> "*"
|
||||||
in
|
in
|
||||||
Outbox.send t.outbox (Irc.Msg.make ~prefix cmd (target :: params))
|
Outbox.send t.outbox
|
||||||
|
(Irc.Msg.make ~prefix num (target :: params))
|
||||||
|
|
||||||
let rpl_tryagain t cmd = rpl t "263" [cmd; "Please wait a while and try again."]
|
let welcome t me =
|
||||||
|
|
||||||
let rpl_welcome t me =
|
|
||||||
let isupport = [
|
|
||||||
"CASEMAPPING=ascii";
|
|
||||||
"CHANTYPES=#";
|
|
||||||
"CHANMODES=b,k,l,imstn";
|
|
||||||
"PREFIX=(ov)@+";
|
|
||||||
] in
|
|
||||||
begin
|
begin
|
||||||
rpl t "001" ["Welcome to the tali IRC network %s"
|
reply t ("001", ["Welcome to the tali IRC network %s" ^ Irc.Msg.prefix_string (User.prefix me)]);
|
||||||
^ Irc.Msg.prefix_string (User.prefix me)];
|
reply t ("002", [Fmt.str "Your host is %s, running version %s" srv_host srv_ver]);
|
||||||
rpl t "002" [Fmt.str "Your host is %s, running version %s" srv_host srv_ver];
|
reply t ("003", [Fmt.str "This server was created %s" srv_created]);
|
||||||
rpl t "003" [Fmt.str "This server was created %s" srv_created];
|
reply t ("004", [srv_host; srv_ver; "iow"; "imnst"; "bklov"]);
|
||||||
rpl t "004" [srv_host; srv_ver; "iow"; "imnst"; "bklov"];
|
reply t ("005", ["CASEMAPPING=ascii";
|
||||||
rpl t "005" (isupport @ ["are supported by this server"]);
|
"CHANTYPES=#";
|
||||||
|
"CHANMODES=b,k,l,imstn";
|
||||||
|
"PREFIX=(ov)@+";
|
||||||
|
"are supported by this server"]);
|
||||||
end
|
end
|
||||||
|
|
||||||
let rpl_motd t =
|
let motd t =
|
||||||
begin
|
begin
|
||||||
rpl t "375" [Fmt.str "- %s Message of the day - " srv_host];
|
reply t ("375", [Fmt.str "- %s Message of the day - " srv_host]);
|
||||||
List.iter (fun ln -> rpl t "372" ["- " ^ ln]) srv_motd_lines;
|
List.iter (fun ln -> reply t ("372", ["- " ^ ln])) srv_motd_lines;
|
||||||
rpl t "376" ["End of /MOTD command"];
|
reply t ("376", ["End of /MOTD command"]);
|
||||||
end
|
end
|
||||||
|
|
||||||
let rpl_names t chan_prefix chan users =
|
(* errors *)
|
||||||
|
|
||||||
|
let nosuchnick tgt = "401", [tgt; "No such nick/channel"]
|
||||||
|
let nosuchchannel tgt = "403", [tgt; "No such channel"]
|
||||||
|
let norecipient = "411", ["No recipient given (PRIVMSG)"]
|
||||||
|
let notexttosend = "412", ["No text to send"]
|
||||||
|
let unknowncommand cmd = "421", [cmd; "Unknown command"]
|
||||||
|
let nonicknamegiven = "431", ["No nickname given"]
|
||||||
|
let erroneusnickname nick = "432", [nick; "Erroneus nickname"]
|
||||||
|
let nicknameinuse nick = "433", [nick; "Nickname is already in use"]
|
||||||
|
let notonchannel chan = "442", [chan; "You're not on that channel"]
|
||||||
|
let notregistered = "451", ["You have not registered"]
|
||||||
|
let needmoreparams cmd = "461", [cmd; "Not enough parameters"]
|
||||||
|
let alreadyregistered = "462", ["Unauthorized command (already registered)"]
|
||||||
|
|
||||||
|
|
||||||
|
(* user registration *)
|
||||||
|
|
||||||
|
let require_registered t =
|
||||||
|
match t.user with
|
||||||
|
| Some me -> Ok me
|
||||||
|
| None -> Error notregistered
|
||||||
|
|
||||||
|
let attempt_to_register t =
|
||||||
|
match t.pending_nick, t.pending_userinfo with
|
||||||
|
| Some nick, Some userinfo ->
|
||||||
|
t.pending_nick <- None;
|
||||||
|
let me = User.make ~userinfo ~outbox:t.outbox in
|
||||||
|
begin match User.set_nick me nick ~router:t.router with
|
||||||
|
| `nick_in_use -> Error (nicknameinuse nick)
|
||||||
|
| `nick_set ->
|
||||||
|
t.user <- Some me;
|
||||||
|
welcome t me;
|
||||||
|
motd t;
|
||||||
|
(* TODO: get "actual" user mode *)
|
||||||
|
let msg = Irc.Msg.make "MODE" [nick; "+iw"] in
|
||||||
|
Router.relay msg ~from:me `to_self;
|
||||||
|
Ok ()
|
||||||
|
end
|
||||||
|
| _, _ ->
|
||||||
|
Ok ()
|
||||||
|
|
||||||
|
let on_msg_nick t nick =
|
||||||
|
let* () =
|
||||||
|
match Irc.name_type nick with
|
||||||
|
| `nick -> Ok ()
|
||||||
|
| `chan | `invalid -> Error (erroneusnickname nick)
|
||||||
|
in
|
||||||
|
match t.user with
|
||||||
|
| Some me ->
|
||||||
|
begin
|
||||||
|
let msg = Irc.Msg.make "NICK" [nick] in
|
||||||
|
match
|
||||||
|
User.set_nick me nick
|
||||||
|
~router:t.router
|
||||||
|
~success_callback:(fun () -> Router.relay msg ~from:me (`to_interested me))
|
||||||
|
with
|
||||||
|
| `nick_in_use -> Error (nicknameinuse nick)
|
||||||
|
| `nick_set -> Ok ()
|
||||||
|
end
|
||||||
|
| None ->
|
||||||
|
t.pending_nick <- Some nick;
|
||||||
|
attempt_to_register t
|
||||||
|
|
||||||
|
let on_msg_user t username realname =
|
||||||
|
match t.user with
|
||||||
|
| Some _me -> Error alreadyregistered
|
||||||
|
| None ->
|
||||||
|
(* TODO: configure hiding hostnames *)
|
||||||
|
let hostname = match t.addr with
|
||||||
|
| ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
|
||||||
|
| ADDR_UNIX path -> path
|
||||||
|
in
|
||||||
|
t.pending_userinfo <- Some { username; realname; hostname };
|
||||||
|
attempt_to_register t
|
||||||
|
|
||||||
|
|
||||||
|
(* messages and channels *)
|
||||||
|
|
||||||
|
let on_msg_privmsg t tgt txt =
|
||||||
|
let* me = require_registered t in
|
||||||
|
(* TODO: comma-separated list of targets *)
|
||||||
|
let* dst =
|
||||||
|
try
|
||||||
|
match Irc.name_type tgt with
|
||||||
|
| `chan -> Ok (`to_chan (Router.find_chan t.router tgt))
|
||||||
|
| _ -> Ok (`to_user (Router.find_user t.router tgt))
|
||||||
|
with Not_found ->
|
||||||
|
Error (nosuchnick tgt)
|
||||||
|
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 msg = Irc.Msg.make "PRIVMSG" [tgt; txt] ~always_trailing:true in
|
||||||
|
Router.relay msg ~from:me dst;
|
||||||
|
Ok ()
|
||||||
|
|
||||||
|
let list_names t chan =
|
||||||
begin
|
begin
|
||||||
List.iter (fun (up, u) -> rpl t "353" [chan_prefix; chan; up ^ u]) users;
|
List.iter
|
||||||
rpl t "366" [chan; "End of NAMES list"]
|
(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
|
end
|
||||||
|
|
||||||
let err_nosuchnick t tgt = rpl t "401" [tgt; "No such nick/channel"]
|
let on_msg_names t name =
|
||||||
let err_nosuchchannel t tgt = rpl t "403" [tgt; "No such channel"]
|
let* _me = require_registered t in
|
||||||
let err_norecipient t cmd = rpl t "411" [Fmt.str "No recipient given (%s)" cmd]
|
(* TODO: comma-separated list of channels *)
|
||||||
let err_notexttosend t = rpl t "412" ["No text to send"]
|
let* chan =
|
||||||
let err_unknowncommand t cmd = rpl t "421" [cmd; "Unknown command"]
|
try
|
||||||
let err_nonicknamegiven t = rpl t "431" ["No nickname given"]
|
match Irc.name_type name with
|
||||||
let err_erroneousnickname t nick = rpl t "432" [nick; "Erroneus nickname"]
|
| `chan -> Ok (Router.find_chan t.router name)
|
||||||
let err_nicknameinuse t nick = rpl t "433" [nick; "Nickname is already in use"]
|
| _ -> Error (nosuchchannel name)
|
||||||
let err_notonchannel t chan = rpl t "442" [chan; "You're not on that channel"]
|
with Not_found ->
|
||||||
let err_notregistered t = rpl t "451" ["You have not registered"]
|
Error (nosuchchannel name)
|
||||||
let err_needmoreparams t cmd = rpl t "461" [cmd; "Not enough parameters"]
|
in
|
||||||
let err_alreadyregistered t = rpl t "462" ["Unauthorized command (already registered)"]
|
(* 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: comma-separated list of channels *)
|
||||||
|
(* 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 ->
|
||||||
|
Logs.debug (fun m -> m "making new channel %S" name);
|
||||||
|
let chan = Chan.make ~name in
|
||||||
|
Chan.register chan ~router:t.router;
|
||||||
|
(* TODO: make user +o *)
|
||||||
|
Ok chan
|
||||||
|
in
|
||||||
|
(* TODO: check if channel is +k, get associated key from parameters *)
|
||||||
|
Chan.join chan me;
|
||||||
|
let msg = Irc.Msg.make "JOIN" [name] in
|
||||||
|
Router.relay msg ~from:me `to_self;
|
||||||
|
Router.relay msg ~from:me (`to_chan chan);
|
||||||
|
(* TODO: send channel topic *)
|
||||||
|
list_names t chan;
|
||||||
|
Ok ()
|
||||||
|
|
||||||
|
let on_msg_part t name =
|
||||||
|
let* me = require_registered t in
|
||||||
|
(* TODO: comma-separated list of channels *)
|
||||||
|
(* TODO: part reason *)
|
||||||
|
let* chan =
|
||||||
|
try
|
||||||
|
match Irc.name_type name with
|
||||||
|
| `chan -> Ok (Router.find_chan t.router name)
|
||||||
|
| `nick | `invalid -> Error (nosuchchannel name)
|
||||||
|
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_self;
|
||||||
|
Router.relay msg ~from:me (`to_chan chan);
|
||||||
|
Chan.part chan me;
|
||||||
|
if Chan.no_members chan then begin
|
||||||
|
Logs.debug (fun m -> m "recycling channel %S" name);
|
||||||
|
Chan.unregister chan ~router:t.router;
|
||||||
|
end;
|
||||||
|
Ok ()
|
||||||
|
|
||||||
|
|
||||||
|
(* misc *)
|
||||||
|
|
||||||
|
let on_msg_motd t =
|
||||||
|
let* _me = require_registered t in
|
||||||
|
motd t;
|
||||||
|
Ok ()
|
||||||
|
|
||||||
|
let on_msg_quit t reason =
|
||||||
|
(* TODO: '''When connections are terminated by a client-sent QUIT command, servers
|
||||||
|
SHOULD prepend <reason> with the ASCII string "Quit: " when sending QUIT messages to
|
||||||
|
other clients''' *)
|
||||||
|
let reason = String.concat " " reason in
|
||||||
|
shutdown t ~reason;
|
||||||
|
Ok ()
|
||||||
|
|
||||||
|
|
||||||
(* message parsing *)
|
(* message parsing *)
|
||||||
|
|
||||||
|
@ -265,37 +268,20 @@ let on_msg t (msg : Irc.Msg.t) : unit =
|
||||||
(* Logs.debug (fun m -> m "%a: %a" pp_sockaddr t.addr Irc.Msg.pp msg); *)
|
(* Logs.debug (fun m -> m "%a: %a" pp_sockaddr t.addr Irc.Msg.pp msg); *)
|
||||||
let result =
|
let result =
|
||||||
match msg.command, msg.params with
|
match msg.command, msg.params with
|
||||||
| "NICK", new_nick :: _ -> on_msg_nick t new_nick
|
| "NICK", nick :: _ when nick <> "" -> on_msg_nick t nick
|
||||||
| "NICK", [] -> `nonicknamegiven
|
| "NICK", _ -> Error nonicknamegiven
|
||||||
| "USER", unm :: _ :: _ :: rnm :: _ -> on_msg_user t unm rnm
|
| "USER", unm :: _ :: _ :: rnm :: _ -> on_msg_user t unm rnm
|
||||||
| "USER", _ -> `needmoreparams
|
|
||||||
| "QUIT", why -> on_msg_quit t why
|
| "QUIT", why -> on_msg_quit t why
|
||||||
| "MOTD", _ -> `motd
|
| "MOTD", _ -> on_msg_motd t
|
||||||
| "PRIVMSG", tgt :: msg :: _ -> on_msg_privmsg t tgt msg
|
| "PRIVMSG", tgt :: msg :: _ -> on_msg_privmsg t tgt msg
|
||||||
| "PRIVMSG", [_] -> `notexttosend | "PRIVMSG", [] -> `norecipient
|
| "PRIVMSG", [_] -> Error notexttosend | "PRIVMSG", [] -> Error norecipient
|
||||||
| "JOIN", tgt :: _ -> on_msg_join t tgt
|
| "JOIN", tgt :: _ when tgt <> "" -> on_msg_join t tgt
|
||||||
| "JOIN", _ -> `needmoreparams
|
| "NAMES", tgt :: _ when tgt <> "" -> on_msg_names t tgt
|
||||||
| "NAMES", tgt :: _ -> on_msg_names t tgt
|
| "PART", tgt :: _ when tgt <> "" -> on_msg_part t tgt
|
||||||
| "NAMES", _ -> `needmoreparams
|
| "USER", _ | "JOIN", _ | "NAMES", _ | "PART", _ ->
|
||||||
| "PART", tgt :: _ -> on_msg_part t tgt
|
Error (needmoreparams msg.command)
|
||||||
| "PART", _ -> `needmoreparams
|
| _, _ -> Error (unknowncommand msg.command)
|
||||||
| _, _ -> `unknowncommand
|
|
||||||
in
|
in
|
||||||
match result with
|
match result with
|
||||||
| `ok -> ()
|
| Ok () -> ()
|
||||||
| `welcome usr -> rpl_welcome t usr; rpl_motd t
|
| Error err -> reply t err
|
||||||
| `motd -> rpl_motd t
|
|
||||||
| `names (cp, ch, us) -> rpl_names t cp ch us
|
|
||||||
| `tryagain -> rpl_tryagain t msg.command
|
|
||||||
| `alreadyregistered -> err_alreadyregistered t
|
|
||||||
| `erroneusnickname n -> err_erroneousnickname t n
|
|
||||||
| `needmoreparams -> err_needmoreparams t msg.command
|
|
||||||
| `nicknameinuse n -> err_nicknameinuse t n
|
|
||||||
| `nonicknamegiven -> err_nonicknamegiven t
|
|
||||||
| `norecipient -> err_norecipient t msg.command
|
|
||||||
| `nosuchchannel c -> err_nosuchchannel t c
|
|
||||||
| `nosuchnick n -> err_nosuchnick t n
|
|
||||||
| `notexttosend -> err_notexttosend t
|
|
||||||
| `notonchannel c -> err_notonchannel t c
|
|
||||||
| `notregistered -> err_notregistered t
|
|
||||||
| `unknowncommand -> err_unknowncommand t msg.command
|
|
||||||
|
|
|
@ -14,3 +14,8 @@ let empty_string_ci = Case_insensitive ""
|
||||||
|
|
||||||
let defer f =
|
let defer f =
|
||||||
Lwt.on_success (Lwt.pause ()) f
|
Lwt.on_success (Lwt.pause ()) f
|
||||||
|
|
||||||
|
module Result_syntax = struct
|
||||||
|
let ( let* ) = Result.bind
|
||||||
|
let ( let+ ) r f = Result.map f r
|
||||||
|
end
|
||||||
|
|
Loading…
Reference in New Issue