packages feed

irc-client 0.2.3.1 → 0.2.4.0

raw patch · 6 files changed

+145/−40 lines, 6 files

Files

LICENSE view
@@ -1,13 +1,20 @@-        DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE -                    Version 2, December 2004 -- Copyright (C) 2004 Sam Hocevar <sam@hocevar.net> +Copyright (c) 2015, Michael Walker <mike@barrucadu.co.uk> - Everyone is permitted to copy and distribute verbatim or modified - copies of this license document, and changing it is allowed as long - as the name is changed. +Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions: -            DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE -   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION +The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software. -  0. You just DO WHAT THE FUCK YOU WANT TO.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Network/IRC/Client.hs view
@@ -19,6 +19,14 @@   , start   , start' +  -- * Logging+  , Origin (..)+  , connect'+  , connectWithTLS'+  , stdoutLogger+  , fileLogger+  , noopLogger+   -- * Interaction   , send   , sendBS@@ -52,12 +60,53 @@ -- * Connecting to an IRC network  -- | Connect to a server without TLS.-connect :: MonadIO m => ByteString -> Int -> NominalDiffTime -> m ConnectionConfig-connect = connect' ircClient defaultDisconnectHandler+connect :: MonadIO m+  => ByteString+  -- ^ The hostname+  -> Int+  -- ^ The port+  -> NominalDiffTime+  -- ^ The flood cooldown+  -> m ConnectionConfig+connect = connect' noopLogger  -- | Connect to a server with TLS.-connectWithTLS :: MonadIO m => ByteString -> Int -> NominalDiffTime -> m ConnectionConfig-connectWithTLS = connect' ircTLSClient defaultDisconnectHandler+connectWithTLS :: MonadIO m+  => ByteString+  -- ^ The hostname+  -> Int+  -- ^ The port+  -> NominalDiffTime+  -- ^ The flood cooldown+  -> m ConnectionConfig+connectWithTLS = connectWithTLS' noopLogger++-- | Connect to a server without TLS, with the provided logging+-- function.+connect' :: MonadIO m+  => (Origin -> ByteString -> IO ())+  -- ^ The message logger+  -> ByteString+  -- ^ The hostname+  -> Int+  -- ^ The port+  -> NominalDiffTime+  -- ^ The flood cooldown+  -> m ConnectionConfig+connect' = connectInternal ircClient defaultDisconnectHandler++-- | Connect to a server with TLS, with the provided logging function.+connectWithTLS' :: MonadIO m+  => (Origin -> ByteString -> IO ())+  -- ^ The message logger+  -> ByteString+  -- ^ The hostname+  -> Int+  -- ^ The port+  -> NominalDiffTime+  -- ^ The flood cooldown+  -> m ConnectionConfig+connectWithTLS' = connectInternal ircTLSClient defaultDisconnectHandler  -- * Starting
Network/IRC/Client/Handlers.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-}  -- | The default event handlers. Handlers are invoked concurrently@@ -31,7 +32,12 @@ import Network.IRC.Client.Types import Network.IRC.Client.Utils import Network.IRC.Client.Internal-import System.Locale          (defaultTimeLocale)++#if MIN_VERSION_time(1,5,0)+import Data.Time.Format (defaultTimeLocale)+#else+import System.Locale    (defaultTimeLocale)+#endif  import qualified Data.Text as T
Network/IRC/Client/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                #-} {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE OverloadedStrings  #-} @@ -20,19 +21,25 @@ import Data.Time.Format           (formatTime) import Network.IRC.Conduit        (IrcEvent, IrcMessage, floodProtector, rawMessage, toByteString) import Network.IRC.Client.Types-import System.Locale              (defaultTimeLocale) +#if MIN_VERSION_time(1,5,0)+import Data.Time.Format (defaultTimeLocale)+#else+import System.Locale    (defaultTimeLocale)+#endif+ -- * Connecting to an IRC network  -- | Connect to a server using the supplied connection function.-connect' :: MonadIO m-         => (Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ())-         -> IRC ()-         -> ByteString-         -> Int-         -> NominalDiffTime-         -> m ConnectionConfig-connect' f dcHandler host port flood = liftIO $ do+connectInternal :: MonadIO m+  => (Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ())+  -> IRC ()+  -> (Origin -> ByteString -> IO ())+  -> ByteString+  -> Int+  -> NominalDiffTime+  -> m ConnectionConfig+connectInternal f dcHandler logf host port flood = liftIO $ do   queueS <- newTBMChanIO 16    return ConnectionConfig@@ -42,6 +49,7 @@     , _port       = port     , _flood      = flood     , _disconnect = dcHandler+    , _logfunc    = logf     }  -- * Event loop@@ -67,16 +75,17 @@   -- end closes the socket.   flood  <- _flood     <$> connectionConfig   func   <- _func      <$> connectionConfig+  logf   <- _logfunc   <$> connectionConfig   port   <- _port      <$> connectionConfig-  server <- _server    <$> connectionConfig   queue  <- _sendqueue <$> connectionConfig+  server <- _server    <$> connectionConfig    antiflood <- liftIO $ floodProtector flood    dchandler <- _disconnect <$> connectionConfig -  let source = toProducer $ sourceTBMChan queue $= antiflood $= logConduit False toByteString-  let sink   = forgetful =$= logConduit True _raw =$ eventSink state+  let source = toProducer $ sourceTBMChan queue $= antiflood $= logConduit (logf FromServer . toByteString)+  let sink   = forgetful =$= logConduit (logf FromClient . _raw) =$ eventSink state    liftIO $ func port server initialise sink source @@ -116,19 +125,39 @@ getHandlersFor e ehs = [_eventFunc eh | eh <- ehs, _matchType eh `elem` [EEverything, eventType e]]  -- |A conduit which logs everything which goes through it.-logConduit :: MonadIO m => Bool -> (a -> ByteString) -> Conduit a m a-logConduit fromsrv f = awaitForever $ \x -> do-  -- Print the log-  liftIO $ do-    now <- getCurrentTime--    putStrLn $ unwords [ formatTime defaultTimeLocale "%c" now-                       , if fromsrv then "<---" else "--->"-                       , init . tail . show $ f x-                       ]+logConduit :: MonadIO m => (a -> IO ()) -> Conduit a m a+logConduit logf = awaitForever $ \x -> do+  -- Call the logging function+  liftIO $ logf x    -- And pass the message on   yield x++-- | Print messages to stdout, with the current time.+stdoutLogger :: Origin -> ByteString -> IO ()+stdoutLogger origin x = do+  now <- getCurrentTime++  putStrLn $ unwords+    [ formatTime defaultTimeLocale "%c" now+    , if origin == FromServer then "<---" else "--->"+    , init . tail $ show x+    ]++-- | Append messages to a file, with the current time.+fileLogger :: FilePath -> Origin -> ByteString -> IO ()+fileLogger fp origin x = do+  now <- getCurrentTime++  appendFile fp $ unwords+    [ formatTime defaultTimeLocale "%c" now+    , if origin == FromServer then "<---" else "--->"+    , init . tail $ show x+    ]++-- | Do no logging.+noopLogger :: a -> b -> IO ()+noopLogger _ _ = return ()  -- * Messaging
Network/IRC/Client/Types.hs view
@@ -83,6 +83,10 @@ putInstanceConfig :: InstanceConfig -> IRC () putInstanceConfig iconf = instanceConfigTVar >>= liftIO . atomically . flip writeTVar iconf +-- | The origin of a message.+data Origin = FromServer | FromClient+  deriving (Eq, Read, Show)+ -- | The static state of an IRC server connection. data ConnectionConfig = ConnectionConfig   { _func       :: Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ()@@ -97,6 +101,8 @@   -- ^ The minimum time between two adjacent messages.   , _disconnect :: IRC ()   -- ^ 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.
irc-client.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.2.3.1+version:             0.2.4.0  -- A short (one-line) description of the package. synopsis:            An IRC client library.@@ -38,7 +38,7 @@ bug-reports:         https://github.com/barrucadu/irc-client/issues  -- The license under which the package is released.-license:             OtherLicense+license:             MIT  -- The file containing the license text. license-file:        LICENSE@@ -89,12 +89,12 @@                      , data-default-class >=0.0.1                      , irc-conduit  >=0.1.1                      , irc-ctcp     >=0.1.2+                     , old-locale   >=1.0                      , stm          >=2.4                      , stm-conduit  >=2.5                      , text         >=1.1                      , time         >=1.4                      , transformers >=0.3-                     , old-locale   >=1.0      -- Directories containing source files.   -- hs-source-dirs:      @@ -102,3 +102,11 @@   -- Base language which the package is written in.   default-language:    Haskell2010   +source-repository head+  type:     git+  location: https://github.com/barrucadu/irc-conduit.git++source-repository this+  type:     git+  location: https://github.com/barrucadu/irc-conduit.git+  tag:      0.2.4.0