core: validate profile image size in chat commands

Enforced in CreateActiveUser, updateProfile_, newGroup, runUpdateGroupProfile
via checkProfileImageSize; max 12500 bytes (matches mobile UIs).

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}} =

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_