diff --git a/src/EuphApi/Bot.hs b/src/EuphApi/Bot.hs index 45515a5..d040abf 100644 --- a/src/EuphApi/Bot.hs +++ b/src/EuphApi/Bot.hs @@ -54,8 +54,9 @@ -- If you want your bot to comply with the , -- see "EuphApi.Utils.Botulez". -- --- For a simple example bot that just connects to , --- see +-- For a simple example bot that just connects to +-- and follows all mandatory and most optional botrulez, +-- see -- in the tests folder of the repository. -- This example bot also configures the logger to use a custom output format. -- @@ -63,7 +64,7 @@ -- -- This library uses the hslogger package for logging. -- --- See +-- See -- for an example of how to set the global format. module EuphApi.Bot ( @@ -83,6 +84,7 @@ module EuphApi.Bot ( , getOwnView -- * Bot commands , stop + , restart , send , reply , nick @@ -94,6 +96,9 @@ module EuphApi.Bot ( , BotException(..) ) where +-- TODO: Move 'PasswordNeeded' to 'ExitState'? +-- TODO: Add 'WrongPassword' exception or 'ExitState'. + import Control.Concurrent import Control.Exception import Control.Monad @@ -117,8 +122,8 @@ infoM :: String -> IO () infoM = L.infoM moduleName noticeM :: String -> IO () noticeM = L.noticeM moduleName ---warningM :: String -> IO () ---warningM = L.warningM moduleName +warningM :: String -> IO () +warningM = L.warningM moduleName --errorM :: String -> IO () --errorM = L.errorM moduleName --criticalM :: String -> IO () @@ -128,6 +133,10 @@ noticeM = L.noticeM moduleName --emergencyM :: String -> IO () --emergencyM = L.emergencyM moduleName +data ExitState = Stopping + | Restarting + | OutOfRetries + data BotState b c = BotState { bAddress :: TVar String , bRoom :: TVar String @@ -137,7 +146,7 @@ data BotState b c = BotState , bBotInfo :: b -- bot specific, user-defined info type , bNewConnectionInfo :: IO c , bReconnectPolicy :: Integer -> Maybe Int - , bStopping :: TVar Bool + , bStopping :: TVar (Maybe ExitState) , bStartTime :: UTCTime -- connection specific , bConnection :: E.Connection @@ -239,14 +248,13 @@ defaultReconnectPolicy n = Just $ (2 ^ n) * 1000 * 1000 -- in microseconds - Running a bot -} --- | Execute a bot in this thread. -runBot :: BotConfig b c -> IO () -runBot BotConfig{..} = do +runBotOnce :: BotConfig b c -> IO ExitState +runBotOnce BotConfig{..} = do bAddress <- atomically $ newTVar botAddress bRoom <- atomically $ newTVar botRoom bPassword <- atomically $ newTVar $ T.pack <$> botPassword bNick <- atomically $ newTVar $ T.pack botNick - bStopping <- atomically $ newTVar False + bStopping <- atomically $ newTVar Nothing bOwnView <- atomically $ newTVar Nothing noticeM $ "Connecting to &" ++ botRoom ++ " on " ++ show botAddress ++ "." bConnectionInfo <- botNewConnectionInfo @@ -260,15 +268,29 @@ runBot BotConfig{..} = do state = BotState{..} runReaderT (eventLoop 0) state -reconnect :: Integer -> Bot b c () +-- | Execute a bot in this thread. +-- +-- Every time a bot is (re-)started, the 'IO' action passed to this function +-- will be executed to obtain a new 'BotConfig'. +-- This config is then used to run the bot. +runBot :: IO (BotConfig b c) -> IO () +runBot ioConfig = do + config <- ioConfig + result <- runBotOnce config + case result of + Stopping -> void $ noticeM "Bot has stopped." + OutOfRetries -> void $ warningM "Bot ran out of retries." + Restarting -> noticeM "Bot has restarted." >> runBot ioConfig + +reconnect :: Integer -> Bot b c ExitState reconnect retries = do state <- ask stopping <- liftIO $ atomically $ readTVar $ bStopping state - if stopping - then return () - else + case stopping of + Just s -> return s + Nothing -> case bReconnectPolicy state retries of - Nothing -> return () + Nothing -> return OutOfRetries Just delay -> do liftIO $ infoM $ "Attempting reconnect in " ++ show (delay `div` 1000000) ++ "s (" ++ show delay ++ "µs)." @@ -288,7 +310,7 @@ reconnect retries = do local (const newState) (eventLoop retries) -- lift $ runReaderT (eventLoop retries) newState -eventLoop :: Integer -> Bot b c () +eventLoop :: Integer -> Bot b c ExitState eventLoop retries = do con <- getConnection handler <- asks bHandler @@ -329,9 +351,9 @@ handlePasswordStuff (E.BounceEvent _ (Just options)) myPassword <- liftIO $ atomically $ readTVar myPasswordVar con <- getConnection case myPassword of - Nothing -> fork $ liftIO $ E.disconnect con -- TODO: Do something here + Nothing -> liftIO $ throwIO PasswordNeeded Just p -> fork $ liftIO $ E.auth con p - | otherwise = return () -- TODO: And also here + | otherwise = liftIO $ throwIO NoValidAuthenticationMethods handlePasswordStuff _ = return () handleOwnViewStuff :: E.Event -> Bot b c () @@ -356,15 +378,24 @@ changeOwnNick var newNick = do - Commands -} +stopWith :: ExitState -> Bot b c () +stopWith s = do + stopping <- asks bStopping + con <- asks bConnection + liftIO $ do + atomically $ writeTVar stopping (Just s) + E.disconnect con + -- | Stop the bot. stop :: Bot b c () -stop = do - stopping <- asks bStopping - con <- asks bConnection - liftIO $ do - atomically $ writeTVar stopping False - E.disconnect con - noticeM "Bot was stopped." +stop = stopWith Stopping + +-- | Restart the bot. +-- +-- This will run the IO action passed to 'runBot' again to obtain a new 'BotConfig'. +-- Then, the new config is used to run the bot again. +restart :: Bot b c () +restart = stopWith Restarting -- | Send a new message. send :: T.Text -> Bot b c E.Message @@ -423,8 +454,18 @@ who = do data BotException = NoOwnViewYet -- ^ The bot has not received a SessionView for its current connection -- from the server yet. + | PasswordNeeded + -- ^ The bot got bounced and needs a password to authenticate, + -- but none was provided in the config. + | NoValidAuthenticationMethods + -- ^ The bot got bounced, but the server didn't provide any + -- valid methods of authentication (password). + -- As long as the server is working properly, this exception should + -- not occur. instance Show BotException where - show NoOwnViewYet = "Bot hasn't received a SessionView of itself yet." + show NoOwnViewYet = "Bot hasn't received a SessionView of itself yet." + show PasswordNeeded = "Bot needs to authenticate, but has no password." + show NoValidAuthenticationMethods = "Server gave no valid authentication methods." instance Exception BotException diff --git a/src/EuphApi/Utils/Botrulez.hs b/src/EuphApi/Utils/Botrulez.hs index b6a493f..35c5b1e 100644 --- a/src/EuphApi/Utils/Botrulez.hs +++ b/src/EuphApi/Utils/Botrulez.hs @@ -11,6 +11,9 @@ module EuphApi.Utils.Botrulez , uptimeCommand , generalUptimeCommand , killCommand + , killCommandSilent + , restartCommand + , restartCommandSilent ) where import Control.Monad @@ -83,7 +86,18 @@ generalUptimeCommand = E.command "uptime" uptime -- When killed, bots should disconnect and not reconnect. -- -- Bots __may implement__ this command. -killCommand :: E.Command b c -killCommand = E.specificCommand "kill" $ \msg -> do - void $ B.reply (E.msgID msg) "Bye!" +killCommand :: T.Text -> E.Command b c +killCommand t = E.specificCommand "kill" $ \msg -> do + void $ B.reply (E.msgID msg) t B.stop + +killCommandSilent :: E.Command b c +killCommandSilent = E.specificCommand "kill" $ const B.stop + +restartCommand :: T.Text -> E.Command b c +restartCommand t = E.specificCommand "restart" $ \msg -> do + void $ B.reply (E.msgID msg) t + B.restart + +restartCommandSilent :: E.Command b c +restartCommandSilent = E.specificCommand "restart" $ const B.restart diff --git a/test/bot_simple_custom_logging.hs b/test/bot_simple_custom_logging.hs deleted file mode 100644 index 4ef882b..0000000 --- a/test/bot_simple_custom_logging.hs +++ /dev/null @@ -1,28 +0,0 @@ -import System.IO - -import qualified System.Log.Formatter as LF -import qualified System.Log.Handler as LH -import qualified System.Log.Handler.Simple as LH -import qualified System.Log.Logger as L - -import qualified EuphApi.Bot as B - -myBotConfig :: B.BotConfig () () -myBotConfig = B.BotConfig - { B.botAddress = "euphoria.io" - , B.botRoom = "test" - , B.botPassword = Nothing - , B.botNick = "EuphApiTestBot" - , B.botHandler = const $ return () - , B.botInfo = () - , B.botNewConnectionInfo = return () - , B.botReconnectPolicy = B.defaultReconnectPolicy - } - -main = do - myHandler <- LH.verboseStreamHandler stdout L.INFO - let myFormatter = LF.simpleLogFormatter "<$time> [$loggername/$prio] $msg" - myFormattedHandler = LH.setFormatter myHandler myFormatter - L.updateGlobalLogger L.rootLoggerName (L.setHandlers [myFormattedHandler]) - L.updateGlobalLogger L.rootLoggerName (L.setLevel L.INFO) - B.runBot myBotConfig diff --git a/test/bot_with_botrulez.hs b/test/bot_with_botrulez.hs index 4b9d1ef..7818db0 100644 --- a/test/bot_with_botrulez.hs +++ b/test/bot_with_botrulez.hs @@ -23,12 +23,8 @@ myCommands = , E.generalHelpCommand "I help test @Garmy's EuphApi" , E.uptimeCommand , E.generalUptimeCommand -- most bots don't do this - , E.command "whatsmynick" (\msg -> do - nick <- E.sessName <$> B.getOwnView - let content = nick <> "\n" <> E.mention nick <> "\n" <> E.atMention nick - <> "\n" <> E.mentionReduce nick - void $ B.reply (E.msgID msg) content - ) + , E.killCommand "Bye!" + , E.restartCommand "brb" ] myBotHandler :: E.EventType -> B.Bot b c () @@ -48,9 +44,9 @@ myBotConfig = B.BotConfig } main = do - myHandler <- LH.verboseStreamHandler stdout L.DEBUG + myHandler <- LH.verboseStreamHandler stdout L.INFO let myFormatter = LF.simpleLogFormatter "<$time> [$loggername/$prio] $msg" myFormattedHandler = LH.setFormatter myHandler myFormatter L.updateGlobalLogger L.rootLoggerName (L.setHandlers [myFormattedHandler]) - L.updateGlobalLogger L.rootLoggerName (L.setLevel L.DEBUG) - B.runBot myBotConfig + L.updateGlobalLogger L.rootLoggerName (L.setLevel L.INFO) + B.runBot (return myBotConfig)