simplex-chat/tests/ChatTests/Utils.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}

module ChatTests.Utils where

import ChatClient
import ChatTests.DBUtils
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_, mapConcurrently_)
import Control.Concurrent.STM
import Control.Monad (join, unless, when)
import Control.Monad.Except (runExceptT)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as B
import Data.Char (isDigit)
import Data.List (isPrefixOf, isSuffixOf)
import Data.Maybe (fromMaybe)
import Data.String
import qualified Data.Text as T
import Simplex.Chat.Badges (BadgeProof (..), BadgeStatus, LocalBadge (..), ProofPresHeader (..))
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), storeCxt)
import Simplex.Chat.Library.Commands (maxProfileImageSize)
import Simplex.Chat.Markdown (viewName)
import Simplex.Chat.Messages.CIContent (e2eInfoNoPQText, e2eInfoPQText)
import Simplex.Chat.Protocol
import Simplex.Chat.Store.Direct (getContact, getContactIdByName, getContactRequest, getContactRequestIdByName)
import Simplex.Chat.Store.Groups (getGroupIdByName, getGroupMember, getGroupMemberIdByName)
import Simplex.Chat.Store.NoteFolders (createNoteFolder)
import Simplex.Chat.Store.Profiles (getUserContactProfiles)
import Simplex.Chat.Store.Shared (getGroupInfo)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme (ChatLayout)
import Simplex.FileTransfer.Description (FileSize (..))
import Simplex.Messaging.Agent.Client (agentClientStore)
import Simplex.Messaging.Agent.Store.AgentStore (maybeFirstRow, withTransaction)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.BBS (BBSPresHeader (..))
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Version
import System.Directory (doesFileExist)
import System.Environment (lookupEnv)
import System.Info (os)
import Test.Hspec hiding (it)
import qualified Test.Hspec as Hspec
import UnliftIO (timeout)
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..))
#else
import Database.SQLite.Simple (Only (..))
#endif

defaultPrefs :: Maybe Preferences
defaultPrefs = Just $ toChatPrefs defaultChatPrefs

aliceDesktopProfile :: Profile
aliceDesktopProfile = mkProfile "alice_desktop" "Alice Desktop" Nothing

aliceProfile :: Profile
aliceProfile = mkProfile "alice" "Alice" Nothing

bobProfile :: Profile
bobProfile = mkProfile "bob" "Bob" $ Just $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAKHGlDQ1BJQ0MgUHJvZmlsZQAASImFVgdUVNcWve9Nb7QZeu9NehtAem/Sq6gMQ28OQxWxgAQjEFFEREARNFQFg1KjiIhiIQgoYA9IEFBisCAq6OQNJNH4//r/zDpz9ttzz7n73ffWmg0A6QCDxYqD+QCIT0hmezlYywQEBsngngEYCAIy0AC6DGYSy8rDwxUg8Xf9d7wbAxC33tHgzvrP3/9nCISFJzEBgIIRTGey2MkILkawT1oyi4tnEUxjI6IQvMLFkauYqxjQQtewwuoaHy8bBNMBwJMZDHYkAERbhJdJZUYic4hhCNZOCItOQDB3vjkzioFwxLsIXhcRl5IOAImrRzs+fivCk7QRrIL0shAcwNUW+tX8yH/tFfrPXgxG5D84Pi6F+dc9ck+HHJ7g641UMSQlQATQBHEgBaQDGcACbLAVYaIRJhx5Dv+9j77aZ4OsZIFtSEc0iARRIBnpt/9qlvfqpGSQBhjImnCEcUU+NtxnujZy4fbqVEiU/wuXdQyA9S0cDqfzC+e2F4DzyLkSB79wyi0A8KoBcL2GmcJOXePQ3C8MIAJeQAOiQArIAxXuWwMMgSmwBHbAGbgDHxAINgMmojceUZUGMkEWyAX54AA4DMpAJTgJ6sAZ0ALawQVwGVwDt8AQGAUPwQSYBi/AAngHliEIwkEUiAqJQtKQIqQO6UJ0yByyg1whLygQCoEioQQoBcqE9kD5UBFUBlVB9dBPUCd0GboBDUP3oUloDnoNfYRRMBmmwZKwEqwF02Er2AX2gTfBkXAinAHnwPvhUrgaPg23wZfhW/AoPAG/gBdRAEVCCaFkURooOsoG5Y4KQkWg2KidqDxUCaoa1YTqQvWj7qAmUPOoD2gsmoqWQWugTdGOaF80E52I3okuQJeh69Bt6D70HfQkegH9GUPBSGDUMSYYJ0wAJhKThsnFlGBqMK2Yq5hRzDTmHRaLFcIqY42wjthAbAx2O7YAewzbjO3BDmOnsIs4HE4Up44zw7njGLhkXC7uKO407hJuBDeNe48n4aXxunh7fBA+AZ+NL8E34LvxI/gZ/DKBj6BIMCG4E8II2wiFhFOELsJtwjRhmchPVCaaEX2IMcQsYimxiXiV+Ij4hkQiyZGMSZ6kaNJuUinpLOk6aZL0gSxAViPbkIPJKeT95FpyD/k++Q2FQlGiWFKCKMmU/ZR6yhXKE8p7HiqPJo8TTxjPLp5ynjaeEZ6XvAReRV4r3s28GbwlvOd4b/PO8xH4lPhs+Bh8O/nK+Tr5xvkW+an8Ovzu/PH8BfwN/Df4ZwVwAkoCdgJhAjkCJwWuCExRUVR5qg2VSd1DPUW9Sp2mYWnKNCdaDC2fdoY2SFsQFBDUF/QTTBcsF7woOCGEElISchKKEyoUahEaE/ooLClsJRwuvE+4SXhEeElEXMRSJFwkT6RZZFTko6iMqJ1orOhB0XbRx2JoMTUxT7E0seNiV8XmxWnipuJM8TzxFvEHErCEmoSXxHaJkxIDEouSUpIOkizJo5JXJOelhKQspWKkiqW6peakqdLm0tHSxdKXpJ/LCMpYycTJlMr0ySzISsg6yqbIVskOyi7LKcv5ymXLNcs9lifK0+Uj5Ivle+UXFKQV3BQyFRoVHigSFOmKUYpHFPsVl5SUlfyV9iq1K80qiyg7KWcoNyo/UqGoWKgkqlSr3FXFqtJVY1WPqQ6pwWoGalFq5Wq31WF1Q/Vo9WPqw+sw64zXJayrXjeuQdaw0kjVaNSY1BTSdNXM1mzXfKmloBWkdVCrX+uztoF2nPYp7Yc6AjrOOtk6XTqvddV0mbrlunf1KHr2erv0OvRe6avrh+sf179nQDVwM9hr0GvwydDIkG3YZDhnpGAUYlRhNE6n0T3oBfTrxhhja+NdxheMP5gYmiSbtJj8YaphGmvaYDq7Xnl9+PpT66fM5MwYZlVmE+Yy5iHmJ8wnLGQtGBbVFk8t5S3DLGssZ6xUrWKsTlu9tNa2Zlu3Wi/ZmNjssOmxRdk62ObZDtoJ2Pnaldk9sZezj7RvtF9wMHDY7tDjiHF0cTzoOO4k6cR0qndacDZy3uHc50J28XYpc3nqqubKdu1yg92c3Q65PdqguCFhQ7s7cHdyP+T+2EPZI9HjZ0+sp4dnueczLx2vTK9+b6r3Fu8G73c+1j6FPg99VXxTfHv9eP2C/er9lvxt/Yv8JwK0AnYE3AoUC4wO7AjCBfkF1QQtbrTbeHjjdLBBcG7w2CblTembbmwW2xy3+eIW3i2MLedCMCH+IQ0hKwx3RjVjMdQptCJ0gWnDPMJ8EWYZVhw2F24WXhQ+E2EWURQxG2kWeShyLsoiqiRqPtomuiz6VYxjTGXMUqx7bG0sJ84/rjkeHx8S35kgkBCb0LdVamv61mGWOiuXNZFokng4cYHtwq5JgpI2JXUk05A/0oEUlZTvUiZTzVPLU9+n+aWdS+dPT0gf2Ka2bd+2mQz7jB+3o7czt/dmymZmZU7usNpRtRPaGbqzd5f8rpxd07sddtdlEbNis37J1s4uyn67x39PV45kzu6cqe8cvmvM5cll547vNd1b+T36++jvB/fp7Tu673NeWN7NfO38kvyVAmbBzR90fij9gbM/Yv9goWHh8QPYAwkHxg5aHKwr4i/KKJo65HaorVimOK/47eEth2+U6JdUHiEeSTkyUepa2nFU4eiBoytlUWWj5dblzRUSFfsqlo6FHRs5bnm8qVKyMr/y44noE/eqHKraqpWqS05iT6aefHbK71T/j/Qf62vEavJrPtUm1E7UedX11RvV1zdINBQ2wo0pjXOng08PnbE909Gk0VTVLNScfxacTTn7/KeQn8ZaXFp6z9HPNZ1XPF/RSm3Na4PatrUttEe1T3QEdgx3Onf2dpl2tf6s+XPtBdkL5RcFLxZ2E7tzujmXMi4t9rB65i9HXp7q3dL78ErAlbt9nn2DV12uXr9mf+1Kv1X/petm1y/cMLnReZN+s/2W4a22AYOB1l8MfmkdNBxsu210u2PIeKhreP1w94jFyOU7tneu3XW6e2t0w+jwmO/YvfHg8Yl7Yfdm78fdf/Ug9cHyw92PMI/yHvM9Lnki8aT6V9VfmycMJy5O2k4OPPV++nCKOfXit6TfVqZznlGelcxIz9TP6s5emLOfG3q+8fn0C9aL5fnc3/l/r3ip8vL8H5Z/DCwELEy/Yr/ivC54I/qm9q3+295Fj8Un7+LfLS/lvRd9X/eB/qH/o//HmeW0FdxK6SfVT12fXT4/4sRzOCwGm7FqBVBIwhERALyuBYASCAB1CPEPG9f8119+BvrK2fyNwVndL5jhvubRVsMQgCakeCFp04OsQ1LJEgAe5NodqT6WANbT+yf/iqQIPd21PXgaAcDJcjivtwJAQHLFgcNZ9uBwPlUgYhHf1z37f7V9g9e8ITewiP88wfWIYET6HPg21nzjV2fybQVcxfrg2/onng/F50lD/ccAAAA4ZVhJZk1NACoAAAAIAAGHaQAEAAAAAQAAABoAAAAAAAKgAgAEAAAAAQAAABigAwAEAAAAAQAAABgAAAAAwf1XlwAAAaNJREFUSA3FlT1LA0EQQBN/gYUYRTksJZVgEbCR/D+7QMr8ABtttBBCsLGzsLG2sxaxED/ie4d77u0dyaE5HHjczn7MzO7M7nU6/yXz+bwLhzCCjTQO+rZhDH3opuNLdRYN4RHe4RIKJ7R34Ro+4AEGSw2mE1iUwT18gpI74WvkGlccu4XNdH0jnYU7cAUacidn37qR23cOxc4aGU0nYUAn7iSWEHkz46w0ocdQu1X6B/AMQZ5o7KfBqNOfwRH8JB7FajGhnmcpKvQe3MEbvILiDm5gPXaCHnZr4vvFGMoEKudKn8YvQIOOe+YzCPop7dwJ3zRfJ7GDuso4YJGRa0yZgg4tUaNXdGrbuZWKKxzYYEJc2xp9AUUjGt8KC2jvgYadF8+10vJyDnNLXwbdiWUZi0fUK01Eoc+AZhCLZVzK4Vq6sDUdz+0dEcbbTTIOJmAyTVhx/WmvrExbv2jtPhWLKodjCtefZiEeZeVZWWSndgwj6fVf3XON8Qwq15++uoqrfYVrow6dGBpCq79ME291jaB0/Q2CPncyht/99MNO/vr9AqW/CGi8sJqbAAAAAElFTkSuQmCC"

cathProfile :: Profile
cathProfile = mkProfile "cath" "Catherine" Nothing

danProfile :: Profile
danProfile = mkProfile "dan" "Daniel" Nothing

eveProfile :: Profile
eveProfile = mkProfile "eve" "Eve" Nothing

frankProfile :: Profile
frankProfile = mkProfile "frank" "Frank" Nothing

businessProfile :: Profile
businessProfile = mkProfile "biz" "Biz Inc" Nothing

chatRelayProfile :: Profile
chatRelayProfile = mkProfile "relay" "Relay" Nothing

serviceProfile :: Profile
serviceProfile = mkProfile "service_user" "Service user" Nothing

mkProfile :: T.Text -> T.Text -> Maybe ImageData -> Profile
mkProfile displayName descr image = Profile {displayName, fullName = "", shortDescr = Just descr, description = Nothing, image, contactLink = Nothing, peerType = Nothing, preferences = defaultPrefs, badge = Nothing, contactDomain = Nothing}

it :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expectation))
it name test =
  Hspec.it name $ \tmp -> timeout t (test tmp) >>= maybe (error "test timed out") pure
  where
    t = 180 * 1000000

xit' :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expectation))
xit' = if os == "linux" then xit else it

xit'' :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
xit'' = ifCI xit Hspec.it

xitMacCI :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expectation))
xitMacCI = ifCI (if os == "darwin" then xit else it) it

xdescribe'' :: HasCallStack => String -> SpecWith a -> SpecWith a
xdescribe'' = ifCI xdescribe describe

ifCI :: HasCallStack => (HasCallStack => String -> a -> SpecWith b) -> (HasCallStack => String -> a -> SpecWith b) -> String -> a -> SpecWith b
ifCI xrun run d t = do
  ci <- runIO $ lookupEnv "CI"
  (if ci == Just "true" then xrun else run) d t

envCI :: IO Bool
envCI = (Just "true" ==) <$> lookupEnv "CI"

skip :: String -> SpecWith a -> SpecWith a
skip = before_ . pendingWith

-- Bool is pqExpected - see testAddContact
versionTestMatrix2 :: (HasCallStack => Bool -> Bool -> TestCC -> TestCC -> IO ()) -> SpecWith TestParams
versionTestMatrix2 runTest = do
  it "current" $ testChat2 aliceProfile bobProfile (runTest True True)
  it "prev" $ runTestCfg2 testCfgVPrev testCfgVPrev (runTest True True)
  it "prev to curr" $ runTestCfg2 testCfg testCfgVPrev (runTest True True)
  it "curr to prev" $ runTestCfg2 testCfgVPrev testCfg (runTest True True)
  it "old (1st supported)" $ testChatCfg2 testCfgV1 aliceProfile bobProfile (runTest True True)
  it "old to curr" $ runTestCfg2 testCfg testCfgV1 (runTest True True)
  it "curr to old" $ runTestCfg2 testCfgV1 testCfg (runTest True True)

versionTestMatrix3 :: (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> SpecWith TestParams
versionTestMatrix3 runTest = do
  it "current" $ testChat3 aliceProfile bobProfile cathProfile runTest
  it "prev" $ runTestCfg3 testCfgVPrev testCfgVPrev testCfgVPrev runTest
  it "prev to curr" $ runTestCfg3 testCfg testCfgVPrev testCfgVPrev runTest
  it "curr+prev to curr" $ runTestCfg3 testCfg testCfg testCfgVPrev runTest
  it "curr to prev" $ runTestCfg3 testCfgVPrev testCfg testCfg runTest
  it "curr+prev to prev" $ runTestCfg3 testCfgVPrev testCfg testCfgVPrev runTest

runTestCfg2 :: ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
runTestCfg2 aliceCfg bobCfg runTest ps =
  withNewTestChatCfg ps aliceCfg "alice" aliceProfile $ \alice ->
    withNewTestChatCfg ps bobCfg "bob" bobProfile $ \bob ->
      runTest alice bob

runTestCfg3 :: ChatConfig -> ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
runTestCfg3 aliceCfg bobCfg cathCfg runTest ps =
  withNewTestChatCfg ps aliceCfg "alice" aliceProfile $ \alice ->
    withNewTestChatCfg ps bobCfg "bob" bobProfile $ \bob ->
      withNewTestChatCfg ps cathCfg "cath" cathProfile $ \cath ->
        runTest alice bob cath

withRelay :: HasCallStack => TestParams -> (TestCC -> IO ()) -> IO ()
withRelay ps = withNewTestChatOpts ps relayTestOpts "relay" chatRelayProfile

-- | test sending direct messages
(<##>) :: HasCallStack => TestCC -> TestCC -> IO ()
cc1 <##> cc2 = do
  name1 <- userName cc1
  name2 <- userName cc2
  cc1 #> ("@" <> name2 <> " hi")
  cc2 <# (name1 <> "> hi")
  cc2 #> ("@" <> name1 <> " hey")
  cc1 <# (name2 <> "> hey")

(##>) :: HasCallStack => TestCC -> String -> IO ()
cc ##> cmd = do
  cc `send` cmd
  cc <## cmd

(#>) :: HasCallStack => TestCC -> String -> IO ()
cc #> cmd = do
  cc `send` cmd
  cc <# cmd

(?#>) :: HasCallStack => TestCC -> String -> IO ()
cc ?#> cmd = do
  cc `send` cmd
  cc <# ("i " <> cmd)

(#$>) :: (Eq a, Show a, HasCallStack) => TestCC -> (String, String -> a, a) -> Expectation
cc #$> (cmd, f, res) = do
  cc ##> cmd
  let expected = "result of " <> cmd <> ": " <> show res
  (f <$> getTermLine' (Just expected) cc) `shouldReturn` res

-- / PQ combinators

(\#>) :: HasCallStack => (TestCC, String) -> TestCC -> IO ()
(\#>) = sndRcv PQEncOff False

(+#>) :: HasCallStack => (TestCC, String) -> TestCC -> IO ()
(+#>) = sndRcv PQEncOn False

(++#>) :: HasCallStack => (TestCC, String) -> TestCC -> IO ()
(++#>) = sndRcv PQEncOn True

sndRcv :: HasCallStack => PQEncryption -> Bool -> (TestCC, String) -> TestCC -> IO ()
sndRcv pqEnc enabled (cc1, msg) cc2 = do
  name1 <- userName cc1
  name2 <- userName cc2
  let cmd = "@" <> name2 <> " " <> msg
  cc1 `send` cmd
  when enabled $ cc1 <## (name2 <> ": quantum resistant end-to-end encryption enabled")
  cc1 <# cmd
  cc1 `pqSndForContact` 2 `shouldReturn` pqEnc
  when enabled $ cc2 <## (name1 <> ": quantum resistant end-to-end encryption enabled")
  cc2 <# (name1 <> "> " <> msg)
  cc2 `pqRcvForContact` 2 `shouldReturn` pqEnc

(\:#>) :: HasCallStack => (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO ()
(\:#>) = sndRcvImg PQEncOff False

(+:#>) :: HasCallStack => (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO ()
(+:#>) = sndRcvImg PQEncOn False

(++:#>) :: HasCallStack => (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO ()
(++:#>) = sndRcvImg PQEncOn True

sndRcvImg :: HasCallStack => PQEncryption -> Bool -> (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO ()
sndRcvImg pqEnc enabled (cc1, msg, v1) (cc2, v2) = do
  name1 <- userName cc1
  name2 <- userName cc2
  g <- C.newRandom
  img <- atomically $ B64.encode <$> C.randomBytes lrgLen g
  cc1 `send` ("/_send @2 json {\"msgContent\":{\"type\":\"image\",\"text\":\"" <> msg <> "\",\"image\":\"" <> B.unpack img <> "\"}}")
  cc1 .<## "}}"
  cc1 <### ([ConsoleString (name2 <> ": quantum resistant end-to-end encryption enabled") | enabled] <> [WithTime ("@" <> name2 <> " " <> msg)])
  cc1 `pqSndForContact` 2 `shouldReturn` pqEnc
  cc1 `pqVerForContact` 2 `shouldReturn` v1
  cc2 <### ([ConsoleString (name1 <> ": quantum resistant end-to-end encryption enabled") | enabled] <> [WithTime (name1 <> "> " <> msg)])
  cc2 `pqRcvForContact` 2 `shouldReturn` pqEnc
  cc2 `pqVerForContact` 2 `shouldReturn` v2
  where
    lrgLen = maxEncodedMsgLength * 3 `div` 4 - 110 -- 98 is ~ max size for binary image preview given the rest of the message

genProfileImg :: IO ByteString
genProfileImg = do
  g <- C.newRandom
  atomically $ B64.encode . ("\x89PNG\r\n\x1a\n" <>) <$> C.randomBytes (lrgLen - 8) g
  where
    -- raw bytes that base64-encode to fit maxProfileImageSize when prefixed with "data:image/png;base64,"
    lrgLen = (maxProfileImageSize - imagePrefixLen) * 3 `div` 4 - 1
    imagePrefixLen = 22

-- PQ combinators /

chat :: String -> [(Int, String)]
chat = map (\(a, _, _) -> a) . chat''

chat' :: String -> [((Int, String), Maybe (Int, String))]
chat' = map (\(a, b, _) -> (a, b)) . chat''

chatF :: String -> [((Int, String), Maybe String)]
chatF = map (\(a, _, c) -> (a, c)) . chat''

chat'' :: String -> [((Int, String), Maybe (Int, String), Maybe String)]
chat'' = read

chatFeatures :: [(Int, String)]
chatFeatures = map (\(a, _, _) -> a) chatFeatures''

chatFeaturesNoPQ :: [(Int, String)]
chatFeaturesNoPQ =
  map (\(a, _, _) -> a) $
    ((1, "chat banner"), Nothing, Nothing) : ((0, e2eeInfoNoPQStr), Nothing, Nothing) : chatFeatures_

chatFeatures' :: [((Int, String), Maybe (Int, String))]
chatFeatures' = map (\(a, b, _) -> (a, b)) chatFeatures''

chatFeaturesF :: [((Int, String), Maybe String)]
chatFeaturesF = map (\(a, _, c) -> (a, c)) chatFeatures''

chatFeatures'' :: [((Int, String), Maybe (Int, String), Maybe String)]
chatFeatures'' = ((1, "chat banner"), Nothing, Nothing) : ((0, e2eeInfoPQStr), Nothing, Nothing) : chatFeatures_

chatFeatures_ :: [((Int, String), Maybe (Int, String), Maybe String)]
chatFeatures_ =
  [ ((0, "Disappearing messages: allowed"), Nothing, Nothing),
    ((0, "Full deletion: off"), Nothing, Nothing),
    ((0, "Message reactions: enabled"), Nothing, Nothing),
    ((0, "Voice messages: enabled"), Nothing, Nothing),
    ((0, "Audio/video calls: enabled"), Nothing, Nothing)
  ]

e2eeInfoNoPQStr :: String
e2eeInfoNoPQStr = T.unpack e2eInfoNoPQText

e2eeInfoPQStr :: String
e2eeInfoPQStr = T.unpack e2eInfoPQText

lastChatFeature :: String
lastChatFeature = snd $ last chatFeatures

groupFeatures :: [(Int, String)]
groupFeatures = map (\(a, _, _) -> a) $ groupFeatures'' 0

groupFeaturesNoE2E :: [(Int, String)]
groupFeaturesNoE2E = map (\(a, _, _) -> a) $ ((1, "chat banner"), Nothing, Nothing) : groupFeatures_ 0 False

channelFeaturesNoE2E :: [(Int, String)]
channelFeaturesNoE2E = map (\(a, _, _) -> a) $ ((1, "chat banner"), Nothing, Nothing) : groupFeatures_ 0 True

sndGroupFeatures :: [(Int, String)]
sndGroupFeatures = map (\(a, _, _) -> a) $ groupFeatures'' 1

groupFeatureStrs :: [String]
groupFeatureStrs = map (\(a, _, _) -> snd a) $ groupFeatures'' 0

groupFeatures'' :: Int -> [((Int, String), Maybe (Int, String), Maybe String)]
groupFeatures'' dir = ((1, "chat banner"), Nothing, Nothing) : ((dir, e2eeInfoNoPQStr), Nothing, Nothing) : groupFeatures_ dir False

groupFeatures_ :: Int -> Bool -> [((Int, String), Maybe (Int, String), Maybe String)]
groupFeatures_ dir isChannel =
  [((dir, "Disappearing messages: off"), Nothing, Nothing)]
    <> [((dir, "Direct messages: on"), Nothing, Nothing) | not isChannel]
    <> [((dir, "Full deletion: off"), Nothing, Nothing)]
    <> [((dir, "Message reactions: on"), Nothing, Nothing)]
    <> [((dir, "Voice messages: on"), Nothing, Nothing) | not isChannel]
    <> [((dir, "Files and media: on"), Nothing, Nothing) | not isChannel]
    <> [((dir, "SimpleX links: on"), Nothing, Nothing) | not isChannel]
    <> [((dir, "Member reports: on"), Nothing, Nothing) | not isChannel]
    <> [((dir, "Recent history: on"), Nothing, Nothing)]
    <> [((dir, "Chat with admins: " <> (if isChannel then "off" else "on")), Nothing, Nothing)]
    <> [((dir, "Sign messages: off"), Nothing, Nothing) | isChannel]

businessGroupFeatures :: [(Int, String)]
businessGroupFeatures = map (\(a, _, _) -> a) $ businessGroupFeatures'' 0

businessGroupFeatures'' :: Int -> [((Int, String), Maybe (Int, String), Maybe String)]
businessGroupFeatures'' dir =
  -- [ ((dir, e2eeInfoNoPQStr), Nothing, Nothing),
  [ ((1, "chat banner"), Nothing, Nothing),
    ((dir, "Disappearing messages: on"), Nothing, Nothing),
    ((dir, "Direct messages: off"), Nothing, Nothing),
    ((dir, "Full deletion: off"), Nothing, Nothing),
    ((dir, "Message reactions: on"), Nothing, Nothing),
    ((dir, "Voice messages: on"), Nothing, Nothing),
    ((dir, "Files and media: on"), Nothing, Nothing),
    ((dir, "SimpleX links: on"), Nothing, Nothing),
    ((dir, "Member reports: off"), Nothing, Nothing),
    ((dir, "Recent history: on"), Nothing, Nothing),
    ((dir, "Chat with admins: on"), Nothing, Nothing)
  ]

itemId :: Int -> String
itemId i = show $ length chatFeatures + i

(@@@) :: HasCallStack => TestCC -> [(String, String)] -> Expectation
(@@@) cc res = do
  threadDelay 100000
  getChats mapChats cc res

mapChats :: [(String, String, Maybe ConnStatus)] -> [(String, String)]
mapChats = map $ \(ldn, msg, _) -> (ldn, msg)

chats :: String -> [(String, String)]
chats = mapChats . read

(@@@!) :: HasCallStack => TestCC -> [(String, String, Maybe ConnStatus)] -> Expectation
(@@@!) = getChats id

getChats :: HasCallStack => (Eq a, Show a) => ([(String, String, Maybe ConnStatus)] -> [a]) -> TestCC -> [a] -> Expectation
getChats f cc res = do
  cc ##> "/_get chats 1 pcc=on"
  line <- getTermLine' (Just "chat list") cc
  f (read line) `shouldMatchList` res

send :: TestCC -> String -> IO ()
send TestCC {chatController = cc} cmd = atomically $ writeTBQueue (inputQ cc) cmd

(<##) :: HasCallStack => TestCC -> String -> Expectation
cc <## line = do
  l <- getTermLine' (Just line) cc
  when (l /= line) $ print ("expected: " <> line, ", got: " <> l)
  l `shouldBe` line

(<##.) :: HasCallStack => TestCC -> String -> Expectation
cc <##. line = do
  l <- getTermLine' (Just $ "prefix: " <> line) cc
  let prefix = line `isPrefixOf` l
  unless prefix $ print ("expected to start from: " <> line, ", got: " <> l)
  prefix `shouldBe` True

(.<##) :: HasCallStack => TestCC -> String -> Expectation
cc .<## line = do
  l <- getTermLine' (Just $ "suffix: " <> line) cc
  let suffix = line `isSuffixOf` l
  unless suffix $ print ("expected to end with: " <> line, ", got: " <> l)
  suffix `shouldBe` True

(.<##.) :: HasCallStack => TestCC -> (String, String) -> Expectation
cc .<##. (linePrefix, lineSuffix) = do
  l <- getTermLine' (Just $ "prefix: " <> linePrefix <> "; suffix: " <> lineSuffix) cc
  let prefix = linePrefix `isPrefixOf` l
  unless prefix $ print ("expected to start from: " <> linePrefix, ", got: " <> l)
  prefix `shouldBe` True
  let suffix = lineSuffix `isSuffixOf` l
  unless suffix $ print ("expected to end with: " <> lineSuffix, ", got: " <> l)
  suffix `shouldBe` True

(<#.) :: HasCallStack => TestCC -> String -> Expectation
cc <#. line = do
  l <- dropTime <$> getTermLine' (Just $ "prefix: " <> line) cc
  let prefix = line `isPrefixOf` l
  unless prefix $ print ("expected to start from: " <> line, ", got: " <> l)
  prefix `shouldBe` True

(.<#) :: HasCallStack => TestCC -> String -> Expectation
cc .<# line = do
  l <- dropTime <$> getTermLine' (Just $ "suffix: " <> line) cc
  let suffix = line `isSuffixOf` l
  unless suffix $ print ("expected to end with: " <> line, ", got: " <> l)
  suffix `shouldBe` True

(<##..) :: HasCallStack => TestCC -> [String] -> Expectation
cc <##.. ls = do
  l <- getTermLine' (Just $ "one of prefixes: " <> show ls) cc
  let prefix = any (`isPrefixOf` l) ls
  unless prefix $ print ("expected to start from one of: " <> show ls, ", got: " <> l)
  prefix `shouldBe` True

(>*) :: HasCallStack => TestCC -> String -> IO ()
cc >* note = do
  cc `send` ("/* " <> note)
  let expected = "* " <> note
  (dropTime <$> getTermLine' (Just expected) cc) `shouldReturn` expected

data ConsoleResponse
  = ConsoleString String
  | WithTime String
  | EndsWith String
  | StartsWith String
  | Predicate (String -> Bool)

instance Show ConsoleResponse where
  show (ConsoleString s) = show s
  show (WithTime s) = "WithTime " <> show s
  show (EndsWith s) = "EndsWith " <> show s
  show (StartsWith s) = "StartsWith " <> show s
  show (Predicate _) = "<predicate>"

instance IsString ConsoleResponse where fromString = ConsoleString

-- this assumes that the string can only match one option
getInAnyOrder :: HasCallStack => (String -> String) -> TestCC -> [ConsoleResponse] -> Expectation
getInAnyOrder _ _ [] = pure ()
getInAnyOrder f cc ls = do
  let expectedDesc = "one of " <> show (length ls) <> " responses: " <> show ls
  line <- f <$> getTermLine' (Just expectedDesc) cc
  let rest = filterFirst (expected line) ls
  if length rest < length ls
    then getInAnyOrder f cc rest
    else error $ "unexpected output: " <> line
  where
    expected :: String -> ConsoleResponse -> Bool
    expected l = \case
      ConsoleString s -> l == s
      WithTime s -> dropTime_ l == Just s
      EndsWith s -> s `isSuffixOf` l
      StartsWith s -> s `isPrefixOf` l
      Predicate p -> p l
    filterFirst :: (a -> Bool) -> [a] -> [a]
    filterFirst _ [] = []
    filterFirst p (x : xs)
      | p x = xs
      | otherwise = x : filterFirst p xs

(<###) :: HasCallStack => TestCC -> [ConsoleResponse] -> Expectation
(<###) = getInAnyOrder id

(<##?) :: HasCallStack => TestCC -> [ConsoleResponse] -> Expectation
(<##?) = getInAnyOrder dropTime

(<#) :: HasCallStack => TestCC -> String -> Expectation
cc <# line = (dropTime <$> getTermLine' (Just line) cc) `shouldReturn` line

(*<#) :: HasCallStack => [TestCC] -> String -> Expectation
ccs *<# line = mapConcurrently_ (<# line) ccs

(?<#) :: HasCallStack => TestCC -> String -> Expectation
cc ?<# line = do
  let expected = "i " <> line
  (dropTime <$> getTermLine' (Just expected) cc) `shouldReturn` expected

($<#) :: HasCallStack => (TestCC, String) -> String -> Expectation
(cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine' (Just $ "for user " <> uName <> ": " <> line) cc) `shouldReturn` line

(^<#) :: HasCallStack => (TestCC, String) -> String -> Expectation
(cc, p) ^<# line = (dropTime . dropStrPrefix p <$> getTermLine' (Just $ "without prefix " <> p <> ": " <> line) cc) `shouldReturn` line

(⩗) :: HasCallStack => TestCC -> String -> Expectation
cc ⩗ line = (dropTime . dropReceipt <$> getTermLine' (Just $ "receipt: " <> line) cc) `shouldReturn` line

(%) :: HasCallStack => TestCC -> String -> Expectation
cc % line = (dropTime . dropPartialReceipt <$> getTermLine' (Just $ "partial receipt: " <> line) cc) `shouldReturn` line

(</) :: HasCallStack => TestCC -> Expectation
(</) = (<// 500000)

(<#?) :: HasCallStack => TestCC -> TestCC -> Expectation
cc1 <#? cc2 = do
  name <- userName cc2
  sName <- showName cc2
  cc2 <## "connection request sent!"
  cc1 <## (sName <> " wants to connect to you!")
  cc1 <## ("to accept: /ac " <> name)
  cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)")

dropUser :: HasCallStack => String -> String -> String
dropUser uName msg = fromMaybe err $ dropUser_ uName msg
  where
    err = error $ "invalid user: " <> msg

dropUser_ :: String -> String -> Maybe String
dropUser_ uName msg = do
  let userPrefix = "[user: " <> uName <> "] "
  if userPrefix `isPrefixOf` msg
    then Just $ drop (length userPrefix) msg
    else Nothing

dropTime :: HasCallStack => String -> String
dropTime msg = fromMaybe err $ dropTime_ msg
  where
    err = error $ "invalid time: " <> msg

dropTime_ :: String -> Maybe String
dropTime_ msg = case splitAt 6 msg of
  ([m, m', ':', s, s', ' '], text) ->
    if all isDigit [m, m', s, s'] then Just text else Nothing
  ([month, month', '-', d, d', ' '], text) ->
    if all isDigit [month, month', d, d'] then Just text else Nothing
  _ -> Nothing

dropStrPrefix :: HasCallStack => String -> String -> String
dropStrPrefix pfx s =
  let (p, rest) = splitAt (length pfx) s
   in if p == pfx then rest else error $ "no prefix " <> pfx <> " in string : " <> s

dropReceipt :: HasCallStack => String -> String
dropReceipt msg = fromMaybe err $ dropReceipt_ msg
  where
    err = error $ "invalid receipt: " <> msg

dropReceipt_ :: String -> Maybe String
dropReceipt_ msg = case splitAt 2 msg of
  ("⩗ ", text) -> Just text
  _ -> Nothing

dropPartialReceipt :: HasCallStack => String -> String
dropPartialReceipt msg = fromMaybe err $ dropPartialReceipt_ msg
  where
    err = error $ "invalid partial receipt: " <> msg

dropPartialReceipt_ :: String -> Maybe String
dropPartialReceipt_ msg = case splitAt 2 msg of
  ("% ", text) -> Just text
  _ -> Nothing

getForOldClientsLine :: HasCallStack => TestCC -> String -> IO String
getForOldClientsLine cc prefix =
  timeout 500000 (getTermLine cc) >>= \case
    Just line -> dropLinePrefix prefix line
    Nothing -> pure ""

getInvitation :: HasCallStack => TestCC -> IO String
getInvitation cc = do
  (_, fullInv) <- getInvitations cc
  pure fullInv

getInvitations :: HasCallStack => TestCC -> IO (String, String)
getInvitations cc = do
  shortInv <- getInvitation_ cc
  cc <##. "The invitation link for old clients:"
  fullInv <- getTermLine' (Just "full invitation link") cc
  pure (shortInv, fullInv)

getInvitationNoShortLink :: HasCallStack => TestCC -> IO String
getInvitationNoShortLink = getInvitation_

getInvitation_ :: HasCallStack => TestCC -> IO String
getInvitation_ cc = do
  cc <## "pass this invitation link to your contact (via another channel):"
  cc <## ""
  inv <- getTermLine' (Just "invitation link") cc
  cc <## ""
  cc <## "and ask them to connect: /c <invitation_link_above>"
  pure inv

getContactLink :: HasCallStack => TestCC -> Bool -> IO String
getContactLink cc created = do
  (_shortLink, fullLink) <- getContactLinks cc created
  pure fullLink

getContactLinks :: HasCallStack => TestCC -> Bool -> IO (String, String)
getContactLinks cc created = do
  shortLink <- getContactLink_ cc created
  fullLink <- getForOldClientsLine cc "The contact link for old clients: "
  pure (shortLink, fullLink)

getContactLinkNoShortLink :: HasCallStack => TestCC -> Bool -> IO String
getContactLinkNoShortLink = getContactLink_

getContactLink_ :: HasCallStack => TestCC -> Bool -> IO String
getContactLink_ cc created = do
  cc <## if created then "Your new chat address is created!" else "Your chat address:"
  cc <## ""
  link <- getTermLine' (Just "contact link") cc
  cc <## ""
  cc <## "Anybody can send you contact requests with: /c <contact_link_above>"
  cc <## "to show it again: /sa"
  cc <## "to share with your contacts: /profile_address on"
  cc <## "to delete it: /da (accepted contacts will remain connected)"
  pure link

dropLinePrefix :: String -> String -> IO String
dropLinePrefix line s
  | line `isPrefixOf` s = pure $ drop (length line) s
  | otherwise = error $ "expected to start from: " <> line <> ", got: " <> s

getGroupLink :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO String
getGroupLink cc gName mRole created = do
  (_shortLink, fullLink) <- getGroupLinks cc gName mRole created
  pure fullLink

getGroupLinks :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO (String, String)
getGroupLinks cc gName mRole created = do
  shortLink <- getGroupLink_ cc gName mRole created
  fullLink <- getForOldClientsLine cc "The group link for old clients: "
  pure (shortLink, fullLink)

getGroupLinkNoShortLink :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO String
getGroupLinkNoShortLink = getGroupLink_

getGroupLink_ :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO String
getGroupLink_ cc gName mRole created = do
  cc <## if created then "Group link is created!" else "Group link:"
  cc <## ""
  link <- getTermLine' (Just $ "group link for " <> gName) cc
  cc <## ""
  cc <## ("Anybody can connect to you and join group as " <> T.unpack (textEncode mRole) <> " with: /c <group_link_above>")
  cc <## ("to show it again: /show link #" <> gName)
  cc <## ("to delete it: /delete link #" <> gName <> " (joined members will remain connected to you)")
  pure link

hasContactProfiles :: HasCallStack => TestCC -> [ContactName] -> Expectation
hasContactProfiles cc names =
  getContactProfiles cc >>= \ps -> ps `shouldMatchList` names

getContactProfiles :: TestCC -> IO [ContactName]
getContactProfiles cc = do
  user_ <- readTVarIO (currentUser $ chatController cc)
  case user_ of
    Nothing -> pure []
    Just user -> do
      profiles <- withTransaction (chatStore $ chatController cc) $ \db -> getUserContactProfiles db user
      pure $ map (\Profile {displayName} -> displayName) profiles

withCCUser :: TestCC -> (User -> IO a) -> IO a
withCCUser cc action = do
  user_ <- readTVarIO (currentUser $ chatController cc)
  case user_ of
    Nothing -> error "no user"
    Just user -> action user

withCCTransaction :: TestCC -> (DB.Connection -> IO a) -> IO a
withCCTransaction cc action =
  withTransaction (chatStore $ chatController cc) $ \db -> action db

withCCAgentTransaction :: TestCC -> (DB.Connection -> IO a) -> IO a
withCCAgentTransaction TestCC {chatController = ChatController {smpAgent}} action =
  withTransaction (agentClientStore smpAgent) $ \db -> action db

createCCNoteFolder :: TestCC -> IO ()
createCCNoteFolder cc =
  withCCTransaction cc $ \db ->
    withCCUser cc $ \user ->
      runExceptT (createNoteFolder db user) >>= either (fail . show) pure

shouldEventuallyReturn :: (HasCallStack, Eq a, Show a) => IO a -> a -> Expectation
shouldEventuallyReturn action expected = go (200 :: Int)
  where
    go n = do
      r <- action
      if r == expected || n == 0
        then r `shouldBe` expected
        else threadDelay 100000 >> go (n - 1)

getProfilePictureByName :: TestCC -> String -> IO (Maybe String)
getProfilePictureByName cc displayName =
  withTransaction (chatStore $ chatController cc) $ \db ->
    join <$> maybeFirstRow fromOnly (DB.query db "SELECT image FROM contact_profiles WHERE display_name = ? LIMIT 1" (Only displayName))

getProfileShortDescrByName :: TestCC -> String -> IO (Maybe String)
getProfileShortDescrByName cc displayName =
  withTransaction (chatStore $ chatController cc) $ \db ->
    join <$> maybeFirstRow fromOnly (DB.query db "SELECT short_descr FROM contact_profiles WHERE display_name = ? LIMIT 1" (Only displayName))

pqSndForContact :: TestCC -> ContactId -> IO PQEncryption
pqSndForContact = pqForContact_ pqSndEnabled PQEncOff

pqRcvForContact :: TestCC -> ContactId -> IO PQEncryption
pqRcvForContact = pqForContact_ pqRcvEnabled PQEncOff

pqForContact :: TestCC -> ContactId -> IO PQEncryption
pqForContact = pqForContact_ (Just . connPQEnabled) (error "impossible")

pqSupportForCt :: TestCC -> ContactId -> IO PQSupport
pqSupportForCt = pqForContact_ (\Connection {pqSupport} -> Just pqSupport) PQSupportOff

pqVerForContact :: TestCC -> ContactId -> IO VersionChat
pqVerForContact = pqForContact_ (Just . connChatVersion) (error "impossible")

pqForContact_ :: (Connection -> Maybe a) -> a -> TestCC -> ContactId -> IO a
pqForContact_ pqSel def cc contactId = (fromMaybe def . pqSel) <$> getCtConn cc contactId

getCtConn :: TestCC -> ContactId -> IO Connection
getCtConn cc contactId = getTestCCContact cc contactId >>= maybe (fail "no connection") pure . contactConn

getTestCCContact :: TestCC -> ContactId -> IO Contact
getTestCCContact cc contactId = do
  let TestCC {chatController} = cc
  withCCTransaction cc $ \db ->
    withCCUser cc $ \user ->
      runExceptT (getContact db (storeCxt chatController) user contactId) >>= either (fail . show) pure

contactChatLayout :: TestCC -> ContactName -> IO (Maybe ChatLayout)
contactChatLayout cc cName =
  withCCTransaction cc $ \db ->
    withCCUser cc $ \user ->
      runExceptT (getContact db (storeCxt $ chatController cc) user =<< getContactIdByName db user cName)
        >>= either (fail . show) (\Contact {chatLayout} -> pure chatLayout)

groupChatLayout :: TestCC -> GroupName -> IO (Maybe ChatLayout)
groupChatLayout cc gName =
  withCCTransaction cc $ \db ->
    withCCUser cc $ \user ->
      runExceptT (getGroupInfo db (storeCxt $ chatController cc) user =<< getGroupIdByName db user gName)
        >>= either (fail . show) (\GroupInfo {groupProfile = GroupProfile {chatLayout}} -> pure chatLayout)

contactBadgeHeader :: TestCC -> ContactName -> IO (Maybe (String, BadgeStatus))
contactBadgeHeader cc cName =
  withCCTransaction cc $ \db ->
    withCCUser cc $ \user ->
      runExceptT (getContact db (storeCxt $ chatController cc) user =<< getContactIdByName db user cName)
        >>= either (fail . show) (pure . storedBadgeHeader . profile')

requestBadgeHeader :: TestCC -> ContactName -> IO (Maybe (String, BadgeStatus))
requestBadgeHeader cc cName =
  withCCTransaction cc $ \db ->
    withCCUser cc $ \user@User {userId} ->
      runExceptT (getContactRequest db user =<< getContactRequestIdByName db userId cName)
        >>= either (fail . show) (\UserContactRequest {profile} -> pure $ storedBadgeHeader profile)

memberBadgeHeader :: TestCC -> GroupName -> ContactName -> IO (Maybe (String, BadgeStatus))
memberBadgeHeader cc gName mName = (\GroupMember {memberProfile} -> storedBadgeHeader memberProfile) <$> getTestMember cc gName mName

memberProofHeader :: TestCC -> GroupName -> ContactName -> IO (Maybe String)
memberProofHeader cc gName mName = (\GroupMember {memberBadgeProof} -> proofHeaderTag <$> unNoJSON memberBadgeProof) <$> getTestMember cc gName mName

getTestMember :: TestCC -> GroupName -> ContactName -> IO GroupMember
getTestMember cc gName mName =
  withCCTransaction cc $ \db ->
    withCCUser cc $ \user ->
      runExceptT
        ( do
            gId <- getGroupIdByName db user gName
            getGroupMember db (storeCxt $ chatController cc) user gId =<< getGroupMemberIdByName db user gId mName
        )
        >>= either (fail . show) pure

storedBadgeHeader :: LocalProfile -> Maybe (String, BadgeStatus)
storedBadgeHeader LocalProfile {localBadge} = case localBadge of
  Just (PeerBadge b st) -> Just (proofHeaderTag b, st)
  _ -> Nothing

proofHeaderTag :: BadgeProof -> String
proofHeaderTag (BadgeProof _ (BBSPresHeader ph) _ _) = case strDecode ph of
  Right (PHChat b) -> 'C' : take 1 (B.unpack b)
  Right (PHRequest _) -> "R"
  Right (PHLink _) -> "L"
  Right (PHTest _) -> "T"
  _ -> "?"

lastItemId :: HasCallStack => TestCC -> IO String
lastItemId cc = do
  cc ##> "/last_item_id"
  getTermLine' (Just "last item id") cc

showActiveUser :: HasCallStack => TestCC -> String -> Expectation
showActiveUser cc name = do
  cc <## ("user profile: " <> name)
  cc <## "use /p <name> [<bio>] to change it"

connectUsersNoShortLink :: HasCallStack => TestCC -> TestCC -> IO ()
connectUsersNoShortLink cc1 cc2 = connectUsers_ cc1 cc2 True

connectUsers :: HasCallStack => TestCC -> TestCC -> IO ()
connectUsers cc1 cc2 = connectUsers_ cc1 cc2 False

connectUsers_ :: HasCallStack => TestCC -> TestCC -> Bool -> IO ()
connectUsers_ cc1 cc2 noShortLink = do
  name1 <- showName cc1
  name2 <- showName cc2
  cc1 ##> "/c"
  inv <- if noShortLink
    then getInvitationNoShortLink cc1
    else getInvitation cc1
  cc2 ##> ("/c " <> inv)
  cc2 <## "confirmation sent!"
  concurrently_
    (cc2 <## (name1 <> ": contact is connected"))
    (cc1 <## (name2 <> ": contact is connected"))

showName :: TestCC -> IO String
showName TestCC {chatController = ChatController {currentUser}} = do
  Just User {localDisplayName, profile = LocalProfile {fullName, shortDescr}} <- readTVarIO currentUser
  pure . T.unpack $ viewName localDisplayName <> optionalFullName localDisplayName fullName shortDescr

createGroup2 :: HasCallStack => String -> TestCC -> TestCC -> IO ()
createGroup2 gName cc1 cc2 = createGroup2' gName cc1 (cc2, GRAdmin) True

createGroup2' :: HasCallStack => String -> TestCC -> (TestCC, GroupMemberRole) -> Bool -> IO ()
createGroup2' gName cc1 (cc2, role2) doConnectUsers = do
  when doConnectUsers $ connectUsers cc1 cc2
  name2 <- userName cc2
  cc1 ##> ("/g " <> gName)
  cc1 <## ("group #" <> gName <> " is created")
  cc1 <## ("to add members use /a " <> gName <> " <name> or /create link #" <> gName)
  addMember gName cc1 cc2 role2
  cc2 ##> ("/j " <> gName)
  concurrently_
    (cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group"))
    (cc2 <## ("#" <> gName <> ": you joined the group"))

disableFullDeletion2 :: HasCallStack => String -> TestCC -> TestCC -> IO ()
disableFullDeletion2 gName cc1 cc2 = do
  cc1 ##> ("/set delete #" <> gName <> " off")
  cc1 <## "updated group preferences:"
  cc1 <## "Full deletion: off"
  name1 <- userName cc1
  cc2 <## (name1 <> " updated group #" <> gName <> ":")
  cc2 <## "updated group preferences:"
  cc2 <## "Full deletion: off"

createGroup3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO ()
createGroup3 gName cc1 cc2 cc3 = do
  createGroup3' gName cc1 (cc2, GRAdmin) (cc3, GRAdmin)

createGroup3' :: HasCallStack => String -> TestCC -> (TestCC, GroupMemberRole) -> (TestCC, GroupMemberRole) -> IO ()
createGroup3' gName cc1 (cc2, role2) (cc3, role3) = do
  createGroup2' gName cc1 (cc2, role2) True
  connectUsers cc1 cc3
  name1 <- userName cc1
  name3 <- userName cc3
  sName2 <- showName cc2
  sName3 <- showName cc3
  addMember gName cc1 cc3 role3
  cc3 ##> ("/j " <> gName)
  concurrentlyN_
    [ cc1 <## ("#" <> gName <> ": " <> name3 <> " joined the group"),
      do
        cc3 <## ("#" <> gName <> ": you joined the group")
        cc3 <## ("#" <> gName <> ": member " <> sName2 <> " is connected"),
      do
        cc2 <## ("#" <> gName <> ": " <> name1 <> " added " <> sName3 <> " to the group (connecting...)")
        cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected")
    ]

createGroup4 :: HasCallStack => String -> TestCC -> (TestCC, GroupMemberRole) -> (TestCC, GroupMemberRole) -> (TestCC, GroupMemberRole) -> IO ()
createGroup4 gName cc1 (cc2, role2) (cc3, role3) (cc4, role4) = do
  createGroup3' gName cc1 (cc2, role2) (cc3, role3)
  connectUsers cc1 cc4
  name1 <- userName cc1
  name4 <- userName cc4
  sName2 <- showName cc2
  sName3 <- showName cc3
  sName4 <- showName cc4
  addMember gName cc1 cc4 role4
  cc4 ##> ("/j " <> gName)
  concurrentlyN_
    [ cc1 <## "#team: dan joined the group",
      do
        cc4 <## ("#" <> gName <> ": you joined the group")
        cc4
          <### [ ConsoleString ("#" <> gName <> ": member " <> sName2 <> " is connected"),
                 ConsoleString ("#" <> gName <> ": member " <> sName3 <> " is connected")
               ],
      do
        cc2 <## ("#" <> gName <> ": " <> name1 <> " added " <> sName4 <> " to the group (connecting...)")
        cc2 <## ("#" <> gName <> ": new member " <> name4 <> " is connected"),
      do
        cc3 <## ("#" <> gName <> ": " <> name1 <> " added " <> sName4 <> " to the group (connecting...)")
        cc3 <## ("#" <> gName <> ": new member " <> name4 <> " is connected")
    ]

disableFullDeletion3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO ()
disableFullDeletion3 gName cc1 cc2 cc3 = do
  disableFullDeletion2 gName cc1 cc2
  name1 <- userName cc1
  cc3 <## (name1 <> " updated group #" <> gName <> ":")
  cc3 <## "updated group preferences:"
  cc3 <## "Full deletion: off"

create2Groups3 :: HasCallStack => String -> String -> TestCC -> TestCC -> TestCC -> IO ()
create2Groups3 gName1 gName2 cc1 cc2 cc3 = do
  createGroup3 gName1 cc1 cc2 cc3
  createGroup2' gName2 cc1 (cc2, GRAdmin) False
  name1 <- userName cc1
  name3 <- userName cc3
  addMember gName2 cc1 cc3 GRAdmin
  cc3 ##> ("/j " <> gName2)
  concurrentlyN_
    [ cc1 <## ("#" <> gName2 <> ": " <> name3 <> " joined the group"),
      do
        cc3 <## ("#" <> gName2 <> ": you joined the group")
        cc3 <##. ("#" <> gName2 <> ": member "), -- "#gName2: member sName2 is connected"
      do
        cc2 <##. ("#" <> gName2 <> ": " <> name1 <> " added ") -- "#gName2: name1 added sName3 to the group (connecting...)"
        cc2 <##. ("#" <> gName2 <> ": new member ") -- "#gName2: new member name3 is connected"
    ]

addMember :: HasCallStack => String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
addMember gName = fullAddMember gName ""

fullAddMember :: HasCallStack => String -> String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
fullAddMember gName fullName inviting invitee role = do
  name1 <- userName inviting
  memName <- userName invitee
  inviting ##> ("/a " <> gName <> " " <> memName <> " " <> T.unpack (textEncode role))
  let fullName' = if null fullName || fullName == gName then "" else " (" <> fullName <> ")"
  concurrentlyN_
    [ inviting <## ("invitation to join the group #" <> gName <> " sent to " <> memName),
      do
        invitee <## ("#" <> gName <> fullName' <> ": " <> name1 <> " invites you to join the group as " <> T.unpack (textEncode role))
        invitee <## ("use /j " <> gName <> " to accept")
    ]

checkActionDeletesFile :: HasCallStack => FilePath -> IO () -> IO ()
checkActionDeletesFile file action = do
  fileExistsBefore <- doesFileExist file
  fileExistsBefore `shouldBe` True
  action
  fileExistsAfter <- doesFileExist file
  fileExistsAfter `shouldBe` False

currentChatVRangeInfo :: String
currentChatVRangeInfo =
  "peer chat protocol version range: " <> vRangeStr supportedChatVRange

vRangeStr :: VersionRange v -> String
vRangeStr (VersionRange minVer maxVer) = "(" <> show minVer <> ", " <> show maxVer <> ")"

linkAnotherSchema :: String -> String
linkAnotherSchema link
  | "https://simplex.chat/" `isPrefixOf` link =
      T.unpack $ T.replace "https://simplex.chat/" "simplex:/" $ T.pack link
  | "simplex:/" `isPrefixOf` link =
      T.unpack $ T.replace "simplex:/" "https://simplex.chat/" $ T.pack link
  | otherwise = error "link starts with neither https://simplex.chat/ nor simplex:/"

xftpCLI :: [String] -> IO [String]
xftpCLI = \case
  ["rand", path, size] -> do
    let FileSize n = fromString size :: FileSize Int
    B.writeFile path =<< atomically . C.randomBytes n =<< C.newRandom
    pure ["File created: " <> path]
  params -> error $ "unsupported xftp CLI command: " <> unwords params

setRelativePaths :: HasCallStack => TestCC -> String -> String -> IO ()
setRelativePaths cc filesFolder tempFolder = do
  cc ##> "/_stop"
  cc <## "chat stopped"
  cc #$> ("/_files_folder " <> filesFolder, id, "ok")
  cc #$> ("/_temp_folder " <> tempFolder, id, "ok")
  cc ##> "/_start"
  cc <## "chat started"