irc-conduit 0.1.0.1 → 0.1.1.0
raw patch · 2 files changed
+38/−4 lines, 2 filesdep +connectiondep +textdep +tls
Dependencies added: connection, text, tls, x509-validation
Files
- Network/IRC/Conduit.hs +32/−3
- irc-conduit.cabal +6/−1
Network/IRC/Conduit.hs view
@@ -47,15 +47,22 @@ 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) import Data.Conduit (Conduit, Consumer, Producer, (=$), ($$), (=$=), awaitForever, yield) import Data.Conduit.Network (AppData, clientSettings, runTCPClient, appSource, appSink)-import Data.Conduit.Network.TLS (tlsClientConfig, runTLSClient)+import Data.Conduit.Network.TLS (TLSClientConfig(..), tlsClientConfig, runTLSClient) import Data.Monoid ((<>))+import Data.Text (unpack)+import Data.Text.Encoding (decodeUtf8) import Data.Time.Clock (NominalDiffTime, getCurrentTime, addUTCTime, diffUTCTime)+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.Extra (ciphersuite_all) import System.IO.Error (catchIOError) -- *Conduits@@ -130,8 +137,27 @@ -- |Like 'ircClient', but with TLS. ircTLSClient :: Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ()-ircTLSClient port host = ircWithConn . runTLSClient $ tlsClientConfig port host+ircTLSClient port host = ircWithConn . runTLSClient . mangle $ tlsClientConfig port host+ where+ -- Override the certificate validation and allowed ciphers.+ mangle tlsSettings = tlsSettings+ { tlsClientTLSSettings = TLSSettings cpara+ { clientHooks = (clientHooks cpara)+ { onServerCertificate = validate }+ , clientSupported = (clientSupported cpara)+ { supportedVersions = [TLS12, TLS11, TLS10]+ , supportedCiphers = ciphersuite_all }}}+ where+ cpara = defaultParamsClient (unpack $ decodeUtf8 host) "" + -- Make the TLS certificate validation a bit more generous. In+ -- particular, allow self-signed certificates.+ validate cs vc sid cc = do+ -- First validate with the standard function+ res <- (onServerCertificate $ clientHooks cpara) cs vc sid cc+ -- Then strip out non-issues+ return $ filter (/=SelfSigned) res+ -- |Run the IRC conduits using a provided connection. ircWithConn :: ((AppData -> IO ()) -> IO ()) -- ^The initialised connection.@@ -139,7 +165,7 @@ -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ()-ircWithConn runner start cons prod = go `catchIOError` ignore+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@@ -152,3 +178,6 @@ -- Ignore all exceptions and just halt. ignore _ = return ()++ -- Rethrow TLS exceptions as IO exceptions+ raiseTLS = const . ioError $ userError "TLS exception" :: TLSException -> IO ()
irc-conduit.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.0.1+version: 0.1.1.0 -- A short (one-line) description of the package. synopsis: Streaming IRC message library using conduits.@@ -74,6 +74,7 @@ , Network.IRC.Conduit.Internal.Messages ghc-options: -Wall+ -threaded -- LANGUAGE extensions used by modules in this package. -- other-extensions: @@ -84,11 +85,15 @@ , 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 -- Directories containing source files. -- hs-source-dirs: