irc-0.6.1.0/0000755000000000000000000000000012444074304010621 5ustar0000000000000000irc-0.6.1.0/irc.cabal0000644000000000000000000000213712444074304012365 0ustar0000000000000000name: irc synopsis: A small library for parsing IRC messages. description: A set of combinators and types for parsing IRC messages. version: 0.6.1.0 category: Data, Network license: BSD3 license-file: LICENSE author: Trevor Elliott maintainer: trevor@geekgateway.com cabal-version: >= 1.10 build-type: Simple source-repository head type: git location: git://github.com/elliottt/hsirc.git library ghc-options: -Wall default-language: Haskell2010 build-depends: base == 4.*, attoparsec, bytestring exposed-Modules: Network.IRC, Network.IRC.Base, Network.IRC.Commands, Network.IRC.Parser test-suite Main type: exitcode-stdio-1.0 x-uses-tf: true build-depends: base == 4.*, HUnit >= 1.2 && < 2, QuickCheck >= 2.4, test-framework >= 0.4.1, test-framework-quickcheck2, test-framework-hunit, bytestring, irc ghc-options: -Wall hs-source-dirs: tests default-language: Haskell2010 main-is: Main.hs irc-0.6.1.0/LICENSE0000644000000000000000000000266112444074304011633 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.6.1.0/Setup.lhs0000644000000000000000000000011112444074304012422 0ustar0000000000000000#!/usr/bin/runhaskell > import Distribution.Simple > main = defaultMain irc-0.6.1.0/Network/0000755000000000000000000000000012444074304012252 5ustar0000000000000000irc-0.6.1.0/Network/IRC.hs0000644000000000000000000000076212444074304013230 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.6.1.0/Network/IRC/0000755000000000000000000000000012444074304012667 5ustar0000000000000000irc-0.6.1.0/Network/IRC/Base.hs0000644000000000000000000001450512444074304014102 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 import Data.Char import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 -- --------------------------------------------------------- -- Data Types type Parameter = ByteString type ServerName = ByteString type UserName = ByteString type RealName = ByteString type Command = ByteString -- | 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 ByteString (Maybe UserName) (Maybe ServerName) deriving (Show,Read,Eq) -- --------------------------------------------------------- -- Formatting -- | Encode a message to its string representation encode :: Message -> ByteString encode = showMessage -- | This is the deprecated version of encode render :: Message -> ByteString render = encode showMessage :: Message -> ByteString showMessage (Message p c ps) = showMaybe p `BS.append` c `BS.append` showParameters ps where showMaybe Nothing = BS.empty showMaybe (Just prefix) = BS.concat [ B8.pack ":" , showPrefix prefix , B8.pack " " ] bsConsAscii :: Char -> ByteString -> ByteString bsConsAscii c = BS.cons (fromIntegral . ord $ c) showPrefix :: Prefix -> ByteString showPrefix (Server s) = s showPrefix (NickName n u h) = BS.concat [n, showMaybe '!' u, showMaybe '@' h] where showMaybe c e = maybe BS.empty (bsConsAscii c) e showParameters :: [Parameter] -> ByteString showParameters [] = BS.empty showParameters params = BS.intercalate (B8.pack " ") (BS.empty : showp params) where showp [p] = [bsConsAscii ':' 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 -> ByteString -- ^ Text translation translateReply r = fromMaybe r $ lookup r replyTable -- One big lookup table of codes and errors replyTable :: [(ByteString, ByteString)] replyTable = map mkPair [ ("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") ] where mkPair (a,b) = (B8.pack a, B8.pack b) irc-0.6.1.0/Network/IRC/Commands.hs0000644000000000000000000000223512444074304014766 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.IRC.Commands ( -- * Types Channel , Password -- * IRC Functions , nick , user , joinChan , part , quit , privmsg , kick , pong ) where import Data.ByteString import Network.IRC.Base type Channel = ByteString type Password = ByteString type Reason = ByteString mkMessage :: ByteString -> [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 ByteString -> Message quit (Just m) = mkMessage "QUIT" [m] quit Nothing = mkMessage "QUIT" [] privmsg :: ByteString -> ByteString -> Message privmsg c m = mkMessage "PRIVMSG" [c,m] pong :: ServerName -> Message pong s = mkMessage "PONG" [s] irc-0.6.1.0/Network/IRC/Parser.hs0000644000000000000000000001054512444074304014464 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 -- :: Parser Prefix , serverPrefix -- :: Parser Prefix , nicknamePrefix -- :: Parser Prefix , command -- :: Parser Command , parameter -- :: Parser Parameter , message -- :: Parser Message , crlf -- :: Parser () , spaces -- :: Parser () -- * Deprecated Functions , parseMessage ) where import Network.IRC.Base import Data.Char import Data.Word import Data.ByteString hiding (elem, map, empty) import Control.Monad (void) import Control.Applicative import Data.Attoparsec.ByteString -- | Casts a character (assumed to be ASCII) to its corresponding byte. asciiToWord8 :: Char -> Word8 asciiToWord8 = fromIntegral . ord wSpace :: Word8 wSpace = asciiToWord8 ' ' wTab :: Word8 wTab = asciiToWord8 '\t' wBell :: Word8 wBell = asciiToWord8 '\b' wDot :: Word8 wDot = asciiToWord8 '.' wExcl :: Word8 wExcl = asciiToWord8 '!' wAt :: Word8 wAt = asciiToWord8 '@' wCR :: Word8 wCR = asciiToWord8 '\r' wLF :: Word8 wLF = asciiToWord8 '\n' wColon :: Word8 wColon = asciiToWord8 ':' -- | Parse a String into a Message. decode :: ByteString -- ^ Message string -> Maybe Message -- ^ Parsed message decode str = case parseOnly message str of Left _ -> Nothing Right r -> Just r -- | The deprecated version of decode parseMessage :: ByteString -> Maybe Message parseMessage = decode -- | Convert a parser that consumes all space after it tokenize :: Parser a -> Parser a tokenize p = p <* spaces -- | Consume only spaces, tabs, or the bell character spaces :: Parser () spaces = skip (\w -> w == wSpace || w == wTab || w == wBell) -- | Parse a Prefix prefix :: Parser Prefix prefix = word8 wColon *> (try nicknamePrefix <|> serverPrefix) "prefix" -- | Parse a Server prefix serverPrefix :: Parser Prefix serverPrefix = Server <$> takeTill (== wSpace) "serverPrefix" -- | optionMaybe p tries to apply parser p. If p fails without consuming input, -- | it return Nothing, otherwise it returns Just the value returned by p. optionMaybe :: Parser a -> Parser (Maybe a) optionMaybe p = option Nothing (Just <$> p) -- | Parse a NickName prefix nicknamePrefix :: Parser Prefix nicknamePrefix = do n <- takeTill (inClass " .!@\r\n") p <- peekWord8 case p of Just c | c == wDot -> empty _ -> NickName n <$> optionMaybe (word8 wExcl *> takeTill (\w -> w == wSpace || w == wAt || w == wCR || w == wLF)) <*> optionMaybe (word8 wAt *> takeTill (\w -> w == wSpace || w == wCR || w == wLF)) "nicknamePrefix" isWordAsciiUpper :: Word8 -> Bool isWordAsciiUpper w = asciiToWord8 'A' <= w && w <= asciiToWord8 'Z' digit :: Parser Word8 digit = satisfy (\w -> asciiToWord8 '0' <= w && w <= asciiToWord8 '9') -- | Parse a command. Either a string of capital letters, or 3 digits. command :: Parser Command command = takeWhile1 isWordAsciiUpper <|> digitsToByteString <$> digit <*> digit <*> digit "command" where digitsToByteString x y z = pack [x,y,z] -- | Parse a command parameter. parameter :: Parser Parameter parameter = (word8 wColon *> takeTill (\w -> w == wCR || w == wLF)) <|> takeTill (\w -> w == wSpace || w == wCR || w == wLF) "parameter" -- | Parse a cr lf crlf :: Parser () crlf = void (word8 wCR *> optional (word8 wLF)) <|> void (word8 wLF) -- | Parse a Message message :: Parser Message message = Message <$> optionMaybe (tokenize prefix) <*> command <*> many (spaces *> parameter) <* optional crlf <* endOfInput "message" irc-0.6.1.0/tests/0000755000000000000000000000000012444074304011763 5ustar0000000000000000irc-0.6.1.0/tests/Main.hs0000644000000000000000000001315412444074304013207 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import Network.IRC import Data.ByteString (ByteString, append, pack) import Data.Word (Word8) import Data.Char (ord) import Control.Applicative ((<$>), (<*>), liftA) import Test.HUnit import Test.QuickCheck import Test.Framework as TF (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 (testProperty) -- --------------------------------------------------------- -- Helpful Wrappers -- An identifier starts with a letter, and consists of interspersed numbers -- and special characters newtype Identifier = Identifier { unIdentifier :: ByteString } deriving (Read,Show,Eq) instance Arbitrary Identifier where arbitrary = do l <- letter ls <- sized $ \n -> loop n return $ Identifier (pack (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 :: ByteString } instance Arbitrary Host where arbitrary = do l <- identifier ls <- sized $ \n -> loop n js <- sized $ \n -> loop n e <- identifier return $ Host (pack (l:ls ++ (w8 '.':js) ++ [e])) where loop n | n <= 0 = return [] | otherwise = do i <- host is <- loop (n-1) return (i:is) w8 :: Char -> Word8 w8 = fromIntegral . ord letter :: Gen Word8 letter = frequency [ (50, choose (w8 'a', w8 'z')) , (50, choose (w8 'A', w8 'Z')) ] digit :: Gen Word8 digit = choose (w8 '0', w8 '9') special :: Gen Word8 special = elements [w8 '_', w8 '-'] identifier :: Gen Word8 identifier = frequency [ (50, letter) , (30, digit) , (10, special) ] host :: Gen Word8 host = frequency [ (90, identifier) , (20, return (w8 '.')) ] -- --------------------------------------------------------- -- IRC Types newtype Cmd = Cmd { unCmd :: ByteString } 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 [ NickName <$> fmap unIdentifier arbitrary <*> fmap (liftA unIdentifier) arbitrary <*> fmap (liftA unIdentifier) arbitrary , Server <$> fmap unHost arbitrary ] instance Arbitrary Message where arbitrary = let params = map unIdentifier <$> sized vector cmd = unCmd <$> arbitrary in Message <$> arbitrary <*> cmd <*> params -- --------------------------------------------------------- -- Properties prop_encodeDecode :: Message -> Bool prop_encodeDecode msg = (decode . appendCRLF . encode $ msg) == Just msg where appendCRLF bs = append bs (pack [w8 '\r', w8 '\n']) properties :: TF.Test properties = testGroup "QuickCheck Network.IRC" [ testProperty "encodeDecode" prop_encodeDecode ] -- --------------------------------------------------------- -- Unit Tests unitTests :: TF.Test unitTests = testGroup "HUnit tests Network.IRC" [ -- Decoding tests testCase "PRIVMSG foo :bar baz" ( decode "PRIVMSG foo :bar baz" @=? Just (Message Nothing "PRIVMSG" ["foo", "bar baz"])) , testCase ":foo.bar NOTICE baz baz :baz baz" ( decode ":foo.bar NOTICE baz baz :baz baz" @=? Just (Message (Just (Server "foo.bar")) "NOTICE" ["baz", "baz", "baz baz"])) , testCase ":foo.bar 001 baz baz :baz baz" ( decode ":foo.bar 001 baz baz :baz baz" @=? Just (Message (Just (Server "foo.bar")) "001" ["baz", "baz", "baz baz"])) , testCase ":foo!bar@baz PRIVMSG #foo :bar baz" ( decode ":foo!bar@baz PRIVMSG #foo :bar baz" @=? Just (Message (Just (NickName "foo" (Just "bar") (Just "baz"))) "PRIVMSG" ["#foo", "bar baz"])) , testCase ":foo@baz PRIVMSG #foo :bar baz" ( decode ":foo@baz PRIVMSG #foo :bar baz" @=? Just (Message (Just (NickName "foo" Nothing (Just "baz"))) "PRIVMSG" ["#foo", "bar baz"])) , testCase ":foo!bar PRIVMSG #foo :bar baz" ( decode ":foo!bar PRIVMSG #foo :bar baz" @=? Just (Message (Just (NickName "foo" (Just "bar") Nothing)) "PRIVMSG" ["#foo", "bar baz"])) , testCase ":foo PRIVMSG #foo :bar baz" ( decode ":foo PRIVMSG #foo :bar baz" @=? Just (Message (Just (NickName "foo" Nothing Nothing)) "PRIVMSG" ["#foo", "bar baz"])) -- Decoding tests -- Initial colon encoding tests , testCase "Message Nothing \"PRIVMSG\" [\"#foo\", \":bar bas\"]" ( encode (Message Nothing "PRIVMSG" ["#foo", ":bar bas"]) @?= "PRIVMSG #foo ::bar bas") , testCase "Message Nothing \"PRIVMSG\" [\"#foo\", \":bar\"]" ( encode (Message Nothing "PRIVMSG" ["#foo", ":bar"]) @?= "PRIVMSG #foo ::bar") -- Corrected case , testCase ":talon.nl.eu.SwiftIRC.net 332 foo #bar :\n" ( decode ":talon.nl.eu.SwiftIRC.net 332 foo #bar :\n" @?= Just (Message (Just $ Server "talon.nl.eu.SwiftIRC.net") "332" ["foo","#bar",""])) ] -- --------------------------------------------------------- -- Test List tests :: [TF.Test] tests = [ properties , unitTests ] main :: IO () main = defaultMain tests