From a190d4ea9bfcd6aa71ab2d0de3edd2d06a8e0fa7 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sat, 20 Sep 2025 19:47:50 +0100 Subject: [PATCH] website: directory page (#6283) * website: directory page * core: use markdown in directory entries * render markdown on directory page * update markdown * toggle secrets on click * update listings asynchronously * add group links to the listing * cleanup * better directory layout with pagination * script to run website * update page navigation * search * readable markdown colors, better "read less" * core: atomic update of directory listings, to avoid files unavailable * fix symlink, sort entries on page with new first * update listings every 15 min, add activeAt time * fix sorting in the page and listing url * replace simplex:/ links on desktop --- apps/simplex-directory-service/Main.hs | 11 +- .../src/Directory/Listing.hs | 87 +++- .../src/Directory/Search.hs | 8 +- .../src/Directory/Service.hs | 130 ++++-- .../src/Directory/Store.hs | 2 +- bots/api/TYPES.md | 1 + bots/src/API/Docs/Types.hs | 18 +- .../types/typescript/src/types.ts | 1 + simplex-chat.cabal | 2 + src/Simplex/Chat/Controller.hs | 2 +- src/Simplex/Chat/Store.hs | 2 - src/Simplex/Chat/Store/Groups.hs | 24 +- src/Simplex/Chat/Store/Messages.hs | 2 - src/Simplex/Chat/Types.hs | 14 +- src/Simplex/Chat/View.hs | 6 +- tests/Bots/DirectoryTests.hs | 13 +- website/run.sh | 8 + website/src/blog.html | 128 ++--- website/src/directory.html | 272 +++++++++++ website/src/img/group.svg | 12 + website/src/js/directory.js | 439 ++++++++++++++++++ website/src/js/script.js | 3 +- 22 files changed, 994 insertions(+), 191 deletions(-) create mode 100755 website/run.sh create mode 100644 website/src/directory.html create mode 100644 website/src/img/group.svg create mode 100644 website/src/js/directory.js diff --git a/apps/simplex-directory-service/Main.hs b/apps/simplex-directory-service/Main.hs index e2b96f5677..88e7739aa0 100644 --- a/apps/simplex-directory-service/Main.hs +++ b/apps/simplex-directory-service/Main.hs @@ -5,8 +5,6 @@ module Main where import Directory.Options import Directory.Service import Directory.Store -import Simplex.Chat.Controller (ChatConfig (..), ChatHooks (..), defaultChatHooks) -import Simplex.Chat.Core import Simplex.Chat.Terminal (terminalChatConfig) main :: IO () @@ -15,11 +13,4 @@ main = do st <- restoreDirectoryStore directoryLog if runCLI then directoryServiceCLI st opts - else do - env <- newServiceState opts - let chatHooks = - defaultChatHooks - { postStartHook = Just $ directoryStartHook st opts, - acceptMember = Just $ acceptMemberHook opts env - } - simplexChatCore (terminalChatConfig {chatHooks}) (mkChatOpts opts) $ directoryService st opts env + else directoryService st opts terminalChatConfig diff --git a/apps/simplex-directory-service/src/Directory/Listing.hs b/apps/simplex-directory-service/src/Directory/Listing.hs index a05e82285d..b9b50cb87b 100644 --- a/apps/simplex-directory-service/src/Directory/Listing.hs +++ b/apps/simplex-directory-service/src/Directory/Listing.hs @@ -1,9 +1,11 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} module Directory.Listing where @@ -11,23 +13,36 @@ module Directory.Listing where import Control.Applicative ((<|>)) import Control.Concurrent.STM import Control.Monad +import Crypto.Hash (Digest, MD5) +import qualified Crypto.Hash as CH import qualified Data.Aeson as J import qualified Data.Aeson.TH as JQ +import qualified Data.ByteArray as BA import Data.ByteString (ByteString) -import Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Base64.URL as B64URL import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as LB -import Data.Maybe (fromMaybe) +import Data.List (isPrefixOf) +import Data.Maybe (catMaybes, fromMaybe) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) +import Data.Time.Clock (UTCTime, getCurrentTime) +import Data.Time.Format.ISO8601 (iso8601Show) import Directory.Store +import Simplex.Chat.Markdown import Simplex.Chat.Types +import Simplex.Messaging.Agent.Protocol +import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, taggedObjectJSON) import System.Directory import System.FilePath +directoryDataPath :: String +directoryDataPath = "data" + listingFileName :: String listingFileName = "listing.json" @@ -47,9 +62,12 @@ $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "DET") ''DirectoryEntryType) data DirectoryEntry = DirectoryEntry { entryType :: DirectoryEntryType, displayName :: Text, - shortDescr :: Maybe Text, - welcomeMessage :: Maybe Text, - imageFile :: Maybe String + groupLink :: CreatedLinkContact, + shortDescr :: Maybe MarkdownList, + welcomeMessage :: Maybe MarkdownList, + imageFile :: Maybe String, + activeAt :: UTCTime, + createdAt :: UTCTime } $(JQ.deriveJSON defaultJSON ''DirectoryEntry) @@ -60,38 +78,67 @@ $(JQ.deriveJSON defaultJSON ''DirectoryListing) type ImageFileData = ByteString -groupDirectoryEntry :: GroupInfoSummary -> (DirectoryEntry, Maybe (FilePath, ImageFileData)) -groupDirectoryEntry (GIS GroupInfo {groupId, groupProfile} summary) = +groupDirectoryEntry :: GroupInfoSummary -> Maybe (DirectoryEntry, Maybe (FilePath, ImageFileData)) +groupDirectoryEntry (GIS GroupInfo {groupProfile, chatTs, createdAt} summary gLink_) = let GroupProfile {displayName, shortDescr, description, image, memberAdmission} = groupProfile entryType = DETGroup memberAdmission summary - imgData = imgFileData =<< image - in (DirectoryEntry {entryType, displayName, shortDescr, welcomeMessage = description, imageFile = fst <$> imgData}, imgData) + entry groupLink = + let de = + DirectoryEntry + { entryType, + displayName, + groupLink, + shortDescr = toFormattedText <$> shortDescr, + welcomeMessage = toFormattedText <$> description, + imageFile = fst <$> imgData, + activeAt = fromMaybe createdAt chatTs, + createdAt + } + imgData = imgFileData groupLink =<< image + in (de, imgData) + in (entry . connLinkContact) <$> gLink_ where - imgFileData (ImageData img) = + imgFileData :: CreatedConnLink 'CMContact -> ImageData -> Maybe (FilePath, ByteString) + imgFileData groupLink (ImageData img) = let (img', imgExt) = fromMaybe (img, ".jpg") $ (,".jpg") <$> T.stripPrefix "data:image/jpg;base64," img <|> (,".png") <$> T.stripPrefix "data:image/png;base64," img - imgFile = listingImageFolder show groupId <> imgExt + imgName = B.unpack $ B64URL.encodeUnpadded $ BA.convert $ (CH.hash :: ByteString -> Digest MD5) $ strEncode (connFullLink groupLink) + imgFile = listingImageFolder imgName <> imgExt in case B64.decode $ encodeUtf8 img' of Right img'' -> Just (imgFile, img'') Left _ -> Nothing generateListing :: DirectoryStore -> FilePath -> [GroupInfoSummary] -> IO () generateListing st dir gs = do + createDirectoryIfMissing True dir + oldDirs <- filter ((directoryDataPath <> ".") `isPrefixOf`) <$> listDirectory dir + ts <- getCurrentTime + let newDirPath = directoryDataPath <> "." <> iso8601Show ts <> "/" + newDir = dir newDirPath gs' <- filterListedGroups st gs - removePathForcibly (dir listingImageFolder) - createDirectoryIfMissing True (dir listingImageFolder) - gs'' <- forM gs' $ \g@(GIS GroupInfo {groupId} _) -> do - let (g', img) = groupDirectoryEntry g - forM_ img $ \(imgFile, imgData) -> B.writeFile (dir imgFile) imgData - pure (groupId, g') - saveListing listingFileName gs'' - saveListing promotedFileName =<< filterPromotedGroups st gs'' + createDirectoryIfMissing True (newDir listingImageFolder) + gs'' <- + fmap catMaybes $ forM gs' $ \g@(GIS GroupInfo {groupId} _ _) -> + forM (groupDirectoryEntry g) $ \(g', img) -> do + forM_ img $ \(imgFile, imgData) -> B.writeFile (newDir imgFile) imgData + pure (groupId, g') + saveListing newDir listingFileName gs'' + saveListing newDir promotedFileName =<< filterPromotedGroups st gs'' + -- atomically update the link + let newSymLink = newDir <> ".link" + symLink = dir directoryDataPath + createDirectoryLink newDirPath newSymLink + renamePath newSymLink symLink + mapM_ (removePathForcibly . (dir )) oldDirs where - saveListing f = LB.writeFile (dir f) . J.encode . DirectoryListing . map snd + saveListing newDir f = LB.writeFile (newDir f) . J.encode . DirectoryListing . map snd filterPromotedGroups :: DirectoryStore -> [(GroupId, DirectoryEntry)] -> IO [(GroupId, DirectoryEntry)] filterPromotedGroups st gs = do pgs <- readTVarIO $ promotedGroups st pure $ filter (\g -> fst g `S.member` pgs) gs + +toFormattedText :: Text -> MarkdownList +toFormattedText t = fromMaybe [FormattedText Nothing t] $ parseMaybeMarkdownList t diff --git a/apps/simplex-directory-service/src/Directory/Search.hs b/apps/simplex-directory-service/src/Directory/Search.hs index 5b0d650444..2d4cbf9c7b 100644 --- a/apps/simplex-directory-service/src/Directory/Search.hs +++ b/apps/simplex-directory-service/src/Directory/Search.hs @@ -20,13 +20,13 @@ data SearchRequest = SearchRequest data SearchType = STAll | STRecent | STSearch Text takeTop :: Int -> [GroupInfoSummary] -> [GroupInfoSummary] -takeTop n = take n . sortOn (\(GIS _ GroupSummary {currentMembers}) -> Down currentMembers) +takeTop n = take n . sortOn (\(GIS _ GroupSummary {currentMembers} _) -> Down currentMembers) takeRecent :: Int -> [GroupInfoSummary] -> [GroupInfoSummary] -takeRecent n = take n . sortOn (\(GIS GroupInfo {createdAt} _) -> Down createdAt) +takeRecent n = take n . sortOn (\(GIS GroupInfo {createdAt} _ _) -> Down createdAt) groupIds :: [GroupInfoSummary] -> Set GroupId -groupIds = S.fromList . map (\(GIS GroupInfo {groupId} _) -> groupId) +groupIds = S.fromList . map (\(GIS GroupInfo {groupId} _ _) -> groupId) filterNotSent :: Set GroupId -> [GroupInfoSummary] -> [GroupInfoSummary] -filterNotSent sentGroups = filter (\(GIS GroupInfo {groupId} _) -> groupId `S.notMember` sentGroups) +filterNotSent sentGroups = filter (\(GIS GroupInfo {groupId} _ _) -> groupId `S.notMember` sentGroups) diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 7bbe4e43a4..b7f1bb3629 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -21,7 +21,6 @@ module Directory.Service where import Control.Concurrent (forkIO) -import Control.Concurrent.Async import Control.Concurrent.STM import Control.Logger.Simple import Control.Monad @@ -54,7 +53,6 @@ import Simplex.Chat.Markdown (Format (..), FormattedText (..), parseMaybeMarkdow import Simplex.Chat.Messages import Simplex.Chat.Options import Simplex.Chat.Protocol (MsgContent (..)) -import Simplex.Chat.Store (GroupLink (..)) import Simplex.Chat.Store.Direct (getContact) import Simplex.Chat.Store.Groups (getGroupInfo, getGroupLink, getGroupSummary, getUserGroupsWithSummary, setGroupCustomData) import Simplex.Chat.Store.Profiles (GroupLinkInfo (..), getGroupLinkInfo) @@ -69,7 +67,7 @@ import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnectionLink (. import Simplex.Messaging.Encoding.String import Simplex.Messaging.TMap (TMap) import qualified Simplex.Messaging.TMap as TM -import Simplex.Messaging.Util (safeDecodeUtf8, tshow, unlessM, whenM, ($>>=), (<$$>)) +import Simplex.Messaging.Util (raceAny_, safeDecodeUtf8, tshow, unlessM, whenM, ($>>=), (<$$>)) import System.Directory (getAppUserDataDirectory) import System.Exit (exitFailure) import System.Process (readProcess) @@ -96,7 +94,8 @@ data GroupRolesStatus data ServiceState = ServiceState { searchRequests :: TMap ContactId SearchRequest, blockedWordsCfg :: BlockedWordsConfig, - pendingCaptchas :: TMap GroupMemberId PendingCaptcha + pendingCaptchas :: TMap GroupMemberId PendingCaptcha, + updateListingsJob :: TMVar ChatController } data PendingCaptcha = PendingCaptcha @@ -119,7 +118,8 @@ newServiceState opts = do searchRequests <- TM.emptyIO blockedWordsCfg <- readBlockedWordsConfig opts pendingCaptchas <- TM.emptyIO - pure ServiceState {searchRequests, blockedWordsCfg, pendingCaptchas} + updateListingsJob <- newEmptyTMVarIO + pure ServiceState {searchRequests, blockedWordsCfg, pendingCaptchas, updateListingsJob} welcomeGetOpts :: IO DirectoryOpts welcomeGetOpts = do @@ -146,22 +146,41 @@ directoryServiceCLI st opts = do env <- newServiceState opts eventQ <- newTQueueIO let eventHook cc resp = atomically $ resp <$ writeTQueue eventQ (cc, resp) - chatHooks = defaultChatHooks {postStartHook = Just $ directoryStartHook st opts, eventHook = Just eventHook, acceptMember = Just $ acceptMemberHook opts env} - race_ - (simplexChatCLI' terminalChatConfig {chatHooks} (mkChatOpts opts) Nothing) - (processEvents eventQ env) + chatHooks = defaultChatHooks {postStartHook = Just $ directoryStartHook opts env, eventHook = Just eventHook, acceptMember = Just $ acceptMemberHook opts env} + raceAny_ $ + [ simplexChatCLI' terminalChatConfig {chatHooks} (mkChatOpts opts) Nothing, + processEvents eventQ env + ] + <> updateListingsThread_ st opts env where processEvents eventQ env = forever $ do (cc, resp) <- atomically $ readTQueue eventQ u_ <- readTVarIO (currentUser cc) forM_ u_ $ \user -> directoryServiceEvent st opts env user cc resp -directoryStartHook :: DirectoryStore -> DirectoryOpts -> ChatController -> IO () -directoryStartHook st opts cc = +updateListingDelay :: Int +updateListingDelay = 15 * 60 * 1000000 -- update every 15 minutes + +updateListingsThread_ :: DirectoryStore -> DirectoryOpts -> ServiceState -> [IO ()] +updateListingsThread_ st opts env = maybe [] (\f -> [updateListingsThread f]) $ webFolder opts + where + updateListingsThread f = do + cc <- atomically $ takeTMVar $ updateListingsJob env + forever $ do + u <- readTVarIO $ currentUser cc + forM_ u $ \user -> updateGroupListingFiles cc st user f + delay <- registerDelay updateListingDelay + atomically $ void (takeTMVar $ updateListingsJob env) `orElse` unlessM (readTVar delay) retry + +listingsUpdated :: ServiceState -> ChatController -> IO () +listingsUpdated env = void . atomically . tryPutTMVar (updateListingsJob env) + +directoryStartHook :: DirectoryOpts -> ServiceState -> ChatController -> IO () +directoryStartHook opts env cc = readTVarIO (currentUser cc) >>= \case Nothing -> putStrLn "No current user" >> exitFailure - Just user@User {userId, profile = p@LocalProfile {preferences}} -> do - forM_ (webFolder opts) $ updateGroupListingFiles cc st user + Just User {userId, profile = p@LocalProfile {preferences}} -> do + listingsUpdated env cc let cmds = fromMaybe [] $ preferences >>= commands_ unless (cmds == directoryCommands) $ do let prefs = (fromMaybe emptyChatPrefs preferences) {files = Just FilesPreference {allow = FANo}, commands = Just directoryCommands} :: Preferences @@ -188,12 +207,23 @@ directoryCommands = where idParam = Just "" -directoryService :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> ChatController -> IO () -directoryService st opts@DirectoryOpts {testing} env user cc = do - initializeBotAddress' (not testing) cc - race_ (forever $ void getLine) . forever $ do - (_, resp) <- atomically . readTBQueue $ outputQ cc - directoryServiceEvent st opts env user cc resp +directoryService :: DirectoryStore -> DirectoryOpts -> ChatConfig -> IO () +directoryService st opts@DirectoryOpts {testing} cfg = do + env <- newServiceState opts + let chatHooks = + defaultChatHooks + { postStartHook = Just $ directoryStartHook opts env, + acceptMember = Just $ acceptMemberHook opts env + } + simplexChatCore cfg {chatHooks} (mkChatOpts opts) $ \user cc -> do + initializeBotAddress' (not testing) cc + raceAny_ $ + [ forever $ void getLine, + forever $ do + (_, resp) <- atomically . readTBQueue $ outputQ cc + directoryServiceEvent st opts env user cc resp + ] + <> updateListingsThread_ st opts env acceptMemberHook :: DirectoryOpts -> ServiceState -> GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole)) acceptMemberHook @@ -301,7 +331,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName getDuplicateGroup GroupInfo {groupId, groupProfile = GroupProfile {displayName, fullName}} = getGroups fullName >>= mapM duplicateGroup where - sameGroupNotRemoved (GIS g@GroupInfo {groupId = gId, groupProfile = GroupProfile {displayName = n, fullName = fn}} _) = + sameGroupNotRemoved (GIS g@GroupInfo {groupId = gId, groupProfile = GroupProfile {displayName = n, fullName = fn}} _ _) = gId /= groupId && n == displayName && fn == fullName && not (memberRemoved $ membership g) duplicateGroup [] = pure DGUnique duplicateGroup groups = do @@ -310,13 +340,13 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName then pure DGUnique else do (lgs, rgs) <- atomically $ (,) <$> readTVar (listedGroups st) <*> readTVar (reservedGroups st) - let reserved = any (\(GIS GroupInfo {groupId = gId} _) -> gId `S.member` lgs || gId `S.member` rgs) gs + let reserved = any (\(GIS GroupInfo {groupId = gId} _ _) -> gId `S.member` lgs || gId `S.member` rgs) gs if reserved then pure DGReserved else do removed <- foldM (\r -> fmap (r &&) . isGroupRemoved) True gs pure $ if removed then DGUnique else DGRegistered - isGroupRemoved (GIS GroupInfo {groupId = gId} _) = + isGroupRemoved (GIS GroupInfo {groupId = gId} _ _) = getGroupReg st gId >>= \case Just GroupReg {groupRegStatus} -> groupRemoved <$> readTVarIO groupRegStatus Nothing -> pure True @@ -395,7 +425,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName notifyOwner gr $ "Joined the group " <> displayName <> ", creating the link…" sendChatCmd cc (APICreateGroupLink groupId GRMember) >>= \case Right CRGroupLinkCreated {groupLink = GroupLink {connLinkContact = gLink}} -> do - setGroupStatus st opts cc user gr GRSPendingUpdate + setGroupStatus st env cc gr GRSPendingUpdate notifyOwner gr "Created the public link to join the group via this directory service that is always online.\n\n\ @@ -456,7 +486,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName Just DGReserved -> notifyOwner gr $ groupAlreadyListed toGroup _ -> do let gaId = 1 - setGroupStatus st opts cc user gr $ GRSPendingApproval gaId + setGroupStatus st env cc gr $ GRSPendingApproval gaId notifyOwner gr $ ("Thank you! The group link for " <> userGroupReference gr toGroup <> " is added to the welcome message" <> byMember) <> ".\nYou will be notified once the group is added to the directory - it may take up to 48 hours." @@ -466,18 +496,18 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName groupRef = groupReference toGroup groupProfileUpdate >>= \case GPNoServiceLink -> do - setGroupStatus st opts cc user gr GRSPendingUpdate + setGroupStatus st env cc gr GRSPendingUpdate notifyOwner gr $ ("The group profile is updated for " <> userGroupRef <> byMember <> ", but no link is added to the welcome message.\n\n") <> "The group will remain hidden from the directory until the group link is added and the group is re-approved." GPServiceLinkRemoved -> do - setGroupStatus st opts cc user gr GRSPendingUpdate + setGroupStatus st env cc gr GRSPendingUpdate notifyOwner gr $ ("The group link for " <> userGroupRef <> " is removed from the welcome message" <> byMember) <> ".\n\nThe group is hidden from the directory until the group link is added and the group is re-approved." notifyAdminUsers $ "The group link is removed from " <> groupRef <> ", de-listed." GPServiceLinkAdded _ -> do - setGroupStatus st opts cc user gr $ GRSPendingApproval n' + setGroupStatus st env cc gr $ GRSPendingApproval n' notifyOwner gr $ ("The group link is added to " <> userGroupRef <> byMember) <> "!\nIt is hidden from the directory until approved." @@ -490,7 +520,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName <> "!\nThe group is listed in directory." notifyAdminUsers $ "The group " <> groupRef <> " is updated" <> byMember <> " - only link or whitespace changes.\nThe group remained listed in directory." | otherwise -> do - setGroupStatus st opts cc user gr $ GRSPendingApproval n' + setGroupStatus st env cc gr $ GRSPendingApproval n' notifyOwner gr $ ("The group " <> userGroupRef <> " is updated" <> byMember) <> "!\nIt is hidden from the directory until approved." @@ -628,14 +658,14 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName when (ctId `isOwner` gr) $ do readTVarIO (groupRegStatus gr) >>= \case GRSSuspendedBadRoles -> when (rStatus == GRSOk) $ do - setGroupStatus st opts cc user gr GRSActive + setGroupStatus st env cc gr GRSActive notifyOwner gr $ uCtRole <> ".\n\nThe group is listed in the directory again." notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suCtRole GRSPendingApproval gaId -> when (rStatus == GRSOk) $ do sendToApprove g gr gaId notifyOwner gr $ uCtRole <> ".\n\nThe group is submitted for approval." GRSActive -> when (rStatus /= GRSOk) $ do - setGroupStatus st opts cc user gr GRSSuspendedBadRoles + setGroupStatus st env cc gr GRSSuspendedBadRoles notifyOwner gr $ uCtRole <> ".\n\nThe group is no longer listed in the directory." notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suCtRole _ -> pure () @@ -654,7 +684,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName readTVarIO (groupRegStatus gr) >>= \case GRSSuspendedBadRoles -> when (serviceRole == GRAdmin) $ whenContactIsOwner gr $ do - setGroupStatus st opts cc user gr GRSActive + setGroupStatus st env cc gr GRSActive notifyOwner gr $ uSrvRole <> ".\n\nThe group is listed in the directory again." notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suSrvRole GRSPendingApproval gaId -> when (serviceRole == GRAdmin) $ @@ -662,7 +692,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName sendToApprove g gr gaId notifyOwner gr $ uSrvRole <> ".\n\nThe group is submitted for approval." GRSActive -> when (serviceRole /= GRAdmin) $ do - setGroupStatus st opts cc user gr GRSSuspendedBadRoles + setGroupStatus st env cc gr GRSSuspendedBadRoles notifyOwner gr $ uSrvRole <> ".\n\nThe group is no longer listed in the directory." notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suSrvRole _ -> pure () @@ -679,7 +709,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName logInfo $ "contact ID " <> tshow ctId <> " removed from group " <> viewGroupName g withGroupReg g "contact removed" $ \gr -> do when (ctId `isOwner` gr) $ do - setGroupStatus st opts cc user gr GRSRemoved + setGroupStatus st env cc gr GRSRemoved notifyOwner gr $ "You are removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory." notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (group owner is removed)." @@ -688,7 +718,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName logInfo $ "contact ID " <> tshow ctId <> " left group " <> viewGroupName g withGroupReg g "contact left" $ \gr -> do when (ctId `isOwner` gr) $ do - setGroupStatus st opts cc user gr GRSRemoved + setGroupStatus st env cc gr GRSRemoved notifyOwner gr $ "You left the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory." notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (group owner left)." @@ -696,7 +726,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName deServiceRemovedFromGroup g = do logInfo $ "service removed from group " <> viewGroupName g withGroupReg g "service removed" $ \gr -> do - setGroupStatus st opts cc user gr GRSRemoved + setGroupStatus st env cc gr GRSRemoved notifyOwner gr $ serviceName <> " is removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory." notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (directory service is removed)." @@ -704,7 +734,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName deGroupDeleted g = do logInfo $ "group removed " <> viewGroupName g withGroupReg g "group removed" $ \gr -> do - setGroupStatus st opts cc user gr GRSRemoved + setGroupStatus st env cc gr GRSRemoved notifyOwner gr $ "The group " <> userGroupReference gr g <> " is deleted.\n\nThe group is no longer listed in the directory." notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (group is deleted)." @@ -925,7 +955,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName where msgs = replyMsg :| map foundGroup gs <> [moreMsg | moreGroups > 0] replyMsg = (Just ciId, MCText reply) - foundGroup (GIS GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_}} GroupSummary {currentMembers}) = + foundGroup (GIS GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_}} GroupSummary {currentMembers} _) = let membersStr = "_" <> tshow currentMembers <> " members_" showId = if isAdmin then tshow groupId <> ". " else "" text = showId <> groupInfoText p <> "\n" <> membersStr @@ -946,16 +976,16 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName _ -> do getGroupRolesStatus g gr >>= \case Just GRSOk -> do - setGroupStatus st opts cc user gr GRSActive + setGroupStatus st env cc gr GRSActive forM_ promote $ \promo -> if promo -- admins can unpromote, only super-user can promote when approving then unlessM (readTVarIO promoted) $ if knownCt `elem` superUsers - then setGroupPromoted st opts cc user gr True + then setGroupPromoted st env cc gr True else sendReply "You cannot promote groups" else do - whenM (readTVarIO promoted) $ setGroupPromoted st opts cc user gr False + whenM (readTVarIO promoted) $ setGroupPromoted st env cc gr False notifyOtherSuperUsers $ "Group promotion is disabled for " <> groupRef let approved = "The group " <> userGroupReference' gr n <> " is approved" notifyOwner gr $ @@ -991,7 +1021,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName withGroupAndReg sendReply groupId gName $ \_ gr -> readTVarIO (groupRegStatus gr) >>= \case GRSActive -> do - setGroupStatus st opts cc user gr GRSSuspended + setGroupStatus st env cc gr GRSSuspended let suspended = "The group " <> userGroupReference' gr gName <> " is suspended" notifyOwner gr $ suspended <> " and hidden from directory. Please contact the administrators." sendReply "Group suspended!" @@ -1002,7 +1032,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName withGroupAndReg sendReply groupId gName $ \_ gr -> readTVarIO (groupRegStatus gr) >>= \case GRSSuspended -> do - setGroupStatus st opts cc user gr GRSActive + setGroupStatus st env cc gr GRSActive let groupStr = "The group " <> userGroupReference' gr gName notifyOwner gr $ groupStr <> " is listed in the directory again!" sendReply "Group listing resumed!" @@ -1078,7 +1108,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName withGroupAndReg sendReply groupId gName $ \_ gr@GroupReg {groupRegStatus, promoted} -> do status <- readTVarIO groupRegStatus promote <- readTVarIO promoted - when (promote' /= promote) $ setGroupPromoted st opts cc user gr promote' + when (promote' /= promote) $ setGroupPromoted st env cc gr promote' let msg = "Group promotion " <> (if promote' then "enabled" <> (if status == GRSActive then "." else ", but the group is not listed.") else "disabled.") @@ -1132,18 +1162,16 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName let text = T.unlines $ [tshow useGroupId <> ". Error: getGroup. Please notify the developers."] <> maybeToList ownerStr_ <> [statusStr] sendComposedMessage cc ct Nothing $ MCText text -setGroupStatus :: DirectoryStore -> DirectoryOpts -> ChatController -> User -> GroupReg -> GroupRegStatus -> IO () -setGroupStatus st opts cc u gr grStatus' = do +setGroupStatus :: DirectoryStore -> ServiceState -> ChatController -> GroupReg -> GroupRegStatus -> IO () +setGroupStatus st env cc gr grStatus' = do let status' = grDirectoryStatus grStatus' status <- setGroupStatusStore st gr grStatus' - forM_ (webFolder opts) $ \dir -> - when ((status == DSListed || status' == DSListed) && status /= status') $ updateGroupListingFiles cc st u dir + when ((status == DSListed || status' == DSListed) && status /= status') $ listingsUpdated env cc -setGroupPromoted :: DirectoryStore -> DirectoryOpts -> ChatController -> User -> GroupReg -> Bool -> IO () -setGroupPromoted st opts cc u gr grPromoted' = do +setGroupPromoted :: DirectoryStore -> ServiceState -> ChatController -> GroupReg -> Bool -> IO () +setGroupPromoted st env cc gr grPromoted' = do (status, grPromoted) <- setGroupPromotedStore st gr grPromoted' - forM_ (webFolder opts) $ \dir -> - when (status == DSListed && grPromoted' /= grPromoted) $ updateGroupListingFiles cc st u dir + when (status == DSListed && grPromoted' /= grPromoted) $ listingsUpdated env cc updateGroupListingFiles :: ChatController -> DirectoryStore -> User -> FilePath -> IO () updateGroupListingFiles cc st u dir = diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs index 16f047202f..1c8e1a24b5 100644 --- a/apps/simplex-directory-service/src/Directory/Store.hs +++ b/apps/simplex-directory-service/src/Directory/Store.hs @@ -273,7 +273,7 @@ getUserGroupRegs st ctId = filter ((ctId ==) . dbContactId) <$> readTVarIO (grou filterListedGroups :: DirectoryStore -> [GroupInfoSummary] -> IO [GroupInfoSummary] filterListedGroups st gs = do lgs <- readTVarIO $ listedGroups st - pure $ filter (\(GIS GroupInfo {groupId} _) -> groupId `S.member` lgs) gs + pure $ filter (\(GIS GroupInfo {groupId} _ _) -> groupId `S.member` lgs) gs listGroup :: DirectoryStore -> GroupReg -> STM () listGroup st gr = do diff --git a/bots/api/TYPES.md b/bots/api/TYPES.md index f20c7c4913..6207b1bf64 100644 --- a/bots/api/TYPES.md +++ b/bots/api/TYPES.md @@ -2159,6 +2159,7 @@ MemberSupport: **Record type**: - groupInfo: [GroupInfo](#groupinfo) - groupSummary: [GroupSummary](#groupsummary) +- groupLink: [GroupLink](#grouplink)? --- diff --git a/bots/src/API/Docs/Types.hs b/bots/src/API/Docs/Types.hs index 83675798af..d74f6d37dd 100644 --- a/bots/src/API/Docs/Types.hs +++ b/bots/src/API/Docs/Types.hs @@ -29,7 +29,6 @@ import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent import Simplex.Chat.Messages.CIContent.Events import Simplex.Chat.Protocol -import Simplex.Chat.Store.Groups import Simplex.Chat.Store.Profiles import Simplex.Chat.Store.Shared import Simplex.Chat.Types @@ -69,7 +68,7 @@ chatTypesDocs = sortOn docTypeName $! snd $! mapAccumL toCTDoc (S.empty, M.empty let (tds', td_) = toTypeDef tds sumTypeInfo in case td_ of Just typeDef -> (tds', CTDoc {typeDef, typeSyntax, typeDescr}) - Nothing -> error $ "Recursive type: " <> typeName + Nothing -> error $ "Recursive type: " <> typeName toTypeDef :: (S.Set String, M.Map String APITypeDef) -> (SumTypeInfo, SumTypeJsonEncoding, String, [ConsName], Expr, Text) -> ((S.Set String, M.Map String APITypeDef), Maybe APITypeDef) toTypeDef acc@(!visited, !typeDefs) (STI typeName allConstrs, jsonEncoding, consPrefix, hideConstrs, _, _) = @@ -84,7 +83,7 @@ toTypeDef acc@(!visited, !typeDefs) (STI typeName allConstrs, jsonEncoding, cons let fields = fromMaybe (error $ "Record type without fields: " <> typeName) $ L.nonEmpty fieldInfos ((visited', typeDefs'), fields') = mapAccumL (toAPIField_ typeName) (S.insert typeName visited, typeDefs) fields td = APITypeDef typeName $ ATDRecord $ L.toList fields' - in ((S.insert typeName visited', M.insert typeName td typeDefs'), Just td) + in ((S.insert typeName visited', M.insert typeName td typeDefs'), Just td) _ -> error $ "Record type with " <> show (length constrs) <> " constructors: " <> typeName STUnion -> if length constrs > 1 then toUnionType constrs else unionError constrs STUnion1 -> if length constrs == 1 then toUnionType constrs else unionError constrs @@ -98,16 +97,16 @@ toTypeDef acc@(!visited, !typeDefs) (STI typeName allConstrs, jsonEncoding, cons toUnionType constrs = let ((visited', typeDefs'), members) = mapAccumL toUnionMember (S.insert typeName visited, typeDefs) $ fromMaybe (unionError constrs) $ L.nonEmpty constrs td = APITypeDef typeName $ ATDUnion members - in ((S.insert typeName visited', M.insert typeName td typeDefs'), Just td) + in ((S.insert typeName visited', M.insert typeName td typeDefs'), Just td) toUnionMember tds RecordTypeInfo {consName, fieldInfos} = let memberTag = normalizeConsName consPrefix consName - in second (ATUnionMember memberTag) $ mapAccumL (toAPIField_ typeName) tds fieldInfos + in second (ATUnionMember memberTag) $ mapAccumL (toAPIField_ typeName) tds fieldInfos unionError constrs = error $ "Union type with " <> show (length constrs) <> " constructor(s): " <> typeName toEnumType = toEnumType_ $ normalizeConsName consPrefix toEnumType_ f constrs = let members = L.map toEnumMember $ fromMaybe (enumError constrs) $ L.nonEmpty constrs td = APITypeDef typeName $ ATDEnum members - in ((S.insert typeName visited, M.insert typeName td typeDefs), Just td) + in ((S.insert typeName visited, M.insert typeName td typeDefs), Just td) where toEnumMember RecordTypeInfo {consName, fieldInfos} = case fieldInfos of [] -> f consName @@ -121,7 +120,7 @@ toAPIField_ typeName tds (FieldInfo fieldName typeInfo) = second (APIRecordField toAPIType = \case TIType (ST name _) -> apiTypeForName name TIOptional tInfo -> second ATOptional $ toAPIType tInfo - TIArray {elemType, nonEmpty} -> second (`ATArray`nonEmpty) $ toAPIType elemType + TIArray {elemType, nonEmpty} -> second (`ATArray` nonEmpty) $ toAPIType elemType TIMap {keyType = ST name _, valueType} | name `elem` primitiveTypes -> second (ATMap (PT name)) $ toAPIType valueType | otherwise -> error $ "Non-primitive key type in " <> typeName <> ", " <> fieldName @@ -133,7 +132,7 @@ toAPIField_ typeName tds (FieldInfo fieldName typeInfo) = second (APIRecordField Nothing -> case find (\(STI name' _, _, _, _, _, _) -> name == name') chatTypesDocsData of Just sumTypeInfo -> let (tds', td_) = toTypeDef tds sumTypeInfo -- recursion to outer function, loops are resolved via type defs map lookup - in case td_ of + in case td_ of Just td -> (tds', ATDef td) Nothing -> (tds', ATRef name) Nothing -> error $ "Undefined type: " <> name @@ -352,7 +351,6 @@ chatTypesDocsData = (sti @XFTPErrorType, STUnion, "", [], "", ""), (sti @XFTPRcvFile, STRecord, "", [], "", ""), (sti @XFTPSndFile, STRecord, "", [], "", "") - -- (sti @DatabaseError, STUnion, "DB", [], "", ""), -- (sti @ChatItemInfo, STRecord, "", [], "", ""), -- (sti @ChatItemVersion, STRecord, "", [], "", ""), @@ -371,7 +369,7 @@ chatTypesDocsData = -- (sti @SendRef, STRecord, "", [], "", ""), -- (sti @SndQueueInfo, STRecord, "", [], "", ""), -- (sti @SndSwitchStatus, STEnum, "", [], "", ""), -- incorrect - ] + ] data SimplePreference = SimplePreference {allow :: FeatureAllowed} deriving (Generic) diff --git a/packages/simplex-chat-client/types/typescript/src/types.ts b/packages/simplex-chat-client/types/typescript/src/types.ts index bdc99ee750..97bc45f3ce 100644 --- a/packages/simplex-chat-client/types/typescript/src/types.ts +++ b/packages/simplex-chat-client/types/typescript/src/types.ts @@ -2451,6 +2451,7 @@ export interface GroupInfo { export interface GroupInfoSummary { groupInfo: GroupInfo groupSummary: GroupSummary + groupLink?: GroupLink } export interface GroupLink { diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 7a9dd3a92d..529873b7d3 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -473,8 +473,10 @@ executable simplex-directory-service , base64-bytestring >=1.0 && <1.3 , composition ==1.0.* , containers ==0.6.* + , crypton ==0.34.* , directory ==1.3.* , filepath ==1.4.* + , memory ==0.18.* , mtl >=2.3.1 && <3.0 , optparse-applicative >=0.15 && <0.17 , process >=1.6 && <1.6.18 diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 0b2f16ad1d..45fd264afc 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -62,7 +62,7 @@ import Simplex.Chat.Protocol import Simplex.Chat.Remote.AppVersion import Simplex.Chat.Remote.Types import Simplex.Chat.Stats (PresentedServersSummary) -import Simplex.Chat.Store (AddressSettings, ChatLockEntity, GroupLink, GroupLinkInfo, StoreError (..), UserContactLink, UserMsgReceiptSettings) +import Simplex.Chat.Store (AddressSettings, ChatLockEntity, GroupLinkInfo, StoreError (..), UserContactLink, UserMsgReceiptSettings) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Shared diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index e80037be74..e81ec0cc3a 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -6,7 +6,6 @@ module Simplex.Chat.Store ChatLockEntity (..), UserMsgReceiptSettings (..), UserContactLink (..), - GroupLink (..), GroupLinkInfo (..), AddressSettings (..), AutoAccept (..), @@ -16,7 +15,6 @@ module Simplex.Chat.Store ) where -import Simplex.Chat.Store.Groups (GroupLink (..)) import Simplex.Chat.Store.Profiles import Simplex.Chat.Store.Shared import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction) diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 3d8bdead72..7e9d7b4ae2 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -18,7 +18,6 @@ module Simplex.Chat.Store.Groups GroupInfoRow, GroupMemberRow, MaybeGroupMemberRow, - GroupLink (..), toGroupInfo, toGroupMember, toMaybeGroupMember, @@ -162,7 +161,6 @@ import Control.Monad import Control.Monad.Except import Control.Monad.IO.Class import Crypto.Random (ChaChaDRG) -import qualified Data.Aeson.TH as J import Data.Bifunctor (second) import Data.Bitraversable (bitraverse) import Data.Char (toLower) @@ -188,7 +186,6 @@ import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..)) import qualified Simplex.Messaging.Agent.Store.DB as DB import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff) -import Simplex.Messaging.Parsers (defaultJSON) import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Util (eitherToMaybe, firstRow', safeDecodeUtf8, ($>>), ($>>=), (<$$>)) import Simplex.Messaging.Version @@ -280,16 +277,6 @@ deleteGroupLink db User {userId} GroupInfo {groupId} = do (userId, groupId) DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND group_id = ?" (userId, groupId) -data GroupLink = GroupLink - { userContactLinkId :: Int64, - connLinkContact :: CreatedLinkContact, - shortLinkDataSet :: Bool, - shortLinkLargeDataSet :: BoolDef, - groupLinkId :: GroupLinkId, - acceptMemberRole :: GroupMemberRole - } - deriving (Show) - getGroupLink :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO GroupLink getGroupLink db User {userId} gInfo@GroupInfo {groupId} = ExceptT . firstRow toGroupLink (SEGroupLinkNotFound gInfo) $ @@ -982,9 +969,12 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do search = maybe "" (map toLower) search_ getUserGroupsWithSummary :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfoSummary] -getUserGroupsWithSummary db vr user _contactId_ search_ = - getUserGroupDetails db vr user _contactId_ search_ - >>= mapM (\g@GroupInfo {groupId} -> GIS g <$> getGroupSummary db user groupId) +getUserGroupsWithSummary db vr user _contactId_ search_ = do + gs <- getUserGroupDetails db vr user _contactId_ search_ + forM gs $ \g@GroupInfo {groupId} -> do + s <- getGroupSummary db user groupId + link_ <- eitherToMaybe <$> runExceptT (getGroupLink db user g) + pure $ GIS g s link_ -- the statuses on non-current members should match memberCurrent' function getGroupSummary :: DB.Connection -> User -> GroupId -> IO GroupSummary @@ -2905,5 +2895,3 @@ updateGroupAlias db userId g@GroupInfo {groupId} localAlias = do updatedAt <- getCurrentTime DB.execute db "UPDATE groups SET local_alias = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (localAlias, updatedAt, userId, groupId) pure (g :: GroupInfo) {localAlias = localAlias} - -$(J.deriveJSON defaultJSON ''GroupLink) diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index f6d0e7da72..7eba39360f 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -2204,8 +2204,6 @@ updateGroupScopeUnreadStats db vr user g@GroupInfo {membership} scopeInfo (unrea m_ <- runExceptT $ getGroupMemberById db vr user groupMemberId pure $ either (const m) id m_ -- Left shouldn't happen, but types require it -deriving instance Show BoolInt - setGroupChatItemsDeleteAt :: DB.Connection -> User -> GroupId -> [(ChatItemId, Int)] -> UTCTime -> IO [(ChatItemId, UTCTime)] setGroupChatItemsDeleteAt db User {userId} groupId itemIds currentTs = forM itemIds $ \(chatItemId, ttl) -> do let deleteAt = addUTCTime (realToFrac ttl) currentTs diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index c4253942d8..a90d457920 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -527,7 +527,17 @@ data GroupSummary = GroupSummary } deriving (Show) -data GroupInfoSummary = GIS {groupInfo :: GroupInfo, groupSummary :: GroupSummary} +data GroupInfoSummary = GIS {groupInfo :: GroupInfo, groupSummary :: GroupSummary, groupLink :: Maybe GroupLink} + deriving (Show) + +data GroupLink = GroupLink + { userContactLinkId :: Int64, + connLinkContact :: CreatedLinkContact, + shortLinkDataSet :: Bool, + shortLinkLargeDataSet :: BoolDef, + groupLinkId :: GroupLinkId, + acceptMemberRole :: GroupMemberRole + } deriving (Show) data ContactOrGroup = CGContact Contact | CGGroup GroupInfo [GroupMember] @@ -2075,6 +2085,8 @@ $(JQ.deriveJSON defaultJSON ''Group) $(JQ.deriveJSON defaultJSON ''GroupSummary) +$(JQ.deriveJSON defaultJSON ''GroupLink) + $(JQ.deriveJSON defaultJSON ''GroupInfoSummary) instance FromField MsgFilter where fromField = fromIntField_ msgFilterIntP diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index dcaabe433e..015d4e6645 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -50,7 +50,7 @@ import Simplex.Chat.Operators import Simplex.Chat.Protocol import Simplex.Chat.Remote.AppVersion (AppVersion (..), pattern AppVersionRange) import Simplex.Chat.Remote.Types -import Simplex.Chat.Store (AddressSettings (..), AutoAccept (..), GroupLink (..), StoreError (..), UserContactLink (..)) +import Simplex.Chat.Store (AddressSettings (..), AutoAccept (..), StoreError (..), UserContactLink (..)) import Simplex.Chat.Styled import Simplex.Chat.Types import Simplex.Chat.Types.Preferences @@ -1365,8 +1365,8 @@ viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g Text - ldn_ (GIS GroupInfo {localDisplayName} _) = T.toLower localDisplayName - groupSS (GIS g@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} GroupSummary {currentMembers}) = + ldn_ (GIS GroupInfo {localDisplayName} _ _) = T.toLower localDisplayName + groupSS (GIS g@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} GroupSummary {currentMembers} _) = case memberStatus membership of GSMemInvited -> groupInvitation' g s -> membershipIncognito g <> ttyFullGroup g <> viewMemberStatus s <> alias g diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 168fd7bfca..1550a7bd9b 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -21,8 +21,7 @@ import Directory.Service import Directory.Store import GHC.IO.Handle (hClose) import Simplex.Chat.Bot.KnownContacts -import Simplex.Chat.Controller (ChatConfig (..), ChatHooks (..), defaultChatHooks) -import Simplex.Chat.Core +import Simplex.Chat.Controller (ChatConfig (..)) import qualified Simplex.Chat.Markdown as MD import Simplex.Chat.Options (CoreChatOpts (..)) import Simplex.Chat.Options.DB @@ -1129,11 +1128,12 @@ testListUserGroups promote ps = checkListings :: [T.Text] -> [T.Text] -> IO () checkListings listed promoted = do + threadDelay 100000 checkListing listingFileName listed checkListing promotedFileName promoted where checkListing f expected = do - Just (DirectoryListing gs) <- J.decodeFileStrict $ "./tests/tmp/web" f + Just (DirectoryListing gs) <- J.decodeFileStrict $ "./tests/tmp/web/data" f map groupName gs `shouldBe` expected groupName DirectoryEntry {displayName} = displayName @@ -1396,14 +1396,9 @@ withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup webFolder test = do runDirectory :: ChatConfig -> DirectoryOpts -> IO () -> IO () runDirectory cfg opts@DirectoryOpts {directoryLog} action = do st <- restoreDirectoryStore directoryLog - t <- forkIO $ bot st + t <- forkIO $ directoryService st opts cfg threadDelay 500000 action `finally` (mapM_ hClose (directoryLogFile st) >> killThread t) - where - bot st = do - env <- newServiceState opts - let cfg' = cfg {chatHooks = defaultChatHooks {acceptMember = Just $ acceptMemberHook opts env}} - simplexChatCore cfg' (mkChatOpts opts) $ directoryService st opts env registerGroup :: TestCC -> TestCC -> String -> String -> IO () registerGroup su u n fn = registerGroupId su u n fn 1 1 diff --git a/website/run.sh b/website/run.sh new file mode 100755 index 0000000000..a0a8dd0e50 --- /dev/null +++ b/website/run.sh @@ -0,0 +1,8 @@ +#!/bin/bash + +set -e + +cd .. +./website/web.sh +cd website +npm run start diff --git a/website/src/blog.html b/website/src/blog.html index 571b240451..4a0460511a 100644 --- a/website/src/blog.html +++ b/website/src/blog.html @@ -1,36 +1,42 @@ --- layout: layouts/main.html title: "SimpleX blog: the latest news" -description: "SimpleX Chat - a private and encrypted messenger without any user IDs (not even random ones)! Make a private connection via link / QR code to send messages and make calls." +description: "SimpleX Chat - a private and encrypted messenger without any user IDs (not even random ones)! Make a +private connection via link / QR code to send messages and make calls." path: /blog templateEngineOverride: njk active_blog: true --- {% block css_links %} - + {% endblock %}
@@ -39,42 +45,48 @@ active_blog: true {% for blog in collections.blogs %} {% if not(blog.data.draft) %} -
-
-
- {% if blog.data.image %} - {% if blog.data.imageBottom %} - - {% elif blog.data.imageWide %} - - {% else %} - - {% endif %} - {% else %} - - - {% endif %} -
+
+
+
+ {% if blog.data.image %} + {% if blog.data.imageBottom %} + + {% elif blog.data.imageWide %} + + {% else %} + + {% endif %} + {% else %} + + + {% endif %}
-
-
-

- {{ blog.data.title | safe }} -

-

- {{ blog.data.date.toUTCString().split(' ').slice(1, 4).join(' ') }} -

- {% if blog.data.previewBody %} -
- {% include blog.data.previewBody %} -
- {% elif blog.data.preview %} -

{{ blog.data.preview | safe }}

- {% endif %} +
+
+
+

+ {{ blog.data.title | safe }} +

+

+ {{ blog.data.date.toUTCString().split(' ').slice(1, 4).join(' ') }} +

+ {% if blog.data.previewBody %} +
+ {% include blog.data.previewBody %}
- Read More + {% elif blog.data.preview %} +

{{ blog.data.preview | safe }}

+ {% endif %}
-
+ Read More +
+
{% endif %} {% endfor %} diff --git a/website/src/directory.html b/website/src/directory.html new file mode 100644 index 0000000000..247ee6ebc2 --- /dev/null +++ b/website/src/directory.html @@ -0,0 +1,272 @@ +--- +layout: layouts/main.html +title: "SimpleX Directory" +description: "Find communities on SimpleX network and create your own" +templateEngineOverride: njk +--- + +{% set lang = page.url | getlang %} +{% block js_scripts %} + + +{% endblock %} + + + +
+
+

SimpleX Directory

+

Welcome to the selected users' communities that you can join via SimpleX Chat + app.

+

SimpleX Directory is also available as a SimpleX chat bot.

+

Read about how to add your community.

+
+ + +
+
+ +
+
\ No newline at end of file diff --git a/website/src/img/group.svg b/website/src/img/group.svg new file mode 100644 index 0000000000..2a262ef38a --- /dev/null +++ b/website/src/img/group.svg @@ -0,0 +1,12 @@ + + + + + + + + + \ No newline at end of file diff --git a/website/src/js/directory.js b/website/src/js/directory.js new file mode 100644 index 0000000000..2eb8db71a1 --- /dev/null +++ b/website/src/js/directory.js @@ -0,0 +1,439 @@ +const directoryDataURL = 'https://directory.simplex.chat/data/'; + +// const directoryDataURL = 'http://localhost:8080/directory-data/'; + +let allEntries = []; + +let sortedEntries = []; + +let filteredEntries = []; + +let currentSortMode = ''; + +async function initDirectory() { + const listing = await fetchJSON(directoryDataURL + 'listing.json') + const liveBtn = document.querySelector('#top-pagination .live'); + const newBtn = document.querySelector('#top-pagination .new'); + const topBtn = document.querySelector('#top-pagination .top'); + const searchInput = document.getElementById('search'); + allEntries = listing.entries + renderSortedEntries('top', byMemberCountDesc, topBtn) + window.addEventListener('hashchange', renderDirectoryPage); + searchInput.addEventListener('input', (e) => renderFilteredEntries(e.target.value)); + + liveBtn.addEventListener('click', () => renderSortedEntries('live', byActiveAtDesc, liveBtn)); + newBtn.addEventListener('click', () => renderSortedEntries('new', byCreatedAtDesc, newBtn)); + topBtn.addEventListener('click', () => renderSortedEntries('top', byMemberCountDesc, topBtn)); + + function renderSortedEntries(mode, comparator, btn) { + if (currentSortMode === mode) return; + currentSortMode = mode; + if (location.hash) location.hash = ''; + liveBtn.classList.remove('active'); + newBtn.classList.remove('active'); + topBtn.classList.remove('active'); + btn.classList.add('active'); + sortedEntries = allEntries.slice().sort(comparator); + renderFilteredEntries(searchInput.value); + } +} + +function renderDirectoryPage() { + const currentEntries = addPagination(filteredEntries); + displayEntries(currentEntries); +} + +function renderFilteredEntries(s) { + const query = s.toLowerCase().trim(); + if (query === '') { + filteredEntries = sortedEntries.slice(); + } else { + filteredEntries = sortedEntries.filter(entry => + (entry.displayName || '').toLowerCase().includes(query) + || includesQuery(entry.shortDescr, query) + || includesQuery(entry.welcomeMessage, query) + ); + } + renderDirectoryPage(); +} + +function includesQuery(field, query) { + return field + && Array.isArray(field) + && field.some(ft => { + switch (ft.format?.type) { + case 'uri': return uriIncludesQuery(ft.text, query); + case 'hyperLink': return textIncludesQuery(ft.format.showText, query) || uriIncludesQuery(ft.format.linkUri, query); + case 'simplexLink': return textIncludesQuery(ft.format.showText, query); + default: return textIncludesQuery(ft.text, query); + } + }); +} + +function textIncludesQuery(text, query) { + text ? text.toLowerCase().includes(query) : false +} + +function uriIncludesQuery(uri, query) { + if (!uri) return false; + uri = uri.toLowerCase(); + return !uri.includes('simplex') && uri.includes(query); +} + +async function fetchJSON(url) { + try { + const response = await fetch(url) + if (!response.ok) throw new Error(`HTTP error! Status: ${response.status}`) + return await response.json() + } catch (error) { + console.error('Error fetching JSON:', error) + } +} + +function byMemberCountDesc(entry1, entry2) { + return entryMemberCount(entry2) - entryMemberCount(entry1); +} + +function byActiveAtDesc(entry1, entry2) { + return (roundedTs(entry2.activeAt) - roundedTs(entry1.activeAt)) * 10 + + Math.sign(byMemberCountDesc(entry1, entry2)); +} + +function byCreatedAtDesc(entry1, entry2) { + return (roundedTs(entry2.createdAt) - roundedTs(entry1.createdAt)) * 10 + + Math.sign(byMemberCountDesc(entry1, entry2)); +} + +function roundedTs(s) { + try { + // rounded to 15 minutes, which is the frequency of listing update + return Math.floor(new Date(s).valueOf() / 900000); + } catch { + return 0; + } +} + +function entryMemberCount(entry) { + return entry.entryType.type == 'group' + ? (entry.entryType.summary?.currentMembers ?? 0) + : 0 +} + +function displayEntries(entries) { + const directory = document.getElementById('directory'); + directory.innerHTML = ''; + + for (let entry of entries) { + try { + const { entryType, displayName, groupLink, shortDescr, welcomeMessage, imageFile } = entry; + const entryDiv = document.createElement('div'); + entryDiv.className = 'entry w-full flex flex-col items-start md:flex-row rounded-[4px] overflow-hidden shadow-[0px_20px_30px_rgba(0,0,0,0.12)] dark:shadow-none bg-white dark:bg-[#11182F] mb-8'; + + const textContainer = document.createElement('div'); + textContainer.className = 'text-container'; + + const nameElement = document.createElement('h2'); + nameElement.textContent = displayName; + nameElement.className = 'text-grey-black dark:text-white !text-lg md:!text-xl font-bold'; + textContainer.appendChild(nameElement); + + const welcomeMessageHTML = welcomeMessage ? renderMarkdown(welcomeMessage) : undefined; + const shortDescrHTML = shortDescr ? renderMarkdown(shortDescr) : undefined; + if (shortDescrHTML && welcomeMessageHTML?.includes(shortDescrHTML) !== true) { + const descrElement = document.createElement('p'); + descrElement.innerHTML = renderMarkdown(shortDescr); + textContainer.appendChild(descrElement); + } + + if (welcomeMessageHTML) { + const messageElement = document.createElement('p'); + messageElement.innerHTML = welcomeMessageHTML; + textContainer.appendChild(messageElement); + + const readMore = document.createElement('p'); + readMore.textContent = 'Read more'; + readMore.className = 'read-more'; + readMore.style.display = 'none'; + textContainer.appendChild(readMore); + + setTimeout(() => { + const computedStyle = window.getComputedStyle(messageElement); + const lineHeight = parseFloat(computedStyle.lineHeight); + const maxLines = 5; + const maxHeight = maxLines * lineHeight + const maxHeightPx = `${maxHeight}px`; + messageElement.style.maxHeight = maxHeightPx; + messageElement.style.overflow = 'hidden'; + + if (messageElement.scrollHeight > maxHeight + 4) { + readMore.style.display = 'block'; + readMore.addEventListener('click', () => { + if (messageElement.style.maxHeight === maxHeightPx) { + messageElement.style.maxHeight = 'none'; + readMore.className = 'read-less'; + readMore.innerHTML = '▲'; + } else { + messageElement.style.maxHeight = maxHeightPx; + readMore.className = 'read-more'; + readMore.textContent = 'Read more'; + } + }); + } + }, 0); + } + + const memberCount = entryMemberCount(entry); + if (typeof memberCount == 'number' && memberCount > 0) { + const memberCountElement = document.createElement('p'); + memberCountElement.innerText = `${memberCount} members`; + memberCountElement.classList = ['text-sm']; + textContainer.appendChild(memberCountElement); + } + + const imgElement = document.createElement('a'); + imgSource = + imageFile + ? directoryDataURL + imageFile + : "/img/group.svg"; + imgElement.innerHTML = `${displayName}`; + imgElement.href = platformSimplexUri(groupLink.connShortLink ?? groupLink.connFullLink); + if (!isCurrentSite(imgElement.href)) imgElement.target = "_blank"; + imgElement.title = `Join ${displayName}`; + entryDiv.appendChild(imgElement); + + entryDiv.appendChild(textContainer); + directory.appendChild(entryDiv); + } catch (e) { + console.log(e); + } + } + + for (let el of document.querySelectorAll('.secret')) { + el.addEventListener('click', () => el.classList.toggle('visible')); + } + + directory.style.height = ''; +} + +function goToPage(p) { + location.hash = p.toString(); +} + +function addPagination(entries) { + const entriesPerPage = 10; + const totalPages = Math.ceil(entries.length / entriesPerPage); + let currentPage = parseInt(location.hash.slice(1)) || 1; + if (currentPage < 1) currentPage = 1; + if (currentPage > totalPages) currentPage = totalPages; + + const startIndex = (currentPage - 1) * entriesPerPage; + const endIndex = Math.min(startIndex + entriesPerPage, entries.length); + const currentEntries = entries.slice(startIndex, endIndex); + + // addPaginationElements('top-pagination') + addPaginationElements('bottom-pagination') + return currentEntries; + + function addPaginationElements(paginationId) { + const pagination = document.getElementById(paginationId); + if (!pagination) { + return currentEntries; + } + pagination.innerHTML = ''; + + try { + let startPage, endPage; + const pageButtonCount = 8 + if (totalPages <= pageButtonCount) { + startPage = 1; + endPage = totalPages; + } else { + startPage = Math.max(1, currentPage - 4); + endPage = Math.min(totalPages, startPage + pageButtonCount - 1); + if (endPage - startPage + 1 < pageButtonCount) { + startPage = Math.max(1, endPage - pageButtonCount + 1); + } + } + + // if (currentPage > 1 && startPage > 1) { + // const firstBtn = document.createElement('button'); + // firstBtn.textContent = 'First'; + // firstBtn.classList.add('text-btn'); + // firstBtn.addEventListener('click', () => goToPage(1)); + // pagination.appendChild(firstBtn); + // } + + if (currentPage > 1) { + const prevBtn = document.createElement('button'); + prevBtn.textContent = 'Prev'; + prevBtn.classList.add('text-btn'); + prevBtn.addEventListener('click', () => goToPage(currentPage - 1)); + pagination.appendChild(prevBtn); + } + + for (let p = startPage; p <= endPage; p++) { + const pageBtn = document.createElement('button'); + pageBtn.textContent = p.toString(); + if (p === currentPage) { + pageBtn.classList.add('active'); + } else if (p === currentPage - 1 || p === currentPage + 1) { + pageBtn.classList.add('neighbor'); + } + pageBtn.addEventListener('click', () => goToPage(p)); + pagination.appendChild(pageBtn); + } + + if (currentPage < totalPages) { + const nextBtn = document.createElement('button'); + nextBtn.textContent = 'Next'; + nextBtn.classList.add('text-btn'); + nextBtn.addEventListener('click', () => goToPage(currentPage + 1)); + pagination.appendChild(nextBtn); + } + + // if (endPage < totalPages) { + // const lastBtn = document.createElement('button'); + // lastBtn.textContent = 'Last'; + // lastBtn.classList.add('text-btn'); + // lastBtn.addEventListener('click', () => goToPage(totalPages)); + // pagination.appendChild(lastBtn); + // } + + } catch (e) { + console.log(e); + } + } +} + +if (document.readyState === 'loading') { + document.addEventListener('DOMContentLoaded', initDirectory); +} else { + initDirectory(); +} + +function escapeHtml(text) { + return text + .replace(/&/g, "&") + .replace(//g, ">") + .replace(/"/g, """) + .replace(/'/g, "'") + .replace(/\n/g, "
"); +} + +function getSimplexLinkDescr(linkType) { + switch (linkType) { + case 'contact': return 'SimpleX contact address'; + case 'invitation': return 'SimpleX one-time invitation'; + case 'group': return 'SimpleX group link'; + case 'channel': return 'SimpleX channel link'; + case 'relay': return 'SimpleX relay link'; + default: return 'SimpleX link'; + } +} + +function viaHost(smpHosts) { + const first = smpHosts[0] ?? '?'; + return `via ${first}`; +} + +function isCurrentSite(uri) { + return uri.startsWith("https://simplex.chat") || uri.startsWith("https://www.simplex.chat") +} + +function targetBlank(uri) { + return isCurrentSite(uri) ? '' : ' target="_blank"' +} + +function platformSimplexUri(uri) { + if (isMobile.any()) return uri; + if (uri.startsWith('simplex:/g#')) { + const prefixLength = 'simplex:/g#'.length; + const fragment = uri.substring(prefixLength); + const queryIndex = fragment.indexOf('?'); + if (queryIndex === -1) return uri; + const hashPart = fragment.substring(0, queryIndex); + const queryStr = fragment.substring(queryIndex + 1); + const params = new URLSearchParams(queryStr); + const host = params.get('h'); + if (!host) return uri; + params.delete('h'); + let newFragment = hashPart; + const remainingParams = params.toString(); + if (remainingParams) newFragment += '?' + remainingParams; + return `https://${host}:/g#${newFragment}`; + } else if(uri.startsWith('simplex:/')) { + const prefixLength = 'simplex:/'.length; + return 'https://simplex.chat/' + uri.substring(prefixLength); + } else { + return uri; + } +} + +function renderMarkdown(fts) { + let html = ''; + for (const ft of fts) { + const { format, text } = ft; + if (!format) { + html += escapeHtml(text); + continue; + } + try { + switch (format.type) { + case 'bold': + html += `${escapeHtml(text)}`; + break; + case 'italic': + html += `${escapeHtml(text)}`; + break; + case 'strikeThrough': + html += `${escapeHtml(text)}`; + break; + case 'snippet': + html += `${escapeHtml(text)}`; + break; + case 'secret': + html += `${escapeHtml(text)}`; + break; + case 'colored': + html += `${escapeHtml(text)}`; + break; + case 'uri': + let href = text.startsWith('http://') || text.startsWith('https://') || text.startsWith('simplex:/') ? text : 'https://' + text; + html += `${escapeHtml(text)}`; + break; + case 'hyperLink': { + const { showText, linkUri } = format; + html += `${escapeHtml(showText ?? linkUri)}`; + break; + } + case 'simplexLink': { + const { showText, linkType, simplexUri, smpHosts } = format; + const linkText = showText ? escapeHtml(showText) : getSimplexLinkDescr(linkType); + html += `${linkText} (${viaHost(smpHosts)})`; + break; + } + case 'command': + html += `${escapeHtml(text)}`; + break; + case 'mention': + html += `${escapeHtml(text)}`; + break; + case 'email': + html += `${escapeHtml(text)}`; + break; + case 'phone': + html += `${escapeHtml(text)}`; + break; + case 'unknown': + html += escapeHtml(text); + break; + default: + html += escapeHtml(text); + } + } catch { + html += escapeHtml(text); + } + } + return html; +} diff --git a/website/src/js/script.js b/website/src/js/script.js index 5f863f48ee..cf240dd375 100644 --- a/website/src/js/script.js +++ b/website/src/js/script.js @@ -26,7 +26,8 @@ const uniqueSwiper = new Swiper('.unique-swiper', { const isMobile = { Android: () => navigator.userAgent.match(/Android/i), - iOS: () => navigator.userAgent.match(/iPhone|iPad|iPod/i) + iOS: () => navigator.userAgent.match(/iPhone|iPad|iPod/i), + any: () => navigator.userAgent.match(/Android|iPhone|iPad|iPod/i) }; const privateSwiper = new Swiper('.private-swiper', {