diff --git a/migrations/20210612_initial.sql b/migrations/20210612_initial.sql index ed10094cbe..a04e7db707 100644 --- a/migrations/20210612_initial.sql +++ b/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, diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index f954a02829..d84e06de2e 100644 --- a/src/Simplex/Chat.hs +++ b/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,7 +352,8 @@ 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 - updateGroupMemberStatus st userId (groupMemberId membership) GSMemConnected + unless (memberActive membership) $ + updateGroupMemberStatus st userId (groupMemberId membership) GSMemConnected -- TODO forward any pending (GMIntroInvReceived) introductions case memberCategory m of GCHostMember -> do @@ -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 /= '@' diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 7ab92a3d74..35d8805107 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -56,8 +56,8 @@ data ChatMsgEvent | XGrpMemCon MemberId | XGrpMemConAll MemberId | XInfoProbe ByteString - | XInfoProbeCheck MemberId ByteString - | XInfoProbeOk MemberId ByteString + | XInfoProbeCheck 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 - chatMsg =<< (XInfoProbeCheck <$> B64.decode memId <*> B64.decode probeHash) - ("x.info.probe.ok", [memId, probe]) -> do - chatMsg =<< (XInfoProbeOk <$> B64.decode memId <*> B64.decode probe) + ("x.info.probe.check", [probeHash]) -> do + chatMsg =<< (XInfoProbeCheck <$> B64.decode probeHash) + ("x.info.probe.ok", [probe]) -> do + 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 -> - rawMsg "x.info.probe.check" [B64.encode memId, B64.encode probeHash] [] - XInfoProbeOk memId probe -> - rawMsg "x.info.probe.ok" [B64.encode memId, B64.encode probe] [] + XInfoProbeCheck probeHash -> + rawMsg "x.info.probe.check" [B64.encode probeHash] [] + XInfoProbeOk probe -> + rawMsg "x.info.probe.ok" [B64.encode probe] [] XOk -> rawMsg "x.ok" [] [] where diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index fd576c0f30..041ac06460 100644 --- a/src/Simplex/Chat/Store.hs +++ b/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 -randomId gVar n = B64.encode <$> (atomically . stateTVar gVar $ randomBytesGenerate n) +randomBytes :: TVar ChaChaDRG -> Int -> IO ByteString +randomBytes gVar n = B64.encode <$> (atomically . stateTVar gVar $ randomBytesGenerate n) data StoreError = SEDuplicateName diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index a2c1a497ff..77322b8850 100644 --- a/src/Simplex/Chat/View.hs +++ b/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' "" <> " to send messages" + ] + receivedMessage :: StyledString -> UTCTime -> Text -> MsgIntegrity -> IO [StyledString] receivedMessage from utcTime msg mOk = do t <- formatUTCTime <$> getCurrentTimeZone <*> getZonedTime diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 70d360b784..dce2c3f666 100644 --- a/tests/ChatTests.hs +++ b/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 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 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" - alice <# "dan_1> hi alice" - alice #> "@dan_1 hello dan" - dan <# "alice_1> hello dan" + dan #> "@alice hi alice" + alice <# "dan> hi alice" + alice #> "@dan hello dan" + dan <# "alice> hello dan" connectUsers :: TestCC -> TestCC -> IO () connectUsers cc1 cc2 = do