core: change relay link type (#6411)

src/Simplex/Chat/Library/Commands.hs

@@ -2026,19 +2026,22 @@ processChatCommand vr nm = \case
     CRContactsList user <$> withFastStore' (\db -> getUserContacts db vr user)
   ListContacts -> withUser $ \User {userId} ->
     processChatCommand vr nm $ APIListContacts userId
-  APICreateMyAddress userId -> withUserId userId $ \user -> do
+  APICreateMyAddress userId -> withUserId userId $ \user@User {userChatRelay} -> do
     withFastStore' (\db -> runExceptT $ getUserAddress db user) >>= \case
       Left SEUserContactLinkNotFound -> pure ()
       Left e -> throwError $ ChatErrorStore e
       Right _ -> throwError $ ChatErrorStore SEDuplicateContactLink
     subMode <- chatReadVar subscriptionMode
-    -- TODO [chat relays] add relay key, identity to link data
+    -- TODO [chat relays] relay address creation:
+    -- TODO               - add relay key, identity to link data
+    -- TODO               - validate short link is created (returned by agent)
     let userData = contactShortLinkData (userProfileDirect user Nothing Nothing True) Nothing
     -- TODO [certs rcv]
     (connId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a nm (aUserId user) True True SCMContact (Just userData) Nothing IKPQOn subMode
     ccLink' <- shortenCreatedLink ccLink
-    withFastStore $ \db -> createUserContactLink db user connId ccLink' subMode
-    pure $ CRUserContactLinkCreated user ccLink'
+    let ccLink'' = if isTrue userChatRelay then createdRelayLink ccLink' else ccLink'
+    withFastStore $ \db -> createUserContactLink db user connId ccLink'' subMode
+    pure $ CRUserContactLinkCreated user ccLink''
   CreateMyAddress -> withUser $ \User {userId} ->
     processChatCommand vr nm $ APICreateMyAddress userId
   APIDeleteMyAddress userId -> withUserId userId $ \user@User {profile = p} -> do

src/Simplex/Chat/Library/Internal.hs

@@ -1272,6 +1272,12 @@ createdGroupLink (CCLink cReq shortLink) = CCLink cReq (toShortGroupLink <$> sho
 toShortGroupLink :: ShortLinkContact -> ShortLinkContact
 toShortGroupLink (CSLContact sch _ srv k) = CSLContact sch CCTGroup srv k
 
+createdRelayLink :: CreatedLinkContact -> CreatedLinkContact
+createdRelayLink (CCLink cReq shortLink) = CCLink cReq (toShortRelayLink <$> shortLink)
+
+toShortRelayLink :: ShortLinkContact -> ShortLinkContact
+toShortRelayLink (CSLContact sch _ srv k) = CSLContact sch CCTRelay srv k
+
 deleteGroupLink' :: User -> GroupInfo -> CM ()
 deleteGroupLink' user gInfo = do
   vr <- chatVersionRange

src/Simplex/Chat/Operators.hs

@@ -46,9 +46,9 @@ import Data.Time (addUTCTime)
 import Data.Time.Clock (UTCTime, nominalDay)
 import Language.Haskell.TH.Syntax (lift)
 import Simplex.Chat.Operators.Conditions
-import Simplex.Chat.Types (ConnLinkContact, User)
+import Simplex.Chat.Types (ShortLinkContact, User)
 import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
-import Simplex.Messaging.Agent.Protocol (sameConnLinkContact)
+import Simplex.Messaging.Agent.Protocol (sameShortLinkContact)
 import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
 import Simplex.Messaging.Agent.Store.Entity
 import Simplex.Messaging.Encoding.String
@@ -261,7 +261,7 @@ deriving instance Show AUserChatRelay
 
 data UserChatRelay' s = UserChatRelay
   { chatRelayId :: DBEntityId' s,
-    address :: ConnLinkContact,
+    address :: ShortLinkContact,
     name :: Text,
     domains :: [Text],
     preset :: Bool,
@@ -273,7 +273,7 @@ data UserChatRelay' s = UserChatRelay
 
 -- for setting chat relays via CLI API
 data CLINewRelay = CLINewRelay
-  { address :: ConnLinkContact,
+  { address :: ShortLinkContact,
     name :: Text
   }
   deriving (Show)
@@ -318,15 +318,15 @@ newUserServer_ :: Bool -> Bool -> ProtoServerWithAuth p -> NewUserServer p
 newUserServer_ preset enabled server =
   UserServer {serverId = DBNewEntity, server, preset, tested = Nothing, enabled, deleted = False}
 
-presetChatRelay :: Bool -> Text -> [Text] -> ConnLinkContact -> NewUserChatRelay
+presetChatRelay :: Bool -> Text -> [Text] -> ShortLinkContact -> NewUserChatRelay
 presetChatRelay = newChatRelay_ True
 {-# INLINE presetChatRelay #-}
 
-newChatRelay :: Text -> [Text] -> ConnLinkContact -> NewUserChatRelay
+newChatRelay :: Text -> [Text] -> ShortLinkContact -> NewUserChatRelay
 newChatRelay = newChatRelay_ False True
 {-# INLINE newChatRelay #-}
 
-newChatRelay_ :: Bool -> Bool -> Text -> [Text] -> ConnLinkContact -> NewUserChatRelay
+newChatRelay_ :: Bool -> Bool -> Text -> [Text] -> ShortLinkContact -> NewUserChatRelay
 newChatRelay_ preset enabled name domains !address =
   UserChatRelay {chatRelayId = DBNewEntity, address, name, domains, preset, tested = Nothing, enabled, deleted = False}
 
@@ -477,7 +477,7 @@ data UserServersError
   | USEProxyMissing {protocol :: AProtocolType, user :: Maybe User}
   | USEDuplicateServer {protocol :: AProtocolType, duplicateServer :: Text, duplicateHost :: TransportHost}
   | USEDuplicateChatRelayName {duplicateChatRelay :: Text}
-  | USEDuplicateChatRelayAddress {duplicateChatRelay :: Text, duplicateAddress :: ConnLinkContact}
+  | USEDuplicateChatRelayAddress {duplicateChatRelay :: Text, duplicateAddress :: ShortLinkContact}
   deriving (Show)
 
 data UserServersWarning = USWNoChatRelays {user :: Maybe User}
@@ -520,9 +520,9 @@ validateUserServers curr others = (currUserErrs <> concatMap otherUserErrs other
         allNames = map (\(AUCR _ UserChatRelay {name}) -> name) cRelays
         duplicateAddresses = snd $ foldl' addAddress ([], []) allAddresses
         allAddresses = map (\(AUCR _ UserChatRelay {address}) -> address) cRelays
-        addAddress :: ([ConnLinkContact], [ConnLinkContact]) -> ConnLinkContact -> ([ConnLinkContact], [ConnLinkContact])
+        addAddress :: ([ShortLinkContact], [ShortLinkContact]) -> ShortLinkContact -> ([ShortLinkContact], [ShortLinkContact])
         addAddress (xs, dups) x
-          | any (sameConnLinkContact x) xs = (xs, x : dups)
+          | any (sameShortLinkContact x) xs = (xs, x : dups)
           | otherwise = (x : xs, dups)
     currUserWarns = noChatRelaysWarns Nothing curr
     otherUserWarns (user, uss) = noChatRelaysWarns (Just user) uss

src/Simplex/Chat/Operators/Presets.hs

@@ -91,9 +91,9 @@ disabledSimplexChatSMPServers =
 -- TODO [chat relays] real chat relays
 simplexChatRelays :: [NewUserChatRelay]
 simplexChatRelays =
-  [ presetChatRelay True "chat_relay_1" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp111.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D"),
-    presetChatRelay True "chat_relay_2" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp222.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D"),
-    presetChatRelay True "chat_relay_3" ["simplex.im"] (either error id $ strDecode "simplex:/contact#/?v=2-7&smp=smp%3A%2F%2FLcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI%3D%40smp333.simplex.im%2Fu8A5BHVvIPOf83Qk%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAiyjKN0nmkp3mFzQxHiLTtRkX3rcp_BKfYF4xtwF9g1o%253D")
+  [ presetChatRelay True "chat_relay_1" ["simplex.im"] (either error id $ strDecode "https://smp111.simplex.im/r#Pz9qz7ZVljMofoRxiDDpL_w2DZSazK8IgafxqnWKv6Y"),
+    presetChatRelay True "chat_relay_2" ["simplex.im"] (either error id $ strDecode "https://smp222.simplex.im/r#Pz9qz7ZVljMofoRxiDDpL_w2DZSazK8IgafxqnWKv6Y"),
+    presetChatRelay True "chat_relay_3" ["simplex.im"] (either error id $ strDecode "https://smp333.simplex.im/r#Pz9qz7ZVljMofoRxiDDpL_w2DZSazK8IgafxqnWKv6Y")
   ]
 
 fluxSMPServers :: [NewUserServer 'PSMP]

src/Simplex/Chat/Store/Profiles.hs

@@ -625,7 +625,7 @@ getChatRelays db User {userId} =
       |]
       (Only userId)
   where
-    toChatRelay :: (DBEntityId, ConnLinkContact, Text, Text, BoolInt, Maybe BoolInt, BoolInt) -> UserChatRelay
+    toChatRelay :: (DBEntityId, ShortLinkContact, Text, Text, BoolInt, Maybe BoolInt, BoolInt) -> UserChatRelay
     toChatRelay (chatRelayId, address, name, domains, BI preset, tested, BI enabled) =
       UserChatRelay {chatRelayId, address, name, domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted = False}