Merge branch 'master' into chat-relays

This commit is contained in:
spaced4ndy
2026-01-09 15:04:53 +04:00
36 changed files with 685 additions and 535 deletions
+9 -3
View File
@@ -41,6 +41,7 @@ enum ChatCommand: ChatCmdProtocol {
case apiGetChatTags(userId: Int64)
case apiGetChats(userId: Int64)
case apiGetChat(chatId: ChatId, scope: GroupChatScope?, contentTag: MsgContentTag?, pagination: ChatPagination, search: String)
case apiGetChatContentTypes(chatId: ChatId, scope: GroupChatScope?)
case apiGetChatItemInfo(type: ChatType, id: Int64, scope: GroupChatScope?, itemId: Int64)
case apiSendMessages(type: ChatType, id: Int64, scope: GroupChatScope?, live: Bool, ttl: Int?, composedMessages: [ComposedMessage])
case apiCreateChatTag(tag: ChatTagData)
@@ -224,7 +225,8 @@ enum ChatCommand: ChatCmdProtocol {
case let .apiGetChats(userId): return "/_get chats \(userId) pcc=on"
case let .apiGetChat(chatId, scope, contentTag, pagination, search):
let tag = contentTag != nil ? " content=\(contentTag!.rawValue)" : ""
return "/_get chat \(chatId)\(scopeRef(scope: scope))\(tag) \(pagination.cmdString)" + (search == "" ? "" : " search=\(search)")
return "/_get chat \(chatId)\(scopeRef(scope))\(tag) \(pagination.cmdString)" + (search == "" ? "" : " search=\(search)")
case let .apiGetChatContentTypes(chatId, scope): return "/_get content types \(chatId)\(scopeRef(scope))"
case let .apiGetChatItemInfo(type, id, scope, itemId): return "/_get item info \(ref(type, id, scope: scope)) \(itemId)"
case let .apiSendMessages(type, id, scope, live, ttl, composedMessages):
let msgs = encodeJSON(composedMessages)
@@ -417,6 +419,7 @@ enum ChatCommand: ChatCmdProtocol {
case .apiGetChatTags: return "apiGetChatTags"
case .apiGetChats: return "apiGetChats"
case .apiGetChat: return "apiGetChat"
case .apiGetChatContentTypes: return "apiGetChatContentTypes"
case .apiGetChatItemInfo: return "apiGetChatItemInfo"
case .apiSendMessages: return "apiSendMessages"
case .apiCreateChatTag: return "apiCreateChatTag"
@@ -559,10 +562,10 @@ enum ChatCommand: ChatCmdProtocol {
}
func ref(_ type: ChatType, _ id: Int64, scope: GroupChatScope?) -> String {
"\(type.rawValue)\(id)\(scopeRef(scope: scope))"
"\(type.rawValue)\(id)\(scopeRef(scope))"
}
func scopeRef(scope: GroupChatScope?) -> String {
func scopeRef(_ scope: GroupChatScope?) -> String {
switch (scope) {
case .none: ""
case let .memberSupport(groupMemberId_):
@@ -648,6 +651,7 @@ enum ChatResponse0: Decodable, ChatAPIResult {
case chatStopped
case apiChats(user: UserRef, chats: [ChatData])
case apiChat(user: UserRef, chat: ChatData, navInfo: NavigationInfo?)
case chatContentTypes(contentTypes: [MsgContentTag])
case chatTags(user: UserRef, userTags: [ChatTag])
case chatItemInfo(user: UserRef, chatItem: AChatItem, chatItemInfo: ChatItemInfo)
case serverTestResult(user: UserRef, testServer: String, testFailure: ProtocolTestFailure?)
@@ -680,6 +684,7 @@ enum ChatResponse0: Decodable, ChatAPIResult {
case .chatStopped: "chatStopped"
case .apiChats: "apiChats"
case .apiChat: "apiChat"
case .chatContentTypes: "chatContentTypes"
case .chatTags: "chatTags"
case .chatItemInfo: "chatItemInfo"
case .serverTestResult: "serverTestResult"
@@ -714,6 +719,7 @@ enum ChatResponse0: Decodable, ChatAPIResult {
case .chatStopped: return noDetails
case let .apiChats(u, chats): return withUser(u, String(describing: chats))
case let .apiChat(u, chat, navInfo): return withUser(u, "chat: \(String(describing: chat))\nnavInfo: \(String(describing: navInfo))")
case let .chatContentTypes(types): return "content types: \(String(describing: types))"
case let .chatTags(u, userTags): return withUser(u, "userTags: \(String(describing: userTags))")
case let .chatItemInfo(u, chatItem, chatItemInfo): return withUser(u, "chatItem: \(String(describing: chatItem))\nchatItemInfo: \(String(describing: chatItemInfo))")
case let .serverTestResult(u, server, testFailure): return withUser(u, "server: \(server)\nresult: \(String(describing: testFailure))")
+6
View File
@@ -444,6 +444,12 @@ func apiGetChat(chatId: ChatId, scope: GroupChatScope?, contentTag: MsgContentTa
throw r.unexpected
}
func apiGetChatContentTypes(chatId: ChatId, scope: GroupChatScope?) async throws -> [MsgContentTag] {
let r: ChatResponse0 = try await chatSendCmd(.apiGetChatContentTypes(chatId: chatId, scope: scope))
if case let .chatContentTypes(types) = r { return types }
throw r.unexpected
}
func loadChat(chat: Chat, im: ItemsModel, search: String = "", clearItems: Bool = true) async {
await loadChat(chatId: chat.chatInfo.id, im: im, search: search, clearItems: clearItems)
}
+1 -1
View File
@@ -4601,7 +4601,7 @@ extension MsgContent: Encodable {
}
}
public enum MsgContentTag: String {
public enum MsgContentTag: String, Decodable {
case text
case link
case image
@@ -54,11 +54,10 @@ add_library( # Sets the name of the library.
simplex-api.c)
add_library( simplex SHARED IMPORTED )
FILE(GLOB SIMPLEXLIB ${CMAKE_SOURCE_DIR}/libs/${OS_LIB_PATH}-${OS_LIB_ARCH}/libsimplex.${OS_LIB_EXT})
if(WIN32)
FILE(GLOB SIMPLEXLIB ${CMAKE_SOURCE_DIR}/libs/${OS_LIB_PATH}-${OS_LIB_ARCH}/lib*simplex*.${OS_LIB_EXT})
set_target_properties( simplex PROPERTIES IMPORTED_IMPLIB ${SIMPLEXLIB})
else()
FILE(GLOB SIMPLEXLIB ${CMAKE_SOURCE_DIR}/libs/${OS_LIB_PATH}-${OS_LIB_ARCH}/lib*simplex-chat*.${OS_LIB_EXT})
set_target_properties( simplex PROPERTIES IMPORTED_LOCATION ${SIMPLEXLIB})
endif()
@@ -1036,6 +1036,14 @@ object ChatController {
return null
}
suspend fun apiGetChatContentTypes(rh: Long?, type: ChatType, id: Long, scope: GroupChatScope?): List<MsgContentTag>? {
val r = sendCmd(rh, CC.ApiGetChatContentTypes(type, id, scope))
if (r is API.Result && r.res is CR.ChatContentTypes) return r.res.contentTypes
Log.e(TAG, "apiGetChatContentTypes bad response: ${r.responseType} ${r.details}")
AlertManager.shared.showAlertMsg(generalGetString(MR.strings.error_loading_details), "${r.responseType}: ${r.details}")
return null
}
suspend fun apiCreateChatTag(rh: Long?, tag: ChatTagData): List<ChatTag>? {
val r = sendCmd(rh, CC.ApiCreateChatTag(tag))
if (r is API.Result && r.res is CR.ChatTags) return r.res.userTags
@@ -3542,6 +3550,7 @@ sealed class CC {
class ApiGetChatTags(val userId: Long): CC()
class ApiGetChats(val userId: Long): CC()
class ApiGetChat(val type: ChatType, val id: Long, val scope: GroupChatScope?, val contentTag: MsgContentTag?, val pagination: ChatPagination, val search: String = ""): CC()
class ApiGetChatContentTypes(val type: ChatType, val id: Long, val scope: GroupChatScope?): CC()
class ApiGetChatItemInfo(val type: ChatType, val id: Long, val scope: GroupChatScope?, val itemId: Long): CC()
class ApiSendMessages(val type: ChatType, val id: Long, val scope: GroupChatScope?, val live: Boolean, val ttl: Int?, val composedMessages: List<ComposedMessage>): CC()
class ApiCreateChatTag(val tag: ChatTagData): CC()
@@ -3726,6 +3735,7 @@ sealed class CC {
}
"/_get chat ${chatRef(type, id, scope)}$tag ${pagination.cmdString}" + (if (search == "") "" else " search=$search")
}
is ApiGetChatContentTypes -> "/_get content types ${chatRef(type, id, scope)})"
is ApiGetChatItemInfo -> "/_get item info ${chatRef(type, id, scope)} $itemId"
is ApiSendMessages -> {
val msgs = json.encodeToString(composedMessages)
@@ -3912,6 +3922,7 @@ sealed class CC {
is ApiGetChatTags -> "apiGetChatTags"
is ApiGetChats -> "apiGetChats"
is ApiGetChat -> "apiGetChat"
is ApiGetChatContentTypes -> "apiGetChatContentTypes"
is ApiGetChatItemInfo -> "apiGetChatItemInfo"
is ApiSendMessages -> "apiSendMessages"
is ApiCreateChatTag -> "apiCreateChatTag"
@@ -6097,6 +6108,7 @@ sealed class CR {
@Serializable @SerialName("chatStopped") class ChatStopped: CR()
@Serializable @SerialName("apiChats") class ApiChats(val user: UserRef, val chats: List<Chat>): CR()
@Serializable @SerialName("apiChat") class ApiChat(val user: UserRef, val chat: Chat, val navInfo: NavigationInfo = NavigationInfo()): CR()
@Serializable @SerialName("chatContentTypes") class ChatContentTypes(val contentTypes: List<MsgContentTag>): CR()
@Serializable @SerialName("chatTags") class ChatTags(val user: UserRef, val userTags: List<ChatTag>): CR()
@Serializable @SerialName("chatItemInfo") class ApiChatItemInfo(val user: UserRef, val chatItem: AChatItem, val chatItemInfo: ChatItemInfo): CR()
@Serializable @SerialName("serverTestResult") class ServerTestResult(val user: UserRef, val testServer: String, val testFailure: ProtocolTestFailure? = null): CR()
@@ -6278,6 +6290,7 @@ sealed class CR {
is ChatStopped -> "chatStopped"
is ApiChats -> "apiChats"
is ApiChat -> "apiChat"
is ChatContentTypes -> "chatContentTypes"
is ChatTags -> "chatTags"
is ApiChatItemInfo -> "chatItemInfo"
is ServerTestResult -> "serverTestResult"
@@ -6451,6 +6464,7 @@ sealed class CR {
is ChatStopped -> noDetails()
is ApiChats -> withUser(user, json.encodeToString(chats))
is ApiChat -> withUser(user, "remoteHostId: ${chat.remoteHostId}\nchatInfo: ${chat.chatInfo}\nchatStats: ${chat.chatStats}\nnavInfo: ${navInfo}\nchatItems: ${chat.chatItems}")
is ChatContentTypes -> "content types: ${json.encodeToString(contentTypes)}"
is ChatTags -> withUser(user, "userTags: ${json.encodeToString(userTags)}")
is ApiChatItemInfo -> withUser(user, "chatItem: ${json.encodeToString(chatItem)}\n${json.encodeToString(chatItemInfo)}")
is ServerTestResult -> withUser(user, "server: $testServer\nresult: ${json.encodeToString(testFailure)}")
+1
View File
@@ -340,6 +340,7 @@ undocumentedCommands =
"APIGetAppSettings",
"APIGetCallInvitations",
"APIGetChat",
"APIGetChatContentTypes",
"APIGetChatItemInfo",
"APIGetChatItems",
"APIGetChatItemTTL",
+1
View File
@@ -121,6 +121,7 @@ undocumentedResponses =
"CRBroadcastSent",
"CRCallInvitations",
"CRChatCleared",
"CRChatContentTypes",
"CRChatHelp",
"CRChatItemId",
"CRChatItemInfo",
+1 -1
View File
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: c4b687ba644d8f0581a9f4317b6211c493a8d685
tag: 6aadcf1f3fc19cbc0c8be457556fbaaffb0bfc46
source-repository-package
type: git
+8 -7
View File
@@ -24,18 +24,19 @@ exports=( $(sed 's/foreign export ccall "chat_migrate_init_key"//' src/Simplex/C
for elem in "${exports[@]}"; do count=$(grep -R "$elem$" libsimplex.dll.def | wc -l); if [ $count -ne 1 ]; then echo Wrong exports in libsimplex.dll.def. Add \"$elem\" to that file; exit 1; fi ; done
for elem in "${exports[@]}"; do count=$(grep -R "\"$elem\"" flake.nix | wc -l); if [ $count -ne 2 ]; then echo Wrong exports in flake.nix. Add \"$elem\" in two places of the file; exit 1; fi ; done
rm -rf $BUILD_DIR
cabal build lib:simplex-chat --ghc-options='-optl-Wl,-rpath,$ORIGIN -flink-rts -threaded' --constraint 'simplexmq +client_library' --constraint 'simplex-chat +client_library'
#rm -rf $BUILD_DIR
cabal build lib:simplex-chat --ghc-options='-optl-Wl,-rpath,$ORIGIN -optl-Wl,-soname,libsimplex.so -flink-rts -threaded' --constraint 'simplexmq +client_library' --constraint 'simplex-chat +client_library'
cd $BUILD_DIR/build
#patchelf --add-needed libHSrts_thr-ghc${GHC_VERSION}.so libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so
#patchelf --add-rpath '$ORIGIN' libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so
mv libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so libsimplex.so 2> /dev/null || true
#patchelf --add-needed libHSrts_thr-ghc${GHC_VERSION}.so libsimplex.so
#patchelf --add-rpath '$ORIGIN' libsimplex.so
# GitHub's Ubuntu 20.04 runner started to set libffi.so.7 as a dependency while Ubuntu 20.04 on user's devices may not have it
# but libffi.so.8 is shipped as an external library with other libs
patchelf --replace-needed "libffi.so.7" "libffi.so.8" libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so
patchelf --replace-needed "libffi.so.7" "libffi.so.8" libsimplex.so
mkdir deps 2> /dev/null || true
ldd libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so | grep "ghc" | cut -d' ' -f 3 | xargs -I {} cp {} ./deps/
ldd libsimplex.so | grep "ghc" | cut -d' ' -f 3 | xargs -I {} cp {} ./deps/
cd -
@@ -44,7 +45,7 @@ rm -rf apps/multiplatform/desktop/build/cmake
mkdir -p apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
cp -r $BUILD_DIR/build/deps/* apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
cp $BUILD_DIR/build/libHSsimplex-chat-*-inplace-ghc${GHC_VERSION}.so apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
cp $BUILD_DIR/build/libsimplex.so apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
scripts/desktop/prepare-vlc-linux.sh
links_dir=apps/multiplatform/build/links
+5 -4
View File
@@ -15,7 +15,7 @@ else
fi
LIB_EXT=dylib
LIB=libHSsimplex-chat-*-inplace-ghc*.$LIB_EXT
LIB=libsimplex.$LIB_EXT
GHC_LIBS_DIR=$(ghc --print-libdir)
BUILD_DIR=dist-newstyle/build/$ARCH-*/ghc-*/simplex-chat-*
@@ -28,13 +28,14 @@ rm -rf $BUILD_DIR
if [[ "$DATABASE_BACKEND" == "postgres" ]]; then
echo "Building with postgres backend..."
cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-L$GHC_LIBS_DIR/$ARCH-osx-ghc-$GHC_VERSION -optl-lHSrts_thr-ghc$GHC_VERSION -optl-lffi" --constraint 'simplexmq +client_library +client_postgres' --constraint 'simplex-chat +client_library +client_postgres'
cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-install_name,@rpath/$LIB -optl-Wl,-L$GHC_LIBS_DIR/$ARCH-osx-ghc-$GHC_VERSION -optl-lHSrts_thr-ghc$GHC_VERSION -optl-lffi" --constraint 'simplexmq +client_library +client_postgres' --constraint 'simplex-chat +client_library +client_postgres'
else
echo "Building with sqlite backend..."
cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-L$GHC_LIBS_DIR/$ARCH-osx-ghc-$GHC_VERSION -optl-lHSrts_thr-ghc$GHC_VERSION -optl-lffi" --constraint 'simplexmq +client_library' --constraint 'simplex-chat +client_library'
cabal build lib:simplex-chat lib:simplex-chat --ghc-options="-optl-Wl,-rpath,@loader_path -optl-Wl,-install_name,@rpath/$LIB -optl-Wl,-L$GHC_LIBS_DIR/$ARCH-osx-ghc-$GHC_VERSION -optl-lHSrts_thr-ghc$GHC_VERSION -optl-lffi" --constraint 'simplexmq +client_library' --constraint 'simplex-chat +client_library'
fi
cd $BUILD_DIR/build
mv libHSsimplex-chat-*-inplace-ghc*.$LIB_EXT libsimplex.dylib 2> /dev/null || true
mkdir deps 2> /dev/null || true
# It's not included by default for some reason. Compiled lib tries to find system one but it's not always available
@@ -103,7 +104,7 @@ rm -rf apps/multiplatform/desktop/build/cmake
mkdir -p apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
cp -r $BUILD_DIR/build/deps/* apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
cp $BUILD_DIR/build/libHSsimplex-chat-*-inplace-ghc*.$LIB_EXT apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
cp $BUILD_DIR/build/$LIB apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
cd apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
+1 -1
View File
@@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."c4b687ba644d8f0581a9f4317b6211c493a8d685" = "0s6wnmxjjr3fgfayyn0rdgwkqsg4z6da6ha0sq78mavvplwhg21m";
"https://github.com/simplex-chat/simplexmq.git"."6aadcf1f3fc19cbc0c8be457556fbaaffb0bfc46" = "1qlm542jnik48zid3zy7iys7ybjmlmj3mjhc5aplfk410a5qsb93";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
+4 -2
View File
@@ -125,7 +125,8 @@ library
Simplex.Chat.Store.Postgres.Migrations.M20251117_member_relations_vector
Simplex.Chat.Store.Postgres.Migrations.M20251128_migrate_member_relations
Simplex.Chat.Store.Postgres.Migrations.M20251230_strict_tables
Simplex.Chat.Store.Postgres.Migrations.M20260106_chat_relays
Simplex.Chat.Store.Postgres.Migrations.M20260108_chat_indices
Simplex.Chat.Store.Postgres.Migrations.M20260109_chat_relays
else
exposed-modules:
Simplex.Chat.Archive
@@ -274,7 +275,8 @@ library
Simplex.Chat.Store.SQLite.Migrations.M20251117_member_relations_vector
Simplex.Chat.Store.SQLite.Migrations.M20251128_migrate_member_relations
Simplex.Chat.Store.SQLite.Migrations.M20251230_strict_tables
Simplex.Chat.Store.SQLite.Migrations.M20260106_chat_relays
Simplex.Chat.Store.SQLite.Migrations.M20260108_chat_indices
Simplex.Chat.Store.SQLite.Migrations.M20260109_chat_relays
other-modules:
Paths_simplex_chat
hs-source-dirs:
+2
View File
@@ -316,6 +316,7 @@ data ChatCommand
| APIGetChatTags UserId
| APIGetChats {userId :: UserId, pendingConnections :: Bool, pagination :: PaginationByTime, query :: ChatListQuery}
| APIGetChat {chatRef :: ChatRef, contentTag :: Maybe MsgContentTag, chatPagination :: ChatPagination, search :: Maybe Text}
| APIGetChatContentTypes ChatRef
| APIGetChatItems {chatPagination :: ChatPagination, search :: Maybe Text}
| APIGetChatItemInfo {chatRef :: ChatRef, chatItemId :: ChatItemId}
| APISendMessages {sendRef :: SendRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessages :: NonEmpty ComposedMessage}
@@ -642,6 +643,7 @@ data ChatResponse
| CRApiChats {user :: User, chats :: [AChat]}
| CRChats {chats :: [AChat]}
| CRApiChat {user :: User, chat :: AChat, navInfo :: Maybe NavigationInfo}
| CRChatContentTypes {contentTypes :: [MsgContentTag]}
| CRChatTags {user :: User, userTags :: [ChatTag]}
| CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]}
| CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo}
+5 -4
View File
@@ -543,16 +543,14 @@ processChatCommand vr nm = \case
APIGetChat (ChatRef cType cId scope_) contentFilter pagination search -> withUser $ \user -> case cType of
-- TODO optimize queries calculating ChatStats, currently they're disabled
CTDirect -> do
when (isJust contentFilter) $ throwCmdError "content filter not supported"
(directChat, navInfo) <- withFastStore (\db -> getDirectChat db vr user cId pagination search)
(directChat, navInfo) <- withFastStore (\db -> getDirectChat db vr user cId contentFilter pagination search)
pure $ CRApiChat user (AChat SCTDirect directChat) navInfo
CTGroup -> do
(groupChat, navInfo) <- withFastStore (\db -> getGroupChat db vr user cId scope_ contentFilter pagination search)
groupChat' <- checkSupportChatAttention user groupChat
pure $ CRApiChat user (AChat SCTGroup groupChat') navInfo
CTLocal -> do
when (isJust contentFilter) $ throwCmdError "content filter not supported"
(localChat, navInfo) <- withFastStore (\db -> getLocalChat db user cId pagination search)
(localChat, navInfo) <- withFastStore (\db -> getLocalChat db user cId contentFilter pagination search)
pure $ CRApiChat user (AChat SCTLocal localChat) navInfo
CTContactRequest -> throwCmdError "not implemented"
CTContactConnection -> throwCmdError "not supported"
@@ -578,6 +576,8 @@ processChatCommand vr nm = \case
newFromMember (CChatItem _ ChatItem {chatDir = CIGroupRcv m, meta = CIMeta {itemStatus = CISRcvNew}}) =
groupMemberId' m == scopeGMId
newFromMember _ = False
APIGetChatContentTypes chatRef -> withUser $ \user ->
CRChatContentTypes <$> withStore (\db -> getChatContentTypes db user chatRef)
APIGetChatItems pagination search -> withUser $ \user -> do
chatItems <- withFastStore $ \db -> getAllChatItems db vr user pagination search
pure $ CRChatItems user Nothing chatItems
@@ -4413,6 +4413,7 @@ chatCommandP =
<*> (A.space *> jsonP <|> pure clqNoFilters)
),
"/_get chat " *> (APIGetChat <$> chatRefP <*> optional (" content=" *> strP) <* A.space <*> chatPaginationP <*> optional (" search=" *> textP)),
"/_get content types " *> (APIGetChatContentTypes <$> chatRefP),
"/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> textP)),
"/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal),
"/_send " *> (APISendMessages <$> sendRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)),
+9 -9
View File
@@ -707,8 +707,8 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
if
| inline -> do
-- accepting inline
ci <- withStore $ \db -> acceptRcvInlineFT db vr user fileId filePath
sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId
(ci, sharedMsgId) <- withStore $ \db ->
liftM2 (,) (acceptRcvInlineFT db vr user fileId filePath) (getSharedMsgIdByFileId db userId fileId)
send $ XFileAcptInv sharedMsgId Nothing fName
pure ci
| fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName
@@ -925,9 +925,11 @@ acceptGroupJoinRequestAsync
incognitoProfile = do
gVar <- asks random
let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted
(groupMemberId, memberId) <- withStore $ \db ->
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ welcomeMsgId_ gLinkMemRole initialStatus
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
((groupMemberId, memberId), currentMemCount) <- withStore $ \db ->
liftM2
(,)
(createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ welcomeMsgId_ gLinkMemRole initialStatus)
(liftIO $ getGroupCurrentMembersCount db user gInfo)
let Profile {displayName} = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile)
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
msg =
@@ -1041,15 +1043,13 @@ introduceToModerators vr user gInfo@GroupInfo {groupId} m@GroupMember {memberRol
introduceToAll :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceToAll vr user gInfo m = do
members <- withStore' $ \db -> getGroupMembers db vr user gInfo
vector <- withStore (`getMemberRelationsVector` m)
(members, vector) <- withStore $ \db -> liftM2 (,) (liftIO $ getGroupMembers db vr user gInfo) (getMemberRelationsVector db m)
let recipients = filter (shouldIntroduce m vector) members
introduceMember user gInfo m recipients Nothing
introduceToRemaining :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceToRemaining vr user gInfo m = do
members <- withStore' $ \db -> getGroupMembers db vr user gInfo
vector <- withStore (`getMemberRelationsVector` m)
(members, vector) <- withStore $ \db -> liftM2 (,) (liftIO $ getGroupMembers db vr user gInfo) (getMemberRelationsVector db m)
let recipients = filter (shouldIntroduce m vector) members
introduceMember user gInfo m recipients Nothing
+45 -36
View File
@@ -691,9 +691,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- TODO REMOVE LEGACY vvv
-- [async agent commands] group link auto-accept continuation on receiving INV
CFCreateConnGrpInv -> do
ct <- withStore $ \db -> getContactViaMember db vr user m
withStore' $ \db -> setNewContactMemberConnRequest db user m cReq
groupLinkId <- withStore' $ \db -> getGroupLinkId db user gInfo
(ct, groupLinkId) <- withStore $ \db -> do
ct <- getContactViaMember db vr user m
liftIO $ setNewContactMemberConnRequest db user m cReq
liftIO $ (ct,) <$> getGroupLinkId db user gInfo
sendGrpInvitation ct m groupLinkId
toView $ CEvtSentGroupInvitation user gInfo ct m
where
@@ -1814,8 +1815,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
ts@(_, ft_) = msgContentTexts mc
live = fromMaybe False live_
updateRcvChatItem = do
cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user gInfo groupMemberId sharedMsgId
scopeInfo <- withStore $ \db -> getGroupChatScopeInfoForItem db vr user gInfo (cChatItemId cci)
(cci, scopeInfo) <- withStore $ \db -> do
cci <- getGroupChatItemBySharedMsgId db user gInfo groupMemberId sharedMsgId
(cci,) <$> getGroupChatScopeInfoForItem db vr user gInfo (cChatItemId cci)
case cci of
CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} ->
if sameMemberId memberId m'
@@ -1948,8 +1950,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xFileCancel :: Contact -> SharedMsgId -> CM ()
xFileCancel Contact {contactId} sharedMsgId = do
fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId
ft <- withStore (\db -> getRcvFileTransfer db user fileId)
(fileId, ft) <- withStore $ \db -> do
fileId <- getFileIdBySharedMsgId db userId contactId sharedMsgId
(fileId,) <$> getRcvFileTransfer db user fileId
unless (rcvFileCompleteOrCancelled ft) $ do
cancelRcvFileTransfer user ft
ci <- withStore $ \db -> getChatItemByFileId db vr user fileId
@@ -1957,8 +1960,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xFileAcptInv :: Contact -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM ()
xFileAcptInv ct sharedMsgId fileConnReq_ fName = do
fileId <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId
(AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId
(fileId, AChatItem _ _ _ ci) <- withStore $ \db -> do
fileId <- getDirectFileIdBySharedMsgId db user ct sharedMsgId
(fileId,) <$> getChatItemByFileId db vr user fileId
assertSMPAcceptNotProhibited ci
ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId)
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
@@ -2033,8 +2037,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xFileCancelGroup g@GroupInfo {groupId} GroupMember {memberId} sharedMsgId = do
(fileId, aci) <- withStore $ \db -> do
fileId <- getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
aci <- getChatItemByFileId db vr user fileId
pure (fileId, aci)
(fileId,) <$> getChatItemByFileId db vr user fileId
case aci of
AChatItem SCTGroup SMDRcv (GroupChat _g scopeInfo) ChatItem {chatDir = CIGroupRcv m} -> do
if sameMemberId memberId m
@@ -2051,8 +2054,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM ()
xFileAcptInvGroup GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName = do
fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
(AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId
(fileId, AChatItem _ _ _ ci) <- withStore $ \db -> do
fileId <- getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
(fileId,) <$> getChatItemByFileId db vr user fileId
assertSMPAcceptNotProhibited ci
-- TODO check that it's not already accepted
ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId)
@@ -2123,8 +2127,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xDirectDel c msg msgMeta =
if directOrUsed c
then do
ct' <- withStore' $ \db -> updateContactStatus db user c CSDeleted
contactConns <- withStore' $ \db -> getContactConnections db vr userId ct'
(ct', contactConns) <- withStore' $ \db -> do
ct' <- updateContactStatus db user c CSDeleted
(ct',) <$> getContactConnections db vr userId ct'
deleteAgentConnectionsAsync $ map aConnId contactConns
forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted
activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted}
@@ -2496,15 +2501,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
associateMemberWithContact :: Contact -> GroupMember -> CM Contact
associateMemberWithContact c1 m2@GroupMember {groupId} = do
withStore' $ \db -> associateMemberWithContactRecord db user c1 m2
g <- withStore $ \db -> getGroupInfo db vr user groupId
g <- withStore $ \db -> do
liftIO $ associateMemberWithContactRecord db user c1 m2
getGroupInfo db vr user groupId
toView $ CEvtContactAndMemberAssociated user c1 g m2 c1
pure c1
associateContactWithMember :: GroupMember -> Contact -> CM Contact
associateContactWithMember m1@GroupMember {groupId} c2 = do
c2' <- withStore $ \db -> associateContactWithMemberRecord db vr user m1 c2
g <- withStore $ \db -> getGroupInfo db vr user groupId
(c2', g) <- withStore $ \db ->
liftM2 (,) (associateContactWithMemberRecord db vr user m1 c2) (getGroupInfo db vr user groupId)
toView $ CEvtContactAndMemberAssociated user c2 g m1 c2'
pure c2'
@@ -2622,19 +2628,21 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memChatVRange _) IntroInvitation {groupConnReq, directConnReq} = do
let GroupMember {memberId = membershipMemId} = membership
checkHostRole m memRole
toMember <-
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
toMember <- withStore $ \db -> do
toMember <- getGroupMemberByMemberId db vr user gInfo memId
-- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent
-- the situation when member does not exist is an error
-- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
-- For now, this branch compensates for the lack of delayed message delivery.
Left _ -> withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
Right m' -> pure m'
-- TODO [knocking] separate pending statuses from GroupMemberStatus?
-- TODO add GSMemIntroInvitedPending, GSMemConnectedPending, etc.?
-- TODO keep as is? (GSMemIntroInvited has no purpose)
let newMemberStatus = if memberPending toMember then memberStatus toMember else GSMemIntroInvited
withStore' $ \db -> updateGroupMemberStatus db userId toMember newMemberStatus
`catchError` \case
SEGroupMemberNotFoundByMemberId _ -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
e -> throwError e
-- TODO [knocking] separate pending statuses from GroupMemberStatus?
-- TODO add GSMemIntroInvitedPending, GSMemConnectedPending, etc.?
-- TODO keep as is? (GSMemIntroInvited has no purpose)
let newMemberStatus = if memberPending toMember then memberStatus toMember else GSMemIntroInvited
liftIO $ updateGroupMemberStatus db userId toMember newMemberStatus
pure toMember
subMode <- chatReadVar subscriptionMode
-- [incognito] send membership incognito profile, create direct connection as incognito
let membershipProfile = redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership
@@ -3021,14 +3029,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
updateGroupItemsStatus :: GroupInfo -> GroupMember -> Connection -> AgentMsgId -> GroupSndStatus -> Maybe Bool -> CM ()
updateGroupItemsStatus gInfo@GroupInfo {groupId} GroupMember {groupMemberId} Connection {connId} msgId newMemStatus viaProxy_ = do
items <- withStore' (\db -> getGroupChatItemsByAgentMsgId db user groupId connId msgId)
cis <- catMaybes <$> withStore (\db -> mapM (updateItem db) items)
-- SENT and RCVD events are received for messages that may be batched in single scope,
-- so we can look up scope of first item
scopeInfo <- case cis of
(ci : _) -> withStore $ \db -> getGroupChatScopeInfoForItem db vr user gInfo (chatItemId' ci)
_ -> pure Nothing
let acis = map (gItem scopeInfo) cis
acis <- withStore $ \db -> do
items <- liftIO $ getGroupChatItemsByAgentMsgId db user groupId connId msgId
cis <- catMaybes <$> mapM (updateItem db) items
-- SENT and RCVD events are received for messages that may be batched in single scope,
-- so we can look up scope of first item
scopeInfo <- case cis of
(ci : _) -> getGroupChatScopeInfoForItem db vr user gInfo (chatItemId' ci)
_ -> pure Nothing
pure $ map (gItem scopeInfo) cis
unless (null acis) $ toView $ CEvtChatItemsStatusesUpdated user acis
where
gItem scopeInfo ci = AChatItem SCTGroup SMDSnd (GroupChat gInfo scopeInfo) ci
+2
View File
@@ -518,6 +518,8 @@ instance ToJSON MsgContentTag where
toJSON = strToJSON
toEncoding = strToJEncoding
instance FromField MsgContentTag where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
instance ToField MsgContentTag where toField = toField . safeDecodeUtf8 . strEncode
data MsgContainer
+6 -7
View File
@@ -184,7 +184,6 @@ import Simplex.Messaging.Util (eitherToMaybe, firstRow', safeDecodeUtf8, ($>>=),
import Simplex.Messaging.Version
import UnliftIO.STM
#if defined(dbPostgres)
import qualified Data.Set as S
import Database.PostgreSQL.Simple (In (..), Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
@@ -1603,11 +1602,11 @@ setMemberVectorNewRelations db GroupMember {groupMemberId} relations = do
v_ <- maybeFirstRow fromOnly $
DB.query
db
( "SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
#if defined(dbPostgres)
"SELECT member_relations_vector FROM group_members WHERE group_member_id = ? FOR UPDATE"
#else
"SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
<> " FOR UPDATE"
#endif
)
(Only groupMemberId)
let v' = setNewRelations relations $ fromMaybe B.empty v_
currentTs <- getCurrentTime
@@ -1645,11 +1644,11 @@ setMemberVectorRelationConnected db GroupMember {groupMemberId} GroupMember {ind
firstRow fromOnly (SEMemberRelationsVectorNotFound groupMemberId) $
DB.query
db
( "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL"
#if defined(dbPostgres)
"SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL FOR UPDATE"
#else
"SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL"
<> " FOR UPDATE"
#endif
)
(Only groupMemberId)
let v' = setRelationConnected indexInGroup newStatus v
currentTs <- liftIO getCurrentTime
+197 -242
View File
@@ -45,6 +45,7 @@ module Simplex.Chat.Store.Messages
createNewChatItem_,
getChatPreviews,
checkContactHasItems,
getChatContentTypes,
getDirectChat,
getGroupChat,
getGroupChatScopeInfoForItem,
@@ -52,7 +53,6 @@ module Simplex.Chat.Store.Messages
getDirectChatItemLast,
getAllChatItems,
getAChatItem,
getAChatItemBySharedMsgId,
updateDirectChatItem,
updateDirectChatItem',
addInitialAndNewCIVersions,
@@ -1167,40 +1167,44 @@ checkContactHasItems db User {userId} Contact {contactId} =
"SELECT EXISTS (SELECT 1 FROM chat_items WHERE user_id = ? AND contact_id = ?)"
(userId, contactId)
getDirectChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChat db vr user contactId pagination search_ = do
getChatContentTypes :: DB.Connection -> User -> ChatRef -> ExceptT StoreError IO [MsgContentTag]
getChatContentTypes db User {userId} (ChatRef cType chatId chatScope_) = case cType of
CTDirect -> getTypes " contact_id = ? " ()
CTLocal -> getTypes " note_folder_id = ? " ()
CTGroup -> case chatScope_ of
Nothing -> getTypes " group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL " ()
Just (GCSMemberSupport mId_) -> getTypes " group_id = ? AND group_scope_tag = ? AND group_scope_group_member_id IS NOT DISTINCT FROM ? " (GCSTMemberSupport_, mId_)
_ -> throwError $ SEInternalError "unsupported chat type"
where
getTypes :: ToRow p => Query -> p -> ExceptT StoreError IO [MsgContentTag]
getTypes cond params =
liftIO $ map fromOnly
<$> DB.query
db
("SELECT DISTINCT msg_content_tag FROM chat_items WHERE user_id = ? AND " <> cond <> " AND msg_content_tag IS NOT NULL ORDER BY msg_content_tag")
((userId, chatId) :. params)
getDirectChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChat db vr user contactId contentFilter pagination search_ = do
let search = fromMaybe "" search_
ct <- getContact db vr user contactId
case pagination of
CPLast count -> liftIO $ (,Nothing) <$> getDirectChatLast_ db user ct count search
CPAfter afterId count -> (,Nothing) <$> getDirectChatAfter_ db user ct afterId count search
CPBefore beforeId count -> (,Nothing) <$> getDirectChatBefore_ db user ct beforeId count search
CPAround aroundId count -> getDirectChatAround_ db user ct aroundId count search
CPLast count -> (,Nothing) <$> getDirectChatLast_ db user ct contentFilter count search
CPAfter afterId count -> (,Nothing) <$> getDirectChatAfter_ db user ct contentFilter afterId count search
CPBefore beforeId count -> (,Nothing) <$> getDirectChatBefore_ db user ct contentFilter beforeId count search
CPAround aroundId count -> getDirectChatAround_ db user ct contentFilter aroundId count search
CPInitial count -> do
unless (T.null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
getDirectChatInitial_ db user ct count
getDirectChatInitial_ db user ct contentFilter count
-- the last items in reverse order (the last item in the conversation is the first in the returned list)
getDirectChatLast_ :: DB.Connection -> User -> Contact -> Int -> Text -> IO (Chat 'CTDirect)
getDirectChatLast_ db user ct count search = do
ciIds <- getDirectChatItemIdsLast_ db user ct count search
ts <- getCurrentTime
cis <- mapM (safeGetDirectItem db user ct ts) ciIds
pure $ Chat (DirectChat ct) (reverse cis) emptyChatStats
getDirectChatItemIdsLast_ :: DB.Connection -> User -> Contact -> Int -> Text -> IO [ChatItemId]
getDirectChatItemIdsLast_ db User {userId} Contact {contactId} count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, contactId, search, count)
getDirectChatLast_ :: DB.Connection -> User -> Contact -> Maybe MsgContentTag -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatLast_ db user ct contentFilter count search = do
let cInfo = DirectChat ct
ciIds <- getChatItemIDs db user cInfo contentFilter CRLast count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetDirectItem db user ct ts) ciIds
pure $ Chat cInfo (reverse cis) emptyChatStats
safeGetDirectItem :: DB.Connection -> User -> Contact -> UTCTime -> ChatItemId -> IO (CChatItem 'CTDirect)
safeGetDirectItem db user ct currentTs itemId =
@@ -1235,91 +1239,71 @@ getDirectChatItemLast db user@User {userId} contactId = do
ExceptT . firstRow fromOnly (SEChatItemNotFoundByContactId contactId) $
DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ?
ORDER BY created_at DESC, chat_item_id DESC
LIMIT 1
|]
( [sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ?
ORDER BY created_at DESC, chat_item_id DESC
LIMIT 1
|]
#if defined(dbPostgres)
<> " FOR UPDATE"
#endif
)
(userId, contactId)
getDirectChatItem db user contactId chatItemId
getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatAfter_ db user ct@Contact {contactId} afterId count search = do
getDirectChatAfter_ :: DB.Connection -> User -> Contact -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatAfter_ db user ct@Contact {contactId} contentFilter afterId count search = do
afterCI <- getDirectChatItem db user contactId afterId
ciIds <- liftIO $ getDirectCIsAfter_ db user ct afterCI count search
let cInfo = DirectChat ct
range = CRAfter (ciCreatedAt afterCI) (cChatItemId afterCI)
ciIds <- getChatItemIDs db user cInfo contentFilter range count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetDirectItem db user ct ts) ciIds
pure $ Chat (DirectChat ct) cis emptyChatStats
pure $ Chat cInfo cis emptyChatStats
getDirectCIsAfter_ :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> Int -> Text -> IO [ChatItemId]
getDirectCIsAfter_ db User {userId} Contact {contactId} afterCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
|]
(userId, contactId, search, ciCreatedAt afterCI, ciCreatedAt afterCI, cChatItemId afterCI, count)
getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatBefore_ db user ct@Contact {contactId} beforeId count search = do
getDirectChatBefore_ :: DB.Connection -> User -> Contact -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChatBefore_ db user ct@Contact {contactId} contentFilter beforeId count search = do
beforeCI <- getDirectChatItem db user contactId beforeId
ciIds <- liftIO $ getDirectCIsBefore_ db user ct beforeCI count search
let cInfo = DirectChat ct
range = CRBefore (ciCreatedAt beforeCI) (cChatItemId beforeCI)
ciIds <- getChatItemIDs db user cInfo contentFilter range count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetDirectItem db user ct ts) ciIds
pure $ Chat (DirectChat ct) (reverse cis) emptyChatStats
pure $ Chat cInfo (reverse cis) emptyChatStats
getDirectCIsBefore_ :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> Int -> Text -> IO [ChatItemId]
getDirectCIsBefore_ db User {userId} Contact {contactId} beforeCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, contactId, search, ciCreatedAt beforeCI, ciCreatedAt beforeCI, cChatItemId beforeCI, count)
getDirectChatAround_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround_ db user ct aroundId count search = do
getDirectChatAround_ :: DB.Connection -> User -> Contact -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround_ db user ct contentFilter aroundId count search = do
stats <- liftIO $ getContactStats_ db user ct
getDirectChatAround' db user ct aroundId count search stats
getDirectChatAround' db user ct contentFilter aroundId count search stats
getDirectChatAround' :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround' db user ct@Contact {contactId} aroundId count search stats = do
getDirectChatAround' :: DB.Connection -> User -> Contact -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatAround' db user ct@Contact {contactId} contentFilter aroundId count search stats = do
aroundCI <- getDirectChatItem db user contactId aroundId
beforeIds <- liftIO $ getDirectCIsBefore_ db user ct aroundCI count search
afterIds <- liftIO $ getDirectCIsAfter_ db user ct aroundCI count search
let cInfo = DirectChat ct
range r = r (ciCreatedAt aroundCI) (cChatItemId aroundCI)
beforeIds <- getChatItemIDs db user cInfo contentFilter (range CRBefore) count search
afterIds <- getChatItemIDs db user cInfo contentFilter (range CRAfter) count search
ts <- liftIO getCurrentTime
beforeCIs <- liftIO $ mapM (safeGetDirectItem db user ct ts) beforeIds
afterCIs <- liftIO $ mapM (safeGetDirectItem db user ct ts) afterIds
let cis = reverse beforeCIs <> [aroundCI] <> afterCIs
navInfo <- liftIO $ getNavInfo cis
pure (Chat (DirectChat ct) cis stats, Just navInfo)
pure (Chat cInfo cis stats, Just navInfo)
where
getNavInfo cis_ = case cis_ of
[] -> pure $ NavigationInfo 0 0
cis -> getContactNavInfo_ db user ct (last cis)
getDirectChatInitial_ :: DB.Connection -> User -> Contact -> Int -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatInitial_ db user ct count = do
getDirectChatInitial_ :: DB.Connection -> User -> Contact -> Maybe MsgContentTag -> Int -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChatInitial_ db user ct contentFilter count = do
liftIO (getContactMinUnreadId_ db user ct) >>= \case
Just minUnreadItemId -> do
unreadCount <- liftIO $ getContactUnreadCount_ db user ct
let stats = emptyChatStats {unreadCount, minUnreadItemId}
getDirectChatAround' db user ct minUnreadItemId count "" stats
Nothing -> liftIO $ (,Just $ NavigationInfo 0 0) <$> getDirectChatLast_ db user ct count ""
getDirectChatAround' db user ct contentFilter minUnreadItemId count "" stats
Nothing -> (,Just $ NavigationInfo 0 0) <$> getDirectChatLast_ db user ct contentFilter count ""
getContactStats_ :: DB.Connection -> User -> Contact -> IO ChatStats
getContactStats_ db user ct = do
@@ -1468,64 +1452,81 @@ getGroupChatScopeForItem_ db itemId =
getGroupChatLast_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatLast_ db user g scopeInfo_ contentFilter count search stats = do
ciIds <- getGroupChatItemIDs db user g scopeInfo_ contentFilter GRLast count search
let cInfo = GroupChat g scopeInfo_
ciIds <- getChatItemIDs db user cInfo contentFilter CRLast count search
ts <- liftIO getCurrentTime
cis <- mapM (liftIO . safeGetGroupItem db user g ts) ciIds
pure $ Chat (GroupChat g scopeInfo_) (reverse cis) stats
pure $ Chat cInfo (reverse cis) stats
data GroupItemIDsRange = GRLast | GRAfter UTCTime ChatItemId | GRBefore UTCTime ChatItemId
data ChatItemIDsRange = CRLast | CRAfter UTCTime ChatItemId | CRBefore UTCTime ChatItemId
getGroupChatItemIDs :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> GroupItemIDsRange -> Int -> Text -> ExceptT StoreError IO [ChatItemId]
getGroupChatItemIDs db User {userId} GroupInfo {groupId} scopeInfo_ contentFilter range count search = case (scopeInfo_, contentFilter) of
(Nothing, Nothing) ->
liftIO $
idsQuery
(baseCond <> " AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL ")
(userId, groupId)
(Nothing, Just mcTag) ->
liftIO $
idsQuery
(baseCond <> " AND msg_content_tag = ? ")
(userId, groupId, mcTag)
(Just GCSIMemberSupport {groupMember_ = Just m}, Nothing) ->
liftIO $
idsQuery
(baseCond <> " AND group_scope_tag = ? AND group_scope_group_member_id = ? ")
(userId, groupId, GCSTMemberSupport_, groupMemberId' m)
(Just GCSIMemberSupport {groupMember_ = Nothing}, Nothing) ->
liftIO $
idsQuery
(baseCond <> " AND group_scope_tag = ? AND group_scope_group_member_id IS NULL ")
(userId, groupId, GCSTMemberSupport_)
(Just _scope, Just _mcTag) ->
throwError $ SEInternalError "group scope and content filter are not supported together"
getChatItemIDs :: DB.Connection -> User -> ChatInfo c -> Maybe MsgContentTag -> ChatItemIDsRange -> Int -> Text -> ExceptT StoreError IO [ChatItemId]
getChatItemIDs db User {userId} cInfo contentFilter range count search = case cInfo of
GroupChat GroupInfo {groupId} scopeInfo_ -> case (scopeInfo_, contentFilter) of
(Nothing, Nothing) ->
liftIO $
idsQuery
(grCond <> " AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL ")
(userId, groupId)
"item_ts"
(Nothing, Just mcTag) ->
liftIO $
idsQuery
(grCond <> " AND msg_content_tag = ? ")
(userId, groupId, mcTag)
"item_ts"
(Just GCSIMemberSupport {groupMember_ = m}, Nothing) ->
liftIO $
idsQuery
(grCond <> " AND group_scope_tag = ? AND group_scope_group_member_id IS NOT DISTINCT FROM ? ")
(userId, groupId, GCSTMemberSupport_, groupMemberId' <$> m)
"item_ts"
(Just _scope, Just _mcTag) ->
throwError $ SEInternalError "group scope and content filter are not supported together"
where
grCond = " user_id = ? AND group_id = ? "
DirectChat Contact {contactId} -> liftIO $ case contentFilter of
Nothing -> idsQuery ctCond (userId, contactId) "created_at"
Just mcTag -> idsQuery (ctCond <> " AND msg_content_tag = ? ") (userId, contactId, mcTag) "created_at"
where
ctCond = " user_id = ? AND contact_id = ? "
LocalChat NoteFolder {noteFolderId} -> liftIO $ case contentFilter of
Nothing -> idsQuery nfCond (userId, noteFolderId) "created_at"
Just mcTag -> idsQuery (nfCond <> " AND msg_content_tag = ? ") (userId, noteFolderId, mcTag) "created_at"
where
nfCond = " user_id = ? AND note_folder_id = ? "
_ -> throwError $ SEInternalError "unsupported chat type"
where
baseQuery = " SELECT chat_item_id FROM chat_items WHERE "
baseCond = " user_id = ? AND group_id = ? "
idsQuery :: ToRow p => Query -> p -> IO [ChatItemId]
idsQuery c p = case range of
GRLast -> rangeQuery c p " ORDER BY item_ts DESC, chat_item_id DESC "
GRAfter ts itemId ->
-- parameterized by timestamp field `f` used to order chat items:
-- `item_ts` for groups, `created_at` for direct chats and notes.
idsQuery :: ToRow p => Query -> p -> Query -> IO [ChatItemId]
idsQuery c p f = case range of
CRLast -> rangeQuery c p (" ORDER BY " <> f <> " DESC, chat_item_id DESC ")
CRAfter ts itemId ->
rangeQuery
(" item_ts > ? " `orCond` " item_ts = ? AND chat_item_id > ? ")
((f <> " > ?") `orCond` (f <> " = ? AND chat_item_id > ?"))
(orParams ts itemId)
" ORDER BY item_ts ASC, chat_item_id ASC "
GRBefore ts itemId ->
(" ORDER BY " <> f <> " ASC, chat_item_id ASC ")
CRBefore ts itemId ->
rangeQuery
(" item_ts < ? " `orCond` " item_ts = ? AND chat_item_id < ? ")
((f <> " < ?") `orCond` (f <> " = ? AND chat_item_id < ?"))
(orParams ts itemId)
" ORDER BY item_ts DESC, chat_item_id DESC "
(" ORDER BY " <> f <> " DESC, chat_item_id DESC ")
where
-- `orCond` creates this query: `(c AND c1) OR (c AND c2)`,
-- that is equivalent to `c AND (c1 OR c2)`.
-- OR has to be used on the top level for query planner to use indices
-- that include fields in c1 and c2.
orCond c1 c2 = " ((" <> c <> " AND " <> c1 <> ") OR (" <> c <> " AND " <> c2 <> ")) "
orParams ts itemId = (p :. (Only ts) :. p :. (ts, itemId))
rangeQuery :: ToRow p => Query -> p -> Query -> IO [ChatItemId]
rangeQuery c p ob
| T.null search = searchQuery "" ()
| otherwise = searchQuery " AND LOWER(item_text) LIKE '%' || LOWER(?) || '%' " (Only search)
where
searchQuery :: ToRow p' => Query -> p' -> IO [ChatItemId]
searchQuery c' p' =
map fromOnly <$> DB.query db (baseQuery <> c <> c' <> ob <> " LIMIT ?") (p :. p' :. Only count)
rangeQuery c p ob =
map fromOnly
<$> if T.null search
then DB.query db (baseQuery <> c <> ob <> " LIMIT ?") (p :. Only count)
else DB.query db (baseQuery <> c <> searchCond <> ob <> " LIMIT ?") (p :. (search, count))
searchCond = " AND LOWER(item_text) LIKE '%' || LOWER(?) || '%' "
safeGetGroupItem :: DB.Connection -> User -> GroupInfo -> UTCTime -> ChatItemId -> IO (CChatItem 'CTGroup)
safeGetGroupItem db user g currentTs itemId =
@@ -1560,33 +1561,39 @@ getGroupMemberChatItemLast db user@User {userId} groupId groupMemberId = do
ExceptT . firstRow fromOnly (SEChatItemNotFoundByGroupId groupId) $
DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT 1
|]
( [sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT 1
|]
#if defined(dbPostgres)
<> " FOR UPDATE"
#endif
)
(userId, groupId, groupMemberId)
getGroupChatItem db user groupId chatItemId
getGroupChatAfter_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatAfter_ db user g@GroupInfo {groupId} scopeInfo contentFilter afterId count search = do
afterCI <- getGroupChatItem db user groupId afterId
let range = GRAfter (chatItemTs afterCI) (cChatItemId afterCI)
ciIds <- getGroupChatItemIDs db user g scopeInfo contentFilter range count search
let cInfo = GroupChat g scopeInfo
range = CRAfter (chatItemTs afterCI) (cChatItemId afterCI)
ciIds <- getChatItemIDs db user cInfo contentFilter range count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetGroupItem db user g ts) ciIds
pure $ Chat (GroupChat g scopeInfo) cis emptyChatStats
pure $ Chat cInfo cis emptyChatStats
getGroupChatBefore_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChatBefore_ db user g@GroupInfo {groupId} scopeInfo contentFilter beforeId count search = do
beforeCI <- getGroupChatItem db user groupId beforeId
let range = GRBefore (chatItemTs beforeCI) (cChatItemId beforeCI)
ciIds <- getGroupChatItemIDs db user g scopeInfo contentFilter range count search
let cInfo = GroupChat g scopeInfo
range = CRBefore (chatItemTs beforeCI) (cChatItemId beforeCI)
ciIds <- getChatItemIDs db user cInfo contentFilter range count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetGroupItem db user g ts) ciIds
pure $ Chat (GroupChat g scopeInfo) (reverse cis) emptyChatStats
pure $ Chat cInfo (reverse cis) emptyChatStats
getGroupChatAround_ :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround_ db user g scopeInfo contentFilter aroundId count search = do
@@ -1596,16 +1603,16 @@ getGroupChatAround_ db user g scopeInfo contentFilter aroundId count search = do
getGroupChatAround' :: DB.Connection -> User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChatAround' db user g scopeInfo contentFilter aroundId count search stats = do
aroundCI <- getGroupCIWithReactions db user g aroundId
let beforeRange = GRBefore (chatItemTs aroundCI) (cChatItemId aroundCI)
afterRange = GRAfter (chatItemTs aroundCI) (cChatItemId aroundCI)
beforeIds <- getGroupChatItemIDs db user g scopeInfo contentFilter beforeRange count search
afterIds <- getGroupChatItemIDs db user g scopeInfo contentFilter afterRange count search
let cInfo = GroupChat g scopeInfo
range r = r (chatItemTs aroundCI) (cChatItemId aroundCI)
beforeIds <- getChatItemIDs db user cInfo contentFilter (range CRBefore) count search
afterIds <- getChatItemIDs db user cInfo contentFilter (range CRAfter) count search
ts <- liftIO getCurrentTime
beforeCIs <- liftIO $ mapM (safeGetGroupItem db user g ts) beforeIds
afterCIs <- liftIO $ mapM (safeGetGroupItem db user g ts) afterIds
let cis = reverse beforeCIs <> [aroundCI] <> afterCIs
navInfo <- liftIO $ getNavInfo cis
pure (Chat (GroupChat g scopeInfo) cis stats, Just navInfo)
pure (Chat cInfo cis stats, Just navInfo)
where
getNavInfo cis_ = case cis_ of
[] -> pure $ NavigationInfo 0 0
@@ -1670,18 +1677,12 @@ queryUnreadGroupItems db User {userId} GroupInfo {groupId} scopeInfo_ contentFil
db
(baseQuery <> " AND msg_content_tag = ? AND item_status = ? " <> orderLimit)
(userId, groupId, mcTag, CISRcvNew)
(Just GCSIMemberSupport {groupMember_ = Just m}, Nothing) ->
(Just GCSIMemberSupport {groupMember_ = m}, Nothing) ->
liftIO $
DB.query
db
(baseQuery <> " AND group_scope_tag = ? AND group_scope_group_member_id = ? AND item_status = ? " <> orderLimit)
(userId, groupId, GCSTMemberSupport_, groupMemberId' m, CISRcvNew)
(Just GCSIMemberSupport {groupMember_ = Nothing}, Nothing) ->
liftIO $
DB.query
db
(baseQuery <> " AND group_scope_tag = ? AND group_scope_group_member_id IS NULL AND item_status = ? " <> orderLimit)
(userId, groupId, GCSTMemberSupport_, CISRcvNew)
(baseQuery <> " AND group_scope_tag = ? AND group_scope_group_member_id IS NOT DISTINCT FROM ? AND item_status = ? " <> orderLimit)
(userId, groupId, GCSTMemberSupport_, groupMemberId' <$> m, CISRcvNew)
(Just _scope, Just _mcTag) ->
throwError $ SEInternalError "group scope and content filter are not supported together"
@@ -1736,39 +1737,26 @@ getGroupNavInfo_ db User {userId} GroupInfo {groupId} afterCI = do
:. (userId, groupId, chatItemTs afterCI, cChatItemId afterCI)
)
getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChat db user folderId pagination search_ = do
getLocalChat :: DB.Connection -> User -> Int64 -> Maybe MsgContentTag -> ChatPagination -> Maybe Text -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChat db user folderId contentFilter pagination search_ = do
let search = fromMaybe "" search_
nf <- getNoteFolder db user folderId
case pagination of
CPLast count -> liftIO $ (,Nothing) <$> getLocalChatLast_ db user nf count search
CPAfter afterId count -> (,Nothing) <$> getLocalChatAfter_ db user nf afterId count search
CPBefore beforeId count -> (,Nothing) <$> getLocalChatBefore_ db user nf beforeId count search
CPAround aroundId count -> getLocalChatAround_ db user nf aroundId count search
CPLast count -> (,Nothing) <$> getLocalChatLast_ db user nf contentFilter count search
CPAfter afterId count -> (,Nothing) <$> getLocalChatAfter_ db user nf contentFilter afterId count search
CPBefore beforeId count -> (,Nothing) <$> getLocalChatBefore_ db user nf contentFilter beforeId count search
CPAround aroundId count -> getLocalChatAround_ db user nf contentFilter aroundId count search
CPInitial count -> do
unless (T.null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
getLocalChatInitial_ db user nf count
getLocalChatInitial_ db user nf contentFilter count
getLocalChatLast_ :: DB.Connection -> User -> NoteFolder -> Int -> Text -> IO (Chat 'CTLocal)
getLocalChatLast_ db user nf count search = do
ciIds <- getLocalChatItemIdsLast_ db user nf count search
ts <- getCurrentTime
cis <- mapM (safeGetLocalItem db user nf ts) ciIds
pure $ Chat (LocalChat nf) (reverse cis) emptyChatStats
getLocalChatItemIdsLast_ :: DB.Connection -> User -> NoteFolder -> Int -> Text -> IO [ChatItemId]
getLocalChatItemIdsLast_ db User {userId} NoteFolder {noteFolderId} count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, noteFolderId, search, count)
getLocalChatLast_ :: DB.Connection -> User -> NoteFolder -> Maybe MsgContentTag -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatLast_ db user nf contentFilter count search = do
let cInfo = LocalChat nf
ciIds <- getChatItemIDs db user cInfo contentFilter CRLast count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetLocalItem db user nf ts) ciIds
pure $ Chat cInfo (reverse cis) emptyChatStats
safeGetLocalItem :: DB.Connection -> User -> NoteFolder -> UTCTime -> ChatItemId -> IO (CChatItem 'CTLocal)
safeGetLocalItem db user NoteFolder {noteFolderId} currentTs itemId =
@@ -1797,81 +1785,57 @@ safeToLocalItem currentTs itemId = \case
file = Nothing
}
getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatAfter_ db user nf@NoteFolder {noteFolderId} afterId count search = do
getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatAfter_ db user nf@NoteFolder {noteFolderId} contentFilter afterId count search = do
afterCI <- getLocalChatItem db user noteFolderId afterId
ciIds <- liftIO $ getLocalCIsAfter_ db user nf afterCI count search
let cInfo = LocalChat nf
range = CRAfter (ciCreatedAt afterCI) (cChatItemId afterCI)
ciIds <- getChatItemIDs db user cInfo contentFilter range count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetLocalItem db user nf ts) ciIds
pure $ Chat (LocalChat nf) cis emptyChatStats
pure $ Chat cInfo cis emptyChatStats
getLocalCIsAfter_ :: DB.Connection -> User -> NoteFolder -> CChatItem 'CTLocal -> Int -> Text -> IO [ChatItemId]
getLocalCIsAfter_ db User {userId} NoteFolder {noteFolderId} afterCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
|]
(userId, noteFolderId, search, ciCreatedAt afterCI, ciCreatedAt afterCI, cChatItemId afterCI, count)
getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatBefore_ db user nf@NoteFolder {noteFolderId} beforeId count search = do
getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal)
getLocalChatBefore_ db user nf@NoteFolder {noteFolderId} contentFilter beforeId count search = do
beforeCI <- getLocalChatItem db user noteFolderId beforeId
ciIds <- liftIO $ getLocalCIsBefore_ db user nf beforeCI count search
let cInfo = LocalChat nf
range = CRBefore (ciCreatedAt beforeCI) (cChatItemId beforeCI)
ciIds <- getChatItemIDs db user cInfo contentFilter range count search
ts <- liftIO getCurrentTime
cis <- liftIO $ mapM (safeGetLocalItem db user nf ts) ciIds
pure $ Chat (LocalChat nf) (reverse cis) emptyChatStats
pure $ Chat cInfo (reverse cis) emptyChatStats
getLocalCIsBefore_ :: DB.Connection -> User -> NoteFolder -> CChatItem 'CTLocal -> Int -> Text -> IO [ChatItemId]
getLocalCIsBefore_ db User {userId} NoteFolder {noteFolderId} beforeCI count search =
map fromOnly
<$> DB.query
db
[sql|
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
|]
(userId, noteFolderId, search, ciCreatedAt beforeCI, ciCreatedAt beforeCI, cChatItemId beforeCI, count)
getLocalChatAround_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround_ db user nf aroundId count search = do
getLocalChatAround_ :: DB.Connection -> User -> NoteFolder -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround_ db user nf contentFilter aroundId count search = do
stats <- liftIO $ getLocalStats_ db user nf
getLocalChatAround' db user nf aroundId count search stats
getLocalChatAround' db user nf contentFilter aroundId count search stats
getLocalChatAround' :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround' db user nf@NoteFolder {noteFolderId} aroundId count search stats = do
getLocalChatAround' :: DB.Connection -> User -> NoteFolder -> Maybe MsgContentTag -> ChatItemId -> Int -> Text -> ChatStats -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatAround' db user nf@NoteFolder {noteFolderId} contentFilter aroundId count search stats = do
aroundCI <- getLocalChatItem db user noteFolderId aroundId
beforeIds <- liftIO $ getLocalCIsBefore_ db user nf aroundCI count search
afterIds <- liftIO $ getLocalCIsAfter_ db user nf aroundCI count search
let cInfo = LocalChat nf
range r = r (ciCreatedAt aroundCI) (cChatItemId aroundCI)
beforeIds <- getChatItemIDs db user cInfo contentFilter (range CRBefore) count search
afterIds <- getChatItemIDs db user cInfo contentFilter (range CRAfter) count search
ts <- liftIO getCurrentTime
beforeCIs <- liftIO $ mapM (safeGetLocalItem db user nf ts) beforeIds
afterCIs <- liftIO $ mapM (safeGetLocalItem db user nf ts) afterIds
let cis = reverse beforeCIs <> [aroundCI] <> afterCIs
navInfo <- liftIO $ getNavInfo cis
pure (Chat (LocalChat nf) cis stats, Just navInfo)
pure (Chat cInfo cis stats, Just navInfo)
where
getNavInfo cis_ = case cis_ of
[] -> pure $ NavigationInfo 0 0
cis -> getLocalNavInfo_ db user nf (last cis)
getLocalChatInitial_ :: DB.Connection -> User -> NoteFolder -> Int -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatInitial_ db user nf count = do
getLocalChatInitial_ :: DB.Connection -> User -> NoteFolder -> Maybe MsgContentTag -> Int -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChatInitial_ db user nf contentFilter count = do
liftIO (getLocalMinUnreadId_ db user nf) >>= \case
Just minUnreadItemId -> do
unreadCount <- liftIO $ getLocalUnreadCount_ db user nf
let stats = emptyChatStats {unreadCount, minUnreadItemId}
getLocalChatAround' db user nf minUnreadItemId count "" stats
Nothing -> liftIO $ (,Just $ NavigationInfo 0 0) <$> getLocalChatLast_ db user nf count ""
getLocalChatAround' db user nf contentFilter minUnreadItemId count "" stats
Nothing -> (,Just $ NavigationInfo 0 0) <$> getLocalChatLast_ db user nf contentFilter count ""
getLocalStats_ :: DB.Connection -> User -> NoteFolder -> IO ChatStats
getLocalStats_ db user nf = do
@@ -3243,15 +3207,6 @@ getAChatItem db vr user (ChatRef cType chatId scope) itemId = do
_ -> throwError $ SEChatItemNotFound itemId
liftIO $ getACIReactions db aci
getAChatItemBySharedMsgId :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> SharedMsgId -> ExceptT StoreError IO AChatItem
getAChatItemBySharedMsgId db user cd sharedMsgId = case cd of
CDDirectRcv ct@Contact {contactId} -> do
(CChatItem msgDir ci) <- getDirectChatItemBySharedMsgId db user contactId sharedMsgId
pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci
CDGroupRcv g scopeInfo GroupMember {groupMemberId} -> do
(CChatItem msgDir ci) <- getGroupChatItemBySharedMsgId db user g groupMemberId sharedMsgId
pure $ AChatItem SCTGroup msgDir (GroupChat g scopeInfo) ci
getChatItemVersions :: DB.Connection -> ChatItemId -> IO [ChatItemVersion]
getChatItemVersions db itemId = do
map toChatItemVersion
@@ -24,7 +24,8 @@ import Simplex.Chat.Store.Postgres.Migrations.M20251017_chat_tags_cascade
import Simplex.Chat.Store.Postgres.Migrations.M20251117_member_relations_vector
import Simplex.Chat.Store.Postgres.Migrations.M20251128_migrate_member_relations
import Simplex.Chat.Store.Postgres.Migrations.M20251230_strict_tables
import Simplex.Chat.Store.Postgres.Migrations.M20260106_chat_relays
import Simplex.Chat.Store.Postgres.Migrations.M20260108_chat_indices
import Simplex.Chat.Store.Postgres.Migrations.M20260109_chat_relays
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
@@ -49,7 +50,8 @@ schemaMigrations =
("20251117_member_relations_vector", m20251117_member_relations_vector, Just down_m20251117_member_relations_vector),
("20251128_migrate_member_relations", m20251128_migrate_member_relations, Just down_m20251128_migrate_member_relations),
("20251230_strict_tables", m20251230_strict_tables, Just down_m20251230_strict_tables),
("20260106_chat_relays", m20260106_chat_relays, Just down_m20260106_chat_relays)
("20260108_chat_indices", m20260108_chat_indices, Just down_m20260108_chat_indices),
("20260109_chat_relays", m20260109_chat_relays, Just down_m20260109_chat_relays)
]
-- | The list of migrations in ascending order by date
@@ -0,0 +1,33 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20260108_chat_indices where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20260108_chat_indices :: Text
m20260108_chat_indices =
[r|
CREATE INDEX idx_chat_items_contacts_msg_content_tag_created_at ON chat_items(
user_id,
contact_id,
msg_content_tag,
created_at
);
CREATE INDEX idx_chat_items_note_folder_msg_content_tag_created_at ON chat_items(
user_id,
note_folder_id,
msg_content_tag,
created_at
);
|]
down_m20260108_chat_indices :: Text
down_m20260108_chat_indices =
[r|
DROP INDEX idx_chat_items_contacts_msg_content_tag_created_at;
DROP INDEX idx_chat_items_note_folder_msg_content_tag_created_at;
|]
@@ -1,13 +1,13 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20260106_chat_relays where
module Simplex.Chat.Store.Postgres.Migrations.M20260109_chat_relays where
import Data.Text (Text)
import qualified Data.Text as T
import Text.RawString.QQ (r)
m20260106_chat_relays :: Text
m20260106_chat_relays =
m20260109_chat_relays :: Text
m20260109_chat_relays =
T.pack
[r|
CREATE TABLE chat_relays(
@@ -32,8 +32,8 @@ ALTER TABLE users ADD COLUMN is_user_chat_relay SMALLINT NOT NULL DEFAULT 0;
ALTER TABLE group_members ADD COLUMN is_chat_relay SMALLINT NOT NULL DEFAULT 0;
|]
down_m20260106_chat_relays :: Text
down_m20260106_chat_relays =
down_m20260109_chat_relays :: Text
down_m20260109_chat_relays =
T.pack
[r|
ALTER TABLE group_members DROP COLUMN is_chat_relay;
@@ -1856,6 +1856,10 @@ CREATE INDEX idx_chat_items_contacts_created_at ON test_chat_schema.chat_items U
CREATE INDEX idx_chat_items_contacts_msg_content_tag_created_at ON test_chat_schema.chat_items USING btree (user_id, contact_id, msg_content_tag, created_at);
CREATE UNIQUE INDEX idx_chat_items_direct_shared_msg_id ON test_chat_schema.chat_items USING btree (user_id, contact_id, shared_msg_id);
@@ -1940,6 +1944,10 @@ CREATE INDEX idx_chat_items_item_status ON test_chat_schema.chat_items USING btr
CREATE INDEX idx_chat_items_note_folder_msg_content_tag_created_at ON test_chat_schema.chat_items USING btree (user_id, note_folder_id, msg_content_tag, created_at);
CREATE INDEX idx_chat_items_notes ON test_chat_schema.chat_items USING btree (user_id, note_folder_id, item_status, created_at);
+4 -2
View File
@@ -147,7 +147,8 @@ import Simplex.Chat.Store.SQLite.Migrations.M20251017_chat_tags_cascade
import Simplex.Chat.Store.SQLite.Migrations.M20251117_member_relations_vector
import Simplex.Chat.Store.SQLite.Migrations.M20251128_migrate_member_relations
import Simplex.Chat.Store.SQLite.Migrations.M20251230_strict_tables
import Simplex.Chat.Store.SQLite.Migrations.M20260106_chat_relays
import Simplex.Chat.Store.SQLite.Migrations.M20260108_chat_indices
import Simplex.Chat.Store.SQLite.Migrations.M20260109_chat_relays
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -295,7 +296,8 @@ schemaMigrations =
("20251117_member_relations_vector", m20251117_member_relations_vector, Just down_m20251117_member_relations_vector),
("20251128_migrate_member_relations", m20251128_migrate_member_relations, Just down_m20251128_migrate_member_relations),
("20251230_strict_tables", m20251230_strict_tables, Just down_m20251230_strict_tables),
("20260106_chat_relays", m20260106_chat_relays, Just down_m20260106_chat_relays)
("20260108_chat_indices", m20260108_chat_indices, Just down_m20260108_chat_indices),
("20260109_chat_relays", m20260109_chat_relays, Just down_m20260109_chat_relays)
]
-- | The list of migrations in ascending order by date
@@ -0,0 +1,32 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20260108_chat_indices where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20260108_chat_indices :: Query
m20260108_chat_indices =
[sql|
CREATE INDEX idx_chat_items_contacts_msg_content_tag_created_at ON chat_items(
user_id,
contact_id,
msg_content_tag,
created_at
);
CREATE INDEX idx_chat_items_note_folder_msg_content_tag_created_at ON chat_items(
user_id,
note_folder_id,
msg_content_tag,
created_at
);
|]
down_m20260108_chat_indices :: Query
down_m20260108_chat_indices =
[sql|
DROP INDEX idx_chat_items_contacts_msg_content_tag_created_at;
DROP INDEX idx_chat_items_note_folder_msg_content_tag_created_at;
|]
@@ -1,12 +1,12 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20260106_chat_relays where
module Simplex.Chat.Store.SQLite.Migrations.M20260109_chat_relays where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20260106_chat_relays :: Query
m20260106_chat_relays =
m20260109_chat_relays :: Query
m20260109_chat_relays =
[sql|
CREATE TABLE chat_relays(
chat_relay_id INTEGER PRIMARY KEY,
@@ -30,8 +30,8 @@ ALTER TABLE users ADD COLUMN is_user_chat_relay INTEGER NOT NULL DEFAULT 0;
ALTER TABLE group_members ADD COLUMN is_chat_relay INTEGER NOT NULL DEFAULT 0;
|]
down_m20260106_chat_relays :: Query
down_m20260106_chat_relays =
down_m20260109_chat_relays :: Query
down_m20260109_chat_relays =
[sql|
ALTER TABLE group_members DROP COLUMN is_chat_relay;
@@ -59,6 +59,16 @@ Query:
Plan:
SEARCH commands USING INDEX idx_commands_server_commands (host=? AND port=?)
Query:
SELECT rcpt_status, snd_message_body_id FROM snd_messages
WHERE NOT EXISTS (SELECT 1 FROM snd_message_deliveries WHERE conn_id = ? AND internal_id = ? AND failed = 0)
AND conn_id = ? AND internal_id = ?
Plan:
SEARCH snd_messages USING PRIMARY KEY (conn_id=?)
SCALAR SUBQUERY 1
SEARCH snd_message_deliveries USING COVERING INDEX idx_snd_message_deliveries_expired (conn_id=?)
Query:
SELECT rcv_file_chunk_id, chunk_no, chunk_size, digest, tmp_path
FROM rcv_file_chunks
@@ -69,6 +79,14 @@ Plan:
SEARCH rcv_file_chunks USING INDEX idx_rcv_file_chunks_rcv_file_id (rcv_file_id=?)
USE TEMP B-TREE FOR ORDER BY
Query:
SELECT rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, deleted, redirect_id, redirect_entity_id, redirect_size, redirect_digest
FROM rcv_files
WHERE rcv_file_id = ?
Plan:
SEARCH rcv_files USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT snd_file_chunk_id, chunk_no, chunk_offset, chunk_size, digest
FROM snd_file_chunks
@@ -77,6 +95,14 @@ Query:
Plan:
SEARCH snd_file_chunks USING INDEX idx_snd_file_chunks_snd_file_id (snd_file_id=?)
Query:
SELECT snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, digest, prefix_path, key, nonce, status, deleted, redirect_size, redirect_digest
FROM snd_files
WHERE snd_file_id = ?
Plan:
SEARCH snd_files USING INTEGER PRIMARY KEY (rowid=?)
Query:
DELETE FROM snd_message_bodies
WHERE NOT EXISTS (SELECT 1 FROM snd_messages WHERE snd_message_body_id = ?)
@@ -201,24 +227,6 @@ SEARCH c USING INTEGER PRIMARY KEY (rowid=?)
SEARCH f USING INTEGER PRIMARY KEY (rowid=?)
USE TEMP B-TREE FOR ORDER BY
Query:
SELECT rcpt_status, snd_message_body_id FROM snd_messages
WHERE NOT EXISTS (SELECT 1 FROM snd_message_deliveries WHERE conn_id = ? AND internal_id = ? AND failed = 0)
AND conn_id = ? AND internal_id = ?
Plan:
SEARCH snd_messages USING PRIMARY KEY (conn_id=?)
SCALAR SUBQUERY 1
SEARCH snd_message_deliveries USING COVERING INDEX idx_snd_message_deliveries_expired (conn_id=?)
Query:
SELECT rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, deleted, redirect_id, redirect_entity_id, redirect_size, redirect_digest
FROM rcv_files
WHERE rcv_file_id = ?
Plan:
SEARCH rcv_files USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT rcv_file_id
FROM rcv_files
@@ -230,14 +238,6 @@ Plan:
SEARCH rcv_files USING INDEX idx_rcv_files_status_created_at (status=? AND created_at>?)
USE TEMP B-TREE FOR ORDER BY
Query:
SELECT snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, digest, prefix_path, key, nonce, status, deleted, redirect_size, redirect_digest
FROM snd_files
WHERE snd_file_id = ?
Plan:
SEARCH snd_files USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT snd_file_id
FROM snd_files
@@ -257,6 +257,22 @@ Query:
Plan:
SEARCH messages USING PRIMARY KEY (conn_id=?)
Query:
SELECT last_internal_msg_id, last_internal_rcv_msg_id, last_external_snd_msg_id, last_rcv_msg_hash
FROM connections
WHERE conn_id = ?
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
Query:
SELECT last_internal_msg_id, last_internal_snd_msg_id, last_snd_msg_hash
FROM connections
WHERE conn_id = ?
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
Query:
SELECT user_id FROM users u
WHERE u.user_id = ?
@@ -268,6 +284,15 @@ SEARCH u USING INTEGER PRIMARY KEY (rowid=?)
CORRELATED SCALAR SUBQUERY 1
SEARCH c USING COVERING INDEX idx_connections_user (user_id=?)
Query:
SELECT user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs,
last_external_snd_msg_id, deleted, ratchet_sync_state, pq_support
FROM connections
WHERE conn_id = ? AND deleted = ?
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
Query:
INSERT INTO conn_confirmations
(confirmation_id, conn_id, sender_key, e2e_snd_pub_key, ratchet_state, sender_conn_info, smp_reply_queues, smp_client_version, accepted) VALUES (?, ?, ?, ?, ?, ?, ?, ?, 0);
@@ -287,6 +312,18 @@ Query:
Plan:
Query:
INSERT INTO xftp_servers (xftp_host, xftp_port, xftp_key_hash)
VALUES (?, ?, ?)
ON CONFLICT (xftp_host, xftp_port, xftp_key_hash)
DO UPDATE SET xftp_host = EXCLUDED.xftp_host
RETURNING xftp_server_id
Plan:
SEARCH deleted_snd_chunk_replicas USING COVERING INDEX idx_deleted_snd_chunk_replicas_xftp_server_id (xftp_server_id=?)
SEARCH snd_file_chunk_replicas USING COVERING INDEX idx_snd_file_chunk_replicas_xftp_server_id (xftp_server_id=?)
SEARCH rcv_file_chunk_replicas USING COVERING INDEX idx_rcv_file_chunk_replicas_xftp_server_id (xftp_server_id=?)
Query:
SELECT
r.internal_id, m.internal_ts, r.broker_id, r.broker_ts, r.external_snd_id, r.integrity, r.internal_hash,
@@ -445,22 +482,6 @@ Query:
Plan:
SEARCH conn_invitations USING PRIMARY KEY (invitation_id=?)
Query:
SELECT last_internal_msg_id, last_internal_rcv_msg_id, last_external_snd_msg_id, last_rcv_msg_hash
FROM connections
WHERE conn_id = ?
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
Query:
SELECT last_internal_msg_id, last_internal_snd_msg_id, last_snd_msg_hash
FROM connections
WHERE conn_id = ?
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
Query:
SELECT link_id, snd_private_key
FROM inv_short_links
@@ -497,15 +518,6 @@ Plan:
SEARCH s USING PRIMARY KEY (conn_id=? AND internal_snd_id=?)
SEARCH m USING PRIMARY KEY (conn_id=? AND internal_id=?)
Query:
SELECT user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs,
last_external_snd_msg_id, deleted, ratchet_sync_state, pq_support
FROM connections
WHERE conn_id = ? AND deleted = ?
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
Query:
DELETE FROM conn_confirmations
WHERE conn_id = ?
@@ -1027,8 +1039,13 @@ Plan:
Query: INSERT INTO rcv_files (rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, redirect_id, redirect_entity_id, redirect_digest, redirect_size, approved_relays) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
Query: INSERT INTO servers (host, port, key_hash) VALUES (?,?,?)
Query: INSERT INTO servers (host, port, key_hash) VALUES (?,?,?) ON CONFLICT (host, port) DO NOTHING RETURNING 1
Plan:
SEARCH inv_short_links USING COVERING INDEX idx_inv_short_links_link_id (host=? AND port=?)
SEARCH commands USING COVERING INDEX idx_commands_server_commands (host=? AND port=?)
SEARCH ntf_subscriptions USING COVERING INDEX idx_ntf_subscriptions_smp_host_smp_port (smp_host=? AND smp_port=?)
SEARCH snd_queues USING COVERING INDEX idx_snd_queues_host_port (host=? AND port=?)
SEARCH rcv_queues USING COVERING INDEX idx_rcv_queues_link_id (host=? AND port=?)
Query: INSERT INTO skipped_messages (conn_id, header_key, msg_n, msg_key) VALUES (?, ?, ?, ?)
Plan:
@@ -1052,9 +1069,6 @@ Plan:
Query: INSERT INTO users DEFAULT VALUES
Plan:
Query: INSERT INTO xftp_servers (xftp_host, xftp_port, xftp_key_hash) VALUES (?,?,?)
Plan:
Query: SELECT 1 FROM encrypted_rcv_message_hashes WHERE conn_id = ? AND hash = ? LIMIT 1
Plan:
SEARCH encrypted_rcv_message_hashes USING COVERING INDEX idx_encrypted_rcv_message_hashes_hash (conn_id=? AND hash=?)
@@ -1159,10 +1173,6 @@ Query: SELECT x3dh_priv_key_1, x3dh_priv_key_2, pq_priv_kem FROM ratchets WHERE
Plan:
SEARCH ratchets USING PRIMARY KEY (conn_id=?)
Query: SELECT xftp_server_id FROM xftp_servers WHERE xftp_host = ? AND xftp_port = ? AND xftp_key_hash = ?
Plan:
SEARCH xftp_servers USING COVERING INDEX sqlite_autoindex_xftp_servers_1 (xftp_host=? AND xftp_port=? AND xftp_key_hash=?)
Query: UPDATE connections SET deleted = ? WHERE conn_id = ?
Plan:
SEARCH connections USING PRIMARY KEY (conn_id=?)
@@ -736,6 +736,26 @@ Query:
Plan:
SEARCH messages USING INDEX idx_messages_group_id_shared_msg_id (group_id=? AND shared_msg_id=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ?
ORDER BY created_at DESC, chat_item_id DESC
LIMIT 1
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT 1
Plan:
SEARCH chat_items USING INDEX idx_chat_items_groups_item_ts (user_id=? AND group_id=?)
Query:
SELECT chat_item_id, contact_id, group_id, group_scope_tag, group_scope_group_member_id, note_folder_id
FROM chat_items
@@ -745,7 +765,7 @@ Query:
LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_group_scope_item_ts (user_id=?)
SEARCH chat_items USING INDEX idx_chat_items_note_folder_msg_content_tag_created_at (user_id=?)
USE TEMP B-TREE FOR ORDER BY
Query:
@@ -756,7 +776,7 @@ Query:
LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_group_scope_item_ts (user_id=?)
SEARCH chat_items USING INDEX idx_chat_items_note_folder_msg_content_tag_created_at (user_id=?)
USE TEMP B-TREE FOR ORDER BY
Query:
@@ -1234,26 +1254,6 @@ Plan:
SEARCH c USING INDEX idx_connections_contact_id (contact_id=?)
SEARCH ct USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ?
ORDER BY created_at DESC, chat_item_id DESC
LIMIT 1
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
ORDER BY item_ts DESC, chat_item_id DESC
LIMIT 1
Plan:
SEARCH chat_items USING INDEX idx_chat_items_groups_item_ts (user_id=? AND group_id=?)
Query:
SELECT chat_item_id
FROM chat_items
@@ -1301,7 +1301,7 @@ Query:
LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_group_scope_item_ts (user_id=?)
SEARCH chat_items USING INDEX idx_chat_items_note_folder_msg_content_tag_created_at (user_id=?)
USE TEMP B-TREE FOR ORDER BY
Query:
@@ -3140,38 +3140,6 @@ SEARCH chat_item_messages USING INDEX sqlite_autoindex_chat_item_messages_1 (mes
LIST SUBQUERY 1
SEARCH msg_deliveries USING INDEX idx_msg_deliveries_agent_msg_id (connection_id=? AND agent_msg_id=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=?)
Query:
SELECT chat_item_id
FROM chat_items
@@ -3222,38 +3190,6 @@ Query:
Plan:
SEARCH chat_items USING INDEX idx_chat_items_group_id (group_id=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
ORDER BY created_at ASC, chat_item_id ASC
LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=?)
Query:
SELECT chat_item_id
FROM chat_items
WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%'
ORDER BY created_at DESC, chat_item_id DESC
LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=?)
Query:
SELECT chat_item_id
FROM chat_items
@@ -5222,7 +5158,7 @@ Query:
JOIN files f ON f.chat_item_id = i.chat_item_id
WHERE i.user_id = ?
Plan:
SEARCH i USING COVERING INDEX idx_chat_items_group_scope_item_ts (user_id=?)
SEARCH i USING COVERING INDEX idx_chat_items_note_folder_msg_content_tag_created_at (user_id=?)
SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?)
Query:
@@ -5492,7 +5428,25 @@ Query:
Plan:
SEARCH user_contact_links USING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?)
Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts < ? ) OR ( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts = ? AND chat_item_id < ? )) ORDER BY item_ts DESC, chat_item_id DESC LIMIT ?
Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND contact_id = ? AND created_at < ?) OR ( user_id = ? AND contact_id = ? AND created_at = ? AND chat_item_id < ?)) ORDER BY created_at DESC, chat_item_id DESC LIMIT ?
Plan:
MULTI-INDEX OR
INDEX 1
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=? AND created_at<?)
INDEX 2
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=? AND created_at=? AND rowid<?)
USE TEMP B-TREE FOR ORDER BY
Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND contact_id = ? AND created_at > ?) OR ( user_id = ? AND contact_id = ? AND created_at = ? AND chat_item_id > ?)) ORDER BY created_at ASC, chat_item_id ASC LIMIT ?
Plan:
MULTI-INDEX OR
INDEX 1
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=? AND created_at>?)
INDEX 2
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=? AND created_at=? AND rowid>?)
USE TEMP B-TREE FOR ORDER BY
Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts < ?) OR ( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts = ? AND chat_item_id < ?)) ORDER BY item_ts DESC, chat_item_id DESC LIMIT ?
Plan:
MULTI-INDEX OR
INDEX 1
@@ -5501,7 +5455,7 @@ INDEX 2
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_scope_item_ts (user_id=? AND group_id=? AND group_scope_tag=? AND group_scope_group_member_id=? AND item_ts=? AND rowid<?)
USE TEMP B-TREE FOR ORDER BY
Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts > ? ) OR ( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts = ? AND chat_item_id > ? )) ORDER BY item_ts ASC, chat_item_id ASC LIMIT ?
Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts > ?) OR ( user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND item_ts = ? AND chat_item_id > ?)) ORDER BY item_ts ASC, chat_item_id ASC LIMIT ?
Plan:
MULTI-INDEX OR
INDEX 1
@@ -5510,11 +5464,37 @@ INDEX 2
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_scope_item_ts (user_id=? AND group_id=? AND group_scope_tag=? AND group_scope_group_member_id=? AND item_ts=? AND rowid>?)
USE TEMP B-TREE FOR ORDER BY
Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_scope_tag = ? AND group_scope_group_member_id = ? ORDER BY item_ts DESC, chat_item_id DESC LIMIT ?
Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND note_folder_id = ? AND created_at < ?) OR ( user_id = ? AND note_folder_id = ? AND created_at = ? AND chat_item_id < ?)) ORDER BY created_at DESC, chat_item_id DESC LIMIT ?
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_scope_item_ts (user_id=? AND group_id=? AND group_scope_tag=? AND group_scope_group_member_id=?)
MULTI-INDEX OR
INDEX 1
SEARCH chat_items USING COVERING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=? AND created_at<?)
INDEX 2
SEARCH chat_items USING COVERING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=? AND created_at=? AND rowid<?)
USE TEMP B-TREE FOR ORDER BY
Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_scope_tag = ? AND group_scope_group_member_id IS NULL ORDER BY item_ts DESC, chat_item_id DESC LIMIT ?
Query: SELECT chat_item_id FROM chat_items WHERE (( user_id = ? AND note_folder_id = ? AND created_at > ?) OR ( user_id = ? AND note_folder_id = ? AND created_at = ? AND chat_item_id > ?)) ORDER BY created_at ASC, chat_item_id ASC LIMIT ?
Plan:
MULTI-INDEX OR
INDEX 1
SEARCH chat_items USING COVERING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=? AND created_at>?)
INDEX 2
SEARCH chat_items USING COVERING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=? AND created_at=? AND rowid>?)
USE TEMP B-TREE FOR ORDER BY
Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND contact_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%' ORDER BY created_at DESC, chat_item_id DESC LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=?)
Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND contact_id = ? AND msg_content_tag = ? ORDER BY created_at DESC, chat_item_id DESC LIMIT ?
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_msg_content_tag_created_at (user_id=? AND contact_id=? AND msg_content_tag=?)
Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND contact_id = ? ORDER BY created_at DESC, chat_item_id DESC LIMIT ?
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=?)
Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ? AND group_scope_tag = ? AND group_scope_group_member_id IS NOT DISTINCT FROM ? ORDER BY item_ts DESC, chat_item_id DESC LIMIT ?
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_scope_item_ts (user_id=? AND group_id=? AND group_scope_tag=? AND group_scope_group_member_id=?)
@@ -5530,6 +5510,18 @@ Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND group_id = ?
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_msg_content_tag_item_ts (user_id=? AND group_id=? AND msg_content_tag=?)
Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND note_folder_id = ? AND LOWER(item_text) LIKE '%' || LOWER(?) || '%' ORDER BY created_at DESC, chat_item_id DESC LIMIT ?
Plan:
SEARCH chat_items USING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=?)
Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND note_folder_id = ? AND msg_content_tag = ? ORDER BY created_at DESC, chat_item_id DESC LIMIT ?
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_note_folder_msg_content_tag_created_at (user_id=? AND note_folder_id=? AND msg_content_tag=?)
Query: SELECT chat_item_id FROM chat_items WHERE user_id = ? AND note_folder_id = ? ORDER BY created_at DESC, chat_item_id DESC LIMIT ?
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_notes_created_at (user_id=? AND note_folder_id=?)
Query: CREATE TABLE temp_delete_members (contact_profile_id INTEGER, member_profile_id INTEGER, local_display_name TEXT)
Error: SQLite3 returned ErrorError while attempting to perform prepare "explain query plan CREATE TABLE temp_delete_members (contact_profile_id INTEGER, member_profile_id INTEGER, local_display_name TEXT)": table temp_delete_members already exists
@@ -5933,7 +5925,7 @@ SEARCH protocol_servers USING COVERING INDEX idx_smp_servers_user_id (user_id=?)
SEARCH settings USING COVERING INDEX idx_settings_user_id (user_id=?)
SEARCH commands USING COVERING INDEX idx_commands_user_id (user_id=?)
SEARCH calls USING COVERING INDEX idx_calls_user_id (user_id=?)
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_scope_item_ts (user_id=?)
SEARCH chat_items USING COVERING INDEX idx_chat_items_note_folder_msg_content_tag_created_at (user_id=?)
SEARCH contact_requests USING COVERING INDEX sqlite_autoindex_contact_requests_2 (user_id=?)
SEARCH user_contact_links USING COVERING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?)
SEARCH connections USING COVERING INDEX idx_connections_to_subscribe (user_id=?)
@@ -6081,6 +6073,18 @@ Query: SELECT COUNT(1), COALESCE(SUM(user_mention), 0) FROM chat_items WHERE use
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_scope_stats_all (user_id=? AND group_id=? AND group_scope_tag=? AND group_scope_group_member_id=? AND item_status=?)
Query: SELECT DISTINCT msg_content_tag FROM chat_items WHERE user_id = ? AND contact_id = ? AND msg_content_tag IS NOT NULL ORDER BY msg_content_tag
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_msg_content_tag_created_at (user_id=? AND contact_id=? AND msg_content_tag>?)
Query: SELECT DISTINCT msg_content_tag FROM chat_items WHERE user_id = ? AND group_id = ? AND group_scope_tag IS NULL AND group_scope_group_member_id IS NULL AND msg_content_tag IS NOT NULL ORDER BY msg_content_tag
Plan:
SEARCH chat_items USING INDEX idx_chat_items_groups_msg_content_tag_deleted (user_id=? AND group_id=? AND msg_content_tag>?)
Query: SELECT DISTINCT msg_content_tag FROM chat_items WHERE user_id = ? AND note_folder_id = ? AND msg_content_tag IS NOT NULL ORDER BY msg_content_tag
Plan:
SEARCH chat_items USING COVERING INDEX idx_chat_items_note_folder_msg_content_tag_created_at (user_id=? AND note_folder_id=? AND msg_content_tag>?)
Query: SELECT EXISTS (SELECT 1 FROM chat_items WHERE user_id = ? AND contact_id = ?)
Plan:
SCAN CONSTANT ROW
@@ -1203,6 +1203,18 @@ CREATE UNIQUE INDEX idx_group_members_group_id_index_in_group ON group_members(
group_id,
index_in_group
);
CREATE INDEX idx_chat_items_contacts_msg_content_tag_created_at ON chat_items(
user_id,
contact_id,
msg_content_tag,
created_at
);
CREATE INDEX idx_chat_items_note_folder_msg_content_tag_created_at ON chat_items(
user_id,
note_folder_id,
msg_content_tag,
created_at
);
CREATE INDEX idx_chat_relays_user_id ON chat_relays(user_id);
CREATE TRIGGER on_group_members_insert_update_summary
AFTER INSERT ON group_members
+1
View File
@@ -122,6 +122,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
CRApiChats u chats -> ttyUser u $ if testView then testViewChats chats else [viewJSON chats]
CRChats chats -> viewChats ts tz chats
CRApiChat u chat _ -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat]
CRChatContentTypes cts -> [plain $ "Chat content types: " <> T.intercalate ", " (map (safeDecodeUtf8 . strEncode) cts)]
CRChatTags u tags -> ttyUser u [viewJSON tags]
CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
CRServerOperatorConditions (ServerOperatorConditions ops _ ca) -> viewServerOperators ops ca
+6 -6
View File
@@ -1167,8 +1167,7 @@ testCapthaScreening ps =
bob <## "/'filter 1 off' - disable filter"
-- connect with captcha screen
_ <- join cath groupLink
cath ##> "/_send #1(_support) text 123" -- sending incorrect captcha
cath <# "#privacy (support) 123"
cath #> "#privacy (support) 123" -- sending incorrect captcha
cath <# "#privacy (support) 'SimpleX Directory'!> > cath 123"
cath <## " Incorrect text, please try again."
captcha <- dropStrPrefix "#privacy (support) 'SimpleX Directory'> " . dropTime <$> getTermLine cath
@@ -1220,8 +1219,7 @@ testCapthaScreening ps =
cath <## "Send captcha text to join the group privacy."
dropStrPrefix "#privacy (support) 'SimpleX Directory'> " . dropTime <$> getTermLine cath
sendCaptcha cath captcha = do
cath ##> ("/_send #1(_support) text " <> captcha)
cath <# ("#privacy (support) " <> captcha)
cath #> ("#privacy (support) " <> captcha)
cath <# ("#privacy (support) 'SimpleX Directory'!> > cath " <> captcha)
cath <## " Correct, you joined the group privacy"
cath <## "#privacy: you joined the group"
@@ -1411,8 +1409,10 @@ submitGroup u n fn = do
groupAccepted :: TestCC -> String -> IO String
groupAccepted u n = do
u <# ("'SimpleX Directory'> Joining the group " <> n <> "")
u <## ("#" <> viewName n <> ": 'SimpleX Directory' joined the group")
u <###
[ WithTime ("'SimpleX Directory'> Joining the group " <> n <> ""),
ConsoleString ("#" <> viewName n <> ": 'SimpleX Directory' joined the group")
]
u <# ("'SimpleX Directory'> Joined the group " <> n <> ", creating the link…")
u <# "'SimpleX Directory'> Created the public link to join the group via this directory service that is always online."
u <## ""
+12 -4
View File
@@ -84,7 +84,7 @@ schemaDumpDBOpts =
DBOpts
{ connstr = B.pack testDBConnstr,
schema = "test_chat_schema",
poolSize = 3,
poolSize = 10,
createSchema = True
}
@@ -131,7 +131,7 @@ testCoreOpts =
-- dbSchemaPrefix is not used in tests (except bot tests where it's redefined),
-- instead different schema prefix is passed per client so that single test database is used
dbSchemaPrefix = "",
dbPoolSize = 1,
dbPoolSize = 10,
dbCreateSchema = True
#else
{ dbFilePrefix = "./simplex_v1", -- dbFilePrefix is not used in tests (except bot tests where it's redefined)
@@ -428,7 +428,10 @@ testChatN cfg opts ps test params =
(<//) cc t = timeout t (getTermLine cc) `shouldReturn` Nothing
getTermLine :: HasCallStack => TestCC -> IO String
getTermLine cc@TestCC {printOutput} =
getTermLine = getTermLine' Nothing
getTermLine' :: HasCallStack => Maybe String -> TestCC -> IO String
getTermLine' expected cc@TestCC {printOutput} =
5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case
Just s -> do
-- remove condition to always echo virtual terminal
@@ -437,7 +440,12 @@ getTermLine cc@TestCC {printOutput} =
name <- userName cc
putStrLn $ name <> ": " <> s
pure s
_ -> error "no output for 5 seconds"
Nothing -> do
name <- userName cc
let expectedMsg = case expected of
Just e -> ", expected: " <> show e
Nothing -> ""
error $ name <> ": no output for 5 seconds" <> expectedMsg
userName :: TestCC -> IO [Char]
userName (TestCC ChatController {currentUser} _ _ _ _ _) =
+34 -6
View File
@@ -68,7 +68,7 @@ runTestMessageWithFile :: HasCallStack => TestParams -> IO ()
runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
connectUsers alice bob
alice ##> "/_send @2 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}]"
alice ##> "/_send @2 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\": \"file\", \"text\": \"hi, sending a file\"}}]"
alice <# "@bob hi, sending a file"
alice <# "/f @bob ./tests/fixtures/test.jpg"
alice <## "use /fc 1 to cancel sending"
@@ -83,12 +83,22 @@ runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withX
"started receiving file 1 (test.jpg) from alice"
]
bob <## "completed receiving file 1 (test.jpg) from alice"
bob #> "@alice received"
alice <# "bob> received"
src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")])
bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")])
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg"), ((0, "received"), Nothing)])
alice ##> "/_get content types @2"
alice <## "Chat content types: file, text"
alice #$> ("/_get chat @2 content=file count=100", chatF, [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")])
bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg"), ((1, "received"), Nothing)])
bob ##> "/_get content types @2"
bob <## "Chat content types: file, text"
bob #$> ("/_get chat @2 content=file count=100", chatF, [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")])
testSendImage :: HasCallStack => TestParams -> IO ()
testSendImage =
@@ -343,15 +353,33 @@ testGroupSendImage =
"started receiving file 1 (test.jpg) from alice"
]
cath <## "completed receiving file 1 (test.jpg) from alice"
threadDelay 1000000
bob #> "#team received"
[alice, cath] *<# "#team bob> received"
threadDelay 1000000
cath #> "#team received too"
[alice, bob] *<# "#team cath> received too"
src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src
dest2 <- B.readFile "./tests/tmp/test_1.jpg"
dest2 `shouldBe` src
alice #$> ("/_get chat #1 count=1", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")])
bob #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test.jpg")])
cath #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")])
alice #$> ("/_get chat #1 count=3", chatF, [((1, ""), Just "./tests/fixtures/test.jpg"), ((0, "received"), Nothing), ((0, "received too"), Nothing)])
alice ##> "/_get content types #1"
alice <## "Chat content types: image, text"
alice #$> ("/_get chat #1 content=image count=100", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")])
bob #$> ("/_get chat #1 count=3", chatF, [((0, ""), Just "./tests/tmp/test.jpg"), ((1, "received"), Nothing), ((0, "received too"), Nothing)])
bob ##> "/_get content types #1"
bob <## "Chat content types: image, text"
bob #$> ("/_get chat #1 content=image count=100", chatF, [((0, ""), Just "./tests/tmp/test.jpg")])
cath #$> ("/_get chat #1 count=3", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg"), ((0, "received"), Nothing), ((1, "received too"), Nothing)])
cath ##> "/_get content types #1"
cath <## "Chat content types: image, text"
cath #$> ("/_get chat #1 content=image count=100", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")])
testGroupSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO ()
testGroupSendImageWithTextAndQuote =
-6
View File
@@ -2071,11 +2071,8 @@ testSharedMessageBody ps' =
]
bob <# "#team alice> hello"
cath <# "#team alice> hello"
-- because of PostgreSQL concurrency deleteSndMsgDelivery fails to delete message body
#if !defined(dbPostgres)
threadDelay 500000
checkMsgBodyCount alice 0
#endif
alice <## "disconnected 4 connections on server localhost"
where
@@ -2130,10 +2127,7 @@ testSharedBatchBody ps =
concurrently_
(bob <# ("#team alice> message " <> show i))
(cath <# ("#team alice> message " <> show i))
-- because of PostgreSQL concurrency deleteSndMsgDelivery fails to delete message body
#if !defined(dbPostgres)
checkMsgBodyCount alice 0
#endif
alice <## "disconnected 4 connections on server localhost"
where
+7 -4
View File
@@ -134,10 +134,13 @@ testFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
alice ##> "/tail"
alice <# "* hi myself"
alice <# "* file 1 (test.jpg)"
alice `send` "/* text note"
alice <# "* text note"
alice ##> "/_get chat *1 count=100"
r <- chatF <$> getTermLine alice
r `shouldBe` [((1, "hi myself"), Just "test.jpg")]
alice #$> ("/_get chat *1 count=100", chatF, [((1, "hi myself"), Just "test.jpg"), ((1, "text note"), Nothing)])
alice ##> "/_get content types *1"
alice <## "Chat content types: image, text"
alice #$> ("/_get chat *1 content=image count=100", chatF, [((1, "hi myself"), Just "test.jpg")])
alice ##> "/fs 1"
alice <## "bad chat command: not supported for local files"
@@ -151,7 +154,7 @@ testFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
alice ##> "/_create *1 json [{\"filePath\": \"another_test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]"
alice <# "* file 2 (another_test.jpg)"
alice ##> "/_delete item *1 2 internal"
alice ##> "/_delete item *1 3 internal"
alice <## "message deleted"
doesFileExist stored2 `shouldReturn` False
doesFileExist stored `shouldReturn` True
+37 -23
View File
@@ -171,7 +171,8 @@ cc ?#> cmd = do
(#$>) :: (Eq a, Show a, HasCallStack) => TestCC -> (String, String -> a, a) -> Expectation
cc #$> (cmd, f, res) = do
cc ##> cmd
(f <$> getTermLine cc) `shouldReturn` res
let expected = "result of " <> cmd <> ": " <> show res
(f <$> getTermLine' (Just expected) cc) `shouldReturn` res
-- / PQ combinators
@@ -345,7 +346,7 @@ chats = mapChats . read
getChats :: HasCallStack => (Eq a, Show a) => ([(String, String, Maybe ConnStatus)] -> [a]) -> TestCC -> [a] -> Expectation
getChats f cc res = do
cc ##> "/_get chats 1 pcc=on"
line <- getTermLine cc
line <- getTermLine' (Just "chat list") cc
f (read line) `shouldMatchList` res
send :: TestCC -> String -> IO ()
@@ -353,41 +354,41 @@ send TestCC {chatController = cc} cmd = atomically $ writeTBQueue (inputQ cc) cm
(<##) :: HasCallStack => TestCC -> String -> Expectation
cc <## line = do
l <- getTermLine cc
l <- getTermLine' (Just line) cc
when (l /= line) $ print ("expected: " <> line, ", got: " <> l)
l `shouldBe` line
(<##.) :: HasCallStack => TestCC -> String -> Expectation
cc <##. line = do
l <- getTermLine cc
l <- getTermLine' (Just $ "prefix: " <> line) cc
let prefix = line `isPrefixOf` l
unless prefix $ print ("expected to start from: " <> line, ", got: " <> l)
prefix `shouldBe` True
(.<##) :: HasCallStack => TestCC -> String -> Expectation
cc .<## line = do
l <- getTermLine cc
l <- getTermLine' (Just $ "suffix: " <> line) cc
let suffix = line `isSuffixOf` l
unless suffix $ print ("expected to end with: " <> line, ", got: " <> l)
suffix `shouldBe` True
(<#.) :: HasCallStack => TestCC -> String -> Expectation
cc <#. line = do
l <- dropTime <$> getTermLine cc
l <- dropTime <$> getTermLine' (Just $ "prefix: " <> line) cc
let prefix = line `isPrefixOf` l
unless prefix $ print ("expected to start from: " <> line, ", got: " <> l)
prefix `shouldBe` True
(.<#) :: HasCallStack => TestCC -> String -> Expectation
cc .<# line = do
l <- dropTime <$> getTermLine cc
l <- dropTime <$> getTermLine' (Just $ "suffix: " <> line) cc
let suffix = line `isSuffixOf` l
unless suffix $ print ("expected to end with: " <> line, ", got: " <> l)
suffix `shouldBe` True
(<##..) :: HasCallStack => TestCC -> [String] -> Expectation
cc <##.. ls = do
l <- getTermLine cc
l <- getTermLine' (Just $ "one of prefixes: " <> show ls) cc
let prefix = any (`isPrefixOf` l) ls
unless prefix $ print ("expected to start from one of: " <> show ls, ", got: " <> l)
prefix `shouldBe` True
@@ -395,7 +396,8 @@ cc <##.. ls = do
(>*) :: HasCallStack => TestCC -> String -> IO ()
cc >* note = do
cc `send` ("/* " <> note)
(dropTime <$> getTermLine cc) `shouldReturn` ("* " <> note)
let expected = "* " <> note
(dropTime <$> getTermLine' (Just expected) cc) `shouldReturn` expected
data ConsoleResponse
= ConsoleString String
@@ -404,13 +406,21 @@ data ConsoleResponse
| StartsWith String
| Predicate (String -> Bool)
instance Show ConsoleResponse where
show (ConsoleString s) = show s
show (WithTime s) = "WithTime " <> show s
show (EndsWith s) = "EndsWith " <> show s
show (StartsWith s) = "StartsWith " <> show s
show (Predicate _) = "<predicate>"
instance IsString ConsoleResponse where fromString = ConsoleString
-- this assumes that the string can only match one option
getInAnyOrder :: HasCallStack => (String -> String) -> TestCC -> [ConsoleResponse] -> Expectation
getInAnyOrder _ _ [] = pure ()
getInAnyOrder f cc ls = do
line <- f <$> getTermLine cc
let expectedDesc = "one of " <> show (length ls) <> " responses: " <> show ls
line <- f <$> getTermLine' (Just expectedDesc) cc
let rest = filterFirst (expected line) ls
if length rest < length ls
then getInAnyOrder f cc rest
@@ -436,25 +446,27 @@ getInAnyOrder f cc ls = do
(<##?) = getInAnyOrder dropTime
(<#) :: HasCallStack => TestCC -> String -> Expectation
cc <# line = (dropTime <$> getTermLine cc) `shouldReturn` line
cc <# line = (dropTime <$> getTermLine' (Just line) cc) `shouldReturn` line
(*<#) :: HasCallStack => [TestCC] -> String -> Expectation
ccs *<# line = mapConcurrently_ (<# line) ccs
(?<#) :: HasCallStack => TestCC -> String -> Expectation
cc ?<# line = (dropTime <$> getTermLine cc) `shouldReturn` "i " <> line
cc ?<# line = do
let expected = "i " <> line
(dropTime <$> getTermLine' (Just expected) cc) `shouldReturn` expected
($<#) :: HasCallStack => (TestCC, String) -> String -> Expectation
(cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine cc) `shouldReturn` line
(cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine' (Just $ "for user " <> uName <> ": " <> line) cc) `shouldReturn` line
(^<#) :: HasCallStack => (TestCC, String) -> String -> Expectation
(cc, p) ^<# line = (dropTime . dropStrPrefix p <$> getTermLine cc) `shouldReturn` line
(cc, p) ^<# line = (dropTime . dropStrPrefix p <$> getTermLine' (Just $ "without prefix " <> p <> ": " <> line) cc) `shouldReturn` line
() :: HasCallStack => TestCC -> String -> Expectation
cc line = (dropTime . dropReceipt <$> getTermLine cc) `shouldReturn` line
cc line = (dropTime . dropReceipt <$> getTermLine' (Just $ "receipt: " <> line) cc) `shouldReturn` line
(%) :: HasCallStack => TestCC -> String -> Expectation
cc % line = (dropTime . dropPartialReceipt <$> getTermLine cc) `shouldReturn` line
cc % line = (dropTime . dropPartialReceipt <$> getTermLine' (Just $ "partial receipt: " <> line) cc) `shouldReturn` line
(</) :: HasCallStack => TestCC -> Expectation
(</) = (<// 500000)
@@ -527,7 +539,7 @@ getInvitations :: HasCallStack => TestCC -> IO (String, String)
getInvitations cc = do
shortInv <- getInvitation_ cc
cc <##. "The invitation link for old clients:"
fullInv <- getTermLine cc
fullInv <- getTermLine' (Just "full invitation link") cc
pure (shortInv, fullInv)
getInvitationNoShortLink :: HasCallStack => TestCC -> IO String
@@ -537,7 +549,7 @@ getInvitation_ :: HasCallStack => TestCC -> IO String
getInvitation_ cc = do
cc <## "pass this invitation link to your contact (via another channel):"
cc <## ""
inv <- getTermLine cc
inv <- getTermLine' (Just "invitation link") cc
cc <## ""
cc <## "and ask them to connect: /c <invitation_link_above>"
pure inv
@@ -550,7 +562,8 @@ getContactLink cc created = do
getContactLinks :: HasCallStack => TestCC -> Bool -> IO (String, String)
getContactLinks cc created = do
shortLink <- getContactLink_ cc created
fullLink <- dropLinePrefix "The contact link for old clients: " =<< getTermLine cc
line <- getTermLine' (Just "full contact link line") cc
fullLink <- dropLinePrefix "The contact link for old clients: " line
pure (shortLink, fullLink)
getContactLinkNoShortLink :: HasCallStack => TestCC -> Bool -> IO String
@@ -560,7 +573,7 @@ getContactLink_ :: HasCallStack => TestCC -> Bool -> IO String
getContactLink_ cc created = do
cc <## if created then "Your new chat address is created!" else "Your chat address:"
cc <## ""
link <- getTermLine cc
link <- getTermLine' (Just "contact link") cc
cc <## ""
cc <## "Anybody can send you contact requests with: /c <contact_link_above>"
cc <## "to show it again: /sa"
@@ -581,7 +594,8 @@ getGroupLink cc gName mRole created = do
getGroupLinks :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO (String, String)
getGroupLinks cc gName mRole created = do
shortLink <- getGroupLink_ cc gName mRole created
fullLink <- dropLinePrefix "The group link for old clients: " =<< getTermLine cc
line <- getTermLine' (Just "full group link line") cc
fullLink <- dropLinePrefix "The group link for old clients: " line
pure (shortLink, fullLink)
getGroupLinkNoShortLink :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO String
@@ -591,7 +605,7 @@ getGroupLink_ :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool ->
getGroupLink_ cc gName mRole created = do
cc <## if created then "Group link is created!" else "Group link:"
cc <## ""
link <- getTermLine cc
link <- getTermLine' (Just $ "group link for " <> gName) cc
cc <## ""
cc <## ("Anybody can connect to you and join group as " <> T.unpack (textEncode mRole) <> " with: /c <group_link_above>")
cc <## ("to show it again: /show link #" <> gName)
@@ -669,7 +683,7 @@ getTestCCContact cc contactId = do
lastItemId :: HasCallStack => TestCC -> IO String
lastItemId cc = do
cc ##> "/last_item_id"
getTermLine cc
getTermLine' (Just "last item id") cc
showActiveUser :: HasCallStack => TestCC -> String -> Expectation
showActiveUser cc name = do