prohibit direct messages to group contacts unless group preferences allow them (#1476)

* prohibit direct messages to group contacts unless group preferences allow them

* tests

* refactor

* more test

src/Simplex/Chat/Controller.hs

@@ -547,6 +547,7 @@ data ChatErrorType
   | CENoCurrentCall
   | CECallContact {contactId :: Int64}
   | CECallState {currentCallState :: CallStateTag}
+  | CEDirectMessagesProhibited {direction :: MsgDirection, contact :: Contact}
   | CEAgentVersion
   | CEAgentNoSubResult {agentConnId :: AgentConnId}
   | CECommandError {message :: String}

src/Simplex/Chat/Store.hs

@@ -91,6 +91,7 @@ module Simplex.Chat.Store
     deleteGroup,
     getUserGroups,
     getUserGroupDetails,
+    getContactGroupPreferences,
     getGroupInvitation,
     createNewContactMember,
     createNewContactMemberAsync,
@@ -1817,6 +1818,20 @@ getUserGroupDetails db User {userId, userContactId} =
       |]
       (userId, userContactId)
 
+getContactGroupPreferences :: DB.Connection -> User -> Contact -> IO [FullGroupPreferences]
+getContactGroupPreferences db User {userId} Contact {contactId} = do
+  map (mergeGroupPreferences . fromOnly)
+    <$> DB.query
+      db
+      [sql|
+        SELECT gp.preferences
+        FROM groups g
+        JOIN group_profiles gp USING (group_profile_id)
+        JOIN group_members m USING (group_id)
+        WHERE g.user_id = ? AND m.contact_id = ?
+      |]
+      (userId, contactId)
+
 getGroupInfoByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupInfo
 getGroupInfoByName db user gName = do
   gId <- getGroupIdByName db user gName

src/Simplex/Chat/Types.hs

@@ -123,6 +123,9 @@ directContact :: Contact -> Bool
 directContact Contact {contactUsed, activeConn = Connection {connLevel, viaGroupLink}} =
   (connLevel == 0 && not viaGroupLink) || contactUsed
 
+anyDirectContact :: Contact -> Bool
+anyDirectContact Contact {contactUsed, activeConn = Connection {connLevel}} = connLevel == 0 || contactUsed
+
 data ContactRef = ContactRef
   { contactId :: ContactId,
     localDisplayName :: ContactName
@@ -342,8 +345,11 @@ groupFeatureToText = \case
   GFVoice -> "Voice messages"
 
 groupFeatureAllowed :: GroupFeature -> GroupInfo -> Bool
-groupFeatureAllowed feature GroupInfo {fullGroupPreferences} =
-  let GroupPreference {enable} = getGroupPreference feature fullGroupPreferences
+groupFeatureAllowed feature gInfo = groupFeatureAllowed' feature $ fullGroupPreferences gInfo
+
+groupFeatureAllowed' :: GroupFeature -> FullGroupPreferences -> Bool
+groupFeatureAllowed' feature prefs =
+  let GroupPreference {enable} = getGroupPreference feature prefs
    in enable == FEOn
 
 instance ToJSON GroupFeature where
@@ -490,6 +496,9 @@ defaultGroupPrefs =
       voice = GroupPreference {enable = FEOn}
     }
 
+emptyGroupPrefs :: GroupPreferences
+emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing
+
 data Preference = Preference
   {allow :: FeatureAllowed}
   deriving (Eq, Show, Generic, FromJSON)

src/Simplex/Chat/View.hs

@@ -496,6 +496,10 @@ viewCannotResendInvitation GroupInfo {localDisplayName = gn} c =
     "to re-send invitation: " <> highlight ("/rm " <> gn <> " " <> c) <> ", " <> highlight ("/a " <> gn <> " " <> c)
   ]
 
+viewDirectMessagesProhibited :: MsgDirection -> Contact -> [StyledString]
+viewDirectMessagesProhibited MDSnd c = [ "direct messages to indirect contact " <> ttyContact' c <> " are prohibited"]
+viewDirectMessagesProhibited MDRcv c = [ "received prohibited direct message from indirect contact " <> ttyContact' c <> " (discarded)"]
+
 viewUserJoinedGroup :: GroupInfo -> [StyledString]
 viewUserJoinedGroup g@GroupInfo {membership = membership@GroupMember {memberProfile}} =
   if memberIncognito membership
@@ -1098,6 +1102,7 @@ viewChatError = \case
     CENoCurrentCall -> ["no call in progress"]
     CECallContact _ -> []
     CECallState _ -> []
+    CEDirectMessagesProhibited dir ct -> viewDirectMessagesProhibited dir ct
     CEAgentVersion -> ["unsupported agent version"]
     CEAgentNoSubResult connId -> ["no subscription result for connection: " <> sShow connId]
     CECommandError e -> ["bad chat command: " <> plain e]