{- This file is part of irc-fun-bot. - - Written in 2015 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - . -} module Network.IRC.Fun.Bot.Internal.Chat ( disconnect --, reconnect , quit , run , login , pong , joinChannel , joinMulti , joinConfig , partChannel , partMulti , partAll , sendToUser , sendToChannel , sendBack , putIrc ) where import Control.Exception (bracket) import Control.Monad (liftM) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS (gets, runRWST) import Data.Char (isSpace) import Data.List (union) import Network.IRC.Fun.Bot.Internal.Persist import Network.IRC.Fun.Bot.Internal.State import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Client.Commands import Network.IRC.Fun.Client.IO (ircConnect, ircDisconnect, hPutIrc) import Network.IRC.Fun.Client.Time (currentTimeGetter) import Network.IRC.Fun.Messages.Types (Message) import qualified Data.HashSet as S (toList) ------------------------------------------------------------------------------- -- Connection Management ------------------------------------------------------------------------------- -- | Disconnect from IRC by closing the bot's side of the connection. This -- function is mainly provided for completeness and cases of error. You should -- probably use the QUIT command of IRC to quit the network in a manner -- coordinated with the server. -- -- After disconnection, make sure not to send more IRC commands. disconnect :: Session e s () disconnect = askHandle >>= liftIO . ircDisconnect -- Disconnect from the IRC server and connect again. This includes -- identifying with the bot's nickname and joining IRC channels. -- -- This operation closes the bot session. It opens a new one, and returns it. --botReconnect :: Session s (Session e s ()) --botReconnect = do -- disconnect -- | Finish the IRC session, asking the server to close the connection. quit :: Maybe String -- ^ Optional message, e.g. the reason for quitting -> Session e s () quit reason = do h <- askHandle liftIO $ ircQuit h reason ------------------------------------------------------------------------------- -- Session Management ------------------------------------------------------------------------------- -- Run a bot session computation runSession :: BotEnv e s -> BotState s -> Session e s a -> IO a runSession bot state session = do (a, _, _) <- runRWST session bot state return a -- | Connect to an IRC server and run the bot session run :: Config -- ^ IRC configuration -> Behavior e s -- ^ Bot behavior definition -> e -- ^ Custom bot environment (read-only state) -> s -- ^ Initial custom bot state -> Session e s a -- ^ Session definition -> IO a run conf beh env state session = do timeGetter <- currentTimeGetter save <- mkSaveBotState conf putStrLn "Bot: Connecting to IRC server" bracket (ircConnect $ connection conf) ircDisconnect (\ h -> do let botEnv = BotEnv conf beh h timeGetter save env putStrLn "Bot: Loading state from file" botState <- loadBotState botEnv state runSession botEnv botState session ) -- | Log in as an IRC user and identify with the bot's nickname and password. -- This is the first thing to do after 'botConnect'ing to the server. login :: Session e s () login = do h <- askHandle conn <- askConfigS connection liftIO $ ircLogin h conn False False -- | IRC servers send PING messages at regular intervals to test the presence -- of an active client, at least if no other activity is detected on the -- connection. The server closes the connection automatically if a PONG -- response isn't sent from the client within a certain amount of time. -- -- Therefore, an IRC client (both human users and bots) usually listens to -- these PINGs and sends back PONG messages. This function sends a PONG. The -- parameters should simply be the ones received in the PING message. pong :: String -- ^ Server name -> Maybe String -- ^ Optional server to forward to -> Session e s () pong server1 mserver2 = do h <- askHandle liftIO $ ircPong h server1 mserver2 ------------------------------------------------------------------------------- -- Channels ------------------------------------------------------------------------------- -- | Join an IRC channel. joinChannel :: String -- ^ Channel name -> Maybe String -- ^ Optional channel key (password) -> Session e s () joinChannel channel key = do h <- askHandle liftIO $ ircJoin h channel key -- | Join one or more IRC channels. joinMulti :: [(String, Maybe String)] -- ^ List of channels and optional keys -> Session e s () joinMulti channels = do h <- askHandle liftIO $ ircJoinMulti h channels -- | Join the IRC channels listed for joining in the persistent state and in -- the configuration, without leaving any other channels the bot already -- joined. joinConfig :: Session e s () joinConfig = do chansC <- askConfigS channels chansP <- liftM S.toList $ gets bsSelChans let chans = union chansC chansP joinMulti $ map (flip (,) Nothing) chans --TODO avoid unnecessary JOINs? -- | Leave an IRC channel. partChannel :: String -- ^ Channel name -> Maybe String -- ^ Optional part message, e.g. the reason for -- leaving -> Session e s () partChannel channel reason = do h <- askHandle liftIO $ ircPart h channel reason removeCurrChan channel -- | Leave one or more IRC channels. partMulti :: [String] -- ^ List of channel names -> Maybe String -- ^ Optional part message, e.g. the reason for -- leaving -> Session e s () partMulti chans reason = do h <- askHandle liftIO $ ircPartMulti h chans reason -- | Leave all IRC channels the bot joined. partAll :: Session e s () partAll = do askHandle >>= liftIO . ircPartAll clearCurrChans ------------------------------------------------------------------------------- -- Sending Messages ------------------------------------------------------------------------------- -- Split a string into N-sized substrings, whose concatenation is the original -- string. The last substring may be shorter than N. splitN :: Int -> String -> [String] splitN n s = case splitAt n s of (l, "") -> [l] (l, r) -> l : splitN n (dropWhile isSpace r) -- Split a message by newlines and possibly length. makeLines :: String -> Session e s [String] makeLines msg = do let ls = lines msg maybelen <- askConfigS maxMsgChars case maybelen of Nothing -> return ls Just maxlen -> return $ concatMap (splitN maxlen) ls -- | Send a message to an IRC channel. -- -- This usually requires that the bot joins the channel first, because many -- channels have the +n flag set. This flag forbids sending a messages into -- a channel from outside it. sendToChannel :: String -- ^ The channel name -> String -- ^ The message to send. It may contain newlines, in -- which case it will be split into multiple messages -- and sent sequentially. -> Session e s () sendToChannel channel msg = do h <- askHandle msgs <- makeLines msg liftIO $ mapM_ (ircSendToChannel h channel) msgs -- | Send a private message to an IRC user. sendToUser :: String -- ^ The user's nickname -> String -- ^ The message to send. It may contain newlines, in -- which case it will be split into multiple messages -- and sent sequentially. -> Session e s () sendToUser nick msg = do h <- askHandle msgs <- makeLines msg liftIO $ mapM_ (ircSendToUser h nick) msgs -- | Send a message back to the sender. If a channel is specified, send to the -- channel. If not, send a private message. sendBack :: Maybe String -- ^ Channel name, specify if replying to a message -- sent in a channel. Otherwise pass 'Nothing'. -> String -- ^ The sender user's nickname -> String -- ^ The message to send. It may contain newlines, in -- which case it will be split into multiple -- messages and sent sequentially. -> Session e s () sendBack (Just chan) _nick msg = sendToChannel chan msg sendBack Nothing nick msg = sendToUser nick msg ------------------------------------------------------------------------------- -- Other Utilities ------------------------------------------------------------------------------- -- | Send an IRC message to the server. This should only be used if the other -- wrappers don't provide what you need. If that's the case, it may be a good -- idea for reusability to add a new wrapper. putIrc :: Message -> Session e s () putIrc msg = do h <- askHandle liftIO $ hPutIrc h msg