summaryrefslogtreecommitdiff
path: root/HsbotMaster/Hsbot
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--HsbotMaster/Hsbot/.gitignore2
-rw-r--r--HsbotMaster/Hsbot/Config.hs9
-rw-r--r--HsbotMaster/Hsbot/Core.hs91
-rw-r--r--HsbotMaster/Hsbot/Message.hs35
-rw-r--r--HsbotMaster/Hsbot/Plugin.hs67
-rw-r--r--HsbotMaster/Hsbot/PluginUtils.hs15
-rw-r--r--HsbotMaster/Hsbot/Types.hs72
7 files changed, 0 insertions, 291 deletions
diff --git a/HsbotMaster/Hsbot/.gitignore b/HsbotMaster/Hsbot/.gitignore
deleted file mode 100644
index a5aa1b9..0000000
--- a/HsbotMaster/Hsbot/.gitignore
+++ /dev/null
@@ -1,2 +0,0 @@
-.*.swp
-Session.vim
diff --git a/HsbotMaster/Hsbot/Config.hs b/HsbotMaster/Hsbot/Config.hs
deleted file mode 100644
index 121cc98..0000000
--- a/HsbotMaster/Hsbot/Config.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Hsbot.Config
- ( BotConfig (..)
- ) where
-
-import Hsbot.Irc.Config
-
--- | Configuration data type
-data BotConfig = IrcBotConfig IrcConfig
-
diff --git a/HsbotMaster/Hsbot/Core.hs b/HsbotMaster/Hsbot/Core.hs
deleted file mode 100644
index d634f10..0000000
--- a/HsbotMaster/Hsbot/Core.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-module Hsbot.Core
- ( hsbot
- ) where
-
-import Control.Concurrent.Chan
-import Control.Concurrent.MVar
-import Control.Exception
-import Control.Monad.State
-import qualified Data.Map as M
-import Data.Time
-import Prelude hiding (catch)
-import System.IO()
-import System.Posix.Signals
-
-import Hsbot.Config
-import Hsbot.Message
-import Hsbot.Plugin
-import Hsbot.Types
-
--- | Bot's main entry point
-hsbot :: [BotConfig] -> Maybe String -> IO ()
-hsbot config txtResumeData= do
- let resumeData = case txtResumeData of
- Just txtData -> read txtData :: BotResumeData -- TODO : catch exception
- Nothing -> M.empty :: BotResumeData
- startTime <- case M.lookup "HSBOT" resumeData of
- Just hsbotData -> do
- case M.lookup "STARTTIME" hsbotData of
- Just txtStartTime -> do
- let gotStartTime = read txtStartTime :: UTCTime
- return gotStartTime
- Nothing -> getCurrentTime
- Nothing -> getCurrentTime
- let resumeData' = M.insert "HSBOT" (M.singleton "STARTTIME" $ show startTime) resumeData
- putStrLn "[Hsbot] Opening communication channel... "
- chan <- newChan :: IO (Chan BotMsg)
- mvar <- newMVar resumeData' :: IO (MVar BotResumeData)
- putStrLn "[Hsbot] Installing signal handlers... "
- _ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing
- _ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing
- putStrLn "[Hsbot] Spawning IrcBot plugins... "
- botState <- execStateT spawnPlugins BotState { botStartTime = startTime
- , botPlugins = M.empty
- , botChan = chan
- , botConfig = config
- , botResumeData = mvar }
- putStrLn "[Hsbot] Entering main loop... "
- (status, botState') <- runLoop botState
- putStrLn "[Hsbot] Killing active plugins... "
- newResumeData <- takeMVar mvar
- evalStateT (mapM_ killPlugin $ M.keys newResumeData) botState'
- if status == BotReboot
- then hsbot config (Just $ show newResumeData) -- TODO : exec on the hsbot launcher with the reload string
- else return ()
- where
- runLoop :: BotState -> IO (BotStatus, BotState)
- runLoop botState = do
- (status, botState') <- (runStateT botCore botState) `catches` [ Handler (\ (_ :: IOException) -> return (BotExit, botState))
- , Handler (\ (_ :: AsyncException) -> return (BotExit, botState)) ]
- case status of
- BotContinue -> runLoop botState'
- _ -> return (status, botState')
-
--- | Run the bot main loop
-botCore :: Bot (BotStatus)
-botCore = do
- chan <- gets botChan
- msg <- liftIO $ readChan chan
- case msg of
- IntMsg intMsg -> processInternalMessage intMsg
- UpdMsg updMsg -> processUpdateMessage updMsg
- RebMsg rebMsg -> processRebootMessage rebMsg
- ExiMsg exiMsg -> processExitMessage exiMsg
-
--- | Process an update command
-processUpdateMessage :: ResumeMsg -> Bot (BotStatus)
-processUpdateMessage msg = do
- resumeData <- gets botResumeData
- let from = resMsgFrom msg
- stuff = resMsgData msg
- liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert from stuff oldData)
- return BotContinue
-
--- | signals handlers
-sigHupHandler :: Chan BotMsg -> IO ()
-sigHupHandler chan = writeChan chan $ RebMsg RebootMsg { rebMsgFrom = "HUP handler" }
-
--- | signals handlers
-sigTermHandler :: Chan BotMsg -> IO ()
-sigTermHandler chan = writeChan chan $ ExiMsg ExitMsg { exiMsgFrom = "TERM handler" }
-
diff --git a/HsbotMaster/Hsbot/Message.hs b/HsbotMaster/Hsbot/Message.hs
deleted file mode 100644
index 933394b..0000000
--- a/HsbotMaster/Hsbot/Message.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Hsbot.Message
- ( processInternalMessage
- , processRebootMessage
- , processExitMessage
- ) where
-
-import Control.Monad.State
-import qualified Data.Map as M
-
-import Hsbot.PluginUtils
-import Hsbot.Types
-
--- | Processes an internal message
-processInternalMessage :: Msg -> Bot (BotStatus)
-processInternalMessage msg
- | msgTo msg == "CORE" = processCoreMessage msg
- | otherwise = do
- plugins <- gets botPlugins
- case M.lookup (msgTo msg) plugins of
- Just (plugin, _, _) -> sendToPlugin (IntMsg msg) plugin
- Nothing -> return ()
- return BotContinue
-
-processCoreMessage :: Msg -> Bot (BotStatus)
-processCoreMessage msg = do
- case msgType msg of
- "REBOOT" -> return BotReboot
- _ -> return BotContinue
-
-processRebootMessage :: RebootMsg -> Bot (BotStatus)
-processRebootMessage _ = return BotReboot -- TODO : check who is sending that to us
-
-processExitMessage :: ExitMsg -> Bot (BotStatus)
-processExitMessage _ = return BotExit -- TODO : check who is sending that to us
-
diff --git a/HsbotMaster/Hsbot/Plugin.hs b/HsbotMaster/Hsbot/Plugin.hs
deleted file mode 100644
index 1493c73..0000000
--- a/HsbotMaster/Hsbot/Plugin.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-module Hsbot.Plugin
- ( killPlugin
- , spawnPlugins
- , spawnPlugin
- , unloadPlugin
- ) where
-
-import Control.Concurrent (forkIO)
-import Control.Concurrent.Chan
-import Control.Concurrent.MVar
-import Control.Exception
-import Control.Monad.State
-import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
-import Prelude hiding (catch)
-
-import Hsbot.Config
-import Hsbot.Irc.Config
-import Hsbot.Irc.Core
-import Hsbot.Types
-
--- | spawns plugins
-spawnPlugins :: Bot ()
-spawnPlugins = do
- config <- gets botConfig
- mapM_ (spawnPlugin) config
-
--- | spawns a single plugin
-spawnPlugin :: BotConfig -> Bot ()
-spawnPlugin (IrcBotConfig ircConfig) = do
- bot <- get
- let mvar = botResumeData bot
- name = ircConfigName ircConfig
- resumeData <- liftIO $ takeMVar mvar
- let pluginResumeData = fromMaybe M.empty $ M.lookup name resumeData
- chan = botChan bot
- pchan <- liftIO (newChan :: IO (Chan BotMsg))
- pluginMVar <- liftIO newEmptyMVar
- threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan (Just $ show pluginResumeData)) (putMVar pluginMVar ())
- let plugin = PluginState { pluginName = name
- , pluginChan = pchan
- , pluginHandles = M.empty }
- plugins = botPlugins bot
- put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, pluginMVar, threadId) plugins }
- liftIO . putMVar mvar $ M.insert name pluginResumeData resumeData
-
--- | Unloads a plugin
-unloadPlugin :: String -> Bot ()
-unloadPlugin name = do
- killPlugin name
- resumeData <- gets botResumeData
- liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.delete name oldData)
-
--- | kills a plugin
-killPlugin :: String -> Bot ()
-killPlugin name = do
- bot <- get
- let oldPlugins = botPlugins bot
- -- We check if the plugin exists
- case M.lookup name oldPlugins of
- Just (_, mvar, threadId) -> do
- let newPlugins = M.delete name oldPlugins
- liftIO $ throwTo threadId UserInterrupt
- put $ bot { botPlugins = newPlugins }
- liftIO $ takeMVar mvar
- Nothing -> return ()
-
diff --git a/HsbotMaster/Hsbot/PluginUtils.hs b/HsbotMaster/Hsbot/PluginUtils.hs
deleted file mode 100644
index d09b3b4..0000000
--- a/HsbotMaster/Hsbot/PluginUtils.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Hsbot.PluginUtils
- ( sendToPlugin
- ) where
-
-import Control.Concurrent
-import Control.Concurrent.Chan ()
-import Control.Monad.State
-
-import Hsbot.Types
-
--- | Sends a msg to a plugin
-sendToPlugin :: BotMsg -> PluginState -> Bot ()
-sendToPlugin botMsg plugin = do
- liftIO $ writeChan (pluginChan plugin) botMsg
-
diff --git a/HsbotMaster/Hsbot/Types.hs b/HsbotMaster/Hsbot/Types.hs
deleted file mode 100644
index ce1432b..0000000
--- a/HsbotMaster/Hsbot/Types.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-module Hsbot.Types
- ( Bot
- , BotMsg (..)
- , BotResumeData
- , BotState (..)
- , BotStatus (..)
- , ExitMsg (..)
- , Msg (..)
- , Plugin
- , PluginState (..)
- , RebootMsg (..)
- , ResumeData
- , ResumeMsg (..)
- ) where
-
-import Control.Concurrent
-import Control.Monad.State
-import qualified Data.Map as M
-import Data.Time
-import System.IO
-
--- | The Bot monad
-type Bot = StateT BotState IO
-
--- | An Hsbot state
-data BotState = BotState
- { botStartTime :: UTCTime -- the bot's uptime
- , botPlugins :: M.Map String (PluginState, MVar (), ThreadId) -- Loaded plugins
- , botChan :: Chan BotMsg -- the bot's communication channel
- , botResumeData :: MVar BotResumeData -- the necessary data to resume the bot's operations on reboot
- }
-
--- | how we exit from the botLoop
-data BotStatus = BotExit | BotReboot | BotContinue deriving (Eq)
-
--- | Types to factorise resume data
-type ResumeData = M.Map String String
-type BotResumeData = M.Map String ResumeData
-
--- | The Plugin monad
-type Plugin = StateT PluginState IO
-
--- | A plugin state
-data PluginState = PluginState
- { pluginName :: String -- The plugin's name
- , pluginChan :: Chan BotMsg -- The plugin chan
- , pluginHandles :: M.Map String Handle -- the plugins's handles
- }
-
--- | A hsbot message
-data Msg = Msg
- { msgType :: String -- the message type
- , msgFrom :: String -- who issues it
- , msgTo :: String -- who it is destinated to
- , msgStuff :: String -- the message to be transfered
- } deriving (Show)
-
-data ResumeMsg = ResMsg
- { resMsgFrom :: String
- , resMsgData :: ResumeData
- } deriving (Show)
-
-data RebootMsg = RebootMsg
- { rebMsgFrom :: String
- } deriving (Show)
-
-data ExitMsg = ExitMsg
- { exiMsgFrom :: String
- } deriving (Show)
-
-data BotMsg = IntMsg Msg | UpdMsg ResumeMsg | RebMsg RebootMsg | ExiMsg ExitMsg deriving (Show)
-
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 23:20:04 +0000