diff options
Diffstat (limited to 'vendor/irc-client/Network/IRC/Client.hs')
| -rw-r--r-- | vendor/irc-client/Network/IRC/Client.hs | 296 |
1 files changed, 296 insertions, 0 deletions
diff --git a/vendor/irc-client/Network/IRC/Client.hs b/vendor/irc-client/Network/IRC/Client.hs new file mode 100644 index 0000000..abae449 --- /dev/null +++ b/vendor/irc-client/Network/IRC/Client.hs @@ -0,0 +1,296 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.IRC.Client +-- Copyright : (c) 2016 Michael Walker +-- License : MIT +-- Maintainer : Michael Walker <mike@barrucadu.co.uk> +-- Stability : experimental +-- Portability : OverloadedStrings +-- +-- A simple IRC client library. Typical usage will be of this form: +-- +-- > run :: ByteString -> Int -> Text -> IO () +-- > run host port nick = do +-- > let conn = plainConnection host port +-- > let cfg = defaultInstanceConfig nick & handlers %~ (yourCustomEventHandlers:) +-- > runClient conn cfg () +-- +-- You shouldn't really need to tweak anything other than the event +-- handlers, as everything has been designed to be as simple as +-- possible. +module Network.IRC.Client + ( -- * Configuration + + -- | The configuration is logically split into two parts: the + -- /connection/ configuration (the 'ConnectionConfig' type) and the + -- /instance/ configuration (the 'InstanceConfig' type). + -- + -- - Connection configuration details how to connect to the IRC + -- server, and cannot be modified after the client has started + -- (although it can be read). + -- + -- - Instance configuration is everything else: the client's + -- nick, and version, handlers for received messages, and so + -- on. It can be modified after the client has started. + + -- ** Connection configuration + + -- | The following values can be changed with the exported lenses: + -- + -- - 'username' (default: \"irc-client\"). The username sent to + -- the server in the \"USER\" command. + -- + -- - 'realname' (default: \"irc-client\"). The real name sent to + -- the server in the \"USER\" command. + -- + -- - 'password' (default: @Nothing@). If set, the password sent to the + -- server in the \"PASS\" command. + -- + -- - 'flood' (default: @1@). The minimum time between sending + -- messages, to avoid flooding. + -- + -- - 'timeout' (default: @300@). The amount of time to wait for a + -- message from the server before locally timing out. + -- + -- - 'onconnect' (default: 'defaultOnConnect'). The action to + -- perform after sending the \"USER\" and \"PASS\" commands. + -- + -- - 'ondisconnect' (default: 'defaultOnDisconnect'). The action + -- to perform after disconnecting from the server + -- + -- - 'logfunc' (default: 'noopLogger'). The function to log received + -- and sent messages. + + ConnectionConfig + , plainConnection + , TLSConfig(..) + , tlsConnection + + -- *** Logging + + -- | The logging functions are told whether the message came from + -- the server or the client, and are given the raw bytestring. + + , Origin(..) + , stdoutLogger + , fileLogger + , noopLogger + + -- ** Instance configuration + + -- | The following values can be changed with the exported lenses: + -- + -- - 'nick'. The nick that 'defaultOnConnect' sends to the + -- server. This is also modified during runtime by the + -- 'welcomeNick' and 'nickMangler' default event handlers. + -- + -- - 'channels' (default: @[]@). The channels that + -- 'joinOnWelcome' joins. This is also modified during runtime + -- by the 'joinHandler' default event handler. + -- + -- - 'version' (default: \"irc-client-$VERSION\"). The + -- version that 'ctcpVersionHandler' sends. + -- + -- - 'handlers' (default: 'defaultEventHandlers'). The list of + -- event handlers. + -- + -- - 'ignore' (default: @[]@). The ignore list, events from + -- matching nicks are not handled. + + , InstanceConfig + , defaultInstanceConfig + + -- * Writing IRC clients + + -- | With this library, IRC clients are mostly composed of event + -- handlers. Event handlers are monadic actions operating in the + -- 'IRC' monad. + + , IRC + , send + , sendBS + , disconnect + , reconnect + + -- ** From event handlers + + , module Network.IRC.Client.Events + + -- ** From the outside + + -- | The 'ConnectionConfig', 'InstanceConfig', and some other stuff + -- are combined in the 'IRCState' type. This can be used to interact + -- with a client from the outside, by providing a way to run @IRC s + -- a@ actions. + + , IRCState + , getIRCState + , runIRCAction + , ConnectionState(..) + , getConnectionState + + -- * Execution + , runClient + + -- | If an 'IRCState' is constructed with 'newIRCState' and a client + -- started with 'runClientWith', then 'runIRCAction' can be used to + -- interact with that client. + + , newIRCState + , runClientWith + + -- | If the client times out from the server, the 'Timeout' + -- exception will be thrown, killing it. + , Timeout(..) + + -- * Concurrency + + -- | A client can manage a collection of threads, which get thrown + -- the 'Disconnect' exception whenever the client disconnects for + -- any reason (including a call to 'reconnect'). These can be + -- created from event handlers to manage long-running tasks. + , U.fork + , Disconnect(..) + + -- * Lenses + , module Network.IRC.Client.Lens + + -- * Utilities + , 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 +-- I think exporting 'fork' with 'Disconnect' gives better documentation. +import Network.IRC.Client.Utils hiding (fork) +import qualified Network.IRC.Client.Utils as U + +import qualified Paths_irc_client as Paths + + +------------------------------------------------------------------------------- +-- Configuration + +-- | Connect to a server without TLS. +plainConnection + :: ByteString + -- ^ The hostname + -> Int + -- ^ The port + -> ConnectionConfig s +plainConnection host port_ = + setupInternal (C.ircClient port_ host) defaultOnConnect defaultOnDisconnect noopLogger host port_ + +-- | How to connect to a server over TLS. +data TLSConfig + = WithDefaultConfig ByteString Int + -- ^ Use @<http://hackage.haskell.org/package/irc-conduit/docs/Network-IRC-Conduit.html#t:defaultTLSConfig Network.IRC.Conduit.defaultTLSConfig>@. + | WithClientConfig TLS.TLSClientConfig + -- ^ Use the given configuration. The hostname and port are stored + -- as fields of the 'TLS.TLSClientConfig'. + | WithVerifier ByteString Int (X.CertificateStore -> TLS.ValidationCache -> X.ServiceID -> X.CertificateChain -> IO [X.FailedReason]) + -- ^ Use @<http://hackage.haskell.org/package/irc-conduit/docs/Network-IRC-Conduit.html#t:defaultTLSConfig Network.IRC.Conduit.defaultTLSConfig>@, + -- with the given certificate verifier. The certificate verifier is + -- a function which returns a list of reasons to reject the + -- certificate. + +-- | Connect to a server with TLS. +tlsConnection + :: TLSConfig + -- ^ How to initiate the TLS connection + -> ConnectionConfig s +tlsConnection (WithDefaultConfig host port_) = + setupInternal (C.ircTLSClient port_ host) defaultOnConnect defaultOnDisconnect noopLogger host port_ +tlsConnection (WithClientConfig cfg) = + setupInternal (C.ircTLSClient' cfg) defaultOnConnect defaultOnDisconnect noopLogger host port_ + where + host = TLS.tlsClientHost cfg + port_ = TLS.tlsClientPort cfg +tlsConnection (WithVerifier host port_ verifier) = + setupInternal (C.ircTLSClient' cfg) defaultOnConnect defaultOnDisconnect noopLogger host port_ + where + cfg = + let cfg0 = C.defaultTLSConfig port_ host + -- this is a partial pattern match, but because I'm the + -- author of irc-conduit I can do this. + TLS.TLSSettings cTLSSettings = TLS.tlsClientTLSSettings cfg0 + cHooks = TLS.clientHooks cTLSSettings + in cfg0 { TLS.tlsClientTLSSettings = TLS.TLSSettings cTLSSettings + { TLS.clientHooks = cHooks + { TLS.onServerCertificate = verifier } + } + } + +-- | Construct a default IRC configuration from a nick +defaultInstanceConfig + :: Text + -- ^ The nick + -> InstanceConfig s +defaultInstanceConfig n = InstanceConfig + { _nick = n + , _channels = [] + , _version = T.append "irc-client-" (T.pack $ showVersion Paths.version) + , _handlers = defaultEventHandlers + , _ignore = [] + } + + +------------------------------------------------------------------------------- +-- Execution + +-- | Connect to the IRC server and run the client: receiving messages +-- and handing them off to handlers as appropriate. +runClient :: MonadIO m + => ConnectionConfig s + -> InstanceConfig s + -> s + -- ^ The initial value for the user state. + -> m () +runClient cconf iconf ustate = newIRCState cconf iconf ustate >>= runClientWith + +-- | Like 'runClient', but use the provided initial +-- 'IRCState'. +-- +-- Multiple clients should not be run with the same 'IRCState'. The +-- utility of this is to be able to run @IRC s a@ actions in order to +-- interact with the client from the outside. +runClientWith :: MonadIO m => IRCState s -> m () +runClientWith = runIRCAction runner + + +------------------------------------------------------------------------------- +-- State + +-- | Construct a new IRC state +newIRCState :: MonadIO m + => ConnectionConfig s + -> InstanceConfig s + -> s + -- ^ The initial value for the user state. + -> m (IRCState s) +newIRCState cconf iconf ustate = liftIO $ IRCState cconf + <$> newTVarIO ustate + <*> newTVarIO iconf + <*> (newTVarIO =<< newTBMChanIO 16) + <*> newTVarIO Disconnected + <*> newTVarIO S.empty |