irc-core 2.10 → 2.11
raw patch · 9 files changed
+181/−103 lines, 9 filesdep ~attoparsecdep ~basedep ~hashablePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: attoparsec, base, hashable, text
API changes (from Hackage documentation)
- Irc.Codes: pattern ERR_BADMASK :: ReplyCode
- Irc.Codes: pattern RPL_SASLABORTED :: ReplyCode
- Irc.Codes: pattern RPL_SASLALREADY :: ReplyCode
- Irc.Codes: pattern RPL_SASLFAIL :: ReplyCode
- Irc.Codes: pattern RPL_SASLTOOLONG :: ReplyCode
+ Irc.Codes: pattern ERR_INVALIDCAPCMD :: ReplyCode
+ Irc.Codes: pattern ERR_MSGNEEDREGGEDNICK :: ReplyCode
+ Irc.Codes: pattern ERR_SASLABORTED :: ReplyCode
+ Irc.Codes: pattern ERR_SASLALREADY :: ReplyCode
+ Irc.Codes: pattern ERR_SASLFAIL :: ReplyCode
+ Irc.Codes: pattern ERR_SASLTOOLONG :: ReplyCode
+ Irc.Codes: pattern RPL_WHOISHELPOP :: ReplyCode
+ Irc.Commands: ircOperwall :: Text -> RawIrcMsg
+ Irc.Commands: ircUndline :: Text -> Maybe Text -> RawIrcMsg
+ Irc.Commands: ircUnresv :: Text -> Maybe Text -> RawIrcMsg
+ Irc.Commands: ircUnxline :: Text -> Maybe Text -> RawIrcMsg
+ Irc.Message: Kill :: !Source -> !Identifier -> !Text -> IrcMsg
+ Irc.Message: Source :: {-# UNPACK #-} !UserInfo -> !Text -> Source
+ Irc.Message: [srcAcct] :: Source -> !Text
+ Irc.Message: [srcUser] :: Source -> {-# UNPACK #-} !UserInfo
+ Irc.Message: data Source
+ Irc.Message: instance GHC.Show.Show Irc.Message.Source
+ Irc.Message: msgSource :: RawIrcMsg -> Maybe Source
- Irc.Commands: ircUnkline :: Text -> RawIrcMsg
+ Irc.Commands: ircUnkline :: Text -> Maybe Text -> RawIrcMsg
- Irc.Message: Account :: !UserInfo -> !Text -> IrcMsg
+ Irc.Message: Account :: !Source -> !Text -> IrcMsg
- Irc.Message: Chghost :: !UserInfo -> !Text -> !Text -> IrcMsg
+ Irc.Message: Chghost :: !Source -> !Text -> !Text -> IrcMsg
- Irc.Message: Ctcp :: !UserInfo -> !Identifier -> !Text -> !Text -> IrcMsg
+ Irc.Message: Ctcp :: !Source -> !Identifier -> !Text -> !Text -> IrcMsg
- Irc.Message: CtcpNotice :: !UserInfo -> !Identifier -> !Text -> !Text -> IrcMsg
+ Irc.Message: CtcpNotice :: !Source -> !Identifier -> !Text -> !Text -> IrcMsg
- Irc.Message: Invite :: !UserInfo -> !Identifier -> !Identifier -> IrcMsg
+ Irc.Message: Invite :: !Source -> !Identifier -> !Identifier -> IrcMsg
- Irc.Message: Join :: !UserInfo -> !Identifier -> !Text -> !Text -> IrcMsg
+ Irc.Message: Join :: !Source -> !Identifier -> !Text -> !Text -> IrcMsg
- Irc.Message: Kick :: !UserInfo -> !Identifier -> !Identifier -> !Text -> IrcMsg
+ Irc.Message: Kick :: !Source -> !Identifier -> !Identifier -> !Text -> IrcMsg
- Irc.Message: Mode :: !UserInfo -> !Identifier -> [Text] -> IrcMsg
+ Irc.Message: Mode :: !Source -> !Identifier -> [Text] -> IrcMsg
- Irc.Message: Nick :: !UserInfo -> !Identifier -> IrcMsg
+ Irc.Message: Nick :: !Source -> !Identifier -> IrcMsg
- Irc.Message: Notice :: !UserInfo -> !Identifier -> !Text -> IrcMsg
+ Irc.Message: Notice :: !Source -> !Identifier -> !Text -> IrcMsg
- Irc.Message: Part :: !UserInfo -> !Identifier -> Maybe Text -> IrcMsg
+ Irc.Message: Part :: !Source -> !Identifier -> Maybe Text -> IrcMsg
- Irc.Message: Privmsg :: !UserInfo -> !Identifier -> !Text -> IrcMsg
+ Irc.Message: Privmsg :: !Source -> !Identifier -> !Text -> IrcMsg
- Irc.Message: Quit :: !UserInfo -> Maybe Text -> IrcMsg
+ Irc.Message: Quit :: !Source -> Maybe Text -> IrcMsg
- Irc.Message: Topic :: !UserInfo -> !Identifier -> !Text -> IrcMsg
+ Irc.Message: Topic :: !Source -> !Identifier -> !Text -> IrcMsg
- Irc.Message: Wallops :: !UserInfo -> !Text -> IrcMsg
+ Irc.Message: Wallops :: !Source -> !Text -> IrcMsg
- Irc.Message: msgActor :: IrcMsg -> Maybe UserInfo
+ Irc.Message: msgActor :: IrcMsg -> Maybe Source
Files
- ChangeLog.md +6/−0
- irc-core.cabal +6/−6
- src/Irc/Codes.hs +16/−12
- src/Irc/Commands.hs +46/−2
- src/Irc/Identifier.hs +0/−3
- src/Irc/Message.hs +95/−67
- src/Irc/Modes.hs +2/−2
- src/Irc/RawIrcMsg.hs +0/−1
- test/Main.hs +10/−10
ChangeLog.md view
@@ -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
irc-core.cabal view
@@ -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
src/Irc/Codes.hs view
@@ -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")
src/Irc/Commands.hs view
@@ -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 ::
src/Irc/Identifier.hs view
@@ -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
src/Irc/Message.hs view
@@ -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 =
src/Irc/Modes.hs view
@@ -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 = ""
src/Irc/RawIrcMsg.hs view
@@ -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
test/Main.hs view
@@ -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"