diff --git a/src/Simplex/Chat/Badges.hs b/src/Simplex/Chat/Badges.hs index 56589f58bb..ae9260ab36 100644 --- a/src/Simplex/Chat/Badges.hs +++ b/src/Simplex/Chat/Badges.hs @@ -311,7 +311,13 @@ data ProofPresHeader | PHLink ByteString | PHUnknown Char ByteString deriving (Eq, Show) - deriving (ToJSON, FromJSON) via (StrJSON "ProofPresHeader" ProofPresHeader) + +instance ToJSON ProofPresHeader where + toJSON = toJSON . BBSPresHeader . strEncode + toEncoding = toEncoding . BBSPresHeader . strEncode + +instance FromJSON ProofPresHeader where + parseJSON v = parseJSON v >>= \(BBSPresHeader ph) -> either fail pure $ strDecode ph instance StrEncoding ProofPresHeader where strEncode = \case diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index db4faa0d12..a70a0b3b50 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1663,7 +1663,7 @@ processChatCommand cxt nm = \case APISetUserUIThemes uId uiThemes -> withUser $ \user@User {userId} -> do user'@User {userId = uId'} <- withFastStore $ \db -> do user' <- getUser db uId - liftIO $ setUserUIThemes db user uiThemes + liftIO $ setUserUIThemes db user' uiThemes pure user' when (userId == uId') $ chatWriteVar currentUser $ Just (user :: User) {uiThemes} ok user' @@ -4043,7 +4043,7 @@ processChatCommand cxt nm = \case p'' = (p' :: Profile) {contactDomain = if isJust contactLink then claim else Nothing} in updateProfile_ user' p'' True $ withFastStore $ \db -> updateUserProfile db user' p'' updateProfile_ :: User -> Profile -> Bool -> CM User -> CM ChatResponse - updateProfile_ user@User {userId, profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n', image = img'} shouldUpdateAddressData updateUser + updateProfile_ user@User {userId, profile = p@LocalProfile {displayName = n, image = img}} p'@Profile {displayName = n', image = img'} shouldUpdateAddressData updateUser | p' == fromLocalProfile p = pure $ CRUserProfileNoChange user | n /= n' = do checkValidName n' @@ -4053,7 +4053,7 @@ processChatCommand cxt nm = \case | otherwise = update where update = do - checkProfileImageSize img' + when (img /= img') $ checkProfileImageSize img' checkProfileSize p' when shouldUpdateAddressData $ do ts <- liftIO getCurrentTime @@ -4148,10 +4148,10 @@ processChatCommand cxt nm = \case lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct' pure $ CRContactPrefsUpdated user ct ct' runUpdateGroupProfile :: User -> GroupInfoKeys -> GroupProfile -> Bool -> CM ChatResponse - runUpdateGroupProfile user (GIK gInfo@GroupInfo {businessChat, groupProfile = p@GroupProfile {displayName = n}} gks) p'@GroupProfile {displayName = n', image = img', memberAdmission = ma'} domainVerified = do + runUpdateGroupProfile user (GIK gInfo@GroupInfo {businessChat, groupProfile = p@GroupProfile {displayName = n, image = img}} gks) p'@GroupProfile {displayName = n', image = img', memberAdmission = ma'} domainVerified = do assertUserGroupRole gInfo GROwner when (n /= n') $ checkValidName n' - checkProfileImageSize img' + when (img /= img') $ checkProfileImageSize img' checkGroupProfileSize p' when (useRelays' gInfo && isJust (ma' >>= review)) $ throwCmdError "Admission review is not supported in channels" -- updateGroupProfile clears domain verification; re-set it when the caller already re-resolved the name diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 8695487530..0e1471f3d5 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -3568,7 +3568,7 @@ createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupI where VersionRange minV maxV = vr cxt newOwnerProfile currentTs = do - (ldn, pId, _) <- createNewMemberProfile_ db cxt user (profileFromName $ nameFromMemberId memberId) currentTs + (ldn, pId, _, _) <- createNewMemberProfile_ db cxt user (profileFromName $ nameFromMemberId memberId) Nothing currentTs pure (ldn, pId) contactNameAndProfile ctId = do Contact {localDisplayName = ldn, profile = LocalProfile {profileId = pId}} <- getContact db cxt user ctId diff --git a/tests/BadgeTests.hs b/tests/BadgeTests.hs index 5875e60c05..360c97edf0 100644 --- a/tests/BadgeTests.hs +++ b/tests/BadgeTests.hs @@ -51,6 +51,7 @@ badgeTests = do it "should accept unknown badge types" testUnknownBadgeType it "credential serializes to a paste-able token and back" testCredentialSerialization it "presentation headers encode and decode" testPresHeaderEncoding + it "presentation headers with binary bytes round-trip through JSON" testPresHeaderJSON it "should reject a proof presented under another chat binding" testOtherChatBinding it "should accept a profile proof only with the header of its chat" testProfileProofHeader describe "redemption codes" $ do @@ -212,6 +213,23 @@ testPresHeaderEncoding = PHUnknown 'Z' "payload" ] +testPresHeaderJSON :: IO () +testPresHeaderJSON = + mapM_ + ( \ph -> do + J.eitherDecode (J.encode ph) `shouldBe` Right ph + J.toJSON ph `shouldBe` J.toJSON (BBSPresHeader $ strEncode ph) + ) + [ PHChat binaryBytes, + PHFileInv {chatBinding = binaryBytes, fileSize = 139737}, + PHFileDescr {chatBinding = binaryBytes, fileSize = 139737, descrHash = binaryBytes, fileExpires = Just futureTime}, + PHRequest binaryBytes, + PHLink binaryBytes, + PHUnknown 'Z' binaryBytes + ] + where + binaryBytes = "\0\1\31\34\92\127\128\195\255" + testOtherChatBinding :: IO () testOtherChatBinding = do let ph = PHFileInv {chatBinding = aliceBinding, fileSize = 139737} diff --git a/tests/ChatTests/Names.hs b/tests/ChatTests/Names.hs index bb0c7e1309..29a8c00c4f 100644 --- a/tests/ChatTests/Names.hs +++ b/tests/ChatTests/Names.hs @@ -66,7 +66,7 @@ testConnectByName ps = withSmpServerAndNames ps $ \reg -> pure () testUpdateProfileKeepsName :: HasCallStack => TestParams -> IO () -testUpdateProfileKeepsName ps = withSmpServerAndNames $ \reg -> +testUpdateProfileKeepsName ps = withSmpServerAndNames ps $ \reg -> testChat2 aliceProfile bobProfile (test reg) ps where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) @@ -103,7 +103,7 @@ testUpdateProfileKeepsName ps = withSmpServerAndNames $ \reg -> pure () testAddressSharingOffRemovesName :: HasCallStack => TestParams -> IO () -testAddressSharingOffRemovesName ps = withSmpServerAndNames $ \reg -> +testAddressSharingOffRemovesName ps = withSmpServerAndNames ps $ \reg -> testChat2 aliceProfile bobProfile (test reg) ps where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) @@ -143,7 +143,7 @@ testAddressSharingOffRemovesName ps = withSmpServerAndNames $ \reg -> pure () testAddressDeleteRemovesName :: HasCallStack => TestParams -> IO () -testAddressDeleteRemovesName ps = withSmpServerAndNames $ \reg -> +testAddressDeleteRemovesName ps = withSmpServerAndNames ps $ \reg -> testChat2 aliceProfile bobProfile (test reg) ps where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 7e0c6c394d..a3060b5a80 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -20,7 +20,6 @@ import Control.Monad.Except import Control.Monad.Reader (runReaderT) import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.ByteString.Char8 as B -import Data.List (isSuffixOf) import qualified Data.Text as T import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime, nominalDay) import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) @@ -47,6 +46,11 @@ import Simplex.Messaging.Util (decodeJSON, encodeJSON) import Simplex.Messaging.Version (mkVersionRange) import System.Directory (copyFile, createDirectoryIfMissing) import Test.Hspec hiding (it) +#if defined(dbPostgres) +import Database.PostgreSQL.Simple (Only (..)) +#else +import Database.SQLite.Simple (Only (..)) +#endif chatProfileTests :: SpecWith TestParams chatProfileTests = do @@ -59,6 +63,7 @@ chatProfileTests = do it "profile description round-trips and shows in contact info" testProfileDescriptionShown it "member profile description is redacted for members without a direct contact" testMemberDescriptionRedacted it "update user profile with image" testUpdateProfileImage + it "stored image over the limit is kept, a new one is rejected" testUpdateProfileStoredLargeImage it "reject profile image that is too large" testSetProfileImageTooLarge it "set profile image from file" testSetProfileImageFromFile it "use multiword profile names" testMultiWordProfileNames @@ -265,8 +270,8 @@ testUpdateProfileAddressDataError ps = do bob <## "disconnected 1 connections on server localhost" where serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg (tmpPath ps) } opts' = @@ -806,8 +811,8 @@ testUserBadgeAddressConnectRetry ps = do bob <## "disconnected 1 connections on server localhost" where serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg (tmpPath ps) } opts' = @@ -849,8 +854,8 @@ testUserBadgeInvitationConnectRetry ps = do bob <## "disconnected 1 connections on server localhost" where serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg (tmpPath ps) } opts' = @@ -1106,6 +1111,21 @@ testUpdateProfileImage = bob <## "use @alice2 to send messages" (bob TestParams -> IO () +testUpdateProfileStoredLargeImage = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + let image = "data:image/png;base64," <> replicate 13000 'A' + withCCTransaction alice $ \db -> + DB.execute db "UPDATE contact_profiles SET image = ? WHERE contact_profile_id = (SELECT contact_profile_id FROM contacts WHERE is_user = 1)" (Only image) + alice ##> "/p alisa" + alice <## "user profile is changed to alisa (your 1 contacts are notified)" + bob <## "contact alice changed to alisa" + bob <## "use @alisa to send messages" + alice #> "@bob hi" + bob <# "alisa> hi" + testSetProfileImageTooLarge :: HasCallStack => TestParams -> IO () testSetProfileImageTooLarge = testChat2 aliceProfile bobProfile $ @@ -4101,7 +4121,6 @@ testShortLinkInvitationConnectRetry ps = testChatCfgOpts2 cfg' opts' aliceProfil { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } - cfg' = testCfg {agentConfig = testAgentCfg {persistErrorInterval = 0}} opts' = testOpts { coreOptions =