Added retrying with new nick if nick is already taken. Other minor fixes.
parent
0b84c0c837
commit
f99815b3b0
|
@ -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
|
||||||
|
|
|
@ -116,14 +116,18 @@ runBotIntenal botConfig' = withSocketsDo $ do
|
||||||
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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -102,15 +102,14 @@ 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
|
||||||
|
|
Loading…
Reference in New Issue