smp server: allow getting and deleting short links for the old contact queues (#1549)

* smp server: allow getting and deleting short links for the old contact queues

* fix verifaction of legacy contact queues

* test

src/Simplex/Messaging/Server.hs

@@ -1049,7 +1049,7 @@ verifyTransmission ms auth_ tAuth authorized queueId cmd =
     Cmd SSender PING -> pure $ VRVerified Nothing
     Cmd SSender RFWD {} -> pure $ VRVerified Nothing
     Cmd SSenderLink (LKEY k) -> verifySecure SSenderLink k
-    Cmd SSenderLink LGET -> verifyQueue (\q -> if isContact (snd q) then VRVerified (Just q) else VRFailed) <$> get SSenderLink
+    Cmd SSenderLink LGET -> verifyQueue (\q -> if isContactQueue (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
@@ -1067,12 +1067,15 @@ verifyTransmission ms auth_ tAuth authorized queueId cmd =
     allowedKey k = \case
       QueueRec {queueMode = Just QMMessaging, senderKey} -> maybe True (k ==) senderKey
       _ -> False
-    isContact = \case
-      QueueRec {queueMode = Just QMContact} -> True
-      _ -> False
     get :: DirectParty p => SParty p -> M (Either ErrorType (StoreQueue s, QueueRec))
     get party = liftIO $ getQueueRec ms party queueId
 
+isContactQueue :: QueueRec -> Bool
+isContactQueue QueueRec {queueMode, senderKey} = case queueMode of
+  Just QMMessaging -> False
+  Just QMContact -> True
+  Nothing -> isNothing senderKey -- for backward compatibility with pre-SKEY contact addresses
+
 verifyCmdAuthorization :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
 verifyCmdAuthorization auth_ tAuth authorized key = maybe False (verify key) tAuth
   where
@@ -1231,7 +1234,7 @@ client
         RFWD encBlock -> (corrId, NoEntity,) <$> processForwardedCommand encBlock
       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
+        LGET -> withQueue $ \q qr -> checkContact qr $ getQueueLink_ q qr
       Cmd SNotifier NSUB -> Just <$> subscribeNotifications
       Cmd SRecipient command ->
         Just <$> case command of
@@ -1247,17 +1250,11 @@ client
           KEY sKey -> withQueue $ \q _ -> either err (corrId,entId,) <$> secureQueue_ q sKey
           RKEY rKeys -> withQueue $ \q qr -> checkMode QMContact qr $ OK <$$ liftIO (updateKeys (queueStore ms) q rKeys)
           LSET lnkId d ->
-            withQueue $ \q QueueRec {queueMode, senderKey, queueData} ->
-              liftIO $ either err (corrId,entId,)
-                -- this check allows adding link data to contact addresses created prior to SKEY,
-                -- using `queueMode == Just QMContact` would prevent it, they have queueMode `Nothing`.
-                <$> if queueMode /= Just QMMessaging && isNothing senderKey
-                  then case queueData of
-                    Just (lnkId', _) | lnkId' /= lnkId -> pure $ Left AUTH
-                    _ -> OK <$$ addQueueLinkData (queueStore ms) q lnkId d
-                  else pure $ Left AUTH
+            withQueue $ \q qr -> checkContact qr $ liftIO $ case queueData qr of
+              Just (lnkId', _) | lnkId' /= lnkId -> pure $ Left AUTH
+              _ -> OK <$$ addQueueLinkData (queueStore ms) q lnkId d
           LDEL ->
-            withQueue $ \q qr -> checkMode QMContact qr $ liftIO $ case queueData qr of
+            withQueue $ \q qr -> checkContact qr $ liftIO $ case queueData qr of
               Just _ -> OK <$$ deleteQueueLinkData (queueStore ms) q
               Nothing -> pure $ Right OK
           NKEY nKey dhKey -> withQueue $ \q _ -> addQueueNotifier_ q nKey dhKey
@@ -1327,6 +1324,13 @@ client
                         pure $ IDS QIK {rcvId, sndId, rcvPublicDhKey, queueMode, linkId = fst <$> queueData} -- , serverNtfCreds = snd <$> ntf
           (corrId,entId,) <$> tryCreate (3 :: Int)
 
+        -- this check allows to support contact queues created prior to SKEY,
+        -- using `queueMode == Just QMContact` would prevent it, as they have queueMode `Nothing`.
+        checkContact :: QueueRec -> M (Either ErrorType BrokerMsg) -> M (Transmission BrokerMsg)
+        checkContact qr a =
+          either err (corrId,entId,)
+            <$> if isContactQueue qr then a else pure $ Left AUTH
+
         checkMode :: QueueMode -> QueueRec -> M (Either ErrorType BrokerMsg) -> M (Transmission BrokerMsg)
         checkMode qm QueueRec {queueMode} a =
           either err (corrId,entId,)

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

@@ -25,6 +25,7 @@ module Simplex.Messaging.Server.QueueStore.Postgres
     foldQueueRecs,
     handleDuplicate,
     withLog_,
+    withDB',
   )
 where
 
@@ -138,7 +139,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
           db
           [sql|
             SELECT
-              (SELECT COUNT(1) FROM msg_queues WHERE deleted_at IS NULL) AS queue_count, 
+              (SELECT COUNT(1) FROM msg_queues WHERE deleted_at IS NULL) AS queue_count,
               (SELECT COUNT(1) FROM msg_queues WHERE deleted_at IS NULL AND notifier_id IS NOT NULL) AS notifier_count
           |]
       pure QueueCounts {queueCount, notifierCount}
@@ -221,7 +222,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
       _ -> throwE AUTH
 
   addQueueLinkData :: PostgresQueueStore q -> q -> LinkId -> QueueLinkData -> IO (Either ErrorType ())
-  addQueueLinkData st sq lnkId d = 
+  addQueueLinkData st sq lnkId d =
     withQueueRec sq "addQueueLinkData" $ \q -> case queueData q of
       Nothing ->
         addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId))
@@ -335,7 +336,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
   unblockQueue st sq =
     setStatusDB "unblockQueue" st sq EntityActive $
       withLog "unblockQueue" st (`logUnblockQueue` recipientId sq)
-  
+
   updateQueueTime :: PostgresQueueStore q -> q -> RoundedSystemTime -> IO (Either ErrorType QueueRec)
   updateQueueTime st sq t =
     withQueueRec sq "updateQueueTime" $ \q@QueueRec {updatedAt} ->