dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-10-05 23:07:22 +00:00
Code Issues Packages Projects Releases Wiki Activity

agent: use double ratchet from the first message in contact addresses, request rejection, RPC (#1831)

Browse Source 
* agent: initialize double ratchet from the invitation via contact address (#1829)

* rfc: agent support for PRC pattern without duplex connection

* update rfc, plan

* corrections

Co-authored-by: Evgeny <evgeny@poberezkin.com>

* split rfcs, add plan

* update rfc

* update rfc and plan

* update plan

* add double ratchet keys to address

* agent schema

* fix version in test

* change ContactRequest encoding

* fix tests

* update plan

* tests, refactor

* fix compilation

* refactor

* refactor more

* fix

* add export

* fix

* refactor

* refactor

* update schema

* rename

* refactor

* refactor 2

* comment, type

* type

* rename

* refactor more

* move type

* refactor

* remove comment

* diff

* refactor

* comment

* puns

* get correct key

* rename

* add autoincrement

* refactor

* move

* move back

* simplify

* rename

* refactor

* tuple

* comment

* split decryption

* refactor

* rename

* refactor

* move

* remove createSndQueue

* remove comment

* remove JoinInvitationReq

* simplify

* rename

* fix

* type synonim

* getConnData

* simplify

* move

* encoding

* version

* async join with ratchet keys

* fix encoding

* rotate address ratchet keys

* rename, parameter order

* refactor, include ratchet keys into ConnectionRequestUri

* simplify

* remove records

* refactor

* rename, encoding

* clean up

* refactor

* compatible

* addrKeysE2EVersion

* support IKUsePQ for contact addresses

* comments, refactor condition

* typos

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>

* agent: contact request rejection and service requests (#1833)

* agent: request rejection

* implement RPC requests/responses

* simplify rpc, test, async

* renames

* clean up

* fix

* fix query

* set flag at creation

* move

* command type, schema

* rename

* refactor

* typo

Co-authored-by: simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com>

* allow overriding the service request timeout per request

* fixes

* use SSENT event for service replies

* AgentServiceError encoding

* sign service requests

* add bad signature error

* update the plan

* clean up

* refactor

* empty line

Co-authored-by: simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com>

* add indices

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
Co-authored-by: simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com>

* update schemas

* tryAllErrors

* combine queries

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
Co-authored-by: simplex-chat-agent[bot] <287173099+simplex-chat-agent[bot]@users.noreply.github.com>
This commit is contained in:
Evgeny
2026-07-31 19:32:34 +01:00
committed by GitHub
co-authored by Evgeny @ SimpleX Chat simplex-chat-agent[bot]
parent 066a93861b
commit e4e5ce75fa
31 changed files with 2382 additions and 390 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/AgentTests/ConnectionRequestTests.hs
+36 -22
View File
@@ -18,6 +18,7 @@ module AgentTests.ConnectionRequestTests
invConnRequest,
) where
import AgentTests.EqInstances ()
import Data.ByteString (ByteString)
import Network.HTTP.Types (urlEncode)
import Simplex.Messaging.Agent.Protocol
@@ -25,7 +26,7 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (EntityId (..), ProtocolServer (..), QueueMode (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC)
import Simplex.Messaging.Protocol (EntityId (..), ProtocolServer (..), QueueMode (..), SubscriptionMode (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC)
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
import Simplex.Messaging.Version
import Test.Hspec hiding (fit, it)
@@ -176,7 +177,7 @@ connectionRequestNoQM :: AConnectionRequestUri
connectionRequestNoQM = ACR SCMInvitation $ CRInvitationUri connReqDataNoQM testE2ERatchetParams
connectionRequestContact :: AConnectionRequestUri
connectionRequestContact = ACR SCMContact $ CRContactUri connReqDataContact
connectionRequestContact = ACR SCMContact $ CRContactUri connReqDataContact Nothing
connectionRequestV1 :: AConnectionRequestUri
connectionRequestV1 = ACR SCMInvitation $ CRInvitationUri connReqDataV1 testE2ERatchetParams
@@ -194,13 +195,16 @@ contactAddress :: AConnectionRequestUri
contactAddress = ACR SCMContact $ contactConnRequest
contactConnRequest :: ConnectionRequestUri 'CMContact
contactConnRequest = CRContactUri connReqData
contactConnRequest = CRContactUri connReqData Nothing
contactAddressDR :: AConnectionRequestUri
contactAddressDR = ACR SCMContact $ CRContactUri connReqData (Just (RatchetKeyId "0123456789abcdef", testE2ERatchetParams))
contactAddressV2 :: AConnectionRequestUri
contactAddressV2 = ACR SCMContact $ CRContactUri connReqDataV2
contactAddressV2 = ACR SCMContact $ CRContactUri connReqDataV2 Nothing
contactAddressNew :: AConnectionRequestUri
contactAddressNew = ACR SCMContact $ CRContactUri connReqDataNew
contactAddressNew = ACR SCMContact $ CRContactUri connReqDataNew Nothing
connectionRequest2queues :: AConnectionRequestUri
connectionRequest2queues = ACR SCMInvitation $ CRInvitationUri connReqData {crSmpQueues = [queue, queue]} testE2ERatchetParams
@@ -209,16 +213,20 @@ connectionRequest2queuesNew :: AConnectionRequestUri
connectionRequest2queuesNew = ACR SCMInvitation $ CRInvitationUri connReqDataNew {crSmpQueues = [queueNew, queueNew]} testE2ERatchetParams
contactAddress2queues :: AConnectionRequestUri
contactAddress2queues = ACR SCMContact $ CRContactUri connReqData {crSmpQueues = [queue, queue]}
contactAddress2queues = ACR SCMContact $ CRContactUri connReqData {crSmpQueues = [queue, queue]} Nothing
contactAddress2queuesNew :: AConnectionRequestUri
contactAddress2queuesNew = ACR SCMContact $ CRContactUri connReqDataNew {crSmpQueues = [queueNew, queueNew]}
contactAddress2queuesNew = ACR SCMContact $ CRContactUri connReqDataNew {crSmpQueues = [queueNew, queueNew]} Nothing
connectionRequestClientDataEmpty :: AConnectionRequestUri
connectionRequestClientDataEmpty = ACR SCMInvitation $ CRInvitationUri connReqData {crClientData = Just "{}"} testE2ERatchetParams
contactAddressClientData :: AConnectionRequestUri
contactAddressClientData = ACR SCMContact $ CRContactUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"}
contactAddressClientData = ACR SCMContact $ CRContactUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"} Nothing
-- binary encoding is defined only for BinaryConnectionRequestUri; drop the address keys for the round-trip
aBinaryConnReq :: AConnectionRequestUri -> ABinaryConnectionRequestUri
aBinaryConnReq (ACR m cr) = ABCR m (binaryConnReq cr)
url :: ByteString -> ByteString
url = urlEncode True
@@ -267,6 +275,7 @@ connectionRequestTests =
connectionRequestV1 #== ("https://simplex.chat/invitation#/?v=1&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri)
connectionRequestClientDataEmpty #==# ("simplex:/invitation#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&data=" <> url "{}")
contactAddress #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr)
contactAddressDR #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr <> "&e2e=" <> testE2ERatchetParamsStrUri <> "&rk=MDEyMzQ1Njc4OWFiY2RlZg%3D%3D")
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)
@@ -287,21 +296,21 @@ connectionRequestTests =
smpEncodingTest queueNew1NoPort
smpEncodingTest queueV1
smpEncodingTest queueV1NoPort
smpEncodingTest connectionRequest
smpEncodingTest (aBinaryConnReq connectionRequest)
-- smpEncodingTest connectionRequestNoQM -- this fails, because of queue mode patch
smpEncodingTest connectionRequestContact -- this passes because of queue mode patch in ConnReqUriData encoding
smpEncodingTest connectionRequest1
smpEncodingTest connectionRequest2queues
smpEncodingTest connectionRequestNew
smpEncodingTest connectionRequestNew1
smpEncodingTest connectionRequest2queuesNew
smpEncodingTest connectionRequestClientDataEmpty
smpEncodingTest contactAddress
smpEncodingTest contactAddress2queues
smpEncodingTest contactAddressNew
smpEncodingTest contactAddress2queuesNew
smpEncodingTest contactAddressV2
smpEncodingTest contactAddressClientData
smpEncodingTest (aBinaryConnReq connectionRequestContact) -- this passes because of queue mode patch in ConnReqUriData encoding
smpEncodingTest (aBinaryConnReq connectionRequest1)
smpEncodingTest (aBinaryConnReq connectionRequest2queues)
smpEncodingTest (aBinaryConnReq connectionRequestNew)
smpEncodingTest (aBinaryConnReq connectionRequestNew1)
smpEncodingTest (aBinaryConnReq connectionRequest2queuesNew)
smpEncodingTest (aBinaryConnReq connectionRequestClientDataEmpty)
smpEncodingTest (aBinaryConnReq contactAddress)
smpEncodingTest (aBinaryConnReq contactAddress2queues)
smpEncodingTest (aBinaryConnReq contactAddressNew)
smpEncodingTest (aBinaryConnReq contactAddress2queuesNew)
smpEncodingTest (aBinaryConnReq contactAddressV2)
smpEncodingTest (aBinaryConnReq contactAddressClientData)
it "should serialize / parse short links" $ do
CSLContact SLSServer CCTContact srv (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im/a#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
CSLContact SLSServer CCTGroup srv (LinkKey "0123456789abcdef0123456789abcdef") #==# "https://smp.simplex.im/g#MDEyMzQ1Njc4OWFiY2RlZjAxMjM0NTY3ODlhYmNkZWY?h=jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion&p=5223&c=1234-w"
@@ -343,6 +352,11 @@ connectionRequestTests =
Right (inv' :: ConnShortLink 'CMInvitation) <- pure $ strDecode "https://localhost/i#tnUaHYp8saREmyEHR93SBpl8ySHBchOt/LJ1ZQUzxH9Udb0jw5wmJACv5o6oe8e7BsX_hUCUMTSY"
shortenShortLink [presetSrv] inv `shouldBe` inv'
restoreShortLink [presetSrv] inv' `shouldBe` inv
it "should serialize and parse service RPC agent messages" $ do
let qInfo = SMPQueueInfo currentSMPClientVersion queueAddr
smpEncodingTest $ AgentServiceRequest [qInfo] Nothing "service request payload"
smpEncodingTest $ AgentServiceResponse "service response payload"
smpEncodingTest $ AgentRejection "rejected: not allowed"
where
smpEncodingTest :: (Encoding a, Eq a, Show a, HasCallStack) => a -> Expectation
smpEncodingTest a = smpDecode (smpEncode a) `shouldBe` Right a
tests/AgentTests/EqInstances.hs
+16 -1
View File
@@ -5,7 +5,7 @@
module AgentTests.EqInstances where
import Data.Type.Equality
import Simplex.Messaging.Agent.Protocol (ShortLinkCreds (..))
import Simplex.Messaging.Agent.Protocol (ABinaryConnectionRequestUri (..), AMessage (..), AMessageReceipt (..), AgentMessage (..), APrivHeader (..), ShortLinkCreds (..))
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Client (ProxiedRelay (..))
@@ -31,3 +31,18 @@ deriving instance Eq ShortLinkCreds
deriving instance Show ProxiedRelay
deriving instance Eq ProxiedRelay
instance Eq ABinaryConnectionRequestUri where
ABCR m cr == ABCR m' cr' = case testEquality m m' of
Just Refl -> cr == cr'
_ -> False
deriving instance Show ABinaryConnectionRequestUri
deriving instance Eq APrivHeader
deriving instance Eq AMessageReceipt
deriving instance Eq AMessage
deriving instance Eq AgentMessage
tests/AgentTests/FunctionalAPITests.hs
+462 -84
View File
@@ -200,7 +200,7 @@ 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 REQ invId srvs connInfo <- A.REQ invId PQSupportOn srvs connInfo _
pattern CON :: AEvent 'AEConn
pattern CON = A.CON PQEncOn
@@ -283,7 +283,7 @@ inAnyOrder g rs = withFrozenCallStack $ do
createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c)
createConnection c userId enableNtfs cMode clientData subMode = do
(connId, CCLink cReq _) <- A.createConnection c NRMInteractive userId enableNtfs True cMode Nothing clientData IKPQOn subMode
(connId, CCLink cReq _) <- A.createConnection c NRMInteractive userId enableNtfs True cMode Nothing clientData IKPQOn False subMode
pure (connId, cReq)
joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
@@ -310,11 +310,11 @@ deleteConnection c = A.deleteConnection c NRMInteractive
deleteConnections :: AgentClient -> [ConnId] -> AE (M.Map ConnId (Either AgentErrorType ()))
deleteConnections c = A.deleteConnections c NRMInteractive
getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c)
getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c, ConnectionRequestUri c)
getConnShortLink c = A.getConnShortLink c NRMInteractive
setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c)
setConnShortLink c = A.setConnShortLink c NRMInteractive
setConnShortLink c connId cMode uld cd = A.setConnShortLink c NRMInteractive connId cMode uld cd False Nothing
suspendConnection :: AgentClient -> ConnId -> AE ()
suspendConnection c = A.suspendConnection c NRMInteractive
@@ -346,8 +346,40 @@ functionalAPITests ps = do
testRatchetMatrix2 ps runAgentClientContactTest
describe "Establish duplex connection via contact address, different PQ settings (3 clients)" $ do
testPQMatrix3 ps $ runAgentClientContactTestPQ3 True
it "should support rejecting contact request" $
withSmpServer ps testRejectContactRequest
describe "contact address with DR" $ do
describe "Establish duplex connection via contact address with DR" $
testContactDRMatrix ps
describe "Establish duplex connection creating contact address with DR" $ do
it "createConnection, IKPQOn" $ runCreateConnectionDRTest_ False IKPQOn PQSupportOn ps
it "createConnection, IKUsePQ" $ runCreateConnectionDRTest_ False IKUsePQ PQSupportOn ps
it "createConnectionAsync, IKPQOn" $ runCreateConnectionDRTest_ True IKPQOn PQSupportOn ps
it "createConnectionAsync, IKUsePQ" $ runCreateConnectionDRTest_ True IKUsePQ PQSupportOn ps
it "should preserve address DR keys when the link data is updated" $
testAddressUpdatePreservesDRKeys ps
it "should rotate address DR keys, keeping old keys for stale requesters until pruned" $
testAddressKeyRotation ps
it "should add DR keys to an existing address via setConnShortLink" $
testAddDRViaSetConnShortLink ps
it "should resume DR accept after a transient failure (reuse the send queue and ratchet)" $
testAcceptContactDRResumeAfterOffline ps
it "should support rejecting contact request" $
withSmpServer ps testRejectContactRequest
it "should communicate rejection reason via double ratchet" $
withSmpServer ps testRejectContactRequestDR
it "should communicate rejection reason via double ratchet (async)" $
withSmpServer ps testRejectContactRequestDRAsync
it "should send a service request and receive the response" $
withSmpServer ps testServiceRequestResponse
it "should send a service request and receive the response (async reply)" $
withSmpServer ps testServiceRequestResponseAsync
it "should reject a service request with a reason" $
withSmpServer ps testServiceRequestRejected
it "should verify a signed service request" $
withSmpServer ps testSignedServiceRequest
it "should verify a signed service request (async)" $
withSmpServer ps testSignedServiceRequestAsync
it "should deliver a service response across server outages" $
testServiceRequestResilient ps
describe "Changing connection user id" $ do
it "should change user id for new connections" $ do
withSmpServer ps testUpdateConnectionUserId
@@ -714,7 +746,7 @@ runAgentClientTest pqSupport sqSecured viaProxy alice bob baseId =
runAgentClientTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
runAgentClientTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId =
runRight_ $ do
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing aPQ SMSubscribe
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing aPQ False SMSubscribe
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
liftIO $ sqSecured' `shouldBe` sqSecured
@@ -943,11 +975,11 @@ runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId =
runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> PQSupport -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, bPQ) baseId =
runRight_ $ do
(_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ SMSubscribe
(_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
("", _, A.REQ invId pqSup' _ "bob's connInfo" _) <- get alice
liftIO $ pqSup' `shouldBe` reqPQSupport
bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ)
sqSecured' <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
@@ -985,9 +1017,218 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b
where
msgId = subtract baseId . fst
allowConfirmGreet :: HasCallStack => AgentClient -> ConnId -> AgentClient -> ConnId -> ConfirmationId -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO ()
allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc = do
allowConnection bob aliceId confId "bob's connInfo"
get alice ##> ("", bobId, A.INFO (CR.connPQEncryption addrIK) "bob's connInfo")
get alice ##> ("", bobId, A.CON pqEnc)
get bob ##> ("", aliceId, A.CON pqEnc)
exchangeGreetings_ pqEnc alice bobId bob aliceId
-- DR-advertising contact address, across accept/join modes, InitialKeys, and joiner PQ
runAgentClientContactDRTest_ :: HasCallStack => Bool -> Bool -> InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO ()
runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do
g <- C.newRandom
rootKey <- atomically $ C.generateKeyPair g
linkEntId <- atomically $ C.randomBytes 32 g
let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
userLinkData = UserContactLinkData userCtData
pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ
runRight_ $ do
(ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing addrIK True Nothing
_ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe
(_, ContactLinkData _ userCtData', connReq') <- getConnShortLink bob 1 shortLink
-- the advertised bundle carries a KEM only for IKUsePQ (PQ from message 1)
liftIO $ case ratchetKeys userCtData' of
Just (_, CR.E2ERatchetParamsUri _ _ _ kem_) ->
isJust kem_ `shouldBe` supportPQ (CR.initialPQEncryption False addrIK)
Nothing -> expectationFailure "address must advertise DR ratchet keys"
-- classic (non-DR) join drops the address keys from the request
let connReqJoin = if useDR then connReq' else case connReq' of CRContactUri d _ -> CRContactUri d Nothing
aliceId <- A.prepareConnectionToJoin bob 1 True connReqJoin bPQ
if asyncJoin
then do
A.joinConnectionAsync bob "join" False aliceId True connReqJoin "bob's connInfo" bPQ SMSubscribe
get bob =##> \case ("join", c, A.JOINED sqSecured) -> c == aliceId && not sqSecured; _ -> False
else do
sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReqJoin "bob's connInfo" bPQ SMSubscribe
liftIO $ sqSecuredJoin `shouldBe` False
("", _, A.REQ invId reqPQ _ "bob's connInfo" _) <- get alice
liftIO $ reqPQ `shouldBe` PQSupportOn
bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
if asyncAccept
then do
acceptContactAsync alice "accept" bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
get alice =##> \case ("accept", c, A.JOINED _) -> c == bobId; _ -> False
else void $ acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
("", _, A.CONF confId confPQ _ "alice's connInfo") <- get bob
liftIO $ confPQ `shouldBe` bPQ
allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
-- DR advertising via createConnection (sync) and createConnectionAsync (async NEW), reaching newRcvConnSrv
runCreateConnectionDRTest_ :: HasCallStack => Bool -> InitialKeys -> PQSupport -> (ASrvTransport, AStoreType) -> IO ()
runCreateConnectionDRTest_ asyncNew addrIK bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ
runRight_ $ do
connReq <-
if asyncNew
then do
addrConnId <- prepareConnectionToCreate alice 1 True SCMContact (CR.connPQEncryption addrIK)
createConnectionAsync alice "1" addrConnId True SCMContact addrIK True SMSubscribe
("1", _, INV (ACR SCMContact cReq)) <- get alice
pure cReq
else do
(_, CCLink cReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing addrIK True SMSubscribe
pure cReq
let CRContactUri _ addrKeys_ = connReq
liftIO $ case addrKeys_ of
Just (_, CR.E2ERatchetParamsUri _ _ _ kem_) -> isJust kem_ `shouldBe` supportPQ (CR.initialPQEncryption False addrIK)
Nothing -> expectationFailure "createConnection must advertise DR ratchet keys"
aliceId <- A.prepareConnectionToJoin bob 1 True connReq bPQ
void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" bPQ SMSubscribe
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
void $ acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
testContactDRMatrix :: HasCallStack => (ASrvTransport, AStoreType) -> Spec
testContactDRMatrix ps = do
describe "DR join (ratchet from the invitation)" $ drRows False True False
describe "classic join, ratchet keys ignored" $ drRows False False False
describe "DR join, async accept (JOIN command)" $ drRows True True False
describe "DR join, async join (JOIN command)" $ drRows False True True
where
drRows asyncAccept useDR asyncJoin = do
it "IKPQOff, dh join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKPQOff useDR PQSupportOff ps
it "IKPQOff, pq join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKPQOff useDR PQSupportOn ps
it "IKPQOn, dh join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKPQOn useDR PQSupportOff ps
it "IKPQOn, pq join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKPQOn useDR PQSupportOn ps
it "IKUsePQ, dh join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKUsePQ useDR PQSupportOff ps
it "IKUsePQ, pq join" $ runAgentClientContactDRTest_ asyncAccept asyncJoin IKUsePQ useDR PQSupportOn ps
joinContactDR :: HasCallStack => AgentClient -> AgentClient -> ConnectionRequestUri 'CMContact -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO ()
joinContactDR alice requester connReq addrIK pqEnc = do
aliceId <- A.prepareConnectionToJoin requester 1 True connReq PQSupportOn
void $ A.joinConnection requester NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
reqId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
void $ acceptContact alice 1 reqId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
("", _, A.CONF confId _ _ "alice's connInfo") <- get requester
allowConfirmGreet alice reqId requester aliceId confId addrIK pqEnc
testAddressKeyRotation :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testAddressKeyRotation ps = withSmpServer ps $ withAgentClients3 $ \alice bob carol -> do
g <- C.newRandom
rootKey <- atomically $ C.generateKeyPair g
linkEntId <- atomically $ C.randomBytes 32 g
let addrIK = IKPQOn
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
connIK = IKLinkPQ (CR.connPQEncryption addrIK)
pqEnc = PQEncryption $ pqConnectionMode addrIK PQSupportOn
runRight_ $ do
(ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing
addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe
(_, ContactLinkData _ ctData1, connReq1) <- getConnShortLink bob 1 shortLink
let key1 = ratchetKeys ctData1
liftIO $ key1 `shouldSatisfy` isJust
void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK)
(_, ContactLinkData _ ctData2, connReq2) <- getConnShortLink carol 1 shortLink
let key2 = ratchetKeys ctData2
liftIO $ (key1 == key2) `shouldBe` False
joinContactDR alice bob connReq1 addrIK pqEnc
joinContactDR alice carol connReq2 addrIK pqEnc
void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK)
void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK)
aId <- A.prepareConnectionToJoin bob 1 True connReq1 PQSupportOn
void $ A.joinConnection bob NRMInteractive 1 aId True connReq1 "bob's connInfo" PQSupportOn SMSubscribe
get alice =##> \case ("", _, A.ERR _) -> True; _ -> False
testAddDRViaSetConnShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testAddDRViaSetConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do
g <- C.newRandom
rootKey <- atomically $ C.generateKeyPair g
linkEntId <- atomically $ C.randomBytes 32 g
let addrIK = IKPQOn
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
connIK = IKLinkPQ (CR.connPQEncryption addrIK)
runRight_ $ do
(ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK False Nothing
addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe
(_, ContactLinkData _ cd0, _) <- getConnShortLink bob 1 shortLink
liftIO $ ratchetKeys cd0 `shouldBe` Nothing
void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing False (Just addrIK)
(_, ContactLinkData _ cd1, _) <- getConnShortLink bob 1 shortLink
liftIO $ ratchetKeys cd1 `shouldSatisfy` isJust
-- updating a DR address's link data must preserve the stored ratchet keys
testAddressUpdatePreservesDRKeys :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do
g <- C.newRandom
rootKey <- atomically $ C.generateKeyPair g
linkEntId <- atomically $ C.randomBytes 32 g
let addrIK = IKPQOn
userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "original", ratchetKeys = Nothing}
connIK = IKLinkPQ (CR.connPQEncryption addrIK)
bPQ = PQSupportOn
pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ
runRight_ $ do
(ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing
addrConnId <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) SMSubscribe
(_, ContactLinkData _ published, _) <- getConnShortLink bob 1 shortLink
liftIO $ ratchetKeys published `shouldSatisfy` isJust
-- update passing ratchetKeys = Nothing; the stored keys must be preserved
let updatedCtData = userCtData {userData = UserLinkData "updated", ratchetKeys = Nothing}
shortLink' <- setConnShortLink alice addrConnId SCMContact (UserContactLinkData updatedCtData) Nothing
liftIO $ shortLink' `shouldBe` shortLink
(_, ContactLinkData _ updated, connReq') <- getConnShortLink bob 1 shortLink
liftIO $ ratchetKeys updated `shouldBe` ratchetKeys published
aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ
sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" bPQ SMSubscribe
liftIO $ sqSecuredJoin `shouldBe` False
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
_ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
-- a DR accept that fails at the network step after committing send queue + ratchet must resume on retry
testAcceptContactDRResumeAfterOffline :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do
g <- C.newRandom
rootKey <- atomically $ C.generateKeyPair g
linkEntId <- atomically $ C.randomBytes 32 g
let addrIK = IKPQOn
userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "u", ratchetKeys = Nothing}
connIK = IKLinkPQ (CR.connPQEncryption addrIK)
pqEnc = PQEncryption $ pqConnectionMode addrIK PQSupportOn
-- set up the DR address, bob joins, alice receives REQ and pre-creates the accept connection (server up)
(bobId, invId, aliceId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
(ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing
_ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) SMSubscribe
(_, _, connReq') <- getConnShortLink bob 1 shortLink
aId <- A.prepareConnectionToJoin bob 1 True connReq' PQSupportOn
_ <- A.joinConnection bob NRMInteractive 1 aId True connReq' "bob's connInfo" PQSupportOn SMSubscribe
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
pure (bId, invId, aId)
("", "", DOWN _ _) <- nGet alice
("", "", DOWN _ _) <- nGet bob
-- server is down: the accept commits the send queue + ratchet (DB-local) then fails at the network step
Left (BROKER _ (NETWORK _)) <- runExceptT $ acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
-- server is back: retrying the same accept must reuse the committed state and complete the handshake
withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
("", "", UP _ _) <- nGet alice
("", "", UP _ _) <- nGet bob
liftIO $ threadDelay 250000
_ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do
(_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ SMSubscribe
(_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe
(bAliceId, bobId, abPQEnc) <- connectViaContact bob bPQ qInfo
sentMessages abPQEnc alice bobId bob bAliceId
(tAliceId, tomId, atPQEnc) <- connectViaContact tom tPQ qInfo
@@ -998,7 +1239,7 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId
aId <- A.prepareConnectionToJoin b 1 True qInfo pq
sqSecuredJoin <- A.joinConnection b NRMInteractive 1 aId True qInfo "bob's connInfo" pq SMSubscribe
liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
("", _, A.REQ invId pqSup' _ "bob's connInfo") <- get alice
("", _, A.REQ invId pqSup' _ "bob's connInfo" _) <- get alice
liftIO $ pqSup' `shouldBe` PQSupportOn
bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ)
sqSecuredAccept <- acceptContact alice 1 bId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
@@ -1040,14 +1281,141 @@ noMessages_ ingoreQCONT c err = tryGet `shouldReturn` ()
testRejectContactRequest :: HasCallStack => IO ()
testRejectContactRequest =
withAgentClients2 $ \alice bob -> runRight_ $ do
(_addrConnId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe
(_addrConnId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
liftIO $ sqSecured `shouldBe` False -- joining via contact address connection
("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get alice
rejectContact alice invId
("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _) <- get alice
Left (A.CMD PROHIBITED _) <- tryError $ rejectContact alice NRMInteractive 1 invId (Just "no rejection without double ratchet")
rejectContact alice NRMInteractive 1 invId Nothing
liftIO $ noMessages bob "nothing delivered to bob"
testRejectContactRequestDR :: HasCallStack => IO ()
testRejectContactRequestDR =
withAgentClients2 $ \alice bob -> runRight_ $ do
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
(_addrConnId, CCLink connReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing IKPQOn True SMSubscribe
aliceId <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn
void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
rejectContact alice NRMInteractive 1 invId (Just "not now")
("", _, A.RJCT "not now") <- get bob
pure ()
testRejectContactRequestDRAsync :: HasCallStack => IO ()
testRejectContactRequestDRAsync =
withAgentClients2 $ \alice bob -> runRight_ $ do
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
(_addrConnId, CCLink connReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing IKPQOn True SMSubscribe
aliceId <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn
void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
rejectContactAsync alice "1" 1 invId (Just "not now")
("", _, A.RJCT "not now") <- get bob
pure ()
serviceUserLinkData :: UserConnLinkData 'CMContact
serviceUserLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
testServiceRequestResponse :: HasCallStack => IO ()
testServiceRequestResponse =
withAgentClients2 $ \service client -> runRight_ $ do
(_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
resp <- liftIO $ fst <$> concurrently
(runRight $ sendServiceRequest client NRMInteractive 1 connReq Nothing Nothing "service request")
(runRight_ $ do
("", _, SREQ invId _ "service request") <- get service
replyConnId <- sendServiceReply service NRMInteractive 1 invId "service response"
("", sentConnId, A.SSENT _ _) <- get service
liftIO $ sentConnId `shouldBe` replyConnId)
liftIO $ resp `shouldBe` "service response"
liftIO $ threadDelay 250000 -- let the async teardown of the reply queues settle before dispose
testServiceRequestResponseAsync :: HasCallStack => IO ()
testServiceRequestResponseAsync =
withAgentClients2 $ \service client -> runRight_ $ do
(_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
resp <- liftIO $ fst <$> concurrently
(runRight $ sendServiceRequest client NRMInteractive 1 connReq Nothing Nothing "service request")
(runRight_ $ do
("", _, SREQ invId _ "service request") <- get service
replyConnId <- sendServiceReplyAsync service "1" 1 invId "service response"
("", sentConnId, A.SSENT _ _) <- get service
liftIO $ sentConnId `shouldBe` replyConnId)
liftIO $ resp `shouldBe` "service response"
liftIO $ threadDelay 250000 -- let the async teardown of the reply queues settle before dispose
testServiceRequestRejected :: HasCallStack => IO ()
testServiceRequestRejected =
withAgentClients2 $ \service client -> runRight_ $ do
(_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
resp <- liftIO $ fst <$> concurrently
(runExceptT $ sendServiceRequest client NRMInteractive 1 connReq Nothing Nothing "service request")
(runRight_ $ do
("", _, SREQ invId _ "service request") <- get service
rejectServiceRequest service NRMInteractive 1 invId (Just "not allowed"))
liftIO $ resp `shouldBe` Left (AGENT (A_SERVICE (ASERejected "not allowed")))
liftIO $ threadDelay 250000 -- let the async teardown of the reply queues settle before dispose
testSignedServiceRequest :: HasCallStack => IO ()
testSignedServiceRequest =
withAgentClients2 $ \service client -> runRight_ $ do
(_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
g <- liftIO C.newRandom
(signPub, signPriv) <- liftIO $ atomically $ C.generateKeyPair g
resp <- liftIO $ fst <$> concurrently
(runRight $ sendServiceRequest client NRMInteractive 1 connReq Nothing (Just signPriv) "signed request")
(runRight_ $ do
("", _, SREQ invId sigKey_ "signed request") <- get service
liftIO $ sigKey_ `shouldBe` Just signPub
void $ sendServiceReply service NRMInteractive 1 invId "service response")
liftIO $ resp `shouldBe` "service response"
liftIO $ threadDelay 250000 -- let the async teardown of the reply queues settle before dispose
testSignedServiceRequestAsync :: HasCallStack => IO ()
testSignedServiceRequestAsync =
withAgentClients2 $ \service client -> runRight_ $ do
(_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
g <- liftIO C.newRandom
(signPub, signPriv) <- liftIO $ atomically $ C.generateKeyPair g
resp <- liftIO $ fst <$> concurrently
(runRight $ sendServiceRequestAsync client 1 connReq Nothing (Just signPriv) "signed request")
(runRight_ $ do
("", _, SREQ invId sigKey_ "signed request") <- get service
liftIO $ sigKey_ `shouldBe` Just signPub
void $ sendServiceReply service NRMInteractive 1 invId "service response")
liftIO $ resp `shouldBe` "service response"
liftIO $ threadDelay 250000 -- let the async teardown of the reply queues settle before dispose
-- server down, send, up, receive, down, reply, up, receive response.
-- The request send retries the outage (bounded by serviceRequestTimeout) until the server is back; the reply is
-- queued while the server is down and delivered on reconnect (async reply via ICReplyDel); the blocking call receives it.
testServiceRequestResilient :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testServiceRequestResilient ps = withAgentClients2 $ \service client -> do
-- server up: create the service address
connReq <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
(_, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
pure connReq
("", "", DOWN _ _) <- nGet service
-- server down: the async send is enqueued as a retried JOIN command and blocks for the response
reqAsync <- async $ runExceptT $ sendServiceRequestAsync client 1 connReq Nothing Nothing "resilient request"
threadDelay 500000 -- let the enqueued send retry against the down server before bringing it up
-- server up: the request is delivered and the service receives it
invId <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
("", "", UP _ _) <- nGet service
("", _, SREQ invId _ "resilient request") <- get service
pure invId :: ExceptT AgentErrorType IO InvitationId
("", "", DOWN _ _) <- nGet service
-- server down: the service replies; the async reply is enqueued and retried until the server is back
replyConnId <- runRight $ sendServiceReplyAsync service "1" 1 invId "resilient response"
-- server up: the reply is delivered, the requester's blocking call returns the response, the service gets SENT
resp <- withSmpServerStoreLogOn ps testPort $ \_ -> do
("", "", UP _ _) <- nGet service
("", sentConnId, A.SSENT _ _) <- get service
sentConnId `shouldBe` replyConnId
wait reqAsync
resp `shouldBe` Right "resilient response"
testUpdateConnectionUserId :: HasCallStack => IO ()
testUpdateConnectionUserId =
withAgentClients2 $ \alice bob -> runRight_ $ do
@@ -1305,7 +1673,7 @@ testContactErrors ps restart = do
Right r -> error $ "unexpected result " <> show r
Left _ -> putStrLn "retrying send" >> threadDelay 200000 >> loopSend
loopSend
("", _, A.REQ invId PQSupportOn _ "bob's connInfo") <- get a
("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _) <- get a
pure invId
("", "", DOWN _ [_]) <- nGet a
bId <- runRight $ A.prepareConnectionToAccept a 1 True invId PQSupportOn
@@ -1367,13 +1735,13 @@ testInvitationShortLink viaProxy a b =
withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
let userData = UserLinkData "some user data"
newLinkData = UserInvLinkData userData
(bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe
(FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
(bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ False SMSubscribe
(_, connData', connReq') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
-- same user can get invitation link again
(FixedLinkData {linkConnReq = connReq2}, connData2) <- runRight $ getConnShortLink b 1 shortLink
(_, connData2, connReq2) <- runRight $ getConnShortLink b 1 shortLink
connReq2 `shouldBe` connReq
linkUserData connData2 `shouldBe` userData
-- another user cannot get the same invitation link
@@ -1403,15 +1771,15 @@ testInvitationShortLinkPrev viaProxy sndSecure a b = runRight_ $ do
let userData = UserLinkData "some user data"
newLinkData = UserInvLinkData userData
-- can't create short link with previous version
(bId, CCLink connReq Nothing) <- A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKPQOn SMSubscribe
(bId, CCLink connReq Nothing) <- A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKPQOn False SMSubscribe
testJoinConn_ viaProxy sndSecure a bId b connReq
testInvitationShortLinkAsync :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
testInvitationShortLinkAsync viaProxy a b = do
let userData = UserLinkData "some user data"
newLinkData = UserInvLinkData userData
(bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe
(FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
(bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ False SMSubscribe
(_, connData', connReq') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
@@ -1436,20 +1804,22 @@ testContactShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO
testContactShortLink viaProxy a b =
withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
newLinkData = UserContactLinkData userCtData
(contactId, CCLink connReq0 (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMSubscribe
Right connReq <- pure $ smpDecode (smpEncode connReq0)
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(contactId, CCLink connReq0 (Just shortLink)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn False SMSubscribe
-- normalize through binary fixed-data encoding (queue mode patch); the extended type has no binary encoding
Right connReqBin <- pure $ smpDecode (smpEncode (binaryConnReq connReq0))
let connReq = connReqWithKeys connReqBin Nothing
(_, ContactLinkData _ userCtData', connReq') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
userCtData' `shouldBe` userCtData
-- same user can get contact link again
(FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
(_, ContactLinkData _ userCtData2, connReq2) <- runRight $ getConnShortLink b 1 shortLink
connReq2 `shouldBe` connReq
userCtData2 `shouldBe` userCtData
-- another user can get the same contact link
(FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
(_, ContactLinkData _ userCtData3, connReq3) <- runRight $ getConnShortLink c 1 shortLink
connReq3 `shouldBe` connReq
userCtData3 `shouldBe` userCtData
runRight $ do
@@ -1467,11 +1837,11 @@ testContactShortLink viaProxy a b =
exchangeGreetingsViaProxy viaProxy a bId b aId
-- update user data
let updatedData = UserLinkData "updated user data"
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing}
userLinkData' = UserContactLinkData updatedCtData
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink' `shouldBe` shortLink
(FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
(_, ContactLinkData _ updatedCtData', connReq4) <- runRight $ getConnShortLink c 1 shortLink
connReq4 `shouldBe` connReq
updatedCtData' `shouldBe` updatedCtData
-- one more time
@@ -1485,22 +1855,24 @@ testContactShortLink viaProxy a b =
testAddContactShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
testAddContactShortLink viaProxy a b =
withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
(contactId, CCLink connReq0 Nothing) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe
Right connReq <- pure $ smpDecode (smpEncode connReq0) --
(contactId, CCLink connReq0 Nothing) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMSubscribe
-- normalize through binary fixed-data encoding (queue mode patch); the extended type has no binary encoding
Right connReqBin <- pure $ smpDecode (smpEncode (binaryConnReq connReq0))
let connReq = connReqWithKeys connReqBin Nothing
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
newLinkData = UserContactLinkData userCtData
shortLink <- runRight $ setConnShortLink a contactId SCMContact newLinkData Nothing
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(_, ContactLinkData _ userCtData', connReq') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
userCtData' `shouldBe` userCtData
-- same user can get contact link again
(FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink
(_, ContactLinkData _ userCtData2, connReq2) <- runRight $ getConnShortLink b 1 shortLink
connReq2 `shouldBe` connReq
userCtData2 `shouldBe` userCtData
-- another user can get the same contact link
(FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink
(_, ContactLinkData _ userCtData3, connReq3) <- runRight $ getConnShortLink c 1 shortLink
connReq3 `shouldBe` connReq
userCtData3 `shouldBe` userCtData
runRight $ do
@@ -1518,11 +1890,11 @@ testAddContactShortLink viaProxy a b =
exchangeGreetingsViaProxy viaProxy a bId b aId
-- update user data
let updatedData = UserLinkData "updated user data"
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing}
userLinkData' = UserContactLinkData updatedCtData
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink' `shouldBe` shortLink
(FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink
(_, ContactLinkData _ updatedCtData', connReq4) <- runRight $ getConnShortLink c 1 shortLink
connReq4 `shouldBe` connReq
updatedCtData' `shouldBe` updatedCtData
@@ -1531,10 +1903,10 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do
let userData = UserLinkData "some user data"
newLinkData = UserInvLinkData userData
(bId, CCLink connReq (Just shortLink)) <- withSmpServer ps $
runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMOnlyCreate
runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ False SMOnlyCreate
withSmpServer ps $ do
runRight_ $ subscribeConnection a bId
(FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink
(_, connData', connReq') <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
linkUserData connData' `shouldBe` userData
@@ -1542,16 +1914,16 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do
testContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
newLinkData = UserContactLinkData userCtData
(contactId, CCLink connReq0 (Just shortLink)) <- withSmpServer ps $
runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMOnlyCreate
Right connReq <- pure $ smpDecode (smpEncode connReq0)
runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn False SMOnlyCreate
Right connReq <- pure $ smpDecode (smpEncode (binaryConnReq connReq0))
let updatedData = UserLinkData "updated user data"
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing}
updatedLinkData = UserContactLinkData updatedCtData
withSmpServer ps $ do
(fd', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(fd', ContactLinkData _ userCtData', _) <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
linkConnReq fd' `shouldBe` connReq
userCtData' `shouldBe` userCtData
@@ -1559,24 +1931,24 @@ testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedLinkData Nothing
shortLink' `shouldBe` shortLink
withSmpServer ps $ do
(fd4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
(fd4, ContactLinkData _ updatedCtData', _) <- runRight $ getConnShortLink b 1 shortLink
linkConnReq fd4 `shouldBe` connReq
updatedCtData' `shouldBe` updatedCtData
testAddContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
newLinkData = UserContactLinkData userCtData
((contactId, CCLink connReq0 Nothing), shortLink) <- withSmpServer ps $ runRight $ do
r@(contactId, _) <- A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate
r@(contactId, _) <- A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMOnlyCreate
(r,) <$> setConnShortLink a contactId SCMContact newLinkData Nothing
Right connReq <- pure $ smpDecode (smpEncode connReq0)
Right connReq <- pure $ smpDecode (smpEncode (binaryConnReq connReq0))
let updatedData = UserLinkData "updated user data"
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing}
updatedLinkData = UserContactLinkData updatedCtData
withSmpServer ps $ do
(fd', ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(fd', ContactLinkData _ userCtData', _) <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
linkConnReq fd' `shouldBe` connReq
userCtData' `shouldBe` userCtData
@@ -1584,14 +1956,14 @@ testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
shortLink' <- runRight $ setConnShortLink a contactId SCMContact updatedLinkData Nothing
shortLink' `shouldBe` shortLink
withSmpServer ps $ do
(fd4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
(fd4, ContactLinkData _ updatedCtData', _) <- runRight $ getConnShortLink b 1 shortLink
linkConnReq fd4 `shouldBe` connReq
updatedCtData' `shouldBe` updatedCtData
testOldContactQueueShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
(contactId, CCLink connReq Nothing) <- withSmpServer ps $ runRight $
A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn SMOnlyCreate
A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMOnlyCreate
-- make it an "old" queue
let updateStoreLog f = replaceSubstringInFile f " queue_mode=C" ""
#if defined(dbServerPostgres)
@@ -1620,22 +1992,22 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
withSmpServer ps $ do
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
userLinkData = UserContactLinkData userCtData
shortLink <- runRight $ setConnShortLink a contactId SCMContact userLinkData Nothing
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData') <- runRight $ getConnShortLink b 1 shortLink
(FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ userCtData', _) <- runRight $ getConnShortLink b 1 shortLink
strDecode (strEncode shortLink) `shouldBe` Right shortLink
connReq' `shouldBe` connReq
connReq' `shouldBe` binaryConnReq connReq
userCtData' `shouldBe` userCtData
-- update user data
let updatedData = UserLinkData "updated user data"
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData}
updatedCtData = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedData, ratchetKeys = Nothing}
userLinkData' = UserContactLinkData updatedCtData
shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing
shortLink' `shouldBe` shortLink
-- check updated
(FixedLinkData {linkConnReq = connReq''}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink
connReq'' `shouldBe` connReq
(FixedLinkData {linkConnReq = connReq''}, ContactLinkData _ updatedCtData', _) <- runRight $ getConnShortLink b 1 shortLink
connReq'' `shouldBe` binaryConnReq connReq
updatedCtData' `shouldBe` updatedCtData
replaceSubstringInFile :: FilePath -> T.Text -> T.Text -> IO ()
@@ -1647,19 +2019,20 @@ replaceSubstringInFile filePath oldText newText = do
testPrepareCreateConnectionLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
let userData = UserLinkData "test user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
userLinkData = UserContactLinkData userCtData
g <- C.newRandom
rootKey <- atomically $ C.generateKeyPair g
linkEntId <- atomically $ C.randomBytes 32 g
runRight $ do
(ccLink@(CCLink connReq (Just shortLink)), preparedParams) <-
A.prepareConnectionLink a 1 rootKey linkEntId True Nothing Nothing
A.prepareConnectionLink a 1 rootKey linkEntId True Nothing CR.IKPQOn False Nothing
liftIO $ strDecode (strEncode shortLink) `shouldBe` Right shortLink
_ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData CR.IKPQOn SMSubscribe
(FixedLinkData {linkConnReq = connReq', linkEntityId}, ContactLinkData _ userCtData') <- getConnShortLink b 1 shortLink
_ <- A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams userLinkData SMSubscribe
(FixedLinkData {linkEntityId}, ContactLinkData _ userCtData', connReq') <- getConnShortLink b 1 shortLink
liftIO $ Just linkEntId `shouldBe` linkEntityId
Right connReqDecoded <- pure $ smpDecode (smpEncode connReq)
Right connReqBin <- pure $ smpDecode (smpEncode (binaryConnReq connReq))
let connReqDecoded = connReqWithKeys connReqBin Nothing
liftIO $ connReq' `shouldBe` connReqDecoded
liftIO $ userCtData' `shouldBe` userCtData
(bId, sndSecure) <- joinConnection b 1 True connReq' "bob's connInfo" SMSubscribe
@@ -1675,6 +2048,11 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b
get b ##> ("", bId, CON)
exchangeGreetings a aId b bId
connReqWithKeys :: BinaryConnectionRequestUri m -> Maybe AddressRatchetKeys -> ConnectionRequestUri m
connReqWithKeys cr rk = case cr of
BCRInvitationUri crData e2eParams -> CRInvitationUri crData e2eParams
BCRContactUri crData -> CRContactUri crData rk
testIncreaseConnAgentVersion :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testIncreaseConnAgentVersion ps = do
alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 1 2} initAgentServers testDB
@@ -2362,7 +2740,7 @@ makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn True
makeConnectionForUsers_ :: HasCallStack => PQSupport -> SndQueueSecured -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
makeConnectionForUsers_ pqSupport sqSecured alice aliceUserId bob bobUserId = do
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive aliceUserId True True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) SMSubscribe
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive aliceUserId True True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) False SMSubscribe
aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport
sqSecured' <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe
liftIO $ sqSecured' `shouldBe` sqSecured
@@ -2642,7 +3020,7 @@ testAsyncCommands :: SndQueueSecured -> AgentClient -> AgentClient -> AgentMsgId
testAsyncCommands sqSecured alice bob baseId =
runRight_ $ do
bobId <- prepareConnectionToCreate alice 1 True SCMInvitation PQSupportOn
createConnectionAsync alice "1" bobId True SCMInvitation IKPQOn SMSubscribe
createConnectionAsync alice "1" bobId True SCMInvitation IKPQOn False SMSubscribe
("1", bobId', INV (ACR _ qInfo)) <- get alice
liftIO $ bobId' `shouldBe` bobId
aliceId <- prepareConnectionToJoin bob 1 True qInfo PQSupportOn
@@ -2695,22 +3073,22 @@ testSetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO ()
testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
let userData = UserLinkData "test user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
newLinkData = UserContactLinkData userCtData
(cId, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe
(cId, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn False SMSubscribe
-- verify initial link data
(_, ContactLinkData _ userCtData') <- getConnShortLink bob 1 shortLink
(_, ContactLinkData _ userCtData', _) <- getConnShortLink bob 1 shortLink
liftIO $ userCtData' `shouldBe` userCtData
-- update link data async
let updatedData = UserLinkData "updated user data"
updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData}
updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData, ratchetKeys = Nothing}
setConnShortLinkAsync alice "1" cId (UserContactLinkData updatedCtData) Nothing
("1", cId', LINK shortLink' (UserContactLinkData updatedCtData')) <- get alice
liftIO $ cId' `shouldBe` cId
liftIO $ shortLink' `shouldBe` shortLink
liftIO $ updatedCtData' `shouldBe` updatedCtData
-- verify updated link data
(_, ContactLinkData _ updatedCtData'') <- getConnShortLink bob 1 shortLink'
(_, ContactLinkData _ updatedCtData'', _) <- getConnShortLink bob 1 shortLink'
liftIO $ updatedCtData'' `shouldBe` updatedCtData
-- complete connection via contact address
(aliceId, _) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
@@ -2727,17 +3105,17 @@ testGetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO ()
testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
let userData = UserLinkData "test user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
newLinkData = UserContactLinkData userCtData
(_, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe
(_, CCLink qInfo (Just shortLink)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn False SMSubscribe
-- get link data async - creates new connection for bob
newId <- getConnShortLinkAsync bob 1 "1" Nothing shortLink
("1", newId', LDATA FixedLinkData {linkConnReq = qInfo'} (ContactLinkData _ userCtData')) <- get bob
("1", newId', LDATA FixedLinkData {linkConnReq = qInfo'} (ContactLinkData _ userCtData') connReq') <- get bob
liftIO $ newId' `shouldBe` newId
liftIO $ qInfo' `shouldBe` qInfo
liftIO $ qInfo' `shouldBe` binaryConnReq qInfo
liftIO $ userCtData' `shouldBe` userCtData
-- join connection async using connId from getConnShortLinkAsync
joinConnectionAsync bob "2" True newId True qInfo' "bob's connInfo" PQSupportOn SMSubscribe
-- join connection async using connId from getConnShortLinkAsync and the merged connReq from LDATA
joinConnectionAsync bob "2" True newId True connReq' "bob's connInfo" PQSupportOn SMSubscribe
let aliceId = newId
("2", aliceId', JOINED False) <- get bob
liftIO $ aliceId' `shouldBe` aliceId
@@ -2756,7 +3134,7 @@ testAsyncCommandsRestore ps = do
alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
bobId <- runRight $ do
connId <- prepareConnectionToCreate alice 1 True SCMInvitation PQSupportOn
createConnectionAsync alice "1" connId True SCMInvitation IKPQOn SMSubscribe
createConnectionAsync alice "1" connId True SCMInvitation IKPQOn False SMSubscribe
pure connId
liftIO $ noMessages alice "alice doesn't receive INV because server is down"
disposeAgentClient alice
@@ -3046,7 +3424,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
withAgent 2 agentCfg initAgentServersSrv2 testDB2 $ \b -> do
(aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
bId <- prepareConnectionToCreate a 1 True SCMInvitation PQSupportOn
createConnectionAsync a "1" bId True SCMInvitation IKPQOn SMSubscribe
createConnectionAsync a "1" bId True SCMInvitation IKPQOn False SMSubscribe
("1", bId', INV (ACR _ qInfo)) <- get a
liftIO $ bId' `shouldBe` bId
aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn
@@ -4351,7 +4729,7 @@ testClientNotice :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
testClientNotice ps = do
withAgent 1 agentCfg initAgentServers testDB $ \c -> do
(cId, _) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $
A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe
A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
("", "", DOWN _ [_]) <- nGet c
addNotice c cId $ Just 1
@@ -4360,7 +4738,7 @@ testClientNotice ps = do
subscribedWithErrors c 1
testNotice c True
threadDelay 1000000
runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe
runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
("", "", DOWN _ [_]) <- nGet c
addNotice c cId' $ Just 1
@@ -4371,7 +4749,7 @@ testClientNotice ps = do
threadDelay 1000000
testNotice c True
threadDelay 1000000
runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe
runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
addNotice c cId'' $ Just 1
@@ -4383,7 +4761,7 @@ testClientNotice ps = do
threadDelay 2000000
testNotice c True
threadDelay 1000000
runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe
runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
("", "", DOWN _ [_]) <- nGet c
addNotice c cId3 Nothing
@@ -4398,7 +4776,7 @@ testClientNotice ps = do
withSmpServerStoreLogOn ps testPort $ \_ -> do
runRight_ $ subscribeAllConnections c False Nothing
subscribedWithErrors c 4
void $ runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe
void $ runRight $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
where
addNotice c cId ttl = logNotice c cId $ Just ClientNotice {ttl}
removeNotice c cId = logNotice c cId Nothing
@@ -4414,7 +4792,7 @@ testClientNotice ps = do
r -> expectationFailure $ "unexpected event: " <> show r
testNotice :: HasCallStack => AgentClient -> Bool -> IO ()
testNotice c willExpire = do
NOTICE "localhost" False expiresAt_ <- runLeft $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn SMSubscribe
NOTICE "localhost" False expiresAt_ <- runLeft $ A.createConnection c NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
isJust expiresAt_ `shouldBe` willExpire
noNetworkDelay :: AgentClient -> IO ()
tests/AgentTests/SQLiteTests.hs
+3 -2
View File
@@ -198,7 +198,8 @@ cData1 =
lastExternalSndId = 0,
deleted = False,
ratchetSyncState = RSOk,
pqSupport = CR.PQSupportOn
pqSupport = CR.PQSupportOn,
serviceRequestExpiresAt = Nothing
}
testPrivateAuthKey :: C.APrivateAuthKey
@@ -696,7 +697,7 @@ testGetPendingServerCommand st = do
Right (Just PendingCommand {corrId = corrId'}) <- getPendingServerCommand db connId (Just smpServer1)
corrId' `shouldBe` "4"
where
command = AClientCommand $ NEW True (ACM SCMInvitation) IKPQOn SMSubscribe
command = AClientCommand $ NEW True (ACM SCMInvitation) IKPQOn SMSubscribe False
corruptCmd :: DB.Connection -> ByteString -> ConnId -> IO ()
corruptCmd db corrId connId = DB.execute db "UPDATE commands SET command = cast('bad' as blob) WHERE conn_id = ? AND corr_id = ?" (connId, corrId)
tests/AgentTests/ShortLinkTests.hs
+14 -14
View File
@@ -49,7 +49,7 @@ testInvShortLink = do
Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
-- decrypt
Right (FixedLinkData {linkConnReq = connReq}, connData') <- pure $ SL.decryptLinkData linkKey k srvData
connReq `shouldBe` invConnRequest
connReq `shouldBe` binaryConnReq invConnRequest
linkUserData connData' `shouldBe` userData
testInvShortLinkBadDataHash :: IO ()
@@ -80,14 +80,14 @@ testContactShortLink = do
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
userLinkData = UserContactLinkData userCtData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right srvData <- runExceptT $ SL.encryptLinkData g k linkData
-- decrypt
Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData
connReq `shouldBe` contactConnRequest
connReq `shouldBe` binaryConnReq contactConnRequest
userCtData' `shouldBe` userCtData
testUpdateContactShortLink :: IO ()
@@ -96,20 +96,20 @@ testUpdateContactShortLink = do
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userCtData = UserContactData {direct = True, owners = [], relays = [], userData}
userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
userLinkData = UserContactLinkData userCtData
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
-- encrypt updated user data
let updatedUserData = UserLinkData "updated user data"
userCtData' = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedUserData}
userCtData' = UserContactData {direct = False, owners = [], relays = [relayLink1, relayLink2], userData = updatedUserData, ratchetKeys = Nothing}
userLinkData' = UserContactLinkData userCtData'
signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange userLinkData'
Right ud' <- runExceptT $ SL.encryptUserData g k signed
-- decrypt
Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud')
connReq `shouldBe` contactConnRequest
connReq `shouldBe` binaryConnReq contactConnRequest
userCtData'' `shouldBe` userCtData'
testContactShortLinkBadDataHash :: IO ()
@@ -118,7 +118,7 @@ testContactShortLinkBadDataHash = do
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
(_linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
-- different key
linkKey <- LinkKey <$> atomically (C.randomBytes 32 g)
@@ -134,13 +134,13 @@ testContactShortLinkBadSignature = do
g <- C.newRandom
sigKeys <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
-- encrypt updated user data
let updatedUserData = UserLinkData "updated user data"
userLinkData' = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = updatedUserData}
userLinkData' = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = updatedUserData, ratchetKeys = Nothing}
-- another signature key
(_, pk) <- atomically $ C.generateKeyPair @'C.Ed25519 g
let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange userLinkData'
@@ -156,7 +156,7 @@ testContactShortLinkOwner = do
(pk, lnk) <- encryptLink g
-- encrypt updated user data
(ownerPK, owner) <- authNewOwner g pk
let ud = UserContactData {direct = True, owners = [owner], relays = [], userData = UserLinkData "updated user data"}
let ud = UserContactData {direct = True, owners = [owner], relays = [], userData = UserLinkData "updated user data", ratchetKeys = Nothing}
testEncDec g pk lnk ud
testEncDec g ownerPK lnk ud
(_, wrongKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
@@ -166,7 +166,7 @@ encryptLink :: TVar ChaChaDRG -> IO (C.PrivateKeyEd25519, (EncFixedDataBytes, Li
encryptLink g = do
sigKeys@(_, pk) <- atomically $ C.generateKeyPair @'C.Ed25519 g
let userData = UserLinkData "some user data"
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
(linkKey, linkData) = SL.encodeSignLinkData sigKeys supportedSMPAgentVRange contactConnRequest Nothing userLinkData
(_linkId, k) = SL.contactShortLinkKdf linkKey
Right (fd, _ud) <- runExceptT $ SL.encryptLinkData g k linkData
@@ -184,7 +184,7 @@ testEncDec g pk (fd, linkKey, k) ctData = do
let signed = SL.encodeSignUserData SCMContact pk supportedSMPAgentVRange $ UserContactLinkData ctData
Right ud <- runExceptT $ SL.encryptUserData g k signed
Right (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud)
connReq' `shouldBe` contactConnRequest
connReq' `shouldBe` binaryConnReq contactConnRequest
ctData' `shouldBe` ctData
testContactShortLinkManyOwners :: IO ()
@@ -199,7 +199,7 @@ testContactShortLinkManyOwners = do
(ownerPK4, owner4) <- authNewOwner g ownerPK1
(ownerPK5, owner5) <- authNewOwner g ownerPK3
let owners = [owner1, owner2, owner3, owner4, owner5]
ud = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"}
ud = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data", ratchetKeys = Nothing}
testEncDec g pk lnk ud
testEncDec g ownerPK1 lnk ud
testEncDec g ownerPK2 lnk ud
@@ -216,7 +216,7 @@ testContactShortLinkInvalidOwners = do
(pk, lnk) <- encryptLink g
-- encrypt updated user data
(ownerPK, owner) <- authNewOwner g pk
let mkCtData owners = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data"}
let mkCtData owners = UserContactData {direct = True, owners, relays = [], userData = UserLinkData "updated user data", ratchetKeys = Nothing}
-- decryption fails: owner uses root key
let ud = mkCtData [owner {ownerKey = C.publicKey pk}]
err = A_LINK $ "owner key for ID " <> ownerIdStr owner <> " matches root key"
tests/SMPProxyTests.hs
+5 -5
View File
@@ -228,7 +228,7 @@ agentDeliverMessageViaProxy :: (C.AlgorithmI a, C.AuthAlgorithm a) => (NonEmpty
agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, bViaProxy) alg msg1 msg2 baseId =
withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->
withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
liftIO $ sqSecured `shouldBe` True
@@ -284,7 +284,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
-- agent connections have to be set up in advance
-- otherwise the CONF messages would get mixed with MSG
prePair alice bob = do
(bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
(bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
sqSecured <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
liftIO $ sqSecured `shouldBe` True
@@ -343,7 +343,7 @@ agentViaProxyRetryOffline = do
let pqEnc = CR.PQEncOn
withServer $ \_ -> do
(aliceId, bobId) <- withServer2 $ \_ -> runRight $ do
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
liftIO $ sqSecured `shouldBe` True
@@ -504,14 +504,14 @@ testAgentClientReconnectAfterCancel :: IO ()
testAgentClientReconnectAfterCancel =
withAgent 1 agentCfg agentServersLeak testDB $ \a -> do
withStallingServerOn testPort2 $ do
t <- async $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
t <- async $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
threadDelay 1000000 -- let the connect to the stalling relay start, then kill it mid-flight
cancel t
withSmpServerConfigOn (transport @TLS) cfgJ2 testPort2 $ \_ -> do
testSMPClient_ "127.0.0.1" testPort2 supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
(_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PING)
reply `shouldBe` Right SMP.PONG -- the relay is up and reachable, so a timeout can only be the poisoned var
r <- timeout 8000000 $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
r <- timeout 8000000 $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
case r of
Just (Right _) -> pure ()
_ -> expectationFailure $ "agent failed to connect after a cancelled connect; got: " <> show r