From 3de88fb9b741bf26143a6ae8f9bec088b917d1b0 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Wed, 3 Jun 2026 22:44:38 +0000 Subject: [PATCH] more tests --- src/Simplex/Chat/Library/Subscriber.hs | 3 + src/Simplex/Chat/Web.hs | 7 +- tests/ChatClient.hs | 4 +- tests/ChatTests/ChatRelays.hs | 243 ++++++++++++++++++++----- 4 files changed, 206 insertions(+), 51 deletions(-) diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 29d3d04c9c..2592b3e720 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -870,6 +870,9 @@ processAgentMessageConn vr 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 diff --git a/src/Simplex/Chat/Web.hs b/src/Simplex/Chat/Web.hs index eb53ce741d..d477b53b74 100644 --- a/src/Simplex/Chat/Web.hs +++ b/src/Simplex/Chat/Web.hs @@ -17,6 +17,7 @@ module Simplex.Chat.Web webPreviewWorker, renderWebPreviews, writeCorsConfig, + removeStaleFiles, channelContentChanged, channelProfileUpdated, channelRemoved, @@ -78,7 +79,7 @@ import Simplex.Messaging.Agent.Store.Common (withTransaction) import Simplex.Messaging.Encoding.String (strEncode) import Simplex.Messaging.Parsers (defaultJSON) import System.Directory (createDirectoryIfMissing, listDirectory, removeFile, renameFile) -import System.FilePath (takeExtension, ()) +import System.FilePath (dropExtension, takeExtension, ()) import UnliftIO.STM data WebFileInfo = WebFileInfo @@ -398,7 +399,9 @@ writeCorsConfig entries path = removeStaleFiles :: FilePath -> S.Set FilePath -> IO () removeStaleFiles dir activeFiles = do - let isPreviewFile f = takeExtension f == ".json" && all isBase64Url (takeWhile (/= '.') f) + let isPreviewFile f = + let base = dropExtension f + in takeExtension f == ".json" && not (null base) && all isBase64Url base isBase64Url c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c == '-' || c == '_' allFiles <- S.filter isPreviewFile . S.fromList <$> listDirectory dir mapM_ (\f -> removeFile (dir f)) $ S.difference allFiles activeFiles diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 18e91e7544..442834b244 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -164,8 +164,8 @@ testCoreOpts = relayTestOpts :: ChatOpts relayTestOpts = testOpts {coreOptions = testCoreOpts {chatRelay = True}} -relayWebTestOpts :: Text -> FilePath -> ChatOpts -relayWebTestOpts webDomain webDir = testOpts {coreOptions = testCoreOpts {chatRelay = True, webPreviewConfig = Just WebPreviewConfig {webDomain, webJsonDir = webDir, webCorsFile = Nothing, webUpdateInterval = 300, webPreviewItemCount = 50}}} +relayWebTestOpts :: Text -> FilePath -> Maybe FilePath -> ChatOpts +relayWebTestOpts webDomain webDir webCorsFile = testOpts {coreOptions = testCoreOpts {chatRelay = True, webPreviewConfig = Just WebPreviewConfig {webDomain, webJsonDir = webDir, webCorsFile, webUpdateInterval = 300, webPreviewItemCount = 50}}} #if !defined(dbPostgres) getTestOpts :: Bool -> ScrubbedBytes -> ChatOpts diff --git a/tests/ChatTests/ChatRelays.hs b/tests/ChatTests/ChatRelays.hs index d6295eb6ab..10d9d71dff 100644 --- a/tests/ChatTests/ChatRelays.hs +++ b/tests/ChatTests/ChatRelays.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -15,16 +16,15 @@ import qualified Data.ByteString.Lazy.Char8 as LB import Data.Maybe (fromMaybe) import qualified Data.Text as T import ProtocolTests (testGroupProfile) -import Simplex.Chat.Controller (ChatConfig (..), ChatController (..)) import Simplex.Chat.Protocol (LinkOwnerSig, MsgChatLink (..), MsgContent (..)) import Simplex.Chat.Types (GroupProfile (..)) -import Simplex.Chat.Web (CorsOrigin (..), WebChannelPreview (..), WebMessage (..), renderWebPreviews, writeCorsConfig) +import Simplex.Chat.Web (CorsOrigin (..), WebChannelPreview (..), WebMessage (..), removeStaleFiles, writeCorsConfig) import Simplex.Messaging.Encoding.String (StrEncoding (..)) import Simplex.Messaging.Util (decodeJSON) -import System.Directory (listDirectory) -import System.FilePath (()) +import qualified Data.Set as S +import System.Directory (createDirectoryIfMissing, doesFileExist, listDirectory) +import System.FilePath (takeExtension, ()) import Test.Hspec hiding (it) -import UnliftIO.STM (readTVarIO) chatRelayTests :: SpecWith TestParams chatRelayTests = do @@ -37,7 +37,14 @@ chatRelayTests = do describe "relay capabilities" $ do it "relay sends webDomain in capabilities" testRelayWebCapabilities describe "web preview" $ do - it "render web preview JSON for channel" testWebPreviewRender + it "render messages and members" testWebPreviewRender + it "incremental render adds new messages" testWebPreviewIncremental + it "edited and deleted messages" testWebPreviewEditedDeleted + it "reactions in rendered messages" testWebPreviewReactions + it "non-public group produces no file" testWebPreviewNonPublic + it "multiple channels produce multiple files" testWebPreviewMultipleChannels + it "channel deletion removes preview file" testWebPreviewChannelDeleted + it "removeStaleFiles preserves non-base64url files" testWebPreviewStaleCleanup it "generate CORS config" testWebPreviewCors describe "share channel card" $ do it "share channel card in direct chat" testShareChannelDirect @@ -339,7 +346,7 @@ getTermLine2 c = (,) <$> getTermLine c <*> getTermLine c testRelayWebCapabilities :: HasCallStack => TestParams -> IO () testRelayWebCapabilities ps = withNewTestChat ps "alice" aliceProfile $ \alice -> - withNewTestChatOpts ps (relayWebTestOpts "relay.example.com" (tmpPath ps "web_cap")) "bob" bobProfile $ \relay -> do + withNewTestChatOpts ps (relayWebTestOpts "relay.example.com" (tmpPath ps "web_cap") Nothing) "bob" bobProfile $ \relay -> do rName <- userName relay relay ##> "/ad" (relaySLink, _cLink) <- getContactLinks relay True @@ -351,55 +358,196 @@ testRelayWebCapabilities ps = concurrentlyN_ [ do alice <## "#news: group link relays updated, current relays:" - alice <## " - relay id 1: active, web: relay.example.com" + alice <### [EndsWith ": active, web: relay.example.com"] alice <## "group link:" _ <- getTermLine alice pure (), relay <## "#news: you joined the group as relay" ] -testWebPreviewRender :: HasCallStack => TestParams -> IO () -testWebPreviewRender ps = do - let webDir = tmpPath ps "web_preview" +-- Helper: set up relay with web config + channel +withWebChannel :: TestParams -> String -> (TestCC -> TestCC -> FilePath -> IO ()) -> IO () +withWebChannel ps gName test = do + let webDir = tmpPath ps "web_" <> gName + corsFile = tmpPath ps "cors_" <> gName <> ".conf" withNewTestChat ps "alice" aliceProfile $ \alice -> - withNewTestChatOpts ps (relayWebTestOpts "relay.example.com" webDir) "bob" bobProfile $ \relay -> do + withNewTestChatOpts ps (relayWebTestOpts "relay.example.com" webDir (Just corsFile)) "bob" bobProfile $ \relay -> do _ <- setupRelay alice relay - alice ##> "/public group relays=1 #news" - alice <## "group #news is created" - alice <## "wait for selected relay(s) to join, then you can invite members via group link" - concurrentlyN_ - [ do - alice <## "#news: group link relays updated, current relays:" - alice <## " - relay id 1: active, web: relay.example.com" - alice <## "group link:" - _ <- getTermLine alice - pure (), - relay <## "#news: you joined the group as relay" - ] - alice #> "#news hello from the channel" - relay <# "#news> hello from the channel" - alice #> "#news second message" - relay <# "#news> second message" - threadDelay 500000 - let cc = chatController relay - ChatConfig {webPreviewConfig = cfg_} = config cc - Just user <- readTVarIO (currentUser cc) - case cfg_ of - Nothing -> error "no web preview config" - Just cfg -> do - renderWebPreviews cfg cc user - files <- listDirectory webDir - length files `shouldBe` 1 - let jsonFile = webDir head files - jsonBytes <- LB.readFile jsonFile + createChannelWithRelayWeb gName alice relay + test alice relay webDir + +createChannelWithRelayWeb :: HasCallStack => String -> TestCC -> TestCC -> IO () +createChannelWithRelayWeb gName owner relay = do + owner ##> ("/public group relays=1 #" <> gName) + owner <## ("group #" <> gName <> " is created") + owner <## "wait for selected relay(s) to join, then you can invite members via group link" + concurrentlyN_ + [ do + owner <## ("#" <> gName <> ": group link relays updated, current relays:") + owner <### [EndsWith ": active, web: relay.example.com"] + owner <## "group link:" + _ <- getTermLine owner + pure (), + relay <## ("#" <> gName <> ": you joined the group as relay") + ] + +-- Poll for a JSON preview file written by the worker that satisfies predicate, with timeout +waitPreviewWith :: HasCallStack => FilePath -> (WebChannelPreview -> Bool) -> IO WebChannelPreview +waitPreviewWith webDir check = go 50 + where + go :: Int -> IO WebChannelPreview + go 0 = error "waitPreview: timed out waiting for matching JSON file" + go n = do + files <- filter (\f -> takeExtension f == ".json") <$> listDirectory webDir + case files of + [f] -> do + jsonBytes <- LB.readFile (webDir f) case J.eitherDecode jsonBytes of - Left err -> error $ "JSON decode error: " <> err - Right (wPreview :: WebChannelPreview) -> do - length (messages wPreview) `shouldBe` 2 - let WebMessage {content = mc1} = messages wPreview !! 0 - WebMessage {content = mc2} = messages wPreview !! 1 - mc1 `shouldBe` MCText "hello from the channel" - mc2 `shouldBe` MCText "second message" + Right p | check p -> pure p + _ -> threadDelay 100000 >> go (n - 1) + _ -> threadDelay 100000 >> go (n - 1) + +waitPreview :: HasCallStack => FilePath -> IO WebChannelPreview +waitPreview webDir = waitPreviewWith webDir (const True) + +testWebPreviewRender :: HasCallStack => TestParams -> IO () +testWebPreviewRender ps = + withWebChannel ps "news" $ \alice relay webDir -> do + alice #> "#news hello from the channel" + relay <# "#news> hello from the channel" + alice #> "#news second message" + relay <# "#news> second message" + wPreview <- waitPreviewWith webDir (\p -> length (messages p) >= 2) + let GroupProfile {displayName = chName} = channel wPreview + chName `shouldBe` "news" + length (messages wPreview) `shouldBe` 2 + content (messages wPreview !! 0) `shouldBe` MCText "hello from the channel" + content (messages wPreview !! 1) `shouldBe` MCText "second message" + length (members wPreview) `shouldSatisfy` (>= 1) + all (\m -> ts m > read "2020-01-01 00:00:00 UTC") (messages wPreview) `shouldBe` True + jsonFiles <- filter (\f -> takeExtension f == ".json") <$> listDirectory webDir + length jsonFiles `shouldBe` 1 + +testWebPreviewIncremental :: HasCallStack => TestParams -> IO () +testWebPreviewIncremental ps = + withWebChannel ps "inc" $ \alice relay webDir -> do + alice #> "#inc first" + relay <# "#inc> first" + p1 <- waitPreviewWith webDir (\p -> length (messages p) >= 1) + length (messages p1) `shouldBe` 1 + content (messages p1 !! 0) `shouldBe` MCText "first" + alice #> "#inc second" + relay <# "#inc> second" + alice #> "#inc third" + relay <# "#inc> third" + p2 <- waitPreviewWith webDir (\p -> length (messages p) >= 3) + length (messages p2) `shouldBe` 3 + content (messages p2 !! 0) `shouldBe` MCText "first" + content (messages p2 !! 1) `shouldBe` MCText "second" + content (messages p2 !! 2) `shouldBe` MCText "third" + +testWebPreviewEditedDeleted :: HasCallStack => TestParams -> IO () +testWebPreviewEditedDeleted ps = + withWebChannel ps "ed" $ \alice relay webDir -> do + alice #> "#ed msg one" + relay <# "#ed> msg one" + alice #> "#ed msg two" + relay <# "#ed> msg two" + msgId2 <- lastItemId alice + alice #> "#ed msg three" + relay <# "#ed> msg three" + msgId3 <- lastItemId alice + alice ##> ("/_update item #1 " <> msgId2 <> " text msg two edited") + alice <# "#ed [edited] msg two edited" + relay <# "#ed> [edited] msg two edited" + alice #$> ("/_delete item #1 " <> msgId3 <> " broadcast", id, "message marked deleted") + relay <# "#ed> [marked deleted] msg three" + p <- waitPreviewWith webDir (\p -> length (messages p) == 2 && any edited (messages p)) + length (messages p) `shouldBe` 2 + content (messages p !! 0) `shouldBe` MCText "msg one" + content (messages p !! 1) `shouldBe` MCText "msg two edited" + edited (messages p !! 0) `shouldBe` False + edited (messages p !! 1) `shouldBe` True + +testWebPreviewReactions :: HasCallStack => TestParams -> IO () +testWebPreviewReactions ps = + withWebChannel ps "react" $ \alice relay webDir -> do + alice #> "#react hello" + relay <# "#react> hello" + alice ##> "+1 #react hello" + alice <## "added 👍" + relay <# "#react alice> > hello" + relay <## " + 👍" + p <- waitPreviewWith webDir (\p -> not (null (messages p)) && not (null (reactions (head (messages p))))) + length (messages p) `shouldBe` 1 + length (reactions (messages p !! 0)) `shouldSatisfy` (>= 1) + +testWebPreviewNonPublic :: HasCallStack => TestParams -> IO () +testWebPreviewNonPublic ps = do + let webDir = tmpPath ps "web_nonpub" + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps (relayWebTestOpts "relay.example.com" webDir Nothing) "bob" bobProfile $ \relay -> do + _ <- setupRelay alice relay + alice ##> "/g private" + alice <## "group #private is created" + alice <## "to add members use /a private or /create link #private" + alice #> "#private hello" + threadDelay 2000000 + files <- filter (\f -> takeExtension f == ".json") <$> listDirectory webDir + length files `shouldBe` 0 + +testWebPreviewMultipleChannels :: HasCallStack => TestParams -> IO () +testWebPreviewMultipleChannels ps = do + let webDir = tmpPath ps "web_multi" + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps (relayWebTestOpts "relay.example.com" webDir Nothing) "bob" bobProfile $ \relay -> do + _ <- setupRelay alice relay + createChannelWithRelayWeb "ch1" alice relay + createChannelWithRelayWeb "ch2" alice relay + alice #> "#ch1 msg in ch1" + relay <# "#ch1> msg in ch1" + alice #> "#ch2 msg in ch2" + relay <# "#ch2> msg in ch2" + threadDelay 2000000 + files <- filter (\f -> takeExtension f == ".json") <$> listDirectory webDir + length files `shouldBe` 2 + +testWebPreviewChannelDeleted :: HasCallStack => TestParams -> IO () +testWebPreviewChannelDeleted ps = + withWebChannel ps "del" $ \alice relay webDir -> do + alice #> "#del hello" + relay <# "#del> hello" + _ <- waitPreviewWith webDir (\p -> not (null (messages p))) + jsonFiles <- filter (\f -> takeExtension f == ".json") <$> listDirectory webDir + length jsonFiles `shouldBe` 1 + let previewFile = webDir head jsonFiles + alice ##> "/d #del" + alice <## "#del: you deleted the group (signed)" + relay <## "#del: alice deleted the group (signed)" + relay <## "use /d #del to delete the local copy of the group" + waitFileDeleted previewFile 50 + +testWebPreviewStaleCleanup :: HasCallStack => TestParams -> IO () +testWebPreviewStaleCleanup ps = do + let webDir = tmpPath ps "web_stale_unit" + activeFile = "abc123.json" + staleFile = "AAAA_stale.json" + safeFile = "my.config.json" + createDirectoryIfMissing True webDir + writeFile (webDir activeFile) "{}" + writeFile (webDir staleFile) "{}" + writeFile (webDir safeFile) "{}" + removeStaleFiles webDir (S.singleton activeFile) + doesFileExist (webDir staleFile) `shouldReturn` False + doesFileExist (webDir safeFile) `shouldReturn` True + doesFileExist (webDir activeFile) `shouldReturn` True + +waitFileDeleted :: HasCallStack => FilePath -> Int -> IO () +waitFileDeleted _ 0 = error "waitFileDeleted: timed out" +waitFileDeleted path n = + doesFileExist path >>= \case + False -> pure () + True -> threadDelay 100000 >> waitFileDeleted path (n - 1) testWebPreviewCors :: HasCallStack => TestParams -> IO () testWebPreviewCors ps = do @@ -415,6 +563,7 @@ testWebPreviewCors ps = do corsContent `shouldContain` "/channel/def456.json \"https://owner-site.com\"" corsContent `shouldContain` "# ghi789.json (no origin configured)" corsContent `shouldContain` "Access-Control-Allow-Origin" + corsContent `shouldContain` "Access-Control-Allow-Methods" -- Create a public group with relay=1, wait for relay to join createChannelWithRelay :: HasCallStack => String -> TestCC -> TestCC -> IO ()