packages feed

ircbot 0.5.4 → 0.6.0

raw patch · 14 files changed

+199/−145 lines, 14 filesdep +SafeSemaphoredep +bytestringdep ~irc

Dependencies added: SafeSemaphore, bytestring

Dependency ranges changed: irc

Files

Network/IRC/Bot/BotMonad.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, UndecidableInstances, OverloadedStrings #-} module Network.IRC.Bot.BotMonad     ( BotPartT(..)     , BotMonad(..)@@ -20,6 +20,7 @@ import Control.Concurrent.Chan (Chan, dupChan, newChan, readChan, writeChan) import Control.Monad.Fix (MonadFix) import Control.Monad.Trans+import Data.ByteString (ByteString) import Network.IRC (Command, Message(Message, msg_prefix, msg_command, msg_params), Prefix(NickName), UserName, encode, decode, joinChan, nick, user) import Network.IRC.Bot.Log @@ -29,14 +30,14 @@   askOutChan   :: m (Chan Message)   localMessage :: (Message -> Message) -> m a -> m a   sendMessage  :: Message -> m ()-  logM         :: LogLevel -> String -> m ()-  whoami       :: m String+  logM         :: LogLevel -> ByteString -> m ()+  whoami       :: m ByteString  data BotEnv = BotEnv     { message   :: Message     , outChan   :: Chan Message     , logFn     :: Logger-    , botName   :: String+    , botName   :: ByteString     , cmdPrefix :: String     }
Network/IRC/Bot/Commands.hs view
@@ -1,14 +1,19 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} module Network.IRC.Bot.Commands where  import Control.Applicative import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as B import Data.Data import Data.List (isPrefixOf)-import Network (HostName, PortID(PortNumber))+import Data.Monoid ((<>))+import Network (PortID(PortNumber)) import Network.IRC import Network.IRC.Bot.BotMonad +type HostName = ByteString+ -- * Commands  cmd :: (Functor m, MonadPlus m, BotMonad m) => Command -> m ()@@ -33,8 +38,8 @@  data PrivMsg   = PrivMsg { prefix     :: (Maybe Prefix)-            , receivers  :: [String]-            , msg        :: String+            , receivers  :: [ByteString]+            , msg        :: ByteString             }       deriving (Eq, Read, Show) @@ -66,11 +71,11 @@     toMessage (Pong hostName) = Message Nothing "PONG" [hostName]  instance ToMessage PrivMsg where-    toMessage (PrivMsg prefix receivers msg) = Message prefix "PRIVMSG" (receivers ++ [msg])+    toMessage (PrivMsg prefix receivers msg) = Message prefix "PRIVMSG" (receivers <> [msg])   -- | get the nickname of the user who sent the message-askSenderNickName :: (BotMonad m) => m (Maybe String)+askSenderNickName :: (BotMonad m) => m (Maybe ByteString) askSenderNickName =     do msg <- askMessage        case msg_prefix msg of@@ -80,18 +85,18 @@ -- | figure out who to reply to for a given `Message` -- -- If message was sent to a #channel reply to the channel. Otherwise reply to the sender.-replyTo :: (BotMonad m) => m (Maybe String)+replyTo :: (BotMonad m) => m (Maybe ByteString) replyTo =     do priv <- privMsg        let receiver = head (receivers priv)-       if ("#" `isPrefixOf` receiver)+       if ("#" `B.isPrefixOf` receiver)           then return (Just receiver)           else askSenderNickName  -- | returns the receiver of a message -- -- if multiple receivers, it returns only the first-askReceiver :: (Alternative m, BotMonad m) => m (Maybe String)+askReceiver :: (Alternative m, BotMonad m) => m (Maybe ByteString) askReceiver =     do priv <- privMsg        return (Just (head $ receivers priv))
Network/IRC/Bot/Core.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, OverloadedStrings #-} module Network.IRC.Bot.Core     ( simpleBot     , simpleBot'@@ -12,16 +12,18 @@ import Control.Concurrent.Chan  (Chan, dupChan, newChan, readChan, writeChan) import Control.Concurrent.STM   (atomically) import Control.Concurrent.STM.TMVar  (TMVar, swapTMVar, newTMVar, readTMVar)-import Control.Concurrent.QSem  (QSem, newQSem, waitQSem, signalQSem) import Control.Exception        (IOException, catch) import Control.Monad            (mplus, forever, when) import Control.Monad.Trans      (liftIO)+import Data.ByteString          (ByteString)+import qualified Data.ByteString.Char8 as C import Data.Data                (Data, Typeable)+import Data.Monoid              ((<>)) import Data.Set                 (Set, empty) import Data.Time                (UTCTime, addUTCTime, getCurrentTime) import GHC.IO.Handle            (hFlushAll) import Network                  (HostName, PortID(PortNumber), connectTo)-import Network.IRC              (Message, decode, encode, joinChan, nick, user)+import Network.IRC              (Message, decode, encode, joinChan, nick, showMessage, user) import Network.IRC              as I import Network.IRC.Bot.Types    (User(..), nullUser) import Network.IRC.Bot.Limiter  (Limiter(..), newLimiter, limit)@@ -29,7 +31,9 @@ import Network.IRC.Bot.BotMonad (BotMonad(logM, sendMessage), BotPartT, BotEnv(..), runBotPartT) import Network.IRC.Bot.Part.NickUser (changeNickUser) import Prelude                  hiding (catch)-import System.IO                (BufferMode(NoBuffering, LineBuffering), Handle, hClose, hGetLine, hPutStrLn, hSetBuffering)+import           Control.Concurrent.SSem (SSem)+import qualified Control.Concurrent.SSem as SSem+import System.IO                (BufferMode(NoBuffering, LineBuffering), Handle, hClose, hGetLine, hPutChar, hSetBuffering)  -- |Bot configuration data BotConf =@@ -38,10 +42,10 @@     , logger        :: Logger           -- ^ app logging     , host          :: HostName         -- ^ irc server to connect     , port          :: PortID           -- ^ irc port to connect to (usually, 'PortNumber 6667')-    , nick          :: String           -- ^ irc nick+    , nick          :: ByteString       -- ^ irc nick     , commandPrefix :: String           -- ^ command prefix     , user          :: User             -- ^ irc user info-    , channels      :: Set String       -- ^ channel to join+    , channels      :: Set ByteString   -- ^ channel to join     , limits        :: Maybe (Int, Int) -- ^ (burst length, delay in microseconds)     } @@ -61,7 +65,7 @@ -- | connect to irc server and send NICK and USER commands ircConnect :: HostName            -> PortID-           -> String+           -> ByteString            -> User            -> IO Handle ircConnect host port n u =@@ -69,12 +73,12 @@        hSetBuffering h LineBuffering        return h -partLoop :: Logger -> String -> String -> Chan Message -> Chan Message -> (BotPartT IO ()) -> IO ()+partLoop :: Logger -> ByteString -> String -> Chan Message -> Chan Message -> (BotPartT IO ()) -> IO () partLoop logger botName prefix incomingChan outgoingChan botPart =   forever $ do msg <- readChan incomingChan                runBotPartT botPart (BotEnv msg outgoingChan logger botName prefix) -ircLoop :: Logger -> String -> String -> Chan Message -> Chan Message -> [BotPartT IO ()] -> IO [ThreadId]+ircLoop :: Logger -> ByteString -> String -> Chan Message -> Chan Message -> [BotPartT IO ()] -> IO [ThreadId] ircLoop logger botName prefix incomingChan outgoingChan parts =     mapM forkPart parts   where@@ -85,8 +89,8 @@ -- 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 -> 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 =+connectionLoop :: Logger -> Maybe (Int, Int) -> TMVar UTCTime -> HostName -> PortID -> ByteString -> User -> Chan Message -> Chan Message -> Maybe (Chan Message) -> SSem -> IO (ThreadId, ThreadId, Maybe ThreadId, IO ())+connectionLoop logger mLimitConf tmv host port nick user outgoingChan incomingChan logChan connSSem =   do hTMVar <- atomically $ newTMVar (undefined :: Handle)      (limit, limitTid) <-          case mLimitConf of@@ -99,20 +103,22 @@                          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)+                         C.hPutStr h (encode msg) `catch` (reconnect logger host port nick user hTMVar connSSem)+                         hPutChar h '\n'                          now <- getCurrentTime                          atomically $ swapTMVar tmv now      incomingTid  <- forkIO $ do-                      doConnect logger host port nick user hTMVar connQSem+                      doConnect logger host port nick user hTMVar connSSem                       forever $                        do h <- atomically $ readTMVar hTMVar-                          msgStr <- (hGetLine h) `catch` (\e -> reconnect logger host port nick user hTMVar connQSem e >> return "")+                          -- FIXME: is C.hGetLine going to do the write thing in the face of unicode?+                          msgStr <- (C.hGetLine h) `catch` (\e -> reconnect logger host port nick user hTMVar connSSem e >> return "")                           now <- getCurrentTime                           atomically $ swapTMVar tmv now-                          case decode (msgStr ++ "\n") of-                            Nothing -> logger Normal ("decode failed: " ++ msgStr)+                          case decode (msgStr <> "\n") of+                            Nothing -> logger Normal ("decode failed: " <> msgStr)                             (Just msg) ->-                              do logger Debug (show msg)+                              do logger Debug (showMessage msg)                                  writeMaybeChan logChan msg                                  writeChan incomingChan msg      let forceReconnect =@@ -125,43 +131,43 @@                 putStrLn "done."      return (outgoingTid, incomingTid, limitTid, forceReconnect) -ircConnectLoop :: (LogLevel -> String -> IO a) -- ^ logging+ircConnectLoop :: (LogLevel -> ByteString -> IO a) -- ^ logging                -> HostName                -> PortID-               -> String+               -> ByteString                -> User                -> IO Handle ircConnectLoop logger host port nick user =         (ircConnect host port nick user) `catch`         (\e ->-          do logger Normal $ "irc connect failed ... retry in 60 seconds: " ++ show (e :: IOException)+          do logger Normal $ "irc connect failed ... retry in 60 seconds: " <> (C.pack $ show (e :: IOException))              threadDelay (60 * 10^6)              ircConnectLoop logger host port nick user) -doConnect :: (LogLevel -> String -> IO a) -> String -> PortID -> String -> User -> TMVar Handle -> QSem -> IO ()-doConnect logger host port nick user hTMVar connQSem =-    do logger Normal $ showString "Connecting to " . showString host . showString " as " $ nick+doConnect :: (LogLevel -> ByteString -> IO a) -> HostName -> PortID -> ByteString -> User -> TMVar Handle -> SSem -> IO ()+doConnect logger host port nick user hTMVar connSSem =+    do logger Normal $ "Connecting to " <> (C.pack host) <> " as " <> nick        h <- ircConnectLoop logger host port nick user        atomically $ swapTMVar hTMVar h        logger Normal $ "Connected."-       signalQSem connQSem+       SSem.signal connSSem        return () -reconnect :: Logger -> String -> PortID -> String -> User -> TMVar Handle -> QSem -> IOException -> IO ()-reconnect logger host port nick user hTMVar connQSem e =-    do logger Normal $ "IRC Connection died: " ++ show e+reconnect :: Logger -> HostName -> PortID -> ByteString -> User -> TMVar Handle -> SSem -> IOException -> IO ()+reconnect logger host port nick user hTMVar connSSem e =+    do logger Normal $ "IRC Connection died: " <> C.pack (show e) {-        atomically $ do empty <- isEmptyTMVar hTMVar                        if empty                           then return ()                           else takeTMVar hTMVar >> return () -}-       doConnect logger host port nick user hTMVar connQSem+       doConnect logger host port nick user hTMVar connSSem -onConnectLoop :: Logger -> String -> String -> Chan Message -> QSem -> BotPartT IO () -> IO ThreadId-onConnectLoop logger botName prefix outgoingChan connQSem action =+onConnectLoop :: Logger -> ByteString -> String -> Chan Message -> SSem -> BotPartT IO () -> IO ThreadId+onConnectLoop logger botName prefix outgoingChan connSSem action =     forkIO $ forever $-      do waitQSem connQSem+      do SSem.wait connSSem          runBotPartT action (BotEnv undefined outgoingChan logger botName prefix)  -- |simpleBot connects to the server and handles messages using the supplied BotPartTs@@ -185,7 +191,7 @@           -> 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+          -> ByteString       -- ^ irc nick           -> String           -- ^ command prefix           -> User             -- ^ irc user info           -> [BotPartT IO ()] -- ^ bot parts (must include 'pingPart', 'channelsPart', and 'nickUserPart)'@@ -203,8 +209,8 @@      incomingChan <- newChan :: IO (Chan Message)      now <- getCurrentTime      tmv <- atomically $ newTMVar now-     connQSem <- newQSem 0-     (outgoingTid, incomingTid, mLimitTid, forceReconnect) <- connectionLoop logger limitConf tmv host port nick user outgoingChan incomingChan mLogChan connQSem+     connSSem <- SSem.new 0+     (outgoingTid, incomingTid, mLimitTid, forceReconnect) <- connectionLoop logger limitConf tmv host port nick user outgoingChan incomingChan mLogChan connSSem      watchDogTid <- forkIO $ forever $                     do let timeout = 5*60                        now          <- getCurrentTime@@ -212,7 +218,7 @@                        when (now > addUTCTime (fromIntegral timeout) lastActivity) forceReconnect                        threadDelay (30*10^6) -- check every 30 seconds      ircTids     <- ircLoop logger nick prefix incomingChan outgoingChan parts-     onConnectId <- onConnectLoop logger nick prefix outgoingChan connQSem onConnect+     onConnectId <- onConnectLoop logger nick prefix outgoingChan connSSem onConnect      return $ (maybe id (:) mLimitTid $ maybe id (:) mLogTid $ (incomingTid : outgoingTid : watchDogTid : ircTids), forceReconnect)     where       onConnect :: BotPartT IO ()
Network/IRC/Bot/ErrorCodes.hs view
@@ -1,16 +1,19 @@+{-# LANGUAGE OverloadedStrings #-} module Network.IRC.Bot.ErrorCodes where +import Data.ByteString (ByteString)+ -- * Nickname errors -noNicknameGiven :: String+noNicknameGiven :: ByteString noNicknameGiven = "431" -erroneusNickname :: String+erroneusNickname :: ByteString erroneusNickname = "432" -nicknameInUse :: String+nicknameInUse :: ByteString nicknameInUse = "433" -nickCollision :: String+nickCollision :: ByteString nickCollision = "436"
Network/IRC/Bot/Limiter.hs view
@@ -18,12 +18,13 @@     where  import Control.Concurrent      (ThreadId, forkIO, threadDelay)-import Control.Concurrent.QSem (QSem, newQSem, signalQSem, waitQSem)+import           Control.Concurrent.SSem (SSem)+import qualified Control.Concurrent.SSem as SSem import Control.Monad           (forever)  data Limiter = Limiter-    { limitsIn       :: QSem-    , limitsOut      :: QSem+    { limitsIn       :: SSem+    , limitsOut      :: SSem     , limitsDelay    :: Int     , limitsThreadId :: ThreadId     }@@ -33,8 +34,8 @@            -> Int -- ^ delay (in microseconds)            -> IO Limiter newLimiter burst delay = do-  rdy  <- newQSem burst-  sent <- newQSem 0+  rdy  <- SSem.new burst+  sent <- SSem.new 0   let l = Limiter { limitsIn       = sent                   , limitsOut      = rdy                   , limitsDelay    = delay@@ -46,12 +47,12 @@ -- | Execute this before sending limit :: Limiter -> IO () limit l = do-  waitQSem   (limitsOut l)-  signalQSem (limitsIn l)+  SSem.wait   (limitsOut l)+  SSem.signal (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)+  SSem.wait    (limitsIn l)+  threadDelay  (limitsDelay l)+  SSem.signal  (limitsOut l)
Network/IRC/Bot/Log.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} module Network.IRC.Bot.Log where +import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as C import Data.Data  data LogLevel@@ -9,11 +11,11 @@     | Important       deriving (Eq, Ord, Read, Show, Data, Typeable) -type Logger = LogLevel -> String -> IO ()+type Logger = LogLevel -> ByteString -> IO ()  stdoutLogger :: LogLevel -> Logger stdoutLogger minLvl msgLvl msg-    | msgLvl >= minLvl = putStrLn msg+    | msgLvl >= minLvl = C.putStrLn msg -- assumes ascii, which is wrong(?)     | otherwise        = return ()  nullLogger :: Logger
Network/IRC/Bot/Parsec.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} module Network.IRC.Bot.Parsec where  {-@@ -34,9 +34,12 @@ import Control.Monad import Control.Monad.Reader (MonadReader, ask) import Control.Monad.Trans+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as C import Data.Char (digitToInt) import Data.List (intercalate, isPrefixOf, nub) import Data.Maybe (fromMaybe)+import Data.Monoid ((<>)) import Network.IRC.Bot.Log import Network.IRC.Bot.BotMonad import Network.IRC.Bot.Commands@@ -57,17 +60,17 @@ mapParsecT f p = mkPT $ \s -> f (runParsecT p s)  -- | parse a positive integer-nat :: (Monad m) => ParsecT String () m Integer+nat :: (Monad m) => ParsecT ByteString () m Integer nat =     do digits <- many1 digit        return $ foldl (\x d -> x * 10 + fromIntegral (digitToInt d)) 0 digits  -- | parser that checks for the 'cmdPrefix' (from the 'BotEnv')-botPrefix :: (BotMonad m) => ParsecT String () m ()+botPrefix :: (BotMonad m) => ParsecT ByteString () m () botPrefix =     do recv <- fromMaybe "" <$> askReceiver        pref <- cmdPrefix <$> askBotEnv-       if "#" `isPrefixOf` recv+       if "#" `C.isPrefixOf` recv           then (try $ string pref >> return ()) <|> lift mzero           else (try $ string pref >> return ()) <|> return () @@ -81,25 +84,25 @@ -- -- see 'dicePart' for an example usage. parsecPart :: (BotMonad m) =>-              (ParsecT String () m a)+              (ParsecT ByteString () m a)            -> m a parsecPart p =     do priv <- privMsg-       logM Debug $ "I got a message: " ++ msg priv ++ " sent to " ++ show (receivers priv)-       ma <- runParserT p () (msg priv) (msg priv)+       logM Debug $ "I got a message: " <> msg priv <> " sent to " <> (C.intercalate ", " (receivers priv))+       ma <- runParserT p () "" (msg priv)        case ma of          (Left e) ->-             do logM Debug $ "Parse error: " ++ show e+             do logM Debug $ "Parse error: " <> C.pack (show e)                 target <- maybeZero =<< replyTo                 reportError target e                 mzero          (Right a) -> return a -reportError :: (BotMonad m) => String -> ParseError -> m ()+reportError :: (BotMonad m) => ByteString -> ParseError -> m () reportError target err =     let errStrs = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages err)         errStr = intercalate "; " errStrs-    in sendCommand (PrivMsg Nothing [target] errStr)+    in sendCommand (PrivMsg Nothing [target] (C.pack errStr))  showErrorMessages ::     String -> String -> String -> String -> String -> [P.Message] -> [String]@@ -116,8 +119,8 @@       showUnExpect    = showMany msgUnExpected unExpect       showSysUnExpect | not (null unExpect) ||                         null sysUnExpect = ""-                      | null firstMsg    = msgUnExpected ++ " " ++ msgEndOfInput-                      | otherwise        = msgUnExpected ++ " " ++ firstMsg+                      | null firstMsg    = msgUnExpected <> " " <> msgEndOfInput+                      | otherwise        = msgUnExpected <> " " <> firstMsg           where               firstMsg  = messageString (head sysUnExpect) @@ -127,16 +130,16 @@       showMany pre msgs = case clean (map messageString msgs) of                             [] -> ""                             ms | null pre  -> commasOr ms-                               | otherwise -> pre ++ " " ++ commasOr ms+                               | otherwise -> pre <> " " <> commasOr ms        commasOr []       = ""       commasOr [m]      = m-      commasOr ms       = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms+      commasOr ms       = commaSep (init ms) <> " " <> msgOr <> " " <> last ms        commaSep          = seperate ", " . clean        seperate   _ []     = ""       seperate   _ [m]    = m-      seperate sep (m:ms) = m ++ sep ++ seperate sep ms+      seperate sep (m:ms) = m <> sep <> seperate sep ms        clean             = nub . filter (not . null)
Network/IRC/Bot/Part/Channels.hs view
@@ -1,19 +1,23 @@+{-# LANGUAGE OverloadedStrings #-} module Network.IRC.Bot.Part.Channels where  import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar, writeTVar) import Control.Monad.Trans (MonadIO(liftIO))+import Data.Monoid ((<>)) import Data.Set (Set, insert, toList)+import Data.ByteString (ByteString)+import Data.ByteString.Char8(unpack) import Network.IRC (Message(..), joinChan) import Network.IRC.Bot.BotMonad (BotMonad(..)) import Network.IRC.Bot.Log (LogLevel(..)) -initChannelsPart :: (BotMonad m) => Set String -> IO (TVar (Set String), m ())+initChannelsPart :: (BotMonad m) => Set ByteString -> IO (TVar (Set ByteString), m ()) initChannelsPart chans =     do channels <- atomically $ newTVar chans        return (channels, channelsPart channels) -channelsPart :: (BotMonad m) => TVar (Set String) -> m ()+channelsPart :: (BotMonad m) => TVar (Set ByteString) -> m () channelsPart channels =     do msg <- askMessage        let cmd = msg_command msg@@ -22,15 +26,14 @@                      mapM_ doJoin (toList chans)          _ -> return ()     where-      doJoin :: (BotMonad m) => String -> m ()-      doJoin chan = +      doJoin :: (BotMonad m) => ByteString -> m ()+      doJoin chan =           do sendMessage (joinChan chan)-             logM Normal $ "Joining room " ++ chan+             logM Normal $ "Joining room " <> chan -joinChannel :: (BotMonad m) => String -> TVar (Set String) -> m ()+joinChannel :: (BotMonad m) => ByteString -> TVar (Set ByteString) -> m () joinChannel chan channels =     do liftIO $ atomically $            do cs <- readTVar channels               writeTVar channels (insert chan cs)        sendMessage (joinChan chan)-
Network/IRC/Bot/Part/Dice.hs view
@@ -1,7 +1,11 @@+{-# LANGUAGE OverloadedStrings #-} module Network.IRC.Bot.Part.Dice where  import Control.Monad            (replicateM) import Control.Monad.Trans      (liftIO)+import Data.ByteString          (ByteString)+import Data.ByteString.Char8    (pack)+import Data.Monoid              ((<>)) import Network.IRC.Bot.Log      (LogLevel(Debug)) import Network.IRC.Bot.BotMonad (BotMonad(..), maybeZero) import Network.IRC.Bot.Commands (PrivMsg(..), sendCommand, replyTo)@@ -12,7 +16,7 @@ dicePart :: (BotMonad m) => m () dicePart = parsecPart diceCommand -diceCommand :: (BotMonad m) => ParsecT String () m ()+diceCommand :: (BotMonad m) => ParsecT ByteString () m () diceCommand =     do try $ botPrefix >> string "dice"        logM Debug "dicePart"@@ -33,5 +37,5 @@               return (nd, ns, mod)) <?> "dice <num-dice>d<num-sides>[+<modifier>]"        rolls <- liftIO $ replicateM (fromIntegral numDice) $ randomRIO (1, numSides)        let results = "You rolled " ++ show numDice ++ " " ++ show numSides ++ "-sided dice with a +" ++ show modifier ++ " modifier: " ++ show rolls ++ " => " ++ show (sum (modifier : rolls))-       sendCommand (PrivMsg Nothing [target] results)+       sendCommand (PrivMsg Nothing [target] (pack results))     <|> return ()
Network/IRC/Bot/Part/Hello.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE OverloadedStrings #-} module Network.IRC.Bot.Part.Hello where  import Control.Monad.Trans      (liftIO) import Data.Maybe               (fromMaybe)+import Data.ByteString          (ByteString)+import Data.Monoid              ((<>)) import Network.IRC.Bot.Log      (LogLevel(Debug)) import Network.IRC.Bot.BotMonad (BotMonad(..), maybeZero) import Network.IRC.Bot.Commands (PrivMsg(..),askSenderNickName, replyTo, sendCommand)@@ -12,15 +15,15 @@ helloPart :: (BotMonad m) => m () helloPart = parsecPart helloCommand -helloCommand :: (BotMonad m) => ParsecT String () m ()+helloCommand :: (BotMonad m) => ParsecT ByteString () m () helloCommand =     do try $ botPrefix >> string "hello"        logM Debug "helloPart"        target <- maybeZero =<< replyTo-       logM Debug $ "target: " ++ target+       logM Debug $ "target: " <> target        mNick <- askSenderNickName        let greetings = ["Hello", "Howdy", "Greetings", "Word up"]        n <- liftIO $ randomRIO (0, length greetings - 1)-       let msg = greetings!!n ++ ", " ++ (fromMaybe "stranger" mNick)+       let msg = greetings!!n <> ", " <> (fromMaybe "stranger" mNick)        sendCommand (PrivMsg Nothing [target] msg)     <|> return ()
Network/IRC/Bot/Part/NickUser.hs view
@@ -1,34 +1,37 @@ module Network.IRC.Bot.Part.NickUser where  import Control.Monad.Trans        (liftIO)+import Data.ByteString            (ByteString)+import Data.ByteString.Char8      (pack, unpack)+import Data.Monoid                ((<>)) import Network.IRC.Bot.BotMonad   (BotMonad(..) ) import Network.IRC.Bot.Types      (User(..))-import Network.IRC.Bot.ErrorCodes +import Network.IRC.Bot.ErrorCodes import Network.IRC.Bot.Log        (LogLevel(..)) -- import Network.IRC.Bot.Commands (Ping(..), Pong(..), ping, sendCommand)-import           Network.IRC      (Message(..))+import           Network.IRC      (Message(..), showMessage) import qualified Network.IRC      as IRC import System.Random              (randomRIO) -nickUserPart :: (BotMonad m) => m ()     +nickUserPart :: (BotMonad m) => m () nickUserPart =-  do msg <- askMessage +  do msg <- askMessage      let cmd = msg_command msg      case () of-       () | cmd == noNicknameGiven  -> logM Important (show msg)-          | cmd == erroneusNickname -> logM Important (show msg)-          | cmd == nickCollision    -> logM Important (show msg)-          | cmd == nicknameInUse    -> -              do logM Important (show msg)+       () | cmd == noNicknameGiven  -> logM Important (showMessage msg)+          | cmd == erroneusNickname -> logM Important (showMessage msg)+          | cmd == nickCollision    -> logM Important (showMessage msg)+          | cmd == nicknameInUse    ->+              do logM Important (showMessage msg)                  n <- whoami                  i <- liftIO $ randomRIO (1, 100 :: Int)-                 changeNickUser (n ++ show i) Nothing+                 changeNickUser (n <> pack (show i)) Nothing           | otherwise -> return () -changeNickUser :: (BotMonad m) => String -> Maybe User -> m ()+changeNickUser :: (BotMonad m) => ByteString -> Maybe User -> m () changeNickUser n mUser =     do sendMessage (IRC.nick n)        case mUser of          Nothing -> return ()          (Just u) ->-             sendMessage (IRC.user (username u) (hostname u) (servername u) (realname u))+             sendMessage (IRC.user (username u) (pack $ hostname u) (pack $ servername u) (realname u))
Network/IRC/Bot/PosixLogger.hs view
@@ -1,22 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+{-++Use the 'unix' library to write the log file. Why not 'Handles' you+ask? I believe it is because 'Handles' lock the file, and we want to+be able to serve the file while it is still being written.++-} module Network.IRC.Bot.PosixLogger where  import Control.Concurrent.Chan-import Data.Time.Calendar (Day(..))-import Data.Time.Clock (UTCTime(..), addUTCTime, getCurrentTime)-import Data.Time.Format (formatTime)-import Network.IRC (Command, Message(Message, msg_prefix, msg_command, msg_params), Prefix(NickName), UserName, encode, decode, joinChan, nick, user)+import Data.ByteString    (ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Char8 (pack, unpack)+import Data.Time.Calendar    (Day(..))+import Data.Time.Clock    (UTCTime(..), addUTCTime, getCurrentTime)+import Data.Time.Format   (formatTime)+import qualified Foreign.C.Error as C+import Foreign.Ptr        (castPtr)+import Network.IRC        (Command, Message(Message, msg_prefix, msg_command, msg_params), Prefix(NickName), UserName, encode, decode, joinChan, nick, user) import Network.IRC.Bot.Commands-import System.Directory (createDirectoryIfMissing)-import System.FilePath ((</>))-import System.Locale (defaultTimeLocale)-import System.Posix ( Fd, OpenMode(WriteOnly), OpenFileFlags(append), closeFd, defaultFileFlags-                    , fdWrite, openFd-                    )+import System.Directory   (createDirectoryIfMissing)+import System.FilePath    ((</>))+import System.Locale      (defaultTimeLocale)+import System.Posix.ByteString ( Fd, OpenMode(WriteOnly), OpenFileFlags(append), closeFd, defaultFileFlags+                               , openFd+                               )+import System.Posix.IO.ByteString (fdWriteBuf)  -- TODO: This should be modified so that a formatting filter can be applied to the log messages -- TODO: should be updated so that log file name matches channel -- TODO: should support multiple channels-posixLogger :: Maybe FilePath -> String -> Chan Message -> IO ()+posixLogger :: Maybe FilePath -> ByteString -> Chan Message -> IO () posixLogger mLogDir channel logChan =   do now <- getCurrentTime      let logDay = utctDay now@@ -28,9 +42,9 @@           case mLogDir of             Nothing -> return Nothing             (Just logDir) ->-                do let logPath = logDir </> (formatTime defaultTimeLocale ((dropWhile (== '#') channel) ++ "-%Y-%m-%d.txt") now)+                do let logPath = logDir </> (formatTime defaultTimeLocale ((dropWhile (== '#') (unpack channel)) ++ "-%Y-%m-%d.txt") now)                    createDirectoryIfMissing True logDir-                   fd <- openFd logPath WriteOnly (Just 0o0644) (defaultFileFlags { append = True })+                   fd <- openFd (pack logPath) WriteOnly (Just 0o0644) (defaultFileFlags { append = True })                    return (Just fd)       updateLogHandle :: UTCTime -> Day -> Maybe Fd -> IO (Day, Maybe Fd)       updateLogHandle now logDay Nothing = return (logDay, Nothing)@@ -48,11 +62,28 @@            let mPrivMsg = toPrivMsg msg            case mPrivMsg of              (Just (PrivMsg (Just (NickName nick _user _server)) receivers msg)) | channel `elem` receivers ->-                   do let logMsg = showString (formatTime defaultTimeLocale "%X " now) . showString "<" . showString nick . showString "> " $ msg+                   do let logMsg =+                              B.concat [ pack (formatTime defaultTimeLocale "%X " now)+                                       , "<" , nick , "> "+                                       , msg+                                       , "\n"+                                       ]                       case mLogFd' of                         Nothing -> return ()-                        (Just logFd') -> fdWrite logFd' (logMsg ++ "\n") >> return ()+                        (Just logFd') -> fdWrites logFd' logMsg >> return ()                       return ()                       -- hPutStrLn logFd logMsg              _ -> return ()            logLoop logDay' mLogFd'++fdWrites :: Fd+         -> ByteString+         -> IO ()+fdWrites fd bs =+    B.useAsCStringLen bs $ \(cstring, len) ->+        if len <= 0+           then return ()+           else do c <- C.throwErrnoIfMinus1Retry "fdWrites" $ fdWriteBuf fd (castPtr cstring) (fromIntegral len)+                   if (fromIntegral c) == (fromIntegral len)+                      then return ()+                      else fdWrites fd (B.drop (fromIntegral c) bs)
Network/IRC/Bot/Types.hs view
@@ -1,32 +1,19 @@-{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, OverloadedStrings #-} module Network.IRC.Bot.Types     ( User(..)     , nullUser     ) where -import Control.Concurrent       (ThreadId, forkIO, threadDelay)-import Control.Concurrent.Chan  (Chan, dupChan, newChan, readChan, writeChan)-import Control.Concurrent.MVar  (MVar, modifyMVar_, newMVar, readMVar)-import Control.Concurrent.QSem  (QSem, newQSem, waitQSem, signalQSem)-import Control.Exception        (IOException, catch)-import Control.Monad            (mplus, forever, when)-import Control.Monad.Trans      (liftIO)+import Data.ByteString          (ByteString) import Data.Data                (Data, Typeable)-import Data.Time                (UTCTime, addUTCTime, getCurrentTime)-import Network                  (HostName, PortID(PortNumber), connectTo)-import Network.IRC              (Message, decode, encode, joinChan, nick, user) import Network.IRC              as I-import Network.IRC.Bot.Log      (Logger, LogLevel(Normal, Debug), stdoutLogger)-import Network.IRC.Bot.BotMonad (BotMonad(logM), BotPartT, BotEnv(..), runBotPartT)-import Prelude                  hiding (catch)-import System.IO                (BufferMode(LineBuffering), Handle, hClose, hGetLine, hPutStrLn, hSetBuffering)-+import Network                  (HostName)  data User = User-    { username   :: String    -- ^ username on client system+    { username   :: ByteString    -- ^ username on client system     , hostname   :: HostName  -- ^ hostname of client system     , servername :: HostName  -- ^ irc server client is connected to-    , realname   :: String    -- ^ client's real name+    , realname   :: ByteString    -- ^ client's real name     }     deriving (Data, Typeable, Eq, Ord, Read, Show)
ircbot.cabal view
@@ -1,5 +1,5 @@ Name:                ircbot-Version:             0.5.4+Version:             0.6.0 Synopsis:            A library for writing irc bots Homepage:            http://hub.darcs.net/stepcut/ircbot License:             BSD3@@ -34,16 +34,18 @@                        Network.IRC.Bot.PosixLogger                        Network.IRC.Bot.Types -  Build-depends:  base       >= 4 && <5,-                  containers >= 0.4 && < 0.6,+  Build-depends:  base       >= 4    && <5,+                  bytestring >= 0.10 && < 0.11,+                  containers >= 0.4  && < 0.6,                   directory   < 1.3,-                  filepath   >= 1.2 && < 1.4,-                  irc        == 0.5.*,-                  mtl        >= 2.0 && < 2.2,-                  network    >= 2.3 && < 2.5,+                  filepath   >= 1.2  && < 1.4,+                  irc        == 0.6.*,+                  mtl        >= 2.0  && < 2.2,+                  network    >= 2.3  && < 2.5,                   old-locale == 1.0.*,                   parsec     == 3.1.*,                   time       == 1.4.*,-                  unix       >= 2.4 && < 2.8,+                  unix       >= 2.4  && < 2.8,                   random     == 1.0.*,-                  stm        >= 2.2 && < 2.5+                  stm        >= 2.2  && < 2.5,+                  SafeSemaphore >= 0.10 && < 0.11