agent: join connection when 1-time invitation short link is already secured (#1496)

* agent: join connection when 1-time invitation short link is already secured * do not pass short link to join * delete short link record after connection
2026-05-15 03:05:08 +00:00 · 2025-03-29 09:42:56 +00:00
parent 1dd677eec2
commit c1a6647f19
13 changed files with 180 additions and 81 deletions
@@ -178,7 +178,7 @@ import Simplex.Messaging.Agent.Store.Common (DBStore)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.Interface (closeDBStore, execSQL, getCurrentMigrations)
 import Simplex.Messaging.Agent.Store.Shared (UpMigration (..), upMigration)
-import Simplex.Messaging.Client (SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse)
+import Simplex.Messaging.Client (SMPClientError, ServerTransmission (..), ServerTransmissionBatch, nonBlockingWriteTBQueue, temporaryClientError, unexpectedResponse)
 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)
@@ -189,7 +189,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP)
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parse)
-import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC)
+import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolType (..), ProtocolTypeI (..), SMPMsgMeta, SParty (..), SProtocolType (..), SndPublicAuthKey, SubscriptionMode (..), UserProtocol, VersionSMPC)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
@@ -705,6 +705,8 @@ newConnNoQueues c userId enableNtfs cMode pqSupport = do
  let cData = ConnData {userId, connId = "", connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
  withStore c $ \db -> createNewConn db g cData cMode

+-- 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
  withInvLock c (strEncode cReqUri) "joinConnAsync" $ do
@@ -805,6 +807,7 @@ newConn c userId enableNtfs cMode userData_ clientData pqInitKeys subMode = do
 setConnShortLink' :: AgentClient -> ConnId -> ConnInfo -> AM (ConnShortLink 'CMContact)
 setConnShortLink' = undefined

+-- TODO [short links] remove 1-time invitation data and link ID from the server after the message is sent.
 getConnShortLink' :: forall c. AgentClient -> UserId -> ConnShortLink c -> AM (ConnectionRequestUri c, ConnInfo)
 getConnShortLink' c userId = \case
  CSLInvitation srv linkId linkKey -> do
@@ -814,23 +817,24 @@ getConnShortLink' c userId = \case
        Just sl@InvShortLink {linkKey = lk} | linkKey == lk -> pure sl
        _ -> do
          (sndPublicKey, sndPrivateKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-          let sl = InvShortLink {server = srv, linkId, linkKey, sndPrivateKey, sndPublicKey}
+          let sl = InvShortLink {server = srv, linkId, linkKey, sndPrivateKey, sndPublicKey, sndId = Nothing}
          createInvShortLink db sl
          pure sl
    let k = SL.invShortLinkKdf linkKey
-    secureGetQueueLink c userId invLink >>= decryptData srv linkKey k
+    ld@(sndId, _) <- secureGetQueueLink c userId invLink
+    withStore' c $ \db -> setInvShortLinkSndId db invLink sndId
+    decryptData srv linkKey k ld
  CSLContact srv _ linkKey -> do
    let (linkId, k) = SL.contactShortLinkKdf linkKey
-    getQueueLink c userId srv linkId >>= decryptData srv linkKey k
+    ld <- getQueueLink c userId srv linkId
+    decryptData srv linkKey k ld
  where
    decryptData :: ConnectionModeI c => SMPServer -> LinkKey -> C.SbKey -> (SMP.SenderId, SMP.QueueLinkData) -> AM (ConnectionRequestUri c, ConnInfo)
    decryptData srv linkKey k (sndId, d) = do
-      r <- liftEither $ SL.decryptLinkData @c linkKey k d
-      checkSameQueue $ case fst r of CRInvitationUri crd _ -> crd; CRContactUri crd -> crd
+      r@(cReq, _) <- liftEither $ SL.decryptLinkData @c linkKey k d
+      unless ((srv, sndId) `sameQAddress` qAddress (connReqQueue cReq)) $
+        throwE $ AGENT $ A_LINK "different address"
      pure r
-      where
-        checkSameQueue ConnReqUriData {crSmpQueues = SMPQueueUri {queueAddress = SMPQueueAddress srv' sndId' _ _} :| _} =
-          unless (srv == srv' && sndId == sndId') $ throwE $ AGENT $ A_LINK "different address"

 delInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM ()
 delInvShortLink' = undefined
@@ -952,52 +956,54 @@ newConnToAccept c connId enableNtfs invId pqSup = do
      newConnToJoin c userId connId enableNtfs connReq pqSup
    _ -> throwE $ CMD PROHIBITED "newConnToAccept"

-- TODO [short link] joining queue that was already secured with LKEY
+-- Short link MUST be passed again to joinConnection so that the same sender key is used.
+-- The alternative design would be to create connection ID and SndQueue when short link is read.
 joinConn :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured
 joinConn c userId connId enableNtfs cReq cInfo pqSupport subMode = do
-  srv <- getNextSMPServer c userId [qServer cReqQueue]
+  srv <- getNextSMPServer c userId [qServer $ connReqQueue cReq]
  joinConnSrv c userId connId enableNtfs cReq cInfo pqSupport subMode srv
-  where
-    cReqQueue :: SMPQueueUri
-    cReqQueue = case cReq of
-      CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q
-      CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q

-startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448)
+connReqQueue :: ConnectionRequestUri c -> SMPQueueUri
+connReqQueue = \case
+  CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _ -> q
+  CRContactUri ConnReqUriData {crSmpQueues = q :| _} -> q
+
+startJoinInvitation :: AgentClient -> UserId -> ConnId -> Maybe SndQueue -> Bool -> ConnectionRequestUri 'CMInvitation -> PQSupport -> AM (ConnData, SndQueue, CR.SndE2ERatchetParams 'C.X448, Bool)
 startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSup =
  lift (compatibleInvitationUri cReqUri) >>= \case
    Just (qInfo, Compatible e2eRcvParams@(CR.E2ERatchetParams v _ _ _), Compatible connAgentVersion) -> do
      -- this case avoids re-generating queue keys and subsequent failure of SKEY that timed out
      -- e2ePubKey is always present, it's Maybe historically
      let pqSupport = pqSup `CR.pqSupportAnd` versionPQSupport_ connAgentVersion (Just v)
-      (sq', e2eSndParams) <- case sq_ of
-        Just sq@SndQueue {e2ePubKey = Just _k} -> do
-          e2eSndParams <-
-            withStore' c (\db -> getSndRatchet db connId v) >>= \case
-              Right r -> pure $ snd r
-              Left e -> do
-                atomically $ writeTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e))
-                createRatchet_ pqSupport e2eRcvParams
-          pure (sq, e2eSndParams)
-        _ -> do
-          q <- lift $ fst <$> newSndQueue userId "" qInfo
-          e2eSndParams <- createRatchet_ pqSupport e2eRcvParams
-          withStore c $ \db -> runExceptT $ do
-            sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
-            pure (sq', e2eSndParams)
+      g <- asks random
+      maxSupported <- asks $ maxVersion . e2eEncryptVRange . config
      let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport}
-      pure (cData, sq', e2eSndParams)
+      case sq_ of
+        Just sq@SndQueue {e2ePubKey = Just _k} -> do
+          e2eSndParams <- withStore c $ \db ->
+            getSndRatchet db connId v >>= \case
+              Right r -> pure $ Right $ snd r
+              Left e -> do
+                nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "no snd ratchet " <> show e))
+                runExceptT $ createRatchet_ db g maxSupported pqSupport e2eRcvParams
+          pure (cData, sq, e2eSndParams, False)
+        _ -> do
+          let Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {smpServer, senderId}} = qInfo
+          sndKeys_ <- withStore' c $ \db -> getInvShortLinkKeys db smpServer senderId
+          (q, _) <- lift $ newSndQueue userId "" qInfo sndKeys_
+          withStore c $ \db -> runExceptT $ do
+            e2eSndParams <- createRatchet_ db g maxSupported pqSupport e2eRcvParams
+            sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
+            pure (cData, sq', e2eSndParams, isJust sndKeys_)
    Nothing -> throwE $ AGENT A_VERSION
  where
-    createRatchet_ pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do
-      g <- asks random
+    createRatchet_ db g maxSupported pqSupport e2eRcvParams@(CR.E2ERatchetParams v _ rcDHRr kem_) = do
      (pk1, pk2, pKem, e2eSndParams) <- liftIO $ CR.generateSndE2EParams g v (CR.replyKEM_ v kem_ pqSupport)
      (_, rcDHRs) <- atomically $ C.generateKeyPair g
-      rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams
-      maxSupported <- asks $ maxVersion . e2eEncryptVRange . config
+      rcParams <- liftEitherWith (SEAgentError . cryptoError) $ CR.pqX3dhSnd pk1 pk2 pKem e2eRcvParams
      let rcVs = CR.RatchetVersions {current = v, maxSupported}
          rc = CR.initSndRatchet rcVs rcDHRr rcDHRs rcParams
-      withStore' c $ \db -> createSndRatchet db connId rc e2eSndParams
+      liftIO $ createSndRatchet db connId rc e2eSndParams
      pure e2eSndParams

 connRequestPQSupport :: AgentClient -> PQSupport -> ConnectionRequestUri c -> IO (Maybe (VersionSMPA, PQSupport))
@@ -1042,8 +1048,9 @@ joinConnSrv c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSup subMod
  where
    doJoin :: Maybe SndQueue -> AM SndQueueSecured
    doJoin sq_ = do
-      (cData, sq, e2eSndParams) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup
+      (cData, sq, e2eSndParams, hasLink) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSup
      secureConfirmQueue c cData sq srv cInfo (Just e2eSndParams) subMode
+        >>= (when hasLink (delInvSL c connId srv sq) $>)
 joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMode srv =
  lift (compatibleContactUri cReqUri) >>= \case
    Just (qInfo, vrsn) -> do
@@ -1052,6 +1059,11 @@ joinConnSrv c userId connId enableNtfs cReqUri@CRContactUri {} cInfo pqSup subMo
      pure False
    Nothing -> throwE $ AGENT A_VERSION

+delInvSL :: AgentClient -> ConnId -> SMPServerWithAuth -> SndQueue -> AM ()
+delInvSL c connId srv sq = 
+  withStore' c (\db -> deleteInvShortLink db (protoServer srv) (queueId sq)) `catchE` \e ->
+    liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e))
+
 joinConnSrvAsync :: AgentClient -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
 joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSupport subMode srv = do
  SomeConn cType conn <- withStore c (`getConn` connId)
@@ -1062,8 +1074,9 @@ joinConnSrvAsync c userId connId enableNtfs inv@CRInvitationUri {} cInfo pqSuppo
  where
    doJoin :: Maybe SndQueue -> AM SndQueueSecured
    doJoin sq_ = do
-      (cData, sq, e2eSndParams) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSupport
+      (cData, sq, e2eSndParams, hasLink) <- startJoinInvitation c userId connId sq_ enableNtfs inv pqSupport
      secureConfirmQueueAsync c cData sq srv cInfo (Just e2eSndParams) subMode
+        >>= (when hasLink (delInvSL c connId srv sq) $>)
 joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode _pqSupport _srv = do
  throwE $ CMD PROHIBITED "joinConnSrvAsync"

@@ -2861,7 +2874,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
                    let (delSqs, keepSqs) = L.partition ((Just dbQueueId ==) . dbReplaceQId) sqs
                    case L.nonEmpty keepSqs of
                      Just sqs' -> do
-                        (sq_@SndQueue {sndPublicKey}, dhPublicKey) <- lift $ newSndQueue userId connId qInfo
+                        (sq_@SndQueue {sndPublicKey}, dhPublicKey) <- lift $ newSndQueue userId connId qInfo Nothing
                        sq2 <- withStore c $ \db -> do
                          liftIO $ mapM_ (deleteConnSndQueue db connId) delSqs
                          addConnSndQueue db connId (sq_ :: NewSndQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
@@ -3053,7 +3066,7 @@ connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _
      enqueueConfirmation c cData sq' ownConnInfo Nothing
      where
        upgradeConn = do
-          (sq, _) <- lift $ newSndQueue userId connId qInfo'
+          (sq, _) <- lift $ newSndQueue userId connId qInfo' Nothing
          withStore c $ \db -> upgradeRcvConnToDuplex db connId sq

 secureConfirmQueueAsync :: AgentClient -> ConnData -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured
@@ -3175,11 +3188,11 @@ agentRatchetDecrypt' g db connId rc encAgentMsg = do
  liftIO $ updateRatchet db connId rc' skippedDiff
  liftEither $ bimap (SEAgentError . cryptoError) (,CR.rcRcvKEM rc') agentMsgBody_

-newSndQueue :: UserId -> ConnId -> Compatible SMPQueueInfo -> AM' (NewSndQueue, C.PublicKeyX25519)
-newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, sndSecure, dhPublicKey = rcvE2ePubDhKey})) = do
+newSndQueue :: UserId -> ConnId -> Compatible SMPQueueInfo -> Maybe (C.AAuthKeyPair) -> AM' (NewSndQueue, C.PublicKeyX25519)
+newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, sndSecure, dhPublicKey = rcvE2ePubDhKey})) sndKeys_ = do
  C.AuthAlg a <- asks $ sndAuthAlg . config
  g <- asks random
-  (sndPublicKey, sndPrivateKey) <- atomically $ C.generateAuthKeyPair a g
+  (sndPublicKey, sndPrivateKey) <- maybe (atomically $ C.generateAuthKeyPair a g) pure sndKeys_
  (e2ePubKey, e2ePrivKey) <- atomically $ C.generateKeyPair g
  let sq =
        SndQueue
@@ -3192,7 +3205,8 @@ newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAdd
            sndPrivateKey,
            e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
            e2ePubKey = Just e2ePubKey,
-            status = New,
+            -- setting status to Secured prevents SKEY when queue was already secured with LKEY
+            status = if isJust sndKeys_ then Secured else New,
            dbQueueId = DBNewQueue,
            primary = True,
            dbReplaceQueueId = Nothing,
@@ -1302,7 +1302,9 @@ data ContactConnType = CCTContact | CCTGroup deriving (Show)
 data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)

 -- TODO [short link] parser, parsing tests
-data AConnectionLink = ACLFull AConnectionRequestUri | ACLShort AConnShortLink
+data ConnectionLink m = CLFull (ConnectionRequestUri m) | CLShort (ConnShortLink m)
+
+data AConnectionLink = forall m. ConnectionModeI m => ACL (SConnectionMode m) (ConnectionLink m)

 instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
  strEncode = \case
@@ -155,7 +155,8 @@ data InvShortLink = InvShortLink
    linkId :: SMP.LinkId,
    linkKey :: LinkKey,
    sndPrivateKey :: SndPrivateAuthKey, -- stored to allow retries
-    sndPublicKey :: SndPublicAuthKey
+    sndPublicKey :: SndPublicAuthKey,
+    sndId :: Maybe SMP.SenderId
  }
  deriving (Show)

@@ -90,7 +90,10 @@ module Simplex.Messaging.Agent.Store.AgentStore
    unacceptInvitation,
    deleteInvitation,
    getInvShortLink,
+    getInvShortLinkKeys,
+    deleteInvShortLink,
    createInvShortLink,
+    setInvShortLinkSndId,
    -- Messages
    updateRcvIds,
    createRcvMsg,
@@ -768,33 +771,64 @@ getInvShortLink db server linkId =
    DB.query
      db
      [sql|
-        SELECT link_key, snd_private_key
+        SELECT link_key, snd_private_key, snd_id
        FROM inv_short_links
        WHERE host = ? AND port = ? AND link_id = ?
      |]
      (host server, port server, linkId)
  where
-    toInvShortLink :: (LinkKey, C.APrivateAuthKey) -> InvShortLink
-    toInvShortLink (linkKey, sndPrivateKey@(C.APrivateAuthKey a pk)) =
+    toInvShortLink :: (LinkKey, C.APrivateAuthKey, Maybe SenderId) -> InvShortLink
+    toInvShortLink (linkKey, sndPrivateKey@(C.APrivateAuthKey a pk), sndId) =
      let sndPublicKey = C.APublicAuthKey a $ C.publicKey pk
-       in InvShortLink {server, linkId, linkKey, sndPrivateKey, sndPublicKey}
+       in InvShortLink {server, linkId, linkKey, sndPrivateKey, sndPublicKey, sndId}
+
+getInvShortLinkKeys :: DB.Connection -> SMPServer -> SenderId -> IO (Maybe C.AAuthKeyPair)
+getInvShortLinkKeys db srv sndId =
+  maybeFirstRow toSndKeys $
+    DB.query
+      db
+      [sql|
+        SELECT snd_private_key
+        FROM inv_short_links
+        WHERE host = ? AND port = ? AND snd_id = ?
+      |]
+      (host srv, port srv, sndId)
+  where
+    toSndKeys :: Only C.APrivateAuthKey -> C.AAuthKeyPair
+    toSndKeys (Only privKey@(C.APrivateAuthKey a pk)) = (C.APublicAuthKey a $ C.publicKey pk, privKey)
+
+deleteInvShortLink :: DB.Connection -> SMPServer -> SenderId -> IO ()
+deleteInvShortLink db srv sndId =
+  DB.execute db "DELETE FROM inv_short_links WHERE host = ? AND port = ? AND snd_id = ?" (host srv, port srv, sndId)

 createInvShortLink :: DB.Connection -> InvShortLink -> IO ()
-createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey} = do
+createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do
  serverKeyHash_ <- createServer_ db server
  DB.execute
    db
    [sql|
      INSERT INTO inv_short_links
-        (host, port, server_key_hash, link_id, link_key, snd_private_key)
-      VALUES (?,?,?,?,?,?)
+        (host, port, server_key_hash, link_id, link_key, snd_private_key, snd_id)
+      VALUES (?,?,?,?,?,?,?)
      ON CONFLICT (host, port, link_id)
      DO UPDATE SET
        server_key_hash = EXCLUDED.server_key_hash,
        link_key = EXCLUDED.link_key,
-        snd_private_key = EXCLUDED.snd_private_key
+        snd_private_key = EXCLUDED.snd_private_key,
+        snd_id = EXCLUDED.snd_id
    |]
-    (host server, port server, serverKeyHash_, linkId, linkKey, sndPrivateKey)
+    (host server, port server, serverKeyHash_, linkId, linkKey, sndPrivateKey, sndId)
+
+setInvShortLinkSndId :: DB.Connection -> InvShortLink -> SenderId -> IO ()
+setInvShortLinkSndId db InvShortLink {server, linkId} sndId =
+  DB.execute
+    db
+    [sql|
+      UPDATE inv_short_links
+      SET snd_id = ?
+      WHERE host = ? AND port = ? AND link_id = ?
+    |]
+    (sndId, host server, port server, linkId)

 updateRcvIds :: DB.Connection -> ConnId -> IO (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
 updateRcvIds db connId = do
@@ -25,6 +25,7 @@ CREATE TABLE inv_short_links(
  link_id BYTEA NOT NULL,
  link_key BYTEA NOT NULL,
  snd_private_key BYTEA NOT NULL,
+  snd_id BYTEA,
  FOREIGN KEY(host, port) REFERENCES servers ON DELETE RESTRICT ON UPDATE CASCADE
 );

@@ -23,6 +23,7 @@ CREATE TABLE inv_short_links(
  link_id BLOB NOT NULL,
  link_key BLOB NOT NULL,
  snd_private_key BLOB NOT NULL,
+  snd_id BLOB,
  FOREIGN KEY(host, port) REFERENCES servers ON DELETE RESTRICT ON UPDATE CASCADE
 );

@@ -434,6 +434,7 @@ CREATE TABLE inv_short_links(
  link_id BLOB NOT NULL,
  link_key BLOB NOT NULL,
  snd_private_key BLOB NOT NULL,
+  snd_id BLOB,
  FOREIGN KEY(host, port) REFERENCES servers ON DELETE RESTRICT ON UPDATE CASCADE
 );
 CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
@@ -107,6 +107,7 @@ module Simplex.Messaging.Client
    TBQueueInfo (..),
    getTBQueueInfo,
    getProtocolClientQueuesInfo,
+    nonBlockingWriteTBQueue,
  )
 where

@@ -302,14 +302,14 @@ data SParty :: Party -> Type where
  SRecipient :: SParty Recipient
  SSender :: SParty Sender
  SNotifier :: SParty Notifier
-  SLinkClient :: SParty LinkClient 
+  SSenderLink :: SParty LinkClient 
  SProxiedClient :: SParty ProxiedClient

 instance TestEquality SParty where
  testEquality SRecipient SRecipient = Just Refl
  testEquality SSender SSender = Just Refl
  testEquality SNotifier SNotifier = Just Refl
-  testEquality SLinkClient SLinkClient = Just Refl
+  testEquality SSenderLink SSenderLink = Just Refl
  testEquality SProxiedClient SProxiedClient = Just Refl
  testEquality _ _ = Nothing

@@ -323,7 +323,7 @@ instance PartyI Sender where sParty = SSender

 instance PartyI Notifier where sParty = SNotifier

-instance PartyI LinkClient where sParty = SLinkClient
+instance PartyI LinkClient where sParty = SSenderLink

 instance PartyI ProxiedClient where sParty = SProxiedClient

@@ -860,8 +860,8 @@ instance ProtocolMsgTag CmdTag where
    "SKEY" -> Just $ CT SSender SKEY_
    "SEND" -> Just $ CT SSender SEND_
    "PING" -> Just $ CT SSender PING_
-    "LKEY" -> Just $ CT SLinkClient LKEY_
-    "LGET" -> Just $ CT SLinkClient LGET_
+    "LKEY" -> Just $ CT SSenderLink LKEY_
+    "LGET" -> Just $ CT SSenderLink LGET_
    "PRXY" -> Just $ CT SProxiedClient PRXY_
    "PFWD" -> Just $ CT SProxiedClient PFWD_
    "RFWD" -> Just $ CT SSender RFWD_
@@ -1587,8 +1587,8 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
        SEND_ -> SEND <$> _smpP <*> (unTail <$> _smpP)
        PING_ -> pure PING
        RFWD_ -> RFWD <$> (EncFwdTransmission . unTail <$> _smpP)
-    CT SLinkClient tag ->
-      Cmd SLinkClient <$> case tag of
+    CT SSenderLink tag ->
+      Cmd SSenderLink <$> case tag of
        LKEY_ -> LKEY <$> _smpP
        LGET_ -> pure LGET
    CT SProxiedClient tag ->
@@ -1068,8 +1068,8 @@ verifyTransmission ms auth_ tAuth authorized queueId cmd =
    Cmd SSender SEND {} -> verifyQueue (\q -> if maybe (isNothing tAuth) verify (senderKey $ snd q) then VRVerified (Just q) else VRFailed) <$> get SSender
    Cmd SSender PING -> pure $ VRVerified Nothing
    Cmd SSender RFWD {} -> pure $ VRVerified Nothing
-    Cmd SLinkClient (LKEY k) -> verifySecure SLinkClient k
-    Cmd SLinkClient LGET -> verifyQueue (\q -> if isContact (snd q) then VRVerified (Just q) else VRFailed) <$> get SLinkClient
+    Cmd SSenderLink (LKEY k) -> verifySecure SSenderLink k
+    Cmd SSenderLink LGET -> verifyQueue (\q -> if isContact (snd q) then VRVerified (Just q) else VRFailed) <$> get SSenderLink
    -- NSUB will not be accepted without authorization
    Cmd SNotifier NSUB -> verifyQueue (\q -> maybe dummyVerify (\n -> Just q `verifiedWith` notifierKey n) (notifier $ snd q)) <$> get SNotifier
    Cmd SProxiedClient _ -> pure $ VRVerified Nothing
@@ -1247,13 +1247,12 @@ client
        SEND flags msgBody -> withQueue_ False $ sendMessage flags msgBody
        PING -> pure (corrId, NoEntity, PONG)
        RFWD encBlock -> (corrId, NoEntity,) <$> processForwardedCommand encBlock
-      Cmd SLinkClient command -> Just <$> case command of
+      Cmd SSenderLink command -> Just <$> case command of
        LKEY k -> withQueue $ \q qr -> checkMode QMMessaging qr $ secureQueue_ q k $>> getQueueLink_ q qr
        LGET -> withQueue $ \q qr -> checkMode QMContact qr $ getQueueLink_ q qr
      Cmd SNotifier NSUB -> Just <$> subscribeNotifications
      Cmd SRecipient command ->
        Just <$> case command of
-          -- TODO [short links] idempotent NEW
          NEW nqr@NewQueueReq {auth_} ->
            ifM allowNew (createQueue nqr) (pure (corrId, entId, ERR AUTH))
            where
@@ -1698,8 +1697,8 @@ client
                    allowed = case cmd' of
                      Cmd SSender SEND {} -> True
                      Cmd SSender (SKEY _) -> True
-                      Cmd SLinkClient (LKEY _) -> True
-                      Cmd SLinkClient LGET -> True
+                      Cmd SSenderLink (LKEY _) -> True
+                      Cmd SSenderLink LGET -> True
                      _ -> False
                    verified = \case
                      VRVerified q -> Right (q, (corrId', entId', cmd'))
@@ -84,6 +84,7 @@ data PostgresQueueStore q = PostgresQueueStore
    queues :: TMap RecipientId q,
    -- this map only cashes the queues that were attempted to send messages to,
    senders :: TMap SenderId RecipientId,
+    links :: TMap LinkId RecipientId,
    -- this map only cashes the queues that were attempted to be subscribed to,
    notifiers :: TMap NotifierId RecipientId,
    notifierLocks :: TMap NotifierId Lock,
@@ -99,9 +100,10 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
    dbStoreLog <- mapM (openWriteStoreLog True) dbStoreLogPath
    queues <- TM.emptyIO
    senders <- TM.emptyIO
+    links <- TM.emptyIO
    notifiers <- TM.emptyIO
    notifierLocks <- TM.emptyIO
-    pure PostgresQueueStore {dbStore, dbStoreLog, queues, senders, notifiers, notifierLocks, deletedTTL}
+    pure PostgresQueueStore {dbStore, dbStoreLog, queues, senders, links, notifiers, notifierLocks, deletedTTL}
    where
      err e = do
        logError $ "STORE: newQueueStore, error opening PostgreSQL database, " <> tshow e
@@ -146,10 +148,11 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
      atomically $ TM.insert rId sq queues
      atomically $ TM.insert (senderId qr) rId senders
      forM_ (notifier qr) $ \NtfCreds {notifierId = nId} -> atomically $ TM.insert nId rId notifiers
+      forM_ (queueData qr) $ \(lnkId, _) -> atomically $ TM.insert lnkId rId links
      withLog "addStoreQueue" st $ \s -> logCreateQueue s rId qr
      pure sq
    where
-      PostgresQueueStore {queues, senders, notifiers} = st
+      PostgresQueueStore {queues, senders, links, notifiers} = st
      -- Not doing duplicate checks in maps as the probability of duplicates is very low.
      -- It needs to be reconsidered when IDs are supplied by the users.
      -- hasId = anyM [TM.memberIO rId queues, TM.memberIO senderId senders, hasNotifier]
@@ -159,12 +162,11 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
  getQueue_ st mkQ party qId = case party of
    SRecipient -> getRcvQueue qId
    SSender -> TM.lookupIO qId senders >>= maybe (mask loadSndQueue) getRcvQueue
-    -- TODO [short links] use map of link IDs - queue will be added there on creation in case there is data
-    SLinkClient -> mask loadLinkQueue
+    SSenderLink -> TM.lookupIO qId links >>= maybe (mask loadLinkQueue) getRcvQueue
    -- loaded queue is deleted from notifiers map to reduce cache size after queue was subscribed to by ntf server
    SNotifier -> TM.lookupIO qId notifiers >>= maybe (mask loadNtfQueue) (getRcvQueue >=> (atomically (TM.delete qId notifiers) $>))
    where
-      PostgresQueueStore {queues, senders, notifiers} = st
+      PostgresQueueStore {queues, senders, links, notifiers} = st
      getRcvQueue rId = TM.lookupIO rId queues >>= maybe (mask loadRcvQueue) (pure . Right)
      loadRcvQueue = do
        (rId, qRec) <- loadQueue " WHERE recipient_id = ?"
@@ -102,7 +102,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
      SRecipient -> TM.lookupIO qId queues
      SSender -> TM.lookupIO qId senders $>>= (`TM.lookupIO` queues)
      SNotifier -> TM.lookupIO qId notifiers $>>= (`TM.lookupIO` queues)
-      SLinkClient -> TM.lookupIO qId links $>>= (`TM.lookupIO` queues)
+      SSenderLink -> TM.lookupIO qId links $>>= (`TM.lookupIO` queues)
    where
      STMQueueStore {queues, senders, notifiers, links} = st

@@ -309,8 +309,9 @@ functionalAPITests ps = do
    it "should restore confirmation after client restart" $
      testAllowConnectionClientRestart ps
  describe "Short connection links" $ do
-    it "create and get 1-time short link" $ testInviationShortLink ps
-    it "create and get contact short link" $ testContactShortLink ps
+    it "should connect via 1-time short link" $ testInviationShortLink ps
+    it "should connect via 1-time short link with async join" $ testInviationShortLinkAsync ps
+    it "should connect via contact short link" $ testContactShortLink ps
  describe "Message delivery" $ do
    describe "update connection agent version on received messages" $ do
      it "should increase if compatible, shouldn'ps decrease" $
@@ -1082,7 +1083,7 @@ testInviationShortLink :: HasCallStack => (ATransport, AStoreType) -> IO ()
 testInviationShortLink ps =
  withAgentClients3 $ \a b c -> withSmpServer ps $ do
    let userData = "some user data"
-    (_bobId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMInvitation (Just userData) Nothing CR.IKUsePQ SMSubscribe
+    (bId, (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
@@ -1095,12 +1096,41 @@ testInviationShortLink ps =
    runExceptT (getConnShortLink c 1 shortLink) >>= \case
      Left (SMP _ AUTH) -> pure ()
      r -> liftIO $ expectationFailure ("unexpected result " <> show r)
+    runRight $ do
+      aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn
+      sndSecure <- A.joinConnection b 1 aId True connReq "bob's connInfo" PQSupportOn SMSubscribe
+      liftIO $ sndSecure `shouldBe` True
+      ("", _, CONF confId _ "bob's connInfo") <- get a
+      allowConnection a bId confId "alice's connInfo"
+      get a ##> ("", bId, CON)
+      get b ##> ("", aId, INFO "alice's connInfo")
+      get b ##> ("", aId, CON)
+      exchangeGreetings a bId b aId
+
+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
+    (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
+    strDecode (strEncode shortLink) `shouldBe` Right shortLink
+    connReq' `shouldBe` connReq
+    userData' `shouldBe` userData
+    runRight $ do
+      aId <- A.joinConnectionAsync b 1 "123" 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"
+      get a ##> ("", bId, CON)
+      get b ##> ("", aId, INFO "alice's connInfo")
+      get b ##> ("", aId, CON)
+      exchangeGreetings a bId b aId

 testContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO ()
 testContactShortLink ps =
  withAgentClients3 $ \a b c -> withSmpServer ps $ do
    let userData = "some user data"
-    (_bobId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
+    (_contactId, (connReq, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe
    (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink
    strDecode (strEncode shortLink) `shouldBe` Right shortLink
    connReq' `shouldBe` connReq
@@ -1113,6 +1143,19 @@ testContactShortLink ps =
    (connReq3, userData3) <- runRight $ getConnShortLink c 1 shortLink
    connReq3 `shouldBe` connReq
    userData3 `shouldBe` userData
+    runRight $ do
+      (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
+      liftIO $ sndSecure `shouldBe` False
+      ("", _, REQ invId _ "bob's connInfo") <- get a
+      bId <- A.prepareConnectionToAccept a True invId PQSupportOn
+      sndSecure' <- acceptContact a bId True invId "alice's connInfo" PQSupportOn SMSubscribe
+      liftIO $ sndSecure' `shouldBe` True
+      ("", _, CONF confId  _ "alice's connInfo") <- get b
+      allowConnection b aId confId "bob's connInfo"
+      get a ##> ("", bId, INFO "bob's connInfo")
+      get a ##> ("", bId, CON)
+      get b ##> ("", aId, CON)
+      exchangeGreetings a bId b aId

 testIncreaseConnAgentVersion :: HasCallStack => (ATransport, AStoreType) -> IO ()
 testIncreaseConnAgentVersion ps = do