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

hask-irc-core/Network/IRC/Bot.hs

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

hask-irc-core/Network/IRC/Client.hs

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

hask-irc-core/Network/IRC/Message/Types.hs

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

hask-irc-core/Network/IRC/MessageBus.hs

@@ -10,6 +10,7 @@ module Network.IRC.MessageBus
   , newMessageChannel
   , sendMessage
   , receiveMessage
+  , receiveMessageEither
   , closeMessageChannel
   , awaitMessageChannel ) where
 
@@ -56,3 +57,7 @@ closeMessageChannel (MessageChannel latch _ _) = doLatch latch
 
 awaitMessageChannel :: MessageChannel a -> IO ()
 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)

hask-irc-core/Network/IRC/Protocol.hs

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