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

group commands (remove member, leave group, delete group) (#87)

Browse Source 
* remove group member

* leave group, fix remove member, tests for leave group/remove member

* delete group with test

* prevent contact deletion error when it is a group member

* support inviting the group member who left or was removed

* use small retry interval in the tests

* test multiline outputs
This commit is contained in:
Evgeny Poberezkin authored and GitHub committed 2021-08-02 20:10:24 +01:00
1 parent b7c4a6e195
commit b798342c61
14 files changed
+537 -138
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

tests/ChatClient.hs
+12 -1
View File
@@ -14,6 +14,7 @@ import Simplex.Chat.Controller (ChatController (..))
import Simplex.Chat.Options
import Simplex.Chat.Store
import Simplex.Chat.Types (Profile)
import Simplex.Messaging.Agent.Env.SQLite
import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
import qualified System.Terminal as C
import System.Terminal.Internal (VirtualTerminal, VirtualTerminalSettings (..), withVirtualTerminal)
@@ -39,12 +40,22 @@ termSettings =
data TestCC = TestCC ChatController VirtualTerminal (Async ())
aCfg :: AgentConfig
aCfg = agentConfig defaultChatConfig
cfg :: ChatConfig
cfg =
defaultChatConfig
{ agentConfig =
aCfg {retryInterval = (retryInterval aCfg) {initialInterval = 50000}}
}
virtualSimplexChat :: FilePath -> Profile -> IO TestCC
virtualSimplexChat dbFile profile = do
st <- createStore (dbFile <> ".chat.db") 1
void . runExceptT $ createUser st profile True
t <- withVirtualTerminal termSettings pure
cc <- newChatController opts {dbFile} t . const $ pure () -- no notifications
cc <- newChatController cfg opts {dbFile} t . const $ pure () -- no notifications
a <- async $ runSimplexChat cc
pure (TestCC cc t a)
tests/ChatTests.hs
+216 -52
View File
@@ -1,5 +1,6 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PostfixOperators #-}
module ChatTests where
@@ -7,11 +8,12 @@ import ChatClient
import Control.Concurrent.Async (concurrently_)
import Control.Concurrent.STM
import Data.Char (isDigit)
import Data.List (dropWhileEnd, isPrefixOf)
import Data.List (dropWhileEnd, intercalate, isPrefixOf)
import qualified Data.Text as T
import Simplex.Chat.Controller
import Simplex.Chat.Types (Profile (..), User (..))
import System.Terminal.Internal (VirtualTerminal (..))
import System.Timeout (timeout)
import Test.Hspec
aliceProfile :: Profile
@@ -33,35 +35,37 @@ chatTests = do
describe "chat groups" $ do
it "add contacts, create group and send/receive messages" testGroup
it "create and join group with 4 members" testGroup2
it "create and delete group" testGroupDelete
fit "remove contact from group and add again" testGroupRemoveAdd
testAddContact :: IO ()
testAddContact =
testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/a"
alice ##> "/c"
Just inv <- invitation <$> getWindow alice
bob ##> ("/c " <> inv)
concurrently_
(bob <## "alice (Alice) is connected")
(alice <## "bob (Bob) is connected")
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
alice #> "@bob hello"
bob <# "alice> hello"
bob #> "@alice hi"
alice <# "bob> hi"
-- test adding the same contact one more time - local name will be different
alice ##> "/a"
alice ##> "/c"
Just inv' <- invitation <$> getWindow alice
bob ##> ("/c " <> inv')
concurrently_
(bob <## "alice_1 (Alice) is connected")
(alice <## "bob_1 (Bob) is connected")
(bob <## "alice_1 (Alice): contact is connected")
(alice <## "bob_1 (Bob): contact is connected")
alice #> "@bob_1 hello"
bob <# "alice_1> hello"
bob #> "@alice_1 hi"
alice <# "bob_1> hi"
-- test deleting contact
alice ##> "/d bob_1"
alice <## "bob_1 is deleted"
alice <## "bob_1: contact is deleted"
alice #:> "@bob_1 hey"
alice <## "no contact bob_1"
@@ -73,11 +77,11 @@ testGroup =
connectUsers alice cath
alice #:> "/g team"
-- TODO this occasionally fails in case getWindow is run before the command above is printed
alice <## "use /a team <name> to add members"
alice <## "group #team is created\nuse /a team <name> to add members"
alice ##> "/a team bob"
concurrently_
(alice <## "invitation to join the group #team sent to bob")
(bob <## "use /j team to accept")
(bob <## "#team: alice invites you to join the group as admin\nuse /j team to accept")
bob ##> "/j team"
concurrently_
(alice <## "#team: bob joined the group")
@@ -85,7 +89,7 @@ testGroup =
alice ##> "/a team cath"
concurrently_
(alice <## "invitation to join the group #team sent to cath")
(cath <## "use /j team to accept")
(cath <## "#team: alice invites you to join the group as admin\nuse /j team to accept")
cath ##> "/j team"
concurrentlyN_
[ alice <## "#team: cath joined the group",
@@ -108,10 +112,25 @@ testGroup =
concurrently_
(alice <# "#team cath> hey")
(bob <# "#team cath> hey")
bob #> "@cath hello cath"
cath <# "bob> hello cath"
cath #> "@bob hello bob"
bob <# "cath> hello bob"
bob <##> cath
-- remove member
bob ##> "/rm team cath"
concurrentlyN_
[ bob <## "#team: you removed cath from the group",
alice <## "#team: bob removed cath from the group",
cath <## "#team: bob removed you from the group\nuse /d #team to delete the group"
]
bob #> "#team hi"
concurrently_
(alice <# "#team bob> hi")
(cath </)
alice #> "#team hello"
concurrently_
(bob <# "#team alice> hello")
(cath </)
cath #:> "#team hello"
cath <## "you are no longer the member of the group"
bob <##> cath
testGroup2 :: IO ()
testGroup2 =
@@ -123,15 +142,15 @@ testGroup2 =
connectUsers alice dan
alice #:> "/g club"
-- TODO this occasionally fails in case getWindow is run before the command above is printed
alice <## "use /a club <name> to add members"
alice <## "group #club is created\nuse /a club <name> to add members"
alice ##> "/a club bob"
concurrently_
(alice <## "invitation to join the group #club sent to bob")
(bob <## "use /j club to accept")
(bob <## "#club: alice invites you to join the group as admin\nuse /j club to accept")
alice ##> "/a club cath"
concurrently_
(alice <## "invitation to join the group #club sent to cath")
(cath <## "use /j club to accept")
(cath <## "#club: alice invites you to join the group as admin\nuse /j club to accept")
bob ##> "/j club"
concurrently_
(alice <## "#club: bob joined the group")
@@ -149,21 +168,18 @@ testGroup2 =
bob ##> "/a club dan"
concurrently_
(bob <## "invitation to join the group #club sent to dan")
(dan <## "use /j club to accept")
(dan <## "#club: bob invites you to join the group as admin\nuse /j club to accept")
dan ##> "/j club"
concurrentlyN_
[ 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",
"use @alice <message> to send messages"
],
dan <### ["#club: member alice_1 (Alice) is connected", "#club: member cath (Catherine) is connected"]
dan <## "contact alice_1 is merged into alice\nuse @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 <## "use @dan <message> to send messages",
alice <## "contact dan_1 is merged into dan\nuse @dan <message> to send messages",
do
cath <## "#club: bob added dan (Daniel) to the group (connecting...)"
cath <## "#club: new member dan is connected"
@@ -192,58 +208,203 @@ testGroup2 =
bob <# "#club dan> how is it going?",
cath <# "#club dan> how is it going?"
]
bob #> "@cath hi cath"
cath <# "bob> hi cath"
cath #> "@bob hi bob"
bob <# "cath> hi bob"
dan #> "@cath hey cath"
cath <# "dan> hey cath"
cath #> "@dan hey dan"
dan <# "cath> hey dan"
dan #> "@alice hi alice"
alice <# "dan> hi alice"
alice #> "@dan hello dan"
dan <# "alice> hello dan"
bob <##> cath
dan <##> cath
dan <##> alice
-- remove member
cath ##> "/rm club dan"
concurrentlyN_
[ cath <## "#club: you removed dan from the group",
alice <## "#club: cath removed dan from the group",
bob <## "#club: cath removed dan from the group",
dan <## "#club: cath removed you from the group\nuse /d #club to delete the group"
]
alice #> "#club hello"
concurrentlyN_
[ bob <# "#club alice> hello",
cath <# "#club alice> hello",
(dan </)
]
bob #> "#club hi there"
concurrentlyN_
[ alice <# "#club bob> hi there",
cath <# "#club bob> hi there",
(dan </)
]
cath #> "#club hey"
concurrentlyN_
[ alice <# "#club cath> hey",
bob <# "#club cath> hey",
(dan </)
]
dan #:> "#club how is it going?"
dan <## "you are no longer the member of the group"
dan <##> cath
dan <##> alice
-- member leaves
bob ##> "/l club"
concurrentlyN_
[ bob <## "#club: you left the group\nuse /d #club to delete the group",
alice <## "#club: bob left the group",
cath <## "#club: bob left the group"
]
alice #> "#club hello"
concurrently_
(cath <# "#club alice> hello")
(bob </)
cath #> "#club hey"
concurrently_
(alice <# "#club cath> hey")
(bob </)
bob #:> "#club how is it going?"
bob <## "you are no longer the member of the group"
bob <##> cath
bob <##> alice
testGroupDelete :: IO ()
testGroupDelete =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
alice ##> "/d #team"
concurrentlyN_
[ alice <## "#team: you deleted the group",
bob <## "#team: alice deleted the group\nuse /d #team to delete the local copy of the group",
cath <## "#team: alice deleted the group\nuse /d #team to delete the local copy of the group"
]
bob #:> "/d #team"
bob <## "#team: you deleted the group"
cath #:> "#team hi"
cath <## "you are no longer the member of the group"
testGroupRemoveAdd :: IO ()
testGroupRemoveAdd =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
-- remove member
alice ##> "/rm team bob"
concurrentlyN_
[ alice <## "#team: you removed bob from the group",
bob <## "#team: alice removed you from the group\nuse /d #team to delete the group",
cath <## "#team: alice removed bob from the group"
]
alice ##> "/a team bob"
bob <## "#team_1 (team): alice invites you to join the group as admin\nuse /j team_1 to accept"
bob ##> "/j team_1"
concurrentlyN_
[ alice <## "#team: bob joined the group",
do
bob <## "#team_1: you joined the group"
bob <## "#team_1: member cath_1 (Catherine) is connected"
bob <## "contact cath_1 is merged into cath\nuse @cath <message> to send messages",
do
cath <## "#team: alice added bob_1 (Bob) to the group (connecting...)"
cath <## "#team: new member bob_1 is connected"
cath <## "contact bob_1 is merged into bob\nuse @bob <message> to send messages"
]
alice #> "#team hi"
concurrently_
(bob <# "#team_1 alice> hi")
(cath <# "#team alice> hi")
bob #> "#team_1 hey"
concurrently_
(alice <# "#team bob> hey")
(cath <# "#team bob> hey")
cath #> "#team hello"
concurrently_
(alice <# "#team cath> hello")
(bob <# "#team_1 cath> hello")
connectUsers :: TestCC -> TestCC -> IO ()
connectUsers cc1 cc2 = do
cc1 ##> "/a"
cc1 ##> "/c"
Just inv <- invitation <$> getWindow cc1
cc2 ##> ("/c " <> inv)
concurrently_
(cc2 <## (showName cc1 <> " is connected"))
(cc1 <## (showName cc2 <> " is connected"))
(cc2 <## (showName cc1 <> ": contact is connected"))
(cc1 <## (showName cc2 <> ": contact is connected"))
showName :: TestCC -> String
showName (TestCC ChatController {currentUser = User {localDisplayName, profile = Profile {fullName}}} _ _) =
T.unpack $ localDisplayName <> " (" <> fullName <> ")"
createGroup3 :: String -> TestCC -> TestCC -> TestCC -> IO ()
createGroup3 gName cc1 cc2 cc3 = do
connectUsers cc1 cc2
connectUsers cc1 cc3
cc1 #:> ("/g " <> gName)
cc1 <## ("use /a " <> gName <> " <name> to add members")
cc1 ##> ("/a team " <> name cc2)
concurrently_
(cc1 <## ("invitation to join the group #" <> gName <> " sent to " <> name cc2))
(cc2 <## ("use /j " <> gName <> " to accept"))
cc2 ##> ("/j " <> gName)
concurrently_
(cc1 <## ("#" <> gName <> ": " <> name cc2 <> " joined the group"))
(cc2 <## ("#" <> gName <> ": you joined the group"))
cc1 ##> ("/a team " <> name cc3)
concurrently_
(cc1 <## ("invitation to join the group #" <> gName <> " sent to " <> name cc3))
(cc3 <## ("use /j " <> gName <> " to accept"))
cc3 ##> ("/j " <> gName)
concurrentlyN_
[ cc1 <## ("#" <> gName <> ": " <> name cc3 <> " joined the group"),
do
cc3 <## ("#" <> gName <> ": you joined the group")
cc3 <## ("#" <> gName <> ": member " <> showName cc2 <> " is connected"),
do
cc2 <## ("#" <> gName <> ": alice added " <> showName cc3 <> " to the group (connecting...)")
cc2 <## ("#" <> gName <> ": new member " <> name cc3 <> " is connected")
]
where
showName :: TestCC -> String
showName (TestCC ChatController {currentUser = User {localDisplayName, profile = Profile {fullName}}} _ _) =
T.unpack $ localDisplayName <> " (" <> fullName <> ")"
name :: TestCC -> String
name (TestCC ChatController {currentUser = User {localDisplayName}} _ _) =
T.unpack localDisplayName
-- | test sending direct messages
(<##>) :: TestCC -> TestCC -> IO ()
cc1 <##> cc2 = do
cc1 #> ("@" <> name cc2 <> " hi")
cc2 <# (name cc1 <> "> hi")
cc2 #> ("@" <> name cc1 <> " hey")
cc1 <# (name cc2 <> "> hey")
where
name (TestCC ChatController {currentUser = User {localDisplayName}} _ _) = T.unpack localDisplayName
(##>) :: TestCC -> String -> IO ()
(##>) cc cmd = do
cc ##> cmd = do
cc #:> cmd
cc <## cmd
(#>) :: TestCC -> String -> IO ()
(#>) cc cmd = do
cc #> cmd = do
cc #:> cmd
cc <# cmd
(#:>) :: TestCC -> String -> IO ()
(#:>) (TestCC cc _ _) cmd = atomically $ writeTBQueue (inputQ cc) $ InputCommand cmd
(TestCC cc _ _) #:> cmd = atomically $ writeTBQueue (inputQ cc) $ InputCommand cmd
(<##) :: TestCC -> String -> Expectation
cc <## line = (lastOutput <$> getWindow cc) `shouldReturn` line
cc <## line =
let n = length $ lines line
in (lastOutput n <$> getWindow cc) `shouldReturn` line
(<###) :: TestCC -> [String] -> Expectation
_ <### [] = pure ()
cc <### ls = do
line <- lastOutput <$> getWindow cc
line <- lastOutput 1 <$> getWindow cc
if line `elem` ls
then cc <### filter (/= line) ls
else error $ "unexpected output: " <> line
(<#) :: TestCC -> String -> Expectation
cc <# line = (dropTime . lastOutput <$> getWindow cc) `shouldReturn` line
cc <# line =
let n = length $ lines line
in (dropTime . lastOutput n <$> getWindow cc) `shouldReturn` line
(</) :: TestCC -> Expectation
(</) cc = timeout 500000 (getWindow cc) `shouldReturn` Nothing
dropTime :: String -> String
dropTime msg = case splitAt 6 msg of
@@ -255,15 +416,18 @@ getWindow :: TestCC -> IO [String]
getWindow (TestCC _ t _) = do
let w = virtualWindow t
win <- readTVarIO w
atomically $ do
-- TODO to debug - putStrLn (lastOutput 1 win') - before returning it
r <- atomically $ do
win' <- readTVar w
if win' /= win then pure win' else retry
putStrLn $ lastOutput 1 r
pure r
invitation :: [String] -> Maybe String
invitation win = lastMaybe $ map (dropWhileEnd (== ' ')) $ filter ("smp::" `isPrefixOf`) win
lastOutput :: [String] -> String
lastOutput win = dropWhileEnd (== ' ') $ win !! (length win - 2) -- (- 2) to exclude prompt
lastOutput :: Int -> [String] -> String
lastOutput n win = intercalate "\n" $ map (dropWhileEnd (== ' ')) $ take n $ drop (length win - n - 1) win -- - 1 to exclude prompt
lastMaybe :: [a] -> Maybe a
lastMaybe [] = Nothing