Got a working hsbot-irc back online!

HsbotIrcBot/Hsbot/Irc/Command.hs

@@ -12,7 +12,6 @@ import Data.Maybe
 import Hsbot.Irc.Message
 import Hsbot.Irc.Plugin
 import Hsbot.Irc.Types
-import Hsbot.Types
 
 -- | Registers a plugin's command
 registerCommand :: String -> String -> IrcBot ()
@@ -57,18 +56,8 @@ processCoreCommand ircCmd = do
         "REGISTER"   -> registerCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
         "UNLOAD"     -> unloadIrcPlugin $ ircCmdMsg ircCmd
         "UNREGISTER" -> unregisterCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
-        "UPDATE"     -> processUpdateCommand ircCmd
         _            -> return ()
     if command' == "REBOOT"
       then return BotReboot
       else return BotContinue
 
--- | 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 }
-

HsbotIrcBot/Hsbot/Irc/Core.hs

@@ -10,72 +10,56 @@ import Data.Maybe (fromMaybe)
 import Network
 import Prelude hiding (catch)
 import System.IO
-import System.Posix.IO (fdToHandle, handleToFd)
-import System.Posix.Types (Fd)
 
+import Hsbot.Irc.CLI
 import Hsbot.Irc.Command
 import Hsbot.Irc.Config
 import Hsbot.Irc.Message
 import Hsbot.Irc.Plugin
 import Hsbot.Irc.Server
 import Hsbot.Irc.Types
-import Hsbot.Types
 
 -- | IrcBot's main entry point
-startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> Maybe String -> IO ()
+startIrcbot :: Options -> IrcConfig -> IO ()
-startIrcbot config masterChan myChan txtResumeData = do
+startIrcbot opts ircConfig = do
-    let resumeData = case txtResumeData of
+    when (optDebug opts) $ putStrLn "[IrcBot] Opening communication channel... "
-            Just txtData -> read txtData :: ResumeData  -- TODO : catch exception
-            Nothing -> M.empty :: ResumeData
-    print resumeData
-    putStrLn "[IrcBot] Opening communication channel... "
     chan <- newChan :: IO (Chan IrcBotMsg)
-    handle <- case M.lookup "HANDLE" resumeData of
+    when (optDebug opts) . putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress ircConfig, "... "]
-        Just txtFd -> do
+    handle <- connectTo (ircConfigAddress ircConfig) (ircConfigPort ircConfig)
-            let fd = read txtFd :: Fd
+    hSetBuffering handle NoBuffering
-            fdToHandle fd
+    hSetEncoding handle utf8
-        Nothing -> do
+    when (optDebug opts) $ putStrLn "[IrcBot] Spawning reader thread..."
-            putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "]
-            handle <- connectTo (ircConfigAddress config) (ircConfigPort config)
-            hSetBuffering handle NoBuffering
-            hSetEncoding handle utf8
-            return handle
-    fd <- handleToFd handle
-    putStrLn "[IrcBot] Spawning reader threads..."
     myOwnThreadId  <- myThreadId
     readerThreadId <- forkIO $ ircBotReader handle chan myOwnThreadId
-    masterReaderThreadId <- forkIO $ ircBotMasterReader myChan chan
+    when (optDebug opts) $ putStrLn "[IrcBot] Initializing server connection..."
-    putStrLn "[IrcBot] Initializing server connection..."
+    let ircServerState = IrcServerState { ircServerId            = ircConfigAddress ircConfig
-    let ircServerState = IrcServerState { ircServerId            = ircConfigAddress config
                                         , ircServerChannels      = []
-                                        , ircServerNickname      = ircConfigNickname config
+                                        , ircServerNickname      = ircConfigNickname ircConfig
-                                        , ircServerCommandPrefix = ircConfigCommandPrefix config
+                                        , ircServerCommandPrefix = ircConfigCommandPrefix ircConfig
                                         , ircServerChan          = chan }
         ircBotState = IrcBotState { ircBotPlugins              = M.empty
                                   , ircBotCommands             = M.empty
                                   , ircBotChan                 = chan
-                                  , ircBotMasterChan           = masterChan
                                   , ircBotServerState          = ircServerState
                                   , ircBotHandle               = handle
-                                  , ircBotConfig               = config
+                                  , ircBotConfig               = ircConfig }
-                                  , ircBotResumeData           = M.singleton "HANDLE" (show fd) }
+    ircBotState' <- execStateT (initBotServerConnection ircConfig) ircBotState
-    ircBotState' <- execStateT (initBotServerConnection config) ircBotState
+    when (optDebug opts) $ putStrLn "[IrcBot] Spawning plugins..."
-    putStrLn "[IrcBot] Spawning plugins..."
     ircBotState'' <- execStateT spawnIrcPlugins ircBotState'
-    putStrLn "[IrcBot] Entering Core loop... "
+    when (optDebug opts) $ putStrLn "[IrcBot] Entering Core loop... "
-    ircBotState''' <- (execStateT ircBotLoop ircBotState'') `catches` [ Handler (\ (_ :: IOException) -> return (ircBotState''))
+    (_, ircBotState''') <- runLoop ircBotState''
-                                                                      , Handler (\ (_ :: AsyncException) -> return (ircBotState'')) ]
+    when (optDebug opts) $ putStrLn "[IrcBot] Killing reader thread..."
-    putStrLn "[IrcBot] Killing reader threads..."
     killThread readerThreadId
-    killThread masterReaderThreadId
+    when (optDebug opts) $ putStrLn "[IrcBot] Killing active plugins... "
-    putStrLn "[IrcBot] Killing active plugins... "
+    evalStateT (mapM_ killIrcPlugin . M.keys $ ircBotPlugins ircBotState''') ircBotState'''
-    let resumeData' = ircBotResumeData ircBotState'''
+  where
-        ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData')) :: [String]
+    runLoop :: IrcBotState -> IO (BotStatus, IrcBotState)
-    evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState'''
+    runLoop botState = do
-    return ()
+        (status, botState') <- (runStateT ircBotCore botState) `catches` [ Handler (\ (_ :: IOException) -> return (BotExit, botState))
-
+                                                                         , Handler (\ (_ :: AsyncException) -> return (BotExit, botState)) ]
---resumeIrcBot
+        case status of
---resumeIrcBot
+            BotContinue -> runLoop botState'
+            _           -> return (status, botState')
 
 -- | Runs the IrcBot's reader loop
 ircBotReader :: Handle -> Chan IrcBotMsg -> ThreadId -> IO ()
@@ -93,13 +77,6 @@ ircBotReader handle chan fatherThreadId = forever $ do
         killThread myId
         return ""
 
--- | Reads the Master's chan
-ircBotMasterReader :: Chan BotMsg -> Chan IrcBotMsg -> IO ()
-ircBotMasterReader masterChan _ = forever $ do
-    _ <- readChan masterChan
-    return ()
-    -- TODO : handle botMsg
-
 -- | Initialize the bot's server connection
 initBotServerConnection :: IrcConfig -> IrcBot ()
 initBotServerConnection config = do
@@ -109,28 +86,24 @@ initBotServerConnection config = do
     put $ ircBot { ircBotServerState = ircServerState' }
 
 -- | Run the IrcBot's main loop
-ircBotLoop :: IrcBot ()
+ircBotCore :: IrcBot (BotStatus)
-ircBotLoop = forever $ do
+ircBotCore = do
     chan <- gets ircBotChan
     msg  <- liftIO $ readChan chan
     case msg of
         InIrcMsg inIrcMsg   -> dispatchMessage $ InIrcMsg inIrcMsg
         OutIrcMsg outIrcMsg -> sendThisMessage outIrcMsg
-        IntIrcCmd intIrcCmd -> do
+        IntIrcCmd intIrcCmd -> processInternalCommand $ IntIrcCmd intIrcCmd
-            reboot <- processInternalCommand $ IntIrcCmd intIrcCmd
-            reportUpdate
-            if reboot == BotReboot
-              then processRebootCommand
-              else return ()
   where
-    sendThisMessage :: IrcMsg -> IrcBot ()
+    sendThisMessage :: IrcMsg -> IrcBot (BotStatus)
     sendThisMessage outputMsg = do
         let str = serializeIrcMsg outputMsg
         handle <- gets ircBotHandle
         liftIO $ hPutStr handle (str ++ "\r\n")
+        return BotContinue
 
 -- | Dispatches an input message
-dispatchMessage :: IrcBotMsg -> IrcBot ()
+dispatchMessage :: IrcBotMsg -> IrcBot (BotStatus)
 dispatchMessage (InIrcMsg inIrcMsg) = do
     config  <- gets ircBotConfig
     plugins <- gets ircBotPlugins
@@ -143,6 +116,7 @@ dispatchMessage (InIrcMsg inIrcMsg) = do
         in mapM_ (sendRunCommand (tail getMsgContent) . first) plugins'
       else
         mapM_ (sendToPlugin (InIrcMsg inIrcMsg) . first) (M.elems plugins)
+    return BotContinue
   where
     isPluginCommand :: IrcConfig -> Bool
     isPluginCommand config =
@@ -152,26 +126,5 @@ dispatchMessage (InIrcMsg inIrcMsg) = do
     sendRunCommand cmd plugin =  sendToPlugin (IntIrcCmd $ IrcCmd "RUN" "CORE" (ircPluginName plugin) cmd inIrcMsg) plugin
     getMsgContent :: String
     getMsgContent = unwords . tail $ ircMsgParameters inIrcMsg
-dispatchMessage _ = return ()
+dispatchMessage _ = return (BotContinue)
-
--- | Reports an update to the master bot
-reportUpdate :: IrcBot ()
-reportUpdate = do
-    ircbot <- get
-    let masterChan = ircBotMasterChan ircbot
-        msg = UpdMsg $ ResMsg { resMsgFrom = ircConfigName $ ircBotConfig ircbot
-                              , resMsgData = ircBotResumeData ircbot }
-    liftIO $ writeChan masterChan msg
-
--- | Process a reboot command
-processRebootCommand :: IrcBot ()
-processRebootCommand = do
-    ircbot <- get
-    let masterChan = ircBotMasterChan ircbot
-        msg = IntMsg $ Msg { msgType  = "REBOOT"
-                           , msgFrom  = ircConfigName $ ircBotConfig ircbot
-                           , msgTo    = "CORE"
-                           , msgStuff = show $ ircBotResumeData ircbot
-                           }
-    liftIO $ writeChan masterChan msg
 

HsbotIrcBot/Hsbot/Irc/Message.hs

@@ -41,7 +41,7 @@ pMsg = do
     cmd <- pCommand
     params <- many (char ' ' >> (pLongParam <|> pShortParam))
     _ <- char '\r'
-    --eof
+    eof
     return $ IrcMsg pfx cmd params
 
 pPrefix :: ParsecT String u Identity [Char]

HsbotIrcBot/Hsbot/Irc/Plugin.hs

@@ -47,7 +47,6 @@ loadIrcPlugin pluginName = do
                         "Quote" -> ircBotPluginQuote
                         _       -> ircBotPluginDummy
     let oldPlugins    = ircBotPlugins ircbot
-        oldResumeData = ircBotResumeData ircbot
     -- We check for unicity
     case M.lookup pluginName oldPlugins of
         Just _  -> return ()
@@ -58,9 +57,7 @@ loadIrcPlugin pluginName = do
                                                , ircPluginChan       = pluginChan
                                                , ircPluginMasterChan = masterChan }
                 newPlugins    = M.insert pluginName (plugin, mvar, threadId) oldPlugins
-                newResumeData = M.insert "PLUGINS" (show $ M.keys newPlugins) oldResumeData
+            put $ ircbot { ircBotPlugins    = newPlugins }
-            put $ ircbot { ircBotPlugins    = newPlugins
-                         , ircBotResumeData = newResumeData }
 
 -- | Sends a list of loaded plugins
 listPlugins :: IrcMsg -> String -> IrcBot ()
@@ -73,13 +70,7 @@ listPlugins originalRequest dest = do
 
 -- | Unloads a plugin
 unloadIrcPlugin :: String -> IrcBot ()
-unloadIrcPlugin name = do
+unloadIrcPlugin name = killIrcPlugin name
-    killIrcPlugin name
-    ircbot <- get
-    let oldResumeData = ircBotResumeData ircbot
-        newPlugins    = M.keys $ ircBotPlugins ircbot
-        newResumeData = M.insert "PLUGINS" (show newPlugins) oldResumeData
-    put $ ircbot { ircBotResumeData = newResumeData }
 
 -- | kills a plugin
 killIrcPlugin :: String -> IrcBot ()

HsbotIrcBot/Hsbot/Irc/Types.hs

@@ -1,5 +1,6 @@
 module Hsbot.Irc.Types
-    ( IrcBot
+    ( BotStatus (..)
+    , IrcBot
     , IrcBotState (..)
     , IrcServer
     , IrcServerState (..)
@@ -14,7 +15,6 @@ import System.IO
 import Hsbot.Irc.Config
 import Hsbot.Irc.Message
 import Hsbot.Irc.Plugin.Utils
-import Hsbot.Types
 
 -- | The Ircbot monad
 type IrcBot = StateT IrcBotState IO
@@ -24,13 +24,14 @@ data IrcBotState = IrcBotState
     { ircBotPlugins              :: M.Map String (IrcPluginState, MVar (), 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
     , ircBotServerState          :: IrcServerState          -- The state of the IrcServer
     , ircBotHandle               :: Handle                  -- The server's socket/handle
     , ircBotConfig               :: IrcConfig               -- The starting configuration
-    , ircBotResumeData           :: ResumeData              -- the necessary data to resume the bot's operations on reboot
     }
 
+-- | how we exit from the botLoop
+data BotStatus = BotExit | BotReboot | BotContinue deriving (Eq)
+
 -- | The IrcServer monad
 type IrcServer = StateT IrcServerState IrcBot
 
@@ -46,3 +47,4 @@ data IrcServerState = IrcServerState
 -- | Utilities for triplets
 first :: (a, b, c) -> a
 first (a, _, _) = a
+

HsbotIrcBot/Main.hs

@@ -8,6 +8,7 @@ import System.IO
 
 import Hsbot.Irc.CLI
 import Hsbot.Irc.Config
+import Hsbot.Irc.Core
 
 -- | Main function
 main :: IO ()
@@ -26,4 +27,8 @@ main = do
     -- We find and parse the config file
     ircConfig <- getIrcConfig $ optConfigFile opts
     when (optDebug opts) . putStrLn $ "[hsbot-irc] Compiled config :\n" ++ (show ircConfig)
+    -- Finally we get into the ircbot stuff
+    case optDebug opts of
+        True -> startIrcbot opts ircConfig
+        False -> startIrcbot opts ircConfig -- TODO : fork process in background
 

HsbotIrcBot/hsbot-irc.cabal

@@ -22,8 +22,16 @@ Executable hsbot-irc
   Extensions:       DeriveDataTypeable ScopedTypeVariables
   Build-depends:    base >= 4.1 && < 5,
                     ConfigFile,
+                    containers,
+                    directory,
+                    filepath,
+                    haskell98,
                     MissingH,
                     mtl,
                     network,
+                    parsec >= 3,
+                    random,
+                    text,
+                    time,
                     unix