From 7ec0ae3bb5d21fdcaf8a404d1638d1e119c7a3dd Mon Sep 17 00:00:00 2001 From: Evgeny Date: Thu, 3 Apr 2025 16:31:22 +0100 Subject: [PATCH] agent: types and encodings to use from the app (#1504) * agent: types and encodings to use from the app * use action forks --- .github/workflows/build.yml | 8 ++-- .github/workflows/docker-image.yml | 6 +-- src/Simplex/Messaging/Agent.hs | 20 +++++---- src/Simplex/Messaging/Agent/Protocol.hs | 60 +++++++++++++++++++++++-- tests/AgentTests/EqInstances.hs | 4 -- tests/AgentTests/FunctionalAPITests.hs | 25 ++++++----- tests/SMPProxyTests.hs | 8 ++-- 7 files changed, 92 insertions(+), 39 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 911bf5e66..451de173b 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -46,10 +46,10 @@ jobs: uses: actions/checkout@v3 - name: Set up Docker Buildx - uses: docker/setup-buildx-action@v3 + uses: simplex-chat/docker-setup-buildx-action@v3 - name: Build and cache Docker image - uses: docker/build-push-action@v6 + uses: simplex-chat/docker-build-push-action@v6 with: context: . load: true @@ -127,7 +127,7 @@ jobs: - name: Build changelog if: startsWith(github.ref, 'refs/tags/v') id: build_changelog - uses: mikepenz/release-changelog-builder-action@v5 + uses: simplex-chat/release-changelog-builder-action@v5 with: configuration: .github/changelog_conf.json failOnError: true @@ -138,7 +138,7 @@ jobs: - name: Create release if: startsWith(github.ref, 'refs/tags/v') && matrix.ghc != '8.10.7' - uses: softprops/action-gh-release@v2 + uses: simplex-chat/action-gh-release@v2 with: body: | See full changelog [here](https://github.com/simplex-chat/simplexmq/blob/master/CHANGELOG.md). diff --git a/.github/workflows/docker-image.yml b/.github/workflows/docker-image.yml index efd74552f..6e3e25e82 100644 --- a/.github/workflows/docker-image.yml +++ b/.github/workflows/docker-image.yml @@ -22,14 +22,14 @@ jobs: uses: actions/checkout@v4 - name: Log in to Docker Hub - uses: docker/login-action@v3 + uses: simplex-chat/docker-login-action@v3 with: username: ${{ secrets.DOCKERHUB_USERNAME }} password: ${{ secrets.DOCKERHUB_PASSWORD }} - name: Extract metadata for Docker image id: meta - uses: docker/metadata-action@v5 + uses: simplex-chat/docker-metadata-action@v5 with: images: ${{ secrets.DOCKERHUB_USERNAME }}/${{ matrix.app }} flavor: | @@ -40,7 +40,7 @@ jobs: type=semver,pattern=v{{major}} - name: Build and push Docker image - uses: docker/build-push-action@v6 + uses: simplex-chat/docker-build-push-action@v6 with: push: true build-args: | diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 1084881ad..44b95a48b 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -365,7 +365,7 @@ deleteConnectionsAsync c waitDelivery = withAgentEnv c . deleteConnectionsAsync' {-# INLINE deleteConnectionsAsync #-} -- | Create SMP agent connection (NEW command) -createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AE (ConnId, (ConnectionRequestUri c, Maybe (ConnShortLink c))) +createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AE (ConnId, CreatedConnLink c) createConnection c userId enableNtfs = withAgentEnv c .::. newConn c userId enableNtfs {-# INLINE createConnection #-} @@ -400,10 +400,12 @@ changeConnectionUser c oldUserId connId newUserId = withAgentEnv c $ changeConne -- "link deleted" (SMP AUTH) interactively, so this approach is simpler overall. prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> PQSupport -> AE ConnId prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs +{-# INLINE prepareConnectionToJoin #-} -- | Create SMP agent connection without queue (to be joined with acceptContact passing invitation ID). prepareConnectionToAccept :: AgentClient -> Bool -> ConfirmationId -> PQSupport -> AE ConnId prepareConnectionToAccept c enableNtfs = withAgentEnv c .: newConnToAccept c "" enableNtfs +{-# INLINE prepareConnectionToAccept #-} -- | Join SMP agent connection (JOIN command). joinConnection :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE SndQueueSecured @@ -822,7 +824,7 @@ switchConnectionAsync' c corrId connId = pure . connectionStats $ DuplexConnection cData rqs' sqs _ -> throwE $ CMD PROHIBITED "switchConnectionAsync: not duplex" -newConn :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, (ConnectionRequestUri c, Maybe (ConnShortLink c))) +newConn :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> AM (ConnId, CreatedConnLink c) newConn c userId enableNtfs cMode userData_ clientData pqInitKeys subMode = do srv <- getSMPServer c userId connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys) @@ -909,7 +911,7 @@ changeConnectionUser' c oldUserId connId newUserId = do where updateConn = withStore' c $ \db -> setConnUserId db oldUserId connId newUserId -newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (ConnectionRequestUri c, Maybe (ConnShortLink c)) +newRcvConnSrv :: forall c. ConnectionModeI c => AgentClient -> UserId -> ConnId -> Bool -> SConnectionMode c -> Maybe ConnInfo -> Maybe CRClientData -> CR.InitialKeys -> SubscriptionMode -> SMPServerWithAuth -> AM (CreatedConnLink c) newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys subMode srvWithAuth@(ProtoServerWithAuth srv _) = do case (cMode, pqInitKeys) of (SCMContact, CR.IKUsePQ) -> throwE $ CMD PROHIBITED "newRcvConnSrv" @@ -923,7 +925,7 @@ newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys s Nothing -> do let qd = case cMode of SCMContact -> CQRContact Nothing; SCMInvitation -> CQRMessaging Nothing (_, qUri) <- createRcvQueue Nothing qd e2eKeys - (,Nothing) <$> createConnReq qUri + (`CCLink` Nothing) <$> createConnReq qUri where createRcvQueue :: Maybe C.CbNonce -> ClntQueueReqData -> C.KeyPairX25519 -> AM (RcvQueue, SMPQueueUri) createRcvQueue nonce_ qd e2eKeys = do @@ -971,21 +973,21 @@ newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys s srvData <- liftIO $ SL.encryptLinkData g k linkData pure $ CQRMessaging $ Just CQRData {linkKey, privSigKey, srvReq = (sndId, srvData)} pure (nonce, qUri, connReq, qd) - connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (ConnectionRequestUri c, Maybe (ConnShortLink c)) + connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (CreatedConnLink c) connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of Just ShortLinkCreds {shortLinkId, shortLinkKey} | qUri == qUri' -> let link = case cReq of CRContactUri _ -> CSLContact srv CCTContact shortLinkKey CRInvitationUri {} -> CSLInvitation srv shortLinkId shortLinkKey - in pure (cReq, Just link) + in pure $ CCLink cReq (Just link) | otherwise -> throwE $ INTERNAL "different rcv queue address" Nothing -> let updated (ConnReqUriData _ vr _ _) = (ConnReqUriData SSSimplex vr [qUri] clientData) cReq' = case cReq of CRContactUri crData -> CRContactUri (updated crData) CRInvitationUri crData e2eParams -> CRInvitationUri (updated crData) e2eParams - in pure (cReq', Nothing) + in pure $ CCLink cReq' Nothing newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> PQSupport -> AM ConnId newConnToJoin c userId connId enableNtfs cReq pqSup = case cReq of @@ -1111,7 +1113,7 @@ joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMod joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv = lift (compatibleContactUri cReqUri) >>= \case Just (qInfo, vrsn) -> do - (cReq, _) <- newRcvConnSrv c userId connId enableNtfs SCMInvitation Nothing Nothing (CR.IKNoPQ pqSup) subMode srv + CCLink cReq _ <- newRcvConnSrv c userId connId enableNtfs SCMInvitation Nothing Nothing (CR.IKNoPQ pqSup) subMode srv void $ sendInvitation c userId connId qInfo vrsn cReq cInfo pure False Nothing -> throwE $ AGENT A_VERSION @@ -1421,7 +1423,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do NEW enableNtfs (ACM cMode) pqEnc subMode -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do - (cReq, _) <- newRcvConnSrv c userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv + CCLink cReq _ <- newRcvConnSrv c userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv notify $ INV (ACR cMode cReq) JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index f27ffbcd2..043f38688 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -112,7 +112,11 @@ module Simplex.Messaging.Agent.Protocol ServiceScheme, FixedLinkData (..), UserLinkData (..), + ConnectionLink (..), + AConnectionLink (..), ConnShortLink (..), + AConnShortLink (..), + CreatedConnLink (..), ContactConnType (..), LinkKey (..), sameConnReqContact, @@ -175,7 +179,7 @@ import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Time.Clock (UTCTime) import Data.Time.Clock.System (SystemTime) import Data.Type.Equality -import Data.Typeable () +import Data.Typeable (Typeable) import Data.Word (Word16, Word32) import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder, fromTextField_) import Simplex.FileTransfer.Description @@ -1129,6 +1133,13 @@ instance ToJSON AConnectionRequestUri where toJSON = strToJSON toEncoding = strToJEncoding +instance ConnectionModeI m => FromJSON (ConnShortLink m) where + parseJSON = strParseJSON "ConnShortLink" + +instance ConnectionModeI m => ToJSON (ConnShortLink m) where + toJSON = strToJSON + toEncoding = strToJEncoding + -- debug :: Show a => String -> a -> a -- debug name value = unsafePerformIO (putStrLn $ name <> ": " <> show value) `seq` value -- {-# INLINE debug #-} @@ -1345,6 +1356,8 @@ data ConnShortLink (m :: ConnectionMode) where CSLInvitation :: SMPServer -> SMP.LinkId -> LinkKey -> ConnShortLink 'CMInvitation CSLContact :: SMPServer -> ContactConnType -> LinkKey -> ConnShortLink 'CMContact +deriving instance Eq (ConnShortLink m) + deriving instance Show (ConnShortLink m) newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data) @@ -1353,15 +1366,49 @@ newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data) instance ToField LinkKey where toField (LinkKey s) = toField $ Binary s -data ContactConnType = CCTContact | CCTGroup deriving (Show) +instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode + +instance (Typeable c, ConnectionModeI c) => FromField (ConnectionLink c) where fromField = blobFieldDecoder strDecode + +instance ConnectionModeI c => ToField (ConnShortLink c) where toField = toField . Binary . strEncode + +instance (Typeable c, ConnectionModeI c) => FromField (ConnShortLink c) where fromField = blobFieldDecoder strDecode + +data ContactConnType = CCTContact | CCTGroup deriving (Eq, Show) data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m) --- TODO [short link] parser, parsing tests data ConnectionLink m = CLFull (ConnectionRequestUri m) | CLShort (ConnShortLink m) + deriving (Eq, Show) + +data CreatedConnLink m = CCLink {connFullLink :: ConnectionRequestUri m, connShortLink :: Maybe (ConnShortLink m)} + deriving (Eq, Show) data AConnectionLink = forall m. ConnectionModeI m => ACL (SConnectionMode m) (ConnectionLink m) +deriving instance Show AConnectionLink + +instance ConnectionModeI m => StrEncoding (ConnectionLink m) where + strEncode = \case + CLFull cr -> strEncode cr + CLShort sl -> strEncode sl + strP = (\(ACL _ cl) -> checkConnMode cl) <$?> strP + {-# INLINE strP #-} + +instance StrEncoding AConnectionLink where + strEncode (ACL _ cl) = strEncode cl + {-# INLINE strEncode #-} + strP = + (\(ACR m cr) -> ACL m (CLFull cr)) <$> strP + <|> (\(ACSL m sl) -> ACL m (CLShort sl)) <$> strP + +instance ConnectionModeI m => ToJSON (ConnectionLink m) where + toEncoding = strToJEncoding + toJSON = strToJSON + +instance ConnectionModeI m => FromJSON (ConnectionLink m) where + parseJSON = strParseJSON "ConnectionLink" + instance ConnectionModeI m => StrEncoding (ConnShortLink m) where strEncode = \case CSLInvitation srv (SMP.EntityId lnkId) (LinkKey k) -> encLink srv (lnkId <> k) "i" @@ -1695,3 +1742,10 @@ $(J.deriveJSON (sumTypeJSON id) ''AgentErrorType) $(J.deriveJSON (enumJSON $ dropPrefix "QD") ''QueueDirection) $(J.deriveJSON (enumJSON $ dropPrefix "SP") ''SwitchPhase) + +instance ConnectionModeI m => FromJSON (CreatedConnLink m) where + parseJSON = $(J.mkParseJSON defaultJSON ''CreatedConnLink) + +instance ConnectionModeI m => ToJSON (CreatedConnLink m) where + toEncoding = $(J.mkToEncoding defaultJSON ''CreatedConnLink) + toJSON = $(J.mkToJSON defaultJSON ''CreatedConnLink) diff --git a/tests/AgentTests/EqInstances.hs b/tests/AgentTests/EqInstances.hs index 14ad526a5..0b7890ae7 100644 --- a/tests/AgentTests/EqInstances.hs +++ b/tests/AgentTests/EqInstances.hs @@ -28,10 +28,6 @@ deriving instance Eq ClientNtfCreds deriving instance Eq ShortLinkCreds -deriving instance Eq ContactConnType - -deriving instance Eq (ConnShortLink m) - deriving instance Show ProxiedRelay deriving instance Eq ProxiedRelay diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 2904f9576..f08ed48a6 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -60,7 +60,7 @@ import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Monad import Control.Monad.Except import Control.Monad.Reader -import Data.Bifunctor (first, second) +import Data.Bifunctor (first) import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B @@ -252,8 +252,9 @@ inAnyOrder g rs = withFrozenCallStack $ do expected r rp = rp r createConnection :: ConnectionModeI c => AgentClient -> UserId -> Bool -> SConnectionMode c -> Maybe CRClientData -> SubscriptionMode -> AE (ConnId, ConnectionRequestUri c) -createConnection c userId enableNtfs cMode clientData = - fmap (second fst) . A.createConnection c userId enableNtfs cMode Nothing clientData (IKNoPQ PQSupportOn) +createConnection c userId enableNtfs cMode clientData subMode = do + (connId, CCLink cReq _) <- A.createConnection c userId enableNtfs cMode Nothing clientData (IKNoPQ PQSupportOn) subMode + pure (connId, cReq) joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured) joinConnection c userId enableNtfs cReq connInfo subMode = do @@ -615,7 +616,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, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing aPQ SMSubscribe + (bobId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing aPQ SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ sqSecured' <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured @@ -817,7 +818,7 @@ 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 - (_, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe + (_, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ sqSecuredJoin <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection @@ -861,7 +862,7 @@ runAgentClientContactTestPQ sqSecured viaProxy reqPQSupport (alice, aPQ) (bob, b runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO () runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do - (_, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe + (_, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMContact Nothing Nothing aPQ SMSubscribe (bAliceId, bobId, abPQEnc) <- connectViaContact bob bPQ qInfo sentMessages abPQEnc alice bobId bob bAliceId (tAliceId, tomId, atPQEnc) <- connectViaContact tom tPQ qInfo @@ -914,7 +915,7 @@ noMessages_ ingoreQCONT c err = tryGet `shouldReturn` () testRejectContactRequest :: HasCallStack => IO () testRejectContactRequest = withAgentClients2 $ \alice bob -> runRight_ $ do - (addrConnId, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMContact Nothing Nothing IKPQOn SMSubscribe + (addrConnId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMContact Nothing Nothing IKPQOn SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn sqSecured <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` False -- joining via contact address connection @@ -1085,7 +1086,7 @@ testInviationShortLink :: HasCallStack => (ATransport, AStoreType) -> IO () testInviationShortLink ps = withAgentClients3 $ \a b c -> withSmpServer ps $ do let userData = "some user data" - (bId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe + (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq @@ -1113,7 +1114,7 @@ testInviationShortLinkAsync :: HasCallStack => (ATransport, AStoreType) -> IO () testInviationShortLinkAsync ps = withAgentClients2 $ \a b -> withSmpServer ps $ do let userData = "some user data" - (bId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe + (bId, CCLink connReq (Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq @@ -1132,7 +1133,7 @@ testContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO () testContactShortLink ps = withAgentClients3 $ \a b c -> withSmpServer ps $ do let userData = "some user data" - (contactId, (connReq0, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe + (contactId, CCLink connReq0 (Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe Right connReq <- pure $ smpDecode (smpEncode connReq0) (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink @@ -1177,7 +1178,7 @@ testContactShortLink ps = testAddContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO () testAddContactShortLink ps = withAgentClients3 $ \a b c -> withSmpServer ps $ do - (contactId, (connReq0, Nothing)) <- runRight $ A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe + (contactId, CCLink connReq0 Nothing) <- runRight $ A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe Right connReq <- pure $ smpDecode (smpEncode connReq0) -- let userData = "some user data" shortLink <- runRight $ setContactShortLink a contactId userData @@ -1901,7 +1902,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, (qInfo, Nothing)) <- A.createConnection alice aliceUserId True SCMInvitation Nothing Nothing (CR.IKNoPQ pqSupport) SMSubscribe + (bobId, CCLink qInfo Nothing) <- A.createConnection alice aliceUserId True SCMInvitation Nothing Nothing (CR.IKNoPQ pqSupport) SMSubscribe aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport sqSecured' <- A.joinConnection bob bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe liftIO $ sqSecured' `shouldBe` sqSecured diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index e39cb3449..b9958b28c 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -225,7 +225,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, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe + (bobId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn sqSecured <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True @@ -281,7 +281,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, (qInfo, Nothing)) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe + (bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn sqSecured <- runExceptT' $ A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True @@ -332,7 +332,7 @@ agentViaProxyVersionError = withAgent 1 agentCfg (servers [SMPServer testHost testPort testKeyHash]) testDB $ \alice -> do Left (A.BROKER _ (TRANSPORT TEVersion)) <- withAgent 2 agentCfg (servers [SMPServer testHost2 testPort2 testKeyHash]) testDB2 $ \bob -> runExceptT $ do - (_bobId, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe + (_bobId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe pure () @@ -352,7 +352,7 @@ agentViaProxyRetryOffline = do let pqEnc = CR.PQEncOn withServer $ \_ -> do (aliceId, bobId) <- withServer2 $ \_ -> runRight $ do - (bobId, (qInfo, Nothing)) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe + (bobId, CCLink qInfo Nothing) <- A.createConnection alice 1 True SCMInvitation Nothing Nothing (CR.IKNoPQ PQSupportOn) SMSubscribe aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn sqSecured <- A.joinConnection bob 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ sqSecured `shouldBe` True