diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,13 +1,20 @@ - DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE - Version 2, December 2004 - - Copyright (C) 2004 Sam Hocevar +Copyright (c) 2015, Michael Walker - 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. diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -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 diff --git a/Network/IRC/Client/Handlers.hs b/Network/IRC/Client/Handlers.hs --- a/Network/IRC/Client/Handlers.hs +++ b/Network/IRC/Client/Handlers.hs @@ -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 diff --git a/Network/IRC/Client/Internal.hs b/Network/IRC/Client/Internal.hs --- a/Network/IRC/Client/Internal.hs +++ b/Network/IRC/Client/Internal.hs @@ -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 diff --git a/Network/IRC/Client/Types.hs b/Network/IRC/Client/Types.hs --- a/Network/IRC/Client/Types.hs +++ b/Network/IRC/Client/Types.hs @@ -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. diff --git a/irc-client.cabal b/irc-client.cabal --- a/irc-client.cabal +++ b/irc-client.cabal @@ -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