diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -3,6 +3,42 @@ +irc-fun-bot 0.2.0.0 -- 2015-09-10 +================================= + +General, build and documentation changes: + +* (None) + +New APIs, features and enhancements: + +* Nickname tracker with control API +* Channel logger with control API +* Persistent state using JSON files +* Bot events logged into a file now, not stdout +* Event sources have access to a logging API +* Support prefix-less bot commands +* Event matching control + +Bug fixes: + +* (None) + +Dependency changes: + +* Add aeson +* Add fast-logger +* Add settings +* Add time +* Add time-interval +* Add time-units +* Add unordered-containers +* Require irc-fun-client >= 0.1.1.0 + + + + + irc-fun-bot 0.1.0.0 -- 2015-08-09 ================================= diff --git a/irc-fun-bot.cabal b/irc-fun-bot.cabal --- a/irc-fun-bot.cabal +++ b/irc-fun-bot.cabal @@ -1,6 +1,6 @@ name: irc-fun-bot -version: 0.1.0.0 -synopsis: Very simple library for writing fun IRC bots. +version: 0.2.0.0 +synopsis: Library for writing fun IRC bots. description: One day an idea came up on the #freepost IRC channel: We didn't need much of the serious features IRC bots provide, but we could develop an IRC bot @@ -9,8 +9,9 @@ use, which is motivating when learning programming, and it's a chance to introduce Haskell to the community. . - And so, this library was started. The API is inspired by the @Irc@ package - and some other IRC client related packages. + This library powers FunBot (which at the time of writing runs under the + nickname /fpbot/ in Freenode) and its development is therefore driven by + actual bot needs. homepage: http://rel4tion.org/projects/irc-fun-bot/ bug-reports: http://rel4tion.org/projects/irc-fun-bot/tickets/ license: PublicDomain @@ -31,18 +32,34 @@ exposed-modules: Network.IRC.Fun.Bot , Network.IRC.Fun.Bot.Behavior , Network.IRC.Fun.Bot.Chat + , Network.IRC.Fun.Bot.EventMatch + , Network.IRC.Fun.Bot.IrcLog + , Network.IRC.Fun.Bot.Logger + , Network.IRC.Fun.Bot.Nicks , Network.IRC.Fun.Bot.State , Network.IRC.Fun.Bot.Types , Network.IRC.Fun.Bot.Util other-modules: Network.IRC.Fun.Bot.Internal.Chat , Network.IRC.Fun.Bot.Internal.Event , Network.IRC.Fun.Bot.Internal.Failure + , Network.IRC.Fun.Bot.Internal.IrcLog + , Network.IRC.Fun.Bot.Internal.Logger + , Network.IRC.Fun.Bot.Internal.Nicks + , Network.IRC.Fun.Bot.Internal.Persist , Network.IRC.Fun.Bot.Internal.State , Network.IRC.Fun.Bot.Internal.Types -- other-extensions: - build-depends: base >=4.7 && <5 - , irc-fun-client + build-depends: aeson + , base >=4.7 && <5 + , fast-logger + , irc-fun-client >=0.1.1.0 , irc-fun-messages - , transformers >=0.4.3 + , settings + , time + , time-interval + , time-units + , transformers >=0.4.3 + , unordered-containers hs-source-dirs: src default-language: Haskell2010 + ghc-options: -Wall diff --git a/src/Network/IRC/Fun/Bot.hs b/src/Network/IRC/Fun/Bot.hs --- a/src/Network/IRC/Fun/Bot.hs +++ b/src/Network/IRC/Fun/Bot.hs @@ -23,12 +23,16 @@ import Control.Concurrent (forkIO) import Control.Concurrent.Chan -import Control.Monad (forever) +import Control.Monad (forever, liftM, void) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS (ask) -import Network.IRC.Fun.Bot.Internal.Event (matchEvent, handleEvent) +import Data.List (transpose) +import Data.Maybe (catMaybes) +import Network.IRC.Fun.Bot.Internal.Event +import Network.IRC.Fun.Bot.Internal.Logger import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Bot.Chat (login, joinConfig, run) +import Network.IRC.Fun.Client.ChannelLogger (LogEvent, fromClientEvent) import Network.IRC.Fun.Client.Events (hGetIrcEvents) -- Get the bot ready for listening to IRC messages. @@ -40,33 +44,48 @@ joinConfig -- Wait for an IRC event, then handle it according to bot behavior definition. -listenToEvent :: Chan (Either Event a) -> EventHandler e s a -> Session e s () +listenToEvent :: Chan (Either (Either LogEvent Event) a) + -> EventHandler e s a + -> Session e s () listenToEvent chan handler = do event <- liftIO $ readChan chan either handleEvent handler event -- Collect IRC events from the server and push into a 'Chan' for the main -- thread to handle. -listenToIrc :: BotEnv e s -> Chan (Either Event a) -> IO () -listenToIrc bot chan = do +listenToIrc :: [EventMatcher e s] + -> BotEnv e s + -> Chan (Either (Either LogEvent Event) a) + -> IO () +listenToIrc ms bot chan = do + logger <- + newLogger (liftM snd $ getTime bot) (botEventLogFile $ config bot) putStrLn "Bot: IRC event source listening to IRC events" + let match e = matchEvent ms e (config bot) (commandSets $ behavior bot) forever $ do ircEvents <- hGetIrcEvents $ handle bot - let match e = matchEvent e (config bot) (commandSets $ behavior bot) - botEvents = map match ircEvents - mapM_ print botEvents - writeList2Chan chan $ map Left botEvents + let botEvents = map match ircEvents + logEvents = catMaybes $ map fromClientEvent ircEvents + interleave l1 l2 = concat $ transpose [map Left l1, map Right l2] + mapM_ (logLine logger . show) botEvents + writeList2Chan chan $ map Left $ interleave logEvents botEvents -- Connect, login, join. Then listen to events and handle them, forever. -botSession :: [EventSource e s a] -> EventHandler e s a -> Session e s () -botSession sources handler = do +botSession :: [EventMatcher e s] + -> [EventSource e s a] + -> EventHandler e s a + -> Session e s () + -> Session e s () +botSession matchers sources handler actInit = do + actInit chan <- liftIO newChan bot <- ask - liftIO $ forkIO $ listenToIrc bot chan + liftIO $ void $ forkIO $ listenToIrc matchers bot chan let launch s = forkIO $ s (config bot) (custom bot) (writeChan chan . Right) (writeList2Chan chan . map Right) + (newLogger $ liftM snd $ getTime bot) liftIO $ mapM_ launch sources startBot liftIO $ putStrLn "Bot: Event sink listening to events" @@ -76,13 +95,16 @@ -- the IRC server and other provided sources, and will respond according to the -- behavior definitions. runBot :: Config -- ^ IRC connection configuration + -> [EventMatcher e s] -- ^ Event detection (high-to-low priority) -> Behavior e s -- ^ Behavior definition for IRC events -> [EventSource e s a] -- ^ Additional event source threads to run -> EventHandler e s a -- ^ Handler for events coming from those sources -> e -- ^ Custom bot environment (read-only state) -> s -- ^ Initial state to hold in the background + -> Session e s () -- ^ Initialization action to run at the very + -- beginning of the session -> IO () -runBot conf behavior sources handler env state = do +runBot conf matchers behav sources handler env state actInit = do putStrLn "Bot: Starting" - run conf behavior env state $ botSession sources handler + run conf behav env state $ botSession matchers sources handler actInit putStrLn "Bot: Disconnected" diff --git a/src/Network/IRC/Fun/Bot/Behavior.hs b/src/Network/IRC/Fun/Bot/Behavior.hs --- a/src/Network/IRC/Fun/Bot/Behavior.hs +++ b/src/Network/IRC/Fun/Bot/Behavior.hs @@ -35,7 +35,7 @@ import Data.Char (toLower) import Data.List (find, isInfixOf) import Network.IRC.Fun.Bot.Types -import Network.IRC.Fun.Bot.Util (maybeQuote, showNames) +import Network.IRC.Fun.Bot.Util (showNames) ------------------------------------------------------------------------------- -- Defining diff --git a/src/Network/IRC/Fun/Bot/EventMatch.hs b/src/Network/IRC/Fun/Bot/EventMatch.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/EventMatch.hs @@ -0,0 +1,53 @@ +{- 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 + - . + -} + +-- | You can control both the detection and the handling of events coming from +-- the IRC server. This module provides tools for defining event detection +-- rules. For example, should your bot take commands through messages in IRC +-- channels, or in private messages, or both, or perhaps none? +-- +-- In addition to the event matchers given here, you can easily write your own +-- custom matchers. +-- +-- Event matchers with a @C@ prefix are handle only channel events. +-- Event matchers with a @P@ prefix are handle only private message events. +-- +-- The 'defaultMatch' matcher matches some essential events, such as pings, and +-- you should probably use it in your matcher list (e.g. as the last item). +module Network.IRC.Fun.Bot.EventMatch + ( matchPrefixedCommandC + , matchPrefixedCommandP + , matchPrefixedCommand + , matchRefCommandC + , matchRefCommandP + , matchRefCommand + , matchRefCommandFromSetC + , matchRefCommandFromSetP + , matchRefCommandFromSet + , matchRefCommandFromNamesC + , matchRefCommandFromNamesP + , matchRefCommandFromNames + , matchPlainPrivateCommand + , matchNoticeC + , matchNoticeP + , matchNotice + , matchRefC + , matchRefP + , matchRef + , defaultMatch + ) +where + +import Network.IRC.Fun.Bot.Internal.Event diff --git a/src/Network/IRC/Fun/Bot/Internal/Chat.hs b/src/Network/IRC/Fun/Bot/Internal/Chat.hs --- a/src/Network/IRC/Fun/Bot/Internal/Chat.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Chat.hs @@ -35,10 +35,12 @@ import Control.Exception (bracket) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS (runRWST) +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) ------------------------------------------------------------------------------- @@ -87,11 +89,18 @@ -> 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 -> runSession (BotEnv conf beh h env) (BotState state) session) + (\ 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. diff --git a/src/Network/IRC/Fun/Bot/Internal/Event.hs b/src/Network/IRC/Fun/Bot/Internal/Event.hs --- a/src/Network/IRC/Fun/Bot/Internal/Event.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Event.hs @@ -14,101 +14,414 @@ -} module Network.IRC.Fun.Bot.Internal.Event - ( matchEvent + ( matchPrefixedCommandC + , matchPrefixedCommandP + , matchPrefixedCommand + , matchRefCommandC + , matchRefCommandP + , matchRefCommand + , matchRefCommandFromSetC + , matchRefCommandFromSetP + , matchRefCommandFromSet + , matchRefCommandFromNamesC + , matchRefCommandFromNamesP + , matchRefCommandFromNames + , matchPlainPrivateCommand + , matchNoticeC + , matchNoticeP + , matchNotice + , matchRefC + , matchRefP + , matchRef + , defaultMatch + , matchEvent , handleEvent ) where -import Data.Char (isSpace) -import Data.List (find, isPrefixOf) -import Network.IRC.Fun.Bot.Internal.Chat (pong) -import Network.IRC.Fun.Bot.Internal.Failure (defaultRespondToChan) -import Network.IRC.Fun.Bot.Internal.State (askBehavior, askBehaviorS) -import Network.IRC.Fun.Bot.Internal.Types -import Network.IRC.Fun.Bot.Behavior (findCmd) +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.RWS +import Data.Char (isSpace) +import qualified Data.HashMap.Lazy as M +import Data.Maybe (catMaybes, fromMaybe, maybeToList) +import Data.List (stripPrefix) +import Network.IRC.Fun.Bot.Internal.Chat (pong) +import Network.IRC.Fun.Bot.Internal.Failure (defaultRespondToChan) +import Network.IRC.Fun.Bot.Internal.Nicks +import Network.IRC.Fun.Bot.Internal.State (askBehavior, askBehaviorS) +import Network.IRC.Fun.Bot.Internal.Types hiding (Logger) +import Network.IRC.Fun.Bot.Behavior (findCmd, findCmdInSet) +import Network.IRC.Fun.Client.ChannelLogger hiding (LogEvent (..)) +import qualified Network.IRC.Fun.Client.ChannelLogger as L import qualified Network.IRC.Fun.Client.Events as C (Event (..)) -import Network.IRC.Fun.Client.IO (nick) -import Network.IRC.Fun.Client.Util (mentions) +import Network.IRC.Fun.Client.IO (nick) +import Network.IRC.Fun.Client.Util (mentions) -matchEvent :: C.Event -> Config -> [CommandSet e s] -> Event -matchEvent event conf csets = +------------------------------------------------------------------------------- +-- Make Events +------------------------------------------------------------------------------- + +detectRef :: Config -> String -> Maybe String +detectRef conf msg = + let bnick = nick (connection conf) + dw = Just . dropWhile isSpace + in case stripPrefix bnick msg of + Nothing -> Nothing + Just (',' : s) -> dw s + Just (':' : s) -> dw s + Just (';' : s) -> dw s + Just (c : s) -> if isSpace c then dw s else Nothing + Just s -> dw s + +mkCmd :: String -> (String, [String]) +mkCmd message = + let w = words message + name = if null w then "" else head w + args = if null w then [] else tail w + in (name, args) + +makePrefixedCommand :: [CommandSet e s] + -> MessageSource + -> Char + -> String + -> Maybe Event +makePrefixedCommand csets src pref msg = + if pref `elem` map prefix csets + then + let (name, args) = mkCmd msg + in Just $ BotCommand src (Just pref) name args + else Nothing + +makeRefCommand :: Config + -> MessageSource + -> String + -> Maybe Event +makeRefCommand conf src msg = + case detectRef conf msg of + Just s -> + let (name, args) = mkCmd s + in Just $ BotCommand src Nothing name args + Nothing -> Nothing + +makeRefCommandFromSet :: Config + -> CommandSet e s + -> MessageSource + -> String + -> Maybe Event +makeRefCommandFromSet conf cset = + makeRefCommandFromNames conf (concatMap names $ commands cset) + +makeRefCommandFromNames :: Config + -> [String] + -> MessageSource + -> String + -> Maybe Event +makeRefCommandFromNames conf names src msg = + case detectRef conf msg of + Just s -> + let (name, args) = mkCmd s + in if name `elem` names + then Just $ BotCommand src Nothing name args + else Nothing + Nothing -> Nothing + +makePlainCommand :: MessageSource + -> String + -> Maybe Event +makePlainCommand src msg = + let (name, args) = mkCmd msg + in Just $ BotCommand src Nothing name args + +makeRefC :: Config -> String -> String -> String -> Maybe Event +makeRefC conf chan nick msg = + case detectRef conf msg of + Just s -> Just $ BotMessage chan nick s + Nothing -> Nothing + +makeRefP :: Config -> String -> String -> Maybe Event +makeRefP conf nick msg = + case detectRef conf msg of + Just s -> Just $ PersonalMessage nick s + Nothing -> Nothing + +------------------------------------------------------------------------------- +-- Match Events +------------------------------------------------------------------------------- + +matchPrefixedCommandC :: EventMatcher e s +matchPrefixedCommandC event _conf csets = case event of - C.Ping server1 server2 -> Ping server1 server2 - C.Kick channel nicks reason -> Kick channel nicks reason - C.Join channel nick -> Join channel nick - C.Part channel nick reason -> Part channel nick reason - C.Quit nick reason -> Quit nick reason - C.Mode -> other - C.ChannelMessage channel nick msg False - | not (null msg) && head msg `elem` map prefix csets -> - let w = words $ tail msg - in BotCommand channel nick (head msg) - (if null w then "" else head w) - (if null w then [] else tail w) - | bnick `isPrefixOf` msg -> - let msg' = drop (length bnick) msg - msg'' = - if null msg' - then [] - else dropWhile isSpace $ tail msg' - in if null msg' || head msg' `elem` ",:" - then BotMessage channel nick msg'' - else Message channel nick msg $ msg `mentions` bnick - | otherwise -> - Message channel nick msg $ msg `mentions` bnick - C.ChannelMessage channel nick msg True -> - Notice (Just channel) nick msg - C.PrivateMessage nick msg False -> PersonalMessage nick msg - C.PrivateMessage nick msg True -> Notice Nothing nick msg - C.Topic channel nick topic -> - TopicChange channel nick topic - C.Invite channel nick -> other - C.Names priv chan pnicks -> Names chan priv pnicks - C.OtherEvent s -> other + C.ChannelMessage chan nick (c:cs) False -> + makePrefixedCommand csets (Channel chan nick) c cs + _ -> Nothing + +matchPrefixedCommandP :: EventMatcher e s +matchPrefixedCommandP event _conf csets = + case event of + C.PrivateMessage nick (c:cs) False -> + makePrefixedCommand csets (User nick) c cs + _ -> Nothing + +matchPrefixedCommand :: EventMatcher e s +matchPrefixedCommand event _conf csets = + case event of + C.ChannelMessage chan nick (c:cs) False -> + makePrefixedCommand csets (Channel chan nick) c cs + C.PrivateMessage nick (c:cs) False -> + makePrefixedCommand csets (User nick) c cs + _ -> Nothing + +matchRefCommandC :: EventMatcher e s +matchRefCommandC event conf _csets = + case event of + C.ChannelMessage chan nick msg False -> + makeRefCommand conf (Channel chan nick) msg + _ -> Nothing + +matchRefCommandP :: EventMatcher e s +matchRefCommandP event conf _csets = + case event of + C.PrivateMessage nick msg False -> + makeRefCommand conf (User nick) msg + _ -> Nothing + +matchRefCommand :: EventMatcher e s +matchRefCommand event conf _csets = + case event of + C.ChannelMessage chan nick msg False -> + makeRefCommand conf (Channel chan nick) msg + C.PrivateMessage nick msg False -> + makeRefCommand conf (User nick) msg + _ -> Nothing + +matchRefCommandFromSetC :: EventMatcher e s +matchRefCommandFromSetC _ _ [] = Nothing +matchRefCommandFromSetC event conf (cset:_) = + case event of + C.ChannelMessage chan nick msg False -> + makeRefCommandFromSet conf cset (Channel chan nick) msg + _ -> Nothing + +matchRefCommandFromSetP :: EventMatcher e s +matchRefCommandFromSetP _ _ [] = Nothing +matchRefCommandFromSetP event conf (cset:_) = + case event of + C.PrivateMessage nick msg False -> + makeRefCommandFromSet conf cset (User nick) msg + _ -> Nothing + +matchRefCommandFromSet :: EventMatcher e s +matchRefCommandFromSet _ _ [] = Nothing +matchRefCommandFromSet event conf (cset:_) = + case event of + C.ChannelMessage chan nick msg False -> + makeRefCommandFromSet conf cset (Channel chan nick) msg + C.PrivateMessage nick msg False -> + makeRefCommandFromSet conf cset (User nick) msg + _ -> Nothing + +matchRefCommandFromNamesC :: [String] -> EventMatcher e s +matchRefCommandFromNamesC names event conf _csets = + case event of + C.ChannelMessage chan nick msg False -> + makeRefCommandFromNames conf names (Channel chan nick) msg + _ -> Nothing + +matchRefCommandFromNamesP :: [String] -> EventMatcher e s +matchRefCommandFromNamesP names event conf _csets = + case event of + C.PrivateMessage nick msg False -> + makeRefCommandFromNames conf names (User nick) msg + _ -> Nothing + +matchRefCommandFromNames :: [String] -> EventMatcher e s +matchRefCommandFromNames names event conf _csets = + case event of + C.ChannelMessage chan nick msg False -> + makeRefCommandFromNames conf names (Channel chan nick) msg + C.PrivateMessage nick msg False -> + makeRefCommandFromNames conf names (User nick) msg + _ -> Nothing + +matchPlainPrivateCommand :: EventMatcher e s +matchPlainPrivateCommand event _conf _csets = + case event of + C.PrivateMessage nick msg False -> + makePlainCommand (User nick) msg + _ -> Nothing + +matchNoticeC :: EventMatcher e s +matchNoticeC event _conf _csets = + case event of + C.ChannelMessage chan nick msg True -> + Just $ Notice (Just chan) nick msg + _ -> Nothing + +matchNoticeP :: EventMatcher e s +matchNoticeP event _conf _csets = + case event of + C.PrivateMessage nick msg True -> + Just $ Notice Nothing nick msg + _ -> Nothing + +matchNotice :: EventMatcher e s +matchNotice event _conf _csets = + case event of + C.ChannelMessage chan nick msg True -> + Just $ Notice (Just chan) nick msg + C.PrivateMessage nick msg True -> + Just $ Notice Nothing nick msg + _ -> Nothing + +matchRefC :: EventMatcher e s +matchRefC event conf _csets = + case event of + C.ChannelMessage chan nick msg False -> makeRefC conf chan nick msg + _ -> Nothing + +matchRefP :: EventMatcher e s +matchRefP event conf _csets = + case event of + C.PrivateMessage nick msg False -> makeRefP conf nick msg + _ -> Nothing + +matchRef :: EventMatcher e s +matchRef event conf _csets = + case event of + C.ChannelMessage chan nick msg False -> makeRefC conf chan nick msg + C.PrivateMessage nick msg False -> makeRefP conf nick msg + _ -> Nothing + +defaultMatch :: EventMatcher e s +defaultMatch event conf csets = + case event of + C.Ping server1 server2 -> Just $ Ping server1 server2 + C.Kick channel nicks reason -> Just $ Kick channel nicks reason + C.Join channel nick -> Just $ Join channel nick + C.Part channel nick reason -> Just $ Part channel nick reason + C.Quit nick reason -> Just $ Quit nick reason + C.ChannelMessage channel nick msg False -> + Just $ Message channel nick msg $ msg `mentions` bnick + C.PrivateMessage nick msg False -> Just $ PersonalMessage nick msg + C.Topic channel nick topic -> Just $ TopicChange channel nick topic + C.Names priv chan pnicks -> Just $ Names chan priv pnicks + _ -> Nothing where bnick = nick (connection conf) - other = OtherEvent $ show event +combineMatchers :: [EventMatcher e s] -> EventMatcher e s +combineMatchers [] _event _conf _csets = Nothing +combineMatchers (m:ms) event conf csets = + case m event conf csets of + ev@(Just _) -> ev + Nothing -> combineMatchers ms event conf csets + +applyMatchers :: [EventMatcher e s] + -> C.Event + -> Config + -> [CommandSet e s] + -> Event +applyMatchers ms event conf csets = + fromMaybe (OtherEvent $ show event) $ combineMatchers ms event conf csets + +matchEvent :: [EventMatcher e s] + -> C.Event + -> Config + -> [CommandSet e s] + -> Event +matchEvent = applyMatchers + +findCommand :: Maybe Char + -> String + -> [CommandSet e s] + -> Maybe (Either (CommandSet e s) (Command e s)) +findCommand (Just cpref) cname csets = findCmd cpref cname csets +findCommand Nothing _ [] = Nothing +findCommand Nothing cname (cset:_) = + Just $ maybe (Left cset) Right $ findCmdInSet cname cset + -- Run the command with the given prefix character, command name and list of -- parameters. If a command with the given prefix and name isn't found, the bot -- sends a default friendly response. -runCommand :: Char -- Command prefix - -> String -- Command name - -> [String] -- List of parameters - -> String -- Channel in which the command was triggered - -> String -- Nickname of user who triggered the command +runCommand :: Maybe Char -- Command prefix, 'Nothing' picks the default prefix + -> String -- Command name + -> [String] -- List of parameters + -> String -- Channel in which the command was triggered + -> String -- Nickname of user who triggered the command -> Session e s () runCommand cpref cname cparams channel sender = do csets <- askBehaviorS commandSets - case findCmd cpref cname csets of + case findCommand cpref cname csets of Nothing -> defaultRespondToChan channel cpref cname Nothing Just (Left cset) -> - defaultRespondToChan channel cpref cname (Just cset) + defaultRespondToChan channel (Just $ prefix cset) cname (Just cset) Just (Right cmd) -> respond cmd channel sender cparams --- | React to an IRC event. -handleEvent :: Event -> Session e s () -handleEvent event = do +-- React to a bot event. +handleBotEvent :: Event -> Session e s () +handleBotEvent event = do b <- askBehavior case event of - Ping s1 s2 -> pong s1 s2 - Kick chan users why -> return () - Join chan nick -> handleJoin b chan nick - Part chan nick why -> handlePart b chan nick why - Quit nick why -> handleQuit b nick why - Message chan sender msg mentioned -> + Ping s1 s2 -> pong s1 s2 + Kick chan users why -> return () + Join chan nick -> do + tracked <- channelIsTracked chan + when tracked $ addMember chan nick + handleJoin b chan nick + Part chan nick why -> do + tracked <- channelIsTracked chan + when tracked $ removeMemberOnce chan nick + handlePart b chan nick why + Quit nick why -> do + removeMember nick + handleQuit b nick why + Message chan sender msg mentioned -> handleMsg b chan sender msg mentioned - Notice mchan sender msg -> return () - BotMessage chan sender msg -> - handleBotMsg b chan sender msg - BotCommand chan sender cpref cname cargs -> + Notice mchan sender msg -> return () + BotMessage chan sender msg -> handleBotMsg b chan sender msg + BotCommand (Channel chan sender) cpref cname cargs -> runCommand cpref cname cargs chan sender - PersonalMessage sender msg -> - handlePersonalMsg b sender msg - TopicChange chan nick topic -> - handleTopicChange b chan nick topic - Names chan priv pnicks -> + BotCommand _ _ _ _ -> return () + PersonalMessage sender msg -> handlePersonalMsg b sender msg + TopicChange chan nick topic -> handleTopicChange b chan nick topic + Names chan priv pnicks -> do + tracked <- channelIsTracked chan + let nicks = map snd pnicks + when tracked $ addChannel chan nicks handleNames b chan priv pnicks - OtherEvent s -> return () + OtherEvent s -> return () + +-- Using nick tracking and logging state, determine from a general log event a +-- set of channel loggers and channel-specific log events to write into them. +detectLogEvents :: L.LogEvent -> Session e s [(Logger, ChanLogEvent)] +detectLogEvents e = + let detect event cstate = fmap (\ cl -> (cl, event)) $ chanLogger cstate + detectOne chan event = do + cstates <- gets chanstate + return $ maybeToList $ M.lookup chan cstates >>= detect event + detectMany nick event = do + chans <- presence nick + cstates <- gets chanstate + let cstatesP = + cstates `M.difference` M.fromList (zip chans (repeat ())) + return $ catMaybes $ map (detect event) $ M.elems cstatesP + in case e of + L.Enter nick chan -> detectOne chan $ EnterChan nick + L.Leave nick chan -> detectOne chan $ LeaveChan nick + L.LeaveAll nick -> detectMany nick $ LeaveChan nick + L.Message nick chan msg -> detectOne chan $ MessageChan nick msg + L.Rename oldN newN -> detectMany oldN $ RenameInChan oldN newN + +-- Possibly write a log event into the right file(s), according to logging +-- settings. +handleLogEvent :: L.LogEvent -> Session e s () +handleLogEvent e = do + l <- detectLogEvents e + liftIO $ mapM_ (\ (logger, event) -> logEvent logger event) l + +-- | Handle a bot event, or log a log event into a file. +handleEvent :: Either L.LogEvent Event -> Session e s () +handleEvent = either handleLogEvent handleBotEvent diff --git a/src/Network/IRC/Fun/Bot/Internal/Failure.hs b/src/Network/IRC/Fun/Bot/Internal/Failure.hs --- a/src/Network/IRC/Fun/Bot/Internal/Failure.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Failure.hs @@ -32,18 +32,20 @@ -- This assumes the same response is set both to channels and to users in -- private conversations, which could change in the future. Right now only -- channel commands are supported by the bot anyway. -defaultResponse :: Char -- Command prefix that was triggered +defaultResponse :: Maybe Char -- Command prefix that was triggered -> String -- Command name that was triggered -> [CommandSet e s] -- Available command sets -> Maybe (CommandSet e s) -- The command set matching the -- prefix, if one was found -> String -defaultResponse cpref _cname csets Nothing = +defaultResponse Nothing _cname csets _ = + "Expected to find a default command prefix, but there’s none." +defaultResponse (Just cpref) _cname csets Nothing = printf "Expected to find a command with prefix ‘%v’, but there’s none. \ \Available prefixes are: ‘%v’." cpref $ intercalate "’, ‘" $ map ((: []) . prefix) csets -defaultResponse cpref cname _csets (Just cset) = +defaultResponse (Just cpref) cname _csets (Just cset) = printf "The command ‘%v%v’ isn’t available. Available commands for prefix \ \‘%v’ are: ‘%v’." cpref @@ -54,7 +56,7 @@ -- | Send the default response to an IRC channel defaultRespondToChan :: String -- Target channel - -> Char -- Command prefix that was triggered + -> Maybe Char -- Command prefix that was triggered -> String -- Command name that was triggered -> Maybe (CommandSet e s) -- The command set matching the prefix, is one -- was found @@ -66,7 +68,7 @@ -- | Send the default response to an IRC user defaultRespondToUser :: String -- Recipient nickname - -> Char -- Command prefix that was triggered + -> Maybe Char -- Command prefix that was triggered -> String -- Command name that was triggered -> Maybe (CommandSet e s) -- The command set matching the prefix, is one -- was found diff --git a/src/Network/IRC/Fun/Bot/Internal/IrcLog.hs b/src/Network/IRC/Fun/Bot/Internal/IrcLog.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/IrcLog.hs @@ -0,0 +1,119 @@ +{- 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.IrcLog + ( makeLogger + , channelIsLogged + , startLoggingAll + , startLoggingChannel + , startLoggingChannels + , stopLoggingAll + , stopLoggingChannel + , stopLoggingChannels + ) +where + +import Control.Monad (liftM) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.RWS (ask) +import qualified Data.HashMap.Lazy as M +import Data.Maybe (isJust) +import Data.Traversable (traverse) +import Network.IRC.Fun.Bot.Internal.State +import Network.IRC.Fun.Bot.Internal.Types hiding (Logger) +import Network.IRC.Fun.Client.ChannelLogger + +makeLogger :: BotEnv e s -> String -> IO Logger +makeLogger env chan = + let timeGetter = getTime env + logdir = logDir $ config env + file = logFilePath logdir "server" chan + in newLogger (liftM snd timeGetter) file + +enable :: String -> ChannelState -> Session e s ChannelState +enable chan cstate = + if isJust $ chanLogger cstate + then return cstate + else do + env <- ask + logger <- liftIO $ makeLogger env chan + return cstate { chanLogger = Just logger } + +disable :: ChannelState -> Session e s ChannelState +disable cstate = + case chanLogger cstate of + Just logger -> do + liftIO $ removeLogger logger + return cstate { chanLogger = Nothing } + Nothing -> return cstate + +-- | Check whether a given channel is being logged. +channelIsLogged :: String -> Session e s Bool +channelIsLogged chan = do + chans <- getChans + return $ isJust $ M.lookup chan chans >>= chanLogger + +-- | Start logging all the channels the bot has joined which aren't +-- being logged. +startLoggingAll :: Session e s () +startLoggingAll = do + chanmap <- getChans + chanmapE <- M.traverseWithKey enable chanmap + putChans chanmapE + +-- | Start logging the given channel, if not being logged already. +startLoggingChannel :: String -> Session e s () +startLoggingChannel chan = do + chanmap <- getChans + case M.lookup chan chanmap of + Just cstate -> do + cstateE <- enable chan cstate + putChans $ M.insert chan cstateE chanmap + Nothing -> return () + +-- | Start logging the channels not being logged, among the ones given. +startLoggingChannels :: [String] -> Session e s () +startLoggingChannels chans = do + chanmapAll <- getChans + let given = M.fromList (zip chans (repeat ())) + chanmapG = chanmapAll `M.intersection` given + chanmapE <- M.traverseWithKey enable chanmapG + putChans $ chanmapE `M.union` chanmapAll + +-- | Stop logging all logged channels. +stopLoggingAll :: Session e s () +stopLoggingAll = do + chanmap <- getChans + chanmapE <- M.traverseWithKey enable chanmap + putChans chanmapE + +-- | Stop logging the given channel, if being logged. +stopLoggingChannel :: String -> Session e s () +stopLoggingChannel chan = do + chanmap <- getChans + case M.lookup chan chanmap of + Just cstate -> do + cstateD <- disable cstate + putChans $ M.insert chan cstateD chanmap + Nothing -> return () + +-- | Stop logging the channels being logged among the ones given. +stopLoggingChannels :: [String] -> Session e s () +stopLoggingChannels chans = do + chanmapAll <- getChans + let given = M.fromList (zip chans (repeat ())) + chanmapG = chanmapAll `M.intersection` given + chanmapD <- traverse disable chanmapG + putChans $ chanmapD `M.union` chanmapAll diff --git a/src/Network/IRC/Fun/Bot/Internal/Logger.hs b/src/Network/IRC/Fun/Bot/Internal/Logger.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/Logger.hs @@ -0,0 +1,66 @@ +{- 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.Logger + ( newLogger + , newLogger' + , removeLogger + , logLine + ) +where + +import Control.Monad (liftM) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.RWS (asks) +import Data.Monoid ((<>)) +import Network.IRC.Fun.Bot.Internal.Types +import System.Log.FastLogger + +-- | Create a logger in the 'IO' monad. +newLogger :: IO String -- ^ Action which returns a formatted time string. You + -> FilePath -- ^ Path of the log file + -> IO Logger +newLogger getTime path = do + lset <- newFileLoggerSet defaultBufSize path + return $ Logger + { loggerSet = lset + , loggerGetTime = getTime + } + +-- | Create a logger inside the bot session. +newLogger' :: FilePath -> Session e s Logger +newLogger' path = do + timeGetter <- asks getTime + liftIO $ newLogger (liftM snd timeGetter) path + +-- | Flush buffers and release resources. +-- +-- When the logger is paused for a long period of time (i.e. not momentarily - +-- e.g. by a user disabling channel logging via UI), you can use this to +-- release resources. Later, when logging is needed again, create a fresh new +-- logger. +removeLogger :: Logger -> IO () +removeLogger logger = rmLoggerSet $ loggerSet logger + +formatLine :: ToLogStr s => IO String -> s -> IO LogStr +formatLine getTime line = do + t <- getTime + return $ toLogStr t <> toLogStr " " <> toLogStr line + +-- | Write a log message. +logLine :: ToLogStr s => Logger -> s -> IO () +logLine logger str = do + line <- formatLine (loggerGetTime logger) str + pushLogStrLn (loggerSet logger) line diff --git a/src/Network/IRC/Fun/Bot/Internal/Nicks.hs b/src/Network/IRC/Fun/Bot/Internal/Nicks.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/Nicks.hs @@ -0,0 +1,166 @@ +{- 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.Nicks + ( channelIsTracked + , startTrackingAll + , startTrackingChannel + , startTrackingChannels + , stopTrackingAll + , stopTrackingChannel + , stopTrackingChannels + , isInChannel + , presence + , addMember + , addChannel + , removeMemberOnce + , removeMember + , removeChannel + , removeChannels + ) +where + +import Control.Monad (unless) +import Control.Monad.Trans.RWS +import qualified Data.HashMap.Lazy as M +import Data.Maybe (fromMaybe) +import Network.IRC.Fun.Bot.Internal.Chat (putIrc) +import Network.IRC.Fun.Bot.Internal.State +import Network.IRC.Fun.Bot.Internal.Types +import qualified Network.IRC.Fun.Client.NickTracker as NT +import Network.IRC.Fun.Messages.TypeAliases (ChannelName) +import Network.IRC.Fun.Messages.Types (Message (NamesMessage)) + +enable :: ChannelState -> ChannelState +enable cstate = cstate { chanTracking = True } + +disable :: ChannelState -> ChannelState +disable cstate = cstate { chanTracking = False } + +-- | Check whether a given channel is being tracked. +channelIsTracked :: String -> Session e s Bool +channelIsTracked chan = do + chans <- getChans + return $ fromMaybe False $ fmap chanTracking $ M.lookup chan chans + +-- | Start tracking nicks in all the channels the bot has joined which aren't +-- being tracked. +startTrackingAll :: Session e s () +startTrackingAll = do + chans <- getChans + let chansD = [chan | (chan, ChannelState False _) <- M.toList chans] + chansAllE = M.map enable chans + putChans chansAllE + unless (null chansD) $ putIrc $ NamesMessage chansD Nothing + +-- | Start tracking nicks in the given channel, if not tracked already. +startTrackingChannel :: String -> Session e s () +startTrackingChannel chan = do + chans <- getChans + case M.lookup chan chans of + Just cstate -> unless (chanTracking cstate) $ do + let chansE = M.insert chan (cstate { chanTracking = True }) chans + putChans chansE + putIrc $ NamesMessage [chan] Nothing + Nothing -> return () + +-- | Start tracking nicks in the channels not tracked, among the ones given. +startTrackingChannels :: [String] -> Session e s () +startTrackingChannels chans = do + chanmapAll <- getChans + let given = M.fromList (zip chans (repeat ())) + chanmapG = chanmapAll `M.intersection` given + chanmapD = M.filter (not . chanTracking) chanmapG + chansD = M.keys chanmapD + chanmapE = M.map enable chanmapD + chanmapAllE = chanmapE `M.union` chanmapAll + putChans chanmapAllE + putIrc $ NamesMessage chansD Nothing + +-- | Stop tracking nicks in all tracked channels. +stopTrackingAll :: Session e s () +stopTrackingAll = + modify $ \ bstate -> bstate + { tracker = NT.newNetwork + , chanstate = M.map disable $ chanstate bstate + } + +-- | Stop tracking nicks in the given channel, if tracked. +stopTrackingChannel :: String -> Session e s () +stopTrackingChannel chan = + modify $ \ bstate -> bstate + { tracker = NT.removeChannel chan $ tracker bstate + , chanstate = M.adjust disable chan $ chanstate bstate + } + +-- | Stop tracking nicks in the tracked channels among the ones given. +stopTrackingChannels :: [String] -> Session e s () +stopTrackingChannels chans = + modify $ \ bstate -> bstate + { tracker = NT.removeChannels chans $ tracker bstate + , chanstate = + let chanmap = chanstate bstate + chanmapE = M.filter chanTracking chanmap + chanmapD = M.map disable chanmapE + in chanmapD `M.union` chanmap + } + +-- | Check whether a nickname is present in a channel. +isInChannel :: String -> String -> Session e s Bool +nick `isInChannel` chan = do + nt <- gets tracker + return $ NT.isInChannel nick chan nt + +-- | Check in which channels a nickname is present. +presence :: String -> Session e s [ChannelName] +presence nick = do + nt <- gets tracker + return $ NT.presence nick nt + +-- | Record a nickname being present in a channel. +addMember :: String -> String -> Session e s () +addMember chan nick = modify $ \ s -> s { tracker = f $ tracker s } + where + f = NT.addToChannel chan nick + +-- | Record a channel with the given present nicknames. +addChannel :: String -> [String] -> Session e s () +addChannel chan nicks = modify $ \ s -> s { tracker = f $ tracker s } + where + f = NT.addChannel chan nicks + +-- | Record a channel not having a given nickname anymore. +removeMemberOnce :: String -> String -> Session e s () +removeMemberOnce chan nick = modify $ \ s -> s { tracker = f $ tracker s } + where + f = NT.removeFromChannel chan nick + +-- | Record a nickname not being present in any channel anymore. +removeMember :: String -> Session e s () +removeMember nick = modify $ \ s -> s { tracker = f $ tracker s } + where + f = NT.removeFromNetwork nick + +-- | Remove a channel from the records. +removeChannel :: String -> Session e s () +removeChannel chan = modify $ \ s -> s { tracker = f $ tracker s } + where + f = NT.removeChannel chan + +-- | Remove channels from the records. +removeChannels :: [String] -> Session e s () +removeChannels chans = modify $ \ s -> s { tracker = f $ tracker s } + where + f = NT.removeChannels chans diff --git a/src/Network/IRC/Fun/Bot/Internal/Persist.hs b/src/Network/IRC/Fun/Bot/Internal/Persist.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/Persist.hs @@ -0,0 +1,107 @@ +{- 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 + - . + -} + +-- For JSON field names +{-# LANGUAGE OverloadedStrings #-} + +module Network.IRC.Fun.Bot.Internal.Persist + ( loadBotState + , mkSaveBotState + , saveBotState + ) +where + +import Control.Applicative +import Control.Monad (mzero) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.RWS +import Data.Aeson +import qualified Data.HashMap.Lazy as M +import Data.Maybe (isJust) +import Data.Settings.Persist +import Data.Time.Interval +import Data.Time.Units (Microsecond) +import Network.IRC.Fun.Bot.Internal.IrcLog (makeLogger) +import Network.IRC.Fun.Bot.Internal.Types +import Network.IRC.Fun.Client.NickTracker (newNetwork) + +data ChannelStateJ = ChannelStateJ Bool Bool + +data BotStateJ = BotStateJ (M.HashMap String ChannelStateJ) + +toJ :: BotState s -> BotStateJ +toJ bstate = BotStateJ $ M.map f $ chanstate bstate + where + f (ChannelState track mlogger) = ChannelStateJ track (isJust mlogger) + +fromJ :: BotStateJ -> BotEnv e s -> s -> IO (BotState s) +fromJ (BotStateJ chansJ) env pub = do + let f chan (ChannelStateJ tracking logging) = do + mlogger <- + if logging + then fmap Just $ makeLogger env chan + else return Nothing + return $ ChannelState tracking mlogger + defstate = ChannelStateJ False False + chansConf = M.fromList $ zip (channels $ config env) (repeat defstate) + chansAll = chansJ `M.union` chansConf + chans <- M.traverseWithKey f chansAll + return $ BotState newNetwork chans pub + +instance FromJSON ChannelStateJ where + parseJSON (Object o) = + ChannelStateJ <$> + o .: "track" <*> + o .: "log" + parseJSON _ = mzero + +instance ToJSON ChannelStateJ where + toJSON (ChannelStateJ tracking logging) = object + [ "track" .= tracking + , "log" .= logging + ] + +instance FromJSON BotStateJ where + parseJSON (Object o) = + BotStateJ <$> + o .: "channels" + parseJSON _ = mzero + +instance ToJSON BotStateJ where + toJSON (BotStateJ chans) = object + [ "channels" .= chans + ] + +instance ToJSON (BotState s) where + toJSON bstate = toJSON $ toJ bstate + +loadBotState :: BotEnv e s -> s -> IO (BotState s) +loadBotState env pub = do + r <- loadSettings $ stateFile $ config env + case r of + Left (False, e) -> error $ "Failed to read state file: " ++ e + Left (True, e) -> error $ "Failed to parse state file: " ++ e + Right sj -> fromJ sj env pub + +mkSaveBotState :: Config -> IO (BotState s -> IO ()) +mkSaveBotState conf = + let iv = fromInteger $ microseconds $ saveInterval conf :: Microsecond + in mkSaveSettings iv (stateFile conf) + +saveBotState :: Session e s () +saveBotState = do + bstate <- get + save <- asks saveState + liftIO $ save bstate diff --git a/src/Network/IRC/Fun/Bot/Internal/State.hs b/src/Network/IRC/Fun/Bot/Internal/State.hs --- a/src/Network/IRC/Fun/Bot/Internal/State.hs +++ b/src/Network/IRC/Fun/Bot/Internal/State.hs @@ -21,16 +21,25 @@ , askEnv , askEnvS , askHandle + , askTimeGetter , getState , getStateS , putState , modifyState + , getChannelState + , getChans + , putChans + , modifyChans ) where -import Control.Monad.Trans.RWS -import Network.IRC.Fun.Bot.Internal.Types -import Network.IRC.Fun.Client.IO (Handle) +import Control.Monad.Trans.RWS +import Data.HashMap.Lazy (HashMap) +import qualified Data.HashMap.Lazy as M +import Data.Maybe (isJust) +import Data.Time.Clock (UTCTime) +import Network.IRC.Fun.Bot.Internal.Types +import Network.IRC.Fun.Client.IO (Handle) -- | Fetch the bot configuration. askConfig :: Session e s Config @@ -60,6 +69,15 @@ askHandle :: Session e s Handle askHandle = asks handle +-- | Fetch the time getter. The actual time data is cached and updated at most +-- once per second depending on need. You can safely use it at any frequency +-- withou overloading IO and time formatting. +-- +-- The second item is a formatted time string in the form +-- @2015-09-01 18:10:00@, and is always expressed in UTC. +askTimeGetter :: Session e s (IO (UTCTime, String)) +askTimeGetter = asks getTime + -- | Fetch the current value of the state within the session. getState :: Session e s s getState = gets public @@ -78,3 +96,28 @@ modifyState :: (s -> s) -> Session e s () modifyState f = modify $ \ old@(BotState { public = st }) -> old { public = f st } + +-- | Get channel state information, in the form of a mapping from channel names +-- to their data. +-- +-- Channel data is a pair of two booleans. The first says whether channel +-- tracking is enabled. The second says whether channel logging info a file is +-- enabled. +getChannelState :: Session e s (HashMap String (Bool, Bool)) +getChannelState = do + chans <- getChans + let f cstate = (chanTracking cstate, isJust $ chanLogger cstate) + return $ M.map f chans + +-- Get the channel state map. +getChans :: Session e s (HashMap String ChannelState) +getChans = gets chanstate + +-- Set a new value for the channel state map. +putChans :: HashMap String ChannelState -> Session e s () +putChans chans = modify $ \ s -> s { chanstate = chans } + +-- Update the channel state map value with the result of applying a function. +modifyChans :: (HashMap String ChannelState -> HashMap String ChannelState) + -> Session e s () +modifyChans f = modify $ \ s -> s { chanstate = f $ chanstate s } diff --git a/src/Network/IRC/Fun/Bot/Internal/Types.hs b/src/Network/IRC/Fun/Bot/Internal/Types.hs --- a/src/Network/IRC/Fun/Bot/Internal/Types.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Types.hs @@ -15,16 +15,20 @@ module Network.IRC.Fun.Bot.Internal.Types ( Config (..) + , MessageSource (..) , Failure (..) , Command (..) , CommandSet (..) , BotEnv (..) + , ChannelState (..) , BotState (..) - , Session (..) + , Session , ChannelPrivacy (..) , Privilege (..) , Event (..) + , EventMatcher , Behavior (..) + , Logger (..) , EventSource , EventHandler , Quotes (..) @@ -32,18 +36,46 @@ where import Control.Monad.Trans.RWS (RWST) +import Data.HashMap.Lazy (HashMap) +import Data.Time.Clock (UTCTime) +import Data.Time.Interval (TimeInterval) +import qualified Network.IRC.Fun.Client.ChannelLogger as L (Logger) import Network.IRC.Fun.Client.IO (Connection, Handle) import Network.IRC.Fun.Client.Events (ChannelPrivacy (..), Privilege (..)) +import qualified Network.IRC.Fun.Client.Events as C (Event) +import Network.IRC.Fun.Client.NickTracker (NetworkTracker) +import System.Log.FastLogger (LoggerSet) -- | Configuration for the bot connection to IRC. data Config = Config { -- | Connection details, including nickname and optional password - connection :: Connection + connection :: Connection -- | List of channels to join, e.g. @["#freepost", "#rel4tion"]@ - , channels :: [String] + , channels :: [String] + -- | Directory path under which IRC log files will be placed. Relative to + -- the bot process working directory, or absolute. + , logDir :: FilePath + -- | Filename into the bot state managed by this library will be stored. + -- The custom part of the state isn't handled. Path relative to the bot + -- process working directory, or absolute. + , stateFile :: FilePath + -- | Minimal time interval between state saves. For example, to say + -- \"don't write state to file more than once per three seconds\", set + -- this field to 3 seconds, i.e. @time (3 :: Second)@. + , saveInterval :: TimeInterval + -- | Filename for the bot's main event log, i.e. produced by the IRC + -- event source. + , botEventLogFile :: FilePath } - deriving (Eq, Show) + deriving Show +-- / A discussion space where the bot is involved. An IRC channel or a private +-- session with a specific user. +--data Room = Channel String | User String deriving (Eq, Show) + +-- | A message for the bot can come privately or in a channel by a given user. +data MessageSource = Channel String String | User String deriving (Eq, Show) + -- | Describes wrong usage of a bot command. data Failure -- | The number of arguments given is wrong @@ -121,15 +153,27 @@ -- the password to automatically re-identify in case of any problem with -- NickServ. And so on. data BotEnv e s = BotEnv - { config :: Config - , behavior :: Behavior e s - , handle :: Handle - , custom :: e + { config :: Config + , behavior :: Behavior e s + , handle :: Handle + , getTime :: IO (UTCTime, String) + , saveState :: BotState s -> IO () + , custom :: e } +-- Per-channel modifiable state +data ChannelState = ChannelState + { chanTracking :: Bool + , chanLogger :: Maybe L.Logger + } + -- Readable and writable bot state. Contains internal state used by this -- library, and public state managed by the bot's behavior logic. -newtype BotState s = BotState { public :: s } +data BotState s = BotState + { tracker :: NetworkTracker + , chanstate :: HashMap String ChannelState + , public :: s + } -- | Bot monad. It provides read-only bot environment (e.g. the configuration), -- read-writable bot state (for use by bot commands) and IO. @@ -164,24 +208,27 @@ -- \"funbot, hello!\" then the 3rd parameter will be \"hello!\". | BotMessage String String String -- | A bot command, which is a message with a special prefix, was sent to - -- a channel. Parameters: Channel, sender nickname, prefix character, + -- a channel or privately to the bot. Parameters: Source, prefix character, -- command name, command arguments. - | BotCommand String String Char String [String] + | BotCommand MessageSource (Maybe Char) String [String] -- | A private message sent specifically to the bot, from a user with the -- given nickname (1st parameter) and with the given content (2nd -- parameter). | PersonalMessage String String -- | Channel, nickname, topic | TopicChange String String String - -- | Unrecognized or unimplemented event. The parameter contains (possibly - -- empty) input. - | OtherEvent String -- | The server sent a list of nicknames present in a channel. Parameters: -- Channel privacy mode, channel name, list of users. Each list item is a -- pair of a user privilege level in the channel, and the user's nickname. | Names String ChannelPrivacy [(Privilege, String)] + -- | Unrecognized or unimplemented event. The parameter contains (possibly + -- empty) input. + | OtherEvent String deriving Show +-- Tries to match a client event to a bot event. +type EventMatcher e s = C.Event -> Config -> [CommandSet e s] -> Maybe Event + -- | Bot behavior definition. data Behavior e s = Behavior { handleJoin :: String -> String -> Session e s () @@ -204,6 +251,11 @@ -> Session e s () } +data Logger = Logger + { loggerSet :: LoggerSet + , loggerGetTime :: IO String + } + -- | An 'IO' action, possibly running forever, which produces events for the -- bot to process. These event sources are run by the bot in dedicated threads. -- @@ -223,6 +275,10 @@ -> ([a] -> IO ()) -- ^ A non-blocking 'IO' action which sends a given list of events to the -- processing queue. + -> (FilePath -> IO Logger) + -- ^ An 'IO' action which creates a logger with a given target filename. + -- An event source can use it to log events, errors, debug into, etc. into + -- files efficiently. -> IO () -- | A bot session action which reacts to a single event which came from an diff --git a/src/Network/IRC/Fun/Bot/IrcLog.hs b/src/Network/IRC/Fun/Bot/IrcLog.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/IrcLog.hs @@ -0,0 +1,28 @@ +{- 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 + - . + -} + +-- | This module provides controls for the IRC channel logging system. +module Network.IRC.Fun.Bot.IrcLog + ( channelIsLogged + , startLoggingAll + , startLoggingChannel + , startLoggingChannels + , stopLoggingAll + , stopLoggingChannel + , stopLoggingChannels + ) +where + +import Network.IRC.Fun.Bot.Internal.IrcLog diff --git a/src/Network/IRC/Fun/Bot/Logger.hs b/src/Network/IRC/Fun/Bot/Logger.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Logger.hs @@ -0,0 +1,26 @@ +{- 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.Logger + ( Logger () + , newLogger + , newLogger' + , removeLogger + , logLine + ) +where + +import Network.IRC.Fun.Bot.Internal.Logger +import Network.IRC.Fun.Bot.Internal.Types diff --git a/src/Network/IRC/Fun/Bot/Nicks.hs b/src/Network/IRC/Fun/Bot/Nicks.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Nicks.hs @@ -0,0 +1,35 @@ +{- 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 + - . + -} + +-- | The module gives access to the nickname tracker. For each channel with +-- tracking enabled, the list of users in the channel is being maintained. It +-- is optionally used internally for logging, and can be very useful for some +-- bot features you may with your bot to have. +module Network.IRC.Fun.Bot.Nicks + ( -- * Tracker Control + startTrackingAll + , startTrackingChannel + , startTrackingChannels + , stopTrackingAll + , stopTrackingChannel + , stopTrackingChannels + -- * Queries + , channelIsTracked + , isInChannel + , presence + ) +where + +import Network.IRC.Fun.Bot.Internal.Nicks diff --git a/src/Network/IRC/Fun/Bot/State.hs b/src/Network/IRC/Fun/Bot/State.hs --- a/src/Network/IRC/Fun/Bot/State.hs +++ b/src/Network/IRC/Fun/Bot/State.hs @@ -20,13 +20,17 @@ , askConfigS , askBehavior , askBehaviorS + , askTimeGetter , askEnv , askEnvS , getState , getStateS , putState , modifyState + , getChannelState + , saveBotState ) where +import Network.IRC.Fun.Bot.Internal.Persist import Network.IRC.Fun.Bot.Internal.State diff --git a/src/Network/IRC/Fun/Bot/Types.hs b/src/Network/IRC/Fun/Bot/Types.hs --- a/src/Network/IRC/Fun/Bot/Types.hs +++ b/src/Network/IRC/Fun/Bot/Types.hs @@ -17,6 +17,7 @@ module Network.IRC.Fun.Bot.Types ( Connection (..) , Config (..) + --, Room (..) , Failure (..) , Command (..) , CommandSet (..)