mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-03-30 20:45:49 +00:00
d21abbdec1
* chat test with VirtualTerminal * disable chat test * fix intermittently failing test * simplify test
57 lines
1.6 KiB
Haskell
57 lines
1.6 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedLists #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module ChatClient where
|
|
|
|
import Control.Concurrent.Async
|
|
import Control.Concurrent.STM (retry)
|
|
import Control.Monad.Except
|
|
import Simplex.Chat
|
|
import Simplex.Chat.Controller (ChatController (..))
|
|
import Simplex.Chat.Options
|
|
import Simplex.Chat.Store
|
|
import Simplex.Chat.Types (Profile)
|
|
import qualified System.Terminal as C
|
|
import System.Terminal.Internal (VirtualTerminal, VirtualTerminalSettings (..), withVirtualTerminal)
|
|
|
|
testDB1 :: FilePath
|
|
testDB1 = "tests/tmp/test1"
|
|
|
|
testDB2 :: FilePath
|
|
testDB2 = "tests/tmp/test2"
|
|
|
|
opts :: ChatOpts
|
|
opts =
|
|
ChatOpts
|
|
{ dbFile = undefined,
|
|
smpServers = ["localhost:5223"]
|
|
}
|
|
|
|
termSettings :: VirtualTerminalSettings
|
|
termSettings =
|
|
VirtualTerminalSettings
|
|
{ virtualType = "xterm",
|
|
virtualWindowSize = pure C.Size {height = 24, width = 1000},
|
|
virtualEvent = retry,
|
|
virtualInterrupt = retry
|
|
}
|
|
|
|
data TestCC = TestCC ChatController VirtualTerminal (Async ())
|
|
|
|
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
|
|
a <- async $ runSimplexChat cc
|
|
pure (TestCC cc t a)
|
|
|
|
testChat2 :: Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO ()
|
|
testChat2 p1 p2 test = do
|
|
tc1 <- virtualSimplexChat testDB1 p1
|
|
tc2 <- virtualSimplexChat testDB2 p2
|
|
test tc1 tc2
|