diff options
Diffstat (limited to 'Hsbot/Core.hs')
| -rw-r--r-- | Hsbot/Core.hs | 163 |
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 |