diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 8ccc83332..6b3ef6a56 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -81,7 +81,7 @@ module Simplex.Messaging.Agent ) where -import Control.Concurrent.STM (flushTBQueue, stateTVar) +import Control.Concurrent.STM (stateTVar) import Control.Logger.Simple (logInfo, showText) import Control.Monad.Except import Control.Monad.IO.Unlift (MonadUnliftIO) @@ -183,8 +183,8 @@ deleteConnectionAsync :: AgentErrorMonad m => AgentClient -> ACorrId -> ConnId - deleteConnectionAsync c = withAgentEnv c .: deleteConnectionAsync' c -- | Create SMP agent connection (NEW command) -createConnection :: AgentErrorMonad m => AgentClient -> Bool -> SConnectionMode c -> m (ConnId, ConnectionRequestUri c) -createConnection c enableNtfs cMode = withAgentEnv c $ newConn c "" False enableNtfs cMode +createConnection :: AgentErrorMonad m => AgentClient -> Bool -> SConnectionMode c -> Maybe CRClientData -> m (ConnId, ConnectionRequestUri c) +createConnection c enableNtfs cMode clientData = withAgentEnv c $ newConn c "" False enableNtfs cMode clientData -- | Join SMP agent connection (JOIN command) joinConnection :: AgentErrorMonad m => AgentClient -> Bool -> ConnectionRequestUri c -> ConnInfo -> m ConnId @@ -331,7 +331,7 @@ client c@AgentClient {rcvQ, subQ} = forever $ do -- | execute any SMP agent command processCommand :: forall m. AgentMonad m => AgentClient -> (ConnId, ACommand 'Client) -> m (ConnId, ACommand 'Agent) processCommand c (connId, cmd) = case cmd of - NEW enableNtfs (ACM cMode) -> second (INV . ACR cMode) <$> newConn c connId False enableNtfs cMode + NEW enableNtfs (ACM cMode) -> second (INV . ACR cMode) <$> newConn c connId False enableNtfs cMode Nothing JOIN enableNtfs (ACR _ cReq) connInfo -> (,OK) <$> joinConn c connId False enableNtfs cReq connInfo LET confId ownCInfo -> allowConnection' c connId confId ownCInfo $> (connId, OK) ACPT invId ownCInfo -> (,OK) <$> acceptContact' c connId True invId ownCInfo @@ -354,9 +354,9 @@ newConnAsync c corrId enableNtfs cMode = do pure connId joinConnAsync :: AgentMonad m => AgentClient -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> m ConnId -joinConnAsync c corrId enableNtfs cReqUri@(CRInvitationUri (ConnReqUriData _ agentVRange _) _) cInfo = do +joinConnAsync c corrId enableNtfs cReqUri@(CRInvitationUri ConnReqUriData {crAgentVRange} _) cInfo = do aVRange <- asks $ smpAgentVRange . config - case agentVRange `compatibleVersion` aVRange of + case crAgentVRange `compatibleVersion` aVRange of Just (Compatible connAgentVersion) -> do g <- asks idsDrg let duplexHS = connAgentVersion /= 1 @@ -426,12 +426,12 @@ switchConnectionAsync' c corrId connId = SomeConn _ DuplexConnection {} -> enqueueCommand c corrId connId Nothing $ AClientCommand SWCH _ -> throwError $ CMD PROHIBITED -newConn :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionMode c -> m (ConnId, ConnectionRequestUri c) -newConn c connId asyncMode enableNtfs cMode = - getSMPServer c >>= newConnSrv c connId asyncMode enableNtfs cMode +newConn :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> m (ConnId, ConnectionRequestUri c) +newConn c connId asyncMode enableNtfs cMode clientData = + getSMPServer c >>= newConnSrv c connId asyncMode enableNtfs cMode clientData -newConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionMode c -> SMPServer -> m (ConnId, ConnectionRequestUri c) -newConnSrv c connId asyncMode enableNtfs cMode srv = do +newConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> SConnectionMode c -> Maybe CRClientData -> SMPServer -> m (ConnId, ConnectionRequestUri c) +newConnSrv c connId asyncMode enableNtfs cMode clientData srv = do AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config (q, qUri) <- newRcvQueue c "" srv smpClientVRange connId' <- setUpConn asyncMode q $ maxVersion smpAgentVRange @@ -440,7 +440,7 @@ newConnSrv c connId asyncMode enableNtfs cMode srv = do when enableNtfs $ do ns <- asks ntfSupervisor atomically $ sendNtfSubCommand ns (connId', NSCCreate) - let crData = ConnReqUriData simplexChat smpAgentVRange [qUri] + let crData = ConnReqUriData simplexChat smpAgentVRange [qUri] clientData case cMode of SCMContact -> pure (connId', CRContactUri crData) SCMInvitation -> do @@ -465,11 +465,11 @@ joinConn c connId asyncMode enableNtfs cReq cInfo = do joinConnSrv c connId asyncMode enableNtfs cReq cInfo srv joinConnSrv :: AgentMonad m => AgentClient -> ConnId -> Bool -> Bool -> ConnectionRequestUri c -> ConnInfo -> SMPServer -> m ConnId -joinConnSrv c connId asyncMode enableNtfs (CRInvitationUri (ConnReqUriData _ agentVRange (qUri :| _)) e2eRcvParamsUri) cInfo srv = do +joinConnSrv c connId asyncMode enableNtfs (CRInvitationUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)} e2eRcvParamsUri) cInfo srv = do AgentConfig {smpClientVRange, smpAgentVRange, e2eEncryptVRange} <- asks config case ( qUri `compatibleVersion` smpClientVRange, e2eRcvParamsUri `compatibleVersion` e2eEncryptVRange, - agentVRange `compatibleVersion` smpAgentVRange + crAgentVRange `compatibleVersion` smpAgentVRange ) of (Just qInfo, Just (Compatible e2eRcvParams@(CR.E2ERatchetParams _ _ rcDHRr)), Just aVersion@(Compatible connAgentVersion)) -> do (pk1, pk2, e2eSndParams) <- liftIO . CR.generateE2EParams $ version e2eRcvParams @@ -502,14 +502,14 @@ joinConnSrv c connId asyncMode enableNtfs (CRInvitationUri (ConnReqUriData _ age liftIO $ createRatchet db connId' rc pure connId' _ -> throwError $ AGENT A_VERSION -joinConnSrv c connId False enableNtfs (CRContactUri (ConnReqUriData _ agentVRange (qUri :| _))) cInfo srv = do +joinConnSrv c connId False enableNtfs (CRContactUri ConnReqUriData {crAgentVRange, crSmpQueues = (qUri :| _)}) cInfo srv = do aVRange <- asks $ smpAgentVRange . config clientVRange <- asks $ smpClientVRange . config case ( qUri `compatibleVersion` clientVRange, - agentVRange `compatibleVersion` aVRange + crAgentVRange `compatibleVersion` aVRange ) of (Just qInfo, Just vrsn) -> do - (connId', cReq) <- newConnSrv c connId False enableNtfs SCMInvitation srv + (connId', cReq) <- newConnSrv c connId False enableNtfs SCMInvitation Nothing srv sendInvitation c qInfo vrsn cReq cInfo pure connId' _ -> throwError $ AGENT A_VERSION @@ -781,7 +781,7 @@ runCommandProcessing c@AgentClient {subQ} server_ = do NEW enableNtfs (ACM cMode) -> noServer $ do usedSrvs <- newTVarIO ([] :: [SMPServer]) tryCommand . withNextSrv usedSrvs [] $ \srv -> do - (_, cReq) <- newConnSrv c connId True enableNtfs cMode srv + (_, cReq) <- newConnSrv c connId True enableNtfs cMode Nothing srv notify $ INV (ACR cMode cReq) JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) connInfo -> noServer $ do let initUsed = [qServer q] diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index d0907493c..3a2a27d9f 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -76,6 +76,7 @@ module Simplex.Messaging.Agent.Protocol ConnectionRequestUri (..), AConnectionRequestUri (..), ConnReqUriData (..), + CRClientData, ConnReqScheme (..), simplexChat, AgentErrorType (..), @@ -138,6 +139,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (isJust) import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock (UTCTime) import Data.Time.Clock.System (SystemTime) import Data.Time.ISO8601 @@ -713,13 +715,14 @@ instance forall m. ConnectionModeI m => StrEncoding (ConnectionRequestUri m) whe CRContactUri crData -> crEncode "contact" crData Nothing where crEncode :: ByteString -> ConnReqUriData -> Maybe (E2ERatchetParamsUri 'C.X448) -> ByteString - crEncode crMode ConnReqUriData {crScheme, crAgentVRange, crSmpQueues} e2eParams = + crEncode crMode ConnReqUriData {crScheme, crAgentVRange, crSmpQueues, crClientData} e2eParams = strEncode crScheme <> "/" <> crMode <> "#/?" <> queryStr where queryStr = strEncode . QSP QEscape $ [("v", strEncode crAgentVRange), ("smp", strEncode crSmpQueues)] <> maybe [] (\e2e -> [("e2e", strEncode e2e)]) e2eParams + <> maybe [] (\cd -> [("data", encodeUtf8 cd)]) crClientData strP = do ACR m cr <- strP case testEquality m $ sConnectionMode @m of @@ -734,7 +737,8 @@ instance StrEncoding AConnectionRequestUri where query <- strP crAgentVRange <- queryParam "v" query crSmpQueues <- queryParam "smp" query - let crData = ConnReqUriData {crScheme, crAgentVRange, crSmpQueues} + let crClientData = safeDecodeUtf8 <$> queryParamStr "data" query + let crData = ConnReqUriData {crScheme, crAgentVRange, crSmpQueues, crClientData} case crMode of CMInvitation -> do crE2eParams <- queryParam "e2e" query @@ -930,10 +934,13 @@ deriving instance Show AConnectionRequestUri data ConnReqUriData = ConnReqUriData { crScheme :: ConnReqScheme, crAgentVRange :: VersionRange, - crSmpQueues :: L.NonEmpty SMPQueueUri + crSmpQueues :: L.NonEmpty SMPQueueUri, + crClientData :: Maybe CRClientData } deriving (Eq, Show) +type CRClientData = Text + data ConnReqScheme = CRSSimplex | CRSAppServer SrvLoc deriving (Eq, Show) @@ -1387,7 +1394,7 @@ tGet party h = liftIO (tGetRaw h) >>= tParseLoadBody tConnId :: ARawTransmission -> ACommand p -> Either AgentErrorType (ACommand p) tConnId (_, connId, _) cmd = case cmd of -- NEW, JOIN and ACPT have optional connId - NEW _ _ -> Right cmd + NEW {} -> Right cmd JOIN {} -> Right cmd ACPT {} -> Right cmd -- ERROR response does not always have connId diff --git a/src/Simplex/Messaging/Agent/QueryString.hs b/src/Simplex/Messaging/Agent/QueryString.hs index b81f9d868..fee552a01 100644 --- a/src/Simplex/Messaging/Agent/QueryString.hs +++ b/src/Simplex/Messaging/Agent/QueryString.hs @@ -24,13 +24,16 @@ instance StrEncoding QueryStringParams where strP = QSP QEscape . Q.parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n') queryParam :: StrEncoding a => ByteString -> QueryStringParams -> Parser a -queryParam name (QSP _ q) = - case find ((== name) . fst) q of - Just (_, p) -> either fail pure $ parseAll strP p +queryParam name q = + case queryParamStr name q of + Just p -> either fail pure $ parseAll strP p _ -> fail $ "no qs param " <> B.unpack name queryParam_ :: StrEncoding a => ByteString -> QueryStringParams -> Parser (Maybe a) -queryParam_ name (QSP _ q) = - case find ((== name) . fst) q of - Just (_, p) -> either fail pure $ parseAll strP p +queryParam_ name q = + case queryParamStr name q of + Just p -> either fail pure $ parseAll strP p _ -> pure Nothing + +queryParamStr :: ByteString -> QueryStringParams -> Maybe ByteString +queryParamStr name (QSP _ q) = snd <$> find ((== name) . fst) q diff --git a/src/Simplex/Messaging/Encoding/String.hs b/src/Simplex/Messaging/Encoding/String.hs index 82bff3286..769d591b9 100644 --- a/src/Simplex/Messaging/Encoding/String.hs +++ b/src/Simplex/Messaging/Encoding/String.hs @@ -97,7 +97,7 @@ instance StrEncoding Word16 where instance StrEncoding Char where strEncode = smpEncode {-# INLINE strEncode #-} - strP = strP + strP = smpP {-# INLINE strP #-} instance StrEncoding Bool where diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs index 8f89594e0..c0c39d665 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs @@ -34,7 +34,6 @@ import Data.Int (Int64) import Data.Map.Strict (Map) import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8With) import Data.Time.Clock.System import qualified Data.X509 as X import GHC.Generics (Generic) @@ -49,6 +48,7 @@ import Simplex.Messaging.Notifications.Protocol import Simplex.Messaging.Notifications.Server.Store (NtfTknData (..)) import Simplex.Messaging.Protocol (EncNMsgMeta) import Simplex.Messaging.Transport.HTTP2.Client +import Simplex.Messaging.Util (safeDecodeUtf8) import System.Environment (getEnv) import UnliftIO.STM @@ -295,7 +295,6 @@ apnsNotification NtfTknData {tknDhSecret} nonce paddedLen = \case apn aps notificationData = APNSNotification {aps, notificationData} apnMutableContent = APNSMutableContent {mutableContent = 1, alert = APNSAlertText "Encrypted message or another app event", category = Just ntfCategoryCheckMessage} apnAlert alert = APNSAlert {alert, badge = Nothing, sound = Nothing, category = Nothing} - safeDecodeUtf8 = decodeUtf8With onError where onError _ _ = Just '?' apnsRequest :: APNSPushClient -> ByteString -> APNSNotification -> IO Request apnsRequest c tkn ntf@APNSNotification {aps} = do diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs index c1e4146d6..6e1b5ef11 100644 --- a/src/Simplex/Messaging/Util.hs +++ b/src/Simplex/Messaging/Util.hs @@ -12,6 +12,7 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Text (Text) import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8With) import UnliftIO.Async raceAny_ :: MonadUnliftIO m => [m a] -> m () @@ -92,3 +93,8 @@ catchAll_ a = catchAll a . const eitherToMaybe :: Either a b -> Maybe b eitherToMaybe = either (const Nothing) Just {-# INLINE eitherToMaybe #-} + +safeDecodeUtf8 :: ByteString -> Text +safeDecodeUtf8 = decodeUtf8With onError + where + onError _ _ = Just '?' diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index f2ff994f4..ea50834fd 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -52,7 +52,8 @@ connReqData = ConnReqUriData { crScheme = simplexChat, crAgentVRange = mkVersionRange 1 1, - crSmpQueues = [queueV1] + crSmpQueues = [queueV1], + crClientData = Nothing } testDhPubKey :: C.PublicKeyX448 @@ -76,6 +77,16 @@ connectionRequest12 = connReqData {crAgentVRange = supportedSMPAgentVRange, crSmpQueues = [queueV1, queueV1]} testE2ERatchetParams12 +connectionRequestClientDataEmpty :: AConnectionRequestUri +connectionRequestClientDataEmpty = + ACR SCMInvitation $ + CRInvitationUri connReqData {crClientData = Just "{}"} testE2ERatchetParams + +connectionRequestClientData :: AConnectionRequestUri +connectionRequestClientData = + ACR SCMInvitation $ + CRInvitationUri connReqData {crClientData = Just "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}"} testE2ERatchetParams + connectionRequestTests :: Spec connectionRequestTests = describe "connection request parsing / serializing" $ do @@ -108,6 +119,16 @@ connectionRequestTests = <> "%2Csmp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" <> urlEncode True testDhKeyStrUri <> "&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" + strEncode connectionRequestClientDataEmpty + `shouldBe` "https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" + <> urlEncode True testDhKeyStrUri + <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" + <> "&data=%7B%7D" + strEncode connectionRequestClientData + `shouldBe` "https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" + <> urlEncode True testDhKeyStrUri + <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" + <> "&data=%7B%22type%22%3A%22group_link%22%2C%20%22group_link_id%22%3A%22abc%22%7D" it "should parse connection requests" $ do strDecode ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23" @@ -140,3 +161,19 @@ connectionRequestTests = <> "&v=1-2" ) `shouldBe` Right connectionRequest12 + strDecode + ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" + <> testDhKeyStrUri + <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" + <> "&data=%7B%7D" + <> "&v=1-1" + ) + `shouldBe` Right connectionRequestClientDataEmpty + strDecode + ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1%26dh%3D" + <> testDhKeyStrUri + <> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D" + <> "&data=%7B%22type%22%3A%22group_link%22%2C%20%22group_link_id%22%3A%22abc%22%7D" + <> "&v=1-1" + ) + `shouldBe` Right connectionRequestClientData diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 75f06869b..55dd1f3a1 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -156,7 +156,7 @@ runTestCfg2 aliceCfg bobCfg baseMsgId runTest = do runAgentClientTest :: AgentClient -> AgentClient -> AgentMsgId -> IO () runAgentClientTest alice bob baseId = do Right () <- runExceptT $ do - (bobId, qInfo) <- createConnection alice True SCMInvitation + (bobId, qInfo) <- createConnection alice True SCMInvitation Nothing aliceId <- joinConnection bob True qInfo "bob's connInfo" ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" @@ -192,7 +192,7 @@ runAgentClientTest alice bob baseId = do runAgentClientContactTest :: AgentClient -> AgentClient -> AgentMsgId -> IO () runAgentClientContactTest alice bob baseId = do Right () <- runExceptT $ do - (_, qInfo) <- createConnection alice True SCMContact + (_, qInfo) <- createConnection alice True SCMContact Nothing aliceId <- joinConnection bob True qInfo "bob's connInfo" ("", _, REQ invId _ "bob's connInfo") <- get alice bobId <- acceptContact alice True invId "alice's connInfo" @@ -240,7 +240,7 @@ testAsyncInitiatingOffline = do alice <- getSMPAgentClient agentCfg initAgentServers bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do - (bobId, cReq) <- createConnection alice True SCMInvitation + (bobId, cReq) <- createConnection alice True SCMInvitation Nothing disconnectAgentClient alice aliceId <- joinConnection bob True cReq "bob's connInfo" alice' <- liftIO $ getSMPAgentClient agentCfg initAgentServers @@ -258,7 +258,7 @@ testAsyncJoiningOfflineBeforeActivation = do alice <- getSMPAgentClient agentCfg initAgentServers bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do - (bobId, qInfo) <- createConnection alice True SCMInvitation + (bobId, qInfo) <- createConnection alice True SCMInvitation Nothing aliceId <- joinConnection bob True qInfo "bob's connInfo" disconnectAgentClient bob ("", _, CONF confId _ "bob's connInfo") <- get alice @@ -276,7 +276,7 @@ testAsyncBothOffline = do alice <- getSMPAgentClient agentCfg initAgentServers bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do - (bobId, cReq) <- createConnection alice True SCMInvitation + (bobId, cReq) <- createConnection alice True SCMInvitation Nothing disconnectAgentClient alice aliceId <- joinConnection bob True cReq "bob's connInfo" disconnectAgentClient bob @@ -298,7 +298,7 @@ testAsyncServerOffline t = do bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers -- create connection and shutdown the server Right (bobId, cReq) <- withSmpServerStoreLogOn t testPort $ \_ -> - runExceptT $ createConnection alice True SCMInvitation + runExceptT $ createConnection alice True SCMInvitation Nothing -- connection fails Left (BROKER NETWORK) <- runExceptT $ joinConnection bob True cReq "bob's connInfo" ("", "", DOWN srv conns) <- get alice @@ -325,7 +325,7 @@ testAsyncHelloTimeout = do alice <- getSMPAgentClient agentCfgV1 initAgentServers bob <- getSMPAgentClient agentCfg {database = testDB2, helloTimeout = 1} initAgentServers Right () <- runExceptT $ do - (_, cReq) <- createConnection alice True SCMInvitation + (_, cReq) <- createConnection alice True SCMInvitation Nothing disconnectAgentClient alice aliceId <- joinConnection bob True cReq "bob's connInfo" get bob ##> ("", aliceId, ERR $ CONN NOT_ACCEPTED) @@ -382,7 +382,7 @@ testDuplicateMessage t = do makeConnection :: AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId) makeConnection alice bob = do - (bobId, qInfo) <- createConnection alice True SCMInvitation + (bobId, qInfo) <- createConnection alice True SCMInvitation Nothing aliceId <- joinConnection bob True qInfo "bob's connInfo" ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" @@ -397,7 +397,7 @@ testInactiveClientDisconnected t = do withSmpServerConfigOn t cfg' testPort $ \_ -> do alice <- getSMPAgentClient agentCfg initAgentServers Right () <- runExceptT $ do - (connId, _cReq) <- createConnection alice True SCMInvitation + (connId, _cReq) <- createConnection alice True SCMInvitation Nothing get alice ##> ("", "", DOWN testSMPServer [connId]) pure () @@ -408,7 +408,7 @@ testActiveClientNotDisconnected t = do alice <- getSMPAgentClient agentCfg initAgentServers ts <- getSystemTime Right () <- runExceptT $ do - (connId, _cReq) <- createConnection alice True SCMInvitation + (connId, _cReq) <- createConnection alice True SCMInvitation Nothing keepSubscribing alice connId ts pure () where @@ -617,7 +617,7 @@ testAcceptContactAsync = do alice <- getSMPAgentClient agentCfg initAgentServers bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do - (_, qInfo) <- createConnection alice True SCMContact + (_, qInfo) <- createConnection alice True SCMContact Nothing aliceId <- joinConnection bob True qInfo "bob's connInfo" ("", _, REQ invId _ "bob's connInfo") <- get alice bobId <- acceptContactAsync alice "1" True invId "alice's connInfo" diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 8d7e358fc..74ca9bcc9 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -213,7 +213,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} = do bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right (bobId, aliceId, nonce, message) <- runExceptT $ do -- establish connection - (bobId, qInfo) <- createConnection alice True SCMInvitation + (bobId, qInfo) <- createConnection alice True SCMInvitation Nothing aliceId <- joinConnection bob True qInfo "bob's connInfo" ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" @@ -275,7 +275,7 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} = do _ <- registerTestToken bob "bcde" NMInstant apnsQ -- establish connection liftIO $ threadDelay 50000 - (bobId, qInfo) <- createConnection alice True SCMInvitation + (bobId, qInfo) <- createConnection alice True SCMInvitation Nothing liftIO $ threadDelay 1000000 aliceId <- joinConnection bob True qInfo "bob's connInfo" liftIO $ threadDelay 750000 @@ -327,7 +327,7 @@ testChangeNotificationsMode APNSMockServer {apnsQ} = do bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right () <- runExceptT $ do -- establish connection - (bobId, qInfo) <- createConnection alice True SCMInvitation + (bobId, qInfo) <- createConnection alice True SCMInvitation Nothing aliceId <- joinConnection bob True qInfo "bob's connInfo" ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo" @@ -392,7 +392,7 @@ testChangeToken APNSMockServer {apnsQ} = do bob <- getSMPAgentClient agentCfg {database = testDB2} initAgentServers Right (aliceId, bobId) <- runExceptT $ do -- establish connection - (bobId, qInfo) <- createConnection alice True SCMInvitation + (bobId, qInfo) <- createConnection alice True SCMInvitation Nothing aliceId <- joinConnection bob True qInfo "bob's connInfo" ("", _, CONF confId _ "bob's connInfo") <- get alice allowConnection alice bobId confId "alice's connInfo"