Merge branch 'master' into remote-desktop
This commit is contained in:
commit
970ca3a409
@ -15,7 +15,6 @@
|
|||||||
<uses-permission android:name="android.permission.RECEIVE_BOOT_COMPLETED" />
|
<uses-permission android:name="android.permission.RECEIVE_BOOT_COMPLETED" />
|
||||||
<uses-permission android:name="android.permission.VIBRATE" />
|
<uses-permission android:name="android.permission.VIBRATE" />
|
||||||
<uses-permission android:name="android.permission.INTERNET" />
|
<uses-permission android:name="android.permission.INTERNET" />
|
||||||
<uses-permission android:name="android.permission.ACCESS_WIFI_STATE" />
|
|
||||||
<uses-permission android:name="android.permission.ACCESS_NETWORK_STATE" />
|
<uses-permission android:name="android.permission.ACCESS_NETWORK_STATE" />
|
||||||
<uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE"
|
<uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE"
|
||||||
tools:ignore="ScopedStorage" />
|
tools:ignore="ScopedStorage" />
|
||||||
|
@ -5646,20 +5646,20 @@ saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content =
|
|||||||
saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False
|
saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False
|
||||||
|
|
||||||
saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDRcv)
|
saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDRcv)
|
||||||
saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content ciFile itemTimed live = do
|
saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerTs content ciFile itemTimed live = do
|
||||||
createdAt <- liftIO getCurrentTime
|
createdAt <- liftIO getCurrentTime
|
||||||
(ciId, quotedItem) <- withStore' $ \db -> do
|
(ciId, quotedItem) <- withStore' $ \db -> do
|
||||||
when (ciRequiresAttention content) $ updateChatTs db user cd createdAt
|
when (ciRequiresAttention content) $ updateChatTs db user cd createdAt
|
||||||
(ciId, quotedItem) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt
|
(ciId, quotedItem) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt
|
||||||
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
|
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
|
||||||
pure (ciId, quotedItem)
|
pure (ciId, quotedItem)
|
||||||
liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed live brokerTs msg.forwardedByGroupMemberId createdAt
|
liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed live brokerTs forwardedByMember createdAt
|
||||||
|
|
||||||
mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> IO (ChatItem c d)
|
mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> IO (ChatItem c d)
|
||||||
mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs forwardedByGroupMemberId currentTs = do
|
mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs forwardedByMember currentTs = do
|
||||||
let itemText = ciContentToText content
|
let itemText = ciContentToText content
|
||||||
itemStatus = ciCreateStatus content
|
itemStatus = ciCreateStatus content
|
||||||
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs forwardedByGroupMemberId currentTs currentTs
|
meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs forwardedByMember currentTs currentTs
|
||||||
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file}
|
pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file}
|
||||||
|
|
||||||
deleteDirectCI :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> Bool -> Bool -> m ChatResponse
|
deleteDirectCI :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> Bool -> Bool -> m ChatResponse
|
||||||
|
@ -318,18 +318,18 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta
|
|||||||
itemTimed :: Maybe CITimed,
|
itemTimed :: Maybe CITimed,
|
||||||
itemLive :: Maybe Bool,
|
itemLive :: Maybe Bool,
|
||||||
editable :: Bool,
|
editable :: Bool,
|
||||||
forwardedByGroupMemberId :: Maybe GroupMemberId,
|
forwardedByMember :: Maybe GroupMemberId,
|
||||||
createdAt :: UTCTime,
|
createdAt :: UTCTime,
|
||||||
updatedAt :: UTCTime
|
updatedAt :: UTCTime
|
||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d
|
mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d
|
||||||
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByGroupMemberId createdAt updatedAt =
|
mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt =
|
||||||
let editable = case itemContent of
|
let editable = case itemContent of
|
||||||
CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted
|
CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted
|
||||||
_ -> False
|
_ -> False
|
||||||
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, forwardedByGroupMemberId, createdAt, updatedAt}
|
in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, forwardedByMember, createdAt, updatedAt}
|
||||||
|
|
||||||
data CITimed = CITimed
|
data CITimed = CITimed
|
||||||
{ ttl :: Int, -- seconds
|
{ ttl :: Int, -- seconds
|
||||||
@ -784,8 +784,8 @@ data RcvMessage = RcvMessage
|
|||||||
chatMsgEvent :: AChatMsgEvent,
|
chatMsgEvent :: AChatMsgEvent,
|
||||||
sharedMsgId_ :: Maybe SharedMsgId,
|
sharedMsgId_ :: Maybe SharedMsgId,
|
||||||
msgBody :: MsgBody,
|
msgBody :: MsgBody,
|
||||||
authorGroupMemberId :: Maybe GroupMemberId,
|
authorMember :: Maybe GroupMemberId,
|
||||||
forwardedByGroupMemberId :: Maybe GroupMemberId
|
forwardedByMember :: Maybe GroupMemberId
|
||||||
}
|
}
|
||||||
|
|
||||||
data PendingGroupMessage = PendingGroupMessage
|
data PendingGroupMessage = PendingGroupMessage
|
||||||
|
@ -200,7 +200,7 @@ createNewMessageAndRcvMsgDelivery db connOrGroupId newMessage sharedMsgId_ RcvMs
|
|||||||
pure msg
|
pure msg
|
||||||
|
|
||||||
createNewRcvMessage :: forall e. (MsgEncodingI e) => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
|
createNewRcvMessage :: forall e. (MsgEncodingI e) => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
|
||||||
createNewRcvMessage db connOrGroupId NewMessage{chatMsgEvent, msgBody} sharedMsgId_ authorGroupMemberId forwardedByGroupMemberId =
|
createNewRcvMessage db connOrGroupId NewMessage{chatMsgEvent, msgBody} sharedMsgId_ authorMember forwardedByMember =
|
||||||
case connOrGroupId of
|
case connOrGroupId of
|
||||||
ConnectionId connId -> liftIO $ insertRcvMsg (Just connId) Nothing
|
ConnectionId connId -> liftIO $ insertRcvMsg (Just connId) Nothing
|
||||||
GroupId groupId -> case sharedMsgId_ of
|
GroupId groupId -> case sharedMsgId_ of
|
||||||
@ -230,9 +230,9 @@ createNewRcvMessage db connOrGroupId NewMessage{chatMsgEvent, msgBody} sharedMsg
|
|||||||
(msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id, shared_msg_id, author_group_member_id, forwarded_by_group_member_id)
|
(msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id, shared_msg_id, author_group_member_id, forwarded_by_group_member_id)
|
||||||
VALUES (?,?,?,?,?,?,?,?,?,?)
|
VALUES (?,?,?,?,?,?,?,?,?,?)
|
||||||
|]
|
|]
|
||||||
(MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_, authorGroupMemberId, forwardedByGroupMemberId)
|
(MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_, authorMember, forwardedByMember)
|
||||||
msgId <- insertedRowId db
|
msgId <- insertedRowId db
|
||||||
pure RcvMessage{msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody, authorGroupMemberId, forwardedByGroupMemberId}
|
pure RcvMessage{msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody, authorMember, forwardedByMember}
|
||||||
|
|
||||||
createSndMsgDeliveryEvent :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> ExceptT StoreError IO ()
|
createSndMsgDeliveryEvent :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> ExceptT StoreError IO ()
|
||||||
createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do
|
createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do
|
||||||
@ -366,8 +366,8 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
|
|||||||
CIQGroupRcv Nothing -> (Just False, Nothing)
|
CIQGroupRcv Nothing -> (Just False, Nothing)
|
||||||
|
|
||||||
createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
|
createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
|
||||||
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByGroupMemberId} sharedMsgId_ ciContent timed live itemTs createdAt = do
|
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live itemTs createdAt = do
|
||||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs forwardedByGroupMemberId createdAt
|
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs forwardedByMember createdAt
|
||||||
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
|
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
|
||||||
pure (ciId, quotedItem)
|
pure (ciId, quotedItem)
|
||||||
where
|
where
|
||||||
@ -389,7 +389,7 @@ createNewChatItemNoMsg db user chatDirection ciContent itemTs =
|
|||||||
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
|
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||||
|
|
||||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
|
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
|
||||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs forwardedByGroupMemberId createdAt = do
|
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs forwardedByMember createdAt = do
|
||||||
DB.execute
|
DB.execute
|
||||||
db
|
db
|
||||||
[sql|
|
[sql|
|
||||||
@ -408,7 +408,7 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
|||||||
pure ciId
|
pure ciId
|
||||||
where
|
where
|
||||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
|
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
|
||||||
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByGroupMemberId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
|
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByMember) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
|
||||||
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
|
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
|
||||||
idsRow = case chatDirection of
|
idsRow = case chatDirection of
|
||||||
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
|
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
|
||||||
@ -594,7 +594,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
|||||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||||
-- CIFile
|
-- CIFile
|
||||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||||
-- CIMeta forwardedByGroupMemberId
|
-- CIMeta forwardedByMember
|
||||||
i.forwarded_by_group_member_id,
|
i.forwarded_by_group_member_id,
|
||||||
-- Maybe GroupMember - sender
|
-- Maybe GroupMember - sender
|
||||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
||||||
@ -1074,7 +1074,7 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
|
|||||||
|
|
||||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||||
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
||||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||||
where
|
where
|
||||||
member_ = toMaybeGroupMember userContactId memberRow_
|
member_ = toMaybeGroupMember userContactId memberRow_
|
||||||
@ -1110,13 +1110,13 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
|||||||
DBCIBlocked -> Just (CIBlocked deletedTs)
|
DBCIBlocked -> Just (CIBlocked deletedTs)
|
||||||
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
||||||
itemEdited' = fromMaybe False itemEdited
|
itemEdited' = fromMaybe False itemEdited
|
||||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByGroupMemberId createdAt updatedAt
|
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt
|
||||||
ciTimed :: Maybe CITimed
|
ciTimed :: Maybe CITimed
|
||||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||||
|
|
||||||
toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
|
toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
|
||||||
toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
|
toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
|
||||||
either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByMember :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
||||||
toGroupChatItemList _ _ _ = []
|
toGroupChatItemList _ _ _ = []
|
||||||
|
|
||||||
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
|
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
|
||||||
@ -1560,7 +1560,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
|||||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||||
-- CIFile
|
-- CIFile
|
||||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||||
-- CIMeta forwardedByGroupMemberId
|
-- CIMeta forwardedByMember
|
||||||
i.forwarded_by_group_member_id,
|
i.forwarded_by_group_member_id,
|
||||||
-- GroupMember
|
-- GroupMember
|
||||||
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
|
||||||
|
@ -508,7 +508,7 @@ viewChats ts tz = concatMap chatPreview . reverse
|
|||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
|
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
|
||||||
viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file} doShow ts tz =
|
viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember}, content, quotedItem, file} doShow ts tz =
|
||||||
withGroupMsgForwarded . withItemDeleted <$> (case chat of
|
withGroupMsgForwarded . withItemDeleted <$> (case chat of
|
||||||
DirectChat c -> case chatDir of
|
DirectChat c -> case chatDir of
|
||||||
CIDirectSnd -> case content of
|
CIDirectSnd -> case content of
|
||||||
@ -548,7 +548,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta, content, quotedItem, file}
|
|||||||
withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of
|
withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of
|
||||||
Nothing -> item
|
Nothing -> item
|
||||||
Just t -> item <> styled (colored Red) (" [" <> t <> "]")
|
Just t -> item <> styled (colored Red) (" [" <> t <> "]")
|
||||||
withGroupMsgForwarded item = case meta.forwardedByGroupMemberId of
|
withGroupMsgForwarded item = case forwardedByMember of
|
||||||
Nothing -> item
|
Nothing -> item
|
||||||
Just _ -> item <> styled (colored Yellow) (" [>>]" :: String)
|
Just _ -> item <> styled (colored Yellow) (" [>>]" :: String)
|
||||||
withSndFile = withFile viewSentFileInvitation
|
withSndFile = withFile viewSentFileInvitation
|
||||||
|
@ -105,8 +105,14 @@ chatGroupTests = do
|
|||||||
it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced
|
it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced
|
||||||
it "share incognito profile" testMemberContactIncognito
|
it "share incognito profile" testMemberContactIncognito
|
||||||
it "sends and updates profile when creating contact" testMemberContactProfileUpdate
|
it "sends and updates profile when creating contact" testMemberContactProfileUpdate
|
||||||
describe "forwarding messages" $ do
|
describe "group message forwarding" $ do
|
||||||
it "admin should forward messages between invitee and introduced" testGroupMsgForward
|
it "forward messages between invitee and introduced (x.msg.new)" testGroupMsgForward
|
||||||
|
it "forward message edit (x.msg.update)" testGroupMsgForwardEdit
|
||||||
|
it "forward message reaction (x.msg.react)" testGroupMsgForwardReaction
|
||||||
|
it "forward message deletion (x.msg.del)" testGroupMsgForwardDeletion
|
||||||
|
it "forward file (x.msg.file.descr)" testGroupMsgForwardFile
|
||||||
|
it "forward role change (x.grp.mem.role)" testGroupMsgForwardChangeRole
|
||||||
|
it "forward new member announcement (x.grp.mem.new)" testGroupMsgForwardNewMember
|
||||||
where
|
where
|
||||||
_0 = supportedChatVRange -- don't create direct connections
|
_0 = supportedChatVRange -- don't create direct connections
|
||||||
_1 = groupCreateDirectVRange
|
_1 = groupCreateDirectVRange
|
||||||
@ -3902,18 +3908,9 @@ testMemberContactProfileUpdate =
|
|||||||
|
|
||||||
testGroupMsgForward :: HasCallStack => FilePath -> IO ()
|
testGroupMsgForward :: HasCallStack => FilePath -> IO ()
|
||||||
testGroupMsgForward =
|
testGroupMsgForward =
|
||||||
testChatCfg4 cfg aliceProfile bobProfile cathProfile danProfile $
|
testChat3 aliceProfile bobProfile cathProfile $
|
||||||
\alice bob cath dan -> withXFTPServer $ do
|
\alice bob cath -> do
|
||||||
createGroup3 "team" alice bob cath
|
setupGroupForwarding3 "team" alice bob cath
|
||||||
|
|
||||||
threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected
|
|
||||||
|
|
||||||
void $ withCCTransaction bob $ \db ->
|
|
||||||
DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3"
|
|
||||||
void $ withCCTransaction cath $ \db ->
|
|
||||||
DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3"
|
|
||||||
void $ withCCTransaction alice $ \db ->
|
|
||||||
DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'"
|
|
||||||
|
|
||||||
bob #> "#team hi there"
|
bob #> "#team hi there"
|
||||||
alice <# "#team bob> hi there"
|
alice <# "#team bob> hi there"
|
||||||
@ -3937,22 +3934,80 @@ testGroupMsgForward =
|
|||||||
cath <# "#team bob> hi there [>>]"
|
cath <# "#team bob> hi there [>>]"
|
||||||
cath <# "#team hey team"
|
cath <# "#team hey team"
|
||||||
|
|
||||||
|
setupGroupForwarding3 :: String -> TestCC -> TestCC -> TestCC -> IO ()
|
||||||
|
setupGroupForwarding3 gName alice bob cath = do
|
||||||
|
createGroup3 gName alice bob cath
|
||||||
|
|
||||||
|
threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected
|
||||||
|
|
||||||
|
void $ withCCTransaction bob $ \db ->
|
||||||
|
DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3"
|
||||||
|
void $ withCCTransaction cath $ \db ->
|
||||||
|
DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3"
|
||||||
|
void $ withCCTransaction alice $ \db ->
|
||||||
|
DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'"
|
||||||
|
|
||||||
|
testGroupMsgForwardEdit :: HasCallStack => FilePath -> IO ()
|
||||||
|
testGroupMsgForwardEdit =
|
||||||
|
testChat3 aliceProfile bobProfile cathProfile $
|
||||||
|
\alice bob cath -> do
|
||||||
|
setupGroupForwarding3 "team" alice bob cath
|
||||||
|
|
||||||
|
bob #> "#team hi there"
|
||||||
|
alice <# "#team bob> hi there"
|
||||||
|
cath <# "#team bob> hi there [>>]"
|
||||||
|
|
||||||
bob ##> "! #team hello there"
|
bob ##> "! #team hello there"
|
||||||
bob <# "#team [edited] hello there"
|
bob <# "#team [edited] hello there"
|
||||||
alice <# "#team bob> [edited] hello there"
|
alice <# "#team bob> [edited] hello there"
|
||||||
cath <# "#team bob> [edited] hello there" -- TODO show as forwarded
|
cath <# "#team bob> [edited] hello there" -- TODO show as forwarded
|
||||||
|
|
||||||
cath ##> "+1 #team hello there"
|
alice ##> "/tail #team 1"
|
||||||
|
alice <# "#team bob> hello there"
|
||||||
|
|
||||||
|
bob ##> "/tail #team 1"
|
||||||
|
bob <# "#team hello there"
|
||||||
|
|
||||||
|
cath ##> "/tail #team 1"
|
||||||
|
cath <# "#team bob> hello there [>>]"
|
||||||
|
|
||||||
|
testGroupMsgForwardReaction :: HasCallStack => FilePath -> IO ()
|
||||||
|
testGroupMsgForwardReaction =
|
||||||
|
testChat3 aliceProfile bobProfile cathProfile $
|
||||||
|
\alice bob cath -> do
|
||||||
|
setupGroupForwarding3 "team" alice bob cath
|
||||||
|
|
||||||
|
bob #> "#team hi there"
|
||||||
|
alice <# "#team bob> hi there"
|
||||||
|
cath <# "#team bob> hi there [>>]"
|
||||||
|
|
||||||
|
cath ##> "+1 #team hi there"
|
||||||
cath <## "added 👍"
|
cath <## "added 👍"
|
||||||
alice <# "#team cath> > bob hello there"
|
alice <# "#team cath> > bob hi there"
|
||||||
alice <## " + 👍"
|
alice <## " + 👍"
|
||||||
bob <# "#team cath> > bob hello there"
|
bob <# "#team cath> > bob hi there"
|
||||||
bob <## " + 👍"
|
bob <## " + 👍"
|
||||||
|
|
||||||
bob ##> "\\ #team hello there"
|
testGroupMsgForwardDeletion :: HasCallStack => FilePath -> IO ()
|
||||||
|
testGroupMsgForwardDeletion =
|
||||||
|
testChat3 aliceProfile bobProfile cathProfile $
|
||||||
|
\alice bob cath -> do
|
||||||
|
setupGroupForwarding3 "team" alice bob cath
|
||||||
|
|
||||||
|
bob #> "#team hi there"
|
||||||
|
alice <# "#team bob> hi there"
|
||||||
|
cath <# "#team bob> hi there [>>]"
|
||||||
|
|
||||||
|
bob ##> "\\ #team hi there"
|
||||||
bob <## "message marked deleted"
|
bob <## "message marked deleted"
|
||||||
alice <# "#team bob> [marked deleted] hello there"
|
alice <# "#team bob> [marked deleted] hi there"
|
||||||
cath <# "#team bob> [marked deleted] hello there" -- TODO show as forwarded
|
cath <# "#team bob> [marked deleted] hi there" -- TODO show as forwarded
|
||||||
|
|
||||||
|
testGroupMsgForwardFile :: HasCallStack => FilePath -> IO ()
|
||||||
|
testGroupMsgForwardFile =
|
||||||
|
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
||||||
|
\alice bob cath -> withXFTPServer $ do
|
||||||
|
setupGroupForwarding3 "team" alice bob cath
|
||||||
|
|
||||||
bob #> "/f #team ./tests/fixtures/test.jpg"
|
bob #> "/f #team ./tests/fixtures/test.jpg"
|
||||||
bob <## "use /fc 1 to cancel sending"
|
bob <## "use /fc 1 to cancel sending"
|
||||||
@ -3972,12 +4027,26 @@ testGroupMsgForward =
|
|||||||
src <- B.readFile "./tests/fixtures/test.jpg"
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
||||||
dest <- B.readFile "./tests/tmp/test.jpg"
|
dest <- B.readFile "./tests/tmp/test.jpg"
|
||||||
dest `shouldBe` src
|
dest `shouldBe` src
|
||||||
|
where
|
||||||
|
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||||
|
|
||||||
|
testGroupMsgForwardChangeRole :: HasCallStack => FilePath -> IO ()
|
||||||
|
testGroupMsgForwardChangeRole =
|
||||||
|
testChat3 aliceProfile bobProfile cathProfile $
|
||||||
|
\alice bob cath -> do
|
||||||
|
setupGroupForwarding3 "team" alice bob cath
|
||||||
|
|
||||||
cath ##> "/mr #team bob member"
|
cath ##> "/mr #team bob member"
|
||||||
cath <## "#team: you changed the role of bob from admin to member"
|
cath <## "#team: you changed the role of bob from admin to member"
|
||||||
alice <## "#team: cath changed the role of bob from admin to member"
|
alice <## "#team: cath changed the role of bob from admin to member"
|
||||||
bob <## "#team: cath changed your role from admin to member" -- TODO show as forwarded
|
bob <## "#team: cath changed your role from admin to member" -- TODO show as forwarded
|
||||||
|
|
||||||
|
testGroupMsgForwardNewMember :: HasCallStack => FilePath -> IO ()
|
||||||
|
testGroupMsgForwardNewMember =
|
||||||
|
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||||
|
\alice bob cath dan -> do
|
||||||
|
setupGroupForwarding3 "team" alice bob cath
|
||||||
|
|
||||||
connectUsers cath dan
|
connectUsers cath dan
|
||||||
cath ##> "/a #team dan"
|
cath ##> "/a #team dan"
|
||||||
cath <## "invitation to join the group #team sent to dan"
|
cath <## "invitation to join the group #team sent to dan"
|
||||||
@ -3994,14 +4063,21 @@ testGroupMsgForward =
|
|||||||
bob <## "#team: cath added dan (Daniel) to the group (connecting...)", -- TODO show as forwarded
|
bob <## "#team: cath added dan (Daniel) to the group (connecting...)", -- TODO show as forwarded
|
||||||
dan <## "#team: member alice (Alice) is connected"
|
dan <## "#team: member alice (Alice) is connected"
|
||||||
]
|
]
|
||||||
|
|
||||||
dan #> "#team hello all"
|
dan #> "#team hello all"
|
||||||
alice <# "#team dan> hello all"
|
alice <# "#team dan> hello all"
|
||||||
-- bob <# "#team dan> hello all [>>]"
|
-- bob <# "#team dan> hello all [>>]"
|
||||||
cath <# "#team dan> hello all"
|
cath <# "#team dan> hello all"
|
||||||
|
|
||||||
bob #> "#team hi all"
|
bob #> "#team hi all"
|
||||||
alice <# "#team bob> hi all"
|
alice <# "#team bob> hi all"
|
||||||
cath <# "#team bob> hi all [>>]"
|
cath <# "#team bob> hi all [>>]"
|
||||||
-- dan <# "#team bob> hi all"
|
-- dan <# "#team bob> hi all [>>]"
|
||||||
where
|
|
||||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
bob ##> "/ms team"
|
||||||
|
bob
|
||||||
|
<### [ "alice (Alice): owner, host, connected",
|
||||||
|
"bob (Bob): admin, you, connected",
|
||||||
|
"cath (Catherine): admin, connected",
|
||||||
|
"dan (Daniel): member"
|
||||||
|
]
|
||||||
|
Loading…
Reference in New Issue
Block a user