smp-server: check queue is not secured in link store

src/Simplex/Messaging/Server.hs

@@ -1319,11 +1319,6 @@ isContactQueue QueueRec {queueMode, senderKey} = case queueMode of
   Just QMContact -> True
   Nothing -> isNothing senderKey -- for backward compatibility with pre-SKEY contact addresses
 
-isSecuredMsgQueue :: QueueRec -> Bool
-isSecuredMsgQueue QueueRec {queueMode, senderKey} = case queueMode of
-  Just QMContact -> False
-  _ -> isJust senderKey
-
 -- Random correlation ID is used as a nonce in case crypto_box authenticator is used to authorize transmission
 verifyCmdAuthorization :: Maybe (THandleAuth 'TServer) -> Maybe TAuthorizations -> ByteString -> CorrId -> C.APublicAuthKey -> Bool
 verifyCmdAuthorization thAuth tAuth authorized corrId key = maybe False (verify key) tAuth

src/Simplex/Messaging/Server/QueueStore.hs

@@ -13,12 +13,14 @@ module Simplex.Messaging.Server.QueueStore
     ServiceRec (..),
     CertFingerprint,
     ServerEntityStatus (..),
+    isSecuredMsgQueue,
   ) where
 
 import Control.Applicative (optional, (<|>))
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.List.NonEmpty (NonEmpty)
+import Data.Maybe (isJust)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
 import Simplex.Messaging.Encoding
@@ -48,6 +50,11 @@ data QueueRec = QueueRec
   }
   deriving (Show)
 
+isSecuredMsgQueue :: QueueRec -> Bool
+isSecuredMsgQueue QueueRec {queueMode, senderKey} = case queueMode of
+  Just QMContact -> False
+  _ -> isJust senderKey
+
 data NtfCreds = NtfCreds
   { notifierId :: NotifierId,
     notifierKey :: NtfPublicAuthKey,

src/Simplex/Messaging/Server/QueueStore/Postgres.hs

@@ -314,9 +314,9 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
   addQueueLinkData st sq lnkId d =
     withQueueRec sq "addQueueLinkData" $ \q -> case queueData q of
       Nothing ->
-        addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId))
+        addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId, QMContact))
       Just (lnkId', _) | lnkId' == lnkId ->
-        addLink q $ \db -> DB.execute db (qry <> " AND (fixed_data IS NULL OR fixed_data = ?)") (d :. (lnkId, rId, fst d))
+        addLink q $ \db -> DB.execute db (qry <> " AND (fixed_data IS NULL OR fixed_data = ?)") (d :. (lnkId, rId, QMContact, fst d))
       _ -> throwE AUTH
     where
       rId = recipientId sq
@@ -324,7 +324,8 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
         assertUpdated $ withDB' "addQueueLinkData" st update
         atomically $ writeTVar (queueRec sq) $ Just q {queueData = Just (lnkId, d)}
         withLog "addQueueLinkData" st $ \s -> logCreateLink s rId lnkId d
-      qry = "UPDATE msg_queues SET fixed_data = ?, user_data = ?, link_id = ? WHERE recipient_id = ? AND deleted_at IS NULL"
+      -- the sender key condition is checked in SQL because without cache each command reads its own copy of the queue record
+      qry = "UPDATE msg_queues SET fixed_data = ?, user_data = ?, link_id = ? WHERE recipient_id = ? AND deleted_at IS NULL AND (sender_key IS NULL OR queue_mode = ?)"
 
   deleteQueueLinkData :: PostgresQueueStore q -> q -> IO (Either ErrorType ())
   deleteQueueLinkData st sq =

src/Simplex/Messaging/Server/QueueStore/STM.hs

@@ -173,6 +173,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
       rId = recipientId sq
       qr = queueRec sq
       add q = case queueData q of
+        _ | isSecuredMsgQueue q -> pure $ Left AUTH
         Nothing -> addLink
         Just (lnkId', d') | lnkId' == lnkId && fst d' == fst d -> addLink
         _ -> pure $ Left AUTH

tests/CoreTests/MsgStoreTests.hs

@@ -34,7 +34,7 @@ import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import SMPClient (testStoreLogFile, testStoreMsgsDir, testStoreMsgsDir2, testStoreMsgsFile, testStoreMsgsFile2)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (EntityId (..), ErrorType, LinkId, Message (..), QueueLinkData, RecipientId, SParty (..), noMsgFlags)
+import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), ErrorType (..), LinkId, Message (..), QueueLinkData, RecipientId, SParty (..), noMsgFlags)
 import Simplex.Messaging.Server (exportMessages, importMessages, printMessageStats)
 import Simplex.Messaging.Server.Env.STM (MsgStore (..), journalMsgStoreDepth, readWriteQueueStore)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..), expireBeforeEpoch)
@@ -43,6 +43,7 @@ import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
+import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog (closeStoreLog, logCreateQueue)
 import System.Directory (copyFile, createDirectoryIfMissing, listDirectory, removeFile, renameFile)
 import System.FilePath ((</>))
@@ -57,7 +58,6 @@ import Simplex.Messaging.Agent.Store.Postgres.Common
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Server.MsgStore.Postgres
 import Simplex.Messaging.Server.QueueStore.Postgres
-import Simplex.Messaging.Server.QueueStore.Types
 import SMPClient (postgressBracket, testServerDBConnectInfo, testStoreDBOpts)
 #endif
 
@@ -101,6 +101,7 @@ msgStoreTests = do
       it "should get queue and store/read messages" testGetQueue
       it "should write/ack messages" testWriteAckMessages
       it "should not fail on EOF when changing read journal" testChangeReadJournal
+      it "should not add link data to secured messaging queue" testLinkDataSecuredQueue
 
 -- TODO constrain to STM stores?
 withMsgStore :: MsgStoreClass s => MsgStoreConfig s -> (s -> IO ()) -> IO ()
@@ -267,6 +268,33 @@ testChangeReadJournal ms = do
     (Msg "message 5", Nothing) <- tryDelPeekMsg ms q mId5
     void $ ExceptT $ deleteQueue ms q
 
+testLinkDataSecuredQueue :: MsgStoreClass s => s -> IO ()
+testLinkDataSecuredQueue ms = do
+  g <- C.newRandom
+  (sKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+  let st = queueStore ms
+      ld = (EncDataBytes "fixed data", EncDataBytes "user data")
+      rndId = atomically $ EntityId <$> C.randomBytes 24 g
+  (rId, qr) <- testNewQueueRec g QMMessaging
+  (cId, cqr) <- testNewQueueRec g QMContact
+  lnkId <- rndId
+  cLnkId <- rndId
+  runRight_ $ do
+    q <- ExceptT $ addQueue ms rId qr
+    -- the handle is read before SKEY, as in a command that raced with it
+    staleQ <- ExceptT $ getQueue ms SRecipient rId
+    ExceptT $ secureQueue st q sKey
+    liftIO $ addQueueLinkData st staleQ lnkId ld `shouldReturn` Left AUTH
+    freshQ <- ExceptT $ getQueue ms SRecipient rId
+    liftIO $ getQueueLinkData st freshQ lnkId `shouldReturn` Left AUTH
+    cq <- ExceptT $ addQueue ms cId cqr
+    ExceptT $ secureQueue st cq sKey
+    ExceptT $ addQueueLinkData st cq cLnkId ld
+    ld' <- ExceptT $ getQueueLinkData st cq cLnkId
+    liftIO $ ld' `shouldBe` ld
+    void $ ExceptT $ deleteQueue ms q
+    void $ ExceptT $ deleteQueue ms cq
+
 testExportImportStore :: JournalMsgStore 'QSMemory -> IO ()
 testExportImportStore ms = do
   g <- C.newRandom