diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + Version 2, December 2004 + + Copyright (C) 2004 Sam Hocevar + + Everyone is permitted to copy and distribute verbatim or modified + copies of this license document, and changing it is allowed as long + as the name is changed. + + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. You just DO WHAT THE FUCK YOU WANT TO. diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs new file mode 100644 --- /dev/null +++ b/Network/IRC/Client.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | A simple IRC client library. Typical usage will be of this form: +-- +-- > run :: ByteString -> Int -> Text -> IO () +-- > run host port nick = do +-- > conn <- connect host port 1 +-- > let cfg = defaultIRCConf nick +-- > let cfg' = cfg { _handlers = yourCustomEventHandlers : _handlers cfg } +-- > start conn cfg' +-- +-- You shouldn't really need to tweak anything other than the event +-- handlers, as everything has been designed to be as simple as +-- possible. +module Network.IRC.Client + ( -- * Initialisation + connect + , connectWithTLS + , start + , start' + + -- * Interaction + , send + , sendBS + , disconnect + + -- * Defaults + , defaultIRCConf + , defaultDisconnectHandler + , defaultEventHandlers + + -- * Types + , module Network.IRC.Client.Types + + -- * Utilities + , module Network.IRC.Client.Utils + , rawMessage + , toByteString + ) where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Reader (runReaderT) +import Data.ByteString (ByteString) +import Data.Text (Text) +import Data.Time.Clock (NominalDiffTime) +import Network.IRC.Client.Handlers +import Network.IRC.Client.Internal +import Network.IRC.Client.Types +import Network.IRC.Client.Utils +import Network.IRC.Conduit (ircClient, ircTLSClient, rawMessage, toByteString) + +-- * Connecting to an IRC network + +-- | Connect to a server without TLS. +connect :: MonadIO m => ByteString -> Int -> NominalDiffTime -> m ConnectionConfig +connect = connect' ircClient defaultDisconnectHandler + +-- | Connect to a server with TLS. +connectWithTLS :: MonadIO m => ByteString -> Int -> NominalDiffTime -> m ConnectionConfig +connectWithTLS = connect' ircTLSClient defaultDisconnectHandler + +-- * Starting + +-- | Run the event loop for a server, receiving messages and handing +-- them off to handlers as appropriate. Messages will be logged to +-- stdout. +start :: MonadIO m => ConnectionConfig -> InstanceConfig -> m () +start cconf iconf = newIRCState cconf iconf >>= start' + +-- | Like 'start', but use the provided initial state. +start' :: MonadIO m => IRCState -> m () +start' = liftIO . runReaderT runner + +-- * Default configuration + +-- | Construct a default IRC configuration from a nick +defaultIRCConf :: Text -> InstanceConfig +defaultIRCConf n = InstanceConfig + { _nick = n + , _username = n + , _realname = n + , _channels = [] + , _ctcpVer = "irc-client-0.2.3.0" + , _eventHandlers = defaultEventHandlers + , _ignore = [] + } diff --git a/Network/IRC/Client/Handlers.hs b/Network/IRC/Client/Handlers.hs new file mode 100644 --- /dev/null +++ b/Network/IRC/Client/Handlers.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | The default event handlers. Handlers are invoked concurrently +-- when matching events are received from the server. +module Network.IRC.Client.Handlers + ( -- * Event handlers + defaultEventHandlers + , pingHandler + , ctcpPingHandler + , ctcpVersionHandler + , ctcpTimeHandler + , welcomeNick + , nickMangler + + -- * Disconnect handlers + , defaultDisconnectHandler + ) where + +import Control.Applicative ((<$>)) +import Control.Arrow (first) +import Control.Concurrent.STM (atomically, readTVar, writeTVar) +import Control.Monad (unless) +import Control.Monad.IO.Class (liftIO) +import Data.Char (isAlphaNum) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import Data.Text (Text, breakOn, takeEnd, toUpper) +import Data.Time.Clock (getCurrentTime) +import Data.Time.Format (formatTime) +import Network.IRC.CTCP (fromCTCP) +import Network.IRC.Client.Types +import Network.IRC.Client.Utils +import Network.IRC.Client.Internal +import System.Locale (defaultTimeLocale) + +import qualified Data.Text as T + +-- * Event handlers + +-- | The default event handlers, the following are included: +-- +-- - respond to server @PING@ messages with a @PONG@; +-- - respond to CTCP @PING@ requests with a CTCP @PONG@; +-- - respond to CTCP @VERSION@ requests with the version string; +-- - respond to CTCP @TIME@ requests with the system time; +-- - update the nick upon receiving the welcome message, in case the +-- server modifies it; +-- - mangle the nick if the server reports a collision; +-- - update the channel list on @JOIN@ and @KICK@. +-- +-- These event handlers are all exposed through the +-- Network.IRC.Client.Handlers module, so you can use them directly if +-- you are building up your 'InstanceConfig' from scratch. +-- +-- If you are building a bot, you may want to write an event handler +-- to process messages representing commands. +defaultEventHandlers :: [EventHandler] +defaultEventHandlers = + [ EventHandler "Respond to server PING requests" EPing pingHandler + , EventHandler "Respond to CTCP PING requests" ECTCP ctcpPingHandler + , EventHandler "Respond to CTCP VERSION requests" ECTCP ctcpVersionHandler + , EventHandler "Respond to CTCP TIME requests" ECTCP ctcpTimeHandler + , EventHandler "Update the nick upon welcome" ENumeric welcomeNick + , EventHandler "Mangle the nick on collision" ENumeric nickMangler + , EventHandler "Update the channel list on JOIN" ENumeric joinHandler + , EventHandler "Update the channel lift on KICK" EKick kickHandler + ] + +-- | Respond to server @PING@ messages with a @PONG@. +pingHandler :: UnicodeEvent -> IRC () +pingHandler ev = case _message ev of + Ping s1 s2 -> send . Pong $ fromMaybe s1 s2 + _ -> return () + +-- | Respond to CTCP @PING@ requests with a CTCP @PONG@. +ctcpPingHandler :: UnicodeEvent -> IRC () +ctcpPingHandler = ctcpHandler [("PING", return)] + +-- | Respond to CTCP @VERSION@ requests with the version string. +ctcpVersionHandler :: UnicodeEvent -> IRC () +ctcpVersionHandler = ctcpHandler [("VERSION", go)] where + go _ = do + ver <- _ctcpVer <$> instanceConfig + return [ver] + +-- | Respond to CTCP @TIME@ requests with the system time. +ctcpTimeHandler :: UnicodeEvent -> IRC () +ctcpTimeHandler = ctcpHandler [("TIME", go)] where + go _ = do + now <- liftIO getCurrentTime + return [T.pack $ formatTime defaultTimeLocale "%c" now] + +-- | Update the nick upon welcome (numeric reply 001), as it may not +-- be what we requested (eg, in the case of a nick too long). +welcomeNick :: UnicodeEvent -> IRC () +welcomeNick = numHandler [(001, go)] where + go (srvNick:_) = do + tvarI <- instanceConfigTVar + + liftIO . atomically $ do + iconf <- readTVar tvarI + writeTVar tvarI iconf { _nick = srvNick } + go _ = return () + +-- | Mangle the nick if there's a collision (numeric replies 432, 433, +-- and 436) when we set it +nickMangler :: UnicodeEvent -> IRC () +nickMangler = numHandler [ (432, go fresh) + , (433, go mangle) + , (436, go mangle) + ] + where + go f (_:srvNick:_) = do + theNick <- _nick <$> instanceConfig + + -- If the length of our nick and the server's idea of our nick + -- differ, it was truncated - so calculate the allowable length. + let nicklen = if T.length srvNick /= T.length theNick + then Just $ T.length srvNick + else Nothing + + setNick . trunc nicklen $ f srvNick + go _ _ = return () + + fresh n = if T.length n' == 0 then "f" else n' + where n' = T.filter isAlphaNum n + + mangle n = (n <> "1") `fromMaybe` charsubst n + + -- Truncate a nick, if there is a known length limit. + trunc len txt = maybe txt (`takeEnd` txt) len + + -- List of substring substitutions. It's important that these + -- don't contain any loops! + charsubst = transform [ ("i", "1") + , ("I", "1") + , ("l", "1") + , ("L", "1") + , ("o", "0") + , ("O", "0") + , ("A", "4") + , ("0", "1") + , ("1", "2") + , ("2", "3") + , ("3", "4") + , ("4", "5") + , ("5", "6") + , ("6", "7") + , ("7", "8") + , ("8", "9") + , ("9", "-") + ] + + -- Attempt to transform some text by the substitutions. + transform ((from, to):trs) txt = case breakOn' from txt of + Just (before, after) -> Just $ before <> to <> after + _ -> transform trs txt + transform [] _ = Nothing + +-- | Upon receiving a channel topic (numeric reply 332), add the +-- channel to the list (if not already present). +joinHandler :: UnicodeEvent -> IRC () +joinHandler = numHandler [(332, go)] where + go (c:_) = do + tvarI <- instanceConfigTVar + + liftIO . atomically $ do + iconf <- readTVar tvarI + unless (c `elem` _channels iconf) $ + writeTVar tvarI iconf { _channels = c : _channels iconf } + + go _ = return () + +-- | Update the channel list upon being kicked. +kickHandler :: UnicodeEvent -> IRC () +kickHandler ev = do + theNick <- _nick <$> instanceConfig + tvarI <- instanceConfigTVar + + case (_source ev, _message ev) of + (Channel c _, Kick n _ _) | n == theNick -> liftIO . atomically $ delChan tvarI c + | otherwise -> return () + _ -> return () + +-- *Misc + +-- | The default disconnect handler: do nothing. You might want to +-- override this with one which reconnects. +defaultDisconnectHandler :: IRC () +defaultDisconnectHandler = return () + +-- *Utils + +-- | Match and handle a named CTCP +ctcpHandler :: [(Text, [Text] -> IRC [Text])] -> UnicodeEvent -> IRC () +ctcpHandler hs ev = case (_source ev, _message ev) of + (User n, Privmsg _ (Left ctcpbs)) -> + let (verb, xs) = first toUpper $ fromCTCP ctcpbs + in case lookup verb hs of + Just f -> do + args <- f xs + send $ ctcpReply n verb args + _ -> return () + _ -> return () + +-- | Match and handle a numeric reply +numHandler :: [(Int, [Text] -> IRC ())] -> UnicodeEvent -> IRC () +numHandler hs ev = case _message ev of + Numeric num xs -> maybe (return ()) ($xs) $ lookup num hs + _ -> return () + +-- | Break some text on the first occurrence of a substring, removing +-- the substring from the second portion. +breakOn' :: Text -> Text -> Maybe (Text, Text) +breakOn' delim txt = if T.length after >= T.length delim + then Just (before, T.drop (T.length delim) after) + else Nothing + where + (before, after) = breakOn delim txt diff --git a/Network/IRC/Client/Internal.hs b/Network/IRC/Client/Internal.hs new file mode 100644 --- /dev/null +++ b/Network/IRC/Client/Internal.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Most of the hairy code. This isn't all internal, due to messy +-- dependencies, but I've tried to make this as \"internal\" as +-- reasonably possible. +module Network.IRC.Client.Internal where + +import Control.Applicative ((<$>)) +import Control.Concurrent (forkIO) +import Control.Concurrent.STM (atomically, readTVar, retry) +import Control.Monad (unless) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Reader (runReaderT) +import Data.ByteString (ByteString) +import Data.Conduit (Producer, Conduit, Consumer, (=$=), ($=), (=$), awaitForever, toProducer, yield) +import Data.Conduit.TMChan (closeTBMChan, isEmptyTBMChan, newTBMChanIO, sourceTBMChan, writeTBMChan) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Time.Clock (NominalDiffTime, getCurrentTime) +import Data.Time.Format (formatTime) +import Network.IRC.Conduit (IrcEvent, IrcMessage, floodProtector, rawMessage, toByteString) +import Network.IRC.Client.Types +import System.Locale (defaultTimeLocale) + +-- * Connecting to an IRC network + +-- | Connect to a server using the supplied connection function. +connect' :: MonadIO m + => (Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ()) + -> IRC () + -> ByteString + -> Int + -> NominalDiffTime + -> m ConnectionConfig +connect' f dcHandler host port flood = liftIO $ do + queueS <- newTBMChanIO 16 + + return ConnectionConfig + { _func = f + , _sendqueue = queueS + , _server = host + , _port = port + , _flood = flood + , _disconnect = dcHandler + } + +-- * Event loop + +-- | The event loop. +runner :: IRC () +runner = do + state <- ircState + + -- Set the nick and username + theNick <- _nick <$> instanceConfig + theUser <- _username <$> instanceConfig + theReal <- _realname <$> instanceConfig + + -- Initialise the IRC session + let initialise = flip runReaderT state $ do + sendBS $ rawMessage "USER" [encodeUtf8 theUser, "-", "-", encodeUtf8 theReal] + send $ Nick theNick + mapM_ (send . Join) . _channels <$> instanceConfig + return () + + -- Run the event loop, and call the disconnect handler if the remote + -- end closes the socket. + flood <- _flood <$> connectionConfig + func <- _func <$> connectionConfig + port <- _port <$> connectionConfig + server <- _server <$> connectionConfig + queue <- _sendqueue <$> connectionConfig + + antiflood <- liftIO $ floodProtector flood + + dchandler <- _disconnect <$> connectionConfig + + let source = toProducer $ sourceTBMChan queue $= antiflood $= logConduit False toByteString + let sink = forgetful =$= logConduit True _raw =$ eventSink state + + liftIO $ func port server initialise sink source + + disconnect + dchandler + +-- | Forget failed decodings. +forgetful :: Monad m => Conduit (Either a b) m b +forgetful = awaitForever go where + go (Left _) = return () + go (Right b) = yield b + +-- | Block on receiving a message and invoke all matching handlers +-- concurrently. +eventSink :: MonadIO m => IRCState -> Consumer IrcEvent m () +eventSink ircstate = awaitForever $ \event -> do + let event' = decodeUtf8 <$> event + ignored <- isIgnored ircstate event' + unless ignored $ do + handlers <- getHandlersFor event' . _eventHandlers <$> getInstanceConfig' ircstate + liftIO $ mapM_ (\h -> forkIO $ runReaderT (h event') ircstate) handlers + +-- | Check if an event is ignored or not. +isIgnored :: MonadIO m => IRCState -> UnicodeEvent -> m Bool +isIgnored ircstate ev = do + iconf <- liftIO . atomically . readTVar . _instanceConfig $ ircstate + let ignoreList = _ignore iconf + + return $ + case _source ev of + User n -> (n, Nothing) `elem` ignoreList + Channel c n -> ((n, Nothing) `elem` ignoreList) || ((n, Just c) `elem` ignoreList) + Server _ -> False + +-- |Get the event handlers for an event. +getHandlersFor :: Event a -> [EventHandler] -> [UnicodeEvent -> IRC ()] +getHandlersFor e ehs = [_eventFunc eh | eh <- ehs, _matchType eh `elem` [EEverything, eventType e]] + +-- |A conduit which logs everything which goes through it. +logConduit :: MonadIO m => Bool -> (a -> ByteString) -> Conduit a m a +logConduit fromsrv f = awaitForever $ \x -> do + -- Print the log + liftIO $ do + now <- getCurrentTime + + putStrLn $ unwords [ formatTime defaultTimeLocale "%c" now + , if fromsrv then "<---" else "--->" + , init . tail . show $ f x + ] + + -- And pass the message on + yield x + +-- * Messaging + +-- | Send a message as UTF-8, using TLS if enabled. This blocks if +-- messages are sent too rapidly. +send :: UnicodeMessage -> IRC () +send = sendBS . fmap encodeUtf8 + +-- | Send a message, using TLS if enabled. This blocks if messages are +-- sent too rapidly. +sendBS :: IrcMessage -> IRC () +sendBS msg = do + queue <- _sendqueue <$> connectionConfig + liftIO . atomically $ writeTBMChan queue msg + +-- * Disconnecting + +-- | Disconnect from the server, properly tearing down the TLS session +-- (if there is one). +disconnect :: IRC () +disconnect = do + queueS <- _sendqueue <$> connectionConfig + + -- Wait for all messages to be sent + liftIO . atomically $ do + empty <- isEmptyTBMChan queueS + unless empty retry + + -- Then close the connection + disconnectNow + +-- | Disconnect immediately, without waiting for messages to be sent. +disconnectNow :: IRC () +disconnectNow = do + queueS <- _sendqueue <$> connectionConfig + liftIO . atomically $ closeTBMChan queueS diff --git a/Network/IRC/Client/Types.hs b/Network/IRC/Client/Types.hs new file mode 100644 --- /dev/null +++ b/Network/IRC/Client/Types.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE ImpredicativeTypes #-} + +-- | Types for IRC clients. See also +-- and +-- . +module Network.IRC.Client.Types + ( module Network.IRC.Client.Types + + -- * Re-exported + , Event(..) + , Source(..) + , Message(..) + ) where + +import Control.Applicative ((<$>)) +import Control.Concurrent.STM (TVar, atomically, readTVar, newTVar, writeTVar) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Reader (ReaderT, ask) +import Data.ByteString (ByteString) +import Data.Conduit (Consumer, Producer) +import Data.Conduit.TMChan (TBMChan) +import Data.Text (Text) +import Data.Time.Clock (NominalDiffTime) +import Network.IRC.Conduit (Event(..), Message(..), Source(..), IrcEvent, IrcMessage) + +-- *Type synonyms +type UnicodeEvent = Event Text +type UnicodeSource = Source Text +type UnicodeMessage = Message Text + +-- *State + +-- | The IRC monad. +type IRC a = ReaderT IRCState IO a + +data IRCState = IRCState { _connectionConfig :: ConnectionConfig + -- ^Read-only connection configuration + , _instanceConfig :: TVar InstanceConfig + -- ^Mutable instance configuration in STM + } + +-- | Construct a new IRC state +newIRCState :: MonadIO m => ConnectionConfig -> InstanceConfig -> m IRCState +newIRCState cconf iconf = do + tvar <- liftIO . atomically . newTVar $ iconf + + return IRCState + { _connectionConfig = cconf + , _instanceConfig = tvar + } + +-- | Access the entire state. +ircState :: IRC IRCState +ircState = ask + +-- | Extract the connection configuration from an IRC state +getConnectionConfig :: IRCState -> ConnectionConfig +getConnectionConfig = _connectionConfig + +-- | Extract the instance configuration from an IRC state +getInstanceConfig :: IRCState -> TVar InstanceConfig +getInstanceConfig = _instanceConfig + +-- | Extract the current snapshot of the instance configuration from +-- an IRC state +getInstanceConfig' :: MonadIO m => IRCState -> m InstanceConfig +getInstanceConfig' = liftIO . atomically . readTVar . _instanceConfig + +-- | Access the connection config +connectionConfig :: IRC ConnectionConfig +connectionConfig = _connectionConfig <$> ask + +-- | Access the instance config TVar +instanceConfigTVar :: IRC (TVar InstanceConfig) +instanceConfigTVar = _instanceConfig <$> ask + +-- | Access the instance config as it is right now. +instanceConfig :: IRC InstanceConfig +instanceConfig = instanceConfigTVar >>= liftIO . atomically . readTVar + +-- | Overwrite the instance config, even if it has changed since we +-- looked at it. +putInstanceConfig :: InstanceConfig -> IRC () +putInstanceConfig iconf = instanceConfigTVar >>= liftIO . atomically . flip writeTVar iconf + +-- | The static state of an IRC server connection. +data ConnectionConfig = ConnectionConfig + { _func :: Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO () + -- ^ Function to connect and start the conduits. + , _sendqueue :: TBMChan IrcMessage + -- ^ Message send queue. + , _server :: ByteString + -- ^ The server host. + , _port :: Int + -- ^ The server port. + , _flood :: NominalDiffTime + -- ^ The minimum time between two adjacent messages. + , _disconnect :: IRC () + -- ^ Action to run if the remote server closes the connection. + } + +-- | The updateable state of an IRC connection. +data InstanceConfig = InstanceConfig + { _nick :: Text + -- ^ Client nick + , _username :: Text + -- ^ Client username + , _realname :: Text + -- ^ Client realname + , _channels :: [Text] + -- ^ Current channels + , _ctcpVer :: Text + -- ^ Response to CTCP VERSION + , _eventHandlers :: [EventHandler] + -- ^ The registered event handlers + , _ignore :: [(Text, Maybe Text)] + -- ^ List of nicks (optionally restricted to channels) to ignore + -- messages from. No channel = global. + } + +-- *Events + +-- | Types of events which can be caught. +data EventType + = EEverything + -- ^ Match all events + | ENothing + -- ^ Match no events + | EPrivmsg | ENotice | ECTCP | ENick | EJoin | EPart | EQuit | EMode | ETopic | EInvite | EKick | EPing | ENumeric + deriving (Eq, Show) + +-- | A function which handles an event. +data EventHandler = EventHandler + { _description :: Text + -- ^ A description of the event handler. + , _matchType :: EventType + -- ^ Which type to be triggered by + , _eventFunc :: UnicodeEvent -> IRC () + -- ^ The function to call. + } + +-- | Get the type of an event. +eventType :: Event a -> EventType +eventType e = case _message e of + (Privmsg _ Right{}) -> EPrivmsg + (Privmsg _ Left{}) -> ECTCP + (Notice _ Right{}) -> ENotice + (Notice _ Left{}) -> ECTCP + + Nick{} -> ENick + Join{} -> EJoin + Part{} -> EPart + Quit{} -> EQuit + Mode{} -> EMode + Topic{} -> ETopic + Invite{} -> EInvite + Kick{} -> EKick + Ping{} -> EPing + Numeric{} -> ENumeric + + _ -> EEverything diff --git a/Network/IRC/Client/Utils.hs b/Network/IRC/Client/Utils.hs new file mode 100644 --- /dev/null +++ b/Network/IRC/Client/Utils.hs @@ -0,0 +1,54 @@ +-- |Commonly-used utility functions for IRC clients. +module Network.IRC.Client.Utils where + +import Control.Concurrent.STM (TVar, STM, atomically, readTVar, writeTVar) +import Control.Monad.IO.Class (liftIO) +import Data.Text (Text) +import Network.IRC.CTCP (toCTCP) +import Network.IRC.Client.Internal (send) +import Network.IRC.Client.Types + +-- | Update the nick in the instance configuration and also send an +-- update message to the server. This doesn't attempt to resolve nick +-- collisions, that's up to the event handlers. +setNick :: Text -> IRC () +setNick new = do + tvarI <- instanceConfigTVar + + liftIO . atomically $ do + iconf <- readTVar tvarI + writeTVar tvarI iconf { _nick = new } + + send $ Nick new + +-- | Update the channel list in the instance configuration and also +-- part the channel. +leaveChannel :: Text -> Maybe Text -> IRC () +leaveChannel chan reason = do + tvarI <- instanceConfigTVar + liftIO . atomically $ delChan tvarI chan + + send $ Part chan reason + +-- | Remove a channel from the list without sending a part command (be +-- careful not to let the channel list get out of sync with the +-- real-world state if you use it for anything!) +delChan :: TVar InstanceConfig -> Text -> STM () +delChan tvarI chan = do + iconf <- readTVar tvarI + writeTVar tvarI iconf { _channels = filter (/=chan) $ _channels iconf } + +-- | Send a message to the source of an event. +reply :: UnicodeEvent -> Text -> IRC () +reply ev txt = case _source ev of + Channel c _ -> send $ Privmsg c $ Right txt + User n -> send $ Privmsg n $ Right txt + _ -> return () + +-- | Construct a @PRIVMSG@ containing a CTCP +ctcp :: Text -> Text -> [Text] -> UnicodeMessage +ctcp t command args = Privmsg t . Left $ toCTCP command args + +-- | Construct a @NOTICE@ containing a CTCP +ctcpReply :: Text -> Text -> [Text] -> UnicodeMessage +ctcpReply t command args = Notice t . Left $ toCTCP command args diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/irc-client.cabal b/irc-client.cabal new file mode 100644 --- /dev/null +++ b/irc-client.cabal @@ -0,0 +1,104 @@ +-- Initial idte.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: irc-client + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.2.3.0 + +-- A short (one-line) description of the package. +synopsis: An IRC client library. + +-- A longer description of the package. +description: + An IRC client library built atop + . Why + another IRC client library, you cry? I didn't really find one that + did what I wanted (specifically, handle connecting to servers and + calling event handlers, possibly with TLS), but which didn't + implement almost a full IRC bot for you. That takes out all the fun! + . + and + are my + solution to the first part of that, this is my solution to the + latter. It's a simple IRC client library that does the basics for + you, but isn't an all-singing, all-dancing, fully-featured IRC + /application/. It is a merely a simple library. + +-- URL for the project homepage or repository. +homepage: https://github.com/barrucadu/irc-client + +-- URL where users should direct bug reports. +bug-reports: https://github.com/barrucadu/irc-client/issues + +-- The license under which the package is released. +license: OtherLicense + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Michael Walker + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: mike@barrucadu.co.uk + +-- A copyright notice. +-- copyright: + +category: Network + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +-- extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +library + -- Modules exported by the library. + exposed-modules: Network.IRC.Client + , Network.IRC.Client.Handlers + , Network.IRC.Client.Types + , Network.IRC.Client.Utils + + -- Modules included in this library but not exported. + other-modules: Network.IRC.Client.Internal + + -- Compile with -Wall by default + ghc-options: -Wall + -fno-warn-unused-do-bind + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base >=4.7 && <5 + , bytestring >=0.10 + , conduit >=1.2 + , data-default-class >=0.0.1 + , irc-conduit >=0.1 + , irc-ctcp >=0.1.2 + , stm >=2.4 + , stm-conduit >=2.5 + , text >=1.1 + , time >=1.4 + , transformers >=0.4 + , old-locale >=1.0 + + -- Directories containing source files. + -- hs-source-dirs: + + -- Base language which the package is written in. + default-language: Haskell2010 +