diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 124c4666b8..434de3fbb3 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -28,7 +28,6 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Time.Clock (getCurrentTime) import Data.Time.LocalTime (getCurrentTimeZone) import System.FilePath (takeExtension) -import UnliftIO.STM import Simplex.Chat import Simplex.Chat.Controller import Simplex.Chat.Library.Commands @@ -67,15 +66,21 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@Cha let backgroundMode = maintenance cc <- newChatController db u_ cfg opts backgroundMode forM_ (preStartHook chatHooks) ($ cc) - u0 <- case u_ of - Nothing -> noMaintenance >> createActiveUser cc coreOptions createBot userDisplayName + img_ <- mapM loadImageFile userImageFile + u <- case u_ of + Nothing -> noMaintenance >> createActiveUser cc coreOptions createBot userDisplayName img_ Just u@User {localDisplayName} -> do forM_ userDisplayName $ \name -> when (localDisplayName /= name) $ do putStrLn $ "Active user display name " <> show localDisplayName <> " does not match --user-display-name " <> show name exitFailure - pure u - u <- maybe (pure u0) (applyUserImage cc chatStore u0) userImageFile + case img_ of + Nothing -> pure u + Just img -> + execChatCommand' (UpdateProfileImage (Just img)) 0 `runReaderT` cc >>= \case + Right (CRUserProfileUpdated u' _ _ _) -> pure u' + Right (CRUserProfileNoChange u') -> pure u' + r -> printResponseEvent (Nothing, Nothing) (config cc) r >> exitFailure unless testView $ putStrLn $ "Current user: " <> userStr u runSimplexChat cfg opts u cc chat noMaintenance = when maintenance $ do @@ -130,13 +135,13 @@ selectActiveUser CoreChatOpts {chatRelay} st users let user = users !! (n - 1) in Just <$> withTransaction st (`setActiveUser` user) -createActiveUser :: ChatController -> CoreChatOpts -> Maybe CreateBotOpts -> Maybe Text -> IO User -createActiveUser cc CoreChatOpts {chatRelay} createBot_ userDisplayName_ = case createBot_ of +createActiveUser :: ChatController -> CoreChatOpts -> Maybe CreateBotOpts -> Maybe Text -> Maybe ImageData -> IO User +createActiveUser cc CoreChatOpts {chatRelay} createBot_ userDisplayName_ img_ = case createBot_ of Just CreateBotOpts {botDisplayName, allowFiles} -> do let preferences = if allowFiles then Nothing else Just emptyChatPrefs {files = Just FilesPreference {allow = FANo}} createUser exitFailure $ (mkProfile botDisplayName) {peerType = Just CPTBot, preferences} Nothing -> case userDisplayName_ of - Just displayName -> createUser exitFailure $ mkProfile displayName + Just displayName -> createUser exitFailure $ (mkProfile displayName :: Profile) {image = img_} Nothing -> putStrLn prompt >> loop where prompt @@ -204,34 +209,16 @@ onOffPrompt prompt def = "N" -> pure False _ -> putStrLn "Invalid input, please enter 'y' or 'n'" >> onOffPrompt prompt def -applyUserImage :: ChatController -> DBStore -> User -> FilePath -> IO User -applyUserImage cc store u@User {profile = p@LocalProfile {image = currentImg}} path = do - newImg <- loadImageFile path >>= either failExit pure - if currentImg == Just newImg - then pure u - else do - let p' = (fromLocalProfile p) {image = Just newImg} :: Profile - withTransaction store (\db -> runExceptT $ updateUserProfile db u p') >>= \case - Left e -> failExit $ "Failed to update user profile: " <> show e - Right u' -> u' <$ atomically (writeTVar (currentUser cc) (Just u')) - where - failExit msg = putStrLn msg >> exitFailure - -loadImageFile :: FilePath -> IO (Either String ImageData) +loadImageFile :: FilePath -> IO ImageData loadImageFile path = case map toLower (takeExtension path) of ".png" -> readAs "image/png" ".jpg" -> readAs "image/jpg" ".jpeg" -> readAs "image/jpg" - ext -> pure $ Left $ "--user-image-file: unsupported image extension " <> show ext <> " (only .png, .jpg, .jpeg)" + ext -> putStrLn ("--user-image-file: unsupported image extension " <> show ext <> " (only .png, .jpg, .jpeg)") >> exitFailure where - -- matches the cap mobile/desktop UIs pass to resizeImageToStrSize for profile images - maxProfileImageSize = 12500 readAs mime = do bs <- BS.readFile path - let url = "data:" <> mime <> ";base64," <> decodeUtf8 (B64.encode bs) - pure $ if T.length url > maxProfileImageSize - then Left $ "--user-image-file: encoded image size " <> show (T.length url) <> " bytes exceeds max " <> show maxProfileImageSize <> " bytes" - else Right $ ImageData url + pure $ ImageData $ "data:" <> mime <> ";base64," <> decodeUtf8 (B64.encode bs) userStr :: User -> String userStr User {localDisplayName, profile = LocalProfile {fullName}} = diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index ccfa1a3fd6..f678bbe3a9 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -149,6 +149,15 @@ _defaultNtfServers = maxImageSize :: Integer maxImageSize = 261120 * 2 -- auto-receive on mobiles +-- matches the cap mobile and desktop UIs pass to resizeImageToStrSize for profile images +maxProfileImageSize :: Int +maxProfileImageSize = 12500 + +checkProfileImageSize :: Maybe ImageData -> CM () +checkProfileImageSize = mapM_ $ \(ImageData t) -> + let size = T.length t + in when (size > maxProfileImageSize) $ throwCmdError $ "Profile image is too large " <> show size + imageExtensions :: [String] imageExtensions = [".jpg", ".jpeg", ".png", ".gif"] @@ -349,7 +358,9 @@ processChatCommand :: VersionRangeChat -> NetworkRequestMode -> ChatCommand -> C processChatCommand vr nm = \case ShowActiveUser -> withUser' $ pure . CRActiveUser CreateActiveUser NewUser {profile, pastTimestamp, userChatRelay} -> do - forM_ profile $ \Profile {displayName} -> checkValidName displayName + forM_ profile $ \Profile {displayName, image} -> do + checkValidName displayName + checkProfileImageSize image p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile u <- asks currentUser users <- withFastStore' getUsers @@ -3624,10 +3635,11 @@ processChatCommand vr nm = \case updateProfile :: User -> Profile -> CM ChatResponse updateProfile user p' = updateProfile_ user p' True $ withFastStore $ \db -> updateUserProfile db user p' updateProfile_ :: User -> Profile -> Bool -> CM User -> CM ChatResponse - updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} shouldUpdateAddressData updateUser + updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n', image = img'} shouldUpdateAddressData updateUser | p' == fromLocalProfile p = pure $ CRUserProfileNoChange user | otherwise = do when (n /= n') $ checkValidName n' + checkProfileImageSize img' -- read contacts before user update to correctly merge preferences contacts <- withFastStore' $ \db -> getUserContacts db vr user user' <- updateUser @@ -3709,9 +3721,10 @@ processChatCommand vr nm = \case lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct' pure $ CRContactPrefsUpdated user ct ct' runUpdateGroupProfile :: User -> GroupInfo -> GroupProfile -> CM ChatResponse - runUpdateGroupProfile user gInfo@GroupInfo {businessChat, groupProfile = p@GroupProfile {displayName = n}} p'@GroupProfile {displayName = n'} = do + runUpdateGroupProfile user gInfo@GroupInfo {businessChat, groupProfile = p@GroupProfile {displayName = n}} p'@GroupProfile {displayName = n', image = img'} = do assertUserGroupRole gInfo GROwner when (n /= n') $ checkValidName n' + checkProfileImageSize img' gInfo' <- withStore $ \db -> updateGroupProfile db user gInfo p' msg <- case businessChat of Just BusinessChatInfo {businessId} -> do @@ -3852,8 +3865,9 @@ processChatCommand vr nm = \case groupMemberId <- getGroupMemberIdByName db user groupId groupMemberName pure (groupId, groupMemberId) newGroup :: User -> IncognitoEnabled -> GroupProfile -> Bool -> MemberId -> Maybe GroupKeys -> Maybe Int64 -> CM GroupInfo - newGroup user incognito gProfile@GroupProfile {displayName} useRelays memberId groupKeys_ publicMemberCount_ = do + newGroup user incognito gProfile@GroupProfile {displayName, image} useRelays memberId groupKeys_ publicMemberCount_ = do checkValidName displayName + checkProfileImageSize image -- [incognito] generate incognito profile for group membership incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing withFastStore $ \db -> createNewGroup db vr user gProfile incognitoProfile useRelays memberId groupKeys_ publicMemberCount_