From 191d83394704a45c6b9c988c7bfa2fab7413e86f Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Sat, 9 Mar 2024 03:09:12 +0400 Subject: [PATCH] core (pq): tests (#3882) * core (pq): tests * rename * move * test allow * mute test output * pq combinators * refactor --------- Co-authored-by: Evgeny Poberezkin --- src/Simplex/Chat/Messages/CIContent.hs | 6 +- src/Simplex/Chat/Types.hs | 12 +- src/Simplex/Chat/View.hs | 2 +- tests/ChatClient.hs | 1 + tests/ChatTests/Direct.hs | 150 ++++++++++++++++++++++++- tests/ChatTests/Utils.hs | 66 ++++++++++- 6 files changed, 225 insertions(+), 12 deletions(-) diff --git a/src/Simplex/Chat/Messages/CIContent.hs b/src/Simplex/Chat/Messages/CIContent.hs index b44090290e..8640cf23d3 100644 --- a/src/Simplex/Chat/Messages/CIContent.hs +++ b/src/Simplex/Chat/Messages/CIContent.hs @@ -270,7 +270,7 @@ ciContentToText = \case directE2EInfoToText :: E2EInfo -> Text directE2EInfoToText E2EInfo {pqEnabled} = case pqEnabled of - PQEncOn -> "This conversation is protected by quantum resistant end-to-end encryption. It has perfect forward secrecy, repudiation and quantum resistant break-in recovery." + PQEncOn -> e2eInfoPQText PQEncOff -> e2eInfoNoPQText groupE2EInfoToText :: E2EInfo -> Text @@ -280,6 +280,10 @@ e2eInfoNoPQText :: Text e2eInfoNoPQText = "This conversation is protected by end-to-end encryption with perfect forward secrecy, repudiation and break-in recovery." +e2eInfoPQText :: Text +e2eInfoPQText = + "This conversation is protected by quantum resistant end-to-end encryption. It has perfect forward secrecy, repudiation and quantum resistant break-in recovery." + ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayName, fullName}} role = "invitation to join group " <> displayName <> optionalFullName displayName fullName <> " as " <> (decodeLatin1 . strEncode $ role) diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 9f24e7007d..d4a3a8029e 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -49,7 +49,7 @@ import Simplex.Chat.Types.Util import Simplex.FileTransfer.Description (FileDigest) import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, RcvFileId, SAEntity (..), SndFileId, UserId) import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) -import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON) import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI) @@ -214,8 +214,8 @@ contactDeleted Contact {contactStatus} = contactStatus == CSDeleted contactSecurityCode :: Contact -> Maybe SecurityCode contactSecurityCode Contact {activeConn} = connectionCode =<< activeConn -contactPQEnabled :: Contact -> Bool -contactPQEnabled Contact {activeConn} = maybe False connPQEnabled activeConn +contactPQEnabled :: Contact -> PQEncryption +contactPQEnabled Contact {activeConn} = maybe PQEncOff connPQEnabled activeConn data ContactStatus = CSActive @@ -1342,9 +1342,9 @@ aConnId Connection {agentConnId = AgentConnId cId} = cId connIncognito :: Connection -> Bool connIncognito Connection {customUserProfileId} = isJust customUserProfileId -connPQEnabled :: Connection -> Bool -connPQEnabled Connection {pqSndEnabled = Just (PQEncryption s), pqRcvEnabled = Just (PQEncryption r)} = s && r -connPQEnabled _ = False +connPQEnabled :: Connection -> PQEncryption +connPQEnabled Connection {pqSndEnabled = Just (PQEncryption s), pqRcvEnabled = Just (PQEncryption r)} = PQEncryption $ s && r +connPQEnabled _ = PQEncOff data PendingContactConnection = PendingContactConnection { pccConnId :: Int64, diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index e355da7a2d..d953b9183f 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1177,7 +1177,7 @@ viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, conta incognitoProfile <> ["alias: " <> plain localAlias | localAlias /= ""] <> [viewConnectionVerified (contactSecurityCode ct)] - <> ["post-quantum encryption enabled" | contactPQEnabled ct] + <> ["post-quantum encryption enabled" | contactPQEnabled ct == CR.PQEncOn] <> maybe [] (\ac -> [viewPeerChatVRange (peerChatVRange ac)]) activeConn viewGroupInfo :: GroupInfo -> GroupSummary -> [StyledString] diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index d5a56ec91a..691a4101a7 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -5,6 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 600a4bcc1f..cc1a7791b0 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_) +import Control.Monad (forM_, when) import Data.Aeson (ToJSON) import qualified Data.Aeson as J import qualified Data.ByteString.Char8 as B @@ -25,7 +25,7 @@ import Simplex.Chat.Protocol (supportedChatVRange) import Simplex.Chat.Store (agentStoreFile, chatStoreFile) import Simplex.Chat.Types (VersionRangeChat, authErrDisableCount, sameVerificationCode, verificationCode, pattern VersionChat) import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOff) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), pattern PQSupportOff, pattern PQEncOn, pattern PQEncOff) import Simplex.Messaging.Util (safeDecodeUtf8) import Simplex.Messaging.Version import System.Directory (copyFile, doesDirectoryExist, doesFileExist) @@ -128,6 +128,10 @@ 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 + it "should enable PQ after several messages in connection without PQ" testPQAllowContact where testInvVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnInvChatVRange vr1 vr2 testReqVRange vr1 vr2 = it (vRangeStr vr1 <> " - " <> vRangeStr vr2) $ testConnReqChatVRange vr1 vr2 @@ -2753,3 +2757,145 @@ 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 + +testPQAllowContact :: HasCallStack => FilePath -> IO () +testPQAllowContact = + 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 allow 2" + alice <## "bob: post-quantum encryption allowed" + sendMany PQEncOff alice bob + PQEncOff <- alice `pqForContact` 2 + PQEncOff <- bob `pqForContact` 2 + + -- both contacts have to allow PQ to enable it + bob ##> "/_pq allow 2" + bob <## "alice: post-quantum encryption allowed" + + (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: post-quantum encryption enabled" + -- bob <# "@alice 6" + -- alice <## "bob: post-quantum encryption enabled" + -- alice <# "bob> 6" + + PQEncOn <- alice `pqForContact` 2 + alice #$> ("/_get chat @2 count=2", chat, [(0, "post-quantum encryption enabled"), (0, "6")]) + + PQEncOn <- bob `pqForContact` 2 + bob #$> ("/_get chat @2 count=2", chat, [(1, "post-quantum encryption enabled"), (1, "6")]) + + (alice, "6") +#> bob + (bob, "7") +#> alice + + sendMany PQEncOn alice bob + + PQEncOn <- alice `pqForContact` 2 + PQEncOn <- bob `pqForContact` 2 + pure () + where + sendMany pqEnc alice bob = + forM_ [(1 :: Int) .. 10] $ \i -> do + sndRcv pqEnc False (alice, show i) bob + sndRcv pqEnc False (bob, show i) alice diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 322a810d92..387dd95dd9 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -21,8 +21,9 @@ import Data.String import qualified Data.Text as T import Database.SQLite.Simple (Only (..)) import Simplex.Chat.Controller (ChatConfig (..), ChatController (..)) -import Simplex.Chat.Messages.CIContent (e2eInfoNoPQText) +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 @@ -30,7 +31,7 @@ import Simplex.Chat.Types.Preferences 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 Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOff) +import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Version import System.Directory (doesFileExist) @@ -114,6 +115,17 @@ runTestCfg3 aliceCfg bobCfg cathCfg runTest tmp = withNewTestChatCfg tmp cathCfg "cath" cathProfile $ \cath -> runTest alice bob cath +type PQEnabled = Bool + +pqMatrix2 :: (HasCallStack => (TestCC, PQEnabled) -> (TestCC, PQEnabled) -> IO ()) -> SpecWith FilePath +pqMatrix2 runTest = do + it "PQ: off, off" $ test False False + it "PQ: on, off" $ test False True + it "PQ: off, on" $ test True False + it "PQ: on, on" $ test True True + where + test aPQ bPQ = testChat2 aliceProfile bobProfile $ \a b -> runTest (a, aPQ) (b, bPQ) + withTestChatGroup3Connected :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a withTestChatGroup3Connected tmp dbPrefix action = do withTestChat tmp dbPrefix $ \cc -> do @@ -172,6 +184,32 @@ 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 <> ": post-quantum encryption enabled") + cc1 <# cmd + cc1 `pqSndForContact` 2 `shouldReturn` pqEnc + when enabled $ cc2 <## (name1 <> ": post-quantum encryption enabled") + cc2 <# (name1 <> "> " <> msg) + cc2 `pqRcvForContact` 2 `shouldReturn` pqEnc + +-- PQ combinators / + chat :: String -> [(Int, String)] chat = map (\(a, _, _) -> a) . chat'' @@ -206,6 +244,9 @@ chatFeatures'' = e2eeInfoNoPQStr :: String e2eeInfoNoPQStr = T.unpack e2eInfoNoPQText +e2eeInfoPQStr :: String +e2eeInfoPQStr = T.unpack e2eInfoPQText + lastChatFeature :: String lastChatFeature = snd $ last chatFeatures @@ -476,6 +517,27 @@ 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 + +pqRcvForContact :: TestCC -> ContactId -> IO PQEncryption +pqRcvForContact = pqForContact_ pqRcvEnabled + +pqForContact :: TestCC -> ContactId -> IO PQEncryption +pqForContact = pqForContact_ (Just . connPQEnabled) + +pqForContact_ :: (Connection -> Maybe PQEncryption) -> TestCC -> ContactId -> IO PQEncryption +pqForContact_ pqSel cc contactId = + getTestCCContact cc contactId >>= \ct -> case contactConn ct of + Just conn -> pure $ fromMaybe PQEncOff $ pqSel conn + Nothing -> fail "no connection" + +getTestCCContact :: TestCC -> ContactId -> IO Contact +getTestCCContact cc contactId = + withCCTransaction cc $ \db -> + withCCUser cc $ \user -> + runExceptT (getContact db user contactId) >>= either (fail . show) pure + lastItemId :: HasCallStack => TestCC -> IO String lastItemId cc = do cc ##> "/last_item_id"