diff options
| -rw-r--r-- | reaktor2.cabal | 4 | ||||
| -rw-r--r-- | src/Data/Char/Extended.hs | 9 | ||||
| -rw-r--r-- | src/Reaktor.hs | 13 | ||||
| -rw-r--r-- | src/Reaktor/IRC.hs | 450 | ||||
| -rw-r--r-- | src/Reaktor/Internal.hs | 7 | ||||
| -rw-r--r-- | src/Reaktor/Parser.hs | 9 | ||||
| -rw-r--r-- | src/Reaktor/Plugins/Mention.hs | 4 | ||||
| -rw-r--r-- | src/Reaktor/Plugins/Ping.hs | 4 | ||||
| -rw-r--r-- | src/Reaktor/Plugins/Register.hs | 42 | ||||
| -rw-r--r-- | src/Reaktor/Plugins/System.hs | 8 | ||||
| -rw-r--r-- | src/Reaktor/Plugins/System/Internal.hs | 3 |
11 files changed, 508 insertions, 45 deletions
diff --git a/reaktor2.cabal b/reaktor2.cabal index d9d3a39..5d19f78 100644 --- a/reaktor2.cabal +++ b/reaktor2.cabal @@ -1,5 +1,5 @@ name: reaktor2 -version: 0.1.7 +version: 0.2.0 license: MIT author: tv <tv@krebsco.de> maintainer: tv <tv@krebsco.de> @@ -17,6 +17,7 @@ executable reaktor containers, data-default, filepath, + hashable, lens, lens-aeson, network, @@ -25,6 +26,7 @@ executable reaktor pcre-light, process, random, + string-conversions, stringsearch, text, time, diff --git a/src/Data/Char/Extended.hs b/src/Data/Char/Extended.hs new file mode 100644 index 0000000..add079d --- /dev/null +++ b/src/Data/Char/Extended.hs @@ -0,0 +1,9 @@ +module Data.Char.Extended + ( module Data.Char + , isAsciiLetter + ) where + +import Data.Char + +isAsciiLetter :: Char -> Bool +isAsciiLetter c = Data.Char.isAsciiUpper c || Data.Char.isAsciiLower c diff --git a/src/Reaktor.hs b/src/Reaktor.hs index 21379ca..34baadb 100644 --- a/src/Reaktor.hs +++ b/src/Reaktor.hs @@ -28,6 +28,7 @@ import Prelude.Extended import Reaktor.Internal import Reaktor.Internal as Exports (Actions(..)) import Reaktor.Internal as Exports (Message(Message,Start)) +import Reaktor.IRC as Exports import Reaktor.Internal as Exports (formatMessage) import Reaktor.Nick as Exports import Reaktor.Nick as Nick @@ -104,7 +105,7 @@ logger h takeLog = forever $ takeLog >>= T.hPutStrLn h . pp pinger :: (Message -> IO ()) -> IO () pinger aSend = forever $ do threadDelay time - aSend (Message Nothing "PING" ["heartbeat"]) + aSend (Message Nothing PING ["heartbeat"]) where time = 300 * 1000000 @@ -162,10 +163,10 @@ splitter plugins takeInMsg = logMsgFilter :: Message -> Maybe Message logMsgFilter = \case - Message _ "PING" _ -> Nothing - Message _ "PONG" _ -> Nothing - Message p "PRIVMSG" ["NickServ",xs] | check -> do - Just (Message p "PRIVMSG" ["NickServ",xs']) + Message _ PING _ -> Nothing + Message _ PONG _ -> Nothing + Message p PRIVMSG ["NickServ",xs] | check -> do + Just (Message p PRIVMSG ["NickServ",xs']) where check = elem cmd ["IDENTIFY","REGAIN"] && length ws > 2 ws = T.words xs @@ -206,7 +207,7 @@ showUnprintable = privmsg :: Text -> [Text] -> Message privmsg msgtarget xs = - Message Nothing "PRIVMSG" (msgtarget:T.intercalate " " xs:[]) + Message Nothing PRIVMSG (msgtarget:T.intercalate " " xs:[]) prefixTimestamp :: Blessings Text -> IO (Blessings Text) diff --git a/src/Reaktor/IRC.hs b/src/Reaktor/IRC.hs new file mode 100644 index 0000000..325374d --- /dev/null +++ b/src/Reaktor/IRC.hs @@ -0,0 +1,450 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +module Reaktor.IRC + ( Command(..) + ) where + +import Data.Aeson +import Data.Aeson.Types (typeMismatch) +import qualified Data.HashMap.Lazy as M +import Data.Hashable (Hashable) +import Data.String.Conversions +import qualified Data.Text.Extended as T +import qualified Data.Text.Read as T +import GHC.Generics (Generic) +import Prelude.Extended + +data Command = + UnknownCommand Text | UnknownReply Int + | ADMIN + | AWAY + | CONNECT + | DIE + | ERROR + | INFO + | INVITE + | ISON + | JOIN + | KICK + | KILL + | LINKS + | LIST + | LUSERS + | MODE + | MOTD + | NAMES + | NICK + | NJOIN + | NOTICE + | OPER + | PART + | PASS + | PING + | PONG + | PRIVMSG + | QUIT + | REHASH + | RESTART + | SERVER + | SERVICE + | SERVLIST + | SQUERY + | SQUIRT + | SQUIT + | STATS + | SUMMON + | TIME + | TOPIC + | TRACE + | USER + | USERHOST + | USERS + | VERSION + | WALLOPS + | WHO + | WHOIS + | WHOWAS + + | RPL_WELCOME + | RPL_YOURHOST + | RPL_CREATED + | RPL_MYINFO + | RPL_BOUNCE + + | RPL_TRACELINK + | RPL_TRACECONNECTING + | RPL_TRACEHANDSHAKE + | RPL_TRACEUNKNOWN + | RPL_TRACEOPERATOR + | RPL_TRACEUSER + | RPL_TRACESERVER + | RPL_TRACESERVICE + | RPL_TRACENEWTYPE + | RPL_TRACECLASS + | RPL_TRACERECONNECT + | RPL_STATSLINKINFO + | RPL_STATSCOMMANDS + | RPL_ENDOFSTATS + | RPL_UMODEIS + | RPL_SERVLIST + | RPL_SERVLISTEND + | RPL_STATSUPTIME + | RPL_STATSOLINE + | RPL_LUSERCLIENT + | RPL_LUSEROP + | RPL_LUSERUNKNOWN + | RPL_LUSERCHANNELS + | RPL_LUSERME + | RPL_ADMINME + | RPL_ADMINLOC1 + | RPL_ADMINLOC2 + | RPL_ADMINEMAIL + | RPL_TRACELOG + | RPL_TRACEEND + | RPL_TRYAGAIN + | RPL_AWAY + | RPL_USERHOST + | RPL_ISON + | RPL_UNAWAY + | RPL_NOWAWAY + | RPL_WHOISUSER + | RPL_WHOISSERVER + | RPL_WHOISOPERATOR + | RPL_WHOWASUSER + | RPL_ENDOFWHO + | RPL_WHOISIDLE + | RPL_ENDOFWHOIS + | RPL_WHOISCHANNELS + | RPL_LISTSTART + | RPL_LIST + | RPL_LISTEND + | RPL_CHANNELMODEIS + | RPL_UNIQOPIS + | RPL_NOTOPIC + | RPL_TOPIC + | RPL_INVITING + | RPL_SUMMONING + | RPL_INVITELIST + | RPL_ENDOFINVITELIST + | RPL_EXCEPTLIST + | RPL_ENDOFEXCEPTLIST + | RPL_VERSION + | RPL_WHOREPLY + | RPL_NAMREPLY + | RPL_LINKS + | RPL_ENDOFLINKS + | RPL_ENDOFNAMES + | RPL_BANLIST + | RPL_ENDOFBANLIST + | RPL_ENDOFWHOWAS + | RPL_INFO + | RPL_MOTD + | RPL_ENDOFINFO + | RPL_MOTDSTART + | RPL_ENDOFMOTD + | RPL_YOUREOPER + | RPL_REHASHING + | RPL_YOURESERVICE + | RPL_TIME + | RPL_USERSSTART + | RPL_USERS + | RPL_ENDOFUSERS + | RPL_NOUSERS + + | ERR_NOSUCHNICK + | ERR_NOSUCHSERVER + | ERR_NOSUCHCHANNEL + | ERR_CANNOTSENDTOCHAN + | ERR_TOOMANYCHANNELS + | ERR_WASNOSUCHNICK + | ERR_TOOMANYTARGETS + | ERR_NOSUCHSERVICE + | ERR_NOORIGIN + | ERR_NORECIPIENT + | ERR_NOTEXTTOSEND + | ERR_NOTOPLEVEL + | ERR_WILDTOPLEVEL + | ERR_BADMASK + | ERR_UNKNOWNCOMMAND + | ERR_NOMOTD + | ERR_NOADMININFO + | ERR_FILEERROR + | ERR_NONICKNAMEGIVEN + | ERR_ERRONEUSNICKNAME + | ERR_NICKNAMEINUSE + | ERR_NICKCOLLISION + | ERR_UNAVAILRESOURCE + | ERR_USERNOTINCHANNEL + | ERR_NOTONCHANNEL + | ERR_USERONCHANNEL + | ERR_NOLOGIN + | ERR_SUMMONDISABLED + | ERR_USERSDISABLED + | ERR_NOTREGISTERED + | ERR_NEEDMOREPARAMS + | ERR_ALREADYREGISTRED + | ERR_NOPERMFORHOST + | ERR_PASSWDMISMATCH + | ERR_YOUREBANNEDCREEP + | ERR_YOUWILLBEBANNED + | ERR_KEYSET + | ERR_CHANNELISFULL + | ERR_UNKNOWNMODE + | ERR_INVITEONLYCHAN + | ERR_BANNEDFROMCHAN + | ERR_BADCHANNELKEY + | ERR_BADCHANMASK + | ERR_NOCHANMODES + | ERR_BANLISTFULL + | ERR_NOPRIVILEGES + | ERR_CHANOPRIVSNEEDED + | ERR_CANTKILLSERVER + | ERR_RESTRICTED + | ERR_UNIQOPPRIVSNEEDED + | ERR_NOOPERHOST + | ERR_UMODEUNKNOWNFLAG + | ERR_USERSDONTMATCH + deriving (Eq,Generic,Hashable,Show) + +instance ConvertibleStrings Text Command where + convertString = convert + where + convert s = M.lookupDefault (fallback s) s mTextCommand + fallback s = + case T.decimal s of + Right (i, "") -> UnknownReply i + _ -> UnknownCommand s + +instance ConvertibleStrings Command Text where + convertString = convert + where + convert c = M.lookupDefault (fallback c) c mCommandText + fallback = \case + UnknownCommand c -> c + UnknownReply i -> show3 i + x -> error ("no fallback for " <> show x) + +instance FromJSON Command where + parseJSON = \case + String t -> pure (convertString t) + invalid -> typeMismatch "Command" invalid + +instance FromJSONKey Command where + fromJSONKey = FromJSONKeyText convertString + + +commands :: [(Text, Command)] +commands = + [ ("ADMIN", ADMIN) + , ("AWAY", AWAY) + , ("CONNECT", CONNECT) + , ("DIE", DIE) + , ("ERROR", ERROR) + , ("INFO", INFO) + , ("INVITE", INVITE) + , ("ISON", ISON) + , ("JOIN", JOIN) + , ("KICK", KICK) + , ("KILL", KILL) + , ("LINKS", LINKS) + , ("LIST", LIST) + , ("LUSERS", LUSERS) + , ("MODE", MODE) + , ("MOTD", MOTD) + , ("NAMES", NAMES) + , ("NICK", NICK) + , ("NJOIN", NJOIN) + , ("NOTICE", NOTICE) + , ("OPER", OPER) + , ("PART", PART) + , ("PASS", PASS) + , ("PING", PING) + , ("PONG", PONG) + , ("PRIVMSG", PRIVMSG) + , ("QUIT", QUIT) + , ("REHASH", REHASH) + , ("RESTART", RESTART) + , ("SERVER", SERVER) + , ("SERVICE", SERVICE) + , ("SERVLIST", SERVLIST) + , ("SQUERY", SQUERY) + , ("SQUIRT", SQUIRT) + , ("SQUIT", SQUIT) + , ("STATS", STATS) + , ("SUMMON", SUMMON) + , ("TIME", TIME) + , ("TOPIC", TOPIC) + , ("TRACE", TRACE) + , ("USER", USER) + , ("USERHOST", USERHOST) + , ("USERS", USERS) + , ("VERSION", VERSION) + , ("WALLOPS", WALLOPS) + , ("WHO", WHO) + , ("WHOIS", WHOIS) + , ("WHOWAS", WHOWAS) + ] + +replies :: [(Int, Command)] +replies = + [ (001, RPL_WELCOME) + , (002, RPL_YOURHOST) + , (003, RPL_CREATED) + , (004, RPL_MYINFO) + , (005, RPL_BOUNCE) + + , (200, RPL_TRACELINK) + , (201, RPL_TRACECONNECTING) + , (202, RPL_TRACEHANDSHAKE) + , (203, RPL_TRACEUNKNOWN) + , (204, RPL_TRACEOPERATOR) + , (205, RPL_TRACEUSER) + , (206, RPL_TRACESERVER) + , (207, RPL_TRACESERVICE) + , (208, RPL_TRACENEWTYPE) + , (209, RPL_TRACECLASS) + , (210, RPL_TRACERECONNECT) + , (211, RPL_STATSLINKINFO) + , (212, RPL_STATSCOMMANDS) + , (219, RPL_ENDOFSTATS) + , (221, RPL_UMODEIS) + , (234, RPL_SERVLIST) + , (235, RPL_SERVLISTEND) + , (242, RPL_STATSUPTIME) + , (243, RPL_STATSOLINE) + , (251, RPL_LUSERCLIENT) + , (252, RPL_LUSEROP) + , (253, RPL_LUSERUNKNOWN) + , (254, RPL_LUSERCHANNELS) + , (255, RPL_LUSERME) + , (256, RPL_ADMINME) + , (257, RPL_ADMINLOC1) + , (258, RPL_ADMINLOC2) + , (259, RPL_ADMINEMAIL) + , (261, RPL_TRACELOG) + , (262, RPL_TRACEEND) + , (263, RPL_TRYAGAIN) + , (301, RPL_AWAY) + , (302, RPL_USERHOST) + , (303, RPL_ISON) + , (305, RPL_UNAWAY) + , (306, RPL_NOWAWAY) + , (311, RPL_WHOISUSER) + , (312, RPL_WHOISSERVER) + , (313, RPL_WHOISOPERATOR) + , (314, RPL_WHOWASUSER) + , (315, RPL_ENDOFWHO) + , (317, RPL_WHOISIDLE) + , (318, RPL_ENDOFWHOIS) + , (319, RPL_WHOISCHANNELS) + , (321, RPL_LISTSTART) + , (322, RPL_LIST) + , (323, RPL_LISTEND) + , (324, RPL_CHANNELMODEIS) + , (325, RPL_UNIQOPIS) + , (331, RPL_NOTOPIC) + , (332, RPL_TOPIC) + , (341, RPL_INVITING) + , (342, RPL_SUMMONING) + , (346, RPL_INVITELIST) + , (347, RPL_ENDOFINVITELIST) + , (348, RPL_EXCEPTLIST) + , (349, RPL_ENDOFEXCEPTLIST) + , (351, RPL_VERSION) + , (352, RPL_WHOREPLY) + , (353, RPL_NAMREPLY) + , (364, RPL_LINKS) + , (365, RPL_ENDOFLINKS) + , (366, RPL_ENDOFNAMES) + , (367, RPL_BANLIST) + , (368, RPL_ENDOFBANLIST) + , (369, RPL_ENDOFWHOWAS) + , (371, RPL_INFO) + , (372, RPL_MOTD) + , (374, RPL_ENDOFINFO) + , (375, RPL_MOTDSTART) + , (376, RPL_ENDOFMOTD) + , (381, RPL_YOUREOPER) + , (382, RPL_REHASHING) + , (383, RPL_YOURESERVICE) + , (391, RPL_TIME) + , (392, RPL_USERSSTART) + , (393, RPL_USERS) + , (394, RPL_ENDOFUSERS) + , (395, RPL_NOUSERS) + + , (401, ERR_NOSUCHNICK) + , (402, ERR_NOSUCHSERVER) + , (403, ERR_NOSUCHCHANNEL) + , (404, ERR_CANNOTSENDTOCHAN) + , (405, ERR_TOOMANYCHANNELS) + , (406, ERR_WASNOSUCHNICK) + , (407, ERR_TOOMANYTARGETS) + , (408, ERR_NOSUCHSERVICE) + , (409, ERR_NOORIGIN) + , (411, ERR_NORECIPIENT) + , (412, ERR_NOTEXTTOSEND) + , (413, ERR_NOTOPLEVEL) + , (414, ERR_WILDTOPLEVEL) + , (415, ERR_BADMASK) + , (421, ERR_UNKNOWNCOMMAND) + , (422, ERR_NOMOTD) + , (423, ERR_NOADMININFO) + , (424, ERR_FILEERROR) + , (431, ERR_NONICKNAMEGIVEN) + , (432, ERR_ERRONEUSNICKNAME) + , (433, ERR_NICKNAMEINUSE) + , (436, ERR_NICKCOLLISION) + , (437, ERR_UNAVAILRESOURCE) + , (441, ERR_USERNOTINCHANNEL) + , (442, ERR_NOTONCHANNEL) + , (443, ERR_USERONCHANNEL) + , (444, ERR_NOLOGIN) + , (445, ERR_SUMMONDISABLED) + , (446, ERR_USERSDISABLED) + , (451, ERR_NOTREGISTERED) + , (461, ERR_NEEDMOREPARAMS) + , (462, ERR_ALREADYREGISTRED) + , (463, ERR_NOPERMFORHOST) + , (464, ERR_PASSWDMISMATCH) + , (465, ERR_YOUREBANNEDCREEP) + , (466, ERR_YOUWILLBEBANNED) + , (467, ERR_KEYSET) + , (471, ERR_CHANNELISFULL) + , (472, ERR_UNKNOWNMODE) + , (473, ERR_INVITEONLYCHAN) + , (474, ERR_BANNEDFROMCHAN) + , (475, ERR_BADCHANNELKEY) + , (476, ERR_BADCHANMASK) + , (477, ERR_NOCHANMODES) + , (478, ERR_BANLISTFULL) + , (481, ERR_NOPRIVILEGES) + , (482, ERR_CHANOPRIVSNEEDED) + , (483, ERR_CANTKILLSERVER) + , (484, ERR_RESTRICTED) + , (485, ERR_UNIQOPPRIVSNEEDED) + , (491, ERR_NOOPERHOST) + , (501, ERR_UMODEUNKNOWNFLAG) + , (502, ERR_USERSDONTMATCH) + ] + +mCommandText :: HashMap Command Text +mCommandText = + M.fromList $ + map (\(s,c) -> (c,s)) commands <> + map (\(i,c) -> (c,show3 i)) replies + +mTextCommand :: HashMap Text Command +mTextCommand = + M.fromList $ + map (\(s,c) -> (s,c)) commands <> + map (\(i,c) -> (show3 i,c)) replies + +show3 :: Int -> Text +show3 i = + p <> s + where s = T.show i + p = T.replicate (3 - T.length s) "0" diff --git a/src/Reaktor/Internal.hs b/src/Reaktor/Internal.hs index e52a347..09dd723 100644 --- a/src/Reaktor/Internal.hs +++ b/src/Reaktor/Internal.hs @@ -6,8 +6,10 @@ module Reaktor.Internal where import Prelude.Extended import Blessings import Data.Aeson +import Data.String.Conversions (convertString) import qualified Data.Text as T import Network.Socket as Exports (HostName,ServiceName) +import Reaktor.IRC import System.IO @@ -50,15 +52,14 @@ instance FromJSON Config where tlsPort :: ServiceName tlsPort = "6697" - -data Message = Message (Maybe Text) Text [Text] | Start +data Message = Message (Maybe Text) Command [Text] | Start deriving Show formatMessage :: Message -> Text formatMessage = \case Message mb_prefix cmd params -> maybe "" ((":"<>) . (<>" ")) mb_prefix - <> cmd + <> convertString cmd <> T.concat (map (" "<>) (init params)) <> if null params then "" else " :" <> last params <> "\r\n" diff --git a/src/Reaktor/Parser.hs b/src/Reaktor/Parser.hs index f226ad5..6fbcce9 100644 --- a/src/Reaktor/Parser.hs +++ b/src/Reaktor/Parser.hs @@ -1,11 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} module Reaktor.Parser where -import Prelude.Extended import Control.Applicative import Data.Attoparsec.Text import qualified Data.Char +import Data.String.Conversions (convertString) import qualified Data.Text.Extended as T +import Prelude.Extended +import Reaktor.IRC import Reaktor.Internal @@ -13,8 +15,9 @@ prefix :: Parser Text prefix = T.pack <$> many (satisfy Data.Char.isAlphaNum <|> satisfy (flip elem (":.-@/!~[]\\`_^{|}" :: String))) -command :: Parser Text -command = T.pack <$> many1 (satisfy Data.Char.isAlphaNum) +command :: Parser Command +command = + convertString . T.pack <$> many1 (satisfy Data.Char.isAlphaNum) nospcrlfcl :: Parser Char nospcrlfcl = diff --git a/src/Reaktor/Plugins/Mention.hs b/src/Reaktor/Plugins/Mention.hs index b3cdbb8..b288fdb 100644 --- a/src/Reaktor/Plugins/Mention.hs +++ b/src/Reaktor/Plugins/Mention.hs @@ -3,16 +3,16 @@ {-# LANGUAGE RecordWildCards #-} module Reaktor.Plugins.Mention (new) where -import Prelude.Extended import qualified Data.Char import qualified Data.Text as T +import Prelude.Extended import Reaktor new :: Actions -> IO (Message -> IO ()) new Actions{..} = do pure $ \case - Message _ "PRIVMSG" (msgtarget:text:[]) -> do + Message _ PRIVMSG (msgtarget:text:[]) -> do nick <- aGetNick when (isMention nick text) $ do aSend (privmsg msgtarget ["I'm famous!"]) diff --git a/src/Reaktor/Plugins/Ping.hs b/src/Reaktor/Plugins/Ping.hs index 436ebe2..07aae9e 100644 --- a/src/Reaktor/Plugins/Ping.hs +++ b/src/Reaktor/Plugins/Ping.hs @@ -10,6 +10,6 @@ new :: Actions -> IO (Message -> IO ()) new Actions{..} = return $ \case Message _ cmd args -> - when (cmd == "PING") $ - aSend (Message Nothing "PONG" args) + when (cmd == PING) $ + aSend (Message Nothing PONG args) _ -> pure () diff --git a/src/Reaktor/Plugins/Register.hs b/src/Reaktor/Plugins/Register.hs index ff420f0..979e4ba 100644 --- a/src/Reaktor/Plugins/Register.hs +++ b/src/Reaktor/Plugins/Register.hs @@ -5,12 +5,12 @@ module Reaktor.Plugins.Register where import Blessings -import Prelude.Extended import Data.Aeson import qualified Data.Text as T import qualified Data.Text.IO as T -import qualified Reaktor.Nick as Nick +import Prelude.Extended import Reaktor +import qualified Reaktor.Nick as Nick import System.Environment (lookupEnv) data ConfigNickServ = ConfigNickServ @@ -60,43 +60,43 @@ new Config{..} Actions{..} = do -- TODO JOIN only if not already joined -- i.e. not during subsequent nick changes unless (T.null channelsArg) $ - aSend (Message Nothing "JOIN" [channelsArg]) + aSend (Message Nothing JOIN [channelsArg]) start = do nick <- maybe aGetNick pure cNick user <- maybe (maybe nick T.pack <$> lookupEnv "LOGNAME") pure cUser aSetNick nick - aSend (Message Nothing "NICK" [nick]) - aSend (Message Nothing "USER" [user, "*", "0", cReal]) + aSend (Message Nothing NICK [nick]) + aSend (Message Nothing USER [user, "*", "0", cReal]) onNick newnick = do nick <- aGetNick when (newnick == nick) join useRandomNick = do nick <- Nick.getRandom aSetNick nick - aSend (Message Nothing "NICK" [nick]) + aSend (Message Nothing NICK [nick]) useNextNick = do nick0 <- aGetNick let nick = Nick.getNext nick0 aSetNick nick - aSend (Message Nothing "NICK" [nick]) + aSend (Message Nothing NICK [nick]) useNextNickTemporarily = do nick <- aGetNick let tmpNick = Nick.getNext nick -- do not aSetNick tmpNick - aSend (Message Nothing "NICK" [tmpNick]) + aSend (Message Nothing NICK [tmpNick]) if not isNickServEnabled then do when (isJust cNickServ) $ do aLog $ SGR [38,5,202] "! disabling NickServ due to insecure connection" pure $ \case Start -> start - Message (Just _self) "NICK" (newnick:[]) -> onNick newnick - Message _ "001" _ -> join - Message _ "432" _ -> useRandomNick - Message _ "433" _ -> useNextNick - Message _ "437" (_msgtarget:res:_reason:[]) -> do + Message (Just _self) NICK (newnick:[]) -> onNick newnick + Message _ RPL_WELCOME _ -> join + Message _ ERR_ERRONEUSNICKNAME _ -> useRandomNick + Message _ ERR_NICKNAMEINUSE _ -> useNextNick + Message _ ERR_UNAVAILRESOURCE (_msgtarget:res:_reason:[]) -> do nick <- aGetNick when (res == nick) useNextNick _ -> pure () @@ -106,16 +106,15 @@ new Config{..} Actions{..} = do [pass] <- T.lines <$> T.readFile cnsPassFile pure $ \case Start -> start - Message (Just _self) "NICK" (newnick:[]) -> onNick newnick + Message (Just _self) NICK (newnick:[]) -> onNick newnick - -- RFC2812 RPL_WELCOME - Message _ "001" [msgtarget,_text] -> do + Message _ RPL_WELCOME [msgtarget,_text] -> do nick <- aGetNick aSend (privmsg "NickServ" ["IDENTIFY", nick, pass]) when (msgtarget /= nick) (regain nick pass) -- TODO structured prefix, and check just for "NickServ"? - Message (Just prefix) "NOTICE" (msgtarget:text:[]) -> + Message (Just prefix) NOTICE (msgtarget:text:[]) -> when (prefix == cnsPrefix) $ do nick <- aGetNick let stx = ("\STX"<>) . (<>"\STX") @@ -135,17 +134,14 @@ new Config{..} Actions{..} = do | otherwise -> pure () - -- RFC1459 ERR_ERRONEUSNICKNAME - Message (Just _servername) "432" (_msgtarget:_nick:_reason:[]) -> + Message _ ERR_ERRONEUSNICKNAME (_msgtarget:_nick:_reason:[]) -> useRandomNick - -- RFC1459 ERR_NICKNAMEINUSE - Message (Just _servername) "433" (_msgtarget:_nick:_reason:[]) -> + Message _ ERR_NICKNAMEINUSE (_msgtarget:_nick:_reason:[]) -> -- TODO what if nick0 /= nick? OR assert/prove nick0 == nick? useNextNickTemporarily - --RFC2812 ERR_UNAVAILRESOURCE - Message (Just _servername) "437" (msgtarget:res:_reason:[]) -> do + Message _ ERR_UNAVAILRESOURCE (msgtarget:res:_reason:[]) -> do nick <- aGetNick when (res == nick) $ case msgtarget of diff --git a/src/Reaktor/Plugins/System.hs b/src/Reaktor/Plugins/System.hs index a39bd23..864bbc3 100644 --- a/src/Reaktor/Plugins/System.hs +++ b/src/Reaktor/Plugins/System.hs @@ -36,12 +36,12 @@ import qualified Text.Regex.PCRE.Light as RE new :: Config -> Actions -> IO (Message -> IO ()) new config@Config{..} actions@Actions{..} = do pure $ \case - Message (Just prefix) "PRIVMSG" (msgtarget:text:[]) -> do - let hooks = maybe [] id (M.lookup "PRIVMSG" cHooks) + Message (Just prefix) PRIVMSG (msgtarget:text:[]) -> do + let hooks = maybe [] id (M.lookup PRIVMSG cHooks) mapM_ (\h -> run1 config actions h prefix msgtarget text) hooks - Message (Just prefix) "JOIN" (channel:[]) -> do - let hooks = maybe [] id (M.lookup "JOIN" cHooks) + Message (Just prefix) JOIN (channel:[]) -> do + let hooks = maybe [] id (M.lookup JOIN cHooks) mapM_ (\h -> run1 config actions h prefix channel "") hooks _ -> pure () diff --git a/src/Reaktor/Plugins/System/Internal.hs b/src/Reaktor/Plugins/System/Internal.hs index aa60452..d042217 100644 --- a/src/Reaktor/Plugins/System/Internal.hs +++ b/src/Reaktor/Plugins/System/Internal.hs @@ -5,6 +5,7 @@ module Reaktor.Plugins.System.Internal where import Prelude.Extended import Data.Aeson import Reaktor () +import qualified Reaktor.IRC as IRC import Text.Regex.PCRE.Light (Regex) import qualified Text.Regex.PCRE.Light as RE @@ -30,7 +31,7 @@ instance FromJSON Activate where data Config = Config { cWorkDir :: Maybe FilePath - , cHooks :: HashMap Text [Hook] + , cHooks :: HashMap IRC.Command [Hook] } deriving Show |