more efficient rendering

src/Simplex/Chat/Controller.hs

@@ -179,8 +179,16 @@ data WebPreviewConfig = WebPreviewConfig
     webPreviewItemCount :: Int
   }
 
+data PublishableGroup = PublishableGroup
+  { pgFileName :: FilePath,
+    pgCorsEntry :: Maybe (Text, CorsOrigin)
+  }
+
+data CorsOrigin = CorsAny | CorsOrigins [Text]
+  deriving (Show)
+
 data WebPreviewState = WebPreviewState
-  { publishableGroupIds :: TVar (Map Int64 FilePath),
+  { publishableGroupIds :: TVar (Map Int64 PublishableGroup),
     priorityRender :: TQueue Int64,
     filesToRemove :: TQueue FilePath,
     corsNeeded :: TVar Bool,

src/Simplex/Chat/Store/Groups.hs

@@ -104,6 +104,7 @@ module Simplex.Chat.Store.Groups
     isRelayGroupRejected,
     allowRelayGroup,
     getRelayServedGroups,
+    getRelayPublishableGroups,
     getRelayInactiveGroups,
     createNewContactMemberAsync,
     createJoiningMember,
@@ -1697,6 +1698,24 @@ getRelayServedGroups db vr User {userId, userContactId} = do
       )
       (userId, userContactId, RSAccepted, RSActive)
 
+getRelayPublishableGroups :: DB.Connection -> User -> IO [(Int64, B64UrlByteString, Maybe PublicGroupAccess)]
+getRelayPublishableGroups db User {userId, userContactId} =
+  map toRow <$>
+    DB.query
+      db
+      [sql|
+        SELECT g.group_id, gp.public_group_id,
+               gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding
+        FROM groups g
+        JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
+        JOIN group_members mu ON mu.group_id = g.group_id AND mu.contact_id = ?
+        WHERE g.user_id = ? AND g.relay_own_status IN (?, ?)
+          AND gp.public_group_id IS NOT NULL
+      |]
+      (userContactId, userId, RSAccepted, RSActive)
+  where
+    toRow ((gId, pgId) :. accessRow) = (gId, pgId, toPublicGroupAccess accessRow)
+
 getRelayInactiveGroups :: DB.Connection -> VersionRangeChat -> User -> NominalDiffTime -> IO [GroupInfo]
 getRelayInactiveGroups db vr User {userId, userContactId} ttl = do
   cutoffTs <- addUTCTime (- ttl) <$> getCurrentTime

src/Simplex/Chat/Web.hs

@@ -13,7 +13,6 @@ module Simplex.Chat.Web
     WebMessage (..),
     WebMemberProfile (..),
     WebFileInfo (..),
-    CorsOrigin (..),
     webPreviewWorker,
     renderWebPreviews,
     writeCorsConfig,
@@ -43,7 +42,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
 import Data.Time.Clock (UTCTime, getCurrentTime)
-import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), WebPreviewConfig (..), WebPreviewState (..))
+import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), CorsOrigin (..), PublishableGroup (..), WebPreviewConfig (..), WebPreviewState (..))
 import Simplex.Chat.Markdown (FormattedText (..), MarkdownList, parseMaybeMarkdownList)
 import Simplex.Chat.Messages
   ( CChatItem (..),
@@ -59,7 +58,7 @@ import Simplex.Chat.Messages
   )
 import Simplex.Chat.Messages.CIContent (ciMsgContent)
 import Simplex.Chat.Protocol (MsgContent, MsgRef (..), QuotedMsg (..), isReport)
-import Simplex.Chat.Store.Groups (getGroupOwners, getRelayServedGroups)
+import Simplex.Chat.Store.Groups (getGroupOwners, getRelayPublishableGroups, getRelayServedGroups)
 import Simplex.Chat.Store.Messages (getGroupWebPreviewItems)
 import Simplex.Chat.Store.Shared (getGroupInfo)
 import Simplex.Chat.Types
@@ -132,6 +131,8 @@ webPreviewWorker cfg@WebPreviewConfig {webJsonDir, webCorsFile, webUpdateInterva
   forM_ (webPreviewState cc) $ \wps -> do
     createDirectoryIfMissing True webJsonDir
     initPublishableGroups wps
+    cleanStaleFiles wps
+    regenerateCors wps
     seedRoutinePending wps
     workerLoop wps
   where
@@ -142,9 +143,6 @@ webPreviewWorker cfg@WebPreviewConfig {webJsonDir, webCorsFile, webUpdateInterva
       drainPriority
       handleCors
       drainRoutine
-      groups <- loadRelayGroups
-      regenerateCors groups
-      cleanStaleFiles groups
       seedRoutinePending wps
       interruptibleSleep
       workerLoop wps
@@ -163,7 +161,7 @@ webPreviewWorker cfg@WebPreviewConfig {webJsonDir, webCorsFile, webUpdateInterva
 
         handleCors = do
           needed <- atomically $ swapTVar corsNeeded False
-          when needed $ loadRelayGroups >>= regenerateCors
+          when needed $ regenerateCors wps
 
         drainRoutine = do
           mGId <- atomically $ do
@@ -183,10 +181,21 @@ webPreviewWorker cfg@WebPreviewConfig {webJsonDir, webCorsFile, webUpdateInterva
               `orElse` takeTMVar wakeSignal
 
     initPublishableGroups WebPreviewState {publishableGroupIds} = do
-      groups <- loadRelayGroups
-      let gIds = M.fromList [(groupId, f) | g@GroupInfo {groupId} <- groups, Just f <- [publicGroupFileName g]]
+      rows <- withTransaction (chatStore cc) $ \db ->
+        concat <$> mapM (getRelayPublishableGroups db) users
+      let gIds = M.fromList [(gId, toPublishableGroup pgId access) | (gId, pgId, access) <- rows]
       atomically $ writeTVar publishableGroupIds gIds
 
+    cleanStaleFiles WebPreviewState {publishableGroupIds} = do
+      ids <- readTVarIO publishableGroupIds
+      let activeFiles = S.fromList $ map pgFileName $ M.elems ids
+      removeStaleFiles webJsonDir activeFiles
+
+    regenerateCors WebPreviewState {publishableGroupIds} = do
+      ids <- readTVarIO publishableGroupIds
+      let entries = mapMaybe pgCorsEntry $ M.elems ids
+      forM_ webCorsFile $ writeCorsConfig entries
+
     seedRoutinePending WebPreviewState {publishableGroupIds, routinePending} =
       atomically $ M.keysSet <$> readTVar publishableGroupIds >>= writeTVar routinePending
 
@@ -201,9 +210,9 @@ webPreviewWorker cfg@WebPreviewConfig {webJsonDir, webCorsFile, webUpdateInterva
               void $ renderGroupPreview cfg cc u gInfo
             _ -> do
               fName <- atomically $ do
-                ids <- readTVar publishableGroupIds
+                pg <- M.lookup gId <$> readTVar publishableGroupIds
                 modifyTVar' publishableGroupIds (M.delete gId)
-                pure $ M.lookup gId ids
+                pure $ pgFileName <$> pg
               forM_ fName $ \f ->
                 removeFile (webJsonDir </> f) `catch` \(_ :: SomeException) -> pure ()
               logInfo $ "web preview: group " <> T.pack (show gId) <> " no longer publishable"
@@ -217,22 +226,6 @@ webPreviewWorker cfg@WebPreviewConfig {webJsonDir, webCorsFile, webUpdateInterva
           Right a -> pure (Just a)
           Left _ -> go us
 
-    loadRelayGroups =
-      withTransaction (chatStore cc) $ \db ->
-        concat <$> mapM (getRelayServedGroups db vr') users
-
-    regenerateCors groups = do
-      let entries = mapMaybe groupCorsEntry groups
-      forM_ webCorsFile $ writeCorsConfig entries
-
-    cleanStaleFiles groups = do
-      let activeFiles = S.fromList $ mapMaybe publicGroupFileName [g | g <- groups, hasPublicGroup g]
-      removeStaleFiles webJsonDir activeFiles
-
-    groupCorsEntry GroupInfo {groupProfile = GroupProfile {publicGroup}} =
-      publicGroup >>= \PublicGroupProfile {publicGroupId, publicGroupAccess} ->
-        corsEntry publicGroupId <$> publicGroupAccess
-
 renderWebPreviews :: WebPreviewConfig -> ChatController -> User -> IO ()
 renderWebPreviews cfg@WebPreviewConfig {webJsonDir} cc user = do
   let vr' = chatVRange (config cc)
@@ -284,16 +277,19 @@ channelProfileUpdated :: ChatController -> Int64 -> GroupProfile -> STM ()
 channelProfileUpdated cc gId GroupProfile {publicGroup} =
   forM_ (webPreviewState cc) $ \WebPreviewState {publishableGroupIds, priorityRender, filesToRemove, corsNeeded, routinePending, wakeSignal} ->
     case publicGroup of
-      Just PublicGroupProfile {publicGroupId} -> do
-        let fName = publicGroupIdFileName publicGroupId <> ".json"
-        modifyTVar' publishableGroupIds (M.insert gId fName)
+      Just PublicGroupProfile {publicGroupId, publicGroupAccess} -> do
+        let pg = PublishableGroup
+              { pgFileName = publicGroupIdFileName publicGroupId <> ".json",
+                pgCorsEntry = corsEntry publicGroupId <$> publicGroupAccess
+              }
+        modifyTVar' publishableGroupIds (M.insert gId pg)
         writeTQueue priorityRender gId
         modifyTVar' routinePending (S.delete gId)
         writeTVar corsNeeded True
         void $ tryPutTMVar wakeSignal ()
       Nothing -> do
         ids <- readTVar publishableGroupIds
-        forM_ (M.lookup gId ids) $ writeTQueue filesToRemove
+        forM_ (pgFileName <$> M.lookup gId ids) $ writeTQueue filesToRemove
         modifyTVar' publishableGroupIds (M.delete gId)
         modifyTVar' routinePending (S.delete gId)
         writeTVar corsNeeded True
@@ -303,7 +299,7 @@ channelRemoved :: ChatController -> Int64 -> STM ()
 channelRemoved cc gId =
   forM_ (webPreviewState cc) $ \WebPreviewState {publishableGroupIds, filesToRemove, corsNeeded, routinePending, wakeSignal} -> do
     ids <- readTVar publishableGroupIds
-    forM_ (M.lookup gId ids) $ writeTQueue filesToRemove
+    forM_ (pgFileName <$> M.lookup gId ids) $ writeTQueue filesToRemove
     modifyTVar' publishableGroupIds (M.delete gId)
     modifyTVar' routinePending (S.delete gId)
     writeTVar corsNeeded True
@@ -361,8 +357,12 @@ memberToProfile :: GroupMember -> WebMemberProfile
 memberToProfile GroupMember {memberId, memberProfile = LocalProfile {displayName, image}} =
   WebMemberProfile {memberId, displayName, image}
 
-data CorsOrigin = CorsAny | CorsOrigins [Text]
-  deriving (Show)
+toPublishableGroup :: B64UrlByteString -> Maybe PublicGroupAccess -> PublishableGroup
+toPublishableGroup pgId access =
+  PublishableGroup
+    { pgFileName = publicGroupIdFileName pgId <> ".json",
+      pgCorsEntry = corsEntry pgId <$> access
+    }
 
 corsEntry :: B64UrlByteString -> PublicGroupAccess -> (Text, CorsOrigin)
 corsEntry publicGroupId PublicGroupAccess {groupWebPage, allowEmbedding} =
@@ -419,6 +419,3 @@ publicGroupIdFileName = B.unpack . strEncode
 hasPublicGroup :: GroupInfo -> Bool
 hasPublicGroup GroupInfo {groupProfile = GroupProfile {publicGroup}} = isJust publicGroup
 
-publicGroupFileName :: GroupInfo -> Maybe FilePath
-publicGroupFileName GroupInfo {groupProfile = GroupProfile {publicGroup}} =
-  (\PublicGroupProfile {publicGroupId} -> publicGroupIdFileName publicGroupId <> ".json") <$> publicGroup

tests/ChatTests/ChatRelays.hs

@@ -18,7 +18,8 @@ import qualified Data.Text as T
 import ProtocolTests (testGroupProfile)
 import Simplex.Chat.Protocol (LinkOwnerSig, MsgChatLink (..), MsgContent (..))
 import Simplex.Chat.Types (GroupProfile (..))
-import Simplex.Chat.Web (CorsOrigin (..), WebChannelPreview (..), WebMessage (..), removeStaleFiles, writeCorsConfig)
+import Simplex.Chat.Controller (CorsOrigin (..))
+import Simplex.Chat.Web (WebChannelPreview (..), WebMessage (..), removeStaleFiles, writeCorsConfig)
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Util (decodeJSON)
 import qualified Data.Set as S

website/src/js/channel-preview.jsc

@@ -1440,7 +1440,13 @@ function renderReactions(reactions) {
     const badge = document.createElement('span');
     badge.className = 'simplex-preview-reaction';
     const emoji = r.reaction && r.reaction.emoji ? r.reaction.emoji : '?';
-    badge.innerHTML = escapeHtml(emoji) + (r.totalReacted > 1 ? '<span class="simplex-preview-reaction-count">' + r.totalReacted + '</span>' : '');
+    badge.appendChild(document.createTextNode(emoji));
+    if (r.totalReacted > 1) {
+      const count = document.createElement('span');
+      count.className = 'simplex-preview-reaction-count';
+      count.textContent = r.totalReacted;
+      badge.appendChild(count);
+    }
     div.appendChild(badge);
   }
   return div;