irc-core-2.2.0.0/0000755000000000000000000000000012767006760011555 5ustar0000000000000000irc-core-2.2.0.0/ChangeLog.md0000644000000000000000000000125012767006760013724 0ustar0000000000000000# Revision history for irc-core ## 2.2.0.0 -- 2016-09-15 * `ircIson` packs all the nicks into a single argument * `Eq` and `Ord` instances for `ReplyCode` * Use `Text` for nickname targets in Irc.Commands ## 2.1.1.1 -- 2016-08-28 * Added parsing tests * Slightly more tolerant of whitespace ## 2.1.1.0 -- 2016-08-13 * Add `Eq` instances to `UserInfo` and `RawIrcMsg` * Add `IsString` instance to `Identifier` * Remove `lens` dependency (functionality preserved) * Show and Read instances for `Identifier` render the text version as a string literal ## 2.1.0.0 -- 2016-08-13 * Add BatchStart and BatchEnd messages ## 2.0.0.0 -- 2016-08-08 * Extracted from glirc-2.5 irc-core-2.2.0.0/irc-core.cabal0000644000000000000000000000366112767006760014252 0ustar0000000000000000name: irc-core version: 2.2.0.0 synopsis: IRC core library for glirc description: IRC core library for glirc . The glirc client has been split off into homepage: https://github.com/glguy/irc-core license: ISC license-file: LICENSE author: Eric Mertens maintainer: emertens@gmail.com copyright: 2016 Eric Mertens category: Network build-type: Simple extra-source-files: ChangeLog.md cabal-version: >=1.10 homepage: https://github.com/glguy/irc-core bug-reports: https://github.com/glguy/irc-core/issues source-repository head type: git location: git://github.com/glguy/irc-core.git branch: v2 library exposed-modules: Irc.Codes Irc.Commands Irc.Identifier Irc.Message Irc.Modes Irc.RateLimit Irc.RawIrcMsg Irc.UserInfo other-modules: View build-depends: base >=4.9 && <4.10, attoparsec >=0.13 && <0.14, bytestring >=0.10 && <0.11, hashable >=1.2 && <1.3, memory >=0.13 && <0.14, primitive >=0.6 && <0.7, text >=1.2 && <1.3, time >=1.6 && <1.7, vector >=0.11 && <0.12 hs-source-dirs: src default-language: Haskell2010 test-suite test type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test build-depends: irc-core, base, text, hashable, HUnit >= 1.3 && < 1.4 default-language: Haskell2010 irc-core-2.2.0.0/LICENSE0000644000000000000000000000133212767006760012561 0ustar0000000000000000Copyright (c) 2016 Eric Mertens Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. irc-core-2.2.0.0/Setup.hs0000644000000000000000000000005612767006760013212 0ustar0000000000000000import Distribution.Simple main = defaultMain irc-core-2.2.0.0/src/0000755000000000000000000000000012767006760012344 5ustar0000000000000000irc-core-2.2.0.0/src/View.hs0000644000000000000000000000052412767006760013613 0ustar0000000000000000{-| Module : View Description : Local definition of view Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com -} module View (view) where import Data.Functor.Const -- | Local definition of lens package's view. view :: ((a -> Const a a) -> s -> Const a s) -> s -> a view l x = getConst (l Const x) irc-core-2.2.0.0/src/Irc/0000755000000000000000000000000012767006760013061 5ustar0000000000000000irc-core-2.2.0.0/src/Irc/Codes.hs0000644000000000000000000014574112767006760014466 0ustar0000000000000000{-# Language PatternSynonyms, OverloadedStrings #-} {-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-} {-| Module : Irc.Codes Description : Helpers for interpreting IRC reply codes Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module defines support for working with IRC's numeric reply codes. Pattern synonyms are provided for each of the possible IRC reply codes. Reply code information was extracted from https://www.alien.net.au/irc/irc2numerics.html -} module Irc.Codes where import Data.Vector (Vector) import qualified Data.Vector as Vector import Data.Text (Text) import qualified Data.Text as Text -- | Type of numeric reply codes newtype ReplyCode = ReplyCode Word deriving (Eq, Ord) -- | Shows number instance Show ReplyCode where showsPrec p (ReplyCode x) = showsPrec p x -- | Reads only the number instance Read ReplyCode where readsPrec p str = [ (ReplyCode x, xs) | (x,xs) <- readsPrec p str ] -- | Categories for reply codes data ReplyType = ClientServerReply -- ^ 0-99 Messages between client and server | CommandReply -- ^ 200-399 Responses to commands | ErrorReply -- ^ 200-399 Errors | UnknownReply -- ^ Uncategorized deriving (Eq, Ord, Read, Show) pattern RPL_WELCOME = ReplyCode 001 pattern RPL_YOURHOST = ReplyCode 002 pattern RPL_CREATED = ReplyCode 003 pattern RPL_MYINFO = ReplyCode 004 pattern RPL_ISUPPORT = ReplyCode 005 pattern RPL_SNOMASK = ReplyCode 008 pattern RPL_STATMEMTOT = ReplyCode 009 pattern RPL_REDIR = ReplyCode 010 pattern RPL_YOURCOOKIE = ReplyCode 014 pattern RPL_MAP = ReplyCode 015 pattern RPL_MAPEND = ReplyCode 017 pattern RPL_YOURID = ReplyCode 042 pattern RPL_SAVENICK = ReplyCode 043 pattern RPL_ATTEMPTINGJUNC = ReplyCode 050 pattern RPL_ATTEMPTINGREROUTE = ReplyCode 051 pattern RPL_TRACELINK = ReplyCode 200 pattern RPL_TRACECONNECTING = ReplyCode 201 pattern RPL_TRACEHANDSHAKE = ReplyCode 202 pattern RPL_TRACEUNKNOWN = ReplyCode 203 pattern RPL_TRACEOPERATOR = ReplyCode 204 pattern RPL_TRACEUSER = ReplyCode 205 pattern RPL_TRACESERVER = ReplyCode 206 pattern RPL_TRACESERVICE = ReplyCode 207 pattern RPL_TRACENEWTYPE = ReplyCode 208 pattern RPL_TRACECLASS = ReplyCode 209 pattern RPL_TRACERECONNECT = ReplyCode 210 pattern RPL_STATS = ReplyCode 210 pattern RPL_STATSLINKINFO = ReplyCode 211 pattern RPL_STATSCOMMANDS = ReplyCode 212 pattern RPL_STATSCLINE = ReplyCode 213 pattern RPL_STATSNLINE = ReplyCode 214 pattern RPL_STATSILINE = ReplyCode 215 pattern RPL_STATSKLINE = ReplyCode 216 pattern RPL_STATSQLINE = ReplyCode 217 pattern RPL_STATSYLINE = ReplyCode 218 pattern RPL_ENDOFSTATS = ReplyCode 219 pattern RPL_STATSPLINE = ReplyCode 220 pattern RPL_UMODEIS = ReplyCode 221 pattern RPL_SQLINE_NICK = ReplyCode 222 pattern RPL_STATSDLINE = ReplyCode 225 pattern RPL_STATSZLINE = ReplyCode 225 pattern RPL_STATSCOUNT = ReplyCode 226 pattern RPL_SERVICEINFO = ReplyCode 231 pattern RPL_ENDOFSERVICES = ReplyCode 232 pattern RPL_SERVICE = ReplyCode 233 pattern RPL_SERVLIST = ReplyCode 234 pattern RPL_SERVLISTEND = ReplyCode 235 pattern RPL_STATSVERBOSE = ReplyCode 236 pattern RPL_STATSIAUTH = ReplyCode 239 pattern RPL_STATSLLINE = ReplyCode 241 pattern RPL_STATSUPTIME = ReplyCode 242 pattern RPL_STATSOLINE = ReplyCode 243 pattern RPL_STATSHLINE = ReplyCode 244 pattern RPL_STATSSLINE = ReplyCode 245 pattern RPL_STATSPING = ReplyCode 246 pattern RPL_STATSXLINE = ReplyCode 247 pattern RPL_STATSULINE = ReplyCode 248 pattern RPL_STATSDEBUG = ReplyCode 249 pattern RPL_STATSCONN = ReplyCode 250 pattern RPL_LUSERCLIENT = ReplyCode 251 pattern RPL_LUSEROP = ReplyCode 252 pattern RPL_LUSERUNKNOWN = ReplyCode 253 pattern RPL_LUSERCHANNELS = ReplyCode 254 pattern RPL_LUSERME = ReplyCode 255 pattern RPL_ADMINME = ReplyCode 256 pattern RPL_ADMINLOC1 = ReplyCode 257 pattern RPL_ADMINLOC2 = ReplyCode 258 pattern RPL_ADMINEMAIL = ReplyCode 259 pattern RPL_TRACELOG = ReplyCode 261 pattern RPL_ENDOFTRACE = ReplyCode 262 pattern RPL_LOAD2HI = ReplyCode 263 pattern RPL_LOCALUSERS = ReplyCode 265 pattern RPL_GLOBALUSERS = ReplyCode 266 pattern RPL_START_NETSTAT = ReplyCode 267 pattern RPL_NETSTAT = ReplyCode 268 pattern RPL_END_NETSTAT = ReplyCode 269 pattern RPL_PRIVS = ReplyCode 270 pattern RPL_SILELIST = ReplyCode 271 pattern RPL_ENDOFSILELIST = ReplyCode 272 pattern RPL_NOTIFY = ReplyCode 273 pattern RPL_ENDNOTIFY = ReplyCode 274 pattern RPL_STATSDELTA = ReplyCode 274 pattern RPL_WHOISCERTFP = ReplyCode 276 pattern RPL_VCHANLIST = ReplyCode 277 pattern RPL_VCHANHELP = ReplyCode 278 pattern RPL_GLIST = ReplyCode 280 pattern RPL_ACCEPTLIST = ReplyCode 281 pattern RPL_ENDOFACCEPT = ReplyCode 282 pattern RPL_ENDOFJUPELIST = ReplyCode 283 pattern RPL_FEATURE = ReplyCode 284 pattern RPL_DATASTR = ReplyCode 290 pattern RPL_END_CHANINFO = ReplyCode 299 pattern RPL_NONE = ReplyCode 300 pattern RPL_AWAY = ReplyCode 301 pattern RPL_USERHOST = ReplyCode 302 pattern RPL_ISON = ReplyCode 303 pattern RPL_TEXT = ReplyCode 304 pattern RPL_UNAWAY = ReplyCode 305 pattern RPL_NOWAWAY = ReplyCode 306 pattern RPL_WHOISREGNICK = ReplyCode 307 pattern RPL_SUSERHOST = ReplyCode 307 pattern RPL_NOTIFYACTION = ReplyCode 308 pattern RPL_WHOISADMIN = ReplyCode 308 pattern RPL_NICKTRACE = ReplyCode 309 pattern RPL_WHOISSADMIN = ReplyCode 309 pattern RPL_WHOISHELPER = ReplyCode 309 pattern RPL_WHOISUSER = ReplyCode 311 pattern RPL_WHOISSERVER = ReplyCode 312 pattern RPL_WHOISOPERATOR = ReplyCode 313 pattern RPL_WHOWASUSER = ReplyCode 314 pattern RPL_ENDOFWHO = ReplyCode 315 pattern RPL_WHOISCHANOP = ReplyCode 316 pattern RPL_WHOISIDLE = ReplyCode 317 pattern RPL_ENDOFWHOIS = ReplyCode 318 pattern RPL_WHOISCHANNELS = ReplyCode 319 pattern RPL_WHOISSPECIAL = ReplyCode 320 pattern RPL_LISTSTART = ReplyCode 321 pattern RPL_LIST = ReplyCode 322 pattern RPL_LISTEND = ReplyCode 323 pattern RPL_CHANNELMODEIS = ReplyCode 324 pattern RPL_CHANNELMLOCKIS = ReplyCode 325 pattern RPL_NOCHANPASS = ReplyCode 326 pattern RPL_CHPASSUNKNOWN = ReplyCode 327 pattern RPL_CHANNEL_URL = ReplyCode 328 pattern RPL_CREATIONTIME = ReplyCode 329 pattern RPL_WHOWAS_TIME = ReplyCode 330 pattern RPL_WHOISACCOUNT = ReplyCode 330 pattern RPL_NOTOPIC = ReplyCode 331 pattern RPL_TOPIC = ReplyCode 332 pattern RPL_TOPICWHOTIME = ReplyCode 333 pattern RPL_LISTUSAGE = ReplyCode 334 pattern RPL_COMMANDSYNTAX = ReplyCode 334 pattern RPL_LISTSYNTAX = ReplyCode 334 pattern RPL_WHOISACTUALLY = ReplyCode 338 pattern RPL_BADCHANPASS = ReplyCode 339 pattern RPL_INVITING = ReplyCode 341 pattern RPL_SUMMONING = ReplyCode 342 pattern RPL_INVITED = ReplyCode 345 pattern RPL_INVEXLIST = ReplyCode 346 pattern RPL_ENDOFINVEXLIST = ReplyCode 347 pattern RPL_EXCEPTLIST = ReplyCode 348 pattern RPL_ENDOFEXCEPTLIST = ReplyCode 349 pattern RPL_VERSION = ReplyCode 351 pattern RPL_WHOREPLY = ReplyCode 352 pattern RPL_NAMREPLY = ReplyCode 353 pattern RPL_WHOSPCRPL = ReplyCode 354 pattern RPL_NAMREPLY_ = ReplyCode 355 pattern RPL_WHOWASREAL = ReplyCode 360 pattern RPL_KILLDONE = ReplyCode 361 pattern RPL_CLOSING = ReplyCode 362 pattern RPL_CLOSEEND = ReplyCode 363 pattern RPL_LINKS = ReplyCode 364 pattern RPL_ENDOFLINKS = ReplyCode 365 pattern RPL_ENDOFNAMES = ReplyCode 366 pattern RPL_BANLIST = ReplyCode 367 pattern RPL_ENDOFBANLIST = ReplyCode 368 pattern RPL_ENDOFWHOWAS = ReplyCode 369 pattern RPL_INFO = ReplyCode 371 pattern RPL_MOTD = ReplyCode 372 pattern RPL_INFOSTART = ReplyCode 373 pattern RPL_ENDOFINFO = ReplyCode 374 pattern RPL_MOTDSTART = ReplyCode 375 pattern RPL_ENDOFMOTD = ReplyCode 376 pattern RPL_WHOISHOST = ReplyCode 378 pattern RPL_KICKLINKED = ReplyCode 379 pattern RPL_YOUREOPER = ReplyCode 381 pattern RPL_REHASHING = ReplyCode 382 pattern RPL_YOURESERVICE = ReplyCode 383 pattern RPL_MYPORTIS = ReplyCode 384 pattern RPL_NOTOPERANYMORE = ReplyCode 385 pattern RPL_RSACHALLENGE = ReplyCode 386 pattern RPL_TIME = ReplyCode 391 pattern RPL_USERSSTART = ReplyCode 392 pattern RPL_USERS = ReplyCode 393 pattern RPL_ENDOFUSERS = ReplyCode 394 pattern RPL_NOUSERS = ReplyCode 395 pattern RPL_HOSTHIDDEN = ReplyCode 396 pattern ERR_UNKNOWNERROR = ReplyCode 400 pattern ERR_NOSUCHNICK = ReplyCode 401 pattern ERR_NOSUCHSERVER = ReplyCode 402 pattern ERR_NOSUCHCHANNEL = ReplyCode 403 pattern ERR_CANNOTSENDTOCHAN = ReplyCode 404 pattern ERR_TOOMANYCHANNELS = ReplyCode 405 pattern ERR_WASNOSUCHNICK = ReplyCode 406 pattern ERR_TOOMANYTARGETS = ReplyCode 407 pattern ERR_NOORIGIN = ReplyCode 409 pattern ERR_NORECIPIENT = ReplyCode 411 pattern ERR_NOTEXTTOSEND = ReplyCode 412 pattern ERR_NOTOPLEVEL = ReplyCode 413 pattern ERR_WILDTOPLEVEL = ReplyCode 414 pattern ERR_BADMASK = ReplyCode 415 pattern ERR_TOOMANYMATCHES = ReplyCode 416 pattern ERR_LENGTHTRUNCATED = ReplyCode 419 pattern ERR_UNKNOWNCOMMAND = ReplyCode 421 pattern ERR_NOMOTD = ReplyCode 422 pattern ERR_NOADMININFO = ReplyCode 423 pattern ERR_FILEERROR = ReplyCode 424 pattern ERR_NOOPERMOTD = ReplyCode 425 pattern ERR_TOOMANYAWAY = ReplyCode 429 pattern ERR_EVENTNICKCHANGE = ReplyCode 430 pattern ERR_NONICKNAMEGIVEN = ReplyCode 431 pattern ERR_ERRONEUSNICKNAME = ReplyCode 432 pattern ERR_NICKNAMEINUSE = ReplyCode 433 pattern ERR_SERVICENAMEINUSE = ReplyCode 434 pattern ERR_NORULES = ReplyCode 434 pattern ERR_BANNICKCHANGE = ReplyCode 435 pattern ERR_NICKCOLLISION = ReplyCode 436 pattern ERR_UNAVAILRESOURCE = ReplyCode 437 pattern ERR_NICKTOOFAST = ReplyCode 438 pattern ERR_TARGETTOOFAST = ReplyCode 439 pattern ERR_SERVICESDOWN = ReplyCode 440 pattern ERR_USERNOTINCHANNEL = ReplyCode 441 pattern ERR_NOTONCHANNEL = ReplyCode 442 pattern ERR_USERONCHANNEL = ReplyCode 443 pattern ERR_NOLOGIN = ReplyCode 444 pattern ERR_SUMMONDISABLED = ReplyCode 445 pattern ERR_USERSDISABLED = ReplyCode 446 pattern ERR_NONICKCHANGE = ReplyCode 447 pattern ERR_NOTIMPLEMENTED = ReplyCode 449 pattern ERR_NOTREGISTERED = ReplyCode 451 pattern ERR_IDCOLLISION = ReplyCode 452 pattern ERR_NICKLOST = ReplyCode 453 pattern ERR_HOSTILENAME = ReplyCode 455 pattern ERR_ACCEPTFULL = ReplyCode 456 pattern ERR_ACCEPTEXIST = ReplyCode 457 pattern ERR_ACCEPTNOT = ReplyCode 458 pattern ERR_NOHIDING = ReplyCode 459 pattern ERR_NOTFORHALFOPS = ReplyCode 460 pattern ERR_NEEDMOREPARAMS = ReplyCode 461 pattern ERR_ALREADYREGISTERED = ReplyCode 462 pattern ERR_NOPERMFORHOST = ReplyCode 463 pattern ERR_PASSWDMISMATCH = ReplyCode 464 pattern ERR_YOUREBANNEDCREEP = ReplyCode 465 pattern ERR_YOUWILLBEBANNED = ReplyCode 466 pattern ERR_KEYSET = ReplyCode 467 pattern ERR_INVALIDUSERNAME = ReplyCode 468 pattern ERR_ONLYSERVERSCANCHANGE = ReplyCode 468 pattern ERR_LINKSET = ReplyCode 469 pattern ERR_LINKCHANNEL = ReplyCode 470 pattern ERR_CHANNELISFULL = ReplyCode 471 pattern ERR_UNKNOWNMODE = ReplyCode 472 pattern ERR_INVITEONLYCHAN = ReplyCode 473 pattern ERR_BANNEDFROMCHAN = ReplyCode 474 pattern ERR_BADCHANNELKEY = ReplyCode 475 pattern ERR_BADCHANMASK = ReplyCode 476 pattern ERR_NEEDREGGEDNICK = ReplyCode 477 pattern ERR_BANLISTFULL = ReplyCode 478 pattern ERR_BADCHANNAME = ReplyCode 479 pattern ERR_THROTTLE = ReplyCode 480 pattern ERR_NOPRIVILEGES = ReplyCode 481 pattern ERR_CHANOPRIVSNEEDED = ReplyCode 482 pattern ERR_CANTKILLSERVER = ReplyCode 483 pattern ERR_ISCHANSERVICE = ReplyCode 484 pattern ERR_BANNEDNICK = ReplyCode 485 pattern ERR_NONONREG = ReplyCode 486 pattern ERR_TSLESSCHAN = ReplyCode 488 pattern ERR_VOICENEEDED = ReplyCode 489 pattern ERR_NOOPERHOST = ReplyCode 491 pattern ERR_NOSERVICEHOST = ReplyCode 492 pattern ERR_NOFEATURE = ReplyCode 493 pattern ERR_OWNMODE = ReplyCode 494 pattern ERR_BADLOGTYPE = ReplyCode 495 pattern ERR_BADLOGSYS = ReplyCode 496 pattern ERR_BADLOGVALUE = ReplyCode 497 pattern ERR_ISOPERLCHAN = ReplyCode 498 pattern ERR_CHANOWNPRIVNEEDED = ReplyCode 499 pattern ERR_UMODEUNKNOWNFLAG = ReplyCode 501 pattern ERR_USERSDONTMATCH = ReplyCode 502 pattern ERR_GHOSTEDCLIENT = ReplyCode 503 pattern ERR_USERNOTONSERV = ReplyCode 504 pattern ERR_SILELISTFULL = ReplyCode 511 pattern ERR_TOOMANYWATCH = ReplyCode 512 pattern ERR_WRONGPONG = ReplyCode 513 pattern ERR_BADEXPIRE = ReplyCode 515 pattern ERR_DONTCHEAT = ReplyCode 516 pattern ERR_DISABLED = ReplyCode 517 pattern ERR_NOINVITE = ReplyCode 518 pattern ERR_LONGMASK = ReplyCode 518 pattern ERR_ADMONLY = ReplyCode 519 pattern ERR_TOOMANYUSERS = ReplyCode 519 pattern ERR_OPERONLY = ReplyCode 520 pattern ERR_MASKTOOWIDE = ReplyCode 520 pattern ERR_WHOTRUNC = ReplyCode 520 pattern ERR_LISTSYNTAX = ReplyCode 521 pattern ERR_WHOSYNTAX = ReplyCode 522 pattern ERR_WHOLIMEXCEED = ReplyCode 523 pattern ERR_HELPNOTFOUND = ReplyCode 524 pattern ERR_REMOTEPFX = ReplyCode 525 pattern ERR_PFXUNROUTABLE = ReplyCode 526 pattern ERR_BADHOSTMASK = ReplyCode 550 pattern ERR_HOSTUNAVAIL = ReplyCode 551 pattern ERR_USINGSLINE = ReplyCode 552 pattern ERR_STATSSLINE = ReplyCode 553 pattern RPL_LOGON = ReplyCode 600 pattern RPL_LOGOFF = ReplyCode 601 pattern RPL_WATCHOFF = ReplyCode 602 pattern RPL_WATCHSTAT = ReplyCode 603 pattern RPL_NOWON = ReplyCode 604 pattern RPL_NOWOFF = ReplyCode 605 pattern RPL_WATCHLIST = ReplyCode 606 pattern RPL_ENDOFWATCHLIST = ReplyCode 607 pattern RPL_WATCHCLEAR = ReplyCode 608 pattern RPL_ISOPER = ReplyCode 610 pattern RPL_ISLOCOP = ReplyCode 611 pattern RPL_ISNOTOPER = ReplyCode 612 pattern RPL_ENDOFISOPER = ReplyCode 613 pattern RPL_DCCSTATUS = ReplyCode 617 pattern RPL_DCCLIST = ReplyCode 618 pattern RPL_ENDOFDCCLIST = ReplyCode 619 pattern RPL_WHOWASHOST = ReplyCode 619 pattern RPL_DCCINFO = ReplyCode 620 pattern RPL_RULES = ReplyCode 621 pattern RPL_ENDOFO = ReplyCode 626 pattern RPL_SETTINGS = ReplyCode 630 pattern RPL_ENDOFSETTINGS = ReplyCode 631 pattern RPL_DUMPING = ReplyCode 640 pattern RPL_DUMPRPL = ReplyCode 641 pattern RPL_EODUMP = ReplyCode 642 pattern RPL_TRACEROUTE_HOP = ReplyCode 660 pattern RPL_TRACEROUTE_START = ReplyCode 661 pattern RPL_MODECHANGEWARN = ReplyCode 662 pattern RPL_CHANREDIR = ReplyCode 663 pattern RPL_SERVMODEIS = ReplyCode 664 pattern RPL_OTHERUMODEIS = ReplyCode 665 pattern RPL_ENDOF_GENERIC = ReplyCode 666 pattern RPL_WHOWASDETAILS = ReplyCode 670 pattern RPL_WHOISSECURE = ReplyCode 671 pattern RPL_UNKNOWNMODES = ReplyCode 672 pattern RPL_CANNOTSETMODES = ReplyCode 673 pattern RPL_LUSERSTAFF = ReplyCode 678 pattern RPL_TIMEONSERVERIS = ReplyCode 679 pattern RPL_NETWORKS = ReplyCode 682 pattern RPL_YOURLANGUAGEIS = ReplyCode 687 pattern RPL_LANGUAGE = ReplyCode 688 pattern RPL_WHOISSTAFF = ReplyCode 689 pattern RPL_WHOISLANGUAGE = ReplyCode 690 pattern RPL_MODLIST = ReplyCode 702 pattern RPL_ENDOFMODLIST = ReplyCode 703 pattern RPL_HELPSTART = ReplyCode 704 pattern RPL_HELPTXT = ReplyCode 705 pattern RPL_ENDOFHELP = ReplyCode 706 pattern ERR_TARGCHANGE = ReplyCode 707 pattern RPL_ETRACEFULL = ReplyCode 708 pattern RPL_ETRACE = ReplyCode 709 pattern RPL_KNOCK = ReplyCode 710 pattern RPL_KNOCKDLVR = ReplyCode 711 pattern ERR_TOOMANYKNOCK = ReplyCode 712 pattern ERR_CHANOPEN = ReplyCode 713 pattern ERR_KNOCKONCHAN = ReplyCode 714 pattern ERR_KNOCKDISABLED = ReplyCode 715 pattern RPL_TARGUMODEG = ReplyCode 716 pattern RPL_TARGNOTIFY = ReplyCode 717 pattern RPL_UMODEGMSG = ReplyCode 718 pattern RPL_OMOTDSTART = ReplyCode 720 pattern RPL_OMOTD = ReplyCode 721 pattern RPL_ENDOFOMOTD = ReplyCode 722 pattern ERR_NOPRIVS = ReplyCode 723 pattern RPL_TESTMASK = ReplyCode 724 pattern RPL_TESTLINE = ReplyCode 725 pattern RPL_NOTESTLINE = ReplyCode 726 pattern RPL_QUIETLIST = ReplyCode 728 pattern RPL_ENDOFQUIETLIST = ReplyCode 729 pattern RPL_MONONLINE = ReplyCode 730 pattern RPL_MONOFFLINE = ReplyCode 731 pattern RPL_MONLIST = ReplyCode 732 pattern RPL_ENDOFMONLIST = ReplyCode 733 pattern ERR_MONLISTFULL = ReplyCode 734 pattern RPL_RSACHALLENGE2 = ReplyCode 740 pattern RPL_ENDOFRSACHALLENGE2 = ReplyCode 741 pattern ERR_MLOCKRESTRICTED = ReplyCode 742 pattern RPL_SCANMATCHED = ReplyCode 750 pattern RPL_SCANUMODES = ReplyCode 751 pattern RPL_XINFO = ReplyCode 771 pattern RPL_XINFOSTART = ReplyCode 773 pattern RPL_XINFOEND = ReplyCode 774 pattern RPL_LOGGEDIN = ReplyCode 900 pattern RPL_LOGGEDOUT = ReplyCode 901 pattern RPL_NICKLOCKED = ReplyCode 902 pattern RPL_SASLSUCCESS = ReplyCode 903 pattern RPL_SASLFAIL = ReplyCode 904 pattern RPL_SASLTOOLONG = ReplyCode 905 pattern RPL_SASLABORTED = ReplyCode 906 pattern RPL_SASLALREADY = ReplyCode 907 pattern RPL_SASLMECHS = ReplyCode 908 pattern ERR_CANNOTDOCOMMAND = ReplyCode 972 pattern ERR_CANNOTCHANGEUMODE = ReplyCode 973 pattern ERR_CANNOTCHANGECHANMODE = ReplyCode 974 pattern ERR_CANNOTCHANGESERVERMODE = ReplyCode 975 pattern ERR_CANNOTSENDTONICK = ReplyCode 976 pattern ERR_UNKNOWNSERVERMODE = ReplyCode 977 pattern ERR_SERVERMODELOCK = ReplyCode 979 pattern ERR_BADCHARENCODING = ReplyCode 980 pattern ERR_TOOMANYLANGUAGES = ReplyCode 981 pattern ERR_NOLANGUAGE = ReplyCode 982 pattern ERR_TEXTTOOSHORT = ReplyCode 983 pattern ERR_NUMERIC_ERR = ReplyCode 999 -- | Information describing the category and human decipherable name of a -- reply. data ReplyCodeInfo = ReplyCodeInfo { replyCodeType :: !ReplyType -- ^ category , replyCodeText :: !Text -- ^ human-decipherable name } deriving (Eq, Ord, Show, Read) -- | Compute information for a reply code replyCodeInfo :: ReplyCode -> ReplyCodeInfo replyCodeInfo (ReplyCode w) = case replyCodeInfoTable Vector.!? i of Nothing -> defaultReplyCodeInfo i Just info -> info where i = fromIntegral w -- | Categorize a reply code using the unknown category and simply showing -- the reply code's number as its name. defaultReplyCodeInfo :: Int -> ReplyCodeInfo defaultReplyCodeInfo = ReplyCodeInfo UnknownReply . Text.pack . show -- | Information about reply codes as derived from Freenode's ircd-seven. replyCodeInfoTable :: Vector ReplyCodeInfo replyCodeInfoTable = Vector.accumulate (\_def new -> new) (Vector.generate 1000 defaultReplyCodeInfo) $ fmap (\(ReplyCode code,info) -> (fromIntegral code, info)) $ Vector.fromList [ (RPL_WELCOME , ReplyCodeInfo ClientServerReply "WELCOME") , (RPL_YOURHOST , ReplyCodeInfo ClientServerReply "YOURHOST") , (RPL_CREATED , ReplyCodeInfo ClientServerReply "CREATED") , (RPL_MYINFO , ReplyCodeInfo ClientServerReply "MYINFO") , (RPL_ISUPPORT , ReplyCodeInfo ClientServerReply "ISUPPORT") , (RPL_SNOMASK , ReplyCodeInfo ClientServerReply "SNOMASK") , (RPL_STATMEMTOT , ReplyCodeInfo ClientServerReply "STATMEMTOT") , (RPL_REDIR , ReplyCodeInfo ClientServerReply "REDIR") , (RPL_YOURCOOKIE , ReplyCodeInfo ClientServerReply "YOURCOOKIE") , (RPL_MAP , ReplyCodeInfo ClientServerReply "MAP") , (RPL_MAPEND , ReplyCodeInfo ClientServerReply "MAPEND") , (RPL_YOURID , ReplyCodeInfo ClientServerReply "YOURID") , (RPL_SAVENICK , ReplyCodeInfo ClientServerReply "SAVENICK") , (RPL_ATTEMPTINGJUNC , ReplyCodeInfo ClientServerReply "ATTEMPTINGJUNC") , (RPL_ATTEMPTINGREROUTE , ReplyCodeInfo ClientServerReply "ATTEMPTINGREROUTE") , (RPL_TRACELINK , ReplyCodeInfo CommandReply "TRACELINK") , (RPL_TRACECONNECTING , ReplyCodeInfo CommandReply "TRACECONNECTING") , (RPL_TRACEHANDSHAKE , ReplyCodeInfo CommandReply "TRACEHANDSHAKE") , (RPL_TRACEUNKNOWN , ReplyCodeInfo CommandReply "TRACEUNKNOWN") , (RPL_TRACEOPERATOR , ReplyCodeInfo CommandReply "TRACEOPERATOR") , (RPL_TRACEUSER , ReplyCodeInfo CommandReply "TRACEUSER") , (RPL_TRACESERVER , ReplyCodeInfo CommandReply "TRACESERVER") , (RPL_TRACESERVICE , ReplyCodeInfo CommandReply "TRACESERVICE") , (RPL_TRACENEWTYPE , ReplyCodeInfo CommandReply "TRACENEWTYPE") , (RPL_TRACECLASS , ReplyCodeInfo CommandReply "TRACECLASS") , (RPL_TRACERECONNECT , ReplyCodeInfo CommandReply "TRACERECONNECT") , (RPL_STATS , ReplyCodeInfo CommandReply "STATS") , (RPL_STATSLINKINFO , ReplyCodeInfo CommandReply "STATSLINKINFO") , (RPL_STATSCOMMANDS , ReplyCodeInfo CommandReply "STATSCOMMANDS") , (RPL_STATSCLINE , ReplyCodeInfo CommandReply "STATSCLINE") , (RPL_STATSNLINE , ReplyCodeInfo CommandReply "STATSNLINE") , (RPL_STATSILINE , ReplyCodeInfo CommandReply "STATSILINE") , (RPL_STATSKLINE , ReplyCodeInfo CommandReply "STATSKLINE") , (RPL_STATSQLINE , ReplyCodeInfo CommandReply "STATSQLINE") , (RPL_STATSYLINE , ReplyCodeInfo CommandReply "STATSYLINE") , (RPL_ENDOFSTATS , ReplyCodeInfo CommandReply "ENDOFSTATS") , (RPL_STATSPLINE , ReplyCodeInfo CommandReply "STATSPLINE") , (RPL_UMODEIS , ReplyCodeInfo CommandReply "UMODEIS") , (RPL_SQLINE_NICK , ReplyCodeInfo CommandReply "SQLINE_NICK") , (RPL_STATSDLINE , ReplyCodeInfo CommandReply "STATSDLINE") , (RPL_STATSZLINE , ReplyCodeInfo CommandReply "STATSZLINE") , (RPL_STATSCOUNT , ReplyCodeInfo CommandReply "STATSCOUNT") , (RPL_SERVICEINFO , ReplyCodeInfo CommandReply "SERVICEINFO") , (RPL_ENDOFSERVICES , ReplyCodeInfo CommandReply "ENDOFSERVICES") , (RPL_SERVICE , ReplyCodeInfo CommandReply "SERVICE") , (RPL_SERVLIST , ReplyCodeInfo CommandReply "SERVLIST") , (RPL_SERVLISTEND , ReplyCodeInfo CommandReply "SERVLISTEND") , (RPL_STATSVERBOSE , ReplyCodeInfo CommandReply "STATSVERBOSE") , (RPL_STATSIAUTH , ReplyCodeInfo CommandReply "STATSIAUTH") , (RPL_STATSLLINE , ReplyCodeInfo CommandReply "STATSLLINE") , (RPL_STATSUPTIME , ReplyCodeInfo CommandReply "STATSUPTIME") , (RPL_STATSOLINE , ReplyCodeInfo CommandReply "STATSOLINE") , (RPL_STATSHLINE , ReplyCodeInfo CommandReply "STATSHLINE") , (RPL_STATSSLINE , ReplyCodeInfo CommandReply "STATSSLINE") , (RPL_STATSPING , ReplyCodeInfo CommandReply "STATSPING") , (RPL_STATSXLINE , ReplyCodeInfo CommandReply "STATSXLINE") , (RPL_STATSULINE , ReplyCodeInfo CommandReply "STATSULINE") , (RPL_STATSDEBUG , ReplyCodeInfo CommandReply "STATSDEBUG") , (RPL_STATSCONN , ReplyCodeInfo CommandReply "STATSCONN") , (RPL_LUSERCLIENT , ReplyCodeInfo CommandReply "LUSERCLIENT") , (RPL_LUSEROP , ReplyCodeInfo CommandReply "LUSEROP") , (RPL_LUSERUNKNOWN , ReplyCodeInfo CommandReply "LUSERUNKNOWN") , (RPL_LUSERCHANNELS , ReplyCodeInfo CommandReply "LUSERCHANNELS") , (RPL_LUSERME , ReplyCodeInfo CommandReply "LUSERME") , (RPL_ADMINME , ReplyCodeInfo CommandReply "ADMINME") , (RPL_ADMINLOC1 , ReplyCodeInfo CommandReply "ADMINLOC1") , (RPL_ADMINLOC2 , ReplyCodeInfo CommandReply "ADMINLOC2") , (RPL_ADMINEMAIL , ReplyCodeInfo CommandReply "ADMINEMAIL") , (RPL_TRACELOG , ReplyCodeInfo CommandReply "TRACELOG") , (RPL_ENDOFTRACE , ReplyCodeInfo CommandReply "ENDOFTRACE") , (RPL_LOAD2HI , ReplyCodeInfo CommandReply "LOAD2HI") , (RPL_LOCALUSERS , ReplyCodeInfo CommandReply "LOCALUSERS") , (RPL_GLOBALUSERS , ReplyCodeInfo CommandReply "GLOBALUSERS") , (RPL_START_NETSTAT , ReplyCodeInfo CommandReply "START_NETSTAT") , (RPL_NETSTAT , ReplyCodeInfo CommandReply "NETSTAT") , (RPL_END_NETSTAT , ReplyCodeInfo CommandReply "END_NETSTAT") , (RPL_PRIVS , ReplyCodeInfo CommandReply "PRIVS") , (RPL_SILELIST , ReplyCodeInfo CommandReply "SILELIST") , (RPL_ENDOFSILELIST , ReplyCodeInfo CommandReply "ENDOFSILELIST") , (RPL_NOTIFY , ReplyCodeInfo CommandReply "NOTIFY") , (RPL_ENDNOTIFY , ReplyCodeInfo CommandReply "ENDNOTIFY") , (RPL_STATSDELTA , ReplyCodeInfo CommandReply "STATSDELTA") , (RPL_WHOISCERTFP , ReplyCodeInfo CommandReply "WHOISCERTFP") , (RPL_VCHANLIST , ReplyCodeInfo CommandReply "VCHANLIST") , (RPL_VCHANHELP , ReplyCodeInfo CommandReply "VCHANHELP") , (RPL_GLIST , ReplyCodeInfo CommandReply "GLIST") , (RPL_ACCEPTLIST , ReplyCodeInfo CommandReply "ACCEPTLIST") , (RPL_ENDOFACCEPT , ReplyCodeInfo CommandReply "ENDOFACCEPT") , (RPL_ENDOFJUPELIST , ReplyCodeInfo CommandReply "ENDOFJUPELIST") , (RPL_FEATURE , ReplyCodeInfo CommandReply "FEATURE") , (RPL_DATASTR , ReplyCodeInfo CommandReply "DATASTR") , (RPL_END_CHANINFO , ReplyCodeInfo CommandReply "END_CHANINFO") , (RPL_NONE , ReplyCodeInfo CommandReply "NONE") , (RPL_AWAY , ReplyCodeInfo CommandReply "AWAY") , (RPL_USERHOST , ReplyCodeInfo CommandReply "USERHOST") , (RPL_ISON , ReplyCodeInfo CommandReply "ISON") , (RPL_TEXT , ReplyCodeInfo CommandReply "TEXT") , (RPL_UNAWAY , ReplyCodeInfo CommandReply "UNAWAY") , (RPL_NOWAWAY , ReplyCodeInfo CommandReply "NOWAWAY") , (RPL_WHOISREGNICK , ReplyCodeInfo CommandReply "WHOISREGNICK") , (RPL_SUSERHOST , ReplyCodeInfo CommandReply "SUSERHOST") , (RPL_NOTIFYACTION , ReplyCodeInfo CommandReply "NOTIFYACTION") , (RPL_WHOISADMIN , ReplyCodeInfo CommandReply "WHOISADMIN") , (RPL_NICKTRACE , ReplyCodeInfo CommandReply "NICKTRACE") , (RPL_WHOISSADMIN , ReplyCodeInfo CommandReply "WHOISSADMIN") , (RPL_WHOISHELPER , ReplyCodeInfo CommandReply "WHOISHELPER") , (RPL_WHOISUSER , ReplyCodeInfo CommandReply "WHOISUSER") , (RPL_WHOISSERVER , ReplyCodeInfo CommandReply "WHOISSERVER") , (RPL_WHOISOPERATOR , ReplyCodeInfo CommandReply "WHOISOPERATOR") , (RPL_WHOWASUSER , ReplyCodeInfo CommandReply "WHOWASUSER") , (RPL_ENDOFWHO , ReplyCodeInfo CommandReply "ENDOFWHO") , (RPL_WHOISCHANOP , ReplyCodeInfo CommandReply "WHOISCHANOP") , (RPL_WHOISIDLE , ReplyCodeInfo CommandReply "WHOISIDLE") , (RPL_ENDOFWHOIS , ReplyCodeInfo CommandReply "ENDOFWHOIS") , (RPL_WHOISCHANNELS , ReplyCodeInfo CommandReply "WHOISCHANNELS") , (RPL_WHOISSPECIAL , ReplyCodeInfo CommandReply "WHOISSPECIAL") , (RPL_LISTSTART , ReplyCodeInfo CommandReply "LISTSTART") , (RPL_LIST , ReplyCodeInfo CommandReply "LIST") , (RPL_LISTEND , ReplyCodeInfo CommandReply "LISTEND") , (RPL_CHANNELMODEIS , ReplyCodeInfo CommandReply "CHANNELMODEIS") , (RPL_CHANNELMLOCKIS , ReplyCodeInfo CommandReply "CHANNELMLOCKIS") , (RPL_NOCHANPASS , ReplyCodeInfo CommandReply "NOCHANPASS") , (RPL_CHPASSUNKNOWN , ReplyCodeInfo CommandReply "CHPASSUNKNOWN") , (RPL_CHANNEL_URL , ReplyCodeInfo CommandReply "CHANNEL_URL") , (RPL_CREATIONTIME , ReplyCodeInfo CommandReply "CREATIONTIME") , (RPL_WHOWAS_TIME , ReplyCodeInfo CommandReply "WHOWAS_TIME") , (RPL_WHOISACCOUNT , ReplyCodeInfo CommandReply "WHOISACCOUNT") , (RPL_NOTOPIC , ReplyCodeInfo CommandReply "NOTOPIC") , (RPL_TOPIC , ReplyCodeInfo CommandReply "TOPIC") , (RPL_TOPICWHOTIME , ReplyCodeInfo CommandReply "TOPICWHOTIME") , (RPL_LISTUSAGE , ReplyCodeInfo CommandReply "LISTUSAGE") , (RPL_COMMANDSYNTAX , ReplyCodeInfo CommandReply "COMMANDSYNTAX") , (RPL_LISTSYNTAX , ReplyCodeInfo CommandReply "LISTSYNTAX") , (RPL_WHOISACTUALLY , ReplyCodeInfo CommandReply "WHOISACTUALLY") , (RPL_BADCHANPASS , ReplyCodeInfo CommandReply "BADCHANPASS") , (RPL_INVITING , ReplyCodeInfo CommandReply "INVITING") , (RPL_SUMMONING , ReplyCodeInfo CommandReply "SUMMONING") , (RPL_INVITED , ReplyCodeInfo CommandReply "INVITED") , (RPL_INVEXLIST , ReplyCodeInfo CommandReply "INVEXLIST") , (RPL_ENDOFINVEXLIST , ReplyCodeInfo CommandReply "ENDOFINVEXLIST") , (RPL_EXCEPTLIST , ReplyCodeInfo CommandReply "EXCEPTLIST") , (RPL_ENDOFEXCEPTLIST , ReplyCodeInfo CommandReply "ENDOFEXCEPTLIST") , (RPL_VERSION , ReplyCodeInfo CommandReply "VERSION") , (RPL_WHOREPLY , ReplyCodeInfo CommandReply "WHOREPLY") , (RPL_NAMREPLY , ReplyCodeInfo CommandReply "NAMREPLY") , (RPL_WHOSPCRPL , ReplyCodeInfo CommandReply "WHOSPCRPL") , (RPL_NAMREPLY_ , ReplyCodeInfo CommandReply "NAMREPLY_") , (RPL_WHOWASREAL , ReplyCodeInfo CommandReply "WHOWASREAL") , (RPL_KILLDONE , ReplyCodeInfo CommandReply "KILLDONE") , (RPL_CLOSING , ReplyCodeInfo CommandReply "CLOSING") , (RPL_CLOSEEND , ReplyCodeInfo CommandReply "CLOSEEND") , (RPL_LINKS , ReplyCodeInfo CommandReply "LINKS") , (RPL_ENDOFLINKS , ReplyCodeInfo CommandReply "ENDOFLINKS") , (RPL_ENDOFNAMES , ReplyCodeInfo CommandReply "ENDOFNAMES") , (RPL_BANLIST , ReplyCodeInfo CommandReply "BANLIST") , (RPL_ENDOFBANLIST , ReplyCodeInfo CommandReply "ENDOFBANLIST") , (RPL_ENDOFWHOWAS , ReplyCodeInfo CommandReply "ENDOFWHOWAS") , (RPL_INFO , ReplyCodeInfo CommandReply "INFO") , (RPL_MOTD , ReplyCodeInfo CommandReply "MOTD") , (RPL_INFOSTART , ReplyCodeInfo CommandReply "INFOSTART") , (RPL_ENDOFINFO , ReplyCodeInfo CommandReply "ENDOFINFO") , (RPL_MOTDSTART , ReplyCodeInfo CommandReply "MOTDSTART") , (RPL_ENDOFMOTD , ReplyCodeInfo CommandReply "ENDOFMOTD") , (RPL_WHOISHOST , ReplyCodeInfo CommandReply "WHOISHOST") , (RPL_KICKLINKED , ReplyCodeInfo CommandReply "KICKLINKED") , (RPL_YOUREOPER , ReplyCodeInfo CommandReply "YOUREOPER") , (RPL_REHASHING , ReplyCodeInfo CommandReply "REHASHING") , (RPL_YOURESERVICE , ReplyCodeInfo CommandReply "YOURESERVICE") , (RPL_MYPORTIS , ReplyCodeInfo CommandReply "MYPORTIS") , (RPL_NOTOPERANYMORE , ReplyCodeInfo CommandReply "NOTOPERANYMORE") , (RPL_RSACHALLENGE , ReplyCodeInfo CommandReply "RSACHALLENGE") , (RPL_TIME , ReplyCodeInfo CommandReply "TIME") , (RPL_USERSSTART , ReplyCodeInfo CommandReply "USERSSTART") , (RPL_USERS , ReplyCodeInfo CommandReply "USERS") , (RPL_ENDOFUSERS , ReplyCodeInfo CommandReply "ENDOFUSERS") , (RPL_NOUSERS , ReplyCodeInfo CommandReply "NOUSERS") , (RPL_HOSTHIDDEN , ReplyCodeInfo CommandReply "HOSTHIDDEN") , (ERR_UNKNOWNERROR , ReplyCodeInfo ErrorReply "UNKNOWNERROR") , (ERR_NOSUCHNICK , ReplyCodeInfo ErrorReply "NOSUCHNICK") , (ERR_NOSUCHSERVER , ReplyCodeInfo ErrorReply "NOSUCHSERVER") , (ERR_NOSUCHCHANNEL , ReplyCodeInfo ErrorReply "NOSUCHCHANNEL") , (ERR_CANNOTSENDTOCHAN , ReplyCodeInfo ErrorReply "CANNOTSENDTOCHAN") , (ERR_TOOMANYCHANNELS , ReplyCodeInfo ErrorReply "TOOMANYCHANNELS") , (ERR_WASNOSUCHNICK , ReplyCodeInfo ErrorReply "WASNOSUCHNICK") , (ERR_TOOMANYTARGETS , ReplyCodeInfo ErrorReply "TOOMANYTARGETS") , (ERR_NOORIGIN , ReplyCodeInfo ErrorReply "NOORIGIN") , (ERR_NORECIPIENT , ReplyCodeInfo ErrorReply "NORECIPIENT") , (ERR_NOTEXTTOSEND , ReplyCodeInfo ErrorReply "NOTEXTTOSEND") , (ERR_NOTOPLEVEL , ReplyCodeInfo ErrorReply "NOTOPLEVEL") , (ERR_WILDTOPLEVEL , ReplyCodeInfo ErrorReply "WILDTOPLEVEL") , (ERR_BADMASK , ReplyCodeInfo ErrorReply "BADMASK") , (ERR_TOOMANYMATCHES , ReplyCodeInfo ErrorReply "TOOMANYMATCHES") , (ERR_LENGTHTRUNCATED , ReplyCodeInfo ErrorReply "LENGTHTRUNCATED") , (ERR_UNKNOWNCOMMAND , ReplyCodeInfo ErrorReply "UNKNOWNCOMMAND") , (ERR_NOMOTD , ReplyCodeInfo ErrorReply "NOMOTD") , (ERR_NOADMININFO , ReplyCodeInfo ErrorReply "NOADMININFO") , (ERR_FILEERROR , ReplyCodeInfo ErrorReply "FILEERROR") , (ERR_NOOPERMOTD , ReplyCodeInfo ErrorReply "NOOPERMOTD") , (ERR_TOOMANYAWAY , ReplyCodeInfo ErrorReply "TOOMANYAWAY") , (ERR_EVENTNICKCHANGE , ReplyCodeInfo ErrorReply "EVENTNICKCHANGE") , (ERR_NONICKNAMEGIVEN , ReplyCodeInfo ErrorReply "NONICKNAMEGIVEN") , (ERR_ERRONEUSNICKNAME , ReplyCodeInfo ErrorReply "ERRONEUSNICKNAME") , (ERR_NICKNAMEINUSE , ReplyCodeInfo ErrorReply "NICKNAMEINUSE") , (ERR_SERVICENAMEINUSE , ReplyCodeInfo ErrorReply "SERVICENAMEINUSE") , (ERR_NORULES , ReplyCodeInfo ErrorReply "NORULES") , (ERR_BANNICKCHANGE , ReplyCodeInfo ErrorReply "BANNICKCHANGE") , (ERR_NICKCOLLISION , ReplyCodeInfo ErrorReply "NICKCOLLISION") , (ERR_UNAVAILRESOURCE , ReplyCodeInfo ErrorReply "UNAVAILRESOURCE") , (ERR_NICKTOOFAST , ReplyCodeInfo ErrorReply "NICKTOOFAST") , (ERR_TARGETTOOFAST , ReplyCodeInfo ErrorReply "TARGETTOOFAST") , (ERR_SERVICESDOWN , ReplyCodeInfo ErrorReply "SERVICESDOWN") , (ERR_USERNOTINCHANNEL , ReplyCodeInfo ErrorReply "USERNOTINCHANNEL") , (ERR_NOTONCHANNEL , ReplyCodeInfo ErrorReply "NOTONCHANNEL") , (ERR_USERONCHANNEL , ReplyCodeInfo ErrorReply "USERONCHANNEL") , (ERR_NOLOGIN , ReplyCodeInfo ErrorReply "NOLOGIN") , (ERR_SUMMONDISABLED , ReplyCodeInfo ErrorReply "SUMMONDISABLED") , (ERR_USERSDISABLED , ReplyCodeInfo ErrorReply "USERSDISABLED") , (ERR_NONICKCHANGE , ReplyCodeInfo ErrorReply "NONICKCHANGE") , (ERR_NOTIMPLEMENTED , ReplyCodeInfo ErrorReply "NOTIMPLEMENTED") , (ERR_NOTREGISTERED , ReplyCodeInfo ErrorReply "NOTREGISTERED") , (ERR_IDCOLLISION , ReplyCodeInfo ErrorReply "IDCOLLISION") , (ERR_NICKLOST , ReplyCodeInfo ErrorReply "NICKLOST") , (ERR_HOSTILENAME , ReplyCodeInfo ErrorReply "HOSTILENAME") , (ERR_ACCEPTFULL , ReplyCodeInfo ErrorReply "ACCEPTFULL") , (ERR_ACCEPTEXIST , ReplyCodeInfo ErrorReply "ACCEPTEXIST") , (ERR_ACCEPTNOT , ReplyCodeInfo ErrorReply "ACCEPTNOT") , (ERR_NOHIDING , ReplyCodeInfo ErrorReply "NOHIDING") , (ERR_NOTFORHALFOPS , ReplyCodeInfo ErrorReply "NOTFORHALFOPS") , (ERR_NEEDMOREPARAMS , ReplyCodeInfo ErrorReply "NEEDMOREPARAMS") , (ERR_ALREADYREGISTERED , ReplyCodeInfo ErrorReply "ALREADYREGISTERED") , (ERR_NOPERMFORHOST , ReplyCodeInfo ErrorReply "NOPERMFORHOST") , (ERR_PASSWDMISMATCH , ReplyCodeInfo ErrorReply "PASSWDMISMATCH") , (ERR_YOUREBANNEDCREEP , ReplyCodeInfo ErrorReply "YOUREBANNEDCREEP") , (ERR_YOUWILLBEBANNED , ReplyCodeInfo ErrorReply "YOUWILLBEBANNED") , (ERR_KEYSET , ReplyCodeInfo ErrorReply "KEYSET") , (ERR_INVALIDUSERNAME , ReplyCodeInfo ErrorReply "INVALIDUSERNAME") , (ERR_ONLYSERVERSCANCHANGE , ReplyCodeInfo ErrorReply "ONLYSERVERSCANCHANGE") , (ERR_LINKSET , ReplyCodeInfo ErrorReply "LINKSET") , (ERR_LINKCHANNEL , ReplyCodeInfo ErrorReply "LINKCHANNEL") , (ERR_CHANNELISFULL , ReplyCodeInfo ErrorReply "CHANNELISFULL") , (ERR_UNKNOWNMODE , ReplyCodeInfo ErrorReply "UNKNOWNMODE") , (ERR_INVITEONLYCHAN , ReplyCodeInfo ErrorReply "INVITEONLYCHAN") , (ERR_BANNEDFROMCHAN , ReplyCodeInfo ErrorReply "BANNEDFROMCHAN") , (ERR_BADCHANNELKEY , ReplyCodeInfo ErrorReply "BADCHANNELKEY") , (ERR_BADCHANMASK , ReplyCodeInfo ErrorReply "BADCHANMASK") , (ERR_NEEDREGGEDNICK , ReplyCodeInfo ErrorReply "NEEDREGGEDNICK") , (ERR_BANLISTFULL , ReplyCodeInfo ErrorReply "BANLISTFULL") , (ERR_BADCHANNAME , ReplyCodeInfo ErrorReply "BADCHANNAME") , (ERR_THROTTLE , ReplyCodeInfo ErrorReply "THROTTLE") , (ERR_NOPRIVILEGES , ReplyCodeInfo ErrorReply "NOPRIVILEGES") , (ERR_CHANOPRIVSNEEDED , ReplyCodeInfo ErrorReply "CHANOPRIVSNEEDED") , (ERR_CANTKILLSERVER , ReplyCodeInfo ErrorReply "CANTKILLSERVER") , (ERR_ISCHANSERVICE , ReplyCodeInfo ErrorReply "ISCHANSERVICE") , (ERR_BANNEDNICK , ReplyCodeInfo ErrorReply "BANNEDNICK") , (ERR_NONONREG , ReplyCodeInfo ErrorReply "NONONREG") , (ERR_TSLESSCHAN , ReplyCodeInfo ErrorReply "TSLESSCHAN") , (ERR_VOICENEEDED , ReplyCodeInfo ErrorReply "VOICENEEDED") , (ERR_NOOPERHOST , ReplyCodeInfo ErrorReply "NOOPERHOST") , (ERR_NOSERVICEHOST , ReplyCodeInfo ErrorReply "NOSERVICEHOST") , (ERR_NOFEATURE , ReplyCodeInfo ErrorReply "NOFEATURE") , (ERR_OWNMODE , ReplyCodeInfo ErrorReply "OWNMODE") , (ERR_BADLOGTYPE , ReplyCodeInfo ErrorReply "BADLOGTYPE") , (ERR_BADLOGSYS , ReplyCodeInfo ErrorReply "BADLOGSYS") , (ERR_BADLOGVALUE , ReplyCodeInfo ErrorReply "BADLOGVALUE") , (ERR_ISOPERLCHAN , ReplyCodeInfo ErrorReply "ISOPERLCHAN") , (ERR_CHANOWNPRIVNEEDED , ReplyCodeInfo ErrorReply "CHANOWNPRIVNEEDED") , (ERR_UMODEUNKNOWNFLAG , ReplyCodeInfo ErrorReply "UMODEUNKNOWNFLAG") , (ERR_USERSDONTMATCH , ReplyCodeInfo ErrorReply "USERSDONTMATCH") , (ERR_GHOSTEDCLIENT , ReplyCodeInfo ErrorReply "GHOSTEDCLIENT") , (ERR_USERNOTONSERV , ReplyCodeInfo ErrorReply "USERNOTONSERV") , (ERR_SILELISTFULL , ReplyCodeInfo ErrorReply "SILELISTFULL") , (ERR_TOOMANYWATCH , ReplyCodeInfo ErrorReply "TOOMANYWATCH") , (ERR_WRONGPONG , ReplyCodeInfo ErrorReply "WRONGPONG") , (ERR_BADEXPIRE , ReplyCodeInfo ErrorReply "BADEXPIRE") , (ERR_DONTCHEAT , ReplyCodeInfo ErrorReply "DONTCHEAT") , (ERR_DISABLED , ReplyCodeInfo ErrorReply "DISABLED") , (ERR_NOINVITE , ReplyCodeInfo ErrorReply "NOINVITE") , (ERR_LONGMASK , ReplyCodeInfo ErrorReply "LONGMASK") , (ERR_ADMONLY , ReplyCodeInfo ErrorReply "ADMONLY") , (ERR_TOOMANYUSERS , ReplyCodeInfo ErrorReply "TOOMANYUSERS") , (ERR_OPERONLY , ReplyCodeInfo ErrorReply "OPERONLY") , (ERR_MASKTOOWIDE , ReplyCodeInfo ErrorReply "MASKTOOWIDE") , (ERR_WHOTRUNC , ReplyCodeInfo ErrorReply "WHOTRUNC") , (ERR_LISTSYNTAX , ReplyCodeInfo ErrorReply "LISTSYNTAX") , (ERR_WHOSYNTAX , ReplyCodeInfo ErrorReply "WHOSYNTAX") , (ERR_WHOLIMEXCEED , ReplyCodeInfo ErrorReply "WHOLIMEXCEED") , (ERR_HELPNOTFOUND , ReplyCodeInfo ErrorReply "HELPNOTFOUND") , (ERR_REMOTEPFX , ReplyCodeInfo ErrorReply "REMOTEPFX") , (ERR_PFXUNROUTABLE , ReplyCodeInfo ErrorReply "PFXUNROUTABLE") , (ERR_BADHOSTMASK , ReplyCodeInfo ErrorReply "BADHOSTMASK") , (ERR_HOSTUNAVAIL , ReplyCodeInfo ErrorReply "HOSTUNAVAIL") , (ERR_USINGSLINE , ReplyCodeInfo ErrorReply "USINGSLINE") , (ERR_STATSSLINE , ReplyCodeInfo ErrorReply "STATSSLINE") , (RPL_LOGON , ReplyCodeInfo CommandReply "LOGON") , (RPL_LOGOFF , ReplyCodeInfo CommandReply "LOGOFF") , (RPL_WATCHOFF , ReplyCodeInfo CommandReply "WATCHOFF") , (RPL_WATCHSTAT , ReplyCodeInfo CommandReply "WATCHSTAT") , (RPL_NOWON , ReplyCodeInfo CommandReply "NOWON") , (RPL_NOWOFF , ReplyCodeInfo CommandReply "NOWOFF") , (RPL_WATCHLIST , ReplyCodeInfo CommandReply "WATCHLIST") , (RPL_ENDOFWATCHLIST , ReplyCodeInfo CommandReply "ENDOFWATCHLIST") , (RPL_WATCHCLEAR , ReplyCodeInfo CommandReply "WATCHCLEAR") , (RPL_ISOPER , ReplyCodeInfo CommandReply "ISOPER") , (RPL_ISLOCOP , ReplyCodeInfo CommandReply "ISLOCOP") , (RPL_ISNOTOPER , ReplyCodeInfo CommandReply "ISNOTOPER") , (RPL_ENDOFISOPER , ReplyCodeInfo CommandReply "ENDOFISOPER") , (RPL_DCCSTATUS , ReplyCodeInfo CommandReply "DCCSTATUS") , (RPL_DCCLIST , ReplyCodeInfo CommandReply "DCCLIST") , (RPL_ENDOFDCCLIST , ReplyCodeInfo CommandReply "ENDOFDCCLIST") , (RPL_WHOWASHOST , ReplyCodeInfo CommandReply "WHOWASHOST") , (RPL_DCCINFO , ReplyCodeInfo CommandReply "DCCINFO") , (RPL_RULES , ReplyCodeInfo CommandReply "RULES") , (RPL_ENDOFO , ReplyCodeInfo CommandReply "ENDOFO") , (RPL_SETTINGS , ReplyCodeInfo CommandReply "SETTINGS") , (RPL_ENDOFSETTINGS , ReplyCodeInfo CommandReply "ENDOFSETTINGS") , (RPL_DUMPING , ReplyCodeInfo CommandReply "DUMPING") , (RPL_DUMPRPL , ReplyCodeInfo CommandReply "DUMPRPL") , (RPL_EODUMP , ReplyCodeInfo CommandReply "EODUMP") , (RPL_TRACEROUTE_HOP , ReplyCodeInfo CommandReply "TRACEROUTE_HOP") , (RPL_TRACEROUTE_START , ReplyCodeInfo CommandReply "TRACEROUTE_START") , (RPL_MODECHANGEWARN , ReplyCodeInfo CommandReply "MODECHANGEWARN") , (RPL_CHANREDIR , ReplyCodeInfo CommandReply "CHANREDIR") , (RPL_SERVMODEIS , ReplyCodeInfo CommandReply "SERVMODEIS") , (RPL_OTHERUMODEIS , ReplyCodeInfo CommandReply "OTHERUMODEIS") , (RPL_ENDOF_GENERIC , ReplyCodeInfo CommandReply "ENDOF_GENERIC") , (RPL_WHOWASDETAILS , ReplyCodeInfo CommandReply "WHOWASDETAILS") , (RPL_WHOISSECURE , ReplyCodeInfo CommandReply "WHOISSECURE") , (RPL_UNKNOWNMODES , ReplyCodeInfo CommandReply "UNKNOWNMODES") , (RPL_CANNOTSETMODES , ReplyCodeInfo CommandReply "CANNOTSETMODES") , (RPL_LUSERSTAFF , ReplyCodeInfo CommandReply "LUSERSTAFF") , (RPL_TIMEONSERVERIS , ReplyCodeInfo CommandReply "TIMEONSERVERIS") , (RPL_NETWORKS , ReplyCodeInfo CommandReply "NETWORKS") , (RPL_YOURLANGUAGEIS , ReplyCodeInfo CommandReply "YOURLANGUAGEIS") , (RPL_LANGUAGE , ReplyCodeInfo CommandReply "LANGUAGE") , (RPL_WHOISSTAFF , ReplyCodeInfo CommandReply "WHOISSTAFF") , (RPL_WHOISLANGUAGE , ReplyCodeInfo CommandReply "WHOISLANGUAGE") , (RPL_MODLIST , ReplyCodeInfo CommandReply "MODLIST") , (RPL_ENDOFMODLIST , ReplyCodeInfo CommandReply "ENDOFMODLIST") , (RPL_HELPSTART , ReplyCodeInfo CommandReply "HELPSTART") , (RPL_HELPTXT , ReplyCodeInfo CommandReply "HELPTXT") , (RPL_ENDOFHELP , ReplyCodeInfo CommandReply "ENDOFHELP") , (ERR_TARGCHANGE , ReplyCodeInfo ErrorReply "TARGCHANGE") , (RPL_ETRACEFULL , ReplyCodeInfo CommandReply "ETRACEFULL") , (RPL_ETRACE , ReplyCodeInfo CommandReply "ETRACE") , (RPL_KNOCK , ReplyCodeInfo CommandReply "KNOCK") , (RPL_KNOCKDLVR , ReplyCodeInfo CommandReply "KNOCKDLVR") , (ERR_TOOMANYKNOCK , ReplyCodeInfo ErrorReply "TOOMANYKNOCK") , (ERR_CHANOPEN , ReplyCodeInfo ErrorReply "CHANOPEN") , (ERR_KNOCKONCHAN , ReplyCodeInfo ErrorReply "KNOCKONCHAN") , (ERR_KNOCKDISABLED , ReplyCodeInfo ErrorReply "KNOCKDISABLED") , (RPL_TARGUMODEG , ReplyCodeInfo CommandReply "TARGUMODEG") , (RPL_TARGNOTIFY , ReplyCodeInfo CommandReply "TARGNOTIFY") , (RPL_UMODEGMSG , ReplyCodeInfo CommandReply "UMODEGMSG") , (RPL_OMOTDSTART , ReplyCodeInfo CommandReply "OMOTDSTART") , (RPL_OMOTD , ReplyCodeInfo CommandReply "OMOTD") , (RPL_ENDOFOMOTD , ReplyCodeInfo CommandReply "ENDOFOMOTD") , (ERR_NOPRIVS , ReplyCodeInfo ErrorReply "NOPRIVS") , (RPL_TESTMASK , ReplyCodeInfo CommandReply "TESTMASK") , (RPL_TESTLINE , ReplyCodeInfo CommandReply "TESTLINE") , (RPL_NOTESTLINE , ReplyCodeInfo CommandReply "NOTESTLINE") , (RPL_QUIETLIST , ReplyCodeInfo CommandReply "QUIETLIST") , (RPL_ENDOFQUIETLIST , ReplyCodeInfo CommandReply "ENDOFQUIETLIST") , (RPL_MONONLINE , ReplyCodeInfo CommandReply "MONONLINE") , (RPL_MONOFFLINE , ReplyCodeInfo CommandReply "MONOFFLINE") , (RPL_MONLIST , ReplyCodeInfo CommandReply "MONLIST") , (RPL_ENDOFMONLIST , ReplyCodeInfo CommandReply "ENDOFMONLIST") , (ERR_MONLISTFULL , ReplyCodeInfo ErrorReply "MONLISTFULL") , (RPL_RSACHALLENGE2 , ReplyCodeInfo CommandReply "RSACHALLENGE2") , (RPL_ENDOFRSACHALLENGE2 , ReplyCodeInfo CommandReply "ENDOFRSACHALLENGE2") , (ERR_MLOCKRESTRICTED , ReplyCodeInfo ErrorReply "MLOCKRESTRICTED") , (RPL_SCANMATCHED , ReplyCodeInfo CommandReply "SCANMATCHED") , (RPL_SCANUMODES , ReplyCodeInfo CommandReply "SCANUMODES") , (RPL_XINFO , ReplyCodeInfo CommandReply "XINFO") , (RPL_XINFOSTART , ReplyCodeInfo CommandReply "XINFOSTART") , (RPL_XINFOEND , ReplyCodeInfo CommandReply "XINFOEND") , (RPL_LOGGEDIN , ReplyCodeInfo CommandReply "LOGGEDIN") , (RPL_LOGGEDOUT , ReplyCodeInfo CommandReply "LOGGEDOUT") , (RPL_NICKLOCKED , ReplyCodeInfo CommandReply "NICKLOCKED") , (RPL_SASLSUCCESS , ReplyCodeInfo CommandReply "SASLSUCCESS") , (RPL_SASLFAIL , ReplyCodeInfo CommandReply "SASLFAIL") , (RPL_SASLTOOLONG , ReplyCodeInfo CommandReply "SASLTOOLONG") , (RPL_SASLABORTED , ReplyCodeInfo CommandReply "SASLABORTED") , (RPL_SASLALREADY , ReplyCodeInfo CommandReply "SASLALREADY") , (RPL_SASLMECHS , ReplyCodeInfo CommandReply "SASLMECHS") , (ERR_CANNOTDOCOMMAND , ReplyCodeInfo ErrorReply "CANNOTDOCOMMAND") , (ERR_CANNOTCHANGEUMODE , ReplyCodeInfo ErrorReply "CANNOTCHANGEUMODE") , (ERR_CANNOTCHANGECHANMODE , ReplyCodeInfo ErrorReply "CANNOTCHANGECHANMODE") , (ERR_CANNOTCHANGESERVERMODE, ReplyCodeInfo ErrorReply "CANNOTCHANGESERVERMODE") , (ERR_CANNOTSENDTONICK , ReplyCodeInfo ErrorReply "CANNOTSENDTONICK") , (ERR_UNKNOWNSERVERMODE , ReplyCodeInfo ErrorReply "UNKNOWNSERVERMODE") , (ERR_SERVERMODELOCK , ReplyCodeInfo ErrorReply "SERVERMODELOCK") , (ERR_BADCHARENCODING , ReplyCodeInfo ErrorReply "BADCHARENCODING") , (ERR_TOOMANYLANGUAGES , ReplyCodeInfo ErrorReply "TOOMANYLANGUAGES") , (ERR_NOLANGUAGE , ReplyCodeInfo ErrorReply "NOLANGUAGE") , (ERR_TEXTTOOSHORT , ReplyCodeInfo ErrorReply "TEXTTOOSHORT") , (ERR_NUMERIC_ERR , ReplyCodeInfo ErrorReply "NUMERIC_ERR") ] irc-core-2.2.0.0/src/Irc/Commands.hs0000644000000000000000000001325112767006760015160 0ustar0000000000000000{-# Language OverloadedStrings #-} {-| Module : Irc.Commands Description : Smart constructors for "RawIrcMsg" Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module provides smart constructors for IRC commands. -} module Irc.Commands ( ircAway , ircCapEnd , ircCapLs , ircCapReq , ircInvite , ircIson , ircJoin , ircKick , ircLinks , ircMode , ircNick , ircNotice , ircPart , ircPass , ircPing , ircPong , ircPrivmsg , ircQuit , ircRemove , ircStats , ircTime , ircTopic , ircUser , ircUserhost , ircWho , ircWhois , ircWhowas -- * ZNC support , ircZnc -- * SASL support , ircAuthenticate , plainAuthenticationMode , encodePlainAuthentication ) where import Irc.RawIrcMsg import Irc.Identifier import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.ByteArray.Encoding as Enc -- | PRIVMSG command ircPrivmsg :: Text {- ^ target -} -> Text {- ^ message -} -> RawIrcMsg ircPrivmsg who msg = rawIrcMsg "PRIVMSG" [who, msg] -- | NOTICE command ircNotice :: Text {- ^ target -} -> Text {- ^ message -} -> RawIrcMsg ircNotice who msg = rawIrcMsg "NOTICE" [who, msg] -- | MODE command ircMode :: Identifier {- ^ target -} -> [Text] {- ^ parameters -} -> RawIrcMsg ircMode tgt params = rawIrcMsg "MODE" (idText tgt : params) -- | WHOIS command ircWhois :: [Text] {- ^ parameters -} -> RawIrcMsg ircWhois = rawIrcMsg "WHOIS" -- | WHO command ircWho :: [Text] {- ^ parameters -} -> RawIrcMsg ircWho = rawIrcMsg "WHO" -- | WHOWAS command ircWhowas :: [Text] {- ^ parameters -} -> RawIrcMsg ircWhowas = rawIrcMsg "WHOWAS" -- | NICK command ircNick :: Text {- ^ nickname -} -> RawIrcMsg ircNick nick = rawIrcMsg "NICK" [nick] -- | PART command ircPart :: Identifier {- ^ channel -} -> Text {- ^ message -} -> RawIrcMsg ircPart chan msg | Text.null msg = rawIrcMsg "PART" [idText chan] | otherwise = rawIrcMsg "PART" [idText chan, msg] -- | JOIN command ircJoin :: Text {- ^ channel -} -> Maybe Text {- ^ key -} -> RawIrcMsg ircJoin chan (Just key) = rawIrcMsg "JOIN" [chan, key] ircJoin chan Nothing = rawIrcMsg "JOIN" [chan] -- | INVITE command ircInvite :: Text {- ^ nickname -} -> Identifier {- ^ channel -} -> RawIrcMsg ircInvite nick channel = rawIrcMsg "INVITE" [nick, idText channel] -- | TOPIC command ircTopic :: Identifier {- ^ channel -} -> Text {- ^ topic -} -> RawIrcMsg ircTopic chan msg | Text.null msg = rawIrcMsg "TOPIC" [idText chan] | otherwise = rawIrcMsg "TOPIC" [idText chan, msg] -- | KICK command ircKick :: Identifier {- ^ channel -} -> Text {- ^ nickname -} -> Text {- ^ message -} -> RawIrcMsg ircKick chan who msg | Text.null msg = rawIrcMsg "KICK" [idText chan, who] | otherwise = rawIrcMsg "KICK" [idText chan, who, msg] -- | REMOVE command ircRemove :: Identifier {- ^ channel -} -> Text {- ^ nickname -} -> Text {- ^ message -} -> RawIrcMsg ircRemove chan who msg | Text.null msg = rawIrcMsg "REMOVE" [idText chan, who] | otherwise = rawIrcMsg "REMOVE" [idText chan, who, msg] -- | QUIT command ircQuit :: Text {- ^ quit message -} -> RawIrcMsg ircQuit msg | Text.null msg = rawIrcMsg "QUIT" [] | otherwise = rawIrcMsg "QUIT" [msg] -- | PASS command ircPass :: Text {- ^ password -} -> RawIrcMsg ircPass pass = rawIrcMsg "PASS" [pass] -- | PING command ircPing :: [Text] {- ^ parameters -} -> RawIrcMsg ircPing = rawIrcMsg "PING" -- | PONG command ircPong :: [Text] {- ^ parameters -} -> RawIrcMsg ircPong = rawIrcMsg "PONG" -- | ISON command ircIson :: [Text] {- ^ nicknames -} -> RawIrcMsg ircIson nicks = rawIrcMsg "ISON" [Text.unwords nicks] -- | TIME command ircTime :: [Text] {- ^ parameters -} -> RawIrcMsg ircTime = rawIrcMsg "TIME" -- | USERHOST command ircUserhost :: [Text] {- ^ parameters -} -> RawIrcMsg ircUserhost = rawIrcMsg "USERHOST" -- | STATS command ircStats :: [Text] {- ^ parameters -} -> RawIrcMsg ircStats = rawIrcMsg "STATS" -- | LINKS command ircLinks :: [Text] {- ^ parameters -} -> RawIrcMsg ircLinks = rawIrcMsg "LINKS" -- | AWAY command ircAway :: Text {- ^ message -} -> RawIrcMsg ircAway msg | Text.null msg = rawIrcMsg "AWAY" [] | otherwise = rawIrcMsg "AWAY" [msg] -- | USER command ircUser :: Text {- ^ username -} -> Bool {- ^ set +w -} -> Bool {- ^ set +i -} -> Text {- ^ realname -} -> RawIrcMsg ircUser user set_w set_i real = rawIrcMsg "USER" [user, modeTxt, "*", real] where modeTxt = Text.pack (show mode) mode :: Int mode = (if set_w then 4 else 0) -- bit 2 + (if set_i then 8 else 0) -- bit 3 -- | CAP REQ command ircCapReq :: [Text] {- ^ capabilities -} -> RawIrcMsg ircCapReq caps = rawIrcMsg "CAP" ["REQ", Text.unwords caps] -- | CAP END command ircCapEnd :: RawIrcMsg ircCapEnd = rawIrcMsg "CAP" ["END"] -- | CAP LS command ircCapLs :: RawIrcMsg ircCapLs = rawIrcMsg "CAP" ["LS"] -- | ZNC command -- -- /specific to ZNC/ ircZnc :: [Text] {- ^ parameters -} -> RawIrcMsg ircZnc = rawIrcMsg "ZNC" -- | AUTHENTICATE command ircAuthenticate :: Text -> RawIrcMsg ircAuthenticate msg = rawIrcMsg "AUTHENTICATE" [msg] -- | PLAIN authentiation mode plainAuthenticationMode :: Text plainAuthenticationMode = "PLAIN" -- | Encoding of username and password in PLAIN authentication encodePlainAuthentication :: Text {- ^ username -} -> Text {- ^ password -} -> Text encodePlainAuthentication user pass = Text.decodeUtf8 $ Enc.convertToBase Enc.Base64 $ Text.encodeUtf8 $ Text.intercalate "\0" [user,user,pass] irc-core-2.2.0.0/src/Irc/Identifier.hs0000644000000000000000000000533712767006760015507 0ustar0000000000000000{-| Module : Irc.Identifier Description : Type and operations for nicknames and channel names Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module defines support for working with IRC's numeric reply codes. Pattern synonyms are provided for each of the possible IRC reply codes. Reply code information was extracted from https://www.alien.net.au/irc/irc2numerics.html -} module Irc.Identifier ( Identifier , idDenote , mkId , idText , idPrefix ) where import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Char import Data.Function import Data.Hashable import Data.Primitive.ByteArray import Data.String import Data.Text (Text) import qualified Data.Text.Encoding as Text import qualified Data.Vector.Primitive as PV import Data.Word -- | Identifier representing channels and nicknames data Identifier = Identifier {-# UNPACK #-} !Text {-# UNPACK #-} !(PV.Vector Word8) -- | Equality on normalized identifier instance Eq Identifier where (==) = (==) `on` idDenote instance Show Identifier where show = show . idText instance Read Identifier where readsPrec p x = [ (mkId t, rest) | (t,rest) <- readsPrec p x] -- | Comparison on normalized identifier instance Ord Identifier where compare = compare `on` idDenote -- | Hash on normalized identifier instance Hashable Identifier where hashWithSalt s = hashPV8WithSalt s . idDenote instance IsString Identifier where fromString = mkId . fromString hashPV8WithSalt :: Int -> PV.Vector Word8 -> Int hashPV8WithSalt salt (PV.Vector off len (ByteArray arr)) = hashByteArrayWithSalt arr off len salt -- | Construct an 'Identifier' from a 'ByteString' mkId :: Text -> Identifier mkId x = Identifier x (ircFoldCase (Text.encodeUtf8 x)) -- | Returns the original 'Text' of an 'Identifier' idText :: Identifier -> Text idText (Identifier x _) = x -- | Returns the case-normalized 'ByteString' of an 'Identifier' -- which is suitable for comparison or hashing. idDenote :: Identifier -> PV.Vector Word8 idDenote (Identifier _ x) = x -- | Returns 'True' when the first argument is a prefix of the second. idPrefix :: Identifier -> Identifier -> Bool idPrefix (Identifier _ x) (Identifier _ y) = x == PV.take (PV.length x) y -- | Capitalize a string according to RFC 2812 -- Latin letters are capitalized and {|}~ are mapped to [\]^ ircFoldCase :: ByteString -> PV.Vector Word8 ircFoldCase = PV.fromList . map (\i -> casemap PV.! fromIntegral i) . B.unpack casemap :: PV.Vector Word8 casemap = PV.fromList $ map (fromIntegral . ord) $ ['\x00'..'`'] ++ "ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^" ++ ['\x7f'..'\xff'] irc-core-2.2.0.0/src/Irc/Message.hs0000644000000000000000000002461112767006760015005 0ustar0000000000000000{-# Language OverloadedStrings #-} {-| Module : Irc.Message Description : High-level representation of IRC messages Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module defines high-level IRC commands. Commands are interpreted and their arguments are extracted into the appropriate types. -} module Irc.Message ( -- * High-level messages IrcMsg(..) , CapCmd(..) , cookIrcMsg -- * Properties of messages , MessageTarget(..) , ircMsgText , msgTarget , msgActor -- * Helper functions , nickSplit , computeMaxMessageLength ) where import Control.Monad import Data.Function import Data.Maybe import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Read as Text import Irc.Identifier import Irc.RawIrcMsg import Irc.UserInfo import Irc.Codes import View -- | High-level IRC message representation data IrcMsg = UnknownMsg !RawIrcMsg -- ^ pass-through for unhandled messages | Reply !ReplyCode [Text] -- ^ code arguments | Nick !UserInfo !Identifier -- ^ old new | Join !UserInfo !Identifier -- ^ user channel | Part !UserInfo !Identifier (Maybe Text) -- ^ user channel reason | Quit !UserInfo (Maybe Text) -- ^ user reason | Kick !UserInfo !Identifier !Identifier !Text -- ^ kicker channel kickee comment | Topic !UserInfo !Identifier !Text -- ^ user channel topic | Privmsg !UserInfo !Identifier !Text -- ^ source target txt | Ctcp !UserInfo !Identifier !Text !Text -- ^ source target command txt | CtcpNotice !UserInfo !Identifier !Text !Text -- ^ source target command txt | Notice !UserInfo !Identifier !Text -- ^ source target txt | Mode !UserInfo !Identifier [Text] -- ^ source target txt | Authenticate !Text -- ^ parameters | Cap !CapCmd [Text] -- ^ command parameters | Ping [Text] -- ^ parameters | Pong [Text] -- ^ parameters | Error !Text -- ^ message | BatchStart Text Text [Text] -- ^ reference-id type parameters | BatchEnd Text -- ^ reference-id deriving Show -- | Sub-commands of the CAP command data CapCmd = CapLs -- ^ request list of supported caps | CapList -- ^ request list of active caps | CapReq -- ^ request activation of cap | CapAck -- ^ request accepted | CapNak -- ^ request denied | CapEnd -- ^ end negotiation deriving (Show, Eq, Ord) -- | Match command text to structured cap sub-command cookCapCmd :: Text -> Maybe CapCmd cookCapCmd "LS" = Just CapLs cookCapCmd "LIST" = Just CapList cookCapCmd "ACK" = Just CapAck cookCapCmd "NAK" = Just CapNak cookCapCmd "END" = Just CapEnd cookCapCmd "REQ" = Just CapReq cookCapCmd _ = Nothing -- | Interpret a low-level 'RawIrcMsg' as a high-level 'IrcMsg'. -- Messages that can't be understood are wrapped in 'UnknownMsg'. cookIrcMsg :: RawIrcMsg -> IrcMsg cookIrcMsg msg = case view msgCommand msg of cmd | Right (n,"") <- decimal cmd -> Reply (ReplyCode n) (view msgParams msg) "CAP" | _target:cmdTxt:rest <- view msgParams msg , Just cmd <- cookCapCmd cmdTxt -> Cap cmd rest "AUTHENTICATE" | x:_ <- view msgParams msg -> Authenticate x "PING" -> Ping (view msgParams msg) "PONG" -> Pong (view msgParams msg) "PRIVMSG" | Just user <- view msgPrefix msg , [chan,txt] <- view msgParams msg -> case parseCtcp txt of Just (cmd,args) -> Ctcp user (mkId chan) (Text.toUpper cmd) args Nothing -> Privmsg user (mkId chan) txt "NOTICE" | Just user <- view msgPrefix msg , [chan,txt] <- view msgParams msg -> case parseCtcp txt of Just (cmd,args) -> CtcpNotice user (mkId chan) (Text.toUpper cmd) args Nothing -> Notice user (mkId chan) txt "JOIN" | Just user <- view msgPrefix msg , chan:_ <- view msgParams msg -> Join user (mkId chan) "QUIT" | Just user <- view msgPrefix msg , reasons <- view msgParams msg -> Quit user (listToMaybe reasons) "PART" | Just user <- view msgPrefix msg , chan:reasons <- view msgParams msg -> Part user (mkId chan) (listToMaybe reasons) "NICK" | Just user <- view msgPrefix msg , newNick:_ <- view msgParams msg -> Nick user (mkId newNick) "KICK" | Just user <- view msgPrefix msg , [chan,nick,reason] <- view msgParams msg -> Kick user (mkId chan) (mkId nick) reason "TOPIC" | Just user <- view msgPrefix msg , [chan,topic] <- view msgParams msg -> Topic user (mkId chan) topic "MODE" | Just user <- view msgPrefix msg , target:modes <- view msgParams msg -> Mode user (mkId target) modes "ERROR" | [reason] <- view msgParams msg -> Error reason "BATCH" | refid : ty : params <- view msgParams msg , Just ('+',refid') <- Text.uncons refid -> BatchStart refid' ty params "BATCH" | [refid] <- view msgParams msg , Just ('-',refid') <- Text.uncons refid -> BatchEnd refid' _ -> UnknownMsg msg -- | Parse a CTCP encoded message: -- -- @\^ACOMMAND arguments\^A@ parseCtcp :: Text -> Maybe (Text, Text) parseCtcp txt = do txt1 <- Text.stripSuffix "\^A" =<< Text.stripPrefix "\^A" txt let (cmd,args) = Text.break (==' ') txt1 guard (not (Text.null cmd)) return (cmd, Text.drop 1 args) -- | Targets used to direct a message to a window for display data MessageTarget = TargetUser !Identifier -- ^ Metadata update for a user | TargetWindow !Identifier -- ^ Directed message to channel or from user | TargetNetwork -- ^ Network-level message | TargetHidden -- ^ Completely hidden message -- | Target information for the window that could be appropriate to -- display this message in. msgTarget :: Identifier -> IrcMsg -> MessageTarget msgTarget me msg = case msg of UnknownMsg{} -> TargetNetwork Nick user _ -> TargetUser (userNick user) Mode _ tgt _ | tgt == me -> TargetNetwork | otherwise -> TargetWindow tgt Join _ chan -> TargetWindow chan Part _ chan _ -> TargetWindow chan Quit user _ -> TargetUser (userNick user) Kick _ chan _ _ -> TargetWindow chan Topic _ chan _ -> TargetWindow chan Privmsg src tgt _ | tgt == me -> TargetWindow (userNick src) | otherwise -> TargetWindow tgt Ctcp src tgt _ _ | tgt == me -> TargetWindow (userNick src) | otherwise -> TargetWindow tgt CtcpNotice src tgt _ _ | tgt == me -> TargetWindow (userNick src) | otherwise -> TargetWindow tgt Notice src tgt _ | tgt == me -> TargetWindow (userNick src) | otherwise -> TargetWindow tgt Authenticate{} -> TargetHidden Ping{} -> TargetHidden Pong{} -> TargetHidden Error{} -> TargetNetwork Cap{} -> TargetNetwork Reply{} -> TargetNetwork BatchStart{} -> TargetHidden BatchEnd{} -> TargetHidden -- | 'UserInfo' of the user responsible for a message. msgActor :: IrcMsg -> Maybe UserInfo msgActor msg = case msg of UnknownMsg{} -> Nothing Reply{} -> Nothing Nick x _ -> Just x Join x _ -> Just x Part x _ _ -> Just x Quit x _ -> Just x Kick x _ _ _ -> Just x Topic x _ _ -> Just x Privmsg x _ _ -> Just x Ctcp x _ _ _ -> Just x CtcpNotice x _ _ _ -> Just x Notice x _ _ -> Just x Mode x _ _ -> Just x Authenticate{}-> Nothing Ping{} -> Nothing Pong{} -> Nothing Error{} -> Nothing Cap{} -> Nothing BatchStart{} -> Nothing BatchEnd{} -> Nothing -- | Text representation of an IRC message to be used for matching with -- regular expressions. ircMsgText :: IrcMsg -> Text ircMsgText msg = case msg of UnknownMsg raw -> Text.unwords (view msgCommand raw : view msgParams raw) Reply (ReplyCode n) xs -> Text.unwords (Text.pack (show n) : xs) Nick x y -> Text.unwords [renderUserInfo x, idText y] Join x _ -> renderUserInfo x Part x _ mb -> Text.unwords (renderUserInfo x : maybeToList mb) Quit x mb -> Text.unwords (renderUserInfo x : maybeToList mb) Kick x _ z r -> Text.unwords [renderUserInfo x, idText z, r] Topic x _ t -> Text.unwords [renderUserInfo x, t] Privmsg x _ t -> Text.unwords [renderUserInfo x, t] Ctcp x _ c t -> Text.unwords [renderUserInfo x, c, t] CtcpNotice x _ c t -> Text.unwords [renderUserInfo x, c, t] Notice x _ t -> Text.unwords [renderUserInfo x, t] Mode x _ xs -> Text.unwords (renderUserInfo x:"set mode":xs) Ping xs -> Text.unwords xs Pong xs -> Text.unwords xs Cap _ xs -> Text.unwords xs Error t -> t Authenticate{} -> "" BatchStart{} -> "" BatchEnd{} -> "" -- nickname = ( letter / special ) *8( letter / digit / special / "-" ) -- letter = %x41-5A / %x61-7A ; A-Z / a-z -- digit = %x30-39 ; 0-9 -- special = %x5B-60 / %x7B-7D isNickChar :: Char -> Bool isNickChar x = '0' <= x && x <= '9' || 'A' <= x && x <= '}' || '-' == x -- | Split a nick into text parts group by whether or not those parts are valid -- nickname characters. nickSplit :: Text -> [Text] nickSplit = Text.groupBy ((==) `on` isNickChar) -- | Maximum length computation for the message part for -- privmsg and notice. Note that the need for the limit is because -- the server will limit the length of the message sent out to each -- client, not just the length of the messages it will recieve. -- -- Note that the length is on the *encoded message* which is UTF-8 -- The calculation isn't using UTF-8 on the userinfo part because -- I'm assuming that the channel name and userinfo are all ASCII -- -- @ -- :my!user@info PRIVMSG #channel :messagebody\r\n -- @ computeMaxMessageLength :: UserInfo -> Text -> Int computeMaxMessageLength myUserInfo target = 512 -- max IRC command - Text.length (renderUserInfo myUserInfo) - length (": PRIVMSG :\r\n"::String) - Text.length target irc-core-2.2.0.0/src/Irc/Modes.hs0000644000000000000000000001067612767006760014476 0ustar0000000000000000{-# Language BangPatterns #-} {-| Module : Irc.Modes Description : Operations for interpreting mode changes Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module provides support for interpreting the modes changed by a MODE command. -} module Irc.Modes ( -- * Interpretation of modes ModeTypes(..) , modesLists , modesAlwaysArg , modesSetArg , modesNeverArg , modesPrefixModes , defaultModeTypes , defaultUmodeTypes -- * Operations for working with MODE command parameters , splitModes , unsplitModes ) where import Data.Text (Text) import qualified Data.Text as Text import View -- | Settings that describe how to interpret channel modes data ModeTypes = ModeTypes { _modesLists :: [Char] -- ^ modes for channel lists (e.g. ban) , _modesAlwaysArg :: [Char] -- ^ modes that always have an argument , _modesSetArg :: [Char] -- ^ modes that have an argument when set , _modesNeverArg :: [Char] -- ^ modes that never have arguments , _modesPrefixModes :: [(Char,Char)] -- ^ modes requiring a nickname argument (mode,sigil) } deriving Show -- | Lens for '_modesList' modesLists :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes modesLists f m = (\x -> m { _modesLists = x }) <$> f (_modesLists m) -- | Lens for '_modesAlwaysArg' modesAlwaysArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes modesAlwaysArg f m = (\x -> m { _modesAlwaysArg = x }) <$> f (_modesAlwaysArg m) -- | Lens for '_modesSetArg' modesSetArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes modesSetArg f m = (\x -> m { _modesSetArg = x }) <$> f (_modesSetArg m) -- | Lens for '_modesNeverArg' modesNeverArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes modesNeverArg f m = (\x -> m { _modesNeverArg = x }) <$> f (_modesNeverArg m) -- | Lens for '_modesPrefixModes' modesPrefixModes :: Functor f => ([(Char,Char)] -> f [(Char,Char)]) -> ModeTypes -> f ModeTypes modesPrefixModes f m = (\x -> m { _modesPrefixModes = x }) <$> f (_modesPrefixModes m) -- | The channel modes used by Freenode defaultModeTypes :: ModeTypes defaultModeTypes = ModeTypes { _modesLists = "eIbq" , _modesAlwaysArg = "k" , _modesSetArg = "flj" , _modesNeverArg = "CFLMPQScgimnprstz" , _modesPrefixModes = [('o','@'),('v','+')] } -- | The default UMODE used by Freenode defaultUmodeTypes :: ModeTypes defaultUmodeTypes = ModeTypes { _modesLists = "" , _modesAlwaysArg = "" , _modesSetArg = "s" , _modesNeverArg = "DQRZgiow" , _modesPrefixModes = [] } -- | Split up a mode change command and arguments into individual changes -- given a configuration. splitModes :: ModeTypes {- ^ mode interpretation -} -> Text {- ^ modes -} -> [Text] {- ^ arguments -} -> Maybe [(Bool,Char,Text)] {- ^ (set, mode, parameter) -} splitModes !icm = computeMode True . Text.unpack where computeMode :: Bool {- current polarity -} -> [Char] {- remaining modes -} -> [Text] {- remaining arguments -} -> Maybe [(Bool,Char,Text)] computeMode polarity modes args = case modes of [] | null args -> Just [] | otherwise -> Nothing '+':ms -> computeMode True ms args '-':ms -> computeMode False ms args m:ms | m `elem` view modesAlwaysArg icm || polarity && m `elem` view modesSetArg icm || m `elem` map fst (view modesPrefixModes icm) || m `elem` view modesLists icm -> let (arg,args') = case args of [] -> (Text.empty,[]) x:xs -> (x,xs) in ((polarity,m,arg):) <$> computeMode polarity ms args' | not polarity && m `elem` view modesSetArg icm || m `elem` view modesNeverArg icm -> do res <- computeMode polarity ms args return ((polarity,m,Text.empty) : res) | otherwise -> Nothing -- | Construct the arguments to a MODE command corresponding to the given -- mode changes. unsplitModes :: [(Bool,Char,Text)] {- ^ (set,mode,parameter) -} -> [Text] unsplitModes modes = Text.pack (foldr combineModeChars (const "") modes True) : args where args = [arg | (_,_,arg) <- modes, not (Text.null arg)] combineModeChars (q,m,_) rest p | p == q = m : rest p | q = '+' : m : rest True | otherwise = '-' : m : rest False irc-core-2.2.0.0/src/Irc/RateLimit.hs0000644000000000000000000000415612767006760015315 0ustar0000000000000000{-| Module : Irc.RateLimit Description : Rate limit operations for IRC Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module implements a simple rate limiter based on the IRC RFC to be used to keep an IRC client from getting disconnected for flooding. It allows one event per duration with a given threshold. This algorithm keeps track of the time at which the client may start sending messages. Each message sent advances that time into the future by the @penalty@. The client is allowed to transmit up to @threshold@ seconds ahead of this time. -} module Irc.RateLimit ( RateLimit , newRateLimit , tickRateLimit ) where import Control.Concurrent import Control.Monad import Data.Time -- | The 'RateLimit' keeps track of rate limit settings as well -- as the current state of the limit. data RateLimit = RateLimit { rateStamp :: !(MVar UTCTime) -- ^ Time that client can send , rateThreshold :: !NominalDiffTime , ratePenalty :: !NominalDiffTime } -- | Construct a new rate limit with the given penalty and threshold. newRateLimit :: Rational {- ^ penalty seconds -} -> Rational {- ^ threshold seconds -} -> IO RateLimit newRateLimit penalty threshold = do unless (penalty > 0) (fail "newRateLimit: Penalty too small") unless (threshold > 0) (fail "newRateLimit: Threshold too small") now <- getCurrentTime ref <- newMVar now return RateLimit { rateStamp = ref , rateThreshold = realToFrac threshold , ratePenalty = realToFrac penalty } -- | Account for an event in the context of a 'RateLimit'. This command -- will block and delay as required to satisfy the current rate. Once -- it returns it is safe to proceed with the rate limited action. tickRateLimit :: RateLimit -> IO () tickRateLimit r = modifyMVar_ (rateStamp r) $ \stamp -> do now <- getCurrentTime let stamp' = ratePenalty r `addUTCTime` max stamp now diff = diffUTCTime stamp' now excess = diff - rateThreshold r when (excess > 0) (threadDelay (ceiling (1000000 * excess))) return stamp' irc-core-2.2.0.0/src/Irc/RawIrcMsg.hs0000644000000000000000000002304612767006760015260 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Irc.RawIrcMsg Description : Low-level representation of IRC messages Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module provides a parser and printer for the low-level IRC message format. It handles splitting up IRC commands into the prefix, command, and arguments. -} module Irc.RawIrcMsg ( -- * Low-level IRC messages RawIrcMsg(..) , TagEntry(..) , rawIrcMsg , msgTags , msgPrefix , msgCommand , msgParams -- * Text format for IRC messages , parseRawIrcMsg , renderRawIrcMsg , prefixParser , simpleTokenParser -- * Permissive text decoder , asUtf8 ) where import Control.Applicative import Data.Attoparsec.Text as P import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as Builder import Data.List import Data.Maybe import Data.Monoid import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Vector (Vector) import qualified Data.Vector as Vector import Irc.UserInfo import View -- | 'RawIrcMsg' breaks down the IRC protocol into its most basic parts. -- The "trailing" parameter indicated in the IRC protocol with a leading -- colon will appear as the last parameter in the parameter list. -- -- Note that RFC 2812 specifies a maximum of 15 parameters. -- -- This parser is permissive regarding spaces. It aims to parse carefully -- constructed messages exactly and to make a best effort to recover from -- extraneous spaces. It makes no effort to validate nicknames, usernames, -- hostnames, commands, etc. Servers don't all agree on these things. -- -- @:prefix COMMAND param0 param1 param2 .. paramN@ data RawIrcMsg = RawIrcMsg { _msgTags :: [TagEntry] -- ^ IRCv3.2 message tags , _msgPrefix :: Maybe UserInfo -- ^ Optional sender of message , _msgCommand :: !Text -- ^ command , _msgParams :: [Text] -- ^ command parameters } deriving (Eq, Read, Show) -- | Key value pair representing an IRCv3.2 message tag. -- The value in this pair has had the message tag unescape -- algorithm applied. data TagEntry = TagEntry {-# UNPACK #-} !Text {-# UNPACK #-} !Text deriving (Eq, Read, Show) -- | Lens for '_msgTags' msgTags :: Functor f => ([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg msgTags f m = (\x -> m { _msgTags = x }) <$> f (_msgTags m) -- | Lens for '_msgPrefix' msgPrefix :: Functor f => (Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg msgPrefix f m = (\x -> m { _msgPrefix = x }) <$> f (_msgPrefix m) -- | Lens for '_msgCommand' msgCommand :: Functor f => (Text -> f Text) -> RawIrcMsg -> f RawIrcMsg msgCommand f m = (\x -> m { _msgCommand = x }) <$> f (_msgCommand m) -- | Lens for '_msgParams' msgParams :: Functor f => ([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg msgParams f m = (\x -> m { _msgParams = x }) <$> f (_msgParams m) -- | Attempt to split an IRC protocol message without its trailing newline -- information into a structured message. parseRawIrcMsg :: Text -> Maybe RawIrcMsg parseRawIrcMsg x = case parseOnly rawIrcMsgParser x of Left{} -> Nothing Right r -> Just r -- | RFC 2812 specifies that there can only be up to -- 14 "middle" parameters, after that the fifteenth is -- the final parameter and the trailing : is optional! maxMiddleParams :: Int maxMiddleParams = 14 -- Excerpt from https://tools.ietf.org/html/rfc2812#section-2.3.1 -- message = [ ":" prefix SPACE ] command [ params ] crlf -- prefix = servername / ( nickname [ [ "!" user ] "@" host ] ) -- command = 1*letter / 3digit -- params = *14( SPACE middle ) [ SPACE ":" trailing ] -- =/ 14( SPACE middle ) [ SPACE [ ":" ] trailing ] -- nospcrlfcl = %x01-09 / %x0B-0C / %x0E-1F / %x21-39 / %x3B-FF -- ; any octet except NUL, CR, LF, " " and ":" -- middle = nospcrlfcl *( ":" / nospcrlfcl ) -- trailing = *( ":" / " " / nospcrlfcl ) -- SPACE = %x20 ; space character -- crlf = %x0D %x0A ; "carriage return" "linefeed" -- | Parse a whole IRC message assuming that the trailing -- newlines have already been removed. This parser will -- parse valid messages correctly but will also accept some -- invalid messages. Presumably the server isn't sending -- invalid messages! rawIrcMsgParser :: Parser RawIrcMsg rawIrcMsgParser = do tags <- fromMaybe [] <$> guarded '@' tagsParser prefix <- guarded ':' prefixParser cmd <- simpleTokenParser params <- paramsParser maxMiddleParams return $! RawIrcMsg { _msgTags = tags , _msgPrefix = prefix , _msgCommand = cmd , _msgParams = params } -- | Parse the list of parameters in a raw message. The RFC -- allows for up to 15 parameters. paramsParser :: Int {- ^ possible middle parameters -} -> Parser [Text] paramsParser !n = do end <- P.atEnd if end then return [] else do isColon <- optionalChar ':' if isColon || n == 0 then finalParam else middleParam where finalParam = do x <- takeText let !x' = Text.copy x return [x'] middleParam = do x <- simpleTokenParser xs <- paramsParser (n-1) return (x:xs) tagsParser :: Parser [TagEntry] tagsParser = tagParser `sepBy1` char ';' <* spaces tagParser :: Parser TagEntry tagParser = do key <- P.takeWhile (notInClass "=; ") _ <- optional (char '=') val <- P.takeWhile (notInClass "; ") return $! TagEntry key (unescapeTagVal val) unescapeTagVal :: Text -> Text unescapeTagVal = Text.pack . aux . Text.unpack where aux ('\\':':':xs) = ';':aux xs aux ('\\':'s':xs) = ' ':aux xs aux ('\\':'\\':xs) = '\\':aux xs aux ('\\':'r':xs) = '\r':aux xs aux ('\\':'n':xs) = '\n':aux xs aux (x:xs) = x : aux xs aux "" = "" escapeTagVal :: Text -> Text escapeTagVal = Text.concatMap aux where aux ';' = "\\:" aux ' ' = "\\s" aux '\\' = "\\\\" aux '\r' = "\\r" aux '\n' = "\\n" aux x = Text.singleton x -- | Parse a rendered 'UserInfo' token. prefixParser :: Parser UserInfo prefixParser = do tok <- simpleTokenParser return $! parseUserInfo tok -- | Take the next space-delimited lexeme simpleTokenParser :: Parser Text simpleTokenParser = do xs <- P.takeWhile1 (/= ' ') spaces return $! Text.copy xs spaces :: Parser () spaces = P.skipWhile (== ' ') -- | Serialize a structured IRC protocol message back into its wire -- format. This command adds the required trailing newline. renderRawIrcMsg :: RawIrcMsg -> ByteString renderRawIrcMsg !m = L.toStrict $ Builder.toLazyByteString $ renderTags (view msgTags m) <> maybe mempty renderPrefix (view msgPrefix m) <> Text.encodeUtf8Builder (view msgCommand m) <> buildParams (view msgParams m) <> Builder.char8 '\r' <> Builder.char8 '\n' -- | Construct a new 'RawIrcMsg' without a time or prefix. rawIrcMsg :: Text {- ^ command -} -> [Text] {- ^ parameters -} -> RawIrcMsg rawIrcMsg = RawIrcMsg [] Nothing renderTags :: [TagEntry] -> Builder renderTags [] = mempty renderTags xs = Builder.char8 '@' <> mconcat (intersperse (Builder.char8 ';') (map renderTag xs)) <> Builder.char8 ' ' renderTag :: TagEntry -> Builder renderTag (TagEntry key val) | Text.null val = Text.encodeUtf8Builder key | otherwise = Text.encodeUtf8Builder key <> Builder.char8 '=' <> Text.encodeUtf8Builder (escapeTagVal val) renderPrefix :: UserInfo -> Builder renderPrefix u = Builder.char8 ':' <> Text.encodeUtf8Builder (renderUserInfo u) <> Builder.char8 ' ' -- | Build concatenate a list of parameters into a single, space- -- delimited bytestring. Use a colon for the last parameter if it contains -- a colon or a space. buildParams :: [Text] -> Builder buildParams [x] | " " `Text.isInfixOf` x || ":" `Text.isPrefixOf` x = Builder.char8 ' ' <> Builder.char8 ':' <> Text.encodeUtf8Builder x buildParams (x:xs) = Builder.char8 ' ' <> Text.encodeUtf8Builder x <> buildParams xs buildParams [] = mempty -- | When the current input matches the given character parse -- using the given parser. guarded :: Char -> Parser b -> Parser (Maybe b) guarded c p = do success <- optionalChar c if success then Just <$> p else pure Nothing -- | Returns 'True' iff next character in stream matches argument. optionalChar :: Char -> Parser Bool optionalChar c = True <$ char c <|> pure False -- | Try to decode a message as UTF-8. If that fails interpret it as Windows -- CP1252 This helps deal with clients like XChat that get clever and otherwise -- misconfigured clients. asUtf8 :: ByteString -> Text asUtf8 x = case Text.decodeUtf8' x of Right txt -> txt Left{} -> decodeCP1252 x -- | Decode a 'ByteString' as CP1252 decodeCP1252 :: ByteString -> Text decodeCP1252 bs = Text.pack [ cp1252 Vector.! fromIntegral x | x <- B.unpack bs ] -- | This character encoding is a superset of ISO 8859-1 in terms of printable -- characters, but differs from the IANA's ISO-8859-1 by using displayable -- characters rather than control characters in the 80 to 9F (hex) range. cp1252 :: Vector Char cp1252 = Vector.fromList $ ['\x00'..'\x7f'] ++ "€\x81‚ƒ„…†‡ˆ‰Š‹Œ\x8dŽ\x8f\x90‘’“”•–—˜™š›œ\x9džŸ" ++ ['\xa0'..'\xff'] irc-core-2.2.0.0/src/Irc/UserInfo.hs0000644000000000000000000000333112767006760015147 0ustar0000000000000000{-# Language OverloadedStrings #-} {-| Module : Irc.UserInfo Description : User hostmasks Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com Information identifying users on IRC. This information includes a nickname and optionally a username and hostname. -} module Irc.UserInfo ( UserInfo(..) , renderUserInfo , parseUserInfo , uiNick ) where import Data.Text (Text) import qualified Data.Text as Text import Irc.Identifier import Data.Monoid ((<>)) -- | 'UserInfo' packages a nickname along with the username and hsotname -- if they are known in the current context. data UserInfo = UserInfo { userNick :: {-# UNPACK #-} !Identifier -- ^ nickname , userName :: {-# UNPACK #-} !Text -- ^ username, empty when missing , userHost :: {-# UNPACK #-} !Text -- ^ hostname, empty when missing } deriving (Eq, Read, Show) -- | 'Lens' into 'userNick' field. uiNick :: Functor f => (Identifier -> f Identifier) -> UserInfo -> f UserInfo uiNick f ui@UserInfo{userNick = n} = (\n' -> ui{userNick = n'}) <$> f n -- | Render 'UserInfo' as @nick!username\@hostname@ renderUserInfo :: UserInfo -> Text renderUserInfo (UserInfo a b c) = idText a <> (if Text.null b then "" else "!" <> b) <> (if Text.null c then "" else "@" <> c) -- | Split up a hostmask into a nickname, username, and hostname. -- The username and hostname might not be defined but are delimited by -- a @!@ and @\@@ respectively. parseUserInfo :: Text -> UserInfo parseUserInfo x = UserInfo { userNick = mkId nick , userName = Text.drop 1 user , userHost = Text.drop 1 host } where (nickuser,host) = Text.break (=='@') x (nick,user) = Text.break (=='!') nickuser irc-core-2.2.0.0/test/0000755000000000000000000000000012767006760012534 5ustar0000000000000000irc-core-2.2.0.0/test/Main.hs0000644000000000000000000001733012767006760013760 0ustar0000000000000000{-# Language OverloadedStrings #-} {-| Module : Main Description : Tests for the irc-core library Copyright : (c) Eric Mertens, 2016 License : ISC Maintainer : emertens@gmail.com This module test IRC message parsing. -} module Main (main) where import qualified Data.Text as Text import Data.Hashable import Data.Semigroup import Irc.RawIrcMsg import Irc.UserInfo import Irc.Identifier import System.Exit import Test.HUnit import Text.Read main :: IO a main = do outcome <- runTestTT tests if errors outcome == 0 && failures outcome == 0 then exitSuccess else exitFailure tests :: Test tests = test [ irc0, irc2, irc15, ircWithPrefix, ircWithTags, parseUserInfos, renderUserInfos, renderIrc, badRawMsgs, userInfoFields, identifierInstances ] -- | Check that we can handle commands without parameters irc0 :: Test irc0 = test [ assertEqual "" goal (parseRawIrcMsg alt) | alt <- alternatives ] where goal = Just (rawIrcMsg "COMMAND" []) alternatives = [ "COMMAND" , "COMMAND " , "COMMAND " ] -- | Check that we can handle commands with two parameters and an assortment of spacing irc2 :: Test irc2 = test [ assertEqual "" goal (parseRawIrcMsg alt) | alt <- alternatives ] where goal = Just (rawIrcMsg "COMMAND" ["param1","param2"]) alternatives = [ "COMMAND param1 param2" , "COMMAND param1 param2" , "COMMAND param1 param2" , "COMMAND param1 param2" , "COMMAND param1 param2 " , "COMMAND param1 :param2" , "COMMAND param1 :param2" ] -- | Check that we max out at 15 parameters irc15 :: Test irc15 = test [ assertEqual "" goal (parseRawIrcMsg raw1) , assertEqual "" goal (parseRawIrcMsg raw2) ] where goal = Just (rawIrcMsg "001" (params ++ ["last two"])) params = map (Text.pack . show) [1 .. 14 :: Int] raw1 = "001 " <> Text.unwords params <> " last two" raw2 = "001 " <> Text.unwords params <> " :last two" ircWithPrefix :: Test ircWithPrefix = test [ assertEqual "" (Just (rawIrcMsg "254" ["glguytest", "57555", "channels formed"]) { _msgPrefix = Just (UserInfo "morgan.freenode.net" "" "") }) (parseRawIrcMsg ":morgan.freenode.net 254 glguytest 57555 :channels formed") ] ircWithTags :: Test ircWithTags = test [ assertEqual "without prefix" (Just (rawIrcMsg "CMD" []) { _msgTags = [TagEntry "time" "value"] }) (parseRawIrcMsg "@time=value CMD") , assertEqual "with prefix" (Just (rawIrcMsg "CMD" []) { _msgTags = [TagEntry "time" "value"] , _msgPrefix = Just (UserInfo "prefix" "user" "host") }) (parseRawIrcMsg "@time=value :prefix!user@host CMD") , assertEqual "two tags" (Just (rawIrcMsg "CMD" []) { _msgTags = [TagEntry "time" "value", TagEntry "this" "\n\rand\\ ;that"] }) (parseRawIrcMsg "@time=value;this=\\n\\rand\\\\\\s\\:that CMD") , assertEqual "don't escape keys" (Just (rawIrcMsg "CMD" []) { _msgTags = [TagEntry "this\\s" "value"] }) (parseRawIrcMsg "@this\\s=value CMD") , assertEqual "optional key" (Just (rawIrcMsg "CMD" []) { _msgTags = [TagEntry "this" ""] }) (parseRawIrcMsg "@this CMD") , assertEqual "optional keys" (Just (rawIrcMsg "CMD" []) { _msgTags = [TagEntry "this" "", TagEntry "that" ""] }) (parseRawIrcMsg "@this;that CMD") ] renderUserInfos :: Test renderUserInfos = test [ assertEqual "missing user and hostname" "glguy" (renderUserInfo (UserInfo "glguy" "" "")) , assertEqual "freenode cloak" "glguy!~glguy@haskell/developer/glguy" (renderUserInfo (UserInfo "glguy" "~glguy" "haskell/developer/glguy")) , assertEqual "missing user" "glguy@haskell/developer/glguy" (renderUserInfo (UserInfo "glguy" "" "haskell/developer/glguy")) , assertEqual "missing host" "glguy!~glguy" (renderUserInfo (UserInfo "glguy" "~glguy" "")) , assertEqual "extra @ goes into host" "nick!user@server@name" (renderUserInfo (UserInfo "nick" "user" "server@name")) , assertEqual "servername in nick" "morgan.freenode.net" (renderUserInfo (UserInfo "morgan.freenode.net" "" "")) ] userInfoFields :: Test userInfoFields = test [ assertEqual "nickfield" "nick" (userNick (UserInfo "nick" "user" "host")) , assertEqual "userfield" "user" (userName (UserInfo "nick" "user" "host")) , assertEqual "hostfield" "host" (userHost (UserInfo "nick" "user" "host")) ] parseUserInfos :: Test parseUserInfos = test [ assertEqual "missing user and hostname" (UserInfo "glguy" "" "") (parseUserInfo "glguy") , assertEqual "freenode cloak" (UserInfo "glguy" "~glguy" "haskell/developer/glguy") (parseUserInfo "glguy!~glguy@haskell/developer/glguy") , assertEqual "missing user" (UserInfo "glguy" "" "haskell/developer/glguy") (parseUserInfo "glguy@haskell/developer/glguy") , assertEqual "missing host" (UserInfo "glguy" "~glguy" "") (parseUserInfo "glguy!~glguy") , assertEqual "extra @ goes into host" (UserInfo "nick" "user" "server@name") (parseUserInfo "nick!user@server@name") , assertEqual "servername in nick" (UserInfo "morgan.freenode.net" "" "") (parseUserInfo "morgan.freenode.net") ] renderIrc :: Test renderIrc = test [ assertEqual "" ":morgan.freenode.net 254 glguytest 57555 :channels formed\r\n" (renderRawIrcMsg (rawIrcMsg "254" ["glguytest", "57555", "channels formed"]) { _msgPrefix = Just (UserInfo "morgan.freenode.net" "" "") }) , assertEqual "" "254 glguytest 57555 :channels formed\r\n" (renderRawIrcMsg (rawIrcMsg "254" ["glguytest", "57555", "channels formed"])) , assertEqual "" "CMD param:with:colon\r\n" (renderRawIrcMsg (rawIrcMsg "CMD" ["param:with:colon"])) , assertEqual "" "CMD ::param\r\n" (renderRawIrcMsg (rawIrcMsg "CMD" [":param"])) , assertEqual "" "CMD\r\n" (renderRawIrcMsg (rawIrcMsg "CMD" [])) , assertEqual "two tags" "@time=value;this=\\n\\rand\\\\\\s\\:that CMD\r\n" (renderRawIrcMsg (rawIrcMsg "CMD" []) { _msgTags = [TagEntry "time" "value", TagEntry "this" "\n\rand\\ ;that"] }) , assertEqual "empty tags" "@time;magic CMD\r\n" (renderRawIrcMsg (rawIrcMsg "CMD" []) { _msgTags = [TagEntry "time" "", TagEntry "magic" ""] }) ] badRawMsgs :: Test badRawMsgs = test [ assertEqual "bad prefix" Nothing (parseRawIrcMsg ": CMD") , assertEqual "empty string" Nothing (parseRawIrcMsg "") , assertEqual "whitespace" Nothing (parseRawIrcMsg " ") , assertEqual "only prefix" Nothing (parseRawIrcMsg ":glguy!glguy@glguy") , assertEqual "only tags" Nothing (parseRawIrcMsg "@glguy=tester") ] identifierInstances :: Test identifierInstances = test [ assertEqual "read" (Just ("GLGUY"::Identifier)) (readMaybe "\"glguy\"") , assertEqual "read2" (Just ("Glguy"::Identifier)) (readMaybe "\"glguy\"") , assertEqual "show1" "\"GLguy\"" (show ("GLguy"::Identifier)) , assertEqual "show2" "\"glguy\"" (show ("glguy"::Identifier)) , assertBool "hash" $ hash ("glguy"::Identifier) == hash ("GLGUY"::Identifier) , assertBool "lt1" $ "glguy" < ("tester" :: Identifier) , assertBool "gt1" $ "tester" > ("glguy" :: Identifier) , assertBool "lt2" $ "GLGUY" < ("tester" :: Identifier) , assertBool "gt2" $ "TESTER" > ("glguy" :: Identifier) , assertBool "pre" $ idPrefix "gl" "GLGUY" , assertBool "pre" $ not $ idPrefix "glguy" "gl" ]