core: render web previews for channels (#7029)

* plan: web previews for channels

* types for recipient side to support channel web previews and domain names

* fix

* migrations

* update schema and api types

* update schema

* rename migrations

* core: render channel preview data

* core: render channel preview data in relays

* website: use cpp to inject JS functions

* JSC files

* remove directory.js

* channel preview renderer

* Revert "cli: fix redraw slowness (#6735)"

This reverts commit b801d77c74.

* sample channel page

* default avatar

* rename options

* better layout

* layout

* images

* some fixes

* tails

* markdown colors

* image sizes

* reactions

* fix reactions

* fewer avatars

* forward icon

* command to change group access parameters

* view public group access changes in CLI

* media metadata color

* ios: group web access ui

* update ui

* add init

* kotlin, labels

* update page

* update relay base URL

* fix

* ios update channel web page info

* update kotlin layout

* use cards

* update layout

* use domains for relay data, path is fixed

* update embed code

* fix bots api

* include only history items and senders

* update preview JS/HTML

* show different error if link is different

* remove stale json files

* better layout

* layout fixes

* improve layout

* improve layout

* update embed code

* web cta

* better layout

* buttons

* layout

* paddings

* desktop cta

* desktop cta

* cta layout

* fonts

* paddings

* paddings

* more paddings

* copy link

* read more

* hide avatar and placeholder when all messages are from channel

* color scheme

* fix color

* improve

* layout

* welcome message

* dark mode colors

* padding

* font size

* overscroll

* font

* logo on button

* better join

* buttons

* refactor

* another logo

* text

* desktop button

* button text

* center

* fix svg

* padding

* smaller gap

* render channel on any message changes etc

* fixes

* atomic file updates, escape attributes

* fix tests

* more tests

* more efficient rendering

* improve security

* sanitize links, include mentioned members

* schema

* fixes

* improve rendering

* fix showing correct subscribers count

* fix member names

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>

src/Simplex/Chat/Library/Commands.hs

@@ -90,6 +90,7 @@ import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.Util (liftIOEither, zipWith3')
 import qualified Simplex.Chat.Util as U
+import Simplex.Chat.Web (webPreviewWorker)
 import Simplex.FileTransfer.Description (FileDescriptionURI (..), maxFileSize, maxFileSizeHard)
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
@@ -201,6 +202,7 @@ startChatController mainApp enableSndFiles = do
           startCleanupManager
           void $ forkIO $ mapM_ startExpireCIs users
           startRelayChecks users
+          startWebPreview users
         else when enableSndFiles $ startXFTP xftpStartSndWorkers
       pure a1
     startXFTP startWorkers = do
@@ -232,6 +234,20 @@ startChatController mainApp enableSndFiles = do
             a <- Just <$> async (void $ runExceptT $ runRelayGroupLinkChecks relayUser)
             atomically $ writeTVar relayAsync a
           _ -> pure ()
+    startWebPreview users = do
+      let relayUsers = filter (\User {userChatRelay} -> isTrue userChatRelay) users
+      ChatConfig {webPreviewConfig = cfg_} <- asks config
+      case (relayUsers, cfg_) of
+        (_ : _, Just cfg) -> do
+          wps_ <- asks webPreviewState
+          forM_ wps_ $ \WebPreviewState {webPreviewWorkerAsync} ->
+            readTVarIO webPreviewWorkerAsync >>= \case
+              Nothing -> do
+                cc <- ask
+                a <- Just <$> async (liftIO $ webPreviewWorker cfg cc relayUsers)
+                atomically $ writeTVar webPreviewWorkerAsync a
+              _ -> pure ()
+        _ -> pure ()
     startExpireCIs user = whenM shouldExpireChats $ do
       startExpireCIThread user
       setExpireCIFlag user True
@@ -3060,6 +3076,12 @@ processChatCommand cxt nm = \case
     updateGroupProfileByName gName $ \p -> p {description}
   ShowGroupDescription gName -> withUser $ \user ->
     CRGroupDescription user <$> withFastStore (\db -> getGroupInfoByName db cxt user gName)
+  SetPublicGroupAccess gName access -> withUser $ \user -> do
+    gInfo@GroupInfo {groupProfile = p@GroupProfile {publicGroup}} <- withStore $ \db ->
+      getGroupIdByName db user gName >>= getGroupInfo db cxt user
+    case publicGroup of
+      Just pg -> runUpdateGroupProfile user gInfo p {publicGroup = Just pg {publicGroupAccess = Just access}}
+      Nothing -> throwChatError $ CECommandError "not a public group"
   APICreateGroupLink groupId mRole -> withUser $ \user -> withGroupLock "createGroupLink" groupId $ do
     gInfo@GroupInfo {groupProfile} <- withFastStore $ \db -> getGroupInfo db cxt user groupId
     assertUserGroupRole gInfo GRAdmin
@@ -4896,6 +4918,17 @@ runRelayGroupLinkChecks user = do
                   else void $ withStore' $ \db -> updateRelayOwnStatusFromTo db gInfo RSActive RSInactive
               _ -> pure ()
           _ -> pure ()
+        sendRelayCapIfNeeded cxt gInfo
+    sendRelayCapIfNeeded cxt gInfo = do
+      ChatConfig {webPreviewConfig} <- asks config
+      let currentWebDomain = (\WebPreviewConfig {webDomain} -> webDomain) <$> webPreviewConfig
+      sentWebDomain <- withStore' (`getRelaySentWebDomain` gInfo)
+      when (currentWebDomain /= sentWebDomain) $ do
+        owners <- withStore' $ \db -> getGroupOwners db cxt user gInfo
+        let capableOwners = filter (\m -> memberCurrent m && m `supportsVersion` relayWebCapVersion) owners
+        unless (null capableOwners) $ do
+          void $ sendGroupMessage' user gInfo capableOwners (XGrpRelayCap RelayCapabilities {webDomain = currentWebDomain})
+          withStore' $ \db -> updateRelaySentWebDomain db gInfo currentWebDomain
     checkRelayInactiveGroups = do
       cxt <- chatStoreCxt
       ttl <- asks (relayInactiveTTL . config)
@@ -5219,6 +5252,7 @@ chatCommandP =
       "/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP),
       ("/group_profile " <|> "/gp ") *> char_ '#' *> (UpdateGroupNames <$> displayNameP <* A.space <*> groupProfile),
       ("/group_profile " <|> "/gp ") *> char_ '#' *> (ShowGroupProfile <$> displayNameP),
+      "/public group access " *> char_ '#' *> (SetPublicGroupAccess <$> displayNameP <*> publicGroupAccessP),
       "/group_descr " *> char_ '#' *> (UpdateGroupDescription <$> displayNameP <*> optional (A.space *> msgTextP)),
       "/set welcome " *> char_ '#' *> (UpdateGroupDescription <$> displayNameP <* A.space <*> (Just <$> msgTextP)),
       "/delete welcome " *> char_ '#' *> (UpdateGroupDescription <$> displayNameP <*> pure Nothing),
@@ -5425,6 +5459,12 @@ chatCommandP =
       clearOverrides <- (" clear_overrides=" *> onOffP) <|> pure False
       pure UserMsgReceiptSettings {enable, clearOverrides}
     onOffP = ("on" $> True) <|> ("off" $> False)
+    publicGroupAccessP = do
+      groupWebPage <- optional (" web=" *> (safeDecodeUtf8 <$> A.takeTill A.isSpace))
+      groupDomain <- optional (" domain=" *> (safeDecodeUtf8 <$> A.takeTill A.isSpace))
+      domainWebPage <- (" domain_page=" *> onOffP) <|> pure False
+      allowEmbedding <- (" embed=" *> onOffP) <|> pure False
+      pure PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding}
     profileNameDescr = (,) <$> displayNameP <*> shortDescrP
     -- 'Help with bot':'link <ID>','Menu of commands':[...]
     botCommandsP :: Parser [ChatBotCommand]

src/Simplex/Chat/Library/Internal.hs

@@ -1046,8 +1046,9 @@ acceptRelayJoinRequestAsync
   cReqInvId
   cReqChatVRange
   relayLink = do
-    -- TODO [channel web] derive RelayCapabilities from relay config (RelayWebOptions)
-    let msg = XGrpRelayAcpt relayLink defaultRelayCapabilities
+    ChatConfig {webPreviewConfig} <- asks config
+    let webDomain_ = (\WebPreviewConfig {webDomain} -> webDomain) <$> webPreviewConfig
+        msg = XGrpRelayAcpt relayLink RelayCapabilities {webDomain = webDomain_}
     subMode <- chatReadVar subscriptionMode
     cxt <- chatStoreCxt
     let chatV = vr cxt `peerConnChatVersion` cReqChatVRange

src/Simplex/Chat/Library/Subscriber.hs

@@ -47,6 +47,7 @@ import Simplex.Chat.Call
 import Simplex.Chat.Controller
 import Simplex.Chat.Delivery
 import Simplex.Chat.Library.Internal
+import Simplex.Chat.Web (channelContentChanged, channelProfileUpdated, channelRemoved)
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.Batch (batchDeliveryTasks1, batchProfiles, batchProfilesWithBody, encodeBinaryBatch, encodeFwdElement, maxBatchElementSize)
 import Simplex.Chat.Messages.CIContent
@@ -870,6 +871,9 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
                   else pure gInfo
               pure (m {memberStatus = GSMemConnected}, gInfo')
             toView $ CEvtUserJoinedGroup user gInfo' m'
+            when (isRelay membership) $ do
+              cc <- ask
+              atomically $ channelProfileUpdated cc groupId groupProfile
             (gInfo'', m'', scopeInfo) <- mkGroupChatScope gInfo' m'
             -- Create e2ee, feature and group description chat items only on first connected relay
             ifM
@@ -1018,6 +1022,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
           processEvent :: forall e. MsgEncodingI e => GroupInfo -> GroupMember -> VerifiedMsg e -> CM (Maybe NewMessageDeliveryTask)
           processEvent gInfo' m' verifiedMsg = do
             (m'', conn', msg@RcvMessage {msgId, chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m' conn msgMeta verifiedMsg
+            cc <- ask
             let ctx js = DeliveryTaskContext js False
                 checkSendAsGroup :: Maybe Bool -> CM (Maybe DeliveryTaskContext) -> CM (Maybe DeliveryTaskContext)
                 checkSendAsGroup asGroup_ a
@@ -1074,7 +1079,17 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
               XInfoProbeOk probe -> Nothing <$ xInfoProbeOk (COMGroupMember m'') probe
               BFileChunk sharedMsgId chunk -> Nothing <$ bFileChunkGroup gInfo' sharedMsgId chunk msgMeta
               _ -> Nothing <$ messageError ("unsupported message: " <> tshow event)
-            forM deliveryTaskContext_ $ \taskContext ->
+            forM deliveryTaskContext_ $ \taskContext -> do
+              let contentChanged :: CM ()
+                  contentChanged = atomically $ channelContentChanged cc groupId
+              case event of
+                XMsgNew {} -> contentChanged
+                XMsgUpdate {} -> contentChanged
+                XMsgDel {} -> contentChanged
+                XMsgReact {} -> contentChanged
+                XGrpInfo p' -> atomically $ channelProfileUpdated cc groupId p'
+                XGrpDel {} -> atomically $ channelRemoved cc groupId
+                _ -> pure ()
               pure $ NewMessageDeliveryTask {messageId = msgId, taskContext}
           checkSendRcpt :: [AParsedMsg] -> CM Bool
           checkSendRcpt aMsgs = do