Merge branch 'master' into rcv-services

src/Simplex/Messaging/Agent.hs

@@ -51,6 +51,7 @@ module Simplex.Messaging.Agent
     connRequestPQSupport,
     createConnectionAsync,
     setConnShortLinkAsync,
+    getConnShortLinkAsync,
     joinConnectionAsync,
     allowConnectionAsync,
     acceptContactAsync,
@@ -199,8 +200,8 @@ import Simplex.Messaging.Client (NetworkRequestMode (..), ProtocolClientError (.
 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)
@@ -223,8 +224,8 @@ import Simplex.Messaging.Protocol
     SParty (..),
     SProtocolType (..),
     ServiceSub (..),
-    ServiceSubResult (..),
     ServiceSubError (..),
+    ServiceSubResult (..),
     SndPublicAuthKey,
     SubscriptionMode (..),
     UserProtocol,
@@ -358,13 +359,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
@@ -412,7 +419,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 #-}
 
@@ -824,8 +831,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
@@ -836,8 +844,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 =
@@ -856,7 +878,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
 
@@ -916,8 +938,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
@@ -932,15 +955,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}, SCMContact, UserContactLinkData {}) -> pure server
-      (RcvConnection _ RcvQueue {server}, SCMInvitation, UserInvLinkData {}) -> pure server
+    srv <- case (conn, userLinkData) of
+      (ContactConnection _ RcvQueue {server, shortLink}, UserContactLinkData d) -> do
+        liftEitherWith (CMD PROHIBITED . ("setConnShortLinkAsync: " <>)) $ validateOwners shortLink d
+        pure server
       _ -> throwE $ CMD PROHIBITED "setConnShortLinkAsync: invalid connection or mode"
-    enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET (AUCLD 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 =
@@ -954,7 +1003,8 @@ setConnShortLink' c nm connId cMode userLinkData clientData =
     pure sl
   where
     prepareContactLinkData :: RcvQueue -> UserConnLinkData 'CMContact -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMContact, QueueLinkData)
-    prepareContactLinkData rq@RcvQueue {shortLink} ud = do
+    prepareContactLinkData rq@RcvQueue {shortLink} ud@(UserContactLinkData d') = do
+      liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink d'
       g <- asks random
       AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
       let cslContact = CSLContact SLSServer CCTContact (qServer rq)
@@ -971,7 +1021,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData =
               (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq ud
               (linkId, k) = SL.contactShortLinkKdf linkKey
           srvData <- liftError id $ SL.encryptLinkData g k linkData
-          let slCreds = ShortLinkCreds linkId linkKey privSigKey (fst srvData)
+          let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing (fst srvData)
           withStore' c $ \db -> updateShortLinkCreds db rq slCreds
           pure (rq, linkId, cslContact linkKey, srvData)
     prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
@@ -995,7 +1045,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
@@ -1016,18 +1066,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}
@@ -1110,7 +1161,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
@@ -1371,7 +1422,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
@@ -1405,7 +1456,8 @@ subscribeConnections_ c conns = do
   notifyResultError rs
   pure rs
   where
-    partitionResultsConns :: (ConnId, Either StoreError SomeConnSub) ->
+    partitionResultsConns ::
+      (ConnId, Either StoreError SomeConnSub) ->
       (Map ConnId (Either AgentErrorType ()), [(ConnId, SomeConnSub)]) ->
       (Map ConnId (Either AgentErrorType ()), [(ConnId, SomeConnSub)])
     partitionResultsConns (connId, conn_) (rs, cs) = case conn_ of
@@ -1499,29 +1551,32 @@ subscribeAllConnections' c onlyNeeded activeUserId_ = handleErr $ do
     handleErr = (`catchAllErrors` \e -> notifySub' c "" (ERR e) >> throwE e)
     getService :: DB.Connection -> Map UserId Bool -> (UserId, SMPServer) -> IO ((UserId, SMPServer), Maybe ServiceSub)
     getService db useServices us@(userId, srv) =
-      fmap (us,) $ getSubscriptionService db userId srv >>= \case
-        Just serviceSub -> case M.lookup userId useServices of
-          Just True -> pure $ Just serviceSub
-          _ -> Nothing <$ unassocUserServerRcvQueueSubs' db userId srv
-        _ -> pure Nothing
+      fmap (us,) $
+        getSubscriptionService db userId srv >>= \case
+          Just serviceSub -> case M.lookup userId useServices of
+            Just True -> pure $ Just serviceSub
+            _ -> Nothing <$ unassocUserServerRcvQueueSubs' db userId srv
+          _ -> pure Nothing
     subscribeService :: ((UserId, SMPServer), Maybe ServiceSub) -> AM' ((UserId, SMPServer), ServiceAssoc)
-    subscribeService (us@(userId, srv), serviceSub_) = fmap ((us,) . fromRight False) $ tryAllErrors' $
-      case serviceSub_ of
-        Just serviceSub -> tryAllErrors (subscribeClientService c True userId srv serviceSub) >>= \case
-          Right (ServiceSubResult e _) -> case e of
-            Just SSErrorServiceId {} -> unassocQueues
-            -- Possibly, we should always resubscribe all when expected is greater than subscribed
-            Just SSErrorQueueCount {expectedQueueCount = n, subscribedQueueCount = n'} | n > 0 && n' == 0 -> unassocQueues
-            _ -> pure True
-          Left e -> do
-            atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR e)
-            if clientServiceError e
-              then unassocQueues
-              else pure True
-          where
-            unassocQueues :: AM Bool
-            unassocQueues = False <$ withStore' c (\db -> unassocUserServerRcvQueueSubs' db userId srv)
-        _ -> pure False
+    subscribeService (us@(userId, srv), serviceSub_) = fmap ((us,) . fromRight False) $
+      tryAllErrors' $
+        case serviceSub_ of
+          Just serviceSub ->
+            tryAllErrors (subscribeClientService c True userId srv serviceSub) >>= \case
+              Right (ServiceSubResult e _) -> case e of
+                Just SSErrorServiceId {} -> unassocQueues
+                -- Possibly, we should always resubscribe all when expected is greater than subscribed
+                Just SSErrorQueueCount {expectedQueueCount = n, subscribedQueueCount = n'} | n > 0 && n' == 0 -> unassocQueues
+                _ -> pure True
+              Left e -> do
+                atomically $ writeTBQueue (subQ c) ("", "", AEvt SAEConn $ ERR e)
+                if clientServiceError e
+                  then unassocQueues
+                  else pure True
+            where
+              unassocQueues :: AM Bool
+              unassocQueues = False <$ withStore' c (\db -> unassocUserServerRcvQueueSubs' db userId srv)
+          _ -> pure False
     subscribeUserServer :: Int -> TVar Int -> ((UserId, SMPServer), ServiceAssoc) -> AM' (Either AgentErrorType Int)
     subscribeUserServer maxPending currPending ((userId, srv), hasService) = do
       atomically $ whenM ((maxPending <=) <$> readTVar currPending) retry
@@ -1746,15 +1801,26 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
           tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do
             CCLink cReq _ <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv
             notify $ INV (ACR cMode cReq)
-        LSET auData@(AUCLD cMode userLinkData) clientData ->
+        LSET userLinkData clientData ->
           withServer' . tryCommand $ do
-            link <- setConnShortLink' c NRMBackground connId cMode userLinkData clientData
-            notify $ LINK (ACSL cMode link) auData
+            link <- setConnShortLink' c NRMBackground connId SCMContact userLinkData clientData
+            notify $ LINK link userLinkData
+        LGET shortLink ->
+          withServer' . tryCommand $ do
+            (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 <- joinConnSrvAsync c userId connId enableNtfs cReq connInfo pqEnc subMode srv
             notify $ JOINED sqSecured
+        -- 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 <- joinConnSrv c NRMBackground userId connId enableNtfs cReq connInfo pqEnc subMode srv
+            notify $ JOINED sqSecured
         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 ->
@@ -1764,7 +1830,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
@@ -1928,7 +1993,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
@@ -1970,7 +2035,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
@@ -2391,7 +2455,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
@@ -2399,7 +2464,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')

src/Simplex/Messaging/Agent/Client.hs

@@ -1503,12 +1503,12 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
       (CQRMessaging ld, Just QMMessaging) ->
         withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (sndId', d)} ->
           if sndId == sndId'
-            then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey (fst d)
+            then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey Nothing (fst d)
             else newErr "different sender ID"
       (CQRContact ld, Just QMContact) ->
         withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (lnkId', (sndId', d))} ->
           if sndId == sndId' && lnkId == lnkId'
-            then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey (fst d)
+            then pure $ Just $ ShortLinkCreds lnkId linkKey privSigKey Nothing (fst d)
             else newErr "different sender or link IDs"
       (_, Nothing) -> case linkId of
         Nothing | v < sndAuthKeySMPVersion -> pure Nothing

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
@@ -107,10 +107,12 @@ module Simplex.Messaging.Agent.Protocol
     ConnectionModeI (..),
     ConnectionRequestUri (..),
     AConnectionRequestUri (..),
+    ShortLinkCreds (..),
     ConnReqUriData (..),
     CRClientData,
     ServiceScheme,
     FixedLinkData (..),
+    AConnLinkData (..),
     ConnLinkData (..),
     AUserConnLinkData (..),
     UserConnLinkData (..),
@@ -127,6 +129,8 @@ module Simplex.Messaging.Agent.Protocol
     ContactConnType (..),
     ShortLinkScheme (..),
     LinkKey (..),
+    validateOwners,
+    validateLinkOwners,
     sameConnReqContact,
     sameShortLinkContact,
     simplexChat,
@@ -195,7 +199,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@@ -235,11 +239,11 @@ import Simplex.Messaging.Protocol
     NMsgMeta,
     ProtocolServer (..),
     QueueMode (..),
-    ServiceSub,
-    ServiceSubResult,
     SMPClientVersion,
     SMPServer,
     SMPServerWithAuth,
+    ServiceSub,
+    ServiceSubResult,
     SndPublicAuthKey,
     SubscriptionMode,
     VersionRangeSMPC,
@@ -250,10 +254,10 @@ import Simplex.Messaging.Protocol
     legacyStrEncodeServer,
     noAuthSrv,
     sameSrvAddr,
+    senderCanSecure,
+    shortLinksSMPClientVersion,
     sndAuthKeySMPClientVersion,
     srvHostnamesSMPClientVersion,
-    shortLinksSMPClientVersion,
-    senderCanSecure,
     pattern ProtoServerWithAuth,
     pattern SMPServer,
   )
@@ -381,7 +385,8 @@ type SndQueueSecured = Bool
 -- | Parameterized type for SMP agent events
 data AEvent (e :: AEntity) where
   INV :: AConnectionRequestUri -> 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
@@ -439,7 +444,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)
@@ -450,6 +456,7 @@ data ACommand
 data ACommandTag
   = NEW_
   | LSET_
+  | LGET_
   | JOIN_
   | LET_
   | ACK_
@@ -460,6 +467,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
@@ -511,6 +519,7 @@ aCommandTag :: ACommand -> ACommandTag
 aCommandTag = \case
   NEW {} -> NEW_
   LSET {} -> LSET_
+  LGET _ -> LGET_
   JOIN {} -> JOIN_
   LET {} -> LET_
   ACK {} -> ACK_
@@ -521,6 +530,7 @@ aEventTag :: AEvent e -> AEventTag e
 aEventTag = \case
   INV {} -> INV_
   LINK {} -> LINK_
+  LDATA {} -> LDATA_
   CONF {} -> CONF_
   REQ {} -> REQ_
   INFO {} -> INFO_
@@ -1449,6 +1459,15 @@ instance Eq AConnectionRequestUri where
 
 deriving instance Show AConnectionRequestUri
 
+data ShortLinkCreds = ShortLinkCreds
+  { shortLinkId :: SMP.LinkId,
+    shortLinkKey :: LinkKey,
+    linkPrivSigKey :: C.PrivateKeyEd25519,
+    linkRootSigKey :: Maybe C.PublicKeyEd25519, -- in case the current user is not the original owner, and the root key is different from linkPrivSigKey
+    linkEncFixedData :: SMP.EncFixedDataBytes
+  }
+  deriving (Show)
+
 data ShortLinkScheme = SLSSimplex | SLSServer deriving (Eq, Show)
 
 data ConnShortLink (m :: ConnectionMode) where
@@ -1704,13 +1723,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,
@@ -1735,14 +1760,7 @@ deriving instance Eq (UserConnLinkData m)
 
 deriving instance Show (UserConnLinkData m)
 
-data AUserConnLinkData = forall m. ConnectionModeI m => AUCLD (SConnectionMode m) (UserConnLinkData m)
-
-instance Eq AUserConnLinkData where
-  AUCLD m d == AUCLD m' d' = case testEquality m m' of
-    Just Refl -> d == d'
-    Nothing -> False
-
-deriving instance Show AUserConnLinkData
+data AUserConnLinkData = forall m. ConnectionModeI m => AULD (SConnectionMode m) (UserConnLinkData m)
 
 linkUserData :: ConnLinkData c -> UserLinkData
 linkUserData = \case
@@ -1759,32 +1777,55 @@ type OwnerId = ByteString
 data OwnerAuth = OwnerAuth
   { ownerId :: OwnerId, -- unique in the list, application specific - e.g., MemberId
     ownerKey :: C.PublicKeyEd25519,
-    -- sender ID signed with ownerKey,
-    -- confirms that the owner accepts being the owner.
-    -- sender ID is used here as it is immutable for the queue, link data can be removed.
-    ownerSig :: C.Signature 'C.Ed25519,
-    -- null for root key authorization
-    authOwnerId :: OwnerId,
-    -- owner authorization, sig(ownerId || ownerKey, key(authOwnerId)),
-    -- where authOwnerId is either null for a root key or some other owner authorized by root key, etc.
-    -- Owner validation should detect and reject loops.
+    -- owner authorization by root or any previous owner, sig(ownerId || ownerKey, prevOwnerKey),
     authOwnerSig :: C.Signature 'C.Ed25519
   }
   deriving (Eq, Show)
 
 instance Encoding OwnerAuth where
-  smpEncode OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig} =
-    smpEncode (ownerId, ownerKey, C.signatureBytes ownerSig, authOwnerId, C.signatureBytes authOwnerSig)
+  smpEncode OwnerAuth {ownerId, ownerKey, authOwnerSig} =
+    -- It is additionally encoded as ByteString to have known length and allow OwnerAuth extension
+    smpEncode $ smpEncode (ownerId, ownerKey, C.signatureBytes authOwnerSig)
   smpP = do
-    (ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig) <- smpP
-    pure OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig}
+    -- parseOnly ignores any unused extension
+    (ownerId, ownerKey, authOwnerSig) <- A.parseOnly smpP <$?> smpP
+    pure OwnerAuth {ownerId, ownerKey, authOwnerSig}
+
+validateOwners :: Maybe ShortLinkCreds -> UserContactData -> Either String ()
+validateOwners shortLink_ UserContactData {owners} = case shortLink_ of
+  Nothing
+    | null owners -> Right ()
+    | otherwise -> Left "no link credentials with additional owners"
+  Just ShortLinkCreds {linkPrivSigKey, linkRootSigKey}
+    | hasOwner -> validateLinkOwners (fromMaybe k linkRootSigKey) owners
+    | otherwise -> Left "no current owner in link data"
+    where
+      hasOwner = isNothing linkRootSigKey || any ((k ==) . ownerKey) owners
+      k = C.publicKey linkPrivSigKey
+
+validateLinkOwners :: C.PublicKeyEd25519 -> [OwnerAuth] -> Either String ()
+validateLinkOwners rootKey = go []
+  where
+    go _ [] = Right ()
+    go prev (o : os) = validOwner o >> go (o : prev) os
+      where
+        validOwner OwnerAuth {ownerId = oId, ownerKey = k, authOwnerSig = sig}
+          | k == rootKey = Left $ "owner key for ID " <> idStr <> " matches root key"
+          | any duplicate prev = Left $ "duplicate owner key or ID " <> idStr
+          | signedBy rootKey || any (signedBy . ownerKey) prev = Right ()
+          | otherwise = Left $ "invalid authorization of owner ID " <> idStr
+          where
+            duplicate OwnerAuth {ownerId, ownerKey} = oId == ownerId || k == ownerKey
+            idStr = B.unpack $ B64.encodeUnpadded oId
+            signedBy k' = C.verify' k' sig (oId <> C.encodePubKey k)
 
 instance ConnectionModeI c => Encoding (FixedLinkData c) where
-  smpEncode FixedLinkData {agentVRange, rootKey, connReq} =
-    smpEncode (agentVRange, rootKey, connReq)
+  smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} =
+    smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId
   smpP = do
-    (agentVRange, rootKey, connReq) <- smpP
-    pure FixedLinkData {agentVRange, rootKey, connReq}
+    (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, linkConnReq, linkEntityId}
 
 instance ConnectionModeI c => Encoding (ConnLinkData c) where
   smpEncode = \case
@@ -1809,21 +1850,21 @@ instance ConnectionModeI c => Encoding (UserConnLinkData c) where
   smpEncode = \case
     UserInvLinkData userData -> smpEncode (CMInvitation, userData)
     UserContactLinkData cd -> smpEncode (CMContact, cd)
-  smpP = (\(AUCLD _ d) -> checkConnMode d) <$?> smpP
+  smpP = (\(AULD _ d) -> checkConnMode d) <$?> smpP
   {-# INLINE smpP #-}
 
 instance Encoding AUserConnLinkData where
-  smpEncode (AUCLD _ d) = smpEncode d
+  smpEncode (AULD _ d) = smpEncode d
   {-# INLINE smpEncode #-}
   smpP =
     smpP >>= \case
       CMInvitation -> do
         userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
-        pure $ AUCLD SCMInvitation $ UserInvLinkData userData
+        pure $ AULD SCMInvitation $ UserInvLinkData userData
       CMContact ->
-        AUCLD SCMContact . UserContactLinkData <$> smpP
+        AULD SCMContact . UserContactLinkData <$> smpP
 
-instance StrEncoding AUserConnLinkData where
+instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where
   strEncode = smpEncode
   {-# INLINE strEncode #-}
   strP = smpP
@@ -2029,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_
@@ -2038,6 +2080,7 @@ instance StrEncoding ACommandTag where
   strEncode = \case
     NEW_ -> "NEW"
     LSET_ -> "LSET"
+    LGET_ -> "LGET"
     JOIN_ -> "JOIN"
     LET_ -> "LET"
     ACK_ -> "ACK"
@@ -2050,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))
@@ -2068,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_

src/Simplex/Messaging/Agent/Store.hs

@@ -29,9 +29,9 @@ import Data.Time (UTCTime)
 import Data.Type.Equality
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval (RI2State)
-import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Agent.Store.Common
 import Simplex.Messaging.Agent.Store.DB (SQLError)
+import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Agent.Store.Interface (createDBStore)
 import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..))
@@ -127,14 +127,6 @@ rcvQueueSub :: RcvQueue -> RcvQueueSub
 rcvQueueSub RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId = DBEntityId dbQueueId, primary, dbReplaceQueueId} =
   RcvQueueSub {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId, primary, dbReplaceQueueId}
 
-data ShortLinkCreds = ShortLinkCreds
-  { shortLinkId :: SMP.LinkId,
-    shortLinkKey :: LinkKey,
-    linkPrivSigKey :: C.PrivateKeyEd25519,
-    linkEncFixedData :: SMP.EncFixedDataBytes
-  }
-  deriving (Show)
-
 type ServiceAssoc = Bool
 
 rcvSMPQueueAddress :: RcvQueue -> SMPQueueAddress

src/Simplex/Messaging/Agent/Store/AgentStore.hs

@@ -45,6 +45,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
     deleteClientServices,
 
     -- * Queues and connections
+    createServer,
     createNewConn,
     updateNewConnRcv,
     updateNewConnSnd,
@@ -70,6 +71,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
     setConnUserId,
     setConnAgentVersion,
     setConnPQSupport,
+    updateNewConnJoin,
     getDeletedConnIds,
     getDeletedWaitingDeliveryConnIds,
     setConnRatchetSync,
@@ -410,7 +412,7 @@ deleteUsersWithoutConns db = do
 
 createClientService :: DB.Connection -> UserId -> SMPServer -> (C.KeyHash, TLS.Credential) -> IO ()
 createClientService db userId srv (kh, (cert, pk)) = do
-  serverKeyHash_ <- createServer_ db srv
+  serverKeyHash_ <- createServer db srv
   DB.execute
     db
     [sql|
@@ -550,7 +552,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_
 
@@ -635,7 +637,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)
@@ -647,7 +649,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 ()
@@ -945,7 +947,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|
@@ -2149,8 +2151,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
@@ -2593,6 +2595,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))
 
@@ -2678,7 +2684,7 @@ toRcvQueue
         (Just ntfPublicKey, Just ntfPrivateKey, Just notifierId, Just rcvNtfDhSecret) -> Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret}
         _ -> Nothing
       shortLink = case (shortLinkId_, shortLinkKey_, linkPrivSigKey_, linkEncFixedData_) of
-        (Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData}
+        (Just shortLinkId, Just shortLinkKey, Just linkPrivSigKey, Just linkEncFixedData) -> Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkRootSigKey = Nothing, linkEncFixedData} -- TODO linkRootSigKey should be stored in a separate field
         _ -> Nothing
       enableNtfs = maybe True unBI enableNtfs_
    in RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, queueMode, shortLink, rcvServiceAssoc, status, enableNtfs, clientNoticeId, dbQueueId, primary, dbReplaceQueueId, rcvSwchStatus, smpClientVersion, clientNtfCreds, deleteErrors}

src/Simplex/Messaging/Agent/Store/Postgres/Common.hs

@@ -19,6 +19,7 @@ module Simplex.Messaging.Agent.Store.Postgres.Common
   )
 where
 
+import Control.Monad (void)
 import Control.Concurrent.MVar
 import Control.Concurrent.STM
 import qualified Control.Exception as E
@@ -100,7 +101,7 @@ withTransactionPriority st priority action = withConnectionPriority st priority
 -- to restore the transaction to a usable state before returning the error.
 withSavepoint :: PSQL.Connection -> PSQL.Query -> IO a -> IO (Either PSQL.SqlError a)
 withSavepoint db name action = do
-  PSQL.execute_ db $ "SAVEPOINT " <> name
+  void $ PSQL.execute_ db $ "SAVEPOINT " <> name
   E.try action
     >>= bimapM
       (PSQL.execute_ db ("ROLLBACK TO SAVEPOINT " <> name) $>)

src/Simplex/Messaging/Crypto/ShortLink.hs

@@ -21,6 +21,7 @@ module Simplex.Messaging.Crypto.ShortLink
 where
 
 import Control.Concurrent.STM
+import Control.Monad (unless)
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Crypto.Random (ChaChaDRG)
@@ -32,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
@@ -50,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}
+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))
 
@@ -81,17 +82,22 @@ 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
     | LinkKey (C.sha3_256 fd) /= linkKey -> linkErr "link data hash"
     | not (C.verify' rootKey sig1 fd) -> linkErr "link data signature"
-    | not (C.verify' rootKey sig2 md) -> linkErr "user data signature"
-    | otherwise -> Right (connReq, md')
+    | otherwise -> case md' of
+        InvitationLinkData {} -> unless (signedBy rootKey) $ linkErr "user data signature"
+        ContactLinkData _ UserContactData {owners} -> do
+          first (AGENT . A_LINK) $ validateLinkOwners rootKey owners
+          unless (signedBy rootKey || any (signedBy . ownerKey) owners) $ linkErr "user data signature"
+  Right (fd', md')
   where
     decrypt (EncDataBytes d) = do
       (nonce, Tail ct) <- decode d
@@ -100,4 +106,5 @@ decryptLinkData linkKey k (encFD, encMD) = do
     decode :: Encoding a => ByteString -> Either AgentErrorType a
     decode = msgErr . smpDecode
     msgErr = first (const $ AGENT A_MESSAGE)
+    linkErr :: String -> Either AgentErrorType ()
     linkErr = Left . AGENT . A_LINK