irc-core 1.1.5 → 2.0.0.0

raw patch · 34 files changed

+2009/−6978 lines, 34 filesdep +hashabledep +memorydep +primitivedep −arraydep −base64-bytestringdep −config-valuedep ~attoparsecdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, memory, primitive, vector

Dependencies removed: array, base64-bytestring, config-value, connection, containers, data-default-class, deepseq, directory, filepath, free, haskell-lexer, irc-core, network, old-locale, regex-tdfa, split, stm, tls, transformers, vty, x509, x509-store, x509-system, x509-validation

Dependency ranges changed: attoparsec, base, bytestring, lens, text, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +0/−50
• ChangeLog.md +5/−0
• LICENSE +11/−28
• README.md +0/−197
• driver/ClientState.hs +0/−327
• driver/CommandArgs.hs +0/−256
• driver/CommandParser.hs +0/−168
• driver/ConnectCmds.hs +0/−34
• driver/Connection.hs +0/−116
• driver/CtcpHandler.hs +0/−69
• driver/EditBox.hs +0/−187
• driver/HaskellHighlighter.hs +0/−74
• driver/ImageUtils.hs +0/−245
• driver/Main.hs +0/−1085
• driver/Moderation.hs +0/−274
• driver/ServerSettings.hs +0/−28
• driver/Views/BanList.hs +0/−26
• driver/Views/Channel.hs +0/−468
• driver/Views/ChannelInfo.hs +0/−93
• irc-core.cabal +31/−154
• src/Irc/Cmd.hs +0/−451
• src/Irc/Codes.hs +854/−0
• src/Irc/Commands.hs +266/−0
• src/Irc/Core.hs +0/−776
• src/Irc/Core/Prisms.hs +0/−9
• src/Irc/Format.hs +0/−303
• src/Irc/Identifier.hs +80/−0
• src/Irc/Message.hs +267/−83
• src/Irc/Model.hs +0/−1432
• src/Irc/Modes.hs +122/−0
• src/Irc/RateLimit.hs +27/−21
• src/Irc/RawIrcMsg.hs +287/−0
• src/Irc/Time.hs +0/−24
• src/Irc/UserInfo.hs +59/−0

@@ -1,50 +0,0 @@-1.1.5---------* Show effects of control-modifiers inline when composing chat messages-* Show time since last transmitted ping-* Automatically split long chat messages--1.1.4---------* Support host-specific server-certificate sections-* Make message parsing more permissive for use with slack irc bridge-* Fix parsing of INVITE reply message--1.1.3---------* Support for running commands upon connection-* Support for SOCKS5 proxy-* Merge view of all channels (F5)--1.1.2---------* Support multiple nicknames in `/filter`-* Periodically ping to determine ping-times and keep connection alive.-* Added ping time field to IrcConnection datatype.-* Add `/ping` command--1.1.1.1---------* Better error handling-* Added a stack.yaml--1.1.1-------* Add `/grep` filter command--1.1.0.1---------* Fix setting default nick in configuration file-* Dependency version constraint bumps--1.1-----* Better support for Freenode's trailing spaces-* More compact metadata representation-* Ignored messages no longer count toward unread number-* Updated version bounds on lens and attoparsec-* Channel info has user count--1.0-----* Initial hackage release

@@ -0,0 +1,5 @@+# Revision history for irc-core++## 2.0.0.0  -- 2016-08-08++* Extracted from glirc-2.5

@@ -1,30 +1,13 @@-Copyright (c) 2015, Eric Mertens--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.+Copyright (c) 2016 Eric Mertens -    * Neither the name of Eric Mertens nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+Permission to use, copy, modify, and/or distribute this software for any purpose+with or without fee is hereby granted, provided that the above copyright notice+and this permission notice appear in all copies. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF+THIS SOFTWARE.

@@ -1,197 +0,0 @@-My IRC client-=============--[![Build Status](https://secure.travis-ci.org/glguy/irc-core.svg)](http://travis-ci.org/glguy/irc-core)--![](https://raw.githubusercontent.com/wiki/glguy/irc-core/images/screenshot.png)--Library-=======--This package is split into a generic IRC modeling library and a VTY-base text client using that library.--Client Features-===============--* Subsequent joins and parts fold into one line and do not scroll chat messages off the screen-* Ignore support that folds ignored messages into the joins and parts. Toggle it off to see previously hidden messages-* Detailed view to see all the messages in a channel in full detail with hostmask and timestamp (F2)-* Nick tab completion-* SASL authentication-* New message notification-* Customizable mention filter (looks for your nick plus extra search terms)-* View ban, quiet, invex, and exception lists-* Support for rendering/inputing colors and formatting-* Haskell source code highlighting (/hs)-* Write your modifications in Haskell!-* Chanserv automation (automatically requests op from chanserv for privileged commands), automatically deop after 5 minutes of not performing privileged commands.-* Command syntax highlighting with hints.-* Each user's nick is assigned a consistent color, when a user's nick is rendered in a chat message it uses that same color.-* Support for /STATUSMSG/ messages-* Togglable support for merged view of all joined channels (F5).-* Run commands upon connection--TLS-===--I've added TLS support. You can enable it with the `-t` flag. Note that Freenode (and other networks) will allow you to authenticate to NickServ via a client certificate. This is configurable via `--tls-client-cert`.--I use the `x509-store` for decoding certificates and private key files. This library seems to support PEM formatted files and does not seem to support encrypted private key files. If the key and certificate are both contained in the certificate file the private key command line argument is unnecessary.--[Identifying with CERTFP](https://freenode.net/certfp/)--Startup-=======--```-glirc <options> SERVER-  -c FILENAME  --config=FILENAME       Configuration file path (default ~/.glirc/config)-  -p PORT      --port=PORT             IRC Server Port-  -n NICK      --nick=NICK             Nickname-  -u USER      --user=USER             Username-  -r REAL      --real=REAL             Real Name-               --sasl-user=USER        SASL username-  -d FILE      --debug=FILE            Debug log filename-  -i USERINFO  --userinfo=USERINFO     CTCP USERINFO Response-  -t           --tls                   Enable TLS-               --tls-client-cert=PATH  Path to PEM encoded client certificate-               --tls-client-key=PATH   Path to PEM encoded client key-               --tls-insecure          Disable server certificate verification-  -h           --help                  Show help--Environment variables-IRCPASSWORD=<your irc password>-SASLPASSWORD=<your sasl password>-```--Configuration file-=================--A configuration file can currently be used to provide some default values instead of-using command line arguments. If any value is missing the default will be used.--Learn more about this file format at [config-value](http://hackage.haskell.org/package/config-value)--```--- Optional file to dump raw server messages-debug-file: "debug.txt"---- Defaults used when not specified on command line-defaults:-  port:            6667-  nick:            "yournick"-  username:        "yourusername"-  realname:        "Your real name"-  password:        "IRC server password"-  sasl-username:   "sasl_username"-  sasl-password:   "sasl_password"-  userinfo:        "user info string"-  tls:             yes -- or: no-  tls-client-cert: "/path/to/cert.pem"-  tls-client-key:  "/path/to/cert.key"---- Override the defaults when connecting to specific servers-servers:-  * hostname:      "chat.freenode.net"-    sasl-username: "someuser"-    sasl-password: "somepass"-    socks-host:    "socks5.example.com"-    socks-port:    8080 -- defaults to 1080--  * hostname:      "example.com"-    port:          7000-    connect-cmds:-      * "JOIN #favoritechannel,#otherchannel"-      * "PRIVMSG mybot another command"--    -- Specify additional certificates beyond the system CAs-    server-certificates:-      * "/path/to/extra/certificate.pem"--```--Commands-========--* `/exit` - *Exit!*--* `/akb <nick> <message>` - Auto-kickban: Request ops from chanserv if needed, ban by accountname if known, hostname otherwise, kick with message-* `/bans` - Show known bans for current channel. Note: Request bans list with `/quote mode <channel> +b`-* `/channel <channel>` - switch to a user message window-* `/channelinfo` - Show information for the current channel-* `/ctcp <command> <params>` - Send CTCP command to current window-* `/clear` - Clear all messages for the current channel-* `/help <topic>` - Request help from the server-* `/hs <haskell source code>` - Send syntax highlighted source code as a message to the current channel-* `/ignore <nick>` - Toggle ignoring a user by nickname.-* `/join <channel>` - join a new channel (optional key argument)-* `/kick <nick> <msg>` - Kick a user from the current channel-* `/masks <mode>` - Show the bans (b), quiets (q), invex (I), or ban exemptions (e) for a channel. The list must be requested as above.-* `/me <message>` - send an action to the current channel-* `/mode <mode> <arguments>` - Set modes on the current channel-* `/msg <nick> <message>` - send a private message-* `/nick <nick>` - Change your nickname-* `/notice <nick> <message>` - send a notice message-* `/op <nicks>` - Op nicks in the channel, self when no nicks given-* `/deop <nicks>` - Deop nicks in the channel, self when no nicks given-* `/voice <nicks>` - Voice nicks in the channel, self when no nicks given-* `/devoice <nicks>` - Devoice nicks in the channel, self when no nicks given-* `/part <message>` - part the current channel with the given message-* `/query <nick>` - switch to a user message window-* `/quote <raw client command>` - send a client command verbatim-* `/remove <nick> <msg>` - Force a user to part from the current channel-* `/server` - switch to the server message window-* `/topic <topic>` - Change the topic for the current channel-* `/umode <mode>` - Set modes on yourself-* `/window <number>` - Jump to a window by index-* `/whois <nick>` - Query the server for information about a user-* `/whowas <nick>` - Query the server for information about a user who recently disconnected.-* `/stats <letter>` - Request server stat information, try `/help stats` on Freenode first.-* `/admin` - Request some basic admin contact information-* `/away <message>` - Toggle current away status-* `/time` - Request server time-* `/oper` - Enter your OPER credentials-* `/accept` - Add user to the "accept list", try `/help accept` on Freenode-* `/unaccept` - Remove a user from the "accept list"-* `/acceptlist` - List users on accept lists-* `/knock` - Request an /invite/ to a restricted channel-* `/invite <nick>` - Invite the given user to the current channel-* `/reconnect` - Reconnect to the current server-* `/ping` - Send ping to upload current roundtrip time-* `/ping <msg>` - Send manually specified ping message--Filters--* `/filter` - Filter chat messages by space-delimited set of nicknames-* `/grep` - Filter chat messages using a regular expression on the message--Keyboard Shortcuts-==================--* `ESC` quit-* `^N` next channel-* `^P` previous channel-* `M-#` jump to window-* `M-A` jump to activity-* `^A` beginning of line-* `^E` end of line-* `^K` delete to end-* `^U` delete to beginning-* `^D` delete at cursor-* `^W` delete word-* `^Y` paste from yank buffer-* `M-F` forward word-* `M-B` backward word-* `TAB` nickname completion-* `F2` toggle detailed view-* `F3` toggle timestamps-* `F4` toggle compressed metadata-* `F5` toggle all channel view-* `Page Up` scroll up-* `Page Down` scroll down-* `^B` bold-* `^C` color-* `^V` reverse video-* `^_` underline-* `^]` italic-* `^O` reset formatting

@@ -1,327 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE BangPatterns #-}--module ClientState where--import Control.Concurrent (ThreadId)-import Control.Concurrent.STM (TChan, atomically, writeTChan)-import Control.DeepSeq (force)-import Control.Lens-import Control.Monad (foldM, guard, when)-import Data.ByteString (ByteString)-import Data.Char (isControl)-import Data.Foldable (for_)-import Data.Functor.Compose-import Data.IORef-import Data.Map (Map)-import Data.Maybe (fromMaybe)-import Data.Monoid-import Data.Set (Set)-import Data.Text (Text)-import Data.Time (TimeZone, UTCTime)-import Graphics.Vty.Image-import System.IO (Handle)-import qualified Data.ByteString as B-import qualified Data.Map as Map-import qualified Data.Set as Set-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text--#if !MIN_VERSION_base(4,8,0)-import Data.Functor ((<$))-#endif--import Irc.Core-import Irc.Format-import Irc.Message-import Irc.Model--import Connection-import EditBox (EditBox)-import qualified EditBox as Edit-import ImageUtils (cleanText, nameHighlighter)---data ClientConnection = ClientConnection-  { _ccServerSettings :: ServerSettings-  , _ccConnection     :: IrcConnection-  , _ccSendChan       :: Maybe (IORef Bool, TChan ByteString)-  , _ccRecvThread     :: Maybe ThreadId-  , _ccSendThread     :: Maybe ThreadId-  }--data ClientState = ClientState-  -- stuff that will need to be split out for mutiple-  -- servers-  { _clientServer0    :: ClientConnection-  , _clientRecvChan   :: TChan (UTCTime, MsgFromServer)-  , _clientErrors     :: Maybe Handle-  , _clientFocus      :: Focus-  , _clientDetailView :: !Bool-  , _clientTimeView   :: !Bool-  , _clientMetaView   :: !Bool-  , _clientFullView   :: !Bool-  , _clientEditBox    :: EditBox-  , _clientTabPattern :: Maybe String-  , _clientScrollPos :: Int-  , _clientHeight :: Int-  , _clientWidth :: Int-  , _clientIgnores :: !(Set Identifier) -- Todo: support mask matching-  , _clientHighlights :: !(Set ByteString)-  , _clientMessages :: !(Map Identifier MessageList)-  , _clientNickColors :: [Color]-  , _clientAutomation :: [EventHandler]-  , _clientTimers     :: Map UTCTime [TimerEvent]-  , _clientTimeZone   :: TimeZone-  }-  -- TODO: split this record into logical pieces--data TimerEvent-  = DropOperator Identifier-  | TransmitPing-  deriving (Read, Show, Eq)--data MessageList = MessageList-  { _mlNewMessages :: !Int-  , _mlMentioned   :: !Bool-  , _mlMessages    :: [(IrcMessage,Image)]-  }--defaultMessageList :: MessageList-defaultMessageList = MessageList-  { _mlNewMessages = 0-  , _mlMentioned   = False-  , _mlMessages    = []-  }--data Focus-  = ChannelFocus Identifier-  | ChannelInfoFocus Identifier-  | MaskListFocus Char Identifier-  deriving (Eq, Ord, Read, Show)--data EventHandler = EventHandler-  { _evName :: String-  , _evOnEvent :: Identifier -> IrcMessage -> ClientState -> IO ClientState-  }--makeLenses ''ClientState-makeLenses ''MessageList-makeLenses ''EventHandler-makePrisms ''Focus-makePrisms ''TimerEvent-makeLenses ''ClientConnection---resetCurrentChannelMessages :: ClientState -> ClientState-resetCurrentChannelMessages st =-  over (clientMessages . ix (focusedName st))-       ( set mlNewMessages 0-       . set mlMentioned False-       )-       st---- Return the message part of a message which counts--- toward unread message count.-isRelevant :: IrcMessageType -> Maybe Text-isRelevant (PrivMsgType   msg) = Just msg-isRelevant (NoticeMsgType msg) = Just msg-isRelevant (ActionMsgType msg) = Just msg-isRelevant (ErrorMsgType msg)  = Just msg-isRelevant _                   = Nothing---clientInput :: ClientState -> String-clientInput = view (clientEditBox . Edit.content)--clearInput :: ClientState -> ClientState-clearInput-  = clearTabPattern-  . over clientEditBox Edit.success---- | Advance the focus element forward. See 'incrementFocus' for--- details.-nextFocus :: ClientState -> ClientState-nextFocus = incrementFocus nextInSorted---- | Advance the focus element backward. See 'incrementFocus' for--- details.-prevFocus :: ClientState -> ClientState-prevFocus = incrementFocus prevInSorted---- | Jump to a zero-based index in the set of focus targets.-jumpFocus :: Int -> ClientState -> ClientState-jumpFocus i = incrementFocus $ \current targets ->-  if 0 <= i && i < Set.size targets-    then Set.elemAt i targets-    else current---- | Find a channel to jump to that is either marked for mention--- or which has new messages-jumpActivity :: ClientState -> ClientState-jumpActivity st =-  case active of-    []     -> st-    name:_ -> clearTabPattern-            $ set clientScrollPos 0-            $ set clientFocus (ChannelFocus name) st-  where-  active =-    [ name | (name,messages) <- views clientMessages Map.toList st-           , view mlMentioned messages ] ++-    [ name | (name,messages) <- views clientMessages Map.toList st-           , view mlNewMessages messages > 0 ]---- | 'incrementFocus' allows moving forward and backward through--- a sorted list of channel names and query windows. Information--- windows like mask lists and info lists will always transition--- back to the associated message view before moving forward--- and backward. The server message window is placed at the--- beginning of this rotation. In the case of overflow the focus--- wraps around to the other side of the list.-incrementFocus ::-  (Identifier -> Set Identifier -> Identifier) ->-  ClientState -> ClientState-incrementFocus f st-  = clearTabPattern-  $ set clientScrollPos 0-  $ set clientFocus focus' st-  where-  focus' =-    case view clientFocus st of-      ChannelInfoFocus c -> ChannelFocus c-      MaskListFocus _  c -> ChannelFocus c-      ChannelFocus c     -> ChannelFocus (f c focuses)--  focuses = Map.keysSet (fullMessageLists st)--clearTabPattern :: ClientState -> ClientState-clearTabPattern = set clientTabPattern Nothing--clientSend :: ByteString -> ClientState -> IO ()-clientSend x st =-  for_ (view (clientServer0.ccSendChan) st) $ \(connectedRef,chan) ->-    do connected <- readIORef connectedRef-       when connected (atomically (writeTChan chan x))--focusedName :: ClientState -> Identifier-focusedName st =-  case view clientFocus st of-    ChannelInfoFocus c -> c-    MaskListFocus _  c -> c-    ChannelFocus     c -> c--focusedChan :: ClientState -> Maybe Identifier-focusedChan st =-  case view clientFocus st of-    ChannelInfoFocus c -> Just c-    MaskListFocus _  c -> Just c-    ChannelFocus     c-      | isChannelName c (view (clientServer0.ccConnection) st) -> Just c-      | otherwise -> Nothing--addMessage :: Identifier -> IrcMessage -> ClientState -> ClientState-addMessage target message st-  | view (clientServer0 . ccConnection . connNick) st == target =-      over (clientMessages . at (views mesgSender userNick message))-           (Just . aux . fromMaybe defaultMessageList)-           st-  | otherwise =-      over (clientMessages . at target)-           (Just . aux . fromMaybe defaultMessageList)-           st-  where-  conn = view (clientServer0 . ccConnection) st--  isIgnored nick = view (clientIgnores . contains nick) st--  aux = case views mesgType isRelevant message of-          Nothing -> over mlMessages (cons (message,error "unused colored message"))-          Just txt -> updateMessageCount-                    . over mlMessages (cons (message,coloredImage))-            where-            updateMessageCount-              | isIgnored (views mesgSender userNick message) = id-              | otherwise = over mlNewMessages (+1)-                          . over mlMentioned   (|| mention txt || private)--            !coloredImage-              | Text.any isControl txt = cleanText txt-              | otherwise = force -- avoid holding on to old channel lists-                          $ nameHighlighter-                                (Text.encodeUtf8 txt)-                                (views (connChannels . ix target . chanUsers) Map.keysSet conn)-                                (view connNick conn)-                                (view clientNickColors st)--  nickTxt = idDenote (view connNick conn)--  highlights-    = set (contains nickTxt) True-    $ view clientHighlights st--  mention txt =-    or [ B.isInfixOf term (ircFoldCase (Text.encodeUtf8 txt))-       | term <- Set.toList highlights-       ]--  private = isNickName target conn && not (view mesgMe message)--fullMessageLists :: ClientState -> Map Identifier MessageList-fullMessageLists st-   = view clientMessages st-  <> views (clientServer0 . ccConnection . connChannels)-           (defaultMessageList <$)-           st-  <> Map.singleton "" defaultMessageList--runEventHandlers :: Identifier -> IrcMessage -> ClientState -> IO ClientState-runEventHandlers tgt msg st0 = foldM aux st1 hs-  where-  st1 = set clientAutomation [] st0-  hs  = view clientAutomation st0--  aux st h = view evOnEvent h tgt msg st--nextInSorted :: Ord a => a -> Set a -> a-nextInSorted x ys =-  case Set.lookupGT x ys of-    Just y  -> y-    Nothing ->-     case Set.minView ys of-       Just (y,_) -> y-       Nothing    -> x--prevInSorted :: Ord a => a -> Set a -> a-prevInSorted x ys =-  case Set.lookupLT x ys of-    Just y  -> y-    Nothing ->-     case Set.maxView ys of-       Just (y,_) -> y-       Nothing    -> x--nextTimerEvent :: UTCTime -> ClientState -> Maybe (TimerEvent, ClientState)-nextTimerEvent now = alaf Compose clientTimers aux-  where-  aux :: Map UTCTime [TimerEvent] -> Maybe (TimerEvent, Map UTCTime [TimerEvent])-  aux timers =-    do ((trigger,events), timers1) <- Map.minViewWithKey timers-       guard (trigger <= now)-       case events of-         []   -> error "nextTimerEvent: empty entry!"-         [e]  -> return (e, timers1)-         e:es -> return (e, Map.insert trigger es timers1)--filterTimerEvents :: (TimerEvent -> Bool) -> ClientState -> ClientState-filterTimerEvents p = over clientTimers (Map.mapMaybe aux)-  where-  aux xs-    | null xs' = Nothing-    | otherwise = Just xs'-    where xs' = filter p xs--addTimerEvent :: UTCTime -> TimerEvent -> ClientState -> ClientState-addTimerEvent trigger e = over clientTimers (Map.insertWith (++) trigger [e])

@@ -1,256 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}-module CommandArgs where--import Config-import Config.Lens-import Control.Applicative-import Control.Exception-import Control.Monad (when, unless)-import Data.Foldable (traverse_)-import Data.Maybe-import Data.List (foldl')-import Data.Text (Text)-import Data.Text.Lens (unpacked)-import Data.Version (showVersion)-import Network.Socket (PortNumber)-import System.Console.GetOpt-import System.Directory-import System.Environment-import System.Exit-import System.FilePath-import System.IO-import System.IO.Error-import Control.Lens-import qualified Data.Text as Text-import qualified Data.Text.IO as Text--import ServerSettings-import Paths_irc_core--defaultSocksPort :: PortNumber-defaultSocksPort = 1080--defaultConfigPath :: IO FilePath-defaultConfigPath =-  do dir <- getAppUserDataDirectory "glirc"-     return (dir </> "config")--data CommandArgs = CommandArgs-  { _cmdArgNick     :: Maybe String-  , _cmdArgServer   :: String-  , _cmdArgPort     :: Maybe Int-  , _cmdArgHelp     :: Bool-  , _cmdArgVersion  :: Bool-  , _cmdArgReal     :: Maybe String-  , _cmdArgUser     :: Maybe String-  , _cmdArgSaslUser :: Maybe String-  , _cmdArgDebug    :: Maybe FilePath-  , _cmdArgUserInfo :: Maybe String-  , _cmdArgTls      :: Bool-  , _cmdArgTlsClientCert :: Maybe FilePath-  , _cmdArgTlsClientKey  :: Maybe FilePath-  , _cmdArgTlsInsecure   :: Bool-  , _cmdArgConfigFile :: Maybe FilePath-  , _cmdArgConfigValue:: Value-  }--makeLenses ''CommandArgs--emptyCommandArgs :: CommandArgs-emptyCommandArgs = CommandArgs-  { _cmdArgServer   = ""-  , _cmdArgReal     = Nothing-  , _cmdArgUser     = Nothing-  , _cmdArgNick     = Nothing-  , _cmdArgUserInfo = Nothing--  , _cmdArgSaslUser = Nothing-  , _cmdArgPort     = Nothing-  , _cmdArgHelp     = False-  , _cmdArgVersion  = False-  , _cmdArgDebug    = Nothing-  , _cmdArgTls      = False-  , _cmdArgTlsClientCert = Nothing-  , _cmdArgTlsClientKey  = Nothing-  , _cmdArgTlsInsecure   = False-  , _cmdArgConfigFile    = Nothing-  , _cmdArgConfigValue   = Sections []-  }--getCommandArgs :: IO CommandArgs-getCommandArgs =-  do args <- getArgs--     let (flags, servers, errors) = getOpt Permute optDescrs args-         r = foldl' (\acc f -> f acc) emptyCommandArgs flags--     when (view cmdArgHelp r) help-     when (view cmdArgVersion r) emitVersion-     unless (null errors) $-       do traverse_ (hPutStrLn stderr) errors-          exitFailure-     server <- case servers of-       [server] -> return server-       [] -> do hPutStrLn stderr "Expected server name argument (try --help)"-                exitFailure-       _  -> do hPutStrLn stderr "Too many server name arguments (try --help)"-                exitFailure--     v <- loadConfigValue (view cmdArgConfigFile r)--     return $ set cmdArgServer server-            $ set cmdArgConfigValue v-            $ r--help :: IO a-help =-  do prog <- getProgName-     let txt = prog ++ " <options> SERVER"-     hPutStr stderr (usageInfo txt optDescrs)-     exitFailure--emitVersion :: IO a-emitVersion =-  do putStrLn ("glirc " ++ showVersion version)-     exitSuccess--optDescrs :: [OptDescr (CommandArgs -> CommandArgs)]-optDescrs =-  [ Option "c" [ "config"]   (ReqArg (set cmdArgConfigFile . Just) "FILENAME") "Configuration file path (default ~/.glirc/config)"-  , Option "p" [ "port"]     (ReqArg (set cmdArgPort     . Just . read) "PORT") "IRC Server Port"-  , Option "n" [ "nick"]     (ReqArg (set cmdArgNick     . Just) "NICK") "Nickname"-  , Option "u" [ "user"]     (ReqArg (set cmdArgUser     . Just) "USER") "Username"-  , Option "r" [ "real"]     (ReqArg (set cmdArgReal     . Just) "REAL") "Real Name"-  , Option ""  ["sasl-user"] (ReqArg (set cmdArgSaslUser . Just) "USER") "SASL username"-  , Option "d" [ "debug"]    (ReqArg (set cmdArgDebug    . Just) "FILE") "Debug log filename"-  , Option "i" [ "userinfo"] (ReqArg (set cmdArgUserInfo . Just) "USERINFO") "CTCP USERINFO Response"-  , Option "t" [ "tls"]      (NoArg  (set cmdArgTls True)) "Enable TLS"-  , Option ""  [ "tls-client-cert"] (ReqArg (set cmdArgTlsClientCert . Just) "PATH") "Path to PEM encoded client certificate"-  , Option ""  [ "tls-client-key"] (ReqArg (set cmdArgTlsClientKey . Just) "PATH") "Path to PEM encoded client key"-  , Option ""  [ "tls-insecure"] (NoArg (set cmdArgTlsInsecure True)) "Disable server certificate verification"-  , Option "v" [ "version"]   (NoArg  (set cmdArgVersion True))   "Show version"-  , Option "h" [ "help"]      (NoArg  (set cmdArgHelp True))   "Show help"-  ]--initialServerSettings :: CommandArgs -> IO ServerSettings-initialServerSettings !args =-  do env  <- getEnvironment-     let username     = fromMaybe "" (lookup "USER" env)-         password     = lookup "IRCPASSWORD" env-         saslpassword = lookup "SASLPASSWORD" env-         nick         = fromMaybe username-                           (view cmdArgNick args <|> defaultStr hostTxt "nick" args)-         hostTxt      = Text.pack (view cmdArgServer args)--     return ServerSettings-       { _ssNick           = nick-       , _ssUser           = fromMaybe username-                           $ view cmdArgUser args-                         <|> defaultStr hostTxt "username" args--       , _ssReal           = fromMaybe username-                           $ view cmdArgReal args-                         <|> defaultStr hostTxt "realname" args--       , _ssUserInfo       = fromMaybe username-                           $ view cmdArgUserInfo args-                         <|> defaultStr hostTxt "userinfo" args--       , _ssPassword       = password-                         <|> defaultStr hostTxt "password" args--       , _ssSaslCredential = (saslpassword <|> defaultStr hostTxt "sasl-password" args)-                         <&> \p -> (fromMaybe nick (view cmdArgSaslUser args-                                                <|> defaultStr hostTxt "sasl-username" args), p)--       , _ssHostName       = view cmdArgServer args--       , _ssPort           = fromIntegral <$> view cmdArgPort args-                         <|> fromIntegral <$> defaultNum hostTxt "port" args--       , _ssTls            = view cmdArgTls args-                          || fromMaybe False (defaultBool hostTxt "tls" args)--       , _ssTlsInsecure    = view cmdArgTlsInsecure args--       , _ssTlsClientCert  = view cmdArgTlsClientCert args-                         <|> defaultStr hostTxt "tls-client-cert" args--       , _ssTlsClientKey   = view cmdArgTlsClientKey args-                         <|> defaultStr hostTxt "tls-client-key" args--       , _ssConnectCmds   = toListOf (cmdArgConfigValue . configPath hostTxt "connect-cmds"-                                     . values . text) args--       , _ssSocksProxy    = do h <- defaultStr hostTxt "socks-host" args-                               let p = maybe defaultSocksPort fromIntegral-                                     $ defaultNum hostTxt "socks-port" args-                               return (h,p)--       , _ssServerCerts   = toListOf-                              ( cmdArgConfigValue-                              . configPath hostTxt "server-certificates"-                              . values . text . unpacked-                              ) args-       }---loadConfigValue :: Maybe FilePath -> IO Value-loadConfigValue mbFp =-  case mbFp of-    Just fp -> process fp-    Nothing ->-      do fp <- defaultConfigPath-         process fp-           `catch` \e ->-           if isDoesNotExistError e-             then return emptyConfig-             else throwIO e-  where-  emptyConfig = Sections []--  process fp =-    do raw <- Text.readFile fp-       case parse raw of-         Right v -> return v-         Left errMsg ->-           do hPutStrLn stderr "Configuration error"-              hPutStrLn stderr (fp ++ ":" ++ errMsg)-              exitFailure---- | Apply a function to the 'Bool' contained inside the given--- 'Value' when it is a @Bool@.-bool :: Applicative f => (Bool -> f Bool) -> Value -> f Value-bool = atom . _Bool---- | Map 'True' to @"yes"@ and 'False' to @"no"@-_Bool :: Prism' Atom Bool-_Bool = prism'-          (\b -> if b then "yes" else "no")-          (\a -> case a of-                   "yes" -> Just True-                   "no"  -> Just False-                   _     -> Nothing)----------------------------------------------------------------------------- Look up settings for a given server from the config---------------------------------------------------------------------------hostnameMatch :: Text -> Value -> Bool-hostnameMatch = elemOf (key "hostname" . text)--configPath :: (Applicative f, Contravariant f) => Text -> Text -> LensLike' f Value Value-configPath hostname name =-  failing (key "servers" . values . filtered (hostnameMatch hostname) . key name)-          (key "defaults" . key name)--defaultStr :: Text -> Text -> CommandArgs -> Maybe String-defaultStr  hostname i = preview (cmdArgConfigValue . configPath hostname i . text . unpacked)--defaultBool :: Text -> Text -> CommandArgs -> Maybe Bool-defaultBool hostname i = preview (cmdArgConfigValue . configPath hostname i . bool)--defaultNum :: Text -> Text -> CommandArgs -> Maybe Integer-defaultNum  hostname i = preview (cmdArgConfigValue . configPath hostname i . number)

@@ -1,168 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module CommandParser-  ( Parser-  , runParser-  , pChannel-  , pNick-  , pRemaining-  , pRemainingNoSp-  , pRemainingNoSpLimit-  , pToken-  , pValidToken-  , pTarget-  , pChar-  , pSatisfy-  , pHaskell-  , pAnyChar-  , pNumber-  , commandsParser-  , many'-  ) where--import Data.Char-import Data.List (find)-import Text.Read (readMaybe)-import Control.Monad-import Control.Lens-import Control.Applicative-import Graphics.Vty.Image hiding ((<|>))-import qualified Graphics.Vty.Image as Vty-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text--import ClientState-import Irc.Model-import Irc.Format-import HaskellHighlighter-import ImageUtils---newtype Parser a = Parser (String -> (String, Image, Maybe a))-  deriving (Functor)--runParser :: Parser a -> String -> (Image, Maybe a)-runParser (Parser p) s-  | all isSpace rest = (img Vty.<|> stringWithControls defAttr rest, res)-  | otherwise = (img Vty.<|> stringWithControls (withForeColor defAttr red) rest, Nothing)-  where-  (rest,img,res) = p s--instance Applicative Parser where-  pure x = Parser (\s -> (s,emptyImage,Just x))-  Parser f <*> Parser x = Parser (\s -> case f s of-                                          (s1,i1,r1) ->-                                             case x s1 of-                                               (s2,i2,r2) ->-                                                 (s2,i1 Vty.<|> i2,r1<*>r2))--instance Alternative Parser where-  empty = Parser (\s -> (s,emptyImage,Nothing))-  Parser x <|> Parser y = Parser $ \s ->-    case (x s,y s) of-      (rx@(_,_,Just{}),_) -> rx-      (_,ry@(_,_,Just{})) -> ry-      (rx,_) -> rx--pAnyChar :: Parser Char-pAnyChar = pValidToken "character" $ \t ->-  case t of-    [x] -> Just x-    _   -> Nothing--pValidToken :: String -> (String -> Maybe a) -> Parser a-pValidToken name validate = Parser $ \s ->-  let (w,s1) = span (==' ') s-      (t,s2) = break (==' ') s1-      img c  = stringWithControls (withForeColor defAttr c) (w ++ t)-  in if null t-       then ("", char defAttr ' ' Vty.<|>-                 stringWithControls (withStyle defAttr reverseVideo) name Vty.<|>-                 stringWithControls defAttr (drop (length name + 1) w)-              , Nothing)-       else case validate t of-              Just x -> (s2, img green, Just x)-              Nothing -> (s2, img red, Nothing)--pToken :: String -> Parser String-pToken name = pValidToken name Just--pRemaining :: Parser String-pRemaining = Parser (\s -> ("", stringWithControls defAttr s, Just s))--pRemainingNoSp :: Parser String-pRemainingNoSp = fmap (dropWhile isSpace) pRemaining--pRemainingNoSpLimit :: Int -> Parser String-pRemainingNoSpLimit len =-  Parser (\s ->-    let (w,s') = span (==' ') s-        (a,b) = splitAt len (dropWhile isSpace s')-    in if null b then ("", stringWithControls defAttr (w++a), Just a)-                 else ("", stringWithControls defAttr (w++a) Vty.<|>-                           stringWithControls (withForeColor defAttr red) b, Nothing))--pChannel :: ClientState -> Parser Identifier-pChannel st = pValidToken "channel" $ \chan ->-  do let ident = asIdentifier chan-     guard (isChannelName ident (view (clientServer0 . ccConnection) st))-     return ident--pTarget :: Parser Identifier-pTarget = pValidToken "target" (Just . asIdentifier)--pNick :: ClientState -> Parser Identifier-pNick st = pValidToken "nick" $ \nick ->-  do let ident = asIdentifier nick-     guard (isNickName ident (view (clientServer0 . ccConnection) st))-     return ident--asIdentifier :: String -> Identifier-asIdentifier = mkId . Text.encodeUtf8 . Text.pack--pChar :: Char -> Parser Char-pChar c = pSatisfy [c] (== c)--pSatisfy :: String -> (Char -> Bool) -> Parser Char-pSatisfy name f = Parser (\s ->-          case s of-            c1:s1 | f c1 -> (s1, char defAttr c1, Just c1)-                  | otherwise -> (s1, emptyImage, Nothing)-            [] -> (s, string (withStyle defAttr reverseVideo) (' ':name), Nothing))--pHaskell :: Parser String-pHaskell = Parser (\s ->-            ("", cleanText (Text.pack (highlightHaskell s)),-                        Just (drop 1 (highlightHaskell s))))--commandsParser ::-  String ->-  [(String, [String], Parser a)] ->-  (Image, Maybe a)-commandsParser input cmds =-  case find matchCommand cmds of-    Just p -> over _1 (\img -> char defAttr '/' Vty.<|>-                               stringWithControls (withForeColor defAttr yellow) cmd Vty.<|>-                               img)-                      (runParser (view _3 p) rest)--    Nothing -> ( char defAttr '/' Vty.<|>-                 stringWithControls (withForeColor defAttr red) (drop 1 input)-               , Nothing)-  where-  (cmd,rest) = break (==' ') (drop 1 input)-  matchCommand (c,cs,_) = cmd `elem` c:cs---- | Many parser that works in this infinite model--- NOTE: MUST BE END OF PARSER!-many' :: Parser a -> Parser [a]-many' p = [] <$ pEnd-      <|> liftA2 (:) p (many' p)--pEnd :: Parser ()-pEnd = Parser (\s ->-          if all isSpace s then ("", string defAttr s, Just ())-                           else (s , emptyImage      , Nothing))--pNumber :: Parser Int-pNumber = pValidToken "number" readMaybe

@@ -1,34 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module ConnectCmds (connectCmds) where--import Control.Lens-import Data.Foldable (for_)-import Data.Text.Encoding-import Data.Monoid ((<>))--import Irc.Message-import Irc.Format-import ClientState-import ServerSettings--connectCmds :: EventHandler-connectCmds = EventHandler-  { _evName = "connect commands"-  , _evOnEvent = handler-  }--handler :: Identifier -> IrcMessage -> ClientState -> IO ClientState--handler ident mesg st-  | ident == ""-  , views mesgSender userNick mesg == "Welcome" =-      do let cmds = view (clientServer0 . ccServerSettings . ssConnectCmds) st-         for_ cmds $ \cmd ->-           clientSend (encodeUtf8 cmd<>"\r\n") st-         return st--  | otherwise = return (reschedule st)---- Reschedule the autojoin handler for the next message-reschedule :: ClientState -> ClientState-reschedule = over clientAutomation (cons connectCmds)

@@ -1,116 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | This module is responsible for creating 'Connection' values--- for a particular server as specified by its 'ServerSettings'-module Connection-  ( -- * Settings-    ServerSettings(..)-  , ssHostName-  , ssPort-  , ssTls-  , ssTlsClientCert-  , ssTlsClientKey--  -- * Operations-  , connect-  , getRawIrcLine-  ) where--import Control.Lens-import Data.ByteString    (ByteString)-import Data.Default.Class (def)-import Data.Maybe         (fromMaybe)-import Data.Monoid        ((<>))-import Data.X509          (CertificateChain(..))-import Data.X509.CertificateStore (CertificateStore, makeCertificateStore)-import Data.X509.File     (readSignedObject, readKeyFile)-import Network.Connection-import Network.Socket     (PortNumber)-import Network.TLS-import Network.TLS.Extra  (ciphersuite_strong)-import System.X509        (getSystemCertificateStore)-import qualified Data.ByteString.Char8 as B8--import ServerSettings---- | This behaves like 'connectionGetLine' but it strips off the @'\r'@--- IRC calls for 512 byte packets  I rounded off to 1024.-getRawIrcLine :: Connection -> IO ByteString-getRawIrcLine h =-  do b <- connectionGetLine 1024 h-     return (if B8.null b then b else B8.init b)-        -- empty lines will still fail, just later and nicely--buildConnectionParams :: ServerSettings -> IO ConnectionParams-buildConnectionParams args =-  do useSecure <- if view ssTls args-                     then fmap Just (buildTlsSettings args)-                     else return Nothing--     let proxySettings = fmap (uncurry SockSettingsSimple)-                              (view ssSocksProxy args)--     return ConnectionParams-       { connectionHostname  = view ssHostName args-       , connectionPort      = ircPort args-       , connectionUseSecure = useSecure-       , connectionUseSocks  = proxySettings-       }--ircPort :: ServerSettings -> PortNumber-ircPort args =-  case view ssPort args of-    Just p -> fromIntegral p-    Nothing | view ssTls args -> 6697-            | otherwise       -> 6667--buildCertificateStore :: ServerSettings -> IO CertificateStore-buildCertificateStore args =-  do systemStore <- getSystemCertificateStore-     userCerts   <- traverse readSignedObject (view ssServerCerts args)-     let userStore = makeCertificateStore (concat userCerts)-     return (userStore <> systemStore)--buildTlsSettings :: ServerSettings -> IO TLSSettings-buildTlsSettings args =-  do store <- buildCertificateStore args--     let portString = B8.pack (show (view ssPort args))-         paramsClient = defaultParamsClient (view ssHostName args) portString-         validationCache-           | view ssTlsInsecure args = ValidationCache-                                         (\_ _ _ -> return ValidationCachePass)-                                         (\_ _ _ -> return ())-           | otherwise = exceptionValidationCache []--     return $ TLSSettings paramsClient-       { clientSupported = def-           { supportedCiphers           = ciphersuite_strong }--       , clientHooks = def-           { onCertificateRequest       = \_ -> loadClientCredentials args }--       , clientShared = def-           { sharedCAStore              = store-           , sharedValidationCache      = validationCache-           }-       }---loadClientCredentials :: ServerSettings -> IO (Maybe (CertificateChain, PrivKey))-loadClientCredentials args =-  case view ssTlsClientCert args of-    Nothing       -> return Nothing-    Just certPath ->-      do cert  <- readSignedObject certPath-         keys  <- readKeyFile (fromMaybe certPath (view ssTlsClientKey args))-         case keys of-           [key] -> return (Just (CertificateChain cert, key))-           []    -> fail "No private keys found"-           _     -> fail "Too many private keys found"--connect :: ServerSettings -> IO Connection-connect args = do-  connectionContext <- initConnectionContext-  connectionParams  <- buildConnectionParams args-  connectTo connectionContext connectionParams

@@ -1,69 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-module CtcpHandler (ctcpHandler) where--import Control.Lens-import Control.Monad-import Data.ByteString (ByteString)-import Data.Monoid-import Data.Time (formatTime, getZonedTime)-import Data.Version (showVersion)-import qualified Data.ByteString.Char8 as B8-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text--#if MIN_VERSION_time(1,5,0)-import Data.Time (defaultTimeLocale)-#else-import System.Locale (defaultTimeLocale)-#endif--import ClientState-import ServerSettings-import Irc.Format-import Irc.Message-import Irc.Cmd-import Paths_irc_core (version)--versionString :: ByteString-versionString = "glirc " <> B8.pack (showVersion version)--sourceString :: ByteString-sourceString = "https://github.com/glguy/irc-core"--ctcpHandler :: EventHandler-ctcpHandler = EventHandler-  { _evName = "CTCP replies"-  , _evOnEvent = \_ msg st ->--       do let sender = views mesgSender userNick msg-          forOf_ (mesgType . _CtcpReqMsgType) msg $ \(command,params) ->--               -- Don't send responses to ignored users-               unless (view (clientIgnores . contains sender) st) $-                 case command of-                   "CLIENTINFO" ->-                     clientSend (ctcpResponseCmd sender "CLIENTINFO"-                                   "ACTION CLIENTINFO FINGER PING SOURCE TIME USERINFO VERSION") st-                   "VERSION" ->-                     clientSend (ctcpResponseCmd sender "VERSION" versionString) st-                   "USERINFO" ->-                     clientSend (ctcpResponseCmd sender "USERINFO"-                                    (views (clientServer0 . ccServerSettings . ssUserInfo)-                                           (Text.encodeUtf8 . Text.pack) st)) st-                   "PING" ->-                     clientSend (ctcpResponseCmd sender "PING" params) st-                   "SOURCE" ->-                     clientSend (ctcpResponseCmd sender "SOURCE" sourceString) st-                   "FINGER" ->-                     clientSend (ctcpResponseCmd sender "FINGER"-                                    "Username and idle time unavailable") st-                   "TIME" -> do-                     now <- getZonedTime-                     let resp = formatTime defaultTimeLocale "%a %d %b %Y %T %Z" now-                     clientSend (ctcpResponseCmd sender "TIME" (B8.pack resp)) st-                   _ -> return ()--          -- reschedule handler-          return (over clientAutomation (cons ctcpHandler) st)-  }

@@ -1,187 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module EditBox-  ( EditBox-  , content-  , pos-  , delete-  , backspace-  , home-  , end-  , killHome-  , killEnd-  , killWord-  , paste-  , left-  , right-  , leftWord-  , rightWord-  , insert-  , insertString-  , empty-  , earlier-  , later-  , success-  ) where--import Control.Lens-import Data.Char--data EditBox = EditBox-  { _content :: !String-  , _pos     :: !Int-  , _history :: [String]-  , _historyPos :: !Int-  , _yankBuffer :: String-  }-  deriving (Read, Show)--makeLenses ''EditBox--empty :: EditBox-empty = EditBox-  { _content = ""-  , _pos     = 0-  , _history = []-  , _historyPos = -1-  , _yankBuffer = ""-  }--updateYankBuffer :: String -> EditBox -> EditBox-updateYankBuffer str-  | null str  = id-  | otherwise = set yankBuffer str--success :: EditBox -> EditBox-success e-  = over history (cons (view content e))-  $ set  content ""-  $ set  historyPos (-1)-  $ set  pos        0 e--earlier :: EditBox -> Maybe EditBox-earlier e =-  do let i = view historyPos e + 1-     x <- preview (history . ix i) e-     return $ set content x-            $ set pos (length x)-            $ set historyPos i e--later :: EditBox -> Maybe EditBox-later e-  | i <  0 = Nothing-  | i == 0 = Just-           $ set content ""-           $ set pos     0-           $ set historyPos (-1) e-  | otherwise =-      do x <- preview (history . ix (i-1)) e-         return $ set content x-                $ set pos (length x)-                $ set historyPos (i-1) e-  where-  i = view historyPos e---- Remove a character without the associated checks--- internal helper for backspace and delete-removeImpl :: EditBox -> EditBox-removeImpl e-  = set content (a++drop 1 b)-  $ over pos (min (views content length e - 1)) e-  where-  (a,b) = splitAt (view pos e) (view content e)--delete :: EditBox -> EditBox-delete e-  | view pos e < views content length e = removeImpl e-  | otherwise = e--backspace :: EditBox -> EditBox-backspace e-  | view pos e > 0 = removeImpl (left e)-  | otherwise      = e--home :: EditBox -> EditBox-home e-  = set pos 0 e--end :: EditBox -> EditBox-end e-  = set pos (views content length e) e--killEnd :: EditBox -> EditBox-killEnd e-  = set content keep-  $ updateYankBuffer kill e-  where-  (keep,kill) = splitAt (view pos e) (view content e)--killHome :: EditBox -> EditBox-killHome e-  = set content keep-  $ set pos 0-  $ updateYankBuffer kill e-  where-  (kill,keep) = splitAt (view pos e) (view content e)--paste :: EditBox -> EditBox-paste e = insertString (view yankBuffer e) e--killWord :: Bool {- ^ yank -} -> EditBox -> EditBox-killWord yank e-  = set pos (length l')-  $ sometimesUpdateYank-  $ set content (l'++r) e-  where-  (l,r) = splitAt (view pos e) (view content e)-  (sp,l1) = span  isSpace (reverse l)-  (wd,l2) = break isSpace l1-  l' = reverse l2-  yanked = reverse (sp++wd)--  sometimesUpdateYank-    | yank = updateYankBuffer yanked-    | otherwise = id--insert :: Char -> EditBox -> EditBox-insert c-  = insertString [c]--insertString :: String -> EditBox -> EditBox-insertString str e-  = over pos (+length str)-  $ set content (a ++ str ++ b) e-  where-  (a,b) = splitAt (view pos e) (view content e)--left :: EditBox -> EditBox-left e-  = over pos (max 0 . subtract 1) e--right :: EditBox -> EditBox-right e-  = over pos (min (views content length e) . (+1)) e--leftWord :: EditBox -> EditBox-leftWord e =-  case search of-    [] -> set pos 0 e-    (i,_):_ -> set pos (i+1) e-  where-  search = dropWhile (isAlphaNum . snd)-         $ dropWhile (not . isAlphaNum . snd)-         $ reverse-         $ take (view pos e)-         $ zip [0..]-         $ view content e--rightWord :: EditBox -> EditBox-rightWord e =-  case search of-    [] -> set pos (views content length e) e-    (i,_):_ -> set pos i e-  where-  search = dropWhile (isAlphaNum . snd)-         $ dropWhile (not . isAlphaNum . snd)-         $ drop (view pos e)-         $ zip [0..]-         $ view content e

@@ -1,74 +0,0 @@-module HaskellHighlighter (highlightHaskell) where--import Language.Haskell.Lexer--highlightHaskell :: String -> String-highlightHaskell src = init (colorize (lexerPass0 (src++"\n")))--- the lexer requires this newline for single-line comments to work--colorize :: [PosToken] -> String-colorize [] = ""-colorize ((_,(_,"`")):(Varid,(_,str)):(_,(_,"`")):rest)-  = orange ("`" ++ str ++ "`") ++ colorize rest-colorize ((tok, (_,str)):rest) = aux str ++ colorize rest-  where-  aux =-    case tok of-      Varid              -> id-      Conid              -> id-      Varsym             -> orange-      Consym             -> orange-      Reservedid ->-        case str of-          "case"         -> orange-          "of"           -> orange-          "do"           -> orange-          "if"           -> orange-          "then"         -> orange-          "else"         -> orange-          "let"          -> orange-          "in"           -> orange--          "import"       -> pink-          "infixl"       -> pink-          "infixr"       -> pink-          "infix"        -> pink--          "_"            -> id-          _              -> green--      Reservedop         -> orange-      Specialid          -> id-      IntLit             -> red-      FloatLit           -> red-      CharLit            -> red-      StringLit          -> red-      Qvarid             -> id-      Qconid             -> id-      Qvarsym            -> orange-      Qconsym            -> orange-      Special            -> id-      Whitespace         -> id-      NestedCommentStart -> comment-      NestedComment      -> comment-      LiterateComment    -> comment-      Commentstart       -> comment-      Comment            -> comment-      ErrorToken         -> id-      GotEOF             -> id-      ModuleName         -> id-      ModuleAlias        -> id-      Layout             -> id-      Indent _           -> id-      Open _             -> id-      TheRest            -> id--comment :: String -> String-comment = cyan--green, orange, red, cyan, pink :: String -> String-green  x = "\03\&03" ++ x ++ "\03\02\02"-red    x = "\03\&04" ++ x ++ "\03\02\02"-orange x = "\03\&07" ++ x ++ "\03\02\02"-cyan   x = "\03\&11" ++ x ++ "\03\02\02"-pink   x = "\03\&13" ++ x ++ "\03\02\02"

@@ -1,245 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module ImageUtils where--import Control.Lens-import Control.Monad (guard)-import Data.Array-import Data.ByteString (ByteString)-import Data.Char (isControl, isAlphaNum)-import Data.Set (Set)-import Data.Text (Text)-import Graphics.Vty.Image-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.Set as Set-import qualified Data.Text as Text--import Irc.Format--data Formatting = Formatting-  { _fmtFore :: Maybe Color-  , _fmtBack :: Maybe Color-  , _fmtBold, _fmtItalic, _fmtUnderline, _fmtReverse-  , _fmtExplicit :: !Bool-  }--makeLenses ''Formatting--lineWrap :: Int -> Image -> [Image]-lineWrap width img-  | w <= width = [img <|> char defAttr ' '] -- vty forgets to turn off formatting-  | otherwise = cropRight width img : lineWrap width (cropLeft (w-width) img)-  where-  w = imageWidth img--cleanText :: Text -> Image-cleanText = ircFormattedText--renderFullUsermask :: UserInfo -> Image-renderFullUsermask u-   = utf8Bytestring' (withForeColor defAttr yellow) (idBytes (userNick u))-  <|> userpart-  <|> hostpart-      where-      userpart = case userName u of-                   Just x -> string defAttr "!"-                         <|> utf8Bytestring' (withForeColor defAttr green) x-                   Nothing -> emptyImage-      hostpart = case userHost u of-                   Just x -> string defAttr "@"-                         <|> utf8Bytestring' (withForeColor defAttr red) x-                   Nothing -> emptyImage--ircFormattedText :: Text -> Image-ircFormattedText = ircFormattedText' defaultFormatting--ircFormattedText' :: Formatting -> Text -> Image-ircFormattedText' fmt t = text' (formattingAttr fmt) a <|> rest-  where-  (a,b) = Text.break isControl t--  normalFormatting = defaultFormatting { _fmtExplicit = view fmtExplicit fmt }--  explicit img-    | view fmtExplicit fmt = img-    | otherwise = emptyImage--  rest = case Text.uncons b of-    Nothing -> emptyImage-    Just (b', xs) ->-      explicit (explicitControlImage b') <|>-      case b' of-        '\^B' -> ircFormattedText' (over fmtBold      not fmt) xs-        '\^O' -> ircFormattedText' normalFormatting            xs-        '\^V' -> ircFormattedText' (over fmtReverse   not fmt) xs-        '\^]' -> ircFormattedText' (over fmtItalic    not fmt) xs-        '\^_' -> ircFormattedText' (over fmtUnderline not fmt) xs-        '\^C'-          | Just (fore,xs1) <- colorNumber xs ->-             case Text.uncons xs1 of-               Just (',',xs2)-                  | Just (back,xs3) <- colorNumber xs2 ->-                      explicit (colorNumbers xs3) <|>-                      ircFormattedText'-                        (set fmtFore (Just fore)-                        (set fmtBack (Just back) fmt)) xs3--               _ -> explicit (colorNumbers xs1) <|>-                    ircFormattedText'-                      (set fmtFore (Just fore)-                      (set fmtBack Nothing fmt)) xs1--          | otherwise -> ircFormattedText' (set fmtFore Nothing (set fmtBack Nothing fmt)) xs-          where-            colorNumbers t = text' defAttr (Text.take (Text.length xs - Text.length t) xs)--        _ -> ircFormattedText' fmt xs--colorNumber :: Text -> Maybe (Color, Text)-colorNumber t =-  do (c1,c2,t1) <- splitNumber t-     case (c1,c2) of-       ('0','0') -> Just (white                , t1) -- white-       ('0','1') -> Just (black                , t1) -- black-       ('0','2') -> Just (blue                 , t1) -- blue-       ('0','3') -> Just (green                , t1) -- green-       ('0','4') -> Just (red                  , t1) -- red-       ('0','5') -> Just (rgbColor' 127 0 0    , t1) -- brown-       ('0','6') -> Just (rgbColor' 156 0 156  , t1) -- purple-       ('0','7') -> Just (rgbColor' 252 127 0  , t1) -- yellow-       ('0','8') -> Just (yellow               , t1) -- yellow-       ('0','9') -> Just (brightGreen          , t1) -- green-       ('1','0') -> Just (cyan                 , t1) -- brightBlue-       ('1','1') -> Just (brightCyan           , t1) -- brightCyan-       ('1','2') -> Just (brightBlue           , t1) -- brightBlue-       ('1','3') -> Just (rgbColor' 255 0 255  , t1) -- brightRed-       ('1','4') -> Just (rgbColor' 127 127 127, t1) -- brightBlack-       ('1','5') -> Just (rgbColor' 210 210 210, t1) -- brightWhite-       _         -> Nothing---- Take up to two digits off the front of a text. If there is only--- a single digit pretend like the first digit was a 0-splitNumber :: Text -> Maybe (Char,Char,Text)-splitNumber t =-  do let isNumber x = '0' <= x && x <= '9'-     (c1,t1) <- Text.uncons t-     guard (isNumber c1)-     case Text.uncons t1 of-       Just (c2,t2) | isNumber c2 -> Just (c1,c2,t2)-       _                          -> Just ('0',c1,t1)--rgbColor' :: Int -> Int -> Int -> Color-rgbColor' = rgbColor -- fix the type to Int--defaultFormatting :: Formatting-defaultFormatting = Formatting-  { _fmtFore      = Nothing-  , _fmtBack      = Nothing-  , _fmtBold      = False-  , _fmtItalic    = False-  , _fmtUnderline = False-  , _fmtReverse   = False-  , _fmtExplicit  = False-  }--explicitFormatting :: Formatting-explicitFormatting = defaultFormatting { _fmtExplicit = True }--formattingAttr :: Formatting -> Attr-formattingAttr fmt-  = addForeColor-  $ addBackColor-  $ flag (view fmtBold      fmt) bold-  $ flag (view fmtUnderline fmt) underline-  $ flag (view fmtReverse   fmt) reverseVideo-  -- no italic support-  $ defAttr--  where-  addForeColor x =-    case view fmtFore fmt of-      Nothing -> x-      Just c  -> withForeColor x c--  addBackColor x =-    case view fmtBack fmt of-      Nothing -> x-      Just c  -> withBackColor x c--  flag True  s x = withStyle x s-  flag False _ x = x--identImg :: Attr -> Identifier -> Image-identImg attr = utf8Bytestring' attr . idBytes---- | Render a string and replace the control characters with--- reversed video of the associated control key.-stringWithControls :: Attr -> String -> Image-stringWithControls _ [] = emptyImage-stringWithControls attr xs =-  case break isControl xs of-    (a,[]) -> string attr a-    (a,b:bs) -> string attr a-            <|> explicitControlImage b-            <|> stringWithControls attr bs--explicitControlImage :: Char -> Image-explicitControlImage x =-  char (withStyle defAttr reverseVideo)-       (controlNames ! fromEnum x)--controlNames :: Array Int Char-controlNames = listArray (0,0x1f) ('@':['A'..'Z']++"[\\]^_")--nameHighlighter ::-  ByteString -> Set Identifier -> Identifier -> [Color] -> Image-nameHighlighter msg users me colors = aux 0 0-  where-  lowmsg = ircFoldCase msg-  n = B8.length lowmsg-  ncolors = length colors--  aux lo hi-    | hi == n = utf8Bytestring' defAttr (B8.drop lo msg)-    | otherwise =-        case nameLookup identFromHi users of-          Nothing -> aux lo (advance hi)-          Just hit -> utf8Bytestring' defAttr-                        (B8.take (hi-lo) (B8.drop lo msg))-                      <|> utf8Bytestring' (withForeColor defAttr color) matchRegion-                      <|> aux hi' hi'-            where-            -- use the original match region to preserve original case-            matchRegion = B8.take (B8.length (idBytes hit)) (B8.drop hi msg)-            hi' = hi + B8.length (idDenote hit)-            color | me == hit = red-                  | otherwise = colors-                             !! mod (nickHash (idDenote hit)) ncolors--    where-    identFromHi = mkId (B8.drop hi lowmsg)--    advance curHi-      | curHi + 1 == n = curHi + 1-      | isAlphaNum (B8.index lowmsg curHi)-      , isAlphaNum (B8.index lowmsg (curHi+1)) = advance (curHi+1)-      | otherwise = curHi+1---nameLookup :: Identifier -> Set Identifier -> Maybe Identifier-nameLookup haystack s =-  case Set.lookupLE haystack s of-    Just x | idDenote x `B8.isPrefixOf` idDenote haystack-           , boundaryCheck (idDenote x) -> Just x-    _               -> Nothing-  where-  boundaryCheck needle =-    B8.length needle == B8.length (idDenote haystack) ||-    not (isAlphaNum (B8.index (idDenote haystack) (B8.length needle)))--nickHash :: ByteString -> Int-nickHash n =-  let h1 = B.foldl' (\acc b -> fromIntegral b + 33 * acc) 0 n-  in h1 + (h1 `quot` 32)--

@@ -1,1085 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-}-module Main where--import Control.Applicative hiding ((<|>))-import Control.Concurrent (killThread, forkIO)-import Control.Concurrent.STM-import Control.Exception-import Control.Lens-import Control.Monad-import Control.Monad.Trans.State-import Control.Monad.IO.Class-import Data.ByteString (ByteString)-import Data.Char-import Data.Fixed (Centi, Pico, showFixed)-import Data.Foldable (for_, traverse_)-import Data.List (elemIndex)-import Data.List.Split (chunksOf)-import Data.IORef-import Data.Maybe (fromMaybe)-import Data.Monoid-import Data.Set (Set)-import Data.Text (Text)-import Data.Time-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)-import Data.Traversable (for)-import Graphics.Vty-import Network.Connection-import System.IO-import System.IO.Error (isEOFError)-import qualified Config.Lens as C-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.Map as Map-import qualified Data.Set as Set-import qualified Data.Text as Text-import qualified Data.Text.Lens as Text-import qualified Data.Text.Encoding as Text--import Irc.Core-import Irc.Cmd-import Irc.Format-import Irc.Message-import Irc.Model-import Irc.RateLimit--import ConnectCmds (connectCmds)-import ClientState-import Connection (connect, getRawIrcLine)-import CommandArgs-import CommandParser-import CtcpHandler-import ImageUtils-import Moderation-import ServerSettings-import Views.BanList-import Views.Channel-import Views.ChannelInfo-import qualified EditBox as Edit--data SendType = SendCtcp String | SendPriv | SendNotice | SendAction-makePrisms ''SendType--main :: IO ()-main = do-  args <- getCommandArgs--  let debugFile = view cmdArgDebug args-                `mplus`-                  preview ( cmdArgConfigValue-                          . C.key "debug-file"-                          . C.text . Text.unpacked) args--  hErr <- for debugFile $ \fn ->-            do hErr <- openFile fn WriteMode-               hSetBuffering hErr NoBuffering-               return hErr--  vtyEventChan <- atomically newTChan-  recvChan     <- atomically newTChan--  withVty $ \vty ->-    do _ <- forkIO (vtyEventLoop vtyEventChan vty)-       settings <- initialServerSettings args-       server0  <- startIrcConnection recvChan settings hErr-       (width,height) <- displayBounds (outputIface vty)-       zone <- getCurrentTimeZone--       let st0 = ClientState-               { _clientServer0         = server0-               , _clientRecvChan        = recvChan-               , _clientErrors          = hErr-               , _clientFocus           = ChannelFocus ""-               , _clientDetailView      = False-               , _clientTimeView        = True-               , _clientMetaView        = True-               , _clientFullView        = False-               , _clientEditBox         = Edit.empty-               , _clientTabPattern      = Nothing-               , _clientScrollPos       = 0-               , _clientHeight          = height-               , _clientWidth           = width-               , _clientIgnores         = mempty-               , _clientHighlights      = mempty-               , _clientMessages        = mempty-               , _clientNickColors      = defaultNickColors-               , _clientAutomation      = [ctcpHandler,cancelDeopTimerOnDeop,connectCmds]-               , _clientTimers          = mempty-               , _clientTimeZone        = zone-               }-       st1 <- schedulePing st0--       driver vty vtyEventChan recvChan st1--withVty :: (Vty -> IO a) -> IO a-withVty k =-  do cfg <- standardIOConfig-     bracket (mkVty cfg) shutdown k--startIrcConnection ::-  TChan (UTCTime, MsgFromServer) {- ^ incoming client events -} ->-  ServerSettings                 {- ^ network parameters     -} ->-  Maybe Handle                   {- ^ error log              -} ->-  IO ClientConnection-startIrcConnection recvChan settings hErr =-  do connectRes <- try (connect settings)-     case connectRes of-       Left e -> connectionFailed e-       Right h -> connectionSuceeded h--  where-  utf8Bytes = Text.encodeUtf8 . Text.pack-  nick = mkId (utf8Bytes (view ssNick settings))-  user = utf8Bytes (view ssUser settings)-  real = utf8Bytes (view ssReal settings)-  sasl = over (mapped.both) utf8Bytes (view ssSaslCredential settings)-  pass = over mapped        utf8Bytes (view ssPassword settings)--  connectionSuceeded h =-    do sendChan     <- atomically newTChan-       connectedRef <- newIORef True-       sendThreadId <- forkIO (sendLoop connectedRef sendChan h)-       recvThreadId <- forkIO (socketLoop recvChan h hErr)-       initializeConnection pass nick user real h-       return ClientConnection-         { _ccServerSettings = settings-         , _ccConnection     = defaultIrcConnection-                                 { _connNick = nick-                                 , _connSasl = sasl-                                 }-         , _ccSendChan       = Just (connectedRef, sendChan)-         , _ccRecvThread     = Just recvThreadId-         , _ccSendThread     = Just sendThreadId-         }--  connectionFailed (SomeException e) =-    do let eUtf8 = utf8Bytes (show e)-       now <- getCurrentTime-       atomically (writeTChan recvChan (now, Error eUtf8))-       return ClientConnection-         { _ccServerSettings = settings-         , _ccConnection     = defaultIrcConnection-                                 { _connNick = nick-                                 , _connSasl = sasl-                                 }-         , _ccSendChan       = Nothing-         , _ccRecvThread     = Nothing-         , _ccSendThread     = Nothing-         }--initializeConnection ::-  Maybe ByteString {- ^ server password -} ->-  Identifier {- ^ nickname        -} ->-  ByteString {- ^ username        -} ->-  ByteString {- ^ realname        -} ->-  Connection -> IO ()-initializeConnection pass nick user real h =-  do connectionPut h capLsCmd-     traverse_ (connectionPut h . passCmd) pass-     connectionPut h (nickCmd nick)-     connectionPut h (userCmd user real)--driver :: Vty -> TChan Event -> TChan (UTCTime, MsgFromServer) -> ClientState -> IO ()-driver vty vtyEventChan ircMsgChan st0 =-  do now <- getCurrentTime-     let (scroll', pic) = picForState now st0-         st1 = set clientScrollPos scroll' st0-     update vty pic-     e <- readEitherTChan vtyEventChan ircMsgChan-     case e of-       Left vtyEvent -> processVtyEvent st1 vtyEvent-       Right (time,msg) -> processIrcMsg st1 time msg--  where-  -- processVtyEvent and processIrcMsg jump here-  continue = considerTimers-           . resetCurrentChannelMessages--  considerTimers st =-    do now <- getCurrentTime-       case nextTimerEvent now st of-         Nothing -> driver vty vtyEventChan ircMsgChan st-         Just (e,st') -> processTimerEvent e st'--  processTimerEvent e st =-    case e of-      TransmitPing ->-        do st1 <- sendTimestampPing st-           st2 <- schedulePing st1-           considerTimers st2--      DropOperator chan ->-        do clientSend (modeCmd chan ["-o",views connNick idBytes conn]) st-           considerTimers st-    where-    conn = view (clientServer0 . ccConnection) st--  processVtyEvent st event =-    case event of-      EvResize width height -> continue-                             $ set clientWidth  width-                             $ set clientHeight height st--      EvKey (KChar 'l') [MCtrl] ->-        do refresh vty-           (width,height) <- displayBounds (outputIface vty)-           continue $ set clientHeight height-                    $ set clientWidth  width st--      EvKey key mods -> do r <- keyEvent key mods st-                           case r of-                             KeepGoing st' -> continue st'-                             Exit -> return ()--      _ -> continue st--  processIrcMsg st time msg =-    do let m :: IO (Either String IrcConnection, ClientState)-           m = flip runStateT st-             $ runLogic time-                  (interpretLogicOp ircMsgChan)-                  (advanceModel msg-                     (view (clientServer0 . ccConnection) st))--       res <- m-       case res of-         (Left e,st') ->-           do for_ (view clientErrors st) $ \h -> hPutStrLn h ("!!! " ++ e)-              continue st'-         (Right conn',st') ->-           do continue (set (clientServer0 . ccConnection) conn' st')--interpretLogicOp :: TChan (UTCTime, MsgFromServer) -> LogicOp a -> StateT ClientState IO a--interpretLogicOp ircMsgChan (Expect k) =-  do fmap (k.snd) (liftIO (atomically (readTChan ircMsgChan)))--interpretLogicOp _ (Emit bytes r) =-  do st <- get-     liftIO (clientSend bytes st)-     return r--interpretLogicOp _ (Record target message r) =-  do put =<< liftIO . runEventHandlers target message-                    . addMessage target message-         =<< get-     return r----------------------------------------------------------------------------- Key Event Handlers!---------------------------------------------------------------------------data KeyEventResult-  = KeepGoing ClientState-  | Exit--changeInput :: (Edit.EditBox -> Edit.EditBox) -> ClientState -> ClientState-changeInput f st = clearTabPattern (over clientEditBox f st)--inputLogic :: ClientState -> (Image, IO KeyEventResult)-inputLogic st =-  case clientInput st of-    '/':_ -> case commandEvent st of-               (img, Nothing) -> (img, return (KeepGoing st))-               (img, Just m ) -> (img, m)-    txt -> ( ircFormattedText' explicitFormatting (Text.pack txt)-           , fmap KeepGoing (doSendMessageCurrent SendPriv st)-           )--keyEvent :: Key -> [Modifier] -> ClientState -> IO KeyEventResult-keyEvent k ms st =-  let more = return . KeepGoing in-  case (k,ms) of-    (KFun 2   , []     ) -> more $ over clientDetailView not st-    (KFun 3   , []     ) -> more $ over clientTimeView   not st-    (KFun 4   , []     ) -> more $ over clientMetaView   not st-    (KFun 5   , []     ) -> more $ over clientFullView   not st-    (KPageUp  , _      ) -> more $ scrollUp st-    (KPageDown, _      ) -> more $ scrollDown st-    (KChar 'n', [MCtrl]) -> more $ nextFocus st-    (KChar 'p', [MCtrl]) -> more $ prevFocus st-    (KChar c  , [MMeta]) | Just i <- jumpNumber c -> more $ jumpFocus i st-    (KChar 'a', [MMeta]) -> more $ jumpActivity st-    (KBS      , _      ) -> more $ changeInput Edit.backspace st-    (KChar 'd', [MCtrl]) -> more $ changeInput Edit.delete st-    (KDel     , _      ) -> more $ changeInput Edit.delete st-    (KUp      , _      ) -> more $ maybe st clearTabPattern $ clientEditBox Edit.earlier st-    (KDown    , _      ) -> more $ maybe st clearTabPattern $ clientEditBox Edit.later st-    (KLeft    , _      ) -> more $ changeInput Edit.left st-    (KRight   , _      ) -> more $ changeInput Edit.right st-    (KHome    , _      ) -> more $ changeInput Edit.home st-    (KEnd     , _      ) -> more $ changeInput Edit.end st-    (KChar 'a', [MCtrl]) -> more $ changeInput Edit.home st-    (KChar 'e', [MCtrl]) -> more $ changeInput Edit.end st-    (KChar 'u', [MCtrl]) -> more $ changeInput Edit.killHome st-    (KChar 'k', [MCtrl]) -> more $ changeInput Edit.killEnd st-    (KChar 'y', [MCtrl]) -> more $ changeInput Edit.paste st-    (KChar 'w', [MCtrl]) -> more $ changeInput (Edit.killWord True) st-    (KChar 'b', [MMeta]) -> more $ changeInput Edit.leftWord st-    (KChar 'f', [MMeta]) -> more $ changeInput Edit.rightWord st-    (KChar '\t', []    ) -> more $ tabComplete st-    (KChar 'b', [MCtrl]) -> more $ changeInput (Edit.insert '\^B') st-    (KChar 'c', [MCtrl]) -> more $ changeInput (Edit.insert '\^C') st-    (KChar ']', [MCtrl]) -> more $ changeInput (Edit.insert '\^]') st-    (KChar '_', [MCtrl]) -> more $ changeInput (Edit.insert '\^_') st-    (KChar 'o', [MCtrl]) -> more $ changeInput (Edit.insert '\^O') st-    (KChar 'v', [MCtrl]) -> more $ changeInput (Edit.insert '\^V') st-    (KChar c  , []     ) -> more $ changeInput (Edit.insert c) st-    (KEnter   , []     ) -> snd (inputLogic st)-    _                    -> more st---- | Map keyboard numbers 1-9,0 to the numbers 0-9-jumpNumber :: Char -> Maybe Int-jumpNumber c = elemIndex c jumps-  where-  jumps = "1234567890qwertyuiop"----- TODO: Don't scroll off the end of the channel--scrollOffset :: ClientState -> Int-scrollOffset st = max 1 (view clientHeight st - 4)--scrollUp :: ClientState -> ClientState-scrollUp st = over clientScrollPos (+ scrollOffset st) st--scrollDown :: ClientState -> ClientState-scrollDown st = over clientScrollPos (\x -> max 0 (x - scrollOffset st)) st--doSendMessageCurrent :: SendType -> ClientState -> IO ClientState-doSendMessageCurrent sendType st =-  case view clientFocus st of-    ChannelFocus c-      | not (null (dropWhile isSpace (clientInput st))) ->-      doSendMessage sendType c (Text.pack (clientInput st)) st-    _ -> return st---- Pessimistic maximum length computation for the message part for--- privmsg and notice. Note that the need for the limit is because--- the server will limit the length of the message sent out to each--- client, not just the length of the messages it will recieve.-computeMaxMessageLength :: Identifier -> String -> Identifier -> Int-computeMaxMessageLength nick user target-  = 512-  - 63 -- max hostname-  - length (":~!@ PRIVMSG :\r\n"::String)-  - B8.length (idBytes nick)-  - length user-  - B8.length (idBytes target)--doSendMessage :: SendType -> Identifier -> Text -> ClientState -> IO ClientState--doSendMessage sendType _ message st-  | Text.null message && hasn't _SendCtcp sendType = return st--doSendMessage sendType target message st =-  do let bs = case sendType of-                SendPriv -> map (privMsgCmd target . Text.encodeUtf8) messages-                                -- long actions aren't split up-                SendAction -> [privMsgCmd target ("\SOHACTION " <>-                                                 Text.encodeUtf8 message <> "\SOH")]-                SendNotice -> map (noticeCmd target . Text.encodeUtf8) messages-                SendCtcp cmd -> [ctcpRequestCmd target-                                 (Text.encodeUtf8 (Text.pack (map toUpper cmd)))-                                 (Text.encodeUtf8 message)]-     mapM_ (`clientSend` st) bs-     now <- getCurrentTime-     let myModes = view (connChannels . ix target' . chanUsers . ix myNick) conn-     return (addMessage target' (fakeMsg now myModes) (clearInput st))--  where-  myNick = view connNick conn--  maxMessageLength =-    computeMaxMessageLength myNick (view (ccServerSettings.ssUser) ircconn) target-  messages = Text.chunksOf maxMessageLength message--  ircconn = view clientServer0 st-  conn = view ccConnection ircconn--  (statusmsg, target') = splitStatusMsg target conn--  fakeMsg now modes = IrcMessage-    { _mesgSender = who-    , _mesgStatus = statusmsg-    , _mesgType = case sendType of-                    SendPriv   -> PrivMsgType   message-                    SendNotice -> NoticeMsgType message-                    SendAction -> ActionMsgType message-                    SendCtcp cmd -> CtcpReqMsgType-                                        (Text.encodeUtf8 (Text.pack cmd))-                                        (Text.encodeUtf8 message)-    , _mesgStamp = now-    , _mesgModes = modes-    , _mesgMe = True-    }--  who = UserInfo (view connNick conn) Nothing Nothing--commandEvent :: ClientState -> (Image, Maybe (IO KeyEventResult))-commandEvent st = commandsParser (clientInput st)-                        (exitCommand : normalCommands)- where- st' = clearInput st- toB = Text.encodeUtf8 . Text.pack- conn = view (clientServer0 . ccConnection) st-- exitCommand =-  ("exit", [], pure (return Exit))-- normalCommands = over (mapped . _3 . mapped . mapped) KeepGoing $-    -- focus setting-  [ ("server", [],-    pure (return (set clientFocus (ChannelFocus "") st')))--  , ("channel", [],-    (\chan -> return (set clientFocus (ChannelFocus chan) st'))-    <$> pChannel st)--  , ("query", [],-    (\user -> return (set clientFocus (ChannelFocus user) st'))-    <$> pNick st)--  , ("window", [],-    (\n -> return (jumpFocus n st'))-    <$> pNumber)--  , ("channelinfo", [], pure (doChannelInfoCmd st))--  , ("bans", [], pure (doMasksCmd 'b' st))--  , ("masks", [],-    (\mode -> doMasksCmd mode st)-    <$> pValidToken "mode" (\m ->-            case m of-              [x] | x `elem` view (connChanModeTypes . modesLists) conn ->-                   Just x-              _ -> Nothing))--    -- chat-  , ("me", [],-    (\msg -> doAction msg st)-    <$> pRemainingNoSp)--  , ("notice", [],-    (\target msg -> doSendMessage SendNotice target (Text.pack msg) st)-    <$> pTarget <*> pRemainingNoSp)--  , ("msg", [],-    (\target msg -> doSendMessage SendPriv target (Text.pack msg) st)-    <$> pTarget <*> pRemainingNoSp)--  , ("ctcp", [],-    (\command params -> doSendMessage (SendCtcp command) (focusedName st) (Text.pack params) st)-    <$> pToken "command" <*> pRemainingNoSp)--    -- carefully preserve whitespace after the command-  , ("hs", [],-    (\src ->-      let msg = Text.pack src in-      case view clientFocus st of-        ChannelFocus c -> doSendMessage SendPriv c msg st-        _ -> return st)-    <$> pHaskell)--    -- raw-  , ("quote", [],-    (\rest -> doQuote rest st')-    <$> pRemainingNoSp)--  , ("help", [],-    (\mbTopic -> st' <$ clientSend (helpCmd (maybe "" toB mbTopic)) st')-    <$> optional (pToken "topic"))--    -- channel commands-  , ("join", ["j"],-    (\c key -> doJoinCmd c (fmap toB key) st')-    <$> pChannel st <*> optional (pToken "key"))--  , ("umode", [],-    (\args ->-         st' <$ clientSend (modeCmd (view connNick conn)-                                    (map toB (words args))) st')-    <$> pRemainingNoSp)--  , ("mode", [],-    (\args -> doMode (Text.encodeUtf8 (Text.pack args)) st)-    <$> pRemainingNoSp)--  , ("kick", [], doKick st <$> pNick st <*> (Text.pack <$> pRemainingNoSp))--  , ("remove", [], doRemove st <$> pNick st <*> (Text.pack <$> pRemainingNoSp))--  , ("invite", [], doInvite st <$> pNick st)--  , ("knock", [],-    (\chan -> doKnock chan st)-    <$> pChannel st)--  , ("part", [],-    (\msg -> case focusedChan st of-               Nothing -> return st-               Just chan -> st' <$ clientSend (partCmd chan (toB msg)) st')-    <$> pRemainingNoSp)--  , ("whois", ["wi"],-    (\u -> st' <$ clientSend (whoisCmd u) st')-    <$> pNick st)--  , ("whowas", [],-    (\u -> st' <$ clientSend (whowasCmd u) st')-    <$> pNick st)--  , ("topic", ["t"],-    (\rest -> doTopicCmd (toB rest) st) -- TODO: the limit should check bytes not chars-    <$> pRemainingNoSpLimit (view connTopicLen conn))--  , ("ignore", [],-    (\u -> return (over (clientIgnores . contains u) not st'))-    <$> pNick st)--  , ("highlight", [],-    (\w ->-       return (over (clientHighlights . contains (ircFoldCase (Text.encodeUtf8 (Text.pack w)))) not st'))-    <$> pRemainingNoSp)--  , ("clear", [],-    (\chan -> return (set (clientMessages . at (fromMaybe (focusedName st) chan)) Nothing st'))-    <$> optional pTarget)--  , ("accept", [],-    (\mbNick -> doAccept True mbNick st)-    <$> optional (pNick st))--  , ("unaccept", [],-    (\mbNick -> doAccept False mbNick st)-    <$> optional (pNick st))--  , ("acceptlist", [], pure (doAccept True (Just "*") st))--  , ("nick", [], doNick st-    <$> pNick st)--  , ("away", [],-    (\rest -> st' <$ clientSend (awayCmd (toB rest)) st')-    <$> pRemainingNoSp)--  , ("quit", [],-    (\rest -> st' <$ clientSend (quitCmd (toB rest)) st')-    <$> pRemainingNoSp)--  , ("who", [],-    (\whomask -> st' <$ clientSend (whoCmd (toB whomask)) st')-    <$> pToken "mask")--  , ("op"     , [], doOp st      <$> many' (pNick st))-  , ("deop"   , [], doDeop st    <$> many' (pNick st))-  , ("voice"  , [], doVoice st   <$> many' (pNick st))-  , ("devoice", [], doDevoice st <$> many' (pNick st))--  , ("akb", [],-    (\nick reason ->-       case focusedChan st of-         Nothing -> return st-         Just chan -> doWithOps chan (doAutoKickBan chan nick (Text.pack reason)) st')-    <$> pNick st <*> pRemainingNoSp)--  , ("time", [],-    (\mbServer -> st' <$ clientSend (timeCmd (fmap (Text.encodeUtf8 . Text.pack) mbServer)) st')-    <$> optional (pToken "server"))--  , ("admin", [],-    (\mbServer -> st' <$ clientSend (adminCmd (fmap (Text.encodeUtf8 . Text.pack) mbServer)) st')-    <$> optional (pToken "server"))--  , ("stats", [],-    (\letter mbTarget ->-        st' <$ clientSend (statsCmd letter (fmap (Text.encodeUtf8 . Text.pack) mbTarget)) st')-    <$> pAnyChar <*> optional (pToken "target"))--  , ("oper", [],-    (\user pass -> st' <$ clientSend (operCmd (Text.encodeUtf8 (Text.pack user))-                                              (Text.encodeUtf8 (Text.pack pass))) st')-    <$> pToken "username" <*> pToken "password")--  , ("reconnect", [], pure (doReconnect st'))--  , ("ping", [],-    (\msg -> doPingCmd msg st')-    <$> pRemainingNoSp)--  ]--doPingCmd :: String -> ClientState -> IO ClientState-doPingCmd ""  st = sendTimestampPing st-doPingCmd msg st = st <$ clientSend (pingCmd (Text.encodeUtf8 (Text.pack msg))) st--doReconnect :: ClientState -> IO ClientState-doReconnect st =-  do let server0 = view clientServer0 st-     traverse_ killThread (view ccRecvThread server0)-     traverse_ killThread (view ccSendThread server0)--     let settings = view ccServerSettings server0-         recvChan = view clientRecvChan st-         hErr     = view clientErrors st-     server0' <- startIrcConnection recvChan settings hErr-     return (set clientServer0 server0' st)--doNick ::-  ClientState ->-  Identifier {- ^ new nickname -} ->-  IO ClientState-doNick st nick-  | B8.length (idBytes nick) > view connNickLen conn-  = return st--  | view connPhase conn /= ActivePhase =-      let st' = clearInput-              $ set (clientServer0 . ccConnection . connNick) nick st in-      st' <$ clientSend (nickCmd nick) st'--  | otherwise =-      clearInput st <$ clientSend (nickCmd nick) st--  where-  conn = view (clientServer0 . ccConnection) st--doMode ::-  ByteString {- mode change -} ->-  ClientState -> IO ClientState-doMode args st = fromMaybe (return st) $-  do chan         <- focusedChan st-     modes:params <- Just (B8.words args)-     parsedModes  <- splitModes (view connChanModeTypes conn)-                        modes params-     let modeChunks = chunksOf (view connModes conn) parsedModes-     return $-       doWithOps chan (\evSt ->-         do for_ modeChunks $ \modeChunk ->-              clientSend (modeCmd chan (unsplitModes modeChunk)) evSt-            return evSt)-         (clearInput st)--  where-  conn = view (clientServer0 . ccConnection) st--doAccept ::-  Bool {- ^ add to list -} ->-  Maybe Identifier {- ^ optional nick -} ->-  ClientState -> IO ClientState-doAccept add mbNick st =-  case mbNick of-    Just n -> go n-    Nothing-      | isNickName (focusedName st) conn -> go (focusedName st)-      | otherwise -> return st--  where-  conn = view (clientServer0 . ccConnection) st-  go nick =-    do let nickBytes-             | add = idBytes nick-             | otherwise = "-" <> idBytes nick-       clientSend (acceptCmd nickBytes) st-       return (clearInput st)--doAction ::-  String {- ^ action text -} ->-  ClientState -> IO ClientState-doAction msg st =-  case view clientFocus st of-    ChannelFocus c -> doSendMessage SendAction c (Text.pack msg) (clearInput st)-    _ -> return st--doKnock ::-  Identifier {- ^ channel  -} ->-  ClientState -> IO ClientState-doKnock chan st-  | not available || not isChannel || inChannel = return st-  | otherwise = do clientSend (knockCmd chan) st-                   return (clearInput st)-  where-  conn = view (clientServer0 . ccConnection) st-  available = view connKnock conn-  inChannel = has (connChannels . ix chan) conn-  isChannel = isChannelName chan conn--doChannelInfoCmd ::-  ClientState -> IO ClientState-doChannelInfoCmd st--  | Just chan <- focusedChan st =--  do let modesKnown-           = has ( connChannels . ix chan . chanModes . folded) conn--     unless modesKnown $-       clientSend (modeCmd chan []) st-     return (clearInput (set clientFocus (ChannelInfoFocus chan) st))--  | otherwise = return st--  where-  conn = view (clientServer0 . ccConnection) st--doMasksCmd ::-  Char       {- ^ mode    -} ->-  ClientState -> IO ClientState-doMasksCmd mode st-  | Just chan <- focusedChan st =-  do let masksKnown =-           has ( connChannels . ix chan . chanMaskLists . ix mode) conn--     unless masksKnown $-       clientSend (modeCmd chan [B8.pack ['+',mode]]) st-     return (set clientFocus (MaskListFocus mode chan) (clearInput st))--  | otherwise = return st--  where-  conn = view (clientServer0 . ccConnection) st--doJoinCmd :: Identifier -> Maybe ByteString -> ClientState -> IO ClientState-doJoinCmd c mbKey st =-  do clientSend (joinCmd c mbKey) st-     -- When joining you can specify more than one channel split on commas-     let c' = mkId (B8.takeWhile (/=',') (idBytes c))-     return (set clientFocus (ChannelFocus c') st)--doQuote :: String -> ClientState -> IO ClientState-doQuote cmd st = st <$ clientSend (Text.encodeUtf8 (Text.pack (cmd ++ "\r\n"))) st------------------------------------------------------------------------------ Primary UI rendering---------------------------------------------------------------------------picForState :: UTCTime -> ClientState -> (Int,Picture)-picForState now st = (scroll', pic)-  where-  conn = view (clientServer0 . ccConnection) st--  pic = Picture-    { picCursor = Cursor (min (view clientWidth st - 1)-                              (view (clientEditBox. Edit.pos) st+1))-                         (view clientHeight st - 1)-    , picLayers =-        [ translateY (view clientHeight st - 2)-             (divider <-> textbox st)-        , everythingBeforeInput-        ]-    , picBackground = ClearBackground-    }--  everythingBeforeInput = vertCat-    [ titlebar-    , string defAttr (replicate (view clientWidth st) '─')-    , mainFocusImage-    ]--  divider = dividerImage now st--  -- Pad the main image when it doesn't fill the screen-  -- so that it starts at the bottom of the frame-  startFromBottom :: Image -> Image-  startFromBottom img = pad 0 top 0 0 img-    where-    top = max 0 (view clientHeight st - 4 - imageHeight img)--  mainFocusImage-    = startFromBottom-    . vertCat-    . reverse-    $ scrolledLines--  (scroll', scrolledLines) = scrollList (view clientHeight st - 4)-                                        (view clientScrollPos st)-                                        wrappedLines--  wrappedLines = reverse . lineWrap (view clientWidth st) =<< mainFocusLines--  mainFocusLines =-    case view clientFocus st of-      MaskListFocus mode chan -> banListImage mode chan st-      ChannelInfoFocus chan -> channelInfoImage chan st-      _ -> channelImage st--  titlebar =-    case view clientFocus st of-      ChannelFocus "" -> string defAttr "Server"-      ChannelFocus c -> topicbar c-      ChannelInfoFocus c -> string defAttr "Channel Info: "-                        <|> identImg defAttr c-      MaskListFocus mode c -> string defAttr (maskListTitle mode ++ ": ")-                          <|> identImg defAttr c--  topicbar chan =-    case preview (connChannels . ix chan . chanTopic . folded . folded . _1) conn of-      Just topic | not (Text.null topic) -> cleanText topic-      _ -> char defAttr ' '---- | Try to drop the suggested number of elements and then--- take the requested number of elements. If the drop drops--- too many, drop fewer (when possible) in favor of taking--- the correct number of elements. Return the actual number--- of elements dropped along with the elements kept.-scrollList ::-  Int {- ^ take parameter -} ->-  Int {- ^ suggested drop -} ->-  [a] {- ^ all elements   -} ->-  (Int,[a]) {- ^ (actual drop, selected elements) -}-scrollList t d xs-  | length xs' == t = (d,xs')-  | otherwise       = (d',drop d' xs)-  where-  xs' = take t (drop d xs)-  x'len = length xs'-  d' = max 0 (d - (t - x'len))--maskListTitle :: Char -> String-maskListTitle 'b' = "Bans"-maskListTitle 'q' = "Quiets"-maskListTitle 'I' = "Invite exceptions"-maskListTitle 'e' = "Ban exceptions"-maskListTitle m   = "Unknown '" ++ [m] ++ "' masks"--textbox :: ClientState -> Image-textbox st-  = applyCrop-  $ beginning <|> content <|> ending-  where-  pos = view (clientEditBox . Edit.pos) st-  width = view clientWidth st-  (content,_) = inputLogic st-  applyCrop-    | 1+pos < width = cropRight width-    | otherwise     = cropLeft  width . cropRight (pos+2)--  beginning = char (withForeColor defAttr brightBlack) '^'-  ending    = char (withForeColor defAttr brightBlack) '$'--dividerImage :: UTCTime -> ClientState -> Image-dividerImage now st-  = extendToWidth (nickPart <|> channelPart <|> lagPart)-  where-  conn = view (clientServer0 . ccConnection) st--  myNick = view connNick conn--  drawLagTime color s =-       let s' = realToFrac s :: Centi -- truncate to two decimal places-           sStr = showFixed True s' <> "s"-       in-                string defAttr "-["-            <|> string (withForeColor defAttr color) sStr-            <|> string defAttr "]"--  lagPart =-    case view connPingTime conn of-      NoPing        -> emptyImage-      PingSent when -> drawLagTime red (realToFrac (diffUTCTime now when))-      PingTime s    -> drawLagTime yellow s---  channelPart =-    ifoldr (\i x xs -> drawOne i x <|> xs)-           emptyImage-           (fullMessageLists st <> extraDefaults)--  -- e.g. glguy(+Zi)-  nickPart =-    identImg defAttr myNick <|>-    string defAttr "(+" <|>-    utf8Bytestring' defAttr (view connUmode conn) <|>-    char defAttr ')'--  drawOne :: Identifier -> MessageList -> Image-  drawOne i seen-    | focusedName st == i =-        string defAttr "─(" <|>-        string (withForeColor defAttr blue) focusedChanPrefixes <|>-        utf8Bytestring'-          (withForeColor defAttr green)-          (identToBytes i) <|>-        string defAttr ")"-    | views mlNewMessages (>0) seen =-        string defAttr "─[" <|>-        utf8Bytestring'-          (withForeColor defAttr brightBlue)-          (identToBytes i) <|>-        string defAttr ":" <|>-        string (withForeColor defAttr (seenColor seen))-               (show (view mlNewMessages seen)) <|>-        string defAttr "]"-    | otherwise =-        string defAttr "─o"--  -- e.g. [('o','@'),('v','+')]-  prefixMapping = view (connChanModeTypes . modesPrefixModes) conn-  myFocusedModes = view (connChannels . ix (focusedName st) . chanUsers . ix myNick) conn--  -- allow prefixMapping to dictate the ordering-  focusedChanPrefixes = [ prefix | (mode,prefix) <- prefixMapping, mode `elem` myFocusedModes ]--  -- deal with the fact that the server window uses the "" identifier-  identToBytes x-    | x == "" = "server"-    | otherwise = idBytes x--  seenColor :: MessageList -> Color-  seenColor seen-    | view mlMentioned seen = red-    | view mlNewMessages seen > 0 = green-    | otherwise = brightBlack--  extendToWidth img =-    img <|> string defAttr (replicate (view clientWidth st - imageWidth img) '─')--  extraDefaults =-    Map.singleton (focusedName st) defaultMessageList----------------------------------------------------------------------------- Event loops---------------------------------------------------------------------------sendLoop :: IORef Bool -> TChan ByteString -> Connection -> IO ()-sendLoop connectedRef queue h =-  do r <- newRateLimitDefault-     forever $-       do x <- atomically (readTChan queue)-          tickRateLimit r-          connectionPut h x-  `catch` \(SomeException _) ->-      writeIORef connectedRef False -- exit silently--socketLoop :: TChan (UTCTime, MsgFromServer) -> Connection -> Maybe Handle -> IO ()-socketLoop chan h hErr =-  forever (atomically . writeTChan chan =<< getOne h hErr)-  `catches`-   [ Handler $ \ioe ->-      do let msg = if isEOFError ioe-                    then "Connection terminated"-                    else Text.encodeUtf8 (Text.pack (show ioe))-         now <- getCurrentTime-         atomically (writeTChan chan (now, Error msg))-   , Handler $ \(SomeException e) ->-        do now <- getCurrentTime-           atomically (writeTChan chan (now, Error (Text.encodeUtf8 (Text.pack (show e)))))-   ]--vtyEventLoop :: TChan Event -> Vty -> IO a-vtyEventLoop chan vty = forever (atomically . writeTChan chan =<< nextEvent vty)--getOne :: Connection -> Maybe Handle -> IO (UTCTime, MsgFromServer)-getOne h hErr =-    do xs <- getRawIrcLine h-       case parseRawIrcMsg xs of-         _ | B.null xs -> connectionClosed-         Nothing       -> unparsableLine xs-         Just rawMsg   ->-           do t <- maybe getCurrentTime return (msgTime rawMsg)-              case ircMsgToServerMsg rawMsg of-                Nothing -> unhandledMsg t rawMsg-                Just msg -> handledMsg t msg-  where-  debugPrint x = for_ hErr (`hPrint` x)--  connectionClosed =-    do t <- getCurrentTime-       return (t,Error "Connection closed")--  unparsableLine xs =-    do debugPrint xs-       t <- getCurrentTime-       return (t,Error ("Unparsable IRC line: " <> xs))--  unhandledMsg t rawMsg =-    do debugPrint rawMsg-       return (t,Error ("Unhandled IRC line: " <> Text.encodeUtf8 (Text.pack (show rawMsg))))--  handledMsg t msg =-    do debugPrint msg-       return (t,msg)--readEitherTChan :: TChan a -> TChan b -> IO (Either a b)-readEitherTChan a b =-  atomically (fmap Left (readTChan a) `orElse` fmap Right (readTChan b))----------------------------------------------------------------------------- Tab completion logic---------------------------------------------------------------------------tabComplete :: ClientState -> ClientState-tabComplete st = fromMaybe st $-  do let current = currentWord st-     guard (not (null current))-     c <- focusedChan st-     let vals = userSet c <> channelSet-     case view clientTabPattern st of-       Just pat -> do next <- tabSearch pat current vals-                      Just $ replaceWith next st--       Nothing  -> do next <- tabSearch current current vals-                      Just $ set clientTabPattern (Just current)-                           $ replaceWith next st-  where-  conn = view (clientServer0 . ccConnection) st--  replaceWith str = over clientEditBox $ \box ->-    let box1 = Edit.killWord False box-        str1 | view Edit.pos box1 == 0 = str ++ ": "-             | otherwise               = str-    in Edit.insertString str1 box1--  userSet c  = views (connChannels . ix c . chanUsers) Map.keysSet conn-  channelSet = views connChannels                      Map.keysSet conn--currentWord :: ClientState -> String-currentWord st-  = reverse-  $ takeWhile (not . isSpace)-  $ dropWhile (\x -> x==' ' || x==':')-  $ reverse-  $ take (view (clientEditBox . Edit.pos) st) (clientInput st)--tabSearch :: String -> String -> Set Identifier -> Maybe String-tabSearch pat cur vals-  | Just next <- Set.lookupGT cur' vals-  , B.isPrefixOf (idDenote pat') (idDenote next)-  = Just (B8.unpack (idBytes next))--  -- wrap around when pat is a user-  | Just next <- Set.lookupGE pat' vals-  , B.isPrefixOf (idDenote pat') (idDenote next)-  = Just (B8.unpack (idBytes next)) -- TODO: Use original case--  -- if all else fails, do nothing-  | otherwise = Nothing-  where-  pat' = mkId (B8.pack pat)-  cur' = mkId (B8.pack cur)--defaultNickColors :: [Color]-defaultNickColors =-  [cyan, magenta, green, yellow, blue,-   brightCyan, brightMagenta, brightGreen, brightBlue]--schedulePing :: ClientState -> IO ClientState-schedulePing st =-  do now <- getCurrentTime-     let pingTime = addUTCTime 60 now-     return (addTimerEvent pingTime TransmitPing st)--sendTimestampPing :: ClientState -> IO ClientState-sendTimestampPing st =-  do now <- getCurrentTime-     let ts = realToFrac (utcTimeToPOSIXSeconds now) :: Pico-         chopTrailingZeros = True-         tsStr = B8.pack (showFixed chopTrailingZeros ts)-     clientSend (pingCmd tsStr) st-     return $! set (clientServer0.ccConnection.connPingTime) (PingSent now) st

@@ -1,274 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{- | Administrative channel operations -}-module Moderation where--import Control.Applicative-import Control.Lens-import Data.ByteString (ByteString)-import Data.Foldable (for_)-import Data.Maybe (fromMaybe)-import Data.Time-import Data.Text (Text)-import Data.List (nub, delete)-import Data.List.Split (chunksOf)-import Data.Monoid-import qualified Data.ByteString.Char8 as B8-import qualified Data.Text.Encoding as Text--import Irc.Cmd-import Irc.Format-import Irc.Model-import Irc.Message--import ClientState--deopWaitDuration :: NominalDiffTime-deopWaitDuration = 5*60 -- seconds---- | Perform a privileged operation. If the connection doesn't--- already have +o on the channel it will be requested from--- ChanServ and the privileged operation will be scheduled to--- run when the connection gets +o.-doWithOps ::-  Identifier {- ^ channel -} ->-  (ClientState -> IO ClientState) {- ^ privileged operation -} ->-  ClientState -> IO ClientState-doWithOps = doWithOps' False--doWithOps' ::-  Bool {- ^ permanent change -} ->-  Identifier {- ^ channel -} ->-  (ClientState -> IO ClientState) {- ^ privileged operation -} ->-  ClientState -> IO ClientState-doWithOps' perm chan privop st-    | initiallyOp = finishUp st-    | otherwise = getOpFirst--  where-  conn = view (clientServer0 . ccConnection) st-  myNick = view connNick conn--  -- was I op when the command was entered-  initiallyOp = nickHasModeInChannel myNick 'o' chan conn--  handler = EventHandler-    { _evName = "Get op for privop"-    , _evOnEvent = \evTgt evMsg evSt ->-         case view mesgType evMsg of-           ModeMsgType True 'o' modeNick-             | mkId modeNick == myNick-             , evTgt    == chan -> finishUp evSt-           _ -> return (over clientAutomation (cons handler) evSt)-    }--  finishUp st1 = privop =<< installTimer st1--  getOpFirst =-    do clientSend (privMsgCmd "chanserv" ("op " <> idDenote chan)) st-       return (over clientAutomation (cons handler) st)--  computeDeopTime =-    do now <- getCurrentTime-       return (addUTCTime deopWaitDuration now)--  installTimer st0--    | perm && deopScheduled chan st0 =-         return $ filterTimerEvents (/= DropOperator chan) st0--    | perm = return st0--    | deopScheduled chan st0 || not initiallyOp =-         do time <- computeDeopTime-            return $ addTimerEvent time (DropOperator chan)-                   $ filterTimerEvents (/= DropOperator chan) st0--    | otherwise = return st0---- | Predicate to determine if a deop is scheduled to happen-deopScheduled ::-  Identifier {- ^ channel -} ->-  ClientState -> Bool-deopScheduled = elemOf (clientTimers . folded . folded . _DropOperator)--doAutoKickBan ::-  Identifier {- ^ channel -} ->-  Identifier {- ^ nick    -} ->-  Text       {- ^ reason  -} ->-  ClientState -> IO ClientState-doAutoKickBan chan nick reason st =-  -- TODO: Look up account name or hostname!-  do clientSend (modeCmd chan ["+b",banMask]) st-     clientSend (kickCmd chan nick (Text.encodeUtf8 reason)) st-     return st--  where-  conn = view (clientServer0 . ccConnection) st-  usr  = view (connUsers . at nick) conn-  nickMask = idDenote nick <> "!*@*"-  banMask = fromMaybe nickMask-          $ previews (folded . usrAccount . folded) ("$a:"<>) usr-        <|> previews (folded . usrHost    . folded) ("*!*@"<>) usr---- | Cancel any pending deop timer if I'm deopped-cancelDeopTimerOnDeop :: EventHandler-cancelDeopTimerOnDeop = EventHandler-  { _evName = "cancel deop timer on deop"-  , _evOnEvent = \evTgt evMsg evSt ->-      let evSt' = reschedule evSt-          conn = view (clientServer0 . ccConnection) evSt-      in-      case view mesgType evMsg of-        ModeMsgType False 'o' modeNick-          | mkId modeNick == view connNick conn ->-                return $ filterTimerEvents (/= DropOperator evTgt) evSt'--        _ -> return evSt'-  }-  where-  reschedule = over clientAutomation (cons cancelDeopTimerOnDeop)--doOp :: ClientState -> [Identifier] -> IO ClientState-doOp st nicks-  | Just chan <- focusedChan st =--      doWithOps'-        (null nicks || myNick `elem` nicks) -- permanent?-        chan-        (massModeChange True 'o' chan (nub (delete myNick nicks)))-        (clearInput st)--  | otherwise = return st--  where-  conn = view (clientServer0 . ccConnection) st-  myNick = view connNick conn---doDeop :: ClientState -> [Identifier] -> IO ClientState-doDeop st nicks-  | Just chan <- focusedChan st =--      doWithOps-        chan-        (massModeChange False 'o' chan nicks')-        (clearInput st)--  | otherwise = return st--  where-  -- deop myself last-  nicks'-    | null nicks = [myNick]-    | myNick `elem` nicks = nub (delete myNick nicks) ++ [myNick]-    | otherwise = nicks--  conn = view (clientServer0 . ccConnection) st-  myNick = view connNick conn--doVoice :: ClientState -> [Identifier] -> IO ClientState-doVoice st nicks-  | Just chan <- focusedChan st =-      doWithOps-        chan-        (massModeChange True 'v' chan nicks')-        (clearInput st)-  | otherwise = return st-  where-  conn = view (clientServer0 . ccConnection) st-  nicks'-    | null nicks = [view connNick conn]-    | otherwise  = nub nicks--doDevoice :: ClientState -> [Identifier] -> IO ClientState-doDevoice st nicks-  | Just chan <- focusedChan st =-      doWithOps-        chan-        (massModeChange False 'v' chan nicks')-        (clearInput st)-  | otherwise = return st-  where-  conn = view (clientServer0 . ccConnection) st-  nicks'-    | null nicks = [view connNick conn]-    | otherwise  = nub nicks--massModeChange ::-  Bool       {- ^ polarity -} ->-  Char       {- ^ mode     -} ->-  Identifier {- ^ channel  -} ->-  [Identifier] {- ^ nicks -} ->-  ClientState -> IO ClientState-massModeChange polarity mode chan nicks st =-  do let nickChunks = chunksOf (view connModes conn) nicks-     for_ nickChunks $ \nickChunk ->-       clientSend (modeCmd chan (modeArg (length nickChunk) : map idBytes nickChunk)) st-     return st-  where-  conn = view (clientServer0 . ccConnection) st-  polarityBs-    | polarity  = B8.empty-    | otherwise = B8.singleton '-'--  modeArg n = polarityBs <> B8.replicate n mode--doTopicCmd ::-  ByteString {- ^ new topic -} ->-  ClientState -> IO ClientState-doTopicCmd topic st-  | not (B8.null topic)-  , Just chan <- focusedChan st =-     let go st' = st' <$ clientSend (topicCmd chan topic) st' in-     case preview (connChannels . ix chan . chanModes . folded) conn of-       -- check if it's known that the mode isn't +t-       Just modes | hasn't (ix 't') modes -> go (clearInput st)-       _                                  -> doWithOps chan go (clearInput st)-  | otherwise = return st--  where-  conn = view (clientServer0 . ccConnection) st---doInvite ::-  ClientState ->-  Identifier {- ^ nickname -} ->-  IO ClientState-doInvite st nick =-  case focusedChan st of-    Nothing -> return st-    Just chan-      -- 'g' is the "FREEINVITE" mode, don't check for ops-      | channelHasMode chan 'g' conn -> go (clearInput st)--      -- it's an error to invite someone already in channel-      | has (connChannels . ix chan . chanUsers . ix nick) conn -> return st--      | otherwise -> doWithOps chan go (clearInput st)-      where-      conn = view (clientServer0 . ccConnection) st-      go st' = st' <$ clientSend (inviteCmd nick chan) st'---doKick ::-  ClientState               ->-  Identifier {- ^ nick   -} ->-  Text       {- ^ reason -} ->-  IO ClientState-doKick st nick msg-  | Just chan <- focusedChan st =-      doWithOps chan (\evSt ->-        evSt <$ clientSend (kickCmd chan nick (Text.encodeUtf8 msg)) evSt) (clearInput st)-  | otherwise = return st---doRemove ::-  ClientState               ->-  Identifier {- ^ nick   -} ->-  Text       {- ^ reason -} ->-  IO ClientState-doRemove st nick msg-  | Just chan <- focusedChan st =-      doWithOps chan (\evSt ->-        evSt <$ clientSend (removeCmd chan nick (Text.encodeUtf8 msg)) evSt) (clearInput st)-  | otherwise = return st

@@ -1,28 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module ServerSettings where--import Control.Lens-import Data.Text--import Network.Socket     (HostName, PortNumber)--data ServerSettings = ServerSettings-  { _ssNick          :: String-  , _ssUser          :: String-  , _ssReal          :: String-  , _ssUserInfo      :: String-  , _ssPassword      :: Maybe String-  , _ssSaslCredential:: Maybe (String,String)-  , _ssHostName      :: HostName-  , _ssPort          :: Maybe PortNumber-  , _ssTls           :: Bool-  , _ssTlsInsecure   :: Bool-  , _ssTlsClientCert :: Maybe FilePath-  , _ssTlsClientKey  :: Maybe FilePath-  , _ssConnectCmds   :: [Text]-  , _ssSocksProxy    :: Maybe (HostName,PortNumber)-  , _ssServerCerts   :: [FilePath]-  }--makeLenses ''ServerSettings

@@ -1,26 +0,0 @@-module Views.BanList where--import ClientState-import Control.Lens-import Graphics.Vty.Image--import Irc.Format-import Irc.Model--banListImage :: Char -> Identifier -> ClientState -> [Image]-banListImage mode chan st =-  case view (connChannels . ix chan . chanMaskLists . at mode) conn of-    Nothing -> [string (withForeColor defAttr red) "Unknown list"]-    Just [] -> [string (withForeColor defAttr green) "Empty list"]-    Just xs -> map renderEntry xs--  where-  conn = view (clientServer0 . ccConnection) st--renderEntry :: IrcMaskEntry -> Image-renderEntry entry =-      utf8Bytestring' (withForeColor defAttr red) (view maskEntryMask entry)-  <|> string defAttr " - "-  <|> utf8Bytestring' (withForeColor defAttr green) (view maskEntryWho entry)-  <|> string defAttr " - "-  <|> string (withForeColor defAttr yellow) (show (view maskEntryStamp entry))

@@ -1,468 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}--#ifndef MIN_VERSION_base-#define MIN_VERSION_base(x,y,z) 1-#endif--#ifndef MIN_VERSION_time-#define MIN_VERSION_time(x,y,z) 1-#endif--module Views.Channel (channelImage) where--import           Control.Lens-import qualified Data.ByteString as BS-import           Data.Foldable (toList)-import           Data.List (intersperse)-import           Data.Maybe (isJust)-import qualified Data.Map as Map-import           Data.Monoid-import qualified Data.Set as Set-import           Data.Text (Text)-import           Data.Time (TimeZone, UTCTime, formatTime, utcToZonedTime)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import           Graphics.Vty.Image-import           Text.Regex.TDFA-import           Text.Regex.TDFA.ByteString (compile, execute)--#if MIN_VERSION_time(1,5,0)-import Data.Time (defaultTimeLocale)-#else-import System.Locale (defaultTimeLocale)-#endif--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif--import Irc.Format-import Irc.Message-import Irc.Model-import Irc.Core--import ClientState-import ImageUtils--channelImage :: ClientState -> [Image]-channelImage st-  | view clientDetailView st = detailedImageForState st-  | otherwise                = compressedImageForState st--detailedImageForState :: ClientState -> [Image]-detailedImageForState !st-  = [ renderOne chan msg | (chan, msg, _img) <- activeMessages st]-  where-  zone = view clientTimeZone st-  renderOne chan x =-      timestamp <|>-      channel <|>-      string (withForeColor defAttr tyColor) (ty ++ " ") <|>-      statusMsgImage (view mesgStatus x) <|>-      renderFullUsermask (view mesgSender x) <|>-      string (withForeColor defAttr blue) (": ") <|>-      cleanText content-    where-    timestamp-      | view clientTimeView st = renderTimestamp zone (view mesgStamp x)-      | otherwise              = emptyImage--    -- show all channel names in detailed/full view-    channel-      | view clientFullView st = identImg (withForeColor defAttr brightBlack) chan-                              <|> string defAttr " "-      | otherwise              = emptyImage--    (tyColor, ty, content) = case view mesgType x of-       JoinMsgType              -> (green  , "Join", "")-       PartMsgType txt          -> (red    , "Part", txt)-       NickMsgType txt          -> (yellow , "Nick", asUtf8 (idBytes txt))-       QuitMsgType txt          -> (red    , "Quit", txt)-       PrivMsgType txt          -> (blue   , "Priv", txt)-       TopicMsgType txt         -> (yellow , "Topc", txt)-       ActionMsgType txt        -> (blue   , "Actn", txt)-       CtcpRspMsgType cmd txt   -> (yellow , "Ctcp", asUtf8 (cmd <> " " <> txt))-       CtcpReqMsgType cmd txt   -> (yellow , "Ctcp", asUtf8 (cmd <> " " <> txt))-       AwayMsgType txt          -> (yellow , "Away", txt)-       NoticeMsgType txt        -> (blue   , "Note", txt)-       KickMsgType who txt      -> (red    , "Kick", asUtf8 (idBytes who) <> " - " <> txt)-       ErrorMsgType txt         -> (red    , "ErrT", txt)-       ErrMsgType err           -> (red    , "ErrR", Text.pack (show err))-       InviteMsgType            -> (yellow , "Invt", "")-       KnockMsgType             -> (yellow , "Knoc", "")-       CallerIdDeliveredMsgType -> (yellow , "Delv", "")-       CallerIdMsgType          -> (yellow , "Call", "")-       ModeMsgType pol mode arg -> (yellow , "Mode", (if pol then "+" else "-")-                                        <> Text.pack [mode, ' ']-                                        <> asUtf8 arg)--renderTimestamp :: TimeZone -> UTCTime -> Image-renderTimestamp zone-  = string (withForeColor defAttr brightBlack)-  . formatTime defaultTimeLocale "%F %H:%M:%S "-  . utcToZonedTime zone--renderCompressedTimestamp :: TimeZone -> UTCTime -> Image-renderCompressedTimestamp zone-  = string (withForeColor defAttr brightBlack)-  . formatTime defaultTimeLocale "[%H:%M] "-  . utcToZonedTime zone--activeMessages :: ClientState -> [(Identifier,IrcMessage,Image)]-activeMessages st =-  case clientInputFilter st of-    FilterNicks nicks -> let nickset = Set.fromList (mkId . toUtf8 <$> nicks)-                         in filter (nicksFilter nickset . view _2) msgs-    FilterBody regex -> let r = compile defaultCompOpt defaultExecOpt regex-                        in filter (bodyFilter r . view _2) msgs-    NoFilter        -> msgs-  where-  focus = focusedName st--  msgs :: [(Identifier,IrcMessage,Image)]-  msgs | view clientFullView st = interleavedMessages st-       | otherwise =-           [ (focus, msg, img) | (msg,img) <- views (clientMessages . ix (focusedName st) . mlMessages) toList st ]--  nicksFilter nickset msg-    = views mesgSender userNick msg `Set.member` nickset--  bodyFilter :: Either a Regex -> IrcMessage -> Bool-  bodyFilter (Left _) _    = True -- regex compilation failed-  bodyFilter (Right r) msg =-    let isMatch = either (const True) isJust . execute r-    in isMatch (textOfMessage msg)--textOfMessage :: IrcMessage -> BS.ByteString-textOfMessage mesg =-    let f n = idBytes (views mesgSender userNick mesg) <> ": " <> Text.encodeUtf8 n-    in f (case mesg ^. mesgType of-             PrivMsgType   t -> t-             NoticeMsgType t -> t-             ActionMsgType t -> t-             KickMsgType _ t -> t-             PartMsgType   t -> t-             QuitMsgType   t -> t-             TopicMsgType  t -> t-             ErrorMsgType  t -> t-             _               -> "")--data InputFilter = FilterNicks [String] | FilterBody BS.ByteString | NoFilter--clientInputFilter :: ClientState -> InputFilter-clientInputFilter st = go (clientInput st)- where-     go (splitAt 8 -> ("/filter ",nicks)) = FilterNicks (words nicks)-     go (splitAt 6 -> ("/grep ",   txt)) = FilterBody (toUtf8 txt)-     go  _                               = NoFilter--compressedImageForState :: ClientState -> [Image]-compressedImageForState !st = renderOne (activeMessages st)-  where-  zone = view clientTimeZone st-  width = view clientWidth st-  activeChan = focusedName st--  ncolors = views clientNickColors length st-  formatNick me nick = identImg (withForeColor defAttr color) nick-    where-    color | me = red-          | otherwise = view clientNickColors st-                     !! mod (nickHash (idDenote nick)) ncolors--  ignores = view clientIgnores st--  renderOne [] = []-  renderOne ((chan,msg,colored):msgs) =-    case mbImg of-      Just img -> (timestamp <|> channel <|> img) : renderOne msgs-      Nothing  -> renderMeta ((chan,msg,colored):msgs)--    where-    timestamp-      | view clientTimeView st = renderCompressedTimestamp zone (view mesgStamp msg)-      | otherwise              = emptyImage--    nick = views mesgSender userNick msg--    visible = not (view (contains nick) ignores)--    -- when in the full monitor view we only show the names of the channels-    -- next to messages for the unfocused channel-    channel-      | chan == activeChan     = emptyImage-      | otherwise              = identImg (withForeColor defAttr brightBlack) chan-                              <|> string defAttr " "--    mbImg =-       case view mesgType msg of-         PrivMsgType _ | visible -> Just $-           statusMsgImage (view mesgStatus msg) <|>-           views mesgModes modePrefix msg <|>-           formatNick (view mesgMe msg) nick <|>-           string (withForeColor defAttr blue) (": ") <|>-           colored--         NoticeMsgType _ | visible -> Just $-           statusMsgImage (view mesgStatus msg) <|>-           string (withForeColor defAttr red) "! " <|>-           views mesgModes modePrefix msg <|>-           identImg (withForeColor defAttr red) nick <|>-           string (withForeColor defAttr blue) (": ") <|>-           colored--         ActionMsgType _ | visible -> Just $-           statusMsgImage (view mesgStatus msg) <|>-           string (withForeColor defAttr blue) "* " <|>-           views mesgModes modePrefix msg <|>-           identImg (withForeColor defAttr blue) nick <|>-           char defAttr ' ' <|>-           colored--         CtcpRspMsgType cmd params | visible -> Just $-           string (withForeColor defAttr red) "C " <|>-           views mesgModes modePrefix msg <|>-           identImg (withForeColor defAttr blue) nick <|>-           char defAttr ' ' <|>-           cleanText (asUtf8 cmd) <|>-           char defAttr ' ' <|>-           cleanText (asUtf8 params)--         KickMsgType who reason -> Just $-           views mesgModes modePrefix msg <|>-           formatNick (view mesgMe msg) nick <|>-           string (withForeColor defAttr red) " kicked " <|>-           identImg (withForeColor defAttr yellow) who <|>-           string (withForeColor defAttr blue) (": ") <|>-           cleanText reason--         ErrorMsgType err -> Just $-           string (withForeColor defAttr red) "Error: " <|>-           cleanText err--         ErrMsgType err -> Just $-           string (withForeColor defAttr red) "Error: " <|>-           text' defAttr (errorMessage err)--         InviteMsgType -> Just $-           identImg (withForeColor defAttr green) nick <|>-           text' defAttr " has invited you to join"--         CallerIdDeliveredMsgType -> Just $-           identImg (withForeColor defAttr green) nick <|>-           text' defAttr " has been notified of your message"--         CallerIdMsgType -> Just $-           identImg (withForeColor defAttr green) nick <|>-           text' defAttr " has sent you a message, use /ACCEPT to accept"--         ModeMsgType pol m arg -> Just $-           views mesgModes modePrefix msg <|>-           formatNick (view mesgMe msg) nick <|>-           string (withForeColor defAttr red) " set mode " <|>-           string (withForeColor defAttr white) ((if pol then '+' else '-'):[m,' ']) <|>-           utf8Bytestring' (withForeColor defAttr yellow) arg--         TopicMsgType txt -> Just $-           views mesgModes modePrefix msg <|>-           formatNick (view mesgMe msg) nick <|>-           string (withForeColor defAttr red) " set topic " <|>-           cleanText txt--         AwayMsgType txt -> Just $-           string (withForeColor defAttr red) "A " <|>-           formatNick (view mesgMe msg) nick <|>-           string (withForeColor defAttr red) " is away: " <|>-           cleanText txt--         _ -> Nothing--  renderMeta msgs = img-                 ++ renderOne rest-    where-    (mds,rest) = splitWith processMeta msgs-    mds1 = mergeMetadatas mds-    gap = char defAttr ' '--    -- the mds1 can be null in the full view due to dropped metas-    img | not (null mds1), view clientMetaView st-                = return -- singleton list-                $ cropRight width-                $ horizCat-                $ intersperse gap-                $ map renderCompressed mds1-        | otherwise = []--  processMeta (chan,msg,_) =-    case view mesgType msg of-      CtcpReqMsgType{} -> keep $ SimpleMetadata (char (withForeColor defAttr brightBlue) 'C') who-      JoinMsgType      -> keep $ SimpleMetadata (char (withForeColor defAttr green) '+') who-      PartMsgType{}    -> keep $ SimpleMetadata (char (withForeColor defAttr red) '-') who-      QuitMsgType{}    -> keep $ SimpleMetadata (char (withForeColor defAttr red) 'x') who-      KnockMsgType     -> keep $ SimpleMetadata (char (withForeColor defAttr yellow) 'K') who-      NickMsgType who' -> keep $ NickChange who who'-      _ | not visible  -> keep $ SimpleMetadata (char (withForeColor defAttr yellow) 'I') who-        | otherwise    -> Done-    where-    keep | chan == activeChan = Keep-         | otherwise          = const Drop-    who = views mesgSender userNick msg-    visible = not (view (contains who) ignores)--  conn = view (clientServer0 . ccConnection) st--  prefixes = view (connChanModeTypes . modesPrefixModes) conn--  modePrefix modes =-    string (withForeColor defAttr blue)-    [ prefix | (mode,prefix) <- prefixes, mode `elem` modes]--data CompressedMetadata-  = SimpleMetadata Image Identifier-  | NickChange Identifier Identifier--renderCompressed :: CompressedMetadata -> Image-renderCompressed md =-  case md of-    SimpleMetadata img who -> img <|> identImg metaAttr who-    NickChange who who' ->-      identImg metaAttr who <|>-      char (withForeColor defAttr yellow) '-' <|>-      identImg metaAttr who'-  where-  metaAttr = withForeColor defAttr brightBlack--statusMsgImage :: String -> Image-statusMsgImage status-  | null status = emptyImage-  | otherwise =-           char defAttr '(' <|>-           string (withForeColor defAttr brightRed) status <|>-           string defAttr ") "---errorMessage :: IrcError -> Text-errorMessage e =-  case e of-    ErrCantKillServer         -> "Can't kill server"-    ErrYoureBannedCreep       -> "Banned from server"-    ErrNoOrigin               -> "No origin on PING or PONG"-    ErrErroneousNickname nick -> "Erroneous nickname: " <> asUtf8 nick-    ErrNoNicknameGiven        -> "No nickname given"-    ErrNicknameInUse nick     -> "Nickname in use: " <> asUtf8 (idBytes nick)-    ErrNotRegistered          -> "Not registered"-    ErrNoSuchServer server    -> "No such server: " <> asUtf8 server-    ErrUnknownMode mode       -> "Unknown mode: " <> Text.pack [mode]-    ErrNoPrivileges           -> "No privileges"-    ErrUnknownUmodeFlag mode  -> "Unknown UMODE: " <> Text.pack [mode]-    ErrUnknownCommand cmd     -> "Unknown command: " <> asUtf8 cmd-    ErrNoTextToSend           -> "No text to send"-    ErrNoMotd                 -> "No MOTD"-    ErrNoRecipient            -> "No recipient"-    ErrNoAdminInfo server     -> "No admin info for server: "<> asUtf8 server-    ErrAcceptFull             -> "ACCEPT list is full"-    ErrAcceptExist            -> "Already on ACCEPT list"-    ErrAcceptNot              -> "Not on ACCEPT list"-    ErrNeedMoreParams cmd     -> "Need more parameters: " <> asUtf8 cmd-    ErrAlreadyRegistered      -> "Already registered"-    ErrNoPermForHost          -> "No permission for host"-    ErrPasswordMismatch       -> "Password mismatch"-    ErrUsersDontMatch         -> "Can't change modes for other users"-    ErrHelpNotFound _         -> "Help topic not found"-    ErrBadChanName name       -> "Illegal channel name: " <> asUtf8 name-    ErrNoOperHost             -> "No OPER line for this host"--    ErrNoSuchNick             -> "No such nick"-    ErrWasNoSuchNick          -> "Was no such nick"-    ErrOwnMode                -> "Can't send while +g is set"-    ErrNoNonReg               -> "Messages blocked from unregistered users"-    ErrIsChanService nick     -> "Protected service: " <> asUtf8 (idBytes nick)-    ErrBanNickChange          -> "Can't change kick when banned"-    ErrNickTooFast            -> "Changed nickname too fast"-    ErrUnavailResource        -> "Resource unavailable"-    ErrThrottle               -> "Unable to join due to throttle"-    ErrTooManyChannels        -> "Too many channels joined"-    ErrServicesDown           -> "Services are unavailable"-    ErrUserNotInChannel nick  -> "Not in channel: " <> asUtf8 (idBytes nick)-    ErrNotOnChannel           -> "Must join channel"-    ErrChanOpPrivsNeeded      -> "Channel privileges needed"-    ErrBadChannelKey          -> "Bad channel key"-    ErrBannedFromChan         -> "Unable to join due to ban"-    ErrChannelFull            -> "Channel is full"-    ErrInviteOnlyChan         -> "Invite only channel"-    ErrNoSuchChannel          -> "No such channel"-    ErrCannotSendToChan       -> "Cannot send to channel"-    ErrTooManyTargets         -> "Too many targets"-    ErrBanListFull mode       -> "Ban list full: " <> Text.singleton mode-    ErrUserOnChannel nick     -> "User already on channel: " <> asUtf8 (idBytes nick)-    ErrLinkChannel chan       -> "Forwarded to: " <> asUtf8 (idBytes chan)-    ErrNeedReggedNick         -> "Registered nick required"-    ErrVoiceNeeded            -> "Voice or operator status required"--    ErrKnockOnChan            -> "Attempted to knock joined channel"-    ErrTooManyKnocks          -> "Too many knocks"-    ErrChanOpen               -> "Knock unnecessary"-    ErrTargUmodeG             -> "Message ignored by +g mode"-    ErrNoPrivs priv           -> "Oper privilege required: " <> asUtf8 priv-    ErrMlockRestricted m ms   -> "Mode '" <> Text.singleton m <> "' in locked set \""-                                 <> asUtf8 ms <> "\""--data SplitResult a-  = Drop   -- drop this element but keep processing-  | Done   -- stop processing-  | Keep a -- produce an output and keep processing--splitWith :: (a -> SplitResult b) -> [a] -> ([b],[a])-splitWith _ [] = ([],[])-splitWith f (x:xs) =-  case f x of-    Done -> ([],x:xs)-    Drop -> splitWith f xs-    Keep y  -> case splitWith f xs of-                 (ys,xs') -> (y:ys, xs')--mergeMetadatas :: [CompressedMetadata] -> [CompressedMetadata]-mergeMetadatas (SimpleMetadata img1 who1 : SimpleMetadata img2 who2 : xs)-  | who1 == who2      = mergeMetadatas (SimpleMetadata (img1 <|> img2) who1 : xs)-mergeMetadatas (x:xs) = x : mergeMetadatas xs-mergeMetadatas []     = []--interleavedMessages :: ClientState -> [(Identifier,IrcMessage,Image)]-interleavedMessages st = merge lists-  where-  lists :: [[(Identifier,IrcMessage,Image)]]-  lists = [ [ (chan, msg, img) | (msg,img) <- view mlMessages msgs ]-          | (chan,msgs) <- views clientMessages Map.toList st-          ]--  merge ::-    [[(Identifier,IrcMessage,Image)]] ->-    [(Identifier,IrcMessage,Image)]-  merge []  = []-  merge [x] = x-  merge xs  = merge (mergeN1 xs)--  -- merge every two lists into one-  mergeN1 ::-    [[(Identifier,IrcMessage,Image)]] ->-    [[(Identifier,IrcMessage,Image)]]-  mergeN1 [] = []-  mergeN1 [x] = [x]-  mergeN1 (x:y:z) = merge2 x y : mergeN1 z--  -- merge two sorted lists into one-  merge2 ::-    [(Identifier,IrcMessage,Image)] ->-    [(Identifier,IrcMessage,Image)] ->-    [(Identifier,IrcMessage,Image)]-  merge2 [] ys = ys-  merge2 xs [] = xs-  merge2 (x:xs) (y:ys)-    | view (_2.mesgStamp) x >= view (_2.mesgStamp) y = x : merge2 xs (y:ys)-    | otherwise                                      = y : merge2 (x:xs) ys--toUtf8 :: String -> BS.ByteString-toUtf8 = Text.encodeUtf8 . Text.pack

@@ -1,93 +0,0 @@-module Views.ChannelInfo where--import ClientState-import Control.Lens-import Data.ByteString (ByteString)-import Data.List (partition)-import Data.Map (Map)-import Data.Monoid-import Graphics.Vty.Image-import ImageUtils-import qualified Data.ByteString.Char8 as B8-import qualified Data.Map as Map--import Irc.Format-import Irc.Model--channelInfoImage :: Identifier -> ClientState -> [Image]-channelInfoImage chan st =--  let conn = view (clientServer0 . ccConnection) st in--  case view (connChannels . at chan) conn of-    Nothing -> [string (withForeColor defAttr red) "Unknown channel"]-    Just channel -> topicLines-                 ++ creationLines-                 ++ modeLines-                 ++ urlLines-                 ++ usersLines-      where-      topicLines =-        case view chanTopic channel of-          Nothing -> [string (withForeColor defAttr red) "Unknown topic"]-          Just Nothing ->-            [ string (withForeColor defAttr green) "Empty Topic "-            ]-          Just (Just (topic, user, time)) ->-            [ string (withForeColor defAttr green) "Topic: "  <|> cleanText topic-            , string (withForeColor defAttr green) "Set by: " <|> cleanText (asUtf8 user)-            , string (withForeColor defAttr green) "Set on: " <|> string defAttr (show time)-            ]--      creationLines =-        case view chanCreation channel of-          Nothing -> [string (withForeColor defAttr red) "Unknown creation time"]-          Just time -> [ string (withForeColor defAttr green) "Created on: " <|>-                         string defAttr (show time)-                       ]--      modeLines =-        case view chanModes channel of-          Nothing -> [string (withForeColor defAttr red) "Unknown mode"]-          Just modes -> [ string (withForeColor defAttr green) "Mode: " <|>-                          utf8Bytestring' defAttr (renderModes modes)-                        ]--      urlLines =-        case view chanUrl channel of-          Nothing -> [string (withForeColor defAttr red) "Unknown URL"]-          Just url -> [ string (withForeColor defAttr green) "URL: " <|>-                        cleanText (asUtf8 url)-                      ]--      prefixes = view (connChanModeTypes . modesPrefixModes) conn-      modePrefix modes =-        string (withForeColor defAttr blue)-        [ prefix | (mode,prefix) <- prefixes, mode `elem` modes ]--      usersLines-        = return-        $ horizCat-        $ string (withForeColor defAttr green) "Users ("-        : string defAttr (show (Map.size (view chanUsers channel)))-        : string (withForeColor defAttr green) "):"-        : [ char defAttr ' ' <|>-            modePrefix modes <|>-            identImg defAttr nick-          | (nick,modes) <- reorderUsers (map fst prefixes)-                          $ Map.toList (view chanUsers channel)-          ]--reorderUsers :: [Char] -> [(Identifier,[Char])] -> [(Identifier,[Char])]-reorderUsers []     users = users-reorderUsers (m:ms) users = haves ++ reorderUsers ms havenots-  where-  (haves,havenots) = partition (elem m . snd) users--renderModes :: Map Char ByteString -> ByteString-renderModes modes = B8.pack ('+':modeLetters)-                 <> B8.concat (map (B8.cons ' ')-                                   (filter (not . B8.null)-                                           modeArgs))-  where-  (modeLetters,modeArgs) = unzip (Map.toList modes)

@@ -1,170 +1,47 @@ name:                irc-core-version:             1.1.5+version:             2.0.0.0+synopsis:            IRC core library for glirc+description:         IRC core library for glirc+                     .+                     The glirc client has been split off into https://hackage.haskell.org/package/glirc homepage:            https://github.com/glguy/irc-core-bug-reports:         https://github.com/glguy/irc-core/issues-license:             BSD3+license:             ISC license-file:        LICENSE author:              Eric Mertens-maintainer:          Eric Mertens <emertens@gmail.com>-copyright:           2015 Eric Mertens+maintainer:          emertens@gmail.com+copyright:           2016 Eric Mertens category:            Network build-type:          Simple+extra-source-files:  ChangeLog.md cabal-version:       >=1.10-synopsis:            An IRC client library and text client-tested-with:         GHC == 7.8.4, GHC == 7.10.3-description:-  This package provides an IRC connection library as well as a console-based IRC client-  that uses the library.-  .-  /Library module breakdown/-  .-  * "Irc.Cmd" - Functions for generating IRC protocol message for client-to-server-  .-  * "Irc.Core" - Functions for parsing low-level IRC messages into mid-level IRC messages-  .-  * "Irc.Core.Prisms" - Prisms for all of the mid-level IRC message constructors-  .-  * "Irc.Format" - Functions for parsing and rendering low-level IRC protocol messages-  .-  * "Irc.Message" - High-level IRC event messages for client interpretation-  .-  * "Irc.Model" - Functions for interpreting mid-level IRC messages to generate high-level-                  event messages and to maintain a consistent view of the connection-  .-  * "Irc.RateLimit" - Functions to assist with rate-limiting outgoing client messages-  .-  * "Irc.Time" - Internal compatibility module for time-1.4 and time-1.5 interop-  .-  /Library module breakdown/-  .-  * "Main" - Main client module-  .-  * "ClientState" - Types and operations representing the full state of the client-  .-  * "CommandArgs" - Types and functions for interpreting the initial client configuration-  .-  * "CommandParser" - Types and functions for parsing and pretty printing IRC commands-  .-  * "Connection" - Types and functions for establishing a plain and TLS connections-  .-  * "CtcpHandler" - Event handler for CTCP messages-  .-  * "EditBox" - Types and functions for managing the input box along the bottom of the client-  .-  * "HaskelHighlighter" - Haskell syntax highlighting support-  .-  * "ImageUtils" - Functions to support the various view construction-  .-  * "Moderation" - Implementation of various IRC channel moderation automation-  .-  * "ServerSettings" - Types for defining connection parameters for an IRC server-  .-  * "Views.BanList" - Functions to generate the ban list view-  .-  * "Views.Channel" - Functions to generate message list views-  .-  * "Views.ChannelInfo" - Functions to generate metadata views for channels-  .-  See the associated README file for help using the client.--extra-source-files:     README.md-                        CHANGELOG.md+homepage:            https://github.com/glguy/irc-core+bug-reports:         https://github.com/glguy/irc-core/issues --- Use time-1.5 and drop old-locale-flag time15-  default: True+source-repository head+  type: git+  location: git://github.com/glguy/irc-core.git+  branch: v2  library-  exposed-modules:     Irc.Core-                       Irc.Core.Prisms-                       Irc.Cmd+  exposed-modules:     Irc.Codes+                       Irc.Commands+                       Irc.Identifier                        Irc.Message-                       Irc.Model-                       Irc.Format+                       Irc.Modes                        Irc.RateLimit--  other-modules:       Irc.Time--  -- Note: GHC 7.8.4 fixes a bug that can cause IRC.Core-  -- to use an absurd amount of RAM when compiling.-  -- The base >= 4.7.0.2 is to protect people from finding-  -- this out the hard way.-  build-depends:       base             >= 4.7.0.2  && < 4.10,--                       array            >= 0.5      && < 0.6,-                       attoparsec       >= 0.12.1.2 && < 0.14,-                       bytestring       >= 0.10     && < 0.11,-                       base64-bytestring>= 1.0.0.1  && < 1.1,-                       containers       >= 0.5      && < 0.6,-                       free             >= 4.11     && < 4.13,-                       lens             >= 4.7      && < 4.15,-                       text             >= 1.2.0.4  && < 1.3,-                       transformers     >= 0.2      && < 0.6,-                       regex-tdfa       >= 1.2      && < 1.3+                       Irc.RawIrcMsg+                       Irc.UserInfo -  if flag(time15)-    build-depends:     time             >= 1.5      && < 1.7-  else-    build-depends:     time             >= 1.4.2    && < 1.5,-                       old-locale       >= 1.0.0.6  && < 1.1+  build-depends:       base       >=4.9  && <4.10,+                       attoparsec >=0.13 && <0.14,+                       bytestring >=0.10 && <0.11,+                       hashable   >=1.2  && <1.3,+                       lens       >=4.14 && <4.15,+                       memory     >=0.13 && <0.14,+                       primitive  >=0.6  && <0.7,+                       text       >=1.2  && <1.3,+                       time       >=1.6  && <1.7,+                       vector     >=0.11 && <0.12    hs-source-dirs:      src   default-language:    Haskell2010--executable glirc-  main-is: Main.hs-  other-modules: ClientState-                 CommandArgs-                 CommandParser-                 Connection-                 ConnectCmds-                 CtcpHandler-                 EditBox-                 HaskellHighlighter-                 ImageUtils-                 Moderation-                 ServerSettings-                 Views.BanList-                 Views.Channel-                 Views.ChannelInfo-                 Paths_irc_core-  hs-source-dirs: driver-  ghc-options: -threaded-  build-depends: irc-core,--                 connection       >= 0.2.4    && < 0.3,-                 tls              >= 1.2.16   && < 1.4,-                 data-default-class >= 0.0.1  && < 0.2,-                 x509             >= 1.5.0.1  && < 1.7,-                 x509-system      >= 1.5.0    && < 1.7,-                 x509-store       >= 1.5.0    && < 1.7,-                 x509-validation  >= 1.5.1    && < 1.7,--                 array            >= 0.5      && < 0.6,-                 base             >= 4.7      && < 4.10,-                 bytestring       >= 0.10.4.0 && < 0.11,-                 containers       >= 0.5      && < 0.6,-                 config-value     >= 0.4      && < 0.5,-                 deepseq          >= 1.3.0.2  && < 1.5,-                 directory        >= 1.2.1.0  && < 1.3,-                 filepath         >= 1.3.0.2  && < 1.5,-                 lens             >= 4.7      && < 4.15,-                 network          >= 2.6.0.2  && < 2.7,-                 split            >= 0.2.2    && < 0.3,-                 stm              >= 2.4.4    && < 2.5,-                 text             >= 1.2.0.4  && < 1.3,-                 vty              >= 5.2.7    && < 5.6,-                 haskell-lexer    >= 1.0      && < 1.1,-                 transformers     >= 0.2      && < 0.6,-                 regex-tdfa       >= 1.2      && < 1.3-  default-language:    Haskell2010--  if flag(time15)-    build-depends:     time             >= 1.5      && < 1.7-  else-    build-depends:     time             >= 1.4.2    && < 1.5,-                       old-locale       >= 1.0.0.6  && < 1.1--source-repository head-  type: git-  location: git://github.com/glguy/irc-core.git

@@ -1,451 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | This module provides functions for constructing--- outgoing IRC messages from the client to the server.------ Note: These functions add the required trailing newline--- characters.-module Irc.Cmd-  ( passCmd-  , nickCmd-  , userCmd-  , operCmd-  , modeCmd-  , quitCmd-  , joinCmd-  , partCmd-  , topicCmd-  , namesCmd-  , listCmd-  , inviteCmd-  , kickCmd-  , privMsgCmd-  , ctcpRequestCmd-  , ctcpResponseCmd-  , noticeCmd-  , whoisCmd-  , whowasCmd-  , whoCmd-  , pongCmd-  , pingCmd-  , capLsCmd-  , capReqCmd-  , capEndCmd-  , authenticateCmd-  , awayCmd-  , helpCmd-  , removeCmd-  , knockCmd-  , acceptCmd-  , timeCmd-  , adminCmd-  , statsCmd-  ) where--import Data.Monoid-import Data.ByteString (ByteString)-import Data.Foldable (toList)-import qualified Data.ByteString.Char8 as B8--import Irc.Format--outgoingMsg :: RawIrcMsg-outgoingMsg = RawIrcMsg-  { msgTime = Nothing-  , msgPrefix = Nothing-  , msgCommand = ""-  , msgParams = []-  }---- | Construct a MODE command------ @MODE target *(mode) *(modeparams)@-modeCmd ::-  Identifier   {- ^ target -} ->-  [ByteString] {- ^ modes and params -} ->-  ByteString-modeCmd c modes = renderRawIrcMsg outgoingMsg-  { msgCommand  = "MODE"-  , msgParams = idBytes c : modes-  }---- | Construct a KICK command------ @KICK channel nick msg-kickCmd ::-  Identifier {- ^ channel -} ->-  Identifier {- ^ nick  -} ->-  ByteString {- ^ msg -} ->-  ByteString-kickCmd c nick msg = renderRawIrcMsg outgoingMsg-  { msgCommand  = "KICK"-  , msgParams = [idBytes c, idBytes nick, msg]-  }---- | Construct a REMOVE command------ @REMOVE channel nick msg-removeCmd ::-  Identifier {- ^ channel -} ->-  Identifier {- ^ nick  -} ->-  ByteString {- ^ msg -} ->-  ByteString-removeCmd c nick msg = renderRawIrcMsg outgoingMsg-  { msgCommand  = "REMOVE"-  , msgParams = [idBytes c, idBytes nick, msg]-  }---- | Construct a JOIN command. A join command--- can support multiple channels separated by--- commas, and takes an optional channel key.------ @JOIN channel [key]@-joinCmd :: Identifier -> Maybe ByteString -> ByteString-joinCmd chan mbKeys = renderRawIrcMsg outgoingMsg-  { msgCommand  = "JOIN"-  , msgParams = [idBytes chan] <> toList mbKeys-  }---- | Construct a PART command.------ @PART channel message@-partCmd ::-  Identifier {- ^ channel -} ->-  ByteString {- ^ message -} ->-  ByteString-partCmd chan msg = renderRawIrcMsg outgoingMsg-  { msgCommand  = "PART"-  , msgParams = [idBytes chan,msg]-  }---- | Construct a TOPIC command. This is used to lookup--- the current topic or to change it.------ @TOPIC channel message@-topicCmd ::-  Identifier {- ^ channel -} ->-  ByteString {- ^ topic   -} ->-  ByteString-topicCmd chan msg = renderRawIrcMsg outgoingMsg-  { msgCommand  = "TOPIC"-  , msgParams = [idBytes chan,msg]-  }---- | Construct a WHOIS command.------ @WHOIS user@-whoisCmd ::-  Identifier {- ^ user -} ->-  ByteString-whoisCmd user = renderRawIrcMsg outgoingMsg-  { msgCommand  = "WHOIS"-  , msgParams = [idBytes user]-  }---- | Construct a WHOWAS command.------ @WHOWAS user@-whowasCmd ::-  Identifier {- ^ user -} ->-  ByteString-whowasCmd user = renderRawIrcMsg outgoingMsg-  { msgCommand  = "WHOWAS"-  , msgParams = [idBytes user]-  }---- | Construct a NICK command. This is used to specify--- the initial nickname as well as to change it.------ @NICK nickname@-nickCmd ::-  Identifier {- ^ nickname -} ->-  ByteString-nickCmd nick = renderRawIrcMsg outgoingMsg-  { msgCommand = "NICK"-  , msgParams = [idBytes nick]-  }---- | Construct a USER command. This is used in the initial--- handshake to specify username and realname.------ @USER username 0 * realname@-userCmd ::-  ByteString {- ^ username -} ->-  ByteString {- ^ realname -} ->-  ByteString-userCmd user realname = renderRawIrcMsg outgoingMsg-  { msgCommand = "USER"-  , msgParams = [user,"0","*",realname]-  }---- | Construct a PING command. This is used to respond to the PING--- command to keep a connection alive.------ @PONG token@-pingCmd ::-  ByteString {- ^ token -} ->-  ByteString-pingCmd token = renderRawIrcMsg outgoingMsg-  { msgCommand = "PING"-  , msgParams = [token]-  }---- | Construct a PONG command. This is used to respond to the PING--- command to keep a connection alive.------ @PONG token@-pongCmd ::-  ByteString {- ^ token -} ->-  ByteString-pongCmd token = renderRawIrcMsg outgoingMsg-  { msgCommand = "PONG"-  , msgParams = [token]-  }---- | Construct a PASS command. This is used in the initial handshake--- to specify a password for the connection.------ @PASS password@-passCmd ::-  ByteString {- ^ password -} ->-  ByteString-passCmd password = renderRawIrcMsg outgoingMsg-  { msgCommand = "PASS"-  , msgParams = [password]-  }---- | Construct a CAP LS command. This is used during the inital connection--- to request a list of extensions that are supported by the server. It--- should be followed by CAP REQ and eventually CAP END commands.------ @CAP LS@-capLsCmd :: ByteString-capLsCmd = renderRawIrcMsg outgoingMsg-  { msgCommand = "CAP"-  , msgParams = ["LS"]-  }---- | Construct a CAP REQ command. This is used to request a subset of--- the capabilities returned in response to a CAP LS command.------ @CAP REQ :cap0 cap1 .. capN@-capReqCmd :: [ByteString] -> ByteString-capReqCmd caps = renderRawIrcMsg outgoingMsg-  { msgCommand    = "CAP"-  , msgParams = ["REQ",B8.unwords caps]-  }---- | Construct a CAP END command. This terminates the capability--- negotiation portion of the initial connection.------ @CAP END@-capEndCmd :: ByteString-capEndCmd = renderRawIrcMsg outgoingMsg-  { msgCommand    = "CAP"-  , msgParams = ["END"]-  }---- | Construct a PRIVMSG command. This send normal chat messages--- to both users as well as channels.------ @PRIVMSG target message@-privMsgCmd ::-  Identifier {- ^ target  -} ->-  ByteString {- ^ message -} ->-  ByteString-privMsgCmd target msg = renderRawIrcMsg outgoingMsg-  { msgCommand = "PRIVMSG"-  , msgParams = [idBytes target,msg]-  }--ctcpRequestCmd ::-  Identifier {- ^ target  -} ->-  ByteString {- ^ command -} ->-  ByteString {- ^ parameters -} ->-  ByteString-ctcpRequestCmd target command params = renderRawIrcMsg outgoingMsg-  { msgCommand = "PRIVMSG"-  , msgParams  = [idBytes target, "\x01" <> command <> " " <> params <> "\x01"]-  }--ctcpResponseCmd ::-  Identifier {- ^ target  -} ->-  ByteString {- ^ command -} ->-  ByteString {- ^ parameters -} ->-  ByteString-ctcpResponseCmd target command params = renderRawIrcMsg outgoingMsg-  { msgCommand = "NOTICE"-  , msgParams  = [idBytes target, "\x01" <> command <> " " <> params <> "\x01"]-  }---- | Construct a NOTICE command. This send notice chat messages--- to both users as well as channels.------ @NOTICE target message@-noticeCmd ::-  Identifier {- ^ target  -} ->-  ByteString {- ^ message -} ->-  ByteString-noticeCmd target msg = renderRawIrcMsg outgoingMsg-  { msgCommand = "NOTICE"-  , msgParams = [idBytes target,msg]-  }---- | Construct an AUTHENTICATE command.------ @AUTHENTICATE message@-authenticateCmd ::-  ByteString {- ^ message -} ->-  ByteString-authenticateCmd msg = renderRawIrcMsg outgoingMsg-  { msgCommand = "AUTHENTICATE"-  , msgParams = [msg]-  }---- | Construct a HELP command.------ @HELP topic@-helpCmd ::-  ByteString {- ^ topic -} ->-  ByteString-helpCmd msg = renderRawIrcMsg outgoingMsg-  { msgCommand = "HELP"-  , msgParams = [msg]-  }---- | Construct an AWAY command.------ @AWAY away_message@-awayCmd ::-  ByteString {- ^ message -} ->-  ByteString-awayCmd msg = renderRawIrcMsg outgoingMsg-  { msgCommand = "AWAY"-  , msgParams = [msg]-  }---- | Construct a QUIT command.------ @QUIT quit_message@-quitCmd ::-  ByteString {- ^ message -} ->-  ByteString-quitCmd msg = renderRawIrcMsg outgoingMsg-  { msgCommand = "QUIT"-  , msgParams = [msg]-  }---- | Construct a LIST command.------ @LIST <channel> *("," <channel>) @-listCmd ::-  [Identifier] {- ^ channels -} ->-  ByteString-listCmd chans = renderRawIrcMsg outgoingMsg-  { msgCommand = "LIST"-  , msgParams = [B8.intercalate "," (map idBytes chans)]-  }---- | Construct a INVITE command.------ @INVITE <nickanme> <channel>@-inviteCmd ::-  Identifier {- ^ nickname -} ->-  Identifier {- ^ channel  -} ->-  ByteString-inviteCmd nick chan = renderRawIrcMsg outgoingMsg-  { msgCommand = "INVITE"-  , msgParams = [idBytes nick,idBytes chan]-  }---- | Construct a NAMES command.------ @NAMES [ <channel> *("," <channel>)@-namesCmd ::-  [Identifier] {- ^ channels -} ->-  ByteString-namesCmd chans = renderRawIrcMsg outgoingMsg-  { msgCommand = "NAMES"-  , msgParams = if null chans-                  then []-                  else [B8.intercalate "," (map idBytes chans)]-  }---- | Construct an OPER command.------ @OPER <name> <password>@-operCmd ::-  ByteString {- ^ name -} ->-  ByteString {- ^ password -} ->-  ByteString-operCmd name pass = renderRawIrcMsg outgoingMsg-  { msgCommand = "OPER"-  , msgParams = [name,pass]-  }---- | Construct a WHO command.------ @WHO <mask>@-whoCmd ::-  ByteString {- ^ mask -} ->-  ByteString-whoCmd mask = renderRawIrcMsg outgoingMsg-  { msgCommand = "WHO"-  , msgParams = [mask]-  }---- | Construct a KNOCK command.------ @KNOCK <channel>@-knockCmd ::-  Identifier {- ^ channel -} ->-  ByteString-knockCmd chan = renderRawIrcMsg outgoingMsg-  { msgCommand = "KNOCK"-  , msgParams = [idBytes chan]-  }---- | Construct an ACCEPT command.------ @ACCEPT <nick>@-acceptCmd ::-  ByteString {- ^ nick, -nick, * -} ->-  ByteString-acceptCmd nick = renderRawIrcMsg outgoingMsg-  { msgCommand = "ACCEPT"-  , msgParams = [nick]-  }---- | Construct an TIME command.------ @TIME [<server>]>@-timeCmd ::-  Maybe ByteString {- ^ server -} ->-  ByteString-timeCmd server = renderRawIrcMsg outgoingMsg-  { msgCommand = "TIME"-  , msgParams = toList server-  }---- | Construct an ADMIN command.------ @ADMIN [<server>]>@-adminCmd ::-  Maybe ByteString {- ^ server -} ->-  ByteString-adminCmd server = renderRawIrcMsg outgoingMsg-  { msgCommand = "ADMIN"-  , msgParams = toList server-  }---- | Construct a STATS command.------ @STATS <letter> [<server>]>@-statsCmd ::-  Char ->-  Maybe ByteString {- ^ target -} ->-  ByteString-statsCmd letter target = renderRawIrcMsg outgoingMsg-  { msgCommand = "STATS"-  , msgParams = B8.singleton letter : toList target-  }

@@ -0,0 +1,854 @@+{-# Language PatternSynonyms, OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}++{-|+Module      : Irc.Codes+Description : Helpers for interpreting IRC reply codes+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module defines support for working with IRC's numeric reply+codes. Pattern synonyms are provided for each of the possible IRC reply codes.++Reply code information was extracted from https://www.alien.net.au/irc/irc2numerics.html++-}++module Irc.Codes where++import           Data.Vector (Vector)+import qualified Data.Vector as Vector+import           Data.Text (Text)+import qualified Data.Text as Text++-- | Type of numeric reply codes+newtype ReplyCode = ReplyCode Word++instance Show ReplyCode where+  showsPrec p (ReplyCode x) = showsPrec p x++-- | Categories for reply codes+data ReplyType+  = ClientServerReply -- ^ 0-99 Messages between client and server+  | CommandReply      -- ^ 200-399 Responses to commands+  | ErrorReply        -- ^ 200-399 Errors+  | UnknownReply      -- ^ Uncategorized++pattern RPL_WELCOME                 = ReplyCode 001+pattern RPL_YOURHOST                = ReplyCode 002+pattern RPL_CREATED                 = ReplyCode 003+pattern RPL_MYINFO                  = ReplyCode 004+pattern RPL_ISUPPORT                = ReplyCode 005+pattern RPL_SNOMASK                 = ReplyCode 008+pattern RPL_STATMEMTOT              = ReplyCode 009+pattern RPL_REDIR                   = ReplyCode 010+pattern RPL_YOURCOOKIE              = ReplyCode 014+pattern RPL_MAP                     = ReplyCode 015+pattern RPL_MAPEND                  = ReplyCode 017+pattern RPL_YOURID                  = ReplyCode 042+pattern RPL_SAVENICK                = ReplyCode 043+pattern RPL_ATTEMPTINGJUNC          = ReplyCode 050+pattern RPL_ATTEMPTINGREROUTE       = ReplyCode 051+pattern RPL_TRACELINK               = ReplyCode 200+pattern RPL_TRACECONNECTING         = ReplyCode 201+pattern RPL_TRACEHANDSHAKE          = ReplyCode 202+pattern RPL_TRACEUNKNOWN            = ReplyCode 203+pattern RPL_TRACEOPERATOR           = ReplyCode 204+pattern RPL_TRACEUSER               = ReplyCode 205+pattern RPL_TRACESERVER             = ReplyCode 206+pattern RPL_TRACESERVICE            = ReplyCode 207+pattern RPL_TRACENEWTYPE            = ReplyCode 208+pattern RPL_TRACECLASS              = ReplyCode 209+pattern RPL_TRACERECONNECT          = ReplyCode 210+pattern RPL_STATS                   = ReplyCode 210+pattern RPL_STATSLINKINFO           = ReplyCode 211+pattern RPL_STATSCOMMANDS           = ReplyCode 212+pattern RPL_STATSCLINE              = ReplyCode 213+pattern RPL_STATSNLINE              = ReplyCode 214+pattern RPL_STATSILINE              = ReplyCode 215+pattern RPL_STATSKLINE              = ReplyCode 216+pattern RPL_STATSQLINE              = ReplyCode 217+pattern RPL_STATSYLINE              = ReplyCode 218+pattern RPL_ENDOFSTATS              = ReplyCode 219+pattern RPL_STATSPLINE              = ReplyCode 220+pattern RPL_UMODEIS                 = ReplyCode 221+pattern RPL_SQLINE_NICK             = ReplyCode 222+pattern RPL_STATSDLINE              = ReplyCode 225+pattern RPL_STATSZLINE              = ReplyCode 225+pattern RPL_STATSCOUNT              = ReplyCode 226+pattern RPL_SERVICEINFO             = ReplyCode 231+pattern RPL_ENDOFSERVICES           = ReplyCode 232+pattern RPL_SERVICE                 = ReplyCode 233+pattern RPL_SERVLIST                = ReplyCode 234+pattern RPL_SERVLISTEND             = ReplyCode 235+pattern RPL_STATSVERBOSE            = ReplyCode 236+pattern RPL_STATSIAUTH              = ReplyCode 239+pattern RPL_STATSLLINE              = ReplyCode 241+pattern RPL_STATSUPTIME             = ReplyCode 242+pattern RPL_STATSOLINE              = ReplyCode 243+pattern RPL_STATSHLINE              = ReplyCode 244+pattern RPL_STATSSLINE              = ReplyCode 245+pattern RPL_STATSPING               = ReplyCode 246+pattern RPL_STATSXLINE              = ReplyCode 247+pattern RPL_STATSULINE              = ReplyCode 248+pattern RPL_STATSDEBUG              = ReplyCode 249+pattern RPL_STATSCONN               = ReplyCode 250+pattern RPL_LUSERCLIENT             = ReplyCode 251+pattern RPL_LUSEROP                 = ReplyCode 252+pattern RPL_LUSERUNKNOWN            = ReplyCode 253+pattern RPL_LUSERCHANNELS           = ReplyCode 254+pattern RPL_LUSERME                 = ReplyCode 255+pattern RPL_ADMINME                 = ReplyCode 256+pattern RPL_ADMINLOC1               = ReplyCode 257+pattern RPL_ADMINLOC2               = ReplyCode 258+pattern RPL_ADMINEMAIL              = ReplyCode 259+pattern RPL_TRACELOG                = ReplyCode 261+pattern RPL_ENDOFTRACE              = ReplyCode 262+pattern RPL_LOAD2HI                 = ReplyCode 263+pattern RPL_LOCALUSERS              = ReplyCode 265+pattern RPL_GLOBALUSERS             = ReplyCode 266+pattern RPL_START_NETSTAT           = ReplyCode 267+pattern RPL_NETSTAT                 = ReplyCode 268+pattern RPL_END_NETSTAT             = ReplyCode 269+pattern RPL_PRIVS                   = ReplyCode 270+pattern RPL_SILELIST                = ReplyCode 271+pattern RPL_ENDOFSILELIST           = ReplyCode 272+pattern RPL_NOTIFY                  = ReplyCode 273+pattern RPL_ENDNOTIFY               = ReplyCode 274+pattern RPL_STATSDELTA              = ReplyCode 274+pattern RPL_WHOISCERTFP             = ReplyCode 276+pattern RPL_VCHANLIST               = ReplyCode 277+pattern RPL_VCHANHELP               = ReplyCode 278+pattern RPL_GLIST                   = ReplyCode 280+pattern RPL_ACCEPTLIST              = ReplyCode 281+pattern RPL_ENDOFACCEPT             = ReplyCode 282+pattern RPL_ENDOFJUPELIST           = ReplyCode 283+pattern RPL_FEATURE                 = ReplyCode 284+pattern RPL_DATASTR                 = ReplyCode 290+pattern RPL_END_CHANINFO            = ReplyCode 299+pattern RPL_NONE                    = ReplyCode 300+pattern RPL_AWAY                    = ReplyCode 301+pattern RPL_USERHOST                = ReplyCode 302+pattern RPL_ISON                    = ReplyCode 303+pattern RPL_TEXT                    = ReplyCode 304+pattern RPL_UNAWAY                  = ReplyCode 305+pattern RPL_NOWAWAY                 = ReplyCode 306+pattern RPL_WHOISREGNICK            = ReplyCode 307+pattern RPL_SUSERHOST               = ReplyCode 307+pattern RPL_NOTIFYACTION            = ReplyCode 308+pattern RPL_WHOISADMIN              = ReplyCode 308+pattern RPL_NICKTRACE               = ReplyCode 309+pattern RPL_WHOISSADMIN             = ReplyCode 309+pattern RPL_WHOISHELPER             = ReplyCode 309+pattern RPL_WHOISUSER               = ReplyCode 311+pattern RPL_WHOISSERVER             = ReplyCode 312+pattern RPL_WHOISOPERATOR           = ReplyCode 313+pattern RPL_WHOWASUSER              = ReplyCode 314+pattern RPL_ENDOFWHO                = ReplyCode 315+pattern RPL_WHOISCHANOP             = ReplyCode 316+pattern RPL_WHOISIDLE               = ReplyCode 317+pattern RPL_ENDOFWHOIS              = ReplyCode 318+pattern RPL_WHOISCHANNELS           = ReplyCode 319+pattern RPL_WHOISSPECIAL            = ReplyCode 320+pattern RPL_LISTSTART               = ReplyCode 321+pattern RPL_LIST                    = ReplyCode 322+pattern RPL_LISTEND                 = ReplyCode 323+pattern RPL_CHANNELMODEIS           = ReplyCode 324+pattern RPL_CHANNELMLOCKIS          = ReplyCode 325+pattern RPL_NOCHANPASS              = ReplyCode 326+pattern RPL_CHPASSUNKNOWN           = ReplyCode 327+pattern RPL_CHANNEL_URL             = ReplyCode 328+pattern RPL_CREATIONTIME            = ReplyCode 329+pattern RPL_WHOWAS_TIME             = ReplyCode 330+pattern RPL_WHOISACCOUNT            = ReplyCode 330+pattern RPL_NOTOPIC                 = ReplyCode 331+pattern RPL_TOPIC                   = ReplyCode 332+pattern RPL_TOPICWHOTIME            = ReplyCode 333+pattern RPL_LISTUSAGE               = ReplyCode 334+pattern RPL_COMMANDSYNTAX           = ReplyCode 334+pattern RPL_LISTSYNTAX              = ReplyCode 334+pattern RPL_WHOISACTUALLY           = ReplyCode 338+pattern RPL_BADCHANPASS             = ReplyCode 339+pattern RPL_INVITING                = ReplyCode 341+pattern RPL_SUMMONING               = ReplyCode 342+pattern RPL_INVITED                 = ReplyCode 345+pattern RPL_INVEXLIST               = ReplyCode 346+pattern RPL_ENDOFINVEXLIST          = ReplyCode 347+pattern RPL_EXCEPTLIST              = ReplyCode 348+pattern RPL_ENDOFEXCEPTLIST         = ReplyCode 349+pattern RPL_VERSION                 = ReplyCode 351+pattern RPL_WHOREPLY                = ReplyCode 352+pattern RPL_NAMREPLY                = ReplyCode 353+pattern RPL_WHOSPCRPL               = ReplyCode 354+pattern RPL_NAMREPLY_               = ReplyCode 355+pattern RPL_WHOWASREAL              = ReplyCode 360+pattern RPL_KILLDONE                = ReplyCode 361+pattern RPL_CLOSING                 = ReplyCode 362+pattern RPL_CLOSEEND                = ReplyCode 363+pattern RPL_LINKS                   = ReplyCode 364+pattern RPL_ENDOFLINKS              = ReplyCode 365+pattern RPL_ENDOFNAMES              = ReplyCode 366+pattern RPL_BANLIST                 = ReplyCode 367+pattern RPL_ENDOFBANLIST            = ReplyCode 368+pattern RPL_ENDOFWHOWAS             = ReplyCode 369+pattern RPL_INFO                    = ReplyCode 371+pattern RPL_MOTD                    = ReplyCode 372+pattern RPL_INFOSTART               = ReplyCode 373+pattern RPL_ENDOFINFO               = ReplyCode 374+pattern RPL_MOTDSTART               = ReplyCode 375+pattern RPL_ENDOFMOTD               = ReplyCode 376+pattern RPL_WHOISHOST               = ReplyCode 378+pattern RPL_KICKLINKED              = ReplyCode 379+pattern RPL_YOUREOPER               = ReplyCode 381+pattern RPL_REHASHING               = ReplyCode 382+pattern RPL_YOURESERVICE            = ReplyCode 383+pattern RPL_MYPORTIS                = ReplyCode 384+pattern RPL_NOTOPERANYMORE          = ReplyCode 385+pattern RPL_RSACHALLENGE            = ReplyCode 386+pattern RPL_TIME                    = ReplyCode 391+pattern RPL_USERSSTART              = ReplyCode 392+pattern RPL_USERS                   = ReplyCode 393+pattern RPL_ENDOFUSERS              = ReplyCode 394+pattern RPL_NOUSERS                 = ReplyCode 395+pattern RPL_HOSTHIDDEN              = ReplyCode 396+pattern ERR_UNKNOWNERROR            = ReplyCode 400+pattern ERR_NOSUCHNICK              = ReplyCode 401+pattern ERR_NOSUCHSERVER            = ReplyCode 402+pattern ERR_NOSUCHCHANNEL           = ReplyCode 403+pattern ERR_CANNOTSENDTOCHAN        = ReplyCode 404+pattern ERR_TOOMANYCHANNELS         = ReplyCode 405+pattern ERR_WASNOSUCHNICK           = ReplyCode 406+pattern ERR_TOOMANYTARGETS          = ReplyCode 407+pattern ERR_NOORIGIN                = ReplyCode 409+pattern ERR_NORECIPIENT             = ReplyCode 411+pattern ERR_NOTEXTTOSEND            = ReplyCode 412+pattern ERR_NOTOPLEVEL              = ReplyCode 413+pattern ERR_WILDTOPLEVEL            = ReplyCode 414+pattern ERR_BADMASK                 = ReplyCode 415+pattern ERR_TOOMANYMATCHES          = ReplyCode 416+pattern ERR_LENGTHTRUNCATED         = ReplyCode 419+pattern ERR_UNKNOWNCOMMAND          = ReplyCode 421+pattern ERR_NOMOTD                  = ReplyCode 422+pattern ERR_NOADMININFO             = ReplyCode 423+pattern ERR_FILEERROR               = ReplyCode 424+pattern ERR_NOOPERMOTD              = ReplyCode 425+pattern ERR_TOOMANYAWAY             = ReplyCode 429+pattern ERR_EVENTNICKCHANGE         = ReplyCode 430+pattern ERR_NONICKNAMEGIVEN         = ReplyCode 431+pattern ERR_ERRONEUSNICKNAME        = ReplyCode 432+pattern ERR_NICKNAMEINUSE           = ReplyCode 433+pattern ERR_SERVICENAMEINUSE        = ReplyCode 434+pattern ERR_NORULES                 = ReplyCode 434+pattern ERR_BANNICKCHANGE           = ReplyCode 435+pattern ERR_NICKCOLLISION           = ReplyCode 436+pattern ERR_UNAVAILRESOURCE         = ReplyCode 437+pattern ERR_NICKTOOFAST             = ReplyCode 438+pattern ERR_TARGETTOOFAST           = ReplyCode 439+pattern ERR_SERVICESDOWN            = ReplyCode 440+pattern ERR_USERNOTINCHANNEL        = ReplyCode 441+pattern ERR_NOTONCHANNEL            = ReplyCode 442+pattern ERR_USERONCHANNEL           = ReplyCode 443+pattern ERR_NOLOGIN                 = ReplyCode 444+pattern ERR_SUMMONDISABLED          = ReplyCode 445+pattern ERR_USERSDISABLED           = ReplyCode 446+pattern ERR_NONICKCHANGE            = ReplyCode 447+pattern ERR_NOTIMPLEMENTED          = ReplyCode 449+pattern ERR_NOTREGISTERED           = ReplyCode 451+pattern ERR_IDCOLLISION             = ReplyCode 452+pattern ERR_NICKLOST                = ReplyCode 453+pattern ERR_HOSTILENAME             = ReplyCode 455+pattern ERR_ACCEPTFULL              = ReplyCode 456+pattern ERR_ACCEPTEXIST             = ReplyCode 457+pattern ERR_ACCEPTNOT               = ReplyCode 458+pattern ERR_NOHIDING                = ReplyCode 459+pattern ERR_NOTFORHALFOPS           = ReplyCode 460+pattern ERR_NEEDMOREPARAMS          = ReplyCode 461+pattern ERR_ALREADYREGISTERED       = ReplyCode 462+pattern ERR_NOPERMFORHOST           = ReplyCode 463+pattern ERR_PASSWDMISMATCH          = ReplyCode 464+pattern ERR_YOUREBANNEDCREEP        = ReplyCode 465+pattern ERR_YOUWILLBEBANNED         = ReplyCode 466+pattern ERR_KEYSET                  = ReplyCode 467+pattern ERR_INVALIDUSERNAME         = ReplyCode 468+pattern ERR_ONLYSERVERSCANCHANGE    = ReplyCode 468+pattern ERR_LINKSET                 = ReplyCode 469+pattern ERR_LINKCHANNEL             = ReplyCode 470+pattern ERR_CHANNELISFULL           = ReplyCode 471+pattern ERR_UNKNOWNMODE             = ReplyCode 472+pattern ERR_INVITEONLYCHAN          = ReplyCode 473+pattern ERR_BANNEDFROMCHAN          = ReplyCode 474+pattern ERR_BADCHANNELKEY           = ReplyCode 475+pattern ERR_BADCHANMASK             = ReplyCode 476+pattern ERR_NEEDREGGEDNICK          = ReplyCode 477+pattern ERR_BANLISTFULL             = ReplyCode 478+pattern ERR_BADCHANNAME             = ReplyCode 479+pattern ERR_THROTTLE                = ReplyCode 480+pattern ERR_NOPRIVILEGES            = ReplyCode 481+pattern ERR_CHANOPRIVSNEEDED        = ReplyCode 482+pattern ERR_CANTKILLSERVER          = ReplyCode 483+pattern ERR_ISCHANSERVICE           = ReplyCode 484+pattern ERR_BANNEDNICK              = ReplyCode 485+pattern ERR_NONONREG                = ReplyCode 486+pattern ERR_TSLESSCHAN              = ReplyCode 488+pattern ERR_VOICENEEDED             = ReplyCode 489+pattern ERR_NOOPERHOST              = ReplyCode 491+pattern ERR_NOSERVICEHOST           = ReplyCode 492+pattern ERR_NOFEATURE               = ReplyCode 493+pattern ERR_OWNMODE                 = ReplyCode 494+pattern ERR_BADLOGTYPE              = ReplyCode 495+pattern ERR_BADLOGSYS               = ReplyCode 496+pattern ERR_BADLOGVALUE             = ReplyCode 497+pattern ERR_ISOPERLCHAN             = ReplyCode 498+pattern ERR_CHANOWNPRIVNEEDED       = ReplyCode 499+pattern ERR_UMODEUNKNOWNFLAG        = ReplyCode 501+pattern ERR_USERSDONTMATCH          = ReplyCode 502+pattern ERR_GHOSTEDCLIENT           = ReplyCode 503+pattern ERR_USERNOTONSERV           = ReplyCode 504+pattern ERR_SILELISTFULL            = ReplyCode 511+pattern ERR_TOOMANYWATCH            = ReplyCode 512+pattern ERR_WRONGPONG               = ReplyCode 513+pattern ERR_BADEXPIRE               = ReplyCode 515+pattern ERR_DONTCHEAT               = ReplyCode 516+pattern ERR_DISABLED                = ReplyCode 517+pattern ERR_NOINVITE                = ReplyCode 518+pattern ERR_LONGMASK                = ReplyCode 518+pattern ERR_ADMONLY                 = ReplyCode 519+pattern ERR_TOOMANYUSERS            = ReplyCode 519+pattern ERR_OPERONLY                = ReplyCode 520+pattern ERR_MASKTOOWIDE             = ReplyCode 520+pattern ERR_WHOTRUNC                = ReplyCode 520+pattern ERR_LISTSYNTAX              = ReplyCode 521+pattern ERR_WHOSYNTAX               = ReplyCode 522+pattern ERR_WHOLIMEXCEED            = ReplyCode 523+pattern ERR_HELPNOTFOUND            = ReplyCode 524+pattern ERR_REMOTEPFX               = ReplyCode 525+pattern ERR_PFXUNROUTABLE           = ReplyCode 526+pattern ERR_BADHOSTMASK             = ReplyCode 550+pattern ERR_HOSTUNAVAIL             = ReplyCode 551+pattern ERR_USINGSLINE              = ReplyCode 552+pattern ERR_STATSSLINE              = ReplyCode 553+pattern RPL_LOGON                   = ReplyCode 600+pattern RPL_LOGOFF                  = ReplyCode 601+pattern RPL_WATCHOFF                = ReplyCode 602+pattern RPL_WATCHSTAT               = ReplyCode 603+pattern RPL_NOWON                   = ReplyCode 604+pattern RPL_NOWOFF                  = ReplyCode 605+pattern RPL_WATCHLIST               = ReplyCode 606+pattern RPL_ENDOFWATCHLIST          = ReplyCode 607+pattern RPL_WATCHCLEAR              = ReplyCode 608+pattern RPL_ISOPER                  = ReplyCode 610+pattern RPL_ISLOCOP                 = ReplyCode 611+pattern RPL_ISNOTOPER               = ReplyCode 612+pattern RPL_ENDOFISOPER             = ReplyCode 613+pattern RPL_DCCSTATUS               = ReplyCode 617+pattern RPL_DCCLIST                 = ReplyCode 618+pattern RPL_ENDOFDCCLIST            = ReplyCode 619+pattern RPL_WHOWASHOST              = ReplyCode 619+pattern RPL_DCCINFO                 = ReplyCode 620+pattern RPL_RULES                   = ReplyCode 621+pattern RPL_ENDOFO                  = ReplyCode 626+pattern RPL_SETTINGS                = ReplyCode 630+pattern RPL_ENDOFSETTINGS           = ReplyCode 631+pattern RPL_DUMPING                 = ReplyCode 640+pattern RPL_DUMPRPL                 = ReplyCode 641+pattern RPL_EODUMP                  = ReplyCode 642+pattern RPL_TRACEROUTE_HOP          = ReplyCode 660+pattern RPL_TRACEROUTE_START        = ReplyCode 661+pattern RPL_MODECHANGEWARN          = ReplyCode 662+pattern RPL_CHANREDIR               = ReplyCode 663+pattern RPL_SERVMODEIS              = ReplyCode 664+pattern RPL_OTHERUMODEIS            = ReplyCode 665+pattern RPL_ENDOF_GENERIC           = ReplyCode 666+pattern RPL_WHOWASDETAILS           = ReplyCode 670+pattern RPL_WHOISSECURE             = ReplyCode 671+pattern RPL_UNKNOWNMODES            = ReplyCode 672+pattern RPL_CANNOTSETMODES          = ReplyCode 673+pattern RPL_LUSERSTAFF              = ReplyCode 678+pattern RPL_TIMEONSERVERIS          = ReplyCode 679+pattern RPL_NETWORKS                = ReplyCode 682+pattern RPL_YOURLANGUAGEIS          = ReplyCode 687+pattern RPL_LANGUAGE                = ReplyCode 688+pattern RPL_WHOISSTAFF              = ReplyCode 689+pattern RPL_WHOISLANGUAGE           = ReplyCode 690+pattern RPL_MODLIST                 = ReplyCode 702+pattern RPL_ENDOFMODLIST            = ReplyCode 703+pattern RPL_HELPSTART               = ReplyCode 704+pattern RPL_HELPTXT                 = ReplyCode 705+pattern RPL_ENDOFHELP               = ReplyCode 706+pattern ERR_TARGCHANGE              = ReplyCode 707+pattern RPL_ETRACEFULL              = ReplyCode 708+pattern RPL_ETRACE                  = ReplyCode 709+pattern RPL_KNOCK                   = ReplyCode 710+pattern RPL_KNOCKDLVR               = ReplyCode 711+pattern ERR_TOOMANYKNOCK            = ReplyCode 712+pattern ERR_CHANOPEN                = ReplyCode 713+pattern ERR_KNOCKONCHAN             = ReplyCode 714+pattern ERR_KNOCKDISABLED           = ReplyCode 715+pattern RPL_TARGUMODEG              = ReplyCode 716+pattern RPL_TARGNOTIFY              = ReplyCode 717+pattern RPL_UMODEGMSG               = ReplyCode 718+pattern RPL_OMOTDSTART              = ReplyCode 720+pattern RPL_OMOTD                   = ReplyCode 721+pattern RPL_ENDOFOMOTD              = ReplyCode 722+pattern ERR_NOPRIVS                 = ReplyCode 723+pattern RPL_TESTMASK                = ReplyCode 724+pattern RPL_TESTLINE                = ReplyCode 725+pattern RPL_NOTESTLINE              = ReplyCode 726+pattern RPL_QUIETLIST               = ReplyCode 728+pattern RPL_ENDOFQUIETLIST          = ReplyCode 729+pattern RPL_MONONLINE               = ReplyCode 730+pattern RPL_MONOFFLINE              = ReplyCode 731+pattern RPL_MONLIST                 = ReplyCode 732+pattern RPL_ENDOFMONLIST            = ReplyCode 733+pattern ERR_MONLISTFULL             = ReplyCode 734+pattern RPL_RSACHALLENGE2           = ReplyCode 740+pattern RPL_ENDOFRSACHALLENGE2      = ReplyCode 741+pattern ERR_MLOCKRESTRICTED         = ReplyCode 742+pattern RPL_SCANMATCHED             = ReplyCode 750+pattern RPL_SCANUMODES              = ReplyCode 751+pattern RPL_XINFO                   = ReplyCode 771+pattern RPL_XINFOSTART              = ReplyCode 773+pattern RPL_XINFOEND                = ReplyCode 774+pattern RPL_LOGGEDIN                = ReplyCode 900+pattern RPL_LOGGEDOUT               = ReplyCode 901+pattern RPL_NICKLOCKED              = ReplyCode 902+pattern RPL_SASLSUCCESS             = ReplyCode 903+pattern RPL_SASLFAIL                = ReplyCode 904+pattern RPL_SASLTOOLONG             = ReplyCode 905+pattern RPL_SASLABORTED             = ReplyCode 906+pattern RPL_SASLALREADY             = ReplyCode 907+pattern RPL_SASLMECHS               = ReplyCode 908+pattern ERR_CANNOTDOCOMMAND         = ReplyCode 972+pattern ERR_CANNOTCHANGEUMODE       = ReplyCode 973+pattern ERR_CANNOTCHANGECHANMODE    = ReplyCode 974+pattern ERR_CANNOTCHANGESERVERMODE  = ReplyCode 975+pattern ERR_CANNOTSENDTONICK        = ReplyCode 976+pattern ERR_UNKNOWNSERVERMODE       = ReplyCode 977+pattern ERR_SERVERMODELOCK          = ReplyCode 979+pattern ERR_BADCHARENCODING         = ReplyCode 980+pattern ERR_TOOMANYLANGUAGES        = ReplyCode 981+pattern ERR_NOLANGUAGE              = ReplyCode 982+pattern ERR_TEXTTOOSHORT            = ReplyCode 983+pattern ERR_NUMERIC_ERR             = ReplyCode 999++data ReplyCodeInfo = ReplyCodeInfo+  { replyCodeType :: !ReplyType+  , replyCodeText :: !Text+  }++replyCodeInfo :: ReplyCode -> ReplyCodeInfo+replyCodeInfo (ReplyCode w) =+  case replyCodeInfoTable Vector.!? i of+    Nothing -> defaultReplyCodeInfo i+    Just info -> info+  where+    i = fromIntegral w++defaultReplyCodeInfo :: Int -> ReplyCodeInfo+defaultReplyCodeInfo = ReplyCodeInfo UnknownReply . Text.pack . show++replyCodeInfoTable :: Vector ReplyCodeInfo+replyCodeInfoTable+  = Vector.accumulate+      (\_def new -> new)+      (Vector.generate 1000 defaultReplyCodeInfo)+  $ fmap (\(ReplyCode code,info) -> (fromIntegral code, info))+  $ Vector.fromList+  [ (RPL_WELCOME               , ReplyCodeInfo ClientServerReply "WELCOME")+  , (RPL_YOURHOST              , ReplyCodeInfo ClientServerReply "YOURHOST")+  , (RPL_CREATED               , ReplyCodeInfo ClientServerReply "CREATED")+  , (RPL_MYINFO                , ReplyCodeInfo ClientServerReply "MYINFO")+  , (RPL_ISUPPORT              , ReplyCodeInfo ClientServerReply "ISUPPORT")+  , (RPL_SNOMASK               , ReplyCodeInfo ClientServerReply "SNOMASK")+  , (RPL_STATMEMTOT            , ReplyCodeInfo ClientServerReply "STATMEMTOT")+  , (RPL_REDIR                 , ReplyCodeInfo ClientServerReply "REDIR")+  , (RPL_YOURCOOKIE            , ReplyCodeInfo ClientServerReply "YOURCOOKIE")+  , (RPL_MAP                   , ReplyCodeInfo ClientServerReply "MAP")+  , (RPL_MAPEND                , ReplyCodeInfo ClientServerReply "MAPEND")+  , (RPL_YOURID                , ReplyCodeInfo ClientServerReply "YOURID")+  , (RPL_SAVENICK              , ReplyCodeInfo ClientServerReply "SAVENICK")+  , (RPL_ATTEMPTINGJUNC        , ReplyCodeInfo ClientServerReply "ATTEMPTINGJUNC")+  , (RPL_ATTEMPTINGREROUTE     , ReplyCodeInfo ClientServerReply "ATTEMPTINGREROUTE")+  , (RPL_TRACELINK             , ReplyCodeInfo CommandReply "TRACELINK")+  , (RPL_TRACECONNECTING       , ReplyCodeInfo CommandReply "TRACECONNECTING")+  , (RPL_TRACEHANDSHAKE        , ReplyCodeInfo CommandReply "TRACEHANDSHAKE")+  , (RPL_TRACEUNKNOWN          , ReplyCodeInfo CommandReply "TRACEUNKNOWN")+  , (RPL_TRACEOPERATOR         , ReplyCodeInfo CommandReply "TRACEOPERATOR")+  , (RPL_TRACEUSER             , ReplyCodeInfo CommandReply "TRACEUSER")+  , (RPL_TRACESERVER           , ReplyCodeInfo CommandReply "TRACESERVER")+  , (RPL_TRACESERVICE          , ReplyCodeInfo CommandReply "TRACESERVICE")+  , (RPL_TRACENEWTYPE          , ReplyCodeInfo CommandReply "TRACENEWTYPE")+  , (RPL_TRACECLASS            , ReplyCodeInfo CommandReply "TRACECLASS")+  , (RPL_TRACERECONNECT        , ReplyCodeInfo CommandReply "TRACERECONNECT")+  , (RPL_STATS                 , ReplyCodeInfo CommandReply "STATS")+  , (RPL_STATSLINKINFO         , ReplyCodeInfo CommandReply "STATSLINKINFO")+  , (RPL_STATSCOMMANDS         , ReplyCodeInfo CommandReply "STATSCOMMANDS")+  , (RPL_STATSCLINE            , ReplyCodeInfo CommandReply "STATSCLINE")+  , (RPL_STATSNLINE            , ReplyCodeInfo CommandReply "STATSNLINE")+  , (RPL_STATSILINE            , ReplyCodeInfo CommandReply "STATSILINE")+  , (RPL_STATSKLINE            , ReplyCodeInfo CommandReply "STATSKLINE")+  , (RPL_STATSQLINE            , ReplyCodeInfo CommandReply "STATSQLINE")+  , (RPL_STATSYLINE            , ReplyCodeInfo CommandReply "STATSYLINE")+  , (RPL_ENDOFSTATS            , ReplyCodeInfo CommandReply "ENDOFSTATS")+  , (RPL_STATSPLINE            , ReplyCodeInfo CommandReply "STATSPLINE")+  , (RPL_UMODEIS               , ReplyCodeInfo CommandReply "UMODEIS")+  , (RPL_SQLINE_NICK           , ReplyCodeInfo CommandReply "SQLINE_NICK")+  , (RPL_STATSDLINE            , ReplyCodeInfo CommandReply "STATSDLINE")+  , (RPL_STATSZLINE            , ReplyCodeInfo CommandReply "STATSZLINE")+  , (RPL_STATSCOUNT            , ReplyCodeInfo CommandReply "STATSCOUNT")+  , (RPL_SERVICEINFO           , ReplyCodeInfo CommandReply "SERVICEINFO")+  , (RPL_ENDOFSERVICES         , ReplyCodeInfo CommandReply "ENDOFSERVICES")+  , (RPL_SERVICE               , ReplyCodeInfo CommandReply "SERVICE")+  , (RPL_SERVLIST              , ReplyCodeInfo CommandReply "SERVLIST")+  , (RPL_SERVLISTEND           , ReplyCodeInfo CommandReply "SERVLISTEND")+  , (RPL_STATSVERBOSE          , ReplyCodeInfo CommandReply "STATSVERBOSE")+  , (RPL_STATSIAUTH            , ReplyCodeInfo CommandReply "STATSIAUTH")+  , (RPL_STATSLLINE            , ReplyCodeInfo CommandReply "STATSLLINE")+  , (RPL_STATSUPTIME           , ReplyCodeInfo CommandReply "STATSUPTIME")+  , (RPL_STATSOLINE            , ReplyCodeInfo CommandReply "STATSOLINE")+  , (RPL_STATSHLINE            , ReplyCodeInfo CommandReply "STATSHLINE")+  , (RPL_STATSSLINE            , ReplyCodeInfo CommandReply "STATSSLINE")+  , (RPL_STATSPING             , ReplyCodeInfo CommandReply "STATSPING")+  , (RPL_STATSXLINE            , ReplyCodeInfo CommandReply "STATSXLINE")+  , (RPL_STATSULINE            , ReplyCodeInfo CommandReply "STATSULINE")+  , (RPL_STATSDEBUG            , ReplyCodeInfo CommandReply "STATSDEBUG")+  , (RPL_STATSCONN             , ReplyCodeInfo CommandReply "STATSCONN")+  , (RPL_LUSERCLIENT           , ReplyCodeInfo CommandReply "LUSERCLIENT")+  , (RPL_LUSEROP               , ReplyCodeInfo CommandReply "LUSEROP")+  , (RPL_LUSERUNKNOWN          , ReplyCodeInfo CommandReply "LUSERUNKNOWN")+  , (RPL_LUSERCHANNELS         , ReplyCodeInfo CommandReply "LUSERCHANNELS")+  , (RPL_LUSERME               , ReplyCodeInfo CommandReply "LUSERME")+  , (RPL_ADMINME               , ReplyCodeInfo CommandReply "ADMINME")+  , (RPL_ADMINLOC1             , ReplyCodeInfo CommandReply "ADMINLOC1")+  , (RPL_ADMINLOC2             , ReplyCodeInfo CommandReply "ADMINLOC2")+  , (RPL_ADMINEMAIL            , ReplyCodeInfo CommandReply "ADMINEMAIL")+  , (RPL_TRACELOG              , ReplyCodeInfo CommandReply "TRACELOG")+  , (RPL_ENDOFTRACE            , ReplyCodeInfo CommandReply "ENDOFTRACE")+  , (RPL_LOAD2HI               , ReplyCodeInfo CommandReply "LOAD2HI")+  , (RPL_LOCALUSERS            , ReplyCodeInfo CommandReply "LOCALUSERS")+  , (RPL_GLOBALUSERS           , ReplyCodeInfo CommandReply "GLOBALUSERS")+  , (RPL_START_NETSTAT         , ReplyCodeInfo CommandReply "START_NETSTAT")+  , (RPL_NETSTAT               , ReplyCodeInfo CommandReply "NETSTAT")+  , (RPL_END_NETSTAT           , ReplyCodeInfo CommandReply "END_NETSTAT")+  , (RPL_PRIVS                 , ReplyCodeInfo CommandReply "PRIVS")+  , (RPL_SILELIST              , ReplyCodeInfo CommandReply "SILELIST")+  , (RPL_ENDOFSILELIST         , ReplyCodeInfo CommandReply "ENDOFSILELIST")+  , (RPL_NOTIFY                , ReplyCodeInfo CommandReply "NOTIFY")+  , (RPL_ENDNOTIFY             , ReplyCodeInfo CommandReply "ENDNOTIFY")+  , (RPL_STATSDELTA            , ReplyCodeInfo CommandReply "STATSDELTA")+  , (RPL_WHOISCERTFP           , ReplyCodeInfo CommandReply "WHOISCERTFP")+  , (RPL_VCHANLIST             , ReplyCodeInfo CommandReply "VCHANLIST")+  , (RPL_VCHANHELP             , ReplyCodeInfo CommandReply "VCHANHELP")+  , (RPL_GLIST                 , ReplyCodeInfo CommandReply "GLIST")+  , (RPL_ACCEPTLIST            , ReplyCodeInfo CommandReply "ACCEPTLIST")+  , (RPL_ENDOFACCEPT           , ReplyCodeInfo CommandReply "ENDOFACCEPT")+  , (RPL_ENDOFJUPELIST         , ReplyCodeInfo CommandReply "ENDOFJUPELIST")+  , (RPL_FEATURE               , ReplyCodeInfo CommandReply "FEATURE")+  , (RPL_DATASTR               , ReplyCodeInfo CommandReply "DATASTR")+  , (RPL_END_CHANINFO          , ReplyCodeInfo CommandReply "END_CHANINFO")+  , (RPL_NONE                  , ReplyCodeInfo CommandReply "NONE")+  , (RPL_AWAY                  , ReplyCodeInfo CommandReply "AWAY")+  , (RPL_USERHOST              , ReplyCodeInfo CommandReply "USERHOST")+  , (RPL_ISON                  , ReplyCodeInfo CommandReply "ISON")+  , (RPL_TEXT                  , ReplyCodeInfo CommandReply "TEXT")+  , (RPL_UNAWAY                , ReplyCodeInfo CommandReply "UNAWAY")+  , (RPL_NOWAWAY               , ReplyCodeInfo CommandReply "NOWAWAY")+  , (RPL_WHOISREGNICK          , ReplyCodeInfo CommandReply "WHOISREGNICK")+  , (RPL_SUSERHOST             , ReplyCodeInfo CommandReply "SUSERHOST")+  , (RPL_NOTIFYACTION          , ReplyCodeInfo CommandReply "NOTIFYACTION")+  , (RPL_WHOISADMIN            , ReplyCodeInfo CommandReply "WHOISADMIN")+  , (RPL_NICKTRACE             , ReplyCodeInfo CommandReply "NICKTRACE")+  , (RPL_WHOISSADMIN           , ReplyCodeInfo CommandReply "WHOISSADMIN")+  , (RPL_WHOISHELPER           , ReplyCodeInfo CommandReply "WHOISHELPER")+  , (RPL_WHOISUSER             , ReplyCodeInfo CommandReply "WHOISUSER")+  , (RPL_WHOISSERVER           , ReplyCodeInfo CommandReply "WHOISSERVER")+  , (RPL_WHOISOPERATOR         , ReplyCodeInfo CommandReply "WHOISOPERATOR")+  , (RPL_WHOWASUSER            , ReplyCodeInfo CommandReply "WHOWASUSER")+  , (RPL_ENDOFWHO              , ReplyCodeInfo CommandReply "ENDOFWHO")+  , (RPL_WHOISCHANOP           , ReplyCodeInfo CommandReply "WHOISCHANOP")+  , (RPL_WHOISIDLE             , ReplyCodeInfo CommandReply "WHOISIDLE")+  , (RPL_ENDOFWHOIS            , ReplyCodeInfo CommandReply "ENDOFWHOIS")+  , (RPL_WHOISCHANNELS         , ReplyCodeInfo CommandReply "WHOISCHANNELS")+  , (RPL_WHOISSPECIAL          , ReplyCodeInfo CommandReply "WHOISSPECIAL")+  , (RPL_LISTSTART             , ReplyCodeInfo CommandReply "LISTSTART")+  , (RPL_LIST                  , ReplyCodeInfo CommandReply "LIST")+  , (RPL_LISTEND               , ReplyCodeInfo CommandReply "LISTEND")+  , (RPL_CHANNELMODEIS         , ReplyCodeInfo CommandReply "CHANNELMODEIS")+  , (RPL_CHANNELMLOCKIS        , ReplyCodeInfo CommandReply "CHANNELMLOCKIS")+  , (RPL_NOCHANPASS            , ReplyCodeInfo CommandReply "NOCHANPASS")+  , (RPL_CHPASSUNKNOWN         , ReplyCodeInfo CommandReply "CHPASSUNKNOWN")+  , (RPL_CHANNEL_URL           , ReplyCodeInfo CommandReply "CHANNEL_URL")+  , (RPL_CREATIONTIME          , ReplyCodeInfo CommandReply "CREATIONTIME")+  , (RPL_WHOWAS_TIME           , ReplyCodeInfo CommandReply "WHOWAS_TIME")+  , (RPL_WHOISACCOUNT          , ReplyCodeInfo CommandReply "WHOISACCOUNT")+  , (RPL_NOTOPIC               , ReplyCodeInfo CommandReply "NOTOPIC")+  , (RPL_TOPIC                 , ReplyCodeInfo CommandReply "TOPIC")+  , (RPL_TOPICWHOTIME          , ReplyCodeInfo CommandReply "TOPICWHOTIME")+  , (RPL_LISTUSAGE             , ReplyCodeInfo CommandReply "LISTUSAGE")+  , (RPL_COMMANDSYNTAX         , ReplyCodeInfo CommandReply "COMMANDSYNTAX")+  , (RPL_LISTSYNTAX            , ReplyCodeInfo CommandReply "LISTSYNTAX")+  , (RPL_WHOISACTUALLY         , ReplyCodeInfo CommandReply "WHOISACTUALLY")+  , (RPL_BADCHANPASS           , ReplyCodeInfo CommandReply "BADCHANPASS")+  , (RPL_INVITING              , ReplyCodeInfo CommandReply "INVITING")+  , (RPL_SUMMONING             , ReplyCodeInfo CommandReply "SUMMONING")+  , (RPL_INVITED               , ReplyCodeInfo CommandReply "INVITED")+  , (RPL_INVEXLIST             , ReplyCodeInfo CommandReply "INVEXLIST")+  , (RPL_ENDOFINVEXLIST        , ReplyCodeInfo CommandReply "ENDOFINVEXLIST")+  , (RPL_EXCEPTLIST            , ReplyCodeInfo CommandReply "EXCEPTLIST")+  , (RPL_ENDOFEXCEPTLIST       , ReplyCodeInfo CommandReply "ENDOFEXCEPTLIST")+  , (RPL_VERSION               , ReplyCodeInfo CommandReply "VERSION")+  , (RPL_WHOREPLY              , ReplyCodeInfo CommandReply "WHOREPLY")+  , (RPL_NAMREPLY              , ReplyCodeInfo CommandReply "NAMREPLY")+  , (RPL_WHOSPCRPL             , ReplyCodeInfo CommandReply "WHOSPCRPL")+  , (RPL_NAMREPLY_             , ReplyCodeInfo CommandReply "NAMREPLY_")+  , (RPL_WHOWASREAL            , ReplyCodeInfo CommandReply "WHOWASREAL")+  , (RPL_KILLDONE              , ReplyCodeInfo CommandReply "KILLDONE")+  , (RPL_CLOSING               , ReplyCodeInfo CommandReply "CLOSING")+  , (RPL_CLOSEEND              , ReplyCodeInfo CommandReply "CLOSEEND")+  , (RPL_LINKS                 , ReplyCodeInfo CommandReply "LINKS")+  , (RPL_ENDOFLINKS            , ReplyCodeInfo CommandReply "ENDOFLINKS")+  , (RPL_ENDOFNAMES            , ReplyCodeInfo CommandReply "ENDOFNAMES")+  , (RPL_BANLIST               , ReplyCodeInfo CommandReply "BANLIST")+  , (RPL_ENDOFBANLIST          , ReplyCodeInfo CommandReply "ENDOFBANLIST")+  , (RPL_ENDOFWHOWAS           , ReplyCodeInfo CommandReply "ENDOFWHOWAS")+  , (RPL_INFO                  , ReplyCodeInfo CommandReply "INFO")+  , (RPL_MOTD                  , ReplyCodeInfo CommandReply "MOTD")+  , (RPL_INFOSTART             , ReplyCodeInfo CommandReply "INFOSTART")+  , (RPL_ENDOFINFO             , ReplyCodeInfo CommandReply "ENDOFINFO")+  , (RPL_MOTDSTART             , ReplyCodeInfo CommandReply "MOTDSTART")+  , (RPL_ENDOFMOTD             , ReplyCodeInfo CommandReply "ENDOFMOTD")+  , (RPL_WHOISHOST             , ReplyCodeInfo CommandReply "WHOISHOST")+  , (RPL_KICKLINKED            , ReplyCodeInfo CommandReply "KICKLINKED")+  , (RPL_YOUREOPER             , ReplyCodeInfo CommandReply "YOUREOPER")+  , (RPL_REHASHING             , ReplyCodeInfo CommandReply "REHASHING")+  , (RPL_YOURESERVICE          , ReplyCodeInfo CommandReply "YOURESERVICE")+  , (RPL_MYPORTIS              , ReplyCodeInfo CommandReply "MYPORTIS")+  , (RPL_NOTOPERANYMORE        , ReplyCodeInfo CommandReply "NOTOPERANYMORE")+  , (RPL_RSACHALLENGE          , ReplyCodeInfo CommandReply "RSACHALLENGE")+  , (RPL_TIME                  , ReplyCodeInfo CommandReply "TIME")+  , (RPL_USERSSTART            , ReplyCodeInfo CommandReply "USERSSTART")+  , (RPL_USERS                 , ReplyCodeInfo CommandReply "USERS")+  , (RPL_ENDOFUSERS            , ReplyCodeInfo CommandReply "ENDOFUSERS")+  , (RPL_NOUSERS               , ReplyCodeInfo CommandReply "NOUSERS")+  , (RPL_HOSTHIDDEN            , ReplyCodeInfo CommandReply "HOSTHIDDEN")+  , (ERR_UNKNOWNERROR          , ReplyCodeInfo ErrorReply "UNKNOWNERROR")+  , (ERR_NOSUCHNICK            , ReplyCodeInfo ErrorReply "NOSUCHNICK")+  , (ERR_NOSUCHSERVER          , ReplyCodeInfo ErrorReply "NOSUCHSERVER")+  , (ERR_NOSUCHCHANNEL         , ReplyCodeInfo ErrorReply "NOSUCHCHANNEL")+  , (ERR_CANNOTSENDTOCHAN      , ReplyCodeInfo ErrorReply "CANNOTSENDTOCHAN")+  , (ERR_TOOMANYCHANNELS       , ReplyCodeInfo ErrorReply "TOOMANYCHANNELS")+  , (ERR_WASNOSUCHNICK         , ReplyCodeInfo ErrorReply "WASNOSUCHNICK")+  , (ERR_TOOMANYTARGETS        , ReplyCodeInfo ErrorReply "TOOMANYTARGETS")+  , (ERR_NOORIGIN              , ReplyCodeInfo ErrorReply "NOORIGIN")+  , (ERR_NORECIPIENT           , ReplyCodeInfo ErrorReply "NORECIPIENT")+  , (ERR_NOTEXTTOSEND          , ReplyCodeInfo ErrorReply "NOTEXTTOSEND")+  , (ERR_NOTOPLEVEL            , ReplyCodeInfo ErrorReply "NOTOPLEVEL")+  , (ERR_WILDTOPLEVEL          , ReplyCodeInfo ErrorReply "WILDTOPLEVEL")+  , (ERR_BADMASK               , ReplyCodeInfo ErrorReply "BADMASK")+  , (ERR_TOOMANYMATCHES        , ReplyCodeInfo ErrorReply "TOOMANYMATCHES")+  , (ERR_LENGTHTRUNCATED       , ReplyCodeInfo ErrorReply "LENGTHTRUNCATED")+  , (ERR_UNKNOWNCOMMAND        , ReplyCodeInfo ErrorReply "UNKNOWNCOMMAND")+  , (ERR_NOMOTD                , ReplyCodeInfo ErrorReply "NOMOTD")+  , (ERR_NOADMININFO           , ReplyCodeInfo ErrorReply "NOADMININFO")+  , (ERR_FILEERROR             , ReplyCodeInfo ErrorReply "FILEERROR")+  , (ERR_NOOPERMOTD            , ReplyCodeInfo ErrorReply "NOOPERMOTD")+  , (ERR_TOOMANYAWAY           , ReplyCodeInfo ErrorReply "TOOMANYAWAY")+  , (ERR_EVENTNICKCHANGE       , ReplyCodeInfo ErrorReply "EVENTNICKCHANGE")+  , (ERR_NONICKNAMEGIVEN       , ReplyCodeInfo ErrorReply "NONICKNAMEGIVEN")+  , (ERR_ERRONEUSNICKNAME      , ReplyCodeInfo ErrorReply "ERRONEUSNICKNAME")+  , (ERR_NICKNAMEINUSE         , ReplyCodeInfo ErrorReply "NICKNAMEINUSE")+  , (ERR_SERVICENAMEINUSE      , ReplyCodeInfo ErrorReply "SERVICENAMEINUSE")+  , (ERR_NORULES               , ReplyCodeInfo ErrorReply "NORULES")+  , (ERR_BANNICKCHANGE         , ReplyCodeInfo ErrorReply "BANNICKCHANGE")+  , (ERR_NICKCOLLISION         , ReplyCodeInfo ErrorReply "NICKCOLLISION")+  , (ERR_UNAVAILRESOURCE       , ReplyCodeInfo ErrorReply "UNAVAILRESOURCE")+  , (ERR_NICKTOOFAST           , ReplyCodeInfo ErrorReply "NICKTOOFAST")+  , (ERR_TARGETTOOFAST         , ReplyCodeInfo ErrorReply "TARGETTOOFAST")+  , (ERR_SERVICESDOWN          , ReplyCodeInfo ErrorReply "SERVICESDOWN")+  , (ERR_USERNOTINCHANNEL      , ReplyCodeInfo ErrorReply "USERNOTINCHANNEL")+  , (ERR_NOTONCHANNEL          , ReplyCodeInfo ErrorReply "NOTONCHANNEL")+  , (ERR_USERONCHANNEL         , ReplyCodeInfo ErrorReply "USERONCHANNEL")+  , (ERR_NOLOGIN               , ReplyCodeInfo ErrorReply "NOLOGIN")+  , (ERR_SUMMONDISABLED        , ReplyCodeInfo ErrorReply "SUMMONDISABLED")+  , (ERR_USERSDISABLED         , ReplyCodeInfo ErrorReply "USERSDISABLED")+  , (ERR_NONICKCHANGE          , ReplyCodeInfo ErrorReply "NONICKCHANGE")+  , (ERR_NOTIMPLEMENTED        , ReplyCodeInfo ErrorReply "NOTIMPLEMENTED")+  , (ERR_NOTREGISTERED         , ReplyCodeInfo ErrorReply "NOTREGISTERED")+  , (ERR_IDCOLLISION           , ReplyCodeInfo ErrorReply "IDCOLLISION")+  , (ERR_NICKLOST              , ReplyCodeInfo ErrorReply "NICKLOST")+  , (ERR_HOSTILENAME           , ReplyCodeInfo ErrorReply "HOSTILENAME")+  , (ERR_ACCEPTFULL            , ReplyCodeInfo ErrorReply "ACCEPTFULL")+  , (ERR_ACCEPTEXIST           , ReplyCodeInfo ErrorReply "ACCEPTEXIST")+  , (ERR_ACCEPTNOT             , ReplyCodeInfo ErrorReply "ACCEPTNOT")+  , (ERR_NOHIDING              , ReplyCodeInfo ErrorReply "NOHIDING")+  , (ERR_NOTFORHALFOPS         , ReplyCodeInfo ErrorReply "NOTFORHALFOPS")+  , (ERR_NEEDMOREPARAMS        , ReplyCodeInfo ErrorReply "NEEDMOREPARAMS")+  , (ERR_ALREADYREGISTERED     , ReplyCodeInfo ErrorReply "ALREADYREGISTERED")+  , (ERR_NOPERMFORHOST         , ReplyCodeInfo ErrorReply "NOPERMFORHOST")+  , (ERR_PASSWDMISMATCH        , ReplyCodeInfo ErrorReply "PASSWDMISMATCH")+  , (ERR_YOUREBANNEDCREEP      , ReplyCodeInfo ErrorReply "YOUREBANNEDCREEP")+  , (ERR_YOUWILLBEBANNED       , ReplyCodeInfo ErrorReply "YOUWILLBEBANNED")+  , (ERR_KEYSET                , ReplyCodeInfo ErrorReply "KEYSET")+  , (ERR_INVALIDUSERNAME       , ReplyCodeInfo ErrorReply "INVALIDUSERNAME")+  , (ERR_ONLYSERVERSCANCHANGE  , ReplyCodeInfo ErrorReply "ONLYSERVERSCANCHANGE")+  , (ERR_LINKSET               , ReplyCodeInfo ErrorReply "LINKSET")+  , (ERR_LINKCHANNEL           , ReplyCodeInfo ErrorReply "LINKCHANNEL")+  , (ERR_CHANNELISFULL         , ReplyCodeInfo ErrorReply "CHANNELISFULL")+  , (ERR_UNKNOWNMODE           , ReplyCodeInfo ErrorReply "UNKNOWNMODE")+  , (ERR_INVITEONLYCHAN        , ReplyCodeInfo ErrorReply "INVITEONLYCHAN")+  , (ERR_BANNEDFROMCHAN        , ReplyCodeInfo ErrorReply "BANNEDFROMCHAN")+  , (ERR_BADCHANNELKEY         , ReplyCodeInfo ErrorReply "BADCHANNELKEY")+  , (ERR_BADCHANMASK           , ReplyCodeInfo ErrorReply "BADCHANMASK")+  , (ERR_NEEDREGGEDNICK        , ReplyCodeInfo ErrorReply "NEEDREGGEDNICK")+  , (ERR_BANLISTFULL           , ReplyCodeInfo ErrorReply "BANLISTFULL")+  , (ERR_BADCHANNAME           , ReplyCodeInfo ErrorReply "BADCHANNAME")+  , (ERR_THROTTLE              , ReplyCodeInfo ErrorReply "THROTTLE")+  , (ERR_NOPRIVILEGES          , ReplyCodeInfo ErrorReply "NOPRIVILEGES")+  , (ERR_CHANOPRIVSNEEDED      , ReplyCodeInfo ErrorReply "CHANOPRIVSNEEDED")+  , (ERR_CANTKILLSERVER        , ReplyCodeInfo ErrorReply "CANTKILLSERVER")+  , (ERR_ISCHANSERVICE         , ReplyCodeInfo ErrorReply "ISCHANSERVICE")+  , (ERR_BANNEDNICK            , ReplyCodeInfo ErrorReply "BANNEDNICK")+  , (ERR_NONONREG              , ReplyCodeInfo ErrorReply "NONONREG")+  , (ERR_TSLESSCHAN            , ReplyCodeInfo ErrorReply "TSLESSCHAN")+  , (ERR_VOICENEEDED           , ReplyCodeInfo ErrorReply "VOICENEEDED")+  , (ERR_NOOPERHOST            , ReplyCodeInfo ErrorReply "NOOPERHOST")+  , (ERR_NOSERVICEHOST         , ReplyCodeInfo ErrorReply "NOSERVICEHOST")+  , (ERR_NOFEATURE             , ReplyCodeInfo ErrorReply "NOFEATURE")+  , (ERR_OWNMODE               , ReplyCodeInfo ErrorReply "OWNMODE")+  , (ERR_BADLOGTYPE            , ReplyCodeInfo ErrorReply "BADLOGTYPE")+  , (ERR_BADLOGSYS             , ReplyCodeInfo ErrorReply "BADLOGSYS")+  , (ERR_BADLOGVALUE           , ReplyCodeInfo ErrorReply "BADLOGVALUE")+  , (ERR_ISOPERLCHAN           , ReplyCodeInfo ErrorReply "ISOPERLCHAN")+  , (ERR_CHANOWNPRIVNEEDED     , ReplyCodeInfo ErrorReply "CHANOWNPRIVNEEDED")+  , (ERR_UMODEUNKNOWNFLAG      , ReplyCodeInfo ErrorReply "UMODEUNKNOWNFLAG")+  , (ERR_USERSDONTMATCH        , ReplyCodeInfo ErrorReply "USERSDONTMATCH")+  , (ERR_GHOSTEDCLIENT         , ReplyCodeInfo ErrorReply "GHOSTEDCLIENT")+  , (ERR_USERNOTONSERV         , ReplyCodeInfo ErrorReply "USERNOTONSERV")+  , (ERR_SILELISTFULL          , ReplyCodeInfo ErrorReply "SILELISTFULL")+  , (ERR_TOOMANYWATCH          , ReplyCodeInfo ErrorReply "TOOMANYWATCH")+  , (ERR_WRONGPONG             , ReplyCodeInfo ErrorReply "WRONGPONG")+  , (ERR_BADEXPIRE             , ReplyCodeInfo ErrorReply "BADEXPIRE")+  , (ERR_DONTCHEAT             , ReplyCodeInfo ErrorReply "DONTCHEAT")+  , (ERR_DISABLED              , ReplyCodeInfo ErrorReply "DISABLED")+  , (ERR_NOINVITE              , ReplyCodeInfo ErrorReply "NOINVITE")+  , (ERR_LONGMASK              , ReplyCodeInfo ErrorReply "LONGMASK")+  , (ERR_ADMONLY               , ReplyCodeInfo ErrorReply "ADMONLY")+  , (ERR_TOOMANYUSERS          , ReplyCodeInfo ErrorReply "TOOMANYUSERS")+  , (ERR_OPERONLY              , ReplyCodeInfo ErrorReply "OPERONLY")+  , (ERR_MASKTOOWIDE           , ReplyCodeInfo ErrorReply "MASKTOOWIDE")+  , (ERR_WHOTRUNC              , ReplyCodeInfo ErrorReply "WHOTRUNC")+  , (ERR_LISTSYNTAX            , ReplyCodeInfo ErrorReply "LISTSYNTAX")+  , (ERR_WHOSYNTAX             , ReplyCodeInfo ErrorReply "WHOSYNTAX")+  , (ERR_WHOLIMEXCEED          , ReplyCodeInfo ErrorReply "WHOLIMEXCEED")+  , (ERR_HELPNOTFOUND          , ReplyCodeInfo ErrorReply "HELPNOTFOUND")+  , (ERR_REMOTEPFX             , ReplyCodeInfo ErrorReply "REMOTEPFX")+  , (ERR_PFXUNROUTABLE         , ReplyCodeInfo ErrorReply "PFXUNROUTABLE")+  , (ERR_BADHOSTMASK           , ReplyCodeInfo ErrorReply "BADHOSTMASK")+  , (ERR_HOSTUNAVAIL           , ReplyCodeInfo ErrorReply "HOSTUNAVAIL")+  , (ERR_USINGSLINE            , ReplyCodeInfo ErrorReply "USINGSLINE")+  , (ERR_STATSSLINE            , ReplyCodeInfo ErrorReply "STATSSLINE")+  , (RPL_LOGON                 , ReplyCodeInfo CommandReply "LOGON")+  , (RPL_LOGOFF                , ReplyCodeInfo CommandReply "LOGOFF")+  , (RPL_WATCHOFF              , ReplyCodeInfo CommandReply "WATCHOFF")+  , (RPL_WATCHSTAT             , ReplyCodeInfo CommandReply "WATCHSTAT")+  , (RPL_NOWON                 , ReplyCodeInfo CommandReply "NOWON")+  , (RPL_NOWOFF                , ReplyCodeInfo CommandReply "NOWOFF")+  , (RPL_WATCHLIST             , ReplyCodeInfo CommandReply "WATCHLIST")+  , (RPL_ENDOFWATCHLIST        , ReplyCodeInfo CommandReply "ENDOFWATCHLIST")+  , (RPL_WATCHCLEAR            , ReplyCodeInfo CommandReply "WATCHCLEAR")+  , (RPL_ISOPER                , ReplyCodeInfo CommandReply "ISOPER")+  , (RPL_ISLOCOP               , ReplyCodeInfo CommandReply "ISLOCOP")+  , (RPL_ISNOTOPER             , ReplyCodeInfo CommandReply "ISNOTOPER")+  , (RPL_ENDOFISOPER           , ReplyCodeInfo CommandReply "ENDOFISOPER")+  , (RPL_DCCSTATUS             , ReplyCodeInfo CommandReply "DCCSTATUS")+  , (RPL_DCCLIST               , ReplyCodeInfo CommandReply "DCCLIST")+  , (RPL_ENDOFDCCLIST          , ReplyCodeInfo CommandReply "ENDOFDCCLIST")+  , (RPL_WHOWASHOST            , ReplyCodeInfo CommandReply "WHOWASHOST")+  , (RPL_DCCINFO               , ReplyCodeInfo CommandReply "DCCINFO")+  , (RPL_RULES                 , ReplyCodeInfo CommandReply "RULES")+  , (RPL_ENDOFO                , ReplyCodeInfo CommandReply "ENDOFO")+  , (RPL_SETTINGS              , ReplyCodeInfo CommandReply "SETTINGS")+  , (RPL_ENDOFSETTINGS         , ReplyCodeInfo CommandReply "ENDOFSETTINGS")+  , (RPL_DUMPING               , ReplyCodeInfo CommandReply "DUMPING")+  , (RPL_DUMPRPL               , ReplyCodeInfo CommandReply "DUMPRPL")+  , (RPL_EODUMP                , ReplyCodeInfo CommandReply "EODUMP")+  , (RPL_TRACEROUTE_HOP        , ReplyCodeInfo CommandReply "TRACEROUTE_HOP")+  , (RPL_TRACEROUTE_START      , ReplyCodeInfo CommandReply "TRACEROUTE_START")+  , (RPL_MODECHANGEWARN        , ReplyCodeInfo CommandReply "MODECHANGEWARN")+  , (RPL_CHANREDIR             , ReplyCodeInfo CommandReply "CHANREDIR")+  , (RPL_SERVMODEIS            , ReplyCodeInfo CommandReply "SERVMODEIS")+  , (RPL_OTHERUMODEIS          , ReplyCodeInfo CommandReply "OTHERUMODEIS")+  , (RPL_ENDOF_GENERIC         , ReplyCodeInfo CommandReply "ENDOF_GENERIC")+  , (RPL_WHOWASDETAILS         , ReplyCodeInfo CommandReply "WHOWASDETAILS")+  , (RPL_WHOISSECURE           , ReplyCodeInfo CommandReply "WHOISSECURE")+  , (RPL_UNKNOWNMODES          , ReplyCodeInfo CommandReply "UNKNOWNMODES")+  , (RPL_CANNOTSETMODES        , ReplyCodeInfo CommandReply "CANNOTSETMODES")+  , (RPL_LUSERSTAFF            , ReplyCodeInfo CommandReply "LUSERSTAFF")+  , (RPL_TIMEONSERVERIS        , ReplyCodeInfo CommandReply "TIMEONSERVERIS")+  , (RPL_NETWORKS              , ReplyCodeInfo CommandReply "NETWORKS")+  , (RPL_YOURLANGUAGEIS        , ReplyCodeInfo CommandReply "YOURLANGUAGEIS")+  , (RPL_LANGUAGE              , ReplyCodeInfo CommandReply "LANGUAGE")+  , (RPL_WHOISSTAFF            , ReplyCodeInfo CommandReply "WHOISSTAFF")+  , (RPL_WHOISLANGUAGE         , ReplyCodeInfo CommandReply "WHOISLANGUAGE")+  , (RPL_MODLIST               , ReplyCodeInfo CommandReply "MODLIST")+  , (RPL_ENDOFMODLIST          , ReplyCodeInfo CommandReply "ENDOFMODLIST")+  , (RPL_HELPSTART             , ReplyCodeInfo CommandReply "HELPSTART")+  , (RPL_HELPTXT               , ReplyCodeInfo CommandReply "HELPTXT")+  , (RPL_ENDOFHELP             , ReplyCodeInfo CommandReply "ENDOFHELP")+  , (ERR_TARGCHANGE            , ReplyCodeInfo ErrorReply "TARGCHANGE")+  , (RPL_ETRACEFULL            , ReplyCodeInfo CommandReply "ETRACEFULL")+  , (RPL_ETRACE                , ReplyCodeInfo CommandReply "ETRACE")+  , (RPL_KNOCK                 , ReplyCodeInfo CommandReply "KNOCK")+  , (RPL_KNOCKDLVR             , ReplyCodeInfo CommandReply "KNOCKDLVR")+  , (ERR_TOOMANYKNOCK          , ReplyCodeInfo ErrorReply "TOOMANYKNOCK")+  , (ERR_CHANOPEN              , ReplyCodeInfo ErrorReply "CHANOPEN")+  , (ERR_KNOCKONCHAN           , ReplyCodeInfo ErrorReply "KNOCKONCHAN")+  , (ERR_KNOCKDISABLED         , ReplyCodeInfo ErrorReply "KNOCKDISABLED")+  , (RPL_TARGUMODEG            , ReplyCodeInfo CommandReply "TARGUMODEG")+  , (RPL_TARGNOTIFY            , ReplyCodeInfo CommandReply "TARGNOTIFY")+  , (RPL_UMODEGMSG             , ReplyCodeInfo CommandReply "UMODEGMSG")+  , (RPL_OMOTDSTART            , ReplyCodeInfo CommandReply "OMOTDSTART")+  , (RPL_OMOTD                 , ReplyCodeInfo CommandReply "OMOTD")+  , (RPL_ENDOFOMOTD            , ReplyCodeInfo CommandReply "ENDOFOMOTD")+  , (ERR_NOPRIVS               , ReplyCodeInfo ErrorReply "NOPRIVS")+  , (RPL_TESTMASK              , ReplyCodeInfo CommandReply "TESTMASK")+  , (RPL_TESTLINE              , ReplyCodeInfo CommandReply "TESTLINE")+  , (RPL_NOTESTLINE            , ReplyCodeInfo CommandReply "NOTESTLINE")+  , (RPL_QUIETLIST             , ReplyCodeInfo CommandReply "QUIETLIST")+  , (RPL_ENDOFQUIETLIST        , ReplyCodeInfo CommandReply "ENDOFQUIETLIST")+  , (RPL_MONONLINE             , ReplyCodeInfo CommandReply "MONONLINE")+  , (RPL_MONOFFLINE            , ReplyCodeInfo CommandReply "MONOFFLINE")+  , (RPL_MONLIST               , ReplyCodeInfo CommandReply "MONLIST")+  , (RPL_ENDOFMONLIST          , ReplyCodeInfo CommandReply "ENDOFMONLIST")+  , (ERR_MONLISTFULL           , ReplyCodeInfo ErrorReply "MONLISTFULL")+  , (RPL_RSACHALLENGE2         , ReplyCodeInfo CommandReply "RSACHALLENGE2")+  , (RPL_ENDOFRSACHALLENGE2    , ReplyCodeInfo CommandReply "ENDOFRSACHALLENGE2")+  , (ERR_MLOCKRESTRICTED       , ReplyCodeInfo ErrorReply "MLOCKRESTRICTED")+  , (RPL_SCANMATCHED           , ReplyCodeInfo CommandReply "SCANMATCHED")+  , (RPL_SCANUMODES            , ReplyCodeInfo CommandReply "SCANUMODES")+  , (RPL_XINFO                 , ReplyCodeInfo CommandReply "XINFO")+  , (RPL_XINFOSTART            , ReplyCodeInfo CommandReply "XINFOSTART")+  , (RPL_XINFOEND              , ReplyCodeInfo CommandReply "XINFOEND")+  , (RPL_LOGGEDIN              , ReplyCodeInfo CommandReply "LOGGEDIN")+  , (RPL_LOGGEDOUT             , ReplyCodeInfo CommandReply "LOGGEDOUT")+  , (RPL_NICKLOCKED            , ReplyCodeInfo CommandReply "NICKLOCKED")+  , (RPL_SASLSUCCESS           , ReplyCodeInfo CommandReply "SASLSUCCESS")+  , (RPL_SASLFAIL              , ReplyCodeInfo CommandReply "SASLFAIL")+  , (RPL_SASLTOOLONG           , ReplyCodeInfo CommandReply "SASLTOOLONG")+  , (RPL_SASLABORTED           , ReplyCodeInfo CommandReply "SASLABORTED")+  , (RPL_SASLALREADY           , ReplyCodeInfo CommandReply "SASLALREADY")+  , (RPL_SASLMECHS             , ReplyCodeInfo CommandReply "SASLMECHS")+  , (ERR_CANNOTDOCOMMAND       , ReplyCodeInfo ErrorReply "CANNOTDOCOMMAND")+  , (ERR_CANNOTCHANGEUMODE     , ReplyCodeInfo ErrorReply "CANNOTCHANGEUMODE")+  , (ERR_CANNOTCHANGECHANMODE  , ReplyCodeInfo ErrorReply "CANNOTCHANGECHANMODE")+  , (ERR_CANNOTCHANGESERVERMODE, ReplyCodeInfo ErrorReply "CANNOTCHANGESERVERMODE")+  , (ERR_CANNOTSENDTONICK      , ReplyCodeInfo ErrorReply "CANNOTSENDTONICK")+  , (ERR_UNKNOWNSERVERMODE     , ReplyCodeInfo ErrorReply "UNKNOWNSERVERMODE")+  , (ERR_SERVERMODELOCK        , ReplyCodeInfo ErrorReply "SERVERMODELOCK")+  , (ERR_BADCHARENCODING       , ReplyCodeInfo ErrorReply "BADCHARENCODING")+  , (ERR_TOOMANYLANGUAGES      , ReplyCodeInfo ErrorReply "TOOMANYLANGUAGES")+  , (ERR_NOLANGUAGE            , ReplyCodeInfo ErrorReply "NOLANGUAGE")+  , (ERR_TEXTTOOSHORT          , ReplyCodeInfo ErrorReply "TEXTTOOSHORT")+  , (ERR_NUMERIC_ERR           , ReplyCodeInfo ErrorReply "NUMERIC_ERR")+  ]

@@ -0,0 +1,266 @@+{-# Language OverloadedStrings #-}+{-|+Module      : Irc.Commands+Description : Smart constructors for "RawIrcMsg"+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module provides smart constructors for IRC commands.+-}+module Irc.Commands+  ( ircAway+  , ircCapEnd+  , ircCapLs+  , ircCapReq+  , ircInvite+  , ircIson+  , ircJoin+  , ircKick+  , ircLinks+  , ircMode+  , ircNick+  , ircNotice+  , ircPart+  , ircPass+  , ircPing+  , ircPong+  , ircPrivmsg+  , ircQuit+  , ircRemove+  , ircStats+  , ircTime+  , ircTopic+  , ircUser+  , ircUserhost+  , ircWho+  , ircWhois+  , ircWhowas++  -- * ZNC support+  , ircZnc++  -- * SASL support+  , ircAuthenticate+  , plainAuthenticationMode+  , encodePlainAuthentication+  ) where++import           Irc.RawIrcMsg+import           Irc.Identifier+import           Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.ByteArray.Encoding as Enc++-- | PRIVMSG command+ircPrivmsg ::+  Identifier {- ^ target  -} ->+  Text       {- ^ message -} ->+  RawIrcMsg+ircPrivmsg who msg = rawIrcMsg "PRIVMSG" [idText who, msg]++-- | NOTICE command+ircNotice ::+  Identifier {- ^ target  -} ->+  Text       {- ^ message -} ->+  RawIrcMsg+ircNotice who msg = rawIrcMsg "NOTICE" [idText who, msg]++-- | MODE command+ircMode ::+  Identifier {- ^ target     -} ->+  [Text]     {- ^ parameters -} ->+  RawIrcMsg+ircMode tgt params = rawIrcMsg "MODE" (idText tgt : params)++-- | WHOIS command+ircWhois ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircWhois = rawIrcMsg "WHOIS"++-- | WHO command+ircWho ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircWho = rawIrcMsg "WHO"++-- | WHOWAS command+ircWhowas ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircWhowas = rawIrcMsg "WHOWAS"++-- | NICK command+ircNick ::+  Identifier {- ^ nickname -} ->+  RawIrcMsg+ircNick nick = rawIrcMsg "NICK" [idText nick]++-- | PART command+ircPart ::+  Identifier {- ^ channel -} ->+  Text       {- ^ message -} ->+  RawIrcMsg+ircPart chan msg+  | Text.null msg = rawIrcMsg "PART" [idText chan]+  | otherwise     = rawIrcMsg "PART" [idText chan, msg]++-- | JOIN command+ircJoin ::+  Text       {- ^ channel -} ->+  Maybe Text {- ^ key     -} ->+  RawIrcMsg+ircJoin chan (Just key) = rawIrcMsg "JOIN" [chan, key]+ircJoin chan Nothing    = rawIrcMsg "JOIN" [chan]++-- | INVITE command+ircInvite ::+  Text       {- ^ nickname -} ->+  Identifier {- ^ channel  -} ->+  RawIrcMsg+ircInvite nick channel = rawIrcMsg "INVITE" [nick, idText channel]++-- | TOPIC command+ircTopic ::+  Identifier {- ^ channel -} ->+  Text       {- ^ topic   -} ->+  RawIrcMsg+ircTopic chan msg+  | Text.null msg = rawIrcMsg "TOPIC" [idText chan]+  | otherwise     = rawIrcMsg "TOPIC" [idText chan, msg]++-- | KICK command+ircKick ::+  Identifier {- ^ channel  -} ->+  Text       {- ^ nickname -} ->+  Text       {- ^ message  -} ->+  RawIrcMsg+ircKick chan who msg+  | Text.null msg = rawIrcMsg "KICK" [idText chan, who]+  | otherwise     = rawIrcMsg "KICK" [idText chan, who, msg]++-- | REMOVE command+ircRemove ::+  Identifier {- ^ channel  -} ->+  Text       {- ^ nickname -} ->+  Text       {- ^ message  -} ->+  RawIrcMsg+ircRemove chan who msg+  | Text.null msg = rawIrcMsg "REMOVE" [idText chan, who]+  | otherwise     = rawIrcMsg "REMOVE" [idText chan, who, msg]++-- | QUIT command+ircQuit :: Text {- ^ quit message -} -> RawIrcMsg+ircQuit msg+  | Text.null msg = rawIrcMsg "QUIT" []+  | otherwise     = rawIrcMsg "QUIT" [msg]++-- | PASS command+ircPass :: Text {- ^ password -} -> RawIrcMsg+ircPass pass = rawIrcMsg "PASS" [pass]++-- | PING command+ircPing ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircPing = rawIrcMsg "PING"++-- | PONG command+ircPong ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircPong = rawIrcMsg "PONG"++-- | ISON command+ircIson ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircIson = rawIrcMsg "ISON"++-- | TIME command+ircTime ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircTime = rawIrcMsg "TIME"++-- | USERHOST command+ircUserhost ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircUserhost = rawIrcMsg "USERHOST"++-- | STATS command+ircStats ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircStats = rawIrcMsg "STATS"++-- | LINKS command+ircLinks ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircLinks = rawIrcMsg "LINKS"++-- | AWAY command+ircAway ::+  Text {- ^ message -} ->+  RawIrcMsg+ircAway msg+  | Text.null msg = rawIrcMsg "AWAY" []+  | otherwise     = rawIrcMsg "AWAY" [msg]++-- | USER command+ircUser ::+  Text {- ^ username -} ->+  Bool {- ^ set +w   -} ->+  Bool {- ^ set +i   -} ->+  Text {- ^ realname -} -> RawIrcMsg+ircUser user set_w set_i real = rawIrcMsg "USER" [user, modeTxt, "*", real]+  where+    modeTxt = Text.pack (show mode)+    mode :: Int+    mode = (if set_w then 4 else 0) -- bit 2+         + (if set_i then 8 else 0) -- bit 3++-- | CAP REQ command+ircCapReq ::+  [Text] {- ^ capabilities -} ->+  RawIrcMsg+ircCapReq caps = rawIrcMsg "CAP" ["REQ", Text.unwords caps]++-- | CAP END command+ircCapEnd :: RawIrcMsg+ircCapEnd = rawIrcMsg "CAP" ["END"]++-- | CAP LS command+ircCapLs :: RawIrcMsg+ircCapLs = rawIrcMsg "CAP" ["LS"]++-- | ZNC command+--+-- /specific to ZNC/+ircZnc ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircZnc = rawIrcMsg "ZNC"++-- | AUTHENTICATE command+ircAuthenticate :: Text -> RawIrcMsg+ircAuthenticate msg = rawIrcMsg "AUTHENTICATE" [msg]++-- | PLAIN authentiation mode+plainAuthenticationMode :: Text+plainAuthenticationMode = "PLAIN"++-- | Encoding of username and password in PLAIN authentication+encodePlainAuthentication ::+  Text {- ^ username -} ->+  Text {- ^ password -} ->+  Text+encodePlainAuthentication user pass+  = Text.decodeUtf8+  $ Enc.convertToBase Enc.Base64+  $ Text.encodeUtf8+  $ Text.intercalate "\0" [user,user,pass]

@@ -1,776 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | This module provides a bridge between the low-level text protocol that--- IRC uses and the high-level events in the "Irc.Model" module.-module Irc.Core-  ( MsgFromServer(..)-  , IrcError(..)-  , ircMsgToServerMsg-  ) where--import Control.Lens (over, _2)-import Data.ByteString (ByteString)-import Data.Time-import Data.Time.Clock.POSIX-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8--import Irc.Format---- | 'MsgFromServer' provides a typed view of the various IRC protocol messages.--- There are more messages defined for IRC (and many of those overlap) than--- are in common use. Please report a bug if a common message is missing--- from this type.-data MsgFromServer-  -- 001-099 Client-server connection messages-  = RplWelcome  ByteString -- ^ 001 "Welcome to the Internet Relay Network \<nick\>!\<user\>\@\<host\>"-  | RplYourHost ByteString -- ^ 002 "Your host is \<servername\>, running version \<ver\>"-  | RplCreated  ByteString -- ^ 003 "This server was created \<date\>"-  | RplMyInfo   ByteString ByteString [ByteString] -- ^ 004 servername version *(modes)-  | RplISupport [(ByteString,ByteString)] -- ^ 005 *(KEY=VALUE)-  | RplSnoMask ByteString -- ^ 008 snomask-  | RplYourId ByteString -- ^ 042 unique-id--  -- 200-399 Command responses-  | RplStatsLinkInfo [ByteString] -- ^ 211 arguments-  | RplStatsCommands [ByteString] -- ^ 212 arguments-  | RplStatsCLine [ByteString] -- ^ 213 arguments-  | RplStatsNLine [ByteString] -- ^ 214 arguments-  | RplStatsILine [ByteString] -- ^ 215 arguments-  | RplStatsKLine [ByteString] -- ^ 216 arguments-  | RplStatsQLine [ByteString] -- ^ 217 arguments-  | RplStatsYLine [ByteString] -- ^ 218 arguments-  | RplEndOfStats Char -- ^ 219 mode-  | RplStatsPLine [ByteString] -- ^ 220 arguments-  | RplUmodeIs ByteString [ByteString] -- ^ 221 modes *(params)-  | RplStatsDLine [ByteString] -- ^ 225-  | RplStatsVLine [ByteString] -- ^ 240-  | RplStatsLLine [ByteString] -- ^ 241-  | RplStatsUptime ByteString -- ^ 242-  | RplStatsOLine [ByteString] -- ^ 243-  | RplStatsHLine [ByteString] -- ^ 244-  | RplStatsSLine [ByteString] -- ^ 245-  | RplStatsPing  [ByteString] -- ^ 246-  | RplStatsXLine [ByteString] -- ^ 247-  | RplStatsULine [ByteString] -- ^ 248-  | RplStatsDebug [ByteString] -- ^ 249-  | RplStatsConn ByteString -- ^ 250 connection-  | RplLuserClient ByteString -- ^ 251 "There are \<integer\> users and \<integer\> services on \<integer\> servers"-  | RplLuserOp ByteString -- ^ 252 number-of-ops-  | RplLuserUnknown ByteString -- ^ 253 number-of-unknown-  | RplLuserChannels ByteString -- ^ 254 number-of-channels-  | RplLuserMe ByteString -- ^ 255 "I have \<integer\> clients and \<integer\> servers"-  | RplLuserAdminMe ByteString -- ^ 256 server-  | RplLuserAdminLoc1 ByteString -- ^ 257 admin-info-1-  | RplLuserAdminLoc2 ByteString -- ^ 258 admin-info-2-  | RplLuserAdminEmail ByteString -- ^ 259 admin-email-  | RplLoadTooHigh ByteString -- ^ 263 command-  | RplLocalUsers [ByteString] -- ^ 265 [local] [max] txt-  | RplGlobalUsers [ByteString] -- ^ 266 [global] [max] txt-  | RplPrivs ByteString -- ^ 270 privstring-  | RplWhoisCertFp Identifier ByteString -- ^ 276 nick txt-  | RplAcceptList Identifier -- ^ 281-  | RplEndOfAccept -- ^ 282--  | RplAway Identifier ByteString -- ^ 301 nick away_message-  | RplUserHost [ByteString] -- ^ 302 *(user hosts)-  | RplIsOn [Identifier] -- ^ 303 *(nick)-  | RplSyntax ByteString -- ^ (inspircd) 304 text-  | RplUnAway -- ^ 305-  | RplNowAway -- ^ 306-  | RplWhoisUser Identifier ByteString ByteString ByteString -- ^ 311 nick user host realname-  | RplWhoisServer Identifier ByteString ByteString -- ^ 312 nick server serverinfo-  | RplWhoisOperator Identifier ByteString -- ^ 313 nick "is an IRC operator"-  | RplWhoWasUser Identifier ByteString ByteString ByteString -- ^ 314 nick user host realname-  | RplEndOfWho Identifier -- ^ 315 channel-  | RplWhoisIdle Identifier Integer (Maybe UTCTime) -- ^ 317 nick idle signon-  | RplEndOfWhois Identifier -- ^ 318 nick-  | RplWhoisChannels Identifier ByteString -- ^ 319 nick channels-  | RplListStart -- ^ 321-  | RplList Identifier Integer ByteString -- ^ 322 channel usercount topic-  | RplListEnd -- ^ 323-  | RplChannelModeIs Identifier ByteString [ByteString] -- ^ 324 channel modes *(params)-  | RplNoTopicSet Identifier -- ^ 331 channel-  | RplTopic Identifier ByteString -- ^ 332 channel topic-  | RplChannelUrl Identifier ByteString -- ^ 328 channel url-  | RplCreationTime Identifier UTCTime -- ^ 329 channel timestamp-  | RplWhoisAccount Identifier ByteString -- ^ 330 nick account-  | RplTopicWhoTime Identifier ByteString UTCTime -- ^ 333 channel nickname timestamp-  | RplInviting Identifier Identifier -- ^ 341 nick channel-  | RplInviteList Identifier ByteString ByteString UTCTime -- ^ 346 channel mask who timestamp-  | RplEndOfInviteList Identifier -- ^ 347 channel-  | RplExceptionList Identifier ByteString ByteString UTCTime -- ^ 348 channel mask who timestamp-  | RplEndOfExceptionList Identifier -- ^ 349 channel-  | RplVersion [ByteString] -- ^ 351 version server comments-  | RplWhoReply Identifier ByteString ByteString ByteString Identifier ByteString ByteString -- ^ 352 channel user host server nick flags txt-  | RplNameReply ChannelType Identifier [ByteString] -- ^ 353 channeltype channel names-  | RplLinks ByteString ByteString ByteString -- ^ 364 mask server info-  | RplEndOfLinks ByteString -- ^ 365 mask-  | RplEndOfNames Identifier -- ^ 366 channel-  | RplBanList Identifier ByteString ByteString UTCTime -- ^ 367 channel banned banner timestamp-  | RplEndOfBanList Identifier -- ^ 368 channel-  | RplEndOfWhoWas Identifier -- ^ 369 nick-  | RplMotd ByteString -- ^ 372 line-of-motd-  | RplMotdStart -- ^ 375-  | RplEndOfMotd -- ^ 376-  | RplTime ByteString ByteString -- ^ 391 server "\<string showing server's local time\>"-  | RplInfo ByteString -- ^ 371 info-  | RplEndOfInfo -- ^ 374-  | RplWhoisHost Identifier ByteString -- ^ 378 nick host-  | RplWhoisModes Identifier ByteString [ByteString] -- ^ 379 nick modes *(args)-  | RplYoureOper ByteString -- ^ 381 text-  | RplHostHidden ByteString -- ^ 396 hostname--  | Err Identifier IrcError--  -- Random high-numbered stuff-  | RplWhoisSecure Identifier -- ^ 671 nick-  | RplHelpStart ByteString ByteString -- ^ 704 topic text-  | RplHelp      ByteString ByteString -- ^ 705 topic text-  | RplEndOfHelp ByteString -- ^ 706 topic text-  | RplKnock Identifier UserInfo -- ^ 710 channel-  | RplKnockDelivered Identifier -- ^ 711 channel-  | RplTargNotify Identifier -- ^ 717 nick-  | RplUmodeGMsg Identifier ByteString -- ^ 718 nick mask-  | RplQuietList Identifier Char ByteString ByteString UTCTime -- ^ 728 channel mode mask who timestamp-  | RplEndOfQuietList Identifier Char -- ^ 729 channel mode--  -- SASL stuff-  | RplLoggedIn ByteString -- ^ 900 account-  | RplLoggedOut -- ^ 901-  | RplNickLocked -- ^ 902-  | RplSaslSuccess -- ^ 903-  | RplSaslFail -- ^ 904-  | RplSaslTooLong -- ^ 905-  | RplSaslAborted -- ^ 906-  | RplSaslAlready -- ^ 907-  | RplSaslMechs ByteString -- ^ 908 comma-sep-mechs--  | Away UserInfo (Maybe ByteString)-  | Ping ByteString-  | Pong (Maybe ByteString) ByteString-  | Notice  UserInfo Identifier ByteString-  | Topic UserInfo Identifier ByteString-  | PrivMsg UserInfo Identifier ByteString-  | ExtJoin UserInfo Identifier (Maybe ByteString) ByteString-  | Join UserInfo Identifier-  | Nick UserInfo Identifier-  | Mode UserInfo Identifier [ByteString]-  | Quit UserInfo ByteString-  | Cap ByteString ByteString-  | Kick UserInfo Identifier Identifier ByteString-  | Part UserInfo Identifier ByteString-  | Invite UserInfo Identifier-  | Error ByteString-  | Authenticate ByteString-  | Account UserInfo (Maybe ByteString)-  deriving (Read, Show)--data IrcError-  -- 400-499 Errors-  = ErrNoSuchNick -- ^ 401-  | ErrNoSuchServer ByteString -- ^ 402 server-  | ErrNoSuchChannel -- ^ 403-  | ErrCannotSendToChan -- ^ 404-  | ErrTooManyChannels -- ^ 405-  | ErrWasNoSuchNick -- ^ 406-  | ErrTooManyTargets -- ^ 407-  | ErrNoOrigin -- ^ 409-  | ErrNoRecipient -- ^ 411-  | ErrNoTextToSend -- ^ 412-  | ErrUnknownCommand ByteString -- ^ 421 command-  | ErrNoMotd -- ^ 422-  | ErrNoAdminInfo ByteString -- ^ 423 server-  | ErrNoNicknameGiven -- ^ 431-  | ErrErroneousNickname ByteString -- ^ 432 badnick-  | ErrNicknameInUse Identifier -- ^ 433 nick-  | ErrBanNickChange -- ^ 435-  | ErrUnavailResource -- ^ 437-  | ErrNickTooFast -- ^ 438-  | ErrServicesDown -- ^ 440-  | ErrUserNotInChannel Identifier -- ^ 441 nick-  | ErrNotOnChannel -- ^ 442 channel-  | ErrUserOnChannel Identifier -- ^ 443 nick-  | ErrNotRegistered -- ^ 451-  | ErrAcceptFull -- ^ 456-  | ErrAcceptExist -- ^ 457-  | ErrAcceptNot -- ^ 458-  | ErrNeedMoreParams ByteString -- ^ 461 command-  | ErrAlreadyRegistered -- ^ 462-  | ErrNoPermForHost -- ^ 463-  | ErrPasswordMismatch -- ^ 464-  | ErrYoureBannedCreep -- ^ 465-  | ErrLinkChannel Identifier -- ^ 470 dstchannel-  | ErrChannelFull -- ^ 471 channel-  | ErrUnknownMode Char -- ^ 472 mode-  | ErrInviteOnlyChan -- ^ 473-  | ErrBannedFromChan -- ^ 474-  | ErrBadChannelKey -- ^ 475-  | ErrNeedReggedNick -- ^ 477-  | ErrBanListFull Char -- ^ 478 mode-  | ErrBadChanName ByteString -- ^ 479 name-  | ErrThrottle -- ^ 480-  | ErrNoPrivileges -- ^ 481-  | ErrChanOpPrivsNeeded -- ^ 482-  | ErrCantKillServer -- ^ 483-  | ErrIsChanService Identifier -- ^ 484 nick-  | ErrNoNonReg -- ^ 486-  | ErrVoiceNeeded -- ^ 489-  | ErrNoOperHost -- ^ 491-  | ErrOwnMode -- ^ 494-  | ErrUnknownUmodeFlag Char -- ^ 501 mode-  | ErrUsersDontMatch -- ^ 502-  | ErrHelpNotFound ByteString -- ^ 524 topic-  | ErrTooManyKnocks -- ^ 713-  | ErrChanOpen -- ^ 713-  | ErrKnockOnChan -- ^ 714-  | ErrTargUmodeG -- ^ 716-  | ErrNoPrivs ByteString -- ^ 723 priv-  | ErrMlockRestricted Char ByteString -- ^ 742 mode setting-  deriving (Read, Show)--data ChannelType = SecretChannel | PrivateChannel | PublicChannel-  deriving (Read, Show)--ircMsgToServerMsg :: RawIrcMsg -> Maybe MsgFromServer-ircMsgToServerMsg ircmsg =-  case (msgCommand ircmsg, msgParams ircmsg) of-    ("001",[_,txt]) -> Just (RplWelcome txt)-    ("002",[_,txt]) -> Just (RplYourHost txt)-    ("003",[_,txt]) -> Just (RplCreated txt)--    ("004", _:host:version:modes) ->-       Just (RplMyInfo host version modes)--    ("005",_:params)-      | not (null params) ->-         let parse1 = over _2 (B.drop 1) . B8.break (=='=')-         in Just (RplISupport (map parse1 (init params)))--    ("008",[_,snomask,_]) ->-       Just (RplSnoMask (B.tail snomask))--    ("042",[_,yourid,_]) ->-       Just (RplYourId yourid)--    ("211", _:linkinfo) -> Just (RplStatsLinkInfo linkinfo)-    ("212", _:commands) -> Just (RplStatsCommands commands)-    ("213", _:cline   ) -> Just (RplStatsCLine cline)-    ("214", _:nline   ) -> Just (RplStatsNLine nline)-    ("215", _:iline   ) -> Just (RplStatsILine iline)-    ("216", _:kline   ) -> Just (RplStatsKLine kline)-    ("217", _:qline   ) -> Just (RplStatsQLine qline)-    ("218", _:yline   ) -> Just (RplStatsYLine yline)-    ("219",[_,mode,_] ) -> Just (RplEndOfStats (B8.head mode))-    ("220", _:pline   ) -> Just (RplStatsPLine pline)-    ("221", _:mode:params) -> Just (RplUmodeIs mode params)-    ("225", _:dline   ) -> Just (RplStatsDLine dline)-    ("240", _:vline   ) -> Just (RplStatsVLine vline)-    ("241", _:lline   ) -> Just (RplStatsLLine lline)-    ("242", [_,uptime]) -> Just (RplStatsUptime uptime)-    ("243", _:oline   ) -> Just (RplStatsOLine oline)-    ("244", _:hline   ) -> Just (RplStatsHLine hline)-    ("245", _:sline   ) -> Just (RplStatsSLine sline)-    ("246", _:ping    ) -> Just (RplStatsPing  ping )-    ("247", _:xline   ) -> Just (RplStatsXLine xline)-    ("248", _:uline   ) -> Just (RplStatsULine uline)-    ("249", _:debug   ) -> Just (RplStatsDebug debug)--    ("250",[_,stats]) ->-       Just (RplStatsConn stats)--    ("251",[_,stats]) ->-       Just (RplLuserClient stats)--    ("252",[_,num,_]) ->-       Just (RplLuserOp num)--    ("253",[_,num,_]) ->-       Just (RplLuserUnknown num)--    ("254",[_,num,_]) ->-       Just (RplLuserChannels num)--    ("255",[_,txt]) -> Just (RplLuserMe txt)-    ("256",[_,server]) -> Just (RplLuserAdminMe server)-    ("257",[_,txt]) -> Just (RplLuserAdminLoc1 txt)-    ("258",[_,txt]) -> Just (RplLuserAdminLoc2 txt)-    ("259",[_,txt]) -> Just (RplLuserAdminEmail txt)--    ("263",[_,cmd,_]) ->-       Just (RplLoadTooHigh cmd)--    ("265", _:params) ->-       Just (RplLocalUsers params)--    ("266", _:params ) ->-       Just (RplGlobalUsers params)--    ("270",[_,txt]) ->-       Just (RplPrivs txt)--    ("276",[_,nick,txt]) ->-       Just (RplWhoisCertFp (mkId nick) txt)--    ("281",[_,nick]) ->-       Just (RplAcceptList (mkId nick))--    ("282",[_,_]) ->-       Just RplEndOfAccept--    ("301",[_,nick,message]) ->-       Just (RplAway (mkId nick) message)--    ("302",[_,txt]) ->-       Just (RplUserHost (filter (not . B.null) (B8.split ' ' txt)))--    ("303",[_,txt]) ->-       Just (RplIsOn (map mkId (filter (not . B.null) (B8.split ' ' txt))))--    ("304",[_,txt]) ->-       Just (RplSyntax txt)--    ("305",[_,_]) ->-       Just RplUnAway--    ("306",[_,_]) ->-       Just RplNowAway--    ("311",[_,nick,user,host,_star,txt]) ->-       Just (RplWhoisUser (mkId nick) user host txt)--    ("312",[_,nick,server,txt]) ->-       Just (RplWhoisServer (mkId nick) server txt)--    ("314",[_,nick,user,host,_star,txt]) ->-       Just (RplWhoWasUser (mkId nick) user host txt)--    ("319",[_,nick,txt]) ->-       Just (RplWhoisChannels (mkId nick) txt)--    ("313",[_,nick,txt]) ->-       Just (RplWhoisOperator (mkId nick) txt)--    ("315",[_,chan,_]) ->-       Just (RplEndOfWho (mkId chan))--    ("317",[_,nick,idle,signon,_txt]) ->-       Just (RplWhoisIdle (mkId nick) (asNumber idle) (Just (asTimeStamp signon)))--    ("317",[_,nick,idle,_txt]) ->-       Just (RplWhoisIdle (mkId nick) (asNumber idle) Nothing)--    ("318",[_,nick,_txt]) ->-       Just (RplEndOfWhois (mkId nick))--    ("321",[_,_,_]) ->-       Just RplListStart--    ("322",[_,chan,num,topic]) ->-       Just (RplList (mkId chan) (asNumber num) topic)--    ("323",[_,_]) ->-       Just RplListEnd--    ("324",_:chan:modes:params) ->-       Just (RplChannelModeIs (mkId chan) modes params)--    ("328",[_,chan,url]) ->-       Just (RplChannelUrl (mkId chan) url)--    ("329",[_,chan,time]) ->-       Just (RplCreationTime (mkId chan) (asTimeStamp time))--    ("330",[_,nick,account,_txt]) ->-       Just (RplWhoisAccount (mkId nick) account)--    ("331",[_,chan,_]) ->-       Just (RplNoTopicSet (mkId chan))--    ("332",[_,chan,txt]) ->-       Just (RplTopic (mkId chan) txt)--    ("333",[_,chan,who,time]) ->-       Just (RplTopicWhoTime (mkId chan) who (asTimeStamp time))--    ("341",_:nick:chan:_) ->-       Just (RplInviting (mkId nick) (mkId chan))--    ("346",[_,chan,mask,who,time]) ->-       Just (RplInviteList (mkId chan) mask who (asTimeStamp time))--    ("347",[_,chan,_txt]) ->-       Just (RplEndOfInviteList (mkId chan))--    ("348",[_,chan,mask,who,time]) ->-       Just (RplExceptionList (mkId chan) mask who (asTimeStamp time))--    ("349",[_,chan,_txt]) ->-       Just (RplEndOfExceptionList (mkId chan))--    ("351", _:version) ->-       Just (RplVersion version)--    ("352",[_,chan,user,host,server,nick,flags,txt]) ->-       Just (RplWhoReply (mkId chan) user host server (mkId nick) flags txt)-         -- trailing is: <hop> <realname>--    ("353",[_,ty,chan,txt]) ->-      do ty' <- case ty of-                  "=" -> Just PublicChannel-                  "*" -> Just PrivateChannel-                  "@" -> Just SecretChannel-                  _   -> Nothing-         Just (RplNameReply ty' (mkId chan) (filter (not . B.null) (B8.split ' ' txt)))--    ("364",[_,mask,server,info]) -> Just (RplLinks mask server info)-    ("365",[_,mask,_]          ) -> Just (RplEndOfLinks mask)--    ("366",[_,chan,_]) -> Just (RplEndOfNames (mkId chan))--    ("367",[_,chan,banned,banner,time]) ->-       Just (RplBanList (mkId chan) banned banner (asTimeStamp time))--    ("368",[_,chan,_txt]) ->-       Just (RplEndOfBanList (mkId chan))--    ("369",[_,nick,_]) ->-       Just (RplEndOfWhoWas (mkId nick))--    ("371",[_,txt]) ->-       Just (RplInfo txt)--    ("374",[_,_]) ->-       Just RplEndOfInfo--    ("375",[_,_]) -> Just RplMotdStart-    ("372",[_,txt]) -> Just (RplMotd txt)-    ("376",[_,_]) -> Just RplEndOfMotd--    ("379",_:nick:modes:args) ->-       Just (RplWhoisModes (mkId nick) modes args)--    ("378",[_,nick,txt]) ->-       Just (RplWhoisHost (mkId nick) txt)--    ("381",[_,txt]) ->-         Just (RplYoureOper txt)--    ("391",[_,server,txt]) ->-         Just (RplTime server txt)--    ("396",[_,host,_]) ->-         Just (RplHostHidden host)--    ("401",[_,nick,_]) ->-         Just (Err (mkId nick) ErrNoSuchNick)--    ("402",[_,server,_]) ->-         Just (Err "" (ErrNoSuchServer server))--    ("403",[_,channel,_]) ->-         Just (Err (mkId channel) ErrNoSuchChannel)--    ("404",[_,channel,_]) ->-         Just (Err (mkId channel) ErrCannotSendToChan)--    ("405",[_,channel,_]) ->-         Just (Err (mkId channel) ErrTooManyChannels)--    ("406",[_,nick,_]) ->-         Just (Err (mkId nick) ErrWasNoSuchNick)--    ("407",[_,target,_]) ->-         Just (Err (mkId target) ErrTooManyTargets)--    ("409",[_,_]) ->-         Just (Err "" ErrNoOrigin)--    ("411",[_,_]) ->-         Just (Err "" ErrNoRecipient)--    ("412",[_,_]) ->-         Just (Err "" ErrNoTextToSend)--    ("421",[_,cmd,_]) ->-         Just (Err "" (ErrUnknownCommand cmd))--    ("422",[_,_]) ->-         Just (Err "" ErrNoMotd)--    ("423",[_,server,_]) ->-         Just (Err "" (ErrNoAdminInfo server))--    ("431",[_,_]) -> Just (Err "" ErrNoNicknameGiven)--    ("432",[_,nick,_]) -> Just (Err "" (ErrErroneousNickname nick))--    ("433",[_,nick,_]) -> Just (Err "" (ErrNicknameInUse (mkId nick)))--    ("435",[_,chan,_]) -> Just (Err (mkId chan) ErrBanNickChange)--    ("437",[_,ident,_]) -> Just (Err (mkId ident) ErrUnavailResource)--    ("438",[_,_,_,_]) -> Just (Err "" ErrNickTooFast)--    ("441",[_,nick,_]) ->-         Just (Err (mkId nick) ErrServicesDown)--    ("441",[_,nick,chan,_]) ->-         Just (Err (mkId chan) (ErrUserNotInChannel (mkId nick)))--    ("442",[_,chan,_]) ->-         Just (Err (mkId chan) ErrNotOnChannel)--    ("443",[_,nick,chan,_]) ->-         Just (Err (mkId chan) (ErrUserOnChannel (mkId nick)))--    ("451",[_,_]) ->-         Just (Err "" ErrNotRegistered)--    ("456",[_,_]) ->-         Just (Err "" ErrAcceptFull)--    ("457",[_,nick,_]) ->-         Just (Err (mkId nick) ErrAcceptExist)--    ("458",[_,nick,_]) ->-         Just (Err (mkId nick) ErrAcceptNot)--    ("461",[_,cmd,_]) ->-         Just (Err "" (ErrNeedMoreParams cmd))--    ("462",[_,_]) ->-         Just (Err "" ErrAlreadyRegistered)--    ("463",[_,_]) ->-         Just (Err "" ErrNoPermForHost)--    ("464",[_,_]) ->-         Just (Err "" ErrPasswordMismatch)--    ("465",[_,_]) ->-         Just (Err "" ErrYoureBannedCreep)--    ("470",[_,chan1,chan2,_]) ->-         Just (Err (mkId chan1) (ErrLinkChannel (mkId chan2)))--    ("471",[_,chan,_]) ->-         Just (Err (mkId chan) ErrChannelFull)--    ("472",[_,mode,_]) ->-         Just (Err "" (ErrUnknownMode (B8.head mode)))--    ("473",[_,chan,_]) ->-         Just (Err (mkId chan) ErrInviteOnlyChan)--    ("474",[_,chan,_]) ->-         Just (Err (mkId chan) ErrBannedFromChan)--    ("475",[_,chan,_]) ->-         Just (Err (mkId chan) ErrBadChannelKey)--    ("477",[_,chan,_]) ->-         Just (Err (mkId chan) ErrNeedReggedNick)--    ("478",[_,chan,mode,_]) ->-         Just (Err (mkId chan) (ErrBanListFull (B8.head mode)))--    ("479",[_,chan,_]) ->-         Just (Err "" (ErrBadChanName chan))--    ("480",[_,chan,_]) ->-         Just (Err (mkId chan) ErrThrottle)--    ("481",[_,_]) ->-         Just (Err "" ErrNoPrivileges)--    ("482",[_,chan,_]) ->-         Just (Err (mkId chan) ErrChanOpPrivsNeeded)--    ("483",[_,_]) ->-         Just (Err "" ErrCantKillServer)--    ("484",[_,nick,chan,_]) ->-         Just (Err (mkId chan) (ErrIsChanService (mkId nick)))--    ("486",[_,nick,_]) ->-         Just (Err (mkId nick) ErrNoNonReg)--    ("489",[_,chan,_]) ->-         Just (Err (mkId chan) ErrVoiceNeeded)--    ("491",[_,_]) ->-         Just (Err "" ErrNoOperHost)--    ("494",[_,nick,_]) ->-         Just (Err (mkId nick) ErrOwnMode)--    ("501",[_,mode,_]) ->-         Just (Err "" (ErrUnknownUmodeFlag (B8.head mode)))--    ("502",[_,_]) ->-         Just (Err "" ErrUsersDontMatch)--    ("524",[_,topic,_]) ->-         Just (Err "" (ErrHelpNotFound topic))--    ("671",[_,nick,_]) ->-         Just (RplWhoisSecure (mkId nick))--    ("704",[_,topic,txt]) ->-         Just (RplHelpStart topic txt)--    ("705",[_,topic,txt]) ->-         Just (RplHelp topic txt)--    ("706",[_,topic,_]) ->-         Just (RplEndOfHelp topic)--    ("710",[_,chan,who,_]) ->-         Just (RplKnock (mkId chan) (parseUserInfo who))--    ("711",[_,chan,_]) ->-         Just (RplKnockDelivered (mkId chan))--    ("712",[_,chan,_]) ->-         Just (Err (mkId chan) ErrTooManyKnocks)--    ("713",[_,chan,_]) ->-         Just (Err (mkId chan) ErrChanOpen)--    ("714",[_,chan,_]) ->-         Just (Err (mkId chan) ErrKnockOnChan)--    ("716",[_,nick,_]) ->-         Just (Err (mkId nick) ErrTargUmodeG)--    ("723",[_,priv,_]) ->-         Just (Err "" (ErrNoPrivs priv))--    ("717",[_,nick,_]) ->-         Just (RplTargNotify (mkId nick))--    ("718",[_,nick,mask,_]) ->-         Just (RplUmodeGMsg (mkId nick) mask)--    ("728",[_,chan,mode,banned,banner,time]) ->-         Just (RplQuietList (mkId chan) (B8.head mode) banned banner (asTimeStamp time))--    ("729",[_,chan,mode,_]) ->-         Just (RplEndOfQuietList (mkId chan) (B8.head mode))--    ("742",[_,chan,mode,setting,_]) ->-         Just (Err (mkId chan) (ErrMlockRestricted (B8.head mode) setting))--    ("900",[_,_,account,_]) ->-         Just (RplLoggedIn account)--    ("901",[_,_,_]) ->-         Just RplLoggedOut--    ("902",[_,_]) ->-         Just RplNickLocked--    ("903",[_,_]) ->-         Just RplSaslSuccess--    ("904",[_,_]) ->-         Just RplSaslFail--    ("905",[_,_]) ->-         Just RplSaslTooLong--    ("906",[_,_]) ->-         Just RplSaslAborted--    ("907",[_,_]) ->-         Just RplSaslAlready--    ("908",[_,mechs,_]) ->-         Just (RplSaslMechs mechs)--    ("PING",[txt]) -> Just (Ping txt)--    ("PONG",[txt       ]) -> Just (Pong Nothing txt)-    ("PONG",[server,txt]) -> Just (Pong (Just server) txt)--    ("PRIVMSG",[dst,txt]) ->-      do src <- msgPrefix ircmsg-         Just (PrivMsg src (mkId dst) txt)--    ("NOTICE",[dst,txt]) ->-      do src <- msgPrefix ircmsg-         Just (Notice src (mkId dst) txt)--    ("TOPIC",[chan,txt]) ->-      do who <- msgPrefix ircmsg-         Just (Topic who (mkId chan) txt)--    ("JOIN",[chan,account,real]) ->-      do who <- msgPrefix ircmsg-         Just (ExtJoin who (mkId chan) (if account == "*" then Nothing else Just account) real)--    ("JOIN",[chan]) ->-      do who <- msgPrefix ircmsg-         Just (Join who (mkId chan))--    ("NICK",[newnick]) ->-      do who <- msgPrefix ircmsg-         Just (Nick who (mkId newnick))--    ("MODE",tgt:modes) ->-      do who <- msgPrefix ircmsg-         Just (Mode who (mkId tgt) modes)--    ("PART",[chan]) ->-      do who <- msgPrefix ircmsg-         Just (Part who (mkId chan) "")--    ("PART",[chan,txt]) ->-      do who <- msgPrefix ircmsg-         Just (Part who (mkId chan) txt)--    ("AWAY",[txt]) ->-      do who <- msgPrefix ircmsg-         Just (Away who (Just txt))--    ("AWAY",[]) ->-      do who <- msgPrefix ircmsg-         Just (Away who Nothing)--    ("QUIT",[txt]) ->-      do who <- msgPrefix ircmsg-         Just (Quit who txt)--    ("KICK",[chan,tgt,txt]) ->-      do who <- msgPrefix ircmsg-         Just (Kick who (mkId chan) (mkId tgt) txt)--    ("INVITE",[_,chan]) ->-      do who <- msgPrefix ircmsg-         Just (Invite who (mkId chan))--    ("CAP",[_,cmd,txt]) ->-         Just (Cap cmd txt)--    ("ERROR",[txt]) ->-         Just (Error txt)--    ("AUTHENTICATE",[txt]) ->-         Just (Authenticate txt)--    ("ACCOUNT",[acct]) ->-      do who <- msgPrefix ircmsg-         Just (Account who (if acct == "*" then Nothing else Just acct))--    _ -> Nothing--asTimeStamp :: ByteString -> UTCTime-asTimeStamp = posixSecondsToUTCTime . fromInteger . asNumber--asNumber :: ByteString -> Integer-asNumber b =-  case B8.readInteger b of-    Nothing    -> 0-    Just (x,_) -> x

@@ -1,9 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}---- | Automatically generated 'Prism's for all of the types in 'MsgFromServer'-module Irc.Core.Prisms where--import Control.Lens-import Irc.Core--makePrisms ''MsgFromServer

@@ -1,303 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}--- | This module provides a parser and printer for the low-level IRC--- message format.-module Irc.Format-  ( UserInfo(..)-  , RawIrcMsg(..)-  , parseRawIrcMsg-  , renderRawIrcMsg-  , parseUserInfo-  , renderUserInfo-  , Identifier-  , mkId-  , idBytes-  , idDenote-  , asUtf8-  , ircFoldCase-  ) where--import Control.Applicative-import Control.Monad (when)-import Data.Array-import Data.Attoparsec.ByteString.Char8 as P-import Data.ByteString (ByteString)-import Data.ByteString.Builder (Builder)-import Data.Functor-import Data.Monoid-import Data.String-import Data.Text (Text)-import Data.Time (UTCTime)-import Data.Word (Word8)-import qualified Data.ByteString as B-import qualified Data.ByteString.Builder as Builder-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Lazy as L-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text--import Irc.Time (myParseTime)---- | 'UserInfo' packages a nickname along with the username and hsotname--- if they are known in the current context.-data UserInfo = UserInfo-  { userNick :: Identifier-  , userName :: Maybe ByteString-  , userHost :: Maybe ByteString-  }-  deriving (Read, Show)---- | 'RawIrcMsg' breaks down the IRC protocol into its most basic parts.--- The "trailing" parameter indicated in the IRC protocol with a leading--- colon will appear as the last parameter in the parameter list.------ Note that RFC 2812 specifies a maximum of 15 parameters.------ @:prefix COMMAND param0 param1 param2 .. paramN@-data RawIrcMsg = RawIrcMsg-  { msgTime    :: Maybe UTCTime-  , msgPrefix  :: Maybe UserInfo-  , msgCommand :: ByteString-  , msgParams  :: [ByteString]-  }-  deriving (Read, Show)---- | Case insensitive identifier representing channels and nicknames-data Identifier = Identifier ByteString ByteString-  deriving (Read, Show)---- Equality on normalized 'Identifiers'-instance Eq Identifier where-  x == y = idDenote x == idDenote y---- Comparison on normalized 'Identifiers'-instance Ord Identifier where-  compare x y = compare (idDenote x) (idDenote y)--instance IsString Identifier where-  fromString = mkId . fromString---- | Construct an 'Identifier' from a 'ByteString'-mkId :: ByteString -> Identifier-mkId x = Identifier x (ircFoldCase x)---- | Returns the original 'ByteString' of an 'Identifier'-idBytes :: Identifier -> ByteString-idBytes (Identifier x _) = x---- | Returns the case-normalized 'ByteString' of an 'Identifier'--- which is suitable for comparison.-idDenote :: Identifier -> ByteString-idDenote (Identifier _ x) = x---- | Attempt to split an IRC protocol message without its trailing newline--- information into a structured message.-parseRawIrcMsg :: ByteString -> Maybe RawIrcMsg-parseRawIrcMsg x =-  case parseOnly rawIrcMsgParser x of-    Left{}  -> Nothing-    Right r -> Just r---- | RFC 2812 specifies that there can only be up to--- 14 "middle" parameters, after that the fifteenth is--- the final parameter and the trailing : is optional!-maxMiddleParams :: Int-maxMiddleParams = 14----  Excerpt from https://tools.ietf.org/html/rfc2812#section-2.3.1----  message    =  [ ":" prefix SPACE ] command [ params ] crlf---  prefix     =  servername / ( nickname [ [ "!" user ] "@" host ] )---  command    =  1*letter / 3digit---  params     =  *14( SPACE middle ) [ SPACE ":" trailing ]---             =/ 14( SPACE middle ) [ SPACE [ ":" ] trailing ]----  nospcrlfcl =  %x01-09 / %x0B-0C / %x0E-1F / %x21-39 / %x3B-FF---                  ; any octet except NUL, CR, LF, " " and ":"---  middle     =  nospcrlfcl *( ":" / nospcrlfcl )---  trailing   =  *( ":" / " " / nospcrlfcl )----  SPACE      =  %x20        ; space character---  crlf       =  %x0D %x0A   ; "carriage return" "linefeed"---- | Parse a whole IRC message assuming that the trailing--- newlines have already been removed. This parser will--- parse valid messages correctly but will also accept some--- invalid messages. Presumably the server isn't sending--- invalid messages!-rawIrcMsgParser :: Parser RawIrcMsg-rawIrcMsgParser =-  do time   <- guarded (string "@time=") timeParser-     prefix <- guarded (char ':') prefixParser-     cmd    <- simpleTokenParser-     params <- paramsParser maxMiddleParams-     return RawIrcMsg-              { msgTime    = time-              , msgPrefix  = prefix-              , msgCommand = cmd-              , msgParams  = params-              }---- | Parse the list of parameters in a raw message. The RFC--- allows for up to 15 parameters.-paramsParser :: Int -> Parser [ByteString]-paramsParser n =-  do _ <- skipMany (char ' ') -- Freenode requires this exception-     endOfInput $> [] <|> more-  where-  more-    | n == 0 =-        do _ <- optional (char ':')-           finalParam--    | otherwise =-        do mbColon <- optional (char ':')-           case mbColon of-             Just{}  -> finalParam-             Nothing -> middleParam--  finalParam =-    do x <- takeByteString-       let !x' = B.copy x-       return [x']--  middleParam =-    do x <- P.takeWhile (/= ' ')-       when (B8.null x) (fail "Empty middle parameter")-       let !x' = B.copy x-       xs <- paramsParser (n-1)-       return (x':xs)---- | Parse the server-time message prefix:--- @time=2015-03-04T22:29:04.064Z-timeParser :: Parser UTCTime-timeParser =-  do timeBytes <- simpleTokenParser-     _         <- char ' '-     case parseIrcTime (B8.unpack timeBytes) of-       Nothing -> fail "Bad server-time format"-       Just t  -> return t--parseIrcTime :: String -> Maybe UTCTime-parseIrcTime = myParseTime "%Y-%m-%dT%H:%M:%S%Q%Z"--prefixParser :: Parser UserInfo-prefixParser =-  do tok <- simpleTokenParser-     _   <- char ' '-     return (parseUserInfo tok)---- | Take the bytes up to the next space delimiter-simpleTokenParser :: Parser ByteString-simpleTokenParser =-  do xs <- P.takeWhile (/= ' ')-     when (B8.null xs) (fail "Empty token")-     return $! B8.copy xs---- | Take the bytes up to the next space delimiter.--- If the first character of this token is a ':'--- then take the whole remaining bytestring---- | Render 'UserInfo' as @nick!username\@hostname@-renderUserInfo :: UserInfo -> ByteString-renderUserInfo u = idBytes (userNick u)-                <> maybe B.empty ("!" <>) (userName u)-                <> maybe B.empty ("@" <>) (userHost u)---- | Split up a hostmask into a nickname, username, and hostname.--- The username and hostname might not be defined but are delimited by--- a @!@ and @\@@ respectively.-parseUserInfo :: ByteString -> UserInfo-parseUserInfo x = UserInfo-  { userNick = mkId nick-  , userName = if B.null user then Nothing else Just (B.drop 1 user)-  , userHost = if B.null host then Nothing else Just (B.drop 1 host)-  }-  where-  (nickuser,host) = B8.break (=='@') x-  (nick,user) = B8.break (=='!') nickuser---- | Serialize a structured IRC protocol message back into its wire--- format. This command adds the required trailing newline.-renderRawIrcMsg :: RawIrcMsg -> ByteString-renderRawIrcMsg m = L.toStrict $ Builder.toLazyByteString $-     maybe mempty renderPrefix (msgPrefix m)-  <> Builder.byteString (msgCommand m)-  <> buildParams (msgParams m)-  <> Builder.word8 13-  <> Builder.word8 10--renderPrefix :: UserInfo -> Builder-renderPrefix u = Builder.char8 ':'-              <> Builder.byteString (renderUserInfo u)-              <> Builder.char8 ' '---- | Build concatenate a list of parameters into a single, space---- delimited bytestring. Use a colon for the last parameter if it contains--- a colon or a space.-buildParams :: [ByteString] -> Builder-buildParams [x]-  | B.elem 32 x || B.elem 58 x-  = Builder.word8 32 <> Builder.word8 58 <> Builder.byteString x-buildParams (x:xs)-  = Builder.word8 32 <> Builder.byteString x <> buildParams xs-buildParams [] = mempty---- | When the first parser succeeds require the second parser to succeed.--- Otherwise return Nothing-guarded :: Parser a -> Parser b -> Parser (Maybe b)-guarded pa pb =-  do mb <- optional pa-     case mb of-       Nothing -> return Nothing-       Just{}  -> fmap Just pb---- | Capitalize a string according to RFC 2812--- Latin letters are capitalized and {|}~ are mapped to [\]^-ircFoldCase :: ByteString -> ByteString-ircFoldCase = B.map (B.index casemap . fromIntegral)--casemap :: ByteString-casemap = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\-          \\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\-          \ !\"#$%&'()*+,-./0123456789:;<=>?\-          \@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_\-          \`ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^\x7f\-          \\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\-          \\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\-          \\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\-          \\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\-          \\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\-          \\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\-          \\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\-          \\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff"---- Try to decode a message as UTF-8. If that fails interpret it as Windows CP1252--- This helps deal with clients like XChat that get clever and otherwise misconfigured--- clients.-asUtf8 :: ByteString -> Text-asUtf8 x = case Text.decodeUtf8' x of-             Right txt -> txt-             Left{}    -> decodeCP1252 x--decodeCP1252 :: ByteString -> Text-decodeCP1252 = Text.pack . map (cp1252!) . B.unpack--cp1252 :: Array Word8 Char-cp1252 = listArray (0,255)-  ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK','\a','\b','\t','\n','\v','\f','\r','\SO','\SI',-   '\DLE','\DC1','\DC2','\DC3','\DC4','\NAK','\SYN','\ETB','\CAN','\EM','\SUB','\ESC','\FS','\GS','\RS','\US',-   ' ','!','\"','#','$','%','&','\'','(',')','*','+',',','-','.','/',-   '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?',-   '@','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O',-   'P','Q','R','S','T','U','V','W','X','Y','Z','[','\\',']','^','_',-   '`','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o',-   'p','q','r','s','t','u','v','w','x','y','z','{','|','}','~','\DEL',-   '\8364','\129','\8218','\402','\8222','\8230','\8224','\8225','\710','\8240','\352','\8249','\338','\141','\381','\143',-   '\144','\8216','\8217','\8220','\8221','\8226','\8211','\8212','\732','\8482','\353','\8250','\339','\157','\382','\376',-   '\160','\161','\162','\163','\164','\165','\166','\167','\168','\169','\170','\171','\172','\173','\174','\175',-   '\176','\177','\178','\179','\180','\181','\182','\183','\184','\185','\186','\187','\188','\189','\190','\191',-   '\192','\193','\194','\195','\196','\197','\198','\199','\200','\201','\202','\203','\204','\205','\206','\207',-   '\208','\209','\210','\211','\212','\213','\214','\215','\216','\217','\218','\219','\220','\221','\222','\223',-   '\224','\225','\226','\227','\228','\229','\230','\231','\232','\233','\234','\235','\236','\237','\238','\239',-   '\240','\241','\242','\243','\244','\245','\246','\247','\248','\249','\250','\251','\252','\253','\254','\255']

@@ -0,0 +1,80 @@+{-|+Module      : Irc.Identifier+Description : Type and operations for nicknames and channel names+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module defines support for working with IRC's numeric reply+codes. Pattern synonyms are provided for each of the possible IRC reply codes.++Reply code information was extracted from https://www.alien.net.au/irc/irc2numerics.html++-}+module Irc.Identifier+  ( Identifier+  , idDenote+  , mkId+  , idText+  , idPrefix+  ) where++import           Data.ByteString (ByteString)+import qualified Data.ByteString as B+import           Data.Char+import           Data.Function+import           Data.Hashable+import           Data.Primitive.ByteArray+import           Data.Text (Text)+import qualified Data.Text.Encoding as Text+import qualified Data.Vector.Primitive as PV+import           Data.Word++-- | Identifier representing channels and nicknames+data Identifier = Identifier {-# UNPACK #-} !Text+                             {-# UNPACK #-} !(PV.Vector Word8)+  deriving (Read, Show)++-- | Equality on normalized identifier+instance Eq Identifier where+  (==) = (==) `on` idDenote++-- | Comparison on normalized identifier+instance Ord Identifier where+  compare = compare `on` idDenote++-- | Hash on normalized identifier+instance Hashable Identifier where+  hashWithSalt s = hashPV8WithSalt s . idDenote++hashPV8WithSalt :: Int -> PV.Vector Word8 -> Int+hashPV8WithSalt salt (PV.Vector off len (ByteArray arr)) =+  hashByteArrayWithSalt arr off len salt++-- | Construct an 'Identifier' from a 'ByteString'+mkId :: Text -> Identifier+mkId x = Identifier x (ircFoldCase (Text.encodeUtf8 x))++-- | Returns the original 'Text' of an 'Identifier'+idText :: Identifier -> Text+idText (Identifier x _) = x++-- | Returns the case-normalized 'ByteString' of an 'Identifier'+-- which is suitable for comparison or hashing.+idDenote :: Identifier -> PV.Vector Word8+idDenote (Identifier _ x) = x++-- | Returns 'True' when the first argument is a prefix of the second.+idPrefix :: Identifier -> Identifier -> Bool+idPrefix (Identifier _ x) (Identifier _ y) = x == PV.take (PV.length x) y++-- | Capitalize a string according to RFC 2812+-- Latin letters are capitalized and {|}~ are mapped to [\]^+ircFoldCase :: ByteString -> PV.Vector Word8+ircFoldCase = PV.fromList . map (\i -> casemap PV.! fromIntegral i) . B.unpack++casemap :: PV.Vector Word8+casemap+  = PV.fromList+  $ map (fromIntegral . ord)+  $ ['\x00'..'`'] ++ "ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^" ++ ['\x7f'..'\xff']

@@ -1,93 +1,277 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}+{-# Language OverloadedStrings #-} +{-|+Module      : Irc.Message+Description : High-level representation of IRC messages+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module defines high-level IRC commands. Commands are interpreted+and their arguments are extracted into the appropriate types.++-}+ module Irc.Message-  ( -- * High-level IRC events-    IrcMessage(..)-  , IrcMessageType(..)-  , mesgType-  , mesgSender-  , mesgStamp-  , mesgStatus-  , mesgMe-  , mesgModes-  , defaultIrcMessage+  (+  -- * High-level messages+    IrcMsg(..)+  , CapCmd(..)+  , cookIrcMsg -  -- * Prisms-  , _PrivMsgType-  , _NoticeMsgType-  , _ActionMsgType-  , _AwayMsgType-  , _JoinMsgType-  , _KickMsgType-  , _PartMsgType-  , _QuitMsgType-  , _NickMsgType-  , _TopicMsgType-  , _ErrorMsgType-  , _ErrMsgType-  , _ModeMsgType-  , _InviteMsgType-  , _KnockMsgType-  , _CallerIdMsgType-  , _CallerIdDeliveredMsgType-  , _CtcpReqMsgType-  , _CtcpRspMsgType+  -- * Properties of messages+  , MessageTarget(..)+  , ircMsgText+  , msgTarget+  , msgActor++  -- * Helper functions+  , nickSplit+  , computeMaxMessageLength   ) where -import Control.Lens-import Data.ByteString (ByteString)-import Data.Text (Text)-import Data.Time-import Data.Time.Clock.POSIX+import           Control.Lens+import           Control.Monad+import           Data.Function+import           Data.Maybe+import           Data.Text (Text)+import qualified Data.Text as Text+import           Data.Text.Read as Text+import           Irc.Identifier+import           Irc.RawIrcMsg+import           Irc.UserInfo+import           Irc.Codes -import Irc.Core-import Irc.Format+-- | High-level IRC message representation+data IrcMsg+  = UnknownMsg !RawIrcMsg -- ^ pass-through for unhandled messages+  | Reply !ReplyCode [Text] -- ^ code arguments+  | Nick !UserInfo !Identifier -- ^ old new+  | Join !UserInfo !Identifier -- ^ user channel+  | Part !UserInfo !Identifier (Maybe Text) -- ^ user channel reason+  | Quit !UserInfo (Maybe Text) -- ^ user reason+  | Kick !UserInfo !Identifier !Identifier !Text -- ^ kicker channel kickee comment+  | Topic !UserInfo !Identifier !Text -- ^ user channel topic+  | Privmsg !UserInfo !Identifier !Text -- ^ source target txt+  | Ctcp !UserInfo !Identifier !Text !Text -- ^ source target command txt+  | CtcpNotice !UserInfo !Identifier !Text !Text -- ^ source target command txt+  | Notice !UserInfo !Identifier !Text -- ^ source target txt+  | Mode !UserInfo !Identifier [Text] -- ^ source target txt+  | Authenticate !Text -- ^ parameters+  | Cap !CapCmd [Text] -- ^ command parameters+  | Ping [Text] -- ^ parameters+  | Pong [Text] -- ^ parameters+  | Error !Text -- ^ message+  deriving Show --- | 'IrcMessage' represents a high-level event to be communicated out--- to the library user when something changes on a connection.-data IrcMessage = IrcMessage-  { _mesgType :: !IrcMessageType-  , _mesgSender :: !UserInfo-  , _mesgStamp :: !UTCTime-  , _mesgMe :: !Bool-  , _mesgModes :: String-  , _mesgStatus :: String -- for Statusmsg feature-  }-  deriving (Read, Show)+-- | Sub-commands of the CAP command+data CapCmd+  = CapLs -- ^ request list of supported caps+  | CapList -- ^ request list of active caps+  | CapReq -- ^ request activation of cap+  | CapAck -- ^ request accepted+  | CapNak -- ^ request denied+  | CapEnd -- ^ end negotiation+  deriving (Show, Eq, Ord) -defaultIrcMessage :: IrcMessage-defaultIrcMessage = IrcMessage-  { _mesgType = PrivMsgType ""-  , _mesgSender = UserInfo "" Nothing Nothing-  , _mesgStamp = posixSecondsToUTCTime 0-  , _mesgMe = False-  , _mesgModes = ""-  , _mesgStatus = ""-  }+-- | Match command text to structured cap sub-command+cookCapCmd :: Text -> Maybe CapCmd+cookCapCmd "LS"   = Just CapLs+cookCapCmd "LIST" = Just CapList+cookCapCmd "ACK"  = Just CapAck+cookCapCmd "NAK"  = Just CapNak+cookCapCmd "END"  = Just CapEnd+cookCapCmd "REQ"  = Just CapReq+cookCapCmd _      = Nothing --- | Event types and associated fields used by 'IrcMessage'.-data IrcMessageType-  = PrivMsgType   Text-  | NoticeMsgType Text-  | ActionMsgType Text-  | AwayMsgType   Text-  | JoinMsgType-  | KickMsgType   Identifier Text-  | PartMsgType   Text-  | QuitMsgType   Text-  | NickMsgType   Identifier-  | TopicMsgType  Text-  | ErrorMsgType  Text-  | ErrMsgType  IrcError -- Family of various responses-  | ModeMsgType Bool Char ByteString-  | InviteMsgType-  | KnockMsgType-  | CallerIdMsgType-  | CallerIdDeliveredMsgType-  | CtcpReqMsgType ByteString ByteString -- ^ ctcp command and arguments-  | CtcpRspMsgType ByteString ByteString -- ^ ctcp command and arguments-  deriving (Read, Show)+-- | Interpret a low-level 'RawIrcMsg' as a high-level 'IrcMsg'.+-- Messages that can't be understood are wrapped in 'UnknownMsg'.+cookIrcMsg :: RawIrcMsg -> IrcMsg+cookIrcMsg msg =+  case view msgCommand msg of+    cmd | Right (n,"") <- decimal cmd ->+        Reply (ReplyCode n) (view msgParams msg)+    "CAP" | _target:cmdTxt:rest <- view msgParams msg+          , Just cmd <- cookCapCmd cmdTxt ->+           Cap cmd rest -makeLenses ''IrcMessage-makePrisms ''IrcMessageType+    "AUTHENTICATE" | x:_ <- view msgParams msg ->+        Authenticate x++    "PING" -> Ping (view msgParams msg)+    "PONG" -> Pong (view msgParams msg)++    "PRIVMSG" | Just user <- view msgPrefix msg+           , [chan,txt]   <- view msgParams msg ->++           case parseCtcp txt of+             Just (cmd,args) -> Ctcp user (mkId chan) (Text.toUpper cmd) args+             Nothing         -> Privmsg user (mkId chan) txt++    "NOTICE" | Just user <- view msgPrefix msg+           , [chan,txt]    <- view msgParams msg ->++           case parseCtcp txt of+             Just (cmd,args) -> CtcpNotice user (mkId chan) (Text.toUpper cmd) args+             Nothing         -> Notice user (mkId chan) txt++    "JOIN" | Just user <- view msgPrefix msg+           , chan:_    <- view msgParams msg ->++           Join user (mkId chan)++    "QUIT" | Just user <- view msgPrefix msg+           , reasons   <- view msgParams msg ->+           Quit user (listToMaybe reasons)++    "PART" | Just user    <- view msgPrefix msg+           , chan:reasons <- view msgParams msg ->+           Part user (mkId chan) (listToMaybe reasons)++    "NICK"  | Just user <- view msgPrefix msg+            , newNick:_ <- view msgParams msg ->+           Nick user (mkId newNick)++    "KICK"  | Just user <- view msgPrefix msg+            , [chan,nick,reason] <- view msgParams msg ->+           Kick user (mkId chan) (mkId nick) reason++    "TOPIC" | Just user <- view msgPrefix msg+            , [chan,topic] <- view msgParams msg ->+            Topic user (mkId chan) topic++    "MODE"  | Just user <- view msgPrefix msg+            , target:modes <- view msgParams msg ->+            Mode user (mkId target) modes++    "ERROR" | [reason] <- view msgParams msg ->+            Error reason++    _      -> UnknownMsg msg++-- | Parse a CTCP encoded message:+--+-- @\^ACOMMAND arguments\^A@+parseCtcp :: Text -> Maybe (Text, Text)+parseCtcp txt =+  do txt1 <- Text.stripSuffix "\^A" =<< Text.stripPrefix "\^A" txt+     let (cmd,args) = Text.break (==' ') txt1+     guard (not (Text.null cmd))+     return (cmd, Text.drop 1 args)+++-- | Targets used to direct a message to a window for display+data MessageTarget+  = TargetUser   !Identifier -- ^ Metadata update for a user+  | TargetWindow !Identifier -- ^ Directed message to channel or from user+  | TargetNetwork            -- ^ Network-level message+  | TargetHidden             -- ^ Completely hidden message++-- | Target information for the window that could be appropriate to+-- display this message in.+msgTarget :: Identifier -> IrcMsg -> MessageTarget+msgTarget me msg =+  case msg of+    UnknownMsg{}                  -> TargetNetwork+    Nick user _                   -> TargetUser (userNick user)+    Mode _ tgt _ | tgt == me      -> TargetNetwork+                 | otherwise      -> TargetWindow tgt+    Join _ chan                   -> TargetWindow chan+    Part _ chan _                 -> TargetWindow chan+    Quit user _                   -> TargetUser (userNick user)+    Kick _ chan _ _               -> TargetWindow chan+    Topic _ chan _                -> TargetWindow chan+    Privmsg src tgt _ | tgt == me -> TargetWindow (userNick src)+                      | otherwise -> TargetWindow tgt+    Ctcp src tgt _ _  | tgt == me -> TargetWindow (userNick src)+                      | otherwise -> TargetWindow tgt+    CtcpNotice src tgt _ _  | tgt == me -> TargetWindow (userNick src)+                            | otherwise -> TargetWindow tgt+    Notice  src tgt _ | tgt == me -> TargetWindow (userNick src)+                      | otherwise -> TargetWindow tgt+    Authenticate{}                -> TargetHidden+    Ping{}                        -> TargetHidden+    Pong{}                        -> TargetHidden+    Error{}                       -> TargetNetwork+    Cap{}                         -> TargetNetwork+    Reply{}                       -> TargetNetwork++-- | 'UserInfo' of the user responsible for a message.+msgActor :: IrcMsg -> Maybe UserInfo+msgActor msg =+  case msg of+    UnknownMsg{}  -> Nothing+    Reply{}       -> Nothing+    Nick x _      -> Just x+    Join x _      -> Just x+    Part x _ _    -> Just x+    Quit x _      -> Just x+    Kick x _ _ _  -> Just x+    Topic x _ _   -> Just x+    Privmsg x _ _ -> Just x+    Ctcp x _ _ _  -> Just x+    CtcpNotice x _ _ _ -> Just x+    Notice x _ _  -> Just x+    Mode x _ _    -> Just x+    Authenticate{}-> Nothing+    Ping{}        -> Nothing+    Pong{}        -> Nothing+    Error{}       -> Nothing+    Cap{}         -> Nothing++-- | Text representation of an IRC message to be used for matching with+-- regular expressions.+ircMsgText :: IrcMsg -> Text+ircMsgText msg =+  case msg of+    UnknownMsg raw -> Text.unwords (view msgCommand raw : view msgParams raw)+    Reply (ReplyCode n) xs -> Text.unwords (Text.pack (show n) : xs)+    Nick x y       -> Text.unwords [renderUserInfo x, idText y]+    Join x _       -> renderUserInfo x+    Part x _ mb    -> Text.unwords (renderUserInfo x : maybeToList mb)+    Quit x mb      -> Text.unwords (renderUserInfo x : maybeToList mb)+    Kick x _ z r   -> Text.unwords [renderUserInfo x, idText z, r]+    Topic x _ t    -> Text.unwords [renderUserInfo x, t]+    Privmsg x _ t  -> Text.unwords [renderUserInfo x, t]+    Ctcp x _ c t   -> Text.unwords [renderUserInfo x, c, t]+    CtcpNotice x _ c t -> Text.unwords [renderUserInfo x, c, t]+    Notice x _ t   -> Text.unwords [renderUserInfo x, t]+    Mode x _ xs    -> Text.unwords (renderUserInfo x:"set mode":xs)+    Ping xs        -> Text.unwords xs+    Pong xs        -> Text.unwords xs+    Cap _ xs       -> Text.unwords xs+    Error t        -> t+    Authenticate{} -> ""++-- nickname   =  ( letter / special ) *8( letter / digit / special / "-" )+-- letter     =  %x41-5A / %x61-7A       ; A-Z / a-z+-- digit      =  %x30-39                 ; 0-9+-- special    =  %x5B-60 / %x7B-7D+isNickChar :: Char -> Bool+isNickChar x = '0' <= x && x <= '9'+              || 'A' <= x && x <= '}'+              || '-' == x++-- | Split a nick into text parts group by whether or not those parts are valid+-- nickname characters.+nickSplit :: Text -> [Text]+nickSplit = Text.groupBy ((==) `on` isNickChar)++-- | Maximum length computation for the message part for+-- privmsg and notice. Note that the need for the limit is because+-- the server will limit the length of the message sent out to each+-- client, not just the length of the messages it will recieve.+--+-- Note that the length is on the *encoded message* which is UTF-8+-- The calculation isn't using UTF-8 on the userinfo part because+-- I'm assuming that the channel name and userinfo are all ASCII+--+-- @+-- :my!user@info PRIVMSG #channel :messagebody\r\n+-- @+computeMaxMessageLength :: UserInfo -> Text -> Int+computeMaxMessageLength myUserInfo target+  = 512 -- max IRC command+  - Text.length (renderUserInfo myUserInfo)+  - length (": PRIVMSG  :\r\n"::String)+  - Text.length target