Vendor in irc-client

Also:
- Make irc-client decode incoming UTF8 leniently
- Remove some redundant imports
- Switch to GHC 9.4.7

6 files changed, 1287 insertions, 0 deletions

diff --git a/vendor/irc-client/Network/IRC/Client/Events.hs b/vendor/irc-client/Network/IRC/Client/Events.hs
new file mode 100644
index 0000000..c55e055
--- /dev/null
+++ b/vendor/irc-client/Network/IRC/Client/Events.hs
@@ -0,0 +1,328 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+
+-- |
+-- Module      : Network.IRC.Client.Events
+-- Copyright   : (c) 2017 Michael Walker
+-- License     : MIT
+-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
+-- Stability   : experimental
+-- Portability : CPP, OverloadedStrings, RankNTypes
+--
+-- Events and event handlers. When a message is received from the
+-- server, all matching handlers are executed sequentially in the
+-- order that they appear in the 'handlers' list.
+module Network.IRC.Client.Events
+  ( -- * Handlers
+    EventHandler(..)
+  , matchCTCP
+  , matchNumeric
+  , matchType
+  , matchWhen
+
+  -- * Default handlers
+  , defaultEventHandlers
+  , defaultOnConnect
+  , defaultOnDisconnect
+
+  -- ** Individual handlers
+  , pingHandler
+  , kickHandler
+  , ctcpPingHandler
+  , ctcpVersionHandler
+  , ctcpTimeHandler
+  , welcomeNick
+  , joinOnWelcome
+  , joinHandler
+  , nickMangler
+
+  -- * Re-exported
+  , Event(..)
+  , Message(..)
+  , Source(..)
+  , module Network.IRC.Conduit.Lens
+  ) where
+
+import           Control.Applicative         ((<|>))
+import           Control.Concurrent.STM      (atomically, modifyTVar, readTVar)
+import           Control.Monad.Catch         (SomeException, fromException,
+                                              throwM)
+import           Control.Monad.IO.Class      (liftIO)
+import           Data.Char                   (isAlphaNum)
+import           Data.Maybe                  (fromMaybe)
+import           Data.Text                   (Text, breakOn, takeEnd, toUpper)
+import           Data.Time.Clock             (getCurrentTime)
+import           Data.Time.Format            (formatTime)
+import           Network.IRC.Conduit         (Event(..), Message(..),
+                                              Source(..))
+import           Network.IRC.Conduit.Lens
+import           Network.IRC.CTCP            (fromCTCP)
+
+#if MIN_VERSION_time(1,5,0)
+import           Data.Time.Format            (defaultTimeLocale)
+#else
+import           System.Locale               (defaultTimeLocale)
+#endif
+
+import qualified Data.Text                   as T
+
+import           Network.IRC.Client.Internal
+import           Network.IRC.Client.Lens
+import           Network.IRC.Client.Utils
+
+
+-------------------------------------------------------------------------------
+-- Handlers
+
+-- | Match the verb of a CTCP, ignoring case, and returning the arguments.
+--
+-- > matchCTCP "ping"   ":foo PRIVMSG #bar :\001PING\001"          ==> Just []
+-- > matchCTCP "PING"   ":foo PRIVMSG #bar :\001PING\001"          ==> Just []
+-- > matchCTCP "ACTION" ":foo PRIVMSG #bar :\001ACTION dances\001" ==> Just ["dances"]
+matchCTCP :: Text -> Event Text -> Maybe [Text]
+matchCTCP verb ev = case _message ev of
+  Privmsg _ (Left ctcpbs) ->
+    let (v, args) = fromCTCP ctcpbs
+    in if toUpper verb == toUpper v
+       then Just args
+       else Nothing
+  _ -> Nothing
+
+-- | Match a numeric server message. Numeric messages are sent in
+-- response to most things, such as connecting to the server, or
+-- joining a channel.
+--
+-- Numerics in the range 001 to 099 are informative messages, numerics
+-- in the range 200 to 399 are responses to commands. Some common
+-- numerics are:
+--
+--    - 001 (RPL_WELCOME), sent after successfully connecting.
+--
+--    - 331 (RPL_NOTOPIC), sent after joining a channel if it has no
+--      topic.
+--
+--    - 332 (RPL_TOPIC), sent after joining a channel if it has a
+--      topic.
+--
+--    - 432 (ERR_ERRONEUSNICKNAME), sent after trying to change to an
+--      invalid nick.
+--
+--    - 433 (ERR_NICKNAMEINUSE), sent after trying to change to a nick
+--      already in use.
+--
+--    - 436 (ERR_NICKCOLLISION), sent after trying to change to a nick
+--      in use on another server.
+--
+-- See Section 5 of @<https://tools.ietf.org/html/rfc2812#section-5
+-- RFC 2812>@ for a complete list.
+--
+-- > matchNumeric 001 "001 :Welcome to irc.example.com" ==> True
+-- > matchNumeric 332 "332 :#haskell: We like Haskell"  ==> True
+matchNumeric :: Int -> Event a -> Maybe [a]
+matchNumeric num ev = case _message ev of
+  Numeric n args | num == n -> Just args
+  _ -> Nothing
+
+-- | Match events of the given type. Refer to
+-- "Network.IRC.Conduit.Lens#Message" for the list of 'Prism''s.
+--
+-- > matchType _Privmsg ":foo PRIVMSG #bar :hello world" ==> Just ("#bar", Right "hello world")
+-- > matchType _Quit    ":foo QUIT :goodbye world"       ==> Just (Just "goodbye world")
+matchType :: Prism' (Message a) b -> Event a -> Maybe b
+matchType k = preview k . _message
+
+-- | Match a predicate against an event.
+--
+-- > matchWhen (const True) ":foo PRIVMSG #bar :hello world" ==> Just ":foo PRIVMSG :hello world"
+matchWhen :: (Event a -> Bool) -> Event a -> Maybe (Message a)
+matchWhen p ev | p ev = Just (_message ev)
+matchWhen _ _ = Nothing
+
+
+-------------------------------------------------------------------------------
+-- Default handlers
+
+-- | The default event handlers, the following are included:
+--
+-- - respond to server @PING@ messages with a @PONG@;
+-- - respond to CTCP @PING@ requests;
+-- - respond to CTCP @VERSION@ requests with the version string;
+-- - respond to CTCP @TIME@ requests with the system time;
+-- - update the nick upon receiving the welcome message, in case the
+--   server modifies it;
+-- - mangle the nick if the server reports a collision;
+-- - update the channel list on @JOIN@ and @KICK@.
+defaultEventHandlers :: [EventHandler s]
+defaultEventHandlers =
+  [ pingHandler
+  , kickHandler
+  , ctcpPingHandler
+  , ctcpTimeHandler
+  , ctcpVersionHandler
+  , welcomeNick
+  , joinOnWelcome
+  , joinHandler
+  , nickMangler
+  ]
+
+-- | The default connect handler: set the nick.
+defaultOnConnect :: IRC s ()
+defaultOnConnect = do
+  iconf <- snapshot instanceConfig =<< getIRCState
+  send . Nick $ get nick iconf
+
+-- | The default disconnect handler
+--
+--    - If the client disconnected due to a 'Timeout' exception, reconnect.
+--
+--    - If the client disconnected due to another exception, rethrow it.
+--
+--    - If the client disconnected without an exception, halt.
+defaultOnDisconnect :: Maybe SomeException -> IRC s ()
+defaultOnDisconnect (Just exc) = case fromException exc of
+  Just Timeout -> reconnect
+  Nothing -> throwM exc
+defaultOnDisconnect Nothing = pure ()
+
+
+-------------------------------------------------------------------------------
+-- Individual handlers
+
+-- | Respond to server @PING@ messages with a @PONG@.
+pingHandler :: EventHandler s
+pingHandler = EventHandler (matchType _Ping) $ \_ (s1, s2) ->
+  send . Pong $ fromMaybe s1 s2
+
+-- | Respond to CTCP @PING@ requests.
+ctcpPingHandler :: EventHandler s
+ctcpPingHandler = EventHandler (matchCTCP "PING") $ \src args -> case src of
+  User n -> send $ ctcpReply n "PING" args
+  _ -> pure ()
+
+-- | Respond to CTCP @VERSION@ requests with the version string.
+ctcpVersionHandler :: EventHandler s
+ctcpVersionHandler = EventHandler (matchCTCP "VERSION") $ \src _ -> case src of
+  User n -> do
+    ver <- get version <$> (snapshot instanceConfig =<< getIRCState)
+    send $ ctcpReply n "VERSION" [ver]
+  _ -> pure ()
+
+-- | Respond to CTCP @TIME@ requests with the system time.
+ctcpTimeHandler :: EventHandler s
+ctcpTimeHandler = EventHandler (matchCTCP "TIME") $ \src _ -> case src of
+  User n -> do
+    now <- liftIO getCurrentTime
+    send $ ctcpReply n "TIME" [T.pack $ formatTime defaultTimeLocale "%c" now]
+  _ -> pure ()
+
+-- | Update the nick upon welcome (numeric reply 001), as it may not
+-- be what we requested (eg, in the case of a nick too long).
+welcomeNick :: EventHandler s
+welcomeNick = EventHandler (matchNumeric 001) $ \_ args -> case args of
+  (srvNick:_) -> do
+    tvarI <- get instanceConfig <$> getIRCState
+    liftIO . atomically $
+      modifyTVar tvarI (set nick srvNick)
+  [] -> pure ()
+
+-- | Join default channels upon welcome (numeric reply 001). If sent earlier,
+-- the server might reject the JOIN attempts.
+joinOnWelcome :: EventHandler s
+joinOnWelcome = EventHandler (matchNumeric 001) $ \_ _ -> do
+  iconf <- snapshot instanceConfig =<< getIRCState
+  mapM_ (send . Join) $ get channels iconf
+
+-- | Mangle the nick if there's a collision (numeric replies 432, 433,
+-- and 436) when we set it
+nickMangler :: EventHandler s
+nickMangler = EventHandler (\ev -> matcher 432 fresh ev <|> matcher 433 mangle ev <|> matcher 436 mangle ev) $ \_ -> uncurry go
+  where
+    matcher num f ev = case _message ev of
+      Numeric n args | num == n -> Just (f, args)
+      _ -> Nothing
+
+    go f (_:srvNick:_) = do
+      theNick <- get nick <$> (snapshot instanceConfig =<< getIRCState)
+
+      -- If the length of our nick and the server's idea of our nick
+      -- differ, it was truncated - so calculate the allowable length.
+      let nicklen = if T.length srvNick /= T.length theNick
+                    then Just $ T.length srvNick
+                    else Nothing
+
+      setNick . trunc nicklen $ f srvNick
+    go _ _ = return ()
+
+    fresh n = if T.length n' == 0 then "f" else n'
+      where n' = T.filter isAlphaNum n
+
+    mangle n = (n <> "1") `fromMaybe` charsubst n
+
+    -- Truncate a nick, if there is a known length limit.
+    trunc len txt = maybe txt (`takeEnd` txt) len
+
+    -- List of substring substitutions. It's important that these
+    -- don't contain any loops!
+    charsubst = transform [ ("i", "1")
+                          , ("I", "1")
+                          , ("l", "1")
+                          , ("L", "1")
+                          , ("o", "0")
+                          , ("O", "0")
+                          , ("A", "4")
+                          , ("0", "1")
+                          , ("1", "2")
+                          , ("2", "3")
+                          , ("3", "4")
+                          , ("4", "5")
+                          , ("5", "6")
+                          , ("6", "7")
+                          , ("7", "8")
+                          , ("8", "9")
+                          , ("9", "-")
+                          ]
+
+    -- Attempt to transform some text by the substitutions.
+    transform ((from, to):trs) txt = case breakOn' from txt of
+      Just (before, after) -> Just $ before <> to <> after
+      _ -> transform trs txt
+    transform [] _ = Nothing
+
+-- | Upon joining a channel (numeric reply 331 or 332), add it to the
+-- list (if not already present).
+joinHandler :: EventHandler s
+joinHandler = EventHandler (\ev -> matchNumeric 331 ev <|> matchNumeric 332 ev) $ \_ args -> case args of
+  (c:_) -> do
+    tvarI <- get instanceConfig <$> getIRCState
+    liftIO . atomically $
+      modifyTVar tvarI $ \iconf ->
+        (if c `elem` get channels iconf
+          then modify channels (c:)
+          else id) iconf
+  _ -> pure ()
+
+-- | Update the channel list upon being kicked.
+kickHandler :: EventHandler s
+kickHandler = EventHandler (matchType _Kick) $ \src (n, _, _) -> do
+  tvarI <- get instanceConfig <$> getIRCState
+  liftIO . atomically $ do
+    theNick <- get nick <$> readTVar tvarI
+    case src of
+      Channel c _
+        | n == theNick -> delChan tvarI c
+        | otherwise    -> pure ()
+      _ -> pure ()
+
+
+-------------------------------------------------------------------------------
+-- Utils
+
+-- | Break some text on the first occurrence of a substring, removing
+-- the substring from the second portion.
+breakOn' :: Text -> Text -> Maybe (Text, Text)
+breakOn' delim txt = if T.length after >= T.length delim
+                     then Just (before, T.drop (T.length delim) after)
+                     else Nothing
+  where
+    (before, after) = breakOn delim txt
diff --git a/vendor/irc-client/Network/IRC/Client/Internal.hs b/vendor/irc-client/Network/IRC/Client/Internal.hs
new file mode 100644
index 0000000..c56bd57
--- /dev/null
+++ b/vendor/irc-client/Network/IRC/Client/Internal.hs
@@ -0,0 +1,358 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- |
+-- Module      : Network.IRC.Client.Internal
+-- Copyright   : (c) 2016 Michael Walker
+-- License     : MIT
+-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
+-- Stability   : experimental
+-- Portability : CPP, OverloadedStrings, ScopedTypeVariables
+--
+-- Most of the hairy code. This isn't all internal, due to messy
+-- dependencies, but I've tried to make this as \"internal\" as
+-- reasonably possible.
+--
+-- This module is NOT considered to form part of the public interface
+-- of this library.
+module Network.IRC.Client.Internal
+  ( module Network.IRC.Client.Internal
+  , module Network.IRC.Client.Internal.Lens
+  , module Network.IRC.Client.Internal.Types
+  ) where
+
+import           Control.Concurrent                (forkIO, killThread,
+                                                    myThreadId, threadDelay,
+                                                    throwTo)
+import           Control.Concurrent.STM            (STM, atomically, readTVar,
+                                                    readTVarIO, writeTVar)
+import           Control.Concurrent.STM.TBMChan    (TBMChan, closeTBMChan,
+                                                    isClosedTBMChan,
+                                                    isEmptyTBMChan, newTBMChan,
+                                                    readTBMChan, writeTBMChan)
+import           Control.Monad                     (forM_, unless, void, when)
+import           Control.Monad.Catch               (SomeException, catch)
+import           Control.Monad.IO.Class            (MonadIO, liftIO)
+import           Control.Monad.Reader              (ask, runReaderT)
+import           Data.ByteString                   (ByteString, isPrefixOf)
+import           Data.Conduit                      (ConduitM, await,
+                                                    awaitForever, yield, (.|))
+import           Data.IORef                        (IORef, newIORef, readIORef,
+                                                    writeIORef)
+import qualified Data.Set                          as S
+import           Data.Text                         (Text)
+import           Data.Text.Encoding                (decodeUtf8', decodeLatin1,
+                                                    encodeUtf8)
+import           Data.Time.Clock                   (NominalDiffTime, UTCTime,
+                                                    addUTCTime, diffUTCTime,
+                                                    getCurrentTime)
+import           Data.Time.Format                  (formatTime)
+import           Data.Void                         (Void)
+import           Network.IRC.Conduit               (Event(..), Message(..),
+                                                    Source(..), floodProtector,
+                                                    rawMessage, toByteString)
+
+#if MIN_VERSION_time(1,5,0)
+import           Data.Time.Format                  (defaultTimeLocale)
+#else
+import           System.Locale                     (defaultTimeLocale)
+#endif
+
+import           Network.IRC.Client.Internal.Lens
+import           Network.IRC.Client.Internal.Types
+import           Network.IRC.Client.Lens
+
+
+-------------------------------------------------------------------------------
+-- * Configuration
+
+-- | Config to connect to a server using the supplied connection
+-- function.
+setupInternal
+  :: (IO () -> ConduitM (Either ByteString (Event ByteString)) Void IO () -> ConduitM () (Message ByteString) IO () -> IO ())
+  -- ^ Function to start the network conduits.
+  -> IRC s ()
+  -- ^ Connect handler
+  -> (Maybe SomeException -> IRC s ())
+  -- ^ Disconnect handler
+  -> (Origin -> ByteString -> IO ())
+  -- ^ Logging function
+  -> ByteString
+  -- ^ Server hostname
+  -> Int
+  -- ^ Server port
+  -> ConnectionConfig s
+setupInternal f oncon ondis logf host port_ = ConnectionConfig
+  { _func         = f
+  , _username     = "irc-client"
+  , _realname     = "irc-client"
+  , _password     = Nothing
+  , _server       = host
+  , _port         = port_
+  , _flood        = 1
+  , _timeout      = 300
+  , _onconnect    = oncon
+  , _ondisconnect = ondis
+  , _logfunc      = logf
+  }
+
+
+-------------------------------------------------------------------------------
+-- * Event loop
+
+-- | The event loop.
+runner :: IRC s ()
+runner = do
+  state <- getIRCState
+  let cconf = _connectionConfig state
+
+  -- Set the real- and user-name
+  let theUser = get username cconf
+  let theReal = get realname cconf
+  let thePass = get password cconf
+
+  -- Initialise the IRC session
+  let initialise = flip runIRCAction state $ do
+        liftIO . atomically $ writeTVar (_connectionState state) Connected
+        mapM_ (\p -> sendBS $ rawMessage "PASS" [encodeUtf8 p]) thePass
+        sendBS $ rawMessage "USER" [encodeUtf8 theUser, "-", "-", encodeUtf8 theReal]
+        _onconnect cconf
+
+  -- Run the event loop, and call the disconnect handler if the remote
+  -- end closes the socket.
+  antiflood <- liftIO $ floodProtector (_flood cconf)
+
+  -- An IORef to keep track of the time of the last received message, to allow a local timeout.
+  lastReceived <- liftIO $ newIORef =<< getCurrentTime
+
+  squeue <- liftIO . readTVarIO $ _sendqueue state
+
+  let source = sourceTBMChan squeue
+               .| antiflood
+               .| logConduit (_logfunc cconf FromClient . toByteString . concealPass)
+  let sink   = forgetful
+               .| logConduit (_logfunc cconf FromServer . _raw)
+               .| eventSink lastReceived state
+
+  -- Fork a thread to disconnect if the timeout elapses.
+  mainTId <- liftIO myThreadId
+  let time  = _timeout cconf
+  let delayms = 1000000 * round time
+  let timeoutThread = do
+        now <- getCurrentTime
+        prior <- readIORef lastReceived
+        if diffUTCTime now prior >= time
+          then throwTo mainTId Timeout
+          else threadDelay delayms >> timeoutThread
+  timeoutTId <- liftIO (forkIO timeoutThread)
+
+  -- Start the client.
+  (exc :: Maybe SomeException) <- liftIO $ catch
+    (_func cconf initialise sink source >> killThread timeoutTId >> pure Nothing)
+    (pure . Just)
+
+  disconnect
+  _ondisconnect cconf exc
+
+-- | Forget failed decodings.
+forgetful :: Monad m => ConduitM (Either a b) b m ()
+forgetful = awaitForever go where
+  go (Left  _) = return ()
+  go (Right b) = yield b
+
+-- | Block on receiving a message and invoke all matching handlers.
+eventSink :: MonadIO m => IORef UTCTime -> IRCState s -> ConduitM (Event ByteString) o m ()
+eventSink lastReceived ircstate = go where
+  go = await >>= maybe (return ()) (\event -> do
+    -- Record the current time.
+    now <- liftIO getCurrentTime
+    liftIO $ writeIORef lastReceived now
+
+    -- Handle the event.
+    let event' = decodeEncodingIRC <$> event
+    ignored <- isIgnored ircstate event'
+    unless ignored . liftIO $ do
+      iconf <- snapshot instanceConfig ircstate
+      forM_ (get handlers iconf) $ \(EventHandler matcher handler) ->
+        maybe (pure ())
+              (void . flip runIRCAction ircstate . handler (_source event'))
+              (matcher event')
+
+    -- If disconnected, do not loop.
+    disconnected <- liftIO . atomically $ (==Disconnected) <$> getConnectionState ircstate
+    unless disconnected go)
+
+  decodeEncodingIRC :: ByteString -> Text
+  decodeEncodingIRC bs =
+    case decodeUtf8' bs of
+      Left _ -> decodeLatin1 bs
+      Right t -> t
+
+-- | Check if an event is ignored or not.
+isIgnored :: MonadIO m => IRCState s -> Event Text -> m Bool
+isIgnored ircstate ev = do
+  iconf <- liftIO . readTVarIO . _instanceConfig $ ircstate
+  let ignoreList = _ignore iconf
+
+  return $
+    case _source ev of
+      User      n ->  (n, Nothing) `elem` ignoreList
+      Channel c n -> ((n, Nothing) `elem` ignoreList) || ((n, Just c) `elem` ignoreList)
+      Server  _   -> False
+
+-- |A conduit which logs everything which goes through it.
+logConduit :: MonadIO m => (a -> IO ()) -> ConduitM a a m ()
+logConduit logf = awaitForever $ \x -> do
+  -- Call the logging function
+  liftIO $ logf x
+
+  -- And pass the message on
+  yield x
+
+-- | Print messages to stdout, with the current time.
+stdoutLogger :: Origin -> ByteString -> IO ()
+stdoutLogger origin x = do
+  now <- getCurrentTime
+
+  putStrLn $ unwords
+    [ formatTime defaultTimeLocale "%c" now
+    , if origin == FromServer then "<---" else "--->"
+    , init . tail $ show x
+    ]
+
+-- | Append messages to a file, with the current time.
+fileLogger :: FilePath -> Origin -> ByteString -> IO ()
+fileLogger fp origin x = do
+  now <- getCurrentTime
+
+  appendFile fp $ unwords
+    [ formatTime defaultTimeLocale "%c" now
+    , if origin == FromServer then "--->" else "<---"
+    , init . tail $ show x
+    , "\n"
+    ]
+
+-- | Do no logging.
+noopLogger :: a -> b -> IO ()
+noopLogger _ _ = return ()
+
+-- | Clear passwords from logs.
+concealPass :: Message ByteString -> Message ByteString
+concealPass (RawMsg msg)
+  | "PASS " `isPrefixOf` msg = rawMessage "PASS" ["<password redacted>"]
+concealPass m = m
+
+
+-------------------------------------------------------------------------------
+-- * Messaging
+
+-- | Send a message as UTF-8, using TLS if enabled. This blocks if
+-- messages are sent too rapidly.
+send :: Message Text -> IRC s ()
+send = sendBS . fmap encodeUtf8
+
+-- | Send a message, using TLS if enabled. This blocks if messages are
+-- sent too rapidly.
+sendBS :: Message ByteString -> IRC s ()
+sendBS msg = do
+  qv <- _sendqueue <$> getIRCState
+  liftIO . atomically $ flip writeTBMChan msg =<< readTVar qv
+
+
+-------------------------------------------------------------------------------
+-- * Disconnecting
+
+-- | Disconnect from the server, properly tearing down the TLS session
+-- (if there is one).
+disconnect :: IRC s ()
+disconnect = do
+  s <- getIRCState
+
+  liftIO $ do
+    connState <- readTVarIO (_connectionState s)
+    case connState of
+      Connected -> do
+        -- Set the state to @Disconnecting@
+        atomically $ writeTVar (_connectionState s) Disconnecting
+
+        -- Wait for all messages to be sent, or a minute has passed.
+        timeoutBlock 60 . atomically $ do
+          queue <- readTVar (_sendqueue s)
+          (||) <$> isEmptyTBMChan queue <*> isClosedTBMChan queue
+
+        -- Close the chan, which closes the sending conduit, and set
+        -- the state to @Disconnected@.
+        atomically $ do
+          closeTBMChan =<< readTVar (_sendqueue s)
+          writeTVar (_connectionState s) Disconnected
+
+        -- Kill all managed threads. Don't wait for them to terminate
+        -- here, as they might be masking exceptions and not pick up
+        -- the 'Disconnect' for a while; just clear the list.
+        mapM_ (`throwTo` Disconnect) =<< readTVarIO (_runningThreads s)
+        atomically $ writeTVar (_runningThreads s) S.empty
+
+      -- If already disconnected, or disconnecting, do nothing.
+      _ -> pure ()
+
+-- | Disconnect from the server (this will wait for all messages to be
+-- sent, or a minute to pass), and then connect again.
+--
+-- This can be called after the client has already disconnected, in
+-- which case it will just connect again.
+--
+-- Like 'runClient' and 'runClientWith', this will not return until
+-- the client terminates (ie, disconnects without reconnecting).
+reconnect :: IRC s ()
+reconnect = do
+  disconnect
+
+  -- create a new send queue
+  s <- getIRCState
+  liftIO . atomically $
+    writeTVar (_sendqueue s) =<< newTBMChan 16
+
+  runner
+
+
+-------------------------------------------------------------------------------
+-- * Utils
+
+-- | Interact with a client from the outside, by using its 'IRCState'.
+runIRCAction :: MonadIO m => IRC s a -> IRCState s -> m a
+runIRCAction ma = liftIO . runReaderT (runIRC ma)
+
+-- | Access the client state.
+getIRCState :: IRC s (IRCState s)
+getIRCState = ask
+
+-- | Get the connection state from an IRC state.
+getConnectionState :: IRCState s -> STM ConnectionState
+getConnectionState = readTVar . _connectionState
+
+-- | Block until an action is successful or a timeout is reached.
+timeoutBlock :: MonadIO m => NominalDiffTime -> IO Bool -> m ()
+timeoutBlock dt check = liftIO $ do
+  finish <- addUTCTime dt <$> getCurrentTime
+  let wait = do
+        now  <- getCurrentTime
+        cond <- check
+        when (now < finish && not cond) wait
+  wait
+
+-- | A simple wrapper around a TBMChan. As data is pushed into the
+-- channel, the source will read it and pass it down the conduit
+-- pipeline. When the channel is closed, the source will close also.
+--
+-- If the channel fills up, the pipeline will stall until values are
+-- read.
+--
+-- From stm-conduit-3.0.0 (by Clark Gaebel <cg.wowus.cg@gmail.com>)
+sourceTBMChan :: MonadIO m => TBMChan a -> ConduitM () a m ()
+sourceTBMChan ch = loop where
+  loop = do
+    a <- liftIO . atomically $ readTBMChan ch
+    case a of
+      Just x  -> yield x >> loop
+      Nothing -> pure ()
diff --git a/vendor/irc-client/Network/IRC/Client/Internal/Lens.hs b/vendor/irc-client/Network/IRC/Client/Internal/Lens.hs
new file mode 100644
index 0000000..783aa63
--- /dev/null
+++ b/vendor/irc-client/Network/IRC/Client/Internal/Lens.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE RankNTypes #-}
+
+-- |
+-- Module      : Network.IRC.Client.Internal.Lens
+-- Copyright   : (c) 2017 Michael Walker
+-- License     : MIT
+-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
+-- Stability   : experimental
+-- Portability : CPP, ImpredicativeTypes
+--
+-- Types and functions for dealing with optics without depending on
+-- the lens library.
+--
+-- This module is NOT considered to form part of the public interface
+-- of this library.
+module Network.IRC.Client.Internal.Lens where
+
+import           Control.Applicative        (Const(..))
+import           Control.Concurrent.STM     (STM, TVar, atomically, readTVar,
+                                             readTVarIO, writeTVar)
+import           Control.Monad.IO.Class     (MonadIO, liftIO)
+import           Data.Functor.Contravariant (Contravariant)
+import           Data.Functor.Identity      (Identity(..))
+import           Data.Monoid                (First(..))
+import           Data.Profunctor            (Choice)
+
+
+-------------------------------------------------------------------------------
+-- * Internal lens synonyms
+
+-- | See @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Lens.html#t:Lens Control.Lens.Lens.Lens>@.
+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
+
+-- | A @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Type.html#t:Simple Simple>@ 'Lens'.
+type Lens' s a = Lens s s a a
+
+-- | See @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Getter.html#t:Getter Control.Lens.Getter.Getter>@.
+type Getter s a = forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s
+
+-- | See @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Getter.html#t:Getting Control.Lens.Getter.Getting>@.
+type Getting r s a = (a -> Const r a) -> s -> Const r s
+
+-- | See @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Prism.html#t:Prism Control.Lens.Prism.Prism>@.
+type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
+
+-- | A @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Type.html#t:Simple Simple>@ 'Prism'.
+type Prism' s a = Prism s s a a
+
+
+-------------------------------------------------------------------------------
+-- * Utilities
+
+-- | Get a value from a lens.
+{-# INLINE get #-}
+get :: Getting a s a -> s -> a
+get lens = getConst . lens Const
+
+-- | Set a value in a lens.
+{-# INLINE set #-}
+set :: Lens' s a -> a -> s -> s
+set lens a = runIdentity . lens (\_ -> Identity a)
+
+-- | Modify a value in a lens.
+{-# INLINE modify #-}
+modify :: Lens' s a -> (a -> a) -> s -> s
+modify lens f s = let a = get lens s in set lens (f a) s
+
+-- | Read a value from a prism.
+{-# INLINE preview #-}
+preview :: Prism' s a -> s -> Maybe a
+preview lens = getFirst . getConst . lens (Const . First . Just)
+
+
+-------------------------------------------------------------------------------
+-- ** STM
+
+-- | Atomically snapshot some shared state.
+snapshot :: MonadIO m => Getting (TVar a) s (TVar a) -> s -> m a
+snapshot lens = liftIO . readTVarIO . get lens
+
+-- | Atomically snapshot and modify some shared state.
+snapshotModify :: MonadIO m => Lens' s (TVar a) -> (a -> STM (a, b)) -> s -> m b
+snapshotModify lens f s = liftIO . atomically $ do
+  let avar = get lens s
+  a <- readTVar avar
+  (a', b) <- f a
+  writeTVar avar a'
+  pure b
diff --git a/vendor/irc-client/Network/IRC/Client/Internal/Types.hs b/vendor/irc-client/Network/IRC/Client/Internal/Types.hs
new file mode 100644
index 0000000..73fbf14
--- /dev/null
+++ b/vendor/irc-client/Network/IRC/Client/Internal/Types.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+-- |
+-- Module      : Network.IRC.Client.Internal.Types
+-- Copyright   : (c) 2017 Michael Walker
+-- License     : MIT
+-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
+-- Stability   : experimental
+-- Portability : FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses
+--
+-- Internal types. Most of these are re-exported elsewhere as lenses.
+--
+-- This module is NOT considered to form part of the public interface
+-- of this library.
+module Network.IRC.Client.Internal.Types where
+
+import           Control.Applicative            (Alternative)
+import           Control.Concurrent             (ThreadId)
+import           Control.Concurrent.STM         (TVar, atomically, readTVar,
+                                                 readTVarIO, writeTVar)
+import           Control.Concurrent.STM.TBMChan (TBMChan)
+import           Control.Monad                  (MonadPlus)
+import           Control.Monad.Catch            (Exception, MonadCatch,
+                                                 MonadMask, MonadThrow,
+                                                 SomeException)
+import           Control.Monad.IO.Class         (MonadIO, liftIO)
+import           Control.Monad.Reader           (MonadReader, ReaderT, asks)
+import           Control.Monad.State            (MonadState(..))
+import           Data.ByteString                (ByteString)
+import           Data.Conduit                   (ConduitM)
+import qualified Data.Set                       as S
+import           Data.Text                      (Text)
+import           Data.Time.Clock                (NominalDiffTime)
+import           Data.Void                      (Void)
+import           Network.IRC.Conduit            (Event(..), Message, Source)
+
+
+-------------------------------------------------------------------------------
+-- * The IRC monad
+
+-- | The IRC monad.
+newtype IRC s a = IRC { runIRC :: ReaderT (IRCState s) IO a }
+  deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadIO, MonadReader (IRCState s), MonadThrow, MonadCatch, MonadMask)
+
+instance MonadState s (IRC s) where
+  state f = do
+    tvar <- asks _userState
+    liftIO . atomically $ do
+      (a, s) <- f <$> readTVar tvar
+      writeTVar tvar s
+      pure a
+  get = do
+    tvar <- asks _userState
+    liftIO $ readTVarIO tvar
+  put s = do
+    tvar <- asks _userState
+    liftIO $ atomically (writeTVar tvar s)
+
+-------------------------------------------------------------------------------
+-- * State
+
+-- | The state of an IRC session.
+data IRCState s = IRCState
+  { _connectionConfig :: ConnectionConfig s
+  -- ^ Read-only connection configuration
+  , _userState        :: TVar s
+  -- ^ Mutable user state
+  , _instanceConfig   :: TVar (InstanceConfig s)
+  -- ^ Mutable instance configuration in STM
+  , _sendqueue        :: TVar (TBMChan (Message ByteString))
+  -- ^ Message send queue.
+  , _connectionState  :: TVar ConnectionState
+  -- ^ State of the connection.
+  , _runningThreads   :: TVar (S.Set ThreadId)
+  -- ^ Threads which will be killed when the client disconnects.
+  }
+
+-- | The static state of an IRC server connection.
+data ConnectionConfig s = ConnectionConfig
+  { _func       :: IO () -> ConduitM (Either ByteString (Event ByteString)) Void IO () -> ConduitM () (Message ByteString) IO () -> IO ()
+  -- ^ Function to connect and start the conduits.
+  , _server     :: ByteString
+  -- ^ The server host.
+  , _port       :: Int
+  -- ^ The server port.
+  , _username   :: Text
+  -- ^ Client username; sent to the server during the initial set-up.
+  , _realname   :: Text
+  -- ^ Client realname; sent to the server during the initial set-up.
+  , _password   :: Maybe Text
+  -- ^ Client password; sent to the server during the initial set-up.
+  , _flood      :: NominalDiffTime
+  -- ^ The minimum time between two adjacent messages.
+  , _timeout    :: NominalDiffTime
+  -- ^ The maximum time (in seconds) between received messages from
+  -- the server. If no messages arrive from the server for this
+  -- period, the client is sent a 'Timeout' exception and disconnects.
+  , _onconnect  :: IRC s ()
+  -- ^ Action to run after sending the @PASS@ and @USER@ commands to the
+  -- server. The default behaviour is to send the @NICK@ command.
+  , _ondisconnect :: Maybe SomeException -> IRC s ()
+  -- ^ Action to run after disconnecting from the server, both by
+  -- local choice and by losing the connection. This is run after
+  -- tearing down the connection. If the connection terminated due to
+  -- an exception, it is given. The default behaviour is to reconnect
+  -- if a timeout, otherwise rethrow any exception.
+  , _logfunc    :: Origin -> ByteString -> IO ()
+  -- ^ Function to log messages sent to and received from the server.
+  }
+
+-- | The updateable state of an IRC connection.
+data InstanceConfig s = InstanceConfig
+  { _nick     :: Text
+  -- ^ Client nick
+  , _channels :: [Text]
+  -- ^ Current channels: this list both determines the channels to join on
+  -- connect, and is modified by the default event handlers when channels
+  -- are joined or parted.
+  , _version  :: Text
+  -- ^ The version is sent in response to the CTCP \"VERSION\" request by
+  -- the default event handlers.
+  , _handlers :: [EventHandler s]
+  -- ^ The registered event handlers. The order in this list is the
+  -- order in which they are executed.
+  , _ignore   :: [(Text, Maybe Text)]
+  -- ^ List of nicks (optionally restricted to channels) to ignore
+  -- messages from. 'Nothing' ignores globally.
+  }
+
+-- | The state of the connection.
+data ConnectionState = Connected | Disconnecting | Disconnected
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
+
+-- | The origin of a message.
+data Origin = FromServer | FromClient
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
+
+
+-------------------------------------------------------------------------------
+-- * Events
+
+-- | A function which handles an event.
+data EventHandler s where
+  EventHandler
+    :: (Event Text -> Maybe b)
+    -> (Source Text -> b -> IRC s ())
+    -> EventHandler s
+
+
+-------------------------------------------------------------------------------
+-- * Exceptions
+
+-- | Exception thrown to kill the client if the timeout elapses with
+-- nothing received from the server.
+data Timeout = Timeout
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
+
+instance Exception Timeout
+
+-- | Exception thrown to all managed threads when the client
+-- disconnects.
+data Disconnect = Disconnect
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
+
+instance Exception Disconnect
diff --git a/vendor/irc-client/Network/IRC/Client/Lens.hs b/vendor/irc-client/Network/IRC/Client/Lens.hs
new file mode 100644
index 0000000..0afc3f5
--- /dev/null
+++ b/vendor/irc-client/Network/IRC/Client/Lens.hs
@@ -0,0 +1,189 @@
+-- |
+-- Module      : Network.IRC.Client.Lens
+-- Copyright   : (c) 2017 Michael Walker
+-- License     : MIT
+-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
+-- Stability   : experimental
+-- Portability : CPP
+--
+-- 'Lens'es and 'Prism's.
+module Network.IRC.Client.Lens where
+
+import           Control.Concurrent.STM            (TVar)
+import           Control.Monad.Catch               (SomeException)
+import           Data.ByteString                   (ByteString)
+import           Data.Profunctor                   (Choice(right'),
+                                                    Profunctor(dimap))
+import           Data.Text                         (Text)
+import           Data.Time                         (NominalDiffTime)
+
+import           Network.IRC.Client.Internal.Lens
+import           Network.IRC.Client.Internal.Types
+
+{-# ANN module ("HLint: ignore Redundant lambda") #-}
+
+-- CPP seem to dislike the first ' on the RHS…
+-- This style of CPP usage doesn't work with clang, which means won't work on Mac.
+{-
+#define PRIME() '
+
+#define LENS(S,F,A) \
+    {-# INLINE F #-}; \
+    {-| PRIME()Lens' for '_/**/F'. -}; \
+    F :: Lens' S A; \
+    F = \ afb s -> (\ b -> s {_/**/F = b}) <$> afb (_/**/F s)
+
+#define GETTER(S,F,A) \
+    {-# INLINE F #-}; \
+    {-| PRIME()Getter' for '_/**/F'. -}; \
+    F :: Getter S A; \
+    F = \ afb s -> (\ b -> s {_/**/F = b}) <$> afb (_/**/F s)
+
+#define PRISM(S,C,ARG,TUP,A) \
+    {-| PRIME()Prism' for 'C'. -}; \
+    {-# INLINE _/**/C #-}; \
+    _/**/C :: Prism' S A; \
+    _/**/C = dimap (\ s -> case s of C ARG -> Right TUP; _ -> Left s) \
+        (either pure $ fmap (\ TUP -> C ARG)) . right'
+
+-}
+
+-------------------------------------------------------------------------------
+-- * Lenses for 'IRCState'
+
+{-# INLINE connectionConfig #-}
+{-| 'Getter' for '_connectionConfig'. -}
+connectionConfig :: Getter (IRCState s) (ConnectionConfig s)
+connectionConfig = \ afb s -> (\ b -> s {_connectionConfig = b}) <$> afb (_connectionConfig s)
+
+{-# INLINE userState #-}
+{-| 'Lens' for '_userState'. -}
+userState :: Lens' (IRCState s) (TVar s)
+userState = \ afb s -> (\ b -> s {_userState = b}) <$> afb (_userState s)
+
+{-# INLINE instanceConfig #-}
+{-| 'Lens' for '_instanceConfig'. -}
+instanceConfig :: Lens' (IRCState s) (TVar (InstanceConfig s))
+instanceConfig = \ afb s -> (\ b -> s {_instanceConfig = b}) <$> afb (_instanceConfig s)
+
+{-# INLINE connectionState #-}
+{-| 'Lens' for '_connectionState'. -}
+connectionState :: Lens' (IRCState s) (TVar ConnectionState)
+connectionState = \ afb s -> (\ b -> s {_connectionState = b}) <$> afb (_connectionState s)
+
+-------------------------------------------------------------------------------
+-- * Lenses for 'ConnectionConfig'
+
+{-# INLINE server #-}
+{-| 'Getter' for '_server'. -}
+server :: Getter (ConnectionConfig s) ByteString
+server = \ afb s -> (\ b -> s {_server = b}) <$> afb (_server s)
+
+{-# INLINE port #-}
+{-| 'Getter' for '_port'. -}
+port :: Getter (ConnectionConfig s) Int
+port = \ afb s -> (\ b -> s {_port = b}) <$> afb (_port s)
+
+{-# INLINE username #-}
+{-| 'Lens' for '_username'. -}
+username :: Lens' (ConnectionConfig s) Text
+username = \ afb s -> (\ b -> s {_username = b}) <$> afb (_username s)
+
+{-# INLINE realname #-}
+{-| 'Lens' for '_realname'. -}
+realname :: Lens' (ConnectionConfig s) Text
+realname = \ afb s -> (\ b -> s {_realname = b}) <$> afb (_realname s)
+
+{-# INLINE password #-}
+{-| 'Lens' for '_password'. -}
+password :: Lens' (ConnectionConfig s) (Maybe Text)
+password = \ afb s -> (\ b -> s {_password = b}) <$> afb (_password s)
+
+{-# INLINE flood #-}
+{-| 'Lens' for '_flood'. -}
+flood :: Lens' (ConnectionConfig s) NominalDiffTime
+flood = \ afb s -> (\ b -> s {_flood = b}) <$> afb (_flood s)
+
+{-# INLINE timeout #-}
+{-| 'Lens' for '_timeout'. -}
+timeout :: Lens' (ConnectionConfig s) NominalDiffTime
+timeout = \ afb s -> (\ b -> s {_timeout = b}) <$> afb (_timeout s)
+
+{-# INLINE onconnect #-}
+{-| 'Lens' for '_onconnect'. -}
+onconnect :: Lens' (ConnectionConfig s) (IRC s ())
+onconnect = \ afb s -> (\ b -> s {_onconnect = b}) <$> afb (_onconnect s)
+
+{-# INLINE ondisconnect #-}
+{-| 'Lens' for '_ondisconnect'. -}
+ondisconnect :: Lens' (ConnectionConfig s) (Maybe SomeException -> IRC s ())
+ondisconnect = \ afb s -> (\ b -> s {_ondisconnect = b}) <$> afb (_ondisconnect s)
+
+{-# INLINE logfunc #-}
+{-| 'Lens' for '_logfunc'. -}
+logfunc :: Lens' (ConnectionConfig s) (Origin -> ByteString -> IO ())
+logfunc = \ afb s -> (\ b -> s {_logfunc = b}) <$> afb (_logfunc s)
+
+-------------------------------------------------------------------------------
+-- * Lenses for 'InstanceConfig'
+
+{-# INLINE nick #-}
+{-| 'Lens' for '_nick'. -}
+nick :: Lens' (InstanceConfig s) Text
+nick = \ afb s -> (\ b -> s {_nick = b}) <$> afb (_nick s)
+
+{-# INLINE channels #-}
+{-| 'Lens' for '_channels'. -}
+channels :: Lens' (InstanceConfig s) [Text]
+channels = \ afb s -> (\ b -> s {_channels = b}) <$> afb (_channels s)
+
+{-# INLINE version #-}
+{-| 'Lens' for '_version'. -}
+version :: Lens' (InstanceConfig s) Text
+version = \ afb s -> (\ b -> s {_version = b}) <$> afb (_version s)
+
+{-# INLINE handlers #-}
+{-| 'Lens' for '_version'. -}
+handlers :: Lens' (InstanceConfig s) [EventHandler s]
+handlers = \ afb s -> (\ b -> s {_handlers = b}) <$> afb (_handlers s)
+
+{-# INLINE ignore #-}
+{-| 'Lens' for '_ignore'. -}
+ignore :: Lens' (InstanceConfig s) [(Text, Maybe Text)]
+ignore = \ afb s -> (\ b -> s {_ignore = b}) <$> afb (_ignore s)
+
+-------------------------------------------------------------------------------
+-- * Prisms for 'ConnectionState'
+
+{-| 'Prism' for 'Connected'. -}
+{-# INLINE _Connected #-}
+_Connected :: Prism' ConnectionState ()
+_Connected = dimap (\ s -> case s of Connected -> Right (); _ -> Left s)
+    (either pure $ fmap (\ () -> Connected)) . right'
+
+{-| 'Prism' for 'Disconnecting'. -}
+{-# INLINE _Disconnecting #-}
+_Disconnecting :: Prism' ConnectionState ()
+_Disconnecting = dimap (\ s -> case s of Disconnecting -> Right (); _ -> Left s)
+    (either pure $ fmap (\ () -> Disconnecting)) . right'
+
+{-| 'Prism' for 'Disconnected'. -}
+{-# INLINE _Disconnected #-}
+_Disconnected :: Prism' ConnectionState ()
+_Disconnected = dimap (\ s -> case s of Disconnected -> Right (); _ -> Left s)
+    (either pure $ fmap (\ () -> Disconnected)) . right'
+
+-------------------------------------------------------------------------------
+-- * Prisms for 'Origin'
+
+{-| 'Prism' for 'FromServer'. -}
+{-# INLINE _FromServer #-}
+_FromServer :: Prism' Origin ()
+_FromServer = dimap (\ s -> case s of FromServer -> Right (); _ -> Left s)
+    (either pure $ fmap (\ () -> FromServer)) . right'
+
+{-| 'Prism' for 'FromClient'. -}
+{-# INLINE _FromClient #-}
+_FromClient :: Prism' Origin ()
+_FromClient = dimap (\ s -> case s of FromClient -> Right (); _ -> Left s)
+    (either pure $ fmap (\ () -> FromClient)) . right'
diff --git a/vendor/irc-client/Network/IRC/Client/Utils.hs b/vendor/irc-client/Network/IRC/Client/Utils.hs
new file mode 100644
index 0000000..f9833c7
--- /dev/null
+++ b/vendor/irc-client/Network/IRC/Client/Utils.hs
@@ -0,0 +1,156 @@
+-- |
+-- Module      : Network.IRC.Client.Utils
+-- Copyright   : (c) 2016 Michael Walker
+-- License     : MIT
+-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
+-- Stability   : experimental
+-- Portability : portable
+--
+-- Commonly-used utility functions for IRC clients.
+module Network.IRC.Client.Utils
+  ( -- * Nicks
+    setNick
+
+    -- * Channels
+  , leaveChannel
+  , delChan
+
+    -- * Events
+  , addHandler
+  , reply
+  , replyTo
+
+    -- * CTCPs
+  , ctcp
+  , ctcpReply
+
+    -- * Connection state
+  , isConnected
+  , isDisconnecting
+  , isDisconnected
+  , snapConnState
+
+    -- * Concurrency
+  , fork
+
+    -- * Lenses
+  , snapshot
+  , snapshotModify
+  , get
+  , set
+  , modify
+  ) where
+
+import           Control.Concurrent          (ThreadId, forkFinally, myThreadId)
+import           Control.Concurrent.STM      (STM, TVar, atomically, modifyTVar)
+import           Control.Monad.IO.Class      (liftIO)
+import qualified Data.Set                    as S
+import           Data.Text                   (Text)
+import qualified Data.Text                   as T
+import           Network.IRC.Conduit         (Event(..), Message(..),
+                                              Source(..))
+import           Network.IRC.CTCP            (toCTCP)
+
+import           Network.IRC.Client.Internal
+import           Network.IRC.Client.Lens
+
+-------------------------------------------------------------------------------
+-- Nicks
+
+-- | Update the nick in the instance configuration and also send an
+-- update message to the server. This doesn't attempt to resolve nick
+-- collisions, that's up to the event handlers.
+setNick :: Text -> IRC s ()
+setNick new = do
+  tvarI <- get instanceConfig <$> getIRCState
+  liftIO . atomically $
+    modifyTVar tvarI (set nick new)
+  send $ Nick new
+
+
+-------------------------------------------------------------------------------
+-- Channels
+
+-- | Update the channel list in the instance configuration and also
+-- part the channel.
+leaveChannel :: Text -> Maybe Text -> IRC s ()
+leaveChannel chan reason = do
+  tvarI <- get instanceConfig <$> getIRCState
+  liftIO . atomically $ delChan tvarI chan
+  send $ Part chan reason
+
+-- | Remove a channel from the list without sending a part command (be
+-- careful not to let the channel list get out of sync with the
+-- real-world state if you use it for anything!)
+delChan :: TVar (InstanceConfig s) -> Text -> STM ()
+delChan tvarI chan =
+  modifyTVar tvarI (modify channels (filter (/=chan)))
+
+
+-------------------------------------------------------------------------------
+-- Events
+
+-- | Add an event handler
+addHandler :: EventHandler s -> IRC s ()
+addHandler handler = do
+  tvarI <- get instanceConfig <$> getIRCState
+  liftIO . atomically $
+    modifyTVar tvarI (modify handlers (handler:))
+
+-- | Send a message to the source of an event.
+reply :: Event Text -> Text -> IRC s ()
+reply = replyTo . _source
+
+-- | Send a message to the source of an event.
+replyTo :: Source Text -> Text -> IRC s ()
+replyTo (Channel c _) = mapM_ (send . Privmsg c . Right) . T.lines
+replyTo (User n)      = mapM_ (send . Privmsg n . Right) . T.lines
+replyTo _ = const $ pure ()
+
+
+-------------------------------------------------------------------------------
+-- CTCPs
+
+-- | Construct a @PRIVMSG@ containing a CTCP
+ctcp :: Text -> Text -> [Text] -> Message Text
+ctcp t command args = Privmsg t . Left $ toCTCP command args
+
+-- | Construct a @NOTICE@ containing a CTCP
+ctcpReply :: Text -> Text -> [Text] -> Message Text
+ctcpReply t command args = Notice t . Left $ toCTCP command args
+
+
+-------------------------------------------------------------------------------
+-- Connection state
+
+-- | Check if the client is connected.
+isConnected :: IRC s Bool
+isConnected = (==Connected) <$> snapConnState
+
+-- | Check if the client is in the process of disconnecting.
+isDisconnecting :: IRC s Bool
+isDisconnecting = (==Disconnecting) <$> snapConnState
+
+-- | Check if the client is disconnected
+isDisconnected :: IRC s Bool
+isDisconnected = (==Disconnected) <$> snapConnState
+
+-- | Snapshot the connection state.
+snapConnState :: IRC s ConnectionState
+snapConnState = liftIO . atomically . getConnectionState =<< getIRCState
+
+
+-------------------------------------------------------------------------------
+-- Concurrency
+
+-- | Fork a thread which will be thrown a 'Disconnect' exception when
+-- the client disconnects.
+fork :: IRC s () -> IRC s ThreadId
+fork ma = do
+  s <- getIRCState
+  liftIO $ do
+    tid <- forkFinally (runIRCAction ma s) $ \_ -> do
+      tid <- myThreadId
+      atomically $ modifyTVar (_runningThreads s) (S.delete tid)
+    atomically $ modifyTVar (_runningThreads s) (S.insert tid)
+    pure tid