cli: add --user-image-file option

Sets the active user's profile image from a .png/.jpg/.jpeg file at
startup. Reads file, base64-encodes as data URL, and updates the user
profile directly in the DB - no notification is sent to existing
contacts. Skips the update if the stored image already matches.

Requires --user-display-name.

src/Simplex/Chat/Core.hs

@@ -17,13 +17,18 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as B
+import Data.Char (toLower)
 import Data.List (find)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
+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
@@ -44,7 +49,7 @@ import Text.Read (readMaybe)
 import UnliftIO.Async
 
 simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
-simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@ChatOpts {coreOptions = coreOptions@CoreChatOpts {dbOptions, logAgent, yesToUpMigrations, migrationBackupPath, maintenance}, createBot, userDisplayName} chat =
+simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@ChatOpts {coreOptions = coreOptions@CoreChatOpts {dbOptions, logAgent, yesToUpMigrations, migrationBackupPath, maintenance}, createBot, userDisplayName, userImageFile} chat =
   case logAgent of
     Just level -> do
       setLogLevel level
@@ -66,7 +71,8 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@Cha
       let backgroundMode = maintenance
       cc <- newChatController db u_ cfg opts backgroundMode
       forM_ (preStartHook chatHooks) ($ cc)
-      u <- maybe (noMaintenance >> createActiveUser cc coreOptions createBot userDisplayName) pure u_
+      u0 <- maybe (noMaintenance >> createActiveUser cc coreOptions createBot userDisplayName) pure u_
+      u <- maybe (pure u0) (applyUserImage cc chatStore u0) userImageFile
       unless testView $ putStrLn $ "Current user: " <> userStr u
       runSimplexChat cfg opts u cc chat
     noMaintenance = when maintenance $ do
@@ -197,6 +203,30 @@ 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 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)"
+  where
+    readAs mime = do
+      bs <- BS.readFile path
+      pure $ Right $ ImageData $ "data:" <> mime <> ";base64," <> decodeUtf8 (B64.encode bs)
+
 userStr :: User -> String
 userStr User {localDisplayName, profile = LocalProfile {fullName}} =
   T.unpack $ localDisplayName <> if T.null fullName || localDisplayName == fullName then "" else " (" <> fullName <> ")"

src/Simplex/Chat/Mobile.hs

@@ -272,7 +272,8 @@ mobileChatOpts dbOptions =
       muteNotifications = True,
       markRead = False,
       createBot = Nothing,
-      userDisplayName = Nothing
+      userDisplayName = Nothing,
+      userImageFile = Nothing
     }
 
 defaultMobileConfig :: ChatConfig

src/Simplex/Chat/Options.hs

@@ -22,7 +22,7 @@ where
 import Control.Logger.Simple (LogLevel (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
@@ -51,7 +51,8 @@ data ChatOpts = ChatOpts
     muteNotifications :: Bool,
     markRead :: Bool,
     createBot :: Maybe CreateBotOpts,
-    userDisplayName :: Maybe Text
+    userDisplayName :: Maybe Text,
+    userImageFile :: Maybe FilePath
   }
 
 data CoreChatOpts = CoreChatOpts
@@ -410,6 +411,13 @@ chatOptsP appDir defaultDbName = do
             <> metavar "NAME"
             <> help "Use existing active user with this display name, or create one on the first start (incompatible with --create-bot-display-name)"
         )
+  userImageFile <-
+    optional $
+      strOption
+        ( long "user-image-file"
+            <> metavar "FILE"
+            <> help "Set user profile image from .png/.jpg file (requires --user-display-name); does not notify existing contacts"
+        )
   pure
     ChatOpts
       { coreOptions,
@@ -431,7 +439,10 @@ chatOptsP appDir defaultDbName = do
           Nothing
             | createBotAllowFiles -> error "--create-bot-allow-files option requires --create-bot-name option"
             | otherwise -> Nothing,
-        userDisplayName
+        userDisplayName,
+        userImageFile = case userImageFile of
+          Just _ | isNothing userDisplayName -> error "--user-image-file option requires --user-display-name option"
+          _ -> userImageFile
       }
 
 parseProtocolServers :: ProtocolTypeI p => ReadM [ProtoServerWithAuth p]