irc-fun-bot 0.1.0.0 → 0.2.0.0
raw patch · 19 files changed
+1219/−116 lines, 19 filesdep +aesondep +fast-loggerdep +settingsdep ~irc-fun-clientPVP ok
version bump matches the API change (PVP)
Dependencies added: aeson, fast-logger, settings, time, time-interval, time-units, unordered-containers
Dependency ranges changed: irc-fun-client
API changes (from Hackage documentation)
+ Network.IRC.Fun.Bot.EventMatch: defaultMatch :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchNotice :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchNoticeC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchNoticeP :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchPlainPrivateCommand :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchPrefixedCommand :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchPrefixedCommandC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchPrefixedCommandP :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRef :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommand :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromNames :: [String] -> EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromNamesC :: [String] -> EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromNamesP :: [String] -> EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromSet :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromSetC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromSetP :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandP :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefP :: EventMatcher e s
+ Network.IRC.Fun.Bot.IrcLog: channelIsLogged :: String -> Session e s Bool
+ Network.IRC.Fun.Bot.IrcLog: startLoggingAll :: Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: startLoggingChannel :: String -> Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: startLoggingChannels :: [String] -> Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: stopLoggingAll :: Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: stopLoggingChannel :: String -> Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: stopLoggingChannels :: [String] -> Session e s ()
+ Network.IRC.Fun.Bot.Logger: data Logger
+ Network.IRC.Fun.Bot.Logger: logLine :: ToLogStr s => Logger -> s -> IO ()
+ Network.IRC.Fun.Bot.Logger: newLogger :: IO String -> FilePath -> IO Logger
+ Network.IRC.Fun.Bot.Logger: newLogger' :: FilePath -> Session e s Logger
+ Network.IRC.Fun.Bot.Logger: removeLogger :: Logger -> IO ()
+ Network.IRC.Fun.Bot.Nicks: channelIsTracked :: String -> Session e s Bool
+ Network.IRC.Fun.Bot.Nicks: isInChannel :: String -> String -> Session e s Bool
+ Network.IRC.Fun.Bot.Nicks: presence :: String -> Session e s [ChannelName]
+ Network.IRC.Fun.Bot.Nicks: startTrackingAll :: Session e s ()
+ Network.IRC.Fun.Bot.Nicks: startTrackingChannel :: String -> Session e s ()
+ Network.IRC.Fun.Bot.Nicks: startTrackingChannels :: [String] -> Session e s ()
+ Network.IRC.Fun.Bot.Nicks: stopTrackingAll :: Session e s ()
+ Network.IRC.Fun.Bot.Nicks: stopTrackingChannel :: String -> Session e s ()
+ Network.IRC.Fun.Bot.Nicks: stopTrackingChannels :: [String] -> Session e s ()
+ Network.IRC.Fun.Bot.State: askTimeGetter :: Session e s (IO (UTCTime, String))
+ Network.IRC.Fun.Bot.State: getChannelState :: Session e s (HashMap String (Bool, Bool))
+ Network.IRC.Fun.Bot.State: saveBotState :: Session e s ()
+ Network.IRC.Fun.Bot.Types: botEventLogFile :: Config -> FilePath
+ Network.IRC.Fun.Bot.Types: logDir :: Config -> FilePath
+ Network.IRC.Fun.Bot.Types: saveInterval :: Config -> TimeInterval
+ Network.IRC.Fun.Bot.Types: stateFile :: Config -> FilePath
- Network.IRC.Fun.Bot: runBot :: Config -> Behavior e s -> [EventSource e s a] -> EventHandler e s a -> e -> s -> IO ()
+ Network.IRC.Fun.Bot: runBot :: Config -> [EventMatcher e s] -> Behavior e s -> [EventSource e s a] -> EventHandler e s a -> e -> s -> Session e s () -> IO ()
- Network.IRC.Fun.Bot.Types: Config :: Connection -> [String] -> Config
+ Network.IRC.Fun.Bot.Types: Config :: Connection -> [String] -> FilePath -> FilePath -> TimeInterval -> FilePath -> Config
- Network.IRC.Fun.Bot.Types: type EventSource e s a = Config -> e -> (a -> IO ()) -> ([a] -> IO ()) -> IO ()
+ Network.IRC.Fun.Bot.Types: type EventSource e s a = Config -> e -> (a -> IO ()) -> ([a] -> IO ()) -> (FilePath -> IO Logger) -> IO ()
Files
- NEWS +36/−0
- irc-fun-bot.cabal +24/−7
- src/Network/IRC/Fun/Bot.hs +36/−14
- src/Network/IRC/Fun/Bot/Behavior.hs +1/−1
- src/Network/IRC/Fun/Bot/EventMatch.hs +53/−0
- src/Network/IRC/Fun/Bot/Internal/Chat.hs +10/−1
- src/Network/IRC/Fun/Bot/Internal/Event.hs +384/−71
- src/Network/IRC/Fun/Bot/Internal/Failure.hs +7/−5
- src/Network/IRC/Fun/Bot/Internal/IrcLog.hs +119/−0
- src/Network/IRC/Fun/Bot/Internal/Logger.hs +66/−0
- src/Network/IRC/Fun/Bot/Internal/Nicks.hs +166/−0
- src/Network/IRC/Fun/Bot/Internal/Persist.hs +107/−0
- src/Network/IRC/Fun/Bot/Internal/State.hs +46/−3
- src/Network/IRC/Fun/Bot/Internal/Types.hs +70/−14
- src/Network/IRC/Fun/Bot/IrcLog.hs +28/−0
- src/Network/IRC/Fun/Bot/Logger.hs +26/−0
- src/Network/IRC/Fun/Bot/Nicks.hs +35/−0
- src/Network/IRC/Fun/Bot/State.hs +4/−0
- src/Network/IRC/Fun/Bot/Types.hs +1/−0
NEWS view
@@ -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 =================================
irc-fun-bot.cabal view
@@ -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
src/Network/IRC/Fun/Bot.hs view
@@ -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"
src/Network/IRC/Fun/Bot/Behavior.hs view
@@ -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
+ src/Network/IRC/Fun/Bot/EventMatch.hs view
@@ -0,0 +1,53 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ 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+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- | 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
src/Network/IRC/Fun/Bot/Internal/Chat.hs view
@@ -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.
src/Network/IRC/Fun/Bot/Internal/Event.hs view
@@ -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
src/Network/IRC/Fun/Bot/Internal/Failure.hs view
@@ -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
+ src/Network/IRC/Fun/Bot/Internal/IrcLog.hs view
@@ -0,0 +1,119 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ 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+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++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
+ src/Network/IRC/Fun/Bot/Internal/Logger.hs view
@@ -0,0 +1,66 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ 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+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++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
+ src/Network/IRC/Fun/Bot/Internal/Nicks.hs view
@@ -0,0 +1,166 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ 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+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++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
+ src/Network/IRC/Fun/Bot/Internal/Persist.hs view
@@ -0,0 +1,107 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ 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+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- 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
src/Network/IRC/Fun/Bot/Internal/State.hs view
@@ -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 }
src/Network/IRC/Fun/Bot/Internal/Types.hs view
@@ -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
+ src/Network/IRC/Fun/Bot/IrcLog.hs view
@@ -0,0 +1,28 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ 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+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- | 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
+ src/Network/IRC/Fun/Bot/Logger.hs view
@@ -0,0 +1,26 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ 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+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++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
+ src/Network/IRC/Fun/Bot/Nicks.hs view
@@ -0,0 +1,35 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ 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+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- | 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
src/Network/IRC/Fun/Bot/State.hs view
@@ -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
src/Network/IRC/Fun/Bot/Types.hs view
@@ -17,6 +17,7 @@ module Network.IRC.Fun.Bot.Types ( Connection (..) , Config (..)+ --, Room (..) , Failure (..) , Command (..) , CommandSet (..)