diff --git a/Network/FastIRC.hs b/Network/FastIRC.hs --- a/Network/FastIRC.hs +++ b/Network/FastIRC.hs @@ -3,12 +3,13 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: alpha -- -- Fast IRC parsing and connection library. module Network.FastIRC - ( module Network.FastIRC.Messages, + ( module Network.FastIRC.IO, + module Network.FastIRC.Messages, module Network.FastIRC.ServerSet, module Network.FastIRC.Types, module Network.FastIRC.Users, @@ -16,6 +17,7 @@ ) where +import Network.FastIRC.IO import Network.FastIRC.Messages import Network.FastIRC.ServerSet import Network.FastIRC.Types diff --git a/Network/FastIRC/IO.hs b/Network/FastIRC/IO.hs new file mode 100644 --- /dev/null +++ b/Network/FastIRC/IO.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Network.FastIRC.IO +-- Copyright: (c) 2010 Ertugrul Soeylemez +-- License: BSD3 +-- Maintainer: Ertugrul Soeylemez +-- Stability: alpha +-- +-- This module helps you with doing input and output on IRC connections +-- or even log files. + +module Network.FastIRC.IO + ( hGetIRCLine, + hGetMessage, + hPutCommand, + hPutMessage + ) + where + +import qualified Data.ByteString.Char8 as B +import Network.FastIRC.Messages +import Network.FastIRC.Types +import Network.FastIRC.Utils +import System.IO + + +-- | Read an IRC message string. + +hGetIRCLine :: Handle -> IO MsgString +hGetIRCLine h = getl B.empty + where + getl :: MsgString -> IO MsgString + getl buf = do + c <- hGetChar h + if isIRCEOLChar c + then return buf + else getl (B.snoc buf c) + + +-- | Read the next valid IRC message. + +hGetMessage :: Handle -> IO Message +hGetMessage h = do + line <- hGetIRCLine h + if B.null line + then hGetMessage h + else + case readMessage line of + Just msg -> return msg + Nothing -> hGetMessage h + + +-- | Write an IRC command with no origin. + +hPutCommand :: Handle -> Command -> IO () +hPutCommand h cmd = + B.hPutStr h $ B.append (showCommand cmd) "\r\n" + + +-- | Write an IRC message. + +hPutMessage :: Handle -> Message -> IO () +hPutMessage h msg = + B.hPutStr h $ B.append (showMessage msg) "\r\n" diff --git a/Network/FastIRC/Messages.hs b/Network/FastIRC/Messages.hs --- a/Network/FastIRC/Messages.hs +++ b/Network/FastIRC/Messages.hs @@ -4,8 +4,8 @@ -- Module: Network.FastIRC.Messages -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 --- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Maintainer: Ertugrul Soeylemez +-- Stability: alpha -- -- Parser and printer for IRC messages. @@ -25,12 +25,14 @@ import qualified Data.ByteString.Char8 as B import qualified Data.Map as M +import qualified Data.Set as S import Control.Applicative +import Control.Monad import Data.Attoparsec.Char8 as P hiding (many) import Data.Char import Data.Map (Map) import Data.Maybe -import Network.FastIRC.ServerSet +import Data.Set (Set) import Network.FastIRC.Types import Network.FastIRC.Users import Network.FastIRC.Utils @@ -44,7 +46,7 @@ msgOrigin :: !(Maybe UserSpec), -- ^ Message origin (user/server). msgCommand :: !Command -- ^ Message command or numeric. } - deriving (Eq, Show) + deriving (Eq, Read, Show) -- | Data type for IRC commands. @@ -53,10 +55,21 @@ = StringCmd CommandName [CommandArg] -- ^ Arbitrary string command. | NumericCmd Integer [CommandArg] -- ^ Arbitrary numeric command. - -- | Join command with a list of channels as well as channel keys. - | JoinCmd (Map ChannelName (Maybe ChannelKey)) + | JoinCmd (Map ChannelName (Maybe ChannelKey)) + | KickCmd (Set ChannelName) (Set NickName) (Maybe CommandArg) + | ModeCmd (Maybe (TargetName, CommandArg, [CommandArg])) + | NickCmd NickName (Maybe Int) + | NoticeCmd (Set TargetName) CommandArg + | PartCmd (Set ChannelName) (Maybe CommandArg) + | PassCmd CommandArg + | PingCmd ServerName (Maybe ServerName) + | PongCmd ServerName (Maybe ServerName) + | PrivMsgCmd (Set TargetName) CommandArg + | QuitCmd (Maybe CommandArg) + | TopicCmd ChannelName (Maybe CommandArg) + | UserCmd UserName CommandArg CommandArg CommandArg - deriving (Eq, Show) + deriving (Eq, Read, Show) -- | Parser for IRC commands and their arguments. @@ -76,45 +89,72 @@ lastArg :: Parser CommandArg lastArg = char ':' *> P.takeWhile isMessageChar + commaArg :: Parser (Set CommandArg) + commaArg = S.filter (not . B.null) . S.fromList . B.split ',' <$> cmdArg + + intArg :: Parser (Maybe Int) + intArg = option Nothing (fmap fst . B.readInt <$> cmdArg) + joinCmd :: Parser Command joinCmd = do channels <- B.split ',' <$> cmdArg keys <- option [] $ B.split ',' <$> cmdArg many cmdArg - return . JoinCmd . M.fromList $ zip channels (map Just keys ++ repeat Nothing) + return . JoinCmd . M.fromList $ + zip channels (map Just keys ++ repeat Nothing) numCmd :: Parser Command numCmd = NumericCmd <$> decimal <*> many cmdArg + optArg :: Parser (Maybe CommandArg) + optArg = option Nothing (Just <$> cmdArg) + stringCmd :: Parser Command stringCmd = do cmd <- B.map toUpper <$> takeWhile1 isCommandChar case cmd of "JOIN" -> joinCmd + "KICK" -> KickCmd <$> commaArg <*> commaArg <*> optArg <* many cmdArg + "MODE" -> + try ((\a b c -> ModeCmd (Just (a,b,c))) + <$> cmdArg + <*> cmdArg + <*> many cmdArg) + <|> (many cmdArg >>= guard . null >> pure (ModeCmd Nothing)) + "NICK" -> NickCmd <$> cmdArg <*> intArg <* many cmdArg + "NOTICE" -> NoticeCmd <$> commaArg <*> cmdArg <* many cmdArg + "PART" -> PartCmd <$> commaArg <*> optArg <* many cmdArg + "PASS" -> PassCmd <$> cmdArg <* many cmdArg + "PING" -> PingCmd <$> cmdArg <*> optArg <* many cmdArg + "PONG" -> PongCmd <$> cmdArg <*> optArg <* many cmdArg + "PRIVMSG" -> PrivMsgCmd <$> commaArg <*> cmdArg <* many cmdArg + "QUIT" -> QuitCmd <$> optArg <* many cmdArg + "TOPIC" -> TopicCmd <$> cmdArg <*> optArg <* many cmdArg + "USER" -> UserCmd <$> cmdArg <*> cmdArg <*> cmdArg <*> cmdArg <* many cmdArg _ -> StringCmd cmd <$> many cmdArg -- | Parser for IRC messages. -messageParser :: ServerSet -> Parser Message -messageParser servers = +messageParser :: Parser Message +messageParser = Message <$> option Nothing (Just <$> try userSpec) <*> commandParser where userSpec :: Parser UserSpec - userSpec = char ':' *> userParser servers <* skipMany1 (char ' ') + userSpec = char ':' *> userParser <* skipMany1 (char ' ') -- | Run the 'messageParser' parser. -readMessage :: ServerSet -> MsgString -> Maybe Message -readMessage = parseComplete . messageParser +readMessage :: MsgString -> Maybe Message +readMessage = parseComplete messageParser --- | Turn a 'Command' into a 'B.ByteString'. Please note that a command --- does not contain an origin specification. You should use --- 'showMessage' to format a an IRC message to be sent to the server. +-- | Turn a 'Command' into a 'B.ByteString'. If you need to specify an +-- origin for the command, you should use 'Message' together with +-- 'showMessage'. showCommand :: Command -> MsgString showCommand cmd = @@ -126,10 +166,40 @@ JoinCmd channels -> case formatJoins channels of - (chanList, "") -> B.append "JOIN" (showArgs [chanList]) - (chanList, keyList) -> B.append "JOIN" (showArgs [chanList, keyList]) + (chanList, "") -> "JOIN" +-+ [chanList] + (chanList, keyList) -> "JOIN" +-+ [chanList, keyList] + KickCmd channels nicks Nothing -> + "KICK" +-+ [commaList channels, commaList nicks] + KickCmd channels nicks (Just reason) -> + "KICK" +-+ [commaList channels, commaList nicks, reason] + ModeCmd Nothing -> "MODE" + ModeCmd (Just (target, mode, args)) -> + "MODE" +-+ [target, mode] ++ args + NickCmd nick (Just hc) -> "NICK" +-+ [nick, B.pack (show hc)] + NickCmd nick Nothing -> "NICK" +-+ [nick] + NoticeCmd targets text -> "NOTICE" +-+ [commaList targets, text] + PartCmd chans Nothing -> "PART" +-+ [commaList chans] + PartCmd chans (Just reason) -> + "PART" +-+ [commaList chans, reason] + PassCmd pwd -> "PASS" +-+ [pwd] + PingCmd srv1 Nothing -> "PING" +-+ [srv1] + PingCmd srv1 (Just srv2) -> "PING" +-+ [srv1, srv2] + PongCmd srv1 Nothing -> "PONG" +-+ [srv1] + PongCmd srv1 (Just srv2) -> "PONG" +-+ [srv1, srv2] + PrivMsgCmd targets text -> "PRIVMSG" +-+ [commaList targets, text] + QuitCmd Nothing -> "QUIT" +-+ [] + QuitCmd (Just reason) -> "QUIT" +-+ [reason] + TopicCmd channel Nothing -> "TOPIC" +-+ [channel] + TopicCmd channel (Just newTopic) -> + "TOPIC" +-+ [channel, newTopic] + UserCmd user vhost vport realName -> + "USER" +-+ [user, vhost, vport, realName] where + (+-+) :: B.ByteString -> [B.ByteString] -> B.ByteString + cmd +-+ args = B.append cmd (showArgs args) + infix 4 +-+ + formatJoins :: Map ChannelName (Maybe ChannelKey) -> (CommandArg, CommandArg) formatJoins channels = (chanList, keyList) @@ -140,6 +210,9 @@ M.keys withoutKey keyList = B.intercalate "," $ map (fromJust . snd) chanWithKeyAssocs + commaList :: Set CommandArg -> CommandArg + commaList = B.intercalate "," . S.toList + showArgs :: [CommandArg] -> MsgString showArgs [] = B.empty showArgs [arg] @@ -151,14 +224,12 @@ B.append (B.cons ' ' arg) (showArgs args) --- | Turn a 'Message' into a 'B.ByteString'. It will already contain --- \"\\r\\n\" and can be sent as is to the IRC server. +-- | Turn a 'Message' into a 'B.ByteString'. showMessage :: Message -> MsgString showMessage (Message origin cmd) = case origin of - Nothing -> B.append (showCommand cmd) "\r\n" + Nothing -> showCommand cmd Just o -> - B.concat [ ':' `B.cons` showUserSpec o, - ' ' `B.cons` showCommand cmd, - "\r\n" ] + B.append (':' `B.cons` showUserSpec o) + (' ' `B.cons` showCommand cmd) diff --git a/Network/FastIRC/ServerSet.hs b/Network/FastIRC/ServerSet.hs --- a/Network/FastIRC/ServerSet.hs +++ b/Network/FastIRC/ServerSet.hs @@ -2,8 +2,8 @@ -- Module: Network.FastIRC.ServerSet -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 --- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Maintainer: Ertugrul Soeylemez +-- Stability: alpha -- -- Functions for dealing with sets of IRC servers. Note that servers -- are compared case-insensitively. diff --git a/Network/FastIRC/Session.hs b/Network/FastIRC/Session.hs --- a/Network/FastIRC/Session.hs +++ b/Network/FastIRC/Session.hs @@ -1,33 +1,399 @@ +{-# LANGUAGE OverloadedStrings #-} + -- | -- Module: Network.FastIRC.Session -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 --- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Maintainer: Ertugrul Soeylemez +-- Stability: alpha -- --- This module implements the 'IRC' monad, which you can use to write --- IRC applications. +-- This module implements a framework for IRC client software. +-- Essentially it consists of a dumb bot, which connects to and stays on +-- an IRC server waiting for commands. -- --- This module is completely useless for now. +-- Using the 'onEvent' function (or the convenience functions +-- 'onConnect', 'onDisconnect', etc.) you can attach event handlers to +-- certain events. These event handlers are run in the 'Bot' monad, +-- which encapsulates the current state of the bot. +-- +-- Please note that even though unlikely you should expect that parts of +-- this interface will be changed in future revisions. module Network.FastIRC.Session - ( Config(..), - IRC + ( -- * Types + Bot, + BotCommand(..), + BotInfo(..), + BotSession, + Event(..), + EventHandler, + Params(..), + + -- * Functions + ircSendCmd, + ircSendMsg, + ircSendString, + onEvent, + sendBotCmd, + startBot, + + -- * Event utility functions + onConnect, + onDisconnect, + onError, + onLoggedIn, + onMessage, + onQuit, + + -- * Bot monad + getBotInfo ) where +import qualified Data.ByteString.Char8 as B +import qualified Data.Map as M +import Control.Applicative +import Control.Concurrent +import Data.Map (Map) +import Data.Unique import MonadLib +import Network.Fancy +import Network.FastIRC.IO +import Network.FastIRC.Messages import Network.FastIRC.ServerSet +import Network.FastIRC.Types +import System.IO --- | Session configuration. +-- | Bot monad. +type Bot = ContT () (StateT Config (ReaderT Params IO)) + + +-- | Commands to be sent to the bot. + +data BotCommand + -- | Add an event handler. + = BotAddHandler (EventHandler -> IO ()) (Event -> Bot ()) + | BotDispatch Event -- ^ Dispatch simulated event. + | BotError String -- ^ Simulate an error. + | BotQuit (Maybe CommandArg) -- ^ Send a quit message. + | BotRecv Message -- ^ Simulate receiving of a message. + | BotSendCmd Command -- ^ Send a command to the IRC server. + | BotSendMsg Message -- ^ Send a message to the IRC server. + | BotSendString MsgString -- ^ Send a raw string to the IRC server. + | BotTerminate -- ^ Immediately kill the bot. + + +-- | Runtime bot information. + +data BotInfo = + BotInfo { + botCurrentNick :: Maybe NickName + } + + +-- | Bot session descriptor. + +data BotSession = + BotSession { + botCmdChan :: Chan BotCommand -- ^ Command channel. + } + + +-- | Bot configuration at run-time. + data Config = Config { - cfgServers :: ServerSet + -- | Event handlers. + botEventHandlers :: Map EventHandler (Event -> Bot ()), + botEventChan :: Chan Event, -- ^ Event channel. + botHandle :: Handle, -- ^ Connection handle. + botInfo :: BotInfo, -- ^ Current information. + botIsQuitting :: Bool, -- ^ Quit command issued? + botKillerThread :: Maybe ThreadId, -- ^ Killer thread. + botServers :: ServerSet, -- ^ Nicknames known to be servers. + botSession :: BotSession -- ^ Session information. } --- | Monad for IRC sessions. +-- | A bot event. -type IRC = StateT Config IO +data Event + = ConnectedEvent -- ^ Bot connected. + | DisconnectedEvent -- ^ Bot disconnected (either error or on demand). + | ErrorEvent String -- ^ Connection failed or disconnected on error. + | LoggedInEvent -- ^ Bot logged in (received numeric 001). + | MessageEvent Message -- ^ Received message from server. + | QuitEvent -- ^ Bot disconnected on demand. + deriving (Eq, Read, Show) + + +-- | Event handler identifier. + +type EventHandler = Unique + + +-- | Parameters for an IRC client connection. + +data Params = + Params { + botGetNick :: IO NickName, -- ^ IRC nick name generator. + botGetUser :: IO UserName, -- ^ IRC user name generator. + botGetRealName :: IO RealName, -- ^ IRC real name generator. + botPassword :: Maybe CommandArg, -- ^ IRC server password. + botServerAddr :: Address -- ^ IRC server address. + } + + +-- | Core bot management thread. + +botManager :: Params -> Config -> IO () +botManager params cfg = do + -- Initialize bot. + let eventChan = botEventChan $ cfg + cmdChan = botCmdChan . botSession $ cfg + h = botHandle $ cfg + + writeChan eventChan ConnectedEvent + + dispatchThread <- forkIO $ + getChanContents eventChan >>= writeList2Chan cmdChan . map BotDispatch + + netThread <- forkIO $ networkHandler cmdChan (botHandle cfg) + + -- Main loop. + runBot params cfg $ do + sendLogin + forever $ do + bcmd <- inBase $ readChan cmdChan + case bcmd of + BotAddHandler reportId f -> do + hid <- inBase newUnique + handlers <- botEventHandlers <$> get + sets_ (\cfg -> cfg { botEventHandlers = M.insert hid f handlers }) + inBase $ reportId hid + + BotDispatch ev -> do + handlerList <- M.elems . botEventHandlers <$> get + mapM_ ($ ev) handlerList + + BotError err -> do + isQuitting <- botIsQuitting <$> get + unless isQuitting . inBase . writeChan eventChan $ ErrorEvent err + die + + BotQuit reason -> do + inBase $ hPutCommand h (QuitCmd reason) + ktid <- inBase . forkIO $ + threadDelay 1000000 >> + writeChan cmdChan BotTerminate + sets_ $ \cfg -> cfg { botIsQuitting = True, + botKillerThread = Just ktid } + + BotRecv msg -> + inBase (writeChan eventChan $ MessageEvent msg) >> + handleMsg msg + + BotSendCmd cmd -> inBase $ hPutCommand h cmd + BotSendMsg msg -> inBase $ hPutMessage h msg + BotSendString str -> inBase $ B.hPutStr h str + BotTerminate -> die + + -- Clean up. + killThread dispatchThread + killThread netThread + + where + networkHandler :: Chan BotCommand -> Handle -> IO () + networkHandler cmdChan h = do + res <- try $ hGetMessage h + case res of + Left err -> writeChan cmdChan $ BotError (show err) + Right msg -> + writeChan cmdChan (BotRecv msg) >> + networkHandler cmdChan h + + die :: Bot () + die = do + isQuitting <- botIsQuitting <$> get + ktidM <- botKillerThread <$> get + handlerList <- M.elems . botEventHandlers <$> get + when isQuitting $ mapM_ ($ QuitEvent) handlerList + case ktidM of + Just ktid -> inBase $ killThread ktid + Nothing -> return () + mapM_ ($ DisconnectedEvent) handlerList + abort () + + +-- | Default bot information. + +defBotInfo :: BotInfo +defBotInfo = + BotInfo { botCurrentNick = Nothing } + + +-- | Handle an incoming IRC message. + +handleMsg :: Message -> Bot () +handleMsg msg = do + h <- botHandle <$> get + let origin = msgOrigin msg + cmd = msgCommand msg + eventChan <- botEventChan <$> get + + case cmd of + NumericCmd 1 (myNick:_) -> do + inBase $ writeChan eventChan LoggedInEvent + sets_ $ \cfg -> let bi = (botInfo cfg) { botCurrentNick = Just myNick } + in cfg { botInfo = bi } + + PingCmd a b -> inBase $ hPutCommand h (PongCmd a b) + + _ -> return () + + +-- | Send a command to the IRC server. + +ircSendCmd :: BotSession -> Command -> IO () +ircSendCmd bs = sendBotCmd bs . BotSendCmd + + +-- | Send a message (with origin) to the IRC server. Note that IRC +-- servers ignore the origin prefix, so in general you would want to use +-- 'ircSendCmd' instead. + +ircSendMsg :: BotSession -> Message -> IO () +ircSendMsg bs = sendBotCmd bs . BotSendMsg + + +-- | Send a raw message string to the IRC server. This is what most IRC +-- clients call /quote. + +ircSendString :: BotSession -> MsgString -> IO () +ircSendString bs = sendBotCmd bs . BotSendString + + +-- | Add an event handler. + +onEvent :: BotSession -> (Event -> Bot ()) -> IO EventHandler +onEvent bs f = do + let cmdChan = botCmdChan bs + answerVar <- newEmptyMVar + writeChan cmdChan $ BotAddHandler (putMVar answerVar) f + takeMVar answerVar + + +-- | Run a 'Bot' monad computation. + +runBot :: Params -> Config -> Bot () -> IO () +runBot params cfg = + fmap fst . + runReaderT params . + runStateT cfg . + runContT return + + +-- | Send bot command to a bot. + +sendBotCmd :: BotSession -> BotCommand -> IO () +sendBotCmd bs cmd = writeChan (botCmdChan bs) cmd + + +-- | Send login commands. + +sendLogin :: Bot () +sendLogin = do + h <- botHandle <$> get + nick <- asks botGetNick >>= inBase + user <- asks botGetUser >>= inBase + real <- asks botGetRealName >>= inBase + addr <- asks botServerAddr + pass <- asks botPassword + let (host, port) = + case addr of + IP h p -> (B.pack h, B.pack $ show p) + IPv4 h p -> (B.pack h, B.pack $ show p) + IPv6 h p -> (B.pack h, B.pack $ show p) + _ -> ("localhost", "6667") + + inBase $ do + case pass of + Just pwd -> hPutCommand h $ PassCmd pwd + Nothing -> return () + + hPutCommand h $ NickCmd nick Nothing + hPutCommand h $ UserCmd user host port real + + +-- | Launch an IRC bot. + +startBot :: Params -> IO (Either IOError BotSession) +startBot params = do + cmdChan <- newChan + eventChan <- newChan + errorVar <- newEmptyMVar + let session = BotSession { botCmdChan = cmdChan } + + forkIO $ + let comp = + withStream (botServerAddr params) $ \h -> + let cfg = + Config { + botEventHandlers = M.empty, + botEventChan = eventChan, + botHandle = h, + botInfo = defBotInfo, + botIsQuitting = False, + botKillerThread = Nothing, + botServers = emptyServers, + botSession = session + } + in do + hSetBuffering h NoBuffering + putMVar errorVar Nothing + res <- try $ botManager params cfg + case res of + Left err -> do + hPutStrLn stderr "Warning (fastirc): unexpected exception:" + hPrint stderr err + hPutStrLn stderr "Please report this to the author." + Right _ -> return () + in comp `catch` (putMVar errorVar . Just) + + error <- takeMVar errorVar + case error of + Nothing -> return (Right session) + Just err -> return (Left err) + + +-- | Action to run on connect. +onConnect :: BotSession -> Bot () -> IO EventHandler +onConnect bs c = onEvent bs $ \ev -> case ev of ConnectedEvent -> c; _ -> return () + +-- | Action to run on disconnect. +onDisconnect :: BotSession -> Bot () -> IO EventHandler +onDisconnect bs c = onEvent bs $ \ev -> case ev of DisconnectedEvent -> c; _ -> return () + +-- | Action to run on error (connection failed/aborted). +onError :: BotSession -> (String -> Bot ()) -> IO EventHandler +onError bs f = onEvent bs $ \ev -> case ev of ErrorEvent str -> f str; _ -> return () + +-- | Action to run after login (numeric 001 received). +onLoggedIn :: BotSession -> Bot () -> IO EventHandler +onLoggedIn bs c = onEvent bs $ \ev -> case ev of LoggedInEvent -> c; _ -> return () + +-- | Action to run when a message arrives. +onMessage :: BotSession -> (Message -> Bot ()) -> IO EventHandler +onMessage bs f = onEvent bs $ \ev -> case ev of MessageEvent msg -> f msg; _ -> return () + +-- | Action to run on quit. +onQuit :: BotSession -> Bot () -> IO EventHandler +onQuit bs c = onEvent bs $ \ev -> case ev of QuitEvent -> c; _ -> return () + + +-- | Get current bot information. + +getBotInfo :: Bot BotInfo +getBotInfo = botInfo <$> get diff --git a/Network/FastIRC/Types.hs b/Network/FastIRC/Types.hs --- a/Network/FastIRC/Types.hs +++ b/Network/FastIRC/Types.hs @@ -3,7 +3,7 @@ -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Stability: alpha -- -- A number of convenient type aliases. @@ -16,7 +16,9 @@ HostName, MsgString, NickName, + RealName, ServerName, + TargetName, UserName ) where @@ -31,5 +33,7 @@ type HostName = B.ByteString type MsgString = B.ByteString type NickName = B.ByteString +type RealName = B.ByteString type ServerName = B.ByteString +type TargetName = B.ByteString type UserName = B.ByteString diff --git a/Network/FastIRC/Users.hs b/Network/FastIRC/Users.hs --- a/Network/FastIRC/Users.hs +++ b/Network/FastIRC/Users.hs @@ -2,20 +2,20 @@ -- Module: Network.FastIRC.Users -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 --- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Maintainer: Ertugrul Soeylemez +-- Stability: alpha -- -- This module includes parsers for IRC users. module Network.FastIRC.Users ( UserSpec(..), + userIsServer, showUserSpec, userParser ) where import qualified Data.ByteString.Char8 as B import Control.Applicative -import Control.Monad import Data.Attoparsec.Char8 as P import Network.FastIRC.ServerSet import Network.FastIRC.Types @@ -29,33 +29,31 @@ = Nick NickName -- | Nickname, username and hostname. | User NickName UserName HostName - -- | IRC server. - | Server ServerName deriving (Eq, Read, Show) +-- | Check whether a given nickname is a server. + +userIsServer :: UserSpec -> ServerSet -> Bool +userIsServer (User _ _ _) _ = False +userIsServer (Nick nick) servers = isServer nick servers + + -- | Turn a 'UserSpec' into a 'B.ByteString' in a format suitable to be -- sent to the IRC server. showUserSpec :: UserSpec -> MsgString showUserSpec (Nick n) = n showUserSpec (User n u h) = B.concat [ n, B.cons '!' u, B.cons '@' h ] -showUserSpec (Server sh) = sh -- | A 'Parser' for IRC users and servers. -userParser :: ServerSet -> Parser UserSpec -userParser servers = - try server <|> try full <|> nickOnly +userParser :: Parser UserSpec +userParser = + try full <|> nickOnly where - server :: Parser UserSpec - server = do - srv <- P.takeWhile1 isIRCTokChar - guard $ srv `isServer` servers - return (Server srv) - full :: Parser UserSpec full = User <$> P.takeWhile1 isNickChar <* char '!' diff --git a/Network/FastIRC/Utils.hs b/Network/FastIRC/Utils.hs --- a/Network/FastIRC/Utils.hs +++ b/Network/FastIRC/Utils.hs @@ -2,8 +2,8 @@ -- Module: Network.FastIRC.Utils -- Copyright: (c) 2010 Ertugrul Soeylemez -- License: BSD3 --- Maintainer: Ertugrul Soeylemez --- Stability: experimental +-- Maintainer: Ertugrul Soeylemez +-- Stability: alpha -- -- Utility functions for parsing IRC messages. diff --git a/fastirc.cabal b/fastirc.cabal --- a/fastirc.cabal +++ b/fastirc.cabal @@ -1,5 +1,5 @@ Name: fastirc -Version: 0.1.2 +Version: 0.2.0 Category: Network Synopsis: Fast Internet Relay Chat (IRC) library Package-URL: http://code.haskell.org/fastirc/ @@ -9,12 +9,12 @@ License: BSD3 License-file: LICENSE Build-type: Simple -Stability: experimental +Stability: alpha Cabal-version: >= 1.6 Description: Fast Internet Relay Chat (IRC) library. This library implements a - attoparsec-based fast parser for IRC messages as well as a (currently - yet nonexistent) network manager for servers and clients. + attoparsec-based fast parser for IRC messages as well as a network + manager for IRC clients (user agents and bots). Source-repository head Type: darcs @@ -28,12 +28,14 @@ bytestring >= 0.9.1.4, bytestring-show >= 0.3.3, containers >= 0.2.0.1, - monadLib >= 3.6.1 + monadLib >= 3.6.1, + network-fancy >= 0.1.4 GHC-Options: -W Extensions: OverloadedStrings Exposed-modules: Network.FastIRC + Network.FastIRC.IO Network.FastIRC.Messages Network.FastIRC.ServerSet Network.FastIRC.Session @@ -43,7 +45,7 @@ -- Executable test --- Build-depends: base >= 4 && < 5 +-- Build-depends: base >= 4 && < 5, network -- Main-is: Test.hs -- GHC-Options: -W -- Other-modules: