From a9dc496059463610d62c85b8084b763018e2539d Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sat, 30 May 2026 06:28:45 +0000 Subject: [PATCH] types for recipient side to support channel web previews and domain names --- apps/ios/SimpleXChat/ChatTypes.swift | 13 ++++ .../chat/simplex/common/model/ChatModel.kt | 19 +++++- plans/2026-05-25-channel-web-preview.md | 59 ++++++++++++++----- simplex-chat.cabal | 2 + src/Simplex/Chat/Library/Commands.hs | 3 +- src/Simplex/Chat/Library/Internal.hs | 3 +- src/Simplex/Chat/Library/Subscriber.hs | 10 +++- src/Simplex/Chat/Operators.hs | 5 +- src/Simplex/Chat/Protocol.hs | 29 +++++++-- src/Simplex/Chat/Store/Groups.hs | 41 +++++++++---- src/Simplex/Chat/Store/Postgres/Migrations.hs | 4 +- src/Simplex/Chat/Store/SQLite/Migrations.hs | 4 +- src/Simplex/Chat/Store/Shared.hs | 32 +++++++--- src/Simplex/Chat/Types.hs | 13 +++- 14 files changed, 188 insertions(+), 49 deletions(-) diff --git a/apps/ios/SimpleXChat/ChatTypes.swift b/apps/ios/SimpleXChat/ChatTypes.swift index 7265038f38..0e4d08788f 100644 --- a/apps/ios/SimpleXChat/ChatTypes.swift +++ b/apps/ios/SimpleXChat/ChatTypes.swift @@ -2531,10 +2531,22 @@ public enum GroupType: Codable, Hashable { } } +public struct PublicGroupAccess: Codable, Hashable { + public var groupWebPage: String? + public var groupDomain: String? + public var domainWebPage: Bool = false + public var allowEmbedding: Bool = false +} + +public struct RelayCapabilities: Codable, Hashable { + public var baseWebUrl: String? +} + public struct PublicGroupProfile: Codable, Hashable { public var groupType: GroupType public var groupLink: String public var publicGroupId: String + public var publicGroupAccess: PublicGroupAccess? } public struct GroupProfile: Codable, NamedChat, Hashable { @@ -2703,6 +2715,7 @@ public struct GroupRelay: Identifiable, Decodable, Equatable, Hashable { public var userChatRelay: UserChatRelay public var relayStatus: RelayStatus public var relayLink: String? + public var relayCap: RelayCapabilities public var id: Int64 { groupRelayId } } diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt index aa4b677b8a..3a2000d7f8 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt @@ -2209,11 +2209,25 @@ object GroupTypeSerializer : KSerializer { } } +@Serializable +data class PublicGroupAccess( + val groupWebPage: String? = null, + val groupDomain: String? = null, + val domainWebPage: Boolean = false, + val allowEmbedding: Boolean = false +) + +@Serializable +data class RelayCapabilities( + val baseWebUrl: String? = null +) + @Serializable data class PublicGroupProfile( val groupType: GroupType, val groupLink: String, - val publicGroupId: String + val publicGroupId: String, + val publicGroupAccess: PublicGroupAccess? = null ) @Serializable @@ -2337,7 +2351,8 @@ data class GroupRelay( val groupMemberId: Long, val userChatRelay: UserChatRelay, val relayStatus: RelayStatus, - val relayLink: String? = null + val relayLink: String? = null, + val relayCap: RelayCapabilities ) { val id: Long get() = groupRelayId } diff --git a/plans/2026-05-25-channel-web-preview.md b/plans/2026-05-25-channel-web-preview.md index c1b8a07083..de0f02506b 100644 --- a/plans/2026-05-25-channel-web-preview.md +++ b/plans/2026-05-25-channel-web-preview.md @@ -98,24 +98,39 @@ Extend `toPublicGroupProfile` to accept and pass through `Maybe PublicGroupAcces - SELECT (line 2375): add `gp.group_web_page`, `gp.group_domain`, `gp.domain_web_page`, `gp.allow_embedding`, `gp.group_domain_verified_at` - UPDATE (line 1922): include new columns in `updateGroupProfile_` -### 2. Extend `XGrpRelayAcpt` with `baseWebUrl` +### 2. `RelayCapabilities` record, extend `XGrpRelayAcpt`, new `XGrpRelayCap` **File:** `src/Simplex/Chat/Protocol.hs` +New record for relay capabilities (extensible for future fields): +```haskell +data RelayCapabilities = RelayCapabilities + { baseWebUrl :: Maybe Text + } +``` + +TH-derived JSON. All fields optional so old relays produce `{}` and new fields are backward compatible. + +**`XGrpRelayAcpt`** - carries capabilities at acceptance time: + Current (line 444): `XGrpRelayAcpt :: ShortLinkContact -> ChatMsgEvent 'Json` -New: `XGrpRelayAcpt :: ShortLinkContact -> Maybe Text -> ChatMsgEvent 'Json` +New: `XGrpRelayAcpt :: ShortLinkContact -> RelayCapabilities -> ChatMsgEvent 'Json` + +Parsing: `XGrpRelayAcpt_ -> XGrpRelayAcpt <$> p "relayLink" <*> (p "relayCap" <|> pure defaultRelayCap)` +Encoding: `XGrpRelayAcpt relayLink cap -> o ["relayLink" .= relayLink, "relayCap" .= cap]` +Backward compatible: old relays omit `relayCap`, parsed as default (all `Nothing`). + +**`XGrpRelayCap`** - new message for ongoing capability updates: -Parsing (line 1319): ```haskell -XGrpRelayAcpt_ -> XGrpRelayAcpt <$> p "relayLink" <*> opt "baseWebUrl" +XGrpRelayCap :: RelayCapabilities -> ChatMsgEvent 'Json ``` -Encoding (line 1391): -```haskell -XGrpRelayAcpt relayLink baseWebUrl_ -> o $ ("baseWebUrl" .=? baseWebUrl_) ["relayLink" .= relayLink] -``` +Tag: `"x.grp.relay.cap"` +Parsing: `XGrpRelayCap_ -> XGrpRelayCap <$> p "relayCap"` +Encoding: `XGrpRelayCap cap -> o ["relayCap" .= cap]` -Backward compatible: old relays omit `baseWebUrl`, parsed as `Nothing`. +Sent by relay to owner only when capabilities change (not periodic). Relay detects change by comparing current config against persisted state on startup. ### 3. Store `baseWebUrl` per relay @@ -132,11 +147,18 @@ data GroupRelay = GroupRelay } ``` -Add: `baseWebUrl :: Maybe Text` +Add: `relayCap :: Maybe RelayCapabilities` +Stored as separate columns (same pattern as `PublicGroupAccess`): **Migration:** `ALTER TABLE group_relays ADD COLUMN base_web_url TEXT` -**Handler:** `src/Simplex/Chat/Library/Subscriber.hs` line 770-774 - when processing `XGrpRelayAcpt`, store `baseWebUrl` in the relay record. +`relayCap` constructed from columns: `Just RelayCapabilities {baseWebUrl}` when any capability column is non-NULL, `Nothing` otherwise. + +**Handlers in `src/Simplex/Chat/Library/Subscriber.hs`:** +- `XGrpRelayAcpt` (line 770): store `RelayCapabilities` in relay record on acceptance +- `XGrpRelayCap` (new handler): update `RelayCapabilities` in relay record; only accepted from relay members (`isRelay m`), owner receives + +**Relay-side persistence:** relay persists its current `RelayCapabilities` (derived from `RelayWebOptions`) so it can detect config changes on restart. On startup, if persisted capabilities differ from config, relay sends `XGrpRelayCap` to all group owners it serves. ### 4. CLI options for web preview @@ -419,11 +441,16 @@ data class PublicGroupProfile( val publicGroupAccess: PublicGroupAccess? = null // NEW ) +@Serializable +data class RelayCapabilities( + val baseWebUrl: String? = null +) + // Extend existing GroupRelay: @Serializable data class GroupRelay( ...existing fields..., - val baseWebUrl: String? = null // NEW + val relayCap: RelayCapabilities? = null // NEW ) ``` @@ -535,21 +562,21 @@ Separate repo or folder. `channel-preview.js` + minimal CSS: ### Modified files - `src/Simplex/Chat/Types.hs` - `PublicGroupAccess` type, extend `PublicGroupProfile` with `publicGroupAccess` -- `src/Simplex/Chat/Protocol.hs` - extend `XGrpRelayAcpt` with `baseWebUrl` +- `src/Simplex/Chat/Protocol.hs` - `RelayCapabilities` record, extend `XGrpRelayAcpt`, add `XGrpRelayCap` - `src/Simplex/Chat/Options.hs` - `RelayWebOptions` record, `relayWebOptions :: Maybe RelayWebOptions` in `CoreChatOpts` - `src/Simplex/Chat/Core.hs` - start web preview thread in `runSimplexChat` - `src/Simplex/Chat/Operators.hs` - `baseWebUrl` in `GroupRelay` - `src/Simplex/Chat/Store/Groups.hs` - read/write `PublicGroupAccess` columns; `getWebPublishGroups` - `src/Simplex/Chat/Store/Shared.hs` - `toPublicGroupAccess`, extend `toPublicGroupProfile` and `GroupInfoRow` -- `src/Simplex/Chat/Library/Subscriber.hs` - handle `baseWebUrl` in `XGrpRelayAcpt` processing -- `apps/multiplatform/.../model/ChatModel.kt` - `PublicGroupAccess`, `PublicGroupProfile.publicGroupAccess`, `GroupRelay.baseWebUrl` +- `src/Simplex/Chat/Library/Subscriber.hs` - handle `RelayCapabilities` in `XGrpRelayAcpt` and `XGrpRelayCap` +- `apps/multiplatform/.../model/ChatModel.kt` - `PublicGroupAccess`, `RelayCapabilities`, `PublicGroupProfile.publicGroupAccess`, `GroupRelay.relayCap` - `apps/multiplatform/.../views/chat/group/GroupChatInfoView.kt` - nav link for web page - `simplex-chat.cabal` - add `Simplex.Chat.Web.Preview`, `Simplex.Chat.Web` to exposed-modules ## Implementation Order 1. **Data model** - `PublicGroupAccess` in `PublicGroupProfile`, migrations (separate columns), store functions -2. **Protocol** - extend `XGrpRelayAcpt`, update handler in Subscriber.hs +2. **Protocol** - `RelayCapabilities`, extend `XGrpRelayAcpt`, add `XGrpRelayCap`, handlers in Subscriber.hs 3. **CLI options** - `RelayWebOptions` record, `relayWebOptions` field in `CoreChatOpts` 4. **Web types** - `WebChannelPreview`, `WebMessage`, etc. in new module 5. **Render loop** - thread startup in Core.hs, periodic JSON generation, Caddy config diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 6e459d6484..6853ac4f16 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -133,6 +133,7 @@ library Simplex.Chat.Store.Postgres.Migrations.M20260429_relay_request_retries Simplex.Chat.Store.Postgres.Migrations.M20260507_relay_inactive_at Simplex.Chat.Store.Postgres.Migrations.M20260514_relay_request_group_link_index + Simplex.Chat.Store.Postgres.Migrations.M20260530_public_group_access else exposed-modules: Simplex.Chat.Archive @@ -288,6 +289,7 @@ library Simplex.Chat.Store.SQLite.Migrations.M20260429_relay_request_retries Simplex.Chat.Store.SQLite.Migrations.M20260507_relay_inactive_at Simplex.Chat.Store.SQLite.Migrations.M20260514_relay_request_group_link_index + Simplex.Chat.Store.SQLite.Migrations.M20260530_public_group_access other-modules: Paths_simplex_chat hs-source-dirs: diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 43e31c8eef..ce075e0632 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2524,7 +2524,8 @@ processChatCommand vr nm = \case -- generate owner key, OwnerAuth signed by root key memberId <- MemberId <$> liftIO (encodedRandomBytes gVar 12) (memberPrivKey, ownerAuth) <- liftIO $ SL.newOwnerAuth gVar (unMemberId memberId) rootPrivKey - let groupProfile' = (groupProfile :: GroupProfile) {publicGroup = Just PublicGroupProfile {groupType = GTChannel, groupLink = sLnk, publicGroupId = B64UrlByteString entityId}} + -- TODO [channel web] pass publicGroupAccess from owner's profile + let groupProfile' = (groupProfile :: GroupProfile) {publicGroup = Just PublicGroupProfile {groupType = GTChannel, groupLink = sLnk, publicGroupId = B64UrlByteString entityId, publicGroupAccess = Nothing}} userData = encodeShortLinkData $ GroupShortLinkData {groupProfile = groupProfile', publicGroupData = Just (PublicGroupData 1)} userLinkData = UserContactLinkData UserContactData {direct = False, owners = [ownerAuth], relays = [], userData} -- create connection with prepared link (single network call) diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index c6c3f92752..31a1d60502 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -1048,7 +1048,8 @@ acceptRelayJoinRequestAsync cReqInvId cReqChatVRange relayLink = do - let msg = XGrpRelayAcpt relayLink + -- TODO [channel web] derive RelayCapabilities from relay config (RelayWebOptions) + let msg = XGrpRelayAcpt relayLink defaultRelayCapabilities subMode <- chatReadVar subscriptionMode vr <- chatVersionRange let chatV = vr `peerConnChatVersion` cReqChatVRange diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 08ca90f2a6..89e39d089c 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -765,9 +765,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- [async agent commands] no continuation needed, but command should be asynchronous for stability allowAgentConnectionAsync user conn' confId XOk | otherwise -> messageError "x.grp.acpt: memberId is different from expected" - XGrpRelayAcpt relayLink + XGrpRelayAcpt relayLink relayCap | memberRole' membership == GROwner && isRelay m -> do - withStore' $ \db -> setRelayLinkConfId db m confId relayLink + withStore' $ \db -> do + setRelayLinkConfId db m confId relayLink + updateRelayCapabilities db m relayCap void $ getAgentConnShortLinkAsync user CFGetRelayDataAccept (Just conn') relayLink | otherwise -> messageError "x.grp.relay.acpt: only owner can add relay" XGrpRelayReject reason @@ -1036,6 +1038,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XGrpLinkMem p -> Nothing <$ xGrpLinkMem gInfo' m'' conn' p XGrpLinkAcpt acceptance role memberId -> Nothing <$ xGrpLinkAcpt gInfo' m'' acceptance role memberId msg brokerTs XGrpRelayNew rl -> fmap ctx <$> xGrpRelayNew gInfo' m'' rl + XGrpRelayCap relayCap + | memberRole' membership == GROwner && isRelay m'' -> + Nothing <$ withStore' (\db -> updateRelayCapabilities db m'' relayCap) + | otherwise -> Nothing <$ messageWarning "x.grp.relay.cap: only owner should receive relay capabilities" XGrpMemNew memInfo msgScope -> fmap ctx <$> xGrpMemNew gInfo' m'' memInfo msgScope msg brokerTs XGrpMemIntro memInfo memRestrictions_ -> Nothing <$ xGrpMemIntro gInfo' m'' memInfo memRestrictions_ XGrpMemInv memId introInv -> Nothing <$ xGrpMemInv gInfo' m'' memId introInv diff --git a/src/Simplex/Chat/Operators.hs b/src/Simplex/Chat/Operators.hs index 03cc38e12a..6816a5f692 100644 --- a/src/Simplex/Chat/Operators.hs +++ b/src/Simplex/Chat/Operators.hs @@ -46,7 +46,7 @@ import Data.Time (addUTCTime) import Data.Time.Clock (UTCTime, nominalDay) import Language.Haskell.TH.Syntax (lift) import Simplex.Chat.Operators.Conditions -import Simplex.Chat.Protocol (RelayProfile (..)) +import Simplex.Chat.Protocol (RelayCapabilities (..), RelayProfile (..)) import Simplex.Chat.Types (ShortLinkContact, User) import Simplex.Chat.Types.Shared (RelayStatus) import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles) @@ -280,7 +280,8 @@ data GroupRelay = GroupRelay groupMemberId :: Int64, userChatRelay :: UserChatRelay, relayStatus :: RelayStatus, - relayLink :: Maybe ShortLinkContact + relayLink :: Maybe ShortLinkContact, + relayCap :: RelayCapabilities } deriving (Eq, Show) diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index f9c29e3552..71daeec635 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -262,6 +262,14 @@ data LinkContent = LCPage | LCImage | LCVideo {duration :: Maybe Int} | LCUnknow data ReportReason = RRSpam | RRContent | RRCommunity | RRProfile | RROther | RRUnknown Text deriving (Eq, Show) +data RelayCapabilities = RelayCapabilities + { baseWebUrl :: Maybe Text + } + deriving (Eq, Show) + +defaultRelayCapabilities :: RelayCapabilities +defaultRelayCapabilities = RelayCapabilities {baseWebUrl = Nothing} + $(pure []) instance FromJSON LinkContent where @@ -281,6 +289,12 @@ instance ToJSON LinkContent where $(JQ.deriveJSON defaultJSON ''LinkPreview) +$(JQ.deriveToJSON defaultJSON ''RelayCapabilities) + +instance FromJSON RelayCapabilities where + parseJSON = $(JQ.mkParseJSON defaultJSON ''RelayCapabilities) + omittedField = Just defaultRelayCapabilities + instance StrEncoding ReportReason where strEncode = \case RRSpam -> "spam" @@ -441,10 +455,11 @@ data ChatMsgEvent (e :: MsgEncoding) where XGrpLinkMem :: Profile -> ChatMsgEvent 'Json XGrpLinkAcpt :: GroupAcceptance -> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json XGrpRelayInv :: GroupRelayInvitation -> ChatMsgEvent 'Json - XGrpRelayAcpt :: ShortLinkContact -> ChatMsgEvent 'Json + XGrpRelayAcpt :: ShortLinkContact -> RelayCapabilities -> ChatMsgEvent 'Json XGrpRelayTest :: ByteString -> Maybe ByteString -> ChatMsgEvent 'Json XGrpRelayNew :: ShortLinkContact -> ChatMsgEvent 'Json XGrpRelayReject :: RelayRejectionReason -> ChatMsgEvent 'Json + XGrpRelayCap :: RelayCapabilities -> ChatMsgEvent 'Json XGrpMemNew :: MemberInfo -> Maybe MsgScope -> ChatMsgEvent 'Json XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json @@ -991,6 +1006,7 @@ data CMEventTag (e :: MsgEncoding) where XGrpRelayTest_ :: CMEventTag 'Json XGrpRelayNew_ :: CMEventTag 'Json XGrpRelayReject_ :: CMEventTag 'Json + XGrpRelayCap_ :: CMEventTag 'Json XGrpMemNew_ :: CMEventTag 'Json XGrpMemIntro_ :: CMEventTag 'Json XGrpMemInv_ :: CMEventTag 'Json @@ -1050,6 +1066,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where XGrpRelayTest_ -> "x.grp.relay.test" XGrpRelayNew_ -> "x.grp.relay.new" XGrpRelayReject_ -> "x.grp.relay.reject" + XGrpRelayCap_ -> "x.grp.relay.cap" XGrpMemNew_ -> "x.grp.mem.new" XGrpMemIntro_ -> "x.grp.mem.intro" XGrpMemInv_ -> "x.grp.mem.inv" @@ -1110,6 +1127,7 @@ instance StrEncoding ACMEventTag where "x.grp.relay.test" -> XGrpRelayTest_ "x.grp.relay.new" -> XGrpRelayNew_ "x.grp.relay.reject" -> XGrpRelayReject_ + "x.grp.relay.cap" -> XGrpRelayCap_ "x.grp.mem.new" -> XGrpMemNew_ "x.grp.mem.intro" -> XGrpMemIntro_ "x.grp.mem.inv" -> XGrpMemInv_ @@ -1162,10 +1180,11 @@ toCMEventTag msg = case msg of XGrpLinkMem _ -> XGrpLinkMem_ XGrpLinkAcpt {} -> XGrpLinkAcpt_ XGrpRelayInv _ -> XGrpRelayInv_ - XGrpRelayAcpt _ -> XGrpRelayAcpt_ + XGrpRelayAcpt {} -> XGrpRelayAcpt_ XGrpRelayTest {} -> XGrpRelayTest_ XGrpRelayNew _ -> XGrpRelayNew_ XGrpRelayReject _ -> XGrpRelayReject_ + XGrpRelayCap _ -> XGrpRelayCap_ XGrpMemNew {} -> XGrpMemNew_ XGrpMemIntro _ _ -> XGrpMemIntro_ XGrpMemInv _ _ -> XGrpMemInv_ @@ -1318,7 +1337,8 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do XGrpLinkMem_ -> XGrpLinkMem <$> p "profile" XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "acceptance" <*> p "role" <*> p "memberId" XGrpRelayInv_ -> XGrpRelayInv <$> p "groupRelayInvitation" - XGrpRelayAcpt_ -> XGrpRelayAcpt <$> p "relayLink" + XGrpRelayAcpt_ -> XGrpRelayAcpt <$> p "relayLink" <*> (fromMaybe defaultRelayCapabilities <$> opt "relayCap") + XGrpRelayCap_ -> XGrpRelayCap <$> p "relayCap" XGrpRelayTest_ -> do B64UrlByteString challenge <- p "challenge" sig_ <- fmap (\(B64UrlByteString s) -> s) <$> opt "signature" @@ -1390,7 +1410,8 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en XGrpLinkMem profile -> o ["profile" .= profile] XGrpLinkAcpt acceptance role memberId -> o ["acceptance" .= acceptance, "role" .= role, "memberId" .= memberId] XGrpRelayInv groupRelayInv -> o ["groupRelayInvitation" .= groupRelayInv] - XGrpRelayAcpt relayLink -> o ["relayLink" .= relayLink] + XGrpRelayAcpt relayLink relayCap -> o ["relayLink" .= relayLink, "relayCap" .= relayCap] + XGrpRelayCap relayCap -> o ["relayCap" .= relayCap] XGrpRelayTest challenge sig_ -> o $ ("signature" .=? (B64UrlByteString <$> sig_)) ["challenge" .= B64UrlByteString challenge] diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 9b21f0697b..e2a9d6816a 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -89,6 +89,7 @@ module Simplex.Chat.Store.Groups updateRelayStatusFromTo, setRelayLinkAccepted, setRelayLinkConfId, + updateRelayCapabilities, getRelayConfId, updateRelayMemberData, setGroupInProgressDone, @@ -367,10 +368,11 @@ createNewGroup db vr user@User {userId} groupProfile incognitoProfile useRelays INSERT INTO group_profiles (display_name, full_name, short_descr, description, image, group_type, group_link, public_group_id, + group_web_page, group_domain, domain_web_page, allow_embedding, user_id, preferences, member_admission, created_at, updated_at) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] - ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) + ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. publicGroupAccessRow publicGroup :. (userId, groupPreferences, memberAdmission, currentTs, currentTs)) profileId <- insertedRowId db DB.execute @@ -868,10 +870,11 @@ createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus p INSERT INTO group_profiles (display_name, full_name, short_descr, description, image, group_type, group_link, public_group_id, + group_web_page, group_domain, domain_web_page, allow_embedding, user_id, preferences, member_admission, created_at, updated_at) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] - ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) + ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. publicGroupAccessRow publicGroup :. (userId, groupPreferences, memberAdmission, currentTs, currentTs)) profileId <- insertedRowId db DB.execute @@ -1343,15 +1346,16 @@ groupRelayQuery = [sql| SELECT gr.group_relay_id, gr.group_member_id, cr.chat_relay_id, cr.address, cr.display_name, cr.full_name, cr.short_descr, cr.image, cr.domains, cr.preset, cr.tested, cr.enabled, cr.deleted, - gr.relay_status, gr.relay_link + gr.relay_status, gr.relay_link, gr.base_web_url FROM group_relays gr JOIN chat_relays cr ON cr.chat_relay_id = gr.chat_relay_id |] -toGroupRelay :: (Int64, GroupMemberId, DBEntityId, ShortLinkContact, Text, Text, Maybe Text, Maybe ImageData, Text, BoolInt) :. (Maybe BoolInt, BoolInt, BoolInt, RelayStatus, Maybe ShortLinkContact) -> GroupRelay -toGroupRelay ((groupRelayId, groupMemberId, chatRelayId, address, displayName, fullName, shortDescr, image, domains, BI preset) :. (tested, BI enabled, BI deleted, relayStatus, relayLink)) = +toGroupRelay :: (Int64, GroupMemberId, DBEntityId, ShortLinkContact, Text, Text, Maybe Text, Maybe ImageData, Text, BoolInt) :. (Maybe BoolInt, BoolInt, BoolInt, RelayStatus, Maybe ShortLinkContact, Maybe Text) -> GroupRelay +toGroupRelay ((groupRelayId, groupMemberId, chatRelayId, address, displayName, fullName, shortDescr, image, domains, BI preset) :. (tested, BI enabled, BI deleted, relayStatus, relayLink, baseWebUrl)) = let userChatRelay = UserChatRelay {chatRelayId, address, relayProfile = toRelayProfile (displayName, fullName, shortDescr, image), domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted} - in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink} + relayCap = RelayCapabilities {baseWebUrl} + in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink, relayCap} createRelayForOwner :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> GroupInfo -> UserChatRelay -> ExceptT StoreError IO GroupMember createRelayForOwner db vr gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do @@ -1491,6 +1495,18 @@ setRelayLinkConfId db m confId relayLink = do |] (relayLink, currentTs, groupMemberId' m) +updateRelayCapabilities :: DB.Connection -> GroupMember -> RelayCapabilities -> IO () +updateRelayCapabilities db m RelayCapabilities {baseWebUrl} = do + currentTs <- getCurrentTime + DB.execute + db + [sql| + UPDATE group_relays + SET base_web_url = ?, updated_at = ? + WHERE group_member_id = ? + |] + (baseWebUrl, currentTs, groupMemberId' m) + getRelayConfId :: DB.Connection -> GroupMember -> ExceptT StoreError IO ConfirmationId getRelayConfId db m = ExceptT . firstRow fromOnly (SEGroupRelayNotFoundByMemberId $ groupMemberId' m) $ @@ -2327,6 +2343,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, UPDATE group_profiles SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?, group_type = ?, group_link = ?, + group_web_page = ?, group_domain = ?, domain_web_page = ?, allow_embedding = ?, preferences = ?, member_admission = ?, updated_at = ? WHERE group_profile_id IN ( SELECT group_profile_id @@ -2334,7 +2351,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, WHERE user_id = ? AND group_id = ? ) |] - ((newName, fullName, shortDescr, description, image, groupType_, groupLink_) :. (groupPreferences, memberAdmission, currentTs, userId, groupId)) + ((newName, fullName, shortDescr, description, image, groupType_, groupLink_) :. publicGroupAccessRow publicGroup :. (groupPreferences, memberAdmission, currentTs, userId, groupId)) updateGroup_ ldn currentTs = do DB.execute db @@ -2374,14 +2391,16 @@ updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName [sql| SELECT gp.display_name, gp.full_name, gp.short_descr, gp.description, gp.image, gp.group_type, gp.group_link, gp.public_group_id, + gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding, gp.preferences, gp.member_admission FROM group_profiles gp JOIN groups g ON gp.group_profile_id = g.group_profile_id WHERE g.group_id = ? |] (Only groupId) - toGroupProfile (displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_, groupPreferences, memberAdmission) = - GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_, groupPreferences, memberAdmission} + toGroupProfile ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (groupPreferences, memberAdmission)) = + let publicGroupAccess = toPublicGroupAccess accessRow + in GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ publicGroupAccess, groupPreferences, memberAdmission} getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo) getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index 437f16a43c..5397e5851a 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -31,6 +31,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260403_item_viewed import Simplex.Chat.Store.Postgres.Migrations.M20260429_relay_request_retries import Simplex.Chat.Store.Postgres.Migrations.M20260507_relay_inactive_at import Simplex.Chat.Store.Postgres.Migrations.M20260514_relay_request_group_link_index +import Simplex.Chat.Store.Postgres.Migrations.M20260530_public_group_access import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] @@ -61,7 +62,8 @@ schemaMigrations = ("20260403_item_viewed", m20260403_item_viewed, Just down_m20260403_item_viewed), ("20260429_relay_request_retries", m20260429_relay_request_retries, Just down_m20260429_relay_request_retries), ("20260507_relay_inactive_at", m20260507_relay_inactive_at, Just down_m20260507_relay_inactive_at), - ("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index) + ("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index), + ("20260530_public_group_access", m20260530_public_group_access, Just down_m20260530_public_group_access) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index 9990ed74fd..5f5ab533c8 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -154,6 +154,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260403_item_viewed import Simplex.Chat.Store.SQLite.Migrations.M20260429_relay_request_retries import Simplex.Chat.Store.SQLite.Migrations.M20260507_relay_inactive_at import Simplex.Chat.Store.SQLite.Migrations.M20260514_relay_request_group_link_index +import Simplex.Chat.Store.SQLite.Migrations.M20260530_public_group_access import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -307,7 +308,8 @@ schemaMigrations = ("20260403_item_viewed", m20260403_item_viewed, Just down_m20260403_item_viewed), ("20260429_relay_request_retries", m20260429_relay_request_retries, Just down_m20260429_relay_request_retries), ("20260507_relay_inactive_at", m20260507_relay_inactive_at, Just down_m20260507_relay_inactive_at), - ("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index) + ("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index), + ("20260530_public_group_access", m20260530_public_group_access, Just down_m20260530_public_group_access) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index af0958ed35..bd51b10329 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -665,18 +665,20 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member type GroupKeysRow = (Maybe C.PrivateKeyEd25519, Maybe C.PublicKeyEd25519, Maybe C.PrivateKeyEd25519) -type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow +type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow + +type PublicGroupAccessRow = (Maybe Text, Maybe Text, Maybe BoolInt, Maybe BoolInt) type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact) type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo -toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) = +toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) = let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite} fullGroupPreferences = mergeGroupPreferences groupPreferences - publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ + publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ (toPublicGroupAccess accessRow) groupKeys = toGroupKeys publicGroupId_ groupKeysRow groupProfile = GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission} businessChat = toBusinessChatInfo businessRow @@ -690,10 +692,25 @@ toPreparedGroup = \case Just PreparedGroup {connLinkToConnect = CCLink fullLink shortLink_, connLinkPreparedConnection, connLinkStartedConnection, welcomeSharedMsgId, requestSharedMsgId} _ -> Nothing -toPublicGroupProfile :: Maybe GroupType -> Maybe ShortLinkContact -> Maybe B64UrlByteString -> Maybe PublicGroupProfile -toPublicGroupProfile (Just groupType) (Just groupLink) (Just publicGroupId) = - Just PublicGroupProfile {groupType, groupLink, publicGroupId} -toPublicGroupProfile _ _ _ = Nothing +toPublicGroupProfile :: Maybe GroupType -> Maybe ShortLinkContact -> Maybe B64UrlByteString -> Maybe PublicGroupAccess -> Maybe PublicGroupProfile +toPublicGroupProfile (Just groupType) (Just groupLink) (Just publicGroupId) publicGroupAccess = + Just PublicGroupProfile {groupType, groupLink, publicGroupId, publicGroupAccess} +toPublicGroupProfile _ _ _ _ = Nothing + +publicGroupAccessRow :: Maybe PublicGroupProfile -> PublicGroupAccessRow +publicGroupAccessRow pgp = case pgp >>= publicGroupAccess of + Just PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding} -> + (groupWebPage, groupDomain, Just (BI domainWebPage), Just (BI allowEmbedding)) + Nothing -> (Nothing, Nothing, Nothing, Nothing) + +toPublicGroupAccess :: PublicGroupAccessRow -> Maybe PublicGroupAccess +toPublicGroupAccess (groupWebPage, groupDomain, domainWebPage_, allowEmbedding_) + | isJust groupWebPage || isJust groupDomain || domainWebPage || allowEmbedding = + Just PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding} + | otherwise = Nothing + where + domainWebPage = maybe False unBI domainWebPage_ + allowEmbedding = maybe False unBI allowEmbedding_ toGroupKeys :: Maybe B64UrlByteString -> GroupKeysRow -> Maybe GroupKeys toGroupKeys (Just publicGroupId) (rootPrivKey_, rootPubKey_, Just memberPrivKey) = @@ -760,6 +777,7 @@ groupInfoQueryFields = SELECT -- GroupInfo g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, gp.description, gp.image, gp.group_type, gp.group_link, gp.public_group_id, + gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission, g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id, diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index f2892898c4..189f730b67 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -793,10 +793,19 @@ instance FromField GroupType where fromField = fromTextField_ textDecode instance ToField GroupType where toField = toField . textEncode +data PublicGroupAccess = PublicGroupAccess + { groupWebPage :: Maybe Text, + groupDomain :: Maybe Text, + domainWebPage :: Bool, + allowEmbedding :: Bool + } + deriving (Eq, Show) + data PublicGroupProfile = PublicGroupProfile { groupType :: GroupType, groupLink :: ShortLinkContact, - publicGroupId :: B64UrlByteString -- group identity = sha256(genesis root key), immutable + publicGroupId :: B64UrlByteString, -- group identity = sha256(genesis root key), immutable + publicGroupAccess :: Maybe PublicGroupAccess } deriving (Eq, Show) @@ -2084,6 +2093,8 @@ instance ToJSON GroupType where toJSON = textToJSON toEncoding = textToEncoding +$(JQ.deriveJSON defaultJSON ''PublicGroupAccess) + $(JQ.deriveJSON defaultJSON ''PublicGroupProfile) $(JQ.deriveJSON defaultJSON ''GroupProfile)