diff options
Diffstat (limited to 'Hsbot')
| -rw-r--r-- | Hsbot/Config.hs | 1 | ||||
| -rw-r--r-- | Hsbot/Core.hs | 1 | ||||
| -rw-r--r-- | Hsbot/Types.hs | 13 | ||||
| -rw-r--r-- | Hsbot/Utils.hs | 19 |
4 files changed, 31 insertions, 3 deletions
diff --git a/Hsbot/Config.hs b/Hsbot/Config.hs index 8c85810..6053e9e 100644 --- a/Hsbot/Config.hs +++ b/Hsbot/Config.hs @@ -16,6 +16,7 @@ defaultConfig = Config , configTLS = noSSL , configAddress = "localhost" , configPort = PortNumber 6667 + , configAccess = [] , configChannels = ["#hsbot"] , configNicknames = ["hsbot"] , configRealname = "The One True bot, with it's haskell soul." diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index 11c8732..eacbe63 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -76,6 +76,7 @@ runHsbot = do mapM_ (liftIO . sendStr connhdl tlsCtx . IRC.encode . IRC.joinChan) channels -- Finally we set the new bot state asks envBotState >>= liftIO . flip putMVar BotState { botPlugins = M.empty + , botAccess = configAccess config , botHooks = [] , botChannels = channels , botNickname = nickname } diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs index 7e340e3..8f84482 100644 --- a/Hsbot/Types.hs +++ b/Hsbot/Types.hs @@ -1,5 +1,7 @@ module Hsbot.Types - ( Bot + ( AccessList (..) + , AccessRight (..) + , Bot , BotState (..) , BotStatus (..) , BotEnv (..) @@ -40,6 +42,7 @@ type Bot = StateT BotState data BotState = BotState { botPlugins :: M.Map String (PluginEnv, ThreadId) + , botAccess :: [AccessList] , botHooks :: [Chan Message] , botChannels :: [String] , botNickname :: String @@ -71,12 +74,20 @@ data Config = Config , configTLS :: TLSConfig , configAddress :: String , configPort :: PortID + , configAccess :: [AccessList] , configChannels :: [String] , configNicknames :: [String] , configRealname :: String , configPlugins :: [PluginId] } +data AccessRight = Admin | JoinPart | Kick | Say deriving (Eq, Show) + +data AccessList = AccessList + { accessMask :: IRC.Prefix + , accessList :: [AccessRight] + } deriving (Show) + data TLSConfig = TLSConfig { sslOn :: Bool , sslVersions :: [Network.TLS.Version] diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs index e56e9f7..912e746 100644 --- a/Hsbot/Utils.hs +++ b/Hsbot/Utils.hs @@ -1,6 +1,7 @@ module Hsbot.Utils ( addThreadIdToQuitMVar , delThreadIdFromQuitMVar + , hasAccess , initTLSEnv , sendStr , setGlobalQuitMVar @@ -8,8 +9,10 @@ module Hsbot.Utils import Control.Concurrent import Control.Monad.Reader +import Control.Monad.State import qualified Data.ByteString.Lazy.UTF8 as L -import Data.List +import qualified Data.List as L +import qualified Network.IRC as IRC import Network.TLS import System.IO @@ -24,13 +27,25 @@ addThreadIdToQuitMVar thrId = do delThreadIdFromQuitMVar :: ThreadId -> Env IO () delThreadIdFromQuitMVar thrId = do threadIdsMv <- asks envThreadIdsMv - liftIO $ modifyMVar_ threadIdsMv (return . delete thrId) + liftIO $ modifyMVar_ threadIdsMv (return . L.delete thrId) setGlobalQuitMVar :: BotStatus -> Env IO () setGlobalQuitMVar status = do quitMv <- asks envQuitMv liftIO $ putMVar quitMv status +-- Access rights +hasAccess :: Maybe IRC.Prefix -> AccessRight -> Env IO (Bool) +hasAccess Nothing _ = return False +hasAccess (Just mask) right = do + botMVar <- asks envBotState + liftIO (readMVar botMVar) >>= evalStateT (gets botAccess >>= return . or . map accessMatch) + where + accessMatch :: AccessList -> Bool + accessMatch (AccessList amask arights) + | mask == amask = or [L.elem Admin arights, L.elem right arights] + | otherwise = False + -- Helpers sendStr :: Handle -> Maybe TLSCtx -> String -> IO () sendStr _ (Just ctx) msg = sendData ctx . L.fromString $ msg ++ "\r\n" |