refactor

src/Simplex/Chat/Library/Commands.hs

@@ -4164,14 +4164,25 @@ processChatCommand cxt nm = \case
         _ -> throwCmdError "not supported"
       processChatCommand cxt nm $ APISetChatSettings (ChatRef cType chatId Nothing) $ updateSettings chatSettings
     connectPlan :: User -> ConnectTarget -> Bool -> Maybe LinkOwnerSig -> CM (ACreatedConnLink, ConnectionPlan)
-    connectPlan user ct resolveKnown sig_ =
-      lookupName user ct >>= \case
-        Left planned -> pure planned
-        Right l -> case ct of
-          CTLink _ -> connectPlanLink user l resolveKnown sig_
-          CTName ni -> do
-            (ccLink, plan) <- connectPlanLink user l False Nothing
-            verifyName user ni ccLink plan
+    connectPlan user target resolveKnown sig_ =
+      withFastStore (\db -> getContactToConnect db cxt user target') >>= \case
+        Just (cReq, ct) | not (contactDeleted ct) -> pure (knownLink cReq, CPContactAddress (CAPKnown ct))
+        _ ->
+          withFastStore (\db -> getGroupToConnect db cxt user target') >>= \case
+            Just (cReq, g) | not (memberRemoved (membership g)) -> pure (knownLink cReq, CPGroupLink (GLPKnown g (BoolDef False) Nothing (ListDef [])))
+            _ -> case target' of
+              CTLink l -> connectPlanLink user l resolveKnown sig_
+              CTName ni -> do
+                l <- resolveNameLink user ni
+                (ccLink, plan) <- connectPlanLink user l False Nothing
+                verifyName user ni ccLink plan
+      where
+        target' = case target of
+          CTLink (ACL SCMContact (CLShort sl)) -> CTLink (ACL SCMContact (CLShort (serverShortLink sl)))
+          _ -> target
+        knownLink cReq = ACCL SCMContact $ CCLink cReq $ case target' of
+          CTLink (ACL SCMContact (CLShort sl)) -> Just sl
+          _ -> Nothing
     connectPlanLink :: User -> AConnectionLink -> Bool -> Maybe LinkOwnerSig -> CM (ACreatedConnLink, ConnectionPlan)
     connectPlanLink user (ACL SCMInvitation cLink) _ sig_ = case cLink of
       CLFull cReq -> invitationReqAndPlan cReq Nothing Nothing Nothing
@@ -4217,17 +4228,13 @@ processChatCommand cxt nm = \case
               knownLinkPlans = withFastStore $ \db ->
                 liftIO (getUserContactLinkViaShortLink db user l') >>= \case
                   Just UserContactLink {connLinkContact = CCLink cReq _} -> pure $ Just (con cReq, CPContactAddress CAPOwnLink)
-                  Nothing ->
-                    getContactViaShortLinkToConnect db cxt user l' >>= \case
-                      Just (cReq, ct') -> pure $ if contactDeleted ct' then Nothing else Just (con cReq, CPContactAddress (CAPKnown ct'))
-                      Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db cxt user l'
+                  Nothing -> pure Nothing
           CCTGroup -> groupShortLinkPlan
           CCTChannel -> groupShortLinkPlan
           CCTRelay -> throwCmdError "chat relay links are not supported in this version"
         where
           l' = serverShortLink l
           con cReq = ACCL SCMContact $ CCLink cReq (Just l')
-          gPlan (cReq, g) = if memberRemoved (membership g) then Nothing else Just (con cReq, CPGroupLink (GLPKnown g (BoolDef False) Nothing (ListDef [])))
           groupShortLinkPlan =
             knownLinkPlans >>= \case
               Just (_, CPGroupLink (GLPKnown g _ _ _))
@@ -4258,7 +4265,7 @@ processChatCommand cxt nm = \case
               knownLinkPlans = withFastStore $ \db ->
                 liftIO (getGroupInfoViaUserShortLink db cxt user l') >>= \case
                   Just (cReq, g) -> pure $ Just (con cReq, CPGroupLink (GLPOwnLink g))
-                  Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db cxt user l'
+                  Nothing -> pure Nothing
               resolveKnownGroup g = do
                 (fd@FixedLinkData {rootKey = rk}, cData@(ContactLinkData _ UserContactData {owners})) <- getShortLinkConnReq' nm user l'
                 groupSLinkData_ <- liftIO $ decodeLinkUserData cData
@@ -4268,43 +4275,6 @@ processChatCommand cxt nm = \case
                   Just sLinkData -> updateGroupFromLinkData user g sLinkData
                   _ -> pure (g, False)
                 pure (con (linkConnReq fd), CPGroupLink (GLPKnown g' (BoolDef updated) ov (ListDef glOwners)))
-    -- existence check on the target; the extra resolve happens only for a name
-    lookupName :: User -> ConnectTarget -> CM (Either (ACreatedConnLink, ConnectionPlan) AConnectionLink)
-    lookupName user = \case
-      CTLink l -> pure (Right l)
-      CTName ni -> maybe (Right <$> resolveNameLink user ni) (pure . Left) =<< knownByName user ni
-    -- a contact/group already connected under this name, with the link to reconnect through
-    knownByName :: User -> SimplexNameInfo -> CM (Maybe (ACreatedConnLink, ConnectionPlan))
-    knownByName user ni@SimplexNameInfo {nameType} = case nameType of
-      NTContact -> do
-        ct_ <- withFastStore $ \db -> getContactBySimplexName db cxt user ni
-        case ct_ of
-          Just ct@Contact {profile = LocalProfile {contactLink = ctLink_}} -> case preparedContact ct of
-            Just PreparedContact {connLinkToConnect} -> pure $ Just (connLinkToConnect, CPContactAddress (CAPKnown ct))
-            Nothing -> case ctLink_ of
-              Just (CLFull cReq) -> pure $ Just (ACCL SCMContact (CCLink cReq Nothing), CPContactAddress (CAPKnown ct))
-              Just (CLShort sLnk) ->
-                let l' = serverShortLink sLnk
-                 in withFastStore (\db -> getContactViaShortLinkToConnect db cxt user l') >>= \case
-                      Just (cReq, ct') | not (contactDeleted ct') -> pure $ Just (ACCL SCMContact (CCLink cReq (Just l')), CPContactAddress (CAPKnown ct'))
-                      _ -> pure Nothing
-              Nothing -> pure Nothing
-          Nothing -> pure Nothing
-      NTPublicGroup -> do
-        g_ <- withFastStore $ \db -> getGroupInfoBySimplexName db cxt user ni
-        case g_ of
-          Just g | memberRemoved (membership g) -> pure Nothing
-          Just g@GroupInfo {groupProfile = GroupProfile {publicGroup}} -> case preparedGroup g of
-            Just PreparedGroup {connLinkToConnect = ccLink} ->
-              pure $ Just (ACCL SCMContact ccLink, CPGroupLink (GLPKnown g (BoolDef False) Nothing (ListDef [])))
-            Nothing -> case publicGroup of
-              Just PublicGroupProfile {groupLink} ->
-                let l' = serverShortLink groupLink
-                 in withFastStore (\db -> getGroupViaShortLinkToConnect db cxt user l') >>= \case
-                      Just (cReq, g') | not (memberRemoved (membership g')) -> pure $ Just (ACCL SCMContact (CCLink cReq (Just l')), CPGroupLink (GLPKnown g' (BoolDef False) Nothing (ListDef [])))
-                      _ -> pure Nothing
-              Nothing -> pure Nothing
-          Nothing -> pure Nothing
     -- resolve a name to its first contact/channel short link
     resolveNameLink :: User -> SimplexNameInfo -> CM AConnectionLink
     resolveNameLink user ni@SimplexNameInfo {nameType, nameDomain} = do

src/Simplex/Chat/Store/Direct.hs

@@ -46,11 +46,10 @@ module Simplex.Chat.Store.Direct
     deleteContactWithoutGroups,
     getDeletedContacts,
     getContactByName,
-    getContactBySimplexName,
+    getContactToConnect,
     getContact,
     getContactViaShortLinkToConnect,
     getContactIdByName,
-    getContactIdBySimplexName,
     updateContactProfile,
     setContactDomainVerified,
     updateContactUserPreferences,
@@ -114,7 +113,7 @@ import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.UITheme
-import Simplex.Messaging.Agent.Protocol (AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionModeI (..), ConnectionRequestUri, CreatedConnLink (..), SimplexNameInfo, UserId)
+import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), AConnectionRequestUri (..), ACreatedConnLink (..), ConnId, ConnShortLink, ConnectionLink (..), ConnectionModeI (..), ConnectionRequestUri, ConnectTarget (..), CreatedConnLink (..), SConnectionMode (..), SimplexNameInfo, UserId)
 import Simplex.Messaging.Encoding.String (StrJSON (..))
 import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
 import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
@@ -799,23 +798,23 @@ getContactByName db cxt user localDisplayName = do
   cId <- getContactIdByName db user localDisplayName
   getContact db cxt user cId
 
-getContactBySimplexName :: DB.Connection -> StoreCxt -> User -> SimplexNameInfo -> ExceptT StoreError IO (Maybe Contact)
-getContactBySimplexName db cxt user ni =
-  liftIO (getContactIdBySimplexName db user ni) >>= \case
-    Nothing -> pure Nothing
-    Just cId -> Just <$> getContact db cxt user cId
-
-getContactIdBySimplexName :: DB.Connection -> User -> SimplexNameInfo -> IO (Maybe Int64)
-getContactIdBySimplexName db User {userId} ni =
-  maybeFirstRow fromOnly $
-    DB.query
-      db
+-- a contact to connect to, found by the connect target: by its address short link, or by its verified name
+getContactToConnect :: DB.Connection -> StoreCxt -> User -> ConnectTarget -> ExceptT StoreError IO (Maybe (ConnReqContact, Contact))
+getContactToConnect db cxt user@User {userId} = \case
+  CTLink (ACL SCMContact (CLShort sl)) -> getContactViaShortLinkToConnect db cxt user sl
+  CTName ni ->
+    liftIO (maybeFirstRow id $ DB.query db byNameQuery (userId, ni)) >>= \case
+      Just (ctId :: Int64, Just (ACR cMode cReq)) | Just Refl <- testEquality cMode SCMContact ->
+        Just . (cReq,) <$> getContact db cxt user ctId
+      _ -> pure Nothing
+  _ -> pure Nothing
+  where
+    byNameQuery =
       [sql|
-        SELECT ct.contact_id FROM contacts ct
+        SELECT ct.contact_id, ct.conn_full_link_to_connect FROM contacts ct
         JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
         WHERE ct.user_id = ? AND cp.contact_domain = ? AND cp.contact_domain_verification = 1 AND ct.deleted = 0
       |]
-      (userId, ni)
 
 getUserContacts :: DB.Connection -> StoreCxt -> User -> IO [Contact]
 getUserContacts db cxt user@User {userId} = do

src/Simplex/Chat/Store/Groups.hs

@@ -50,11 +50,10 @@ module Simplex.Chat.Store.Groups
     updateGroupPreferences,
     updateGroupProfileFromMember,
     getGroupIdByName,
-    getGroupIdBySimplexName,
     getGroupMemberIdByName,
     getActiveMembersByName,
     getGroupInfoByName,
-    getGroupInfoBySimplexName,
+    getGroupToConnect,
     getGroupMember,
     getHostMember,
     getMentionedGroupMember,
@@ -234,7 +233,7 @@ import Simplex.Chat.Types.MemberRelations (IntroductionDirection (..), MemberRel
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
-import Simplex.Messaging.Agent.Protocol (ConfirmationId, ConnId, CreatedConnLink (..), InvitationId, OwnerAuth (..), SimplexNameInfo, UserId)
+import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConfirmationId, ConnId, ConnectionLink (..), ConnectTarget (..), CreatedConnLink (..), InvitationId, OwnerAuth (..), SConnectionMode (..), SimplexNameInfo, UserId)
 import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
 import qualified Simplex.FileTransfer.Description as FD
 import Simplex.Messaging.Encoding (smpDecode, smpEncode)
@@ -1075,23 +1074,22 @@ getGroupInfoByName db cxt user gName = do
   gId <- getGroupIdByName db user gName
   getGroupInfo db cxt user gId
 
-getGroupInfoBySimplexName :: DB.Connection -> StoreCxt -> User -> SimplexNameInfo -> ExceptT StoreError IO (Maybe GroupInfo)
-getGroupInfoBySimplexName db cxt user ni =
-  liftIO (getGroupIdBySimplexName db user ni) >>= \case
-    Nothing -> pure Nothing
-    Just gId -> Just <$> getGroupInfo db cxt user gId
-
-getGroupIdBySimplexName :: DB.Connection -> User -> SimplexNameInfo -> IO (Maybe GroupId)
-getGroupIdBySimplexName db User {userId} ni =
-  maybeFirstRow fromOnly $
-    DB.query
-      db
+-- a group to connect to, found by the connect target: by its address short link, or by its verified name
+getGroupToConnect :: DB.Connection -> StoreCxt -> User -> ConnectTarget -> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
+getGroupToConnect db cxt user@User {userId} = \case
+  CTLink (ACL SCMContact (CLShort sl)) -> getGroupViaShortLinkToConnect db cxt user sl
+  CTName ni ->
+    liftIO (maybeFirstRow id $ DB.query db byNameQuery (userId, ni)) >>= \case
+      Just (gId :: Int64, Just cReq) -> Just . (cReq,) <$> getGroupInfo db cxt user gId
+      _ -> pure Nothing
+  _ -> pure Nothing
+  where
+    byNameQuery =
       [sql|
-        SELECT g.group_id FROM groups g
+        SELECT g.group_id, g.conn_full_link_to_connect FROM groups g
         JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
         WHERE g.user_id = ? AND gp.group_domain = ? AND g.group_domain_verification = 1
       |]
-      (userId, ni)
 
 getGroupMember :: DB.Connection -> StoreCxt -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
 getGroupMember db cxt user@User {userId} groupId groupMemberId = do