irc-client 0.2.4.0 → 0.2.5.0

raw patch · 6 files changed

+94/−68 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Network/IRC/Client.hs +15/−10
• Network/IRC/Client/Handlers.hs +12/−12
• Network/IRC/Client/Internal.hs +14/−15
• Network/IRC/Client/Types.hs +48/−25
• Network/IRC/Client/Utils.hs +4/−4
• irc-client.cabal +1/−2

@@ -6,7 +6,7 @@ -- > run host port nick = do -- >   conn <- connect host port 1 -- >   let cfg = defaultIRCConf nick--- >   let cfg' = cfg { _handlers = yourCustomEventHandlers : _handlers cfg }+-- >   let cfg' = cfg { _eventHandlers = yourCustomEventHandlers : _eventHandlers cfg } -- >   start conn cfg' -- -- You shouldn't really need to tweak anything other than the event@@ -18,6 +18,7 @@   , connectWithTLS   , start   , start'+  , startStateful    -- * Logging   , Origin (..)@@ -67,7 +68,7 @@   -- ^ The port   -> NominalDiffTime   -- ^ The flood cooldown-  -> m ConnectionConfig+  -> m (ConnectionConfig s) connect = connect' noopLogger  -- | Connect to a server with TLS.@@ -78,7 +79,7 @@   -- ^ The port   -> NominalDiffTime   -- ^ The flood cooldown-  -> m ConnectionConfig+  -> m (ConnectionConfig s) connectWithTLS = connectWithTLS' noopLogger  -- | Connect to a server without TLS, with the provided logging@@ -92,7 +93,7 @@   -- ^ The port   -> NominalDiffTime   -- ^ The flood cooldown-  -> m ConnectionConfig+  -> m (ConnectionConfig s) connect' = connectInternal ircClient defaultDisconnectHandler  -- | Connect to a server with TLS, with the provided logging function.@@ -105,7 +106,7 @@   -- ^ The port   -> NominalDiffTime   -- ^ The flood cooldown-  -> m ConnectionConfig+  -> m (ConnectionConfig s) connectWithTLS' = connectInternal ircTLSClient defaultDisconnectHandler  -- * Starting@@ -113,23 +114,27 @@ -- | Run the event loop for a server, receiving messages and handing -- them off to handlers as appropriate. Messages will be logged to -- stdout.-start :: MonadIO m => ConnectionConfig -> InstanceConfig -> m ()-start cconf iconf = newIRCState cconf iconf >>= start'+start :: MonadIO m => ConnectionConfig () -> InstanceConfig () -> m ()+start cconf iconf = startStateful cconf iconf () +-- | like 'start' but for clients with state.+startStateful :: MonadIO m => ConnectionConfig s -> InstanceConfig s -> s -> m ()+startStateful cconf iconf ustate = newIRCState cconf iconf ustate >>= start'+ -- | Like 'start', but use the provided initial state.-start' :: MonadIO m => IRCState -> m ()+start' :: MonadIO m => IRCState s -> m () start' = liftIO . runReaderT runner  -- * Default configuration  -- | Construct a default IRC configuration from a nick-defaultIRCConf :: Text -> InstanceConfig+defaultIRCConf :: Text -> InstanceConfig s defaultIRCConf n = InstanceConfig   { _nick          = n   , _username      = n   , _realname      = n   , _channels      = []-  , _ctcpVer       = "irc-client-0.2.3.0"+  , _ctcpVer       = "irc-client-0.2.5.0"   , _eventHandlers = defaultEventHandlers   , _ignore        = []   }

@@ -60,7 +60,7 @@ -- -- If you are building a bot, you may want to write an event handler -- to process messages representing commands.-defaultEventHandlers :: [EventHandler]+defaultEventHandlers :: [EventHandler s] defaultEventHandlers =   [ EventHandler "Respond to server PING requests"  EPing    pingHandler   , EventHandler "Respond to CTCP PING requests"    ECTCP    ctcpPingHandler@@ -73,24 +73,24 @@   ]  -- | Respond to server @PING@ messages with a @PONG@.-pingHandler :: UnicodeEvent -> IRC ()+pingHandler :: UnicodeEvent -> StatefulIRC s () pingHandler ev = case _message ev of   Ping s1 s2 -> send . Pong $ fromMaybe s1 s2   _ -> return ()  -- | Respond to CTCP @PING@ requests with a CTCP @PONG@.-ctcpPingHandler :: UnicodeEvent -> IRC ()+ctcpPingHandler :: UnicodeEvent -> StatefulIRC s () ctcpPingHandler = ctcpHandler [("PING", return)]  -- | Respond to CTCP @VERSION@ requests with the version string.-ctcpVersionHandler :: UnicodeEvent -> IRC ()+ctcpVersionHandler :: UnicodeEvent -> StatefulIRC s () ctcpVersionHandler = ctcpHandler [("VERSION", go)] where   go _ = do     ver <- _ctcpVer <$> instanceConfig     return [ver]  -- | Respond to CTCP @TIME@ requests with the system time.-ctcpTimeHandler :: UnicodeEvent -> IRC ()+ctcpTimeHandler :: UnicodeEvent -> StatefulIRC s () ctcpTimeHandler = ctcpHandler [("TIME", go)] where   go _ = do     now <- liftIO getCurrentTime@@ -98,7 +98,7 @@  -- | Update the nick upon welcome (numeric reply 001), as it may not -- be what we requested (eg, in the case of a nick too long).-welcomeNick :: UnicodeEvent -> IRC ()+welcomeNick :: UnicodeEvent -> StatefulIRC s () welcomeNick = numHandler [(001, go)] where   go (srvNick:_) = do     tvarI <- instanceConfigTVar@@ -110,7 +110,7 @@  -- | Mangle the nick if there's a collision (numeric replies 432, 433, -- and 436) when we set it-nickMangler :: UnicodeEvent -> IRC ()+nickMangler :: UnicodeEvent -> StatefulIRC s () nickMangler = numHandler [ (432, go fresh)                          , (433, go mangle)                          , (436, go mangle)@@ -165,7 +165,7 @@  -- | Upon receiving a channel topic (numeric reply 332), add the -- channel to the list (if not already present).-joinHandler :: UnicodeEvent -> IRC ()+joinHandler :: UnicodeEvent -> StatefulIRC s () joinHandler = numHandler [(332, go)] where   go (c:_) = do     tvarI <- instanceConfigTVar@@ -178,7 +178,7 @@   go _ = return ()  -- | Update the channel list upon being kicked.-kickHandler :: UnicodeEvent -> IRC ()+kickHandler :: UnicodeEvent -> StatefulIRC s () kickHandler ev = do   theNick <- _nick <$> instanceConfig   tvarI   <- instanceConfigTVar@@ -192,13 +192,13 @@  -- | The default disconnect handler: do nothing. You might want to -- override this with one which reconnects.-defaultDisconnectHandler :: IRC ()+defaultDisconnectHandler :: StatefulIRC s () defaultDisconnectHandler = return ()  -- *Utils  -- | Match and handle a named CTCP-ctcpHandler :: [(Text, [Text] -> IRC [Text])] -> UnicodeEvent -> IRC ()+ctcpHandler :: [(Text, [Text] -> StatefulIRC s [Text])] -> UnicodeEvent -> StatefulIRC s () ctcpHandler hs ev = case (_source ev, _message ev) of   (User n, Privmsg _ (Left ctcpbs)) ->     let (verb, xs) = first toUpper $ fromCTCP ctcpbs@@ -210,7 +210,7 @@   _ -> return ()  -- | Match and handle a numeric reply-numHandler :: [(Int, [Text] -> IRC ())] -> UnicodeEvent -> IRC ()+numHandler :: [(Int, [Text] -> StatefulIRC s ())] -> UnicodeEvent -> StatefulIRC s () numHandler hs ev = case _message ev of   Numeric num xs -> maybe (return ()) ($xs) $ lookup num hs   _ -> return ()

@@ -33,12 +33,12 @@ -- | Connect to a server using the supplied connection function. connectInternal :: MonadIO m   => (Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ())-  -> IRC ()+  -> StatefulIRC s ()   -> (Origin -> ByteString -> IO ())   -> ByteString   -> Int   -> NominalDiffTime-  -> m ConnectionConfig+  -> m (ConnectionConfig s) connectInternal f dcHandler logf host port flood = liftIO $ do   queueS <- newTBMChanIO 16 @@ -55,7 +55,7 @@ -- * Event loop  -- | The event loop.-runner :: IRC ()+runner :: StatefulIRC s () runner = do   state <- ircState @@ -68,8 +68,7 @@   let initialise = flip runReaderT state $ do         sendBS $ rawMessage "USER" [encodeUtf8 theUser, "-", "-", encodeUtf8 theReal]         send $ Nick theNick-        mapM_ (send . Join) . _channels <$> instanceConfig-        return ()+        instanceConfig >>= mapM_ (send . Join) . _channels    -- Run the event loop, and call the disconnect handler if the remote   -- end closes the socket.@@ -84,8 +83,8 @@    dchandler <- _disconnect <$> connectionConfig -  let source = toProducer $ sourceTBMChan queue $= antiflood $= logConduit (logf FromServer . toByteString)-  let sink   = forgetful =$= logConduit (logf FromClient . _raw) =$ eventSink state+  let source = toProducer $ sourceTBMChan queue $= antiflood $= logConduit (logf FromClient . toByteString)+  let sink   = forgetful =$= logConduit (logf FromServer . _raw) =$ eventSink state    liftIO $ func port server initialise sink source @@ -100,7 +99,7 @@  -- | Block on receiving a message and invoke all matching handlers -- concurrently.-eventSink :: MonadIO m => IRCState -> Consumer IrcEvent m ()+eventSink :: MonadIO m => IRCState s -> Consumer IrcEvent m () eventSink ircstate = awaitForever $ \event -> do   let event'  = decodeUtf8 <$> event   ignored <- isIgnored ircstate event'@@ -109,7 +108,7 @@     liftIO $ mapM_ (\h -> forkIO $ runReaderT (h event') ircstate) handlers  -- | Check if an event is ignored or not.-isIgnored :: MonadIO m => IRCState -> UnicodeEvent -> m Bool+isIgnored :: MonadIO m => IRCState s -> UnicodeEvent -> m Bool isIgnored ircstate ev = do   iconf <- liftIO . atomically . readTVar . _instanceConfig $ ircstate   let ignoreList = _ignore iconf@@ -121,7 +120,7 @@       Server  _   -> False  -- |Get the event handlers for an event.-getHandlersFor :: Event a -> [EventHandler] -> [UnicodeEvent -> IRC ()]+getHandlersFor :: Event a -> [EventHandler s] -> [UnicodeEvent -> StatefulIRC s ()] getHandlersFor e ehs = [_eventFunc eh | eh <- ehs, _matchType eh `elem` [EEverything, eventType e]]  -- |A conduit which logs everything which goes through it.@@ -151,7 +150,7 @@    appendFile fp $ unwords     [ formatTime defaultTimeLocale "%c" now-    , if origin == FromServer then "<---" else "--->"+    , if origin == FromServer then "--->" else "<---"     , init . tail $ show x     ] @@ -163,12 +162,12 @@  -- | Send a message as UTF-8, using TLS if enabled. This blocks if -- messages are sent too rapidly.-send :: UnicodeMessage -> IRC ()+send :: UnicodeMessage -> StatefulIRC s () send = sendBS . fmap encodeUtf8  -- | Send a message, using TLS if enabled. This blocks if messages are -- sent too rapidly.-sendBS :: IrcMessage -> IRC ()+sendBS :: IrcMessage -> StatefulIRC s () sendBS msg = do   queue <- _sendqueue <$> connectionConfig   liftIO . atomically $ writeTBMChan queue msg@@ -177,7 +176,7 @@  -- | Disconnect from the server, properly tearing down the TLS session -- (if there is one).-disconnect :: IRC ()+disconnect :: StatefulIRC s () disconnect = do   queueS <- _sendqueue <$> connectionConfig @@ -190,7 +189,7 @@   disconnectNow  -- | Disconnect immediately, without waiting for messages to be sent.-disconnectNow :: IRC ()+disconnectNow :: StatefulIRC s () disconnectNow = do   queueS <- _sendqueue <$> connectionConfig   liftIO . atomically $ closeTBMChan queueS

@@ -31,64 +31,87 @@ -- *State  -- | The IRC monad.-type IRC a = ReaderT IRCState IO a+type IRC a = StatefulIRC () a -data IRCState = IRCState { _connectionConfig :: ConnectionConfig-                         -- ^Read-only connection configuration-                         , _instanceConfig   :: TVar InstanceConfig-                         -- ^Mutable instance configuration in STM-                         }+-- | The IRC monad, with state.+type StatefulIRC s a = ReaderT (IRCState s) IO a +data IRCState s = IRCState { _connectionConfig :: ConnectionConfig s+                           -- ^Read-only connection configuration+                           , _userState :: TVar s+                           -- ^Mutable user state+                           , _instanceConfig   :: TVar (InstanceConfig s)+                           -- ^Mutable instance configuration in STM+                           }+ -- | Construct a new IRC state-newIRCState :: MonadIO m => ConnectionConfig -> InstanceConfig -> m IRCState-newIRCState cconf iconf = do-  tvar <- liftIO . atomically . newTVar $ iconf+newIRCState :: MonadIO m => ConnectionConfig s -> InstanceConfig s -> s -> m (IRCState s)+newIRCState cconf iconf ustate = do+  ustvar <- liftIO . atomically . newTVar $ ustate+  ictvar <- liftIO . atomically . newTVar $ iconf    return IRCState     { _connectionConfig = cconf-    , _instanceConfig   = tvar+    , _userState        = ustvar+    , _instanceConfig   = ictvar     } --- | Access the entire state.-ircState :: IRC IRCState+-- | Access the client state.+ircState :: StatefulIRC s (IRCState s) ircState = ask  -- | Extract the connection configuration from an IRC state-getConnectionConfig :: IRCState -> ConnectionConfig+getConnectionConfig :: IRCState s -> ConnectionConfig s getConnectionConfig = _connectionConfig  -- | Extract the instance configuration from an IRC state-getInstanceConfig :: IRCState -> TVar InstanceConfig+getInstanceConfig :: IRCState s -> TVar (InstanceConfig s) getInstanceConfig = _instanceConfig +-- | Extract the user state from an IRC state+getUserState :: IRCState s -> TVar s+getUserState = _userState+ -- | Extract the current snapshot of the instance configuration from -- an IRC state-getInstanceConfig' :: MonadIO m => IRCState -> m InstanceConfig+getInstanceConfig' :: MonadIO m => IRCState s -> m (InstanceConfig s) getInstanceConfig' = liftIO . atomically . readTVar . _instanceConfig  -- | Access the connection config-connectionConfig :: IRC ConnectionConfig+connectionConfig :: StatefulIRC s (ConnectionConfig s) connectionConfig = _connectionConfig <$> ask  -- | Access the instance config TVar-instanceConfigTVar :: IRC (TVar InstanceConfig)+instanceConfigTVar :: StatefulIRC s (TVar (InstanceConfig s)) instanceConfigTVar = _instanceConfig <$> ask  -- | Access the instance config as it is right now.-instanceConfig :: IRC InstanceConfig+instanceConfig :: StatefulIRC s (InstanceConfig s) instanceConfig = instanceConfigTVar >>= liftIO . atomically . readTVar  -- | Overwrite the instance config, even if it has changed since we -- looked at it.-putInstanceConfig :: InstanceConfig -> IRC ()+putInstanceConfig :: InstanceConfig s -> StatefulIRC s () putInstanceConfig iconf = instanceConfigTVar >>= liftIO . atomically . flip writeTVar iconf +-- | Access the user state.+stateTVar :: StatefulIRC s (TVar s)+stateTVar = _userState <$> ask++-- | Access the user state as it is right now.+state :: StatefulIRC s s+state = stateTVar >>= liftIO . atomically . readTVar++-- | Set the user state.+putState :: s -> StatefulIRC s ()+putState s = stateTVar >>= liftIO . atomically . flip writeTVar s+ -- | The origin of a message. data Origin = FromServer | FromClient   deriving (Eq, Read, Show)  -- | The static state of an IRC server connection.-data ConnectionConfig = ConnectionConfig+data ConnectionConfig s = ConnectionConfig   { _func       :: Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ()   -- ^ Function to connect and start the conduits.   , _sendqueue  :: TBMChan IrcMessage@@ -99,14 +122,14 @@   -- ^ The server port.   , _flood      :: NominalDiffTime   -- ^ The minimum time between two adjacent messages.-  , _disconnect :: IRC ()+  , _disconnect :: StatefulIRC s ()   -- ^ Action to run if the remote server closes the connection.   , _logfunc    :: Origin -> ByteString -> IO ()   -- ^ Function to log messages sent to and received from the server.   }  -- | The updateable state of an IRC connection.-data InstanceConfig = InstanceConfig+data InstanceConfig s = InstanceConfig   { _nick     :: Text   -- ^ Client nick   , _username :: Text@@ -117,7 +140,7 @@   -- ^ Current channels   , _ctcpVer  :: Text   -- ^ Response to CTCP VERSION-  , _eventHandlers :: [EventHandler]+  , _eventHandlers :: [EventHandler s]   -- ^ The registered event handlers   , _ignore   :: [(Text, Maybe Text)]   -- ^ List of nicks (optionally restricted to channels) to ignore@@ -136,12 +159,12 @@   deriving (Eq, Show)  -- | A function which handles an event.-data EventHandler = EventHandler+data EventHandler s = EventHandler   { _description :: Text   -- ^ A description of the event handler.   , _matchType   :: EventType   -- ^ Which type to be triggered by-  , _eventFunc   :: UnicodeEvent -> IRC ()+  , _eventFunc   :: UnicodeEvent -> StatefulIRC s ()   -- ^ The function to call.   } 

@@ -13,7 +13,7 @@ -- | Update the nick in the instance configuration and also send an -- update message to the server. This doesn't attempt to resolve nick -- collisions, that's up to the event handlers.-setNick :: Text -> IRC ()+setNick :: Text -> StatefulIRC s () setNick new = do   tvarI <- instanceConfigTVar @@ -25,7 +25,7 @@  -- | Update the channel list in the instance configuration and also -- part the channel.-leaveChannel :: Text -> Maybe Text -> IRC ()+leaveChannel :: Text -> Maybe Text -> StatefulIRC s () leaveChannel chan reason = do   tvarI <- instanceConfigTVar   liftIO . atomically $ delChan tvarI chan@@ -35,13 +35,13 @@ -- | Remove a channel from the list without sending a part command (be -- careful not to let the channel list get out of sync with the -- real-world state if you use it for anything!)-delChan :: TVar InstanceConfig -> Text -> STM ()+delChan :: TVar (InstanceConfig s) -> Text -> STM () delChan tvarI chan = do   iconf <- readTVar tvarI   writeTVar tvarI iconf { _channels = filter (/=chan) $ _channels iconf }  -- | Send a message to the source of an event.-reply :: UnicodeEvent -> Text -> IRC ()+reply :: UnicodeEvent -> Text -> StatefulIRC s () reply ev txt = case _source ev of   Channel c _ -> mapM_ (send . Privmsg c . Right) $ T.lines txt   User n      -> mapM_ (send . Privmsg n . Right) $ T.lines txt

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.2.4.0+version:             0.2.5.0  -- A short (one-line) description of the package. synopsis:            An IRC client library.@@ -77,7 +77,6 @@      -- Compile with -Wall by default   ghc-options:         -Wall-                       -fno-warn-unused-do-bind      -- LANGUAGE extensions used by modules in this package.   -- other-extensions: