diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -3,6 +3,34 @@ +irc-fun-bot 0.5.0.0 -- 2015-12-17 +================================= + +General, build and documentation changes: + +* (None) + +New APIs, features and enhancements: + +* Debug log +* History logging (moved code from funbot) +* Per-channel history lines limit +* Message delay thread with configurable delay +* Prefix `Config` fields +* Message counting system + +Bug fixes: + +* Log and remember bot's own messages, otherwise logs were incomplete + +Dependency changes: + +* Require irc-fun-client >= 0.4 + + + + + irc-fun-bot 0.4.0.0 -- 2015-10-17 ================================= diff --git a/irc-fun-bot.cabal b/irc-fun-bot.cabal --- a/irc-fun-bot.cabal +++ b/irc-fun-bot.cabal @@ -1,5 +1,5 @@ name: irc-fun-bot -version: 0.4.0.0 +version: 0.5.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 @@ -35,25 +35,32 @@ , Network.IRC.Fun.Bot.EventMatch , Network.IRC.Fun.Bot.IrcLog , Network.IRC.Fun.Bot.Logger + , Network.IRC.Fun.Bot.MsgCount , 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 + other-modules: Data.Sequence.Util + , Network.IRC.Fun.Bot.Internal.Chat + , Network.IRC.Fun.Bot.Internal.ChatExt , Network.IRC.Fun.Bot.Internal.Event , Network.IRC.Fun.Bot.Internal.Failure + , Network.IRC.Fun.Bot.Internal.History , Network.IRC.Fun.Bot.Internal.IrcLog , Network.IRC.Fun.Bot.Internal.Logger + , Network.IRC.Fun.Bot.Internal.MsgCount , 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: aeson + , auto-update , base >=4.7 && <5 , clock >=0.5 + , containers >=0.5 , fast-logger - , irc-fun-client >=0.3 + , irc-fun-client >=0.4 , irc-fun-messages >=0.2 , json-state , time diff --git a/src/Data/Sequence/Util.hs b/src/Data/Sequence/Util.hs new file mode 100644 --- /dev/null +++ b/src/Data/Sequence/Util.hs @@ -0,0 +1,30 @@ +{- 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 Data.Sequence.Util + ( tail + ) +where + +import Data.Sequence (Seq, ViewL (..)) +import Prelude hiding (tail) + +import qualified Data.Sequence as Q + +tail :: Seq a -> Seq a +tail s = + case Q.viewl s of + EmptyL -> s + _ :< t -> t 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 @@ -25,20 +25,23 @@ import Control.Concurrent (threadDelay, forkIO) import Control.Concurrent.Chan import Control.Concurrent.MVar -import Control.Monad (liftM, void, when) +import Control.Monad (liftM, forever, void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS (ask) import Data.List (transpose) -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Time.Interval import Data.Time.Units +import Network.IRC.Fun.Bot.Internal.Chat (sendIO) import Network.IRC.Fun.Bot.Internal.Event +import Network.IRC.Fun.Bot.Internal.History import Network.IRC.Fun.Bot.Internal.Logger +import Network.IRC.Fun.Bot.Internal.MsgCount import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Bot.Chat (login, joinConfig, run) import Network.IRC.Fun.Bot.Types (Connection (..)) import Network.IRC.Fun.Client.ChannelLogger (fromClientEvent) -import Network.IRC.Fun.Client.Events (hGetIrcEvents) +import Network.IRC.Fun.Client.Events (hGetIrcEvents, hGetIrcEvents') import Network.IRC.Fun.Client.IO (hPutIrc) import Network.IRC.Fun.Messages.Types (Message (PingMessage)) import System.Clock @@ -56,22 +59,25 @@ -- incrementing the library's major version and breaking compatibility. defConfig :: Config defConfig = Config - { connection = Connection - { server = "irc.freenode.net" - , port = 6667 - , tls = False -- not supported yet - , nick = "bot_test_joe" - , password = Nothing + { cfgConnection = Connection + { connServer = "irc.freenode.net" + , connPort = 6667 + , connTls = False -- not supported yet + , connNick = "bot_test_joe" + , connPassword = Nothing } - , channels = ["#freepost-bot-test"] - , logDir = "state/chanlogs" - , stateRepo = Nothing - , stateFile = "state/state.json" - , saveInterval = time (3 :: Second) - , botEventLogFile = "state/bot.log" - , maxMsgChars = Nothing - , lagCheck = Just $ time (1 :: Minute) - , lagMax = time (5 :: Minute) + , cfgChannels = ["#freepost-bot-test"] + , cfgLogDir = "state/chanlogs" + , cfgStateRepo = Nothing + , cfgStateFile = "state/state.json" + , cfgSaveInterval = time (3 :: Second) + , cfgBotEventLogFile = "state/bot.log" + , cfgIrcErrorLogFile = Nothing + , cfgMaxMsgChars = Nothing + , cfgLagCheck = Just $ time (1 :: Minute) + , cfgLagMax = time (5 :: Minute) + , cfgMaxMsgCount = 1000 + , cfgMsgDelay = time (100 :: Millisecond) } -- Get the bot ready for listening to IRC messages. @@ -87,13 +93,34 @@ listenToEvent :: Chan (Msg a) -- Chan from which to read events -> EventHandler e s a -- Handler for external events -> Session e s Bool -listenToEvent chan handler = do - msg <- liftIO $ readChan chan - case msg of - MsgLogEvent event -> handleEvent (Left event) >> return True - MsgBotEvent event -> handleEvent (Right event) >> return True - MsgExtEvent event -> handler event >> return True - MsgQuit -> return False +listenToEvent q handler = do + m <- liftIO $ readChan q + case m of + MsgLogEvent event -> do + handleEvent $ Left event + return True + MsgHistoryEvent nick chan msg action -> do + rememberMsg chan nick msg action + return True + MsgCountLogMsg chan -> do + recordMsg chan + return True + MsgCountLogJoin nick chan -> do + recordJoin nick chan + return True + MsgCountLogPart nick chan -> do + recordPart nick chan + return True + MsgCountLogQuit nick -> do + recordQuit nick + return True + MsgBotEvent event -> do + handleEvent $ Right event + return True + MsgExtEvent event -> do + handler event + return True + MsgQuit -> return False -- Get time since epoch. getNow :: IO TimeSpec @@ -108,21 +135,37 @@ -> IO () listenToIrc ms bot chan pongvar = do logger <- - newLogger (liftM snd $ beGetTime bot) (botEventLogFile $ beConfig bot) + newLogger + (liftM snd $ beGetTime bot) + (cfgBotEventLogFile $ beConfig bot) + elogger <- + case cfgIrcErrorLogFile $ beConfig bot of + Just path -> fmap Just $ newLogger (liftM snd $ beGetTime bot) path + Nothing -> return Nothing putStrLn "Bot: IRC event source listening to IRC events" let match e = matchEvent ms e (beConfig bot) (commandSets $ beBehavior bot) + getEvents = + if isJust elogger + then hGetIrcEvents' + else \ h -> liftM (\ es -> ([], es)) $ hGetIrcEvents h loop = do - r <- tryIOError $ hGetIrcEvents $ beHandle bot + r <- tryIOError $ getEvents $ beHandle bot case r of Left e -> do putStrLn "Bot: IRC event listener hGetIrcEvents IO error" print e writeChan chan MsgQuit - Right ircEvents -> do + Right (errs, ircEvents) -> do let botEvents = map match ircEvents - logEvents = catMaybes $ map fromClientEvent ircEvents - interleave logs bots = concat $ transpose - [map MsgLogEvent logs, map MsgBotEvent bots] + logEvents = mapMaybe fromClientEvent ircEvents + hisEvents = mapMaybe checkEvent ircEvents + cntEvents = mapMaybe countEvent ircEvents + interleaved = concat $ transpose + [ map MsgLogEvent logEvents + , hisEvents + , cntEvents + , map MsgBotEvent botEvents + ] isPong (C.Pong _ _) = True isPong _ = False when (any isPong ircEvents) $ do @@ -130,7 +173,10 @@ void $ tryTakeMVar pongvar putMVar pongvar now mapM_ (logLine logger . show) botEvents - writeList2Chan chan $ interleave logEvents botEvents + case elogger of + Nothing -> return () + Just lg -> mapM_ (logLine lg) errs + writeList2Chan chan interleaved loop loop @@ -151,11 +197,11 @@ -> MVar TimeSpec -> IO () manageLag bot chan pongvar = - case lagCheck $ beConfig bot of + case cfgLagCheck $ beConfig bot of Nothing -> return () Just iv -> do putStrLn "Bot: IRC lag manager thread running" - let maxdiff = intervalToSpec $ lagMax $ beConfig bot + let maxdiff = intervalToSpec $ cfgLagMax $ beConfig bot loop prev = do mpong <- tryTakeMVar pongvar let pong = fromMaybe prev mpong @@ -165,12 +211,26 @@ putStrLn "Bot: IRC max lag reached" writeChan chan MsgQuit else do - let serv = server $ connection $ beConfig bot + let serv = + connServer $ cfgConnection $ beConfig bot hPutIrc (beHandle bot) $ PingMessage serv Nothing threadDelay $ fromInteger $ microseconds iv loop pong loop =<< getNow +-- Wait for requests to send IRC messages, and send them while maintaining a +-- delay to avoid flood. +sendMessages :: BotEnv e s -> IO () +sendMessages bot = do + putStrLn "Bot: IRC message sending scheduler thread running" + let q = beMsgQueue bot + h = beHandle bot + delay = fromInteger $ microseconds $ cfgMsgDelay $ beConfig bot + forever $ do + msg <- readChan q + sendIO h msg + threadDelay delay + -- Connect, login, join. Then listen to events and handle them, forever. botSession :: [EventMatcher e s] -> [EventSource e s a] @@ -182,6 +242,7 @@ chan <- liftIO newChan bot <- ask pongvar <- liftIO newEmptyMVar + liftIO $ void $ forkIO $ sendMessages bot liftIO $ void $ forkIO $ listenToIrc matchers bot chan pongvar liftIO $ void $ forkIO $ manageLag bot chan pongvar let launch s = forkIO $ s (beConfig bot) diff --git a/src/Network/IRC/Fun/Bot/Chat.hs b/src/Network/IRC/Fun/Bot/Chat.hs --- a/src/Network/IRC/Fun/Bot/Chat.hs +++ b/src/Network/IRC/Fun/Bot/Chat.hs @@ -44,4 +44,5 @@ where import Network.IRC.Fun.Bot.Internal.Chat +import Network.IRC.Fun.Bot.Internal.ChatExt import Network.IRC.Fun.Bot.Internal.Failure 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 @@ -26,27 +26,37 @@ , partChannel , partMulti , partAll + , sendIO , sendToUser + , sendToUserNow , sendToChannel + , sendToChannelNow , sendBack - , putIrc + , sendBackNow ) where +import Control.AutoUpdate +import Control.Concurrent.Chan import Control.Exception (bracket) import Control.Monad (liftM) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.RWS (gets, runRWST) +import Control.Monad.Trans.RWS (asks, gets, runRWST) import Data.Char (isSpace) import Data.List (union) +import Network.IRC.Fun.Bot.Internal.History (rememberMsg) +import Network.IRC.Fun.Bot.Internal.MsgCount (recordMsg) 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.ChannelLogger (logEvent, ChanLogEvent (..)) import Network.IRC.Fun.Client.Commands -import Network.IRC.Fun.Client.IO (ircConnect, ircDisconnect, hPutIrc) +import Network.IRC.Fun.Client.IO import Network.IRC.Fun.Client.Time (currentTimeGetter) import Network.IRC.Fun.Messages.Types (Message) +import System.Clock +import qualified Data.HashMap.Lazy as M (lookup) import qualified Data.HashSet as S (toList) ------------------------------------------------------------------------------- @@ -97,12 +107,17 @@ run conf beh env state session = do timeGetter <- currentTimeGetter save <- mkSaveBotState conf + getMin <- mkAutoUpdate defaultUpdateSettings + { updateFreq = 1000000 * 60 -- 60 seconds + , updateAction = liftM ((`div` 60) . sec) $ getTime Realtime + } + mq <- newChan putStrLn "Bot: Connecting to IRC server" bracket - (ircConnect $ connection conf) + (ircConnect $ cfgConnection conf) ircDisconnect (\ h -> do - let botEnv = BotEnv conf beh h timeGetter save env + let botEnv = BotEnv conf beh h timeGetter getMin save mq env putStrLn "Bot: Loading state from file" botState <- loadBotState botEnv state runSession botEnv botState session @@ -113,7 +128,7 @@ login :: Session e s () login = do h <- askHandle - conn <- askConfigS connection + conn <- askConfigS cfgConnection liftIO $ ircLogin h conn False False -- | IRC servers send PING messages at regular intervals to test the presence @@ -155,7 +170,7 @@ -- joined. joinConfig :: Session e s () joinConfig = do - chansC <- askConfigS channels + chansC <- askConfigS cfgChannels chansP <- liftM S.toList $ gets bsSelChans let chans = union chansC chansP joinMulti $ map (flip (,) Nothing) chans @@ -202,37 +217,125 @@ makeLines :: String -> Session e s [String] makeLines msg = do let ls = lines msg - maybelen <- askConfigS maxMsgChars + maybelen <- askConfigS cfgMaxMsgChars case maybelen of Nothing -> return ls Just maxlen -> return $ concatMap (splitN maxlen) ls +-- Log a channel message event. +logChanMsg :: String -> String -> String -> Session e s () +logChanMsg nick chan msg = do + cstates <- gets bsChannels + case M.lookup chan cstates >>= csLogger of + Nothing -> return () + Just lg -> liftIO $ logEvent lg (MessageChan nick msg) + +sendToChannelIO :: Handle -> String -> [String] -> IO () +sendToChannelIO h chan = mapM_ $ ircSendToChannel h chan + +sendToUserIO :: Handle -> String -> [String] -> IO () +sendToUserIO h nick = mapM_ $ ircSendToUser h nick + +sendIO :: Handle -> IrcMsg -> IO () +sendIO h msg = + case msgRecip msg of + Left nick -> sendToUserIO h nick $ msgLines msg + Right chan -> sendToChannelIO h chan $ msgLines msg + +sendToChannelHere :: String -> [String] -> Session e s () +sendToChannelHere chan lines = do + h <- askHandle + liftIO $ sendToChannelIO h chan lines + +sendToUserHere :: String -> [String] -> Session e s () +sendToUserHere nick lines = do + h <- askHandle + liftIO $ sendToUserIO h nick lines + +sendToChannelDefer :: String -> [String] -> Session e s () +sendToChannelDefer chan lines = do + q <- asks beMsgQueue + let msg = IrcMsg + { msgRecip = Right chan + , msgLines = lines + } + liftIO $ writeChan q msg + +sendToUserDefer :: String -> [String] -> Session e s () +sendToUserDefer nick lines = do + q <- asks beMsgQueue + let msg = IrcMsg + { msgRecip = Left nick + , msgLines = lines + } + liftIO $ writeChan q msg + +sendToChannelImpl :: (String -> [String] -> Session e s ()) + -> String + -> String + -> Session e s () +sendToChannelImpl send chan msg = do + msgs <- makeLines msg + send chan msgs + self <- askConfigS $ connNick . cfgConnection + let remember s = do + rememberMsg chan self s False + recordMsg chan + logChanMsg self chan s + mapM_ remember msgs + +sendToUserImpl :: (String -> [String] -> Session e s ()) + -> String + -> String + -> Session e s () +sendToUserImpl send nick msg = do + msgs <- makeLines msg + send nick msgs + -- | 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 +-- +-- This function doesn't instantly send the message, but instead queues it for +-- sending by the sending scheduler thread, which adds delay to avoid flood. If +-- you want to send instantly, see 'sendToChannelNow'. +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 = sendToChannelImpl sendToChannelDefer +-- | A variant of 'sendToChannel' which sends instantly, without any delay. +sendToChannelNow + :: 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 () +sendToChannelNow = sendToChannelImpl sendToChannelHere + -- | Send a private message to an IRC user. +-- +-- This function doesn't instantly send the message, but instead queues it for +-- sending by the sending scheduler thread, which adds delay to avoid flood. If +-- you want to send instantly, see 'sendToUserNow'. 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 +sendToUser = sendToUserImpl sendToUserDefer +-- | A variant of 'sendToUser' which sends instantly, without any delay. +sendToUserNow :: 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 () +sendToUserNow = sendToUserImpl sendToUserHere + -- | 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 @@ -245,14 +348,20 @@ sendBack (Just chan) _nick msg = sendToChannel chan msg sendBack Nothing nick msg = sendToUser nick msg +-- | A variant of 'sendBack' which sends instantly, without any delay. +sendBackNow + :: 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 () +sendBackNow (Just chan) _nick msg = sendToChannelNow chan msg +sendBackNow Nothing nick msg = sendToUserNow 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 +-- See the ChatExt module. diff --git a/src/Network/IRC/Fun/Bot/Internal/ChatExt.hs b/src/Network/IRC/Fun/Bot/Internal/ChatExt.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/ChatExt.hs @@ -0,0 +1,34 @@ +{- 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.ChatExt + ( putIrc + ) +where + + +import Control.Monad.IO.Class (liftIO) +import Network.IRC.Fun.Bot.Internal.State (askHandle) +import Network.IRC.Fun.Bot.Internal.Types (Session) +import Network.IRC.Fun.Client.IO (hPutIrc) +import Network.IRC.Fun.Messages.Types (Message) + +-- | 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 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 @@ -49,7 +49,7 @@ 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 Network.IRC.Fun.Client.IO (nick) +import Network.IRC.Fun.Client.IO (connNick) import Network.IRC.Fun.Client.Util (mentions) import qualified Data.HashMap.Lazy as M @@ -107,7 +107,7 @@ detectRef :: Config -> String -> Maybe String detectRef conf msg = - let bnick = nick (connection conf) + let bnick = connNick (cfgConnection conf) dw = Just . dropWhile isSpace in case stripPrefix bnick msg of Nothing -> Nothing @@ -382,7 +382,7 @@ C.Names priv chan pnicks -> Just $ Names chan priv pnicks _ -> Nothing where - bnick = nick (connection conf) + bnick = connNick (cfgConnection conf) combineMatchers :: [EventMatcher e s] -> EventMatcher e s combineMatchers [] _event _conf _csets = Nothing @@ -452,7 +452,7 @@ Join chan user -> do tracked <- channelIsTracked chan when tracked $ addMember chan user - self <- askConfigS $ nick . connection + self <- askConfigS $ connNick . cfgConnection when (user == self) $ addCurrChan chan handleJoin b chan user Part chan nick why -> do @@ -489,7 +489,7 @@ -- 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 + let detect event cstate = fmap (\ cl -> (cl, event)) $ csLogger cstate detectOne chan event = do cstates <- gets bsChannels return $ maybeToList $ M.lookup chan cstates >>= detect event diff --git a/src/Network/IRC/Fun/Bot/Internal/History.hs b/src/Network/IRC/Fun/Bot/Internal/History.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/History.hs @@ -0,0 +1,65 @@ +{- 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.History + ( rememberMsg + , checkEvent + ) +where + +import Control.Monad (liftM, when) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.RWS (modify) +import Data.Sequence ((|>), Seq, ViewL (..)) +import Network.IRC.Fun.Bot.Internal.State +import Network.IRC.Fun.Bot.Internal.Types + +import qualified Data.HashMap.Lazy as M +import qualified Data.Sequence as Q +import qualified Data.Sequence.Util as QU +import qualified Network.IRC.Fun.Client.Events as C (Event (..)) + +-- | Remember someone said something, for use later when quoting. +rememberMsg :: String -- ^ Channel + -> String -- ^ User nickname + -> String -- ^ Message + -> Bool -- ^ Whether a /me action (True) or regular message (False) + -> Session e s () +rememberMsg chan nick msg action = do + maxlines <- liftM (maybe 0 csHistoryLines . M.lookup chan) getChans + when (maxlines > 0) $ do + h <- getHistory + t <- askTimeGetter >>= liftIO . liftM snd + m <- getMinutes + let hl = HistoryLine + { hlTime = t + , hlNick = nick + , hlMessage = msg + , hlAction = action + , hlMinute = m + } + shorten s = if Q.length s > maxlines then QU.tail s else s + hls' = case M.lookup chan h of + Just hls -> shorten $ hls |> hl + Nothing -> Q.singleton hl + modify $ \ s -> s { bsHistory = M.insert chan hls' h } + +-- | If a client event is a message to remember, get details. +checkEvent :: C.Event -> Maybe (Msg a) +checkEvent (C.ChannelMessage chan nick msg _) = + Just $ MsgHistoryEvent nick chan msg False +checkEvent (C.ChannelAction chan nick msg) = + Just $ MsgHistoryEvent nick chan msg True +checkEvent _ = Nothing diff --git a/src/Network/IRC/Fun/Bot/Internal/IrcLog.hs b/src/Network/IRC/Fun/Bot/Internal/IrcLog.hs --- a/src/Network/IRC/Fun/Bot/Internal/IrcLog.hs +++ b/src/Network/IRC/Fun/Bot/Internal/IrcLog.hs @@ -39,32 +39,32 @@ makeLogger :: BotEnv e s -> String -> IO Logger makeLogger env chan = let timeGetter = beGetTime env - logdir = logDir $ beConfig env + logdir = cfgLogDir $ beConfig env file = logFilePath logdir "server" chan in newLogger (liftM snd timeGetter) file -enable :: String -> ChannelState -> Session e s ChannelState +enable :: String -> ChanState -> Session e s ChanState enable chan cstate = - if isJust $ chanLogger cstate + if isJust $ csLogger cstate then return cstate else do env <- ask logger <- liftIO $ makeLogger env chan - return cstate { chanLogger = Just logger } + return cstate { csLogger = Just logger } -disable :: ChannelState -> Session e s ChannelState +disable :: ChanState -> Session e s ChanState disable cstate = - case chanLogger cstate of + case csLogger cstate of Just logger -> do liftIO $ removeLogger logger - return cstate { chanLogger = Nothing } + return cstate { csLogger = 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 + return $ isJust $ M.lookup chan chans >>= csLogger -- | Start logging all the channels the bot has joined which aren't -- being logged. diff --git a/src/Network/IRC/Fun/Bot/Internal/MsgCount.hs b/src/Network/IRC/Fun/Bot/Internal/MsgCount.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/MsgCount.hs @@ -0,0 +1,227 @@ +{- 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.MsgCount + ( startCountingAll + , startCountingChan + , startCountingChans + , stopCountingAll + , stopCountingChan + , stopCountingChans + , getCountLogs + , getCountLog + , chanIsCounted + , everParted + , everJoined + , countMsgs + , msgsSinceParted + , recordMsg + , recordJoin + , recordPart + , recordQuit + , countEvent + ) +where + +import Control.Monad (liftM, when) +import Control.Monad.Trans.RWS (modify, gets) +import Data.Foldable (any, foldl) +import Data.Sequence (Seq, ViewR (..), (|>)) +import Network.IRC.Fun.Bot.Internal.Nicks (presence) +import Network.IRC.Fun.Bot.Internal.State +import Network.IRC.Fun.Bot.Internal.Types +import Prelude hiding (any, foldl) + +import qualified Data.HashMap.Lazy as M +import qualified Data.Sequence as Q +import qualified Data.Sequence.Util as QU +import qualified Network.IRC.Fun.Client.Events as C (Event (..)) + +set :: Bool -> ChanState -> ChanState +set b cs = cs { csCounting = b } + +enable :: ChanState -> ChanState +enable = set True + +disable :: ChanState -> ChanState +disable = set False + +-- | Start counting in all the channels the bot has joined which aren't +-- being counted. +startCountingAll :: Session e s () +startCountingAll = modifyChans $ M.map enable + +-- | Start counting in the given channel, if not counted already. +startCountingChan :: String -> Session e s () +startCountingChan chan = modifyChans $ M.adjust enable chan + +-- | Start counting in the channels not counted, among the ones given. +startCountingChans :: [String] -> Session e s () +startCountingChans chans = do + chanmapAll <- getChans + let given = M.fromList (zip chans (repeat ())) + chanmapG = chanmapAll `M.intersection` given + chanmapD = M.filter (not . csCounting) chanmapG + chanmapE = M.map enable chanmapD + chanmapAllE = chanmapE `M.union` chanmapAll + putChans chanmapAllE + +-- | Stop counting in all counted channels. +stopCountingAll :: Session e s () +stopCountingAll = + modify $ \ bstate -> bstate + { bsMsgCountLog = M.empty + , bsChannels = M.map disable $ bsChannels bstate + } + +-- | Stop counting in the given channel, if counted. +stopCountingChan :: String -> Session e s () +stopCountingChan chan = + modify $ \ bstate -> bstate + { bsMsgCountLog = M.delete chan $ bsMsgCountLog bstate + , bsChannels = M.adjust disable chan $ bsChannels bstate + } + +-- | Stop counting in the counted channels among the ones given. +stopCountingChans :: [String] -> Session e s () +stopCountingChans chans = + modify $ \ bstate -> bstate + { bsMsgCountLog = + bsMsgCountLog bstate + `M.difference` + M.fromList (zip chans (repeat ())) + , bsChannels = + let chanmap = bsChannels bstate + chanmapE = M.filter csCounting chanmap + chanmapD = M.map disable chanmapE + in chanmapD `M.union` chanmap + } + +-- | Get a mapping between channel names and sequences of their message +-- counting data. +getCountLogs :: Session e s (M.HashMap String (Seq MsgCountEntry)) +getCountLogs = gets bsMsgCountLog + +-- | Get the count log for a specific channel. If there is none, an empty log +-- is returned. +getCountLog :: String -> Session e s (Seq MsgCountEntry) +getCountLog chan = liftM (M.lookupDefault Q.empty chan) getCountLogs + +-- | Check whether a given channel is being counted. +chanIsCounted :: String -> Session e s Bool +chanIsCounted chan = liftM (maybe False csCounting . M.lookup chan) getChans + +-- | Check whether a given user ever parted the channel, as far as the count +-- log remembers. +everParted :: String -> String -> Session e s Bool +nick `everParted` chan = + let p (MsgCountPart n) = n == nick + p _ = False + in liftM (any p) $ getCountLog chan + +-- | Check whether a given user ever joined the channel, as far as the count +-- log remembers. +everJoined :: String -> String -> Session e s Bool +nick `everJoined` chan = + let p (MsgCountJoin n) = n == nick + p _ = False + in liftM (any p) $ getCountLog chan + +-- | Determine how many messages a log sequence has recorded. +countMsgs :: Seq MsgCountEntry -> Int +countMsgs = + let f n (MsgCountMsgs m) = n + m + f n (MsgCountJoin _) = n + f n (MsgCountPart _) = n + in foldl f 0 + +-- | Find out how many messages the channel had since the given user parted it. +-- On success, return 'Right' it. Otherwise, i.e. if no parting of the user is +-- recorded, return 'Left' the total recorded messages. +msgsSinceParted :: String -> String -> Session e s (Either Int Int) +msgsSinceParted nick chan = do + cl <- getCountLog chan + let p (MsgCountPart n) = n == nick + p _ = False + (after, until) = Q.breakr p cl + count = countMsgs after + return $ if Q.null until + then Left count + else Right count + +modifyLog :: String + -> (Seq MsgCountEntry -> Seq MsgCountEntry) + -> Session e s () +modifyLog chan f = do + t <- chanIsCounted chan + when t $ do + n <- askConfigS cfgMaxMsgCount + let g logs = + let prev = M.lookupDefault Q.empty chan logs + new = f prev + fixed = if Q.length new > n then QU.tail new else new + in M.insert chan fixed logs + modify $ \ bstate -> bstate + { bsMsgCountLog = g $ bsMsgCountLog bstate + } + +-- | Count a message in the channel's count log. +recordMsg :: String -> Session e s () +recordMsg chan = + let f q = + case Q.viewr q of + EmptyR -> Q.singleton $ MsgCountMsgs 1 + l :> MsgCountMsgs n -> l |> MsgCountMsgs (n + 1) + _ :> _ -> q |> MsgCountMsgs 1 + in modifyLog chan f + +-- | Count a join in the channel's count log. +recordJoin :: String -> String -> Session e s () +recordJoin nick chan = + let f = (|> (MsgCountJoin nick)) + in modifyLog chan f + +-- | Count a part (i.e. leave one channel) in the channel's count log. +recordPart :: String -> String -> Session e s () +recordPart nick chan = + let f = (|> (MsgCountPart nick)) + in modifyLog chan f + +-- | Count a quit (i.e. leave all channels) in the channel's count log. +recordQuit :: String -> Session e s () +recordQuit nick = do + chans <- presence nick + let chansPresent = M.fromList $ zip chans (repeat ()) + chansCounted <- liftM (M.filter csCounting) getChans + let chansAct = chansPresent `M.intersection` chansCounted + logs <- getCountLogs + let logsAct = logs `M.intersection` chansAct + n <- askConfigS cfgMaxMsgCount + let f q = + let new = q |> MsgCountPart nick + in if Q.length new > n then QU.tail new else new + logsNew = M.map f logsAct + modify $ \ bstate -> bstate + { bsMsgCountLog = logsNew `M.union` bsMsgCountLog bstate + } + +-- | If en event needs to be considered in message counting, handle it. +countEvent :: C.Event -> Maybe (Msg a) +countEvent (C.Join chan nick) = Just $ MsgCountLogJoin nick chan +countEvent (C.Part chan nick _) = Just $ MsgCountLogPart nick chan +countEvent (C.Quit nick _) = Just $ MsgCountLogQuit nick +countEvent (C.ChannelMessage chan _ _ _) = Just $ MsgCountLogMsg chan +countEvent (C.ChannelAction chan _ _) = Just $ MsgCountLogMsg chan +countEvent _ = Nothing diff --git a/src/Network/IRC/Fun/Bot/Internal/Nicks.hs b/src/Network/IRC/Fun/Bot/Internal/Nicks.hs --- a/src/Network/IRC/Fun/Bot/Internal/Nicks.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Nicks.hs @@ -36,7 +36,7 @@ import Control.Monad (unless) import Control.Monad.Trans.RWS import Data.Maybe (fromMaybe) -import Network.IRC.Fun.Bot.Internal.Chat (putIrc) +import Network.IRC.Fun.Bot.Internal.ChatExt (putIrc) import Network.IRC.Fun.Bot.Internal.State import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Messages.TypeAliases (ChannelName) @@ -45,24 +45,24 @@ import qualified Data.HashMap.Lazy as M import qualified Network.IRC.Fun.Client.NickTracker as NT -enable :: ChannelState -> ChannelState -enable cstate = cstate { chanTracking = True } +enable :: ChanState -> ChanState +enable cstate = cstate { csTracking = True } -disable :: ChannelState -> ChannelState -disable cstate = cstate { chanTracking = False } +disable :: ChanState -> ChanState +disable cstate = cstate { csTracking = 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 + return $ fromMaybe False $ fmap csTracking $ 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] + let chansD = [chan | (chan, ChanState False _ _ _) <- M.toList chans] chansAllE = M.map enable chans putChans chansAllE unless (null chansD) $ putIrc $ NamesMessage chansD Nothing @@ -72,8 +72,8 @@ 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 + Just cstate -> unless (csTracking cstate) $ do + let chansE = M.insert chan (cstate { csTracking = True }) chans putChans chansE putIrc $ NamesMessage [chan] Nothing Nothing -> return () @@ -84,7 +84,7 @@ chanmapAll <- getChans let given = M.fromList (zip chans (repeat ())) chanmapG = chanmapAll `M.intersection` given - chanmapD = M.filter (not . chanTracking) chanmapG + chanmapD = M.filter (not . csTracking) chanmapG chansD = M.keys chanmapD chanmapE = M.map enable chanmapD chanmapAllE = chanmapE `M.union` chanmapAll @@ -114,7 +114,7 @@ { bsTracker = NT.removeChannels chans $ bsTracker bstate , bsChannels = let chanmap = bsChannels bstate - chanmapE = M.filter chanTracking chanmap + chanmapE = M.filter csTracking chanmap chanmapD = M.map disable chanmapE in chanmapD `M.union` chanmap } diff --git a/src/Network/IRC/Fun/Bot/Internal/Persist.hs b/src/Network/IRC/Fun/Bot/Internal/Persist.hs --- a/src/Network/IRC/Fun/Bot/Internal/Persist.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Persist.hs @@ -31,7 +31,6 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS import Data.Aeson -import Data.Maybe (isJust) import Data.JsonState import Data.List (union) import Data.Time.Interval @@ -44,41 +43,42 @@ import qualified Data.HashMap.Lazy as M import qualified Data.HashSet as S -data ChannelStateJ = ChannelStateJ Bool Bool - -data BotStateJ = BotStateJ (M.HashMap String ChannelStateJ) (S.HashSet String) +data BotStateJ = BotStateJ (M.HashMap String ChanInfo) (S.HashSet String) toJ :: BotState s -> BotStateJ -toJ bstate = BotStateJ (M.map f $ bsChannels bstate) (bsSelChans bstate) - where - f (ChannelState track mlogger) = ChannelStateJ track (isJust mlogger) +toJ bstate = + BotStateJ (M.map stateToInfo $ bsChannels bstate) (bsSelChans bstate) fromJ :: BotEnv e s -> BotStateJ -> s -> IO (BotState s) fromJ env (BotStateJ stateJ selJ) pub = do - let f chan (ChannelStateJ tracking logging) = do + let f chan (ChanInfo tracking counting logging hls) = do mlogger <- if logging then fmap Just $ makeLogger env chan else return Nothing - return $ ChannelState tracking mlogger - defstate = ChannelStateJ False False - chansConf = S.toList selJ `union` channels (beConfig env) + return $ ChanState tracking counting mlogger hls + defstate = ChanInfo False False False 0 + chansConf = S.toList selJ `union` cfgChannels (beConfig env) stateConf = M.fromList $ zip chansConf (repeat defstate) stateAll = stateJ `M.union` stateConf cstate <- M.traverseWithKey f stateAll - return $ BotState newNetwork cstate S.empty selJ pub + return $ BotState newNetwork cstate S.empty selJ M.empty M.empty pub -instance FromJSON ChannelStateJ where +instance FromJSON ChanInfo where parseJSON (Object o) = - ChannelStateJ <$> + ChanInfo <$> o .: "track" <*> - o .: "log" + o .: "count" <*> + o .: "log" <*> + o .: "history-lines" parseJSON _ = mzero -instance ToJSON ChannelStateJ where - toJSON (ChannelStateJ tracking logging) = object - [ "track" .= tracking - , "log" .= logging +instance ToJSON ChanInfo where + toJSON (ChanInfo tracking counting logging hls) = object + [ "track" .= tracking + , "count" .= counting + , "log" .= logging + , "history-lines" .= hls ] instance FromJSON BotStateJ where @@ -100,7 +100,7 @@ loadBotState :: BotEnv e s -> s -> IO (BotState s) loadBotState env pub = do let conf = beConfig env - r <- loadState $ stateFilePath (stateFile conf) (stateRepo conf) + r <- loadState $ stateFilePath (cfgStateFile conf) (cfgStateRepo conf) case r of Left (False, e) -> error $ "Failed to read state file: " ++ e Left (True, e) -> error $ "Failed to parse state file: " ++ e @@ -108,9 +108,9 @@ mkSaveBotState :: Config -> IO (BotState s -> IO ()) mkSaveBotState conf = - let iv = fromInteger $ microseconds $ saveInterval conf :: Microsecond + let iv = fromInteger $ microseconds $ cfgSaveInterval conf :: Microsecond msg = "auto commit by irc-fun-bot" - in mkSaveStateChoose iv (stateFile conf) (stateRepo conf) msg + in mkSaveStateChoose iv (cfgStateFile conf) (cfgStateRepo conf) msg saveBotState :: Session e s () saveBotState = do @@ -145,5 +145,5 @@ addChannelState chan = do chans <- getChans unless (chan `M.member` chans) $ do - putChans $ M.insert chan (ChannelState False Nothing) chans + putChans $ M.insert chan (ChanState False False Nothing 0) chans saveBotState 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 @@ -22,11 +22,15 @@ , askEnvS , askHandle , askTimeGetter + , askMinuteGetter + , getMinutes , getState , getStateS , putState , modifyState - , getChannelState + , getHistory + , stateToInfo + , getChanInfo , getChans , putChans , modifyChans @@ -39,9 +43,12 @@ where import Control.Monad (liftM) +import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS import Data.HashMap.Lazy (HashMap) +import Data.Int (Int64) import Data.Maybe (isJust) +import Data.Sequence (Seq) import Data.Time.Clock (UTCTime) import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Client.IO (Handle) @@ -86,6 +93,18 @@ askTimeGetter :: Session e s (IO (UTCTime, String)) askTimeGetter = asks beGetTime +-- | Fetch the minute getter. The actual data is cached and updated at most +-- once per minute depending on need. You can safely use it at any frequency +-- withou overloading IO and time formatting. +askMinuteGetter :: Session e s (IO Int64) +askMinuteGetter = asks beGetMinute + +-- | Get the number of minutes since the epoch using an auto updating counter. +getMinutes :: Session e s Int64 +getMinutes = do + getMin <- askMinuteGetter + liftIO getMin + -- | Fetch the current value of the state within the session. getState :: Session e s s getState = gets bsPublic @@ -105,28 +124,30 @@ modifyState f = modify $ \ old@(BotState { bsPublic = st }) -> old { bsPublic = f st } +-- | Get a mapping between channel names and sequences of their last messages. +getHistory :: Session e s (HashMap String (Seq HistoryLine)) +getHistory = gets bsHistory + +-- Create channel info from its state +stateToInfo :: ChanState -> ChanInfo +stateToInfo (ChanState track count mlogger hls) = + ChanInfo track count (isJust mlogger) hls + -- | 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 +getChanInfo :: Session e s (HashMap String ChanInfo) +getChanInfo = liftM (M.map stateToInfo) getChans -- Get the channel state map. -getChans :: Session e s (HashMap String ChannelState) +getChans :: Session e s (HashMap String ChanState) getChans = gets bsChannels -- Set a new value for the channel state map. -putChans :: HashMap String ChannelState -> Session e s () +putChans :: HashMap String ChanState -> Session e s () putChans chans = modify $ \ s -> s { bsChannels = chans } -- Update the channel state map value with the result of applying a function. -modifyChans :: (HashMap String ChannelState -> HashMap String ChannelState) +modifyChans :: (HashMap String ChanState -> HashMap String ChanState) -> Session e s () modifyChans f = modify $ \ s -> s { bsChannels = f $ bsChannels 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 @@ -19,8 +19,12 @@ , Failure (..) , Command (..) , CommandSet (..) + , IrcMsg (..) , BotEnv (..) - , ChannelState (..) + , MsgCountEntry (..) + , ChanState (..) + , ChanInfo (..) + , HistoryLine (..) , BotState (..) , Session , ChannelPrivacy (..) @@ -37,15 +41,19 @@ ) where +import Control.Concurrent.Chan (Chan) import Control.Monad.Trans.RWS (RWST) import Data.HashMap.Lazy (HashMap) import Data.HashSet (HashSet) +import Data.Int (Int64) +import Data.Sequence (Seq) import Data.Time.Clock (UTCTime) import Data.Time.Interval (TimeInterval) import Network.IRC.Fun.Client.ChannelLogger (LogEvent) import Network.IRC.Fun.Client.IO (Connection, Handle) import Network.IRC.Fun.Client.Events (ChannelPrivacy (..), Privilege (..)) import Network.IRC.Fun.Client.NickTracker (NetworkTracker) +import Network.IRC.Fun.Messages.TypeAliases (NickName, ChannelName) import System.Log.FastLogger (LoggerSet) import qualified Network.IRC.Fun.Client.ChannelLogger as L (Logger) @@ -54,44 +62,63 @@ -- | Configuration for the bot connection to IRC. data Config = Config { -- | Connection details, including nickname and optional password - connection :: Connection + cfgConnection :: Connection -- | The list of channels for the bot to join is generally set in the -- state file, but when the bot launches it joins both the channels -- listed there and the ones listed here. This list is intended to be -- used as hard-coded backup, i.e. the bot will always join these -- channels regardless of what the state file says. - , channels :: [String] + , cfgChannels :: [String] -- | Directory path under which IRC log files will be placed. Relative to -- the bot process working directory, or absolute. - , logDir :: FilePath + , cfgLogDir :: FilePath -- | Directory path for the state file. This enables Git commits of the -- state file. A relative (to the bot process working dir) or absolute -- path to the Git repository. You must create the directory yourself if -- it doesn't exist, but repo will be auto-created for you if needed. - , stateRepo :: Maybe FilePath + , cfgStateRepo :: Maybe FilePath -- | Filename into the bot state managed by this library will be stored. -- The custom part of the state isn't handled. If 'stateDir' is -- 'Nothing', this is a path relative to the bot process working -- directory, or absolute. Otherwise, it's relative to the 'stateDir'. - , stateFile :: FilePath + , cfgStateFile :: 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 + , cfgSaveInterval :: TimeInterval -- | Filename for the bot's main event log, i.e. produced by the IRC -- event source. - , botEventLogFile :: FilePath + , cfgBotEventLogFile :: FilePath + -- | Filename for writing error messages generated by invalid IRC lines + -- or errors in their analysis or in event detection. Useful for + -- debugging. + , cfgIrcErrorLogFile :: Maybe FilePath -- | Maximal number of characters in a message the bot can send to a user -- or a channel. Longer messages will be split. 'Nothing' means no limit, -- i.e. let the IRC server truncate long messages. This limit applies to -- 'sendToUser' and 'sendToChannel' and all the functions which use them. -- A safe default if you want to set a limit is 400. - , maxMsgChars :: Maybe Int + , cfgMaxMsgChars :: Maybe Int -- | Time interval for sending PINGs to the server, to make sure the -- connection is alive. 'Nothing' means no PINGs sent. - , lagCheck :: Maybe TimeInterval + , cfgLagCheck :: Maybe TimeInterval -- | Maximal lag time allowed before the bot quits. - , lagMax :: TimeInterval + , cfgLagMax :: TimeInterval + -- | Maximal number of messages to count per channel in the message + -- counter. Possibly a bit more will be counted, in cases it doesn't + -- require more memory anyway. If a user misses more than that number N, + -- they will simply be notified \"you missed at least N messages!\". + -- + -- TODO actually right now this is the maximal length of the per-channel + -- log, which includes messages, joins and parts. It's just a tool to + -- limit memory usage, nothing more. + , cfgMaxMsgCount :: Int + -- | IRC messages can be sent to users or channels either instantly, or + -- through a dedicated sender thread. That thread creates a delay + -- between messages, to avoid flooding, since that may result with the + -- server blocking some of the messages. This option sets the time to + -- wait between messages. + , cfgMsgDelay :: TimeInterval } deriving Show @@ -169,6 +196,13 @@ , csetCommands :: [Command e s] } +-- An IRC message to send to a user or a channel. +data IrcMsg = IrcMsg + { msgRecip :: Either NickName ChannelName + , msgLines :: [String] + } + deriving (Show) + -- Read-only bot environment. -- -- The full environment is exposed to commands, which is both power and @@ -185,29 +219,73 @@ , beBehavior :: Behavior e s , beHandle :: Handle , beGetTime :: IO (UTCTime, String) + -- An 'IO' action which reads a periodically updated counter of the + -- number of minutes since the epoch. + , beGetMinute :: IO Int64 , beSaveState :: BotState s -> IO () + , beMsgQueue :: Chan IrcMsg , beCustom :: e } +-- | Message counter log entry. +data MsgCountEntry + -- | Number of messages sent in a channel + = MsgCountMsgs Int + -- | User joined the channel + | MsgCountJoin String + -- | User left the channel + | MsgCountPart String + -- Per-channel modifiable state -data ChannelState = ChannelState - { chanTracking :: Bool - , chanLogger :: Maybe L.Logger +data ChanState = ChanState + { -- Whether user-in-channel tracking is enabled for this channel + csTracking :: Bool + -- Whether message counting is enabled for this channel + , csCounting :: Bool + -- An optional channel-activity-to-text-file logger + , csLogger :: Maybe L.Logger + -- Maximal number of channel message history lines to remember + , csHistoryLines :: Int } +-- | Per-channel information to return to the API user +data ChanInfo = ChanInfo + { -- | Whether user-in-channel tracking is enabled for this channel + ciTrack :: Bool + -- | Whether message counting is enabled for this channel + , ciCount :: Bool + -- | Whether logging-to-file is enabled for this channel + , ciLog :: Bool + -- | Maximal number of channel message history lines to remember + , ciHistoryLines :: Int + } + +-- | A message sent previously by an IRC user into a channel. +data HistoryLine = HistoryLine + { hlTime :: String + , hlNick :: String + , hlMessage :: String + , hlAction :: Bool + , hlMinute :: Int64 + } + -- Readable and writable bot state. Contains internal state used by this -- library, and public state managed by the bot's behavior logic. data BotState s = BotState { -- Keeps track of which users are in which channels - bsTracker :: NetworkTracker + bsTracker :: NetworkTracker -- Per-channel persistent state - , bsChannels :: HashMap String ChannelState + , bsChannels :: HashMap String ChanState -- Channels of which the bot is currently a member - , bsCurrChans :: HashSet String + , bsCurrChans :: HashSet String -- Channels the bot should join when it launches - , bsSelChans :: HashSet String + , bsSelChans :: HashSet String + -- Per-channel last messages + , bsHistory :: HashMap String (Seq HistoryLine) + -- Per-channel message counter log + , bsMsgCountLog :: HashMap String (Seq MsgCountEntry) -- Custom state - , bsPublic :: s + , bsPublic :: s } -- | Bot monad. It provides read-only bot environment (e.g. the configuration), @@ -315,6 +393,11 @@ -- An event passed to the main thread (event handler) from other threads. data Msg a = MsgLogEvent LogEvent + | MsgHistoryEvent String String String Bool + | MsgCountLogMsg String + | MsgCountLogJoin String String + | MsgCountLogPart String String + | MsgCountLogQuit String | MsgBotEvent Event | MsgExtEvent a | MsgQuit diff --git a/src/Network/IRC/Fun/Bot/MsgCount.hs b/src/Network/IRC/Fun/Bot/MsgCount.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/MsgCount.hs @@ -0,0 +1,39 @@ +{- 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 message count. For each channel with +-- counting enabled, the counter system maintains a log which lists counts of +-- message made in the channel, and user join/part events. This log can then +-- be used to determine how many messages were made between events. +module Network.IRC.Fun.Bot.MsgCount + ( -- * Counter Control + startCountingAll + , startCountingChan + , startCountingChans + , stopCountingAll + , stopCountingChan + , stopCountingChans + -- * Queries + , getCountLogs + , getCountLog + , chanIsCounted + , everParted + , everJoined + , countMsgs + , msgsSinceParted + ) +where + +import Network.IRC.Fun.Bot.Internal.MsgCount 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 @@ -21,13 +21,15 @@ , askBehavior , askBehaviorS , askTimeGetter + , getMinutes , askEnv , askEnvS , getState , getStateS , putState , modifyState - , getChannelState + , getHistory + , getChanInfo , selectChannel , unselectChannel , channelSelected 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,10 +17,12 @@ module Network.IRC.Fun.Bot.Types ( Connection (..) , Config (..) - --, Room (..) , Failure (..) , Command (..) , CommandSet (..) + , HistoryLine (..) + , ChanInfo (..) + , MsgCountEntry (..) , Session , EventMatchSpace (..) , Behavior (..)