glirc 2.5 → 2.6
raw patch · 28 files changed
+648/−2386 lines, 28 filesdep +irc-coredep −memorydep −primitive
Dependencies added: irc-core
Dependencies removed: memory, primitive
Files
- ChangeLog.md +9/−0
- README.md +12/−4
- glirc.cabal +2/−12
- src/Client/ChannelState.hs +1/−1
- src/Client/Commands.hs +37/−39
- src/Client/Configuration.hs +77/−60
- src/Client/ConnectionState.hs +32/−30
- src/Client/EditBox.hs +267/−101
- src/Client/EventLoop.hs +90/−36
- src/Client/Hook.hs +6/−2
- src/Client/Hook/Znc/Buffextras.hs +30/−33
- src/Client/Image.hs +30/−14
- src/Client/Image/ChannelInfo.hs +4/−1
- src/Client/Image/MaskList.hs +2/−2
- src/Client/Image/Message.hs +21/−17
- src/Client/Image/Palette.hs +3/−0
- src/Client/ServerSettings.hs +3/−0
- src/Client/State.hs +15/−14
- src/Client/WordCompletion.hs +6/−5
- src/Irc/Codes.hs +0/−854
- src/Irc/Commands.hs +0/−266
- src/Irc/Identifier.hs +0/−80
- src/Irc/Message.hs +0/−277
- src/Irc/Modes.hs +0/−122
- src/Irc/RateLimit.hs +0/−69
- src/Irc/RawIrcMsg.hs +0/−287
- src/Irc/UserInfo.hs +0/−59
- src/Main.hs +1/−1
ChangeLog.md view
@@ -1,5 +1,14 @@ # Revision history for glirc2 +## 2.6++* connect-cmds now use actual client commands instead of raw IRC messages. For example `msg user my message` or `join #mychannel`+* Multiple lines can be held in the textbox at once. Pasting mutiple lines insert those lines into the textbox rather than sending them immediately.+* Added `M-d` and `M-Enter` key bindings+* Added `name` field to server configuration+* Extract irc-core library again+* Configurable self color+ ## 2.5 * Add facilities for hooks that can alter the irc message stream.
README.md view
@@ -52,6 +52,8 @@ 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. +The default configuration file path is `~/.config/glirc/config`+ Relative paths are relative to the home directory. Learn more about this file format at [config-value](http://hackage.haskell.org/package/config-value)@@ -76,7 +78,8 @@ socks-host: "socks5.example.com" socks-port: 8080 -- defaults to 1080 - * hostname: "example.com"+ * name: "example"+ hostname: "example.com" port: 7000 connect-cmds: * "JOIN #favoritechannel,#otherchannel"@@ -106,10 +109,12 @@ * `defaults` - These settings are used for all connections * `servers` - These settings are used to override defaults when the hostname matches * `palette` - Client color overrides+* `window-names` - text - Names of windows (typically overridden on non QWERTY layouts) Settings -------- +* `name` - text - name of server entry, defaults to `hostname` * `hostname` - text - hostname used to connect and to specify the server * `port` - number - port number, defaults to 6667 without TLS and 6697 with TLS * `nick` - text - nickname@@ -153,7 +158,7 @@ * `/exit` - Terminate the client * `/quit` - Gracefully terminate connection to the current server-* `/connect <hostname>` - Connect to the given hostname+* `/connect <name>` - Connect to the given server * `/disconnect` - Forcefully terminate connection to the current server * `/reconnect` - Reconnect to the current server @@ -230,17 +235,19 @@ * `^N` next channel * `^P` previous channel-* `M-#` jump to window - 1234567890qwertyuiop!@#$%^&*()QWERTYUIOP+* `M-#` jump to window - `1234567890qwertyuiop!@#$%^&*()QWERTYUIOP` * `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+* `^W` delete word backwards * `^Y` paste from yank buffer * `M-F` forward word * `M-B` backward word+* `M-BACKSPACE` delete word backwards+* `M-D` delete word forwards * `TAB` nickname completion * `F2` toggle detailed view * `Page Up` scroll up@@ -251,6 +258,7 @@ * `^_` underline * `^]` italic * `^O` reset formatting+* `M-Enter` insert newline Hooks =====
glirc.cabal view
@@ -1,5 +1,5 @@ name: glirc-version: 2.5+version: 2.6 synopsis: Console IRC client description: Console IRC client license: ISC@@ -52,19 +52,10 @@ Client.Window Client.WordCompletion Config.FromConfig- Irc.Codes- Irc.Commands- Irc.Identifier- Irc.Message- Irc.Modes- Irc.RateLimit- Irc.RawIrcMsg- Irc.UserInfo LensUtils StrictUnit Paths_glirc - -- other-extensions: build-depends: base >=4.9 && <4.10, async >=2.1 && < 2.2, attoparsec >=0.13 && <0.14,@@ -78,10 +69,9 @@ filepath >=1.4.1 && <1.5, gitrev >=1.2 && <1.3, hashable >=1.2.4 && <1.3,+ irc-core >=2.0 && <2.1, lens >=4.14 && <4.15,- memory >=0.13 && <0.14, network >=2.6.2 && <2.7,- primitive >=0.6 && <0.7, split >=0.2 && <0.3, stm >=2.4 && <2.5, text >=1.2.2 && <1.3,
src/Client/ChannelState.hs view
@@ -15,7 +15,7 @@ module Client.ChannelState (- -- * Channel state type+ -- * Channel state ChannelState(..) , chanTopic , chanTopicProvenance
src/Client/Commands.hs view
@@ -14,6 +14,7 @@ module Client.Commands ( CommandResult(..) , execute+ , executeCommand , tabCompletion ) where @@ -48,7 +49,10 @@ -- | Possible results of running a command data CommandResult- = CommandContinue ClientState -- ^ Continue running client with updated state+ = CommandSuccess ClientState+ -- ^ Continue running the client, consume input if command was from input+ | CommandFailure ClientState+ -- ^ Continue running the client, report an error | CommandQuit -- ^ Client should close type ClientCommand = ClientState -> String -> IO CommandResult@@ -64,24 +68,22 @@ | ChatCommand ChannelCommand (Bool -> ChannelCommand) -- ^ requires an active chat window | ChannelCommand ChannelCommand (Bool -> ChannelCommand) -- ^ requires an active channel window --- | Resume the client without further state changes-commandContinue :: Monad m => ClientState -> m CommandResult-commandContinue = return . CommandContinue- -- | Consider the text entry successful and resume the client commandSuccess :: Monad m => ClientState -> m CommandResult-commandSuccess = commandContinue . consumeInput+commandSuccess = return . CommandSuccess -- | Consider the text entry a failure and resume the client commandFailure :: Monad m => ClientState -> m CommandResult-commandFailure = commandContinue . set clientBell True+commandFailure = return . CommandFailure --- | Interpret whatever text is in the textbox. Leading @/@ indicates a+-- | Interpret the given chat message or command. Leading @/@ indicates a -- command. Otherwise if a channel or user query is focused a chat message -- will be sent.-execute :: ClientState -> IO CommandResult-execute st =- case clientInput st of+execute ::+ String {- ^ chat or command -} ->+ ClientState -> IO CommandResult+execute str st =+ case str of [] -> commandFailure st '/':command -> executeCommand Nothing command st msg -> executeChat msg st@@ -91,9 +93,9 @@ -- input based on the users of the channel related to the current buffer. tabCompletion :: Bool {- ^ reversed -} -> ClientState -> IO CommandResult tabCompletion isReversed st =- case clientInput st of+ case snd $ clientLine st of '/':command -> executeCommand (Just isReversed) command st- _ -> commandContinue (nickTabCompletion isReversed st)+ _ -> commandSuccess (nickTabCompletion isReversed st) -- | Treat the current text input as a chat message and send it. executeChat :: String -> ClientState -> IO CommandResult@@ -102,7 +104,7 @@ ChannelFocus network channel | Just !cs <- preview (clientConnection network) st -> do now <- getZonedTime- let msgTxt = Text.pack msg+ let msgTxt = Text.pack $ takeWhile (/='\n') msg ircMsg = rawIrcMsg "PRIVMSG" [idText channel, msgTxt] myNick = UserInfo (view csNick cs) "" "" entry = ClientMessage@@ -132,7 +134,7 @@ executeCommand :: Maybe Bool -> String -> ClientState -> IO CommandResult executeCommand (Just isReversed) _ st- | Just st' <- commandNameCompletion isReversed st = commandContinue st'+ | Just st' <- commandNameCompletion isReversed st = commandSuccess st' executeCommand tabCompleteReversed str st = let (cmd, rest) = splitWord str@@ -164,7 +166,7 @@ _ -> case tabCompleteReversed of Nothing -> commandFailure st- Just isReversed -> commandContinue (nickTabCompletion isReversed st)+ Just isReversed -> commandSuccess (nickTabCompletion isReversed st) -- Expands each alias to have its own copy of the command callbacks expandAliases :: [([a],b)] -> [(a,b)]@@ -228,15 +230,15 @@ simpleClientTab :: Bool -> ClientCommand simpleClientTab isReversed st _ =- commandContinue (nickTabCompletion isReversed st)+ commandSuccess (nickTabCompletion isReversed st) simpleNetworkTab :: Bool -> NetworkCommand simpleNetworkTab isReversed _ _ st _ =- commandContinue (nickTabCompletion isReversed st)+ commandSuccess (nickTabCompletion isReversed st) simpleChannelTab :: Bool -> ChannelCommand simpleChannelTab isReversed _ _ _ st _ =- commandContinue (nickTabCompletion isReversed st)+ commandSuccess (nickTabCompletion isReversed st) cmdExit :: ClientCommand cmdExit _ _ = return CommandQuit@@ -398,14 +400,12 @@ -- the current networks are used. tabFocus :: Bool -> ClientCommand tabFocus isReversed st _- = commandContinue+ = commandSuccess $ fromMaybe st $ clientTextBox (wordComplete id isReversed completions) st where networks = map mkId $ HashMap.keys $ view clientNetworkMap st- textBox = view clientTextBox st- params = words $ take (view Edit.pos textBox)- (view Edit.content textBox)+ params = words $ uncurry take $ clientLine st completions | length params == 2 = networks@@ -532,12 +532,12 @@ cs' <- if freeTarget then cs <$ sendMsg cs cmd else sendModeration channelId [cmd] cs- commandContinueUpdateCS cs' st+ commandSuccessUpdateCS cs' st _ -> commandFailure st -commandContinueUpdateCS :: ConnectionState -> ClientState -> IO CommandResult-commandContinueUpdateCS cs st =+commandSuccessUpdateCS :: ConnectionState -> ClientState -> IO CommandResult+commandSuccessUpdateCS cs st = let networkId = view csNetworkId cs in commandSuccess $ setStrict (clientConnections . ix networkId) cs st@@ -565,8 +565,8 @@ | all isSpace rest , Just topic <- preview (csChannels . ix channelId . chanTopic) cs = do let textBox = Edit.end- . set Edit.content ("/topic " ++ Text.unpack topic)- commandContinue (over clientTextBox textBox st)+ . set Edit.line (Edit.endLine $ "/topic " ++ Text.unpack topic)+ commandSuccess (over clientTextBox textBox st) | otherwise = commandFailure st @@ -592,7 +592,7 @@ do let msg = Text.pack (dropWhile isSpace reason) cmd = ircKick channelId (Text.pack who) msg cs' <- sendModeration channelId [cmd] cs- commandContinueUpdateCS cs' st+ commandSuccessUpdateCS cs' st cmdKickBan :: NetworkName -> ConnectionState -> Identifier -> ClientState -> String -> IO CommandResult@@ -609,7 +609,7 @@ , ircKick channelId whoTxt msg ] cs' <- sendModeration channelId cmds cs- commandContinueUpdateCS cs' st+ commandSuccessUpdateCS cs' st computeBanUserInfo :: Identifier -> ConnectionState -> UserInfo computeBanUserInfo who cs =@@ -625,7 +625,7 @@ do let msg = Text.pack (dropWhile isSpace reason) cmd = ircRemove channelId (Text.pack who) msg cs' <- sendModeration channelId [cmd] cs- commandContinueUpdateCS cs' st+ commandSuccessUpdateCS cs' st cmdJoin :: NetworkName -> ConnectionState -> ClientState -> String -> IO CommandResult cmdJoin network cs st rest =@@ -718,7 +718,7 @@ cs' <- if needOp then sendModeration chan cmds cs else cs <$ traverse_ (sendMsg cs) cmds- commandContinueUpdateCS cs' st+ commandSuccessUpdateCS cs' st _ -> commandFailure st @@ -733,16 +733,14 @@ [ (pol,mode) | (pol,mode,arg) <- parsedModes, not (Text.null arg) ] , (pol,mode):_ <- drop (paramIndex-3) parsedModesWithParams , let completions = computeModeCompletion pol mode channel cs- -> commandContinue+ -> commandSuccess $ fromMaybe st $ clientTextBox (wordComplete id isReversed completions) st - _ -> commandContinue st+ _ -> commandSuccess st where- textBox = view clientTextBox st- paramIndex = length $ words $ take (view Edit.pos textBox)- (view Edit.content textBox)+ paramIndex = length $ words $ uncurry take $ clientLine st -- | Use the *!*@host masks of users for channel lists when setting list modes --@@ -778,8 +776,8 @@ clientTextBox (wordComplete id isReversed possibilities) st where n = length leadingPart- leadingPart = takeWhile (not . isSpace) (clientInput st)- cursorPos = view (clientTextBox . Edit.pos) st+ (cursorPos, line) = clientLine st+ leadingPart = takeWhile (not . isSpace) line possibilities = mkId . Text.cons '/' <$> HashMap.keys commands -- | Complete the nickname at the current cursor position using the
src/Client/Configuration.hs view
@@ -21,6 +21,7 @@ , configDefaults , configServers , configPalette+ , configWindowNames -- * Loading configuration , loadConfiguration@@ -32,7 +33,6 @@ import Client.Image.Palette import Client.Configuration.Colors import Client.ServerSettings-import Control.Applicative import Control.Exception import Control.Monad import Config@@ -44,10 +44,8 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text-import Data.Traversable import Graphics.Vty.Attributes import Irc.Identifier (Identifier, mkId)-import Network.Socket (HostName) import System.Directory import System.FilePath import System.IO.Error@@ -57,8 +55,9 @@ -- otherwise '_configDefaults' is used. data Configuration = Configuration { _configDefaults :: ServerSettings -- ^ Default connection settings- , _configServers :: (HashMap HostName ServerSettings) -- ^ Host-specific settings+ , _configServers :: (HashMap Text ServerSettings) -- ^ Host-specific settings , _configPalette :: Palette+ , _configWindowNames :: Text -- ^ Names of windows, used when alt-jumping } deriving Show @@ -72,6 +71,9 @@ instance Exception ConfigurationFailure +defaultWindowNames :: Text+defaultWindowNames = "1234567890qwertyuiop!@#$%^&*()QWERTYUIOP"+ -- | Uses 'getAppUserDataDirectory' to find @.glirc/config@ getOldConfigPath :: IO FilePath getOldConfigPath =@@ -155,19 +157,21 @@ _configPalette <- fromMaybe defaultPalette <$> sectionOptWith parsePalette "palette" + _configWindowNames <- fromMaybe defaultWindowNames+ <$> sectionOpt "window-names"+ return Configuration{..} parsePalette :: Value -> ConfigParser Palette-parsePalette (Sections ss) = foldM paletteHelper defaultPalette ss-parsePalette _ = failure "Expected sections"+parsePalette = parseSectionsWith paletteHelper defaultPalette -paletteHelper :: Palette -> Section -> ConfigParser Palette-paletteHelper p (Section k v) =- extendLoc k $+paletteHelper :: Palette -> Text -> Value -> ConfigParser Palette+paletteHelper p k v = case k of "nick-colors" -> do xs <- parseColors v return $! set palNicks xs p + "self" -> setAttr palSelf "time" -> setAttr palTime "meta" -> setAttr palMeta "sigil" -> setAttr palSigil@@ -185,66 +189,79 @@ let !attr = withForeColor defAttr x return $! set l attr p +parseSectionsWith :: (a -> Text -> Value -> ConfigParser a) -> a -> Value -> ConfigParser a+parseSectionsWith p start s =+ case s of+ Sections xs -> foldM (\x (Section k v) -> extendLoc k (p x k v)) start xs+ _ -> failure "Expected sections" -parseServers :: ServerSettings -> Value -> ConfigParser (HashMap HostName ServerSettings)-parseServers def (List xs) =- do ys <- traverse (parseServerSettings def) xs- return (HashMap.fromList [(view ssHostName ss, ss) | ss <- ys])-parseServers _ _ = failure "expected list"+parseServers :: ServerSettings -> Value -> ConfigParser (HashMap Text ServerSettings)+parseServers def v =+ do sss <- parseList (parseServerSettings def) v+ return (HashMap.fromList [(serverSettingName ss, ss) | ss <- sss])+ where+ serverSettingName ss =+ fromMaybe (views ssHostName Text.pack ss)+ (view ssName ss) -sectionOptString :: Text -> SectionParser (Maybe String)-sectionOptString key = fmap Text.unpack <$> sectionOpt key+parseServerSettings :: ServerSettings -> Value -> ConfigParser ServerSettings+parseServerSettings = parseSectionsWith parseServerSetting -sectionOptStrings :: Text -> SectionParser (Maybe [String])-sectionOptStrings key = fmap (fmap Text.unpack) <$> sectionOpt key+parseServerSetting :: ServerSettings -> Text -> Value -> ConfigParser ServerSettings+parseServerSetting ss k v =+ case k of+ "nick" -> setField ssNick+ "username" -> setField ssUser+ "realname" -> setField ssReal+ "userinfo" -> setField ssUserInfo+ "password" -> setFieldMb ssPassword+ "sasl-username" -> setFieldMb ssSaslUsername+ "sasl-password" -> setFieldMb ssSaslPassword+ "hostname" -> setFieldWith ssHostName parseString+ "port" -> setFieldWithMb ssPort parseNum+ "tls" -> setFieldWith ssTls parseBoolean+ "tls-insecure" -> setFieldWith ssTlsInsecure parseBoolean+ "tls-client-cert" -> setFieldWithMb ssTlsClientCert parseString+ "tls-client-key" -> setFieldWithMb ssTlsClientKey parseString+ "server-certificates" -> setFieldWith ssServerCerts (parseList parseString)+ "connect-cmds" -> setField ssConnectCmds+ "socks-host" -> setFieldWithMb ssSocksHost parseString+ "socks-port" -> setFieldWith ssSocksPort parseNum+ "chanserv-channels" -> setFieldWith ssChanservChannels (parseList parseIdentifier)+ "flood-penalty" -> setField ssFloodPenalty+ "flood-threshold" -> setField ssFloodThreshold+ "message-hooks" -> setField ssMessageHooks+ "name" -> setFieldMb ssName+ _ -> failure "Unknown section"+ where+ setField l = setFieldWith l parseConfig+ setFieldMb l = setFieldWithMb l parseConfig -sectionOptNum :: Num a => Text -> SectionParser (Maybe a)-sectionOptNum key = fmap fromInteger <$> sectionOpt key+ setFieldWith l p =+ do x <- p v+ return $! set l x ss -sectionOptIdentifiers :: Text -> SectionParser (Maybe [Identifier])-sectionOptIdentifiers key = fmap (fmap mkId) <$> sectionOpt key+ setFieldWithMb l p =+ do x <- p v+ return $! set l (Just x) ss -parseServerSettings :: ServerSettings -> Value -> ConfigParser ServerSettings-parseServerSettings !def =- parseSections $- do _ssNick <- fieldReq ssNick "nick"- _ssUser <- fieldReq ssUser "username"- _ssReal <- fieldReq ssReal "realname"- _ssUserInfo <- fieldReq ssUserInfo "userinfo"- _ssPassword <- field ssPassword "password"- _ssSaslUsername <- field ssSaslUsername "sasl-username"- _ssSaslPassword <- field ssSaslPassword "sasl-password"- _ssHostName <- fieldReq' ssHostName (sectionOptString "hostname")- _ssPort <- field' ssPort (sectionOptNum "port")- _ssTls <- fieldReq' ssTls (boolean "tls")- _ssTlsInsecure <- fieldReq' ssTlsInsecure (boolean "tls-insecure")- _ssTlsClientCert <- field' ssTlsClientCert (sectionOptString "tls-client-cert")- _ssTlsClientKey <- field' ssTlsClientKey (sectionOptString "tls-client-key")- _ssConnectCmds <- fieldReq ssConnectCmds "connect-cmds"- _ssSocksHost <- field' ssSocksHost (sectionOptString "socks-host")- _ssSocksPort <- fieldReq' ssSocksPort (sectionOptNum "socks-port")- _ssServerCerts <- fieldReq' ssServerCerts (sectionOptStrings "server-certificates")- _ssChanservChannels <- fieldReq' ssChanservChannels (sectionOptIdentifiers "chanserv-channels")- _ssFloodPenalty <- fieldReq ssFloodPenalty "flood-penalty"- _ssFloodThreshold <- fieldReq ssFloodThreshold "flood-threshold"- _ssMessageHooks <- fieldReq ssMessageHooks "message-hooks"- return ServerSettings{..}- where- field l key = field' l (sectionOpt key)- fieldReq l key = fieldReq' l (sectionOpt key)+parseBoolean :: Value -> ConfigParser Bool+parseBoolean (Atom "yes") = return True+parseBoolean (Atom "no") = return False+parseBoolean _ = failure "expected yes or no" - fieldReq' l p = fromMaybe (view l def) <$> p+parseList :: (Value -> ConfigParser a) -> Value -> ConfigParser [a]+parseList p (List xs) = traverse p xs+parseList _ _ = failure "expected list" - field' l p = (<|> view l def) <$> p+parseNum :: Num a => Value -> ConfigParser a+parseNum v = fromInteger <$> parseConfig v -boolean :: Text -> SectionParser (Maybe Bool)-boolean key =- do mb <- sectionOpt key- for mb $ \a ->- case atomName a of- "yes" -> return True- "no" -> return False- _ -> liftConfigParser (failure "expected yes or no")+parseIdentifier :: Value -> ConfigParser Identifier+parseIdentifier v = mkId <$> parseConfig v++parseString :: Value -> ConfigParser String+parseString v = Text.unpack <$> parseConfig v -- | Resolve relative paths starting at the home directory rather than -- the current directory of the client.
src/Client/ConnectionState.hs view
@@ -18,8 +18,10 @@ module Client.ConnectionState (- -- * Connection state type+ -- * Connection state ConnectionState(..)+ , newConnectionState+ , csNick , csChannels , csSocket@@ -39,8 +41,6 @@ , csPingStatus , csMessageHooks - , newConnectionState- -- * User information , UserAndHost(..) @@ -92,33 +92,38 @@ import Irc.UserInfo import LensUtils +-- | State tracked for each IRC connection data ConnectionState = ConnectionState- { _csNetworkId :: !NetworkId- , _csChannels :: !(HashMap Identifier ChannelState)- , _csSocket :: !NetworkConnection- , _csModeTypes :: !ModeTypes- , _csChannelTypes :: ![Char]- , _csTransaction :: !Transaction- , _csModes :: ![Char]- , _csStatusMsg :: ![Char]- , _csSettings :: !ServerSettings- , _csUserInfo :: !UserInfo- , _csUsers :: !(HashMap Identifier UserAndHost)- , _csModeCount :: !Int- , _csNetwork :: !Text- , _csNextPingTime :: !(Maybe UTCTime)- , _csPingStatus :: !PingStatus- , _csMessageHooks :: ![Text]+ { _csNetworkId :: !NetworkId -- ^ network connection identifier+ , _csChannels :: !(HashMap Identifier ChannelState) -- ^ joined channels+ , _csSocket :: !NetworkConnection -- ^ network socket+ , _csModeTypes :: !ModeTypes -- ^ channel mode meanings+ , _csChannelTypes :: ![Char] -- ^ channel identifier prefixes+ , _csTransaction :: !Transaction -- ^ state for multi-message sequences+ , _csModes :: ![Char] -- ^ modes for the connected user+ , _csStatusMsg :: ![Char] -- ^ modes that prefix statusmsg channel names+ , _csSettings :: !ServerSettings -- ^ settings used for this connection+ , _csUserInfo :: !UserInfo -- ^ usermask used by the server for this connection+ , _csUsers :: !(HashMap Identifier UserAndHost) -- ^ user and hostname for other nicks+ , _csModeCount :: !Int -- ^ maximum mode changes per MODE command+ , _csNetwork :: !Text -- ^ name of network connection+ , _csNextPingTime :: !(Maybe UTCTime) -- ^ time for next ping event+ , _csPingStatus :: !PingStatus -- ^ state of ping timer+ , _csMessageHooks :: ![Text] -- ^ names of message hooks to apply to this connection } deriving Show -data UserAndHost = UserAndHost {-# UNPACK #-} !Text {-# UNPACK #-} !Text+-- | Pair of username and hostname. Empty strings represent missing information.+data UserAndHost =+ UserAndHost {-# UNPACK #-} !Text {-# UNPACK #-} !Text+ -- ^ username hostname deriving Show +-- | Status of the ping timer data PingStatus- = PingSent !UTCTime- | PingLatency !Double -- seconds- | PingNever+ = PingSent !UTCTime -- ^ ping sent waiting for pong+ | PingLatency !Double -- ^ latency in seconds for last ping+ | PingNever -- ^ no ping sent deriving Show data Transaction@@ -263,13 +268,10 @@ ZonedTime {- ^ message received -} -> Identifier {- ^ my nickname -} -> ConnectionState -> ([RawIrcMsg], ConnectionState)-doWelcome msgWhen me cs = (reply, update cs)- where- reply = mapMaybe parseRawIrcMsg (view (csSettings . ssConnectCmds) cs)-- update- = set csNick me- . set csNextPingTime (Just $! addUTCTime 30 (zonedTimeToUTC msgWhen))+doWelcome msgWhen me+ = noReply+ . set csNick me+ . set csNextPingTime (Just $! addUTCTime 30 (zonedTimeToUTC msgWhen)) doTopic :: ZonedTime -> UserInfo -> Identifier -> Text -> ConnectionState -> ConnectionState doTopic when user chan topic =
src/Client/EditBox.hs view
@@ -15,9 +15,17 @@ -} module Client.EditBox- ( EditBox+ ( Line(Line)+ , endLine+ , HasLine(..)+ , Content+ , above+ , current+ , below+ , singleLine+ , firstLine+ , EditBox , content- , pos , tabSeed , delete , backspace@@ -25,7 +33,8 @@ , end , killHome , killEnd- , killWord+ , killWordBackward+ , killWordForward , paste , left , right@@ -39,12 +48,199 @@ , success ) where -import Control.Lens+import Control.Lens hiding (below) import Data.Char +data Line = Line+ { _pos :: !Int+ , _text :: !String+ }+ deriving (Read, Show)++makeClassy ''Line++emptyLine :: Line+emptyLine = Line 0 ""++endLine :: String -> Line+endLine s = Line (length s) s++-- | Zipper-ish view of the multi-line content of an 'EditBox'.+-- Lines 'above' the 'current' are stored in reverse order.+data Content = Content+ { _above :: ![String]+ , _current :: !Line+ , _below :: ![String]+ }+ deriving (Read, Show)++makeLenses ''Content++instance HasLine Content where+ line = current++-- | Default 'Content' value+noContent :: Content+noContent = Content [] emptyLine []++-- | Single line 'Content'.+singleLine :: Line -> Content+singleLine l = Content [] l []++-- | Shifts the first line off of the 'Content', yielding the+-- text of the line and the rest of the content.+shift :: Content -> (String, Content)+shift (Content [] l []) = (view text l, noContent)+shift (Content a@(_:_) l b) = (last a, Content (init a) l b)+shift (Content [] l (b:bs)) = (view text l, Content [] (endLine b) bs)++firstLine :: Content -> String+firstLine (Content a c _) = head (reverse a ++ [_text c])++jumpLeft :: Content -> Content+jumpLeft c+ | view pos c == 0+ , a:as <- view above c+ = over below (cons $ view text c)+ . set text a+ . set above as+ $ c+ | otherwise = set pos 0 c++jumpRight :: Content -> Content+jumpRight c+ | view pos c == len+ , b:bs <- view below c+ = over above (cons $ view text c)+ . set text b+ . set pos len+ . set below bs+ $ c+ | otherwise = set pos len c+ where len = views text length c++-- Move the cursor left, across lines if necessary.+left :: Content -> Content+left c+ | n > 0+ = over (current.pos) (subtract 1) c++ | n == 0+ , a:as <- view above c+ = over below (cons s)+ . set above as+ . set current (endLine a)+ $ c++ | otherwise = c+ where Line n s = view current c++-- Move the cursor right, across lines if necessary.+right :: Content -> Content+right c+ | n < length s+ = over (current.pos) (+1) c++ | n == length s+ , b:bs <- view below c+ = over above (cons s)+ . set below bs+ . set current (Line 0 b)+ $ c++ | otherwise = c+ where Line n s = view current c++-- | Move the cursor left to the previous word boundary.+leftWord :: Content -> Content+leftWord c+ | n == 0+ = case view above c of+ [] -> c+ (a:as) -> leftWord+ . set current (endLine a)+ . over below (cons txt)+ . set above as+ $ c+ | otherwise+ = case search of+ [] -> set (current.pos) 0 c+ (i,_):_ -> set (current.pos) (i+1) c+ where+ Line n txt = view current c+ search = dropWhile (isAlphaNum . snd)+ $ dropWhile (not . isAlphaNum . snd)+ $ reverse+ $ take n+ $ zip [0..]+ $ txt++-- | Move the cursor right to the next word boundary.+rightWord :: Content -> Content+rightWord c+ | n == length txt+ = case view below c of+ [] -> c+ (b:bs) -> rightWord+ . set current (endLine b)+ . over above (cons txt)+ . set below bs+ $ c+ | otherwise+ = case search of+ [] -> set (current.pos) (length txt) c+ (i,_):_ -> set (current.pos) i c+ where+ Line n txt = view current c+ search = dropWhile (isAlphaNum . snd)+ $ dropWhile (not . isAlphaNum . snd)+ $ drop n+ $ zip [0..]+ $ txt++-- | Delete the character before the cursor.+backspace :: Content -> Content+backspace c+ | n == 0+ = case view above c of+ [] -> c+ a:as -> set above as+ . set current (Line (length a) (a ++ s))+ $ c++ | (preS, postS) <- splitAt (n-1) s+ = set current (Line (n-1) (preS ++ drop 1 postS)) c+ where+ Line n s = view current c++-- | Delete the character after/under the cursor.+delete :: Content -> Content+delete c+ | n == length s+ = case view below c of+ [] -> c+ b:bs -> set below bs+ . set current (Line n (s ++ b))+ $ c++ | (preS, postS) <- splitAt n s+ = set current (Line n (preS ++ drop 1 postS)) c+ where+ Line n s = view current c++insertString :: String -> Content -> Content+insertString ins c = case push (view above c) (preS ++ l) ls of+ (newAbove, newCurrent) -> set above newAbove . set current newCurrent $ c+ where+ l:ls = lines (ins ++ "\n")+ Line n txt = view current c+ (preS, postS) = splitAt n txt++ push stk x [] = (stk, Line (length x) (x ++ postS))+ push stk x (y:ys) = push (x:stk) y ys+ data EditBox = EditBox- { _content :: !String- , _pos :: !Int+ { _content :: !Content , _history :: ![String] , _historyPos :: !Int , _yankBuffer :: !(String)@@ -54,17 +250,19 @@ makeLenses ''EditBox --- | Default 'EditBox value+-- | Default 'EditBox' value empty :: EditBox empty = EditBox- { _content = ""- , _pos = 0+ { _content = noContent , _history = [] , _historyPos = -1 , _yankBuffer = "" , _tabSeed = Nothing } +instance HasLine EditBox where+ line = content . line+ -- | Sets the given string to the yank buffer unless the string is empty. updateYankBuffer :: String -> EditBox -> EditBox updateYankBuffer str@@ -72,23 +270,24 @@ | otherwise = set yankBuffer str -- | Indicate that the contents of the text box were successfully used--- by the program. This clears the contents and cursor and updates the--- history.+-- by the program. This clears the first line of the contents and updates+-- the history. success :: EditBox -> EditBox success e- = over history (cons (view content e))- $ set content ""+ = over history (cons sent)+ $ set content c $ set tabSeed Nothing $ set historyPos (-1)- $ set pos 0 e+ $ e+ where+ (sent, c) = shift $ view content e -- | Update the editbox to reflect the earlier element in the history. 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)+ return $ set content (singleLine . endLine $ x) $ set historyPos i e -- | Update the editbox to reflect the later element in the history.@@ -96,84 +295,76 @@ later e | i < 0 = Nothing | i == 0 = Just- $ set content ""- $ set pos 0+ $ set content noContent $ set historyPos (-1) e | otherwise = do x <- preview (history . ix (i-1)) e- return $ set content x- $ set pos (length x)+ return $ set content (singleLine . endLine $ 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)- $ set tabSeed Nothing- $ over pos (min (views content length e - 1)) e- where- (a,b) = splitAt (view pos e) (view content e)---- | Delete the character after the cursor.-delete :: EditBox -> EditBox-delete e- | view pos e < views content length e = removeImpl e- | otherwise = e---- | Delete the character before the cursor.-backspace :: EditBox -> EditBox-backspace e- | view pos e > 0 = removeImpl (left e)- | otherwise = e- -- | Jump the cursor to the beginning of the input. home :: EditBox -> EditBox home = set tabSeed Nothing- . set pos 0+ . over content jumpLeft -- | Jump the cursor to the end of the input. end :: EditBox -> EditBox-end e+end = set tabSeed Nothing- $ set pos (views content length e) e+ . over content jumpRight -- | Delete all text from the cursor to the end and store it in -- the yank buffer. killEnd :: EditBox -> EditBox killEnd e- = set content keep+ | null kill+ = case view (content.below) e of+ [] -> e+ b:bs -> set (content.below) bs+ $ updateYankBuffer b e+ | otherwise+ = set (content.current) (endLine keep) $ updateYankBuffer kill e where- (keep,kill) = splitAt (view pos e) (view content e)+ Line n txt = view (content.current) e+ (keep,kill) = splitAt n txt -- | Delete all text from the cursor to the beginning and store it in -- the yank buffer. killHome :: EditBox -> EditBox killHome e- = set content keep- $ set pos 0+ | null kill+ = case view (content.above) e of+ [] -> e+ a:as -> set (content.above) as+ . set tabSeed Nothing+ $ updateYankBuffer a e++ | otherwise+ = set (content.current) (Line 0 keep) $ set tabSeed Nothing $ updateYankBuffer kill e where- (kill,keep) = splitAt (view pos e) (view content e)+ Line n txt = view (content.current) e+ (kill,keep) = splitAt n txt -- | Insert the yank buffer at the cursor. paste :: EditBox -> EditBox-paste e = insertString (view yankBuffer e) e+paste e = over content (insertString (view yankBuffer e)) e -- | Kill the content from the cursor back to the previous word boundary. -- When @yank@ is set the yank buffer will be updated.-killWord :: Bool {- ^ yank -} -> EditBox -> EditBox-killWord yank e- = set pos (length l')- $ sometimesUpdateYank- $ set content (l'++r) e+killWordBackward :: Bool {- ^ yank -} -> EditBox -> EditBox+killWordBackward yank e+ = sometimesUpdateYank+ $ set (content.current) (Line (length l') (l'++r))+ $ e where- (l,r) = splitAt (view pos e) (view content e)+ Line n txt = view (content.current) e+ (l,r) = splitAt n txt (sp,l1) = span isSpace (reverse l) (wd,l2) = break isSpace l1 l' = reverse l2@@ -183,51 +374,26 @@ | yank = updateYankBuffer yanked | otherwise = id +-- | Kill the content from the curser forward to the next word boundary.+-- When @yank@ is set the yank buffer will be updated+killWordForward :: Bool {- ^ yank -} -> EditBox -> EditBox+killWordForward yank e+ = sometimesUpdateYank+ $ set (content.current) (Line (length l) (l++r2))+ $ e+ where+ Line n txt = view (content.current) e+ (l,r) = splitAt n txt+ (sp,r1) = span isSpace r+ (wd,r2) = break isSpace r1+ yanked = sp++wd++ sometimesUpdateYank+ | yank = updateYankBuffer yanked+ | otherwise = id+ -- | Insert a character at the cursor and advance the cursor. insert :: Char -> EditBox -> EditBox insert c = set tabSeed Nothing- . insertString [c]---- | Insert a string at the cursor and advance the cursor.-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)---- | Move the cursor left.-left :: EditBox -> EditBox-left = over pos (max 0 . subtract 1)---- | Move the cursor right.-right :: EditBox -> EditBox-right e = over pos (min (views content length e) . (+1)) e---- | Move the cursor left to the previous word boundary.-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---- | Move the cursor right to the next word boundary.-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+ . over content (insertString [c])
src/Client/EventLoop.hs view
@@ -16,6 +16,7 @@ ) where import Client.Commands+import Client.Configuration import Client.ConnectionState import qualified Client.EditBox as Edit import Client.Hook@@ -23,6 +24,7 @@ import Client.Image import Client.Message import Client.NetworkConnection+import Client.ServerSettings import Client.State import Client.Window import Control.Concurrent.STM@@ -36,9 +38,11 @@ import qualified Data.Map as Map import Data.Maybe import Data.Ord+import Data.Text (Text) import qualified Data.Text as Text import Data.Time import Graphics.Vty+import Irc.Codes import Irc.Message import Irc.RawIrcMsg @@ -175,7 +179,8 @@ case stateHook (cookIrcMsg raw) of Nothing -> eventLoop st -- Message ignored Just irc -> do traverse_ (sendMsg cs) replies- eventLoop st'+ st2 <- clientResponse time' irc cs st1+ eventLoop st2 where -- state with message recorded recSt = case viewHook irc of@@ -191,8 +196,48 @@ } -- record messages *before* applying the changes- (replies, st') = applyMessageToClientState time irc networkId cs recSt+ (replies, st1) = applyMessageToClientState time irc networkId cs recSt +-- | Client-level responses to specific IRC messages.+-- This is in contrast to the connection state tracking logic in+-- "Client.ConnectionState"+clientResponse :: ZonedTime -> IrcMsg -> ConnectionState -> ClientState -> IO ClientState+clientResponse now irc cs st =+ case irc of+ Reply RPL_WELCOME _ ->+ foldM+ (processConnectCmd now cs)+ st+ (view (csSettings . ssConnectCmds) cs)+ _ -> return st++processConnectCmd ::+ ZonedTime {- ^ now -} ->+ ConnectionState {- ^ current network -} ->+ ClientState ->+ Text {- ^ command -} ->+ IO ClientState+processConnectCmd now cs st0 cmdTxt =+ do res <- executeCommand Nothing (Text.unpack cmdTxt) st0+ return $! case res of+ CommandFailure st -> reportConnectCmdError now cs cmdTxt st+ CommandSuccess st -> st+ CommandQuit -> st0 -- not supported+++reportConnectCmdError ::+ ZonedTime {- ^ now -} ->+ ConnectionState {- ^ current network -} ->+ Text {- ^ bad command -} ->+ ClientState ->+ ClientState+reportConnectCmdError now cs cmdTxt =+ recordNetworkMessage ClientMessage+ { _msgTime = now+ , _msgNetwork = view csNetwork cs+ , _msgBody = ErrorBody ("Bad connect-cmd: " ++ Text.unpack cmdTxt)+ }+ -- | Find the ZNC provided server time computeEffectiveTime :: ZonedTime -> [TagEntry] -> ZonedTime computeEffectiveTime time tags = fromMaybe time zncTime@@ -225,29 +270,31 @@ (w,h) <- displayBounds (outputIface vty) eventLoop $ set clientWidth w $ set clientHeight h st+ EvPaste s -> eventLoop (over (clientTextBox . Edit.content) (Edit.insertString s) st) _ -> eventLoop st -- | Map keyboard inputs to actions in the client doKey :: Key -> [Modifier] -> ClientState -> IO () doKey key modifier st =- let changeInput f = eventLoop (over clientTextBox f st) in+ let changeEditor f = eventLoop (over clientTextBox f st)+ changeContent f = eventLoop (over (clientTextBox . Edit.content) f st) in case modifier of [MCtrl] -> case key of- KChar 'd' -> changeInput Edit.delete- KChar 'a' -> changeInput Edit.home- KChar 'e' -> changeInput Edit.end- KChar 'u' -> changeInput Edit.killHome- KChar 'k' -> changeInput Edit.killEnd- KChar 'y' -> changeInput Edit.paste- KChar 'w' -> changeInput (Edit.killWord True)- KChar 'b' -> changeInput (Edit.insert '\^B')- KChar 'c' -> changeInput (Edit.insert '\^C')- KChar ']' -> changeInput (Edit.insert '\^]')- KChar '_' -> changeInput (Edit.insert '\^_')- KChar 'o' -> changeInput (Edit.insert '\^O')- KChar 'v' -> changeInput (Edit.insert '\^V')+ KChar 'd' -> changeContent Edit.delete+ KChar 'a' -> changeEditor Edit.home+ KChar 'e' -> changeEditor Edit.end+ KChar 'u' -> changeEditor Edit.killHome+ KChar 'k' -> changeEditor Edit.killEnd+ KChar 'y' -> changeEditor Edit.paste+ KChar 'w' -> changeEditor (Edit.killWordBackward True)+ KChar 'b' -> changeEditor (Edit.insert '\^B')+ KChar 'c' -> changeEditor (Edit.insert '\^C')+ KChar ']' -> changeEditor (Edit.insert '\^]')+ KChar '_' -> changeEditor (Edit.insert '\^_')+ KChar 'o' -> changeEditor (Edit.insert '\^O')+ KChar 'v' -> changeEditor (Edit.insert '\^V') KChar 'p' -> eventLoop (retreatFocus st) KChar 'n' -> eventLoop (advanceFocus st) KChar 'l' -> refresh (view clientVty st) >> eventLoop st@@ -255,32 +302,35 @@ [MMeta] -> case key of- KBS -> changeInput (Edit.killWord True)- KChar 'b' -> changeInput Edit.leftWord- KChar 'f' -> changeInput Edit.rightWord+ KEnter -> changeEditor (Edit.insert '\^J')+ KBS -> changeEditor (Edit.killWordBackward True)+ KChar 'd' -> changeEditor (Edit.killWordForward True)+ KChar 'b' -> changeContent Edit.leftWord+ KChar 'f' -> changeContent Edit.rightWord KChar 'a' -> eventLoop (jumpToActivity st)- KChar c | Just i <- elemIndex c windowNames ->+ KChar c | let names = view (clientConfig . configWindowNames) st+ , Just i <- Text.findIndex (==c) names -> eventLoop (jumpFocus i st) _ -> eventLoop st [] -> -- no modifier case key of- KBS -> changeInput Edit.backspace- KDel -> changeInput Edit.delete- KLeft -> changeInput Edit.left- KRight -> changeInput Edit.right- KHome -> changeInput Edit.home- KEnd -> changeInput Edit.end- KUp -> changeInput $ \ed -> fromMaybe ed $ Edit.earlier ed- KDown -> changeInput $ \ed -> fromMaybe ed $ Edit.later ed+ KBS -> changeContent Edit.backspace+ KDel -> changeContent Edit.delete+ KLeft -> changeContent Edit.left+ KRight -> changeContent Edit.right+ KHome -> changeEditor Edit.home+ KEnd -> changeEditor Edit.end+ KUp -> changeEditor $ \ed -> fromMaybe ed $ Edit.earlier ed+ KDown -> changeEditor $ \ed -> fromMaybe ed $ Edit.later ed KPageUp -> eventLoop (pageUp st) KPageDown -> eventLoop (pageDown st) - KEnter -> doCommandResult =<< execute st- KBackTab -> doCommandResult =<< tabCompletion True st- KChar '\t' -> doCommandResult =<< tabCompletion False st+ KEnter -> doCommandResult True =<< executeInput st+ KBackTab -> doCommandResult False =<< tabCompletion True st+ KChar '\t' -> doCommandResult False =<< tabCompletion False st - KChar c -> changeInput (Edit.insert c)+ KChar c -> changeEditor (Edit.insert c) KFun 2 -> eventLoop (over clientDetailView not st) _ -> eventLoop st @@ -288,11 +338,15 @@ -- | Process 'CommandResult' by either running the 'eventLoop' with the -- new 'ClientState' or returning.-doCommandResult :: CommandResult -> IO ()-doCommandResult res =+doCommandResult :: Bool -> CommandResult -> IO ()+doCommandResult clearOnSuccess res = case res of- CommandQuit -> return ()- CommandContinue st -> eventLoop st+ CommandQuit -> return ()+ CommandSuccess st -> eventLoop (if clearOnSuccess then consumeInput st else st)+ CommandFailure st -> eventLoop (set clientBell True st)++executeInput :: ClientState -> IO CommandResult+executeInput st = execute (clientFirstLine st) st -- | Scroll the current buffer to show older messages pageUp :: ClientState -> ClientState
src/Client/Hook.hs view
@@ -23,6 +23,7 @@ ) where import Control.Lens+import Data.Semigroup import Data.Text import Irc.Message@@ -35,10 +36,13 @@ | OmitMessage | RemapMessage IrcMsg +instance Semigroup MessageResult where+ PassMessage <> r = r+ l <> _ = l+ instance Monoid MessageResult where mempty = PassMessage- PassMessage `mappend` r = r- l `mappend` _ = l+ mappend = (<>) maybeFromResult :: IrcMsg -> MessageResult -> Maybe IrcMsg maybeFromResult original PassMessage = Just original
src/Client/Hook/Znc/Buffextras.hs view
@@ -17,15 +17,15 @@ ( buffextrasHook ) where -import Data.Attoparsec.Text as P-import Data.Monoid-import Data.Text as Text hiding (head)+import Control.Monad+import Data.Attoparsec.Text as P+import Data.Text as Text hiding (head) -import Client.Hook-import Irc.Identifier-import Irc.Message-import Irc.RawIrcMsg-import Irc.UserInfo+import Client.Hook+import Irc.Identifier+import Irc.Message+import Irc.RawIrcMsg+import Irc.UserInfo -- | Map ZNC's buffextras messages to native client messages. -- Set debugging to pass through buffextras messages that@@ -38,7 +38,7 @@ IrcMsg -> MessageResult remap debug (Privmsg user chan msg) | userNick user == mkId "*buffextras"- , Right newMsg <- parseOnly (mainParser chan) msg+ , Right newMsg <- parseOnly (prefixedParser chan) msg = RemapMessage newMsg | userNick user == mkId "*buffextras"@@ -47,37 +47,34 @@ remap _ _ = PassMessage --- Note: the "Server set mode:" message is intentionally not handled at this--- time.-mainParser :: Identifier -> Parser IrcMsg-mainParser = prefixedParser- prefixedParser :: Identifier -> Parser IrcMsg prefixedParser chan = do pfx <- prefixParser- choice [ Join pfx chan <$ sepMsg "joined"- , Quit pfx <$> parseLeave "quit"- , Part pfx chan <$> parseLeave "parted"- , Nick pfx . mkId <$ sepMsg "is now known as" <*> simpleTokenParser- , Mode pfx chan <$ sepMsg "set mode:" <*> allTokens- ]+ choice+ [ Join pfx chan <$ skipToken "joined"+ , Quit pfx . filterEmpty <$ skipToken "quit with message:" <*> parseReason+ , Part pfx chan . filterEmpty <$ skipToken "parted with message:" <*> parseReason+ , Nick pfx . mkId <$ skipToken "is now known as" <*> simpleTokenParser+ , Mode pfx chan <$ skipToken "set mode:" <*> allTokens+ , Kick pfx chan <$ skipToken "kicked" <*> parseId <* skipToken "Reason:" <*> parseReason+ ] allTokens :: Parser [Text] allTokens = Text.words <$> P.takeText -sepMsg :: Text -> Parser ()-sepMsg m = P.skipWhile (==' ') *> string m *> P.skipWhile (==' ')+skipToken :: Text -> Parser ()+skipToken m = string m *> P.skipWhile (==' ') --- Parts and quits have a similar format.-parseLeave- :: Text- -> Parser (Maybe Text)-parseLeave small =- do sepMsg (small <> " with message:")- P.skipWhile (==' ')- filterEmpty <$ char '[' <*> P.takeWhile (/=']') <* char ']'+parseId :: Parser Identifier+parseId = mkId <$> simpleTokenParser filterEmpty :: Text -> Maybe Text-filterEmpty tx- | Text.null tx = Nothing- | otherwise = Just tx+filterEmpty txt+ | Text.null txt = Nothing+ | otherwise = Just txt++parseReason :: Parser Text+parseReason =+ do txt <- char '[' *> P.takeText+ guard (not (Text.null txt) && Text.last txt == ']')+ return (Text.init txt)
src/Client/Image.hs view
@@ -39,21 +39,21 @@ clientPicture :: ClientState -> (Picture, ClientState) clientPicture st = (pic, st') where- (img, st') = clientImage st+ (pos, img, st') = clientImage st pic0 = picForImage img pic = pic0 { picCursor = cursor }- cursor = Cursor (min (view clientWidth st - 1)- (view (clientTextBox . Edit.pos) st+1))+ cursor = Cursor (min (view clientWidth st - 1) (pos+1)) (view clientHeight st - 1) -clientImage :: ClientState -> (Image, ClientState)-clientImage st = (img, st')+clientImage :: ClientState -> (Int, Image, ClientState)+clientImage st = (pos, img, st') where (mp, st') = messagePane st+ (pos, tbImg) = textboxImage st' img = vertCat [ mp , horizDividerImage st'- , textboxImage st'+ , tbImg ] messagePaneImages :: ClientState -> [Image]@@ -196,7 +196,8 @@ string defAttr "]" where windows = views clientWindows Map.elems st- winNames = windowNames ++ repeat '?'+ windowNames = view (clientConfig . configWindowNames) st+ winNames = Text.unpack windowNames ++ repeat '?' indicators = aux (zip winNames windows) aux [] = [] aux ((i,w):ws)@@ -242,10 +243,12 @@ pal = view (clientConfig . configPalette) st focus = view clientFocus st+ windowNames = view (clientConfig . configWindowNames) st+ windowName = case Map.lookupIndex focus (view clientWindows st) of- Nothing -> '?'- Just i -> (windowNames ++ repeat '?') !! i+ Just i | i < Text.length windowNames -> Text.index windowNames i+ _ -> '?' subfocusName = case view clientSubfocus st of@@ -286,14 +289,12 @@ where (modes,args) = unzip (Map.toList modeMap) _ -> emptyImage -textboxImage :: ClientState -> Image+textboxImage :: ClientState -> (Int, Image) textboxImage st- = applyCrop- $ beginning <|> content <|> ending+ = (pos, applyCrop $ beginning <|> content <|> ending) where- pos = view (clientTextBox . Edit.pos) st width = view clientWidth st- content = parseIrcTextExplicit (Text.pack (view (clientTextBox . Edit.content) st))+ (pos, content) = views (clientTextBox . Edit.content) renderContent st applyCrop | 1+pos < width = cropRight width | otherwise = cropLeft width . cropRight (pos+2)@@ -301,6 +302,21 @@ attr = view (clientConfig . configPalette . palTextBox) st beginning = char attr '^' ending = char attr '$'++renderContent :: Edit.Content -> (Int, Image)+renderContent c = (imgPos, wholeImg)+ where+ as = view Edit.above c+ bs = view Edit.below c+ cur = view Edit.current c++ imgPos = view Edit.pos cur + length as + sum (map length as)++ renderLine l = parseIrcTextExplicit $ Text.pack l++ curImg = views Edit.text renderLine cur+ rightImg = foldl (\i b -> i <|> renderLine ('\n':b)) curImg bs+ wholeImg = foldl (\i a -> renderLine (a ++ "\n") <|> i) rightImg as latencyImage :: ClientState -> Image latencyImage st
src/Client/Image/ChannelInfo.hs view
@@ -29,7 +29,10 @@ import Irc.Identifier -- | Render the lines used in a channel mask list-channelInfoImages :: NetworkName -> Identifier -> ClientState -> [Image]+channelInfoImages ::+ NetworkName {- ^ network -} ->+ Identifier {- ^ channel -} ->+ ClientState -> [Image] channelInfoImages network channelId st | Just cs <- preview (clientConnection network) st
src/Client/Image/MaskList.hs view
@@ -31,8 +31,8 @@ -- | Render the lines used in a channel mask list maskListImages :: Char {- ^ Mask mode -} ->- NetworkName {- ^ Focused network -} ->- Identifier {- ^ Focused channel -} ->+ NetworkName {- ^ network -} ->+ Identifier {- ^ channel -} -> ClientState -> [Image] maskListImages mode network channel st = case mbEntries of
src/Client/Image/Message.hs view
@@ -14,7 +14,6 @@ , RenderMode(..) , defaultRenderParams , msgImage- , detailedMsgImage , metadataImg , ignoreImage , quietIdentifier@@ -63,23 +62,28 @@ -- | Construct a message given the time the message was received and its -- render parameters. msgImage ::+ RenderMode -> ZonedTime {- ^ time of message -} -> MessageRendererParams -> MessageBody -> Image-msgImage when params body = horizCat- [ timeImage (rendPalette params) when+msgImage rm when params body = horizCat+ [ renderTime rm (rendPalette params) when , statusMsgImage (rendStatusMsg params)- , bodyImage NormalRender params body+ , bodyImage rm params body ] --- | Construct a message given the time the message was received and its--- render parameters using a detailed view.-detailedMsgImage :: ZonedTime -> MessageRendererParams -> MessageBody -> Image-detailedMsgImage when params body = horizCat- [ datetimeImage (rendPalette params) when- , statusMsgImage (rendStatusMsg params)- , bodyImage DetailedRender params body+errorImage ::+ MessageRendererParams ->+ String {- ^ error message -} ->+ Image+errorImage params txt = horizCat+ [ text' (view palError (rendPalette params)) "Error "+ , string defAttr txt ] +renderTime :: RenderMode -> Palette -> ZonedTime -> Image+renderTime DetailedRender = datetimeImage+renderTime NormalRender = timeImage+ -- | Render the sigils for a restricted message. statusMsgImage :: [Char] {- ^ sigils -} -> Image statusMsgImage modes@@ -98,9 +102,9 @@ MessageBody -> Image bodyImage rm params body = case body of- IrcBody irc -> ircLineImage rm params irc- ErrorBody ex -> string defAttr ("Exception: " ++ show ex)- ExitBody -> string defAttr "Thread finished"+ IrcBody irc -> ircLineImage rm params irc+ ErrorBody txt -> errorImage params txt+ ExitBody -> string defAttr "Thread finished" -- | Render a 'ZonedTime' as time using quiet attributes --@@ -315,11 +319,11 @@ Identifier -> Image coloredIdentifier palette myNicks ident =- text' (withForeColor defAttr color) (idText ident)+ text' color (idText ident) where color- | ident `elem` myNicks = red- | otherwise = v Vector.! i+ | ident `elem` myNicks = _palSelf palette+ | otherwise = withForeColor defAttr $ v Vector.! i v = _palNicks palette i = hash ident `mod` Vector.length v
src/Client/Image/Palette.hs view
@@ -13,6 +13,7 @@ -- * Palette type Palette(..) , palNicks+ , palSelf , palTime , palMeta , palSigil@@ -36,6 +37,7 @@ -- | Color palette used for rendering the client UI data Palette = Palette { _palNicks :: Vector Color -- ^ colors for highlighting nicknames+ , _palSelf :: Attr -- ^ color of our own nickname(s) , _palTime :: Attr -- ^ color of message timestamps , _palMeta :: Attr -- ^ color of coalesced metadata , _palSigil :: Attr -- ^ color of sigils (e.g. @+)@@ -55,6 +57,7 @@ defaultPalette :: Palette defaultPalette = Palette { _palNicks = defaultNickColorPalette+ , _palSelf = withForeColor defAttr red , _palTime = withForeColor defAttr brightBlack , _palMeta = withForeColor defAttr brightBlack , _palSigil = withForeColor defAttr cyan
src/Client/ServerSettings.hs view
@@ -37,6 +37,7 @@ , ssFloodPenalty , ssFloodThreshold , ssMessageHooks+ , ssName -- * Load function , loadDefaultServerSettings@@ -75,6 +76,7 @@ , _ssFloodPenalty :: !Rational -- ^ Flood limiter penalty (seconds) , _ssFloodThreshold :: !Rational -- ^ Flood limited threshold (seconds) , _ssMessageHooks :: ![Text] -- ^ Initial message hooks+ , _ssName :: !(Maybe Text) -- ^ The name referencing the server in commands } deriving Show @@ -110,4 +112,5 @@ , _ssFloodPenalty = 2 -- RFC 1459 defaults , _ssFloodThreshold = 10 , _ssMessageHooks = []+ , _ssName = Nothing }
src/Client/State.hs view
@@ -40,7 +40,8 @@ , consumeInput , currentCompletionList , ircIgnorable- , clientInput+ , clientFirstLine+ , clientLine , abortNetwork , addConnection , removeNetwork@@ -60,7 +61,6 @@ , changeSubfocus , advanceFocus , retreatFocus- , windowNames ) where @@ -169,9 +169,13 @@ Just i -> clientConnections (ix i f) st -- | Full content of the edit box-clientInput :: ClientState -> String-clientInput = view (clientTextBox . Edit.content)+clientFirstLine :: ClientState -> String+clientFirstLine = views (clientTextBox . Edit.content) Edit.firstLine +-- | The line under the cursor in the edit box.+clientLine :: ClientState -> (Int, String)+clientLine = views (clientTextBox . Edit.line) (\(Edit.Line n t) -> (n, t))+ -- | Return the network associated with the current focus focusNetwork :: ClientFocus -> Maybe NetworkName focusNetwork Unfocused = Nothing@@ -371,8 +375,8 @@ toWindowLine params msg = WindowLine { _wlBody = view msgBody msg , _wlText = views msgBody msgText msg- , _wlImage = force $ msgImage (view msgTime msg) params (view msgBody msg)- , _wlFullImage = force $ detailedMsgImage (view msgTime msg) params (view msgBody msg)+ , _wlImage = force $ msgImage NormalRender (view msgTime msg) params (view msgBody msg)+ , _wlFullImage = force $ msgImage DetailedRender (view msgTime msg) params (view msgBody msg) } toWindowLine' :: Palette -> ClientMessage -> WindowLine@@ -455,12 +459,9 @@ = set clientScroll 0 . set clientSubfocus focus -windowNames :: [Char]-windowNames = "1234567890qwertyuiop!@#$%^&*()QWERTYUIOP"- clientMatcher :: ClientState -> Text -> Bool clientMatcher st =- case break (==' ') (clientInput st) of+ case break (==' ') (clientFirstLine st) of ("/grep" ,_:reStr) -> go [] reStr ("/grepi",_:reStr) -> go [ICU.CaseInsensitive] reStr _ -> const True@@ -488,11 +489,11 @@ addConnection :: Text -> ClientState -> IO ClientState addConnection network st =- do let host = Text.unpack network- defSettings = (view (clientConfig . configDefaults) st)- { _ssHostName = host }+ do let defSettings = (view (clientConfig . configDefaults) st)+ { _ssName = Just network }+ settings = fromMaybe defSettings- (view (clientConfig . configServers . at host) st)+ $ preview (clientConfig . configServers . ix network) st let (i,st') = st & clientNextConnectionId <+~ 1 c <- createConnection
src/Client/WordCompletion.hs view
@@ -19,7 +19,7 @@ import Data.Char import Data.List import Control.Lens-import Client.EditBox as Edit+import qualified Client.EditBox as Edit import Control.Monad -- | Perform word completion on a text box.@@ -50,15 +50,15 @@ _ -> do next <- tabSearch isReversed cur cur vals- Just $ set tabSeed (Just current)+ Just $ set Edit.tabSeed (Just current) $ replaceWith leadingCase (idString next) box replaceWith :: (String -> String) -> String -> Edit.EditBox -> Edit.EditBox replaceWith leadingCase str box =- let box1 = Edit.killWord False box+ let box1 = Edit.killWordBackward False box str1 | view Edit.pos box1 == 0 = leadingCase str | otherwise = str- in Edit.insertString str1 box1+ in over Edit.content (Edit.insertString str1) box1 idString :: Identifier -> String idString = Text.unpack . idText@@ -69,7 +69,8 @@ $ takeWhile (not . isSpace) $ dropWhile (\x -> x==' ' || x==':') $ reverse- $ take (view Edit.pos box) (view Edit.content box)+ $ take n txt+ where Edit.Line n txt = view (Edit.content . Edit.current) box class Prefix a where isPrefix :: a -> a -> Bool instance Prefix Identifier where isPrefix = idPrefix
− src/Irc/Codes.hs
@@ -1,854 +0,0 @@-{-# 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")- ]
− src/Irc/Commands.hs
@@ -1,266 +0,0 @@-{-# 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]
− src/Irc/Identifier.hs
@@ -1,80 +0,0 @@-{-|-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']
− src/Irc/Message.hs
@@ -1,277 +0,0 @@-{-# 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 messages- IrcMsg(..)- , CapCmd(..)- , cookIrcMsg-- -- * Properties of messages- , MessageTarget(..)- , ircMsgText- , msgTarget- , msgActor-- -- * Helper functions- , nickSplit- , computeMaxMessageLength- ) where--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---- | 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---- | 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)---- | 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---- | 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-- "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
− src/Irc/Modes.hs
@@ -1,122 +0,0 @@-{-# Language TemplateHaskell #-}-{-# Language BangPatterns #-}--{-|-Module : Irc.Modes-Description : Operations for interpreting mode changes-Copyright : (c) Eric Mertens, 2016-License : ISC-Maintainer : emertens@gmail.com--This module provides support for interpreting the modes changed by-a MODE command.---}-module Irc.Modes- (- -- * Interpretation of modes- ModeTypes(..)- , modesLists- , modesAlwaysArg- , modesSetArg- , modesNeverArg- , modesPrefixModes- , defaultModeTypes- , defaultUmodeTypes-- -- * Operations for working with MODE command parameters- , splitModes- , unsplitModes- ) where--import Control.Lens-import Data.Text (Text)-import qualified Data.Text as Text---- | Settings that describe how to interpret channel modes-data ModeTypes = ModeTypes- { _modesLists :: [Char] -- ^ modes for channel lists (e.g. ban)- , _modesAlwaysArg :: [Char] -- ^ modes that always have an argument- , _modesSetArg :: [Char] -- ^ modes that have an argument when set- , _modesNeverArg :: [Char] -- ^ modes that never have arguments- , _modesPrefixModes :: [(Char,Char)] -- ^ modes requiring a nickname argument (mode,sigil)- }- deriving Show--makeLenses ''ModeTypes---- | The channel modes used by Freenode-defaultModeTypes :: ModeTypes-defaultModeTypes = ModeTypes- { _modesLists = "eIbq"- , _modesAlwaysArg = "k"- , _modesSetArg = "flj"- , _modesNeverArg = "CFLMPQScgimnprstz"- , _modesPrefixModes = [('o','@'),('v','+')]- }---- | The default UMODE used by Freenode-defaultUmodeTypes :: ModeTypes-defaultUmodeTypes = ModeTypes- { _modesLists = ""- , _modesAlwaysArg = ""- , _modesSetArg = "s"- , _modesNeverArg = "DQRZgiow"- , _modesPrefixModes = []- }---- | Split up a mode change command and arguments into individual changes--- given a configuration.-splitModes ::- ModeTypes {- ^ mode interpretation -} ->- Text {- ^ modes -} ->- [Text] {- ^ arguments -} ->- Maybe [(Bool,Char,Text)] {- ^ (set, mode, parameter) -}-splitModes !icm = computeMode True . Text.unpack- where- computeMode ::- Bool {- current polarity -} ->- [Char] {- remaining modes -} ->- [Text] {- remaining arguments -} ->- Maybe [(Bool,Char,Text)]- computeMode polarity modes args =-- case modes of- [] | null args -> Just []- | otherwise -> Nothing-- '+':ms -> computeMode True ms args- '-':ms -> computeMode False ms args-- m:ms- | m `elem` view modesAlwaysArg icm- || polarity && m `elem` view modesSetArg icm- || m `elem` map fst (view modesPrefixModes icm)- || m `elem` view modesLists icm ->- let (arg,args') =- case args of- [] -> (Text.empty,[])- x:xs -> (x,xs)- in cons (polarity,m,arg) <$> computeMode polarity ms args'-- | not polarity && m `elem` view modesSetArg icm- || m `elem` view modesNeverArg icm ->- do res <- computeMode polarity ms args- return ((polarity,m,Text.empty) : res)-- | otherwise -> Nothing---- | Construct the arguments to a MODE command corresponding to the given--- mode changes.-unsplitModes ::- [(Bool,Char,Text)] {- ^ (set,mode,parameter) -} ->- [Text]-unsplitModes modes- = Text.pack (foldr combineModeChars (const "") modes True)- : args- where- args = [arg | (_,_,arg) <- modes, not (Text.null arg)]- combineModeChars (q,m,_) rest p- | p == q = m : rest p- | q = '+' : m : rest True- | otherwise = '-' : m : rest False
− src/Irc/RateLimit.hs
@@ -1,69 +0,0 @@-{-|-Module : Irc.RateLimit-Description : Rate limit operations for IRC-Copyright : (c) Eric Mertens, 2016-License : ISC-Maintainer : emertens@gmail.com--This module implements a simple rate limiter based on the IRC RFC-to be used to keep an IRC client from getting disconnected for-flooding. It allows one event per duration with a given threshold.--This algorithm keeps track of the time at which the client may-start sending messages. Each message sent advances that time into-the future by the @penalty@. The client is allowed to transmit-up to @threshold@ seconds ahead of this time.---}-module Irc.RateLimit- ( RateLimit- , newRateLimit- , tickRateLimit- ) where--import Control.Concurrent-import Control.Monad-import Data.Time---- | The 'RateLimit' keeps track of rate limit settings as well--- as the current state of the limit.-data RateLimit = RateLimit- { rateStamp :: !(MVar UTCTime) -- ^ Time that client can send- , rateThreshold :: !NominalDiffTime- , ratePenalty :: !NominalDiffTime- }---- | Construct a new rate limit with the given penalty and threshold.-newRateLimit ::- Rational {- ^ penalty seconds -} ->- Rational {- ^ threshold seconds -} ->- IO RateLimit-newRateLimit penalty threshold =- do unless (penalty > 0)- (fail "newRateLimit: Penalty too small")-- unless (threshold > 0)- (fail "newRateLimit: Threshold too small")-- now <- getCurrentTime- ref <- newMVar now-- return RateLimit- { rateStamp = ref- , rateThreshold = realToFrac threshold- , ratePenalty = realToFrac penalty- }---- | Account for an event in the context of a 'RateLimit'. This command--- will block and delay as required to satisfy the current rate. Once--- it returns it is safe to proceed with the rate limited action.-tickRateLimit :: RateLimit -> IO ()-tickRateLimit r = modifyMVar_ (rateStamp r) $ \stamp ->- do now <- getCurrentTime- let stamp' = ratePenalty r `addUTCTime` max stamp now- diff = diffUTCTime stamp' now- excess = diff - rateThreshold r-- when (excess > 0) (threadDelay (ceiling (1000000 * excess)))-- return stamp'
− src/Irc/RawIrcMsg.hs
@@ -1,287 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# Language TemplateHaskell #-}--{-|-Module : Irc.RawIrcMsg-Description : Low-level representation of IRC messages-Copyright : (c) Eric Mertens, 2016-License : ISC-Maintainer : emertens@gmail.com--This module provides a parser and printer for the low-level IRC-message format. It handles splitting up IRC commands into the-prefix, command, and arguments.---}-module Irc.RawIrcMsg- (- -- * Low-level IRC messages- RawIrcMsg(..)- , TagEntry(..)- , rawIrcMsg- , msgTags- , msgPrefix- , msgCommand- , msgParams-- -- * Text format for IRC messages- , parseRawIrcMsg- , renderRawIrcMsg- , prefixParser- , simpleTokenParser-- -- * Permissive text decoder- , asUtf8- ) where--import Control.Applicative-import Control.Lens-import Data.Attoparsec.Text as P-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Builder (Builder)-import qualified Data.ByteString.Builder as Builder-import Data.List-import Data.Maybe-import Data.Monoid-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import Data.Vector (Vector)-import qualified Data.Vector as Vector--import Irc.UserInfo---- | '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.------ This parser is permissive regarding spaces. It aims to parse carefully--- constructed messages exactly and to make a best effort to recover from--- extraneous spaces. It makes no effort to validate nicknames, usernames,--- hostnames, commands, etc. Servers don't all agree on these things.------ @:prefix COMMAND param0 param1 param2 .. paramN@-data RawIrcMsg = RawIrcMsg- { _msgTags :: [TagEntry] -- ^ IRCv3.2 message tags- , _msgPrefix :: Maybe UserInfo -- ^ Optional sender of message- , _msgCommand :: !Text -- ^ command- , _msgParams :: [Text] -- ^ command parameters- }- deriving (Read, Show)---- | Key value pair representing an IRCv3.2 message tag.--- The value in this pair has had the message tag unescape--- algorithm applied.-data TagEntry = TagEntry {-# UNPACK #-} !Text {-# UNPACK #-} !Text- deriving (Read, Show)--makeLenses ''RawIrcMsg---- | Attempt to split an IRC protocol message without its trailing newline--- information into a structured message.-parseRawIrcMsg :: Text -> 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 tags <- fromMaybe [] <$> guarded '@' tagsParser- prefix <- guarded ':' prefixParser- cmd <- simpleTokenParser- params <- paramsParser maxMiddleParams- return $! RawIrcMsg- { _msgTags = tags- , _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 {- ^ possible middle parameters -} -> Parser [Text]-paramsParser !n =- do end <- P.atEnd- if end- then return []- else do isColon <- optionalChar ':'- if isColon || n == 0- then finalParam- else middleParam-- where-- finalParam =- do x <- takeText- let !x' = Text.copy x- return [x']-- middleParam =- do x <- simpleTokenParser- xs <- paramsParser (n-1)- return (x:xs)--tagsParser :: Parser [TagEntry]-tagsParser = tagParser `sepBy1` char ';' <* char ' '--tagParser :: Parser TagEntry-tagParser =- do key <- P.takeWhile (notInClass " =;")- hasValue <- optionalChar '='- val <- if hasValue- then unescapeTagVal <$> P.takeWhile (notInClass " ;")- else return ""- return $! TagEntry key val---unescapeTagVal :: Text -> Text-unescapeTagVal = Text.pack . aux . Text.unpack- where- aux ('\\':':':xs) = ';':aux xs- aux ('\\':'s':xs) = ' ':aux xs- aux ('\\':'\\':xs) = '\\':aux xs- aux ('\\':'r':xs) = '\r':aux xs- aux ('\\':'n':xs) = '\n':aux xs- aux (x:xs) = x : aux xs- aux "" = ""--escapeTagVal :: Text -> Text-escapeTagVal = Text.concatMap aux- where- aux ';' = "\\:"- aux ' ' = "\\s"- aux '\\' = "\\\\"- aux '\r' = "\\r"- aux '\n' = "\\n"- aux x = Text.singleton x---- | Parse a rendered 'UserInfo' token.-prefixParser :: Parser UserInfo-prefixParser =- do tok <- simpleTokenParser- return $! parseUserInfo tok---- | Take the next space-delimited lexeme-simpleTokenParser :: Parser Text-simpleTokenParser =- do xs <- P.takeWhile1 (/= ' ')- P.skipWhile (== ' ')- return $! Text.copy xs----- | 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- $ renderTags (view msgTags m)- <> maybe mempty renderPrefix (view msgPrefix m)- <> Text.encodeUtf8Builder (view msgCommand m)- <> buildParams (view msgParams m)- <> Builder.char8 '\r'- <> Builder.char8 '\n'---- | Construct a new 'RawIrcMsg' without a time or prefix.-rawIrcMsg ::- Text {- ^ command -} ->- [Text] {- ^ parameters -} -> RawIrcMsg-rawIrcMsg = RawIrcMsg [] Nothing--renderTags :: [TagEntry] -> Builder-renderTags [] = mempty-renderTags xs- = Builder.char8 '@'- <> mconcat (intersperse (Builder.char8 ';') (map renderTag xs))- <> Builder.char8 ' '--renderTag :: TagEntry -> Builder-renderTag (TagEntry key val)- = Text.encodeUtf8Builder key- <> Builder.char8 '='- <> Text.encodeUtf8Builder (escapeTagVal val)--renderPrefix :: UserInfo -> Builder-renderPrefix u- = Builder.char8 ':'- <> Text.encodeUtf8Builder (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 :: [Text] -> Builder-buildParams [x]- | " " `Text.isInfixOf` x || ":" `Text.isPrefixOf` x- = Builder.char8 ' ' <> Builder.char8 ':' <> Text.encodeUtf8Builder x-buildParams (x:xs)- = Builder.char8 ' ' <> Text.encodeUtf8Builder x <> buildParams xs-buildParams [] = mempty---- | When the current input matches the given character parse--- using the given parser.-guarded :: Char -> Parser b -> Parser (Maybe b)-guarded c p =- do success <- optionalChar c- if success then Just <$> p else pure Nothing----- | Returns 'True' iff next character in stream matches argument.-optionalChar :: Char -> Parser Bool-optionalChar c = True <$ char c <|> pure False----- | 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---- | Decode a 'ByteString' as CP1252-decodeCP1252 :: ByteString -> Text-decodeCP1252 bs = Text.pack [ cp1252 Vector.! fromIntegral x | x <- B.unpack bs ]---- This character encoding is a superset of ISO 8859-1 in terms of printable--- characters, but differs from the IANA's ISO-8859-1 by using displayable--- characters rather than control characters in the 80 to 9F (hex) range.-cp1252 :: Vector Char-cp1252 = Vector.fromList- $ ['\x00'..'\x7f']- ++ "€\x81‚ƒ„…†‡ˆ‰Š‹Œ\x8dŽ\x8f\x90‘’“”•–—˜™š›œ\x9džŸ"- ++ ['\xa0'..'\xff']
− src/Irc/UserInfo.hs
@@ -1,59 +0,0 @@-{-# Language OverloadedStrings #-}--{-|-Module : Irc.UserInfo-Description : User hostmasks-Copyright : (c) Eric Mertens, 2016-License : ISC-Maintainer : emertens@gmail.com--Information identifying users on IRC. This information includes-a nickname and optionally a username and hostname.---}--module Irc.UserInfo- ( UserInfo(..)- , renderUserInfo- , parseUserInfo- , uiNick- ) where--import Data.Text (Text)-import qualified Data.Text as Text-import Irc.Identifier-import Data.Monoid ((<>))-import Control.Lens---- | 'UserInfo' packages a nickname along with the username and hsotname--- if they are known in the current context.-data UserInfo = UserInfo- { userNick :: {-# UNPACK #-} !Identifier -- ^ nickname- , userName :: {-# UNPACK #-} !Text -- ^ username, empty when missing- , userHost :: {-# UNPACK #-} !Text -- ^ hostname, empty when missing- }- deriving (Read, Show)---- | 'Lens' into 'userNick' field.-uiNick :: Lens' UserInfo Identifier-uiNick f ui@UserInfo{userNick = n} = (\n' -> ui{userNick = n'}) <$> f n---- | Render 'UserInfo' as @nick!username\@hostname@-renderUserInfo :: UserInfo -> Text-renderUserInfo (UserInfo a b c)- = idText a- <> (if Text.null b then "" else "!" <> b)- <> (if Text.null c then "" else "@" <> c)---- | 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 :: Text -> UserInfo-parseUserInfo x = UserInfo- { userNick = mkId nick- , userName = Text.drop 1 user- , userHost = Text.drop 1 host- }- where- (nickuser,host) = Text.break (=='@') x- (nick,user) = Text.break (=='!') nickuser
src/Main.hs view
@@ -27,7 +27,7 @@ -- | Initialize a 'Vty' value and run a continuation. Shutdown the 'Vty' -- once the continuation finishes. withVty :: (Vty -> IO a) -> IO a-withVty = bracket (mkVty def) shutdown+withVty = bracket (mkVty def{bracketedPasteMode = Just True}) shutdown -- | Main action for IRC client main :: IO ()