abhin4v
/
hask-irc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Adds support for automatic nick recovery.

master
Abhinav Sarkar 2015-06-21 15:14:32 +05:30
parent 3d42577e62
commit fdf641d187
8 changed files with 119 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -1,7 +1,9 @@
*.hi
*.o
*.iml
.cabal-sandbox
cabal.sandbox.config
.idea
dist
config.cfg
*sublime*

18
hask-irc-core/Network/IRC/Bot.hs
View File

@ -96,6 +96,7 @@ messageProcessLoop inChan messageChan = loop 0
status <- get
Bot { .. } <- ask
let nick = botNick botConfig
let origNick = botOrigNick botConfig
mpass <- io $ CF.lookup (config botConfig) "password"
nStatus <- io . mask_ $
@ -107,10 +108,14 @@ messageProcessLoop inChan messageChan = loop 0
mIn <- receiveMessage inChan
case mIn of
Timeout -> newMessage IdleMsg >>= sendMessage messageChan >> return Idle
Timeout -> do
idleMsg <- newMessage IdleMsg
sendMessage messageChan idleMsg
sendWhoisMessage nick origNick
return Idle
EOD -> infoM "Connection closed" >> return Disconnected
Msg (msg@Message { .. }) -> do
nStatus <- handleMsg nick message mpass
nStatus <- handleMsg nick origNick message mpass
sendMessage messageChan msg
return nStatus
@ -119,10 +124,15 @@ messageProcessLoop inChan messageChan = loop 0
Idle -> loop (idleFor + oneSec)
Disconnected -> return ()
NickNotAvailable -> return ()
NickAvailable -> return ()
_ -> loop 0
where
handleMsg nick message mpass
sendWhoisMessage nick origNick =
when (nick /= origNick && idleFor /= 0 && idleFor `mod` (10 * oneSec) == 0) $
(newMessage . WhoisCmd . nickToText $ origNick) >>= sendMessage messageChan
handleMsg nick origNick message mpass
| Just (JoinMsg user) <- fromMessage message, userNick user == nick =
infoM "Joined" >> return Joined
| Just (KickMsg { .. }) <- fromMessage message, kickedNick == nick =
@ -135,5 +145,7 @@ messageProcessLoop inChan messageChan = loop 0
sendMessage messageChan msg
newMessage JoinCmd >>= sendMessage messageChan
return Connected
| Just (WhoisNoSuchNick n) <- fromMessage message, n == origNick =
infoM "Original nick available" >> return NickAvailable
| otherwise =
return Connected

9
hask-irc-core/Network/IRC/Client.hs
View File

@ -71,7 +71,7 @@ connect botConfig@BotConfig { .. } = do
where
connectToWithRetry = connectTo (unpack botServer) (PortNumber (fromIntegral botPort))
`catch` (\(e :: SomeException) -> do
errorM ("Error while connecting: " ++ show e ++ ". Waiting.")
errorM ("Error while connecting: " ++ show e ++ ". Retrying.")
threadDelay (5 * oneSec)
connectToWithRetry)
@ -112,8 +112,9 @@ runBotIntenal botConfig' = withSocketsDo $ do
case status of
Disconnected -> debugM "Restarting .." >> runBotIntenal botConfigWithCore
Errored -> debugM "Restarting .." >> runBotIntenal botConfigWithCore
Interrupted -> return ()
NickNotAvailable -> debugM "Trying new nick" >> runBotIntenal botConfigWithNewNick
NickAvailable -> debugM "Trying original nick" >> runBotIntenal botConfigWithOrigNick
Interrupted -> return ()
_ -> error "Unsupported status"
where
botConfigWithCore = botConfig' {
@ -127,6 +128,10 @@ runBotIntenal botConfig' = withSocketsDo $ do
botNick = Nick $ nickToText (botNick botConfigWithCore) ++ "_"
}
botConfigWithOrigNick = botConfigWithCore {
botNick = botOrigNick botConfigWithCore
}
handleErrors :: SomeException -> IO BotStatus
handleErrors e = case fromException e of
Just UserInterrupt -> debugM "User interrupt" >> return Interrupted

8
hask-irc-core/Network/IRC/Internal/Types.hs
View File

@ -59,7 +59,8 @@ data BotConfig = BotConfig
, botPort :: !Int
-- | The channel to join.
, botChannel :: !Text
-- | Nick of the bot.
, botOrigNick :: !Nick
-- | Current nick of the bot.
, botNick :: !Nick
-- | The timeout in seconds after which bot automatically disconnects and tries to reconnect.
-- Should be few seconds more than the ping timeout of the server.
@ -94,7 +95,7 @@ newBotConfig :: Text -- ^ server
-> Int -- ^ botTimeout
-> BotConfig
newBotConfig server port channel botNick botTimeout =
BotConfig server port channel botNick botTimeout mempty mempty [] [] CF.empty
BotConfig server port channel botNick botNick botTimeout mempty mempty [] [] CF.empty
-- | The bot.
data Bot = Bot
@ -116,7 +117,8 @@ data BotStatus = Connected -- ^ Connected to the server
| Idle -- ^ No communication with the server. The bot is idle.
-- If the bot stays idle for 'botTimeout' seconds, it disconnects.
| Interrupted -- ^ Interrupted using external signals like SIGINT.
| NickNotAvailable -- ^ Bot's nick already taken on the server.
| NickNotAvailable -- ^ Bot's current nick already taken on the server.
| NickAvailable -- ^ Bot's original nick is available on the server.
deriving (Show, Eq, Ord)
-- | An IRC action to be run.

15
hask-irc-core/Network/IRC/Message/Types.hs
View File

@ -125,6 +125,18 @@ data ModeMsg = ModeMsg { modeUser :: !User, modeTarget :: !Text, mode :: !T
deriving (Typeable, Show, Eq, Ord)
instance MessageC ModeMsg
data WhoisReplyMsg = WhoisNoSuchNick { whoisNick :: !Nick }
| WhoisReplyMsg {
whoisNick :: !Nick
, whoisUser :: !Text
, whoisHost :: !Text
, whoisRealName :: !Text
, whoisChannels :: ![Text]
, whoisServer :: !Text
, whoisServerInfo :: !Text
} deriving (Typeable, Show, Eq, Ord)
instance MessageC WhoisReplyMsg
-- | All other messages which are not parsed as any of the above types.
data OtherMsg = OtherMsg { msgSource :: !Text, msgCommand :: !Text, msgTarget :: !Text , msg :: !Text }
deriving (Typeable, Show, Eq, Ord)
@ -166,3 +178,6 @@ instance MessageC QuitCmd
-- | A /NAMES/ command sent to ask for the nicks of the users in the channel.
data NamesCmd = NamesCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC NamesCmd
data WhoisCmd = WhoisCmd !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC WhoisCmd

40
hask-irc-core/Network/IRC/Protocol.hs
View File

@ -2,6 +2,7 @@ module Network.IRC.Protocol (parseLine, formatCommand) where
import ClassyPrelude
import Data.Foldable (msum)
import Data.Maybe (fromJust)
import Data.List ((!!))
import Data.Text (strip)
@ -17,7 +18,7 @@ parseLine botConfig@BotConfig { .. } time line msgParts =
Partial msgParts' -> ([], (singletonMap msgParserId msgParts'))
Done message msgParts' -> ([message], (singletonMap msgParserId msgParts'))
where
parsers = [pingParser, namesParser, lineParser] ++ msgParsers ++ [defaultParser]
parsers = [pingParser, namesParser, whoisParser, lineParser] ++ msgParsers ++ [defaultParser]
pingParser :: MessageParser
pingParser = MessageParser "ping" go
@ -91,11 +92,45 @@ namesParser = MessageParser "names" go
in Done (Message time allLines . toMessage $ NamesMsg nicks) otherMsgParts
_ -> Reject
where
(_ : command : target : _) = words line
(_, command, _ , target, _) = parseMsgLine line
stripNickPrefix = pack . dropWhile (`elem` ("~&@%+" :: String)) . unpack
namesNicks line' =
map (Nick . stripNickPrefix) . words . drop 1 . unwords . drop 5 . words $ line'
whoisParser :: MessageParser
whoisParser = MessageParser "whois" go
where
go BotConfig { .. } time line msgParts
| "PING :" `isPrefixOf` line = Reject
| command `elem` ["401", "311", "319", "312", "317"] =
Partial $ MessagePart target time line : msgParts
| command == "318" = let
(myMsgParts, otherMsgParts) = partition ((target ==) . msgPartTarget) msgParts
allLines = intercalate "\r\n" . reverse . (line :) . map msgPartLine $ myMsgParts
in Done (Message time allLines . toMessage $ parse myMsgParts) otherMsgParts
| otherwise = Reject
where
(_, command, _, target, _) = parseMsgLine line
parse :: [MessagePart] -> WhoisReplyMsg
parse myMsgParts =
let partMap = asMap $ foldl' (\m MessagePart { .. } ->
insertMap (words msgPartLine !! 1) msgPartLine m)
mempty myMsgParts
in case lookup "401" partMap of
Just line -> WhoisNoSuchNick . Nick $ words line !! 3
Nothing -> let
splits311 = words . fromJust . lookup "311" $ partMap
nick = Nick (splits311 !! 3)
user = splits311 !! 4
host = splits311 !! 5
realName = drop 1 $ splits311 !! 7
channels = mconcat . maybeToList . map (words . drop 1 . unwords . drop 4 . words) . lookup "319" $ partMap
splits312 = words . fromJust . lookup "312" $ partMap
server = splits312 !! 4
serverInfo = drop 1 $ splits312 !! 5
in WhoisReplyMsg nick user host realName channels server serverInfo
formatCommand :: CommandFormatter
formatCommand botConfig@BotConfig { .. } message =
msum . map (\formatter -> formatter botConfig message) $ defaultCommandFormatter : cmdFormatters
@ -109,6 +144,7 @@ defaultCommandFormatter BotConfig { .. } Message { .. }
| Just JoinCmd <- fromMessage message = Just $ "JOIN " ++ botChannel
| Just QuitCmd <- fromMessage message = Just "QUIT"
| Just NamesCmd <- fromMessage message = Just $ "NAMES " ++ botChannel
| Just (WhoisCmd nick) <- fromMessage message = Just $ "WHOIS " ++ nick
| Just (ChannelMsgReply msg) <- fromMessage message =
Just $ "PRIVMSG " ++ botChannel ++ " :" ++ msg
| Just (PrivMsgReply (User { .. }) msg) <- fromMessage message =

2
hask-irc-core/Network/IRC/Types.hs
View File

@ -31,6 +31,7 @@ module Network.IRC.Types
, NickMsg (..)
, KickMsg (..)
, ModeMsg (..)
, WhoisReplyMsg (..)
, OtherMsg (..)
-- * IRC Commands
, PingCmd (..)
@ -42,6 +43,7 @@ module Network.IRC.Types
, JoinCmd (..)
, QuitCmd (..)
, NamesCmd (..)
, WhoisCmd (..)
-- * Message Parsing
, MessageParserId
, MessagePart (..)