diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 157564fbe1..d52868d4bb 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1946,7 +1946,7 @@ processChatCommand vr nm = \case groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences groupProfile = businessGroupProfile profile groupPreferences gVar <- asks random - (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user groupProfile True ccLink welcomeSharedMsgId False GRMember Nothing + (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user groupProfile True (toPreparedConnLink ccLink) welcomeSharedMsgId False GRMember Nothing hostMember <- maybe (throwCmdError "no host member") pure hostMember_ void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) let cd = CDGroupRcv gInfo Nothing hostMember @@ -1978,7 +1978,7 @@ processChatCommand vr nm = \case let useRelays = not direct subRole <- if useRelays then asks $ channelSubscriberRole . config else pure GRMember gVar <- asks random - (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user gp False ccLink welcomeSharedMsgId useRelays subRole publicMemberCount_ + (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar vr user gp False (toPreparedConnLink ccLink) welcomeSharedMsgId useRelays subRole publicMemberCount_ void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) let cd = maybe (CDChannelRcv gInfo Nothing) (CDGroupRcv gInfo Nothing) hostMember_ cInfo = GroupChat gInfo Nothing @@ -2059,7 +2059,7 @@ processChatCommand vr nm = \case gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId case gInfo of GroupInfo {preparedGroup = Nothing} -> throwCmdError "group doesn't have link to connect" - GroupInfo {useRelays = BoolDef True, preparedGroup = Just PreparedGroup {connLinkToConnect = PreparedGroupLink {connShortLink = sLnk_}}} -> do + GroupInfo {useRelays = BoolDef True, preparedGroup = Just PreparedGroup {connLinkToConnect = PreparedConnLink {connShortLink = sLnk_}}} -> do sLnk <- case sLnk_ of Just sl -> pure sl Nothing -> throwChatError $ CEException "failed to retrieve relays: no short link" @@ -2136,7 +2136,7 @@ processChatCommand vr nm = \case newConnIds <- getAgentConnShortLinkAsync user CFGetRelayDataJoin Nothing relayLink withStore' $ \db -> createRelayMemberConnectionAsync db user gInfo' relayMember relayLink newConnIds subMode GroupInfo {preparedGroup = Just PreparedGroup {connLinkToConnect, welcomeSharedMsgId, requestSharedMsgId}} -> do - ccLink <- case toCreatedLinkContact connLinkToConnect of + ccLink <- case toCreatedConnLink connLinkToConnect of Just cl -> pure cl Nothing -> throwChatError $ CEException "no full link to connect" hostMember <- withFastStore $ \db -> getHostMember db vr user groupId diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 86315266d9..71ea9d2d6d 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -601,10 +601,10 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile { DB.execute db "DELETE FROM contacts WHERE contact_id = ?" (Only contactId) DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId) -createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember) +createPreparedGroup :: DB.Connection -> TVar ChaChaDRG -> VersionRangeChat -> User -> GroupProfile -> Bool -> PreparedGroupLink -> Maybe SharedMsgId -> Bool -> GroupMemberRole -> Maybe Int64 -> ExceptT StoreError IO (GroupInfo, Maybe GroupMember) createPreparedGroup db gVar vr user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId useRelays userMemberRole publicMemberCount_ = do currentTs <- liftIO getCurrentTime - let prepared = Just (toPreparedGroupLink connLinkToConnect, welcomeSharedMsgId) + let prepared = Just (connLinkToConnect, welcomeSharedMsgId) (groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing useRelays Nothing publicMemberCount_ currentTs hostMemberId_ <- if useRelays diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 43324c5bb6..0f0f3e36dd 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -458,7 +458,7 @@ type NewPreparedGroupRow m = (Maybe (ConnectionRequestUri m), Maybe (ConnShortLi toPreparedGroupRow :: Maybe (PreparedGroupLink, Maybe SharedMsgId) -> NewPreparedGroupRow 'CMContact toPreparedGroupRow = \case - Just (PreparedGroupLink {connFullLink, connShortLink}, welcomeSharedMsgId) -> (connFullLink, connShortLink, welcomeSharedMsgId) + Just (PreparedConnLink {connFullLink, connShortLink}, welcomeSharedMsgId) -> (connFullLink, connShortLink, welcomeSharedMsgId) Nothing -> (Nothing, Nothing, Nothing) {-# INLINE toPreparedGroupRow #-} @@ -688,7 +688,7 @@ toPreparedGroup :: PreparedGroupRow -> Maybe PreparedGroup toPreparedGroup = \case (fullLink_, shortLink_, BI connLinkPreparedConnection, BI connLinkStartedConnection, welcomeSharedMsgId, requestSharedMsgId) | isJust fullLink_ || isJust shortLink_ -> - Just PreparedGroup {connLinkToConnect = PreparedGroupLink {connFullLink = fullLink_, connShortLink = shortLink_}, connLinkPreparedConnection, connLinkStartedConnection, welcomeSharedMsgId, requestSharedMsgId} + Just PreparedGroup {connLinkToConnect = PreparedConnLink {connFullLink = fullLink_, connShortLink = shortLink_}, connLinkPreparedConnection, connLinkStartedConnection, welcomeSharedMsgId, requestSharedMsgId} _ -> Nothing toPublicGroupProfile :: Maybe GroupType -> Maybe ShortLinkContact -> Maybe B64UrlByteString -> Maybe PublicGroupProfile diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 43a55a595a..bde932e632 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -52,7 +52,7 @@ import Simplex.Chat.Types.Shared import Simplex.Chat.Types.UITheme import Simplex.FileTransfer.Description (FileDigest) import Simplex.FileTransfer.Types (RcvFileId, SndFileId) -import Simplex.Messaging.Agent.Protocol (ACorrId, ACreatedConnLink, AEventTag (..), AEvtTag (..), ConnId, ConnShortLink (..), ConnectionLink, ConnectionMode (..), ConnectionRequestUri, ContactConnType (..), CreatedConnLink (..), InvitationId, SAEntity (..), UserId) +import Simplex.Messaging.Agent.Protocol (ACorrId, ACreatedConnLink, AEventTag (..), AEvtTag (..), ConnId, ConnShortLink (..), ConnectionLink, ConnectionMode (..), ConnectionModeI, ConnectionRequestUri, ContactConnType (..), CreatedConnLink (..), InvitationId, SAEntity (..), UserId) import Simplex.Messaging.Agent.Store.DB (Binary (..), blobFieldDecoder, fromTextField_) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) @@ -518,9 +518,9 @@ instance FromField BusinessChatType where fromField = fromTextField_ textDecode instance ToField BusinessChatType where toField = toField . textEncode -data PreparedGroupLink = PreparedGroupLink - { connFullLink :: Maybe ConnReqContact, - connShortLink :: Maybe ShortLinkContact +data PreparedConnLink (m :: ConnectionMode) = PreparedConnLink + { connFullLink :: Maybe (ConnectionRequestUri m), + connShortLink :: Maybe (ConnShortLink m) } deriving (Eq, Show) @@ -530,18 +530,23 @@ class HasShortLink l where instance HasShortLink CreatedConnLink where connShortLink' (CCLink _ sl) = sl +instance HasShortLink PreparedConnLink where + connShortLink' PreparedConnLink {connShortLink} = connShortLink + setShortLinkType :: ContactConnType -> CreatedLinkContact -> CreatedLinkContact setShortLinkType ct (CCLink cReq sl) = CCLink cReq (setShortLinkType_ ct <$> sl) setShortLinkType_ :: ContactConnType -> ShortLinkContact -> ShortLinkContact setShortLinkType_ ct (CSLContact sch _ srv k) = CSLContact sch ct srv k -toPreparedGroupLink :: CreatedLinkContact -> PreparedGroupLink -toPreparedGroupLink (CCLink fl sl) = PreparedGroupLink (Just fl) sl +toPreparedConnLink :: CreatedConnLink m -> PreparedConnLink m +toPreparedConnLink (CCLink fl sl) = PreparedConnLink (Just fl) sl -toCreatedLinkContact :: PreparedGroupLink -> Maybe CreatedLinkContact -toCreatedLinkContact PreparedGroupLink {connFullLink = Just fl, connShortLink} = Just $ CCLink fl connShortLink -toCreatedLinkContact _ = Nothing +toCreatedConnLink :: PreparedConnLink m -> Maybe (CreatedConnLink m) +toCreatedConnLink PreparedConnLink {connFullLink = Just fl, connShortLink} = Just $ CCLink fl connShortLink +toCreatedConnLink _ = Nothing + +type PreparedGroupLink = PreparedConnLink 'CMContact data PreparedGroup = PreparedGroup { connLinkToConnect :: PreparedGroupLink, @@ -2115,7 +2120,12 @@ $(JQ.deriveJSON (enumJSON $ dropPrefix "BC") ''BusinessChatType) $(JQ.deriveJSON defaultJSON ''BusinessChatInfo) -$(JQ.deriveJSON defaultJSON ''PreparedGroupLink) +instance ConnectionModeI m => FromJSON (PreparedConnLink m) where + parseJSON = $(JQ.mkParseJSON defaultJSON ''PreparedConnLink) + +instance ConnectionModeI m => ToJSON (PreparedConnLink m) where + toJSON = $(JQ.mkToJSON defaultJSON ''PreparedConnLink) + toEncoding = $(JQ.mkToEncoding defaultJSON ''PreparedConnLink) $(JQ.deriveJSON defaultJSON ''PreparedGroup)