{-# LANGUAGE OverloadedStrings #-}
module Network.IRC.Client
(
ConnectionConfig
, plainConnection
, TLSConfig(..)
, tlsConnection
, Origin(..)
, stdoutLogger
, fileLogger
, noopLogger
, InstanceConfig
, defaultInstanceConfig
, IRC
, send
, sendBS
, disconnect
, reconnect
, module Network.IRC.Client.Events
, IRCState
, getIRCState
, runIRCAction
, ConnectionState(..)
, getConnectionState
, runClient
, newIRCState
, runClientWith
, Timeout(..)
, U.fork
, Disconnect(..)
, module Network.IRC.Client.Lens
, module Network.IRC.Client.Utils
, C.rawMessage
, C.toByteString
) where
import Control.Concurrent.STM (newTVarIO)
import Control.Concurrent.STM.TBMChan (newTBMChanIO)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString (ByteString)
import qualified Data.Conduit.Network.TLS as TLS
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Version (showVersion)
import qualified Data.X509 as X
import qualified Data.X509.CertificateStore as X
import qualified Data.X509.Validation as X
import Network.Connection as TLS (TLSSettings(..))
import qualified Network.IRC.Conduit as C
import qualified Network.TLS as TLS
import Network.IRC.Client.Events
import Network.IRC.Client.Internal
import Network.IRC.Client.Lens
import Network.IRC.Client.Utils hiding (fork)
import qualified Network.IRC.Client.Utils as U
import qualified Paths_irc_client as Paths
plainConnection
:: ByteString
-> Int
-> ConnectionConfig s
plainConnection :: forall s. ByteString -> Int -> ConnectionConfig s
plainConnection ByteString
host Int
port_ =
forall s.
(IO ()
-> ConduitM (Either ByteString (Event ByteString)) Void IO ()
-> ConduitM () (Message ByteString) IO ()
-> IO ())
-> IRC s ()
-> (Maybe SomeException -> IRC s ())
-> (Origin -> ByteString -> IO ())
-> ByteString
-> Int
-> ConnectionConfig s
setupInternal (Int
-> ByteString
-> IO ()
-> ConduitM (Either ByteString (Event ByteString)) Void IO ()
-> ConduitM () (Message ByteString) IO ()
-> IO ()
C.ircClient Int
port_ ByteString
host) forall s. IRC s ()
defaultOnConnect forall s. Maybe SomeException -> IRC s ()
defaultOnDisconnect forall a b. a -> b -> IO ()
noopLogger ByteString
host Int
port_
data TLSConfig
= WithDefaultConfig ByteString Int
| WithClientConfig TLS.TLSClientConfig
| WithVerifier ByteString Int (X.CertificateStore -> TLS.ValidationCache -> X.ServiceID -> X.CertificateChain -> IO [X.FailedReason])
tlsConnection
:: TLSConfig
-> ConnectionConfig s
tlsConnection :: forall s. TLSConfig -> ConnectionConfig s
tlsConnection (WithDefaultConfig ByteString
host Int
port_) =
forall s.
(IO ()
-> ConduitM (Either ByteString (Event ByteString)) Void IO ()
-> ConduitM () (Message ByteString) IO ()
-> IO ())
-> IRC s ()
-> (Maybe SomeException -> IRC s ())
-> (Origin -> ByteString -> IO ())
-> ByteString
-> Int
-> ConnectionConfig s
setupInternal (Int
-> ByteString
-> IO ()
-> ConduitM (Either ByteString (Event ByteString)) Void IO ()
-> ConduitM () (Message ByteString) IO ()
-> IO ()
C.ircTLSClient Int
port_ ByteString
host) forall s. IRC s ()
defaultOnConnect forall s. Maybe SomeException -> IRC s ()
defaultOnDisconnect forall a b. a -> b -> IO ()
noopLogger ByteString
host Int
port_
tlsConnection (WithClientConfig TLSClientConfig
cfg) =
forall s.
(IO ()
-> ConduitM (Either ByteString (Event ByteString)) Void IO ()
-> ConduitM () (Message ByteString) IO ()
-> IO ())
-> IRC s ()
-> (Maybe SomeException -> IRC s ())
-> (Origin -> ByteString -> IO ())
-> ByteString
-> Int
-> ConnectionConfig s
setupInternal (TLSClientConfig
-> IO ()
-> ConduitM (Either ByteString (Event ByteString)) Void IO ()
-> ConduitM () (Message ByteString) IO ()
-> IO ()
C.ircTLSClient' TLSClientConfig
cfg) forall s. IRC s ()
defaultOnConnect forall s. Maybe SomeException -> IRC s ()
defaultOnDisconnect forall a b. a -> b -> IO ()
noopLogger ByteString
host Int
port_
where
host :: ByteString
host = TLSClientConfig -> ByteString
TLS.tlsClientHost TLSClientConfig
cfg
port_ :: Int
port_ = TLSClientConfig -> Int
TLS.tlsClientPort TLSClientConfig
cfg
tlsConnection (WithVerifier ByteString
host Int
port_ CertificateStore
-> ValidationCache
-> ServiceID
-> CertificateChain
-> IO [FailedReason]
verifier) =
forall s.
(IO ()
-> ConduitM (Either ByteString (Event ByteString)) Void IO ()
-> ConduitM () (Message ByteString) IO ()
-> IO ())
-> IRC s ()
-> (Maybe SomeException -> IRC s ())
-> (Origin -> ByteString -> IO ())
-> ByteString
-> Int
-> ConnectionConfig s
setupInternal (TLSClientConfig
-> IO ()
-> ConduitM (Either ByteString (Event ByteString)) Void IO ()
-> ConduitM () (Message ByteString) IO ()
-> IO ()
C.ircTLSClient' TLSClientConfig
cfg) forall s. IRC s ()
defaultOnConnect forall s. Maybe SomeException -> IRC s ()
defaultOnDisconnect forall a b. a -> b -> IO ()
noopLogger ByteString
host Int
port_
where
cfg :: TLSClientConfig
cfg =
let cfg0 :: TLSClientConfig
cfg0 = Int -> ByteString -> TLSClientConfig
C.defaultTLSConfig Int
port_ ByteString
host
TLS.TLSSettings ClientParams
cTLSSettings = TLSClientConfig -> TLSSettings
TLS.tlsClientTLSSettings TLSClientConfig
cfg0
cHooks :: ClientHooks
cHooks = ClientParams -> ClientHooks
TLS.clientHooks ClientParams
cTLSSettings
in TLSClientConfig
cfg0 { tlsClientTLSSettings :: TLSSettings
TLS.tlsClientTLSSettings = ClientParams -> TLSSettings
TLS.TLSSettings ClientParams
cTLSSettings
{ clientHooks :: ClientHooks
TLS.clientHooks = ClientHooks
cHooks
{ onServerCertificate :: CertificateStore
-> ValidationCache
-> ServiceID
-> CertificateChain
-> IO [FailedReason]
TLS.onServerCertificate = CertificateStore
-> ValidationCache
-> ServiceID
-> CertificateChain
-> IO [FailedReason]
verifier }
}
}
defaultInstanceConfig
:: Text
-> InstanceConfig s
defaultInstanceConfig :: forall s. Text -> InstanceConfig s
defaultInstanceConfig Text
n = InstanceConfig
{ _nick :: Text
_nick = Text
n
, _channels :: [Text]
_channels = []
, _version :: Text
_version = Text -> Text -> Text
T.append Text
"irc-client-" (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
Paths.version)
, _handlers :: [EventHandler s]
_handlers = forall s. [EventHandler s]
defaultEventHandlers
, _ignore :: [(Text, Maybe Text)]
_ignore = []
}
runClient :: MonadIO m
=> ConnectionConfig s
-> InstanceConfig s
-> s
-> m ()
runClient :: forall (m :: * -> *) s.
MonadIO m =>
ConnectionConfig s -> InstanceConfig s -> s -> m ()
runClient ConnectionConfig s
cconf InstanceConfig s
iconf s
ustate = forall (m :: * -> *) s.
MonadIO m =>
ConnectionConfig s -> InstanceConfig s -> s -> m (IRCState s)
newIRCState ConnectionConfig s
cconf InstanceConfig s
iconf s
ustate forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) s. MonadIO m => IRCState s -> m ()
runClientWith
runClientWith :: MonadIO m => IRCState s -> m ()
runClientWith :: forall (m :: * -> *) s. MonadIO m => IRCState s -> m ()
runClientWith = forall (m :: * -> *) s a. MonadIO m => IRC s a -> IRCState s -> m a
runIRCAction forall s. IRC s ()
runner
newIRCState :: MonadIO m
=> ConnectionConfig s
-> InstanceConfig s
-> s
-> m (IRCState s)
newIRCState :: forall (m :: * -> *) s.
MonadIO m =>
ConnectionConfig s -> InstanceConfig s -> s -> m (IRCState s)
newIRCState ConnectionConfig s
cconf InstanceConfig s
iconf s
ustate = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall s.
ConnectionConfig s
-> TVar s
-> TVar (InstanceConfig s)
-> TVar (TBMChan (Message ByteString))
-> TVar ConnectionState
-> TVar (Set ThreadId)
-> IRCState s
IRCState ConnectionConfig s
cconf
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (TVar a)
newTVarIO s
ustate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (TVar a)
newTVarIO InstanceConfig s
iconf
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> IO (TVar a)
newTVarIO forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Int -> IO (TBMChan a)
newTBMChanIO Int
16)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (TVar a)
newTVarIO ConnectionState
Disconnected
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (TVar a)
newTVarIO forall a. Set a
S.empty