{-# LANGUAGE DeriveDataTypeable, RecordWildCards, OverloadedStrings #-}
module Network.IRC.Bot.Core
( simpleBot
, simpleBot'
, BotConf(..)
, nullBotConf
, User(..)
, nullUser
) where
import Control.Concurrent (ThreadId, forkIO, threadDelay)
import Control.Concurrent.Chan (Chan, dupChan, newChan, readChan, writeChan)
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TMVar (TMVar, swapTMVar, newTMVar, readTMVar)
import Control.Exception (IOException, catch)
import Control.Monad (mplus, forever, when)
import Control.Monad.Trans (liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C
import Data.Data (Data, Typeable)
import Data.Monoid ((<>))
import Data.Set (Set, empty)
import Data.Time (UTCTime, addUTCTime, getCurrentTime)
import GHC.IO.Handle (hFlushAll)
import Network.Socket hiding (Debug)
import Network.IRC (Message, decode, encode, joinChan, nick, showMessage, user)
import Network.IRC as I
import Network.IRC.Bot.Types (User(..), nullUser)
import Network.IRC.Bot.Limiter (Limiter(..), newLimiter, limit)
import Network.IRC.Bot.Log (Logger, LogLevel(Normal, Debug), stdoutLogger)
import Network.IRC.Bot.BotMonad (BotMonad(logM, sendMessage), BotPartT, BotEnv(..), runBotPartT)
import Network.IRC.Bot.Part.NickUser (changeNickUser)
import Prelude hiding (catch)
import Control.Concurrent.SSem (SSem)
import qualified Control.Concurrent.SSem as SSem
import System.IO (BufferMode(NoBuffering, LineBuffering), Handle, hClose, hGetLine, hPutChar, hSetBuffering, IOMode(..))
data BotConf =
BotConf
{ BotConf -> Maybe (Chan Message -> IO ())
channelLogger :: (Maybe (Chan Message -> IO ()))
, BotConf -> Logger
logger :: Logger
, BotConf -> HostName
host :: HostName
, BotConf -> PortNumber
port :: PortNumber
, BotConf -> ByteString
nick :: ByteString
, BotConf -> HostName
commandPrefix :: String
, BotConf -> User
user :: User
, BotConf -> Set ByteString
channels :: Set ByteString
, BotConf -> Maybe (Int, Int)
limits :: Maybe (Int, Int)
}
nullBotConf :: BotConf
nullBotConf :: BotConf
nullBotConf =
BotConf :: Maybe (Chan Message -> IO ())
-> Logger
-> HostName
-> PortNumber
-> ByteString
-> HostName
-> User
-> Set ByteString
-> Maybe (Int, Int)
-> BotConf
BotConf { channelLogger :: Maybe (Chan Message -> IO ())
channelLogger = Maybe (Chan Message -> IO ())
forall a. Maybe a
Nothing
, logger :: Logger
logger = LogLevel -> Logger
stdoutLogger LogLevel
Normal
, host :: HostName
host = ""
, port :: PortNumber
port = 6667
, nick :: ByteString
nick = ""
, commandPrefix :: HostName
commandPrefix = "#"
, user :: User
user = User
nullUser
, channels :: Set ByteString
channels = Set ByteString
forall a. Set a
empty
, limits :: Maybe (Int, Int)
limits = Maybe (Int, Int)
forall a. Maybe a
Nothing
}
ircConnect :: HostName
-> PortNumber
-> ByteString
-> User
-> IO Handle
ircConnect :: HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnect host :: HostName
host port :: PortNumber
port n :: ByteString
n u :: User
u = do
AddrInfo
addr <- [AddrInfo] -> AddrInfo
forall a. [a] -> a
head ([AddrInfo] -> AddrInfo) -> IO [AddrInfo] -> IO AddrInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo]
getAddrInfo Maybe AddrInfo
forall a. Maybe a
Nothing (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
host) (HostName -> Maybe HostName
forall a. a -> Maybe a
Just (HostName -> Maybe HostName) -> HostName -> Maybe HostName
forall a b. (a -> b) -> a -> b
$ PortNumber -> HostName
forall a. Show a => a -> HostName
show PortNumber
port)
AddrInfo -> IO ()
forall a. Show a => a -> IO ()
print AddrInfo
addr
Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
addr) (AddrInfo -> SocketType
addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
addrProtocol AddrInfo
addr)
Socket -> SockAddr -> IO ()
connect Socket
sock (SockAddr -> IO ()) -> SockAddr -> IO ()
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
addrAddress AddrInfo
addr
Handle
h <- Socket -> IOMode -> IO Handle
socketToHandle Socket
sock IOMode
ReadWriteMode
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h
partLoop :: Logger -> ByteString -> String -> Chan Message -> Chan Message -> (BotPartT IO ()) -> IO ()
partLoop :: Logger
-> ByteString
-> HostName
-> Chan Message
-> Chan Message
-> BotPartT IO ()
-> IO ()
partLoop logger :: Logger
logger botName :: ByteString
botName prefix :: HostName
prefix incomingChan :: Chan Message
incomingChan outgoingChan :: Chan Message
outgoingChan botPart :: BotPartT IO ()
botPart =
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do Message
msg <- Chan Message -> IO Message
forall a. Chan a -> IO a
readChan Chan Message
incomingChan
BotPartT IO () -> BotEnv -> IO ()
forall (m :: * -> *) a. BotPartT m a -> BotEnv -> m a
runBotPartT BotPartT IO ()
botPart (Message
-> Chan Message -> Logger -> ByteString -> HostName -> BotEnv
BotEnv Message
msg Chan Message
outgoingChan Logger
logger ByteString
botName HostName
prefix)
ircLoop :: Logger -> ByteString -> String -> Chan Message -> Chan Message -> [BotPartT IO ()] -> IO [ThreadId]
ircLoop :: Logger
-> ByteString
-> HostName
-> Chan Message
-> Chan Message
-> [BotPartT IO ()]
-> IO [ThreadId]
ircLoop logger :: Logger
logger botName :: ByteString
botName prefix :: HostName
prefix incomingChan :: Chan Message
incomingChan outgoingChan :: Chan Message
outgoingChan parts :: [BotPartT IO ()]
parts =
(BotPartT IO () -> IO ThreadId)
-> [BotPartT IO ()] -> IO [ThreadId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BotPartT IO () -> IO ThreadId
forkPart [BotPartT IO ()]
parts
where
forkPart :: BotPartT IO () -> IO ThreadId
forkPart botPart :: BotPartT IO ()
botPart =
do Chan Message
inChan <- Chan Message -> IO (Chan Message)
forall a. Chan a -> IO (Chan a)
dupChan Chan Message
incomingChan
IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Logger
-> ByteString
-> HostName
-> Chan Message
-> Chan Message
-> BotPartT IO ()
-> IO ()
partLoop Logger
logger ByteString
botName HostName
prefix Chan Message
inChan Chan Message
outgoingChan (BotPartT IO ()
botPart BotPartT IO () -> BotPartT IO () -> BotPartT IO ()
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` () -> BotPartT IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
connectionLoop :: Logger -> Maybe (Int, Int) -> TMVar UTCTime -> HostName -> PortNumber -> ByteString -> User -> Chan Message -> Chan Message -> Maybe (Chan Message) -> SSem -> IO (ThreadId, ThreadId, Maybe ThreadId, IO ())
connectionLoop :: Logger
-> Maybe (Int, Int)
-> TMVar UTCTime
-> HostName
-> PortNumber
-> ByteString
-> User
-> Chan Message
-> Chan Message
-> Maybe (Chan Message)
-> SSem
-> IO (ThreadId, ThreadId, Maybe ThreadId, IO ())
connectionLoop logger :: Logger
logger mLimitConf :: Maybe (Int, Int)
mLimitConf tmv :: TMVar UTCTime
tmv host :: HostName
host port :: PortNumber
port nick :: ByteString
nick user :: User
user outgoingChan :: Chan Message
outgoingChan incomingChan :: Chan Message
incomingChan logChan :: Maybe (Chan Message)
logChan connSSem :: SSem
connSSem =
do TMVar Handle
hTMVar <- STM (TMVar Handle) -> IO (TMVar Handle)
forall a. STM a -> IO a
atomically (STM (TMVar Handle) -> IO (TMVar Handle))
-> STM (TMVar Handle) -> IO (TMVar Handle)
forall a b. (a -> b) -> a -> b
$ Handle -> STM (TMVar Handle)
forall a. a -> STM (TMVar a)
newTMVar (Handle
forall a. HasCallStack => a
undefined :: Handle)
(limit :: IO ()
limit, limitTid :: Maybe ThreadId
limitTid) <-
case Maybe (Int, Int)
mLimitConf of
Nothing -> (IO (), Maybe ThreadId) -> IO (IO (), Maybe ThreadId)
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), Maybe ThreadId
forall a. Maybe a
Nothing)
(Just (burst :: Int
burst, delay :: Int
delay)) ->
do Limiter
limiter <- Int -> Int -> IO Limiter
newLimiter Int
burst Int
delay
(IO (), Maybe ThreadId) -> IO (IO (), Maybe ThreadId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Limiter -> IO ()
limit Limiter
limiter, ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just (ThreadId -> Maybe ThreadId) -> ThreadId -> Maybe ThreadId
forall a b. (a -> b) -> a -> b
$ Limiter -> ThreadId
limitsThreadId Limiter
limiter)
ThreadId
outgoingTid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO UTCTime -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall a b. (a -> b) -> a -> b
$
do Message
msg <- Chan Message -> IO Message
forall a. Chan a -> IO a
readChan Chan Message
outgoingChan
Maybe (Chan Message) -> Message -> IO ()
forall a. Maybe (Chan a) -> a -> IO ()
writeMaybeChan Maybe (Chan Message)
logChan Message
msg
Handle
h <- STM Handle -> IO Handle
forall a. STM a -> IO a
atomically (STM Handle -> IO Handle) -> STM Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ TMVar Handle -> STM Handle
forall a. TMVar a -> STM a
readTMVar TMVar Handle
hTMVar
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> ByteString
msg_command Message
msg ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["PRIVMSG", "NOTICE"]) IO ()
limit
Handle -> ByteString -> IO ()
C.hPutStr Handle
h (Message -> ByteString
encode Message
msg) IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (Logger
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IOException
-> IO ()
reconnect Logger
logger HostName
host PortNumber
port ByteString
nick User
user TMVar Handle
hTMVar SSem
connSSem)
Handle -> Char -> IO ()
hPutChar Handle
h '\n'
UTCTime
now <- IO UTCTime
getCurrentTime
STM UTCTime -> IO UTCTime
forall a. STM a -> IO a
atomically (STM UTCTime -> IO UTCTime) -> STM UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ TMVar UTCTime -> UTCTime -> STM UTCTime
forall a. TMVar a -> a -> STM a
swapTMVar TMVar UTCTime
tmv UTCTime
now
ThreadId
incomingTid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
Logger
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IO ()
forall a.
(LogLevel -> ByteString -> IO a)
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IO ()
doConnect Logger
logger HostName
host PortNumber
port ByteString
nick User
user TMVar Handle
hTMVar SSem
connSSem
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do Handle
h <- STM Handle -> IO Handle
forall a. STM a -> IO a
atomically (STM Handle -> IO Handle) -> STM Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ TMVar Handle -> STM Handle
forall a. TMVar a -> STM a
readTMVar TMVar Handle
hTMVar
ByteString
msgStr <- (Handle -> IO ByteString
C.hGetLine Handle
h) IO ByteString -> (IOException -> IO ByteString) -> IO ByteString
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\e :: IOException
e -> Logger
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IOException
-> IO ()
reconnect Logger
logger HostName
host PortNumber
port ByteString
nick User
user TMVar Handle
hTMVar SSem
connSSem IOException
e IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return "")
UTCTime
now <- IO UTCTime
getCurrentTime
STM UTCTime -> IO UTCTime
forall a. STM a -> IO a
atomically (STM UTCTime -> IO UTCTime) -> STM UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ TMVar UTCTime -> UTCTime -> STM UTCTime
forall a. TMVar a -> a -> STM a
swapTMVar TMVar UTCTime
tmv UTCTime
now
case ByteString -> Maybe Message
decode (ByteString
msgStr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> "\n") of
Nothing -> Logger
logger LogLevel
Normal ("decode failed: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msgStr)
(Just msg :: Message
msg) ->
do Logger
logger LogLevel
Debug (Message -> ByteString
showMessage Message
msg)
Maybe (Chan Message) -> Message -> IO ()
forall a. Maybe (Chan a) -> a -> IO ()
writeMaybeChan Maybe (Chan Message)
logChan Message
msg
Chan Message -> Message -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan Message
incomingChan Message
msg
let forceReconnect :: IO ()
forceReconnect =
do HostName -> IO ()
putStrLn "forceReconnect: getting handle"
Handle
h <- STM Handle -> IO Handle
forall a. STM a -> IO a
atomically (STM Handle -> IO Handle) -> STM Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ TMVar Handle -> STM Handle
forall a. TMVar a -> STM a
readTMVar TMVar Handle
hTMVar
HostName -> IO ()
putStrLn "forceReconnect: sending /quit"
Chan Message -> Message -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan Message
outgoingChan (Maybe ByteString -> Message
quit (Maybe ByteString -> Message) -> Maybe ByteString -> Message
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just "restarting...")
HostName -> IO ()
putStrLn "forceReconnect: closing handle"
Handle -> IO ()
hClose Handle
h
HostName -> IO ()
putStrLn "done."
(ThreadId, ThreadId, Maybe ThreadId, IO ())
-> IO (ThreadId, ThreadId, Maybe ThreadId, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadId
outgoingTid, ThreadId
incomingTid, Maybe ThreadId
limitTid, IO ()
forceReconnect)
ircConnectLoop :: (LogLevel -> ByteString -> IO a)
-> HostName
-> PortNumber
-> ByteString
-> User
-> IO Handle
ircConnectLoop :: (LogLevel -> ByteString -> IO a)
-> HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnectLoop logger :: LogLevel -> ByteString -> IO a
logger host :: HostName
host port :: PortNumber
port nick :: ByteString
nick user :: User
user =
(HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnect HostName
host PortNumber
port ByteString
nick User
user) IO Handle -> (IOException -> IO Handle) -> IO Handle
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
(\e :: IOException
e ->
do LogLevel -> ByteString -> IO a
logger LogLevel
Normal (ByteString -> IO a) -> ByteString -> IO a
forall a b. (a -> b) -> a -> b
$ "irc connect failed ... retry in 60 seconds: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (HostName -> ByteString
C.pack (HostName -> ByteString) -> HostName -> ByteString
forall a b. (a -> b) -> a -> b
$ IOException -> HostName
forall a. Show a => a -> HostName
show (IOException
e :: IOException))
Int -> IO ()
threadDelay (60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 10Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^6)
(LogLevel -> ByteString -> IO a)
-> HostName -> PortNumber -> ByteString -> User -> IO Handle
forall a.
(LogLevel -> ByteString -> IO a)
-> HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnectLoop LogLevel -> ByteString -> IO a
logger HostName
host PortNumber
port ByteString
nick User
user)
doConnect :: (LogLevel -> ByteString -> IO a) -> HostName -> PortNumber -> ByteString -> User -> TMVar Handle -> SSem -> IO ()
doConnect :: (LogLevel -> ByteString -> IO a)
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IO ()
doConnect logger :: LogLevel -> ByteString -> IO a
logger host :: HostName
host port :: PortNumber
port nick :: ByteString
nick user :: User
user hTMVar :: TMVar Handle
hTMVar connSSem :: SSem
connSSem =
do LogLevel -> ByteString -> IO a
logger LogLevel
Normal (ByteString -> IO a) -> ByteString -> IO a
forall a b. (a -> b) -> a -> b
$ "Connecting to " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (HostName -> ByteString
C.pack HostName
host) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> " as " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
nick
Handle
h <- (LogLevel -> ByteString -> IO a)
-> HostName -> PortNumber -> ByteString -> User -> IO Handle
forall a.
(LogLevel -> ByteString -> IO a)
-> HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnectLoop LogLevel -> ByteString -> IO a
logger HostName
host PortNumber
port ByteString
nick User
user
STM Handle -> IO Handle
forall a. STM a -> IO a
atomically (STM Handle -> IO Handle) -> STM Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ TMVar Handle -> Handle -> STM Handle
forall a. TMVar a -> a -> STM a
swapTMVar TMVar Handle
hTMVar Handle
h
LogLevel -> ByteString -> IO a
logger LogLevel
Normal (ByteString -> IO a) -> ByteString -> IO a
forall a b. (a -> b) -> a -> b
$ "Connected."
SSem -> IO ()
SSem.signal SSem
connSSem
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reconnect :: Logger -> HostName -> PortNumber -> ByteString -> User -> TMVar Handle -> SSem -> IOException -> IO ()
reconnect :: Logger
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IOException
-> IO ()
reconnect logger :: Logger
logger host :: HostName
host port :: PortNumber
port nick :: ByteString
nick user :: User
user hTMVar :: TMVar Handle
hTMVar connSSem :: SSem
connSSem e :: IOException
e =
do Logger
logger LogLevel
Normal (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ "IRC Connection died: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> HostName -> ByteString
C.pack (IOException -> HostName
forall a. Show a => a -> HostName
show IOException
e)
Logger
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IO ()
forall a.
(LogLevel -> ByteString -> IO a)
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IO ()
doConnect Logger
logger HostName
host PortNumber
port ByteString
nick User
user TMVar Handle
hTMVar SSem
connSSem
onConnectLoop :: Logger -> ByteString -> String -> Chan Message -> SSem -> BotPartT IO () -> IO ThreadId
onConnectLoop :: Logger
-> ByteString
-> HostName
-> Chan Message
-> SSem
-> BotPartT IO ()
-> IO ThreadId
onConnectLoop logger :: Logger
logger botName :: ByteString
botName prefix :: HostName
prefix outgoingChan :: Chan Message
outgoingChan connSSem :: SSem
connSSem action :: BotPartT IO ()
action =
IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do SSem -> IO ()
SSem.wait SSem
connSSem
BotPartT IO () -> BotEnv -> IO ()
forall (m :: * -> *) a. BotPartT m a -> BotEnv -> m a
runBotPartT BotPartT IO ()
action (Message
-> Chan Message -> Logger -> ByteString -> HostName -> BotEnv
BotEnv Message
forall a. HasCallStack => a
undefined Chan Message
outgoingChan Logger
logger ByteString
botName HostName
prefix)
simpleBot :: BotConf
-> [BotPartT IO ()]
-> IO ([ThreadId], IO ())
simpleBot :: BotConf -> [BotPartT IO ()] -> IO ([ThreadId], IO ())
simpleBot BotConf{..} parts :: [BotPartT IO ()]
parts =
Maybe (Chan Message -> IO ())
-> Logger
-> Maybe (Int, Int)
-> HostName
-> PortNumber
-> ByteString
-> HostName
-> User
-> [BotPartT IO ()]
-> IO ([ThreadId], IO ())
simpleBot' Maybe (Chan Message -> IO ())
channelLogger Logger
logger Maybe (Int, Int)
limits HostName
host PortNumber
port ByteString
nick HostName
commandPrefix User
user [BotPartT IO ()]
parts
simpleBot' :: (Maybe (Chan Message -> IO ()))
-> Logger
-> Maybe (Int, Int)
-> HostName
-> PortNumber
-> ByteString
-> String
-> User
-> [BotPartT IO ()]
-> IO ([ThreadId], IO ())
simpleBot' :: Maybe (Chan Message -> IO ())
-> Logger
-> Maybe (Int, Int)
-> HostName
-> PortNumber
-> ByteString
-> HostName
-> User
-> [BotPartT IO ()]
-> IO ([ThreadId], IO ())
simpleBot' mChanLogger :: Maybe (Chan Message -> IO ())
mChanLogger logger :: Logger
logger limitConf :: Maybe (Int, Int)
limitConf host :: HostName
host port :: PortNumber
port nick :: ByteString
nick prefix :: HostName
prefix user :: User
user parts :: [BotPartT IO ()]
parts =
do (mLogTid :: Maybe ThreadId
mLogTid, mLogChan :: Maybe (Chan Message)
mLogChan) <-
case Maybe (Chan Message -> IO ())
mChanLogger of
Nothing -> (Maybe ThreadId, Maybe (Chan Message))
-> IO (Maybe ThreadId, Maybe (Chan Message))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ThreadId
forall a. Maybe a
Nothing, Maybe (Chan Message)
forall a. Maybe a
Nothing)
(Just chanLogger :: Chan Message -> IO ()
chanLogger) ->
do Chan Message
logChan <- IO (Chan Message)
forall a. IO (Chan a)
newChan :: IO (Chan Message)
ThreadId
logTid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Chan Message -> IO ()
chanLogger Chan Message
logChan
(Maybe ThreadId, Maybe (Chan Message))
-> IO (Maybe ThreadId, Maybe (Chan Message))
forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
logTid, Chan Message -> Maybe (Chan Message)
forall a. a -> Maybe a
Just Chan Message
logChan)
Chan Message
outgoingChan <- IO (Chan Message)
forall a. IO (Chan a)
newChan :: IO (Chan Message)
Chan Message
incomingChan <- IO (Chan Message)
forall a. IO (Chan a)
newChan :: IO (Chan Message)
UTCTime
now <- IO UTCTime
getCurrentTime
TMVar UTCTime
tmv <- STM (TMVar UTCTime) -> IO (TMVar UTCTime)
forall a. STM a -> IO a
atomically (STM (TMVar UTCTime) -> IO (TMVar UTCTime))
-> STM (TMVar UTCTime) -> IO (TMVar UTCTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> STM (TMVar UTCTime)
forall a. a -> STM (TMVar a)
newTMVar UTCTime
now
SSem
connSSem <- Int -> IO SSem
SSem.new 0
(outgoingTid :: ThreadId
outgoingTid, incomingTid :: ThreadId
incomingTid, mLimitTid :: Maybe ThreadId
mLimitTid, forceReconnect :: IO ()
forceReconnect) <- Logger
-> Maybe (Int, Int)
-> TMVar UTCTime
-> HostName
-> PortNumber
-> ByteString
-> User
-> Chan Message
-> Chan Message
-> Maybe (Chan Message)
-> SSem
-> IO (ThreadId, ThreadId, Maybe ThreadId, IO ())
connectionLoop Logger
logger Maybe (Int, Int)
limitConf TMVar UTCTime
tmv HostName
host PortNumber
port ByteString
nick User
user Chan Message
outgoingChan Chan Message
incomingChan Maybe (Chan Message)
mLogChan SSem
connSSem
ThreadId
watchDogTid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do let timeout :: Integer
timeout = 5Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*60
UTCTime
now <- IO UTCTime
getCurrentTime
UTCTime
lastActivity <- STM UTCTime -> IO UTCTime
forall a. STM a -> IO a
atomically (STM UTCTime -> IO UTCTime) -> STM UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ TMVar UTCTime -> STM UTCTime
forall a. TMVar a -> STM a
readTMVar TMVar UTCTime
tmv
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UTCTime
now UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Integer -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
timeout) UTCTime
lastActivity) IO ()
forceReconnect
Int -> IO ()
threadDelay (30Int -> Int -> Int
forall a. Num a => a -> a -> a
*10Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^6)
[ThreadId]
ircTids <- Logger
-> ByteString
-> HostName
-> Chan Message
-> Chan Message
-> [BotPartT IO ()]
-> IO [ThreadId]
ircLoop Logger
logger ByteString
nick HostName
prefix Chan Message
incomingChan Chan Message
outgoingChan [BotPartT IO ()]
parts
ThreadId
onConnectId <- Logger
-> ByteString
-> HostName
-> Chan Message
-> SSem
-> BotPartT IO ()
-> IO ThreadId
onConnectLoop Logger
logger ByteString
nick HostName
prefix Chan Message
outgoingChan SSem
connSSem BotPartT IO ()
onConnect
([ThreadId], IO ()) -> IO ([ThreadId], IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (([ThreadId], IO ()) -> IO ([ThreadId], IO ()))
-> ([ThreadId], IO ()) -> IO ([ThreadId], IO ())
forall a b. (a -> b) -> a -> b
$ (([ThreadId] -> [ThreadId])
-> (ThreadId -> [ThreadId] -> [ThreadId])
-> Maybe ThreadId
-> [ThreadId]
-> [ThreadId]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ThreadId] -> [ThreadId]
forall a. a -> a
id (:) Maybe ThreadId
mLimitTid ([ThreadId] -> [ThreadId]) -> [ThreadId] -> [ThreadId]
forall a b. (a -> b) -> a -> b
$ ([ThreadId] -> [ThreadId])
-> (ThreadId -> [ThreadId] -> [ThreadId])
-> Maybe ThreadId
-> [ThreadId]
-> [ThreadId]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ThreadId] -> [ThreadId]
forall a. a -> a
id (:) Maybe ThreadId
mLogTid ([ThreadId] -> [ThreadId]) -> [ThreadId] -> [ThreadId]
forall a b. (a -> b) -> a -> b
$ (ThreadId
incomingTid ThreadId -> [ThreadId] -> [ThreadId]
forall a. a -> [a] -> [a]
: ThreadId
outgoingTid ThreadId -> [ThreadId] -> [ThreadId]
forall a. a -> [a] -> [a]
: ThreadId
watchDogTid ThreadId -> [ThreadId] -> [ThreadId]
forall a. a -> [a] -> [a]
: [ThreadId]
ircTids), IO ()
forceReconnect)
where
onConnect :: BotPartT IO ()
onConnect :: BotPartT IO ()
onConnect =
ByteString -> Maybe User -> BotPartT IO ()
forall (m :: * -> *).
BotMonad m =>
ByteString -> Maybe User -> m ()
changeNickUser ByteString
nick (User -> Maybe User
forall a. a -> Maybe a
Just User
user)
writeMaybeChan :: Maybe (Chan a) -> a -> IO ()
writeMaybeChan :: Maybe (Chan a) -> a -> IO ()
writeMaybeChan Nothing _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeMaybeChan (Just chan :: Chan a
chan) a :: a
a = Chan a -> a -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan a
chan a
a