Added retrying with new nick if nick is already taken. Other minor fixes.

master
Abhinav Sarkar 2014-10-05 13:12:49 +05:30
parent 0b84c0c837
commit f99815b3b0
5 changed files with 35 additions and 26 deletions

View File

@ -54,7 +54,7 @@ readMessageLoop = go []
case botStatus of case botStatus of
Disconnected -> closeMessageChannel inChan Disconnected -> closeMessageChannel inChan
_ -> do _ -> do
mLine <- try $ timeout timeoutDelay readLine' mLine <- try $ timeout timeoutDelay readLine
msgParts' <- case mLine of msgParts' <- case mLine of
Left (e :: SomeException) -> do Left (e :: SomeException) -> do
errorM $ "Error while reading from connection: " ++ show e errorM $ "Error while reading from connection: " ++ show e
@ -67,12 +67,12 @@ readMessageLoop = go []
Right (Just EOS) -> sendMessage inChan EOD >> return msgParts Right (Just EOS) -> sendMessage inChan EOD >> return msgParts
limit <- map (addUTCTime (- msgPartTimeout)) getCurrentTime limit <- map (addUTCTime (- msgPartTimeout)) getCurrentTime
let msgParts'' = concat let validMsgParts = concat
. filter ((> limit) . msgPartTime . headEx . sortBy (flip $ comparing msgPartTime)) . filter ((> limit) . msgPartTime . headEx . sortBy (flip $ comparing msgPartTime))
. groupAllOn (msgPartParserId &&& msgPartTarget) $ msgParts' . groupAllOn (msgPartParserId &&& msgPartTarget) $ msgParts'
go msgParts'' mvBotStatus inChan bot timeoutDelay go validMsgParts mvBotStatus inChan bot timeoutDelay
where where
readLine' = do readLine = do
eof <- hIsEOF botSocket eof <- hIsEOF botSocket
if eof if eof
then return EOS then return EOS
@ -98,14 +98,15 @@ messageProcessLoop = go 0
when (status == Kicked) $ when (status == Kicked) $
threadDelay (5 * oneSec) >> newMessage JoinCmd >>= sendMessage messageChan threadDelay (5 * oneSec) >> newMessage JoinCmd >>= sendMessage messageChan
mIn <- receiveMessage inChan mIn <- receiveMessageEither inChan messageChan
case mIn of case mIn of
Timeout -> newMessage IdleMsg >>= sendMessage messageChan >> return Idle Left Timeout -> newMessage IdleMsg >>= sendMessage messageChan >> return Idle
EOD -> infoM "Connection closed" >> return Disconnected Left EOD -> infoM "Connection closed" >> return Disconnected
Msg (msg@Message { .. }) -> do Left (Msg (msg@Message { .. })) -> do
nStatus <- handleMsg nick message mpass nStatus <- handleMsg nick message mpass
sendMessage messageChan msg sendMessage messageChan msg
return nStatus return nStatus
Right _ -> return status
put nStatus put nStatus
case nStatus of case nStatus of
@ -121,7 +122,7 @@ messageProcessLoop = go 0
| Just (KickMsg { .. }) <- fromMessage message, kickedNick == nick = | Just (KickMsg { .. }) <- fromMessage message, kickedNick == nick =
infoM "Kicked" >> return Kicked infoM "Kicked" >> return Kicked
| Just NickInUseMsg <- fromMessage message = | Just NickInUseMsg <- fromMessage message =
infoM "Nick already in use" >> return NickNotAvailable infoM "Nick already in use" >> return NickNotAvailable
| Just (ModeMsg { .. }) <- fromMessage message, modeUser == Self = do | Just (ModeMsg { .. }) <- fromMessage message, modeUser == Self = do
whenJust mpass $ \pass -> do whenJust mpass $ \pass -> do
msg <- newMessage $ PrivMsgReply (User (Nick "NickServ") "") $ "IDENTIFY " ++ pass msg <- newMessage $ PrivMsgReply (User (Nick "NickServ") "") $ "IDENTIFY " ++ pass

View File

@ -113,17 +113,21 @@ runBotIntenal :: BotConfig -> IO ()
runBotIntenal botConfig' = withSocketsDo $ do runBotIntenal botConfig' = withSocketsDo $ do
status <- run status <- run
case status of case status of
Disconnected -> debugM "Restarting .." >> runBotIntenal botConfigWithCore Disconnected -> debugM "Restarting .." >> runBotIntenal botConfigWithCore
Errored -> debugM "Restarting .." >> runBotIntenal botConfigWithCore Errored -> debugM "Restarting .." >> runBotIntenal botConfigWithCore
Interrupted -> return () Interrupted -> return ()
NickNotAvailable -> return () NickNotAvailable -> debugM "Trying new nick" >> runBotIntenal botConfigWithNewNick
_ -> error "Unsupported status" _ -> error "Unsupported status"
where where
botConfigWithCore = botConfig' { botConfigWithCore = botConfig' {
msgHandlerInfo = msgHandlerInfo =
foldl' (\m name -> insertMap name mempty m) mempty foldl' (\m name -> insertMap name mempty m) mempty
(hashNub $ mapKeys (msgHandlerInfo botConfig') ++ mapKeys coreMsgHandlerMakers), (hashNub $ mapKeys (msgHandlerInfo botConfig') ++ mapKeys coreMsgHandlerMakers)
msgHandlerMakers = coreMsgHandlerMakers <> msgHandlerMakers botConfig' , msgHandlerMakers = coreMsgHandlerMakers <> msgHandlerMakers botConfig'
}
botConfigWithNewNick = botConfigWithCore {
botNick = Nick $ nickToText (botNick botConfigWithCore) ++ "_"
} }
handleErrors :: SomeException -> IO BotStatus handleErrors :: SomeException -> IO BotStatus

View File

@ -28,7 +28,7 @@ data User
= Self = Self
-- | An user other than the bot. -- | An user other than the bot.
| User | User
{ userNick :: !Nick -- ^ The user's nick. { userNick :: !Nick -- ^ The user's nick.
, userServer :: !Text -- ^ The user's server. , userServer :: !Text -- ^ The user's server.
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)

View File

@ -10,6 +10,7 @@ module Network.IRC.MessageBus
, newMessageChannel , newMessageChannel
, sendMessage , sendMessage
, receiveMessage , receiveMessage
, receiveMessageEither
, closeMessageChannel , closeMessageChannel
, awaitMessageChannel ) where , awaitMessageChannel ) where
@ -56,3 +57,7 @@ closeMessageChannel (MessageChannel latch _ _) = doLatch latch
awaitMessageChannel :: MessageChannel a -> IO () awaitMessageChannel :: MessageChannel a -> IO ()
awaitMessageChannel (MessageChannel latch _ _) = awaitLatch latch awaitMessageChannel (MessageChannel latch _ _) = awaitLatch latch
receiveMessageEither :: MessageChannel a -> MessageChannel b -> IO (Either a b)
receiveMessageEither chan1 chan2 = atomically $
map Left (receiveMessageSTM chan1) `orElseSTM` map Right (receiveMessageSTM chan2)

View File

@ -99,18 +99,17 @@ formatCommand botConfig@BotConfig { .. } message =
defaultCommandFormatter :: CommandFormatter defaultCommandFormatter :: CommandFormatter
defaultCommandFormatter BotConfig { .. } Message { .. } defaultCommandFormatter BotConfig { .. } Message { .. }
| Just (PongCmd msg) <- fromMessage message = Just $ "PONG :" ++ msg | Just (PongCmd msg) <- fromMessage message = Just $ "PONG :" ++ msg
| Just (PingCmd msg) <- fromMessage message = Just $ "PING :" ++ msg | Just (PingCmd msg) <- fromMessage message = Just $ "PING :" ++ msg
| Just NickCmd <- fromMessage message = Just $ "NICK " ++ botNick' | Just NickCmd <- fromMessage message = Just $ "NICK " ++ botNick'
| Just UserCmd <- fromMessage message = | Just UserCmd <- fromMessage message = Just $ "USER " ++ botNick' ++ " 0 * :" ++ botNick'
Just $ "USER " ++ botNick' ++ " 0 * :" ++ botNick' | Just JoinCmd <- fromMessage message = Just $ "JOIN " ++ botChannel
| Just JoinCmd <- fromMessage message = Just $ "JOIN " ++ botChannel | Just QuitCmd <- fromMessage message = Just "QUIT"
| Just QuitCmd <- fromMessage message = Just "QUIT" | Just NamesCmd <- fromMessage message = Just $ "NAMES " ++ botChannel
| Just (ChannelMsgReply msg) <- fromMessage message = | Just (ChannelMsgReply msg) <- fromMessage message =
Just $ "PRIVMSG " ++ botChannel ++ " :" ++ msg Just $ "PRIVMSG " ++ botChannel ++ " :" ++ msg
| Just (PrivMsgReply (User { .. }) msg) <- fromMessage message = | Just (PrivMsgReply (User { .. }) msg) <- fromMessage message =
Just $ "PRIVMSG " ++ nickToText userNick ++ " :" ++ msg Just $ "PRIVMSG " ++ nickToText userNick ++ " :" ++ msg
| Just NamesCmd <- fromMessage message = Just $ "NAMES " ++ botChannel
| otherwise = Nothing | otherwise = Nothing
where where
botNick' = nickToText botNick botNick' = nickToText botNick