Rewrote the whole architecture.
This commit is contained in:
Julien Dessaux
parent
d4103e3e18
commit
57f559f3a1
8 changed files with 230 additions and 210 deletions
163
Hsbot/Core.hs
163
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)
|
||||
}
|
||||
|
||||
-- | Returns a new, empty bot
|
||||
newbot :: Bot
|
||||
newbot = Bot (M.empty)
|
||||
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
|
||||
|
||||
-- |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
|
||||
|
||||
|
|
|
|||
Reference in a new issue