merge profiles using contact probe (#86)

* chat commands to list members and to quit chat

* merge profiles using probe

* merge contacts connected to the same user based on successful profile probe

* delete display name after merging contacts

* probe: rename "existing" contacts to "matching"

migrations/20210612_initial.sql

@@ -5,6 +5,8 @@ CREATE TABLE contact_profiles ( -- remote user profile
   properties TEXT NOT NULL DEFAULT '{}' -- JSON with contact profile properties
 );
 
+CREATE INDEX contact_profiles_index ON contact_profiles (display_name, full_name);
+
 CREATE TABLE users (
   user_id INTEGER PRIMARY KEY,
   contact_id INTEGER NOT NULL UNIQUE REFERENCES contacts ON DELETE CASCADE
@@ -43,6 +45,30 @@ CREATE TABLE contacts (
   UNIQUE (user_id, contact_profile_id)
 );
 
+CREATE TABLE sent_probes (
+  sent_probe_id INTEGER PRIMARY KEY,
+  contact_id INTEGER NOT NULL UNIQUE REFERENCES contacts ON DELETE CASCADE,
+  probe BLOB NOT NULL,
+  user_id INTEGER NOT NULL REFERENCES users,
+  UNIQUE (user_id, probe)
+);
+
+CREATE TABLE sent_probe_hashes (
+  sent_probe_hash_id INTEGER PRIMARY KEY,
+  sent_probe_id INTEGER NOT NULL REFERENCES sent_probes ON DELETE CASCADE,
+  contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE,
+  user_id INTEGER NOT NULL REFERENCES users,
+  UNIQUE (sent_probe_id, contact_id)
+);
+
+CREATE TABLE received_probes (
+  received_probe_id INTEGER PRIMARY KEY,
+  contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE,
+  probe BLOB,
+  probe_hash BLOB NOT NULL,
+  user_id INTEGER NOT NULL REFERENCES users
+);
+
 CREATE TABLE known_servers(
   server_id INTEGER PRIMARY KEY,
   host TEXT NOT NULL,

src/Simplex/Chat.hs

@@ -43,9 +43,10 @@ import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Client (smpDefaultConfig)
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Util (raceAny_)
-import System.Exit (exitFailure)
+import System.Exit (exitFailure, exitSuccess)
 import System.IO (hFlush, stdout)
 import Text.Read (readMaybe)
 import UnliftIO.Async (race_)
@@ -67,6 +68,7 @@ data ChatCommand
   | DeleteGroup GroupName
   | ListMembers GroupName
   | SendGroupMessage GroupName ByteString
+  | QuitChat
   deriving (Show)
 
 cfg :: AgentConfig
@@ -186,7 +188,9 @@ processChatCommand user@User {userId, profile} = \case
   RemoveMember _gName _cName -> pure ()
   LeaveGroup _gName -> pure ()
   DeleteGroup _gName -> pure ()
-  ListMembers _gName -> pure ()
+  ListMembers gName -> do
+    group <- withStore $ \st -> getGroup st user gName
+    showGroupMembers group
   SendGroupMessage gName msg -> do
     -- TODO save sent messages
     -- TODO save pending message delivery for members without connections
@@ -194,6 +198,7 @@ processChatCommand user@User {userId, profile} = \case
     let msgEvent = XMsgNew $ MsgContent MTText [] [MsgContentBody {contentType = SimplexContentType XCText, contentData = msg}]
     sendGroupMessage members msgEvent
     setActive $ ActiveG gName
+  QuitChat -> liftIO exitSuccess
   where
     isMember :: Contact -> [GroupMember] -> Bool
     isMember Contact {contactId} members = isJust $ find ((== Just contactId) . memberContactId) members
@@ -272,6 +277,9 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
             XMsgNew (MsgContent MTText [] body) -> newTextMessage c meta $ find (isSimplexContentType XCText) body
             XInfo _ -> pure () -- TODO profile update
             XGrpInv gInv -> processGroupInvitation ct gInv
+            XInfoProbe probe -> xInfoProbe ct probe
+            XInfoProbeCheck probeHash -> xInfoProbeCheck ct probeHash
+            XInfoProbeOk probe -> xInfoProbeOk ct probe
             _ -> pure ()
         CONF confId connInfo -> do
           -- confirming direct connection with a member
@@ -298,7 +306,9 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
               setActive $ ActiveC c
               showToast (c <> "> ") "connected"
             Just (gName, m) ->
-              when (memberIsReady m) $ notifyMemberConnected gName m
+              when (memberIsReady m) $ do
+                notifyMemberConnected gName m
+                when (memberCategory m == GCPreMember) $ probeMatchingContacts ct
         END -> do
           showContactDisconnected c
           showToast (c <> "> ") "disconnected"
@@ -342,6 +352,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
         group@Group {members, membership} <- withStore $ \st -> getGroup st user gName
         withStore $ \st -> do
           updateGroupMemberStatus st userId (groupMemberId m) GSMemConnected
+          unless (memberActive membership) $
             updateGroupMemberStatus st userId (groupMemberId membership) GSMemConnected
         -- TODO forward any pending (GMIntroInvReceived) introductions
         case memberCategory m of
@@ -366,7 +377,9 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
                 notifyMemberConnected gName m
                 messageError "implementation error: connected member does not have contact"
               Just ct ->
-                when (contactIsReady ct) $ notifyMemberConnected gName m
+                when (contactIsReady ct) $ do
+                  notifyMemberConnected gName m
+                  when (memberCategory m == GCPreMember) $ probeMatchingContacts ct
       MSG meta msgBody -> do
         ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
         case chatMsgEvent of
@@ -385,6 +398,19 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
       setActive $ ActiveG gName
       showToast ("#" <> gName) $ "member " <> localDisplayName <> " is connected"
 
+    probeMatchingContacts :: Contact -> m ()
+    probeMatchingContacts ct = do
+      gVar <- asks idsDrg
+      (probe, probeId) <- withStore $ \st -> createSentProbe st gVar userId ct
+      sendDirectMessage (contactConnId ct) $ XInfoProbe probe
+      cs <- withStore (\st -> getMatchingContacts st userId ct)
+      let probeHash = C.sha256Hash probe
+      forM_ cs $ \c -> sendProbeHash c probeHash probeId `catchError` const (pure ())
+      where
+        sendProbeHash c probeHash probeId = do
+          sendDirectMessage (contactConnId c) $ XInfoProbeCheck probeHash
+          withStore $ \st -> createSentProbeHash st userId probeId c
+
     messageWarning :: Text -> m ()
     messageWarning = liftIO . print
 
@@ -416,6 +442,32 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
       group <- withStore $ \st -> createGroupInvitation st user ct inv
       showReceivedGroupInvitation group localDisplayName memRole
 
+    xInfoProbe :: Contact -> ByteString -> m ()
+    xInfoProbe c2 probe = do
+      r <- withStore $ \st -> matchReceivedProbe st userId c2 probe
+      forM_ r $ \c1 -> probeMatch c1 c2 probe
+
+    xInfoProbeCheck :: Contact -> ByteString -> m ()
+    xInfoProbeCheck c1 probeHash = do
+      r <- withStore $ \st -> matchReceivedProbeHash st userId c1 probeHash
+      forM_ r $ \(c2, probe) -> probeMatch c1 c2 probe
+
+    probeMatch :: Contact -> Contact -> ByteString -> m ()
+    probeMatch c1@Contact {profile = p1} c2@Contact {profile = p2} probe =
+      when (p1 == p2) $ do
+        sendDirectMessage (contactConnId c1) $ XInfoProbeOk probe
+        mergeContacts c1 c2
+
+    xInfoProbeOk :: Contact -> ByteString -> m ()
+    xInfoProbeOk c1 probe = do
+      r <- withStore $ \st -> matchSentProbe st userId c1 probe
+      forM_ r $ \c2 -> mergeContacts c1 c2
+
+    mergeContacts :: Contact -> Contact -> m ()
+    mergeContacts to from = do
+      withStore $ \st -> mergeContactRecords st userId to from
+      showContactsMerged to from
+
     parseChatMessage :: ByteString -> Either ChatError ChatMessage
     parseChatMessage msgBody = first ChatErrorMessage (parseAll rawChatMessageP msgBody >>= toChatMessage)
 
@@ -597,13 +649,14 @@ chatCommandP =
     <|> ("/join #" <|> "/join " <|> "/j #" <|> "/j ") *> (JoinGroup <$> displayName)
     <|> ("/remove #" <|> "/rm #") *> (RemoveMember <$> displayName <* A.space <*> displayName)
     <|> ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName)
-    <|> ("/members #" <|> "/ms #") *> (ListMembers <$> displayName)
+    <|> ("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName)
     <|> A.char '#' *> (SendGroupMessage <$> displayName <* A.space <*> A.takeByteString)
     <|> ("/add" <|> "/a") $> AddContact
     <|> ("/connect " <|> "/c ") *> (Connect <$> smpQueueInfoP)
     <|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName)
     <|> A.char '@' *> (SendMessage <$> displayName <*> (A.space *> A.takeByteString))
     <|> ("/markdown" <|> "/m") $> MarkdownHelp
+    <|> ("/quit" <|> "/q") $> QuitChat
   where
     displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' '))
     refChar c = c > ' ' && c /= '#' && c /= '@'

src/Simplex/Chat/Protocol.hs

@@ -56,8 +56,8 @@ data ChatMsgEvent
   | XGrpMemCon MemberId
   | XGrpMemConAll MemberId
   | XInfoProbe ByteString
-  | XInfoProbeCheck MemberId ByteString
+  | XInfoProbeCheck ByteString
-  | XInfoProbeOk MemberId ByteString
+  | XInfoProbeOk ByteString
   | XOk
   deriving (Eq, Show)
 
@@ -124,10 +124,10 @@ toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBod
       chatMsg . XGrpMemConAll =<< B64.decode memId
     ("x.info.probe", [probe]) -> do
       chatMsg . XInfoProbe =<< B64.decode probe
-    ("x.info.probe.check", [memId, probeHash]) -> do
+    ("x.info.probe.check", [probeHash]) -> do
-      chatMsg =<< (XInfoProbeCheck <$> B64.decode memId <*> B64.decode probeHash)
+      chatMsg =<< (XInfoProbeCheck <$> B64.decode probeHash)
-    ("x.info.probe.ok", [memId, probe]) -> do
+    ("x.info.probe.ok", [probe]) -> do
-      chatMsg =<< (XInfoProbeOk <$> B64.decode memId <*> B64.decode probe)
+      chatMsg =<< (XInfoProbeOk <$> B64.decode probe)
     ("x.ok", []) ->
       chatMsg XOk
     _ -> Left $ "bad syntax or unsupported event " <> B.unpack chatMsgEvent
@@ -202,10 +202,10 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
       rawMsg "x.grp.mem.con.all" [B64.encode memId] []
     XInfoProbe probe ->
       rawMsg "x.info.probe" [B64.encode probe] []
-    XInfoProbeCheck memId probeHash ->
+    XInfoProbeCheck probeHash ->
-      rawMsg "x.info.probe.check" [B64.encode memId, B64.encode probeHash] []
+      rawMsg "x.info.probe.check" [B64.encode probeHash] []
-    XInfoProbeOk memId probe ->
+    XInfoProbeOk probe ->
-      rawMsg "x.info.probe.ok" [B64.encode memId, B64.encode probe] []
+      rawMsg "x.info.probe.ok" [B64.encode probe] []
     XOk ->
       rawMsg "x.ok" [] []
   where

src/Simplex/Chat/Store.hs

@@ -44,6 +44,14 @@ module Simplex.Chat.Store
     saveMemberInvitation,
     getViaGroupMember,
     getViaGroupContact,
+    getMatchingContacts,
+    randomBytes,
+    createSentProbe,
+    createSentProbeHash,
+    matchReceivedProbe,
+    matchReceivedProbeHash,
+    matchSentProbe,
+    mergeContactRecords,
   )
 where
 
@@ -73,6 +81,7 @@ import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Protocol (AParty (..), ConnId, SMPQueueInfo)
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, withTransaction)
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Util (bshow, liftIOEither)
 import System.FilePath (takeBaseName, takeExtension)
 import UnliftIO.STM
@@ -293,6 +302,126 @@ toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Ju
   Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, createdAt)
 toMaybeConnection _ = Nothing
 
+getMatchingContacts :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [Contact]
+getMatchingContacts st userId Contact {contactId, profile = Profile {displayName, fullName}} =
+  liftIO . withTransaction st $ \db -> do
+    contactNames <-
+      map fromOnly
+        <$> DB.queryNamed
+          db
+          [sql|
+            SELECT ct.local_display_name
+            FROM contacts ct
+            JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
+            WHERE ct.user_id = :user_id AND ct.contact_id != :contact_id
+              AND p.display_name = :display_name AND p.full_name = :full_name
+          |]
+          [ ":user_id" := userId,
+            ":contact_id" := contactId,
+            ":display_name" := displayName,
+            ":full_name" := fullName
+          ]
+    rights <$> mapM (runExceptT . getContact_ db userId) contactNames
+
+createSentProbe :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> UserId -> Contact -> m (ByteString, Int64)
+createSentProbe st gVar userId _to@Contact {contactId} =
+  liftIOEither . withTransaction st $ \db ->
+    createWithRandomBytes 32 gVar $ \probe -> do
+      DB.execute db "INSERT INTO sent_probes (contact_id, probe, user_id) VALUES (?,?,?)" (contactId, probe, userId)
+      (probe,) <$> insertedRowId db
+
+createSentProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> Contact -> m ()
+createSentProbeHash st userId probeId _to@Contact {contactId} =
+  liftIO . withTransaction st $ \db ->
+    DB.execute db "INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, user_id) VALUES (?,?,?)" (probeId, contactId, userId)
+
+matchReceivedProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe Contact)
+matchReceivedProbe st userId _from@Contact {contactId} probe =
+  liftIO . withTransaction st $ \db -> do
+    let probeHash = C.sha256Hash probe
+    contactNames <-
+      map fromOnly
+        <$> DB.query
+          db
+          [sql|
+            SELECT c.local_display_name
+            FROM contacts c
+            JOIN received_probes r ON r.contact_id = c.contact_id
+            WHERE c.user_id = ? AND r.probe_hash = ? AND r.probe IS NULL
+          |]
+          (userId, probeHash)
+    DB.execute db "INSERT INTO received_probes (contact_id, probe, probe_hash, user_id) VALUES (?,?,?,?)" (contactId, probe, probeHash, userId)
+    case contactNames of
+      [] -> pure Nothing
+      cName : _ ->
+        either (const Nothing) Just
+          <$> runExceptT (getContact_ db userId cName)
+
+matchReceivedProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe (Contact, ByteString))
+matchReceivedProbeHash st userId _from@Contact {contactId} probeHash =
+  liftIO . withTransaction st $ \db -> do
+    namesAndProbes <-
+      DB.query
+        db
+        [sql|
+          SELECT c.local_display_name, r.probe
+          FROM contacts c
+          JOIN received_probes r ON r.contact_id = c.contact_id
+          WHERE c.user_id = ? AND r.probe_hash = ? AND r.probe IS NOT NULL
+        |]
+        (userId, probeHash)
+    DB.execute db "INSERT INTO received_probes (contact_id, probe_hash, user_id) VALUES (?,?,?)" (contactId, probeHash, userId)
+    case namesAndProbes of
+      [] -> pure Nothing
+      (cName, probe) : _ ->
+        either (const Nothing) (Just . (,probe))
+          <$> runExceptT (getContact_ db userId cName)
+
+matchSentProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe Contact)
+matchSentProbe st userId _from@Contact {contactId} probe =
+  liftIO . withTransaction st $ \db -> do
+    contactNames <-
+      map fromOnly
+        <$> DB.query
+          db
+          [sql|
+            SELECT c.local_display_name
+            FROM contacts c
+            JOIN sent_probes s ON s.contact_id = c.contact_id
+            JOIN sent_probe_hashes h ON h.sent_probe_id = s.sent_probe_id
+            WHERE c.user_id = ? AND s.probe = ? AND h.contact_id = ?
+          |]
+          (userId, probe, contactId)
+    case contactNames of
+      [] -> pure Nothing
+      cName : _ ->
+        either (const Nothing) Just
+          <$> runExceptT (getContact_ db userId cName)
+
+mergeContactRecords :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Contact -> m ()
+mergeContactRecords st userId Contact {contactId = toContactId} Contact {contactId = fromContactId, localDisplayName} =
+  liftIO . withTransaction st $ \db -> do
+    DB.execute db "UPDATE connections SET contact_id = ? WHERE contact_id = ? AND user_id = ?" (toContactId, fromContactId, userId)
+    DB.execute db "UPDATE connections SET via_contact = ? WHERE via_contact = ? AND user_id = ?" (toContactId, fromContactId, userId)
+    DB.execute db "UPDATE group_members SET invited_by = ? WHERE invited_by = ? AND user_id = ?" (toContactId, fromContactId, userId)
+    DB.execute db "UPDATE messages SET contact_id = ? WHERE contact_id = ?" (toContactId, fromContactId)
+    DB.executeNamed
+      db
+      [sql|
+        UPDATE group_members
+        SET contact_id = :to_contact_id,
+            local_display_name = (SELECT local_display_name FROM contacts WHERE contact_id = :to_contact_id),
+            contact_profile_id = (SELECT contact_profile_id FROM contacts WHERE contact_id = :to_contact_id)
+        WHERE contact_id = :from_contact_id
+          AND user_id = :user_id
+      |]
+      [ ":to_contact_id" := toContactId,
+        ":from_contact_id" := fromContactId,
+        ":user_id" := userId
+      ]
+    DB.execute db "DELETE FROM contacts WHERE contact_id = ? AND user_id = ?" (fromContactId, userId)
+    DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
+
 getConnectionChatDirection :: StoreMonad m => SQLiteStore -> User -> ConnId -> m (ChatDirection 'Agent)
 getConnectionChatDirection st User {userId, userContactId} agentConnId =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
@@ -377,7 +506,7 @@ createNewGroup st gVar user groupProfile =
     profileId <- insertedRowId db
     DB.execute db "INSERT INTO groups (local_display_name, user_id, group_profile_id) VALUES (?, ?, ?)" (displayName, uId, profileId)
     groupId <- insertedRowId db
-    memberId <- randomId gVar 12
+    memberId <- randomBytes gVar 12
     membership <- createContactMember_ db user groupId user (memberId, GROwner) GCUserMember GSMemCreator IBUser
     pure $ Right Group {groupId, localDisplayName = displayName, groupProfile, members = [], membership}
 
@@ -865,20 +994,23 @@ withLocalDisplayName db userId displayName action = getLdnSuffix >>= (`tryCreate
             (ldn, displayName, ldnSuffix, userId)
 
 createWithRandomId :: forall a. TVar ChaChaDRG -> (ByteString -> IO a) -> IO (Either StoreError a)
-createWithRandomId gVar create = tryCreate 3
+createWithRandomId = createWithRandomBytes 12
+
+createWithRandomBytes :: forall a. Int -> TVar ChaChaDRG -> (ByteString -> IO a) -> IO (Either StoreError a)
+createWithRandomBytes size gVar create = tryCreate 3
   where
     tryCreate :: Int -> IO (Either StoreError a)
     tryCreate 0 = pure $ Left SEUniqueID
     tryCreate n = do
-      id' <- randomId gVar 12
+      id' <- randomBytes gVar size
       E.try (create id') >>= \case
         Right x -> pure $ Right x
         Left e
           | DB.sqlError e == DB.ErrorConstraint -> tryCreate (n - 1)
           | otherwise -> pure . Left . SEInternal $ bshow e
 
-randomId :: TVar ChaChaDRG -> Int -> IO ByteString
+randomBytes :: TVar ChaChaDRG -> Int -> IO ByteString
-randomId gVar n = B64.encode <$> (atomically . stateTVar gVar $ randomBytesGenerate n)
+randomBytes gVar n = B64.encode <$> (atomically . stateTVar gVar $ randomBytesGenerate n)
 
 data StoreError
   = SEDuplicateName

src/Simplex/Chat/View.hs

@@ -27,6 +27,8 @@ module Simplex.Chat.View
     showUserJoinedGroup,
     showJoinedGroupMemberConnecting,
     showConnectedToGroupMember,
+    showGroupMembers,
+    showContactsMerged,
     safeDecodeUtf8,
   )
 where
@@ -118,6 +120,12 @@ showJoinedGroupMemberConnecting = printToView .:. joinedGroupMemberConnecting
 showConnectedToGroupMember :: ChatReader m => GroupName -> GroupMember -> m ()
 showConnectedToGroupMember = printToView .: connectedToGroupMember
 
+showGroupMembers :: ChatReader m => Group -> m ()
+showGroupMembers = printToView . groupMembers
+
+showContactsMerged :: ChatReader m => Contact -> Contact -> m ()
+showContactsMerged = printToView .: contactsMerged
+
 invitation :: SMPQueueInfo -> [StyledString]
 invitation qInfo =
   [ "pass this invitation to your contact (via another channel): ",
@@ -181,6 +189,32 @@ connectedMember m = case memberCategory m of
   GCPostMember -> "new member " <> ttyMember m -- without fullName as as it was shown in joinedGroupMemberConnecting
   _ -> "member " <> ttyMember m -- these case is not used
 
+groupMembers :: Group -> [StyledString]
+groupMembers Group {membership, members} = map groupMember . filter (not . removedOrLeft) $ membership : members
+  where
+    removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
+    groupMember m = ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
+    role = plain . serializeMemberRole . memberRole
+    category m = case memberCategory m of
+      GCUserMember -> "you, "
+      GCInviteeMember -> "invited, "
+      GCHostMember -> "host, "
+      _ -> ""
+    status m = case memberStatus m of
+      GSMemRemoved -> "removed"
+      GSMemLeft -> "left"
+      GSMemInvited -> "not yet joined"
+      GSMemConnected -> "connected"
+      GSMemComplete -> "connected"
+      GSMemCreator -> "created group"
+      _ -> ""
+
+contactsMerged :: Contact -> Contact -> [StyledString]
+contactsMerged _to@Contact {localDisplayName = c1} _from@Contact {localDisplayName = c2} =
+  [ "contact " <> ttyContact c2 <> " is merged into " <> ttyContact c1,
+    "use " <> ttyToContact c1 <> highlight' "<message>" <> " to send messages"
+  ]
+
 receivedMessage :: StyledString -> UTCTime -> Text -> MsgIntegrity -> IO [StyledString]
 receivedMessage from utcTime msg mOk = do
   t <- formatUTCTime <$> getCurrentTimeZone <*> getZonedTime

tests/ChatTests.hs

@@ -155,10 +155,15 @@ testGroup2 =
         [ bob <## "#club: dan joined the group",
           do
             dan <## "#club: you joined the group"
-            dan <### ["#club: member alice_1 (Alice) is connected", "#club: member cath (Catherine) is connected"],
+            dan
+              <### [ "#club: member alice_1 (Alice) is connected",
+                     "#club: member cath (Catherine) is connected",
+                     "use @alice <message> to send messages"
+                   ],
           do
             alice <## "#club: bob added dan_1 (Daniel) to the group (connecting...)"
-            alice <## "#club: new member dan_1 is connected",
+            alice <## "#club: new member dan_1 is connected"
+            alice <## "use @dan <message> to send messages",
           do
             cath <## "#club: bob added dan (Daniel) to the group (connecting...)"
             cath <## "#club: new member dan is connected"
@@ -167,7 +172,7 @@ testGroup2 =
       concurrentlyN_
         [ bob <# "#club alice> hello",
           cath <# "#club alice> hello",
-          dan <# "#club alice_1> hello"
+          dan <# "#club alice> hello"
         ]
       bob #> "#club hi there"
       concurrentlyN_
@@ -183,7 +188,7 @@ testGroup2 =
         ]
       dan #> "#club how is it going?"
       concurrentlyN_
-        [ alice <# "#club dan_1> how is it going?",
+        [ alice <# "#club dan> how is it going?",
           bob <# "#club dan> how is it going?",
           cath <# "#club dan> how is it going?"
         ]
@@ -195,10 +200,10 @@ testGroup2 =
       cath <# "dan> hey cath"
       cath #> "@dan hey dan"
       dan <# "cath> hey dan"
-      dan #> "@alice_1 hi alice"
+      dan #> "@alice hi alice"
-      alice <# "dan_1> hi alice"
+      alice <# "dan> hi alice"
-      alice #> "@dan_1 hello dan"
+      alice #> "@dan hello dan"
-      dan <# "alice_1> hello dan"
+      dan <# "alice> hello dan"
 
 connectUsers :: TestCC -> TestCC -> IO ()
 connectUsers cc1 cc2 = do