FunctionalAPITests.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module AgentTests.FunctionalAPITests
  ( functionalAPITests,
    testServerMatrix2,
    withAgentClientsCfg2,
    withAgentClientsCfgServers2,
    getSMPAgentClient',
    withAgent,
    withAgentClients2,
    withAgentClients3,
    makeConnection,
    exchangeGreetings,
    switchComplete,
    createConnection,
    joinConnection,
    sendMessage,
    runRight,
    runRight_,
    inAnyOrder,
    get,
    get',
    rfGet,
    sfGet,
    nGet,
    (##>),
    (=##>),
    pattern CON,
    pattern CONF,
    pattern INFO,
    pattern REQ,
    pattern Msg,
    pattern Msg',
    pattern SENT,
    agentCfgVPrevPQ,
  )
where

import AgentTests.ConnectionRequestTests (connReqData, queueAddr, testE2ERatchetParams12)
import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Data.Bifunctor (first)
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Either (isRight)
import Data.Int (Int64)
import Data.List (find, nub)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map as M
import Data.Maybe (isJust, isNothing)
import qualified Data.Set as S
import Data.Text.Encoding (decodeLatin1)
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import Data.Time.Clock.System (SystemTime (..), getSystemTime)
import Data.Type.Equality (testEquality, (:~:) (Refl))
import Data.Word (Word16)
import qualified Database.SQLite.Simple as SQL
import GHC.Stack (withFrozenCallStack)
import SMPAgentClient
import SMPClient (cfg, prevRange, prevVersion, testPort, testPort2, testStoreLogFile2, withSmpServer, withSmpServerConfigOn, withSmpServerOn, withSmpServerProxy, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn)
import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
import qualified Simplex.Messaging.Agent as A
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), ServerQueueInfo (..), UserNetworkInfo (..), UserNetworkType (..), waitForUserNetwork)
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore)
import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, REQ, SENT)
import qualified Simplex.Messaging.Agent.Protocol as A
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), SQLiteStore (dbNew))
import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction')
import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SMPProxyFallback (..), SMPProxyMode (..), TransportSessionMode (TSMEntity, TSMUser), defaultClientConfig)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Notifications.Transport (NTFVersion, pattern VersionNTF)
import Simplex.Messaging.Protocol (BasicAuth, ErrorType (..), MsgBody, ProtocolServer (..), SubscriptionMode (..), supportedSMPClientVRange)
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Server.QueueStore.QueueInfo
import Simplex.Messaging.Transport (ATransport (..), SMPVersion, VersionSMP, authCmdsSMPVersion, basicAuthSMPVersion, batchCmdsSMPVersion, currentServerSMPRelayVersion, sndAuthKeySMPVersion, supportedSMPHandshakes)
import Simplex.Messaging.Util (bshow, diffToMicroseconds)
import Simplex.Messaging.Version (VersionRange (..))
import qualified Simplex.Messaging.Version as V
import Simplex.Messaging.Version.Internal (Version (..))
import System.Directory (copyFile, renameFile)
import Test.Hspec
import UnliftIO
import Util
import XFTPClient (testXFTPServer)

type AEntityTransmission e = (ACorrId, ConnId, AEvent e)

-- deriving instance Eq (ValidFileDescription p)

shouldRespond :: (HasCallStack, MonadUnliftIO m, Eq a, Show a) => m a -> a -> m ()
a `shouldRespond` r = withFrozenCallStack $ withTimeout a (`shouldBe` r)

(##>) :: (HasCallStack, MonadUnliftIO m) => m (AEntityTransmission e) -> AEntityTransmission e -> m ()
a ##> t = a `shouldRespond` t

(=##>) :: (Show a, HasCallStack, MonadUnliftIO m) => m a -> (HasCallStack => a -> Bool) -> m ()
a =##> p =
  withTimeout a $ \r -> do
    unless (p r) $ liftIO $ putStrLn $ "value failed predicate: " <> show r
    r `shouldSatisfy` p

withTimeout :: (HasCallStack, MonadUnliftIO m) => m a -> (HasCallStack => a -> Expectation) -> m ()
withTimeout a test =
  timeout 10_000000 a >>= \case
    Nothing -> error "operation timed out"
    Just t -> liftIO $ test t

get :: (MonadIO m, HasCallStack) => AgentClient -> m (AEntityTransmission 'AEConn)
get c = withFrozenCallStack $ get' @'AEConn c

rfGet :: (MonadIO m, HasCallStack) => AgentClient -> m (AEntityTransmission 'AERcvFile)
rfGet c = withFrozenCallStack $ get' @'AERcvFile c

sfGet :: (MonadIO m, HasCallStack) => AgentClient -> m (AEntityTransmission 'AESndFile)
sfGet c = withFrozenCallStack $ get' @'AESndFile c

nGet :: (MonadIO m, HasCallStack) => AgentClient -> m (AEntityTransmission 'AENone)
nGet c = withFrozenCallStack $ get' @'AENone c

get' :: forall e m. (MonadIO m, AEntityI e, HasCallStack) => AgentClient -> m (AEntityTransmission e)
get' c = withFrozenCallStack $ do
  (corrId, connId, AEvt e cmd) <- pGet c
  case testEquality e (sAEntity @e) of
    Just Refl -> pure (corrId, connId, cmd)
    _ -> error $ "unexpected command " <> show cmd

pGet :: forall m. MonadIO m => AgentClient -> m ATransmission
pGet c = pGet' c True

pGet' :: forall m. MonadIO m => AgentClient -> Bool -> m ATransmission
pGet' c skipWarn = do
  t@(_, _, AEvt _ cmd) <- atomically (readTBQueue $ subQ c)
  case cmd of
    CONNECT {} -> pGet c
    DISCONNECT {} -> pGet c
    ERR (BROKER _ NETWORK) -> pGet c
    MWARN {} | skipWarn -> pGet c
    RFWARN {} | skipWarn -> pGet c
    SFWARN {} | skipWarn -> pGet c
    _ -> pure t

pattern CONF :: ConfirmationId -> [SMPServer] -> ConnInfo -> AEvent e
pattern CONF conId srvs connInfo <- A.CONF conId PQSupportOn srvs connInfo

pattern INFO :: ConnInfo -> AEvent 'AEConn
pattern INFO connInfo = A.INFO PQSupportOn connInfo

pattern REQ :: InvitationId -> NonEmpty SMPServer -> ConnInfo -> AEvent e
pattern REQ invId srvs connInfo <- A.REQ invId PQSupportOn srvs connInfo

pattern CON :: AEvent 'AEConn
pattern CON = A.CON PQEncOn

pattern Msg :: MsgBody -> AEvent e
pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk, pqEncryption = PQEncOn} _ msgBody

pattern Msg' :: AgentMsgId -> PQEncryption -> MsgBody -> AEvent e
pattern Msg' aMsgId pq msgBody <- MSG MsgMeta {integrity = MsgOk, recipient = (aMsgId, _), pqEncryption = pq} _ msgBody

pattern MsgErr :: AgentMsgId -> MsgErrorType -> MsgBody -> AEvent 'AEConn
pattern MsgErr msgId err msgBody <- MSG MsgMeta {recipient = (msgId, _), integrity = MsgError err} _ msgBody

pattern MsgErr' :: AgentMsgId -> MsgErrorType -> PQEncryption -> MsgBody -> AEvent 'AEConn
pattern MsgErr' msgId err pq msgBody <- MSG MsgMeta {recipient = (msgId, _), integrity = MsgError err, pqEncryption = pq} _ msgBody

pattern SENT :: AgentMsgId -> AEvent 'AEConn
pattern SENT msgId = A.SENT msgId Nothing

pattern Rcvd :: AgentMsgId -> AEvent 'AEConn
pattern Rcvd agentMsgId <- RCVD MsgMeta {integrity = MsgOk} [MsgReceipt {agentMsgId, msgRcptStatus = MROk}]

smpCfgVPrev :: ProtocolClientConfig SMPVersion
smpCfgVPrev = (smpCfg agentCfg) {clientALPN = Nothing, serverVRange = prevRange $ serverVRange $ smpCfg agentCfg}

ntfCfgVPrev :: ProtocolClientConfig NTFVersion
ntfCfgVPrev = (ntfCfg agentCfg) {clientALPN = Nothing, serverVRange = V.mkVersionRange (VersionNTF 1) (VersionNTF 1)}

agentCfgVPrev :: AgentConfig
agentCfgVPrev = agentCfgVPrevPQ {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg}

agentCfgVPrevPQ :: AgentConfig
agentCfgVPrevPQ =
  agentCfg
    { sndAuthAlg = C.AuthAlg C.SEd25519,
      smpAgentVRange = prevRange $ smpAgentVRange agentCfg,
      smpClientVRange = prevRange $ smpClientVRange agentCfg,
      smpCfg = smpCfgVPrev,
      ntfCfg = ntfCfgVPrev
    }

agentCfgRatchetVPrev :: AgentConfig
agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg}

mkVersionRange :: Word16 -> Word16 -> VersionRange v
mkVersionRange v1 v2 = V.mkVersionRange (Version v1) (Version v2)

runRight_ :: (Eq e, Show e, HasCallStack) => ExceptT e IO () -> Expectation
runRight_ action = withFrozenCallStack $ runExceptT action `shouldReturn` Right ()

runRight :: (Show e, HasCallStack) => ExceptT e IO a -> IO a
runRight action =
  runExceptT action >>= \case
    Right x -> pure x
    Left e -> error $ "Unexpected error: " <> show e

getInAnyOrder :: HasCallStack => AgentClient -> [ATransmission -> Bool] -> Expectation
getInAnyOrder c ts = withFrozenCallStack $ inAnyOrder (pGet c) ts

inAnyOrder :: (Show a, MonadUnliftIO m, HasCallStack) => m a -> [a -> Bool] -> m ()
inAnyOrder _ [] = pure ()
inAnyOrder g rs = withFrozenCallStack $ do
  r <- 5000000 `timeout` g >>= maybe (error "inAnyOrder timeout") pure
  let rest = filter (not . expected r) rs
  if length rest < length rs
    then inAnyOrder g rest
    else error $ "unexpected event: " <> show r
  where
    expected :: a -> (a -> Bool) -> Bool
    expected r rp = rp r

createConnection :: AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c)
createConnection c userId enableNtfs cMode clientData = A.createConnection c userId enableNtfs cMode clientData (IKNoPQ PQSupportOn)

joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE ConnId
joinConnection c userId enableNtfs cReq connInfo = A.joinConnection c userId Nothing enableNtfs cReq connInfo PQSupportOn

sendMessage :: AgentClient -> ConnId -> SMP.MsgFlags -> MsgBody -> AE AgentMsgId
sendMessage c connId msgFlags msgBody = do
  (msgId, pqEnc) <- A.sendMessage c connId PQEncOn msgFlags msgBody
  liftIO $ pqEnc `shouldBe` PQEncOn
  pure msgId

functionalAPITests :: ATransport -> Spec
functionalAPITests t = do
  describe "Establishing duplex connection" $ do
    testMatrix2 t runAgentClientTest
    it "should connect when server with multiple identities is stored" $
      withSmpServer t testServerMultipleIdentities
    it "should connect with two peers" $
      withSmpServer t testAgentClient3
    it "should establish connection without PQ encryption and enable it" $
      withSmpServer t testEnablePQEncryption
  describe "Duplex connection - delivery stress test" $ do
    describe "one way (50)" $ testMatrix2Stress t $ runAgentClientStressTestOneWay 50
    xdescribe "one way (1000)" $ testMatrix2Stress t $ runAgentClientStressTestOneWay 1000
    describe "two way concurrently (50)" $ testMatrix2Stress t $ runAgentClientStressTestConc 25
    xdescribe "two way concurrently (1000)" $ testMatrix2Stress t $ runAgentClientStressTestConc 500
  describe "Establishing duplex connection, different PQ settings" $ do
    testPQMatrix2 t $ runAgentClientTestPQ True
  describe "Establishing duplex connection v2, different Ratchet versions" $
    testRatchetMatrix2 t runAgentClientTest
  describe "Establish duplex connection via contact address" $
    testMatrix2 t runAgentClientContactTest
  describe "Establish duplex connection via contact address, different PQ settings" $ do
    testPQMatrix2NoInv t $ runAgentClientContactTestPQ True PQSupportOn
  describe "Establish duplex connection via contact address v2, different Ratchet versions" $
    testRatchetMatrix2 t runAgentClientContactTest
  describe "Establish duplex connection via contact address, different PQ settings" $ do
    testPQMatrix3 t $ runAgentClientContactTestPQ3 True
  it "should support rejecting contact request" $
    withSmpServer t testRejectContactRequest
  describe "Establishing connection asynchronously" $ do
    it "should connect with initiating client going offline" $
      withSmpServer t testAsyncInitiatingOffline
    it "should connect with joining client going offline before its queue activation" $
      withSmpServer t testAsyncJoiningOfflineBeforeActivation
    it "should connect with both clients going offline" $
      withSmpServer t testAsyncBothOffline
    it "should connect on the second attempt if server was offline" $
      testAsyncServerOffline t
    it "should restore confirmation after client restart" $
      testAllowConnectionClientRestart t
  describe "Message delivery" $ do
    describe "update connection agent version on received messages" $ do
      it "should increase if compatible, shouldn't decrease" $
        testIncreaseConnAgentVersion t
      it "should increase to max compatible version" $
        testIncreaseConnAgentVersionMaxCompatible t
      it "should increase when connection was negotiated on different versions" $
        testIncreaseConnAgentVersionStartDifferentVersion t
    -- TODO PQ tests for upgrading connection to PQ encryption
    it "should deliver message after client restart" $
      testDeliverClientRestart t
    it "should deliver messages to the user once, even if repeat delivery is made by the server (no ACK)" $
      testDuplicateMessage t
    it "should report error via msg integrity on skipped messages" $
      testSkippedMessages t
    it "should connect to the server when server goes up if it initially was down" $
      testDeliveryAfterSubscriptionError t
    it "should deliver messages if one of connections has quota exceeded" $
      testMsgDeliveryQuotaExceeded t
    describe "message expiration" $ do
      it "should expire one message" $ testExpireMessage t
      it "should expire multiple messages" $ testExpireManyMessages t
      it "should expire one message if quota is exceeded" $ testExpireMessageQuota t
      it "should expire multiple messages if quota is exceeded" $ testExpireManyMessagesQuota t
    describe "Ratchet synchronization" $ do
      it "should report ratchet de-synchronization, synchronize ratchets" $
        testRatchetSync t
      it "should synchronize ratchets after server being offline" $
        testRatchetSyncServerOffline t
      it "should synchronize ratchets after client restart" $
        testRatchetSyncClientRestart t
      it "should synchronize ratchets after suspend/foreground" $
        testRatchetSyncSuspendForeground t
      it "should synchronize ratchets when clients start synchronization simultaneously" $
        testRatchetSyncSimultaneous t
    describe "Subscription mode OnlyCreate" $ do
      it "messages delivered only when polled (v8 - slow handshake)" $
        withSmpServer t testOnlyCreatePullSlowHandshake
      it "messages delivered only when polled" $
        withSmpServer t testOnlyCreatePull
  describe "Inactive client disconnection" $ do
    it "should disconnect clients without subs if they were inactive longer than TTL" $
      testInactiveNoSubs t
    it "should NOT disconnect inactive clients when they have subscriptions" $
      testInactiveWithSubs t
    it "should NOT disconnect active clients" $
      testActiveClientNotDisconnected t
  describe "Suspending agent" $ do
    it "should update client when agent is suspended" $
      withSmpServer t testSuspendingAgent
    it "should complete sending messages when agent is suspended" $
      testSuspendingAgentCompleteSending t
    it "should suspend agent on timeout, even if pending messages not sent" $
      testSuspendingAgentTimeout t
  describe "Batching SMP commands" $ do
    it "should subscribe to multiple (200) subscriptions with batching" $
      testBatchedSubscriptions 200 10 t
    skip "faster version of the previous test (200 subscriptions gets very slow with test coverage)" $
      it "should subscribe to multiple (6) subscriptions with batching" $
        testBatchedSubscriptions 6 3 t
    it "should subscribe to multiple connections with pending messages" $
      withSmpServer t $
        testBatchedPendingMessages 10 5
  describe "Async agent commands" $ do
    describe "connect using async agent commands" $
      testBasicMatrix2 t testAsyncCommands
    it "should restore and complete async commands on restart" $
      testAsyncCommandsRestore t
    describe "accept connection using async command" $
      testBasicMatrix2 t testAcceptContactAsync
    it "should delete connections using async command when server connection fails" $
      testDeleteConnectionAsync t
    it "join connection when reply queue creation fails (v8 - slow handshake)" $
      testJoinConnectionAsyncReplyErrorV8 t
    it "join connection when reply queue creation fails" $
      testJoinConnectionAsyncReplyError t
    describe "delete connection waiting for delivery" $ do
      it "should delete connection immediately if there are no pending messages" $
        testWaitDeliveryNoPending t
      it "should delete connection after waiting for delivery to complete" $
        testWaitDelivery t
      it "should delete connection if message can't be delivered due to AUTH error" $
        testWaitDeliveryAUTHErr t
      it "should delete connection by timeout even if message wasn't delivered" $
        testWaitDeliveryTimeout t
      it "should delete connection by timeout, message in progress can be delivered" $
        testWaitDeliveryTimeout2 t
  describe "Users" $ do
    it "should create and delete user with connections" $
      withSmpServer t testUsers
    it "should create and delete user without connections" $
      withSmpServer t testDeleteUserQuietly
    it "should create and delete user with connections when server connection fails" $
      testUsersNoServer t
    it "should connect two users and switch session mode" $
      withSmpServer t testTwoUsers
  describe "Connection switch" $ do
    describe "should switch delivery to the new queue" $
      testServerMatrix2 t testSwitchConnection
    describe "should switch to new queue asynchronously" $
      testServerMatrix2 t testSwitchAsync
    describe "should delete connection during switch" $
      testServerMatrix2 t testSwitchDelete
    describe "should abort switch in Started phase" $
      testServerMatrix2 t testAbortSwitchStarted
    describe "should abort switch in Started phase, reinitiate immediately" $
      testServerMatrix2 t testAbortSwitchStartedReinitiate
    describe "should prohibit to abort switch in Secured phase" $
      testServerMatrix2 t testCannotAbortSwitchSecured
    describe "should switch two connections simultaneously" $
      testServerMatrix2 t testSwitch2Connections
    describe "should switch two connections simultaneously, abort one" $
      testServerMatrix2 t testSwitch2ConnectionsAbort1
  describe "SMP basic auth" $ do
    let v4 = prevVersion basicAuthSMPVersion
    forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do
      let baseId = if v >= sndAuthKeySMPVersion then 1 else 3
      describe ("v" <> show v <> ": with server auth") $ do
        --                                       allow NEW | server auth, v | clnt1 auth, v  | clnt2 auth, v    |  2 - success, 1 - JOIN fail, 0 - NEW fail
        it "success                " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 2
        it "disabled               " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 0
        it "NEW fail, no auth      " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) baseId `shouldReturn` 0
        it "NEW fail, bad auth     " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) baseId `shouldReturn` 0
        it "NEW fail, version      " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) baseId `shouldReturn` 0
        it "JOIN fail, no auth     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) baseId `shouldReturn` 1
        it "JOIN fail, bad auth    " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) baseId `shouldReturn` 1
        it "JOIN fail, version     " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) baseId `shouldReturn` 1
      describe ("v" <> show v <> ": no server auth") $ do
        it "success     " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) baseId `shouldReturn` 2
        it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) baseId `shouldReturn` 0
        it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) 3 `shouldReturn` 2
        it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) baseId `shouldReturn` 2
        it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) 3 `shouldReturn` 2
        it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) 3 `shouldReturn` 2
        it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) 3 `shouldReturn` 2
        it "auth fst    " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) baseId `shouldReturn` 2
        it "auth fst 2  " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) 3 `shouldReturn` 2
        it "auth snd    " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) baseId `shouldReturn` 2
        it "auth both   " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 2
        it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) baseId `shouldReturn` 0
  describe "SMP server test via agent API" $ do
    it "should pass without basic auth" $ testSMPServerConnectionTest t Nothing (noAuthSrv testSMPServer2) `shouldReturn` Nothing
    let srv1 = testSMPServer2 {keyHash = "1234"}
    it "should fail with incorrect fingerprint" $ do
      testSMPServerConnectionTest t Nothing (noAuthSrv srv1) `shouldReturn` Just (ProtocolTestFailure TSConnect $ BROKER (B.unpack $ strEncode srv1) NETWORK)
    describe "server with password" $ do
      let auth = Just "abcd"
          srv = ProtoServerWithAuth testSMPServer2
          authErr = Just (ProtocolTestFailure TSCreateQueue $ SMP (B.unpack $ strEncode testSMPServer2) AUTH)
      it "should pass with correct password" $ testSMPServerConnectionTest t auth (srv auth) `shouldReturn` Nothing
      it "should fail without password" $ testSMPServerConnectionTest t auth (srv Nothing) `shouldReturn` authErr
      it "should fail with incorrect password" $ testSMPServerConnectionTest t auth (srv $ Just "wrong") `shouldReturn` authErr
  describe "getRatchetAdHash" $
    it "should return the same data for both peers" $
      withSmpServer t testRatchetAdHash
  describe "Delivery receipts" $ do
    it "should send and receive delivery receipt" $ withSmpServer t testDeliveryReceipts
    it "should send delivery receipt only in connection v3+" $ testDeliveryReceiptsVersion t
    it "send delivery receipts concurrently with messages" $ testDeliveryReceiptsConcurrent t
  describe "user network info" $ do
    it "should wait for user network" testWaitForUserNetwork
    it "should not reset online to offline if happens too quickly" testDoNotResetOnlineToOffline
    it "should resume multiple threads" testResumeMultipleThreads
  describe "SMP queue info" $ do
    it "server should respond with queue and subscription information" $
      withSmpServer t testServerQueueInfo

testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 baseId = do
  let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange batchCmdsSMPVersion srvVersion}
      canCreate1 = canCreateQueue allowNewQueues srv clnt1
      canCreate2 = canCreateQueue allowNewQueues srv clnt2
      expected
        | canCreate1 && canCreate2 = 2
        | canCreate1 = 1
        | otherwise = 0
  created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth srvVersion clnt1 clnt2 baseId
  created `shouldBe` expected
  pure created

canCreateQueue :: Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> Bool
canCreateQueue allowNew (srvAuth, srvVersion) (clntAuth, clntVersion) =
  let v = basicAuthSMPVersion
   in allowNew && (isNothing srvAuth || (srvVersion >= v && clntVersion >= v && srvAuth == clntAuth))

testMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
testMatrix2 t runTest = do
  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff False
  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False
  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False

testMatrix2Stress :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
testMatrix2Stress t runTest = do
  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aCfg aCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aProxyCfgV8 aProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
  it "current" $ withSmpServer t $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn False
  it "prev" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfgVPrev 3 $ runTest PQSupportOff False
  it "prev to current" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfg 3 $ runTest PQSupportOff False
  it "current to prev" $ withSmpServer t $ runTestCfg2 aCfg aCfgVPrev 3 $ runTest PQSupportOff False
  where
    aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
    aProxyCfgV8 = agentProxyCfgV8 {messageRetryInterval = fastMessageRetryInterval}
    aCfgVPrev = agentCfgVPrev {messageRetryInterval = fastMessageRetryInterval}

testBasicMatrix2 :: HasCallStack => ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
testBasicMatrix2 t runTest = do
  it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest
  it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 3 $ runTest
  it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfg 3 $ runTest
  it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrevPQ 3 $ runTest

testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
testRatchetMatrix2 t runTest = do
  it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True
  it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn True
  it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn False
  it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff False
  it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff False
  it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff False

testServerMatrix2 :: HasCallStack => ATransport -> (InitialAgentServers -> IO ()) -> Spec
testServerMatrix2 t runTest = do
  it "1 server" $ withSmpServer t $ runTest initAgentServers
  it "2 servers" $ withSmpServer t . withSmpServerOn t testPort2 $ runTest initAgentServers2

testPQMatrix2 :: HasCallStack => ATransport -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
testPQMatrix2 = pqMatrix2_ True

testPQMatrix2NoInv :: HasCallStack => ATransport -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
testPQMatrix2NoInv = pqMatrix2_ False

pqMatrix2_ :: HasCallStack => Bool -> ATransport -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
pqMatrix2_ pqInv t test = do
  it "dh/dh handshake" $ runTest $ \a b -> test (a, IKPQOff) (b, PQSupportOff)
  it "dh/pq handshake" $ runTest $ \a b -> test (a, IKPQOff) (b, PQSupportOn)
  it "pq/dh handshake" $ runTest $ \a b -> test (a, IKPQOn) (b, PQSupportOff)
  it "pq/pq handshake" $ runTest $ \a b -> test (a, IKPQOn) (b, PQSupportOn)
  when pqInv $ do
    it "pq-inv/dh handshake" $ runTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOff)
    it "pq-inv/pq handshake" $ runTest $ \a b -> test (a, IKUsePQ) (b, PQSupportOn)
  where
    runTest = withSmpServerProxy t . runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3

testPQMatrix3 ::
  HasCallStack =>
  ATransport ->
  (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) ->
  Spec
testPQMatrix3 t test = do
  it "dh" $ runTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOff) (c, PQSupportOff)
  it "dh/dh/pq" $ runTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOff) (c, PQSupportOn)
  it "dh/pq/dh" $ runTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOn) (c, PQSupportOff)
  it "dh/pq/pq" $ runTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOn) (c, PQSupportOn)
  it "pq/dh/dh" $ runTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOff) (c, PQSupportOff)
  it "pq/dh/pq" $ runTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOff) (c, PQSupportOn)
  it "pq/pq/dh" $ runTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOn) (c, PQSupportOff)
  it "pq" $ runTest $ \a b c -> test (a, IKPQOn) (b, PQSupportOn) (c, PQSupportOn)
  where
    runTest test' =
      withSmpServerProxy t $
        runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 servers 3 $ \a b baseMsgId ->
          withAgent 3 agentProxyCfgV8 servers testDB3 $ \c -> test' a b c baseMsgId
    servers = initAgentServersProxy SPMAlways SPFProhibit

runTestCfg2 :: HasCallStack => AgentConfig -> AgentConfig -> AgentMsgId -> (HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
runTestCfg2 aCfg bCfg = runTestCfgServers2 aCfg bCfg initAgentServers
{-# INLINE runTestCfg2 #-}

runTestCfgServers2 :: HasCallStack => AgentConfig -> AgentConfig -> InitialAgentServers -> AgentMsgId -> (HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
runTestCfgServers2 aCfg bCfg servers baseMsgId runTest =
  withAgentClientsCfgServers2 aCfg bCfg servers $ \a b -> runTest a b baseMsgId
{-# INLINE runTestCfgServers2 #-}

withAgentClientsCfgServers2 :: HasCallStack => AgentConfig -> AgentConfig -> InitialAgentServers -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
withAgentClientsCfgServers2 aCfg bCfg servers runTest =
  withAgent 1 aCfg servers testDB $ \a ->
    withAgent 2 bCfg servers testDB2 $ \b ->
      runTest a b

withAgentClientsCfg2 :: HasCallStack => AgentConfig -> AgentConfig -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
withAgentClientsCfg2 aCfg bCfg = withAgentClientsCfgServers2 aCfg bCfg initAgentServers
{-# INLINE withAgentClientsCfg2 #-}

withAgentClients2 :: HasCallStack => (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
withAgentClients2 = withAgentClientsCfg2 agentCfg agentCfg
{-# INLINE withAgentClients2 #-}

withAgentClients3 :: HasCallStack => (HasCallStack => AgentClient -> AgentClient -> AgentClient -> IO ()) -> IO ()
withAgentClients3 runTest =
  withAgentClients2 $ \a b ->
    withAgent 3 agentCfg initAgentServers testDB3 $ \c ->
      runTest a b c

runAgentClientTest :: HasCallStack => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
runAgentClientTest pqSupport viaProxy alice bob baseId =
  runAgentClientTestPQ viaProxy (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId

runAgentClientTestPQ :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId =
  runRight_ $ do
    (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing aPQ SMSubscribe
    aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" bPQ SMSubscribe
    ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
    liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ
    allowConnection alice bobId confId "alice's connInfo"
    let pqEnc = PQEncryption $ pqConnectionMode aPQ bPQ
    get alice ##> ("", bobId, A.CON pqEnc)
    get bob ##> ("", aliceId, A.INFO bPQ "alice's connInfo")
    get bob ##> ("", aliceId, A.CON pqEnc)
    -- message IDs 1 to 3 (or 1 to 4 in v1) get assigned to control messages, so first MSG is assigned ID 4
    let proxySrv = if viaProxy then Just testSMPServer else Nothing
    1 <- msgId <$> A.sendMessage alice bobId pqEnc SMP.noMsgFlags "hello"
    get alice ##> ("", bobId, A.SENT (baseId + 1) proxySrv)
    2 <- msgId <$> A.sendMessage alice bobId pqEnc SMP.noMsgFlags "how are you?"
    get alice ##> ("", bobId, A.SENT (baseId + 2) proxySrv)
    get bob =##> \case ("", c, Msg' _ pq "hello") -> c == aliceId && pq == pqEnc; _ -> False
    ackMessage bob aliceId (baseId + 1) Nothing
    get bob =##> \case ("", c, Msg' _ pq "how are you?") -> c == aliceId && pq == pqEnc; _ -> False
    ackMessage bob aliceId (baseId + 2) Nothing
    3 <- msgId <$> A.sendMessage bob aliceId pqEnc SMP.noMsgFlags "hello too"
    get bob ##> ("", aliceId, A.SENT (baseId + 3) proxySrv)
    4 <- msgId <$> A.sendMessage bob aliceId pqEnc SMP.noMsgFlags "message 1"
    get bob ##> ("", aliceId, A.SENT (baseId + 4) proxySrv)
    get alice =##> \case ("", c, Msg' _ pq "hello too") -> c == bobId && pq == pqEnc; _ -> False
    ackMessage alice bobId (baseId + 3) Nothing
    get alice =##> \case ("", c, Msg' _ pq "message 1") -> c == bobId && pq == pqEnc; _ -> False
    ackMessage alice bobId (baseId + 4) Nothing
    suspendConnection alice bobId
    5 <- msgId <$> A.sendMessage bob aliceId pqEnc SMP.noMsgFlags "message 2"
    get bob =##> \case ("", cId, MERR mId (SMP _ AUTH)) -> cId == aliceId && mId == (baseId + 5); _ -> False
    deleteConnection alice bobId
    liftIO $ noMessages alice "nothing else should be delivered to alice"
  where
    msgId = subtract baseId . fst

pqConnectionMode :: InitialKeys -> PQSupport -> Bool
pqConnectionMode pqMode1 pqMode2 = supportPQ (CR.connPQEncryption pqMode1) && supportPQ pqMode2

runAgentClientStressTestOneWay :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
runAgentClientStressTestOneWay n pqSupport viaProxy alice bob baseId = runRight_ $ do
  let pqEnc = PQEncryption $ supportPQ pqSupport
  (aliceId, bobId) <- makeConnection_ pqSupport alice bob
  let proxySrv = if viaProxy then Just testSMPServer else Nothing
      message i = "message " <> bshow i
  concurrently_
    ( forM_ ([1 .. n] :: [Int64]) $ \i -> do
        mId <- msgId <$> A.sendMessage alice bobId pqEnc SMP.noMsgFlags (message i)
        liftIO $ do
          mId >= i `shouldBe` True
          let getEvent =
                get alice >>= \case
                  ("", c, A.SENT mId' srv) -> c == bobId && mId' >= baseId + i && srv == proxySrv `shouldBe` True
                  ("", c, QCONT) -> do
                    c == bobId `shouldBe` True
                    getEvent
                  r -> expectationFailure $ "wrong message: " <> show r
          getEvent
    )
    ( forM_ ([1 .. n] :: [Int64]) $ \i -> do
        get bob >>= \case
          ("", c, Msg' mId pq msg) -> do
            liftIO $ c == aliceId && mId >= baseId + i && pq == pqEnc && msg == message i `shouldBe` True
            ackMessage bob aliceId mId Nothing
          r -> liftIO $ expectationFailure $ "wrong message: " <> show r
    )
  liftIO $ noMessagesIngoreQCONT alice "nothing else should be delivered to alice"
  liftIO $ noMessagesIngoreQCONT bob "nothing else should be delivered to bob"
  where
    msgId = subtract baseId . fst

runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
runAgentClientStressTestConc n pqSupport viaProxy alice bob baseId = runRight_ $ do
  let pqEnc = PQEncryption $ supportPQ pqSupport
  (aliceId, bobId) <- makeConnection_ pqSupport alice bob
  let proxySrv = if viaProxy then Just testSMPServer else Nothing
      message i = "message " <> bshow i
      loop a bId mIdVar i = do
        when (i <= n) $ do
          mId <- msgId <$> A.sendMessage a bId pqEnc SMP.noMsgFlags (message i)
          liftIO $ mId >= i `shouldBe` True
        let getEvent = do
              get a >>= \case
                ("", c, A.SENT _ srv) -> liftIO $ c == bId && srv == proxySrv `shouldBe` True
                ("", c, QCONT) -> do
                  liftIO $ c == bId `shouldBe` True
                  getEvent
                ("", c, Msg' mId pq msg) -> do
                  -- tests that mId increases
                  liftIO $ (mId >) <$> atomically (swapTVar mIdVar mId) `shouldReturn` True
                  liftIO $ c == bId && pq == pqEnc && ("message " `B.isPrefixOf` msg) `shouldBe` True
                  ackMessage a bId mId Nothing
                r -> liftIO $ expectationFailure $ "wrong message: " <> show r
        getEvent
  amId <- newTVarIO 0
  bmId <- newTVarIO 0
  concurrently_
    (forM_ ([1 .. n * 2] :: [Int64]) $ loop alice bobId amId)
    (forM_ ([1 .. n * 2] :: [Int64]) $ loop bob aliceId bmId)
  liftIO $ noMessagesIngoreQCONT alice "nothing else should be delivered to alice"
  liftIO $ noMessagesIngoreQCONT bob "nothing else should be delivered to bob"
  where
    msgId = subtract baseId . fst

testEnablePQEncryption :: HasCallStack => IO ()
testEnablePQEncryption =
  withAgentClients2 $ \ca cb -> runRight_ $ do
    g <- liftIO C.newRandom
    (aId, bId) <- makeConnection_ PQSupportOff ca cb
    let a = (ca, aId)
        b = (cb, bId)
    (a, 2, "msg 1") \#>\ b
    (b, 3, "msg 2") \#>\ a
    -- 45 bytes is used by agent message envelope inside double ratchet message envelope
    let largeMsg g' pqEnc = atomically $ C.randomBytes (e2eEncAgentMsgLength pqdrSMPAgentVersion pqEnc - 45) g'
    lrg <- largeMsg g PQSupportOff
    (a, 4, lrg) \#>\ b
    (b, 5, lrg) \#>\ a
    -- switched to smaller envelopes (before reporting PQ encryption enabled)
    sml <- largeMsg g PQSupportOn
    -- fail because of message size
    Left (A.CMD LARGE _) <- tryError $ A.sendMessage ca bId PQEncOn SMP.noMsgFlags lrg
    (7, PQEncOff) <- A.sendMessage ca bId PQEncOn SMP.noMsgFlags sml
    get ca =##> \case ("", connId, SENT 7) -> connId == bId; _ -> False
    get cb =##> \case ("", connId, MsgErr' 6 MsgSkipped {} PQEncOff msg') -> connId == aId && msg' == sml; _ -> False
    ackMessage cb aId 6 Nothing
    -- -- fail in reply to sync IDss
    Left (A.CMD LARGE _) <- tryError $ A.sendMessage cb aId PQEncOn SMP.noMsgFlags lrg
    (8, PQEncOff) <- A.sendMessage cb aId PQEncOn SMP.noMsgFlags sml
    get cb =##> \case ("", connId, SENT 8) -> connId == aId; _ -> False
    get ca =##> \case ("", connId, MsgErr' 8 MsgSkipped {} PQEncOff msg') -> connId == bId && msg' == sml; _ -> False
    ackMessage ca bId 8 Nothing
    (a, 9, sml) \#>! b
    -- PQ encryption now enabled
    (b, 10, sml) !#>! a
    (a, 11, sml) !#>! b
    (b, 12, sml) !#>! a
    -- disabling PQ encryption
    (a, 13, sml) !#>\ b
    (b, 14, sml) !#>\ a
    (a, 15, sml) \#>\ b
    (b, 16, sml) \#>\ a
    -- enabling PQ encryption again
    (a, 17, sml) \#>! b
    (b, 18, sml) \#>! a
    (a, 19, sml) \#>! b
    (b, 20, sml) !#>! a
    (a, 21, sml) !#>! b
    -- disabling PQ encryption again
    (b, 22, sml) !#>\ a
    (a, 23, sml) !#>\ b
    (b, 24, sml) \#>\ a
    (a, 25, sml) \#>\ b
    -- PQ encryption is now disabled, but support remained enabled, so we still cannot send larger messages
    Left (A.CMD LARGE _) <- tryError $ A.sendMessage ca bId PQEncOff SMP.noMsgFlags (sml <> "123456")
    Left (A.CMD LARGE _) <- tryError $ A.sendMessage cb aId PQEncOff SMP.noMsgFlags (sml <> "123456")
    pure ()
  where
    (\#>\) = PQEncOff `sndRcv` PQEncOff
    (\#>!) = PQEncOff `sndRcv` PQEncOn
    (!#>!) = PQEncOn `sndRcv` PQEncOn
    (!#>\) = PQEncOn `sndRcv` PQEncOff

sndRcv :: PQEncryption -> PQEncryption -> ((AgentClient, ConnId), AgentMsgId, MsgBody) -> (AgentClient, ConnId) -> ExceptT AgentErrorType IO ()
sndRcv pqEnc pqEnc' ((c1, id1), mId, msg) (c2, id2) = do
  r <- A.sendMessage c1 id2 pqEnc' SMP.noMsgFlags msg
  liftIO $ r `shouldBe` (mId, pqEnc)
  get c1 =##> \case ("", connId, SENT mId') -> connId == id2 && mId' == mId; _ -> False
  get c2 =##> \case ("", connId, Msg' mId' pq msg') -> connId == id1 && mId' == mId && msg' == msg && pq == pqEnc; _ -> False
  ackMessage c2 id1 mId Nothing

testAgentClient3 :: HasCallStack => IO ()
testAgentClient3 =
  withAgentClients3 $ \a b c -> runRight_ $ do
    (aIdForB, bId) <- makeConnection a b
    (aIdForC, cId) <- makeConnection a c

    2 <- sendMessage a bId SMP.noMsgFlags "b4"
    2 <- sendMessage a cId SMP.noMsgFlags "c4"
    3 <- sendMessage a bId SMP.noMsgFlags "b5"
    3 <- sendMessage a cId SMP.noMsgFlags "c5"
    get a =##> \case ("", connId, SENT 2) -> connId == bId || connId == cId; _ -> False
    get a =##> \case ("", connId, SENT 2) -> connId == bId || connId == cId; _ -> False
    get a =##> \case ("", connId, SENT 3) -> connId == bId || connId == cId; _ -> False
    get a =##> \case ("", connId, SENT 3) -> connId == bId || connId == cId; _ -> False
    get b =##> \case ("", connId, Msg "b4") -> connId == aIdForB; _ -> False
    ackMessage b aIdForB 2 Nothing
    get b =##> \case ("", connId, Msg "b5") -> connId == aIdForB; _ -> False
    ackMessage b aIdForB 3 Nothing
    get c =##> \case ("", connId, Msg "c4") -> connId == aIdForC; _ -> False
    ackMessage c aIdForC 2 Nothing
    get c =##> \case ("", connId, Msg "c5") -> connId == aIdForC; _ -> False
    ackMessage c aIdForC 3 Nothing

runAgentClientContactTest :: HasCallStack => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
runAgentClientContactTest pqSupport viaProxy alice bob baseId =
  runAgentClientContactTestPQ viaProxy pqSupport (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId

runAgentClientContactTestPQ :: HasCallStack => Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
runAgentClientContactTestPQ viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId =
  runRight_ $ do
    (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing aPQ SMSubscribe
    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
    aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" bPQ SMSubscribe
    liftIO $ aliceId' `shouldBe` aliceId
    ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
    liftIO $ pqSup' `shouldBe` reqPQSupport
    bobId <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
    ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get bob
    liftIO $ pqSup'' `shouldBe` bPQ
    allowConnection bob aliceId confId "bob's connInfo"
    let pqEnc = PQEncryption $ pqConnectionMode aPQ bPQ
    get alice ##> ("", bobId, A.INFO (CR.connPQEncryption aPQ) "bob's connInfo")
    get alice ##> ("", bobId, A.CON pqEnc)
    get bob ##> ("", aliceId, A.CON pqEnc)
    -- message IDs 1 to 3 (or 1 to 4 in v1) get assigned to control messages, so first MSG is assigned ID 4
    let proxySrv = if viaProxy then Just testSMPServer else Nothing
    1 <- msgId <$> A.sendMessage alice bobId pqEnc SMP.noMsgFlags "hello"
    get alice ##> ("", bobId, A.SENT (baseId + 1) proxySrv)
    2 <- msgId <$> A.sendMessage alice bobId pqEnc SMP.noMsgFlags "how are you?"
    get alice ##> ("", bobId, A.SENT (baseId + 2) proxySrv)
    get bob =##> \case ("", c, Msg' _ pq "hello") -> c == aliceId && pq == pqEnc; _ -> False
    ackMessage bob aliceId (baseId + 1) Nothing
    get bob =##> \case ("", c, Msg' _ pq "how are you?") -> c == aliceId && pq == pqEnc; _ -> False
    ackMessage bob aliceId (baseId + 2) Nothing
    3 <- msgId <$> A.sendMessage bob aliceId pqEnc SMP.noMsgFlags "hello too"
    get bob ##> ("", aliceId, A.SENT (baseId + 3) proxySrv)
    4 <- msgId <$> A.sendMessage bob aliceId pqEnc SMP.noMsgFlags "message 1"
    get bob ##> ("", aliceId, A.SENT (baseId + 4) proxySrv)
    get alice =##> \case ("", c, Msg' _ pq "hello too") -> c == bobId && pq == pqEnc; _ -> False
    ackMessage alice bobId (baseId + 3) Nothing
    get alice =##> \case ("", c, Msg' _ pq "message 1") -> c == bobId && pq == pqEnc; _ -> False
    ackMessage alice bobId (baseId + 4) Nothing
    suspendConnection alice bobId
    5 <- msgId <$> A.sendMessage bob aliceId pqEnc SMP.noMsgFlags "message 2"
    get bob =##> \case ("", cId, MERR mId (SMP _ AUTH)) -> cId == aliceId && mId == (baseId + 5); _ -> False
    deleteConnection alice bobId
    liftIO $ noMessages alice "nothing else should be delivered to alice"
  where
    msgId = subtract baseId . fst

runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do
  (_, qInfo) <- A.createConnection alice 1 True SCMContact Nothing aPQ SMSubscribe
  (bAliceId, bobId, abPQEnc) <- connectViaContact bob bPQ qInfo
  sentMessages abPQEnc alice bobId bob bAliceId
  (tAliceId, tomId, atPQEnc) <- connectViaContact tom tPQ qInfo
  sentMessages atPQEnc alice tomId tom tAliceId
  where
    msgId = subtract baseId . fst
    connectViaContact b pq qInfo = do
      aId <- A.prepareConnectionToJoin b 1 True qInfo pq
      aId' <- A.joinConnection b 1 (Just aId) True qInfo "bob's connInfo" pq SMSubscribe
      liftIO $ aId' `shouldBe` aId
      ("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
      liftIO $ pqSup' `shouldBe` PQSupportOn
      bId <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
      ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b
      liftIO $ pqSup'' `shouldBe` pq
      allowConnection b aId confId "bob's connInfo"
      let pqEnc = PQEncryption $ pqConnectionMode aPQ pq
      get alice ##> ("", bId, A.INFO (CR.connPQEncryption aPQ) "bob's connInfo")
      get alice ##> ("", bId, A.CON pqEnc)
      get b ##> ("", aId, A.CON pqEnc)
      pure (aId, bId, pqEnc)
    sentMessages pqEnc a bId b aId = do
      let proxySrv = if viaProxy then Just testSMPServer else Nothing
      1 <- msgId <$> A.sendMessage a bId pqEnc SMP.noMsgFlags "hello"
      get a ##> ("", bId, A.SENT (baseId + 1) proxySrv)
      get b =##> \case ("", c, Msg' _ pq "hello") -> c == aId && pq == pqEnc; _ -> False
      ackMessage b aId (baseId + 1) Nothing
      2 <- msgId <$> A.sendMessage b aId pqEnc SMP.noMsgFlags "hello too"
      get b ##> ("", aId, A.SENT (baseId + 2) proxySrv)
      get a =##> \case ("", c, Msg' _ pq "hello too") -> c == bId && pq == pqEnc; _ -> False
      ackMessage a bId (baseId + 2) Nothing

noMessages :: HasCallStack => AgentClient -> String -> Expectation
noMessages = noMessages_ False

noMessagesIngoreQCONT :: AgentClient -> String -> Expectation
noMessagesIngoreQCONT = noMessages_ True

noMessages_ :: Bool -> HasCallStack => AgentClient -> String -> Expectation
noMessages_ ingoreQCONT c err = tryGet `shouldReturn` ()
  where
    tryGet =
      10000 `timeout` get c >>= \case
        Just (_, _, QCONT) | ingoreQCONT -> noMessages_ ingoreQCONT c err
        Just msg -> error $ err <> ": " <> show msg
        _ -> return ()

testRejectContactRequest :: HasCallStack => IO ()
testRejectContactRequest =
  withAgentClients2 $ \alice bob -> runRight_ $ do
    (addrConnId, qInfo) <- A.createConnection alice 1 True SCMContact Nothing IKPQOn SMSubscribe
    aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
    aliceId' <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe
    liftIO $ aliceId' `shouldBe` aliceId
    ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice
    liftIO $ runExceptT (rejectContact alice "abcd" invId) `shouldReturn` Left (CONN NOT_FOUND)
    rejectContact alice addrConnId invId
    liftIO $ noMessages bob "nothing delivered to bob"

testAsyncInitiatingOffline :: HasCallStack => IO ()
testAsyncInitiatingOffline =
  withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> runRight_ $ do
    alice <- liftIO $ getSMPAgentClient' 1 agentCfg initAgentServers testDB
    (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    liftIO $ disposeAgentClient alice
    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    alice' <- liftIO $ getSMPAgentClient' 3 agentCfg initAgentServers testDB
    subscribeConnection alice' bobId
    ("", _, CONF confId _ "bob's connInfo") <- get alice'
    allowConnection alice' bobId confId "alice's connInfo"
    get alice' ##> ("", bobId, CON)
    get bob ##> ("", aliceId, INFO "alice's connInfo")
    get bob ##> ("", aliceId, CON)
    exchangeGreetings alice' bobId bob aliceId
    liftIO $ disposeAgentClient alice'

testAsyncJoiningOfflineBeforeActivation :: HasCallStack => IO ()
testAsyncJoiningOfflineBeforeActivation =
  withAgent 1 agentCfg initAgentServers testDB $ \alice -> runRight_ $ do
    bob <- liftIO $ getSMPAgentClient' 2 agentCfg initAgentServers testDB2
    (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
    liftIO $ disposeAgentClient bob
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnection alice bobId confId "alice's connInfo"
    bob' <- liftIO $ getSMPAgentClient' 3 agentCfg initAgentServers testDB2
    subscribeConnection bob' aliceId
    get alice ##> ("", bobId, CON)
    get bob' ##> ("", aliceId, INFO "alice's connInfo")
    get bob' ##> ("", aliceId, CON)
    exchangeGreetings alice bobId bob' aliceId
    liftIO $ disposeAgentClient bob'

testAsyncBothOffline :: HasCallStack => IO ()
testAsyncBothOffline = do
  alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
  runRight_ $ do
    (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    liftIO $ disposeAgentClient alice
    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    liftIO $ disposeAgentClient bob
    alice' <- liftIO $ getSMPAgentClient' 3 agentCfg initAgentServers testDB
    subscribeConnection alice' bobId
    ("", _, CONF confId _ "bob's connInfo") <- get alice'
    allowConnection alice' bobId confId "alice's connInfo"
    bob' <- liftIO $ getSMPAgentClient' 4 agentCfg initAgentServers testDB2
    subscribeConnection bob' aliceId
    get alice' ##> ("", bobId, CON)
    get bob' ##> ("", aliceId, INFO "alice's connInfo")
    get bob' ##> ("", aliceId, CON)
    exchangeGreetings alice' bobId bob' aliceId
    liftIO $ disposeAgentClient alice'
    liftIO $ disposeAgentClient bob'

testAsyncServerOffline :: HasCallStack => ATransport -> IO ()
testAsyncServerOffline t = withAgentClients2 $ \alice bob -> do
  -- create connection and shutdown the server
  (bobId, cReq) <- withSmpServerStoreLogOn t testPort $ \_ ->
    runRight $ createConnection alice 1 True SCMInvitation Nothing SMSubscribe
  -- connection fails
  Left (BROKER _ NETWORK) <- runExceptT $ joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
  ("", "", DOWN srv conns) <- nGet alice
  srv `shouldBe` testSMPServer
  conns `shouldBe` [bobId]
  -- connection succeeds after server start
  withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
    ("", "", UP srv1 conns1) <- nGet alice
    liftIO $ do
      srv1 `shouldBe` testSMPServer
      conns1 `shouldBe` [bobId]
    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnection alice bobId confId "alice's connInfo"
    get alice ##> ("", bobId, CON)
    get bob ##> ("", aliceId, INFO "alice's connInfo")
    get bob ##> ("", aliceId, CON)
    exchangeGreetings alice bobId bob aliceId

testAllowConnectionClientRestart :: HasCallStack => ATransport -> IO ()
testAllowConnectionClientRestart t = do
  let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]}
  alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg initAgentServersSrv2 testDB2
  withSmpServerStoreLogOn t testPort $ \_ -> do
    (aliceId, bobId, confId) <-
      withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \_ -> do
        runRight $ do
          (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
          aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
          ("", _, CONF confId _ "bob's connInfo") <- get alice
          pure (aliceId, bobId, confId)

    ("", "", DOWN _ _) <- nGet bob

    runRight_ $ do
      allowConnectionAsync alice "1" bobId confId "alice's connInfo"
      get alice ##> ("1", bobId, OK)
      pure ()

    threadDelay 100000 -- give time to enqueue confirmation (enqueueConfirmation)
    disposeAgentClient alice
    threadDelay 250000

    alice2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB

    withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \_ -> do
      runRight $ do
        ("", "", UP _ _) <- nGet bob

        subscribeConnection alice2 bobId

        get alice2 ##> ("", bobId, CON)
        get bob ##> ("", aliceId, INFO "alice's connInfo")
        get bob ##> ("", aliceId, CON)
        exchangeGreetings alice2 bobId bob aliceId
    disposeAgentClient alice2
    disposeAgentClient bob

testIncreaseConnAgentVersion :: HasCallStack => ATransport -> IO ()
testIncreaseConnAgentVersion t = do
  alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aliceId, bobId) <- runRight $ do
      (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
      exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
      checkVersion alice bobId 2
      checkVersion bob aliceId 2
      pure (aliceId, bobId)

    -- version doesn't increase if incompatible

    disposeAgentClient alice
    threadDelay 250000
    alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB

    runRight_ $ do
      subscribeConnection alice2 bobId
      exchangeGreetingsMsgId_ PQEncOff 4 alice2 bobId bob aliceId
      checkVersion alice2 bobId 2
      checkVersion bob aliceId 2

    -- version increases if compatible

    disposeAgentClient bob
    threadDelay 250000
    bob2 <- getSMPAgentClient' 4 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2

    runRight_ $ do
      subscribeConnection bob2 aliceId
      exchangeGreetingsMsgId_ PQEncOff 6 alice2 bobId bob2 aliceId
      checkVersion alice2 bobId 3
      checkVersion bob2 aliceId 3

    -- version doesn't decrease, even if incompatible

    disposeAgentClient alice2
    threadDelay 250000
    alice3 <- getSMPAgentClient' 5 agentCfg {smpAgentVRange = mkVersionRange 2 2} initAgentServers testDB

    runRight_ $ do
      subscribeConnection alice3 bobId
      exchangeGreetingsMsgId_ PQEncOff 8 alice3 bobId bob2 aliceId
      checkVersion alice3 bobId 3
      checkVersion bob2 aliceId 3

    disposeAgentClient bob2
    threadDelay 250000
    bob3 <- getSMPAgentClient' 6 agentCfg {smpAgentVRange = mkVersionRange 1 1} initAgentServers testDB2

    runRight_ $ do
      subscribeConnection bob3 aliceId
      exchangeGreetingsMsgId_ PQEncOff 10 alice3 bobId bob3 aliceId
      checkVersion alice3 bobId 3
      checkVersion bob3 aliceId 3
    disposeAgentClient alice3
    disposeAgentClient bob3

checkVersion :: AgentClient -> ConnId -> Word16 -> ExceptT AgentErrorType IO ()
checkVersion c connId v = do
  ConnectionStats {connAgentVersion} <- getConnectionServers c connId
  liftIO $ connAgentVersion `shouldBe` VersionSMPA v

testIncreaseConnAgentVersionMaxCompatible :: HasCallStack => ATransport -> IO ()
testIncreaseConnAgentVersionMaxCompatible t = do
  alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aliceId, bobId) <- runRight $ do
      (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
      exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
      checkVersion alice bobId 2
      checkVersion bob aliceId 2
      pure (aliceId, bobId)

    -- version increases to max compatible

    disposeAgentClient alice
    threadDelay 250000
    alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
    disposeAgentClient bob
    threadDelay 250000
    bob2 <- getSMPAgentClient' 4 agentCfg {smpAgentVRange = supportedSMPAgentVRange} initAgentServers testDB2

    runRight_ $ do
      subscribeConnection alice2 bobId
      subscribeConnection bob2 aliceId
      exchangeGreetingsMsgId_ PQEncOff 4 alice2 bobId bob2 aliceId
      checkVersion alice2 bobId 3
      checkVersion bob2 aliceId 3
    disposeAgentClient alice2
    disposeAgentClient bob2

testIncreaseConnAgentVersionStartDifferentVersion :: HasCallStack => ATransport -> IO ()
testIncreaseConnAgentVersionStartDifferentVersion t = do
  alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aliceId, bobId) <- runRight $ do
      (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob
      exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId
      checkVersion alice bobId 2
      checkVersion bob aliceId 2
      pure (aliceId, bobId)

    -- version increases to max compatible

    disposeAgentClient alice
    threadDelay 250000
    alice2 <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB

    runRight_ $ do
      subscribeConnection alice2 bobId
      exchangeGreetingsMsgId_ PQEncOff 4 alice2 bobId bob aliceId
      checkVersion alice2 bobId 3
      checkVersion bob aliceId 3
    disposeAgentClient alice2
    disposeAgentClient bob

testDeliverClientRestart :: HasCallStack => ATransport -> IO ()
testDeliverClientRestart t = do
  alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2

  (aliceId, bobId) <- withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    runRight $ do
      (aliceId, bobId) <- makeConnection alice bob
      exchangeGreetings alice bobId bob aliceId
      pure (aliceId, bobId)

  ("", "", DOWN _ _) <- nGet alice
  ("", "", DOWN _ _) <- nGet bob

  4 <- runRight $ sendMessage bob aliceId SMP.noMsgFlags "hello"

  disposeAgentClient bob

  bob2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB2

  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    runRight_ $ do
      ("", "", UP _ _) <- nGet alice

      subscribeConnection bob2 aliceId

      get bob2 ##> ("", aliceId, SENT 4)
      get alice =##> \case ("", c, Msg "hello") -> c == bobId; _ -> False
  disposeAgentClient alice
  disposeAgentClient bob2

testDuplicateMessage :: HasCallStack => ATransport -> IO ()
testDuplicateMessage t = do
  alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
  (aliceId, bobId, bob1) <- withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aliceId, bobId) <- runRight $ makeConnection alice bob
    runRight_ $ do
      2 <- sendMessage alice bobId SMP.noMsgFlags "hello"
      get alice ##> ("", bobId, SENT 2)
      get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
    disposeAgentClient bob
    threadDelay 250000

    -- if the agent user did not send ACK, the message will be delivered again
    bob1 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB2
    runRight_ $ do
      subscribeConnection bob1 aliceId
      get bob1 =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
      ackMessage bob1 aliceId 2 Nothing
      3 <- sendMessage alice bobId SMP.noMsgFlags "hello 2"
      get alice ##> ("", bobId, SENT 3)
      get bob1 =##> \case ("", c, Msg "hello 2") -> c == aliceId; _ -> False

    pure (aliceId, bobId, bob1)

  nGet alice =##> \case ("", "", DOWN _ [c]) -> c == bobId; _ -> False
  nGet bob1 =##> \case ("", "", DOWN _ [c]) -> c == aliceId; _ -> False
  -- commenting two lines below and uncommenting further two lines would also runRight_,
  -- it is the scenario tested above, when the message was not acknowledged by the user
  threadDelay 200000
  Left (BROKER _ NETWORK) <- runExceptT $ ackMessage bob1 aliceId 3 Nothing

  disposeAgentClient alice
  disposeAgentClient bob1
  threadDelay 250000

  alice2 <- getSMPAgentClient' 4 agentCfg initAgentServers testDB
  bob2 <- getSMPAgentClient' 5 agentCfg initAgentServers testDB2

  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    runRight_ $ do
      subscribeConnection bob2 aliceId
      subscribeConnection alice2 bobId
      -- get bob2 =##> \case ("", c, Msg "hello 2") -> c == aliceId; _ -> False
      -- ackMessage bob2 aliceId 5 Nothing
      -- message 2 is not delivered again, even though it was delivered to the agent
      4 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 3"
      get alice2 ##> ("", bobId, SENT 4)
      get bob2 =##> \case ("", c, Msg "hello 3") -> c == aliceId; _ -> False
  disposeAgentClient alice2
  disposeAgentClient bob2

testSkippedMessages :: HasCallStack => ATransport -> IO ()
testSkippedMessages t = do
  alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
  (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \_ -> do
    (aliceId, bobId) <- runRight $ makeConnection alice bob
    runRight_ $ do
      2 <- sendMessage alice bobId SMP.noMsgFlags "hello"
      get alice ##> ("", bobId, SENT 2)
      get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
      ackMessage bob aliceId 2 Nothing

    disposeAgentClient bob

    runRight_ $ do
      3 <- sendMessage alice bobId SMP.noMsgFlags "hello 2"
      get alice ##> ("", bobId, SENT 3)
      4 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
      get alice ##> ("", bobId, SENT 4)
      5 <- sendMessage alice bobId SMP.noMsgFlags "hello 4"
      get alice ##> ("", bobId, SENT 5)

    pure (aliceId, bobId)

  nGet alice =##> \case ("", "", DOWN _ [c]) -> c == bobId; _ -> False
  threadDelay 200000

  disposeAgentClient alice

  alice2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB
  bob2 <- getSMPAgentClient' 4 agentCfg initAgentServers testDB2

  withSmpServerStoreLogOn t testPort $ \_ -> do
    runRight_ $ do
      subscribeConnection bob2 aliceId
      subscribeConnection alice2 bobId

      6 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 5"
      get alice2 ##> ("", bobId, SENT 6)
      get bob2 =##> \case ("", c, MSG MsgMeta {integrity = MsgError {errorInfo = MsgSkipped {fromMsgId = 3, toMsgId = 5}}} _ "hello 5") -> c == aliceId; _ -> False
      ackMessage bob2 aliceId 3 Nothing

      7 <- sendMessage alice2 bobId SMP.noMsgFlags "hello 6"
      get alice2 ##> ("", bobId, SENT 7)
      get bob2 =##> \case ("", c, Msg "hello 6") -> c == aliceId; _ -> False
      ackMessage bob2 aliceId 4 Nothing
  disposeAgentClient alice2
  disposeAgentClient bob2

testDeliveryAfterSubscriptionError :: HasCallStack => ATransport -> IO ()
testDeliveryAfterSubscriptionError t = do
  (aId, bId) <- withAgentClients2 $ \a b -> do
    (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ makeConnection a b
    nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
    nGet b =##> \case ("", "", DOWN _ [c]) -> c == aId; _ -> False
    2 <- runRight $ sendMessage a bId SMP.noMsgFlags "hello"
    liftIO $ noMessages b "not delivered"
    pure (aId, bId)

  withAgentClients2 $ \a b -> do
    Left (BROKER _ NETWORK) <- runExceptT $ subscribeConnection a bId
    Left (BROKER _ NETWORK) <- runExceptT $ subscribeConnection b aId
    withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
      withUP a bId $ \case ("", c, SENT 2) -> c == bId; _ -> False
      withUP b aId $ \case ("", c, Msg "hello") -> c == aId; _ -> False
      ackMessage b aId 2 Nothing

testMsgDeliveryQuotaExceeded :: HasCallStack => ATransport -> IO ()
testMsgDeliveryQuotaExceeded t =
  withAgentClients2 $ \a b -> withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
    (aId, bId) <- makeConnection a b
    (aId', bId') <- makeConnection a b
    forM_ ([1 .. 4] :: [Int]) $ \i -> do
      mId <- sendMessage a bId SMP.noMsgFlags $ "message " <> bshow i
      get a =##> \case ("", c, SENT mId') -> bId == c && mId == mId'; _ -> False
    6 <- sendMessage a bId SMP.noMsgFlags "over quota"
    pGet' a False =##> \case ("", c, AEvt _ (MWARN 6 (SMP _ QUOTA))) -> bId == c; _ -> False
    2 <- sendMessage a bId' SMP.noMsgFlags "hello"
    get a =##> \case ("", c, SENT 2) -> bId' == c; _ -> False
    get b =##> \case ("", c, Msg "message 1") -> aId == c; _ -> False
    get b =##> \case ("", c, Msg "hello") -> aId' == c; _ -> False
    ackMessage b aId' 2 Nothing
    ackMessage b aId 2 Nothing
    get b =##> \case ("", c, Msg "message 2") -> aId == c; _ -> False
    ackMessage b aId 3 Nothing
    get b =##> \case ("", c, Msg "message 3") -> aId == c; _ -> False
    ackMessage b aId 4 Nothing
    get b =##> \case ("", c, Msg "message 4") -> aId == c; _ -> False
    ackMessage b aId 5 Nothing
    get a =##> \case ("", c, QCONT) -> bId == c; _ -> False
    get b =##> \case ("", c, Msg "over quota") -> aId == c; _ -> False
    ackMessage b aId 7 Nothing -- msg 8 was QCONT
    get a =##> \case ("", c, SENT 6) -> bId == c; _ -> False
    liftIO $ concurrently_ (noMessages a "no more events") (noMessages b "no more events")

testExpireMessage :: HasCallStack => ATransport -> IO ()
testExpireMessage t =
  withAgent 1 agentCfg {messageTimeout = 1.5, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
    withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
      (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ makeConnection a b
      nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
      nGet b =##> \case ("", "", DOWN _ [c]) -> c == aId; _ -> False
      2 <- runRight $ sendMessage a bId SMP.noMsgFlags "1"
      threadDelay 1500000
      3 <- runRight $ sendMessage a bId SMP.noMsgFlags "2" -- this won't expire
      get a =##> \case ("", c, MERR 2 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
      withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
        withUP a bId $ \case ("", _, SENT 3) -> True; _ -> False
        withUP b aId $ \case ("", _, MsgErr 2 (MsgSkipped 2 2) "2") -> True; _ -> False
        ackMessage b aId 2 Nothing

testExpireManyMessages :: HasCallStack => ATransport -> IO ()
testExpireManyMessages t =
  withAgent 1 agentCfg {messageTimeout = 1.5, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
    withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
      (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ makeConnection a b
      runRight_ $ do
        nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
        nGet b =##> \case ("", "", DOWN _ [c]) -> c == aId; _ -> False
        2 <- sendMessage a bId SMP.noMsgFlags "1"
        3 <- sendMessage a bId SMP.noMsgFlags "2"
        4 <- sendMessage a bId SMP.noMsgFlags "3"
        liftIO $ threadDelay 1500000
        5 <- sendMessage a bId SMP.noMsgFlags "4" -- this won't expire
        get a =##> \case ("", c, MERR 2 (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
        -- get a =##> \case ("", c, MERRS [5, 6] (BROKER _ e)) -> bId == c && (e == TIMEOUT || e == NETWORK); _ -> False
        let expected c e = bId == c && (e == TIMEOUT || e == NETWORK)
        get a >>= \case
          ("", c, MERR 3 (BROKER _ e)) -> do
            liftIO $ expected c e `shouldBe` True
            get a =##> \case ("", c', MERR 4 (BROKER _ e')) -> expected c' e'; ("", c', MERRS [6] (BROKER _ e')) -> expected c' e'; _ -> False
          ("", c, MERRS [3] (BROKER _ e)) -> do
            liftIO $ expected c e `shouldBe` True
            get a =##> \case ("", c', MERR 4 (BROKER _ e')) -> expected c' e'; _ -> False
          ("", c, MERRS [3, 4] (BROKER _ e)) ->
            liftIO $ expected c e `shouldBe` True
          r -> error $ show r
      withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
        withUP a bId $ \case ("", _, SENT 5) -> True; _ -> False
        withUP b aId $ \case ("", _, MsgErr 2 (MsgSkipped 2 4) "4") -> True; _ -> False
        ackMessage b aId 2 Nothing

withUP :: HasCallStack => AgentClient -> ConnId -> (AEntityTransmission 'AEConn -> Bool) -> ExceptT AgentErrorType IO ()
withUP a bId p =
  liftIO $
    getInAnyOrder
      a
      [ \case ("", "", AEvt SAENone (UP _ [c])) -> c == bId; _ -> False,
        \case (corrId, c, AEvt SAEConn cmd) -> c == bId && p (corrId, c, cmd); _ -> False
      ]

testExpireMessageQuota :: HasCallStack => ATransport -> IO ()
testExpireMessageQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1} testPort $ \_ -> do
  a <- getSMPAgentClient' 1 agentCfg {quotaExceededTimeout = 1, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB
  b <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
  (aId, bId) <- runRight $ do
    (aId, bId) <- makeConnection a b
    liftIO $ threadDelay 500000 >> disposeAgentClient b
    2 <- sendMessage a bId SMP.noMsgFlags "1"
    get a ##> ("", bId, SENT 2)
    3 <- sendMessage a bId SMP.noMsgFlags "2"
    liftIO $ threadDelay 1000000
    4 <- sendMessage a bId SMP.noMsgFlags "3" -- this won't expire
    get a =##> \case ("", c, MERR 3 (SMP _ QUOTA)) -> bId == c; _ -> False
    pure (aId, bId)
  withAgent 3 agentCfg initAgentServers testDB2 $ \b' -> runRight_ $ do
    subscribeConnection b' aId
    get b' =##> \case ("", c, Msg "1") -> c == aId; _ -> False
    ackMessage b' aId 2 Nothing
    liftIO . getInAnyOrder a $
      [ \case ("", c, AEvt SAEConn (SENT 4)) -> c == bId; _ -> False,
        \case ("", c, AEvt SAEConn QCONT) -> c == bId; _ -> False
      ]
    get b' =##> \case ("", c, MsgErr 4 (MsgSkipped 3 3) "3") -> c == aId; _ -> False
    ackMessage b' aId 4 Nothing
  disposeAgentClient a

testExpireManyMessagesQuota :: ATransport -> IO ()
testExpireManyMessagesQuota t = withSmpServerConfigOn t cfg {msgQueueQuota = 1} testPort $ \_ -> do
  a <- getSMPAgentClient' 1 agentCfg {quotaExceededTimeout = 1, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB
  b <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
  (aId, bId) <- runRight $ do
    (aId, bId) <- makeConnection a b
    liftIO $ threadDelay 500000 >> disposeAgentClient b
    2 <- sendMessage a bId SMP.noMsgFlags "1"
    get a ##> ("", bId, SENT 2)
    3 <- sendMessage a bId SMP.noMsgFlags "2"
    4 <- sendMessage a bId SMP.noMsgFlags "3"
    5 <- sendMessage a bId SMP.noMsgFlags "4"
    liftIO $ threadDelay 1000000
    6 <- sendMessage a bId SMP.noMsgFlags "5" -- this won't expire
    get a =##> \case ("", c, MERR 3 (SMP _ QUOTA)) -> bId == c; _ -> False
    get a >>= \case
      ("", c, MERR 4 (SMP _ QUOTA)) -> do
        liftIO $ bId `shouldBe` c
        get a =##> \case ("", c', MERR 5 (SMP _ QUOTA)) -> bId == c'; ("", c', MERRS [5] (SMP _ QUOTA)) -> bId == c'; _ -> False
      ("", c, MERRS [4] (SMP _ QUOTA)) -> do
        liftIO $ bId `shouldBe` c
        get a =##> \case ("", c', MERR 5 (SMP _ QUOTA)) -> bId == c'; _ -> False
      ("", c, MERRS [4, 5] (SMP _ QUOTA)) -> liftIO $ bId `shouldBe` c
      r -> error $ show r
    pure (aId, bId)
  withAgent 3 agentCfg initAgentServers testDB2 $ \b' -> runRight_ $ do
    subscribeConnection b' aId
    get b' =##> \case ("", c, Msg "1") -> c == aId; _ -> False
    ackMessage b' aId 2 Nothing
    liftIO . getInAnyOrder a $
      [ \case ("", c, AEvt SAEConn (SENT 6)) -> c == bId; _ -> False,
        \case ("", c, AEvt SAEConn QCONT) -> c == bId; _ -> False
      ]
    get b' =##> \case ("", c, MsgErr 4 (MsgSkipped 3 5) "5") -> c == aId; _ -> False
    ackMessage b' aId 4 Nothing
  disposeAgentClient a

testRatchetSync :: HasCallStack => ATransport -> IO ()
testRatchetSync t = withAgentClients2 $ \alice bob ->
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aliceId, bobId, bob2) <- setupDesynchronizedRatchet alice bob
    runRight $ do
      ConnectionStats {ratchetSyncState} <- synchronizeRatchet bob2 aliceId PQSupportOn False
      liftIO $ ratchetSyncState `shouldBe` RSStarted
      get alice =##> ratchetSyncP bobId RSAgreed
      get bob2 =##> ratchetSyncP aliceId RSAgreed
      get alice =##> ratchetSyncP bobId RSOk
      get bob2 =##> ratchetSyncP aliceId RSOk
      exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
    disposeAgentClient bob2

setupDesynchronizedRatchet :: HasCallStack => AgentClient -> AgentClient -> IO (ConnId, ConnId, AgentClient)
setupDesynchronizedRatchet alice bob = do
  (aliceId, bobId) <- runRight $ makeConnection alice bob
  runRight_ $ do
    2 <- sendMessage alice bobId SMP.noMsgFlags "hello"
    get alice ##> ("", bobId, SENT 2)
    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
    ackMessage bob aliceId 2 Nothing

    3 <- sendMessage bob aliceId SMP.noMsgFlags "hello 2"
    get bob ##> ("", aliceId, SENT 3)
    get alice =##> \case ("", c, Msg "hello 2") -> c == bobId; _ -> False
    ackMessage alice bobId 3 Nothing

    liftIO $ copyFile testDB2 (testDB2 <> ".bak")

    4 <- sendMessage alice bobId SMP.noMsgFlags "hello 3"
    get alice ##> ("", bobId, SENT 4)
    get bob =##> \case ("", c, Msg "hello 3") -> c == aliceId; _ -> False
    ackMessage bob aliceId 4 Nothing

    5 <- sendMessage bob aliceId SMP.noMsgFlags "hello 4"
    get bob ##> ("", aliceId, SENT 5)
    get alice =##> \case ("", c, Msg "hello 4") -> c == bobId; _ -> False
    ackMessage alice bobId 5 Nothing

  disposeAgentClient bob
  threadDelay 250000

  -- importing database backup after progressing ratchet de-synchronizes ratchet
  liftIO $ renameFile (testDB2 <> ".bak") testDB2

  bob2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB2

  runRight_ $ do
    subscribeConnection bob2 aliceId

    Left A.CMD {cmdErr = PROHIBITED} <- liftIO . runExceptT $ synchronizeRatchet bob2 aliceId PQSupportOn False

    6 <- sendMessage alice bobId SMP.noMsgFlags "hello 5"
    get alice ##> ("", bobId, SENT 6)
    get bob2 =##> ratchetSyncP aliceId RSRequired

    Left A.CMD {cmdErr = PROHIBITED} <- liftIO . runExceptT $ sendMessage bob2 aliceId SMP.noMsgFlags "hello 6"
    pure ()

  pure (aliceId, bobId, bob2)

ratchetSyncP :: ConnId -> RatchetSyncState -> AEntityTransmission 'AEConn -> Bool
ratchetSyncP cId rss = \case
  (_, cId', RSYNC rss' _ ConnectionStats {ratchetSyncState}) ->
    cId' == cId && rss' == rss && ratchetSyncState == rss
  _ -> False

ratchetSyncP' :: ConnId -> RatchetSyncState -> ATransmission -> Bool
ratchetSyncP' cId rss = \case
  (_, cId', AEvt SAEConn (RSYNC rss' _ ConnectionStats {ratchetSyncState})) ->
    cId' == cId && rss' == rss && ratchetSyncState == rss
  _ -> False

testRatchetSyncServerOffline :: HasCallStack => ATransport -> IO ()
testRatchetSyncServerOffline t = withAgentClients2 $ \alice bob -> do
  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn t testPort $ \_ ->
    setupDesynchronizedRatchet alice bob

  ("", "", DOWN _ _) <- nGet alice
  ("", "", DOWN _ _) <- nGet bob2

  ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False
  liftIO $ ratchetSyncState `shouldBe` RSStarted

  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    concurrently_
      (getInAnyOrder alice [ratchetSyncP' bobId RSAgreed, serverUpP])
      (getInAnyOrder bob2 [ratchetSyncP' aliceId RSAgreed, serverUpP])
    runRight_ $ do
      get alice =##> ratchetSyncP bobId RSOk
      get bob2 =##> ratchetSyncP aliceId RSOk
      exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
  disposeAgentClient bob2

serverUpP :: ATransmission -> Bool
serverUpP = \case
  ("", "", AEvt SAENone (UP _ _)) -> True
  _ -> False

testRatchetSyncClientRestart :: HasCallStack => ATransport -> IO ()
testRatchetSyncClientRestart t = do
  alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn t testPort $ \_ ->
    setupDesynchronizedRatchet alice bob
  ("", "", DOWN _ _) <- nGet alice
  ("", "", DOWN _ _) <- nGet bob2
  ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False
  ratchetSyncState `shouldBe` RSStarted
  disposeAgentClient bob2
  bob3 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    runRight_ $ do
      ("", "", UP _ _) <- nGet alice
      subscribeConnection bob3 aliceId
      get alice =##> ratchetSyncP bobId RSAgreed
      get bob3 =##> ratchetSyncP aliceId RSAgreed
      get alice =##> ratchetSyncP bobId RSOk
      get bob3 =##> ratchetSyncP aliceId RSOk
      exchangeGreetingsMsgIds alice bobId 10 bob3 aliceId 7
  disposeAgentClient alice
  disposeAgentClient bob
  disposeAgentClient bob3

testRatchetSyncSuspendForeground :: HasCallStack => ATransport -> IO ()
testRatchetSyncSuspendForeground t = do
  alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn t testPort $ \_ ->
    setupDesynchronizedRatchet alice bob

  ("", "", DOWN _ _) <- nGet alice
  ("", "", DOWN _ _) <- nGet bob2

  ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False
  liftIO $ ratchetSyncState `shouldBe` RSStarted

  suspendAgent bob2 0
  threadDelay 100000
  foregroundAgent bob2

  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    concurrently_
      (getInAnyOrder alice [ratchetSyncP' bobId RSAgreed, serverUpP])
      (getInAnyOrder bob2 [ratchetSyncP' aliceId RSAgreed, serverUpP])
    runRight_ $ do
      get alice =##> ratchetSyncP bobId RSOk
      get bob2 =##> ratchetSyncP aliceId RSOk
      exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
  disposeAgentClient alice
  disposeAgentClient bob
  disposeAgentClient bob2

testRatchetSyncSimultaneous :: HasCallStack => ATransport -> IO ()
testRatchetSyncSimultaneous t = do
  alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
  bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn t testPort $ \_ ->
    setupDesynchronizedRatchet alice bob

  ("", "", DOWN _ _) <- nGet alice
  ("", "", DOWN _ _) <- nGet bob2

  ConnectionStats {ratchetSyncState = bRSS} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False
  liftIO $ bRSS `shouldBe` RSStarted

  ConnectionStats {ratchetSyncState = aRSS} <- runRight $ synchronizeRatchet alice bobId PQSupportOn True
  liftIO $ aRSS `shouldBe` RSStarted

  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    concurrently_
      (getInAnyOrder alice [ratchetSyncP' bobId RSAgreed, serverUpP])
      (getInAnyOrder bob2 [ratchetSyncP' aliceId RSAgreed, serverUpP])
    runRight_ $ do
      get alice =##> ratchetSyncP bobId RSOk
      get bob2 =##> ratchetSyncP aliceId RSOk
      exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
  disposeAgentClient alice
  disposeAgentClient bob
  disposeAgentClient bob2

testOnlyCreatePullSlowHandshake :: IO ()
testOnlyCreatePullSlowHandshake = withAgentClientsCfg2 agentProxyCfgV8 agentProxyCfgV8 $ \alice bob -> runRight_ $ do
  (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
  aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
  Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
  allowConnection alice bobId confId "alice's connInfo"
  liftIO $ threadDelay 1_000000
  getMsg bob aliceId $
    get bob ##> ("", aliceId, INFO "alice's connInfo")
  liftIO $ threadDelay 1_000000
  getMsg alice bobId $ pure ()
  get alice ##> ("", bobId, CON)
  getMsg bob aliceId $
    get bob ##> ("", aliceId, CON)
  -- exchange messages
  4 <- sendMessage alice bobId SMP.noMsgFlags "hello"
  get alice ##> ("", bobId, SENT 4)
  getMsg bob aliceId $
    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
  ackMessage bob aliceId 4 Nothing
  5 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
  get bob ##> ("", aliceId, SENT 5)
  getMsg alice bobId $
    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
  ackMessage alice bobId 5 Nothing

getMsg :: AgentClient -> ConnId -> ExceptT AgentErrorType IO a -> ExceptT AgentErrorType IO a
getMsg c cId action = do
  liftIO $ noMessages c "nothing should be delivered before GET"
  Just _ <- getConnectionMessage c cId
  r <- action
  get c =##> \case ("", cId', MSGNTF _) -> cId == cId'; _ -> False
  pure r

testOnlyCreatePull :: IO ()
testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
  (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
  aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
  Just ("", _, CONF confId _ "bob's connInfo") <- getMsg alice bobId $ timeout 5_000000 $ get alice
  allowConnection alice bobId confId "alice's connInfo"
  liftIO $ threadDelay 1_000000
  getMsg bob aliceId $ do
    get bob ##> ("", aliceId, INFO "alice's connInfo")
    get bob ##> ("", aliceId, CON)
  liftIO $ threadDelay 1_000000
  get alice ##> ("", bobId, CON) -- sent to initiating party after sending confirmation
  -- exchange messages
  2 <- sendMessage alice bobId SMP.noMsgFlags "hello"
  get alice ##> ("", bobId, SENT 2)
  getMsg bob aliceId $
    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
  ackMessage bob aliceId 2 Nothing
  3 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
  get bob ##> ("", aliceId, SENT 3)
  getMsg alice bobId $
    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
  ackMessage alice bobId 3 Nothing

makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
makeConnection = makeConnection_ PQSupportOn

makeConnection_ :: PQSupport -> AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId)
makeConnection_ pqEnc alice bob = makeConnectionForUsers_ pqEnc alice 1 bob 1

makeConnectionForUsers :: HasCallStack => AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn

makeConnectionForUsers_ :: HasCallStack => PQSupport -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
makeConnectionForUsers_ pqSupport alice aliceUserId bob bobUserId = do
  (bobId, qInfo) <- A.createConnection alice aliceUserId True SCMInvitation Nothing (CR.IKNoPQ pqSupport) SMSubscribe
  aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport
  aliceId' <- A.joinConnection bob bobUserId (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe
  liftIO $ aliceId' `shouldBe` aliceId
  ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
  liftIO $ pqSup' `shouldBe` pqSupport
  allowConnection alice bobId confId "alice's connInfo"
  let pqEnc = CR.pqSupportToEnc pqSupport
  get alice ##> ("", bobId, A.CON pqEnc)
  get bob ##> ("", aliceId, A.INFO pqSupport "alice's connInfo")
  get bob ##> ("", aliceId, A.CON pqEnc)
  pure (aliceId, bobId)

testInactiveNoSubs :: ATransport -> IO ()
testInactiveNoSubs t = do
  let cfg' = cfg {inactiveClientExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
  withSmpServerConfigOn t cfg' testPort $ \_ ->
    withAgent 1 agentCfg initAgentServers testDB $ \alice -> do
      runRight_ . void $ createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate -- do not subscribe to pass noSubscriptions check
      Just (_, _, AEvt SAENone (CONNECT _ _)) <- timeout 2000000 $ atomically (readTBQueue $ subQ alice)
      Just (_, _, AEvt SAENone (DISCONNECT _ _)) <- timeout 5000000 $ atomically (readTBQueue $ subQ alice)
      pure ()

testInactiveWithSubs :: ATransport -> IO ()
testInactiveWithSubs t = do
  let cfg' = cfg {inactiveClientExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
  withSmpServerConfigOn t cfg' testPort $ \_ ->
    withAgent 1 agentCfg initAgentServers testDB $ \alice -> do
      runRight_ . void $ createConnection alice 1 True SCMInvitation Nothing SMSubscribe
      Nothing <- 800000 `timeout` get alice
      liftIO $ threadDelay 1200000
      -- and after 2 sec of inactivity no DOWN is sent as we have a live subscription
      liftIO $ timeout 1200000 (get alice) `shouldReturn` Nothing

testActiveClientNotDisconnected :: ATransport -> IO ()
testActiveClientNotDisconnected t = do
  let cfg' = cfg {inactiveClientExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
  withSmpServerConfigOn t cfg' testPort $ \_ ->
    withAgent 1 agentCfg initAgentServers testDB $ \alice -> do
      ts <- getSystemTime
      runRight_ $ do
        (connId, _cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
        keepSubscribing alice connId ts
  where
    keepSubscribing :: AgentClient -> ConnId -> SystemTime -> ExceptT AgentErrorType IO ()
    keepSubscribing alice connId ts = do
      ts' <- liftIO getSystemTime
      if milliseconds ts' - milliseconds ts < 2200
        then do
          -- keep sending SUB for 2.2 seconds
          liftIO $ threadDelay 200000
          subscribeConnection alice connId
          keepSubscribing alice connId ts
        else do
          -- check that nothing is sent from agent
          Nothing <- 800000 `timeout` get alice
          liftIO $ threadDelay 1200000
          -- and after 2 sec of inactivity no DOWN is sent as we have a live subscription
          liftIO $ timeout 1200000 (get alice) `shouldReturn` Nothing
    milliseconds ts = systemSeconds ts * 1000 + fromIntegral (systemNanoseconds ts `div` 1000000)

testSuspendingAgent :: IO ()
testSuspendingAgent =
  withAgentClients2 $ \a b -> runRight_ $ do
    (aId, bId) <- makeConnection a b
    2 <- sendMessage a bId SMP.noMsgFlags "hello"
    get a ##> ("", bId, SENT 2)
    get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
    ackMessage b aId 2 Nothing
    liftIO $ suspendAgent b 1000000
    get' b ##> ("", "", SUSPENDED)
    3 <- sendMessage a bId SMP.noMsgFlags "hello 2"
    get a ##> ("", bId, SENT 3)
    Nothing <- 100000 `timeout` get b
    liftIO $ foregroundAgent b
    get b =##> \case ("", c, Msg "hello 2") -> c == aId; _ -> False

testSuspendingAgentCompleteSending :: ATransport -> IO ()
testSuspendingAgentCompleteSending t = withAgentClients2 $ \a b -> do
  (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
    (aId, bId) <- makeConnection a b
    2 <- sendMessage a bId SMP.noMsgFlags "hello"
    get a ##> ("", bId, SENT 2)
    get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
    ackMessage b aId 2 Nothing
    pure (aId, bId)

  runRight_ $ do
    ("", "", DOWN {}) <- nGet a
    ("", "", DOWN {}) <- nGet b
    3 <- sendMessage b aId SMP.noMsgFlags "hello too"
    4 <- sendMessage b aId SMP.noMsgFlags "how are you?"
    liftIO $ threadDelay 100000
    liftIO $ suspendAgent b 5000000

  withSmpServerStoreLogOn t testPort $ \_ -> runRight_ @AgentErrorType $ do
    pGet b =##> \case ("", c, AEvt SAEConn (SENT 3)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
    pGet b =##> \case ("", c, AEvt SAEConn (SENT 3)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
    pGet b =##> \case ("", c, AEvt SAEConn (SENT 4)) -> c == aId; ("", "", AEvt _ UP {}) -> True; _ -> False
    ("", "", SUSPENDED) <- nGet b

    pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
    pGet a =##> \case ("", c, AEvt _ (Msg "hello too")) -> c == bId; ("", "", AEvt _ UP {}) -> True; _ -> False
    ackMessage a bId 3 Nothing
    get a =##> \case ("", c, Msg "how are you?") -> c == bId; _ -> False
    ackMessage a bId 4 Nothing

testSuspendingAgentTimeout :: ATransport -> IO ()
testSuspendingAgentTimeout t = withAgentClients2 $ \a b -> do
  (aId, _) <- withSmpServer t . runRight $ do
    (aId, bId) <- makeConnection a b
    2 <- sendMessage a bId SMP.noMsgFlags "hello"
    get a ##> ("", bId, SENT 2)
    get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
    ackMessage b aId 2 Nothing
    pure (aId, bId)

  runRight_ $ do
    ("", "", DOWN {}) <- nGet a
    ("", "", DOWN {}) <- nGet b
    3 <- sendMessage b aId SMP.noMsgFlags "hello too"
    4 <- sendMessage b aId SMP.noMsgFlags "how are you?"
    liftIO $ suspendAgent b 100000
    ("", "", SUSPENDED) <- nGet b
    pure ()

testBatchedSubscriptions :: Int -> Int -> ATransport -> IO ()
testBatchedSubscriptions nCreate nDel t =
  withAgentClientsCfgServers2 agentCfg agentCfg initAgentServers2 $ \a b -> do
    conns <- runServers $ do
      conns <- replicateM nCreate $ makeConnection_ PQSupportOff a b
      forM_ conns $ \(aId, bId) -> exchangeGreetings_ PQEncOff a bId b aId
      let (aIds', bIds') = unzip $ take nDel conns
      delete a bIds'
      delete b aIds'
      liftIO $ threadDelay 1000000
      pure conns
    ("", "", DOWN {}) <- nGet a
    ("", "", DOWN {}) <- nGet a
    ("", "", DOWN {}) <- nGet b
    ("", "", DOWN {}) <- nGet b
    runServers $ do
      ("", "", UP {}) <- nGet a
      ("", "", UP {}) <- nGet a
      ("", "", UP {}) <- nGet b
      ("", "", UP {}) <- nGet b
      liftIO $ threadDelay 1000000
      let (aIds, bIds) = unzip conns
          conns' = drop nDel conns
          (aIds', bIds') = unzip conns'
      subscribe a bIds
      subscribe b aIds
      forM_ conns' $ \(aId, bId) -> exchangeGreetingsMsgId_ PQEncOff 4 a bId b aId
      void $ resubscribeConnections a bIds
      void $ resubscribeConnections b aIds
      forM_ conns' $ \(aId, bId) -> exchangeGreetingsMsgId_ PQEncOff 6 a bId b aId
      delete a bIds'
      delete b aIds'
      deleteFail a bIds'
      deleteFail b aIds'
  where
    subscribe :: AgentClient -> [ConnId] -> ExceptT AgentErrorType IO ()
    subscribe c cs = do
      r <- subscribeConnections c cs
      liftIO $ do
        let dc = S.fromList $ take nDel cs
        all isRight (M.withoutKeys r dc) `shouldBe` True
        all (== Left (CONN NOT_FOUND)) (M.restrictKeys r dc) `shouldBe` True
        M.keys r `shouldMatchList` cs
    delete :: AgentClient -> [ConnId] -> ExceptT AgentErrorType IO ()
    delete c cs = do
      r <- deleteConnections c cs
      liftIO $ do
        all isRight r `shouldBe` True
        M.keys r `shouldMatchList` cs
    deleteFail :: AgentClient -> [ConnId] -> ExceptT AgentErrorType IO ()
    deleteFail c cs = do
      r <- deleteConnections c cs
      liftIO $ do
        all (== Left (CONN NOT_FOUND)) r `shouldBe` True
        M.keys r `shouldMatchList` cs
    runServers :: ExceptT AgentErrorType IO a -> IO a
    runServers a = do
      withSmpServerStoreLogOn t testPort $ \t1 -> do
        res <- withSmpServerConfigOn t cfg {storeLogFile = Just testStoreLogFile2} testPort2 $ \t2 ->
          runRight a `finally` killThread t2
        killThread t1
        pure res

testBatchedPendingMessages :: Int -> Int -> IO ()
testBatchedPendingMessages nCreate nMsgs =
  withA $ \a -> do
    conns <- withB $ \b -> runRight $ do
      replicateM nCreate $ makeConnection a b
    let msgConns = take nMsgs conns
    runRight_ $ forM_ msgConns $ \(_, bId) -> sendMessage a bId SMP.noMsgFlags "hello"
    replicateM_ nMsgs $ get a =##> \case ("", cId, SENT _) -> isJust $ find ((cId ==) . snd) msgConns; _ -> False
    withB $ \b -> runRight_ $ do
      r <- subscribeConnections b $ map fst conns
      liftIO $ all isRight r `shouldBe` True
      replicateM_ nMsgs $ do
        ("", cId, Msg' msgId _ "hello") <- get b
        liftIO $ isJust (find ((cId ==) . fst) msgConns) `shouldBe` True
        ackMessage b cId msgId Nothing
  where
    withA = withAgent 1 agentCfg initAgentServers testDB
    withB = withAgent 2 agentCfg initAgentServers testDB2

testAsyncCommands :: AgentClient -> AgentClient -> AgentMsgId -> IO ()
testAsyncCommands alice bob baseId =
  runRight_ $ do
    bobId <- createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
    ("1", bobId', INV (ACR _ qInfo)) <- get alice
    liftIO $ bobId' `shouldBe` bobId
    aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
    ("2", aliceId', OK) <- get bob
    liftIO $ aliceId' `shouldBe` aliceId
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnectionAsync alice "3" bobId confId "alice's connInfo"
    get alice =##> \case ("3", _, OK) -> True; _ -> False
    get alice ##> ("", bobId, CON)
    get bob ##> ("", aliceId, INFO "alice's connInfo")
    get bob ##> ("", aliceId, CON)
    -- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
    1 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "hello"
    get alice ##> ("", bobId, SENT $ baseId + 1)
    2 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
    get alice ##> ("", bobId, SENT $ baseId + 2)
    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
    ackMessageAsync bob "4" aliceId (baseId + 1) Nothing
    inAnyOrder
      (get bob)
      [ \case ("4", _, OK) -> True; _ -> False,
        \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False
      ]
    ackMessageAsync bob "5" aliceId (baseId + 2) Nothing
    get bob =##> \case ("5", _, OK) -> True; _ -> False
    3 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "hello too"
    get bob ##> ("", aliceId, SENT $ baseId + 3)
    4 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "message 1"
    get bob ##> ("", aliceId, SENT $ baseId + 4)
    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
    ackMessageAsync alice "6" bobId (baseId + 3) Nothing
    inAnyOrder
      (get alice)
      [ \case ("6", _, OK) -> True; _ -> False,
        \case ("", c, Msg "message 1") -> c == bobId; _ -> False
      ]
    ackMessageAsync alice "7" bobId (baseId + 4) Nothing
    get alice =##> \case ("7", _, OK) -> True; _ -> False
    deleteConnectionAsync alice False bobId
    get alice =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bobId; _ -> False
    get alice =##> \case ("", c, DEL_CONN) -> c == bobId; _ -> False
    liftIO $ noMessages alice "nothing else should be delivered to alice"
  where
    msgId = subtract baseId

testAsyncCommandsRestore :: ATransport -> IO ()
testAsyncCommandsRestore t = do
  alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
  bobId <- runRight $ createConnectionAsync alice 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
  liftIO $ noMessages alice "alice doesn't receive INV because server is down"
  disposeAgentClient alice
  withAgent 2 agentCfg initAgentServers testDB $ \alice' ->
    withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
      subscribeConnection alice' bobId
      get alice' =##> \case ("1", _, INV _) -> True; _ -> False
      pure ()

testAcceptContactAsync :: AgentClient -> AgentClient -> AgentMsgId -> IO ()
testAcceptContactAsync alice bob baseId =
  runRight_ $ do
    (_, qInfo) <- createConnection alice 1 True SCMContact Nothing SMSubscribe
    aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
    ("", _, REQ invId _ "bob's connInfo") <- get alice
    bobId <- acceptContactAsync alice "1" True invId "alice's connInfo" PQSupportOn SMSubscribe
    get alice =##> \case ("1", c, OK) -> c == bobId; _ -> False
    ("", _, CONF confId _ "alice's connInfo") <- get bob
    allowConnection bob aliceId confId "bob's connInfo"
    get alice ##> ("", bobId, INFO "bob's connInfo")
    get alice ##> ("", bobId, CON)
    get bob ##> ("", aliceId, CON)
    -- message IDs 1 to 3 (or 1 to 4 in v1) get assigned to control messages, so first MSG is assigned ID 4
    1 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "hello"
    get alice ##> ("", bobId, SENT $ baseId + 1)
    2 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
    get alice ##> ("", bobId, SENT $ baseId + 2)
    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
    ackMessage bob aliceId (baseId + 1) Nothing
    get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False
    ackMessage bob aliceId (baseId + 2) Nothing
    3 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "hello too"
    get bob ##> ("", aliceId, SENT $ baseId + 3)
    4 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "message 1"
    get bob ##> ("", aliceId, SENT $ baseId + 4)
    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
    ackMessage alice bobId (baseId + 3) Nothing
    get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False
    ackMessage alice bobId (baseId + 4) Nothing
    suspendConnection alice bobId
    5 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "message 2"
    get bob =##> \case ("", cId, MERR mId (SMP _ AUTH)) -> cId == aliceId && mId == (baseId + 5); _ -> False
    deleteConnection alice bobId
    liftIO $ noMessages alice "nothing else should be delivered to alice"
  where
    msgId = subtract baseId

testDeleteConnectionAsync :: ATransport -> IO ()
testDeleteConnectionAsync t =
  withAgent 1 agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \a -> do
    connIds <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
      (bId1, _inv) <- createConnection a 1 True SCMInvitation Nothing SMSubscribe
      (bId2, _inv) <- createConnection a 1 True SCMInvitation Nothing SMSubscribe
      (bId3, _inv) <- createConnection a 1 True SCMInvitation Nothing SMSubscribe
      pure ([bId1, bId2, bId3] :: [ConnId])
    runRight_ $ do
      deleteConnectionsAsync a False connIds
      nGet a =##> \case ("", "", DOWN {}) -> True; _ -> False
      get a =##> \case ("", c, DEL_RCVQ _ _ (Just (BROKER _ e))) -> c `elem` connIds && (e == TIMEOUT || e == NETWORK); _ -> False
      get a =##> \case ("", c, DEL_RCVQ _ _ (Just (BROKER _ e))) -> c `elem` connIds && (e == TIMEOUT || e == NETWORK); _ -> False
      get a =##> \case ("", c, DEL_RCVQ _ _ (Just (BROKER _ e))) -> c `elem` connIds && (e == TIMEOUT || e == NETWORK); _ -> False
      get a =##> \case ("", c, DEL_CONN) -> c `elem` connIds; _ -> False
      get a =##> \case ("", c, DEL_CONN) -> c `elem` connIds; _ -> False
      get a =##> \case ("", c, DEL_CONN) -> c `elem` connIds; _ -> False
      liftIO $ noMessages a "nothing else should be delivered to alice"

testWaitDeliveryNoPending :: ATransport -> IO ()
testWaitDeliveryNoPending t = withAgentClients2 $ \alice bob ->
  withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
    (aliceId, bobId) <- makeConnection alice bob

    1 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "hello"
    get alice ##> ("", bobId, SENT $ baseId + 1)
    get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
    ackMessage bob aliceId (baseId + 1) Nothing

    2 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "hello too"
    get bob ##> ("", aliceId, SENT $ baseId + 2)
    get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
    ackMessage alice bobId (baseId + 2) Nothing

    deleteConnectionsAsync alice True [bobId]
    get alice =##> \case ("", cId, DEL_RCVQ _ _ Nothing) -> cId == bobId; _ -> False
    get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False

    3 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "message 2"
    get bob =##> \case ("", cId, MERR mId (SMP _ AUTH)) -> cId == aliceId && mId == (baseId + 3); _ -> False

    liftIO $ noMessages alice "nothing else should be delivered to alice"
    liftIO $ noMessages bob "nothing else should be delivered to bob"
  where
    baseId = 1
    msgId = subtract baseId

testWaitDelivery :: ATransport -> IO ()
testWaitDelivery t =
  withAgent 1 agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \alice ->
    withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> do
      (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
        (aliceId, bobId) <- makeConnection alice bob

        1 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "hello"
        get alice ##> ("", bobId, SENT $ baseId + 1)
        get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
        ackMessage bob aliceId (baseId + 1) Nothing

        2 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "hello too"
        get bob ##> ("", aliceId, SENT $ baseId + 2)
        get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
        ackMessage alice bobId (baseId + 2) Nothing

        pure (aliceId, bobId)

      runRight_ $ do
        ("", "", DOWN _ _) <- nGet alice
        ("", "", DOWN _ _) <- nGet bob
        3 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
        4 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "message 1"
        deleteConnectionsAsync alice True [bobId]
        get alice =##> \case ("", cId, DEL_RCVQ _ _ (Just (BROKER _ e))) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"

      withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
        get alice ##> ("", bobId, SENT $ baseId + 3)
        get alice ##> ("", bobId, SENT $ baseId + 4)
        get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False

        liftIO $
          getInAnyOrder
            bob
            [ \case ("", "", AEvt SAENone (UP _ [cId])) -> cId == aliceId; _ -> False,
              \case ("", cId, AEvt SAEConn (Msg "how are you?")) -> cId == aliceId; _ -> False
            ]
        ackMessage bob aliceId (baseId + 3) Nothing
        get bob =##> \case ("", c, Msg "message 1") -> c == aliceId; _ -> False
        ackMessage bob aliceId (baseId + 4) Nothing

        -- queue wasn't deleted (DEL never reached server, see DEL_RCVQ with error), so bob can send message
        5 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "message 2"
        get bob ##> ("", aliceId, SENT $ baseId + 5)

        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"
  where
    baseId = 1
    msgId = subtract baseId

testWaitDeliveryAUTHErr :: ATransport -> IO ()
testWaitDeliveryAUTHErr t =
  withAgent 1 agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \alice ->
    withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> do
      (_aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
        (aliceId, bobId) <- makeConnection alice bob

        1 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "hello"
        get alice ##> ("", bobId, SENT $ baseId + 1)
        get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
        ackMessage bob aliceId (baseId + 1) Nothing

        2 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "hello too"
        get bob ##> ("", aliceId, SENT $ baseId + 2)
        get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
        ackMessage alice bobId (baseId + 2) Nothing

        deleteConnectionsAsync bob False [aliceId]
        get bob =##> \case ("", cId, DEL_RCVQ _ _ Nothing) -> cId == aliceId; _ -> False
        get bob =##> \case ("", cId, DEL_CONN) -> cId == aliceId; _ -> False

        pure (aliceId, bobId)

      runRight_ $ do
        ("", "", DOWN _ _) <- nGet alice
        3 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
        4 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "message 1"
        deleteConnectionsAsync alice True [bobId]
        get alice =##> \case ("", cId, DEL_RCVQ _ _ (Just (BROKER _ e))) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"

      withSmpServerStoreLogOn t testPort $ \_ -> do
        get alice =##> \case ("", cId, MERR mId (SMP _ AUTH)) -> cId == bobId && mId == (baseId + 3); _ -> False
        get alice =##> \case ("", cId, MERR mId (SMP _ AUTH)) -> cId == bobId && mId == (baseId + 4); _ -> False
        get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False

        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"
  where
    baseId = 1
    msgId = subtract baseId

testWaitDeliveryTimeout :: ATransport -> IO ()
testWaitDeliveryTimeout t =
  withAgent 1 agentCfg {connDeleteDeliveryTimeout = 1, initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \alice ->
    withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> do
      (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
        (aliceId, bobId) <- makeConnection alice bob

        1 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "hello"
        get alice ##> ("", bobId, SENT $ baseId + 1)
        get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
        ackMessage bob aliceId (baseId + 1) Nothing

        2 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "hello too"
        get bob ##> ("", aliceId, SENT $ baseId + 2)
        get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
        ackMessage alice bobId (baseId + 2) Nothing

        pure (aliceId, bobId)

      runRight_ $ do
        ("", "", DOWN _ _) <- nGet alice
        ("", "", DOWN _ _) <- nGet bob
        3 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
        4 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "message 1"
        deleteConnectionsAsync alice True [bobId]
        get alice =##> \case ("", cId, DEL_RCVQ _ _ (Just (BROKER _ e))) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
        get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"

      liftIO $ threadDelay 100000

      withSmpServerStoreLogOn t testPort $ \_ -> do
        nGet bob =##> \case ("", "", UP _ [cId]) -> cId == aliceId; _ -> False
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"
  where
    baseId = 1
    msgId = subtract baseId

testWaitDeliveryTimeout2 :: ATransport -> IO ()
testWaitDeliveryTimeout2 t =
  withAgent 1 agentCfg {connDeleteDeliveryTimeout = 2, messageRetryInterval = fastMessageRetryInterval, initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \alice ->
    withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> do
      (aliceId, bobId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
        (aliceId, bobId) <- makeConnection alice bob

        1 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "hello"
        get alice ##> ("", bobId, SENT $ baseId + 1)
        get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
        ackMessage bob aliceId (baseId + 1) Nothing

        2 <- msgId <$> sendMessage bob aliceId SMP.noMsgFlags "hello too"
        get bob ##> ("", aliceId, SENT $ baseId + 2)
        get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
        ackMessage alice bobId (baseId + 2) Nothing

        pure (aliceId, bobId)

      runRight_ $ do
        ("", "", DOWN _ _) <- nGet alice
        ("", "", DOWN _ _) <- nGet bob
        3 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "how are you?"
        4 <- msgId <$> sendMessage alice bobId SMP.noMsgFlags "message 1"
        deleteConnectionsAsync alice True [bobId]
        get alice =##> \case ("", cId, DEL_RCVQ _ _ (Just (BROKER _ e))) -> cId == bobId && (e == TIMEOUT || e == NETWORK); _ -> False
        get alice =##> \case ("", cId, DEL_CONN) -> cId == bobId; _ -> False
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"

      withSmpServerStoreLogOn t testPort $ \_ -> do
        get alice ##> ("", bobId, SENT $ baseId + 3)
        -- "message 1" not delivered

        liftIO $
          getInAnyOrder
            bob
            [ \case ("", "", AEvt SAENone (UP _ [cId])) -> cId == aliceId; _ -> False,
              \case ("", cId, AEvt SAEConn (Msg "how are you?")) -> cId == aliceId; _ -> False
            ]
        liftIO $ noMessages alice "nothing else should be delivered to alice"
        liftIO $ noMessages bob "nothing else should be delivered to bob"
  where
    baseId = 1
    msgId = subtract baseId

testJoinConnectionAsyncReplyErrorV8 :: HasCallStack => ATransport -> IO ()
testJoinConnectionAsyncReplyErrorV8 t = do
  let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]}
  withAgent 1 agentCfgVPrevPQ initAgentServers testDB $ \a ->
    withAgent 2 agentCfgVPrevPQ initAgentServersSrv2 testDB2 $ \b -> do
      (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
        bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
        ("1", bId', INV (ACR _ qInfo)) <- get a
        liftIO $ bId' `shouldBe` bId
        aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
        liftIO $ threadDelay 500000
        ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
        pure (aId, bId)
      nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
      withSmpServerOn t testPort2 $ do
        get b =##> \case ("2", c, OK) -> c == aId; _ -> False
        confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
          pGet a >>= \case
            ("", "", AEvt _ (UP _ [_])) -> do
              ("", _, CONF confId _ "bob's connInfo") <- get a
              pure confId
            ("", _, AEvt _ (CONF confId _ "bob's connInfo")) -> do
              ("", "", UP _ [_]) <- nGet a
              pure confId
            r -> error $ "unexpected response " <> show r
        nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
        runRight_ $ do
          allowConnectionAsync a "3" bId confId "alice's connInfo"
          get a ##> ("3", bId, OK)
          liftIO $ threadDelay 500000
          ConnectionStats {rcvQueuesInfo = [RcvQueueInfo {}], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
          pure ()
        withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
          nGet a =##> \case ("", "", UP _ [c]) -> c == bId; _ -> False
          get a ##> ("", bId, CON)
          get b ##> ("", aId, INFO "alice's connInfo")
          get b ##> ("", aId, CON)
          exchangeGreetingsMsgId 4 a bId b aId

testJoinConnectionAsyncReplyError :: HasCallStack => ATransport -> IO ()
testJoinConnectionAsyncReplyError t = do
  let initAgentServersSrv2 = initAgentServers {smp = userServers [noAuthSrv testSMPServer2]}
  withAgent 1 agentCfg initAgentServers testDB $ \a ->
    withAgent 2 agentCfg initAgentServersSrv2 testDB2 $ \b -> do
      (aId, bId) <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
        bId <- createConnectionAsync a 1 "1" True SCMInvitation (IKNoPQ PQSupportOn) SMSubscribe
        ("1", bId', INV (ACR _ qInfo)) <- get a
        liftIO $ bId' `shouldBe` bId
        aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
        liftIO $ threadDelay 500000
        ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
        pure (aId, bId)
      nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
      withSmpServerOn t testPort2 $ do
        confId <- withSmpServerStoreLogOn t testPort $ \_ -> do
          -- both servers need to be online for connection to progress because of SKEY
          get b =##> \case ("2", c, OK) -> c == aId; _ -> False
          pGet a >>= \case
            ("", "", AEvt _ (UP _ [_])) -> do
              ("", _, CONF confId _ "bob's connInfo") <- get a
              pure confId
            ("", _, AEvt _ (CONF confId _ "bob's connInfo")) -> do
              ("", "", UP _ [_]) <- nGet a
              pure confId
            r -> error $ "unexpected response " <> show r
        nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
        runRight_ $ do
          allowConnectionAsync a "3" bId confId "alice's connInfo"
          get a ##> ("3", bId, OK)
          get a ##> ("", bId, CON)
          liftIO $ threadDelay 500000
          ConnectionStats {rcvQueuesInfo = [RcvQueueInfo {}], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
          pure ()
        withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
          nGet a =##> \case ("", "", UP _ [c]) -> c == bId; _ -> False
          get b ##> ("", aId, INFO "alice's connInfo")
          get b ##> ("", aId, CON)
          exchangeGreetings a bId b aId

testUsers :: IO ()
testUsers =
  withAgentClients2 $ \a b -> runRight_ $ do
    (aId, bId) <- makeConnection a b
    exchangeGreetings a bId b aId
    auId <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
    (aId', bId') <- makeConnectionForUsers a auId b 1
    exchangeGreetings a bId' b aId'
    deleteUser a auId True
    get a =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bId'; _ -> False
    get a =##> \case ("", c, DEL_CONN) -> c == bId'; _ -> False
    nGet a =##> \case ("", "", DEL_USER u) -> u == auId; _ -> False
    exchangeGreetingsMsgId 4 a bId b aId
    liftIO $ noMessages a "nothing else should be delivered to alice"

testDeleteUserQuietly :: IO ()
testDeleteUserQuietly =
  withAgentClients2 $ \a b -> runRight_ $ do
    (aId, bId) <- makeConnection a b
    exchangeGreetings a bId b aId
    auId <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
    (aId', bId') <- makeConnectionForUsers a auId b 1
    exchangeGreetings a bId' b aId'
    deleteUser a auId False
    exchangeGreetingsMsgId 4 a bId b aId
    liftIO $ noMessages a "nothing else should be delivered to alice"

testUsersNoServer :: HasCallStack => ATransport -> IO ()
testUsersNoServer t = withAgentClientsCfg2 aCfg agentCfg $ \a b -> do
  (aId, bId, auId, _aId', bId') <- withSmpServerStoreLogOn t testPort $ \_ -> runRight $ do
    (aId, bId) <- makeConnection a b
    exchangeGreetings a bId b aId
    auId <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
    (aId', bId') <- makeConnectionForUsers a auId b 1
    exchangeGreetings a bId' b aId'
    pure (aId, bId, auId, aId', bId')
  nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId || c == bId'; _ -> False
  nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId || c == bId'; _ -> False
  nGet b =##> \case ("", "", DOWN _ cs) -> length cs == 2; _ -> False
  runRight_ $ do
    deleteUser a auId True
    get a =##> \case ("", c, DEL_RCVQ _ _ (Just (BROKER _ e))) -> c == bId' && (e == TIMEOUT || e == NETWORK); _ -> False
    get a =##> \case ("", c, DEL_CONN) -> c == bId'; _ -> False
    nGet a =##> \case ("", "", DEL_USER u) -> u == auId; _ -> False
    liftIO $ noMessages a "nothing else should be delivered to alice"
  withSmpServerStoreLogOn t testPort $ \_ -> runRight_ $ do
    nGet a =##> \case ("", "", UP _ [c]) -> c == bId; _ -> False
    nGet b =##> \case ("", "", UP _ cs) -> length cs == 2; _ -> False
    exchangeGreetingsMsgId 4 a bId b aId
  where
    aCfg = agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3}

testSwitchConnection :: InitialAgentServers -> IO ()
testSwitchConnection servers =
  withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
    (aId, bId) <- makeConnection a b
    exchangeGreetings a bId b aId
    testFullSwitch a bId b aId 8
    testFullSwitch a bId b aId 14

testFullSwitch :: AgentClient -> ByteString -> AgentClient -> ByteString -> Int64 -> ExceptT AgentErrorType IO ()
testFullSwitch a bId b aId msgId = do
  stats <- switchConnectionAsync a "" bId
  liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
  switchComplete a bId b aId
  exchangeGreetingsMsgId msgId a bId b aId

switchComplete :: AgentClient -> ByteString -> AgentClient -> ByteString -> ExceptT AgentErrorType IO ()
switchComplete a bId b aId = do
  phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
  phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
  phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
  phaseRcv a bId SPConfirmed [Just RSSendingQADD, Nothing]
  phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]
  phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
  phaseSnd b aId SPCompleted [Nothing]
  phaseRcv a bId SPCompleted [Nothing]

phaseRcv :: AgentClient -> ByteString -> SwitchPhase -> [Maybe RcvSwitchStatus] -> ExceptT AgentErrorType IO ()
phaseRcv c connId p swchStatuses = phase c connId QDRcv p (\stats -> rcvSwchStatuses' stats `shouldMatchList` swchStatuses)

rcvSwchStatuses' :: ConnectionStats -> [Maybe RcvSwitchStatus]
rcvSwchStatuses' ConnectionStats {rcvQueuesInfo} = map (\RcvQueueInfo {rcvSwitchStatus} -> rcvSwitchStatus) rcvQueuesInfo

phaseSnd :: AgentClient -> ByteString -> SwitchPhase -> [Maybe SndSwitchStatus] -> ExceptT AgentErrorType IO ()
phaseSnd c connId p swchStatuses = phase c connId QDSnd p (\stats -> sndSwchStatuses' stats `shouldMatchList` swchStatuses)

sndSwchStatuses' :: ConnectionStats -> [Maybe SndSwitchStatus]
sndSwchStatuses' ConnectionStats {sndQueuesInfo} = map (\SndQueueInfo {sndSwitchStatus} -> sndSwitchStatus) sndQueuesInfo

phase :: AgentClient -> ByteString -> QueueDirection -> SwitchPhase -> (ConnectionStats -> Expectation) -> ExceptT AgentErrorType IO ()
phase c connId d p statsExpectation =
  get c >>= \(_, connId', msg) -> do
    liftIO $ connId `shouldBe` connId'
    case msg of
      SWITCH d' p' stats -> liftIO $ do
        d `shouldBe` d'
        p `shouldBe` p'
        statsExpectation stats
      ERR (AGENT A_DUPLICATE) -> phase c connId d p statsExpectation
      r -> do
        liftIO . putStrLn $ "expected: " <> show p <> ", received: " <> show r
        SWITCH {} <- pure r
        pure ()

testSwitchAsync :: HasCallStack => InitialAgentServers -> IO ()
testSwitchAsync servers = do
  (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
    (aId, bId) <- makeConnection a b
    exchangeGreetings a bId b aId
    pure (aId, bId)
  let withA' = sessionSubscribe withA [bId]
      withB' = sessionSubscribe withB [aId]
  withA' $ \a -> do
    stats <- switchConnectionAsync a "" bId
    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
  withB' $ \b -> do
    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
  withA' $ \a -> do
    phaseRcv a bId SPConfirmed [Just RSSendingQADD, Nothing]
    phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]
  withB' $ \b -> do
    phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
    phaseSnd b aId SPCompleted [Nothing]
  withA' $ \a -> phaseRcv a bId SPCompleted [Nothing]
  withA $ \a -> withB $ \b -> runRight_ $ do
    subscribeConnection a bId
    subscribeConnection b aId
    exchangeGreetingsMsgId 8 a bId b aId
    testFullSwitch a bId b aId 14
  where
    withA :: (AgentClient -> IO a) -> IO a
    withA = withAgent 1 agentCfg servers testDB
    withB :: (AgentClient -> IO a) -> IO a
    withB = withAgent 2 agentCfg servers testDB2

withAgent :: HasCallStack => Int -> AgentConfig -> InitialAgentServers -> FilePath -> (HasCallStack => AgentClient -> IO a) -> IO a
withAgent clientId cfg' servers dbPath = bracket (getSMPAgentClient' clientId cfg' servers dbPath) (\a -> disposeAgentClient a >> threadDelay 100000)

sessionSubscribe :: (forall a. (AgentClient -> IO a) -> IO a) -> [ConnId] -> (AgentClient -> ExceptT AgentErrorType IO ()) -> IO ()
sessionSubscribe withC connIds a =
  withC $ \c -> runRight_ $ do
    void $ subscribeConnections c connIds
    r <- a c
    liftIO $ threadDelay 500000
    liftIO $ noMessages c "nothing else should be delivered"
    pure r

testSwitchDelete :: InitialAgentServers -> IO ()
testSwitchDelete servers =
  withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
    (aId, bId) <- makeConnection a b
    exchangeGreetings a bId b aId
    liftIO $ disposeAgentClient b
    stats <- switchConnectionAsync a "" bId
    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
    deleteConnectionAsync a False bId
    get a =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bId; _ -> False
    get a =##> \case ("", c, DEL_RCVQ _ _ Nothing) -> c == bId; _ -> False
    get a =##> \case ("", c, DEL_CONN) -> c == bId; _ -> False
    liftIO $ noMessages a "nothing else should be delivered to alice"

testAbortSwitchStarted :: HasCallStack => InitialAgentServers -> IO ()
testAbortSwitchStarted servers = do
  (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
    (aId, bId) <- makeConnection a b
    exchangeGreetings a bId b aId
    pure (aId, bId)
  let withA' = sessionSubscribe withA [bId]
      withB' = sessionSubscribe withB [aId]
  withA' $ \a -> do
    stats <- switchConnectionAsync a "" bId
    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
    -- repeat switch is prohibited
    Left A.CMD {cmdErr = PROHIBITED} <- liftIO . runExceptT $ switchConnectionAsync a "" bId
    -- abort current switch
    stats' <- abortConnectionSwitch a bId
    liftIO $ rcvSwchStatuses' stats' `shouldMatchList` [Nothing]
  withB' $ \b -> do
    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
  withA' $ \a -> do
    get a ##> ("", bId, ERR (AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}}))
    -- repeat switch
    stats <- switchConnectionAsync a "" bId
    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
  withA $ \a -> withB $ \b -> runRight_ $ do
    subscribeConnection a bId
    subscribeConnection b aId

    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]

    phaseRcv a bId SPConfirmed [Just RSSendingQADD, Nothing]
    phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]

    phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
    phaseSnd b aId SPCompleted [Nothing]

    phaseRcv a bId SPCompleted [Nothing]

    exchangeGreetingsMsgId 10 a bId b aId

    testFullSwitch a bId b aId 16
  where
    withA :: (AgentClient -> IO a) -> IO a
    withA = withAgent 1 agentCfg servers testDB
    withB :: (AgentClient -> IO a) -> IO a
    withB = withAgent 2 agentCfg servers testDB2

testAbortSwitchStartedReinitiate :: HasCallStack => InitialAgentServers -> IO ()
testAbortSwitchStartedReinitiate servers = do
  (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
    (aId, bId) <- makeConnection a b
    exchangeGreetings a bId b aId
    pure (aId, bId)
  let withA' = sessionSubscribe withA [bId]
      withB' = sessionSubscribe withB [aId]
  withA' $ \a -> do
    stats <- switchConnectionAsync a "" bId
    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
    -- abort current switch
    stats' <- abortConnectionSwitch a bId
    liftIO $ rcvSwchStatuses' stats' `shouldMatchList` [Nothing]
    -- repeat switch
    stats'' <- switchConnectionAsync a "" bId
    liftIO $ rcvSwchStatuses' stats'' `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
  withB' $ \b -> do
    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
    liftIO . getInAnyOrder b $
      [ switchPhaseSndP aId SPStarted [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId SPConfirmed [Just SSSendingQKEY, Nothing]
      ]
    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
  withA $ \a -> withB $ \b -> runRight_ $ do
    subscribeConnection a bId
    subscribeConnection b aId

    liftIO . getInAnyOrder a $
      [ errQueueNotFoundP bId,
        switchPhaseRcvP bId SPConfirmed [Just RSSendingQADD, Nothing]
      ]

    phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]

    phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
    phaseSnd b aId SPCompleted [Nothing]

    phaseRcv a bId SPCompleted [Nothing]

    exchangeGreetingsMsgId 10 a bId b aId

    testFullSwitch a bId b aId 16
  where
    withA :: (AgentClient -> IO a) -> IO a
    withA = withAgent 1 agentCfg servers testDB
    withB :: (AgentClient -> IO a) -> IO a
    withB = withAgent 2 agentCfg servers testDB2

switchPhaseRcvP :: ConnId -> SwitchPhase -> [Maybe RcvSwitchStatus] -> ATransmission -> Bool
switchPhaseRcvP cId sphase swchStatuses = switchPhaseP cId QDRcv sphase (\stats -> rcvSwchStatuses' stats == swchStatuses)

switchPhaseSndP :: ConnId -> SwitchPhase -> [Maybe SndSwitchStatus] -> ATransmission -> Bool
switchPhaseSndP cId sphase swchStatuses = switchPhaseP cId QDSnd sphase (\stats -> sndSwchStatuses' stats == swchStatuses)

switchPhaseP :: ConnId -> QueueDirection -> SwitchPhase -> (ConnectionStats -> Bool) -> ATransmission -> Bool
switchPhaseP cId qd sphase statsP = \case
  (_, cId', AEvt SAEConn (SWITCH qd' sphase' stats)) -> cId' == cId && qd' == qd && sphase' == sphase && statsP stats
  _ -> False

errQueueNotFoundP :: ConnId -> ATransmission -> Bool
errQueueNotFoundP cId = \case
  (_, cId', AEvt SAEConn (ERR AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}})) -> cId' == cId
  _ -> False

testCannotAbortSwitchSecured :: HasCallStack => InitialAgentServers -> IO ()
testCannotAbortSwitchSecured servers = do
  (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
    (aId, bId) <- makeConnection a b
    exchangeGreetings a bId b aId
    pure (aId, bId)
  let withA' = sessionSubscribe withA [bId]
      withB' = sessionSubscribe withB [aId]
  withA' $ \a -> do
    stats <- switchConnectionAsync a "" bId
    liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId SPStarted [Just RSSendingQADD, Nothing]
  withB' $ \b -> do
    phaseSnd b aId SPStarted [Just SSSendingQKEY, Nothing]
    phaseSnd b aId SPConfirmed [Just SSSendingQKEY, Nothing]
  withA' $ \a -> do
    phaseRcv a bId SPConfirmed [Just RSSendingQADD, Nothing]
    phaseRcv a bId SPSecured [Just RSSendingQUSE, Nothing]
    Left A.CMD {cmdErr = PROHIBITED} <- liftIO . runExceptT $ abortConnectionSwitch a bId
    pure ()
  withA $ \a -> withB $ \b -> runRight_ $ do
    subscribeConnection a bId
    subscribeConnection b aId

    phaseSnd b aId SPSecured [Just SSSendingQTEST, Nothing]
    phaseSnd b aId SPCompleted [Nothing]

    phaseRcv a bId SPCompleted [Nothing]

    exchangeGreetingsMsgId 8 a bId b aId

    testFullSwitch a bId b aId 14
  where
    withA :: (AgentClient -> IO a) -> IO a
    withA = withAgent 1 agentCfg servers testDB
    withB :: (AgentClient -> IO a) -> IO a
    withB = withAgent 2 agentCfg servers testDB2

testSwitch2Connections :: HasCallStack => InitialAgentServers -> IO ()
testSwitch2Connections servers = do
  (aId1, bId1, aId2, bId2) <- withA $ \a -> withB $ \b -> runRight $ do
    (aId1, bId1) <- makeConnection a b
    exchangeGreetings a bId1 b aId1
    (aId2, bId2) <- makeConnection a b
    exchangeGreetings a bId2 b aId2
    pure (aId1, bId1, aId2, bId2)
  let withA' = sessionSubscribe withA [bId1, bId2]
      withB' = sessionSubscribe withB [aId1, aId2]
  withA' $ \a -> do
    stats1 <- switchConnectionAsync a "" bId1
    liftIO $ rcvSwchStatuses' stats1 `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId1 SPStarted [Just RSSendingQADD, Nothing]
    stats2 <- switchConnectionAsync a "" bId2
    liftIO $ rcvSwchStatuses' stats2 `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId2 SPStarted [Just RSSendingQADD, Nothing]
  withB' $ \b -> do
    liftIO . getInAnyOrder b $
      [ switchPhaseSndP aId1 SPStarted [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId1 SPConfirmed [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId2 SPStarted [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId2 SPConfirmed [Just SSSendingQKEY, Nothing]
      ]
  withA' $ \a -> do
    liftIO . getInAnyOrder a $
      [ switchPhaseRcvP bId1 SPConfirmed [Just RSSendingQADD, Nothing],
        switchPhaseRcvP bId1 SPSecured [Just RSSendingQUSE, Nothing],
        switchPhaseRcvP bId2 SPConfirmed [Just RSSendingQADD, Nothing],
        switchPhaseRcvP bId2 SPSecured [Just RSSendingQUSE, Nothing]
      ]
  withB' $ \b -> do
    liftIO . getInAnyOrder b $
      [ switchPhaseSndP aId1 SPSecured [Just SSSendingQTEST, Nothing],
        switchPhaseSndP aId1 SPCompleted [Nothing],
        switchPhaseSndP aId2 SPSecured [Just SSSendingQTEST, Nothing],
        switchPhaseSndP aId2 SPCompleted [Nothing]
      ]
  withA' $ \a -> do
    liftIO . getInAnyOrder a $
      [ switchPhaseRcvP bId1 SPCompleted [Nothing],
        switchPhaseRcvP bId2 SPCompleted [Nothing]
      ]
  withA $ \a -> withB $ \b -> runRight_ $ do
    void $ subscribeConnections a [bId1, bId2]
    void $ subscribeConnections b [aId1, aId2]

    exchangeGreetingsMsgId 8 a bId1 b aId1
    exchangeGreetingsMsgId 8 a bId2 b aId2

    testFullSwitch a bId1 b aId1 14
    testFullSwitch a bId2 b aId2 14
  where
    withA :: (AgentClient -> IO a) -> IO a
    withA = withAgent 1 agentCfg servers testDB
    withB :: (AgentClient -> IO a) -> IO a
    withB = withAgent 2 agentCfg servers testDB2

testSwitch2ConnectionsAbort1 :: HasCallStack => InitialAgentServers -> IO ()
testSwitch2ConnectionsAbort1 servers = do
  (aId1, bId1, aId2, bId2) <- withA $ \a -> withB $ \b -> runRight $ do
    (aId1, bId1) <- makeConnection a b
    exchangeGreetings a bId1 b aId1
    (aId2, bId2) <- makeConnection a b
    exchangeGreetings a bId2 b aId2
    pure (aId1, bId1, aId2, bId2)
  let withA' = sessionSubscribe withA [bId1, bId2]
      withB' = sessionSubscribe withB [aId1, aId2]
  withA' $ \a -> do
    stats1 <- switchConnectionAsync a "" bId1
    liftIO $ rcvSwchStatuses' stats1 `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId1 SPStarted [Just RSSendingQADD, Nothing]
    stats2 <- switchConnectionAsync a "" bId2
    liftIO $ rcvSwchStatuses' stats2 `shouldMatchList` [Just RSSwitchStarted]
    phaseRcv a bId2 SPStarted [Just RSSendingQADD, Nothing]
    -- abort switch of second connection
    stats2' <- abortConnectionSwitch a bId2
    liftIO $ rcvSwchStatuses' stats2' `shouldMatchList` [Nothing]
  withB' $ \b -> do
    liftIO . getInAnyOrder b $
      [ switchPhaseSndP aId1 SPStarted [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId1 SPConfirmed [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId2 SPStarted [Just SSSendingQKEY, Nothing],
        switchPhaseSndP aId2 SPConfirmed [Just SSSendingQKEY, Nothing]
      ]
  withA' $ \a -> do
    liftIO . getInAnyOrder a $
      [ switchPhaseRcvP bId1 SPConfirmed [Just RSSendingQADD, Nothing],
        switchPhaseRcvP bId1 SPSecured [Just RSSendingQUSE, Nothing],
        errQueueNotFoundP bId2
      ]
  withA $ \a -> withB $ \b -> runRight_ $ do
    void $ subscribeConnections a [bId1, bId2]
    void $ subscribeConnections b [aId1, aId2]

    phaseSnd b aId1 SPSecured [Just SSSendingQTEST, Nothing]
    phaseSnd b aId1 SPCompleted [Nothing]

    phaseRcv a bId1 SPCompleted [Nothing]

    exchangeGreetingsMsgId 8 a bId1 b aId1
    exchangeGreetingsMsgId 6 a bId2 b aId2

    testFullSwitch a bId1 b aId1 14
    testFullSwitch a bId2 b aId2 12
  where
    withA :: (AgentClient -> IO a) -> IO a
    withA = withAgent 1 agentCfg servers testDB
    withB :: (AgentClient -> IO a) -> IO a
    withB = withAgent 2 agentCfg servers testDB2

testCreateQueueAuth :: HasCallStack => VersionSMP -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> AgentMsgId -> IO Int
testCreateQueueAuth srvVersion clnt1 clnt2 baseId = do
  a <- getClient 1 clnt1 testDB
  b <- getClient 2 clnt2 testDB2
  r <- runRight $ do
    tryError (createConnection a 1 True SCMInvitation Nothing SMSubscribe) >>= \case
      Left (SMP _ AUTH) -> pure 0
      Left e -> throwError e
      Right (bId, qInfo) ->
        tryError (joinConnection b 1 True qInfo "bob's connInfo" SMSubscribe) >>= \case
          Left (SMP _ AUTH) -> pure 1
          Left e -> throwError e
          Right aId -> do
            ("", _, CONF confId _ "bob's connInfo") <- get a
            allowConnection a bId confId "alice's connInfo"
            get a ##> ("", bId, CON)
            get b ##> ("", aId, INFO "alice's connInfo")
            get b ##> ("", aId, CON)
            exchangeGreetingsMsgId (baseId + 1) a bId b aId
            pure 2
  disposeAgentClient a
  disposeAgentClient b
  pure r
  where
    getClient clientId (clntAuth, clntVersion) db =
      let servers = initAgentServers {smp = userServers [ProtoServerWithAuth testSMPServer clntAuth]}
          alpn_ = if clntVersion >= authCmdsSMPVersion then Just supportedSMPHandshakes else Nothing
          smpCfg = defaultClientConfig alpn_ $ V.mkVersionRange (prevVersion basicAuthSMPVersion) clntVersion
          sndAuthAlg = if srvVersion >= authCmdsSMPVersion && clntVersion >= authCmdsSMPVersion then C.AuthAlg C.SX25519 else C.AuthAlg C.SEd25519
       in getSMPAgentClient' clientId agentCfg {smpCfg, sndAuthAlg} servers db

testSMPServerConnectionTest :: ATransport -> Maybe BasicAuth -> SMPServerWithAuth -> IO (Maybe ProtocolTestFailure)
testSMPServerConnectionTest t newQueueBasicAuth srv =
  withSmpServerConfigOn t cfg {newQueueBasicAuth} testPort2 $ \_ -> do
    -- initially passed server is not running
    withAgent 1 agentCfg initAgentServers testDB $ \a ->
      testProtocolServer a 1 srv

testRatchetAdHash :: HasCallStack => IO ()
testRatchetAdHash =
  withAgentClients2 $ \a b -> runRight_ $ do
    (aId, bId) <- makeConnection a b
    ad1 <- getConnectionRatchetAdHash a bId
    ad2 <- getConnectionRatchetAdHash b aId
    liftIO $ ad1 `shouldBe` ad2

testDeliveryReceipts :: HasCallStack => IO ()
testDeliveryReceipts =
  withAgentClients2 $ \a b -> runRight_ $ do
    (aId, bId) <- makeConnection a b
    -- a sends, b receives and sends delivery receipt
    2 <- sendMessage a bId SMP.noMsgFlags "hello"
    get a ##> ("", bId, SENT 2)
    get b =##> \case ("", c, Msg "hello") -> c == aId; _ -> False
    ackMessage b aId 2 $ Just ""
    get a =##> \case ("", c, Rcvd 2) -> c == bId; _ -> False
    ackMessage a bId 3 Nothing
    -- b sends, a receives and sends delivery receipt
    4 <- sendMessage b aId SMP.noMsgFlags "hello too"
    get b ##> ("", aId, SENT 4)
    get a =##> \case ("", c, Msg "hello too") -> c == bId; _ -> False
    ackMessage a bId 4 $ Just ""
    get b =##> \case ("", c, Rcvd 4) -> c == aId; _ -> False
    ackMessage b aId 5 (Just "") `catchError` \case (A.CMD PROHIBITED _) -> pure (); e -> liftIO $ expectationFailure ("unexpected error " <> show e)
    ackMessage b aId 5 Nothing

testDeliveryReceiptsVersion :: HasCallStack => ATransport -> IO ()
testDeliveryReceiptsVersion t = do
  a <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB
  b <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2
  withSmpServerStoreMsgLogOn t testPort $ \_ -> do
    (aId, bId) <- runRight $ do
      (aId, bId) <- makeConnection_ PQSupportOff a b
      checkVersion a bId 3
      checkVersion b aId 3
      (2, _) <- A.sendMessage a bId PQEncOff SMP.noMsgFlags "hello"
      get a ##> ("", bId, SENT 2)
      get b =##> \case ("", c, Msg' 2 PQEncOff "hello") -> c == aId; _ -> False
      ackMessage b aId 2 $ Just ""
      liftIO $ noMessages a "no delivery receipt (unsupported version)"
      (3, _) <- A.sendMessage b aId PQEncOff SMP.noMsgFlags "hello too"
      get b ##> ("", aId, SENT 3)
      get a =##> \case ("", c, Msg' 3 PQEncOff "hello too") -> c == bId; _ -> False
      ackMessage a bId 3 $ Just ""
      liftIO $ noMessages b "no delivery receipt (unsupported version)"
      pure (aId, bId)

    disposeAgentClient a
    disposeAgentClient b
    a' <- getSMPAgentClient' 3 agentCfg {smpAgentVRange = supportedSMPAgentVRange} initAgentServers testDB
    b' <- getSMPAgentClient' 4 agentCfg {smpAgentVRange = supportedSMPAgentVRange} initAgentServers testDB2

    runRight_ $ do
      subscribeConnection a' bId
      subscribeConnection b' aId
      exchangeGreetingsMsgId_ PQEncOff 4 a' bId b' aId
      checkVersion a' bId 6
      checkVersion b' aId 6
      (6, PQEncOff) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello"
      get a' ##> ("", bId, SENT 6)
      get b' =##> \case ("", c, Msg' 6 PQEncOff "hello") -> c == aId; _ -> False
      ackMessage b' aId 6 $ Just ""
      get a' =##> \case ("", c, Rcvd 6) -> c == bId; _ -> False
      ackMessage a' bId 7 Nothing
      (8, PQEncOff) <- A.sendMessage b' aId PQEncOn SMP.noMsgFlags "hello too"
      get b' ##> ("", aId, SENT 8)
      get a' =##> \case ("", c, Msg' 8 PQEncOff "hello too") -> c == bId; _ -> False
      ackMessage a' bId 8 $ Just ""
      get b' =##> \case ("", c, Rcvd 8) -> c == aId; _ -> False
      ackMessage b' aId 9 Nothing
      (10, _) <- A.sendMessage a' bId PQEncOn SMP.noMsgFlags "hello 2"
      get a' ##> ("", bId, SENT 10)
      get b' =##> \case ("", c, Msg' 10 PQEncOff "hello 2") -> c == aId; _ -> False
      ackMessage b' aId 10 $ Just ""
      get a' =##> \case ("", c, Rcvd 10) -> c == bId; _ -> False
      ackMessage a' bId 11 Nothing
    disposeAgentClient a'
    disposeAgentClient b'

testDeliveryReceiptsConcurrent :: HasCallStack => ATransport -> IO ()
testDeliveryReceiptsConcurrent t =
  withSmpServerConfigOn t cfg {msgQueueQuota = 256} testPort $ \_ -> do
    withAgentClients2 $ \a b -> do
      (aId, bId) <- runRight $ makeConnection a b
      t1 <- liftIO getCurrentTime
      concurrently_ (runClient "a" a bId) (runClient "b" b aId)
      t2 <- liftIO getCurrentTime
      diffUTCTime t2 t1 `shouldSatisfy` (< 60)
      liftIO $ noMessages a "nothing else should be delivered to alice"
      liftIO $ noMessages b "nothing else should be delivered to bob"
  where
    runClient :: String -> AgentClient -> ConnId -> IO ()
    runClient _cName client connId = do
      concurrently_ send receive
      where
        numMsgs = 100
        send = runRight_ $
          replicateM_ numMsgs $ do
            void $ sendMessage client connId SMP.noMsgFlags "hello"
        receive =
          runRight_ $
            -- for each sent message: 1 SENT, 1 RCVD, 1 OK for acknowledging RCVD
            -- for each received message: 1 MSG, 1 OK for acknowledging MSG
            receiveLoop (numMsgs * 5)
        receiveLoop :: Int -> ExceptT AgentErrorType IO ()
        receiveLoop 0 = pure ()
        receiveLoop n = do
          r <- getWithTimeout
          case r of
            (_, _, SENT _) -> do
              -- liftIO $ print $ cName <> ": SENT"
              pure ()
            (_, _, MSG MsgMeta {recipient = (msgId, _), integrity = MsgOk} _ _) -> do
              -- liftIO $ print $ cName <> ": MSG " <> show msgId
              ackMessageAsync client (B.pack . show $ n) connId msgId (Just "")
            (_, _, RCVD MsgMeta {recipient = (msgId, _), integrity = MsgOk} _) -> do
              -- liftIO $ print $ cName <> ": RCVD " <> show msgId
              ackMessageAsync client (B.pack . show $ n) connId msgId Nothing
            (_, _, OK) -> do
              -- liftIO $ print $ cName <> ": OK"
              pure ()
            r' -> error $ "unexpected event: " <> show r'
          receiveLoop (n - 1)
        getWithTimeout :: ExceptT AgentErrorType IO (AEntityTransmission 'AEConn)
        getWithTimeout = do
          3000000 `timeout` get client >>= \case
            Just r -> pure r
            _ -> error "timeout"

testTwoUsers :: HasCallStack => IO ()
testTwoUsers = withAgentClientsCfg2 aCfg aCfg $ \a b -> do
  let nc = netCfg initAgentServers
  sessionMode nc `shouldBe` TSMUser
  runRight_ $ do
    (aId1, bId1) <- makeConnectionForUsers a 1 b 1
    exchangeGreetings a bId1 b aId1
    (aId1', bId1') <- makeConnectionForUsers a 1 b 1
    exchangeGreetings a bId1' b aId1'
    a `hasClients` 1
    b `hasClients` 1
    liftIO $ setNetworkConfig a nc {sessionMode = TSMEntity}
    liftIO $ threadDelay 250000
    ("", "", DOWN_ALL) <- nGet a
    ("", "", UP _ _) <- nGet a
    a `hasClients` 2

    exchangeGreetingsMsgId 4 a bId1 b aId1
    exchangeGreetingsMsgId 4 a bId1' b aId1'
    liftIO $ threadDelay 250000
    liftIO $ setNetworkConfig a nc {sessionMode = TSMUser}
    liftIO $ threadDelay 250000
    ("", "", DOWN_ALL) <- nGet a
    ("", "", UP _ _) <- nGet a
    a `hasClients` 1

    aUserId2 <- createUser a [noAuthSrv testSMPServer] [noAuthSrv testXFTPServer]
    (aId2, bId2) <- makeConnectionForUsers a aUserId2 b 1
    exchangeGreetings a bId2 b aId2
    (aId2', bId2') <- makeConnectionForUsers a aUserId2 b 1
    exchangeGreetings a bId2' b aId2'
    a `hasClients` 2
    b `hasClients` 1
    liftIO $ setNetworkConfig a nc {sessionMode = TSMEntity}
    liftIO $ threadDelay 250000
    ("", "", DOWN_ALL) <- nGet a
    ("", "", UP _ _) <- nGet a
    a `hasClients` 4
    exchangeGreetingsMsgId 6 a bId1 b aId1
    exchangeGreetingsMsgId 6 a bId1' b aId1'
    exchangeGreetingsMsgId 4 a bId2 b aId2
    exchangeGreetingsMsgId 4 a bId2' b aId2'
    liftIO $ threadDelay 250000
    liftIO $ setNetworkConfig a nc {sessionMode = TSMUser}
    liftIO $ threadDelay 250000
    ("", "", DOWN_ALL) <- nGet a
    ("", "", UP _ _) <- nGet a
    a `hasClients` 2
    exchangeGreetingsMsgId 8 a bId1 b aId1
    exchangeGreetingsMsgId 8 a bId1' b aId1'
    exchangeGreetingsMsgId 6 a bId2 b aId2
    exchangeGreetingsMsgId 6 a bId2' b aId2'
  where
    aCfg :: AgentConfig
    aCfg = agentCfg {tbqSize = 16}
    hasClients :: HasCallStack => AgentClient -> Int -> ExceptT AgentErrorType IO ()
    hasClients c n = liftIO $ M.size <$> readTVarIO (smpClients c) `shouldReturn` n

getSMPAgentClient' :: Int -> AgentConfig -> InitialAgentServers -> FilePath -> IO AgentClient
getSMPAgentClient' clientId cfg' initServers dbPath = do
  Right st <- liftIO $ createAgentStore dbPath "" False MCError
  c <- getSMPAgentClient_ clientId cfg' initServers st False
  when (dbNew st) $ withTransaction' st (`SQL.execute_` "INSERT INTO users (user_id) VALUES (1)")
  pure c

testServerMultipleIdentities :: HasCallStack => IO ()
testServerMultipleIdentities =
  withAgentClients2 $ \alice bob -> runRight_ $ do
    (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    allowConnection alice bobId confId "alice's connInfo"
    get alice ##> ("", bobId, CON)
    get bob ##> ("", aliceId, INFO "alice's connInfo")
    get bob ##> ("", aliceId, CON)
    exchangeGreetings alice bobId bob aliceId
    -- this saves queue with second server identity
    bob' <- liftIO $ do
      Left (BROKER _ NETWORK) <- runExceptT $ joinConnection bob 1 True secondIdentityCReq "bob's connInfo" SMSubscribe
      disposeAgentClient bob
      threadDelay 250000
      getSMPAgentClient' 3 agentCfg initAgentServers testDB2
    subscribeConnection bob' aliceId
    exchangeGreetingsMsgId 4 alice bobId bob' aliceId
    liftIO $ disposeAgentClient bob'
  where
    secondIdentityCReq :: ConnectionRequestUri 'CMInvitation
    secondIdentityCReq =
      CRInvitationUri
        connReqData
          { crSmpQueues =
              [ SMPQueueUri
                  supportedSMPClientVRange
                  queueAddr
                    { smpServer = SMPServer "localhost" "5001" (C.KeyHash "\215m\248\251")
                    }
              ]
          }
        testE2ERatchetParams12

testWaitForUserNetwork :: IO ()
testWaitForUserNetwork = do
  a <- getSMPAgentClient' 1 aCfg initAgentServers testDB
  noNetworkDelay a
  setUserNetworkInfo a $ UserNetworkInfo UNNone False
  networkDelay a 100000
  networkDelay a 100000
  setUserNetworkInfo a $ UserNetworkInfo UNCellular True
  noNetworkDelay a
  setUserNetworkInfo a $ UserNetworkInfo UNCellular False
  networkDelay a 100000
  concurrently_
    (threadDelay 50000 >> setUserNetworkInfo a (UserNetworkInfo UNCellular True))
    (networkDelay a 50000)
  noNetworkDelay a
  where
    aCfg = agentCfg {userNetworkInterval = 100000, userOfflineDelay = 0}

testDoNotResetOnlineToOffline :: IO ()
testDoNotResetOnlineToOffline = do
  a <- getSMPAgentClient' 1 aCfg initAgentServers testDB
  noNetworkDelay a
  setUserNetworkInfo a $ UserNetworkInfo UNWifi False
  networkDelay a 100000
  setUserNetworkInfo a $ UserNetworkInfo UNWifi False
  setUserNetworkInfo a $ UserNetworkInfo UNWifi True
  noNetworkDelay a
  setUserNetworkInfo a $ UserNetworkInfo UNWifi False -- ingnored
  noNetworkDelay a
  threadDelay 100000
  setUserNetworkInfo a $ UserNetworkInfo UNWifi False
  networkDelay a 100000
  setUserNetworkInfo a $ UserNetworkInfo UNNone False
  networkDelay a 100000
  setUserNetworkInfo a $ UserNetworkInfo UNWifi True
  setUserNetworkInfo a $ UserNetworkInfo UNNone False -- ingnored
  noNetworkDelay a
  where
    aCfg = agentCfg {userNetworkInterval = 100000, userOfflineDelay = 0.1}

testResumeMultipleThreads :: IO ()
testResumeMultipleThreads = do
  a <- getSMPAgentClient' 1 aCfg initAgentServers testDB
  noNetworkDelay a
  setUserNetworkInfo a $ UserNetworkInfo UNNone False
  vs <-
    replicateM 50000 $ do
      v <- newEmptyTMVarIO
      void . forkIO $ waitNetwork a >>= atomically . putTMVar v
      pure v
  threadDelay 1000000
  setUserNetworkInfo a $ UserNetworkInfo UNCellular True
  ts <- mapM (atomically . readTMVar) vs
  -- print $ minimum ts
  -- print $ maximum ts
  -- print $ sum ts `div` fromIntegral (length ts)
  let average = sum ts `div` fromIntegral (length ts)
  average < 3000000 `shouldBe` True
  maximum ts < 4000000 `shouldBe` True
  where
    aCfg = agentCfg {userOfflineDelay = 0}

testServerQueueInfo :: IO ()
testServerQueueInfo = do
  withAgentClients2 $ \alice bob -> runRight_ $ do
    (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
    liftIO $ threadDelay 200000
    checkEmptyQ alice bobId False
    aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe
    ("", _, CONF confId _ "bob's connInfo") <- get alice
    liftIO $ threadDelay 200000
    checkEmptyQ alice bobId True -- secured by sender
    allowConnection alice bobId confId "alice's connInfo"
    get alice ##> ("", bobId, CON)
    get bob ##> ("", aliceId, INFO "alice's connInfo")
    get bob ##> ("", aliceId, CON)
    liftIO $ threadDelay 200000
    checkEmptyQ alice bobId True
    checkEmptyQ bob aliceId True
    let msgId = 2
    (msgId', PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello"
    liftIO $ msgId' `shouldBe` msgId
    get alice ##> ("", bobId, SENT msgId)
    liftIO $ threadDelay 200000
    Just srvMsgId <- checkMsgQ bob aliceId 1
    get bob =##> \case
      ("", c, MSG MsgMeta {integrity = MsgOk, broker = (smId, _), recipient = (mId, _), pqEncryption = PQEncOn} _ "hello") ->
        c == aliceId && decodeLatin1 (B64.encode smId) == srvMsgId && mId == msgId
      _ -> False
    ackMessage bob aliceId msgId Nothing
    liftIO $ threadDelay 200000
    checkEmptyQ bob aliceId True
    (msgId1, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello 1"
    get alice ##> ("", bobId, SENT msgId1)
    Just _ <- checkMsgQ bob aliceId 1
    (msgId2, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello 2"
    get alice ##> ("", bobId, SENT msgId2)
    (msgId3, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello 3"
    get alice ##> ("", bobId, SENT msgId3)
    (msgId4, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello 4"
    get alice ##> ("", bobId, SENT msgId4)
    Just _ <- checkMsgQ bob aliceId 4
    (msgId5, PQEncOn) <- A.sendMessage alice bobId PQEncOn SMP.noMsgFlags "hello: quota exceeded"
    liftIO $ threadDelay 200000
    Just _ <- checkMsgQ bob aliceId 5
    get bob =##> \case ("", c, Msg' mId PQEncOn "hello 1") -> c == aliceId && mId == msgId1; _ -> False
    ackMessage bob aliceId msgId1 Nothing
    liftIO $ threadDelay 200000
    Just _ <- checkMsgQ bob aliceId 4
    get bob =##> \case ("", c, Msg' mId PQEncOn "hello 2") -> c == aliceId && mId == msgId2; _ -> False
    ackMessage bob aliceId msgId2 Nothing
    get bob =##> \case ("", c, Msg' mId PQEncOn "hello 3") -> c == aliceId && mId == msgId3; _ -> False
    ackMessage bob aliceId msgId3 Nothing
    liftIO $ threadDelay 200000
    Just _ <- checkMsgQ bob aliceId 2
    get bob =##> \case ("", c, Msg' mId PQEncOn "hello 4") -> c == aliceId && mId == msgId4; _ -> False
    ackMessage bob aliceId msgId4 Nothing
    liftIO $ threadDelay 200000
    Just _ <- checkMsgQ bob aliceId 1 -- the one that did not fit now accepted
    get alice ##> ("", bobId, QCONT)
    get alice ##> ("", bobId, SENT msgId5)
    liftIO $ threadDelay 200000
    Just _srvMsgId <- checkQ bob aliceId True (Just QNoSub) 1 (Just MTMessage)
    get bob =##> \case ("", c, Msg' mId PQEncOn "hello: quota exceeded") -> c == aliceId && mId == msgId5 + 1; _ -> False
    ackMessage bob aliceId (msgId5 + 1) Nothing
    liftIO $ threadDelay 200000
    checkEmptyQ bob aliceId True
    pure ()
  where
    checkEmptyQ c cId qiSnd' = do
      r <- checkQ c cId qiSnd' (Just QNoSub) 0 Nothing
      liftIO $ r `shouldBe` Nothing
    checkMsgQ c cId qiSize' = do
      r <- checkQ c cId True (Just QNoSub) qiSize' (Just MTMessage)
      liftIO $ isJust r `shouldBe` True
      pure r
    checkQ c cId qiSnd' qiSubThread_ qiSize' msgType_ = do
      ServerQueueInfo {info = QueueInfo {qiSnd, qiNtf, qiSub, qiSize, qiMsg}} <- getConnectionQueueInfo c cId
      liftIO $ do
        qiSnd `shouldBe` qiSnd'
        qiNtf `shouldBe` False
        qSubThread <$> qiSub `shouldBe` qiSubThread_
        qiSize `shouldBe` qiSize'
        msgId_ <- forM qiMsg $ \MsgInfo {msgId, msgType} -> msgId <$ (Just msgType `shouldBe` msgType_)
        qDelivered <$> qiSub `shouldBe` Just msgId_
        pure msgId_

noNetworkDelay :: AgentClient -> IO ()
noNetworkDelay a = do
  d <- waitNetwork a
  unless (d < 10000) $ expectationFailure $ "expected no delay, d = " <> show d

networkDelay :: AgentClient -> Int64 -> IO ()
networkDelay a d' = do
  d <- waitNetwork a
  unless (d' - 1000 < d && d < d' + 15000) $ expectationFailure $ "expected delay " <> show d' <> ", d = " <> show d

waitNetwork :: AgentClient -> IO Int64
waitNetwork a = do
  t <- getCurrentTime
  waitForUserNetwork a
  t' <- getCurrentTime
  pure $ diffToMicroseconds $ diffUTCTime t' t

exchangeGreetings :: HasCallStack => AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
exchangeGreetings = exchangeGreetings_ PQEncOn

exchangeGreetings_ :: HasCallStack => PQEncryption -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
exchangeGreetings_ pqEnc = exchangeGreetingsMsgId_ pqEnc 2

exchangeGreetingsMsgId :: HasCallStack => Int64 -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
exchangeGreetingsMsgId = exchangeGreetingsMsgId_ PQEncOn

exchangeGreetingsMsgId_ :: HasCallStack => PQEncryption -> Int64 -> AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
exchangeGreetingsMsgId_ pqEnc msgId alice bobId bob aliceId = do
  msgId1 <- A.sendMessage alice bobId pqEnc SMP.noMsgFlags "hello"
  liftIO $ msgId1 `shouldBe` (msgId, pqEnc)
  get alice ##> ("", bobId, SENT msgId)
  get bob =##> \case ("", c, Msg' mId pq "hello") -> c == aliceId && mId == msgId && pq == pqEnc; _ -> False
  ackMessage bob aliceId msgId Nothing
  msgId2 <- A.sendMessage bob aliceId pqEnc SMP.noMsgFlags "hello too"
  let msgId' = msgId + 1
  liftIO $ msgId2 `shouldBe` (msgId', pqEnc)
  get bob ##> ("", aliceId, SENT msgId')
  get alice =##> \case ("", c, Msg' mId pq "hello too") -> c == bobId && mId == msgId' && pq == pqEnc; _ -> False
  ackMessage alice bobId msgId' Nothing

exchangeGreetingsMsgIds :: HasCallStack => AgentClient -> ConnId -> Int64 -> AgentClient -> ConnId -> Int64 -> ExceptT AgentErrorType IO ()
exchangeGreetingsMsgIds alice bobId aliceMsgId bob aliceId bobMsgId = do
  msgId1 <- sendMessage alice bobId SMP.noMsgFlags "hello"
  liftIO $ msgId1 `shouldBe` aliceMsgId
  get alice ##> ("", bobId, SENT aliceMsgId)
  get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
  ackMessage bob aliceId bobMsgId Nothing
  msgId2 <- sendMessage bob aliceId SMP.noMsgFlags "hello too"
  let aliceMsgId' = aliceMsgId + 1
      bobMsgId' = bobMsgId + 1
  liftIO $ msgId2 `shouldBe` bobMsgId'
  get bob ##> ("", aliceId, SENT bobMsgId')
  get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
  ackMessage alice bobId aliceMsgId' Nothing

newtype InternalException e = InternalException {unInternalException :: e}
  deriving (Eq, Show)

instance Exception e => Exception (InternalException e)

instance Exception e => MonadUnliftIO (ExceptT e IO) where
  {-# INLINE withRunInIO #-}
  withRunInIO :: ((forall a. ExceptT e IO a -> IO a) -> IO b) -> ExceptT e IO b
  withRunInIO inner =
    ExceptT . fmap (first unInternalException) . try $
      withRunInIO $ \run ->
        inner $ run . (either (throwIO . InternalException) pure <=< runExceptT)