{-# LANGUAGE 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, void, when)
import Data.ByteString          (ByteString)
import qualified Data.ByteString.Char8 as C
import Data.Set                 (Set, empty)
import Data.Time                (UTCTime, addUTCTime, getCurrentTime)
import Network.Socket           hiding (Debug)
import Network.IRC              (Message, decode, encode, showMessage, msg_command, quit)
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 (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(LineBuffering), Handle, hClose, hPutChar, hSetBuffering, IOMode(..))

-- |Bot configuration
data BotConf =
    BotConf
    { BotConf -> Maybe (Chan Message -> IO ())
channelLogger :: (Maybe (Chan Message -> IO ()))  -- ^ optional channel logging function
    , BotConf -> Logger
logger        :: Logger           -- ^ app logging
    , BotConf -> HostName
host          :: HostName         -- ^ irc server to connect
    , BotConf -> PortNumber
port          :: PortNumber       -- ^ irc port to connect to (usually, 'PortNumber 6667')
    , BotConf -> ByteString
nick          :: ByteString       -- ^ irc nick
    , BotConf -> HostName
commandPrefix :: String           -- ^ command prefix
    , BotConf -> User
user          :: User             -- ^ irc user info
    , BotConf -> Set ByteString
channels      :: Set ByteString   -- ^ channel to join
    , BotConf -> Maybe (Int, Int)
limits        :: Maybe (Int, Int) -- ^ (burst length, delay in microseconds)
    }

nullBotConf :: BotConf
nullBotConf :: BotConf
nullBotConf =
    BotConf { channelLogger :: Maybe (Chan Message -> IO ())
channelLogger  = forall a. Maybe a
Nothing
            , logger :: Logger
logger         = LogLevel -> Logger
stdoutLogger LogLevel
Normal
            , host :: HostName
host           = HostName
""
            , port :: PortNumber
port           = PortNumber
6667
            , nick :: ByteString
nick           = ByteString
""
            , commandPrefix :: HostName
commandPrefix  = HostName
"#"
            , user :: User
user           = User
nullUser
            , channels :: Set ByteString
channels       = forall a. Set a
empty
            , limits :: Maybe (Int, Int)
limits         = forall a. Maybe a
Nothing
            }

-- | connect to irc server and send NICK and USER commands
ircConnect :: HostName
           -> PortNumber
           -> ByteString
           -> User
           -> IO Handle
ircConnect :: HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnect HostName
host PortNumber
port ByteString
_n User
_u = do
    AddrInfo
addr <- forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo]
getAddrInfo forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just HostName
host) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> HostName
show PortNumber
port)
    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 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
    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 ByteString
botName HostName
prefix Chan Message
incomingChan Chan Message
outgoingChan BotPartT IO ()
botPart =
  forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do Message
msg <- forall a. Chan a -> IO a
readChan Chan Message
incomingChan
               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 ByteString
botName HostName
prefix Chan Message
incomingChan Chan Message
outgoingChan [BotPartT IO ()]
parts =
    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 BotPartT IO ()
botPart =
      do Chan Message
inChan <- forall a. Chan a -> IO (Chan a)
dupChan Chan Message
incomingChan
         IO () -> IO ThreadId
forkIO 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 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- reconnect loop is still a bit buggy
-- if you try to write multiple lines, and the all fail, reconnect will be called multiple times..
-- something should be done so that this does not happen
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 Maybe (Int, Int)
mLimitConf TMVar UTCTime
tmv HostName
host PortNumber
port ByteString
nick User
user Chan Message
outgoingChan Chan Message
incomingChan Maybe (Chan Message)
logChan SSem
connSSem =
  do TMVar Handle
hTMVar <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. a -> STM (TMVar a)
newTMVar (forall a. HasCallStack => a
undefined :: Handle)
     (IO ()
limit', Maybe ThreadId
limitTid) <-
         case Maybe (Int, Int)
mLimitConf of
           Maybe (Int, Int)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return (), forall a. Maybe a
Nothing)
           (Just (Int
burst, Int
delay)) ->
                    do Limiter
limiter <- Int -> Int -> IO Limiter
newLimiter Int
burst Int
delay
                       forall (m :: * -> *) a. Monad m => a -> m a
return (Limiter -> IO ()
limit Limiter
limiter, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Limiter -> ThreadId
limitsThreadId Limiter
limiter)
     ThreadId
outgoingTid  <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$
                      do Message
msg <- forall a. Chan a -> IO a
readChan Chan Message
outgoingChan
                         forall a. Maybe (Chan a) -> a -> IO ()
writeMaybeChan Maybe (Chan Message)
logChan Message
msg
                         Handle
h <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
readTMVar TMVar Handle
hTMVar
                         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> ByteString
msg_command Message
msg forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"PRIVMSG", ByteString
"NOTICE"]) IO ()
limit'
                         Handle -> ByteString -> IO ()
C.hPutStr Handle
h (Message -> ByteString
encode Message
msg) 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 Char
'\n'
                         UTCTime
now <- IO UTCTime
getCurrentTime
                         forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM a
swapTMVar TMVar UTCTime
tmv UTCTime
now
     ThreadId
incomingTid  <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ do
                      Logger
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IO ()
doConnect Logger
logger HostName
host PortNumber
port ByteString
nick User
user TMVar Handle
hTMVar SSem
connSSem
                      forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$
                       do Handle
h <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
readTMVar TMVar Handle
hTMVar
                          -- FIXME: is C.hGetLine going to do the write thing in the face of unicode?
                          ByteString
msgStr <- (Handle -> IO ByteString
C.hGetLine Handle
h) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
"")
                          UTCTime
now <- IO UTCTime
getCurrentTime
                          forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM a
swapTMVar TMVar UTCTime
tmv UTCTime
now
                          case ByteString -> Maybe Message
decode (ByteString
msgStr forall a. Semigroup a => a -> a -> a
<> ByteString
"\n") of
                            Maybe Message
Nothing -> Logger
logger LogLevel
Normal (ByteString
"decode failed: " forall a. Semigroup a => a -> a -> a
<> ByteString
msgStr)
                            (Just Message
msg) ->
                              do Logger
logger LogLevel
Debug (Message -> ByteString
showMessage Message
msg)
                                 forall a. Maybe (Chan a) -> a -> IO ()
writeMaybeChan Maybe (Chan Message)
logChan Message
msg
                                 forall a. Chan a -> a -> IO ()
writeChan Chan Message
incomingChan Message
msg
     let forceReconnect :: IO ()
forceReconnect =
             do HostName -> IO ()
putStrLn HostName
"forceReconnect: getting handle"
                Handle
h <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
readTMVar TMVar Handle
hTMVar
                HostName -> IO ()
putStrLn HostName
"forceReconnect: sending /quit"
                forall a. Chan a -> a -> IO ()
writeChan Chan Message
outgoingChan (Maybe ByteString -> Message
quit forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ByteString
"restarting...")
                HostName -> IO ()
putStrLn HostName
"forceReconnect: closing handle"
                Handle -> IO ()
hClose Handle
h
                HostName -> IO ()
putStrLn HostName
"done."
     forall (m :: * -> *) a. Monad m => a -> m a
return (ThreadId
outgoingTid, ThreadId
incomingTid, Maybe ThreadId
limitTid, IO ()
forceReconnect)

ircConnectLoop :: (LogLevel -> ByteString -> IO ()) -- ^ logging
               -> HostName
               -> PortNumber
               -> ByteString
               -> User
               -> IO Handle
ircConnectLoop :: Logger -> HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnectLoop Logger
logger HostName
host PortNumber
port ByteString
nick User
user =
        (HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnect HostName
host PortNumber
port ByteString
nick User
user) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
        (\IOException
e ->
          do Logger
logger LogLevel
Normal forall a b. (a -> b) -> a -> b
$ ByteString
"irc connect failed ... retry in 60 seconds: " forall a. Semigroup a => a -> a -> a
<> (HostName -> ByteString
C.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> HostName
show (IOException
e :: IOException))
             Int -> IO ()
threadDelay (Int
60 forall a. Num a => a -> a -> a
* Int
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int))
             Logger -> HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnectLoop Logger
logger HostName
host PortNumber
port ByteString
nick User
user)

doConnect :: (LogLevel -> ByteString -> IO ()) -> HostName -> PortNumber -> ByteString -> User -> TMVar Handle -> SSem -> IO ()
doConnect :: Logger
-> HostName
-> PortNumber
-> ByteString
-> User
-> TMVar Handle
-> SSem
-> IO ()
doConnect Logger
logger HostName
host PortNumber
port ByteString
nick User
user TMVar Handle
hTMVar SSem
connSSem =
    do Logger
logger LogLevel
Normal forall a b. (a -> b) -> a -> b
$ ByteString
"Connecting to " forall a. Semigroup a => a -> a -> a
<> (HostName -> ByteString
C.pack HostName
host) forall a. Semigroup a => a -> a -> a
<> ByteString
" as " forall a. Semigroup a => a -> a -> a
<> ByteString
nick
       Handle
h <- Logger -> HostName -> PortNumber -> ByteString -> User -> IO Handle
ircConnectLoop Logger
logger HostName
host PortNumber
port ByteString
nick User
user
       forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM a
swapTMVar TMVar Handle
hTMVar Handle
h
       forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Logger
logger LogLevel
Normal forall a b. (a -> b) -> a -> b
$ ByteString
"Connected."
       SSem -> IO ()
SSem.signal SSem
connSSem
       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 HostName
host PortNumber
port ByteString
nick User
user TMVar Handle
hTMVar SSem
connSSem IOException
e =
    do Logger
logger LogLevel
Normal forall a b. (a -> b) -> a -> b
$ ByteString
"IRC Connection died: " forall a. Semigroup a => a -> a -> a
<> HostName -> ByteString
C.pack (forall a. Show a => a -> HostName
show IOException
e)
{-
       atomically $ do empty <- isEmptyTMVar hTMVar
                       if empty
                          then return ()
                          else takeTMVar hTMVar >> return ()
-}
       Logger
-> 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 ByteString
botName HostName
prefix Chan Message
outgoingChan SSem
connSSem BotPartT IO ()
action =
    IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$
      do SSem -> IO ()
SSem.wait SSem
connSSem
         forall (m :: * -> *) a. BotPartT m a -> BotEnv -> m a
runBotPartT BotPartT IO ()
action (Message
-> Chan Message -> Logger -> ByteString -> HostName -> BotEnv
BotEnv forall a. HasCallStack => a
undefined Chan Message
outgoingChan Logger
logger ByteString
botName HostName
prefix)

-- |simpleBot connects to the server and handles messages using the supplied BotPartTs
--
-- the 'Chan Message' for the optional logging function will include
-- all received and sent messages. This means that the bots output
-- will be included in the logs.
simpleBot :: BotConf          -- ^ Bot configuration
          -> [BotPartT IO ()] -- ^ bot parts (must include 'pingPart', or equivalent)
          -> IO ([ThreadId], IO ())    -- ^ 'ThreadId' for all forked handler threads and a function that forces a reconnect
simpleBot :: BotConf -> [BotPartT IO ()] -> IO ([ThreadId], IO ())
simpleBot BotConf{HostName
Maybe (Int, Int)
Maybe (Chan Message -> IO ())
ByteString
Set ByteString
PortNumber
User
Logger
limits :: Maybe (Int, Int)
channels :: Set ByteString
user :: User
commandPrefix :: HostName
nick :: ByteString
port :: PortNumber
host :: HostName
logger :: Logger
channelLogger :: Maybe (Chan Message -> IO ())
limits :: BotConf -> Maybe (Int, Int)
channels :: BotConf -> Set ByteString
user :: BotConf -> User
commandPrefix :: BotConf -> HostName
nick :: BotConf -> ByteString
port :: BotConf -> PortNumber
host :: BotConf -> HostName
logger :: BotConf -> Logger
channelLogger :: BotConf -> Maybe (Chan Message -> IO ())
..} [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' connects to the server and handles messages using the supplied BotPartTs
--
-- the 'Chan Message' for the optional logging function will include
-- all received and sent messages. This means that the bots output
-- will be included in the logs.
simpleBot' :: (Maybe (Chan Message -> IO ())) -- ^ optional logging function
          -> Logger           -- ^ application logging
          -> Maybe (Int, Int) -- ^ rate limiter settings (burst length, delay in microseconds)
          -> HostName         -- ^ irc server to connect
          -> PortNumber       -- ^ irc port to connect to (usually, '6667')
          -> ByteString       -- ^ irc nick
          -> String           -- ^ command prefix
          -> User             -- ^ irc user info
          -> [BotPartT IO ()] -- ^ bot parts (must include 'pingPart', 'channelsPart', and 'nickUserPart)'
          -> IO ([ThreadId], IO ())    -- ^ 'ThreadId' for all forked handler threads and an IO action that forces a reconnect
simpleBot' :: Maybe (Chan Message -> IO ())
-> Logger
-> Maybe (Int, Int)
-> HostName
-> PortNumber
-> ByteString
-> HostName
-> User
-> [BotPartT IO ()]
-> IO ([ThreadId], IO ())
simpleBot' Maybe (Chan Message -> IO ())
mChanLogger Logger
logger Maybe (Int, Int)
limitConf HostName
host PortNumber
port ByteString
nick HostName
prefix User
user [BotPartT IO ()]
parts =
  do (Maybe ThreadId
mLogTid, Maybe (Chan Message)
mLogChan) <-
         case Maybe (Chan Message -> IO ())
mChanLogger of
           Maybe (Chan Message -> IO ())
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
           (Just Chan Message -> IO ()
chanLogger) ->
               do Chan Message
logChan <- forall a. IO (Chan a)
newChan :: IO (Chan Message)
                  ThreadId
logTid  <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ Chan Message -> IO ()
chanLogger Chan Message
logChan
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ThreadId
logTid, forall a. a -> Maybe a
Just Chan Message
logChan)
     -- message channels
     Chan Message
outgoingChan <- forall a. IO (Chan a)
newChan :: IO (Chan Message)
     Chan Message
incomingChan <- forall a. IO (Chan a)
newChan :: IO (Chan Message)
     UTCTime
now <- IO UTCTime
getCurrentTime
     TMVar UTCTime
tmv <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. a -> STM (TMVar a)
newTMVar UTCTime
now
     SSem
connSSem <- Int -> IO SSem
SSem.new Int
0
     (ThreadId
outgoingTid, ThreadId
incomingTid, Maybe ThreadId
mLimitTid, 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 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$
                    do let timeout :: Int
                           timeout :: Int
timeout = Int
5forall a. Num a => a -> a -> a
*Int
60
                       UTCTime
now'         <- IO UTCTime
getCurrentTime
                       UTCTime
lastActivity <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
readTMVar TMVar UTCTime
tmv
                       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UTCTime
now' forall a. Ord a => a -> a -> Bool
> NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timeout) UTCTime
lastActivity) IO ()
forceReconnect
                       Int -> IO ()
threadDelay (Int
30forall a. Num a => a -> a -> a
*Int
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int)) -- check every 30 seconds
     [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
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe ThreadId
mLimitTid forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe ThreadId
mLogTid forall a b. (a -> b) -> a -> b
$ (ThreadId
incomingTid forall a. a -> [a] -> [a]
: ThreadId
outgoingTid forall a. a -> [a] -> [a]
: ThreadId
watchDogTid forall a. a -> [a] -> [a]
: [ThreadId]
ircTids), IO ()
forceReconnect)
    where
      onConnect :: BotPartT IO ()
      onConnect :: BotPartT IO ()
onConnect =
          forall (m :: * -> *).
BotMonad m =>
ByteString -> Maybe User -> m ()
changeNickUser ByteString
nick (forall a. a -> Maybe a
Just User
user)

-- | call 'writeChan' if 'Just'. Do nothing for Nothing.
writeMaybeChan :: Maybe (Chan a) -> a -> IO ()
writeMaybeChan :: forall a. Maybe (Chan a) -> a -> IO ()
writeMaybeChan Maybe (Chan a)
Nothing     a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeMaybeChan (Just Chan a
chan) a
a = forall a. Chan a -> a -> IO ()
writeChan Chan a
chan a
a