packages feed

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 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"