Merge branch 'master' into master-ghc8107

This commit is contained in:
Evgeny Poberezkin 2023-12-13 12:35:37 +00:00
commit 256f85024f
16 changed files with 165 additions and 263 deletions

View File

@ -16,7 +16,6 @@ struct GroupChatInfoView: View {
@Environment(\.dismiss) var dismiss: DismissAction
@ObservedObject var chat: Chat
@Binding var groupInfo: GroupInfo
@ObservedObject private var alertManager = AlertManager.shared
@State private var alert: GroupChatInfoViewAlert? = nil
@State private var groupLink: String?
@State private var groupLinkMemberRole: GroupMemberRole = .member

View File

@ -188,17 +188,19 @@ struct GroupMemberInfoView: View {
// this condition prevents re-setting picker
if !justOpened { return }
}
newRole = member.memberRole
do {
let (_, stats) = try apiGroupMemberInfo(groupInfo.apiId, member.groupMemberId)
let (mem, code) = member.memberActive ? try apiGetGroupMemberCode(groupInfo.apiId, member.groupMemberId) : (member, nil)
_ = chatModel.upsertGroupMember(groupInfo, mem)
connectionStats = stats
connectionCode = code
} catch let error {
logger.error("apiGroupMemberInfo or apiGetGroupMemberCode error: \(responseError(error))")
}
justOpened = false
DispatchQueue.main.async {
newRole = member.memberRole
do {
let (_, stats) = try apiGroupMemberInfo(groupInfo.apiId, member.groupMemberId)
let (mem, code) = member.memberActive ? try apiGetGroupMemberCode(groupInfo.apiId, member.groupMemberId) : (member, nil)
_ = chatModel.upsertGroupMember(groupInfo, mem)
connectionStats = stats
connectionCode = code
} catch let error {
logger.error("apiGroupMemberInfo or apiGetGroupMemberCode error: \(responseError(error))")
}
}
}
.onChange(of: newRole) { newRole in
if newRole != member.memberRole {

View File

@ -17,7 +17,7 @@ struct ScanCodeView: View {
var body: some View {
VStack(alignment: .leading) {
CodeScannerView(codeTypes: [.qr], completion: processQRCode)
CodeScannerView(codeTypes: [.qr], scanMode: .oncePerCode, completion: processQRCode)
.aspectRatio(1, contentMode: .fit)
.cornerRadius(12)
Text("Scan security code from your contact's app.")

View File

@ -74,6 +74,7 @@ struct QRCode: View {
.onAppear {
image = image ?? generateImage(uri, tintColor: tintColor)
}
.frame(maxWidth: .infinity, maxHeight: .infinity)
}
}

View File

@ -25,7 +25,7 @@ struct ScanToConnectView: View {
.fixedSize(horizontal: false, vertical: true)
.padding(.vertical)
CodeScannerView(codeTypes: [.qr], completion: processQRCode)
CodeScannerView(codeTypes: [.qr], scanMode: .continuous, completion: processQRCode)
.aspectRatio(1, contentMode: .fit)
.cornerRadius(12)

View File

@ -332,7 +332,7 @@ struct ConnectDesktopView: View {
private func scanDesctopAddressView() -> some View {
Section("Scan QR code from desktop") {
CodeScannerView(codeTypes: [.qr], completion: processDesktopQRCode)
CodeScannerView(codeTypes: [.qr], scanMode: .oncePerCode, completion: processDesktopQRCode)
.aspectRatio(1, contentMode: .fit)
.cornerRadius(12)
.listRowBackground(Color.clear)

View File

@ -21,7 +21,7 @@ struct ScanProtocolServer: View {
.font(.largeTitle)
.bold()
.padding(.vertical)
CodeScannerView(codeTypes: [.qr], completion: processQRCode)
CodeScannerView(codeTypes: [.qr], scanMode: .oncePerCode, completion: processQRCode)
.aspectRatio(1, contentMode: .fit)
.cornerRadius(12)
.padding(.top)

View File

@ -4,25 +4,23 @@ packages: .
with-compiler: ghc-8.10.7
index-state: 2023-10-06T00:00:00Z
index-state: 2023-12-12T00:00:00Z
package cryptostore
flags: +use_crypton
constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: f576260594b9898e26dbac1bcb4b5061fa4fa242
tag: 18be2709f59a4cb20fe9758b899622092dba062e
source-repository-package
type: git
location: https://github.com/simplex-chat/hs-socks.git
tag: a30cc7a79a08d8108316094f8f2f82a0c5e1ac51
source-repository-package
type: git
location: https://github.com/kazu-yamamoto/http2.git
tag: f5525b755ff2418e6e6ecc69e877363b0d0bcaeb
source-repository-package
type: git
location: https://github.com/simplex-chat/direct-sqlcipher.git

View File

@ -288,11 +288,11 @@
"hackage": {
"flake": false,
"locked": {
"lastModified": 1696724662,
"narHash": "sha256-jV2ugSjZE0FjMYR2YIx0p2cDBqd+xxhZrRxp5BmieYk=",
"lastModified": 1702340598,
"narHash": "sha256-CC0HI+6iKPtH+8r/ZfcpW5v/OYvL7zMwpr0xfkXV1zU=",
"owner": "input-output-hk",
"repo": "hackage.nix",
"rev": "df603bff8606d8653a0876ae0c3fd1f9014882f2",
"rev": "24617c569995e38bf3b83b48eec6628a50fdb4fb",
"type": "github"
},
"original": {

View File

@ -31,7 +31,7 @@
let pkgs = haskellNix.legacyPackages.${system}.appendOverlays [android26]; in
let drv' = { extra-modules, pkgs', ... }: pkgs'.haskell-nix.project {
compiler-nix-name = "ghc8107";
index-state = "2023-10-06T00:00:00Z";
index-state = "2023-12-12T00:00:00Z";
# We need this, to specify we want the cabal project.
# If the stack.yaml was dropped, this would not be necessary.
projectFileName = "cabal.project";

View File

@ -22,7 +22,7 @@ dependencies:
- composition == 1.0.*
- constraints >= 0.12 && < 0.14
- containers == 0.6.*
- cryptonite == 0.30.*
- crypton == 0.34.*
- data-default >= 0.7 && < 0.8
- directory == 1.3.*
- direct-sqlcipher == 2.3.*
@ -46,7 +46,7 @@ dependencies:
- stm == 2.5.*
- terminal == 0.2.*
- time == 1.9.*
- tls >= 1.6.0 && < 1.7
- tls >= 1.7.0 && < 1.8
- unliftio == 0.2.*
- unliftio-core == 0.2.*
- zip == 2.0.*

View File

@ -1,8 +1,7 @@
{
"https://github.com/simplex-chat/simplexmq.git"."f576260594b9898e26dbac1bcb4b5061fa4fa242" = "0lmfncha6dxxg5ck9f4a155kyd6267k5m9w5mli121lir6ikvk7z";
"https://github.com/simplex-chat/simplexmq.git"."18be2709f59a4cb20fe9758b899622092dba062e" = "08dr4vyg1wz2z768iikg8fks5zqf4dw5myr87hbpv964idda3pmj";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/kazu-yamamoto/http2.git"."f5525b755ff2418e6e6ecc69e877363b0d0bcaeb" = "0fyx0047gvhm99ilp212mmz37j84cwrfnpmssib5dw363fyb88b6";
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "0kiwhvml42g9anw4d2v0zd1fpc790pj9syg5x3ik4l97fnkbbwpp";
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
"https://github.com/simplex-chat/aeson.git"."aab7b5a14d6c5ea64c64dcaee418de1bb00dcc2b" = "0jz7kda8gai893vyvj96fy962ncv8dcsx71fbddyy8zrvc88jfrr";
"https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";

View File

@ -175,7 +175,7 @@ library
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, cryptonite ==0.30.*
, crypton ==0.34.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
@ -199,7 +199,7 @@ library
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.9.*
, tls >=1.6.0 && <1.7
, tls >=1.7.0 && <1.8
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==2.0.*
@ -234,7 +234,7 @@ executable simplex-bot
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, cryptonite ==0.30.*
, crypton ==0.34.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
@ -259,7 +259,7 @@ executable simplex-bot
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.9.*
, tls >=1.6.0 && <1.7
, tls >=1.7.0 && <1.8
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==2.0.*
@ -294,7 +294,7 @@ executable simplex-bot-advanced
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, cryptonite ==0.30.*
, crypton ==0.34.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
@ -319,7 +319,7 @@ executable simplex-bot-advanced
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.9.*
, tls >=1.6.0 && <1.7
, tls >=1.7.0 && <1.8
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==2.0.*
@ -356,7 +356,7 @@ executable simplex-broadcast-bot
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, cryptonite ==0.30.*
, crypton ==0.34.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
@ -381,7 +381,7 @@ executable simplex-broadcast-bot
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.9.*
, tls >=1.6.0 && <1.7
, tls >=1.7.0 && <1.8
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==2.0.*
@ -417,7 +417,7 @@ executable simplex-chat
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, cryptonite ==0.30.*
, crypton ==0.34.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
@ -442,7 +442,7 @@ executable simplex-chat
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.9.*
, tls >=1.6.0 && <1.7
, tls >=1.7.0 && <1.8
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, websockets ==0.12.*
@ -482,7 +482,7 @@ executable simplex-directory-service
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, cryptonite ==0.30.*
, crypton ==0.34.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
@ -507,7 +507,7 @@ executable simplex-directory-service
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.9.*
, tls >=1.6.0 && <1.7
, tls >=1.7.0 && <1.8
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==2.0.*
@ -571,7 +571,7 @@ test-suite simplex-chat-test
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, cryptonite ==0.30.*
, crypton ==0.34.*
, data-default ==0.7.*
, deepseq ==1.4.*
, direct-sqlcipher ==2.3.*
@ -600,7 +600,7 @@ test-suite simplex-chat-test
, stm ==2.5.*
, terminal ==0.2.*
, time ==1.9.*
, tls >=1.6.0 && <1.7
, tls >=1.7.0 && <1.8
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, zip ==2.0.*

View File

@ -26,9 +26,6 @@ CREATE INDEX idx_contacts_chat_ts ON contacts(user_id, chat_ts);
CREATE INDEX idx_groups_chat_ts ON groups(user_id, chat_ts);
CREATE INDEX idx_contact_requests_updated_at ON contact_requests(user_id, updated_at);
CREATE INDEX idx_connections_updated_at ON connections(user_id, updated_at);
CREATE INDEX idx_chat_items_contact_id_item_status ON chat_items(contact_id, item_status);
CREATE INDEX idx_chat_items_group_id_item_status ON chat_items(group_id, item_status);
|]
down_m20231207_chat_list_pagination :: Query
@ -38,7 +35,4 @@ DROP INDEX idx_contacts_chat_ts;
DROP INDEX idx_groups_chat_ts;
DROP INDEX idx_contact_requests_updated_at;
DROP INDEX idx_connections_updated_at;
DROP INDEX idx_chat_items_contact_id_item_status;
DROP INDEX idx_chat_items_group_id_item_status;
|]

View File

@ -817,11 +817,3 @@ CREATE INDEX idx_contact_requests_updated_at ON contact_requests(
updated_at
);
CREATE INDEX idx_connections_updated_at ON connections(user_id, updated_at);
CREATE INDEX idx_chat_items_contact_id_item_status ON chat_items(
contact_id,
item_status
);
CREATE INDEX idx_chat_items_group_id_item_status ON chat_items(
group_id,
item_status
);

View File

@ -499,8 +499,8 @@ getChatPreviews db user withPCC pagination query = do
where
ts :: AChatPreviewData -> UTCTime
ts (ACPD _ cpd) = case cpd of
(DirectChatPD t _ _) -> t
(GroupChatPD t _ _) -> t
(DirectChatPD t _ _ _) -> t
(GroupChatPD t _ _ _) -> t
(ContactRequestPD t _) -> t
(ContactConnectionPD t _) -> t
sortTake = case pagination of
@ -515,8 +515,8 @@ getChatPreviews db user withPCC pagination query = do
SCTContactConnection -> let (ContactConnectionPD _ chat) = cpd in pure chat
data ChatPreviewData (c :: ChatType) where
DirectChatPD :: UTCTime -> ContactId -> Maybe ChatStats -> ChatPreviewData 'CTDirect
GroupChatPD :: UTCTime -> GroupId -> Maybe ChatStats -> ChatPreviewData 'CTGroup
DirectChatPD :: UTCTime -> ContactId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTDirect
GroupChatPD :: UTCTime -> GroupId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTGroup
ContactRequestPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactRequest
ContactConnectionPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactConnection
@ -528,283 +528,200 @@ paginationByTimeFilter = \case
PTAfter ts count -> ("\nAND ts > :ts ORDER BY ts ASC LIMIT :count", [":ts" := ts, ":count" := count])
PTBefore ts count -> ("\nAND ts < :ts ORDER BY ts DESC LIMIT :count", [":ts" := ts, ":count" := count])
type MaybeChatStatsRow = (Maybe Int, Maybe ChatItemId, Maybe Bool)
type ChatStatsRow = (Int, ChatItemId, Bool)
toMaybeChatStats :: MaybeChatStatsRow -> Maybe ChatStats
toMaybeChatStats (Just unreadCount, Just minUnreadItemId, Just unreadChat) = Just ChatStats {unreadCount, minUnreadItemId, unreadChat}
toMaybeChatStats _ = Nothing
toChatStats :: ChatStatsRow -> ChatStats
toChatStats (unreadCount, minUnreadItemId, unreadChat) = ChatStats {unreadCount, minUnreadItemId, unreadChat}
findDirectChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
findDirectChatPreviews_ db User {userId} pagination clq =
map toPreview <$> getPreviews
where
toPreview :: (ContactId, UTCTime) :. MaybeChatStatsRow -> AChatPreviewData
toPreview ((contactId, ts) :. statsRow_) =
ACPD SCTDirect $ DirectChatPD ts contactId (toMaybeChatStats statsRow_)
toPreview :: (ContactId, UTCTime, Maybe ChatItemId) :. ChatStatsRow -> AChatPreviewData
toPreview ((contactId, ts, lastItemId_) :. statsRow) =
ACPD SCTDirect $ DirectChatPD ts contactId lastItemId_ (toChatStats statsRow)
baseQuery =
[sql|
SELECT ct.contact_id, ct.chat_ts as ts, LastItems.chat_item_id, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat
FROM contacts ct
LEFT JOIN (
SELECT contact_id, chat_item_id, MAX(created_at)
FROM chat_items
GROUP BY contact_id
) LastItems ON LastItems.contact_id = ct.contact_id
LEFT JOIN (
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
WHERE item_status = :rcv_new
GROUP BY contact_id
) ChatStats ON ChatStats.contact_id = ct.contact_id
|]
(pagQuery, pagParams) = paginationByTimeFilter pagination
getPreviews = case clq of
CLQFilters {favorite = False, unread = False} ->
DB.queryNamed
db
( [sql|
SELECT ct.contact_id, ct.chat_ts as ts, NULL, NULL, NULL
FROM contacts ct
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
|]
( baseQuery
<> [sql|
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
|]
<> pagQuery
)
([":user_id" := userId] <> pagParams)
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
CLQFilters {favorite = True, unread = False} ->
DB.queryNamed
db
( [sql|
SELECT ct.contact_id, ct.chat_ts as ts, NULL, NULL, NULL
FROM contacts ct
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
AND ct.favorite = 1
|]
( baseQuery
<> [sql|
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
AND ct.favorite = 1
|]
<> pagQuery
)
([":user_id" := userId] <> pagParams)
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
CLQFilters {favorite = False, unread = True} ->
DB.queryNamed
db
( [sql|
SELECT ct.contact_id, ct.chat_ts as ts, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat
FROM contacts ct
LEFT JOIN (
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
WHERE item_status = :rcv_new
GROUP BY contact_id
) ChatStats ON ChatStats.contact_id = ct.contact_id
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
AND (ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
( baseQuery
<> [sql|
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
AND (ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
<> pagQuery
)
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
CLQFilters {favorite = True, unread = True} ->
DB.queryNamed
db
( [sql|
SELECT ct.contact_id, ct.chat_ts as ts, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), ct.unread_chat
FROM contacts ct
LEFT JOIN (
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
WHERE item_status = :rcv_new
GROUP BY contact_id
) ChatStats ON ChatStats.contact_id = ct.contact_id
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
AND (ct.favorite = 1
OR ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
( baseQuery
<> [sql|
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
AND (ct.favorite = 1
OR ct.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
<> pagQuery
)
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
CLQSearch {search} ->
DB.queryNamed
db
( [sql|
SELECT ct.contact_id, ct.chat_ts as ts, NULL, NULL, NULL
FROM contacts ct
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
AND (
ct.local_display_name LIKE '%' || :search || '%'
OR cp.display_name LIKE '%' || :search || '%'
OR cp.full_name LIKE '%' || :search || '%'
OR cp.local_alias LIKE '%' || :search || '%'
)
|]
( baseQuery
<> [sql|
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
WHERE ct.user_id = :user_id AND ct.is_user = 0 AND ct.deleted = 0 AND ct.contact_used
AND (
ct.local_display_name LIKE '%' || :search || '%'
OR cp.display_name LIKE '%' || :search || '%'
OR cp.full_name LIKE '%' || :search || '%'
OR cp.local_alias LIKE '%' || :search || '%'
)
|]
<> pagQuery
)
([":user_id" := userId, ":search" := search] <> pagParams)
([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams)
getDirectChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
getDirectChatPreview_ db user (DirectChatPD _ contactId stats_) = do
getDirectChatPreview_ db user (DirectChatPD _ contactId lastItemId_ stats) = do
contact <- getContact db user contactId
lastItem <- getLastItem
stats <- maybe getChatStats pure stats_
lastItem <- case lastItemId_ of
Just lastItemId -> (: []) <$> getDirectChatItem db user contactId lastItemId
Nothing -> pure []
pure $ AChat SCTDirect (Chat (DirectChat contact) lastItem stats)
where
getLastItem :: ExceptT StoreError IO [CChatItem 'CTDirect]
getLastItem =
liftIO getLastItemId >>= \case
Nothing -> pure []
Just lastItemId -> (: []) <$> getDirectChatItem db user contactId lastItemId
getLastItemId :: IO (Maybe ChatItemId)
getLastItemId =
maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT chat_item_id FROM (
SELECT contact_id, chat_item_id, MAX(created_at)
FROM chat_items
WHERE contact_id = ?
GROUP BY contact_id
)
|]
(Only contactId)
getChatStats :: ExceptT StoreError IO ChatStats
getChatStats = do
r_ <- liftIO getUnreadStats
let (unreadCount, minUnreadItemId) = maybe (0, 0) (\(_, unreadCnt, minId) -> (unreadCnt, minId)) r_
-- unread_chat could be read into contact to not search twice
unreadChat <-
ExceptT . firstRow fromOnly (SEInternalError $ "unread_chat not found for contact " <> show contactId) $
DB.query db "SELECT unread_chat FROM contacts WHERE contact_id = ?" (Only contactId)
pure ChatStats {unreadCount, minUnreadItemId, unreadChat}
getUnreadStats :: IO (Maybe (ContactId, Int, ChatItemId))
getUnreadStats =
maybeFirstRow id $
DB.query
db
[sql|
SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
WHERE contact_id = ? AND item_status = ?
GROUP BY contact_id
|]
(contactId, CISRcvNew)
findGroupChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
findGroupChatPreviews_ db User {userId} pagination clq =
map toPreview <$> getPreviews
where
toPreview :: (GroupId, UTCTime) :. MaybeChatStatsRow -> AChatPreviewData
toPreview ((groupId, ts) :. statsRow_) =
ACPD SCTGroup $ GroupChatPD ts groupId (toMaybeChatStats statsRow_)
toPreview :: (GroupId, UTCTime, Maybe ChatItemId) :. ChatStatsRow -> AChatPreviewData
toPreview ((groupId, ts, lastItemId_) :. statsRow) =
ACPD SCTGroup $ GroupChatPD ts groupId lastItemId_ (toChatStats statsRow)
baseQuery =
[sql|
SELECT g.group_id, g.chat_ts as ts, LastItems.chat_item_id, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat
FROM groups g
LEFT JOIN (
SELECT group_id, chat_item_id, MAX(item_ts)
FROM chat_items
GROUP BY group_id
) LastItems ON LastItems.group_id = g.group_id
LEFT JOIN (
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
WHERE item_status = :rcv_new
GROUP BY group_id
) ChatStats ON ChatStats.group_id = g.group_id
|]
(pagQuery, pagParams) = paginationByTimeFilter pagination
getPreviews = case clq of
CLQFilters {favorite = False, unread = False} ->
DB.queryNamed
db
( [sql|
SELECT g.group_id, g.chat_ts as ts, NULL, NULL, NULL
FROM groups g
WHERE g.user_id = :user_id
|]
( baseQuery
<> [sql|
WHERE g.user_id = :user_id
|]
<> pagQuery
)
([":user_id" := userId] <> pagParams)
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
CLQFilters {favorite = True, unread = False} ->
DB.queryNamed
db
( [sql|
SELECT g.group_id, g.chat_ts as ts, NULL, NULL, NULL
FROM groups g
WHERE g.user_id = :user_id
AND g.favorite = 1
|]
( baseQuery
<> [sql|
WHERE g.user_id = :user_id
AND g.favorite = 1
|]
<> pagQuery
)
([":user_id" := userId] <> pagParams)
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
CLQFilters {favorite = False, unread = True} ->
DB.queryNamed
db
( [sql|
SELECT g.group_id, g.chat_ts as ts, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat
FROM groups g
LEFT JOIN (
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
WHERE item_status = :rcv_new
GROUP BY group_id
) ChatStats ON ChatStats.group_id = g.group_id
WHERE g.user_id = :user_id
AND (g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
( baseQuery
<> [sql|
WHERE g.user_id = :user_id
AND (g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
<> pagQuery
)
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
CLQFilters {favorite = True, unread = True} ->
DB.queryNamed
db
( [sql|
SELECT g.group_id, g.chat_ts as ts, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat
FROM groups g
LEFT JOIN (
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
WHERE item_status = :rcv_new
GROUP BY group_id
) ChatStats ON ChatStats.group_id = g.group_id
WHERE g.user_id = :user_id
AND (g.favorite = 1
OR g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
( baseQuery
<> [sql|
WHERE g.user_id = :user_id
AND (g.favorite = 1
OR g.unread_chat = 1 OR ChatStats.UnreadCount > 0)
|]
<> pagQuery
)
([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams)
CLQSearch {search} ->
DB.queryNamed
db
( [sql|
SELECT g.group_id, g.chat_ts as ts, NULL, NULL, NULL
FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
WHERE g.user_id = :user_id
AND (
g.local_display_name LIKE '%' || :search || '%'
OR gp.display_name LIKE '%' || :search || '%'
OR gp.full_name LIKE '%' || :search || '%'
OR gp.description LIKE '%' || :search || '%'
)
|]
( baseQuery
<> [sql|
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
WHERE g.user_id = :user_id
AND (
g.local_display_name LIKE '%' || :search || '%'
OR gp.display_name LIKE '%' || :search || '%'
OR gp.full_name LIKE '%' || :search || '%'
OR gp.description LIKE '%' || :search || '%'
)
|]
<> pagQuery
)
([":user_id" := userId, ":search" := search] <> pagParams)
([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams)
getGroupChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
getGroupChatPreview_ db user (GroupChatPD _ groupId stats_) = do
getGroupChatPreview_ db user (GroupChatPD _ groupId lastItemId_ stats) = do
groupInfo <- getGroupInfo db user groupId
lastItem <- getLastItem
stats <- maybe getChatStats pure stats_
lastItem <- case lastItemId_ of
Just lastItemId -> (: []) <$> getGroupChatItem db user groupId lastItemId
Nothing -> pure []
pure $ AChat SCTGroup (Chat (GroupChat groupInfo) lastItem stats)
where
getLastItem :: ExceptT StoreError IO [CChatItem 'CTGroup]
getLastItem =
liftIO getLastItemId >>= \case
Nothing -> pure []
Just lastItemId -> (: []) <$> getGroupChatItem db user groupId lastItemId
getLastItemId :: IO (Maybe ChatItemId)
getLastItemId =
maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT chat_item_id FROM (
SELECT group_id, chat_item_id, MAX(item_ts)
FROM chat_items
WHERE group_id = ?
GROUP BY group_id
)
|]
(Only groupId)
getChatStats :: ExceptT StoreError IO ChatStats
getChatStats = do
r_ <- liftIO getUnreadStats
let (unreadCount, minUnreadItemId) = maybe (0, 0) (\(_, unreadCnt, minId) -> (unreadCnt, minId)) r_
-- unread_chat could be read into group to not search twice
unreadChat <-
ExceptT . firstRow fromOnly (SEInternalError $ "unread_chat not found for group " <> show groupId) $
DB.query db "SELECT unread_chat FROM groups WHERE group_id = ?" (Only groupId)
pure ChatStats {unreadCount, minUnreadItemId, unreadChat}
getUnreadStats :: IO (Maybe (GroupId, Int, ChatItemId))
getUnreadStats =
maybeFirstRow id $
DB.query
db
[sql|
SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread
FROM chat_items
WHERE group_id = ? AND item_status = ?
GROUP BY group_id
|]
(groupId, CISRcvNew)
getContactRequestChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of