diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 2e19dd73d9..536524cf96 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -103,7 +103,7 @@ import Simplex.Messaging.Client (defaultNetworkConfig) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF -import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKNoPQ, pattern IKPQOff, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKNoPQ, pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String @@ -634,20 +634,6 @@ processChatCommand' vr = \case ok_ APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_ SetContactMergeEnabled onOff -> chatWriteVar contactMergeEnabled onOff >> ok_ - APISetPQEncryption onOff -> chatWriteVar pqExperimentalEnabled onOff >> ok_ - APISetContactPQ ctId pqEnc -> withUser $ \user -> do - ct@Contact {activeConn} <- withStore $ \db -> getContact db vr user ctId - case activeConn of - Just conn@Connection {connId, pqSupport, pqEncryption} - | pqEncryption == pqEnc -> pure $ CRContactPQAllowed user ct pqEnc - | otherwise -> do - let pqSup = PQSupport $ pqEnc == PQEncOn || pqSupport == PQSupportOn - conn' = conn {pqSupport = pqSup, pqEncryption = pqEnc} :: Connection - ct' = ct {activeConn = Just conn'} :: Contact - withStore' $ \db -> updateConnSupportPQ db connId pqSup pqEnc - pure $ CRContactPQAllowed user ct' pqEnc - Nothing -> throwChatError $ CEContactNotActive ct - SetContactPQ cName pqEnc -> withContactName cName (`APISetContactPQ` pqEnc) APIExportArchive cfg -> checkChatStopped $ lift (exportArchive cfg) >> ok_ ExportArchive -> do ts <- liftIO getCurrentTime @@ -1925,7 +1911,7 @@ processChatCommand' vr = \case unless (maxVersion peerChatVRange >= groupDirectInvVersion) $ throwChatError CEPeerChatVRangeIncompatible when (isJust $ memberContactId m) $ throwChatError $ CECommandError "member contact already exists" subMode <- chatReadVar subscriptionMode - (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOff subMode + (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing IKPQOn subMode -- [incognito] reuse membership incognito profile ct <- withStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode -- TODO not sure it is correct to set connections status here? @@ -6681,6 +6667,7 @@ createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode IKPQOff subMode pure (cmdId, connId) +-- TODO PQ parameter joinAgentConnectionAsync :: User -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM (CommandId, ConnId) joinAgentConnectionAsync user enableNtfs cReqUri cInfo subMode = do cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn @@ -6983,9 +6970,6 @@ chatCommandP = "/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath), "/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP), "/contact_merge " *> (SetContactMergeEnabled <$> onOffP), - "/_pq @" *> (APISetContactPQ <$> A.decimal <* A.space <*> (PQEncryption <$> onOffP)), - "/pq @" *> (SetContactPQ <$> displayName <* A.space <*> (PQEncryption <$> onOffP)), - "/pq " *> (APISetPQEncryption . PQSupport <$> onOffP), "/_db export " *> (APIExportArchive <$> jsonP), "/db export" $> ExportArchive, "/_db import " *> (APIImportArchive <$> jsonP), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 00c2e153f1..51fc463b7f 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -268,9 +268,6 @@ data ChatCommand | SetRemoteHostsFolder FilePath | APISetEncryptLocalFiles Bool | SetContactMergeEnabled Bool - | APISetPQEncryption PQSupport - | APISetContactPQ ContactId PQEncryption - | SetContactPQ ContactName PQEncryption | APIExportArchive ArchiveConfig | ExportArchive | APIImportArchive ArchiveConfig @@ -736,7 +733,6 @@ data ChatResponse | CRRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text} | CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo} | CRRemoteCtrlStopped {rcsState :: RemoteCtrlSessionState, rcStopReason :: RemoteCtrlStopReason} - | CRContactPQAllowed {user :: User, contact :: Contact, pqEncryption :: PQEncryption} | CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: PQEncryption} | CRSQLResult {rows :: [Text]} | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 89d0136478..a10acc884a 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -342,7 +342,6 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlDeviceName} -> ["remote controller " <> sShow rcId <> " session started with " <> plain ctrlDeviceName] CRRemoteCtrlStopped {} -> ["remote controller stopped"] - CRContactPQAllowed u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": enable " <> (if pqOn then "quantum resistant" else "standard") <> " end-to-end encryption"] CRContactPQEnabled u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": " <> (if pqOn then "quantum resistant" else "standard") <> " end-to-end encryption enabled"] CRSQLResult rows -> map plain rows CRSlowSQLQueries {chatQueries, agentQueries} -> diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 4b0389ab90..600a4bcc1f 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -10,7 +10,7 @@ import ChatClient import ChatTests.Utils import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_) -import Control.Monad (forM_, when) +import Control.Monad (forM_) import Data.Aeson (ToJSON) import qualified Data.Aeson as J import qualified Data.ByteString.Char8 as B @@ -21,11 +21,11 @@ import qualified Simplex.Chat.AppSettings as AS import Simplex.Chat.Call import Simplex.Chat.Controller (ChatConfig (..)) import Simplex.Chat.Options (ChatOpts (..)) -import Simplex.Chat.Protocol (currentChatVersion, pqEncryptionCompressionVersion, supportedChatVRange) +import Simplex.Chat.Protocol (supportedChatVRange) import Simplex.Chat.Store (agentStoreFile, chatStoreFile) -import Simplex.Chat.Types (VersionRangeChat, authErrDisableCount, sameVerificationCode, verificationCode, VersionChat, pattern VersionChat) +import Simplex.Chat.Types (VersionRangeChat, authErrDisableCount, sameVerificationCode, verificationCode, pattern VersionChat) import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) +import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOff) import Simplex.Messaging.Util (safeDecodeUtf8) import Simplex.Messaging.Version import System.Directory (copyFile, doesDirectoryExist, doesFileExist) @@ -128,13 +128,6 @@ chatDirectTests = do it "update peer version range on received messages" testUpdatePeerChatVRange describe "network statuses" $ do it "should get network statuses" testGetNetworkStatuses - describe "PQ tests" $ do - describe "enable PQ before connection, connect via invitation link" $ pqMatrix2 runTestPQConnectViaLink - describe "enable PQ before connection, connect via contact address" $ pqMatrix2 runTestPQConnectViaAddress - describe "connect via invitation link with PQ encryption enabled" $ pqVersionTestMatrix2 runTestPQVersionsViaLink - describe "connect via contact address with PQ encryption enabled" $ pqVersionTestMatrix2 runTestPQVersionsViaAddress - it "should enable PQ after several messages in connection without PQ" testPQEnableContact - it "should enable PQ, reduce envelope size and enable compression" testPQEnableContactCompression where testInvVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnInvChatVRange vr1 vr2 testReqVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnReqChatVRange vr1 vr2 @@ -2760,258 +2753,3 @@ contactInfoChatVRange cc (VersionRange minVer maxVer) = do cc <## "you've shared main profile with this contact" cc <## "connection not verified, use /code command to see security code" cc <## ("peer chat protocol version range: (" <> show minVer <> ", " <> show maxVer <> ")") - -runTestPQConnectViaLink :: HasCallStack => (TestCC, PQEnabled) -> (TestCC, PQEnabled) -> IO () -runTestPQConnectViaLink (alice, aPQ) (bob, bPQ) = do - when aPQ $ pqOn alice - when bPQ $ pqOn bob - - connectUsers alice bob - - (alice, "hi") `pqSend` bob - (bob, "hey") `pqSend` alice - - alice ##> "/_get chat @2 count=100" - ra <- chat <$> getTermLine alice - ra `shouldContain` [(0, e2eeInfo)] - alice `pqForContact` 2 `shouldReturn` PQEncryption pqEnabled - - bob ##> "/_get chat @2 count=100" - rb <- chat <$> getTermLine bob - rb `shouldContain` [(0, e2eeInfo)] - bob `pqForContact` 2 `shouldReturn` PQEncryption pqEnabled - where - pqEnabled = aPQ && bPQ - pqSend = if pqEnabled then (+#>) else (\#>) - e2eeInfo = if pqEnabled then e2eeInfoPQStr else e2eeInfoNoPQStr - -pqOn :: TestCC -> IO () -pqOn cc = do - cc ##> "/pq on" - cc <## "ok" - -runTestPQConnectViaAddress :: HasCallStack => (TestCC, PQEnabled) -> (TestCC, PQEnabled) -> IO () -runTestPQConnectViaAddress (alice, aPQ) (bob, bPQ) = do - when aPQ $ pqOn alice - when bPQ $ pqOn bob - - alice ##> "/ad" - cLink <- getContactLink alice True - bob ##> ("/c " <> cLink) - alice <#? bob - alice @@@ [("<@bob", "")] - alice ##> "/ac bob" - alice <## "bob (Bob): accepting contact request..." - concurrently_ - (bob <## "alice (Alice): contact is connected") - (alice <## "bob (Bob): contact is connected") - - (alice, "hi") `pqSend` bob - (bob, "hey") `pqSend` alice - - alice ##> "/_get chat @2 count=100" - ra <- chat <$> getTermLine alice - ra `shouldContain` [(0, e2eeInfo)] - alice `pqForContact` 2 `shouldReturn` PQEncryption pqEnabled - - bob ##> "/_get chat @2 count=100" - rb <- chat <$> getTermLine bob - rb `shouldContain` [(0, e2eeInfo)] - bob `pqForContact` 2 `shouldReturn` PQEncryption pqEnabled - where - pqEnabled = aPQ && bPQ - pqSend = if pqEnabled then (+#>) else (\#>) - e2eeInfo = if pqEnabled then e2eeInfoPQStr else e2eeInfoNoPQStr - -runTestPQVersionsViaLink :: HasCallStack => TestCC -> TestCC -> Bool -> VersionChat -> IO () -runTestPQVersionsViaLink alice bob pqExpected vExpected = do - img <- genProfileImg - let profileImage = "data:image/png;base64," <> B.unpack img - alice `send` ("/set profile image " <> profileImage) - _trimmedCmd1 <- getTermLine alice - alice <## "profile image updated" - bob `send` ("/set profile image " <> profileImage) - _trimmedCmd2 <- getTermLine bob - bob <## "profile image updated" - - pqOn alice - pqOn bob - - connectUsers alice bob - - (alice, "hi", vExpected) `pqSend` (bob, vExpected) - (bob, "hey", vExpected) `pqSend` (alice, vExpected) - - alice ##> "/_get chat @2 count=100" - ra <- chat <$> getTermLine alice - ra `shouldContain` [(0, e2eeInfo)] - alice `pqForContact` 2 `shouldReturn` PQEncryption pqExpected - - bob ##> "/_get chat @2 count=100" - rb <- chat <$> getTermLine bob - rb `shouldContain` [(0, e2eeInfo)] - bob `pqForContact` 2 `shouldReturn` PQEncryption pqExpected - where - pqSend = if pqExpected then (+:#>) else (\:#>) - e2eeInfo = if pqExpected then e2eeInfoPQStr else e2eeInfoNoPQStr - -runTestPQVersionsViaAddress :: HasCallStack => TestCC -> TestCC -> Bool -> VersionChat -> IO () -runTestPQVersionsViaAddress alice bob pqExpected vExpected = do - img <- genProfileImg - let profileImage = "data:image/png;base64," <> B.unpack img - alice `send` ("/set profile image " <> profileImage) - _trimmedCmd1 <- getTermLine alice - alice <## "profile image updated" - bob `send` ("/set profile image " <> profileImage) - _trimmedCmd2 <- getTermLine bob - bob <## "profile image updated" - - pqOn alice - pqOn bob - - alice ##> "/ad" - cLink <- getContactLink alice True - bob ##> ("/c " <> cLink) - alice <#? bob - alice @@@ [("<@bob", "")] - alice ##> "/ac bob" - alice <## "bob (Bob): accepting contact request..." - concurrently_ - (bob <## "alice (Alice): contact is connected") - (alice <## "bob (Bob): contact is connected") - - (alice, "hi", vExpected) `pqSend` (bob, vExpected) - (bob, "hey", vExpected) `pqSend` (alice, vExpected) - - alice ##> "/_get chat @2 count=100" - ra <- chat <$> getTermLine alice - ra `shouldContain` [(0, e2eeInfo)] - alice `pqForContact` 2 `shouldReturn` PQEncryption pqExpected - - bob ##> "/_get chat @2 count=100" - rb <- chat <$> getTermLine bob - rb `shouldContain` [(0, e2eeInfo)] - bob `pqForContact` 2 `shouldReturn` PQEncryption pqExpected - where - pqSend = if pqExpected then (+:#>) else (\:#>) - e2eeInfo = if pqExpected then e2eeInfoPQStr else e2eeInfoNoPQStr - -testPQEnableContact :: HasCallStack => FilePath -> IO () -testPQEnableContact = - testChat2 aliceProfile bobProfile $ \alice bob -> do - connectUsers alice bob - (alice, "hi") \#> bob - (bob, "hey") \#> alice - - alice ##> "/_get chat @2 count=100" - ra <- chat <$> getTermLine alice - ra `shouldContain` [(0, e2eeInfoNoPQStr)] - PQEncOff <- alice `pqForContact` 2 - - bob ##> "/_get chat @2 count=100" - rb <- chat <$> getTermLine bob - rb `shouldContain` [(0, e2eeInfoNoPQStr)] - PQEncOff <- bob `pqForContact` 2 - - sendMany PQEncOff alice bob - PQEncOff <- alice `pqForContact` 2 - PQEncOff <- bob `pqForContact` 2 - - -- enabling experimental flags doesn't enable PQ in previously created connection - pqOn alice - sendMany PQEncOff alice bob - PQEncOff <- alice `pqForContact` 2 - PQEncOff <- bob `pqForContact` 2 - - pqOn bob - sendMany PQEncOff alice bob - PQEncOff <- alice `pqForContact` 2 - PQEncOff <- bob `pqForContact` 2 - - -- if only one contact allows PQ, it's not enabled - alice ##> "/pq @bob on" - alice <## "bob: enable quantum resistant end-to-end encryption" - sendMany PQEncOff alice bob - PQEncOff <- alice `pqForContact` 2 - PQEncOff <- bob `pqForContact` 2 - - -- both contacts have to allow PQ to enable it - bob ##> "/pq @alice on" - bob <## "alice: enable quantum resistant end-to-end encryption" - - (alice, "1") \#> bob - (bob, "2") \#> alice - (alice, "3") \#> bob - (bob, "4") \#> alice - (alice, "5") +#> bob - - PQEncOff <- alice `pqForContact` 2 - PQEncOff <- bob `pqForContact` 2 - - (bob, "6") ++#> alice - -- equivalent to: - -- bob `send` "@alice 6" - -- bob <## "alice: quantum resistant end-to-end encryption enabled" - -- bob <# "@alice 6" - -- alice <## "bob: quantum resistant end-to-end encryption enabled" - -- alice <# "bob> 6" - - PQEncOn <- alice `pqForContact` 2 - alice #$> ("/_get chat @2 count=2", chat, [(0, e2eeInfoPQStr), (0, "6")]) - - PQEncOn <- bob `pqForContact` 2 - bob #$> ("/_get chat @2 count=2", chat, [(1, e2eeInfoPQStr), (1, "6")]) - - (alice, "6") +#> bob - (bob, "7") +#> alice - - sendMany PQEncOn alice bob - - PQEncOn <- alice `pqForContact` 2 - PQEncOn <- bob `pqForContact` 2 - pure () - -sendMany :: PQEncryption -> TestCC -> TestCC -> IO () -sendMany pqEnc alice bob = - forM_ [(1 :: Int) .. 10] $ \i -> do - sndRcv pqEnc False (alice, show i) bob - sndRcv pqEnc False (bob, show i) alice - -testPQEnableContactCompression :: HasCallStack => FilePath -> IO () -testPQEnableContactCompression = - testChat2 aliceProfile bobProfile $ \alice bob -> do - connectUsers alice bob - (alice, "hi") \#> bob - (bob, "hey") \#> alice - PQEncOff <- alice `pqForContact` 2 - PQEncOff <- bob `pqForContact` 2 - (alice, "lrg 1", v) \:#> (bob, v) - (bob, "lrg 2", v) \:#> (alice, v) - PQSupportOff <- alice `pqSupportForCt` 2 - alice ##> "/pq @bob on" - alice <## "bob: enable quantum resistant end-to-end encryption" - PQSupportOn <- alice `pqSupportForCt` 2 - (alice, "lrg 3", v) \:#> (bob, v) - (bob, "lrg 4", v) \:#> (alice, v) - PQSupportOff <- bob `pqSupportForCt` 2 - bob ##> "/pq @alice on" - bob <## "alice: enable quantum resistant end-to-end encryption" - PQSupportOn <- bob `pqSupportForCt` 2 - threadDelay 300000 - (alice, "lrg 1", v) \:#> (bob, v') - threadDelay 300000 - (bob, "lrg 2", v') \:#> (alice, v') - threadDelay 300000 - (alice, "lrg 3", v') \:#> (bob, v') - threadDelay 300000 - (bob, "lrg 4", v') \:#> (alice, v') - threadDelay 300000 - (alice, "lrg 5", v') +:#> (bob, v') - PQEncOff <- alice `pqForContact` 2 - PQEncOff <- bob `pqForContact` 2 - (bob, "lrg 6", v') ++:#> (alice, v') - (alice, "lrg 7", v') +:#> (bob, v') - (bob, "lrg 8", v') +:#> (alice, v') - where - v = currentChatVersion - v' = pqEncryptionCompressionVersion diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index aa6579efee..4a4d0a3537 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -13,8 +13,6 @@ import Control.Concurrent.Async (concurrently_) import Control.Concurrent.STM import Control.Monad (unless, when) import Control.Monad.Except (runExceptT) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as B import Data.Char (isDigit) import Data.List (isPrefixOf, isSuffixOf) @@ -25,7 +23,6 @@ import Database.SQLite.Simple (Only (..)) import Simplex.Chat.Controller (ChatConfig (..), ChatController (..)) import Simplex.Chat.Messages.CIContent (e2eInfoNoPQText, e2eInfoPQText) import Simplex.Chat.Protocol -import Simplex.Chat.Store.Direct (getContact) import Simplex.Chat.Store.NoteFolders (createNoteFolder) import Simplex.Chat.Store.Profiles (getUserContactProfiles) import Simplex.Chat.Types @@ -34,8 +31,7 @@ import Simplex.Chat.Types.Shared import Simplex.FileTransfer.Client.Main (xftpClientCLI) import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow, withTransaction) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB -import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff) +import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Version import System.Directory (doesFileExist) @@ -205,65 +201,6 @@ cc #$> (cmd, f, res) = do cc ##> cmd (f <$> getTermLine cc) `shouldReturn` res --- / PQ combinators - -(\#>) :: HasCallStack => (TestCC, String) -> TestCC -> IO () -(\#>) = sndRcv PQEncOff False - -(+#>) :: HasCallStack => (TestCC, String) -> TestCC -> IO () -(+#>) = sndRcv PQEncOn False - -(++#>) :: HasCallStack => (TestCC, String) -> TestCC -> IO () -(++#>) = sndRcv PQEncOn True - -sndRcv :: HasCallStack => PQEncryption -> Bool -> (TestCC, String) -> TestCC -> IO () -sndRcv pqEnc enabled (cc1, msg) cc2 = do - name1 <- userName cc1 - name2 <- userName cc2 - let cmd = "@" <> name2 <> " " <> msg - cc1 `send` cmd - when enabled $ cc1 <## (name2 <> ": quantum resistant end-to-end encryption enabled") - cc1 <# cmd - cc1 `pqSndForContact` 2 `shouldReturn` pqEnc - when enabled $ cc2 <## (name1 <> ": quantum resistant end-to-end encryption enabled") - cc2 <# (name1 <> "> " <> msg) - cc2 `pqRcvForContact` 2 `shouldReturn` pqEnc - -(\:#>) :: HasCallStack => (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO () -(\:#>) = sndRcvImg PQEncOff False - -(+:#>) :: HasCallStack => (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO () -(+:#>) = sndRcvImg PQEncOn False - -(++:#>) :: HasCallStack => (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO () -(++:#>) = sndRcvImg PQEncOn True - -sndRcvImg :: HasCallStack => PQEncryption -> Bool -> (TestCC, String, VersionChat) -> (TestCC, VersionChat) -> IO () -sndRcvImg pqEnc enabled (cc1, msg, v1) (cc2, v2) = do - name1 <- userName cc1 - name2 <- userName cc2 - g <- C.newRandom - img <- atomically $ B64.encode <$> C.randomBytes lrgLen g - cc1 `send` ("/_send @2 json {\"msgContent\":{\"type\":\"image\",\"text\":\"" <> msg <> "\",\"image\":\"" <> B.unpack img <> "\"}}") - cc1 .<## "}}" - cc1 <### ([ConsoleString (name2 <> ": quantum resistant end-to-end encryption enabled") | enabled] <> [WithTime ("@" <> name2 <> " " <> msg)]) - cc1 `pqSndForContact` 2 `shouldReturn` pqEnc - cc1 `pqVerForContact` 2 `shouldReturn` v1 - cc2 <### ([ConsoleString (name1 <> ": quantum resistant end-to-end encryption enabled") | enabled] <> [WithTime (name1 <> "> " <> msg)]) - cc2 `pqRcvForContact` 2 `shouldReturn` pqEnc - cc2 `pqVerForContact` 2 `shouldReturn` v2 - where - lrgLen = maxEncodedMsgLength * 3 `div` 4 - 110 -- 98 is ~ max size for binary image preview given the rest of the message - -genProfileImg :: IO ByteString -genProfileImg = do - g <- C.newRandom - atomically $ B64.encode <$> C.randomBytes lrgLen g - where - lrgLen = maxEncodedInfoLength * 3 `div` 4 - 420 - --- PQ combinators / - chat :: String -> [(Int, String)] chat = map (\(a, _, _) -> a) . chat'' @@ -572,34 +509,6 @@ getProfilePictureByName cc displayName = maybeFirstRow fromOnly $ DB.query db "SELECT image FROM contact_profiles WHERE display_name = ? LIMIT 1" (Only displayName) -pqSndForContact :: TestCC -> ContactId -> IO PQEncryption -pqSndForContact = pqForContact_ pqSndEnabled PQEncOff - -pqRcvForContact :: TestCC -> ContactId -> IO PQEncryption -pqRcvForContact = pqForContact_ pqRcvEnabled PQEncOff - -pqForContact :: TestCC -> ContactId -> IO PQEncryption -pqForContact = pqForContact_ (Just . connPQEnabled) (error "impossible") - -pqSupportForCt :: TestCC -> ContactId -> IO PQSupport -pqSupportForCt = pqForContact_ (\Connection {pqSupport} -> Just pqSupport) PQSupportOff - -pqVerForContact :: TestCC -> ContactId -> IO VersionChat -pqVerForContact = pqForContact_ (Just . connChatVersion) (error "impossible") - -pqForContact_ :: (Connection -> Maybe a) -> a -> TestCC -> ContactId -> IO a -pqForContact_ pqSel def cc contactId = (fromMaybe def . pqSel) <$> getCtConn cc contactId - -getCtConn :: TestCC -> ContactId -> IO Connection -getCtConn cc contactId = getTestCCContact cc contactId >>= maybe (fail "no connection") pure . contactConn - -getTestCCContact :: TestCC -> ContactId -> IO Contact -getTestCCContact cc contactId = do - let TestCC {chatController = ChatController {config = ChatConfig {chatVRange = vr}}} = cc - withCCTransaction cc $ \db -> - withCCUser cc $ \user -> - runExceptT (getContact db vr user contactId) >>= either (fail . show) pure - lastItemId :: HasCallStack => TestCC -> IO String lastItemId cc = do cc ##> "/last_item_id" diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs index b6bc91e48b..8b0483c6d5 100644 --- a/tests/SchemaDump.hs +++ b/tests/SchemaDump.hs @@ -55,7 +55,8 @@ testSchemaMigrations = withTmpFiles $ do schema <- getSchema testDB testSchema Migrations.run st $ MTRUp [m] schema' <- getSchema testDB testSchema - schema' `shouldNotBe` schema + unless (name m `elem` skipComparisonForUpMigrations) $ + schema' `shouldNotBe` schema Migrations.run st $ MTRDown [downMigr] unless (name m `elem` skipComparisonForDownMigrations) $ do schema'' <- getSchema testDB testSchema @@ -64,6 +65,12 @@ testSchemaMigrations = withTmpFiles $ do schema''' <- getSchema testDB testSchema schema''' `shouldBe` schema' +skipComparisonForUpMigrations :: [String] +skipComparisonForUpMigrations = + [ -- schema doesn't change + "20240419_enable_pq_support" + ] + skipComparisonForDownMigrations :: [String] skipComparisonForDownMigrations = [ -- on down migration msg_delivery_events table moves down to the end of the file