{-# 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.Monoid              ((<>))
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 :: 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           = HostName
""
            , port :: PortNumber
port           = PortNumber
6667
            , nick :: ByteString
nick           = ByteString
""
            , commandPrefix :: HostName
commandPrefix  = HostName
"#"
            , 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
            }

-- | 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 <- [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 ByteString
botName HostName
prefix Chan Message
incomingChan Chan Message
outgoingChan 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 ByteString
botName HostName
prefix Chan Message
incomingChan Chan Message
outgoingChan [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 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 ())

-- 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 <- 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)
     (IO ()
limit', Maybe ThreadId
limitTid) <-
         case Maybe (Int, Int)
mLimitConf of
           Maybe (Int, Int)
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 (Int
burst, 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` [ByteString
"PRIVMSG", ByteString
"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 Char
'\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 ()
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
                          -- FIXME: is C.hGetLine going to do the write thing in the face of unicode?
                          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` (\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 ByteString
"")
                          UTCTime
now <- IO UTCTime
getCurrentTime
                          IO UTCTime -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO UTCTime -> IO ()) -> IO UTCTime -> IO ()
forall a b. (a -> b) -> a -> b
$ 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
<> ByteString
"\n") of
                            Maybe Message
Nothing -> Logger
logger LogLevel
Normal (ByteString
"decode failed: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msgStr)
                            (Just 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 HostName
"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 HostName
"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 ByteString
"restarting...")
                HostName -> IO ()
putStrLn HostName
"forceReconnect: closing handle"
                Handle -> IO ()
hClose Handle
h
                HostName -> IO ()
putStrLn HostName
"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 ()) -- ^ 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) IO Handle -> (IOException -> IO Handle) -> IO Handle
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
        (\IOException
e ->
          do Logger
logger LogLevel
Normal (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
"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 (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10Int -> Int -> Int
forall 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 (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
"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
<> ByteString
" as " ByteString -> ByteString -> ByteString
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
       IO Handle -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Handle -> IO ()) -> IO Handle -> IO ()
forall a b. (a -> b) -> a -> b
$ 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
       IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Logger
logger LogLevel
Normal (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
"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 HostName
host PortNumber
port ByteString
nick User
user TMVar Handle
hTMVar SSem
connSSem IOException
e =
    do Logger
logger LogLevel
Normal (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
"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)
{-
       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 (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 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  -> (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 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)
     -- message channels
     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 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 (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 :: Int
                           timeout :: Int
timeout = Int
5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
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 (Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timeout) UTCTime
lastActivity) IO ()
forceReconnect
                       Int -> IO ()
threadDelay (Int
30Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
10Int -> Int -> Int
forall 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
     ([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)

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