diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for irc-core +## 2.10 + +* Track servername in `Reply` constructor + ## 2.9 * Move message hiding logic out of the IRC library diff --git a/irc-core.cabal b/irc-core.cabal --- a/irc-core.cabal +++ b/irc-core.cabal @@ -1,5 +1,5 @@ name: irc-core -version: 2.9 +version: 2.10 synopsis: IRC core library for glirc description: IRC core library for glirc . @@ -32,14 +32,14 @@ Irc.UserInfo other-modules: View - build-depends: base >=4.11 && <4.15, - base64-bytestring >= 1.0.0.1 && <1.1, + build-depends: base >=4.11 && <4.16, + base64-bytestring >= 1.0.0.1 && <1.3, attoparsec >=0.13 && <0.14, - bytestring >=0.10 && <0.11, + bytestring >=0.10 && <0.12, hashable >=1.2 && <1.4, primitive >=0.6 && <0.8, text >=1.2 && <1.3, - time >=1.6 && <1.10, + time >=1.6 && <1.12, vector >=0.11 && <0.13 hs-source-dirs: src diff --git a/src/Irc/Codes.hs b/src/Irc/Codes.hs --- a/src/Irc/Codes.hs +++ b/src/Irc/Codes.hs @@ -83,7 +83,6 @@ 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 @@ -168,7 +167,6 @@ 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 @@ -513,7 +511,6 @@ , (RPL_UMODEIS , ReplyCodeInfo CommandReply "umode-is") , (RPL_SQLINE_NICK , ReplyCodeInfo CommandReply "sqline-nick") , (RPL_STATSDLINE , ReplyCodeInfo CommandReply "stats-dline") - , (RPL_STATSZLINE , ReplyCodeInfo CommandReply "stats-zline") , (RPL_STATSCOUNT , ReplyCodeInfo CommandReply "stats-count") , (RPL_SERVICEINFO , ReplyCodeInfo CommandReply "service-info") , (RPL_ENDOFSERVICES , ReplyCodeInfo CommandReply "end-of-services") @@ -571,7 +568,7 @@ , (RPL_ISON , ReplyCodeInfo CommandReply "ison") , (RPL_TEXT , ReplyCodeInfo CommandReply "text") , (RPL_UNAWAY , ReplyCodeInfo CommandReply "unaway") - , (RPL_NOWAWAY , ReplyCodeInfo CommandReply "nowaway") + , (RPL_NOWAWAY , ReplyCodeInfo CommandReply "now-away") , (RPL_WHOISREGNICK , ReplyCodeInfo CommandReply "whois-regnick") , (RPL_SUSERHOST , ReplyCodeInfo CommandReply "suserhost") , (RPL_NOTIFYACTION , ReplyCodeInfo CommandReply "notify-action") @@ -598,7 +595,6 @@ , (RPL_CHPASSUNKNOWN , ReplyCodeInfo CommandReply "chpass-unknown") , (RPL_CHANNEL_URL , ReplyCodeInfo CommandReply "channel-url") , (RPL_CREATIONTIME , ReplyCodeInfo CommandReply "creation-time") - , (RPL_WHOWAS_TIME , ReplyCodeInfo CommandReply "whowas-time") , (RPL_WHOISACCOUNT , ReplyCodeInfo CommandReply "whois-account") , (RPL_NOTOPIC , ReplyCodeInfo CommandReply "notopic") , (RPL_TOPIC , ReplyCodeInfo CommandReply "topic") diff --git a/src/Irc/Commands.hs b/src/Irc/Commands.hs --- a/src/Irc/Commands.hs +++ b/src/Irc/Commands.hs @@ -54,7 +54,10 @@ , ircUnkline , ircUser , ircUserhost + , ircUserip + , ircUsers , ircVersion + , ircWallops , ircWho , ircWhois , ircWhowas @@ -80,7 +83,7 @@ import qualified Data.ByteString.Base64 as Enc nonempty :: Text -> [Text] -nonempty txt = filter (not . Text.null) [txt] +nonempty txt = [txt | not (Text.null txt)] -- | PRIVMSG command ircPrivmsg :: @@ -255,7 +258,7 @@ ircEtrace :: Text {- ^ argument -} -> RawIrcMsg -ircEtrace arg = rawIrcMsg "ETRACE" [arg] +ircEtrace arg = rawIrcMsg "ETRACE" (nonempty arg) -- | REMOVE command ircRemove :: @@ -267,7 +270,7 @@ -- | QUIT command ircQuit :: Text {- ^ quit message -} -> RawIrcMsg -ircQuit = rawIrcMsg "QUIT" . nonempty +ircQuit msg = rawIrcMsg "QUIT" [msg] -- | PASS command ircPass :: Text {- ^ password -} -> RawIrcMsg diff --git a/src/Irc/Identifier.hs b/src/Irc/Identifier.hs --- a/src/Irc/Identifier.hs +++ b/src/Irc/Identifier.hs @@ -28,7 +28,6 @@ import Data.Function import Data.Hashable import Data.Monoid -import Data.Primitive.ByteArray import Data.String import Data.Text (Text) import qualified Data.Text as Text @@ -72,7 +71,7 @@ -- | Hash on normalized identifier instance Hashable Identifier where - hashWithSalt salt (Identifier _ b@(ByteArray arr)) = + hashWithSalt salt (Identifier _ b@(BA.ByteArray arr)) = hashByteArrayWithSalt arr 0 (BA.sizeofByteArray b) salt -- | @'fromString' = 'mkId' . 'fromString' diff --git a/src/Irc/Message.hs b/src/Irc/Message.hs --- a/src/Irc/Message.hs +++ b/src/Irc/Message.hs @@ -47,7 +47,7 @@ -- | High-level IRC message representation data IrcMsg = UnknownMsg !RawIrcMsg -- ^ pass-through for unhandled messages - | Reply !ReplyCode [Text] -- ^ code arguments + | 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 @@ -69,6 +69,7 @@ | 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 deriving Show data CapMore = CapMore | CapDone @@ -102,8 +103,9 @@ cookIrcMsg :: RawIrcMsg -> IrcMsg cookIrcMsg msg = case view msgCommand msg of - cmd | Right (n,"") <- decimal cmd -> - Reply (ReplyCode n) (view msgParams msg) + cmd | Just user <- view msgPrefix msg + , Right (n,"") <- decimal cmd -> + Reply (idText (userNick user)) (ReplyCode n) (view msgParams msg) "CAP" | _target:cmdTxt:rest <- view msgParams msg , Just cmd <- cookCapCmd cmdTxt rest -> Cap cmd @@ -181,6 +183,10 @@ , [txt] <- view msgParams msg -> Wallops user txt + "INVITE" | Just user <- view msgPrefix msg + , [target, channel] <- view msgParams msg -> + Invite user (mkId target) (mkId channel) + _ -> UnknownMsg msg -- | Parse a CTCP encoded message: @@ -207,7 +213,7 @@ msgTarget me msg = case msg of UnknownMsg{} -> TargetNetwork - Nick user oldUser -> TargetUser (userNick user) + Nick user _ -> TargetUser (userNick user) Mode _ tgt _ | tgt == me -> TargetNetwork | otherwise -> TargetWindow tgt Join _ chan _ _ -> TargetWindow chan @@ -215,6 +221,7 @@ Quit user _ -> TargetUser (userNick user) Kick _ chan _ _ -> TargetWindow chan Topic _ chan _ -> TargetWindow chan + Invite{} -> TargetNetwork Privmsg src tgt _ -> directed src tgt Ctcp src tgt _ _ -> directed src tgt CtcpNotice src tgt _ _ -> directed src tgt @@ -224,7 +231,7 @@ Pong{} -> TargetNetwork Error{} -> TargetNetwork Cap{} -> TargetNetwork - Reply code args -> replyTarget code args + Reply _ code args -> replyTarget code args BatchStart{} -> TargetNetwork BatchEnd{} -> TargetNetwork Account user _ -> TargetUser (userNick user) @@ -253,6 +260,7 @@ Kick x _ _ _ -> Just x Topic x _ _ -> Just x Privmsg x _ _ -> Just x + Invite x _ _ -> Just x Ctcp x _ _ _ -> Just x CtcpNotice x _ _ _ -> Just x Notice x _ _ -> Just x @@ -274,7 +282,7 @@ 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) + 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) @@ -294,6 +302,7 @@ Authenticate{} -> "" BatchStart{} -> "" BatchEnd{} -> "" + Invite _ _ _ -> "" Chghost x a b -> Text.unwords [renderUserInfo x, a, b] Wallops x t -> Text.unwords [renderUserInfo x, t]