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, forever, void, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.RWS (ask)
import Data.List (transpose)
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, 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))
defConfig :: Config
defConfig = Config
{ cfgConnection = Connection
{ connServer = "irc.freenode.net"
, connPort = 6667
, connTls = False
, connNick = "bot_test_joe"
, connPassword = Nothing
}
, 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)
}
startBot :: Session e s ()
startBot = do
liftIO $ putStrLn "Bot: Logging in as IRC user with nickname"
login
liftIO $ putStrLn "Bot: Joining IRC channels"
joinConfig
listenToEvent :: Chan (Msg a)
-> EventHandler e s a
-> Session e s Bool
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
getNow :: IO TimeSpec
getNow = getTime Realtime
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)
(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 $ getEvents $ beHandle bot
case r of
Left e -> do
putStrLn "Bot: IRC event listener hGetIrcEvents IO error"
print e
writeChan chan MsgQuit
Right (errs, ircEvents) -> do
let botEvents = map match ircEvents
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
now <- getNow
void $ tryTakeMVar pongvar
putMVar pongvar now
mapM_ (logLine logger . show) botEvents
case elogger of
Nothing -> return ()
Just lg -> mapM_ (logLine lg) errs
writeList2Chan chan interleaved
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
}
manageLag :: BotEnv e s
-> Chan (Msg a)
-> MVar TimeSpec
-> IO ()
manageLag bot chan pongvar =
case cfgLagCheck $ beConfig bot of
Nothing -> return ()
Just iv -> do
putStrLn "Bot: IRC lag manager thread running"
let maxdiff = intervalToSpec $ cfgLagMax $ 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 =
connServer $ cfgConnection $ beConfig bot
hPutIrc (beHandle bot) $ PingMessage serv Nothing
threadDelay $ fromInteger $ microseconds iv
loop pong
loop =<< getNow
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
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 $ sendMessages bot
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
runBot :: Config
-> [EventMatcher e s]
-> Behavior e s
-> [EventSource e s a]
-> EventHandler e s a
-> e
-> s
-> Session e s ()
-> 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"