summaryrefslogtreecommitdiff
path: root/Hsbot/Core.hs
diff options
context:
space:
mode:
authorJulien Dessaux2010-02-04 20:27:22 +0100
committerJulien Dessaux2010-02-04 20:27:22 +0100
commit57f559f3a119b400e4f6288d3b5753185b8f19a7 (patch)
tree76bcd9a7e3980b8a79f64d46e5ae75a362dcd486 /Hsbot/Core.hs
parentRebooting now works great, thanks to the communication channel preservation. (diff)
downloadhsbot-57f559f3a119b400e4f6288d3b5753185b8f19a7.tar.gz
hsbot-57f559f3a119b400e4f6288d3b5753185b8f19a7.tar.bz2
hsbot-57f559f3a119b400e4f6288d3b5753185b8f19a7.zip
Rewrote the whole architecture.
Diffstat (limited to '')
-rw-r--r--Hsbot/Core.hs163
1 files changed, 135 insertions, 28 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index fddcb72..41340ba 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -1,56 +1,163 @@
module Hsbot.Core
( Bot(..)
+ , Channel(..)
, Config(..)
, IrcServer(..)
- , isConnected
- , newbot
- , sendstr
- , saveServersStates
+ , IrcBot
+ , IrcMsg(..)
+ , Plugin(..)
+ , connectServer
+ , disconnectServer
+ , inColor
+ , serializeIrcMsg
+ , traceM
+ , writeMsg
) where
-import qualified Data.Map as M
-import System.IO (Handle)
-import Text.Printf (hPrintf)
+import Control.Concurrent
+import Control.Concurrent.Chan
+import Control.Monad.State
+import Data.List
+import Network
+import System.IO
+import System.Plugins
+import System.Time (ClockTime, getClockTime)
--- | An IRC Bot server state (socket handles)
-data Bot = Bot
- { joinedServers :: M.Map IrcServer Handle -- servers we are connected to
- } deriving (Eq, Show)
+-- | TODO : a monad for a channel, and a monad for a server, all together driven by a Bot?
-- | Configuration data type
data Config = Config {
commandPrefixes :: String, -- command prefixes, for example @[\'>\',\'@\',\'?\']@
- ircServers :: [IrcServer] -- list of 'Server's to connect to
-} deriving (Eq,Show)
+ ircServer :: IrcServer -- list of 'Server's to connect to
+} deriving (Show)
-- | An IRC server
data IrcServer = IrcServer
{ address :: String -- the server's address
- , port :: Int -- the server's port
+ , port :: PortID -- the server's port
, channels :: [String] -- a list of channels to join
, nickname :: String -- the hsbot's nickname
, password :: String -- the hsbot's password, optional
, realname :: String -- the hsbot's real name, optional
, administrators :: [String] -- bot admins nicknames
- } deriving (Eq, Ord, Show)
+ }
+
+instance Show IrcServer where
+ show (IrcServer a p c n pa r ad) = (show a)
+ ++ (case p of
+ PortNumber num -> show num
+ Service s -> show s
+ UnixSocket u -> show u)
+ ++ (show c) ++ (show n) ++ (show pa) ++ (show r) ++ (show ad)
+
+-- instance Show PortID where
+-- show (PortNumber n) = show n
+-- show (Service s) = show s
+-- show (UnixSocket g) = show g
+
+-- | The IrcBot monad
+type IrcBot a = StateT Bot IO a
+
+-- | An IRC Bot server state
+data Bot = Bot
+ { serverConfig :: IrcServer -- original server config we are connected to
+ , startTime :: ClockTime -- the bot's uptime
+ , botHandle :: Handle -- the socket/handle
+ , chans :: [Channel] -- the list of channels we have joined
+ , botPlugins :: [Plugin] -- The list of loaded plugins
+ , serverChannel :: Chan IrcMsg -- The bot's communication channel
+ , serverThreadId :: ThreadId -- The bot's thread ID
+ }
+
+instance Show Bot where
+ show (Bot _ s h c p _ _) = (show s) ++ (show h) ++ (show c) ++ (show p)
+
+-- | A channel connection
+data Channel = Channel
+ { channelName :: String -- the channel's name
+ , channelNick :: String -- our nickname
+ , channelAdmins :: [String] -- the bot administrators
+ } deriving (Show)
+
+-- |An IRC message.
+data IrcMsg = IrcMsg
+ { prefix :: Maybe String -- the message prefix
+ , command :: String -- the message command
+ , parameters :: [String] -- the message parameters
+ } deriving (Show)
+
+-- | A plugin definition
+data Plugin = Plugin
+ { pluginName :: String -- The plugin's name
+ , pluginModule :: Module -- The plugin himself
+ , pluginThreadId :: ThreadId -- The plugin thread
+ , pluginChannel :: Chan IrcMsg -- The plugin channel
+ }
+
+instance Show Plugin where
+ show (Plugin name _ _ _) = show name
+
+-- Connect to the server and return the initial bot state
+connectServer :: IrcServer -> IO Bot
+connectServer server = do
+ let name = address server
+ starttime <- getClockTime
+ putStr $ "Connecting to " ++ name ++ "... "
+ handle <- connectTo name $ port server
+ hSetBuffering handle NoBuffering
+ putStrLn "done."
+ putStr $ "Opening server communication channel... "
+ chan <- newChan :: IO (Chan IrcMsg)
+ threadId <- forkIO $ botWriter handle chan
+ putStrLn "done."
+ return (Bot server starttime handle [] [] chan threadId)
+
+-- | Disconnect from the server
+disconnectServer :: Bot -> IO () -- IO Bot ?
+disconnectServer bot = do
+ killThread $ serverThreadId bot
+ hClose $ botHandle bot
+ return ()
+
+-- | Processing loop
+botWriter :: Handle -> Chan IrcMsg -> IO ()
+botWriter handle chan = forever $ do
+ input <- readChan chan :: IO IrcMsg
+ sendstr handle (serializeIrcMsg input)
+
+-- | Write an IRC message to the bot's writer
+writeMsg :: IrcMsg -> IrcBot ()
+writeMsg msg = do
+ chan <- gets serverChannel
+ liftIO $ writeChan chan msg
--- | Returns a new, empty bot
-newbot :: Bot
-newbot = Bot (M.empty)
+-- |Serialize an IRC message to a string.
+serializeIrcMsg :: IrcMsg -> String
+serializeIrcMsg (IrcMsg pfx cmd params) = pfxStr ++ cmd ++ paramStr
+ where pfxStr = case pfx of
+ Nothing -> ""
+ Just pfx' -> ":" ++ pfx' ++ " "
+ paramStr = concat (map paramToStr (init params)
+ ++ [lastParamToStr (last params)])
+ paramToStr p = " " ++ p
+ lastParamToStr p = " :" ++ p
-- | Send a string over handle
sendstr :: Handle -> String -> IO ()
-sendstr handle str = hPrintf handle "%s\r\n" str
+sendstr handle str = do
+ trace $ inColor ("--> " ++ str) [33]
+ hPutStr handle (str ++ "\r\n")
--- | Are we already connected to this server?
-isConnected :: Bot -> IrcServer -> Bool
-isConnected (Bot bot) ircServer = ircServer `M.member` bot
+-- | Log a message string
+trace :: String -> IO ()
+trace msg = putStrLn msg
-saveServerState :: Handle -> IrcServer -> Bot -> Bot
-saveServerState handle ircServer x@(Bot bot) =
- if ircServer `M.member` bot then x
- else (Bot $ M.insert ircServer handle bot)
+-- | Log a message string
+traceM :: String -> IrcBot ()
+traceM msg = liftIO $ putStrLn msg
-saveServersStates :: [(IrcServer, Handle)] -> Bot -> Bot
-saveServersStates liste bot = foldl (\bot' (ircServer, handle) -> saveServerState handle ircServer bot') bot liste
+-- |Wrap a string with ANSI escape sequences.
+inColor :: String -> [Int] -> String
+inColor str vals = "\ESC[" ++ valstr ++ "m" ++ str ++ "\ESC[0m"
+ where valstr = concat $ intersperse ";" $ map show vals