summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Core.hs23
-rw-r--r--Hsbot/Message.hs6
-rw-r--r--Hsbot/Plugin.hs38
-rw-r--r--Hsbot/Plugin/Ping.hs25
-rw-r--r--Hsbot/Types.hs6
-rw-r--r--hsbot.cabal5
6 files changed, 68 insertions, 35 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 8eb4643..1f017ce 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -19,6 +19,7 @@ import Prelude hiding (catch)
import System.IO
import System.Log.Logger
+import Hsbot.Plugin
import Hsbot.Types
import Hsbot.Utils
@@ -77,7 +78,7 @@ runHsbot = do
chan <- lift $ asks envChan
(liftIO . forkIO $ botReader connhdl tlsCtx chan myOwnThreadId) >>= lift . addThreadIdToQuitMVar
-- Then we spawn all plugins
- -- asks envSocket >>= mapM_ ( ----- what's next? the core server handling! ----- )
+ (lift $ asks envConfig) >>= mapM_ loadPlugin . configPlugins
-- Finally we spawn the main bot loop
bot <- get
finalStateMVar <- liftIO newEmptyMVar
@@ -86,6 +87,7 @@ runHsbot = do
code <- asks envQuitMv >>= liftIO . takeMVar
-- and we clean things up
asks envThreadIdsMv >>= liftIO . readMVar >>= liftIO . mapM_ killThread
+ -- TODO : kill plugin threads
return code
storeFinalState :: MVar BotState -> BotState -> Env IO ()
storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState
@@ -103,8 +105,16 @@ botReader handle Nothing chan fatherThreadId = forever $
killThread myId
return ""
+handleIncomingStr :: Chan Message -> String -> IO ()
+handleIncomingStr chan str = do
+ case IRC.decode str of
+ Just msg -> do
+ debugM "Ircd.Reader" $ "<-- " ++ (show msg)
+ writeChan chan $ IncomingMsg msg
+ Nothing -> debugM "Ircd.Reader" $ "Error: couldn't decode : " ++ str -- TODO: spam control
+
botLoop :: Bot (Env IO) ()
-botLoop = do
+botLoop = forever $ do
chan <- lift $ asks envChan
hooks <- gets botHooks
msg <- liftIO $ readChan chan
@@ -115,16 +125,9 @@ botLoop = do
env <- lift ask
let connhdl = envHandle env
tlsCtx = envTLSCtx env
+ liftIO $ debugM "Ircd.Reader" $ "--> " ++ (show outMsg)
liftIO . sendStr connhdl tlsCtx $ IRC.encode outMsg
-handleIncomingStr :: Chan Message -> String -> IO ()
-handleIncomingStr chan str = do
- case IRC.decode str of
- Just msg -> do
- debugM "Ircd.Reader" $ "<-- " ++ (show msg)
- writeChan chan $ IncomingMsg msg
- Nothing -> debugM "Ircd.Reader" $ "Error: couldn't decode : " ++ str -- TODO: spam control
-
terminateHsbot :: Env IO ()
terminateHsbot = do
liftIO $ infoM "Hsbot.Core" "Closing connection"
diff --git a/Hsbot/Message.hs b/Hsbot/Message.hs
index e95c3e7..133ff92 100644
--- a/Hsbot/Message.hs
+++ b/Hsbot/Message.hs
@@ -11,13 +11,13 @@ import qualified Network.IRC as IRC
import Hsbot.Types
-- Plugin Utils
-readMsg :: Plugin IO (Message)
+readMsg :: Plugin (Env IO) (Message)
readMsg = gets pluginChan >>= liftIO . readChan >>= return
-writeMsg :: Message -> Plugin IO ()
+writeMsg :: Message -> Plugin (Env IO) ()
writeMsg msg = gets pluginMaster >>= liftIO . flip writeChan msg
-answerMsg :: IRC.Message -> String -> Plugin IO ()
+answerMsg :: IRC.Message -> String -> Plugin (Env IO) ()
answerMsg request msg =
case IRC.msg_params request of
sender:_ -> writeMsg . OutgoingMsg $ IRC.Message Nothing "PRIVMSG" [sender, msg]
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
new file mode 100644
index 0000000..3191a15
--- /dev/null
+++ b/Hsbot/Plugin.hs
@@ -0,0 +1,38 @@
+module Hsbot.Plugin
+ ( loadPlugin
+ ) where
+
+import Control.Concurrent
+import qualified Data.Map as M
+import Control.Monad.Reader
+import Control.Monad.State
+import System.Log.Logger
+
+import Hsbot.Types
+
+loadPlugin :: PluginId -> Bot (Env IO) ()
+loadPlugin pId = do
+ bot <- get
+ chan <- liftIO (newChan :: IO (Chan Message))
+ master <- lift $ asks envChan
+ let name = pluginName pId
+ loop = pluginEp pId
+ oldPlugins = botPlugins bot
+ pState = PluginState { pluginId = pId
+ , pluginChan = chan
+ , pluginMaster = master }
+ -- We check for unicity
+ case M.lookup name oldPlugins of
+ Just _ -> liftIO . warningM "Hsbot.Core.LoadPlugin" $ "Not loading already loaded plugin : " ++ name
+ Nothing -> do
+ liftIO . infoM "Hsbot.Core.LoadPlugin" $ "Loading plugin : " ++ name
+ env <- lift ask
+ finalStateMVar <- liftIO newEmptyMVar
+ threadId <- liftIO . forkIO $ runReaderT (execStateT loop pState >>= storeFinalState finalStateMVar) env
+ let newPlugins = M.insert name (pState, finalStateMVar, threadId) oldPlugins
+ put $ bot { botPlugins = newPlugins
+ , botHooks = chan : botHooks bot }
+ where
+ storeFinalState :: MVar PluginState -> PluginState -> Env IO ()
+ storeFinalState finalStateMVar finalState = liftIO $ putMVar finalStateMVar finalState
+
diff --git a/Hsbot/Plugin/Ping.hs b/Hsbot/Plugin/Ping.hs
index 192bab4..d399ab8 100644
--- a/Hsbot/Plugin/Ping.hs
+++ b/Hsbot/Plugin/Ping.hs
@@ -1,35 +1,28 @@
module Hsbot.Plugin.Ping
- ( pingId
- , ping
+ ( ping
+ , thePing
) where
import Control.Concurrent.Chan ()
-import Control.Exception
-import Control.Monad.State (execStateT, forever)
+import Control.Monad.State
import qualified Network.IRC as IRC
import Prelude hiding (catch)
import Hsbot.Message
import Hsbot.Types
-pingId :: PluginId
-pingId = PluginId
+ping :: PluginId
+ping = PluginId
{ pluginName = "ping"
- , pluginEp = ping }
-
--- | The plugin's main entry point
-ping :: PluginState -> IO ()
-ping state = do
- _ <- (execStateT run state) `catch` (\(_ :: AsyncException) -> return state)
- return ()
+ , pluginEp = thePing }
-- | The IrcPlugin monad main function
-run :: Plugin IO ()
-run = forever $ do
+thePing :: Plugin (Env IO) ()
+thePing = forever $ do
msg <- readMsg
eval msg
where
- eval :: Message -> Plugin IO ()
+ eval :: Message -> Plugin (Env IO) ()
eval (IncomingMsg msg)
| (IRC.msg_command msg) == "PING" = writeMsg . OutgoingMsg . IRC.Message Nothing "PONG" $ IRC.msg_params msg
| otherwise = return ()
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index e906a10..3e00fb2 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -38,7 +38,7 @@ data BotEnv = BotEnv
type Bot = StateT BotState
data BotState = BotState
- { botPlugins :: M.Map String (PluginState, MVar (), ThreadId)
+ { botPlugins :: M.Map String (PluginState, MVar PluginState, ThreadId)
, botHooks :: [Chan Message]
, botChannels :: [String]
, botNickname :: String
@@ -55,7 +55,7 @@ data PluginState = PluginState
data PluginId = PluginId
{ pluginName :: String
- , pluginEp :: PluginState -> IO ()
+ , pluginEp :: Plugin (Env IO) ()
}
-- Messaging
@@ -73,7 +73,7 @@ data Config = Config
, configChannels :: [String]
, configNicknames :: [String]
, configRealname :: String
- , configPlugins :: [(String, Chan Message -> Chan Message -> IO ())]
+ , configPlugins :: [PluginId]
}
data TLSConfig = TLSConfig
diff --git a/hsbot.cabal b/hsbot.cabal
index cc4eae7..055d36d 100644
--- a/hsbot.cabal
+++ b/hsbot.cabal
@@ -1,5 +1,5 @@
Name: hsbot
-Version: 0.4.1
+Version: 0.4.4
Cabal-version: >=1.2
Synopsis: A multipurposes IRC bot
Description:
@@ -19,11 +19,10 @@ Build-type: Simple
Library
ghc-options: -Wall
exposed-modules: Hsbot
- --Hsbot.Command
Hsbot.Config
Hsbot.Core
Hsbot.Message
- --Hsbot.Plugin
+ Hsbot.Plugin
Hsbot.Plugin.Ping
Hsbot.Types
Hsbot.Utils
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 20:05:51 +0000