From 27494a69afb148229065e80ec3ba82920f6f8832 Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Fri, 6 Sep 2024 13:56:57 -0700 Subject: [PATCH] Track identify-msg status --- lib/src/Irc/Message.hs | 18 +++++++------ src/Client/CApi/Exports.hs | 2 +- src/Client/Commands.hs | 3 +-- src/Client/Commands/Chat.hs | 6 ++--- src/Client/Hook/DroneBLRelay.hs | 6 ++--- src/Client/Hook/Matterbridge.hs | 6 ++--- src/Client/Hook/Snotice.hs | 4 +-- src/Client/Hook/Znc/Buffextras.hs | 2 +- src/Client/Image/Message.hs | 44 +++++++++++++------------------ src/Client/State.hs | 7 +---- src/Client/State/Network.hs | 3 +++ src/Client/View/Messages.hs | 2 -- 12 files changed, 46 insertions(+), 57 deletions(-) diff --git a/lib/src/Irc/Message.hs b/lib/src/Irc/Message.hs index 01c86e48..7160c898 100644 --- a/lib/src/Irc/Message.hs +++ b/lib/src/Irc/Message.hs @@ -79,7 +79,7 @@ data IrcMsg | Tagmsg !Source !Identifier -- ^ source target deriving Show -data Source = Source { srcUser :: {-# UNPACK #-}!UserInfo, srcAcct :: !Text } +data Source = Source { srcUser :: {-# UNPACK #-}!UserInfo, srcAcct :: !Text, srcIdentified :: !Bool } deriving Show data CapMore = CapMore | CapDone @@ -112,11 +112,13 @@ 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) - + Just p -> Just Source{ srcUser = p, srcAcct = acct, srcIdentified = identified } + where + acct = + case [a | TagEntry "account" a <- view msgTags msg ] of + [] -> "" + a:_ -> a + identified = not (null [() | TagEntry "solanum.chat/identified" _ <- view msgTags msg ]) -- | Interpret a low-level 'RawIrcMsg' as a high-level 'IrcMsg'. -- Messages that can't be understood are wrapped in 'UnknownMsg'. @@ -319,8 +321,8 @@ msgActor msg = Tagmsg x _ -> Just x renderSource :: Source -> Text -renderSource (Source u "") = renderUserInfo u -renderSource (Source u a) = renderUserInfo u <> "(" <> a <> ")" +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. diff --git a/src/Client/CApi/Exports.hs b/src/Client/CApi/Exports.hs index fb77f1fb..3d5a39dd 100644 --- a/src/Client/CApi/Exports.hs +++ b/src/Client/CApi/Exports.hs @@ -248,7 +248,7 @@ glirc_inject_chat stab netPtr netLen srcPtr srcLen tgtPtr tgtLen msgPtr msgLen = now <- getZonedTime let msg = ClientMessage - { _msgBody = IrcBody (Privmsg (Source (parseUserInfo src) "") tgt txt) + { _msgBody = IrcBody (Privmsg (Source (parseUserInfo src) "" False) tgt txt) , _msgTime = now , _msgNetwork = net } diff --git a/src/Client/Commands.hs b/src/Client/Commands.hs index 06ec7fcf..1a0762c3 100644 --- a/src/Client/Commands.hs +++ b/src/Client/Commands.hs @@ -44,7 +44,7 @@ import Control.Exception (displayException, try) import Control.Lens import Control.Monad (guard, foldM) import Data.Foldable (foldl', toList) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, maybeToList) import Data.Text (Text) import Data.Text qualified as Text import Data.Time (getZonedTime) @@ -67,7 +67,6 @@ import Client.Commands.Toggles (togglesCommands) import Client.Commands.Types import Client.Commands.Window (windowCommands, focusNames) import Client.Commands.ZNC (zncCommands) -import Data.Maybe (maybeToList) -- | Interpret the given chat message or command. Leading @/@ indicates a -- command. Otherwise if a channel or user query is focused a chat message will diff --git a/src/Client/Commands/Chat.hs b/src/Client/Commands/Chat.hs index 1b62632f..661cc0ac 100644 --- a/src/Client/Commands/Chat.hs +++ b/src/Client/Commands/Chat.hs @@ -331,7 +331,7 @@ chatCommand' :: chatCommand' con targetTxts cs st = do now <- getZonedTime let targetIds = mkId <$> targetTxts - !myNick = Source (view csUserInfo cs) "" + !myNick = Source (view csUserInfo cs) (view csAccount cs) True network = view csNetwork cs entries = [ (targetId, ClientMessage @@ -382,7 +382,7 @@ cmdMe :: ChannelCommand String cmdMe channelId cs st rest = do now <- getZonedTime let actionTxt = Text.pack ("\^AACTION " ++ rest ++ "\^A") - !myNick = Source (view csUserInfo cs) "" + !myNick = Source (view csUserInfo cs) (view csAccount cs) True network = view csNetwork cs entry = ClientMessage { _msgTime = now @@ -411,7 +411,7 @@ executeChat focus msg st = when allow (sendMsg cs (ircPrivmsg tgtTxt msgTxt)) - let myNick = Source (view csUserInfo cs) "" + let myNick = Source (view csUserInfo cs) (view csAccount cs) True entry = ClientMessage { _msgTime = now , _msgNetwork = network diff --git a/src/Client/Hook/DroneBLRelay.hs b/src/Client/Hook/DroneBLRelay.hs index e071d1fa..38fb4bb1 100644 --- a/src/Client/Hook/DroneBLRelay.hs +++ b/src/Client/Hook/DroneBLRelay.hs @@ -35,7 +35,7 @@ droneblRelayHook args = Just (MessageHook "droneblrelay" False (remap (map mkId -- | Remap messages from #dronebl that match one of the -- rewrite rules. remap :: [Identifier] -> IrcMsg -> MessageResult -remap nicks (Privmsg (Source (UserInfo nick _ _) _) chan@"#dronebl" msg) +remap nicks (Privmsg (Source (UserInfo nick _ _) _ _) chan@"#dronebl" msg) | nick `elem` nicks , Just sub <- rules chan msg = RemapMessage sub remap _ _ = PassMessage @@ -121,7 +121,7 @@ joinMsg :: IrcMsg joinMsg chan srv nick user host = Join - (Source (UserInfo (mkId (nick <> "@" <> srv)) user host) "") + (Source (UserInfo (mkId (nick <> "@" <> srv)) user host) "" False) chan "" -- account "" -- gecos @@ -189,7 +189,7 @@ modeMsg chan srv nick modes = userInfo :: Text {- ^ nickname -} -> Source -userInfo nick = Source (UserInfo (mkId nick) "*" "*") "" +userInfo nick = Source (UserInfo (mkId nick) "" "") "" False ------------------------------------------------------------------------ diff --git a/src/Client/Hook/Matterbridge.hs b/src/Client/Hook/Matterbridge.hs index eea0662d..a983641d 100644 --- a/src/Client/Hook/Matterbridge.hs +++ b/src/Client/Hook/Matterbridge.hs @@ -46,9 +46,9 @@ matterbridgeHook (nick:chans) = Just (MessageHook "matterbridge" False (remap (m remap :: Identifier -> (Identifier -> Bool) -> IrcMsg -> MessageResult remap nick chanfilter ircmsg = case ircmsg of - Privmsg (Source ui _) chan msg + Privmsg (Source ui _ _) chan msg | view uiNick ui == nick, chanfilter chan -> remap' Msg ui chan msg - Ctcp (Source ui _) chan "ACTION" msg + Ctcp (Source ui _ _) chan "ACTION" msg | view uiNick ui == nick, chanfilter chan -> remap' Act ui chan msg _ -> PassMessage @@ -63,4 +63,4 @@ newmsg Msg src chan msg = Privmsg src chan msg newmsg Act src chan msg = Ctcp src chan "ACTION" msg fakeUser :: Text -> UserInfo -> Source -fakeUser nick ui = Source (set uiNick (mkId nick) ui) "" +fakeUser nick ui = Source (set uiNick (mkId nick) ui) "" False diff --git a/src/Client/Hook/Snotice.hs b/src/Client/Hook/Snotice.hs index 2cd3aa63..8ca52e28 100644 --- a/src/Client/Hook/Snotice.hs +++ b/src/Client/Hook/Snotice.hs @@ -30,12 +30,12 @@ snoticeHook = MessageHook "snotice" True remap remap :: IrcMsg -> MessageResult -remap (Notice (Source (UserInfo u "" "") _) _ msg) +remap (Notice (Source (UserInfo u "" "") _ _) _ msg) | Just msg1 <- Text.stripPrefix "*** Notice -- " msg , let msg2 = Text.filter (\x -> x /= '\x02' && x /= '\x0f') msg1 , Just (lvl, cat) <- characterize msg2 = if lvl < 1 then OmitMessage - else RemapMessage (Notice (Source (UserInfo u "" "*") "") cat msg1) + else RemapMessage (Notice (Source (UserInfo u "" "") "" True) cat msg1) remap _ = PassMessage diff --git a/src/Client/Hook/Znc/Buffextras.hs b/src/Client/Hook/Znc/Buffextras.hs index 041bf2da..2e47e55f 100644 --- a/src/Client/Hook/Znc/Buffextras.hs +++ b/src/Client/Hook/Znc/Buffextras.hs @@ -52,7 +52,7 @@ remap _ _ = PassMessage prefixedParser :: Identifier -> Parser IrcMsg prefixedParser chan = do pfx <- prefixParser - let src = Source pfx "" + let src = Source pfx "" False choice [ Join src chan "" "" <$ skipToken "joined" , Quit src . filterEmpty <$ skipToken "quit:" <*> P.takeText diff --git a/src/Client/Image/Message.hs b/src/Client/Image/Message.hs index a56e8b43..ad08a0c0 100644 --- a/src/Client/Image/Message.hs +++ b/src/Client/Image/Message.hs @@ -38,9 +38,7 @@ import Client.Image.PackedImage (char, imageWidth, string, text', Image') import Client.Image.Palette import Client.Message import Client.State.Window (unpackTimeOfDay, wlImage, wlPrefix, wlTimestamp, WindowLine) -import Client.UserHost ( uhAccount, UserAndHost ) -import Control.Applicative ((<|>)) -import Control.Lens (view, (^?), filtered, folded, views, Ixed(ix), At (at)) +import Control.Lens (view, views, At (at)) import Data.Char (ord, chr, isControl) import Data.Hashable (hash) import Data.HashMap.Strict (HashMap) @@ -65,7 +63,7 @@ data MessageRendererParams = MessageRendererParams , rendUserSigils :: [Char] -- ^ sender sigils , rendHighlights :: HashMap Identifier Highlight -- ^ words to highlight , rendPalette :: Palette -- ^ nick color palette - , rendAccounts :: Maybe (HashMap Identifier UserAndHost) + , rendAccounts :: Bool -- ^ should we indicate account and identified status? , rendNetPalette :: NetworkPalette , rendChanTypes :: [Char] -- ^ A list of valid channel name prefixes. } @@ -77,7 +75,7 @@ defaultRenderParams = MessageRendererParams , rendUserSigils = "" , rendHighlights = HashMap.empty , rendPalette = defaultPalette - , rendAccounts = Nothing + , rendAccounts = False , rendNetPalette = defaultNetworkPalette , rendChanTypes = "#&!+" -- Default for if we aren't told otherwise by ISUPPORT. } @@ -220,22 +218,18 @@ ircLinePrefix !rp body = who n = string (view palSigil pal) sigils <> ui where - baseUI = coloredUserInfo pal rm hilites (srcUser n) - ui = case rendAccounts rp of - Nothing -> baseUI -- not tracking any accounts - Just accts -> - let tagAcct = if Text.null (srcAcct n) then Nothing else Just (srcAcct n) - - isKnown acct = not (Text.null acct || acct == "*") - lkupAcct = accts - ^? ix (userNick (srcUser n)) - . uhAccount - . filtered isKnown in - case tagAcct <|> lkupAcct of - Just acct - | mkId acct == userNick (srcUser n) -> baseUI - | otherwise -> baseUI <> "(" <> ctxt acct <> ")" - Nothing -> "~" <> baseUI + ui = prefix <> coloredUserInfo pal rm hilites (srcUser n) <> suffix + prefix + | rendAccounts rp, not (srcIdentified n) = "~" + | otherwise = mempty + + suffix + | rendAccounts rp + , not (Text.null (srcAcct n)) + , mkId (srcAcct n) /= userNick (srcUser n) + ="(" <> ctxt (srcAcct n) <> ")" + | otherwise = mempty + in case body of Join {} -> mempty @@ -381,11 +375,9 @@ fullIrcLineImage !rp body = -- nick!user@host plainWho (srcUser n) <> - case rendAccounts rp ^? folded . ix (userNick (srcUser n)) . uhAccount of - _ | not (Text.null (srcAcct n)) -> text' quietAttr ("(" <> cleanText (srcAcct n) <> ")") - Just acct - | not (Text.null acct) -> text' quietAttr ("(" <> cleanText acct <> ")") - _ -> "" + if rendAccounts rp && not (Text.null (srcAcct n)) + then text' quietAttr ("(" <> cleanText (srcAcct n) <> ")") + else "" in case body of Nick old new -> diff --git a/src/Client/State.hs b/src/Client/State.hs index f9710a8b..38cd73c3 100644 --- a/src/Client/State.hs +++ b/src/Client/State.hs @@ -360,7 +360,7 @@ recordChannelMessage' create network channel msg st , rendUserSigils = computeMsgLineSigils network channel' msg st , rendHighlights = highlights , rendPalette = clientPalette st - , rendAccounts = accounts + , rendAccounts = view (csSettings . ssShowAccounts) cs , rendNetPalette = clientNetworkPalette st , rendChanTypes = "#&!+" -- TODO: Don't hardcode this, use CHANTYPES ISUPPORT. } @@ -372,11 +372,6 @@ recordChannelMessage' create network channel msg st importance = msgImportance msg st highlights = clientHighlightsFocus (ChannelFocus network channel) st - accounts = - if view (csSettings . ssShowAccounts) cs - then Just (view csUsers cs) - else Nothing - recordLogLine :: ClientMessage {- ^ message -} -> diff --git a/src/Client/State/Network.hs b/src/Client/State/Network.hs index 33927aa7..3da157e8 100644 --- a/src/Client/State/Network.hs +++ b/src/Client/State/Network.hs @@ -38,6 +38,7 @@ module Client.State.Network , csStatusMsg , csSettings , csUserInfo + , csAccount , csUsers , csUser , csModeCount @@ -140,6 +141,7 @@ data NetworkState = NetworkState , _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 + , _csAccount :: !Text -- ^ account name for this connection or "" , _csUsers :: !(HashMap Identifier UserAndHost) -- ^ user and hostname for other nicks , _csModeCount :: !Int -- ^ maximum mode changes per MODE command , _csNetwork :: !Text -- ^ name of network connection @@ -306,6 +308,7 @@ newNetworkState :: NetworkState {- ^ new network state -} newNetworkState network settings sock ping seed = NetworkState { _csUserInfo = UserInfo "*" "" "" + , _csAccount = "" , _csChannels = HashMap.empty , _csChannelList = newChannelList Nothing Nothing , _csWhoReply = finishWhoReply $ newWhoReply "" "" diff --git a/src/Client/View/Messages.hs b/src/Client/View/Messages.hs index 960ef599..9790f7c2 100644 --- a/src/Client/View/Messages.hs +++ b/src/Client/View/Messages.hs @@ -23,13 +23,11 @@ import Client.Image.Palette import Client.Message import Client.State import Client.State.Focus -import Client.State.Network import Client.State.Window import Control.Lens import Control.Monad import Data.List import Irc.Identifier -import Irc.Message import Irc.UserInfo