Implemented ircbot update messages.

5 files changed, 72 insertions, 44 deletions

diff --git a/Hsbot/Irc/Command.hs b/Hsbot/Irc/Command.hs
index e5c033e..ef1ef27 100644
--- a/Hsbot/Irc/Command.hs
+++ b/Hsbot/Irc/Command.hs
@@ -36,7 +36,7 @@ unregisterCommand cmd pluginName' = do
 -- | Processes an internal command
 processInternalCommand :: IrcBotMsg -> IrcBot ()
 processInternalCommand (IntIrcCmd ircCmd)
-  | ircCmdTo ircCmd == "CORE" = processCoreCommand ircCmd
+  | ircCmdTo ircCmd == "CORE"   = processCoreCommand ircCmd
   | otherwise = do
       plugins <- gets ircBotPlugins
       case M.lookup (ircCmdTo ircCmd) plugins of
@@ -52,8 +52,18 @@ processCoreCommand ircCmd = do
     case command' of
         "LIST"       -> listPlugins originalRequest (ircCmdFrom ircCmd)
         "LOAD"       -> loadIrcPlugin $ ircCmdMsg ircCmd
-        "UNLOAD"     -> unloadPlugin $ ircCmdMsg ircCmd
+        "UNLOAD"     -> unloadIrcPlugin $ ircCmdMsg ircCmd
+        "UPDATE"     -> processUpdateCommand ircCmd
         "REGISTER"   -> registerCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
         "UNREGISTER" -> unregisterCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
         _            -> return ()
 
+-- | Process an update command
+processUpdateCommand :: IrcCmd -> IrcBot ()
+processUpdateCommand ircCmd = do
+    ircbot <- get
+    let oldData = ircBotResumeData ircbot
+        from    = ircCmdFrom ircCmd
+        stuff   = ircCmdMsg ircCmd
+    put $ ircbot { ircBotResumeData = M.insert from stuff oldData }
+
diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs
index 2c455ce..1a51a5c 100644
--- a/Hsbot/Irc/Core.hs
+++ b/Hsbot/Irc/Core.hs
@@ -11,6 +11,7 @@ import Data.Time
 import Network
 import Prelude hiding (catch)
 import System.IO
+import System.Posix.IO (handleToFd)
 
 import Hsbot.Irc.Command
 import Hsbot.Irc.Config
@@ -18,7 +19,7 @@ import Hsbot.Irc.Message
 import Hsbot.Irc.Plugin
 import Hsbot.Irc.Server
 import Hsbot.Irc.Types
-import Hsbot.Message (BotMsg)
+import Hsbot.Message
 
 -- | IrcBot's main entry point
 startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO ()
@@ -29,8 +30,9 @@ startIrcbot config masterChan myChan = do
     putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "]
     handle <- connectTo (ircConfigAddress config) (ircConfigPort config)
     hSetBuffering handle NoBuffering
-    myOwnThreadId <- myThreadId
+    fd <- handleToFd handle
     putStrLn "[IrcBot] Spawning reader threads..."
+    myOwnThreadId  <- myThreadId
     readerThreadId <- forkIO $ ircBotReader handle chan myOwnThreadId
     masterReaderThreadId <- forkIO $ ircBotMasterReader masterChan chan
     putStrLn "[IrcBot] Initializing server connection..."
@@ -49,10 +51,13 @@ startIrcbot config masterChan myChan = do
                                   , ircBotHandle               = handle
                                   , ircBotConfig               = config
                                   , ircBotReaderThreadId       = readerThreadId
-                                  , ircBotMasterReaderThreadId = masterReaderThreadId }
+                                  , ircBotMasterReaderThreadId = masterReaderThreadId
+                                  , ircBotResumeData           = M.singleton "HANDLE" (show fd) }
     ircBotState' <- execStateT (initBotServerConnection config) ircBotState
-    putStrLn "[IrcBot] Entering main loop... "
-    _ <- ircBotLoop ircBotState' `catch` (\(_ :: IOException) -> return ())
+    putStrLn "[IrcBot] Spawning plugins..."
+    ircBotState'' <- execStateT spawnIrcPlugins ircBotState'
+    putStrLn "[IrcBot] Entering Core loop... "
+    _ <- (execStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return (ircBotState''))
     return ()
 
 --resumeIrcBot
@@ -89,28 +94,17 @@ initBotServerConnection config = do
     ircServerState' <- execStateT (initServerConnection config) ircServerState
     put $ ircBot { ircBotServerState = ircServerState' }
 
--- | IrcBot's loop that can catch ircbot's states' updates
-ircBotLoop :: IrcBotState -> IO ()
-ircBotLoop ircBotState = do
-    putStrLn "[IrcBot] Spawning plugins..."
-    ircBotState' <- execStateT spawnIrcPlugins ircBotState
-    -- Todo : throw new ircbotstate to hsbot
-    putStrLn "[IrcBot] Entering Core loop... "
-    _ <- (execStateT ircBotCore ircBotState') -- `catch` (\(_ :: NewBotStateException) -> return ircBotState')
-    return ()
-    -- TODO : loop!
-
 -- | Run the IrcBot's main loop
-ircBotCore :: IrcBot ()
-ircBotCore = forever $ do
-    ircBot <- get
-    let chan = ircBotChan ircBot
+ircBotLoop :: IrcBot ()
+ircBotLoop = forever $ do
+    chan <- gets ircBotChan
     msg  <- liftIO $ readChan chan
     case msg of
         InIrcMsg inIrcMsg   -> dispatchMessage $ InIrcMsg inIrcMsg
         OutIrcMsg outIrcMsg -> sendThisMessage outIrcMsg
         IntIrcCmd intIrcCmd -> do
             processInternalCommand $ IntIrcCmd intIrcCmd
+            reportUpdate
   where
     sendThisMessage :: IrcMsg -> IrcBot ()
     sendThisMessage outputMsg = do
@@ -143,3 +137,15 @@ dispatchMessage (InIrcMsg inIrcMsg) = do
     getMsgContent = unwords . tail $ ircMsgParameters inIrcMsg
 dispatchMessage _ = return ()
 
+-- | Reports an update to the master bot
+reportUpdate :: IrcBot ()
+reportUpdate = do
+    ircbot <- get
+    let masterChan = ircBotMasterChan ircbot
+        msg        = IntMsg $ Msg { msgType = "UPDATE"
+                                  , msgFrom = ircConfigName $ ircBotConfig ircbot
+                                  , msgTo   = "CORE"
+                                  , msgCmd  = show $ ircBotResumeData ircbot
+                                  }
+    liftIO $ writeChan masterChan msg
+
diff --git a/Hsbot/Irc/Plugin.hs b/Hsbot/Irc/Plugin.hs
index 3e6bef0..d972db2 100644
--- a/Hsbot/Irc/Plugin.hs
+++ b/Hsbot/Irc/Plugin.hs
@@ -5,7 +5,7 @@ module Hsbot.Irc.Plugin
     , loadIrcPlugin
     , sendToPlugin
     , spawnIrcPlugins
-    , unloadPlugin
+    , unloadIrcPlugin
     ) where
 
 import Control.Concurrent
@@ -45,16 +45,20 @@ loadIrcPlugin pluginName = do
                         "Ping"  -> ircBotPluginPing
                         "Quote" -> ircBotPluginQuote
                         _       -> ircBotPluginDummy
-    let oldPlugins = ircBotPlugins ircbot
+    let oldPlugins    = ircBotPlugins ircbot
+        oldResumeData = ircBotResumeData ircbot
     -- We check for unicity
     case M.lookup pluginName oldPlugins of
         Just _  -> return ()
         Nothing -> do
             threadId <- liftIO $ forkIO (entryPoint pluginChan masterChan)
-            let plugin  = IrcPluginState { ircPluginName       = pluginName
-                                         , ircPluginChan       = pluginChan
-                                         , ircPluginMasterChan = masterChan }
-            put $ ircbot { ircBotPlugins = M.insert pluginName (plugin, threadId) oldPlugins }
+            let plugin        = IrcPluginState { ircPluginName       = pluginName
+                                               , ircPluginChan       = pluginChan
+                                               , ircPluginMasterChan = masterChan }
+                newPlugins    = M.insert pluginName (plugin, threadId) oldPlugins
+                newResumeData = M.insert "PLUGINS" (show $ M.keys newPlugins) oldResumeData
+            put $ ircbot { ircBotPlugins    = newPlugins
+                         , ircBotResumeData = newResumeData }
 
 -- | Sends a list of loaded plugins
 listPlugins :: IrcMsg -> String -> IrcBot ()
@@ -66,14 +70,18 @@ listPlugins originalRequest dest = do
         Nothing          -> return ()
 
 -- | Unloads a plugin
-unloadPlugin :: String -> IrcBot ()
-unloadPlugin name = do
-    bot <- get
-    let oldPlugins = ircBotPlugins bot
+unloadIrcPlugin :: String -> IrcBot ()
+unloadIrcPlugin name = do
+    ircbot <- get
+    let oldPlugins    = ircBotPlugins ircbot
+        oldResumeData = ircBotResumeData ircbot
+    -- We check if the plugin exists
     case M.lookup name oldPlugins of
         Just (_, threadId) -> do
-            let newPlugins = M.delete name oldPlugins
+            let newPlugins    = M.delete name oldPlugins
+                newResumeData = M.insert "PLUGINS" (show $ M.keys newPlugins) oldResumeData
             liftIO $ throwTo threadId UserInterrupt
-            put $ bot { ircBotPlugins = newPlugins }
+            put $ ircbot { ircBotPlugins = newPlugins
+                         , ircBotResumeData = newResumeData }
         Nothing     -> return ()
 
diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs
index 78e663b..90bd728 100644
--- a/Hsbot/Irc/Types.hs
+++ b/Hsbot/Irc/Types.hs
@@ -21,17 +21,18 @@ type IrcBot = StateT IrcBotState IO
 
 -- | An Ircbot state
 data IrcBotState = IrcBotState
-    { ircBotStartTime            :: UTCTime                                 -- the bot's uptime
+    { ircBotStartTime            :: UTCTime                 -- the bot's uptime
     , ircBotPlugins              :: M.Map String (IrcPluginState, ThreadId) -- Loaded plugins
-    , ircBotCommands             :: M.Map String [String]                   -- Loaded plugins
-    , ircBotChan                 :: Chan IrcBotMsg                          -- The IrcBot's communication channel
-    , ircBotMasterChan           :: Chan BotMsg                             -- The Hsbot communication channel
-    , ircBotMyChan               :: Chan BotMsg                             -- The Hsbot communication channel
-    , ircBotServerState          :: IrcServerState                          -- The state of the IrcServer
-    , ircBotHandle               :: Handle                                  -- The server's socket/handle
-    , ircBotConfig               :: IrcConfig                               -- The starting configuration
-    , ircBotReaderThreadId       :: ThreadId
-    , ircBotMasterReaderThreadId :: ThreadId
+    , ircBotCommands             :: M.Map String [String]   -- Loaded plugins
+    , ircBotChan                 :: Chan IrcBotMsg          -- The IrcBot's communication channel
+    , ircBotMasterChan           :: Chan BotMsg             -- The Hsbot communication channel
+    , ircBotMyChan               :: Chan BotMsg             -- The Hsbot communication channel
+    , ircBotServerState          :: IrcServerState          -- The state of the IrcServer
+    , ircBotHandle               :: Handle                  -- The server's socket/handle
+    , ircBotConfig               :: IrcConfig               -- The starting configuration
+    , ircBotReaderThreadId       :: ThreadId                -- the thread that process inputs from the socket
+    , ircBotMasterReaderThreadId :: ThreadId                -- the thread that process inputs from the master bot
+    , ircBotResumeData           :: M.Map String String     -- the necessary data to resume the bot's operations on reboot
     }
 
 -- | The IrcServer monad
diff --git a/Hsbot/Message.hs b/Hsbot/Message.hs
index 7532211..83d4c08 100644
--- a/Hsbot/Message.hs
+++ b/Hsbot/Message.hs
@@ -1,8 +1,11 @@
 module Hsbot.Message
     ( BotMsg (..)
     , Msg (..)
+    , processInternalMessage
     ) where
 
+import Hsbot.PluginUtils
+
 -- | A hsbot message
 data Msg = Msg
     { msgType :: String -- the message type