From 6ba2ddfaeadb250b50e9b1593fd49631066d70e9 Mon Sep 17 00:00:00 2001 From: Joscha Date: Fri, 16 Feb 2018 00:19:19 +0000 Subject: [PATCH] Add Bot module --- src/EuphApi/Bot.hs | 186 +++++++++++++++++++++++++++++++++++++++++++++ test/bottest.hs | 16 ++++ 2 files changed, 202 insertions(+) create mode 100644 src/EuphApi/Bot.hs create mode 100644 test/bottest.hs diff --git a/src/EuphApi/Bot.hs b/src/EuphApi/Bot.hs new file mode 100644 index 0000000..fe675f4 --- /dev/null +++ b/src/EuphApi/Bot.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module EuphApi.Bot ( + -- Creating a bot + Bot + , BotConfig(..) + , runBot + -- Utilities + , fork + , getBotInfo + , getConnection + , getConnectionInfo + , defaultReconnectPolicy + , respondToPing + ) where + +import Control.Concurrent +import Control.Monad +import Control.Monad.IO.Class + +import Control.Concurrent.STM +import qualified Data.Text as T +import Control.Monad.Trans.Reader + +import qualified EuphApi.Connection as E + +data BotState b c = BotState + { bAddress :: TVar String + , bRoom :: TVar String + , bPassword :: TVar (Maybe T.Text) + , bNick :: TVar T.Text + , bHandler :: E.EventType -> Bot b c () + , bBotInfo :: b -- bot specific, user-defined info type + , bNewConnectionInfo :: IO c + , bReconnectPolicy :: Integer -> Maybe Int + , bStopping :: TVar Bool + -- connection specific + , bConnection :: E.Connection + , bConnectionInfo :: c -- connection specific, user-defined info type + } + +type Bot b c = ReaderT (BotState b c) IO + +data BotConfig b c = BotConfig + { botAddress :: String + , botRoom :: String + , botPassword :: Maybe String + , botNick :: String + , botHandler :: E.EventType -> Bot b c () + , botInfo :: b + , botNewConnectionInfo :: IO c + , botReconnectPolicy :: Integer -> Maybe Int + } + +fork :: Bot b c a -> Bot b c () +fork bot = do + state <- ask + void $ liftIO $ forkIO $ void $ runReaderT bot state + +getBotInfo :: Bot b c b +getBotInfo = asks bBotInfo + +getConnection :: Bot b c E.Connection +getConnection = asks bConnection + +getConnectionInfo :: Bot b c c +getConnectionInfo = asks bConnectionInfo + +defaultReconnectPolicy :: Integer -> Maybe Int +defaultReconnectPolicy n = Just $ (2 ^ n) * 1000 * 1000 -- in microseconds + +respondToPing :: E.EventType -> Bot b c () +respondToPing (E.EuphEvent (E.PingEvent time _)) = do + con <- getConnection + liftIO $ E.pingReply con time -- TODO: Replace with bot version of the command +respondToPing _ = return () + +runBot :: BotConfig b c -> IO () +runBot 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 + bConnection <- E.startEuphConnection botAddress botRoom + bConnectionInfo <- botNewConnectionInfo + let bHandler = botHandler + bBotInfo = botInfo + bNewConnectionInfo = botNewConnectionInfo + bReconnectPolicy = botReconnectPolicy + state = BotState{..} + runReaderT eventLoop state + +reconnect :: Integer -> Bot b c () +reconnect retries = do + state <- ask + stopping <- liftIO $ atomically $ readTVar $ bStopping state + if stopping + then return () + else + case (bReconnectPolicy state $ retries) of + Nothing -> return () + Just delay -> do + liftIO $ threadDelay delay + address <- liftIO $ atomically $ readTVar $ bAddress state + room <- liftIO $ atomically $ readTVar $ bRoom state + con <- liftIO $ E.startEuphConnection address room + conInfo <- liftIO $ bNewConnectionInfo state + let newState = state{bConnection=con, bConnectionInfo=conInfo} + local (const newState) eventLoop + -- lift $ runReaderT eventLoop newState + +eventLoop :: Bot b c () +eventLoop = do + con <- getConnection + handler <- asks bHandler + event <- liftIO $ E.getEvent con + handler event + case event of + E.ConnectionFailed -> reconnect 0 + E.Disconnected -> reconnect 0 + E.EuphEvent e -> do + handlePasswordStuff e + handleNickStuff e + eventLoop + +handleNickStuff :: E.Event -> Bot b c () +handleNickStuff (E.SnapshotEvent _ _ _ maybeNick) = do + myNickVar <- asks bNick + myNick <- liftIO $ atomically $ readTVar $ myNickVar + con <- getConnection + case maybeNick of + Nothing -> fork $ liftIO $ E.nick con myNick + Just nick -> + if nick == myNick + then return () + else fork $ liftIO $ E.nick con myNick +handleNickStuff _ = return () + +handlePasswordStuff :: E.Event -> Bot b c () +handlePasswordStuff (E.BounceEvent _ (Just options)) + | "passcode" `elem` options = do + myPasswordVar <- asks bPassword + myPassword <- liftIO $ atomically $ readTVar $ myPasswordVar + con <- getConnection + case myPassword of + Nothing -> fork $ liftIO $ E.disconnect con -- TODO: Do something here + Just p -> fork $ liftIO $ E.auth con p + | otherwise = return () +handlePasswordStuff _ = return () + +-- +-- +-- +-- +-- +-- +-- + +-- BOT EXAMPLE +{- +data MyConSpec = MyConSpec + { mySessionView :: TVar E.SessionView + , myListing :: TVar E.Listing + , myArchive :: TVar E.Archive + } + +instance ConSpecific MyConSpec where + newConSpecific = do + mySessionView <- newTVar empty + myListing <- newTVar empty + myArchive <- newTVar empty + return MyConSpec{..} + +myBotConfig :: BotConfig +myBotConfig = defaultBotConfig{botNick="MyTestBot", botHandler=myHandler} + +myHandler :: E.Event -> Bot () MyConSpec () +myHandler e = undefined $ do + conSpec <- getConSpecific + upateOwnView e (mySessionView conSpec) + upateListing e (myListing conSpec) + upateArchive e (myArchive conSpec) + withEuphEvent e handleEuphEvent +-} diff --git a/test/bottest.hs b/test/bottest.hs new file mode 100644 index 0000000..26ad622 --- /dev/null +++ b/test/bottest.hs @@ -0,0 +1,16 @@ +import qualified EuphApi.Bot as E +import qualified EuphApi.Connection as E + +myBotConfig :: E.BotConfig () () +myBotConfig = E.BotConfig + { E.botAddress = "euphoria.io" + , E.botRoom = "test" + , E.botPassword = Nothing + , E.botNick = "EuphApiTestBot" + , E.botHandler = E.respondToPing + , E.botInfo = () + , E.botNewConnectionInfo = return () + , E.botReconnectPolicy = E.defaultReconnectPolicy + } + +main = E.runBot myBotConfig