mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-07-03 13:21:51 +00:00
75 lines
3.1 KiB
Haskell
75 lines
3.1 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PostfixOperators #-}
|
|
|
|
module ChatTests.Names where
|
|
|
|
import ChatClient
|
|
import ChatTests.DBUtils
|
|
import ChatTests.Utils
|
|
import Control.Concurrent.Async (concurrently_)
|
|
import qualified Data.Text as T
|
|
import NameResolver
|
|
import Simplex.Messaging.SimplexName (SimplexNameDomain (..), 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 unregistered name fails to resolve" testConnectByNameNotFound
|
|
it "set name not resolving to own address is rejected" testSetNameNotOwnAddress
|
|
|
|
testConnectByName :: HasCallStack => TestParams -> IO ()
|
|
testConnectByName ps = withSmpServerAndNames $ \reg ->
|
|
testChat2 aliceProfile bobProfile (test reg) ps
|
|
where
|
|
aliceName = SimplexNameInfo NTContact (SimplexNameDomain TLDSimplex "alice" [])
|
|
test reg alice bob = do
|
|
alice ##> "/ad"
|
|
(shortLink, _) <- getContactLinks alice True
|
|
registerName reg aliceName (contactNameRecord "alice" (T.pack shortLink))
|
|
alice ##> "/_set_name 1 @alice.simplex"
|
|
alice <## "new contact address set"
|
|
bob ##> "/c @alice.simplex"
|
|
alice <#? bob
|
|
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
|
|
|
|
testConnectByNameNotClaimed :: HasCallStack => TestParams -> IO ()
|
|
testConnectByNameNotClaimed ps = withSmpServerAndNames $ \reg ->
|
|
testChat2 aliceProfile bobProfile (test reg) ps
|
|
where
|
|
aliceName = SimplexNameInfo NTContact (SimplexNameDomain 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"
|
|
|
|
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 (SimplexNameDomain 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_name 1 @alice.simplex"
|
|
alice <## "bad chat command: name does not point to your address"
|