more efficient rendering

This commit is contained in:
Evgeny @ SimpleX Chat
2026-06-04 07:39:39 +00:00
parent 3de88fb9b7
commit 6f539d8786
5 changed files with 71 additions and 40 deletions
+9 -1
View File
@@ -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,
+19
View File
@@ -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
+34 -37
View File
@@ -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