simpleirc-0.2.1/0000755000000000000000000000000011665461053011676 5ustar0000000000000000simpleirc-0.2.1/simpleirc.cabal0000644000000000000000000000173411665461053014656 0ustar0000000000000000Name: simpleirc Version: 0.2.1 Category: Network, IRC Synopsis: Simple IRC Library Maintainer: Dominik Picheta Author: Dominik Picheta Copyright: (c) 2010 Dominik Picheta License: BSD3 License-file: license Homepage: http://github.com/dom96/SimpleIRC Build-type: Simple Stability: provisional Cabal-version: >= 1.6 Description: Simple IRC Library. This IRC Library aims to be simple and lightweight. Source-repository head Type: git Location: git://github.com/dom96/SimpleIRC.git Source-repository this Type: git Location: git://github.com/dom96/SimpleIRC.git tag: v0.2.1 Library Build-depends: base >= 4 && < 5, bytestring >= 0.9.1.7, network >= 2.2.1.5, containers >= 0.3.0.0, time >= 1.1.4, old-locale >= 1.0.0.2 Exposed-modules: Network.SimpleIRC Network.SimpleIRC.Core Network.SimpleIRC.Messages simpleirc-0.2.1/Setup.hs0000644000000000000000000000007511665461053013334 0ustar0000000000000000import Distribution.Simple main :: IO () main = defaultMain simpleirc-0.2.1/license0000644000000000000000000000275211665461053013251 0ustar0000000000000000Copyright (c) 2010, Dominik Picheta All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 DOMINIK PICHETA 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. simpleirc-0.2.1/Network/0000755000000000000000000000000011665461053013327 5ustar0000000000000000simpleirc-0.2.1/Network/SimpleIRC.hs0000644000000000000000000000065611665461053015461 0ustar0000000000000000-- | -- Module : Network.SimpleIRC -- Copyright : (c) Dominik Picheta 2010 -- License : BSD3 -- -- Maintainer : morfeusz8@gmail.com -- Stability : Alpha -- Portability : portable -- -- Simple and efficient IRC Library -- module Network.SimpleIRC ( -- * Core module Network.SimpleIRC.Core -- * Messages , module Network.SimpleIRC.Messages ) where import Network.SimpleIRC.Core import Network.SimpleIRC.Messages simpleirc-0.2.1/Network/SimpleIRC/0000755000000000000000000000000011665461053015116 5ustar0000000000000000simpleirc-0.2.1/Network/SimpleIRC/Messages.hs0000644000000000000000000001645611665461053017235 0ustar0000000000000000-- | -- Module : Network.SimpleIRC.Core -- Copyright : (c) Dominik Picheta 2010 -- License : BSD3 -- -- Maintainer : morfeusz8@gmail.com -- Stability : provisional -- Portability : portable -- -- Messages (parsing) module -- {-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} module Network.SimpleIRC.Messages ( IrcMessage(..) , Command(..) , parse , showCommand ) where import Data.Maybe import qualified Data.ByteString.Char8 as B import Control.Arrow import Control.Applicative import Data.Typeable -- PING :asimov.freenode.net -- :haskellTestBot!~test@host86-177-151-242.range86-177.btcentralplus.com JOIN :#() -- :dom96!~dom96@unaffiliated/dom96 PRIVMSG #() :it lives! -- :haskellTestBot MODE haskellTestBot :+i -- :asimov.freenode.net 376 haskellTestBot :End of /MOTD command. -- :asimov.freenode.net 332 haskellTestBot #() :Parenthesis -- :asimov.freenode.net 333 haskellTestBot #() Raynes!~macr0@unaffiliated/raynes 1281221819 data Command = Command | MPrivmsg B.ByteString B.ByteString -- ^ PRIVMSG #chan :msg | MJoin B.ByteString (Maybe B.ByteString) -- ^ JOIN #chan key | MPart B.ByteString B.ByteString -- ^ PART #chan :msg | MMode B.ByteString B.ByteString (Maybe B.ByteString) -- ^ MODE #chan +o user | MTopic B.ByteString (Maybe B.ByteString) -- ^ TOPIC #chan :topic | MInvite B.ByteString B.ByteString -- ^ INVITE user #chan | MKick B.ByteString B.ByteString B.ByteString -- ^ KICK #chan user :msg | MQuit B.ByteString -- ^ QUIT :msg | MNick B.ByteString -- ^ NICK newnick | MNotice B.ByteString B.ByteString -- ^ NOTICE usr/#chan :msg | MAction B.ByteString B.ByteString -- ^ PRIVMSG usr/#chan :ACTION msg deriving (Eq, Read, Show) data IrcMessage = IrcMessage { mNick :: Maybe B.ByteString , mUser :: Maybe B.ByteString , mHost :: Maybe B.ByteString , mServer :: Maybe B.ByteString , mCode :: B.ByteString , mMsg :: B.ByteString , mChan :: Maybe B.ByteString , mOrigin :: Maybe B.ByteString -- ^ Origin of the message, this is mNick if a message was sent directly to the bot, otherwise if it got sent to the channel it's mChan. , mOther :: Maybe [B.ByteString] , mRaw :: B.ByteString } deriving (Show, Typeable) -- |Parse a raw IRC message parse :: B.ByteString -> IrcMessage parse txt = case length split of 2 -> parse2 split noCarriage 3 -> parse3 split noCarriage 4 -> parse4 split noCarriage 5 -> parse5 split noCarriage _ -> parseOther split noCarriage where noCarriage = takeCarriageRet txt split = smartSplit noCarriage -- Nick, Host, Server parseFirst :: B.ByteString -> (Maybe B.ByteString, Maybe B.ByteString, Maybe B.ByteString, Maybe B.ByteString) parseFirst first = if '!' `B.elem` first then let (nick, user_host) = B.break (== '!') (dropColon first) in if '@' `B.elem` user_host then let (user, host) = second B.tail $ B.break (== '@') $ B.tail user_host in (Just nick, Just user, Just host, Nothing) else (Just nick, Nothing, Just user_host, Nothing) else (Nothing, Nothing, Nothing, Just $ dropColon first) getOrigin :: Maybe B.ByteString -> B.ByteString -> B.ByteString getOrigin (Just nick) chan = if "#" `B.isPrefixOf` chan || "&" `B.isPrefixOf` chan || "+" `B.isPrefixOf` chan || "!" `B.isPrefixOf` chan then chan else nick getOrigin Nothing chan = chan parse2 :: [B.ByteString] -> B.ByteString -> IrcMessage parse2 (code:msg:_) = IrcMessage Nothing Nothing Nothing Nothing code (dropColon msg) Nothing Nothing Nothing parse3 :: [B.ByteString] -> B.ByteString -> IrcMessage parse3 (first:code:msg:_) = let (nick, user, host, server) = parseFirst first in IrcMessage nick user host server code (dropColon msg) Nothing Nothing Nothing parse4 :: [B.ByteString] -> B.ByteString -> IrcMessage parse4 (first:code:chan:msg:_) = let (nick, user, host, server) = parseFirst first in IrcMessage nick user host server code (dropColon msg) (Just chan) (Just $ getOrigin nick chan) Nothing parse5 :: [B.ByteString] -> B.ByteString -> IrcMessage parse5 (first:code:chan:other:msg:_) = let (nick, user, host, server) = parseFirst first in IrcMessage nick user host server code (dropColon msg) (Just chan) (Just $ getOrigin nick chan) (Just [other]) parseOther :: [B.ByteString] -> B.ByteString -> IrcMessage parseOther (server:code:nick:chan:other) = IrcMessage (Just nick) Nothing Nothing (Just server) code (B.unwords other) (Just chan) (Just $ getOrigin (Just nick) chan) (Just other) smartSplit :: B.ByteString -> [B.ByteString] smartSplit txt = case B.breakSubstring (B.pack " :") (dropColon txt) of (x,y) | B.null y -> B.words txt | otherwise -> let (_, msg) = B.break (== ':') y in B.words x ++ [msg] takeLast :: B.ByteString -> B.ByteString takeLast xs = B.take (B.length xs - 1) xs takeCarriageRet :: B.ByteString -> B.ByteString takeCarriageRet xs = if B.drop (B.length xs - 1) xs == B.pack "\r" then takeLast xs else xs dropColon :: B.ByteString -> B.ByteString dropColon xs = if B.take 1 xs == B.pack ":" then B.drop 1 xs else xs showCommand :: Command -> B.ByteString showCommand (MPrivmsg chan msg) = "PRIVMSG " `B.append` chan `B.append` " :" `B.append` msg showCommand (MJoin chan (Just key)) = "JOIN " `B.append` chan `B.append` " " `B.append` key showCommand (MJoin chan Nothing) = "JOIN " `B.append` chan showCommand (MPart chan msg) = "PART " `B.append` chan `B.append` " :" `B.append` msg showCommand (MMode chan mode (Just usr)) = "MODE " `B.append` chan `B.append` " " `B.append` mode `B.append` " " `B.append` usr showCommand (MMode chan mode Nothing) = "MODE " `B.append` chan `B.append` " " `B.append` mode showCommand (MTopic chan (Just msg)) = "TOPIC " `B.append` chan `B.append` " :" `B.append` msg showCommand (MTopic chan Nothing) = "TOPIC " `B.append` chan showCommand (MInvite usr chan) = "INVITE " `B.append` usr `B.append` " " `B.append` chan showCommand (MKick chan usr msg) = "KICK " `B.append` chan `B.append` " " `B.append` usr `B.append` " :" `B.append` msg showCommand (MQuit msg) = "QUIT :" `B.append` msg showCommand (MNick nick) = "NICK " `B.append` nick showCommand (MNotice chan msg) = "NOTICE " `B.append` chan `B.append` " :" `B.append` msg showCommand (MAction chan msg) = showCommand $ MPrivmsg chan ("\x01 ACTION " `B.append` msg `B.append` "\x01") simpleirc-0.2.1/Network/SimpleIRC/Core.hs0000644000000000000000000004065711665461053016356 0ustar0000000000000000-- | -- Module : Network.SimpleIRC.Core -- Copyright : (c) Dominik Picheta 2010 -- License : BSD3 -- -- Maintainer : morfeusz8@gmail.com -- Stability : provisional -- Portability : portable -- -- For information on how to use this library please take a look at the readme file on github, . {-# LANGUAGE OverloadedStrings #-} module Network.SimpleIRC.Core ( -- * Types MIrc , EventFunc , IrcConfig(..) , IrcEvent(..) -- * Functions , connect , disconnect , reconnect , sendRaw , sendMsg , sendCmd , addEvent , changeEvents , remEvent , defaultConfig -- * Accessors , getChannels , getNickname , getAddress , getPort , getUsername , getRealname ) where import Network import System.IO import Data.Maybe import Data.List (delete) import Data.Char (isNumber) import Control.Monad import Control.Concurrent import Control.Concurrent.Chan import Control.Concurrent.MVar import Network.SimpleIRC.Messages import Data.Unique import System.IO.Error import System.Timeout import Data.Time import System.Locale import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map internalEvents = [joinChans, pong, trackChanges] internalNormEvents = [Privmsg ctcpHandler] type MIrc = MVar IrcServer data IrcConfig = IrcConfig { cAddr :: String -- ^ Server address to connect to , cPort :: Int -- ^ Server port to connect to , cNick :: String -- ^ Nickname , cPass :: Maybe String -- ^ Optional server password , cUsername :: String -- ^ Username , cRealname :: String -- ^ Realname , cChannels :: [String] -- ^ List of channels to join on connect , cEvents :: [IrcEvent] -- ^ Events to bind , cCTCPVersion :: String -- ^ What to send on CTCP VERSION , cCTCPTime :: IO String -- ^ What to send on CTCP TIME , cPingTimeoutInterval :: Int -- The time between server messages that causes ping timeout } data SIrcCommand = SIrcAddEvent (Unique, IrcEvent) | SIrcChangeEvents (Map.Map Unique IrcEvent) | SIrcRemoveEvent Unique data IrcServer = IrcServer { sAddr :: B.ByteString , sPort :: Int , sNickname :: B.ByteString , sPassword :: Maybe B.ByteString , sUsername :: B.ByteString , sRealname :: B.ByteString , sChannels :: [B.ByteString] , sEvents :: Map.Map Unique IrcEvent , sSock :: Maybe Handle , sListenThread :: Maybe ThreadId , sCmdThread :: Maybe ThreadId , sCmdChan :: Chan SIrcCommand , sDebug :: Bool -- Other info , sCTCPVersion :: String , sCTCPTime :: IO String , sPingTimeoutInterval :: Int } -- When adding events here, remember add them in callEvents and in eventFunc -- AND also in the Show instance and Eq instance data IrcEvent = Privmsg EventFunc -- ^ PRIVMSG | Numeric EventFunc -- ^ Numeric, 001, 002, 372 etc. | Ping EventFunc -- ^ PING | Join EventFunc -- ^ JOIN | Part EventFunc -- ^ PART | Mode EventFunc -- ^ MODE | Topic EventFunc -- ^ TOPIC | Invite EventFunc -- ^ INVITE | Kick EventFunc -- ^ KICK | Quit EventFunc -- ^ QUIT | Nick EventFunc -- ^ NICK | Notice EventFunc -- ^ NOTICE | RawMsg EventFunc -- ^ This event gets called on every message received | Disconnect (MIrc -> IO ()) -- ^ This event gets called whenever the -- connection with the server is dropped instance Show IrcEvent where show (Privmsg _) = "IrcEvent - Privmsg" show (Numeric _) = "IrcEvent - Numeric" show (Ping _) = "IrcEvent - Ping" show (Join _) = "IrcEvent - Join" show (Part _) = "IrcEvent - Part" show (Mode _) = "IrcEvent - Mode" show (Topic _) = "IrcEvent - Topic" show (Invite _) = "IrcEvent - Invite" show (Kick _) = "IrcEvent - Kick" show (Quit _) = "IrcEvent - Quit" show (Nick _) = "IrcEvent - Nick" show (Notice _) = "IrcEvent - Notice" show (RawMsg _) = "IrcEvent - RawMsg" show (Disconnect _) = "IrcEvent - Disconnect" type EventFunc = (MIrc -> IrcMessage -> IO ()) -- |Connects to a server connect :: IrcConfig -- ^ Configuration -> Bool -- ^ Run in a new thread -> Bool -- ^ Print debug messages -> IO (Either IOError MIrc) -- ^ IrcServer instance connect config threaded debug = try $ do (when debug $ B.putStrLn $ "Connecting to " `B.append` B.pack (cAddr config)) h <- connectTo (cAddr config) (PortNumber $ fromIntegral $ cPort config) hSetBuffering h NoBuffering cmdChan <- newChan server <- toServer config h cmdChan debug -- Initialize connection with the server greetServer server -- Create a new MVar res <- newMVar server -- Start the loops, listen and exec cmds if threaded then do listenId <- forkIO (listenLoop res) cmdId <- forkIO (execCmdsLoop res) modifyMVar_ res (\srv -> return $ srv {sListenThread = Just listenId}) return res else do listenLoop res return res -- |Sends a QUIT command to the server. disconnect :: MIrc -> B.ByteString -- ^ Quit message -> IO () disconnect server quitMsg = do s <- readMVar server let h = fromJust $ sSock s write s $ "QUIT :" `B.append` quitMsg return () -- |Reconnects to the server. reconnect :: MIrc -> IO (Either IOError MIrc) reconnect mServer = try $ do server <- readMVar mServer h <- connectTo (B.unpack $ sAddr server) (PortNumber $ fromIntegral $ sPort server) hSetBuffering h NoBuffering modifyMVar_ mServer (\s -> return $ s {sSock = Just h}) -- Initialize connection with the server withMVar mServer greetServer -- Restart the listen loop. listenId <- forkIO (listenLoop mServer) cmdId <- forkIO (execCmdsLoop mServer) modifyMVar_ mServer (\s -> return $ s {sListenThread = Just listenId, sCmdThread = Just cmdId}) return mServer {- -- |Reconnects to the server. reconnect :: MIrc -> IO (Either IOError MIrc) reconnect server = do s <- readMVar server let conf = IrcConfig (B.unpack $ sAddr s) (sPort s) (B.unpack $ sNickname s) (B.unpack $ sUsername s) (B.unpack $ sRealname s) (map (B.unpack) (sChannels s)) (elems $ sEvents s) (sCTCPVersion s) (sCTCPTime s) connect conf True (sDebug s) -} genUnique :: IrcEvent -> IO (Unique, IrcEvent) genUnique e = do u <- newUnique return (u, e) genUniqueMap :: [IrcEvent] -> IO (Map.Map Unique IrcEvent) genUniqueMap events = do uEvents <- mapM genUnique events return $ Map.fromList uEvents toServer :: IrcConfig -> Handle -> Chan SIrcCommand -> Bool -> IO IrcServer toServer config h cmdChan debug = do uniqueEvents <- genUniqueMap $ internalNormEvents ++ cEvents config return $ IrcServer (B.pack $ cAddr config) (cPort config) (B.pack $ cNick config) (B.pack `fmap` cPass config) (B.pack $ cUsername config) (B.pack $ cRealname config) (map B.pack $ cChannels config) uniqueEvents (Just h) Nothing Nothing cmdChan debug (cCTCPVersion config) (cCTCPTime config) (cPingTimeoutInterval config) greetServer :: IrcServer -> IO IrcServer greetServer server = do case mpass of Nothing -> return () Just pass -> write server $ "PASS " `B.append` pass write server $ "NICK " `B.append` nick write server $ "USER " `B.append` user `B.append` " " `B.append` user `B.append` " " `B.append` addr `B.append` " :" `B.append` real return server where nick = sNickname server mpass = sPassword server user = sUsername server real = sRealname server addr = sAddr server execCmdsLoop :: MIrc -> IO () execCmdsLoop mIrc = do server <- readMVar mIrc cmd <- readChan $ sCmdChan server case cmd of (SIrcAddEvent uEvent) -> do swapMVar mIrc (server {sEvents = (uncurry Map.insert uEvent) (sEvents server)}) execCmdsLoop mIrc (SIrcChangeEvents events) -> do swapMVar mIrc (server {sEvents = events}) execCmdsLoop mIrc (SIrcRemoveEvent key) -> do swapMVar mIrc (server {sEvents = Map.delete key (sEvents server)}) execCmdsLoop mIrc listenLoop :: MIrc -> IO () listenLoop s = do server <- readMVar s let h = fromJust $ sSock server eof <- timeout (sPingTimeoutInterval server) $ hIsEOF h -- If EOF then we are disconnected if (eof /= Just False) then do let comp = (\a -> a `eqEvent` (Disconnect undefined)) events = Map.filter comp (sEvents server) eventCall = (\obj -> (eventFuncD $ snd obj) s) modifyMVar_ s (\serv -> return $ serv {sSock = Nothing}) debugWrite server $ B.pack $ show $ length $ Map.toList events mapM_ eventCall (Map.toList events) else do line <- B.hGetLine h server1 <- takeMVar s -- Print the received line. debugWrite server1 $ (B.pack ">> ") `B.append` line -- Call the internal events newServ <- foldM (\sr f -> f sr (parse line)) server1 internalEvents putMVar s newServ -- Put the MVar back. let parsed = (parse line) -- Call the events callEvents s parsed -- Call the RawMsg Events. events s (RawMsg undefined) parsed listenLoop s -- Internal Events - They can edit the server joinChans :: IrcServer -> IrcMessage -> IO IrcServer joinChans server msg = if code == "001" then do mapM_ (\chan -> write server $ "JOIN " `B.append` chan) (sChannels server) return server {sChannels = []} else return server where h = fromJust $ sSock server code = mCode msg pong :: IrcServer -> IrcMessage -> IO IrcServer pong server msg = if code == "PING" then do write server $ "PONG :" `B.append` pingMsg return server else return server where h = fromJust $ sSock server pingMsg = mMsg msg code = mCode msg trackChanges :: IrcServer -> IrcMessage -> IO IrcServer trackChanges server msg | code == "JOIN" = do let nick = fromJust $ mNick msg chan = mMsg msg if nick == sNickname server then return server { sChannels = chan:(sChannels server) } else return server | code == "NICK" = do let nick = fromJust $ mNick msg newNick = mMsg msg if nick == sNickname server then return server { sNickname = newNick } else return server | code == "KICK" = do let nick = (fromJust $ mOther msg) !! 0 chan = fromJust $ mChan msg if nick == sNickname server then return server { sChannels = delete chan (sChannels server) } else return server | code == "PART" = do let nick = fromJust $ mNick msg chan = mMsg msg if nick == sNickname server then return server { sChannels = delete chan (sChannels server) } else return server | otherwise = return server where code = mCode msg -- Internal normal events ctcpHandler :: EventFunc ctcpHandler mServ iMsg | msg == "\x01VERSION\x01" = do server <- readMVar mServ sendCmd mServ (MNotice origin ("\x01VERSION " `B.append` B.pack (sCTCPVersion server) `B.append` "\x01")) | msg == "\x01TIME\x01" = do server <- readMVar mServ time <- sCTCPTime server sendCmd mServ (MNotice origin ("\x01TIME " `B.append` (B.pack time) `B.append` "\x01")) | "\x01PING " `B.isPrefixOf` msg = do server <- readMVar mServ sendCmd mServ (MNotice origin msg) | otherwise = return () where msg = mMsg iMsg origin = fromJust $ mOrigin iMsg -- Event code events :: MIrc -> IrcEvent -> IrcMessage -> IO () events mServ event msg = do server <- readMVar mServ let comp = (`eqEvent` event) events = Map.filter comp (sEvents server) eventCall = (\obj -> (eventFunc $ snd obj) mServ msg) mapM_ eventCall (Map.toList events) callEvents :: MIrc -> IrcMessage -> IO () callEvents mServ msg | mCode msg == "PRIVMSG" = events mServ (Privmsg undefined) msg | mCode msg == "PING" = events mServ (Ping undefined) msg | mCode msg == "JOIN" = events mServ (Join undefined) msg | mCode msg == "PART" = events mServ (Part undefined) msg | mCode msg == "MODE" = events mServ (Mode undefined) msg | mCode msg == "TOPIC" = events mServ (Topic undefined) msg | mCode msg == "INVITE" = events mServ (Invite undefined) msg | mCode msg == "KICK" = events mServ (Kick undefined) msg | mCode msg == "QUIT" = events mServ (Quit undefined) msg | mCode msg == "NICK" = events mServ (Nick undefined) msg | mCode msg == "NOTICE" = events mServ (Notice undefined) msg | B.all isNumber (mCode msg) = events mServ (Numeric undefined) msg | otherwise = return () (Privmsg _) `eqEvent` (Privmsg _) = True (Numeric _) `eqEvent` (Numeric _) = True (Ping _) `eqEvent` (Ping _) = True (Join _) `eqEvent` (Join _) = True (Part _) `eqEvent` (Part _) = True (Mode _) `eqEvent` (Mode _) = True (Topic _) `eqEvent` (Topic _) = True (Invite _) `eqEvent` (Invite _) = True (Kick _) `eqEvent` (Kick _) = True (Quit _) `eqEvent` (Quit _) = True (Nick _) `eqEvent` (Nick _) = True (Notice _) `eqEvent` (Notice _) = True (RawMsg _) `eqEvent` (RawMsg _) = True (Disconnect _) `eqEvent` (Disconnect _) = True _ `eqEvent` _ = False eventFunc :: IrcEvent -> EventFunc eventFunc (Privmsg f) = f eventFunc (Numeric f) = f eventFunc (Ping f) = f eventFunc (Join f) = f eventFunc (Part f) = f eventFunc (Mode f) = f eventFunc (Topic f) = f eventFunc (Invite f) = f eventFunc (Kick f) = f eventFunc (Quit f) = f eventFunc (Nick f) = f eventFunc (Notice f) = f eventFunc (RawMsg f) = f eventFuncD (Disconnect f) = f -- |Sends a raw command to the server sendRaw :: MIrc -> B.ByteString -> IO () sendRaw mServ msg = do server <- readMVar mServ write server msg -- |Sends a message to a channel -- |Please note: As of now this function doesn't provide flood control. -- So be careful with \\n. sendMsg :: MIrc -> B.ByteString -- ^ Channel -> B.ByteString -- ^ Message -> IO () sendMsg mServ chan msg = mapM_ s lins where lins = B.lines msg s m = sendCmd mServ (MPrivmsg chan m) sendCmd :: MIrc -> Command -- Command to send -> IO () sendCmd mServ cmd = sendRaw mServ (showCommand cmd) addEvent :: MIrc -> IrcEvent -> IO Unique addEvent mIrc event = do s <- readMVar mIrc u <- newUnique writeChan (sCmdChan s) (SIrcAddEvent (u, event)) return u changeEvents :: MIrc -> [IrcEvent] -> IO () changeEvents mIrc events = do s <- readMVar mIrc uniqueEvents <- genUniqueMap events writeChan (sCmdChan s) (SIrcChangeEvents uniqueEvents) remEvent :: MIrc -> Unique -> IO () remEvent mIrc uniq = do s <- readMVar mIrc writeChan (sCmdChan s) (SIrcRemoveEvent uniq) debugWrite :: IrcServer -> B.ByteString -> IO () debugWrite s msg = (when (sDebug s) $ B.putStrLn msg) write :: IrcServer -> B.ByteString -> IO () write s msg = do debugWrite s $ "<< " `B.append` msg `B.append` "\\r\\n" B.hPutStr h (msg `B.append` "\r\n") where h = fromJust $ sSock s defaultConfig = IrcConfig { cPort = 6667 , cPass = Nothing , cUsername = "simpleirc" , cRealname = "SimpleIRC Bot" , cChannels = [] , cEvents = [] , cCTCPVersion = "SimpleIRC v0.2" , cCTCPTime = fmap (formatTime defaultTimeLocale "%c") getZonedTime , cPingTimeoutInterval = 350 * 10^6 } -- MIrc Accessors -- |Returns a list of channels currently joined. getChannels :: MIrc -> IO [B.ByteString] getChannels mIrc = do s <- readMVar mIrc return $ sChannels s -- |Returns the current nickname. getNickname :: MIrc -> IO B.ByteString getNickname mIrc = do s <- readMVar mIrc return $ sNickname s -- |Returns the address getAddress :: MIrc -> IO B.ByteString getAddress mIrc = do s <- readMVar mIrc return $ sAddr s -- |Returns the address getPort :: MIrc -> IO Int getPort mIrc = do s <- readMVar mIrc return $ sPort s -- |Returns the User name getUsername :: MIrc -> IO B.ByteString getUsername mIrc = do s <- readMVar mIrc return $ sUsername s -- |Returns the Real name getRealname :: MIrc -> IO B.ByteString getRealname mIrc = do s <- readMVar mIrc return $ sRealname s