mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-07-12 09:38:58 +00:00
Evgeny @ SimpleX Chat
249 lines
13 KiB
Haskell
249 lines
13 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PostfixOperators #-}
|
|
|
|
module ChatTests.Names where
|
|
|
|
import ChatClient
|
|
import ChatTests.DBUtils
|
|
import ChatTests.Groups (prepareChannel1Relay)
|
|
import ChatTests.Utils
|
|
import Control.Concurrent.Async (concurrently_)
|
|
import qualified Data.Text as T
|
|
import NameResolver
|
|
import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexNameInfo (..), SimplexNameType (..), SimplexTLD (..))
|
|
import Test.Hspec hiding (it)
|
|
|
|
chatNamesTests :: SpecWith TestParams
|
|
chatNamesTests = do
|
|
it "connect by resolved name" testConnectByName
|
|
it "connect by name not claimed in link profile is rejected" testConnectByNameNotClaimed
|
|
it "connect by name to a known contact not claimed in profile is rejected" testConnectByNameKnownContactNotClaimed
|
|
it "connect by unregistered name fails to resolve" testConnectByNameNotFound
|
|
it "set name not resolving to own address is rejected" testSetNameNotOwnAddress
|
|
it "connect by channel name" testConnectByChannelName
|
|
it "connect by name resolving to channel (primary) and direct contact" testConnectByNameChannelAndContact
|
|
it "connect by name resolving to direct contact (primary) and channel" testConnectByNameContactAndChannel
|
|
it "connect by name resolving to business (primary) and channel" testConnectByNameBusinessAndChannel
|
|
|
|
testConnectByName :: HasCallStack => TestParams -> IO ()
|
|
testConnectByName ps = withSmpServerAndNames $ \reg ->
|
|
testChat2 aliceProfile bobProfile (test reg) ps
|
|
where
|
|
aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" [])
|
|
test reg alice bob = do
|
|
alice ##> "/ad"
|
|
(shortLink, _) <- getContactLinks alice True
|
|
registerName reg aliceName (contactNameRecord "alice" (T.pack shortLink))
|
|
alice ##> "/_set domain 1 alice.simplex"
|
|
alice <## "new contact address set"
|
|
bob ##> "/c @alice.simplex"
|
|
bob <## "alice: connection started"
|
|
alice <## "bob (Bob) wants to connect to you!"
|
|
alice <## "to accept: /ac bob"
|
|
alice <## "to reject: /rc bob (the sender will NOT be notified)"
|
|
alice ##> "/ac bob"
|
|
alice <## "bob (Bob): accepting contact request, you can send messages to contact"
|
|
concurrently_
|
|
(bob <## "alice (Alice): contact is connected")
|
|
(alice <## "bob (Bob): contact is connected")
|
|
alice <##> bob
|
|
bob ##> "/i alice"
|
|
bob <## "contact ID: 2"
|
|
bob <## "receiving messages via: localhost"
|
|
bob <## "sending messages via: localhost"
|
|
_ <- getTermLine bob
|
|
bob <## "SimpleX name: @alice.simplex (verified)"
|
|
bob <## "you've shared main profile with this contact"
|
|
bob <## "connection not verified, use /code command to see security code"
|
|
bob <## "quantum resistant end-to-end encryption"
|
|
_ <- getTermLine bob
|
|
pure ()
|
|
|
|
testConnectByNameNotClaimed :: HasCallStack => TestParams -> IO ()
|
|
testConnectByNameNotClaimed ps = withSmpServerAndNames $ \reg ->
|
|
testChat2 aliceProfile bobProfile (test reg) ps
|
|
where
|
|
aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" [])
|
|
test reg alice bob = do
|
|
alice ##> "/ad"
|
|
(shortLink, _) <- getContactLinks alice True
|
|
registerName reg aliceName (contactNameRecord "alice" (T.pack shortLink))
|
|
bob ##> "/c @alice.simplex"
|
|
bob <## "SimpleX name alice.simplex is not included in the connection link's profile"
|
|
|
|
testConnectByNameKnownContactNotClaimed :: HasCallStack => TestParams -> IO ()
|
|
testConnectByNameKnownContactNotClaimed ps = withSmpServerAndNames $ \reg ->
|
|
testChat2 aliceProfile bobProfile (test reg) ps
|
|
where
|
|
aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" [])
|
|
test reg alice bob = do
|
|
alice ##> "/ad"
|
|
(shortLink, _) <- getContactLinks alice True
|
|
bob ##> ("/c " <> shortLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob) wants to connect to you!"
|
|
alice <## "to accept: /ac bob"
|
|
alice <## "to reject: /rc bob (the sender will NOT be notified)"
|
|
alice ##> "/ac bob"
|
|
alice <## "bob (Bob): accepting contact request, you can send messages to contact"
|
|
concurrently_
|
|
(bob <## "alice (Alice): contact is connected")
|
|
(alice <## "bob (Bob): contact is connected")
|
|
registerName reg aliceName (contactNameRecord "alice" (T.pack shortLink))
|
|
bob ##> "/c @alice.simplex"
|
|
bob <## "SimpleX name alice.simplex is not included in the connection link's profile"
|
|
|
|
testConnectByNameNotFound :: HasCallStack => TestParams -> IO ()
|
|
testConnectByNameNotFound ps = withSmpServerAndNames $ \_reg ->
|
|
testChat2 aliceProfile bobProfile test ps
|
|
where
|
|
test _alice bob = do
|
|
bob ##> "/c @nobody.simplex"
|
|
bob .<## "smpErr = NAME {nameErr = NOT_FOUND}}"
|
|
|
|
testSetNameNotOwnAddress :: HasCallStack => TestParams -> IO ()
|
|
testSetNameNotOwnAddress ps = withSmpServerAndNames $ \reg ->
|
|
testChat2 aliceProfile bobProfile (test reg) ps
|
|
where
|
|
aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" [])
|
|
test reg alice bob = do
|
|
bob ##> "/ad"
|
|
(bobShortLink, _) <- getContactLinks bob True
|
|
registerName reg aliceName (contactNameRecord "alice" (T.pack bobShortLink))
|
|
alice ##> "/ad"
|
|
_ <- getContactLinks alice True
|
|
alice ##> "/_set domain 1 alice.simplex"
|
|
alice <## "SimpleX name alice.simplex has no valid connection link"
|
|
|
|
testConnectByChannelName :: HasCallStack => TestParams -> IO ()
|
|
testConnectByChannelName ps = withSmpServerAndNames $ \reg ->
|
|
withNewTestChat ps "alice" aliceProfile $ \alice ->
|
|
withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath ->
|
|
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
|
(shortLink, _) <- prepareChannel1Relay "team" alice cath
|
|
registerName reg teamName (channelNameRecord "team" (T.pack shortLink))
|
|
alice ##> "/public group access #team domain=team.simplex"
|
|
alice <## "updated public group access: domain=team.simplex"
|
|
cath <## "alice updated group #team: (signed)"
|
|
cath <## "updated public group access: domain=team.simplex"
|
|
bob ##> "/c #team.simplex"
|
|
bob <## "#team: connection started"
|
|
concurrentlyN_
|
|
[ bob
|
|
<### [ "#team: joining the group (connecting to relay cath)...",
|
|
"#team: you joined the group (connected to relay cath)"
|
|
]
|
|
, do
|
|
cath <## "bob (Bob): accepting request to join group #team..."
|
|
cath <## "#team: bob joined the group"
|
|
, alice <### [EndsWith "introduced bob (Bob) in the channel"]
|
|
]
|
|
bob ##> ("/_connect plan 1 " <> shortLink)
|
|
bob <## "group link: known group #team"
|
|
bob <## "SimpleX name: #team (verified)"
|
|
bob <## "use #team <message> to send messages"
|
|
where
|
|
teamName = SimplexNameInfo NTPublicGroup (SimplexDomain TLDSimplex "team" [])
|
|
|
|
-- The bare name "team.simplex" resolves to both a channel and a direct contact. The channel is tried
|
|
-- first and succeeds (bob has joined #team), so it is the primary (planSimplexName); otherSimplexName
|
|
-- is the direct contact @team.simplex, shown as "You can also connect to @team.simplex in direct chat".
|
|
testConnectByNameChannelAndContact :: HasCallStack => TestParams -> IO ()
|
|
testConnectByNameChannelAndContact ps = withSmpServerAndNames $ \reg ->
|
|
withNewTestChat ps "alice" aliceProfile $ \alice ->
|
|
withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath ->
|
|
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
|
(channelLink, _) <- prepareChannel1Relay "team" alice cath
|
|
alice ##> "/ad"
|
|
(contactLink, _) <- getContactLinks alice True
|
|
registerName reg teamName (contactAndChannelNameRecord "team" (T.pack contactLink) (T.pack channelLink))
|
|
alice ##> "/public group access #team domain=team.simplex"
|
|
alice <## "updated public group access: domain=team.simplex"
|
|
cath <## "alice updated group #team: (signed)"
|
|
cath <## "updated public group access: domain=team.simplex"
|
|
bob ##> "/c #team.simplex"
|
|
bob <## "#team: connection started"
|
|
concurrentlyN_
|
|
[ bob
|
|
<### [ "#team: joining the group (connecting to relay cath)...",
|
|
"#team: you joined the group (connected to relay cath)"
|
|
]
|
|
, do
|
|
cath <## "bob (Bob): accepting request to join group #team..."
|
|
cath <## "#team: bob joined the group"
|
|
, alice <### [EndsWith "introduced bob (Bob) in the channel"]
|
|
]
|
|
bob ##> "/_connect plan 1 team.simplex"
|
|
bob <## "group link: known group #team"
|
|
bob <## "SimpleX name: #team (verified)"
|
|
bob <## "use #team <message> to send messages"
|
|
bob <## "You can also connect to @team.simplex in direct chat"
|
|
where
|
|
teamName = SimplexNameInfo NTPublicGroup (SimplexDomain TLDSimplex "team" [])
|
|
|
|
-- The bare name "acme.simplex" resolves to both a channel and a direct contact. The channel is tried
|
|
-- first but its group profile does not claim the domain, so the channel side of the plan fails; the
|
|
-- plan falls back to the direct contact as primary (planSimplexName) while otherSimplexName is the
|
|
-- channel #acme, shown as "You can also join channel #acme". The channel link is a real, fetchable
|
|
-- #acme channel, so the failure is the faithful "channel does not claim this domain" case, not a broken link.
|
|
testConnectByNameContactAndChannel :: HasCallStack => TestParams -> IO ()
|
|
testConnectByNameContactAndChannel ps = withSmpServerAndNames $ \reg ->
|
|
withNewTestChat ps "alice" aliceProfile $ \alice ->
|
|
withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath ->
|
|
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
|
(channelLink, _) <- prepareChannel1Relay "acme" alice cath
|
|
alice ##> "/ad"
|
|
(contactLink, _) <- getContactLinks alice True
|
|
registerName reg acmeName (contactAndChannelNameRecord "acme" (T.pack contactLink) (T.pack channelLink))
|
|
alice ##> "/_set domain 1 acme.simplex"
|
|
alice <## "new contact address set"
|
|
bob ##> "/_connect plan 1 acme.simplex"
|
|
bob <## "contact address: ok to connect"
|
|
_ <- getTermLine bob -- contact short link data (JSON, printed in test view)
|
|
bob <## "You can also join channel #acme"
|
|
where
|
|
acmeName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "acme" [])
|
|
|
|
testConnectByNameBusinessAndChannel :: HasCallStack => TestParams -> IO ()
|
|
testConnectByNameBusinessAndChannel ps = withSmpServerAndNames $ \reg ->
|
|
withNewTestChat ps "alice" aliceProfile $ \alice ->
|
|
withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath ->
|
|
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
|
(channelLink, _) <- prepareChannel1Relay "biz" alice cath
|
|
alice ##> "/ad"
|
|
(contactLink, fullLink) <- getContactLinks alice True
|
|
registerName reg bizName (contactAndChannelNameRecord "biz" (T.pack contactLink) (T.pack channelLink))
|
|
alice ##> "/auto_accept on business"
|
|
alice <## "auto_accept on, business"
|
|
alice ##> "/_set domain 1 biz.simplex"
|
|
alice <## "new contact address set"
|
|
bob ##> "/_connect plan 1 biz.simplex"
|
|
bob <## "business address: ok to connect"
|
|
contactSLinkData <- getTermLine bob -- contact short link data (JSON, printed in test view)
|
|
bob <## "You can also join channel #biz"
|
|
-- preparing the business by name saves its domain on the group, so it is then found by local name search
|
|
bob ##> ("/_prepare contact 1 " <> fullLink <> " " <> contactLink <> " domain=biz.simplex " <> contactSLinkData)
|
|
bob <## "#alice: group is prepared"
|
|
-- host changes its profile so the handshake's group-profile write fires; it must not wipe the saved domain
|
|
alice ##> "/p alice Alice Biz"
|
|
alice <## "user bio changed to Alice Biz (your 0 contacts are notified)"
|
|
bob ##> "/_connect plan 1 @biz.simplex resolve=never"
|
|
bob <## "business address: known prepared business #alice"
|
|
bob ##> "/_connect group #1"
|
|
bob <## "#alice: connection started"
|
|
alice <## "#bob (Bob): accepting business address request..."
|
|
bob <## "#alice: joining the group..."
|
|
alice <## "#bob: bob_1 joined the group"
|
|
bob <## "#alice: you joined the group"
|
|
-- after fully connecting, the business must still be found by local name search
|
|
bob ##> "/_connect plan 1 @biz.simplex resolve=never"
|
|
bob <## "business address: known business #alice"
|
|
bob <## "use #alice <message> to send messages"
|
|
-- the business's verified domain survives the handshake and is shown in group info
|
|
bob ##> "/i #alice"
|
|
bob <## "group ID: 1"
|
|
bob <## "current members: 2"
|
|
bob <## "SimpleX name: @biz.simplex (verified)"
|
|
where
|
|
bizName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "biz" [])
|