irc-0.6.1.1/0000755000000000000000000000000007346545000010623 5ustar0000000000000000irc-0.6.1.1/LICENSE0000644000000000000000000000266107346545000011635 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.1/Network/0000755000000000000000000000000007346545000012254 5ustar0000000000000000irc-0.6.1.1/Network/IRC.hs0000644000000000000000000000076207346545000013232 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.1/Network/IRC/0000755000000000000000000000000007346545000012671 5ustar0000000000000000irc-0.6.1.1/Network/IRC/Base.hs0000644000000000000000000001450507346545000014104 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.1/Network/IRC/Commands.hs0000644000000000000000000000216307346545000014770 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 :: Command -> [Parameter] -> Message mkMessage = Message Nothing 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 Reason -> Message quit (Just m) = mkMessage "QUIT" [m] quit Nothing = mkMessage "QUIT" [] privmsg :: Channel -> ByteString -> Message privmsg c m = mkMessage "PRIVMSG" [c,m] pong :: ServerName -> Message pong s = mkMessage "PONG" [s] irc-0.6.1.1/Network/IRC/Parser.hs0000644000000000000000000001055207346545000014464 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 (some spaces *> parameter) <* optional crlf <* endOfInput "message" irc-0.6.1.1/Setup.lhs0000644000000000000000000000011107346545000012424 0ustar0000000000000000#!/usr/bin/runhaskell > import Distribution.Simple > main = defaultMain irc-0.6.1.1/irc.cabal0000644000000000000000000000213707346545000012367 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.1 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.1/tests/0000755000000000000000000000000007346545000011765 5ustar0000000000000000irc-0.6.1.1/tests/Main.hs0000644000000000000000000001313607346545000013211 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