ircbot 0.4.0 → 0.5.0
raw patch · 4 files changed
+79/−10 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.IRC.Bot.Core: limits :: BotConf -> Maybe (Int, Int)
+ Network.IRC.Bot.Limiter: Limiter :: QSem -> QSem -> Int -> ThreadId -> Limiter
+ Network.IRC.Bot.Limiter: data Limiter
+ Network.IRC.Bot.Limiter: limit :: Limiter -> IO ()
+ Network.IRC.Bot.Limiter: limitsDelay :: Limiter -> Int
+ Network.IRC.Bot.Limiter: limitsIn :: Limiter -> QSem
+ Network.IRC.Bot.Limiter: limitsOut :: Limiter -> QSem
+ Network.IRC.Bot.Limiter: limitsThreadId :: Limiter -> ThreadId
+ Network.IRC.Bot.Limiter: newLimiter :: Int -> Int -> IO Limiter
- Network.IRC.Bot.Core: BotConf :: (Maybe (Chan Message -> IO ())) -> Logger -> HostName -> PortID -> String -> String -> User -> Set String -> BotConf
+ Network.IRC.Bot.Core: BotConf :: (Maybe (Chan Message -> IO ())) -> Logger -> HostName -> PortID -> String -> String -> User -> Set String -> Maybe (Int, Int) -> BotConf
- Network.IRC.Bot.Core: simpleBot' :: (Maybe (Chan Message -> IO ())) -> Logger -> HostName -> PortID -> String -> String -> User -> [BotPartT IO ()] -> IO ([ThreadId], IO ())
+ Network.IRC.Bot.Core: simpleBot' :: (Maybe (Chan Message -> IO ())) -> Logger -> Maybe (Int, Int) -> HostName -> PortID -> String -> String -> User -> [BotPartT IO ()] -> IO ([ThreadId], IO ())
Files
- LICENSE +1/−1
- Network/IRC/Bot/Core.hs +18/−7
- Network/IRC/Bot/Limiter.hs +57/−0
- ircbot.cabal +3/−2
LICENSE view
@@ -1,4 +1,4 @@-Copyright Jeremy Shaw 2011+Copyright 2011-2012 Jeremy Shaw, Eric Mertens, SeeReason Partners LLC All rights reserved.
Network/IRC/Bot/Core.hs view
@@ -24,6 +24,7 @@ import Network.IRC (Message, decode, encode, joinChan, nick, user) import Network.IRC as I import Network.IRC.Bot.Types (User(..), nullUser)+import Network.IRC.Bot.Limiter (Limiter(..), newLimiter, limit) import Network.IRC.Bot.Log (Logger, LogLevel(Normal, Debug), stdoutLogger) import Network.IRC.Bot.BotMonad (BotMonad(logM, sendMessage), BotPartT, BotEnv(..), runBotPartT) import Network.IRC.Bot.Part.NickUser (changeNickUser)@@ -41,6 +42,7 @@ , commandPrefix :: String -- ^ command prefix , user :: User -- ^ irc user info , channels :: Set String -- ^ channel to join+ , limits :: Maybe (Int, Int) -- ^ (burst length, delay in microseconds) } nullBotConf :: BotConf@@ -53,6 +55,7 @@ , commandPrefix = "#" , user = nullUser , channels = empty+ , limits = Nothing } -- | connect to irc server and send NICK and USER commands@@ -78,14 +81,21 @@ -- reconnect loop is still a bit buggy -- if you try to write multiple lines, and the all fail, reconnect will be called multiple times.. -- something should be done so that this does not happen-connectionLoop :: Logger -> TMVar UTCTime -> HostName -> PortID -> String -> User -> Chan Message -> Chan Message -> Maybe (Chan Message) -> QSem -> IO (ThreadId, ThreadId, IO ())-connectionLoop logger tmv host port nick user outgoingChan incomingChan logChan connQSem =+connectionLoop :: Logger -> Maybe (Int, Int) -> TMVar UTCTime -> HostName -> PortID -> String -> User -> Chan Message -> Chan Message -> Maybe (Chan Message) -> QSem -> IO (ThreadId, ThreadId, Maybe ThreadId, IO ())+connectionLoop logger mLimitConf tmv host port nick user outgoingChan incomingChan logChan connQSem = do hTMVar <- atomically $ newTMVar (undefined :: Handle)+ (limit, limitTid) <-+ case mLimitConf of+ Nothing -> return (return (), Nothing)+ (Just (burst, delay)) ->+ do limiter <- newLimiter burst delay+ return (limit limiter, Just $ limitsThreadId limiter) doConnect logger host port nick user hTMVar connQSem outgoingTid <- forkIO $ forever $ do msg <- readChan outgoingChan writeMaybeChan logChan msg h <- atomically $ readTMVar hTMVar+ when (msg_command msg `elem` ["PRIVMSG", "NOTICE"]) limit hPutStrLn h (encode msg) `catch` (reconnect logger host port nick user hTMVar connQSem) now <- getCurrentTime atomically $ swapTMVar tmv now@@ -107,7 +117,7 @@ writeChan outgoingChan (quit $ Just "restarting...") hClose h putStrLn "forceReconnect 3"- return (outgoingTid, incomingTid, forceReconnect)+ return (outgoingTid, incomingTid, limitTid, forceReconnect) ircConnectLoop logger host port nick user = (ircConnect host port nick user) `catch`@@ -145,7 +155,7 @@ -> [BotPartT IO ()] -- ^ bot parts (must include 'pingPart', or equivalent) -> IO ([ThreadId], IO ()) -- ^ 'ThreadId' for all forked handler threads and a function that forces a reconnect simpleBot BotConf{..} parts =- simpleBot' channelLogger logger host port nick commandPrefix user parts+ simpleBot' channelLogger logger limits host port nick commandPrefix user parts -- |simpleBot' connects to the server and handles messages using the supplied BotPartTs --@@ -154,6 +164,7 @@ -- will be included in the logs. simpleBot' :: (Maybe (Chan Message -> IO ())) -- ^ optional logging function -> Logger -- ^ application logging+ -> Maybe (Int, Int) -- ^ rate limiter settings (burst length, delay in microseconds) -> HostName -- ^ irc server to connect -> PortID -- ^ irc port to connect to (usually, 'PortNumber 6667') -> String -- ^ irc nick@@ -161,7 +172,7 @@ -> User -- ^ irc user info -> [BotPartT IO ()] -- ^ bot parts (must include 'pingPart', 'channelsPart', and 'nickUserPart)' -> IO ([ThreadId], IO ()) -- ^ 'ThreadId' for all forked handler threads and an IO action that forces a reconnect-simpleBot' mChanLogger logger host port nick prefix user parts =+simpleBot' mChanLogger logger limitConf host port nick prefix user parts = do (mLogTid, mLogChan) <- case mChanLogger of Nothing -> return (Nothing, Nothing)@@ -175,7 +186,7 @@ now <- getCurrentTime tmv <- atomically $ newTMVar now connQSem <- newQSem 0- (outgoingTid, incomingTid, forceReconnect) <- connectionLoop logger tmv host port nick user outgoingChan incomingChan mLogChan connQSem+ (outgoingTid, incomingTid, mLimitTid, forceReconnect) <- connectionLoop logger limitConf tmv host port nick user outgoingChan incomingChan mLogChan connQSem watchDogTid <- forkIO $ forever $ do let timeout = 5*60 now <- getCurrentTime@@ -184,7 +195,7 @@ threadDelay (30*10^6) -- check every 30 seconds ircTids <- ircLoop logger nick prefix incomingChan outgoingChan parts onConnectId <- onConnectLoop logger nick prefix outgoingChan connQSem onConnect- return $ (maybe id (:) mLogTid $ (incomingTid : outgoingTid : watchDogTid : ircTids), forceReconnect)+ return $ (maybe id (:) mLimitTid $ maybe id (:) mLogTid $ (incomingTid : outgoingTid : watchDogTid : ircTids), forceReconnect) where onConnect :: BotPartT IO () onConnect =
+ Network/IRC/Bot/Limiter.hs view
@@ -0,0 +1,57 @@+{- |+Module : Network.IRC.Bot.Limiter+Description : simple rate limiter+Copyright : (c) 2012 Eric Mertens+License : BSD3++Maintainer : jeremy@seereason.com+Stability : stable+Portability : portable++A simple rate limiter.+-}+module Network.IRC.Bot.Limiter+ ( Limiter(..)+ , newLimiter+ , limit+ )+ where++import Control.Concurrent (ThreadId, forkIO, threadDelay)+import Control.Concurrent.QSem (QSem, newQSem, signalQSem, waitQSem)+import Control.Monad (forever)++data Limiter = Limiter+ { limitsIn :: QSem+ , limitsOut :: QSem+ , limitsDelay :: Int+ , limitsThreadId :: ThreadId+ }++-- | Construct a new rate limit control+newLimiter :: Int -- ^ max burst length+ -> Int -- ^ delay (in microseconds)+ -> IO Limiter+newLimiter burst delay = do+ rdy <- newQSem burst+ sent <- newQSem 0+ let l = Limiter { limitsIn = sent+ , limitsOut = rdy+ , limitsDelay = delay+ , limitsThreadId = error "limiter thread not started yet"+ }+ tid <- forkIO (limiter l)+ return $ l { limitsThreadId = tid }++-- | Execute this before sending+limit :: Limiter -> IO ()+limit l = do+ waitQSem (limitsOut l)+ signalQSem (limitsIn l)++-- | Loop which manages the limit timers+limiter :: Limiter -> IO b+limiter l = forever $ do+ waitQSem (limitsIn l)+ threadDelay (limitsDelay l)+ signalQSem (limitsOut l)
ircbot.cabal view
@@ -1,10 +1,10 @@ Name: ircbot-Version: 0.4.0+Version: 0.5.0 Synopsis: A library for writing irc bots Homepage: http://patch-tag.com/r/stepcut/ircbot License: BSD3 License-file: LICENSE-Author: Jeremy Shaw+Author: Jeremy Shaw, Eric Mertens Maintainer: jeremy@seereason.com Copyright: 2012 SeeReason Partners LLC Stability: Experimental@@ -19,6 +19,7 @@ Network.IRC.Bot.Core Network.IRC.Bot.Commands Network.IRC.Bot.ErrorCodes+ Network.IRC.Bot.Limiter Network.IRC.Bot.Log Network.IRC.Bot.Part.Channels Network.IRC.Bot.Part.Dice