diff --git a/Network/IRC/Conduit.hs b/Network/IRC/Conduit.hs --- a/Network/IRC/Conduit.hs +++ b/Network/IRC/Conduit.hs @@ -1,8 +1,16 @@ -{-# LANGUAGE ImpredicativeTypes #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} --- |Conduits for serialising and deserialising IRC messages. +-- | +-- Module : Network.IRC.Conduit +-- Copyright : (c) 2016 Michael Walker +-- License : MIT +-- Maintainer : Michael Walker +-- Stability : experimental +-- Portability : OverloadedStrings, RankNTypes -- +-- Conduits for serialising and deserialising IRC messages. +-- -- The 'Event', 'Message', and 'Source' types are parameterised on the -- underlying representation, and are functors. Decoding and encoding -- only work in terms of 'ByteString's, but the generality is provided @@ -47,7 +55,6 @@ import Control.Applicative ((*>)) import Control.Concurrent (newMVar, takeMVar, putMVar, threadDelay) import Control.Concurrent.Async (Concurrently(..)) -import Control.Exception (catch) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.ByteString (ByteString) @@ -61,9 +68,8 @@ import Data.X509.Validation (FailedReason(..)) import Network.Connection (TLSSettings(..)) import Network.IRC.Conduit.Internal -import Network.TLS (ClientParams(..), ClientHooks(..), Supported(..), TLSException, Version(..), defaultParamsClient) +import Network.TLS (ClientParams(..), ClientHooks(..), Supported(..), Version(..), defaultParamsClient) import Network.TLS.Extra (ciphersuite_all) -import System.IO.Error (catchIOError) -- *Conduits @@ -133,11 +139,11 @@ -> Producer IO IrcMessage -- ^The producer of irc messages -> IO () -ircClient port host = ircWithConn . runTCPClient $ clientSettings port host +ircClient port host = ircWithConn $ runTCPClient $ clientSettings port host -- |Like 'ircClient', but with TLS. ircTLSClient :: Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO () -ircTLSClient port host = ircWithConn . runTLSClient . mangle $ tlsClientConfig port host +ircTLSClient port host = ircWithConn $ runTLSClient $ mangle $ tlsClientConfig port host where -- Override the certificate validation and allowed ciphers. mangle tlsSettings = tlsSettings @@ -159,25 +165,17 @@ return $ filter (`notElem` [UnknownCA, SelfSigned]) res -- |Run the IRC conduits using a provided connection. +-- +-- Starts the connection and concurrently run the initialiser, event +-- consumer, and message sources. Terminates as soon as one throws an +-- exception. ircWithConn :: ((AppData -> IO ()) -> IO ()) -- ^The initialised connection. -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO () -ircWithConn runner start cons prod = (go `catch` raiseTLS) `catchIOError` ignore - where - -- Start the connection and concurrently run the initialiser, - -- event consumer, and message sources: terminating as soon as one - -- throws an exception. - go = runner $ \appdata -> - runConcurrently $ - Concurrently start *> - Concurrently (appSource appdata =$= exceptionalConduit $$ ircDecoder =$ cons) *> - Concurrently (prod $$ ircEncoder =$ appSink appdata) - - -- Ignore all exceptions and just halt. - ignore _ = return () - - -- Rethrow TLS exceptions as IO exceptions - raiseTLS = const . ioError $ userError "TLS exception" :: TLSException -> IO () +ircWithConn runner start cons prod = runner $ \appdata -> runConcurrently $ + Concurrently start + *> Concurrently (appSource appdata =$= exceptionalConduit $$ ircDecoder =$ cons) + *> Concurrently (prod $$ ircEncoder =$ appSink appdata) diff --git a/Network/IRC/Conduit/Internal.hs b/Network/IRC/Conduit/Internal.hs --- a/Network/IRC/Conduit/Internal.hs +++ b/Network/IRC/Conduit/Internal.hs @@ -1,3 +1,13 @@ +-- | +-- Module : Network.IRC.Conduit.Internal +-- Copyright : (c) 2016 Michael Walker +-- License : MIT +-- Maintainer : Michael Walker +-- Stability : experimental +-- Portability : non-portable +-- +-- Internal types and functions for irc-conduit. This module is NOT +-- considered to form part of the public interface of this library. module Network.IRC.Conduit.Internal ( module Network.IRC.Conduit.Internal.Conduits , module Network.IRC.Conduit.Internal.Messages diff --git a/Network/IRC/Conduit/Internal/Conduits.hs b/Network/IRC/Conduit/Internal/Conduits.hs --- a/Network/IRC/Conduit/Internal/Conduits.hs +++ b/Network/IRC/Conduit/Internal/Conduits.hs @@ -1,7 +1,16 @@ -{-# LANGUAGE ImpredicativeTypes #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} --- |Internal helper conduits +-- | +-- Module : Network.IRC.Conduit.Internal.Conduits +-- Copyright : (c) 2016 Michael Walker +-- License : MIT +-- Maintainer : Michael Walker +-- Stability : experimental +-- Portability : OverloadedStrings, RankNTypes +-- +-- Internal helper conduits. This module is NOT considered to form +-- part of the public interface of this library. module Network.IRC.Conduit.Internal.Conduits where import Control.Arrow ((&&&)) diff --git a/Network/IRC/Conduit/Internal/Messages.hs b/Network/IRC/Conduit/Internal/Messages.hs --- a/Network/IRC/Conduit/Internal/Messages.hs +++ b/Network/IRC/Conduit/Internal/Messages.hs @@ -2,7 +2,16 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} --- |Internal IRC conduit types and utilities. +-- | +-- Module : Network.IRC.Conduit.Internal.Messages +-- Copyright : (c) 2016 Michael Walker +-- License : MIT +-- Maintainer : Michael Walker +-- Stability : experimental +-- Portability : DeriveFunctor, OverloadedStrings, TupleSections +-- +-- Internal IRC conduit types and utilities. This module is NOT +-- considered to form part of the public interface of this library. module Network.IRC.Conduit.Internal.Messages where import Control.Applicative ((<$>)) diff --git a/irc-conduit.cabal b/irc-conduit.cabal --- a/irc-conduit.cabal +++ b/irc-conduit.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.2.0 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: Streaming IRC message library using conduits. @@ -67,33 +67,34 @@ library -- Modules exported by the library. exposed-modules: Network.IRC.Conduit - - -- Modules included in this library but not exported. - other-modules: Network.IRC.Conduit.Internal + , Network.IRC.Conduit.Internal , Network.IRC.Conduit.Internal.Conduits , Network.IRC.Conduit.Internal.Messages + -- Modules included in this library but not exported. + -- other-modules: + ghc-options: -Wall -- LANGUAGE extensions used by modules in this package. -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base >=4.5 && <5 - , async >=2.0 - , bytestring >=0.10 - , conduit >=1.2 - , conduit-extra >=1.1 - , connection - , irc >=0.6 - , irc-ctcp >=0.1.1 - , network-conduit-tls >=1.1 - , text >=1.0 - , time >=1.4 - , tls - , transformers >=0.3 - , x509-validation - + build-depends: base >=4.8 && <5 + , async >=2.0 && <2.2 + , bytestring >=0.10 && <0.11 + , conduit >=1.2 && <1.3 + , conduit-extra >=1.1 && <1.2 + , connection >=0.2 && <0.3 + , irc >=0.6 && <0.7 + , irc-ctcp >=0.1.1 && <0.2 + , network-conduit-tls >=1.1 && <1.3 + , text >=1.0 && <1.3 + , time >=1.4 && <1.7 + , tls >=1.3 && <1.4 + , transformers >=0.3 && <0.6 + , x509-validation >=1.6 && <1.7 + -- Directories containing source files. -- hs-source-dirs: @@ -107,4 +108,4 @@ source-repository this type: git location: https://github.com/barrucadu/irc-conduit.git - tag: 0.1.2.0 + tag: 0.2.0.0