initial oper indication

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, srcIdentified :: !Bool }
+data Source = Source { srcUser :: {-# UNPACK #-}!UserInfo, srcAcct :: !Text, srcOper :: !Text, srcIdentified :: !Bool }
   deriving Show
 
 data CapMore = CapMore | CapDone
@@ -112,13 +112,17 @@ msgSource :: RawIrcMsg -> Maybe Source
 msgSource msg =
   case view msgPrefix msg of
     Nothing -> Nothing
-    Just p -> Just Source{ srcUser = p, srcAcct = acct, srcIdentified = identified }
+    Just p -> Just Source{ srcUser = p, srcAcct = acct, srcIdentified = identified, srcOper = oper }
       where
         acct = 
           case [a | TagEntry "account" a <- view msgTags msg ] of
             []  -> ""
             a:_ -> a
         identified = not (null [() | TagEntry "solanum.chat/identified" _ <- view msgTags msg ])
+        oper =
+          case [a | TagEntry "solanum.chat/oper" a <- view msgTags msg ] of
+            []  -> ""
+            a:_ -> a
 
 -- | Interpret a low-level 'RawIrcMsg' as a high-level 'IrcMsg'.
 -- Messages that can't be understood are wrapped in 'UnknownMsg'.
@@ -321,8 +325,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.

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) "" False) tgt txt)
+                 { _msgBody    = IrcBody (Privmsg (Source (parseUserInfo src) "" "" False) tgt txt)
                  , _msgTime    = now
                  , _msgNetwork = net
                  }

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) (view csAccount cs) True
+         !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) (view csAccount cs) True
+         !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) (view csAccount cs) True
+             let myNick = Source (view csUserInfo cs) (view csAccount cs) "" True
                  entry = ClientMessage
                    { _msgTime    = now
                    , _msgNetwork = network

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) "" False)
+    (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) "" "") "" False
+userInfo nick = Source (UserInfo (mkId nick) "" "") "" "" False
 
 ------------------------------------------------------------------------
 

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) "" False
+fakeUser nick ui = Source (set uiNick (mkId nick) ui) "" "" False

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 "" "*") "" True) cat msg1)
+               else RemapMessage (Notice (Source (UserInfo u "" "*") "" "" True) cat msg1)
                     -- @*@ host causes the client not to treat this as a server message
                     -- which would then be routed to the server window
 

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 "" False
+    let src = Source pfx "" "" False
     choice
       [ Join src chan "" "" <$ skipToken "joined"
       , Quit src . filterEmpty <$ skipToken "quit:" <*> P.takeText

src/Client/Image/Message.hs

@@ -218,18 +218,31 @@ ircLinePrefix !rp body =
 
       who n   = string (view palSigil pal) sigils <> ui
         where
-          ui = prefix <> coloredUserInfo pal rm hilites (srcUser n) <> suffix
+          ui = oprefix <> prefix <> coloredUserInfo pal rm hilites (srcUser n) <> suffix <> osuffix
+
+          oprefix =
+            case srcOper n of
+              "" -> mempty
+              _  -> "◆"
+
           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) <> ")"
+            = "(" <> ctxt (srcAcct n) <> ")"
             | otherwise = mempty
-
+
+          osuffix
+            | rendAccounts rp
+            , not (Text.null (srcOper n))
+            , Text.toLower (srcOper n) /= Text.toLower (srcAcct n)
+            = "{" <> ctxt (srcOper n) <> "}"
+            | otherwise = mempty
+
   in
   case body of
     Join       {} -> mempty

src/Client/State/Network.hs

@@ -847,7 +847,8 @@ selectCaps cs offered = (supported `intersect` Map.keys capMap)
       ["multi-prefix", "batch", "znc.in/playback", "znc.in/self-message"
       , "cap-notify", "extended-join", "account-notify", "chghost"
       , "userhost-in-names", "account-tag", "solanum.chat/identify-msg"
-      , "solanum.chat/realhost", "away-notify", "extended-monitor", "invite-notify", "message-tags"]
+      , "solanum.chat/realhost", "away-notify", "extended-monitor"
+      , "invite-notify", "message-tags", "solanum.chat/oper"]
 
     -- logic for using IRCv3.2 server-time if available and falling back
     -- to ZNC's specific extension otherwise.