From 7565ddd91c74010da2f443a76259276e8a429caf Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 18 Jul 2024 19:54:14 +0400 Subject: [PATCH] agent: initialize ratchet on processing confirmation to support decryption of messages received before allowConnection; return SndQueueSecured from joinConnection, acceptContact (#1233) --- src/Simplex/Messaging/Agent.hs | 72 +++--- src/Simplex/Messaging/Agent/Protocol.hs | 12 +- tests/AgentTests/ConnectionRequestTests.hs | 30 +-- tests/AgentTests/FunctionalAPITests.hs | 275 ++++++++++++--------- tests/AgentTests/NotificationTests.hs | 10 +- tests/SMPProxyTests.hs | 9 +- 6 files changed, 241 insertions(+), 167 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 94ed7f44f..a0079c883 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -339,7 +339,7 @@ prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs -- | Join SMP agent connection (JOIN command). -joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId +joinConnection :: AgentClient -> UserId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured) joinConnection c userId Nothing enableNtfs = withAgentEnv c .:: joinConn c userId "" False enableNtfs joinConnection c userId (Just connId) enableNtfs = withAgentEnv c .:: joinConn c userId connId True enableNtfs {-# INLINE joinConnection #-} @@ -350,7 +350,7 @@ allowConnection c = withAgentEnv c .:. allowConnection' c {-# INLINE allowConnection #-} -- | Accept contact after REQ notification (ACPT command) -acceptContact :: AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId +acceptContact :: AgentClient -> Bool -> ConfirmationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AE (ConnId, SndQueueSecured) acceptContact c enableNtfs = withAgentEnv c .:: acceptContact' c "" enableNtfs {-# INLINE acceptContact #-} @@ -783,7 +783,7 @@ newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} withStore c $ \db -> createNewConn db g cData SCMInvitation -joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId +joinConn :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured) joinConn c userId connId hasNewConn enableNtfs cReq cInfo pqSupport subMode = do srv <- case cReq of CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> @@ -842,7 +842,7 @@ versionPQSupport_ :: VersionSMPA -> Maybe CR.VersionE2E -> PQSupport versionPQSupport_ agentV e2eV_ = PQSupport $ agentV >= pqdrSMPAgentVersion && maybe True (>= CR.pqRatchetE2EEncryptVersion) e2eV_ {-# INLINE versionPQSupport_ #-} -joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM ConnId +joinConnSrv :: AgentClient -> UserId -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnId, SndQueueSecured) joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo pqSup subMode srv = withInvLock c (strEncode inv) "joinConnSrv" $ do (cData, q, _, rc, e2eSndParams) <- startJoinInvitation userId connId Nothing enableNtfs inv pqSup @@ -859,7 +859,7 @@ joinConnSrv c userId connId hasNewConn enableNtfs inv@CRInvitationUri {} cInfo p -- otherwise we would need to manage retries here to avoid SndQueue recreated with a different key, -- similar to how joinConnAsync does that. tryError (secureConfirmQueue c cData' sq srv cInfo (Just e2eSndParams) subMode) >>= \case - Right _ -> pure connId' + Right sqSecured -> pure (connId', sqSecured) Left e -> do -- possible improvement: recovery for failure on network timeout, see rfcs/2022-04-20-smp-conf-timeout-recovery.md void $ withStore' c $ \db -> deleteConn db Nothing connId' @@ -869,10 +869,10 @@ joinConnSrv c userId connId hasNewConn enableNtfs cReqUri@CRContactUri {} cInfo Just (qInfo, vrsn) -> do (connId', cReq) <- newConnSrv c userId connId hasNewConn enableNtfs SCMInvitation Nothing (CR.IKNoPQ pqSup) subMode srv void $ sendInvitation c userId qInfo vrsn cReq cInfo - pure connId' + pure (connId', False) Nothing -> throwE $ AGENT A_VERSION -joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM () +joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do SomeConn cType conn <- withStore c (`getConn` connId) case conn of @@ -880,7 +880,7 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo SndConnection _ sq -> doJoin $ Just sq _ -> throwE $ CMD PROHIBITED $ "joinConnSrvAsync: bad connection " <> show cType where - doJoin :: Maybe SndQueue -> AM () + doJoin :: Maybe SndQueue -> AM SndQueueSecured doJoin sq_ = do (cData, sq, _, rc, e2eSndParams) <- startJoinInvitation userId connId sq_ enableNtfs inv pqSupport sq' <- withStore c $ \db -> runExceptT $ do @@ -907,18 +907,14 @@ createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVers allowConnection' :: AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> AM () allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConnection" $ do withStore c (`getConn` connId) >>= \case - SomeConn _ (RcvConnection _ rq@RcvQueue {server, rcvId, e2ePrivKey, smpClientVersion = v}) -> do - senderKey <- withStore c $ \db -> runExceptT $ do - AcceptedConfirmation {ratchetState, senderConf = SMPConfirmation {senderKey, e2ePubKey, smpClientVersion = v'}} <- ExceptT $ acceptConfirmation db confId ownConnInfo - liftIO $ createRatchet db connId ratchetState - let dhSecret = C.dh' e2ePubKey e2ePrivKey - liftIO $ setRcvQueueConfirmedE2E db rq dhSecret $ min v v' - pure senderKey + SomeConn _ (RcvConnection _ RcvQueue {server, rcvId}) -> do + AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <- + withStore c $ \db -> acceptConfirmation db confId ownConnInfo enqueueCommand c "" connId (Just server) . AInternalCommand $ ICAllowSecure rcvId senderKey _ -> throwE $ CMD PROHIBITED "allowConnection" -- | Accept contact (ACPT command) in Reader monad -acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId +acceptContact' :: AgentClient -> ConnId -> Bool -> InvitationId -> ConnInfo -> PQSupport -> SubscriptionMode -> AM (ConnId, SndQueueSecured) acceptContact' c connId enableNtfs invId ownConnInfo pqSupport subMode = withConnLock c connId "acceptContact" $ do Invitation {contactConnId, connReq} <- withStore c (`getInvitation` invId) withStore c (`getConn` contactConnId) >>= \case @@ -1155,8 +1151,8 @@ runCommandProcessing c@AgentClient {subQ} server_ Worker {doWork} = do let initUsed = [qServer q] usedSrvs <- newTVarIO initUsed tryCommand . withNextSrv c userId usedSrvs initUsed $ \srv -> do - joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv - notify OK + sqSecured <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv + notify $ JOINED sqSecured LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK SWCH -> @@ -2492,6 +2488,18 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId confId <- withStore c $ \db -> do setConnAgentVersion db connId agentVersion when (pqSupport /= pqSupport') $ setConnPQSupport db connId pqSupport' + -- / + -- Starting with agent version 7 (ratchetOnConfSMPAgentVersion), + -- initiating party initializes ratchet on processing confirmation; + -- previously, it initialized ratchet on allowConnection; + -- this is to support decryption of messages that may be received before allowConnection + liftIO $ do + createRatchet db connId rc' + let RcvQueue {smpClientVersion = v, e2ePrivKey = e2ePrivKey'} = rq + SMPConfirmation {smpClientVersion = v', e2ePubKey = e2ePubKey'} = senderConf + dhSecret = C.dh' e2ePubKey' e2ePrivKey' + setRcvQueueConfirmedE2E db rq dhSecret $ min v v' + -- / createConfirmation db g newConfirmation let srvs = map qServer $ smpReplyQueues senderConf notify $ CONF confId pqSupport' srvs connInfo @@ -2775,25 +2783,27 @@ connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _ Just qInfo' -> do -- in case of SKEY retry the connection is already duplex sq' <- maybe upgradeConn pure sq_ - agentSecureSndQueue c sq' + void $ agentSecureSndQueue c cData sq' enqueueConfirmation c cData sq' ownConnInfo Nothing where upgradeConn = do (sq, _) <- lift $ newSndQueue userId connId qInfo' withStore c $ \db -> upgradeRcvConnToDuplex db connId sq -secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM () +secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured secureConfirmQueueAsync c cData sq srv connInfo e2eEncryption_ subMode = do - agentSecureSndQueue c sq + sqSecured <- agentSecureSndQueue c cData sq storeConfirmation c cData sq e2eEncryption_ =<< mkAgentConfirmation c cData sq srv connInfo subMode lift $ submitPendingMsg c cData sq + pure sqSecured -secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM () +secureConfirmQueue :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv connInfo e2eEncryption_ subMode = do - agentSecureSndQueue c sq + sqSecured <- agentSecureSndQueue c cData sq msg <- mkConfirmation =<< mkAgentConfirmation c cData sq srv connInfo subMode void $ sendConfirmation c sq msg withStore' c $ \db -> setSndQueueStatus db sq Confirmed + pure sqSecured where mkConfirmation :: AgentMessage -> AM MsgBody mkConfirmation aMessage = do @@ -2806,11 +2816,17 @@ secureConfirmQueue c cData@ConnData {connId, connAgentVersion, pqSupport} sq srv (encConnInfo, _) <- agentRatchetEncrypt db cData agentMsgBody e2eEncConnInfoLength (Just pqEnc) currentE2EVersion pure . smpEncode $ AgentConfirmation {agentVersion = connAgentVersion, e2eEncryption_, encConnInfo} -agentSecureSndQueue :: AgentClient -> SndQueue -> AM () -agentSecureSndQueue c sq@SndQueue {sndSecure, status} = - when (sndSecure && status == New) $ do - secureSndQueue c sq - withStore' c $ \db -> setSndQueueStatus db sq Secured +agentSecureSndQueue :: AgentClient -> ConnData -> SndQueue -> AM SndQueueSecured +agentSecureSndQueue c ConnData {connAgentVersion} sq@SndQueue {sndSecure, status} + | sndSecure && status == New = do + secureSndQueue c sq + withStore' c $ \db -> setSndQueueStatus db sq Secured + pure initiatorRatchetOnConf + -- on repeat JOIN processing (e.g. previous attempt to create reply queue failed) + | sndSecure && status == Secured = pure initiatorRatchetOnConf + | otherwise = pure False + where + initiatorRatchetOnConf = connAgentVersion >= ratchetOnConfSMPAgentVersion mkAgentConfirmation :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> SubscriptionMode -> AM AgentMessage mkAgentConfirmation c cData sq srv connInfo subMode = do diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index b123fc1ec..ca9737008 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -42,6 +42,7 @@ module Simplex.Messaging.Agent.Protocol deliveryRcptsSMPAgentVersion, pqdrSMPAgentVersion, sndAuthKeySMPAgentVersion, + ratchetOnConfSMPAgentVersion, currentSMPAgentVersion, supportedSMPAgentVRange, e2eEncConnInfoLength, @@ -49,6 +50,7 @@ module Simplex.Messaging.Agent.Protocol -- * SMP agent protocol types ConnInfo, + SndQueueSecured, ACommand (..), AEvent (..), AEvt (..), @@ -257,11 +259,14 @@ pqdrSMPAgentVersion = VersionSMPA 5 sndAuthKeySMPAgentVersion :: VersionSMPA sndAuthKeySMPAgentVersion = VersionSMPA 6 +ratchetOnConfSMPAgentVersion :: VersionSMPA +ratchetOnConfSMPAgentVersion = VersionSMPA 7 + minSupportedSMPAgentVersion :: VersionSMPA minSupportedSMPAgentVersion = duplexHandshakeSMPAgentVersion currentSMPAgentVersion :: VersionSMPA -currentSMPAgentVersion = VersionSMPA 6 +currentSMPAgentVersion = VersionSMPA 7 supportedSMPAgentVRange :: VersionRangeSMPA supportedSMPAgentVRange = mkVersionRange minSupportedSMPAgentVersion currentSMPAgentVersion @@ -327,6 +332,8 @@ deriving instance Show AEvt type ConnInfo = ByteString +type SndQueueSecured = Bool + -- | Parameterized type for SMP agent events data AEvent (e :: AEntity) where INV :: AConnectionRequestUri -> AEvent AEConn @@ -354,6 +361,7 @@ data AEvent (e :: AEntity) where DEL_USER :: Int64 -> AEvent AENone STAT :: ConnectionStats -> AEvent AEConn OK :: AEvent AEConn + JOINED :: SndQueueSecured -> AEvent AEConn ERR :: AgentErrorType -> AEvent AEConn SUSPENDED :: AEvent AENone RFPROG :: Int64 -> Int64 -> AEvent AERcvFile @@ -422,6 +430,7 @@ data AEventTag (e :: AEntity) where DEL_USER_ :: AEventTag AENone STAT_ :: AEventTag AEConn OK_ :: AEventTag AEConn + JOINED_ :: AEventTag AEConn ERR_ :: AEventTag AEConn SUSPENDED_ :: AEventTag AENone -- XFTP commands and responses @@ -474,6 +483,7 @@ aEventTag = \case DEL_USER _ -> DEL_USER_ STAT _ -> STAT_ OK -> OK_ + JOINED _ -> JOINED_ ERR _ -> ERR_ SUSPENDED -> SUSPENDED_ RFPROG {} -> RFPROG_ diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 8684c787c..5d0a2c00a 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -225,23 +225,23 @@ connectionRequestTests = queueV1NoPort #== ("smp://1234-w==@smp.simplex.im/3456-w==#/?v=1-1&dh=" <> url testDhKeyStr <> "&srv=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion") queueV1NoPort #== ("smp://1234-w==@smp.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion/3456-w==#" <> testDhKeyStr) it "should serialize and parse connection invitations and contact addresses" $ do - connectionRequest #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequest #== ("https://simplex.chat/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequestSK #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStrSK <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequest1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequest2queues #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequestNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest #== ("https://simplex.chat/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequestSK #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStrSK <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest1 #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queue1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest2queues #==# ("simplex:/invitation#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequestNew #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueNewStr <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequestNew1 #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueNew1Str <> "&e2e=" <> testE2ERatchetParamsStrUri) + connectionRequest2queuesNew #==# ("simplex:/invitation#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr) <> "&e2e=" <> testE2ERatchetParamsStrUri) connectionRequestV1 #== ("https://simplex.chat/invitation#/?v=1&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri) - connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-6&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}") - contactAddress #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr) - contactAddress #== ("https://simplex.chat/contact#/?v=2-6&smp=" <> url queueStr) - contactAddress2queues #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueStr <> ";" <> queueStr)) - contactAddressNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueNewStr) - contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-6&smp=" <> url (queueNewStr <> ";" <> queueNewStr)) + connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}") + contactAddress #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr) + contactAddress #== ("https://simplex.chat/contact#/?v=2-7&smp=" <> url queueStr) + contactAddress2queues #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueStr <> ";" <> queueStr)) + contactAddressNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueNewStr) + contactAddress2queuesNew #==# ("simplex:/contact#/?v=2-7&smp=" <> url (queueNewStr <> ";" <> queueNewStr)) contactAddressV2 #==# ("simplex:/contact#/?v=2&smp=" <> url queueStr) contactAddressV2 #== ("https://simplex.chat/contact#/?v=1&smp=" <> url queueStr) -- adjusted to v2 contactAddressV2 #== ("https://simplex.chat/contact#/?v=1-2&smp=" <> url queueStr) -- adjusted to v2 contactAddressV2 #== ("https://simplex.chat/contact#/?v=2-2&smp=" <> url queueStr) - contactAddressClientData #==# ("simplex:/contact#/?v=2-6&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}") + contactAddressClientData #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}") diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 3f70ad6ab..75593be73 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -244,7 +244,7 @@ inAnyOrder g rs = withFrozenCallStack $ do 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 :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured) joinConnection c userId enableNtfs cReq connInfo = A.joinConnection c userId Nothing enableNtfs cReq connInfo PQSupportOn sendMessage :: AgentClient -> ConnId -> SMP.MsgFlags -> MsgBody -> AE AgentMsgId @@ -269,13 +269,13 @@ functionalAPITests t = do 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 + testPQMatrix2 t $ runAgentClientTestPQ False 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 + testPQMatrix2NoInv t $ runAgentClientContactTestPQ False 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 @@ -410,29 +410,30 @@ functionalAPITests t = do let v4 = prevVersion basicAuthSMPVersion forM_ (nub [prevVersion authCmdsSMPVersion, authCmdsSMPVersion, currentServerSMPRelayVersion]) $ \v -> do let baseId = if v >= sndAuthKeySMPVersion then 1 else 3 + sqSecured = if v >= sndAuthKeySMPVersion then True else False 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 + it "success " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2 + it "disabled " $ testBasicAuth t False (Just "abcd", v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0 + it "NEW fail, no auth " $ testBasicAuth t True (Just "abcd", v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0 + it "NEW fail, bad auth " $ testBasicAuth t True (Just "abcd", v) (Just "wrong", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 0 + it "NEW fail, version " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v4) (Just "abcd", v) sqSecured baseId `shouldReturn` 0 + it "JOIN fail, no auth " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 1 + it "JOIN fail, bad auth " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "wrong", v) sqSecured baseId `shouldReturn` 1 + it "JOIN fail, version " $ testBasicAuth t True (Just "abcd", v) (Just "abcd", v) (Just "abcd", v4) sqSecured 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 + it "success " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 2 + it "srv disabled" $ testBasicAuth t False (Nothing, v) (Nothing, v) (Nothing, v) sqSecured baseId `shouldReturn` 0 + it "version srv " $ testBasicAuth t True (Nothing, v4) (Nothing, v) (Nothing, v) False 3 `shouldReturn` 2 + it "version fst " $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v) False baseId `shouldReturn` 2 + it "version snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Nothing, v4) sqSecured 3 `shouldReturn` 2 + it "version both" $ testBasicAuth t True (Nothing, v) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2 + it "version all " $ testBasicAuth t True (Nothing, v4) (Nothing, v4) (Nothing, v4) False 3 `shouldReturn` 2 + it "auth fst " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Nothing, v) sqSecured baseId `shouldReturn` 2 + it "auth fst 2 " $ testBasicAuth t True (Nothing, v4) (Just "abcd", v) (Nothing, v) False 3 `shouldReturn` 2 + it "auth snd " $ testBasicAuth t True (Nothing, v) (Nothing, v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2 + it "auth both " $ testBasicAuth t True (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured baseId `shouldReturn` 2 + it "auth, disabled" $ testBasicAuth t False (Nothing, v) (Just "abcd", v) (Just "abcd", v) sqSecured 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"} @@ -460,8 +461,8 @@ functionalAPITests t = 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 +testBasicAuth :: ATransport -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int +testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 sqSecured baseId = do let testCfg = cfg {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange batchCmdsSMPVersion srvVersion} canCreate1 = canCreateQueue allowNewQueues srv clnt1 canCreate2 = canCreateQueue allowNewQueues srv clnt2 @@ -469,7 +470,7 @@ testBasicAuth t allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 baseId = do | canCreate1 && canCreate2 = 2 | canCreate1 = 1 | otherwise = 0 - created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth srvVersion clnt1 clnt2 baseId + created <- withSmpServerConfigOn t testCfg testPort $ \_ -> testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId created `shouldBe` expected pure created @@ -478,43 +479,43 @@ 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 :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> 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 + it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True True + it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn False True + it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False + it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfgVPrev 3 $ runTest PQSupportOff False False + it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrev agentCfg 3 $ runTest PQSupportOff False False + it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrev 3 $ runTest PQSupportOff False False -testMatrix2Stress :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec +testMatrix2Stress :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> 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 + it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aCfg aCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True True + it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 aProxyCfgV8 aProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn False True + it "current" $ withSmpServer t $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn True False + it "prev" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfgVPrev 3 $ runTest PQSupportOff False False + it "prev to current" $ withSmpServer t $ runTestCfg2 aCfgVPrev aCfg 3 $ runTest PQSupportOff False False + it "current to prev" $ withSmpServer t $ runTestCfg2 aCfg aCfgVPrev 3 $ runTest PQSupportOff False False where aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval} aProxyCfgV8 = agentProxyCfgV8 {messageRetryInterval = fastMessageRetryInterval} aCfgVPrev = agentCfgVPrev {messageRetryInterval = fastMessageRetryInterval} -testBasicMatrix2 :: HasCallStack => ATransport -> (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec +testBasicMatrix2 :: HasCallStack => ATransport -> (SndQueueSecured -> 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 + it "current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest True + it "prev" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfgVPrevPQ 3 $ runTest False + it "prev to current" $ withSmpServer t $ runTestCfg2 agentCfgVPrevPQ agentCfg 3 $ runTest False + it "current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgVPrevPQ 3 $ runTest False -testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec +testRatchetMatrix2 :: HasCallStack => ATransport -> (PQSupport -> SndQueueSecured -> 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 + it "current, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentCfg agentCfg (initAgentServersProxy SPMAlways SPFProhibit) 1 $ runTest PQSupportOn True True + it "v8, via proxy" $ withSmpServerProxy t $ runTestCfgServers2 agentProxyCfgV8 agentProxyCfgV8 (initAgentServersProxy SPMAlways SPFProhibit) 3 $ runTest PQSupportOn False True + it "ratchet current" $ withSmpServer t $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False + it "ratchet prev" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfgRatchetVPrev 1 $ runTest PQSupportOff True False + it "ratchets prev to current" $ withSmpServer t $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff True False + it "ratchets current to prev" $ withSmpServer t $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff True False testServerMatrix2 :: HasCallStack => ATransport -> (InitialAgentServers -> IO ()) -> Spec testServerMatrix2 t runTest = do @@ -589,15 +590,16 @@ withAgentClients3 runTest = 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 +runAgentClientTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO () +runAgentClientTest pqSupport sqSecured viaProxy alice bob baseId = + runAgentClientTestPQ sqSecured viaProxy (alice, IKNoPQ pqSupport) (bob, pqSupport) baseId -runAgentClientTestPQ :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () -runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId = +runAgentClientTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () +runAgentClientTestPQ sqSecured 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 + (aliceId, sqSecured') <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" bPQ SMSubscribe + liftIO $ sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` CR.connPQEncryption aPQ allowConnection alice bobId confId "alice's connInfo" @@ -634,10 +636,10 @@ runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId = 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 +runAgentClientStressTestOneWay :: HasCallStack => Int64 -> PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO () +runAgentClientStressTestOneWay n pqSupport sqSecured viaProxy alice bob baseId = runRight_ $ do let pqEnc = PQEncryption $ supportPQ pqSupport - (aliceId, bobId) <- makeConnection_ pqSupport alice bob + (aliceId, bobId) <- makeConnection_ pqSupport sqSecured alice bob let proxySrv = if viaProxy then Just testSMPServer else Nothing message i = "message " <> bshow i concurrently_ @@ -666,10 +668,10 @@ runAgentClientStressTestOneWay n pqSupport viaProxy alice bob baseId = runRight_ where msgId = subtract baseId . fst -runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO () -runAgentClientStressTestConc n pqSupport viaProxy alice bob baseId = runRight_ $ do +runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO () +runAgentClientStressTestConc n pqSupport sqSecured viaProxy alice bob baseId = runRight_ $ do let pqEnc = PQEncryption $ supportPQ pqSupport - (aliceId, bobId) <- makeConnection_ pqSupport alice bob + (aliceId, bobId) <- makeConnection_ pqSupport sqSecured alice bob let proxySrv = if viaProxy then Just testSMPServer else Nothing message i = "message " <> bshow i loop a bId mIdVar i = do @@ -703,7 +705,7 @@ testEnablePQEncryption :: HasCallStack => IO () testEnablePQEncryption = withAgentClients2 $ \ca cb -> runRight_ $ do g <- liftIO C.newRandom - (aId, bId) <- makeConnection_ PQSupportOff ca cb + (aId, bId) <- makeConnection_ PQSupportOff True ca cb let a = (ca, aId) b = (cb, bId) (a, 2, "msg 1") \#>\ b @@ -789,20 +791,23 @@ testAgentClient3 = 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 +runAgentClientContactTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO () +runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId = + runAgentClientContactTestPQ sqSecured 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 = +runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () +runAgentClientContactTestPQ sqSecured 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 + (aliceId', sqSecuredJoin) <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" bPQ SMSubscribe + liftIO $ do + aliceId' `shouldBe` aliceId + sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, 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 + (bobId, sqSecured') <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe + liftIO $ sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get bob liftIO $ pqSup'' `shouldBe` bPQ allowConnection bob aliceId confId "bob's connInfo" @@ -847,11 +852,14 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId 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 + (aId', sqSecuredJoin) <- A.joinConnection b 1 (Just aId) True qInfo "bob's connInfo" pq SMSubscribe + liftIO $ do + aId' `shouldBe` aId + sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, 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 + (bId, sqSecuredAccept) <- acceptContact alice True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe + liftIO $ sqSecuredAccept `shouldBe` False -- agent cfg is v8 ("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b liftIO $ pqSup'' `shouldBe` pq allowConnection b aId confId "bob's connInfo" @@ -891,8 +899,10 @@ 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 + (aliceId', sqSecured) <- A.joinConnection bob 1 (Just aliceId) True qInfo "bob's connInfo" PQSupportOn SMSubscribe + liftIO $ do + aliceId' `shouldBe` aliceId + sqSecured `shouldBe` False -- joining via contact address connection ("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice liftIO $ runExceptT (rejectContact alice "abcd" invId) `shouldReturn` Left (CONN NOT_FOUND) rejectContact alice addrConnId invId @@ -904,15 +914,34 @@ testAsyncInitiatingOffline = 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 + + (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe + liftIO $ sqSecured `shouldBe` True + + -- send messages + msgId1 <- A.sendMessage bob aliceId PQEncOn SMP.noMsgFlags "can send 1" + liftIO $ msgId1 `shouldBe` (2, PQEncOff) + get bob ##> ("", aliceId, SENT 2) + msgId2 <- A.sendMessage bob aliceId PQEncOn SMP.noMsgFlags "can send 2" + liftIO $ msgId2 `shouldBe` (3, PQEncOff) + get bob ##> ("", aliceId, SENT 3) + alice' <- liftIO $ getSMPAgentClient' 3 agentCfg initAgentServers testDB subscribeConnection alice' bobId ("", _, CONF confId _ "bob's connInfo") <- get alice' + -- receive messages + get alice' =##> \case ("", c, Msg' mId pq "can send 1") -> c == bobId && mId == 1 && pq == PQEncOff; _ -> False + ackMessage alice' bobId 1 Nothing + get alice' =##> \case ("", c, Msg' mId pq "can send 2") -> c == bobId && mId == 2 && pq == PQEncOff; _ -> False + ackMessage alice' bobId 2 Nothing + -- for alice msg id 3 is sent confirmation, then they're matched with bob at msg id 4 + + -- allow connection 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 + exchangeGreetingsMsgId 4 alice' bobId bob aliceId liftIO $ disposeAgentClient alice' testAsyncJoiningOfflineBeforeActivation :: HasCallStack => IO () @@ -920,7 +949,8 @@ 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 + (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + liftIO $ sqSecured `shouldBe` True liftIO $ disposeAgentClient bob ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" @@ -939,7 +969,8 @@ testAsyncBothOffline = do runRight_ $ do (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe liftIO $ disposeAgentClient alice - aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe + (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe + liftIO $ sqSecured `shouldBe` True liftIO $ disposeAgentClient bob alice' <- liftIO $ getSMPAgentClient' 3 agentCfg initAgentServers testDB subscribeConnection alice' bobId @@ -970,7 +1001,8 @@ testAsyncServerOffline t = withAgentClients2 $ \alice bob -> do liftIO $ do srv1 `shouldBe` testSMPServer conns1 `shouldBe` [bobId] - aliceId <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe + (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe + liftIO $ sqSecured `shouldBe` True ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" get alice ##> ("", bobId, CON) @@ -988,7 +1020,8 @@ testAllowConnectionClientRestart t = do 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 + (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + liftIO $ sqSecured `shouldBe` True ("", _, CONF confId _ "bob's connInfo") <- get alice pure (aliceId, bobId, confId) @@ -1024,7 +1057,7 @@ testIncreaseConnAgentVersion t = do bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2 withSmpServerStoreMsgLogOn t testPort $ \_ -> do (aliceId, bobId) <- runRight $ do - (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob + (aliceId, bobId) <- makeConnection_ PQSupportOff False alice bob exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId checkVersion alice bobId 2 checkVersion bob aliceId 2 @@ -1089,7 +1122,7 @@ testIncreaseConnAgentVersionMaxCompatible t = do bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB2 withSmpServerStoreMsgLogOn t testPort $ \_ -> do (aliceId, bobId) <- runRight $ do - (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob + (aliceId, bobId) <- makeConnection_ PQSupportOff False alice bob exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId checkVersion alice bobId 2 checkVersion bob aliceId 2 @@ -1119,7 +1152,7 @@ testIncreaseConnAgentVersionStartDifferentVersion t = do bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2 withSmpServerStoreMsgLogOn t testPort $ \_ -> do (aliceId, bobId) <- runRight $ do - (aliceId, bobId) <- makeConnection_ PQSupportOff alice bob + (aliceId, bobId) <- makeConnection_ PQSupportOff False alice bob exchangeGreetingsMsgId_ PQEncOff 2 alice bobId bob aliceId checkVersion alice bobId 2 checkVersion bob aliceId 2 @@ -1620,7 +1653,8 @@ testRatchetSyncSimultaneous t = do 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 + (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate + liftIO $ sqSecured `shouldBe` False 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 @@ -1654,7 +1688,8 @@ getMsg c cId action = do 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 + (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate + liftIO $ sqSecured `shouldBe` True 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 @@ -1676,20 +1711,22 @@ testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do ackMessage alice bobId 3 Nothing makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId) -makeConnection = makeConnection_ PQSupportOn +makeConnection = makeConnection_ PQSupportOn True -makeConnection_ :: PQSupport -> AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId) -makeConnection_ pqEnc alice bob = makeConnectionForUsers_ pqEnc alice 1 bob 1 +makeConnection_ :: PQSupport -> SndQueueSecured -> AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId) +makeConnection_ pqEnc sqSecured alice bob = makeConnectionForUsers_ pqEnc sqSecured alice 1 bob 1 makeConnectionForUsers :: HasCallStack => AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) -makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn +makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn True -makeConnectionForUsers_ :: HasCallStack => PQSupport -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) -makeConnectionForUsers_ pqSupport alice aliceUserId bob bobUserId = do +makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId) +makeConnectionForUsers_ pqSupport sqSecured 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 + (aliceId', sqSecured') <- A.joinConnection bob bobUserId (Just aliceId) True qInfo "bob's connInfo" pqSupport SMSubscribe + liftIO $ do + aliceId' `shouldBe` aliceId + sqSecured' `shouldBe` sqSecured ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` pqSupport allowConnection alice bobId confId "alice's connInfo" @@ -1816,7 +1853,7 @@ 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 + conns <- replicateM nCreate $ makeConnection_ PQSupportOff True a b forM_ conns $ \(aId, bId) -> exchangeGreetings_ PQEncOff a bId b aId let (aIds', bIds') = unzip $ take nDel conns delete a bIds' @@ -1894,15 +1931,17 @@ testBatchedPendingMessages nCreate nMsgs = withA = withAgent 1 agentCfg initAgentServers testDB withB = withAgent 2 agentCfg initAgentServers testDB2 -testAsyncCommands :: AgentClient -> AgentClient -> AgentMsgId -> IO () -testAsyncCommands alice bob baseId = +testAsyncCommands :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO () +testAsyncCommands sqSecured 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 + ("2", aliceId', JOINED sqSecured') <- get bob + liftIO $ do + aliceId' `shouldBe` aliceId + sqSecured' `shouldBe` sqSecured ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnectionAsync alice "3" bobId confId "alice's connInfo" get alice =##> \case ("3", _, OK) -> True; _ -> False @@ -1955,14 +1994,15 @@ testAsyncCommandsRestore t = do get alice' =##> \case ("1", _, INV _) -> True; _ -> False pure () -testAcceptContactAsync :: AgentClient -> AgentClient -> AgentMsgId -> IO () -testAcceptContactAsync alice bob baseId = +testAcceptContactAsync :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId -> IO () +testAcceptContactAsync sqSecured alice bob baseId = runRight_ $ do (_, qInfo) <- createConnection alice 1 True SCMContact Nothing SMSubscribe - aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + (aliceId, sqSecuredJoin) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection ("", _, 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 + get alice =##> \case ("1", c, JOINED sqSecured') -> c == bobId && sqSecured' == sqSecured; _ -> False ("", _, CONF confId _ "alice's connInfo") <- get bob allowConnection bob aliceId confId "bob's connInfo" get alice ##> ("", bobId, INFO "bob's connInfo") @@ -2238,7 +2278,7 @@ testJoinConnectionAsyncReplyErrorV8 t = do pure (aId, bId) nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False withSmpServerOn t testPort2 $ do - get b =##> \case ("2", c, OK) -> c == aId; _ -> False + get b =##> \case ("2", c, JOINED sqSecured) -> c == aId && not sqSecured; _ -> False confId <- withSmpServerStoreLogOn t testPort $ \_ -> do pGet a >>= \case ("", "", AEvt _ (UP _ [_])) -> do @@ -2279,7 +2319,7 @@ testJoinConnectionAsyncReplyError t = do 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 + get b =##> \case ("2", c, JOINED sqSecured) -> c == aId && sqSecured; _ -> False pGet a >>= \case ("", "", AEvt _ (UP _ [_])) -> do ("", _, CONF confId _ "bob's connInfo") <- get a @@ -2733,8 +2773,8 @@ testSwitch2ConnectionsAbort1 servers = do 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 +testCreateQueueAuth :: HasCallStack => VersionSMP -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int +testCreateQueueAuth srvVersion clnt1 clnt2 sqSecured baseId = do a <- getClient 1 clnt1 testDB b <- getClient 2 clnt2 testDB2 r <- runRight $ do @@ -2745,7 +2785,8 @@ testCreateQueueAuth srvVersion clnt1 clnt2 baseId = do tryError (joinConnection b 1 True qInfo "bob's connInfo" SMSubscribe) >>= \case Left (SMP _ AUTH) -> pure 1 Left e -> throwError e - Right aId -> do + Right (aId, sqSecured') -> do + liftIO $ sqSecured' `shouldBe` sqSecured ("", _, CONF confId _ "bob's connInfo") <- get a allowConnection a bId confId "alice's connInfo" get a ##> ("", bId, CON) @@ -2805,7 +2846,7 @@ testDeliveryReceiptsVersion t = do b <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 1 3} initAgentServers testDB2 withSmpServerStoreMsgLogOn t testPort $ \_ -> do (aId, bId) <- runRight $ do - (aId, bId) <- makeConnection_ PQSupportOff a b + (aId, bId) <- makeConnection_ PQSupportOff False a b checkVersion a bId 3 checkVersion b aId 3 (2, _) <- A.sendMessage a bId PQEncOff SMP.noMsgFlags "hello" @@ -2829,8 +2870,8 @@ testDeliveryReceiptsVersion t = do subscribeConnection a' bId subscribeConnection b' aId exchangeGreetingsMsgId_ PQEncOff 4 a' bId b' aId - checkVersion a' bId 6 - checkVersion b' aId 6 + checkVersion a' bId 7 + checkVersion b' aId 7 (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 @@ -2979,7 +3020,8 @@ 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 + (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe + liftIO $ sqSecured `shouldBe` True ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" get alice ##> ("", bobId, CON) @@ -3078,7 +3120,8 @@ testServerQueueInfo = 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 + (aliceId, sqSecured) <- joinConnection bob 1 True cReq "bob's connInfo" SMSubscribe + liftIO $ sqSecured `shouldBe` True ("", _, CONF confId _ "bob's connInfo") <- get alice liftIO $ threadDelay 200000 checkEmptyQ alice bobId True -- secured by sender diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index fd737e913..41ed8c730 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -477,7 +477,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali (bobId, aliceId, nonce, message) <- runRight $ do -- establish connection (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe - aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + (aliceId, _sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" get bob ##> ("", aliceId, INFO "alice's connInfo") @@ -544,7 +544,7 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} baseId alice bo liftIO $ threadDelay 50000 (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe liftIO $ threadDelay 1000000 - aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + (aliceId, _sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe liftIO $ threadDelay 750000 void $ messageNotificationData alice apnsQ ("", _, CONF confId _ "bob's connInfo") <- get alice @@ -591,7 +591,8 @@ testChangeNotificationsMode APNSMockServer {apnsQ} = withAgentClients2 $ \alice bob -> runRight_ $ do -- establish connection (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe - aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + liftIO $ sqSecured `shouldBe` True ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" get bob ##> ("", aliceId, INFO "alice's connInfo") @@ -653,7 +654,8 @@ testChangeToken APNSMockServer {apnsQ} = withAgent 1 agentCfg initAgentServers t (aliceId, bobId) <- withAgent 2 agentCfg initAgentServers testDB $ \alice -> runRight $ do -- establish connection (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe - aliceId <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + liftIO $ sqSecured `shouldBe` True ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" get bob ##> ("", aliceId, INFO "alice's connInfo") diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 7505ef977..2aa89e06f 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -207,7 +207,8 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b withAgent 1 aCfg (servers aTestCfg) testDB $ \alice -> withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe - aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe + (aliceId, sqSecured) <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe + liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn allowConnection alice bobId confId "alice's connInfo" @@ -261,7 +262,8 @@ agentDeliverMessagesViaProxyConc agentServers msgs = -- otherwise the CONF messages would get mixed with MSG prePair alice bob = do (bobId, qInfo) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe - aliceId <- runExceptT' $ A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe + (aliceId, sqSecured) <- runExceptT' $ A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe + liftIO $ sqSecured `shouldBe` True confId <- get alice >>= \case ("", _, A.CONF confId pqSup' _ "bob's connInfo") -> do @@ -329,7 +331,8 @@ agentViaProxyRetryOffline = do withServer $ \_ -> do (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do (bobId, qInfo) <- A.createConnection alice 1 True SCMInvitation Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe - aliceId <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe + (aliceId, sqSecured) <- A.joinConnection bob 1 Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe + liftIO $ sqSecured `shouldBe` True ("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice liftIO $ pqSup' `shouldBe` PQSupportOn allowConnection alice bobId confId "alice's connInfo"