From e9ca12a945b1d1c068e9c31050e264cb20690db4 Mon Sep 17 00:00:00 2001 From: tv Date: Sun, 27 Jan 2019 03:23:17 +0100 Subject: Reaktor: add data Command --- src/Reaktor/Plugins/Mention.hs | 4 ++-- src/Reaktor/Plugins/Ping.hs | 4 ++-- src/Reaktor/Plugins/Register.hs | 42 +++++++++++++++------------------- src/Reaktor/Plugins/System.hs | 8 +++---- src/Reaktor/Plugins/System/Internal.hs | 3 ++- 5 files changed, 29 insertions(+), 32 deletions(-) (limited to 'src/Reaktor/Plugins') 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 -- cgit v1.2.3