simpleirc 0.2.0 → 0.2.1

raw patch · 3 files changed

+120/−57 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Network/SimpleIRC/Core.hs +93/−42
• Network/SimpleIRC/Messages.hs +25/−13
• simpleirc.cabal +2/−2

@@ -20,6 +20,7 @@     -- * Functions   , connect   , disconnect+  , reconnect   , sendRaw   , sendMsg   , sendCmd@@ -28,13 +29,11 @@   , remEvent   , defaultConfig   -   -- * Utils-  , getDest-      -- * Accessors   , getChannels   , getNickname   , getAddress+  , getPort   , getUsername   , getRealname   ) where@@ -42,6 +41,7 @@ import Network import System.IO import Data.Maybe+import Data.List (delete) import Data.Char (isNumber) import Control.Monad import Control.Concurrent@@ -50,12 +50,13 @@ import Network.SimpleIRC.Messages import Data.Unique import System.IO.Error+import System.Timeout import Data.Time import System.Locale import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map -internalEvents     = [joinChans, pong, onJoin]+internalEvents     = [joinChans, pong, trackChanges] internalNormEvents = [Privmsg ctcpHandler]  type MIrc = MVar IrcServer@@ -64,12 +65,14 @@   { cAddr     :: String   -- ^ Server address to connect to   , cPort     :: Int      -- ^ Server port to connect to   , cNick     :: String   -- ^ Nickname+  , cPass     :: Maybe String -- ^ Optional server password   , cUsername :: String   -- ^ Username   , cRealname :: String   -- ^ Realname   , cChannels :: [String]   -- ^ List of channels to join on connect   , cEvents   :: [IrcEvent] -- ^ Events to bind   , cCTCPVersion :: String  -- ^ What to send on CTCP VERSION   , cCTCPTime    :: IO String  -- ^ What to send on CTCP TIME+  , cPingTimeoutInterval :: Int -- The time between server messages that causes ping timeout   }  data SIrcCommand =@@ -81,6 +84,7 @@   { sAddr         :: B.ByteString   , sPort         :: Int   , sNickname     :: B.ByteString+  , sPassword     :: Maybe B.ByteString   , sUsername     :: B.ByteString   , sRealname     :: B.ByteString   , sChannels     :: [B.ByteString]@@ -93,6 +97,7 @@   -- Other info   , sCTCPVersion  :: String   , sCTCPTime     :: IO String+  , sPingTimeoutInterval :: Int   }  -- When adding events here, remember add them in callEvents and in eventFunc@@ -112,7 +117,7 @@   | Nick EventFunc    -- ^ NICK   | Notice EventFunc  -- ^ NOTICE   | RawMsg EventFunc  -- ^ This event gets called on every message received-  | Disconnect (IrcServer -> IO ()) -- ^ This event gets called whenever the+  | Disconnect (MIrc -> IO ()) -- ^ This event gets called whenever the                                     --   connection with the server is dropped    instance Show IrcEvent where@@ -174,6 +179,38 @@   write s $ "QUIT :" `B.append` quitMsg   return () +-- |Reconnects to the server.+reconnect :: MIrc -> IO (Either IOError MIrc)+reconnect mServer = try $ do+  server <- readMVar mServer+  +  h <- connectTo (B.unpack $ sAddr server) (PortNumber $ fromIntegral $ sPort server)+  hSetBuffering h NoBuffering+  modifyMVar_ mServer (\s -> return $ s {sSock = Just h})++  -- Initialize connection with the server+  withMVar mServer greetServer++  -- Restart the listen loop.+  listenId <- forkIO (listenLoop mServer)+  cmdId <- forkIO (execCmdsLoop mServer)+  modifyMVar_ mServer (\s -> return $ s {sListenThread = Just listenId,+                        sCmdThread = Just cmdId})+  return mServer++{-+-- |Reconnects to the server.+reconnect :: MIrc -> IO (Either IOError MIrc)+reconnect server = do+  s <- readMVar server+  +  let conf = IrcConfig (B.unpack $ sAddr s) (sPort s) +                       (B.unpack $ sNickname s) (B.unpack $ sUsername s) +                       (B.unpack $ sRealname s) (map (B.unpack) (sChannels s)) +                       (elems $ sEvents s) (sCTCPVersion s) (sCTCPTime s)+  connect conf True (sDebug s)+-}+ genUnique :: IrcEvent -> IO (Unique, IrcEvent) genUnique e = do   u <- newUnique@@ -189,19 +226,23 @@   uniqueEvents <- genUniqueMap $ internalNormEvents ++ cEvents config    return $ IrcServer (B.pack $ cAddr config) (cPort config)-              (B.pack $ cNick config) (B.pack $ cUsername config) +              (B.pack $ cNick config) (B.pack `fmap` cPass config) (B.pack $ cUsername config)                (B.pack $ cRealname config) (map B.pack $ cChannels config)                uniqueEvents (Just h) Nothing Nothing cmdChan debug-              (cCTCPVersion config) (cCTCPTime config)+              (cCTCPVersion config) (cCTCPTime config) (cPingTimeoutInterval config)  greetServer :: IrcServer -> IO IrcServer greetServer server = do+  case mpass of+    Nothing -> return ()+    Just pass -> write server $ "PASS " `B.append` pass   write server $ "NICK " `B.append` nick   write server $ "USER " `B.append` user `B.append` " " `B.append`       user `B.append` " " `B.append` addr `B.append` " :" `B.append` real      return server   where nick = sNickname server+        mpass = sPassword server         user = sUsername server         real = sRealname server         addr = sAddr server@@ -228,14 +269,15 @@   server <- readMVar s    let h = fromJust $ sSock server-  eof <- hIsEOF h+  eof <- timeout (sPingTimeoutInterval server) $ hIsEOF h      -- If EOF then we are disconnected-  if eof +  if (eof /= Just False)     then do       let comp   = (\a -> a `eqEvent` (Disconnect undefined))           events = Map.filter comp (sEvents server)-          eventCall = (\obj -> (eventFuncD $ snd obj) server)+          eventCall = (\obj -> (eventFuncD $ snd obj) s)+      modifyMVar_ s (\serv -> return $ serv {sSock = Nothing})       debugWrite server $ B.pack $ show $ length $ Map.toList events       mapM_ eventCall (Map.toList events)     else do@@ -251,9 +293,12 @@              putMVar s newServ -- Put the MVar back.       +      let parsed = (parse line)       -- Call the events-      callEvents s (parse line)+      callEvents s parsed +      -- Call the RawMsg Events.+      events s (RawMsg undefined) parsed               listenLoop s@@ -280,15 +325,32 @@         pingMsg = mMsg msg         code    = mCode msg --- TODO: Nick and Channels tracking. KICK, PART and NICK.-onJoin :: IrcServer -> IrcMessage -> IO IrcServer-onJoin server msg+trackChanges :: IrcServer -> IrcMessage -> IO IrcServer+trackChanges server msg   | code == "JOIN" = do     let nick = fromJust $ mNick msg         chan  = mMsg msg     if nick == sNickname server       then return server { sChannels = chan:(sChannels server) }       else return server+  | code == "NICK" = do+    let nick    = fromJust $ mNick msg+        newNick = mMsg msg+    if nick == sNickname server+      then return server { sNickname = newNick }+      else return server +  | code == "KICK" = do +    let nick = (fromJust $ mOther msg) !! 0+        chan = fromJust $ mChan msg+    if nick == sNickname server+      then return server { sChannels = delete chan (sChannels server) }+      else return server+  | code == "PART" = do +    let nick = fromJust $ mNick msg+        chan = mMsg msg+    if nick == sNickname server+      then return server { sChannels = delete chan (sChannels server) }+      else return server   | otherwise = return server      where code = mCode msg@@ -299,28 +361,26 @@   | msg == "\x01VERSION\x01" = do     server <- readMVar mServ     -    chan <- getDest mServ iMsg     sendCmd mServ-      (MNotice chan ("\x01VERSION " `B.append`+      (MNotice origin ("\x01VERSION " `B.append`         B.pack (sCTCPVersion server) `B.append` "\x01"))+   | msg == "\x01TIME\x01" = do     server <- readMVar mServ          time <- sCTCPTime server-    chan <- getDest mServ iMsg     sendCmd mServ-      (MNotice chan ("\x01TIME " `B.append`+      (MNotice origin ("\x01TIME " `B.append`         (B.pack time) `B.append` "\x01"))   | "\x01PING " `B.isPrefixOf` msg = do     server <- readMVar mServ     -    chan <- getDest mServ iMsg     sendCmd mServ-      (MNotice chan msg)+      (MNotice origin msg)    | otherwise = return ()-  where msg = mMsg iMsg-+  where msg    = mMsg iMsg+        origin = fromJust $ mOrigin iMsg -- Event code events :: MIrc -> IrcEvent -> IrcMessage -> IO () events mServ event msg = do@@ -370,8 +430,8 @@   | B.all isNumber (mCode msg) =     events mServ (Numeric undefined) msg   -  | otherwise                =-    events mServ (RawMsg undefined) msg+  | otherwise                = return ()+      (Privmsg _) `eqEvent` (Privmsg _) = True (Numeric _) `eqEvent` (Numeric _) = True@@ -466,32 +526,18 @@  defaultConfig = IrcConfig   { cPort     = 6667+  , cPass     = Nothing   , cUsername = "simpleirc"   , cRealname = "SimpleIRC Bot"   , cChannels = []   , cEvents   = []   , cCTCPVersion = "SimpleIRC v0.2"   , cCTCPTime    = fmap (formatTime defaultTimeLocale "%c") getZonedTime+  , cPingTimeoutInterval = 350 * 10^6   }   --- Utils---- |Gets the destination, i.e if the IrcMessage was sent---  directly to you returns the senders nick otherwise the channel.-getDest :: MIrc -> IrcMessage -> IO B.ByteString-getDest mIrc m = do-  s <- readMVar mIrc-  -  if sNickname s == chan-    then return (fromJust $ mNick m)-    else return chan-  -  where chan = fromJust $ mChan m-   -- MIrc Accessors -- |Returns a list of channels currently joined.--- --- Currently this is not updated on KICK or PART. getChannels :: MIrc -> IO [B.ByteString] getChannels mIrc = do   s <- readMVar mIrc@@ -499,8 +545,6 @@   return $ sChannels s  -- |Returns the current nickname.--- --- Currently this is not updated on NICK. getNickname :: MIrc -> IO B.ByteString getNickname mIrc = do   s <- readMVar mIrc@@ -513,6 +557,13 @@   s <- readMVar mIrc      return $ sAddr s  ++-- |Returns the address+getPort :: MIrc -> IO Int+getPort mIrc = do+  s <- readMVar mIrc+  +  return $ sPort s  -- |Returns the User name getUsername :: MIrc -> IO B.ByteString

@@ -20,6 +20,7 @@ import Data.Maybe import qualified Data.ByteString.Char8 as B import Control.Arrow+import Control.Applicative import Data.Typeable  -- PING :asimov.freenode.net@@ -55,6 +56,7 @@   , mCode   :: B.ByteString   , mMsg    :: B.ByteString   , mChan   :: Maybe B.ByteString+  , mOrigin :: Maybe B.ByteString   -- ^ Origin of the message, this is mNick if a message was sent directly to the bot, otherwise if it got sent to the channel it's mChan.   , mOther  :: Maybe [B.ByteString]   , mRaw    :: B.ByteString   } deriving (Show, Typeable)@@ -63,13 +65,14 @@ parse :: B.ByteString -> IrcMessage parse txt =    case length split of -    2 -> parse2 split txt-    3 -> parse3 split txt-    4 -> parse4 split txt -    5 -> parse5 split txt-    _ -> parseOther split txt+    2 -> parse2 split noCarriage+    3 -> parse3 split noCarriage+    4 -> parse4 split noCarriage +    5 -> parse5 split noCarriage+    _ -> parseOther split noCarriage   -  where split = smartSplit (takeCarriageRet txt)+  where noCarriage = takeCarriageRet txt+        split      = smartSplit noCarriage  -- Nick, Host, Server parseFirst :: B.ByteString -> (Maybe B.ByteString, Maybe B.ByteString, Maybe B.ByteString, Maybe B.ByteString)@@ -82,31 +85,40 @@                else (Just nick, Nothing, Just user_host, Nothing)     else (Nothing, Nothing, Nothing, Just $ dropColon first)  +getOrigin :: Maybe B.ByteString -> B.ByteString -> B.ByteString+getOrigin (Just nick) chan =+  if "#" `B.isPrefixOf` chan || "&" `B.isPrefixOf` chan || "+" `B.isPrefixOf` chan+      || "!" `B.isPrefixOf` chan+    then chan+    else nick+getOrigin Nothing chan = chan+ parse2 :: [B.ByteString] -> B.ByteString -> IrcMessage parse2 (code:msg:_) =   IrcMessage Nothing Nothing Nothing Nothing code-    (dropColon msg) Nothing Nothing+    (dropColon msg) Nothing Nothing Nothing      parse3 :: [B.ByteString] -> B.ByteString -> IrcMessage parse3 (first:code:msg:_) =   let (nick, user, host, server) = parseFirst first-  in IrcMessage nick user host server code (dropColon msg) Nothing Nothing+  in IrcMessage nick user host server code (dropColon msg) Nothing Nothing Nothing    parse4 :: [B.ByteString] -> B.ByteString -> IrcMessage parse4 (first:code:chan:msg:_) =    let (nick, user, host, server) = parseFirst first   in IrcMessage nick user host server code-       (dropColon msg) (Just chan) Nothing+       (dropColon msg) (Just chan) (Just $ getOrigin nick chan) Nothing  parse5 :: [B.ByteString] -> B.ByteString -> IrcMessage-parse5 (server:code:nick:chan:msg:_) =-  IrcMessage (Just nick) Nothing Nothing (Just server) code-    (dropColon msg) (Just chan) Nothing+parse5 (first:code:chan:other:msg:_) =+  let (nick, user, host, server) = parseFirst first+  in IrcMessage nick user host server code+    (dropColon msg) (Just chan) (Just $ getOrigin nick chan) (Just [other])  parseOther :: [B.ByteString] -> B.ByteString -> IrcMessage parseOther (server:code:nick:chan:other) =   IrcMessage (Just nick) Nothing Nothing (Just server) code-    (B.unwords other) (Just chan) (Just other)+    (B.unwords other) (Just chan) (Just $ getOrigin (Just nick) chan) (Just other)  smartSplit :: B.ByteString -> [B.ByteString] smartSplit txt = 

@@ -1,5 +1,5 @@ Name:          simpleirc-Version:       0.2.0+Version:       0.2.1 Category:      Network, IRC Synopsis:      Simple IRC Library Maintainer:    Dominik Picheta <dominikpicheta@googlemail.com>@@ -21,7 +21,7 @@ Source-repository this   Type:     git   Location: git://github.com/dom96/SimpleIRC.git-  tag:      v0.2.0+  tag:      v0.2.1  Library   Build-depends: