From b2e683bf4a6d3adce08d9256833521ff2103476c Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 22 Oct 2026 19:36:17 +0000 Subject: [PATCH] fix, debug --- src/Simplex/Chat/Library/Internal.hs | 2 -- src/Simplex/Chat/Library/Subscriber.hs | 1 - tests/Bots/BadgeService/WebTests.hs | 14 +++++++------ tests/ChatTests/Profiles.hs | 29 ++++++++++++++++++-------- 4 files changed, 28 insertions(+), 18 deletions(-) diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index a4f68805c1..cd89881e4f 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -1803,7 +1803,6 @@ metaBrokerTs MsgMeta {broker = (_, brokerTs)} = brokerTs createContactPQSndItem :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection) createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' = - (liftIO (putStrLn $ "PQ-DEBUG snd " <> show (localDisplayName' ct) <> " " <> show pqSndEnabled <> " -> " <> show pqSndEnabled') >>) $ flip catchAllErrors (const $ pure (ct, conn)) $ case (pqSndEnabled, pqSndEnabled') of (Just b, b') | b' /= b -> createPQItem $ CISndConnEvent (SCEPqEnabled pqSndEnabled') (Nothing, PQEncOn) -> createPQItem $ CISndDirectE2EEInfo (e2eInfoEncrypted $ Just pqSndEnabled') @@ -1819,7 +1818,6 @@ createContactPQSndItem user ct conn@Connection {pqSndEnabled} pqSndEnabled' = updateContactPQRcv :: User -> Contact -> Connection -> PQEncryption -> CM (Contact, Connection) updateContactPQRcv user ct conn@Connection {connId, pqRcvEnabled} pqRcvEnabled' = - (liftIO (putStrLn $ "PQ-DEBUG rcv " <> show (localDisplayName' ct) <> " " <> show pqRcvEnabled <> " -> " <> show pqRcvEnabled') >>) $ flip catchAllErrors (const $ pure (ct, conn)) $ case (pqRcvEnabled, pqRcvEnabled') of (Just b, b') | b' /= b -> updatePQ $ CIRcvConnEvent (RCEPqEnabled pqRcvEnabled') (Nothing, PQEncOn) -> updatePQ $ CIRcvDirectE2EEInfo (e2eInfoEncrypted $ Just pqRcvEnabled') diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 85e4a1bacc..e7738cddc2 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -664,7 +664,6 @@ processAgentMessageConn cxt user@User {userId} entity gks_ corrId agentConnId ag XOk -> pure () _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok" CON pqEnc -> do - liftIO $ putStrLn $ "PQ-DEBUG con " <> show (localDisplayName' ct) <> " " <> show pqEnc when (pqEnc == PQEncOn) $ withStore' $ \db -> updateConnPQEnabledCON db connId pqEnc let conn' = conn {pqSndEnabled = Just pqEnc, pqRcvEnabled = Just pqEnc} :: Connection ct' = ct {activeConn = Just conn'} :: Contact diff --git a/tests/Bots/BadgeService/WebTests.hs b/tests/Bots/BadgeService/WebTests.hs index 65c5cc3017..0421151050 100644 --- a/tests/Bots/BadgeService/WebTests.hs +++ b/tests/Bots/BadgeService/WebTests.hs @@ -53,7 +53,9 @@ import Data.Time.Calendar (fromGregorian) import Data.Time.Clock (NominalDiffTime, UTCTime (..), addUTCTime, diffUTCTime, getCurrentTime, picosecondsToDiffTime, secondsToDiffTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Data.Word (Word32, Word8) -import GHC.IO.Handle (hDuplicate, hDuplicateTo) +import qualified GHC.IO.Device as IODevice +import qualified GHC.IO.FD as FD +import GHC.IO.Handle.FD (handleToFd) import Network.HTTP.Client (Manager, Request (..), RequestBody (..), Response, defaultManagerSettings, httpLbs, newManager, parseRequest, responseBody, responseHeaders, responseStatus, responseTimeoutMicro) import Network.HTTP.Types (Header, HeaderName, hCacheControl, hContentType) import Network.HTTP.Types.Status (statusCode) @@ -72,7 +74,7 @@ import Simplex.Messaging.Encoding.String (textDecode, textEncode) import Simplex.Messaging.Util (safeDecodeUtf8, tshow) import System.Directory (createDirectoryIfMissing, createFileLink, doesFileExist, listDirectory) import System.FilePath (()) -import System.IO (IOMode (..), hClose, hGetBuffering, hSetBuffering, stderr, withFile) +import System.IO (IOMode (..), hFlush, stderr, withFile) import System.IO.Unsafe (unsafePerformIO) import System.Timeout (timeout) import Test.Hspec @@ -2675,16 +2677,16 @@ stderrCaptureLock :: MVar () stderrCaptureLock = unsafePerformIO $ newMVar () {-# NOINLINE stderrCaptureLock #-} --- hDuplicateTo changes stderr's buffering, so put the original setting back. capturingStderr :: IO () -> IO Text capturingStderr action = withMVar stderrCaptureLock $ \_ -> do createDirectoryIfMissing True "tests/tmp" withTempDirectory "tests/tmp" "badge-stderr" $ \dir -> do let path = dir "stderr.log" withFile path WriteMode $ \h -> do - buffering <- hGetBuffering stderr - saved <- hDuplicate stderr - (hDuplicateTo h stderr >> action) `E.finally` (hDuplicateTo saved stderr >> hClose saved >> hSetBuffering stderr buffering) + fd <- handleToFd h + hFlush stderr + saved <- IODevice.dup FD.stderr + (IODevice.dup2 fd FD.stderr >> action) `E.finally` (hFlush stderr >> IODevice.dup2 saved FD.stderr >> IODevice.close saved) T.readFile path loggedError :: Text -> Text -> Bool diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 85cf84e8b3..eeefbe8162 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} @@ -14,7 +15,7 @@ import ChatClient import ChatTests.DBUtils import ChatTests.Utils import Control.Concurrent (threadDelay) -import Control.Concurrent.Async (concurrently_) +import Control.Concurrent.Async (concurrently, concurrently_) import Control.Monad import Control.Monad.Except import Control.Monad.Reader (runReaderT) @@ -5148,14 +5149,24 @@ testShortLinkInvitationChangeUser = testChat2 aliceProfile bobProfile test <### [ "alisa: connection started", WithTime "@alisa hello" ] - concurrently_ - (bob <## "alisa: contact is connected") - ( alice - <### [ WithTime "bob> hello", - "bob (Bob): contact is connected" - ] - ) - alice <##> bob + (_, connectedFirst) <- + concurrently + (bob <## "alisa: contact is connected") + ( getTermLine alice >>= \case + "bob (Bob): contact is connected" -> do + alice <## "bob: standard end-to-end encryption enabled" + alice <# "bob> hello" + pure True + l -> do + dropTime l `shouldBe` "bob> hello" + alice <## "bob (Bob): contact is connected" + pure False + ) + alice #> "@bob hi" + bob <# "alisa> hi" + bob #> "@alisa hey" + when connectedFirst $ alice <## "bob: quantum resistant end-to-end encryption enabled" + alice <# "bob> hey" testShortLinkAddressChangeProfile :: HasCallStack => TestParams -> IO () testShortLinkAddressChangeProfile = testChat2 aliceProfile bobProfile test