mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-29 13:34:20 +00:00
core: group snd status (#2763)
* core: group snd status * schema, implementation * refactor direct, tests * configure, tests * item info * refactor * refactor * remove do * rename * remove receipts on events * refactor * refactor * refactor * refactor * tests * rename tests * aggregates * fix name * refactor --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
spaced4ndy
@@ -203,6 +203,8 @@ data ChatCommand
|
||||
| SetAllContactReceipts Bool
|
||||
| APISetUserContactReceipts UserId UserMsgReceiptSettings
|
||||
| SetUserContactReceipts UserMsgReceiptSettings
|
||||
| APISetUserGroupReceipts UserId UserMsgReceiptSettings
|
||||
| SetUserGroupReceipts UserMsgReceiptSettings
|
||||
| APIHideUser UserId UserPwd
|
||||
| APIUnhideUser UserId UserPwd
|
||||
| APIMuteUser UserId
|
||||
|
||||
@@ -21,7 +21,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (isJust, isNothing)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
@@ -624,13 +624,15 @@ data CIFileInfo = CIFileInfo
|
||||
|
||||
data CIStatus (d :: MsgDirection) where
|
||||
CISSndNew :: CIStatus 'MDSnd
|
||||
CISSndSent :: CIStatus 'MDSnd
|
||||
CISSndRcvd :: MsgReceiptStatus -> CIStatus 'MDSnd
|
||||
CISSndSent :: SndCIStatusProgress -> CIStatus 'MDSnd
|
||||
CISSndRcvd :: MsgReceiptStatus -> SndCIStatusProgress -> CIStatus 'MDSnd
|
||||
CISSndErrorAuth :: CIStatus 'MDSnd
|
||||
CISSndError :: String -> CIStatus 'MDSnd
|
||||
CISRcvNew :: CIStatus 'MDRcv
|
||||
CISRcvRead :: CIStatus 'MDRcv
|
||||
|
||||
deriving instance Eq (CIStatus d)
|
||||
|
||||
deriving instance Show (CIStatus d)
|
||||
|
||||
instance ToJSON (CIStatus d) where
|
||||
@@ -639,6 +641,8 @@ instance ToJSON (CIStatus d) where
|
||||
|
||||
instance MsgDirectionI d => ToField (CIStatus d) where toField = toField . decodeLatin1 . strEncode
|
||||
|
||||
instance (Typeable d, MsgDirectionI d) => FromField (CIStatus d) where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
|
||||
|
||||
instance FromField ACIStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
|
||||
|
||||
data ACIStatus = forall d. MsgDirectionI d => ACIStatus (SMsgDirection d) (CIStatus d)
|
||||
@@ -648,8 +652,8 @@ deriving instance Show ACIStatus
|
||||
instance MsgDirectionI d => StrEncoding (CIStatus d) where
|
||||
strEncode = \case
|
||||
CISSndNew -> "snd_new"
|
||||
CISSndSent -> "snd_sent"
|
||||
CISSndRcvd status -> "snd_rcvd " <> strEncode status
|
||||
CISSndSent sndProgress -> "snd_sent " <> strEncode sndProgress
|
||||
CISSndRcvd msgRcptStatus sndProgress -> "snd_rcvd " <> strEncode msgRcptStatus <> " " <> strEncode sndProgress
|
||||
CISSndErrorAuth -> "snd_error_auth"
|
||||
CISSndError e -> "snd_error " <> encodeUtf8 (T.pack e)
|
||||
CISRcvNew -> "rcv_new"
|
||||
@@ -661,8 +665,8 @@ instance StrEncoding ACIStatus where
|
||||
strP =
|
||||
A.takeTill (== ' ') >>= \case
|
||||
"snd_new" -> pure $ ACIStatus SMDSnd CISSndNew
|
||||
"snd_sent" -> pure $ ACIStatus SMDSnd CISSndSent
|
||||
"snd_rcvd" -> ACIStatus SMDSnd . CISSndRcvd <$> (A.space *> strP)
|
||||
"snd_sent" -> ACIStatus SMDSnd . CISSndSent <$> ((A.space *> strP) <|> pure SSPComplete)
|
||||
"snd_rcvd" -> ACIStatus SMDSnd <$> (CISSndRcvd <$> (A.space *> strP) <*> ((A.space *> strP) <|> pure SSPComplete))
|
||||
"snd_error_auth" -> pure $ ACIStatus SMDSnd CISSndErrorAuth
|
||||
"snd_error" -> ACIStatus SMDSnd . CISSndError . T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString)
|
||||
"rcv_new" -> pure $ ACIStatus SMDRcv CISRcvNew
|
||||
@@ -671,8 +675,8 @@ instance StrEncoding ACIStatus where
|
||||
|
||||
data JSONCIStatus
|
||||
= JCISSndNew
|
||||
| JCISSndSent
|
||||
| JCISSndRcvd {msgRcptStatus :: MsgReceiptStatus}
|
||||
| JCISSndSent {sndProgress :: SndCIStatusProgress}
|
||||
| JCISSndRcvd {msgRcptStatus :: MsgReceiptStatus, sndProgress :: SndCIStatusProgress}
|
||||
| JCISSndErrorAuth
|
||||
| JCISSndError {agentError :: String}
|
||||
| JCISRcvNew
|
||||
@@ -686,8 +690,8 @@ instance ToJSON JSONCIStatus where
|
||||
jsonCIStatus :: CIStatus d -> JSONCIStatus
|
||||
jsonCIStatus = \case
|
||||
CISSndNew -> JCISSndNew
|
||||
CISSndSent -> JCISSndSent
|
||||
CISSndRcvd ok -> JCISSndRcvd ok
|
||||
CISSndSent sndProgress -> JCISSndSent sndProgress
|
||||
CISSndRcvd msgRcptStatus sndProgress -> JCISSndRcvd msgRcptStatus sndProgress
|
||||
CISSndErrorAuth -> JCISSndErrorAuth
|
||||
CISSndError e -> JCISSndError e
|
||||
CISRcvNew -> JCISRcvNew
|
||||
@@ -703,6 +707,40 @@ ciCreateStatus content = case msgDirection @d of
|
||||
SMDSnd -> ciStatusNew
|
||||
SMDRcv -> if ciRequiresAttention content then ciStatusNew else CISRcvRead
|
||||
|
||||
membersGroupItemStatus :: [(CIStatus 'MDSnd, Int)] -> CIStatus 'MDSnd
|
||||
membersGroupItemStatus memStatusCounts
|
||||
| rcvdOk == total = CISSndRcvd MROk SSPComplete
|
||||
| rcvdOk + rcvdBad == total = CISSndRcvd MRBadMsgHash SSPComplete
|
||||
| rcvdBad > 0 = CISSndRcvd MRBadMsgHash SSPPartial
|
||||
| rcvdOk > 0 = CISSndRcvd MROk SSPPartial
|
||||
| sent == total = CISSndSent SSPComplete
|
||||
| sent > 0 = CISSndSent SSPPartial
|
||||
| otherwise = CISSndNew
|
||||
where
|
||||
total = sum $ map snd memStatusCounts
|
||||
rcvdOk = fromMaybe 0 $ lookup (CISSndRcvd MROk SSPComplete) memStatusCounts
|
||||
rcvdBad = fromMaybe 0 $ lookup (CISSndRcvd MRBadMsgHash SSPComplete) memStatusCounts
|
||||
sent = fromMaybe 0 $ lookup (CISSndSent SSPComplete) memStatusCounts
|
||||
|
||||
data SndCIStatusProgress
|
||||
= SSPPartial
|
||||
| SSPComplete
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON SndCIStatusProgress where
|
||||
toJSON = J.genericToJSON . enumJSON $ dropPrefix "SSP"
|
||||
toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "SSP"
|
||||
|
||||
instance StrEncoding SndCIStatusProgress where
|
||||
strEncode = \case
|
||||
SSPPartial -> "partial"
|
||||
SSPComplete -> "complete"
|
||||
strP =
|
||||
A.takeWhile1 (/= ' ') >>= \case
|
||||
"partial" -> pure SSPPartial
|
||||
"complete" -> pure SSPComplete
|
||||
_ -> fail "bad SndCIStatusProgress"
|
||||
|
||||
type ChatItemId = Int64
|
||||
|
||||
type ChatItemTs = UTCTime
|
||||
@@ -887,7 +925,8 @@ itemDeletedTs = \case
|
||||
CIModerated ts _ -> ts
|
||||
|
||||
data ChatItemInfo = ChatItemInfo
|
||||
{ itemVersions :: [ChatItemVersion]
|
||||
{ itemVersions :: [ChatItemVersion],
|
||||
memberDeliveryStatuses :: Maybe [MemberDeliveryStatus]
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
@@ -917,6 +956,14 @@ mkItemVersion ChatItem {content, meta} = version <$> ciMsgContent content
|
||||
createdAt = createdAt
|
||||
}
|
||||
|
||||
data MemberDeliveryStatus = MemberDeliveryStatus
|
||||
{ groupMemberId :: GroupMemberId,
|
||||
memberDeliveryStatus :: CIStatus 'MDSnd
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON MemberDeliveryStatus where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data CIModeration = CIModeration
|
||||
{ moderationId :: Int64,
|
||||
moderatorMember :: GroupMember,
|
||||
|
||||
@@ -0,0 +1,33 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230721_group_snd_item_statuses where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20230721_group_snd_item_statuses :: Query
|
||||
m20230721_group_snd_item_statuses =
|
||||
[sql|
|
||||
CREATE TABLE group_snd_item_statuses (
|
||||
group_snd_item_status_id INTEGER PRIMARY KEY,
|
||||
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||
group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
|
||||
group_snd_item_status TEXT NOT NULL,
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
|
||||
CREATE INDEX idx_group_snd_item_statuses_chat_item_id ON group_snd_item_statuses(chat_item_id);
|
||||
CREATE INDEX idx_group_snd_item_statuses_group_member_id ON group_snd_item_statuses(group_member_id);
|
||||
|
||||
UPDATE users SET send_rcpts_small_groups = 1 WHERE send_rcpts_contacts = 1;
|
||||
|]
|
||||
|
||||
down_m20230721_group_snd_item_statuses :: Query
|
||||
down_m20230721_group_snd_item_statuses =
|
||||
[sql|
|
||||
DROP INDEX idx_group_snd_item_statuses_group_member_id;
|
||||
DROP INDEX idx_group_snd_item_statuses_chat_item_id;
|
||||
|
||||
DROP TABLE group_snd_item_statuses;
|
||||
|]
|
||||
@@ -496,6 +496,14 @@ CREATE TABLE chat_item_moderations(
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE TABLE group_snd_item_statuses(
|
||||
group_snd_item_status_id INTEGER PRIMARY KEY,
|
||||
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||
group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
|
||||
group_snd_item_status TEXT NOT NULL,
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE INDEX contact_profiles_index ON contact_profiles(
|
||||
display_name,
|
||||
full_name
|
||||
@@ -687,3 +695,9 @@ CREATE INDEX idx_chat_item_moderations_group ON chat_item_moderations(
|
||||
item_member_id,
|
||||
shared_msg_id
|
||||
);
|
||||
CREATE INDEX idx_group_snd_item_statuses_chat_item_id ON group_snd_item_statuses(
|
||||
chat_item_id
|
||||
);
|
||||
CREATE INDEX idx_group_snd_item_statuses_group_member_id ON group_snd_item_statuses(
|
||||
group_member_id
|
||||
);
|
||||
|
||||
@@ -39,6 +39,7 @@ module Simplex.Chat.Store.Groups
|
||||
getGroupMemberById,
|
||||
getGroupMembers,
|
||||
getGroupMembersForExpiration,
|
||||
getGroupCurrentMembersCount,
|
||||
deleteGroupConnectionsAndFiles,
|
||||
deleteGroupItemsAndMembers,
|
||||
deleteGroup,
|
||||
@@ -548,6 +549,20 @@ toContactMember :: User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
|
||||
toContactMember User {userContactId} (memberRow :. connRow) =
|
||||
(toGroupMember userContactId memberRow) {activeConn = toMaybeConnection connRow}
|
||||
|
||||
getGroupCurrentMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int
|
||||
getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do
|
||||
statuses :: [GroupMemberStatus] <-
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT member_status
|
||||
FROM group_members
|
||||
WHERE group_id = ? AND user_id = ?
|
||||
|]
|
||||
(groupId, userId)
|
||||
pure $ length $ filter memberCurrent' statuses
|
||||
|
||||
getGroupInvitation :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
|
||||
getGroupInvitation db user groupId =
|
||||
getConnRec_ user >>= \case
|
||||
|
||||
@@ -44,6 +44,7 @@ module Simplex.Chat.Store.Messages
|
||||
createChatItemVersion,
|
||||
deleteDirectChatItem,
|
||||
markDirectChatItemDeleted,
|
||||
updateGroupChatItemStatus,
|
||||
updateGroupChatItem,
|
||||
deleteGroupChatItem,
|
||||
updateGroupChatItemModerated,
|
||||
@@ -69,6 +70,7 @@ module Simplex.Chat.Store.Messages
|
||||
getGroupChatItem,
|
||||
getGroupChatItemBySharedMsgId,
|
||||
getGroupMemberCIBySharedMsgId,
|
||||
getGroupChatItemByAgentMsgId,
|
||||
getGroupMemberChatItemLast,
|
||||
getDirectChatItemIdByText,
|
||||
getDirectChatItemIdByText',
|
||||
@@ -87,6 +89,11 @@ module Simplex.Chat.Store.Messages
|
||||
createCIModeration,
|
||||
getCIModeration,
|
||||
deleteCIModeration,
|
||||
createGroupSndStatus,
|
||||
getGroupSndStatus,
|
||||
updateGroupSndStatus,
|
||||
getGroupSndStatuses,
|
||||
getGroupSndStatusCounts,
|
||||
)
|
||||
where
|
||||
|
||||
@@ -1325,6 +1332,16 @@ getDirectChatItemIdByText' db User {userId} contactId msg =
|
||||
|]
|
||||
(userId, contactId, msg <> "%")
|
||||
|
||||
updateGroupChatItemStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> GroupId -> ChatItemId -> CIStatus d -> ExceptT StoreError IO (ChatItem 'CTGroup d)
|
||||
updateGroupChatItemStatus db user@User {userId} groupId itemId itemStatus = do
|
||||
ci <- liftEither . correctDir =<< getGroupChatItem db user groupId itemId
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO $ DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?" (itemStatus, currentTs, userId, groupId, itemId)
|
||||
pure ci {meta = (meta ci) {itemStatus}}
|
||||
where
|
||||
correctDir :: CChatItem c -> Either StoreError (ChatItem c d)
|
||||
correctDir (CChatItem _ ci) = first SEInternalError $ checkDirection ci
|
||||
|
||||
updateGroupChatItem :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> ChatItem 'CTGroup d -> CIContent d -> Bool -> Maybe MessageId -> IO (ChatItem 'CTGroup d)
|
||||
updateGroupChatItem db user groupId ci newContent live msgId_ = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
@@ -1434,6 +1451,11 @@ getGroupMemberCIBySharedMsgId db user@User {userId} groupId memberId sharedMsgId
|
||||
(GCUserMember, userId, groupId, memberId, sharedMsgId)
|
||||
getGroupChatItem db user groupId itemId
|
||||
|
||||
getGroupChatItemByAgentMsgId :: DB.Connection -> User -> GroupId -> Int64 -> AgentMsgId -> IO (Maybe (CChatItem 'CTGroup))
|
||||
getGroupChatItemByAgentMsgId db user groupId connId msgId = do
|
||||
itemId_ <- getChatItemIdByAgentMsgId db connId msgId
|
||||
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupChatItem db user groupId) itemId_
|
||||
|
||||
getGroupChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTGroup)
|
||||
getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
currentTs <- getCurrentTime
|
||||
@@ -1847,3 +1869,58 @@ deleteCIModeration db GroupInfo {groupId} itemMemberId (Just sharedMsgId) =
|
||||
db
|
||||
"DELETE FROM chat_item_moderations WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?"
|
||||
(groupId, itemMemberId, sharedMsgId)
|
||||
|
||||
createGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> IO ()
|
||||
createGroupSndStatus db itemId memberId status =
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO group_snd_item_statuses (chat_item_id, group_member_id, group_snd_item_status) VALUES (?,?,?)"
|
||||
(itemId, memberId, status)
|
||||
|
||||
getGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> ExceptT StoreError IO (CIStatus 'MDSnd)
|
||||
getGroupSndStatus db itemId memberId =
|
||||
ExceptT . firstRow fromOnly (SENoGroupSndStatus itemId memberId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT group_snd_item_status
|
||||
FROM group_snd_item_statuses
|
||||
WHERE chat_item_id = ? AND group_member_id = ?
|
||||
LIMIT 1
|
||||
|]
|
||||
(itemId, memberId)
|
||||
|
||||
updateGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> IO ()
|
||||
updateGroupSndStatus db itemId memberId status = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE group_snd_item_statuses
|
||||
SET group_snd_item_status = ?, updated_at = ?
|
||||
WHERE chat_item_id = ? AND group_member_id = ?
|
||||
|]
|
||||
(status, currentTs, itemId, memberId)
|
||||
|
||||
getGroupSndStatuses :: DB.Connection -> ChatItemId -> IO [(GroupMemberId, CIStatus 'MDSnd)]
|
||||
getGroupSndStatuses db itemId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT group_member_id, group_snd_item_status
|
||||
FROM group_snd_item_statuses
|
||||
WHERE chat_item_id = ?
|
||||
|]
|
||||
(Only itemId)
|
||||
|
||||
getGroupSndStatusCounts :: DB.Connection -> ChatItemId -> IO [(CIStatus 'MDSnd, Int)]
|
||||
getGroupSndStatusCounts db itemId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT group_snd_item_status, COUNT(1)
|
||||
FROM group_snd_item_statuses
|
||||
WHERE chat_item_id = ?
|
||||
GROUP BY group_snd_item_status
|
||||
|]
|
||||
(Only itemId)
|
||||
|
||||
@@ -74,6 +74,7 @@ import Simplex.Chat.Migrations.M20230608_deleted_contacts
|
||||
import Simplex.Chat.Migrations.M20230618_favorite_chats
|
||||
import Simplex.Chat.Migrations.M20230621_chat_item_moderations
|
||||
import Simplex.Chat.Migrations.M20230705_delivery_receipts
|
||||
import Simplex.Chat.Migrations.M20230721_group_snd_item_statuses
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -147,7 +148,8 @@ schemaMigrations =
|
||||
("20230608_deleted_contacts", m20230608_deleted_contacts, Just down_m20230608_deleted_contacts),
|
||||
("20230618_favorite_chats", m20230618_favorite_chats, Just down_m20230618_favorite_chats),
|
||||
("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations),
|
||||
("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts)
|
||||
("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts),
|
||||
("20230721_group_snd_item_statuses", m20230721_group_snd_item_statuses, Just down_m20230721_group_snd_item_statuses)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -30,6 +30,7 @@ module Simplex.Chat.Store.Profiles
|
||||
updateUserPrivacy,
|
||||
updateAllContactReceipts,
|
||||
updateUserContactReceipts,
|
||||
updateUserGroupReceipts,
|
||||
updateUserProfile,
|
||||
setUserProfileContactLink,
|
||||
getUserContactProfiles,
|
||||
@@ -92,7 +93,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
|
||||
when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
|
||||
let showNtfs = True
|
||||
sendRcptsContacts = True
|
||||
sendRcptsSmallGroups = False
|
||||
sendRcptsSmallGroups = True
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,0,?,?,?,?,?)"
|
||||
@@ -222,13 +223,21 @@ updateUserPrivacy db User {userId, showNtfs, viewPwdHash} =
|
||||
|
||||
updateAllContactReceipts :: DB.Connection -> Bool -> IO ()
|
||||
updateAllContactReceipts db onOff =
|
||||
DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE view_pwd_hash IS NULL" (Only onOff)
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE users SET send_rcpts_contacts = ?, send_rcpts_small_groups = ? WHERE view_pwd_hash IS NULL"
|
||||
(onOff, onOff)
|
||||
|
||||
updateUserContactReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
|
||||
updateUserContactReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
|
||||
DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE user_id = ?" (enable, userId)
|
||||
when clearOverrides $ DB.execute_ db "UPDATE contacts SET send_rcpts = NULL"
|
||||
|
||||
updateUserGroupReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
|
||||
updateUserGroupReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
|
||||
DB.execute db "UPDATE users SET send_rcpts_small_groups = ? WHERE user_id = ?" (enable, userId)
|
||||
when clearOverrides $ DB.execute_ db "UPDATE groups SET send_rcpts = NULL"
|
||||
|
||||
updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User
|
||||
updateUserProfile db user p'
|
||||
| displayName == newName = do
|
||||
|
||||
@@ -92,6 +92,7 @@ data StoreError
|
||||
| SEGroupLinkNotFound {groupInfo :: GroupInfo}
|
||||
| SEHostMemberIdNotFound {groupId :: Int64}
|
||||
| SEContactNotFoundByFileId {fileId :: FileTransferId}
|
||||
| SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
|
||||
deriving (Show, Exception, Generic)
|
||||
|
||||
instance ToJSON StoreError where
|
||||
|
||||
@@ -782,7 +782,10 @@ memberActive m = case memberStatus m of
|
||||
GSMemCreator -> True
|
||||
|
||||
memberCurrent :: GroupMember -> Bool
|
||||
memberCurrent m = case memberStatus m of
|
||||
memberCurrent = memberCurrent' . memberStatus
|
||||
|
||||
memberCurrent' :: GroupMemberStatus -> Bool
|
||||
memberCurrent' = \case
|
||||
GSMemRemoved -> False
|
||||
GSMemLeft -> False
|
||||
GSMemGroupDeleted -> False
|
||||
|
||||
@@ -465,12 +465,21 @@ localTs tz ts = do
|
||||
viewChatItemStatusUpdated :: AChatItem -> CurrentTime -> TimeZone -> Bool -> Bool -> [StyledString]
|
||||
viewChatItemStatusUpdated (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) ts tz testView showReceipts =
|
||||
case itemStatus of
|
||||
CISSndRcvd rcptStatus ->
|
||||
CISSndRcvd rcptStatus SSPPartial ->
|
||||
if testView && showReceipts
|
||||
then prependFirst (viewDeliveryReceiptPartial rcptStatus <> " ") $ viewChatItem chat item False ts tz
|
||||
else []
|
||||
CISSndRcvd rcptStatus SSPComplete ->
|
||||
if testView && showReceipts
|
||||
then prependFirst (viewDeliveryReceipt rcptStatus <> " ") $ viewChatItem chat item False ts tz
|
||||
else []
|
||||
_ -> []
|
||||
|
||||
viewDeliveryReceiptPartial :: MsgReceiptStatus -> StyledString
|
||||
viewDeliveryReceiptPartial = \case
|
||||
MROk -> "%"
|
||||
MRBadMsgHash -> ttyError' "%!"
|
||||
|
||||
viewDeliveryReceipt :: MsgReceiptStatus -> StyledString
|
||||
viewDeliveryReceipt = \case
|
||||
MROk -> "⩗"
|
||||
|
||||
Reference in New Issue
Block a user