terminal: set voice message preferences (#1447)

* terminal: set voice message preferences

* enable all tests

src/Simplex/Chat.hs

@@ -992,20 +992,8 @@ processChatCommand = \case
     processChatCommand $ APIListMembers groupId
   ListGroups -> CRGroupsList <$> withUser (\user -> withStore' (`getUserGroupDetails` user))
   APIUpdateGroupProfile groupId p' -> withUser $ \user -> do
-    Group g@GroupInfo {groupProfile = p} ms <- withStore $ \db -> getGroup db user groupId
-    let s = memberStatus $ membership g
-        canUpdate =
-          memberRole (membership g :: GroupMember) == GROwner
-            || (s == GSMemRemoved || s == GSMemLeft || s == GSMemGroupDeleted || s == GSMemInvited)
-    unless canUpdate $ throwChatError CEGroupUserRole
-    g' <- withStore $ \db -> updateGroupProfile db user g p'
-    msg <- sendGroupMessage g' ms (XGrpInfo p')
-    let cd = CDGroupSnd g'
-    unless (sameGroupProfileInfo p p') $ do
-      ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') Nothing Nothing
-      toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat g') ci
-    createGroupFeatureChangedItems user cd CISndGroupFeature p p'
-    pure $ CRGroupUpdated g g' Nothing
+    g <- withStore $ \db -> getGroup db user groupId
+    runUpdateGroupProfile user g p'
   UpdateGroupProfile gName profile -> withUser $ \user -> do
     groupId <- withStore $ \db -> getGroupIdByName db user gName
     processChatCommand $ APIUpdateGroupProfile groupId profile
@@ -1096,6 +1084,17 @@ processChatCommand = \case
   UpdateProfileImage image -> withUser $ \user@User {profile} -> do
     let p = (fromLocalProfile profile :: Profile) {image}
     updateProfile user p
+  SetUserFeature f allowed -> withUser $ \user@User {profile} -> do
+    let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user}
+    updateProfile user p
+  SetContactFeature f cName allowed_ -> withUser $ \user -> do
+    ct@Contact {userPreferences} <- withStore $ \db -> getContactByName db user cName
+    let prefs' = setPreference f allowed_ $ Just userPreferences
+    updateContactPrefs user ct prefs'
+  SetGroupFeature f gName enabled -> withUser $ \user -> do
+    g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db -> getGroup db user =<< getGroupIdByName db user gName
+    let p' = p {groupPreferences = Just . setGroupPreference f enabled $ groupPreferences p}
+    runUpdateGroupProfile user g p'
   QuitChat -> liftIO exitSuccess
   ShowVersion -> pure $ CRVersionInfo versionNumber
   DebugLocks -> do
@@ -1202,6 +1201,21 @@ processChatCommand = \case
           void (sendDirectContactMessage ct' $ XInfo p') `catchError` (toView . CRChatError)
           when (directContact ct) $ createFeatureChangedItems user ct ct' CDDirectSnd CISndChatFeature
           pure $ CRContactPrefsUpdated ct ct'
+    runUpdateGroupProfile :: User -> Group -> GroupProfile -> m ChatResponse
+    runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p} ms) p' = do
+      let s = memberStatus $ membership g
+          canUpdate =
+            memberRole (membership g :: GroupMember) == GROwner
+              || (s == GSMemRemoved || s == GSMemLeft || s == GSMemGroupDeleted || s == GSMemInvited)
+      unless canUpdate $ throwChatError CEGroupUserRole
+      g' <- withStore $ \db -> updateGroupProfile db user g p'
+      msg <- sendGroupMessage g' ms (XGrpInfo p')
+      let cd = CDGroupSnd g'
+      unless (sameGroupProfileInfo p p') $ do
+        ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') Nothing Nothing
+        toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat g') ci
+      createGroupFeatureChangedItems user cd CISndGroupFeature p p'
+      pure $ CRGroupUpdated g g' Nothing
     isReady :: Contact -> Bool
     isReady ct =
       let s = connStatus $ activeConn (ct :: Contact)
@@ -2412,7 +2426,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
 
     receiveInlineChunk :: RcvFileTransfer -> FileChunk -> MsgMeta -> m ()
     receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _
-      | chunkNo == 1 = throwChatError $ CEFileLargeSentInline fileId
+      | chunkNo == 1 = throwChatError $ CEInlineFileProhibited fileId
       | otherwise = pure ()
     receiveInlineChunk ft chunk meta = do
       case chunk of
@@ -3384,6 +3398,9 @@ chatCommandP =
       "/profile_image" $> UpdateProfileImage Nothing,
       ("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> userNames),
       ("/profile" <|> "/p") $> ShowProfile,
+      "/voice #" *> (SetGroupFeature CFVoice <$> displayName <*> (A.space *> strP)),
+      "/voice @" *> (SetContactFeature CFVoice <$> displayName <*> optional (A.space *> strP)),
+      "/voice " *> (SetUserFeature CFVoice <$> strP),
       "/incognito " *> (SetIncognito <$> onOffP),
       ("/quit" <|> "/q" <|> "/exit") $> QuitChat,
       ("/version" <|> "/v") $> ShowVersion,

src/Simplex/Chat/Controller.hs

@@ -250,6 +250,9 @@ data ChatCommand
   | ShowProfile
   | UpdateProfile ContactName Text
   | UpdateProfileImage (Maybe ImageData)
+  | SetUserFeature ChatFeature FeatureAllowed
+  | SetContactFeature ChatFeature ContactName (Maybe FeatureAllowed)
+  | SetGroupFeature ChatFeature GroupName GroupFeatureEnabled
   | QuitChat
   | ShowVersion
   | DebugLocks
@@ -536,7 +539,7 @@ data ChatErrorType
   | CEFileImageType {filePath :: FilePath}
   | CEFileImageSize {filePath :: FilePath}
   | CEFileNotReceived {fileId :: FileTransferId}
-  | CEFileLargeSentInline {fileId :: FileTransferId}
+  | CEInlineFileProhibited {fileId :: FileTransferId}
   | CEInvalidQuote
   | CEInvalidChatItemUpdate
   | CEInvalidChatItemDelete

src/Simplex/Chat/Types.hs

@@ -303,6 +303,14 @@ instance PreferenceI FullPreferences where
     CFVoice -> voice
   {-# INLINE getPreference #-}
 
+setPreference :: ChatFeature -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
+setPreference f allow_ prefs_ =
+  let prefs = toChatPrefs $ mergePreferences Nothing prefs_
+      pref = (\allow -> (getPreference f prefs :: Preference) {allow}) <$> allow_
+   in case f of
+        CFVoice -> prefs {voice = pref}
+        CFFullDelete -> prefs {fullDelete = pref}
+
 -- collection of optional chat preferences for the user and the contact
 data Preferences = Preferences
   { fullDelete :: Maybe Preference,
@@ -361,6 +369,14 @@ instance ToField GroupPreferences where
 instance FromField GroupPreferences where
   fromField = fromTextField_ decodeJSON
 
+setGroupPreference :: ChatFeature -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
+setGroupPreference f enable prefs_ =
+  let prefs = mergeGroupPreferences prefs_
+      pref = (getGroupPreference f prefs :: GroupPreference) {enable}
+   in toGroupPreferences $ case f of
+        CFVoice -> prefs {voice = pref}
+        CFFullDelete -> prefs {fullDelete = pref}
+
 -- full collection of chat preferences defined in the app - it is used to ensure we include all preferences and to simplify processing
 -- if some of the preferences are not defined in Preferences, defaults from defaultChatPrefs are used here.
 data FullPreferences = FullPreferences
@@ -534,6 +550,16 @@ mergeGroupPreferences groupPreferences =
   where
     pref pt = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPreferences >>= groupPrefSel pt)
 
+toGroupPreferences :: FullGroupPreferences -> GroupPreferences
+toGroupPreferences groupPreferences =
+  GroupPreferences
+    { fullDelete = pref CFFullDelete,
+      -- receipts = pref CFReceipts,
+      voice = pref CFVoice
+    }
+  where
+    pref f = Just $ getGroupPreference f groupPreferences
+
 data PrefEnabled = PrefEnabled {forUser :: Bool, forContact :: Bool}
   deriving (Eq, Show, Generic, FromJSON)
 

src/Simplex/Chat/View.hs

@@ -1083,7 +1083,7 @@ viewChatError = \case
     CEFileImageType _ -> ["image type must be jpg, send as a file using " <> highlight' "/f"]
     CEFileImageSize _ -> ["max image size: " <> sShow maxImageSize <> " bytes, resize it or send as a file using " <> highlight' "/f"]
     CEFileNotReceived fileId -> ["file " <> sShow fileId <> " not received"]
-    CEFileLargeSentInline _ -> ["A small file sent without acceptance - you can enable receiving such files automatically with -f option."]
+    CEInlineFileProhibited _ -> ["A small file sent without acceptance - you can enable receiving such files with -f option."]
     CEInvalidQuote -> ["cannot reply to this message"]
     CEInvalidChatItemUpdate -> ["cannot update this item"]
     CEInvalidChatItemDelete -> ["cannot delete this item"]