IRC.icl

   1 implementation module IRC
   2
   3 import StdEnv
   4
   5 import Control.Applicative
   6 import Control.Monad => qualified join
   7 import Data.Either
   8 import Data.Func
   9 import Data.Maybe
  10 import Text
  11 import Text.GenPrint
  12 import Text.Parsers.Simple.Chars
  13 import Text.Parsers.Simple.Core
  14
  15 import GenIRC
  16
  17 derive gPrint IRCErrors, IRCReplies, Maybe, Either, IRCUser, IRCNumReply
  18
  19 Start = (map (fmap toString) msgs, msgs)
  20 where
  21         msgs =
  22                 [ parseIRCMessage ":clooglebot!~cloogle@dhcp-077-249-221-037.chello.nl QUIT\r\n"
  23                 , parseIRCMessage ":clooglebot!~cloogle QUIT\r\n"
  24                 , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 QUIT\r\n"
  25                 , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 AWAY test\r\n"
  26                 , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 AWAY :test with spaces\r\n"
  27                 , parseIRCMessage ":cherryh.freenode.net NOTICE * :*** Found your hostname\r\n"
  28                 , parseIRCMessage ":cherryh.freenode.net QUIT :hoi hoi\r\n"
  29                 , parseIRCMessage ":cherryh.freenode.net JOIN #cha,#ch-b #twilight\r\n"
  30                 , parseIRCMessage ":cherryh.freenode.net ISON a b c d e f :g h\r\n"
  31                 , parseIRCMessage ":wilhelm.freenode.net 001 clooglebot :Welcome to the freenode Internet Relay Chat Network clooglebot\r\n"
  32                 , parseIRCMessage "PING :orwell.freenode.net\r\n"
  33                 , parseIRCMessage ":ChanServ!ChanServ@services. MODE #cloogle +o frobnicator\r\n"
  34                 , parseIRCMessage ":qbot_v01!~qbot@ip-213-124-170-20.ip.prioritytelecom.net PRIVMSG ##chinees :[link] Cloogle - https://cloogle.org"
  35                 ]
  36
  37 parseIRCMessage :: String -> Either [Error] IRCMessage
  38 parseIRCMessage s = case runParser parsePrefix (fromString s) of
  39         // Prefix is parsed
  40         ([(prefix, rest):_], _)
  41                 //Try parsing a numeric reply
  42                 = case parse parseReply rest of
  43                         //Try a normal command
  44                         Left e = case parseCmd rest of
  45                                 Left e2 = Left [e2:e]
  46                                 Right cmd = Right {IRCMessage | irc_prefix=prefix, irc_command=Right cmd}
  47                         Right repl = Right {IRCMessage | irc_prefix=prefix, irc_command=Left repl}
  48         // Error parsing prefix
  49         (_, es) = Left ["Error parsing prefix"]
  50
  51 //Prefix
  52 parsePrefix :: Parser Char (Maybe (Either IRCUser String))
  53 parsePrefix
  54         = optional (pToken ':' >>| parseEither parseUser parseHost <* pToken ' ')
  55 where
  56         parseEither :: (Parser a b) (Parser a c) -> Parser a (Either b c)
  57         parseEither p q = Left <$> p <|> Right <$> q
  58
  59         parseUser :: Parser Char IRCUser
  60         parseUser = parseNick
  61                         >>= \nick->optional (pToken '!' >>| parseUsr)
  62                         >>= \muser->optional (pToken '@' >>| parseHost)
  63                         >>= \mhost->pure {IRCUser
  64                                 | irc_nick=nick, irc_user=muser, irc_host=mhost}
  65
  66         parseUsr :: Parser Char String
  67         parseUsr = toString <$> pSome (pNoneOf [' ', '@':illegal])
  68
  69         parseNick :: Parser Char String
  70         parseNick = pAlpha
  71                 >>= \c ->pMany (pAlpha <|> pDigit <|> pOneOf (fromString "_-[]\\`^{}"))
  72                 >>= \cs->pure (toString [c:cs])
  73
  74         parseHost :: Parser Char String
  75         parseHost = join "." <$> (pSepBy parseName (pToken '.'))
  76                 >>= \s->optional (pToken '.') >>= pure o maybe s (\p->s+++toString s)
  77                 where
  78                         parseName :: Parser Char String
  79                         parseName = toString <$> pSome (pAlpha <|> pDigit <|> pOneOf ['-', '/'])
  80
  81 //Parse Cmd
  82 parseCmd :: [Char] -> Either Error IRCCommand
  83 parseCmd cs = fst $ gIRCParse{|*|} $ argfun $ split " " $ toString cs
  84         where
  85                 argfun :: [String] -> [String]
  86                 argfun [] = []
  87                 argfun [x:xs]
  88                 # x = trim x
  89                 | x.[0] == ':' = [join " " $ [x % (1, size x):map rtrim xs]]
  90                 | otherwise = [x:argfun xs]
  91
  92 //Reply
  93 parseReply :: Parser Char IRCNumReply
  94 parseReply = spaceParser
  95         >>|       (pMany (pToken '0') >>| pSome pDigit <* spaceParser)
  96         >>= \rep->(toString <$> pSome (pNoneOf [' ':illegal]) <* spaceParser)
  97         >>= \rec->(toString <$> pSome (pNoneOf illegal))
  98         >>= \msg->pure {IRCNumReply
  99                 | irc_reply     = fromInt $ toInt $ toString rep
 100                 , irc_recipient = rec
 101                 , irc_message   = msg % (if (msg.[0] == ':') 1 0, size msg)
 102                 }
 103         <* pToken '\r' <* pToken '\n'
 104         where
 105                 spaceParser :: Parser Char [Char]
 106                 spaceParser = pMany $ pToken ' '
 107
 108 //Common parsers
 109 pNoneOf :: [a] -> Parser a a | Eq a
 110 pNoneOf l = pSatisfy (not o flip isMember l)
 111
 112 illegal :: [Char]
 113 illegal = ['\x00','\r','\n']
 114
 115 instance toString IRCNumReply where
 116         toString m = lpad (toString $ toInt m.irc_reply) 3 '0' <+ " " <+
 117                 m.irc_recipient <+ " " <+ concat (gIRCPrint{|*|} m.irc_message)
 118 instance toString IRCMessage where
 119         toString m = maybe "" (\s->either ((<+) ":") id s <+ " ") m.irc_prefix
 120                 <+ either toString toString m.irc_command
 121 instance toString IRCUser where
 122         toString m = m.irc_nick <+ maybe "" ((<+) "!") m.irc_user
 123                 <+ maybe "" ((<+) "@") m.irc_host
 124 instance toString IRCCommand where
 125         toString m = join " " (gIRCPrint{|*|} m) +++ "\r\n"
 126 instance toString IRCReplies where toString r = printToString r
 127 instance toString IRCErrors where toString r = printToString r
 128
 129 (<+) infixr 5 :: a b -> String | toString a & toString b
 130 (<+) a b = toString a +++ toString b
 131
 132 instance fromInt IRCReplies where
 133         fromInt r = case r of
 134                 1 = RPL_WELCOME
 135                 2 = RPL_YOURHOST
 136                 3 = RPL_CREATED
 137                 4 = RPL_MYINFO
 138                 5 = RPL_BOUNCE
 139                 200 = RPL_TRACELINK
 140                 201 = RPL_TRACECONNECTING
 141                 202 = RPL_TRACEHANDSHAKE
 142                 203 = RPL_TRACEUNKNOWN
 143                 204 = RPL_TRACEOPERATOR
 144                 205 = RPL_TRACEUSER
 145                 206 = RPL_TRACESERVER
 146                 207 = RPL_TRACESERVICE
 147                 208 = RPL_TRACENEWTYPE
 148                 209 = RPL_TRACECLASS
 149                 210 = RPL_TRACERECONNECT
 150                 211 = RPL_STATSLINKINFO
 151                 212 = RPL_STATSCOMMANDS
 152                 219 = RPL_ENDOFSTATS
 153                 221 = RPL_UMODEIS
 154                 234 = RPL_SERVLIST
 155                 235 = RPL_SERVLISTEND
 156                 242 = RPL_STATSUPTIME
 157                 243 = RPL_STATSOLINE
 158                 251 = RPL_LUSERCLIENT
 159                 252 = RPL_LUSEROP
 160                 253 = RPL_LUSERUNKNOWN
 161                 254 = RPL_LUSERCHANNELS
 162                 255 = RPL_LUSERME
 163                 256 = RPL_ADMINME
 164                 257 = RPL_ADMINLOC1
 165                 258 = RPL_ADMINLOC2
 166                 259 = RPL_ADMINEMAIL
 167                 261 = RPL_TRACELOG
 168                 262 = RPL_TRACEEND
 169                 263 = RPL_TRYAGAIN
 170                 301 = RPL_AWAY
 171                 302 = RPL_USERHOST
 172                 303 = RPL_ISON
 173                 304 = RPL_UNAWAY
 174                 305 = RPL_NOWAWAY
 175                 311 = RPL_WHOISUSER
 176                 312 = RPL_WHOISSERVER
 177                 313 = RPL_WHOISOPERATOR
 178                 314 = RPL_WHOWASUSER
 179                 315 = RPL_ENDOFWHO
 180                 317 = RPL_WHOISIDLE
 181                 318 = RPL_ENDOFWHOIS
 182                 319 = RPL_WHOISCHANNELS
 183                 321 = RPL_LISTSTART
 184                 322 = RPL_LIST
 185                 323 = RPL_LISTEND
 186                 324 = RPL_CHANNELMODEIS
 187                 325 = RPL_UNIQOPIS
 188                 331 = RPL_NOTOPIC
 189                 332 = RPL_TOPIC
 190                 341 = RPL_INVITING
 191                 342 = RPL_SUMMONING
 192                 346 = RPL_INVITELIST
 193                 347 = RPL_ENDOFINVITELIST
 194                 348 = RPL_EXCEPTLIST
 195                 349 = RPL_ENDOFEXCEPTLIST
 196                 351 = RPL_VERSION
 197                 352 = RPL_WHOREPLY
 198                 353 = RPL_NAMREPLY
 199                 364 = RPL_LINKS
 200                 365 = RPL_ENDOFLINKS
 201                 366 = RPL_ENDOFNAMES
 202                 367 = RPL_BANLIST
 203                 368 = RPL_ENDOFBANLIST
 204                 369 = RPL_ENDOFWHOWAS
 205                 371 = RPL_INFO
 206                 372 = RPL_MOTD
 207                 374 = RPL_ENDOFINFO
 208                 375 = RPL_MOTDSTART
 209                 376 = RPL_ENDOFMOTD
 210                 381 = RPL_YOUREOPER
 211                 382 = RPL_REHASHING
 212                 383 = RPL_YOURESERVICE
 213                 391 = RPL_TIME
 214                 392 = RPL_USERSSTART
 215                 393 = RPL_USERS
 216                 394 = RPL_ENDOFUSERS
 217                 395 = RPL_NOUSERS
 218                 _ = RPL_UNKNOWN
 219
 220 instance toInt IRCReplies where
 221         toInt r = case r of
 222                 RPL_WELCOME = 1
 223                 RPL_YOURHOST = 2
 224                 RPL_CREATED = 3
 225                 RPL_MYINFO = 4
 226                 RPL_BOUNCE = 5
 227                 RPL_TRACELINK = 200
 228                 RPL_TRACECONNECTING = 201
 229                 RPL_TRACEHANDSHAKE = 202
 230                 RPL_TRACEUNKNOWN = 203
 231                 RPL_TRACEOPERATOR = 204
 232                 RPL_TRACEUSER = 205
 233                 RPL_TRACESERVER = 206
 234                 RPL_TRACESERVICE = 207
 235                 RPL_TRACENEWTYPE = 208
 236                 RPL_TRACECLASS = 209
 237                 RPL_TRACERECONNECT = 210
 238                 RPL_STATSLINKINFO = 211
 239                 RPL_STATSCOMMANDS = 212
 240                 RPL_ENDOFSTATS = 219
 241                 RPL_UMODEIS = 221
 242                 RPL_SERVLIST = 234
 243                 RPL_SERVLISTEND = 234
 244                 RPL_STATSUPTIME = 242
 245                 RPL_STATSOLINE = 243
 246                 RPL_LUSERCLIENT = 251
 247                 RPL_LUSEROP = 252
 248                 RPL_LUSERUNKNOWN = 253
 249                 RPL_LUSERCHANNELS = 254
 250                 RPL_LUSERME = 255
 251                 RPL_ADMINME = 256
 252                 RPL_ADMINLOC1 = 257
 253                 RPL_ADMINLOC2 = 258
 254                 RPL_ADMINEMAIL = 259
 255                 RPL_TRACELOG = 261
 256                 RPL_TRACEEND = 262
 257                 RPL_TRYAGAIN = 263
 258                 RPL_AWAY = 301
 259                 RPL_USERHOST = 302
 260                 RPL_ISON = 303
 261                 RPL_UNAWAY = 304
 262                 RPL_NOWAWAY = 305
 263                 RPL_WHOISUSER = 311
 264                 RPL_WHOISSERVER = 312
 265                 RPL_WHOISOPERATOR = 313
 266                 RPL_WHOWASUSER = 314
 267                 RPL_ENDOFWHO = 315
 268                 RPL_WHOISIDLE = 317
 269                 RPL_ENDOFWHOIS = 318
 270                 RPL_WHOISCHANNELS = 319
 271                 RPL_LISTSTART = 321
 272                 RPL_LIST = 322
 273                 RPL_LISTEND = 323
 274                 RPL_CHANNELMODEIS = 324
 275                 RPL_UNIQOPIS = 325
 276                 RPL_NOTOPIC = 331
 277                 RPL_TOPIC = 332
 278                 RPL_INVITING = 341
 279                 RPL_SUMMONING = 342
 280                 RPL_INVITELIST = 346
 281                 RPL_ENDOFINVITELIST = 347
 282                 RPL_EXCEPTLIST = 348
 283                 RPL_ENDOFEXCEPTLIST = 349
 284                 RPL_VERSION = 351
 285                 RPL_WHOREPLY = 352
 286                 RPL_NAMREPLY = 353
 287                 RPL_LINKS = 364
 288                 RPL_ENDOFLINKS = 365
 289                 RPL_ENDOFNAMES = 366
 290                 RPL_BANLIST = 367
 291                 RPL_ENDOFBANLIST = 367
 292                 RPL_ENDOFWHOWAS = 369
 293                 RPL_INFO = 371
 294                 RPL_MOTD = 372
 295                 RPL_ENDOFINFO = 374
 296                 RPL_MOTDSTART = 375
 297                 RPL_ENDOFMOTD = 376
 298                 RPL_YOUREOPER = 381
 299                 RPL_REHASHING = 382
 300                 RPL_YOURESERVICE = 383
 301                 RPL_TIME = 391
 302                 RPL_USERSSTART = 392
 303                 RPL_USERS = 393
 304                 RPL_ENDOFUSERS = 394
 305                 RPL_NOUSERS = 395
 306                 RPL_UNKNOWN = 998
 307
 308 instance fromInt IRCErrors where
 309         fromInt r = case r of
 310                 401 = ERR_NOSUCHNICK
 311                 402 = ERR_NOSUCHSERVER
 312                 403 = ERR_NOSUCHCHANNEL
 313                 404 = ERR_CANNOTSENDTOCHAN
 314                 405 = ERR_TOOMANYCHANNELS
 315                 406 = ERR_WASNOSUCHNICK
 316                 407 = ERR_TOOMANYTARGETS
 317                 408 = ERR_NOSUCHSERVICE
 318                 409 = ERR_NOORIGIN
 319                 411 = ERR_NORECIPIENT
 320                 412 = ERR_NOTEXTTOSEND
 321                 413 = ERR_NOTOPLEVEL
 322                 414 = ERR_WILDTOPLEVEL
 323                 415 = ERR_BADMASK
 324                 421 = ERR_UNKNOWNCOMMAND
 325                 422 = ERR_NOMOTD
 326                 423 = ERR_NOADMININFO
 327                 424 = ERR_FILEERROR
 328                 431 = ERR_NONICKNAMEGIVEN
 329                 432 = ERR_ERRONEUSNICKNAME
 330                 433 = ERR_NICKNAMEINUSE
 331                 436 = ERR_NICKCOLLISION
 332                 437 = ERR_UNAVAILRESOURCE
 333                 441 = ERR_USERNOTINCHANNEL
 334                 442 = ERR_NOTONCHANNEL
 335                 443 = ERR_USERONCHANNEL
 336                 444 = ERR_NOLOGIN
 337                 445 = ERR_SUMMONDISABLED
 338                 446 = ERR_USERSDISABLED
 339                 451 = ERR_NOTREGISTERED
 340                 461 = ERR_NEEDMOREPARAMS
 341                 462 = ERR_ALREADYREGISTRED
 342                 463 = ERR_NOPERMFORHOST
 343                 464 = ERR_PASSWDMISMATCH
 344                 465 = ERR_YOUREBANNEDCREEP
 345                 466 = ERR_YOUWILLBEBANNED
 346                 467 = ERR_KEYSET
 347                 471 = ERR_CHANNELISFULL
 348                 472 = ERR_UNKNOWNMODE
 349                 473 = ERR_INVITEONLYCHAN
 350                 474 = ERR_BANNEDFROMCHAN
 351                 475 = ERR_BADCHANNELKEY
 352                 476 = ERR_BADCHANMASK
 353                 477 = ERR_NOCHANMODES
 354                 478 = ERR_BANLISTFULL
 355                 481 = ERR_NOPRIVILEGES
 356                 482 = ERR_CHANOPRIVSNEEDED
 357                 483 = ERR_CANTKILLSERVER
 358                 484 = ERR_RESTRICTED
 359                 485 = ERR_UNIQOPPRIVSNEEDED
 360                 491 = ERR_NOOPERHOST
 361                 501 = ERR_UMODEUNKNOWNFLAG
 362                 502 = ERR_USERSDONTMATCH
 363                 _ = ERR_UNKNOWN
 364
 365 instance toInt IRCErrors where
 366         toInt r = case r of
 367                 ERR_NOSUCHNICK = 401
 368                 ERR_NOSUCHSERVER = 402
 369                 ERR_NOSUCHCHANNEL = 403
 370                 ERR_CANNOTSENDTOCHAN = 404
 371                 ERR_TOOMANYCHANNELS = 405
 372                 ERR_WASNOSUCHNICK = 406
 373                 ERR_TOOMANYTARGETS = 407
 374                 ERR_NOSUCHSERVICE = 408
 375                 ERR_NOORIGIN = 409
 376                 ERR_NORECIPIENT = 411
 377                 ERR_NOTEXTTOSEND = 412
 378                 ERR_NOTOPLEVEL = 413
 379                 ERR_WILDTOPLEVEL = 414
 380                 ERR_BADMASK = 415
 381                 ERR_UNKNOWNCOMMAND = 421
 382                 ERR_NOMOTD = 422
 383                 ERR_NOADMININFO = 423
 384                 ERR_FILEERROR = 424
 385                 ERR_NONICKNAMEGIVEN = 431
 386                 ERR_ERRONEUSNICKNAME = 432
 387                 ERR_NICKNAMEINUSE = 433
 388                 ERR_NICKCOLLISION = 436
 389                 ERR_UNAVAILRESOURCE = 437
 390                 ERR_USERNOTINCHANNEL = 441
 391                 ERR_NOTONCHANNEL = 442
 392                 ERR_USERONCHANNEL = 443
 393                 ERR_NOLOGIN = 444
 394                 ERR_SUMMONDISABLED = 445
 395                 ERR_USERSDISABLED = 446
 396                 ERR_NOTREGISTERED = 451
 397                 ERR_NEEDMOREPARAMS = 461
 398                 ERR_ALREADYREGISTRED = 462
 399                 ERR_NOPERMFORHOST = 463
 400                 ERR_PASSWDMISMATCH = 464
 401                 ERR_YOUREBANNEDCREEP = 465
 402                 ERR_YOUWILLBEBANNED = 466
 403                 ERR_KEYSET = 467
 404                 ERR_CHANNELISFULL = 471
 405                 ERR_UNKNOWNMODE = 472
 406                 ERR_INVITEONLYCHAN = 473
 407                 ERR_BANNEDFROMCHAN = 474
 408                 ERR_BADCHANNELKEY = 475
 409                 ERR_BADCHANMASK = 476
 410                 ERR_NOCHANMODES = 477
 411                 ERR_BANLISTFULL = 478
 412                 ERR_NOPRIVILEGES = 481
 413                 ERR_CHANOPRIVSNEEDED = 482
 414                 ERR_CANTKILLSERVER = 483
 415                 ERR_RESTRICTED = 484
 416                 ERR_UNIQOPPRIVSNEEDED = 485
 417                 ERR_NOOPERHOST = 491
 418                 ERR_UMODEUNKNOWNFLAG = 501
 419                 ERR_USERSDONTMATCH = 502
 420                 ERR_UNKNOWN = 999