SimpleX-Chat/tests/ChatClient.hs

{-# 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 System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
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
  createDirectoryIfMissing False "tests/tmp"
  tc1 <- virtualSimplexChat testDB1 p1
  tc2 <- virtualSimplexChat testDB2 p2
  test tc1 tc2
  removeDirectoryRecursive "tests/tmp"