irc-0.5.1.0/0000755000000000000000000000000012007034007010607 5ustar0000000000000000irc-0.5.1.0/irc.cabal0000644000000000000000000000145012007034007012350 0ustar0000000000000000name: irc synopsis: A small library for parsing IRC messages. description: A set of combinators and types for parsing IRC messages. version: 0.5.1.0 category: Data, Network license: BSD3 license-file: LICENSE author: Trevor Elliott maintainer: trevor@geekgateway.com extra-source-files: tests/Makefile, tests/Tests.hs cabal-version: >= 1.6.0 build-type: Simple source-repository head type: git location: git://github.com/elliottt/hsirc.git library ghc-options: -Wall build-depends: base == 4.*, parsec >= 2.1 && < 3.2 exposed-Modules: Network.IRC, Network.IRC.Base, Network.IRC.Commands, Network.IRC.Parser irc-0.5.1.0/Setup.lhs0000644000000000000000000000011112007034007012410 0ustar0000000000000000#!/usr/bin/runhaskell > import Distribution.Simple > main = defaultMain irc-0.5.1.0/LICENSE0000644000000000000000000000266112007034007011621 0ustar0000000000000000Copyright (c) 2008 Trevor Elliott All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. irc-0.5.1.0/tests/0000755000000000000000000000000012007034007011751 5ustar0000000000000000irc-0.5.1.0/tests/Makefile0000644000000000000000000000030412007034007013406 0ustar0000000000000000ODIR = .ghc TARGET = Tests all : $(ODIR) ghc --make -odir=$(ODIR) -hidir=$(ODIR) $(TARGET) -i../ ./$(TARGET) $(ODIR) : mkdir $(ODIR) clean : $(RM) -r $(ODIR) $(TARGET) .PHONY: all clean irc-0.5.1.0/tests/Tests.hs0000644000000000000000000000702512007034007013413 0ustar0000000000000000module Main where -- Friends import Network.IRC -- Libraries import Control.Applicative import Control.Monad import System.Random import Test.QuickCheck import Test.HUnit instance Applicative Gen where (<*>) = ap pure = return -- --------------------------------------------------------- -- Helpful Wrappers -- An identifier starts with a letter, and consists of interspersed numbers -- and special characters newtype Identifier = Identifier { unIdentifier :: String } deriving (Read,Show,Eq) instance Arbitrary Identifier where arbitrary = do l <- letter ls <- sized $ \n -> loop n return $ Identifier (l:ls) where loop n | n <= 0 = return [] | otherwise = do i <- identifier is <- loop (n-1) return (i:is) -- A hostname is a string that starts and ends with an identifier, and has -- periods peppered in the middle. newtype Host = Host { unHost :: String } instance Arbitrary Host where arbitrary = do l <- identifier ls <- sized $ \n -> loop n js <- sized $ \n -> loop n e <- identifier return $ Host (l:ls ++ ('.':js) ++ [e]) where loop n | n <= 0 = return [] | otherwise = do i <- host is <- loop (n-1) return (i:is) letter :: Gen Char letter = frequency [ (50, choose ('a','z')) , (50, choose ('A','Z')) ] digit :: Gen Char digit = choose ('0','9') special :: Gen Char special = elements ['_','-'] identifier :: Gen Char identifier = frequency [ (50, letter) , (30, digit) , (10, special) ] host :: Gen Char host = frequency [ (90, identifier) , (20, return '.') ] -- --------------------------------------------------------- -- IRC Types newtype Cmd = Cmd { unCmd :: String } deriving (Read,Show,Eq) instance Arbitrary Cmd where arbitrary = let c = (replyTable !!) <$> choose (0, length replyTable - 1) in Cmd . fst <$> c instance Arbitrary Prefix where arbitrary = oneof [ do name <- unIdentifier <$> arbitrary user <- (liftM unIdentifier) <$> arbitrary host <- (liftM unIdentifier) <$> arbitrary return $ NickName name user host , do host <- unHost <$> arbitrary return $ Server host ] instance Arbitrary Message where arbitrary = let params = map unIdentifier <$> sized vector cmd = unCmd <$> arbitrary in Message <$> arbitrary <*> cmd <*> params -- --------------------------------------------------------- -- Properties prop_ircId :: Message -> Bool prop_ircId msg = (decode . (++ "\r\n") . encode $ msg) == Just msg -- --------------------------------------------------------- -- Unit Tests tests :: Test tests = TestList $ map TestCase -- Initial colon encoding tests [ encode (Message Nothing "PRIVMSG" ["#foo", ":bar bas"]) @?= "PRIVMSG #foo ::bar bas" , encode (Message Nothing "PRIVMSG" ["#foo", ":bar"]) @?= "PRIVMSG #foo ::bar" -- Corrected case , decode ":talon.nl.eu.SwiftIRC.net 332 foo #bar :\n" @?= Just (Message (Just $ Server "talon.nl.eu.SwiftIRC.net") "332" ["foo","#bar",""]) ] -- --------------------------------------------------------- -- Test Running header :: String -> IO () header s = putStrLn "" >> putStrLn s >> putStrLn (replicate 60 '*') main :: IO Counts main = do header "Checking irc encode/decode identity" quickCheck prop_ircId header "Checking individual test cases" runTestTT tests irc-0.5.1.0/Network/0000755000000000000000000000000012007034007012240 5ustar0000000000000000irc-0.5.1.0/Network/IRC.hs0000644000000000000000000000076212007034007013216 0ustar0000000000000000-- | -- Module : Network.IRC -- Copyright : (c) Trevor Elliott 2007 -- License : BSD3 -- -- Maintainer : trevor@geekgateway.com -- Stability : experimental -- Portability : non-portable -- -- library for parsing IRC messages -- module Network.IRC ( -- * Parsers module Network.IRC.Parser -- * Base , module Network.IRC.Base -- * Message API , module Network.IRC.Commands ) where import Network.IRC.Parser import Network.IRC.Base import Network.IRC.Commands irc-0.5.1.0/Network/IRC/0000755000000000000000000000000012007034007012655 5ustar0000000000000000irc-0.5.1.0/Network/IRC/Base.hs0000644000000000000000000001350612007034007014070 0ustar0000000000000000-- | Datatypes for representing IRC messages, as well as formatting them. module Network.IRC.Base ( -- * Type Synonyms Parameter , ServerName , UserName , RealName , Command -- * IRC Datatypes , Prefix(..) , Message(..) -- * Formatting functions , encode -- :: Message -> String , showMessage, showPrefix, showParameters , translateReply -- :: String -> String , replyTable -- :: [(String,String)] -- * Deprecated , render ) where import Data.Maybe -- --------------------------------------------------------- -- Data Types type Parameter = String type ServerName = String type UserName = String type RealName = String type Command = String -- | IRC messages are parsed as: -- [ ':' prefix space ] command { space param } crlf data Message = Message { msg_prefix :: Maybe Prefix , msg_command :: Command , msg_params :: [Parameter] } deriving (Show,Read,Eq) -- | The optional beginning of an IRC messages data Prefix = -- | Server Prefix Server ServerName | -- | Nickname Prefix NickName String (Maybe UserName) (Maybe ServerName) deriving (Show,Read,Eq) -- --------------------------------------------------------- -- Formatting -- | Encode a message to its string representation encode :: Message -> String encode m = showMessage m -- | This is the deprecated version of encode render :: Message -> String render = encode showMessage :: Message -> String showMessage (Message p c ps) = showMaybe p ++ c ++ showParameters ps where showMaybe = maybe "" ((++ " ") . (':':) . showPrefix) showPrefix :: Prefix -> String showPrefix (Server s) = s showPrefix (NickName n u h) = n ++ showMaybe '!' u ++ showMaybe '@' h where showMaybe c e = maybe "" (c:) e showParameters :: [Parameter] -> String showParameters [] = [] showParameters params = " " ++ (unwords $ showp params) where showp [p] | ' ' `elem` p || null p || head p == ':' = [':' : p] | otherwise = [p] showp (p:ps) = p : showp ps showp [] = [] -- --------------------------------------------------------- -- Message Translation -- | Translate a reply into its text description. -- If no text is available, the argument is returned. translateReply :: Command -- ^ Reply -> String -- ^ Text translation translateReply r = fromMaybe r $ lookup r replyTable -- One big lookup table of codes and errors replyTable :: [(String,String)] replyTable = [ ("401","ERR_NOSUCHNICK") , ("402","ERR_NOSUCHSERVER") , ("403","ERR_NOSUCHCHANNEL") , ("404","ERR_CANNOTSENDTOCHAN") , ("405","ERR_TOOMANYCHANNELS") , ("406","ERR_WASNOSUCHNICK") , ("407","ERR_TOOMANYTARGETS") , ("409","ERR_NOORIGIN") , ("411","ERR_NORECIPIENT") , ("412","ERR_NOTEXTTOSEND") , ("413","ERR_NOTOPLEVEL") , ("414","ERR_WILDTOPLEVEL") , ("421","ERR_UNKNOWNCOMMAND") , ("422","ERR_NOMOTD") , ("423","ERR_NOADMININFO") , ("424","ERR_FILEERROR") , ("431","ERR_NONICKNAMEGIVEN") , ("432","ERR_ERRONEUSNICKNAME") , ("433","ERR_NICKNAMEINUSE") , ("436","ERR_NICKCOLLISION") , ("441","ERR_USERNOTINCHANNEL") , ("442","ERR_NOTONCHANNEL") , ("443","ERR_USERONCHANNEL") , ("444","ERR_NOLOGIN") , ("445","ERR_SUMMONDISABLED") , ("446","ERR_USERSDISABLED") , ("451","ERR_NOTREGISTERED") , ("461","ERR_NEEDMOREPARAMS") , ("462","ERR_ALREADYREGISTRED") , ("463","ERR_NOPERMFORHOST") , ("464","ERR_PASSWDMISMATCH") , ("465","ERR_YOUREBANNEDCREEP") , ("467","ERR_KEYSET") , ("471","ERR_CHANNELISFULL") , ("472","ERR_UNKNOWNMODE") , ("473","ERR_INVITEONLYCHAN") , ("474","ERR_BANNEDFROMCHAN") , ("475","ERR_BADCHANNELKEY") , ("481","ERR_NOPRIVILEGES") , ("482","ERR_CHANOPRIVSNEEDED") , ("483","ERR_CANTKILLSERVER") , ("491","ERR_NOOPERHOST") , ("501","ERR_UMODEUNKNOWNFLAG") , ("502","ERR_USERSDONTMATCH") , ("300","RPL_NONE") , ("302","RPL_USERHOST") , ("303","RPL_ISON") , ("301","RPL_AWAY") , ("305","RPL_UNAWAY") , ("306","RPL_NOWAWAY") , ("311","RPL_WHOISUSER") , ("312","RPL_WHOISSERVER") , ("313","RPL_WHOISOPERATOR") , ("317","RPL_WHOISIDLE") , ("318","RPL_ENDOFWHOIS") , ("319","RPL_WHOISCHANNELS") , ("314","RPL_WHOWASUSER") , ("369","RPL_ENDOFWHOWAS") , ("321","RPL_LISTSTART") , ("322","RPL_LIST") , ("323","RPL_LISTEND") , ("324","RPL_CHANNELMODEIS") , ("331","RPL_NOTOPIC") , ("332","RPL_TOPIC") , ("341","RPL_INVITING") , ("342","RPL_SUMMONING") , ("351","RPL_VERSION") , ("352","RPL_WHOREPLY") , ("315","RPL_ENDOFWHO") , ("353","RPL_NAMREPLY") , ("366","RPL_ENDOFNAMES") , ("364","RPL_LINKS") , ("365","RPL_ENDOFLINKS") , ("367","RPL_BANLIST") , ("368","RPL_ENDOFBANLIST") , ("371","RPL_INFO") , ("374","RPL_ENDOFINFO") , ("375","RPL_MOTDSTART") , ("372","RPL_MOTD") , ("376","RPL_ENDOFMOTD") , ("381","RPL_YOUREOPER") , ("382","RPL_REHASHING") , ("391","RPL_TIME") , ("392","RPL_USERSSTART") , ("393","RPL_USERS") , ("394","RPL_ENDOFUSERS") , ("395","RPL_NOUSERS") , ("200","RPL_TRACELINK") , ("201","RPL_TRACECONNECTING") , ("202","RPL_TRACEHANDSHAKE") , ("203","RPL_TRACEUNKNOWN") , ("204","RPL_TRACEOPERATOR") , ("205","RPL_TRACEUSER") , ("206","RPL_TRACESERVER") , ("208","RPL_TRACENEWTYPE") , ("261","RPL_TRACELOG") , ("211","RPL_STATSLINKINFO") , ("212","RPL_STATSCOMMANDS") , ("213","RPL_STATSCLINE") , ("214","RPL_STATSNLINE") , ("215","RPL_STATSILINE") , ("216","RPL_STATSKLINE") , ("218","RPL_STATSYLINE") , ("219","RPL_ENDOFSTATS") , ("241","RPL_STATSLLINE") , ("242","RPL_STATSUPTIME") , ("243","RPL_STATSOLINE") , ("244","RPL_STATSHLINE") , ("221","RPL_UMODEIS") , ("251","RPL_LUSERCLIENT") , ("252","RPL_LUSEROP") , ("253","RPL_LUSERUNKNOWN") , ("254","RPL_LUSERCHANNELS") , ("255","RPL_LUSERME") , ("256","RPL_ADMINME") , ("257","RPL_ADMINLOC1") , ("258","RPL_ADMINLOC2") , ("259","RPL_ADMINEMAIL") ] irc-0.5.1.0/Network/IRC/Commands.hs0000644000000000000000000000177612007034007014765 0ustar0000000000000000module Network.IRC.Commands ( -- * Types Channel , Password -- * IRC Functions , nick , user , joinChan , part , quit , privmsg , kick ) where import Network.IRC.Base type Channel = String type Password = String type Reason = String mkMessage :: String -> [Parameter] -> Message mkMessage cmd params = Message Nothing cmd params nick :: UserName -> Message nick u = mkMessage "NICK" [u] user :: UserName -> ServerName -> ServerName -> RealName -> Message user u h s r = mkMessage "USER" [u,h,s,r] joinChan :: Channel -> Message joinChan c = mkMessage "JOIN" [c] kick :: Channel -> UserName -> Maybe Reason -> Message kick c u (Just r) = mkMessage "KICK" [c,u,r] kick c u Nothing = mkMessage "KICK" [c,u] part :: Channel -> Message part c = mkMessage "PART" [c] quit :: Maybe String -> Message quit (Just m) = mkMessage "QUIT" [m] quit Nothing = mkMessage "QUIT" [] privmsg :: String -> String -> Message privmsg c m = mkMessage "PRIVMSG" [c,m] irc-0.5.1.0/Network/IRC/Parser.hs0000644000000000000000000000547612007034007014461 0ustar0000000000000000-- | Parsec parsers and a general parsing interface for IRC messages module Network.IRC.Parser ( -- * Parsing and Formatting Functions decode -- :: String -> Maybe Message -- * Parsec Combinators for Parsing IRC messages , prefix -- :: CharParser st Prefix , serverPrefix -- :: CharParser st Prefix , nicknamePrefix -- :: CharParser st Prefix , command -- :: CharParser st Command , parameter -- :: CharParser st Parameter , message -- :: CharParser st Message , crlf -- :: CharParser st () , spaces -- :: CharParser st () -- * Other Parser Combinators , tokenize -- :: CharParser st a -> CharParser st a , takeUntil -- :: String -> CharParser st String -- * Deprecated Functions , parseMessage ) where import Network.IRC.Base import Control.Monad import Text.ParserCombinators.Parsec hiding (spaces) -- | Parse a String into a Message. decode :: String -- ^ Message string -> Maybe Message -- ^ Parsed message decode = (either (const Nothing) Just) . (parse message "") -- | The deprecated version of decode parseMessage :: String -> Maybe Message parseMessage = decode -- | Take all tokens until one character from a given string is found takeUntil :: String -> CharParser st String takeUntil s = anyChar `manyTill` (lookAhead (oneOf s)) -- | Convert a parser that consumes all space after it tokenize :: CharParser st a -> CharParser st a tokenize p = p >>= \x -> spaces >> return x -- | Consume only spaces tabs or the bell character spaces :: CharParser st () spaces = skipMany1 (oneOf " \t\b") -- | Parse a Prefix prefix :: CharParser st Prefix prefix = char ':' >> (try nicknamePrefix <|> serverPrefix) -- | Parse a Server prefix serverPrefix :: CharParser st Prefix serverPrefix = takeUntil " " >>= return . Server -- | Parse a NickName prefix nicknamePrefix :: CharParser st Prefix nicknamePrefix = do n <- takeUntil " .!@\r\n" p <- option False (char '.' >> return True) when p (fail "") u <- optionMaybe $ char '!' >> takeUntil " @\r\n" s <- optionMaybe $ char '@' >> takeUntil " \r\n" return $ NickName n u s -- | Parse a command. Either a string of capital letters, or 3 digits. command :: CharParser st Command command = (many1 upper) <|> do x <- digit y <- digit z <- digit return [x,y,z] -- | Parse a command parameter. parameter :: CharParser st Parameter parameter = (char ':' >> takeUntil "\r\n") <|> (takeUntil " \r\n") -- | Parse a cr lf crlf :: CharParser st () crlf = (char '\r' >> optional (char '\n')) <|> (char '\n' >> return () ) -- | Parse a Message message :: CharParser st Message message = do p <- optionMaybe $ tokenize prefix c <- command ps <- many (spaces >> parameter) crlf >> eof return $ Message p c ps