diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index f81add594..116c32b70 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -50,6 +50,7 @@ module Simplex.Messaging.Agent connRequestPQSupport, createConnectionAsync, setConnShortLinkAsync, + getConnShortLinkAsync, joinConnectionAsync, allowConnectionAsync, acceptContactAsync, @@ -198,8 +199,8 @@ import Simplex.Messaging.Client (NetworkRequestMode (..), SMPClientError, Server import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs) import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) -import qualified Simplex.Messaging.Crypto.ShortLink as SL import qualified Simplex.Messaging.Crypto.Ratchet as CR +import qualified Simplex.Messaging.Crypto.ShortLink as SL import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP) @@ -347,13 +348,19 @@ createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAs {-# INLINE createConnectionAsync #-} -- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response -setConnShortLinkAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE () -setConnShortLinkAsync c = withAgentEnv c .::. setConnShortLinkAsync' c +setConnShortLinkAsync :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AE () +setConnShortLinkAsync c = withAgentEnv c .:: setConnShortLinkAsync' c {-# INLINE setConnShortLinkAsync #-} --- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id -joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId -joinConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId enableNtfs +-- | Get and verify data from short link (LGET/LKEY command) asynchronously, synchronous response is new connection id +getConnShortLinkAsync :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AE ConnId +getConnShortLinkAsync c = withAgentEnv c .:. getConnShortLinkAsync' c +{-# INLINE getConnShortLinkAsync #-} + +-- | Join SMP agent connection (JOIN command) asynchronously, synchronous response is new connection id. +-- If connId is provided (for contact URIs), it updates the existing connection record created by getConnShortLinkAsync. +joinConnectionAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AE ConnId +joinConnectionAsync c userId aCorrId connId_ enableNtfs = withAgentEnv c .:: joinConnAsync c userId aCorrId connId_ enableNtfs {-# INLINE joinConnectionAsync #-} -- | Allow connection to continue after CONF notification (LET command), no synchronous response @@ -401,7 +408,7 @@ deleteConnShortLink c = withAgentEnv c .:. deleteConnShortLink' c {-# INLINE deleteConnShortLink #-} -- | Get and verify data from short link. For 1-time invitations it preserves the key to allow retries -getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (ConnectionRequestUri c, ConnLinkData c) +getConnShortLink :: AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c) getConnShortLink c = withAgentEnv c .:. getConnShortLink' c {-# INLINE getConnShortLink #-} @@ -784,8 +791,9 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do -- TODO [short links] TBC, but probably we will need async join for contact addresses as the contact will be created after user confirming the connection, -- and join should retry, the same as 1-time invitation joins. -joinConnAsync :: AgentClient -> UserId -> ACorrId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId -joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do +joinConnAsync :: AgentClient -> UserId -> ACorrId -> Maybe ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM ConnId +joinConnAsync c userId corrId connId_ enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup subMode = do + when (isJust connId_) $ throwE $ CMD PROHIBITED "joinConnAsync: connId not allowed for invitation URI" withInvLock c (strEncode cReqUri) "joinConnAsync" $ do lift (compatibleInvitationUri cReqUri) >>= \case Just (_, Compatible (CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do @@ -796,8 +804,22 @@ joinConnAsync c userId corrId enableNtfs cReqUri@CRInvitationUri {} cInfo pqSup enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo pure connId Nothing -> throwE $ AGENT A_VERSION -joinConnAsync _c _userId _corrId _enableNtfs (CRContactUri _) _subMode _cInfo _pqEncryption = - throwE $ CMD PROHIBITED "joinConnAsync" +joinConnAsync c userId corrId connId_ enableNtfs cReqUri@(CRContactUri _) cInfo pqSup subMode = do + lift (compatibleContactUri cReqUri) >>= \case + Just (_, Compatible connAgentVersion) -> do + let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion Nothing + connId <- case connId_ of + Just cId -> do + -- update connection record created by getConnShortLinkAsync + withStore' c $ \db -> updateNewConnJoin db cId connAgentVersion pqSupport enableNtfs + pure cId + Nothing -> do + g <- asks random + let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport} + withStore c $ \db -> createNewConn db g cData SCMInvitation + enqueueCommand c corrId connId Nothing $ AClientCommand $ JOIN enableNtfs (ACR sConnectionMode cReqUri) pqSupport subMode cInfo + pure connId + Nothing -> throwE $ AGENT A_VERSION allowConnectionAsync' :: AgentClient -> ACorrId -> ConnId -> ConfirmationId -> ConnInfo -> AM () allowConnectionAsync' c corrId connId confId ownConnInfo = @@ -816,7 +838,7 @@ acceptContactAsync' :: AgentClient -> UserId -> ACorrId -> Bool -> InvitationId acceptContactAsync' c userId corrId enableNtfs invId ownConnInfo pqSupport subMode = do Invitation {connReq} <- withStore c $ \db -> getInvitation db "acceptContactAsync'" invId withStore' c $ \db -> acceptInvitation db invId ownConnInfo - joinConnAsync c userId corrId enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do + joinConnAsync c userId corrId Nothing enableNtfs connReq ownConnInfo pqSupport subMode `catchAllErrors` \err -> do withStore' c (`unacceptInvitation` invId) throwE err @@ -876,8 +898,9 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey srv <- getSMPServer c userId when (checkNotices && connMode cMode == CMContact) $ checkClientNotices c srv connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption pqInitKeys) - (connId,) <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv - `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e + (connId,) + <$> newRcvConnSrv c nm userId connId enableNtfs cMode linkData_ clientData pqInitKeys subMode srv + `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e checkClientNotices :: AgentClient -> SMPServerWithAuth -> AM () checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAuth srv@(ProtocolServer {host}) _) = do @@ -892,17 +915,41 @@ checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAu when (maybe True (ts <) expires_) $ throwError NOTICE {server = safeDecodeUtf8 $ strEncode $ L.head host, preset = isNothing srvKey, expiresAt = roundedToUTCTime <$> expires_} -setConnShortLinkAsync' :: forall c. ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM () -setConnShortLinkAsync' c corrId connId cMode userLinkData clientData = +setConnShortLinkAsync' :: AgentClient -> ACorrId -> ConnId -> UserConnLinkData 'CMContact -> Maybe CRClientData -> AM () +setConnShortLinkAsync' c corrId connId userLinkData clientData = withConnLock c connId "setConnShortLinkAsync" $ do SomeConn _ conn <- withStore c (`getConn` connId) - srv <- case (conn, cMode, userLinkData) of - (ContactConnection _ RcvQueue {server, shortLink}, SCMContact, UserContactLinkData d) -> do - liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <> )) $ validateOwners shortLink d + srv <- case (conn, userLinkData) of + (ContactConnection _ RcvQueue {server, shortLink}, UserContactLinkData d) -> do + liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <>)) $ validateOwners shortLink d pure server - (RcvConnection _ RcvQueue {server}, SCMInvitation, UserInvLinkData {}) -> pure server _ -> throwE $ CMD PROHIBITED "setConnShortLinkAsync: invalid connection or mode" - enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET (AULD cMode userLinkData) clientData + enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET userLinkData clientData + +getConnShortLinkAsync' :: AgentClient -> UserId -> ACorrId -> ConnShortLink 'CMContact -> AM ConnId +getConnShortLinkAsync' c userId corrId shortLink@(CSLContact _ _ srv _) = do + g <- asks random + connId <- withStore c $ \db -> do + -- server is created so the command is processed in server queue, + -- not blocking other "no server" commands + void $ createServer db srv + prepareNewConn db g + enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LGET shortLink + pure connId + where + prepareNewConn db g = do + let cData = + ConnData + { userId, + connId = "", + connAgentVersion = currentSMPAgentVersion, + enableNtfs = False, + lastExternalSndId = 0, + deleted = False, + ratchetSyncState = RSOk, + pqSupport = PQSupportOff + } + createNewConn db g cData SCMInvitation setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c) setConnShortLink' c nm connId cMode userLinkData clientData = @@ -917,7 +964,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData = where prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData) prepareContactLinkData rq@RcvQueue {shortLink} ud@(UserContactLinkData d') = do - liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <> )) $ validateOwners shortLink d' + liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink d' g <- asks random AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config let cslContact = CSLContact SLSServer CCTContact (qServer rq) @@ -958,7 +1005,7 @@ deleteConnShortLink' c nm connId cMode = _ -> throwE $ CMD PROHIBITED "deleteConnShortLink: not contact address" -- TODO [short links] remove 1-time invitation data and link ID from the server after the message is sent. -getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnLinkData c) +getConnShortLink' :: forall c. AgentClient -> NetworkRequestMode -> UserId -> ConnShortLink c -> AM (FixedLinkData c, ConnLinkData c) getConnShortLink' c nm userId = \case CSLInvitation _ srv linkId linkKey -> do g <- asks random @@ -979,18 +1026,19 @@ getConnShortLink' c nm userId = \case ld <- getQueueLink c nm userId srv linkId decryptData srv linkKey k ld where - decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (ConnectionRequestUri c, ConnLinkData c) + decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, QueueLinkData) -> AM (FixedLinkData c, ConnLinkData c) decryptData srv linkKey k (sndId, d) = do - r@(cReq, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d - let (srv', sndId') = qAddress (connReqQueue cReq) - unless (srv `sameSrvHost` srv' && sndId == sndId') $ - throwE $ AGENT $ A_LINK "different address" - pure $ if srv' == srv then r else (updateConnReqServer srv cReq, clData) + r@(fd, clData) <- liftEither $ SL.decryptLinkData @c linkKey k d + let (srv', sndId') = qAddress (connReqQueue $ linkConnReq fd) + unless (srv `sameSrvHost` srv' && sndId == sndId') $ throwE $ AGENT $ A_LINK "different address" + pure $ if srv' == srv then r else (updateConnReqServer srv fd, clData) sameSrvHost ProtocolServer {host = h :| _} ProtocolServer {host = hs} = h `elem` hs - updateConnReqServer :: SMPServer -> ConnectionRequestUri c -> ConnectionRequestUri c - updateConnReqServer srv = \case - CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams - CRContactUri crData -> CRContactUri $ updateQueues crData + updateConnReqServer :: SMPServer -> FixedLinkData c -> FixedLinkData c + updateConnReqServer srv fd = + let connReq' = case linkConnReq fd of + CRInvitationUri crData e2eParams -> CRInvitationUri (updateQueues crData) e2eParams + CRContactUri crData -> CRContactUri $ updateQueues crData + in fd {linkConnReq = connReq'} where updateQueues crData@(ConnReqUriData {crSmpQueues = SMPQueueUri vr addr :| qs}) = crData {crSmpQueues = SMPQueueUri vr addr {smpServer = srv} :| qs} @@ -1073,7 +1121,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (CreatedConnLink c) connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of Just ShortLinkCreds {shortLinkId, shortLinkKey} - | qUri == qUri' -> pure $ case cReq of + | qUri == qUri' -> pure $ case cReq of CRContactUri _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey CRInvitationUri crData (CR.E2ERatchetParamsUri vr k1 k2 _) -> let cReq' = case pqInitKeys of @@ -1334,7 +1382,7 @@ databaseDiff passed known = let passedSet = S.fromList passed knownSet = S.fromList known missingIds = S.toList $ passedSet `S.difference` knownSet - extraIds = S.toList $ knownSet `S.difference` passedSet + extraIds = S.toList $ knownSet `S.difference` passedSet in DatabaseDiff {missingIds, extraIds} -- | Subscribe to receive connection messages (SUB command) in Reader monad @@ -1372,7 +1420,8 @@ subscribeConnections_ c conns = do notifyResultError rs pure rs where - partitionResultsConns :: (ConnId, Either StoreError SomeConnSub) -> + partitionResultsConns :: + (ConnId, Either StoreError SomeConnSub) -> (Map ConnId (Either AgentErrorType (Maybe ClientServiceId)), [(ConnId, SomeConnSub)]) -> (Map ConnId (Either AgentErrorType (Maybe ClientServiceId)), [(ConnId, SomeConnSub)]) partitionResultsConns (connId, conn_) (rs, cs) = case conn_ of @@ -1679,15 +1728,26 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do (CCLink cReq _, service) <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv notify $ INV (ACR cMode cReq) service - LSET auData@(AULD cMode userLinkData) clientData -> + LSET userLinkData clientData -> + withServer' . tryCommand $ do + link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData + notify $ LINK link userLinkData + LGET shortLink -> withServer' . tryCommand $ do - link <- setConnShortLink' c NRMBackground connId cMode userLinkData clientData - notify $ LINK (ACSL cMode link) auData + (fixedData, linkData) <- getConnShortLink' c NRMBackground userId shortLink + notify $ LDATA fixedData linkData JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do triedHosts <- newTVarIO S.empty tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do (sqSecured, service) <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv notify $ JOINED sqSecured service + -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously. + -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously. + JOIN enableNtfs (ACR _ cReq@(CRContactUri ConnReqUriData {crSmpQueues = q :| _})) pqEnc subMode connInfo -> noServer $ do + triedHosts <- newTVarIO S.empty + tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do + (sqSecured, service) <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo pqEnc subMode srv + notify $ JOINED sqSecured service LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK SWCH -> @@ -1697,7 +1757,6 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do switchDuplexConnection c NRMBackground conn replaced >>= notify . SWITCH QDRcv SPStarted _ -> throwE $ CMD PROHIBITED "SWCH: not duplex" DEL -> withServer' . tryCommand $ deleteConnection' c NRMBackground connId >> notify OK - _ -> notify $ ERR $ INTERNAL $ "unsupported async command " <> show (aCommandTag cmd) AInternalCommand cmd -> case cmd of ICAckDel rId srvMsgId msgId -> withServer $ \srv -> tryWithLock "ICAckDel" $ ack srv rId srvMsgId >> withStore' c (\db -> deleteMsg db connId msgId) ICAck rId srvMsgId -> withServer $ \srv -> tryWithLock "ICAck" $ ack srv rId srvMsgId @@ -1861,7 +1920,7 @@ enqueueMessageB c reqs = do storeSentMsg db cfg aMessageIds = \case Left e -> pure (aMessageIds, Left e) Right req@(csqs_, pqEnc_, msgFlags, mbr) -> case mbr of - VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of + VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body") Nothing -> do (mbId_, r) <- case csqs_ of @@ -1903,7 +1962,6 @@ enqueueMessageB c reqs = do handleInternal :: E.SomeException -> IO (Either AgentErrorType b) handleInternal = pure . Left . INTERNAL . show - encodeAgentMsgStr :: AMessage -> InternalSndId -> PrevSndMsgHash -> ByteString encodeAgentMsgStr aMessage internalSndId prevMsgHash = do let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash @@ -2324,7 +2382,8 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do forM_ cIds_ $ \cIds -> notify ("", "", AEvt SAEConn $ DEL_CONNS cIds) pure res where - partitionResultsConns :: (ConnId, Either StoreError SomeConn) -> + partitionResultsConns :: + (ConnId, Either StoreError SomeConn) -> (Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId]) -> (Map ConnId (Either AgentErrorType ()), [RcvQueue], [ConnId]) partitionResultsConns (connId, conn_) (rs, rqs, cIds) = case conn_ of @@ -2332,7 +2391,7 @@ prepareDeleteConnections_ getConnections c waitDelivery connIds = do Right (SomeConn _ conn) -> case connRcvQueues conn of [] -> (M.insert connId (Right ()) rs, rqs, cIds) rqs' -> (rs, rqs' ++ rqs, connId : cIds) - unsubNtfConnIds :: NonEmpty ConnId -> AM' () + unsubNtfConnIds :: NonEmpty ConnId -> AM' () unsubNtfConnIds connIds' = do ns <- asks ntfSupervisor atomically $ writeTBQueue (ntfSubQ ns) (NSCDeleteSub, connIds') diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index cf511482f..46d5ebaa9 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -20,8 +20,8 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} +{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} -- | -- Module : Simplex.Messaging.Agent.Protocol @@ -112,6 +112,7 @@ module Simplex.Messaging.Agent.Protocol CRClientData, ServiceScheme, FixedLinkData (..), + AConnLinkData (..), ConnLinkData (..), AUserConnLinkData (..), UserConnLinkData (..), @@ -255,10 +256,10 @@ import Simplex.Messaging.Protocol legacyStrEncodeServer, noAuthSrv, sameSrvAddr, + senderCanSecure, + shortLinksSMPClientVersion, sndAuthKeySMPClientVersion, srvHostnamesSMPClientVersion, - shortLinksSMPClientVersion, - senderCanSecure, pattern ProtoServerWithAuth, pattern SMPServer, ) @@ -386,7 +387,8 @@ type SndQueueSecured = Bool -- | Parameterized type for SMP agent events data AEvent (e :: AEntity) where INV :: AConnectionRequestUri -> Maybe ClientServiceId -> AEvent AEConn - LINK :: AConnShortLink -> AUserConnLinkData -> AEvent AEConn + LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn + LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> AEvent AEConn CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender INFO :: PQSupport -> ConnInfo -> AEvent AEConn @@ -440,7 +442,8 @@ deriving instance Show AEvtTag data ACommand = NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV - | LSET AUserConnLinkData (Maybe CRClientData) -- response LINK + | LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK + | LGET (ConnShortLink 'CMContact) -- response LDATA | JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo | LET ConfirmationId ConnInfo -- ConnInfo is from client | ACK AgentMsgId (Maybe MsgReceiptInfo) @@ -451,6 +454,7 @@ data ACommand data ACommandTag = NEW_ | LSET_ + | LGET_ | JOIN_ | LET_ | ACK_ @@ -461,6 +465,7 @@ data ACommandTag data AEventTag (e :: AEntity) where INV_ :: AEventTag AEConn LINK_ :: AEventTag AEConn + LDATA_ :: AEventTag AEConn CONF_ :: AEventTag AEConn REQ_ :: AEventTag AEConn INFO_ :: AEventTag AEConn @@ -508,6 +513,7 @@ aCommandTag :: ACommand -> ACommandTag aCommandTag = \case NEW {} -> NEW_ LSET {} -> LSET_ + LGET _ -> LGET_ JOIN {} -> JOIN_ LET {} -> LET_ ACK {} -> ACK_ @@ -518,6 +524,7 @@ aEventTag :: AEvent e -> AEventTag e aEventTag = \case INV {} -> INV_ LINK {} -> LINK_ + LDATA {} -> LDATA_ CONF {} -> CONF_ REQ {} -> REQ_ INFO {} -> INFO_ @@ -1706,14 +1713,19 @@ type CRClientData = Text data FixedLinkData c = FixedLinkData { agentVRange :: VersionRangeSMPA, rootKey :: C.PublicKeyEd25519, - connReq :: ConnectionRequestUri c, + linkConnReq :: ConnectionRequestUri c, linkEntityId :: Maybe ByteString } + deriving (Eq, Show) data ConnLinkData c where InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation ContactLinkData :: VersionRangeSMPA -> UserContactData -> ConnLinkData 'CMContact +deriving instance Eq (ConnLinkData c) + +deriving instance Show (ConnLinkData c) + data UserContactData = UserContactData { -- direct connection via connReq in fixed data is allowed. direct :: Bool, @@ -1740,13 +1752,6 @@ deriving instance Show (UserConnLinkData m) data AUserConnLinkData = forall m. ConnectionModeI m => AULD (SConnectionMode m) (UserConnLinkData m) -instance Eq AUserConnLinkData where - AULD m d == AULD m' d' = case testEquality m m' of - Just Refl -> d == d' - Nothing -> False - -deriving instance Show AUserConnLinkData - linkUserData :: ConnLinkData c -> UserLinkData linkUserData = \case InvitationLinkData _ d -> d @@ -1787,10 +1792,10 @@ validateOwners shortLink_ UserContactData {owners} = case shortLink_ of where hasOwner = isNothing linkRootSigKey || any ((k ==) . ownerKey) owners k = C.publicKey linkPrivSigKey - + validateLinkOwners :: C.PublicKeyEd25519 -> [OwnerAuth] -> Either String () validateLinkOwners rootKey = go [] - where + where go _ [] = Right () go prev (o : os) = validOwner o >> go (o : prev) os where @@ -1805,12 +1810,12 @@ validateLinkOwners rootKey = go [] signedBy k' = C.verify' k' sig (oId <> C.encodePubKey k) instance ConnectionModeI c => Encoding (FixedLinkData c) where - smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId} = - smpEncode (agentVRange, rootKey, connReq) <> maybe "" smpEncode linkEntityId + smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} = + smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId smpP = do - (agentVRange, rootKey, connReq) <- smpP + (agentVRange, rootKey, linkConnReq) <- smpP linkEntityId <- (smpP <|> pure Nothing) <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding - pure FixedLinkData {agentVRange, rootKey, connReq, linkEntityId} + pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} instance ConnectionModeI c => Encoding (ConnLinkData c) where smpEncode = \case @@ -1849,7 +1854,7 @@ instance Encoding AUserConnLinkData where CMContact -> AULD SCMContact . UserContactLinkData <$> smpP -instance StrEncoding AUserConnLinkData where +instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where strEncode = smpEncode {-# INLINE strEncode #-} strP = smpP @@ -2065,6 +2070,7 @@ instance StrEncoding ACommandTag where A.takeTill (== ' ') >>= \case "NEW" -> pure NEW_ "LSET" -> pure LSET_ + "LGET" -> pure LGET_ "JOIN" -> pure JOIN_ "LET" -> pure LET_ "ACK" -> pure ACK_ @@ -2074,6 +2080,7 @@ instance StrEncoding ACommandTag where strEncode = \case NEW_ -> "NEW" LSET_ -> "LSET" + LGET_ -> "LGET" JOIN_ -> "JOIN" LET_ -> "LET" ACK_ -> "ACK" @@ -2086,6 +2093,7 @@ commandP binaryP = >>= \case NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe)) LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP)) + LGET_ -> s (LGET <$> strP) JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP) LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP) ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP)) @@ -2104,6 +2112,7 @@ serializeCommand :: ACommand -> ByteString serializeCommand = \case NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode) LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_ + LGET sl -> s (LGET_, sl) JOIN ntfs cReq pqSup subMode cInfo -> s (JOIN_, ntfs, cReq, pqSup, subMode, Str $ serializeBinary cInfo) LET confId cInfo -> B.unwords [s LET_, confId, serializeBinary cInfo] ACK mId rcptInfo_ -> s (ACK_, mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_ diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index ce6e71a5e..711f6f05b 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -36,6 +36,7 @@ module Simplex.Messaging.Agent.Store.AgentStore checkUser, -- * Queues and connections + createServer, createNewConn, updateNewConnRcv, updateNewConnSnd, @@ -57,6 +58,7 @@ module Simplex.Messaging.Agent.Store.AgentStore setConnUserId, setConnAgentVersion, setConnPQSupport, + updateNewConnJoin, getDeletedConnIds, getDeletedWaitingDeliveryConnIds, setConnRatchetSync, @@ -432,7 +434,7 @@ createSndConn db gVar cData q@SndQueue {server} = -- check confirmed snd queue doesn't already exist, to prevent it being deleted by REPLACE in insertSndQueue_ ifM (liftIO $ checkConfirmedSndQueueExists_ db q) (pure $ Left SESndQueueExists) $ createConn_ db gVar cData $ \connId -> do - serverKeyHash_ <- createServer_ db server + serverKeyHash_ <- createServer db server createConnRecord db connId cData SCMInvitation insertSndQueue_ db connId q serverKeyHash_ @@ -519,7 +521,7 @@ addConnRcvQueue db connId rq subMode = addConnRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue addConnRcvQueue_ db connId rq@RcvQueue {server} subMode = do - serverKeyHash_ <- createServer_ db server + serverKeyHash_ <- createServer db server insertRcvQueue_ db connId rq subMode serverKeyHash_ addConnSndQueue :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue) @@ -531,7 +533,7 @@ addConnSndQueue db connId sq = addConnSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> IO SndQueue addConnSndQueue_ db connId sq@SndQueue {server} = do - serverKeyHash_ <- createServer_ db server + serverKeyHash_ <- createServer db server insertSndQueue_ db connId sq serverKeyHash_ setRcvQueueStatus :: DB.Connection -> RcvQueue -> QueueStatus -> IO () @@ -829,7 +831,7 @@ deleteInvShortLink db srv lnkId = createInvShortLink :: DB.Connection -> InvShortLink -> IO () createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do - serverKeyHash_ <- createServer_ db server + serverKeyHash_ <- createServer db server DB.execute db [sql| @@ -2024,8 +2026,8 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f, -- * Server helper -- | Creates a new server, if it doesn't exist, and returns the passed key hash if it is different from stored. -createServer_ :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash) -createServer_ db newSrv@ProtocolServer {host, port, keyHash} = do +createServer :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash) +createServer db newSrv@ProtocolServer {host, port, keyHash} = do r <- insertNewServer_ if null r then getServerKeyHash_ db newSrv >>= either E.throwIO pure @@ -2406,6 +2408,10 @@ setConnPQSupport :: DB.Connection -> ConnId -> PQSupport -> IO () setConnPQSupport db connId pqSupport = DB.execute db "UPDATE connections SET pq_support = ? WHERE conn_id = ?" (pqSupport, connId) +updateNewConnJoin :: DB.Connection -> ConnId -> VersionSMPA -> PQSupport -> Bool -> IO () +updateNewConnJoin db connId aVersion pqSupport enableNtfs = + DB.execute db "UPDATE connections SET smp_agent_version = ?, pq_support = ?, enable_ntfs = ? WHERE conn_id = ?" (aVersion, pqSupport, BI enableNtfs, connId) + getDeletedConnIds :: DB.Connection -> IO [ConnId] getDeletedConnIds db = map fromOnly <$> DB.query db "SELECT conn_id FROM connections WHERE deleted = ?" (Only (BI True)) diff --git a/src/Simplex/Messaging/Crypto/ShortLink.hs b/src/Simplex/Messaging/Crypto/ShortLink.hs index 962c1aecc..ae9049889 100644 --- a/src/Simplex/Messaging/Crypto/ShortLink.hs +++ b/src/Simplex/Messaging/Crypto/ShortLink.hs @@ -33,7 +33,7 @@ import Simplex.Messaging.Agent.Client (cryptoError) import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding -import Simplex.Messaging.Protocol (EntityId (..), LinkId, EncDataBytes (..), QueueLinkData) +import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), LinkId, QueueLinkData) import Simplex.Messaging.Util (liftEitherWith) fixedDataPaddedLength :: Int @@ -51,8 +51,8 @@ invShortLinkKdf :: LinkKey -> C.SbKey invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32 encodeSignLinkData :: ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserConnLinkData c -> (LinkKey, (ByteString, ByteString)) -encodeSignLinkData (rootKey, pk) agentVRange connReq userData = - let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId = Nothing} +encodeSignLinkData (rootKey, pk) agentVRange linkConnReq userData = + let fd = smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId = Nothing} md = smpEncode $ connLinkData agentVRange userData in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md)) @@ -82,11 +82,11 @@ encryptData g k len s = do ct <- liftEitherWith cryptoError $ C.sbEncrypt k nonce s len pure $ EncDataBytes $ smpEncode nonce <> ct -decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnLinkData c) +decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (FixedLinkData c, ConnLinkData c) decryptLinkData linkKey k (encFD, encMD) = do (sig1, fd) <- decrypt encFD (sig2, md) <- decrypt encMD - FixedLinkData {rootKey, connReq} <- decode fd + fd'@FixedLinkData {rootKey} <- decode fd md' <- decode @(ConnLinkData c) md let signedBy k' = C.verify' k' sig2 md if @@ -97,7 +97,7 @@ decryptLinkData linkKey k (encFD, encMD) = do ContactLinkData _ UserContactData {owners} -> do first (AGENT . A_LINK) $ validateLinkOwners rootKey owners unless (signedBy rootKey || any (signedBy . ownerKey) owners) $ linkErr "user data signature" - Right (connReq, md') + Right (fd', md') where decrypt (EncDataBytes d) = do (nonce, Tail ct) <- decode d diff --git a/tests/AgentTests/EqInstances.hs b/tests/AgentTests/EqInstances.hs index b33980f6a..b01174343 100644 --- a/tests/AgentTests/EqInstances.hs +++ b/tests/AgentTests/EqInstances.hs @@ -5,7 +5,7 @@ module AgentTests.EqInstances where import Data.Type.Equality -import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), ShortLinkCreds (..)) +import Simplex.Messaging.Agent.Protocol (ShortLinkCreds (..)) import Simplex.Messaging.Agent.Store import Simplex.Messaging.Client (ProxiedRelay (..)) @@ -28,10 +28,6 @@ deriving instance Eq ClientNtfCreds deriving instance Eq ShortLinkCreds -deriving instance Show (ConnLinkData c) - -deriving instance Eq (ConnLinkData c) - deriving instance Show ProxiedRelay deriving instance Eq ProxiedRelay diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 09c873d31..be873befb 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -313,7 +313,7 @@ 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 (ConnectionRequestUri c, ConnLinkData c) +getConnShortLink :: AgentClient -> UserId -> ConnShortLink c -> AE (FixedLinkData c, ConnLinkData c) getConnShortLink c = A.getConnShortLink c NRMInteractive setConnShortLink :: AgentClient -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE (ConnShortLink c) @@ -458,6 +458,8 @@ functionalAPITests ps = do testBasicMatrix2 ps testAsyncCommands it "should add short link data using async agent command" $ testSetConnShortLinkAsync ps + it "should get short link data and join connection using async agent commands" $ + testGetConnShortLinkAsync ps it "should restore and complete async commands on restart" $ testAsyncCommandsRestore ps describe "accept connection using async command" $ @@ -1369,12 +1371,12 @@ testInvitationShortLink viaProxy a b = let userData = UserLinkData "some user data" newLinkData = UserInvLinkData userData (bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe - (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, connData') <- 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 - (connReq2, connData2) <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq2}, connData2) <- runRight $ getConnShortLink b 1 shortLink connReq2 `shouldBe` connReq linkUserData connData2 `shouldBe` userData -- another user cannot get the same invitation link @@ -1412,12 +1414,12 @@ testInvitationShortLinkAsync viaProxy a b = do let userData = UserLinkData "some user data" newLinkData = UserInvLinkData userData (bId, (CCLink connReq (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMSubscribe - (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq linkUserData connData' `shouldBe` userData runRight $ do - aId <- A.joinConnectionAsync b 1 "123" True connReq "bob's connInfo" PQSupportOn SMSubscribe + aId <- A.joinConnectionAsync b 1 "123" Nothing True connReq "bob's connInfo" PQSupportOn SMSubscribe get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False ("", _, CONF confId _ "bob's connInfo") <- get a allowConnection a bId confId "alice's connInfo" @@ -1440,16 +1442,16 @@ testContactShortLink viaProxy a b = newLinkData = UserContactLinkData userCtData (contactId, (CCLink connReq0 (Just shortLink), Nothing)) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing CR.IKPQOn SMSubscribe Right connReq <- pure $ smpDecode (smpEncode connReq0) - (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 userCtData' `shouldBe` userCtData -- same user can get contact link again - (connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink connReq2 `shouldBe` connReq userCtData2 `shouldBe` userCtData -- another user can get the same contact link - (connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink + (FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink connReq3 `shouldBe` connReq userCtData3 `shouldBe` userCtData runRight $ do @@ -1471,7 +1473,7 @@ testContactShortLink viaProxy a b = userLinkData' = UserContactLinkData updatedCtData shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink - (connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink + (FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink connReq4 `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData -- one more time @@ -1491,16 +1493,16 @@ testAddContactShortLink viaProxy a b = userCtData = UserContactData {direct = True, owners = [], relays = [], userData} newLinkData = UserContactLinkData userCtData shortLink <- runRight $ setConnShortLink a contactId SCMContact newLinkData Nothing - (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 userCtData' `shouldBe` userCtData -- same user can get contact link again - (connReq2, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq2}, ContactLinkData _ userCtData2) <- runRight $ getConnShortLink b 1 shortLink connReq2 `shouldBe` connReq userCtData2 `shouldBe` userCtData -- another user can get the same contact link - (connReq3, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink + (FixedLinkData {linkConnReq = connReq3}, ContactLinkData _ userCtData3) <- runRight $ getConnShortLink c 1 shortLink connReq3 `shouldBe` connReq userCtData3 `shouldBe` userCtData runRight $ do @@ -1522,7 +1524,7 @@ testAddContactShortLink viaProxy a b = userLinkData' = UserContactLinkData updatedCtData shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink - (connReq4, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink + (FixedLinkData {linkConnReq = connReq4}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink c 1 shortLink connReq4 `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData @@ -1534,7 +1536,7 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do runRight $ A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKUsePQ SMOnlyCreate withSmpServer ps $ do runRight_ $ subscribeConnection a bId - (connReq', connData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq'}, connData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq linkUserData connData' `shouldBe` userData @@ -1623,7 +1625,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do userCtData = UserContactData {direct = True, owners = [], relays = [], userData} userLinkData = UserContactLinkData userCtData shortLink <- runRight $ setConnShortLink a contactId SCMContact userLinkData Nothing - (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 userCtData' `shouldBe` userCtData @@ -1634,7 +1636,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do shortLink' <- runRight $ setConnShortLink a contactId SCMContact userLinkData' Nothing shortLink' `shouldBe` shortLink -- check updated - (connReq'', ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink + (FixedLinkData {linkConnReq = connReq''}, ContactLinkData _ updatedCtData') <- runRight $ getConnShortLink b 1 shortLink connReq'' `shouldBe` connReq updatedCtData' `shouldBe` updatedCtData @@ -2617,7 +2619,7 @@ testAsyncCommands sqSecured alice bob baseId = bobId <- createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe ("1", bobId', INV (ACR _ qInfo)) <- get alice liftIO $ bobId' `shouldBe` bobId - aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe + aliceId <- joinConnectionAsync bob 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe ("2", aliceId', JOINED sqSecured') <- get bob liftIO $ do aliceId' `shouldBe` aliceId @@ -2675,8 +2677,8 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> -- update link data async let updatedData = UserLinkData "updated user data" updatedCtData = UserContactData {direct = False, owners = [], relays = [], userData = updatedData} - setConnShortLinkAsync alice "1" cId SCMContact (UserContactLinkData updatedCtData) Nothing - ("1", cId', LINK (ACSL SCMContact shortLink') (AULD SCMContact (UserContactLinkData updatedCtData'))) <- get alice + 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 @@ -2694,6 +2696,34 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob -> get alice ##> ("", bobId, CON) get bob ##> ("", aliceId, CON) +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} + newLinkData = UserContactLinkData userCtData + (_, (CCLink qInfo (Just shortLink), _)) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just newLinkData) Nothing IKPQOn SMSubscribe + -- get link data async - creates new connection for bob + newId <- getConnShortLinkAsync bob 1 "1" shortLink + ("1", newId', LDATA FixedLinkData {linkConnReq = qInfo'} (ContactLinkData _ userCtData')) <- get bob + liftIO $ newId' `shouldBe` newId + liftIO $ qInfo' `shouldBe` qInfo + liftIO $ userCtData' `shouldBe` userCtData + -- join connection async using connId from getConnShortLinkAsync + aliceId <- joinConnectionAsync bob 1 "2" (Just newId) True qInfo' "bob's connInfo" PQSupportOn SMSubscribe + liftIO $ aliceId `shouldBe` newId + ("2", aliceId', JOINED False) <- get bob + liftIO $ aliceId' `shouldBe` aliceId + -- complete connection + ("", _, REQ invId _ "bob's connInfo") <- get alice + bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn + (_, Nothing) <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe + ("", _, CONF confId _ "alice's connInfo") <- get bob + allowConnection bob aliceId confId "bob's connInfo" + get alice ##> ("", bobId, INFO "bob's connInfo") + get alice ##> ("", bobId, CON) + get bob ##> ("", aliceId, CON) + testAsyncCommandsRestore :: (ASrvTransport, AStoreType) -> IO () testAsyncCommandsRestore ps = do alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB @@ -2987,7 +3017,7 @@ testJoinConnectionAsyncReplyErrorV8 ps@(t, ASType qsType _) = do bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId - aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe + aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) @@ -3032,7 +3062,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do bId <- createConnectionAsync a 1 "1" True SCMInvitation IKPQOn SMSubscribe ("1", bId', INV (ACR _ qInfo)) <- get a liftIO $ bId' `shouldBe` bId - aId <- joinConnectionAsync b 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe + aId <- joinConnectionAsync b 1 "2" Nothing True qInfo "bob's connInfo" PQSupportOn SMSubscribe liftIO $ threadDelay 500000 ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId pure (aId, bId) diff --git a/tests/AgentTests/ShortLinkTests.hs b/tests/AgentTests/ShortLinkTests.hs index ab6062c30..97472bec1 100644 --- a/tests/AgentTests/ShortLinkTests.hs +++ b/tests/AgentTests/ShortLinkTests.hs @@ -12,12 +12,12 @@ import AgentTests.EqInstances () import Control.Concurrent.STM import Control.Monad.Except import Crypto.Random (ChaChaDRG) -import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Base64.URL as B64 -import Simplex.Messaging.Encoding.String +import qualified Data.ByteString.Char8 as B import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Crypto as C import qualified Simplex.Messaging.Crypto.ShortLink as SL +import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (EncFixedDataBytes) import Test.Hspec hiding (fit, it) import Util @@ -48,7 +48,7 @@ testInvShortLink = do k = SL.invShortLinkKdf linkKey Right srvData <- runExceptT $ SL.encryptLinkData g k linkData -- decrypt - Right (connReq, connData') <- pure $ SL.decryptLinkData linkKey k srvData + Right (FixedLinkData {linkConnReq = connReq}, connData') <- pure $ SL.decryptLinkData linkKey k srvData connReq `shouldBe` invConnRequest linkUserData connData' `shouldBe` userData @@ -86,7 +86,7 @@ testContactShortLink = do (_linkId, k) = SL.contactShortLinkKdf linkKey Right srvData <- runExceptT $ SL.encryptLinkData g k linkData -- decrypt - Right (connReq, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData + Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData') <- pure $ SL.decryptLinkData @'CMContact linkKey k srvData connReq `shouldBe` contactConnRequest userCtData' `shouldBe` userCtData @@ -108,7 +108,7 @@ testUpdateContactShortLink = do signed = SL.encodeSignUserData SCMContact (snd sigKeys) supportedSMPAgentVRange userLinkData' Right ud' <- runExceptT $ SL.encryptUserData g k signed -- decrypt - Right (connReq, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud') + Right (FixedLinkData {linkConnReq = connReq}, ContactLinkData _ userCtData'') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud') connReq `shouldBe` contactConnRequest userCtData'' `shouldBe` userCtData' @@ -148,7 +148,7 @@ testContactShortLinkBadSignature = do -- decryption fails SL.decryptLinkData @'CMContact linkKey k (fd, ud') `shouldBe` Left (AGENT (A_LINK "user data signature")) - + testContactShortLinkOwner :: IO () testContactShortLinkOwner = do -- encrypt @@ -183,7 +183,7 @@ testEncDec :: TVar ChaChaDRG -> C.PrivateKeyEd25519 -> (EncFixedDataBytes, LinkK 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 (connReq', ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud) + Right (FixedLinkData {linkConnReq = connReq'}, ContactLinkData _ ctData') <- pure $ SL.decryptLinkData @'CMContact linkKey k (fd, ud) connReq' `shouldBe` contactConnRequest ctData' `shouldBe` ctData