diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for irc-core +## 2.11 + +* Added extra reply code patterns. Sasl errors renamed to ERR_ prefix +* Added extra ircoper specific commands +* Added 'Source' type to allow account names to be tracked on messages + ## 2.10 * Track servername in `Reply` constructor diff --git a/irc-core.cabal b/irc-core.cabal --- a/irc-core.cabal +++ b/irc-core.cabal @@ -1,5 +1,6 @@ +cabal-version: 2.4 name: irc-core -version: 2.10 +version: 2.11 synopsis: IRC core library for glirc description: IRC core library for glirc . @@ -12,7 +13,6 @@ category: Network build-type: Simple extra-source-files: ChangeLog.md -cabal-version: >=1.10 homepage: https://github.com/glguy/irc-core bug-reports: https://github.com/glguy/irc-core/issues @@ -32,13 +32,13 @@ Irc.UserInfo other-modules: View - build-depends: base >=4.11 && <4.16, + build-depends: base >=4.11 && <4.17, base64-bytestring >= 1.0.0.1 && <1.3, - attoparsec >=0.13 && <0.14, + attoparsec ^>=0.14, bytestring >=0.10 && <0.12, - hashable >=1.2 && <1.4, + hashable >=1.2 && <1.5, primitive >=0.6 && <0.8, - text >=1.2 && <1.3, + text >=1.2 && <2.1, time >=1.6 && <1.12, vector >=0.11 && <0.13 diff --git a/src/Irc/Codes.hs b/src/Irc/Codes.hs --- a/src/Irc/Codes.hs +++ b/src/Irc/Codes.hs @@ -148,6 +148,7 @@ pattern RPL_NICKTRACE = ReplyCode 309 pattern RPL_WHOISSADMIN = ReplyCode 309 pattern RPL_WHOISHELPER = ReplyCode 309 +pattern RPL_WHOISHELPOP = ReplyCode 310 pattern RPL_WHOISUSER = ReplyCode 311 pattern RPL_WHOISSERVER = ReplyCode 312 pattern RPL_WHOISOPERATOR = ReplyCode 313 @@ -227,11 +228,12 @@ pattern ERR_WASNOSUCHNICK = ReplyCode 406 pattern ERR_TOOMANYTARGETS = ReplyCode 407 pattern ERR_NOORIGIN = ReplyCode 409 +pattern ERR_INVALIDCAPCMD = ReplyCode 410 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_MSGNEEDREGGEDNICK = ReplyCode 415 pattern ERR_TOOMANYMATCHES = ReplyCode 416 pattern ERR_LENGTHTRUNCATED = ReplyCode 419 pattern ERR_UNKNOWNCOMMAND = ReplyCode 421 @@ -422,10 +424,10 @@ 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 ERR_SASLFAIL = ReplyCode 904 +pattern ERR_SASLTOOLONG = ReplyCode 905 +pattern ERR_SASLABORTED = ReplyCode 906 +pattern ERR_SASLALREADY = ReplyCode 907 pattern RPL_SASLMECHS = ReplyCode 908 pattern ERR_CANNOTDOCOMMAND = ReplyCode 972 pattern ERR_CANNOTCHANGEUMODE = ReplyCode 973 @@ -462,7 +464,7 @@ defaultReplyCodeInfo :: Int -> ReplyCodeInfo defaultReplyCodeInfo = ReplyCodeInfo UnknownReply . Text.pack . show --- | Information about reply codes as derived from Freenode's ircd-seven. +-- | Information about reply codes as derived from ircd-seven. replyCodeInfoTable :: Vector ReplyCodeInfo replyCodeInfoTable = Vector.accumulate @@ -540,7 +542,7 @@ , (RPL_ADMINEMAIL , ReplyCodeInfo CommandReply "admin-email") , (RPL_TRACELOG , ReplyCodeInfo CommandReply "trace-log") , (RPL_ENDOFTRACE , ReplyCodeInfo CommandReply "end-of-trace") - , (RPL_LOAD2HI , ReplyCodeInfo CommandReply "load-too-hi") + , (RPL_LOAD2HI , ReplyCodeInfo CommandReply "load-too-high") , (RPL_LOCALUSERS , ReplyCodeInfo CommandReply "local-users") , (RPL_GLOBALUSERS , ReplyCodeInfo CommandReply "global-users") , (RPL_START_NETSTAT , ReplyCodeInfo CommandReply "start-netstat") @@ -576,6 +578,7 @@ , (RPL_NICKTRACE , ReplyCodeInfo CommandReply "nick-trace") , (RPL_WHOISSADMIN , ReplyCodeInfo CommandReply "whois-sadmin") , (RPL_WHOISHELPER , ReplyCodeInfo CommandReply "whois-helper") + , (RPL_WHOISHELPOP , ReplyCodeInfo CommandReply "whois-helpop") , (RPL_WHOISUSER , ReplyCodeInfo CommandReply "whois-user") , (RPL_WHOISSERVER , ReplyCodeInfo CommandReply "whois-server") , (RPL_WHOISOPERATOR , ReplyCodeInfo CommandReply "whois-operator") @@ -655,11 +658,12 @@ , (ERR_WASNOSUCHNICK , ReplyCodeInfo ErrorReply "was-no-such-nick") , (ERR_TOOMANYTARGETS , ReplyCodeInfo ErrorReply "too-many-targets") , (ERR_NOORIGIN , ReplyCodeInfo ErrorReply "no-origin") + , (ERR_INVALIDCAPCMD , ReplyCodeInfo ErrorReply "invalid-cap-cmd") , (ERR_NORECIPIENT , ReplyCodeInfo ErrorReply "no-recipient") , (ERR_NOTEXTTOSEND , ReplyCodeInfo ErrorReply "no-text-to-send") , (ERR_NOTOPLEVEL , ReplyCodeInfo ErrorReply "no-top-level") , (ERR_WILDTOPLEVEL , ReplyCodeInfo ErrorReply "wild-top-level") - , (ERR_BADMASK , ReplyCodeInfo ErrorReply "bad-mask") + , (ERR_MSGNEEDREGGEDNICK , ReplyCodeInfo ErrorReply "msg-need-regged-nick") , (ERR_TOOMANYMATCHES , ReplyCodeInfo ErrorReply "too-many-matches") , (ERR_LENGTHTRUNCATED , ReplyCodeInfo ErrorReply "length-truncated") , (ERR_UNKNOWNCOMMAND , ReplyCodeInfo ErrorReply "unknown-command") @@ -850,10 +854,10 @@ , (RPL_LOGGEDOUT , ReplyCodeInfo CommandReply "logged-out") , (RPL_NICKLOCKED , ReplyCodeInfo CommandReply "nick-locked") , (RPL_SASLSUCCESS , ReplyCodeInfo CommandReply "sasl-success") - , (RPL_SASLFAIL , ReplyCodeInfo CommandReply "sasl-fail") - , (RPL_SASLTOOLONG , ReplyCodeInfo CommandReply "sasl-toolong") - , (RPL_SASLABORTED , ReplyCodeInfo CommandReply "sasl-aborted") - , (RPL_SASLALREADY , ReplyCodeInfo CommandReply "sasl-already") + , (ERR_SASLFAIL , ReplyCodeInfo ErrorReply "sasl-fail") + , (ERR_SASLTOOLONG , ReplyCodeInfo ErrorReply "sasl-toolong") + , (ERR_SASLABORTED , ReplyCodeInfo ErrorReply "sasl-aborted") + , (ERR_SASLALREADY , ReplyCodeInfo ErrorReply "sasl-already") , (RPL_SASLMECHS , ReplyCodeInfo CommandReply "sasl-mechs") , (ERR_CANNOTDOCOMMAND , ReplyCodeInfo ErrorReply "cannot-do-command") , (ERR_CANNOTCHANGEUMODE , ReplyCodeInfo ErrorReply "cannot-change-umode") diff --git a/src/Irc/Commands.hs b/src/Irc/Commands.hs --- a/src/Irc/Commands.hs +++ b/src/Irc/Commands.hs @@ -1,4 +1,4 @@ -{-# Language OverloadedStrings #-} +{-# Language OverloadedStrings, BlockArguments #-} {-| Module : Irc.Commands Description : Smart constructors for "RawIrcMsg" @@ -37,6 +37,7 @@ , ircNick , ircNotice , ircOper + , ircOperwall , ircPart , ircPass , ircPing @@ -51,7 +52,10 @@ , ircTime , ircTopic , ircTrace + , ircUndline , ircUnkline + , ircUnxline + , ircUnresv , ircUser , ircUserhost , ircUserip @@ -164,6 +168,12 @@ RawIrcMsg ircWallops msg = rawIrcMsg "WALLOPS" [msg] +-- | OPERWALL command +ircOperwall :: + Text {- ^ message -} -> + RawIrcMsg +ircOperwall msg = rawIrcMsg "OPERWALL" [msg] + -- | NICK command ircNick :: Text {- ^ nickname -} -> @@ -225,8 +235,42 @@ -- | UNKLINE command ircUnkline :: Text {- ^ mask -} -> + Maybe Text {- ^ server -} -> RawIrcMsg -ircUnkline mask = rawIrcMsg "UNKLINE" [mask] +ircUnkline mask mbServer = rawIrcMsg "UNKLINE" + case mbServer of + Nothing -> [mask] + Just server -> [mask, "ON", server] + +-- | UNDLINE command +ircUndline :: + Text {- ^ mask -} -> + Maybe Text {- ^ server -} -> + RawIrcMsg +ircUndline mask mbServer = rawIrcMsg "UNDLINE" + case mbServer of + Nothing -> [mask] + Just server -> [mask, "ON", server] + +-- | UNXLINE command +ircUnxline :: + Text {- ^ mask -} -> + Maybe Text {- ^ server -} -> + RawIrcMsg +ircUnxline mask mbServer = rawIrcMsg "UNXLINE" + case mbServer of + Nothing -> [mask] + Just server -> [mask, "ON", server] + +-- | UNRESV command +ircUnresv :: + Text {- ^ mask -} -> + Maybe Text {- ^ server -} -> + RawIrcMsg +ircUnresv mask mbServer = rawIrcMsg "UNRESV" + case mbServer of + Nothing -> [mask] + Just server -> [mask, "ON", server] -- | TESTLINE command ircTestline :: diff --git a/src/Irc/Identifier.hs b/src/Irc/Identifier.hs --- a/src/Irc/Identifier.hs +++ b/src/Irc/Identifier.hs @@ -25,12 +25,9 @@ import qualified Data.ByteString as B import Data.Char import Data.Foldable -import Data.Function import Data.Hashable -import Data.Monoid import Data.String import Data.Text (Text) -import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Vector.Primitive as PV import qualified Data.Primitive.ByteArray as BA diff --git a/src/Irc/Message.hs b/src/Irc/Message.hs --- a/src/Irc/Message.hs +++ b/src/Irc/Message.hs @@ -25,11 +25,14 @@ , ircMsgText , msgTarget , msgActor + , msgSource -- * Helper functions , nickSplit , computeMaxMessageLength , capCmdText + + , Source(..) ) where import Control.Monad @@ -48,17 +51,18 @@ data IrcMsg = UnknownMsg !RawIrcMsg -- ^ pass-through for unhandled messages | Reply !Text !ReplyCode [Text] -- ^ server code arguments - | Nick !UserInfo !Identifier -- ^ old new - | Join !UserInfo !Identifier !Text !Text -- ^ user channel account account gecos - | 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 + | Nick !Source !Identifier -- ^ old new + | Join !Source !Identifier !Text !Text -- ^ user channel account account gecos + | Part !Source !Identifier (Maybe Text) -- ^ user channel reason + | Quit !Source (Maybe Text) -- ^ user reason + | Kick !Source !Identifier !Identifier !Text -- ^ kicker channel kickee comment + | Kill !Source !Identifier !Text -- ^ killer killee reason + | Topic !Source !Identifier !Text -- ^ user channel topic + | Privmsg !Source !Identifier !Text -- ^ source target txt + | Ctcp !Source !Identifier !Text !Text -- ^ source target command txt + | CtcpNotice !Source !Identifier !Text !Text -- ^ source target command txt + | Notice !Source !Identifier !Text -- ^ source target txt + | Mode !Source !Identifier [Text] -- ^ source target txt | Authenticate !Text -- ^ parameters | Cap !CapCmd -- ^ cap command and parameters | Ping [Text] -- ^ parameters @@ -66,12 +70,15 @@ | Error !Text -- ^ message | BatchStart !Text !Text [Text] -- ^ reference-id type parameters | BatchEnd !Text -- ^ reference-id - | Account !UserInfo !Text -- ^ user account name changed (account-notify extension) - | Chghost !UserInfo !Text !Text -- ^ Target, new username and new hostname - | Wallops !UserInfo !Text -- ^ Braodcast message: Source, message - | Invite !UserInfo !Identifier !Identifier -- ^ sender target channel + | Account !Source !Text -- ^ user account name changed (account-notify extension) + | Chghost !Source !Text !Text -- ^ Target, new username and new hostname + | Wallops !Source !Text -- ^ Braodcast message: Source, message + | Invite !Source !Identifier !Identifier -- ^ sender target channel deriving Show +data Source = Source { srcUser :: {-# UNPACK #-}!UserInfo, srcAcct :: !Text } + deriving Show + data CapMore = CapMore | CapDone deriving (Show, Read, Eq, Ord) @@ -98,6 +105,16 @@ ("DEL" , [ caps]) -> Just (CapDel (Text.words caps)) _ -> Nothing +msgSource :: RawIrcMsg -> Maybe Source +msgSource msg = + case view msgPrefix msg of + Nothing -> Nothing + Just p -> + case [a | TagEntry "account" a <- view msgTags msg ] of + [] -> Just (Source p "") + a:_ -> Just (Source p a) + + -- | Interpret a low-level 'RawIrcMsg' as a high-level 'IrcMsg'. -- Messages that can't be understood are wrapped in 'UnknownMsg'. cookIrcMsg :: RawIrcMsg -> IrcMsg @@ -115,50 +132,54 @@ "PING" -> Ping (view msgParams msg) "PONG" -> Pong (view msgParams msg) - "PRIVMSG" | Just user <- view msgPrefix msg + "PRIVMSG" | Just source <- msgSource 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 + Just (cmd,args) -> Ctcp source (mkId chan) (Text.toUpper cmd) args + Nothing -> Privmsg source (mkId chan) txt - "NOTICE" | Just user <- view msgPrefix msg + "NOTICE" | Just source <- msgSource 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 + Just (cmd,args) -> CtcpNotice source (mkId chan) (Text.toUpper cmd) args + Nothing -> Notice source (mkId chan) txt - "JOIN" | Just user <- view msgPrefix msg + "JOIN" | Just source <- msgSource msg , chan:rest <- view msgParams msg , let (a, r) = case rest of [acct, real] -> (acct, real) _ -> ("", "") -> - Join user (mkId chan) a r + Join source (mkId chan) a r - "QUIT" | Just user <- view msgPrefix msg + "QUIT" | Just source <- msgSource msg , reasons <- view msgParams msg -> - Quit user (listToMaybe reasons) + Quit source (listToMaybe reasons) - "PART" | Just user <- view msgPrefix msg + "PART" | Just source <- msgSource msg , chan:reasons <- view msgParams msg -> - Part user (mkId chan) (listToMaybe reasons) + Part source (mkId chan) (listToMaybe reasons) - "NICK" | Just user <- view msgPrefix msg + "NICK" | Just source <- msgSource msg , newNick:_ <- view msgParams msg -> - Nick user (mkId newNick) + Nick source (mkId newNick) - "KICK" | Just user <- view msgPrefix msg + "KICK" | Just source <- msgSource msg , [chan,nick,reason] <- view msgParams msg -> - Kick user (mkId chan) (mkId nick) reason + Kick source (mkId chan) (mkId nick) reason - "TOPIC" | Just user <- view msgPrefix msg + "KILL" | Just source <- msgSource msg + , [nick,reason] <- view msgParams msg -> + Kill source (mkId nick) reason + + "TOPIC" | Just source <- msgSource msg , [chan,topic] <- view msgParams msg -> - Topic user (mkId chan) topic + Topic source (mkId chan) topic - "MODE" | Just user <- view msgPrefix msg + "MODE" | Just source <- msgSource msg , target:modes <- view msgParams msg -> - Mode user (mkId target) modes + Mode source (mkId target) modes "ERROR" | [reason] <- view msgParams msg -> Error reason @@ -171,21 +192,21 @@ , Just ('-',refid') <- Text.uncons refid -> BatchEnd refid' - "ACCOUNT" | Just user <- view msgPrefix msg + "ACCOUNT" | Just source <- msgSource msg , [acct] <- view msgParams msg -> - Account user (if acct == "*" then "" else acct) + Account source (if acct == "*" then "" else acct) - "CHGHOST" | Just user <- view msgPrefix msg + "CHGHOST" | Just source <- msgSource msg , [newuser, newhost] <- view msgParams msg -> - Chghost user newuser newhost + Chghost source newuser newhost - "WALLOPS" | Just user <- view msgPrefix msg + "WALLOPS" | Just source <- msgSource msg , [txt] <- view msgParams msg -> - Wallops user txt + Wallops source txt - "INVITE" | Just user <- view msgPrefix msg + "INVITE" | Just source <- msgSource msg , [target, channel] <- view msgParams msg -> - Invite user (mkId target) (mkId channel) + Invite source (mkId target) (mkId channel) _ -> UnknownMsg msg @@ -213,19 +234,20 @@ msgTarget me msg = case msg of UnknownMsg{} -> TargetNetwork - Nick user _ -> TargetUser (userNick user) + Nick user _ -> TargetUser (userNick (srcUser user)) Mode _ tgt _ | tgt == me -> TargetNetwork | otherwise -> TargetWindow tgt Join _ chan _ _ -> TargetWindow chan Part _ chan _ -> TargetWindow chan - Quit user _ -> TargetUser (userNick user) + Quit user _ -> TargetUser (userNick (srcUser user)) Kick _ chan _ _ -> TargetWindow chan + Kill _ _ _ -> TargetNetwork Topic _ chan _ -> TargetWindow chan Invite{} -> TargetNetwork - Privmsg src tgt _ -> directed src tgt - Ctcp src tgt _ _ -> directed src tgt - CtcpNotice src tgt _ _ -> directed src tgt - Notice src tgt _ -> directed src tgt + Privmsg src tgt _ -> directed (srcUser src) tgt + Ctcp src tgt _ _ -> directed (srcUser src) tgt + CtcpNotice src tgt _ _ -> directed (srcUser src) tgt + Notice src tgt _ -> directed (srcUser src) tgt Authenticate{} -> TargetNetwork Ping{} -> TargetNetwork Pong{} -> TargetNetwork @@ -234,9 +256,9 @@ Reply _ code args -> replyTarget code args BatchStart{} -> TargetNetwork BatchEnd{} -> TargetNetwork - Account user _ -> TargetUser (userNick user) - Chghost user _ _ -> TargetUser (userNick user) - Wallops src _ -> TargetWindow (userNick src) + Account user _ -> TargetUser (userNick (srcUser user)) + Chghost user _ _ -> TargetUser (userNick (srcUser user)) + Wallops _ _ -> TargetNetwork where directed src tgt | Text.null (userHost src) = TargetNetwork -- server message @@ -248,7 +270,7 @@ replyTarget _ _ = TargetNetwork -- | 'UserInfo' of the user responsible for a message. -msgActor :: IrcMsg -> Maybe UserInfo +msgActor :: IrcMsg -> Maybe Source msgActor msg = case msg of UnknownMsg{} -> Nothing @@ -258,6 +280,7 @@ Part x _ _ -> Just x Quit x _ -> Just x Kick x _ _ _ -> Just x + Kill x _ _ -> Just x Topic x _ _ -> Just x Privmsg x _ _ -> Just x Invite x _ _ -> Just x @@ -276,6 +299,10 @@ Chghost x _ _ -> Just x Wallops x _ -> Just x +renderSource :: Source -> Text +renderSource (Source u "") = renderUserInfo u +renderSource (Source u a) = renderUserInfo u <> "(" <> a <> ")" + -- | Text representation of an IRC message to be used for matching with -- regular expressions. ircMsgText :: IrcMsg -> Text @@ -283,28 +310,29 @@ case msg of UnknownMsg raw -> Text.unwords (view msgCommand raw : view msgParams raw) Reply srv (ReplyCode n) xs -> Text.unwords (srv : 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) + Nick x y -> Text.unwords [renderSource x, idText y] + Join x _ _ _ -> renderSource x + Part x _ mb -> Text.unwords (renderSource x : maybeToList mb) + Quit x mb -> Text.unwords (renderSource x : maybeToList mb) + Kick x _ z r -> Text.unwords [renderSource x, idText z, r] + Kill x z r -> Text.unwords [renderSource x, idText z, r] + Topic x _ t -> Text.unwords [renderSource x, t] + Privmsg x _ t -> Text.unwords [renderSource x, t] + Ctcp x _ c t -> Text.unwords [renderSource x, c, t] + CtcpNotice x _ c t -> Text.unwords [renderSource x, c, t] + Notice x _ t -> Text.unwords [renderSource x, t] + Mode x _ xs -> Text.unwords (renderSource x:"set mode":xs) Ping xs -> Text.unwords xs Pong xs -> Text.unwords xs Cap cmd -> capCmdText cmd Error t -> t - Account x a -> Text.unwords [renderUserInfo x, a] + Account x a -> Text.unwords [renderSource x, a] Authenticate{} -> "" BatchStart{} -> "" BatchEnd{} -> "" Invite _ _ _ -> "" - Chghost x a b -> Text.unwords [renderUserInfo x, a, b] - Wallops x t -> Text.unwords [renderUserInfo x, t] + Chghost x a b -> Text.unwords [renderSource x, a, b] + Wallops x t -> Text.unwords [renderSource x, t] capCmdText :: CapCmd -> Text capCmdText cmd = diff --git a/src/Irc/Modes.hs b/src/Irc/Modes.hs --- a/src/Irc/Modes.hs +++ b/src/Irc/Modes.hs @@ -63,7 +63,7 @@ modesPrefixModes :: Functor f => ([(Char,Char)] -> f [(Char,Char)]) -> ModeTypes -> f ModeTypes modesPrefixModes f m = (\x -> m { _modesPrefixModes = x }) <$> f (_modesPrefixModes m) --- | The channel modes used by Freenode +-- | The channel modes used by Solanum defaultModeTypes :: ModeTypes defaultModeTypes = ModeTypes { _modesLists = "eIbq" @@ -73,7 +73,7 @@ , _modesPrefixModes = [('o','@'),('v','+')] } --- | The default UMODE used by Freenode +-- | The default UMODE used by Solanum defaultUmodeTypes :: ModeTypes defaultUmodeTypes = ModeTypes { _modesLists = "" diff --git a/src/Irc/RawIrcMsg.hs b/src/Irc/RawIrcMsg.hs --- a/src/Irc/RawIrcMsg.hs +++ b/src/Irc/RawIrcMsg.hs @@ -43,7 +43,6 @@ 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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -75,8 +75,8 @@ ircWithPrefix = test [ assertEqual "" (Just (rawIrcMsg "254" ["glguytest", "57555", "channels formed"]) - { _msgPrefix = Just (UserInfo "morgan.freenode.net" "" "") }) - (parseRawIrcMsg ":morgan.freenode.net 254 glguytest 57555 :channels formed") + { _msgPrefix = Just (UserInfo "morgan.example.net" "" "") }) + (parseRawIrcMsg ":morgan.example.net 254 glguytest 57555 :channels formed") ] ircWithTags :: Test @@ -121,7 +121,7 @@ "glguy" (renderUserInfo (UserInfo "glguy" "" "")) - , assertEqual "freenode cloak" + , assertEqual "example cloak" "glguy!~glguy@haskell/developer/glguy" (renderUserInfo (UserInfo "glguy" "~glguy" "haskell/developer/glguy")) @@ -138,8 +138,8 @@ (renderUserInfo (UserInfo "nick" "user" "server@name")) , assertEqual "servername in nick" - "morgan.freenode.net" - (renderUserInfo (UserInfo "morgan.freenode.net" "" "")) + "morgan.example.net" + (renderUserInfo (UserInfo "morgan.example.net" "" "")) ] userInfoFields :: Test @@ -156,7 +156,7 @@ (UserInfo "glguy" "" "") (parseUserInfo "glguy") - , assertEqual "freenode cloak" + , assertEqual "example cloak" (UserInfo "glguy" "~glguy" "haskell/developer/glguy") (parseUserInfo "glguy!~glguy@haskell/developer/glguy") @@ -173,17 +173,17 @@ (parseUserInfo "nick!user@server@name") , assertEqual "servername in nick" - (UserInfo "morgan.freenode.net" "" "") - (parseUserInfo "morgan.freenode.net") + (UserInfo "morgan.example.net" "" "") + (parseUserInfo "morgan.example.net") ] renderIrc :: Test renderIrc = test [ assertEqual "" - ":morgan.freenode.net 254 glguytest 57555 :channels formed\r\n" + ":morgan.example.net 254 glguytest 57555 :channels formed\r\n" (renderRawIrcMsg (rawIrcMsg "254" ["glguytest", "57555", "channels formed"]) - { _msgPrefix = Just (UserInfo "morgan.freenode.net" "" "") }) + { _msgPrefix = Just (UserInfo "morgan.example.net" "" "") }) , assertEqual "" "254 glguytest 57555 :channels formed\r\n"