Wrote most of the resume code for the core and the irc plugin.
This commit is contained in:
parent
3410caa6f2
commit
d97177ce3b
6 changed files with 57 additions and 50 deletions
|
@ -18,12 +18,23 @@ import Hsbot.Plugin
|
||||||
import Hsbot.Types
|
import Hsbot.Types
|
||||||
|
|
||||||
-- | Bot's main entry point
|
-- | Bot's main entry point
|
||||||
hsbot :: [BotConfig] -> IO ()
|
hsbot :: [BotConfig] -> Maybe String -> IO ()
|
||||||
hsbot config = do
|
hsbot config txtResumeData= do
|
||||||
startTime <- getCurrentTime
|
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... "
|
putStrLn "[Hsbot] Opening communication channel... "
|
||||||
chan <- newChan :: IO (Chan BotMsg)
|
chan <- newChan :: IO (Chan BotMsg)
|
||||||
mvar <- newMVar M.empty :: IO (MVar BotResumeData)
|
mvar <- newMVar resumeData' :: IO (MVar BotResumeData)
|
||||||
putStrLn "[Hsbot] Installing signal handlers... "
|
putStrLn "[Hsbot] Installing signal handlers... "
|
||||||
_ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing
|
_ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing
|
||||||
_ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing
|
_ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing
|
||||||
|
@ -36,10 +47,10 @@ hsbot config = do
|
||||||
putStrLn "[Hsbot] Entering main loop... "
|
putStrLn "[Hsbot] Entering main loop... "
|
||||||
(status, botState') <- runLoop botState
|
(status, botState') <- runLoop botState
|
||||||
putStrLn "[Hsbot] Killing active plugins... "
|
putStrLn "[Hsbot] Killing active plugins... "
|
||||||
resumeData <- takeMVar mvar
|
newResumeData <- takeMVar mvar
|
||||||
evalStateT (mapM_ killPlugin $ M.keys resumeData) botState'
|
evalStateT (mapM_ killPlugin $ M.keys newResumeData) botState'
|
||||||
if status == BotReboot
|
if status == BotReboot
|
||||||
then resumeHsbot resumeData
|
then hsbot config (Just $ show newResumeData) -- TODO : exec on the hsbot launcher with the reload string
|
||||||
else return ()
|
else return ()
|
||||||
where
|
where
|
||||||
runLoop :: BotState -> IO (BotStatus, BotState)
|
runLoop :: BotState -> IO (BotStatus, BotState)
|
||||||
|
@ -50,10 +61,6 @@ hsbot config = do
|
||||||
BotContinue -> runLoop botState'
|
BotContinue -> runLoop botState'
|
||||||
_ -> return (status, botState')
|
_ -> return (status, botState')
|
||||||
|
|
||||||
resumeHsbot :: BotResumeData -> IO ()
|
|
||||||
resumeHsbot resumeData = do
|
|
||||||
print resumeData
|
|
||||||
|
|
||||||
-- | Run the bot main loop
|
-- | Run the bot main loop
|
||||||
botCore :: Bot (BotStatus)
|
botCore :: Bot (BotStatus)
|
||||||
botCore = do
|
botCore = do
|
||||||
|
|
|
@ -7,11 +7,11 @@ import Control.Exception (AsyncException, Handler (..), IOException, catch, catc
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Time
|
|
||||||
import Network
|
import Network
|
||||||
import Prelude hiding (catch)
|
import Prelude hiding (catch)
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Posix.IO (handleToFd)
|
import System.Posix.IO (fdToHandle, handleToFd)
|
||||||
|
import System.Posix.Types (Fd)
|
||||||
|
|
||||||
import Hsbot.Irc.Command
|
import Hsbot.Irc.Command
|
||||||
import Hsbot.Irc.Config
|
import Hsbot.Irc.Config
|
||||||
|
@ -22,14 +22,24 @@ import Hsbot.Irc.Types
|
||||||
import Hsbot.Types
|
import Hsbot.Types
|
||||||
|
|
||||||
-- | IrcBot's main entry point
|
-- | IrcBot's main entry point
|
||||||
startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO ()
|
startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> Maybe String -> IO ()
|
||||||
startIrcbot config masterChan myChan = do
|
startIrcbot config masterChan myChan txtResumeData = do
|
||||||
startTime <- getCurrentTime
|
let resumeData = case txtResumeData of
|
||||||
|
Just txtData -> read txtData :: ResumeData -- TODO : catch exception
|
||||||
|
Nothing -> M.empty :: ResumeData
|
||||||
|
print resumeData
|
||||||
putStrLn "[IrcBot] Opening communication channel... "
|
putStrLn "[IrcBot] Opening communication channel... "
|
||||||
chan <- newChan :: IO (Chan IrcBotMsg)
|
chan <- newChan :: IO (Chan IrcBotMsg)
|
||||||
|
handle <- case M.lookup "HANDLE" resumeData of
|
||||||
|
Just txtFd -> do
|
||||||
|
let fd = read txtFd :: Fd
|
||||||
|
fdToHandle fd
|
||||||
|
Nothing -> do
|
||||||
putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "]
|
putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "]
|
||||||
handle <- connectTo (ircConfigAddress config) (ircConfigPort config)
|
handle <- connectTo (ircConfigAddress config) (ircConfigPort config)
|
||||||
hSetBuffering handle NoBuffering
|
hSetBuffering handle NoBuffering
|
||||||
|
hSetEncoding handle utf8
|
||||||
|
return handle
|
||||||
fd <- handleToFd handle
|
fd <- handleToFd handle
|
||||||
putStrLn "[IrcBot] Spawning reader threads..."
|
putStrLn "[IrcBot] Spawning reader threads..."
|
||||||
myOwnThreadId <- myThreadId
|
myOwnThreadId <- myThreadId
|
||||||
|
@ -41,8 +51,7 @@ startIrcbot config masterChan myChan = do
|
||||||
, ircServerNickname = ircConfigNickname config
|
, ircServerNickname = ircConfigNickname config
|
||||||
, ircServerCommandPrefix = ircConfigCommandPrefix config
|
, ircServerCommandPrefix = ircConfigCommandPrefix config
|
||||||
, ircServerChan = chan }
|
, ircServerChan = chan }
|
||||||
ircBotState = IrcBotState { ircBotStartTime = startTime
|
ircBotState = IrcBotState { ircBotPlugins = M.empty
|
||||||
, ircBotPlugins = M.empty
|
|
||||||
, ircBotCommands = M.empty
|
, ircBotCommands = M.empty
|
||||||
, ircBotChan = chan
|
, ircBotChan = chan
|
||||||
, ircBotMasterChan = masterChan
|
, ircBotMasterChan = masterChan
|
||||||
|
@ -60,8 +69,8 @@ startIrcbot config masterChan myChan = do
|
||||||
killThread readerThreadId
|
killThread readerThreadId
|
||||||
killThread masterReaderThreadId
|
killThread masterReaderThreadId
|
||||||
putStrLn "[IrcBot] Killing active plugins... "
|
putStrLn "[IrcBot] Killing active plugins... "
|
||||||
let resumeData = ircBotResumeData ircBotState'''
|
let resumeData' = ircBotResumeData ircBotState'''
|
||||||
ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData)) :: [String]
|
ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData')) :: [String]
|
||||||
evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState'''
|
evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState'''
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
|
|
@ -9,7 +9,6 @@ module Hsbot.Irc.Types
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Time
|
|
||||||
import System.IO
|
import System.IO
|
||||||
|
|
||||||
import Hsbot.Irc.Config
|
import Hsbot.Irc.Config
|
||||||
|
@ -22,8 +21,7 @@ type IrcBot = StateT IrcBotState IO
|
||||||
|
|
||||||
-- | An Ircbot state
|
-- | An Ircbot state
|
||||||
data IrcBotState = IrcBotState
|
data IrcBotState = IrcBotState
|
||||||
{ ircBotStartTime :: UTCTime -- the bot's uptime
|
{ ircBotPlugins :: M.Map String (IrcPluginState, MVar (), ThreadId) -- Loaded plugins
|
||||||
, ircBotPlugins :: M.Map String (IrcPluginState, MVar (), ThreadId) -- Loaded plugins
|
|
||||||
, ircBotCommands :: M.Map String [String] -- Loaded plugins
|
, ircBotCommands :: M.Map String [String] -- Loaded plugins
|
||||||
, ircBotChan :: Chan IrcBotMsg -- The IrcBot's communication channel
|
, ircBotChan :: Chan IrcBotMsg -- The IrcBot's communication channel
|
||||||
, ircBotMasterChan :: Chan BotMsg -- The Hsbot communication channel
|
, ircBotMasterChan :: Chan BotMsg -- The Hsbot communication channel
|
||||||
|
|
|
@ -11,6 +11,7 @@ import Control.Concurrent.MVar
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
import Prelude hiding (catch)
|
import Prelude hiding (catch)
|
||||||
|
|
||||||
import Hsbot.Config
|
import Hsbot.Config
|
||||||
|
@ -28,17 +29,20 @@ spawnPlugins = do
|
||||||
spawnPlugin :: BotConfig -> Bot ()
|
spawnPlugin :: BotConfig -> Bot ()
|
||||||
spawnPlugin (IrcBotConfig ircConfig) = do
|
spawnPlugin (IrcBotConfig ircConfig) = do
|
||||||
bot <- get
|
bot <- get
|
||||||
let chan = botChan bot
|
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))
|
pchan <- liftIO (newChan :: IO (Chan BotMsg))
|
||||||
mvar <- liftIO newEmptyMVar
|
pluginMVar <- liftIO newEmptyMVar
|
||||||
threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan) (putMVar mvar ())
|
threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan (Just $ show pluginResumeData)) (putMVar pluginMVar ())
|
||||||
let plugin = PluginState { pluginName = ircConfigName ircConfig
|
let plugin = PluginState { pluginName = name
|
||||||
, pluginChan = pchan
|
, pluginChan = pchan
|
||||||
, pluginHandles = M.empty }
|
, pluginHandles = M.empty }
|
||||||
plugins = botPlugins bot
|
plugins = botPlugins bot
|
||||||
put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, mvar, threadId) plugins }
|
put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, pluginMVar, threadId) plugins }
|
||||||
resumeData <- gets botResumeData
|
liftIO . putMVar mvar $ M.insert name pluginResumeData resumeData
|
||||||
liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert (ircConfigName ircConfig) M.empty oldData)
|
|
||||||
|
|
||||||
-- | Unloads a plugin
|
-- | Unloads a plugin
|
||||||
unloadPlugin :: String -> Bot ()
|
unloadPlugin :: String -> Bot ()
|
||||||
|
|
5
TODO
5
TODO
|
@ -1,6 +1,9 @@
|
||||||
:julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
|
:julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
|
||||||
|
|
||||||
|
* Find a way to prevent the socket from being garbage collected, by writing a connection handler for example
|
||||||
|
* Design another way to launch and manage hsbot and it's configuration
|
||||||
* Find a way to handle bot reloading threw exec
|
* Find a way to handle bot reloading threw exec
|
||||||
|
* Find a way so that not a single message/information would be lost in the case of a reboot
|
||||||
|
|
||||||
* write the vote system for the quote module
|
* write the vote system for the quote module
|
||||||
* only the quote reporter should be able to edit it
|
* only the quote reporter should be able to edit it
|
||||||
|
@ -20,10 +23,8 @@
|
||||||
* add register for casual conversations for plugins?
|
* add register for casual conversations for plugins?
|
||||||
* add a "I have stuff to save so don't kill me too hard" status for plugins
|
* add a "I have stuff to save so don't kill me too hard" status for plugins
|
||||||
|
|
||||||
* Handle unix signals properly
|
|
||||||
* Make the bot auto-reconnect (/!\ admin plugin!)
|
* Make the bot auto-reconnect (/!\ admin plugin!)
|
||||||
* discard all trace with a color param and replace those with functions info/warn/error/debug
|
* discard all trace with a color param and replace those with functions info/warn/error/debug
|
||||||
* write a safe reload : try reload before unloading
|
* write a safe reload : try reload before unloading
|
||||||
* remove from Types.hs what can be removed from it
|
* remove from Types.hs what can be removed from it
|
||||||
|
|
||||||
|
|
||||||
|
|
18
hsbot.cabal
18
hsbot.cabal
|
@ -1,5 +1,5 @@
|
||||||
name: hsbot
|
name: hsbot
|
||||||
version: 0.1.0
|
version: 0.2.1
|
||||||
cabal-version: >= 1.8
|
cabal-version: >= 1.8
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
license: BSD3
|
license: BSD3
|
||||||
|
@ -20,20 +20,10 @@ Executable hsbot
|
||||||
Main-Is: Main.hs
|
Main-Is: Main.hs
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
extensions: DeriveDataTypeable ScopedTypeVariables
|
extensions: DeriveDataTypeable ScopedTypeVariables
|
||||||
build-depends: base >= 4.1,
|
build-depends: base >= 4.1 && < 5,
|
||||||
containers >= 0.3,
|
|
||||||
directory >= 1.0,
|
directory >= 1.0,
|
||||||
filepath >= 1.1,
|
filepath >= 1.1,
|
||||||
ghc >= 6.12,
|
|
||||||
haskell98 >= 1.0,
|
|
||||||
mtl >= 1.1,
|
|
||||||
network >= 2.2,
|
|
||||||
old-time >= 1.0,
|
|
||||||
parsec >= 3.1,
|
|
||||||
process >= 1.0,
|
process >= 1.0,
|
||||||
random >= 1.0,
|
|
||||||
text >= 0.7,
|
|
||||||
time >= 1.1,
|
|
||||||
unix >= 2.4
|
unix >= 2.4
|
||||||
|
|
||||||
Library
|
Library
|
||||||
|
@ -58,15 +48,13 @@ Library
|
||||||
Hsbot.Types
|
Hsbot.Types
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
extensions: DeriveDataTypeable ScopedTypeVariables
|
extensions: DeriveDataTypeable ScopedTypeVariables
|
||||||
build-depends: base >= 4.1,
|
build-depends: base >= 4.1 && < 5,
|
||||||
containers >= 0.3,
|
containers >= 0.3,
|
||||||
directory >= 1.0,
|
directory >= 1.0,
|
||||||
filepath >= 1.1,
|
filepath >= 1.1,
|
||||||
ghc >= 6.12,
|
|
||||||
haskell98 >= 1.0,
|
haskell98 >= 1.0,
|
||||||
mtl >= 1.1,
|
mtl >= 1.1,
|
||||||
network >= 2.2,
|
network >= 2.2,
|
||||||
old-time >= 1.0,
|
|
||||||
parsec >= 3.1,
|
parsec >= 3.1,
|
||||||
random >= 1.0,
|
random >= 1.0,
|
||||||
text >= 0.7,
|
text >= 0.7,
|
||||||
|
|
Reference in a new issue