irc-fun-bot-0.4.0.0: src/Network/IRC/Fun/Bot.hs
{- 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 allows you to define bot event handlers and commands, and then
-- just run event source and sink threads in your @main@ function and let them
-- handle all the details.
module Network.IRC.Fun.Bot
( defConfig
, runBot
)
where
import Control.Concurrent (threadDelay, forkIO)
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Control.Monad (liftM, 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.Time.Interval
import Data.Time.Units
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.Bot.Types (Connection (..))
import Network.IRC.Fun.Client.ChannelLogger (fromClientEvent)
import Network.IRC.Fun.Client.Events (hGetIrcEvents)
import Network.IRC.Fun.Client.IO (hPutIrc)
import Network.IRC.Fun.Messages.Types (Message (PingMessage))
import System.Clock
import System.IO.Error (tryIOError)
import qualified Network.IRC.Fun.Client.Events as C (Event (Pong))
-- | A default bot configuration. You can use it with record syntax to override
-- just the fields you need. It also allows your code to remain valid when a
-- new config option is added, since you won't be using the 'Config'
-- constructor directy.
--
-- In the future the constructor may be removed, and then this function will be
-- the only way to create a configuration. It allows adding a field without
-- 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
}
, 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)
}
-- Get the bot ready for listening to IRC messages.
startBot :: Session e s ()
startBot = do
liftIO $ putStrLn "Bot: Logging in as IRC user with nickname"
login
liftIO $ putStrLn "Bot: Joining IRC channels"
joinConfig
-- Wait for an IRC event, then handle it according to bot behavior definition.
-- Return whether listening should continue.
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
-- Get time since epoch.
getNow :: IO TimeSpec
getNow = getTime Realtime
-- Collect IRC events from the server and push into a 'Chan' for the main
-- thread to handle.
listenToIrc :: [EventMatcher e s]
-> BotEnv e s
-> Chan (Msg a)
-> MVar TimeSpec
-> IO ()
listenToIrc ms bot chan pongvar = do
logger <-
newLogger (liftM snd $ beGetTime bot) (botEventLogFile $ beConfig bot)
putStrLn "Bot: IRC event source listening to IRC events"
let match e = matchEvent ms e (beConfig bot) (commandSets $ beBehavior bot)
loop = do
r <- tryIOError $ hGetIrcEvents $ beHandle bot
case r of
Left e -> do
putStrLn "Bot: IRC event listener hGetIrcEvents IO error"
print e
writeChan chan MsgQuit
Right ircEvents -> do
let botEvents = map match ircEvents
logEvents = catMaybes $ map fromClientEvent ircEvents
interleave logs bots = concat $ transpose
[map MsgLogEvent logs, map MsgBotEvent bots]
isPong (C.Pong _ _) = True
isPong _ = False
when (any isPong ircEvents) $ do
now <- getNow
void $ tryTakeMVar pongvar
putMVar pongvar now
mapM_ (logLine logger . show) botEvents
writeList2Chan chan $ interleave logEvents botEvents
loop
loop
intervalToSpec :: TimeInterval -> TimeSpec
intervalToSpec ti =
let t = microseconds ti
(s, us) = t `divMod` (1000 * 1000)
in TimeSpec
{ sec = fromInteger s
, nsec = 1000 * fromInteger us
}
-- Send pings periodically to the server, and track the latest PONGs received,
-- as reported by the receiver thread. If it has been long enough since the
-- last PONG, tell the main thread to shut down.
manageLag :: BotEnv e s
-> Chan (Msg a)
-> MVar TimeSpec
-> IO ()
manageLag bot chan pongvar =
case lagCheck $ beConfig bot of
Nothing -> return ()
Just iv -> do
putStrLn "Bot: IRC lag manager thread running"
let maxdiff = intervalToSpec $ lagMax $ beConfig bot
loop prev = do
mpong <- tryTakeMVar pongvar
let pong = fromMaybe prev mpong
now <- getNow
if now - pong > maxdiff
then do
putStrLn "Bot: IRC max lag reached"
writeChan chan MsgQuit
else do
let serv = server $ connection $ beConfig bot
hPutIrc (beHandle bot) $ PingMessage serv Nothing
threadDelay $ fromInteger $ microseconds iv
loop pong
loop =<< getNow
-- Connect, login, join. Then listen to events and handle them, forever.
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
pongvar <- liftIO newEmptyMVar
liftIO $ void $ forkIO $ listenToIrc matchers bot chan pongvar
liftIO $ void $ forkIO $ manageLag bot chan pongvar
let launch s = forkIO $ s (beConfig bot)
(beCustom bot)
(writeChan chan . MsgExtEvent)
(writeList2Chan chan . map MsgExtEvent)
(newLogger $ liftM snd $ beGetTime bot)
liftIO $ mapM_ launch sources
startBot
liftIO $ putStrLn "Bot: Event sink listening to events"
let loop = do
proceed <- listenToEvent chan handler
if proceed
then loop
else liftIO $ putStrLn "Bot: Event sink asked to stop"
loop
-- | Start the bot and run its event loop. The bot will listen to messages from
-- 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 matchers behav sources handler env state actInit = do
putStrLn "Bot: Starting"
run conf behav env state $ botSession matchers sources handler actInit
putStrLn "Bot: Disconnected"