IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

merge profiles using contact probe (#86)

Browse Source 
* 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"
This commit is contained in:
Evgeny Poberezkin 2021-07-27 08:08:05 +01:00 committed by GitHub
parent cc4cb78209
commit b3af93e0ad
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 279 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
migrations/20210612_initial.sql
View File

@ -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,

65
src/Simplex/Chat.hs
View File

@ -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 /= '@'

20
src/Simplex/Chat/Protocol.hs
View File

@ -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

142
src/Simplex/Chat/Store.hs
View File

@ -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

34
src/Simplex/Chat/View.hs
View File

@ -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

21
tests/ChatTests.hs
View File

@ -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"
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