{-# 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 :: 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_

-- | 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 :: 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
          -- this is a partial pattern match, but because I'm the
          -- author of irc-conduit I can do this.
          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 }
                }
              }

-- | Construct a default IRC configuration from a nick
defaultInstanceConfig
  :: Text
  -- ^ The nick
  -> 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   = []
  }


-------------------------------------------------------------------------------
-- 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 :: 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

-- | 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 :: 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


-------------------------------------------------------------------------------
-- 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 :: 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