core: change logic of checking if peer supports feature (check if peer version is compatible) (#3024)

cabal.project

@@ -9,7 +9,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 980e5c4d1ec15f44290542fd2a5d1c08456f00d1
+    tag: 351f42650c57f310fc1ea858ff9b7178823f1fd4
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."980e5c4d1ec15f44290542fd2a5d1c08456f00d1" = "1lqciyy215dvmbhykyp80bwipqmxybv39p6jff6vjgd5r34958nh";
+  "https://github.com/simplex-chat/simplexmq.git"."351f42650c57f310fc1ea858ff9b7178823f1fd4" = "12r13yc0qk9dkii58808862wraqrk66rzmkrgyp6lg1xrazrd0d2";
   "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
   "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
   "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";

src/Simplex/Chat.hs

@@ -1866,7 +1866,7 @@ processChatCommand = \case
       xftpCfg <- readTVarIO =<< asks userXFTPFileConfig
       fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cfArgs
       when (fromInteger fileSize > maxFileSize) $ throwChatError $ CEFileSize f
-      let chunks = -((-fileSize) `div` fileChunkSize)
+      let chunks = - ((- fileSize) `div` fileChunkSize)
           fileInline = inlineFileMode mc inlineFiles chunks n
           fileMode = case xftpCfg of
             Just cfg
@@ -2566,7 +2566,7 @@ cleanupManager = do
           `catchChatError` (toView . CRChatError (Just user))
     cleanupMessages = do
       ts <- liftIO getCurrentTime
-      let cutoffTs = addUTCTime (-(30 * nominalDay)) ts
+      let cutoffTs = addUTCTime (- (30 * nominalDay)) ts
       withStoreCtx' (Just "cleanupManager, deleteOldMessages") (`deleteOldMessages` cutoffTs)
 
 startProximateTimedItemThread :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m ()
@@ -3040,11 +3040,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           case cReq of
             groupConnReq@(CRInvitationUri _ _) -> case cmdFunction of
               -- [async agent commands] XGrpMemIntro continuation on receiving INV
-              CFCreateConnGrpMemInv ->
-                ifM
-                  (featureVersionSupported (peerChatVRange conn) groupNoDirectVersion)
-                  sendWithoutDirectCReq
-                  sendWithDirectCReq
+              CFCreateConnGrpMemInv
+                | isCompatibleRange (peerChatVRange conn) groupNoDirectVRange -> sendWithoutDirectCReq
+                | otherwise -> sendWithDirectCReq
                 where
                   sendWithoutDirectCReq = do
                     let GroupMember {groupMemberId, memberId} = m
@@ -4291,11 +4289,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               groupConnIds <- createConn
               directConnIds <- case memberChatVRange of
                 Nothing -> Just <$> createConn
-                Just mcvr ->
-                  ifM
-                    (featureVersionSupported (fromChatVRange mcvr) groupNoDirectVersion)
-                    (pure Nothing)
-                    (Just <$> createConn)
+                Just mcvr
+                  | isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> pure Nothing
+                  | otherwise -> Just <$> createConn
               let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing
               void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnIds directConnIds customUserProfileId
         _ -> messageError "x.grp.mem.intro can be only sent by host member"
@@ -4488,13 +4484,6 @@ updatePeerChatVRange conn@Connection {connId, peerChatVRange} msgChatVRange
     pure conn {peerChatVRange = msgChatVRange}
   | otherwise = pure conn
 
-featureVersionSupported :: ChatMonad' m => VersionRange -> Version -> m Bool
-featureVersionSupported peerVRange v = do
-  ChatConfig {chatVRange} <- asks config
-  case chatVRange `compatibleVersion` peerVRange of
-    Just (Compatible v') -> pure $ v' >= v
-    Nothing -> pure False
-
 parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p)
 parseFileDescription =
   liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8)

src/Simplex/Chat/Protocol.hs

@@ -54,9 +54,9 @@ currentChatVersion = 2
 supportedChatVRange :: VersionRange
 supportedChatVRange = mkVersionRange 1 currentChatVersion
 
--- version that starts support for skipping establishing direct connections in a group
-groupNoDirectVersion :: Version
-groupNoDirectVersion = 3 -- 2
+-- version range that supports skipping establishing direct connections in a group
+groupNoDirectVRange :: VersionRange
+groupNoDirectVRange = mkVersionRange 2 currentChatVersion
 
 data ConnectionEntity
   = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 980e5c4d1ec15f44290542fd2a5d1c08456f00d1
+    commit: 351f42650c57f310fc1ea858ff9b7178823f1fd4
   - github: kazu-yamamoto/http2
     commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
   # - ../direct-sqlcipher

tests/Bots/DirectoryTests.hs

@@ -795,7 +795,7 @@ withDirectoryServiceCfg tmp cfg test = do
         connectUsers ds superUser
         ds ##> "/ad"
         getContactLink ds True
-  withDirectory tmp dsLink test
+  withDirectory tmp cfg dsLink test
 
 restoreDirectoryService :: HasCallStack => FilePath -> Int -> Int -> (TestCC -> String -> IO ()) -> IO ()
 restoreDirectoryService tmp ctCount grCount test = do
@@ -809,24 +809,24 @@ restoreDirectoryService tmp ctCount grCount test = do
       dsLink <- getContactLink ds False
       ds <## "auto_accept on"
       pure dsLink
-  withDirectory tmp dsLink test
+  withDirectory tmp testCfg dsLink test
 
-withDirectory :: HasCallStack => FilePath -> String -> (TestCC -> String -> IO ()) -> IO ()
-withDirectory tmp dsLink test = do
+withDirectory :: HasCallStack => FilePath -> ChatConfig -> String -> (TestCC -> String -> IO ()) -> IO ()
+withDirectory tmp cfg dsLink test = do
   let opts = mkDirectoryOpts tmp [KnownContact 2 "alice"]
-  runDirectory opts $
-    withTestChat tmp "super_user" $ \superUser -> do
+  runDirectory cfg opts $
+    withTestChatCfg tmp cfg "super_user" $ \superUser -> do
       superUser <## "1 contacts connected (use /cs for the list)"
       test superUser dsLink
 
-runDirectory :: DirectoryOpts -> IO () -> IO ()
-runDirectory opts@DirectoryOpts {directoryLog} action = do
+runDirectory :: ChatConfig -> DirectoryOpts -> IO () -> IO ()
+runDirectory cfg opts@DirectoryOpts {directoryLog} action = do
   st <- restoreDirectoryStore directoryLog
   t <- forkIO $ bot st
   threadDelay 500000
   action `finally` (mapM_ hClose (directoryLogFile st) >> killThread t)
   where
-    bot st = simplexChatCore testCfg (mkChatOpts opts) Nothing $ directoryService st opts
+    bot st = simplexChatCore cfg (mkChatOpts opts) Nothing $ directoryService st opts
 
 registerGroup :: TestCC -> TestCC -> String -> String -> IO ()
 registerGroup su u n fn = registerGroupId su u n fn 1 1

tests/ChatClient.hs

@@ -22,7 +22,6 @@ import Simplex.Chat
 import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..))
 import Simplex.Chat.Core
 import Simplex.Chat.Options
-import Simplex.Chat.Protocol (groupNoDirectVersion)
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Terminal
@@ -142,7 +141,7 @@ mkCfgCreateGroupDirect :: ChatConfig -> ChatConfig
 mkCfgCreateGroupDirect cfg = cfg {chatVRange = groupCreateDirectVRange}
 
 groupCreateDirectVRange :: VersionRange
-groupCreateDirectVRange = mkVersionRange 1 (groupNoDirectVersion - 1)
+groupCreateDirectVRange = mkVersionRange 1 1
 
 createTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
 createTestChat tmp cfg opts@ChatOpts {coreOptions = CoreChatOpts {dbKey}} dbPrefix profile = do

tests/ChatTests/Groups.hs

@@ -68,17 +68,17 @@ chatGroupTests = do
     it "should send delivery receipts in group depending on configuration" testConfigureGroupDeliveryReceipts
   describe "direct connections in group are not established based on chat protocol version" $ do
     describe "3 members group" $ do
-      testNoDirect _0 _0 False -- True
-      testNoDirect _0 _1 False
+      testNoDirect _0 _0 True
+      testNoDirect _0 _1 True
       testNoDirect _1 _0 False
       testNoDirect _1 _1 False
     describe "4 members group" $ do
-      testNoDirect4 _0 _0 _0 False False False -- True True True
-      testNoDirect4 _0 _0 _1 False False False -- True False False
-      testNoDirect4 _0 _1 _0 False False False -- False True False
-      testNoDirect4 _0 _1 _1 False False False
-      testNoDirect4 _1 _0 _0 False False False -- False False True
-      testNoDirect4 _1 _0 _1 False False False
+      testNoDirect4 _0 _0 _0 True True True
+      testNoDirect4 _0 _0 _1 True True True
+      testNoDirect4 _0 _1 _0 True True False
+      testNoDirect4 _0 _1 _1 True True False
+      testNoDirect4 _1 _0 _0 False False True
+      testNoDirect4 _1 _0 _1 False False True
       testNoDirect4 _1 _1 _0 False False False
       testNoDirect4 _1 _1 _1 False False False
   where