mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
Compare commits
76 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 0a22706d01 | |||
| bfac8bd58a | |||
| 34c10fc12f | |||
| 22fc2e5151 | |||
| 2396531414 | |||
| a3906cf88f | |||
| d03fc53151 | |||
| 69138dd99f | |||
| f9d01f6f8e | |||
| b90f7a932f | |||
| 40db6686c1 | |||
| 21f9c7fd50 | |||
| d15560a29f | |||
| f197c4174c | |||
| 99719088e5 | |||
| 01611fd719 | |||
| 0ce7d16a59 | |||
| bf20b73893 | |||
| c9ae77e9f3 | |||
| d875fc99f4 | |||
| 1c4c48f168 | |||
| 122d5948af | |||
| fd5e5d295f | |||
| 3a2e59a6e8 | |||
| 494724de01 | |||
| 089e5f6ec1 | |||
| 74c6a425b3 | |||
| 0698f4acfc | |||
| 779a91f5cb | |||
| 20c4c02f63 | |||
| d2a473c908 | |||
| 01d0c4ef96 | |||
| bab2341406 | |||
| c98e8e774f | |||
| cf32d1d950 | |||
| 065cc170da | |||
| a84b56d39d | |||
| 937e66b3b8 | |||
| 638b237b8c | |||
| 37a5c353ea | |||
| 31eca1687c | |||
| 7e9ab7cd85 | |||
| 8ff2f66bb9 | |||
| e2de454426 | |||
| f87a4a43c9 | |||
| 83ce1f5808 | |||
| 4bbee43602 | |||
| 0ee2769e15 | |||
| 82e6b2eefc | |||
| 97894c7f53 | |||
| ff42ca69de | |||
| 5ccf00f70e | |||
| 22be251862 | |||
| 84bd23a99d | |||
| 9737f6baa6 | |||
| 39e3a8cb70 | |||
| 649561fbc9 | |||
| c681c89657 | |||
| 7ad0a2dd87 | |||
| 71d891acc2 | |||
| 7faa5b4f6a | |||
| c93ed87228 | |||
| 2b170830df | |||
| 19755e359d | |||
| 53c77d310a | |||
| 796d3916bd | |||
| b93abb9555 | |||
| c31560238a | |||
| 2b7ad80dfd | |||
| d8f5b6e813 | |||
| b6359559c1 | |||
| 5826d14866 | |||
| a9ca467a80 | |||
| 185e307e70 | |||
| f738d2731c | |||
| ea61fd7e2b |
+1
-1
@@ -29,7 +29,7 @@ RUN cp ./scripts/cabal.project.local.linux ./cabal.project.local
|
||||
|
||||
# Compile simplex-chat
|
||||
RUN cabal update
|
||||
RUN cabal build exe:simplex-chat --constraint 'simplexmq +client_library'
|
||||
RUN cabal build exe:simplex-chat
|
||||
|
||||
# Strip the binary from debug symbols to reduce size
|
||||
RUN bin=$(find /project/dist-newstyle -name "simplex-chat" -type f -executable) && \
|
||||
|
||||
@@ -149,9 +149,9 @@
|
||||
6419EC582AB97507004A607A /* CIMemberCreatedContactView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 6419EC572AB97507004A607A /* CIMemberCreatedContactView.swift */; };
|
||||
6432857C2925443C00FBE5C8 /* GroupPreferencesView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 6432857B2925443C00FBE5C8 /* GroupPreferencesView.swift */; };
|
||||
643B3B452CCBEB080083A2CF /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 643B3B402CCBEB080083A2CF /* libgmpxx.a */; };
|
||||
643B3B462CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 643B3B412CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5-ghc9.6.3.a */; };
|
||||
643B3B462CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9-ghc9.6.3.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 643B3B412CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9-ghc9.6.3.a */; };
|
||||
643B3B472CCBEB080083A2CF /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 643B3B422CCBEB080083A2CF /* libffi.a */; };
|
||||
643B3B482CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 643B3B432CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5.a */; };
|
||||
643B3B482CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 643B3B432CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9.a */; };
|
||||
643B3B492CCBEB080083A2CF /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 643B3B442CCBEB080083A2CF /* libgmp.a */; };
|
||||
6440CA00288857A10062C672 /* CIEventView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 6440C9FF288857A10062C672 /* CIEventView.swift */; };
|
||||
6440CA03288AECA70062C672 /* AddGroupMembersView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 6440CA02288AECA70062C672 /* AddGroupMembersView.swift */; };
|
||||
@@ -492,9 +492,9 @@
|
||||
6419EC572AB97507004A607A /* CIMemberCreatedContactView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIMemberCreatedContactView.swift; sourceTree = "<group>"; };
|
||||
6432857B2925443C00FBE5C8 /* GroupPreferencesView.swift */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.swift; path = GroupPreferencesView.swift; sourceTree = "<group>"; };
|
||||
643B3B402CCBEB080083A2CF /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = libgmpxx.a; path = Libraries/libgmpxx.a; sourceTree = "<group>"; };
|
||||
643B3B412CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = "libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5-ghc9.6.3.a"; path = "Libraries/libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5-ghc9.6.3.a"; sourceTree = "<group>"; };
|
||||
643B3B412CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9-ghc9.6.3.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = "libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9-ghc9.6.3.a"; path = "Libraries/libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9-ghc9.6.3.a"; sourceTree = "<group>"; };
|
||||
643B3B422CCBEB080083A2CF /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = libffi.a; path = Libraries/libffi.a; sourceTree = "<group>"; };
|
||||
643B3B432CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = "libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5.a"; path = "Libraries/libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5.a"; sourceTree = "<group>"; };
|
||||
643B3B432CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = "libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9.a"; path = "Libraries/libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9.a"; sourceTree = "<group>"; };
|
||||
643B3B442CCBEB080083A2CF /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; name = libgmp.a; path = Libraries/libgmp.a; sourceTree = "<group>"; };
|
||||
6440C9FF288857A10062C672 /* CIEventView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIEventView.swift; sourceTree = "<group>"; };
|
||||
6440CA02288AECA70062C672 /* AddGroupMembersView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = AddGroupMembersView.swift; sourceTree = "<group>"; };
|
||||
@@ -663,8 +663,8 @@
|
||||
5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */,
|
||||
5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */,
|
||||
CE38A29C2C3FCD72005ED185 /* SwiftyGif in Frameworks */,
|
||||
643B3B482CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5.a in Frameworks */,
|
||||
643B3B462CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5-ghc9.6.3.a in Frameworks */,
|
||||
643B3B482CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9.a in Frameworks */,
|
||||
643B3B462CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9-ghc9.6.3.a in Frameworks */,
|
||||
);
|
||||
runOnlyForDeploymentPostprocessing = 0;
|
||||
};
|
||||
@@ -815,8 +815,8 @@
|
||||
643B3B422CCBEB080083A2CF /* libffi.a */,
|
||||
643B3B442CCBEB080083A2CF /* libgmp.a */,
|
||||
643B3B402CCBEB080083A2CF /* libgmpxx.a */,
|
||||
643B3B412CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5-ghc9.6.3.a */,
|
||||
643B3B432CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-CTfGB7l09cqEHVIdvhrnH5.a */,
|
||||
643B3B412CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9-ghc9.6.3.a */,
|
||||
643B3B432CCBEB080083A2CF /* libHSsimplex-chat-6.1.1.0-KwHIA7FZqPI5ZTCAoi00n9.a */,
|
||||
5CA059C2279559F40002BEB4 /* Shared */,
|
||||
5CDCAD462818589900503DA2 /* SimpleX NSE */,
|
||||
CEE723A82C3BD3D70009AE93 /* SimpleX SE */,
|
||||
@@ -912,9 +912,10 @@
|
||||
5CB924DF27A8678B00ACCCDD /* UserSettings */ = {
|
||||
isa = PBXGroup;
|
||||
children = (
|
||||
643B3B4C2CCFD34B0083A2CF /* NetworkAndServers */,
|
||||
5CB924D627A8563F00ACCCDD /* SettingsView.swift */,
|
||||
5CB346E62868D76D001FD2EF /* NotificationsView.swift */,
|
||||
5C9C2DA6289957AE00CC63B1 /* AdvancedNetworkSettings.swift */,
|
||||
5C9C2DA82899DA6F00CC63B1 /* NetworkAndServers.swift */,
|
||||
5CADE79929211BB900072E13 /* PreferencesView.swift */,
|
||||
5C5DB70D289ABDD200730FFF /* AppearanceSettings.swift */,
|
||||
5C05DF522840AA1D00C683F9 /* CallSettings.swift */,
|
||||
@@ -922,6 +923,9 @@
|
||||
5CC036DF29C488D500C0EF20 /* HiddenProfileView.swift */,
|
||||
5C577F7C27C83AA10006112D /* MarkdownHelp.swift */,
|
||||
5C3F1D57284363C400EC8A82 /* PrivacySettings.swift */,
|
||||
5C93292E29239A170090FFF9 /* ProtocolServersView.swift */,
|
||||
5C93293029239BED0090FFF9 /* ProtocolServerView.swift */,
|
||||
5C9329402929248A0090FFF9 /* ScanProtocolServer.swift */,
|
||||
5CB2084E28DA4B4800D024EC /* RTCServers.swift */,
|
||||
64F1CC3A28B39D8600CD1FB1 /* IncognitoHelp.swift */,
|
||||
18415845648CA4F5A8BCA272 /* UserProfilesView.swift */,
|
||||
@@ -1052,18 +1056,6 @@
|
||||
path = Database;
|
||||
sourceTree = "<group>";
|
||||
};
|
||||
643B3B4C2CCFD34B0083A2CF /* NetworkAndServers */ = {
|
||||
isa = PBXGroup;
|
||||
children = (
|
||||
5C9329402929248A0090FFF9 /* ScanProtocolServer.swift */,
|
||||
5C93293029239BED0090FFF9 /* ProtocolServerView.swift */,
|
||||
5C93292E29239A170090FFF9 /* ProtocolServersView.swift */,
|
||||
5C9C2DA6289957AE00CC63B1 /* AdvancedNetworkSettings.swift */,
|
||||
5C9C2DA82899DA6F00CC63B1 /* NetworkAndServers.swift */,
|
||||
);
|
||||
path = NetworkAndServers;
|
||||
sourceTree = "<group>";
|
||||
};
|
||||
6440CA01288AEC770062C672 /* Group */ = {
|
||||
isa = PBXGroup;
|
||||
children = (
|
||||
|
||||
+11
@@ -11,6 +11,7 @@ import androidx.compose.ui.text.style.TextDecoration
|
||||
import chat.simplex.common.platform.*
|
||||
import chat.simplex.common.ui.theme.*
|
||||
import chat.simplex.common.views.call.*
|
||||
import chat.simplex.common.views.chat.ChatSectionArea
|
||||
import chat.simplex.common.views.chat.ComposeState
|
||||
import chat.simplex.common.views.helpers.*
|
||||
import chat.simplex.common.views.migration.MigrationToDeviceState
|
||||
@@ -65,6 +66,8 @@ object ChatModel {
|
||||
// current chat
|
||||
val chatId = mutableStateOf<String?>(null)
|
||||
val chatItems = mutableStateOf(SnapshotStateList<ChatItem>())
|
||||
// chatItemId, SectionArea
|
||||
val chatItemsSectionArea = mutableMapOf<Long, ChatSectionArea>()
|
||||
// rhId, chatId
|
||||
val deletedChats = mutableStateOf<List<Pair<Long?, String>>>(emptyList())
|
||||
val chatItemStatuses = mutableMapOf<Long, CIStatus>()
|
||||
@@ -329,6 +332,7 @@ object ChatModel {
|
||||
if (chatId.value == cInfo.id) {
|
||||
// Prevent situation when chat item already in the list received from backend
|
||||
if (chatItems.value.none { it.id == cItem.id }) {
|
||||
chatItemsSectionArea[cItem.id] = ChatSectionArea.Bottom
|
||||
if (chatItems.value.lastOrNull()?.id == ChatItem.TEMP_LIVE_CHAT_ITEM_ID) {
|
||||
chatItems.add(kotlin.math.max(0, chatItems.value.lastIndex), cItem)
|
||||
} else {
|
||||
@@ -377,6 +381,7 @@ object ChatModel {
|
||||
} else {
|
||||
cItem
|
||||
}
|
||||
chatItemsSectionArea[ci.id] = ChatSectionArea.Bottom
|
||||
chatItems.add(ci)
|
||||
true
|
||||
}
|
||||
@@ -608,6 +613,7 @@ object ChatModel {
|
||||
val cItem = ChatItem.liveDummy(chatInfo is ChatInfo.Direct)
|
||||
withContext(Dispatchers.Main) {
|
||||
chatItems.add(cItem)
|
||||
chatItemsSectionArea[cItem.id] = ChatSectionArea.Bottom
|
||||
}
|
||||
return cItem
|
||||
}
|
||||
@@ -615,6 +621,7 @@ object ChatModel {
|
||||
fun removeLiveDummy() {
|
||||
if (chatItems.value.lastOrNull()?.id == ChatItem.TEMP_LIVE_CHAT_ITEM_ID) {
|
||||
chatItems.removeLast()
|
||||
chatItemsSectionArea.remove(ChatItem.TEMP_LIVE_CHAT_ITEM_ID)
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2307,6 +2314,10 @@ fun <T> MutableState<SnapshotStateList<T>>.removeAt(index: Int): T {
|
||||
return res
|
||||
}
|
||||
|
||||
fun <T> MutableState<SnapshotStateList<T>>.removeRange(fromIndex: Int, toIndex: Int) {
|
||||
value = SnapshotStateList<T>().apply { addAll(value); removeRange(fromIndex, toIndex) }
|
||||
}
|
||||
|
||||
fun <T> MutableState<SnapshotStateList<T>>.removeLast() {
|
||||
value = SnapshotStateList<T>().apply { addAll(value); removeLast() }
|
||||
}
|
||||
|
||||
+24
-7
@@ -865,11 +865,15 @@ object ChatController {
|
||||
return emptyList()
|
||||
}
|
||||
|
||||
suspend fun apiGetChat(rh: Long?, type: ChatType, id: Long, pagination: ChatPagination = ChatPagination.Last(ChatPagination.INITIAL_COUNT), search: String = ""): Chat? {
|
||||
suspend fun apiGetChat(rh: Long?, type: ChatType, id: Long, pagination: ChatPagination = ChatPagination.Last(ChatPagination.INITIAL_COUNT), search: String = ""): Pair<Chat, ChatLandingSection>? {
|
||||
val r = sendCmd(rh, CC.ApiGetChat(type, id, pagination, search))
|
||||
if (r is CR.ApiChat) return if (rh == null) r.chat else r.chat.copy(remoteHostId = rh)
|
||||
Log.e(TAG, "apiGetChat bad response: ${r.responseType} ${r.details}")
|
||||
AlertManager.shared.showAlertMsg(generalGetString(MR.strings.failed_to_parse_chat_title), generalGetString(MR.strings.contact_developers))
|
||||
if (r is CR.ApiChat) return if (rh == null) Pair(r.chat, r.section) else Pair(r.chat.copy(remoteHostId = rh), r.section)
|
||||
if (r is CR.ChatCmdError && r.chatError is ChatError.ChatErrorStore && r.chatError.storeError is StoreError.ChatItemNotFound) {
|
||||
AlertManager.shared.showAlertMsg(generalGetString(MR.strings.failed_to_get_chat_item_not_found_title), generalGetString(MR.strings.failed_to_get_chat_item_not_found_description))
|
||||
} else {
|
||||
Log.e(TAG, "apiGetChat bad response: ${r.responseType} ${r.details}")
|
||||
AlertManager.shared.showAlertMsg(generalGetString(MR.strings.failed_to_parse_chat_title), generalGetString(MR.strings.contact_developers))
|
||||
}
|
||||
return null
|
||||
}
|
||||
|
||||
@@ -3468,11 +3472,15 @@ sealed class ChatPagination {
|
||||
class Last(val count: Int): ChatPagination()
|
||||
class After(val chatItemId: Long, val count: Int): ChatPagination()
|
||||
class Before(val chatItemId: Long, val count: Int): ChatPagination()
|
||||
class Around(val chatItemId: Long, val count: Int): ChatPagination()
|
||||
class Initial(val count: Int): ChatPagination()
|
||||
|
||||
val cmdString: String get() = when (this) {
|
||||
is Last -> "count=${this.count}"
|
||||
is After -> "after=${this.chatItemId} count=${this.count}"
|
||||
is Before -> "before=${this.chatItemId} count=${this.count}"
|
||||
is Around -> "around=${this.chatItemId} count=${this.count}"
|
||||
is Initial -> "initial=${this.count}"
|
||||
}
|
||||
|
||||
companion object {
|
||||
@@ -4857,7 +4865,10 @@ class APIResponse(val resp: CR, val remoteHostId: Long?, val corr: String? = nul
|
||||
} else if (type == "apiChat") {
|
||||
val user: UserRef = json.decodeFromJsonElement(resp["user"]!!.jsonObject)
|
||||
val chat = parseChatData(resp["chat"]!!)
|
||||
return APIResponse(CR.ApiChat(user, chat), remoteHostId, corr)
|
||||
val section = resp["section"]?.let {
|
||||
json.decodeFromJsonElement<ChatLandingSection>(it)
|
||||
} ?: ChatLandingSection.Latest
|
||||
return APIResponse(CR.ApiChat(user, chat, section), remoteHostId, corr)
|
||||
} else if (type == "chatCmdError") {
|
||||
val userObject = resp["user_"]?.jsonObject
|
||||
val user = runCatching<UserRef?> { json.decodeFromJsonElement(userObject!!) }.getOrNull()
|
||||
@@ -4914,7 +4925,7 @@ sealed class CR {
|
||||
@Serializable @SerialName("chatRunning") class ChatRunning: 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): CR()
|
||||
@Serializable @SerialName("apiChat") class ApiChat(val user: UserRef, val chat: Chat, val section: ChatLandingSection): CR()
|
||||
@Serializable @SerialName("chatItemInfo") class ApiChatItemInfo(val user: UserRef, val chatItem: AChatItem, val chatItemInfo: ChatItemInfo): CR()
|
||||
@Serializable @SerialName("userProtoServers") class UserProtoServers(val user: UserRef, val servers: UserProtocolServers): CR()
|
||||
@Serializable @SerialName("serverTestResult") class ServerTestResult(val user: UserRef, val testServer: String, val testFailure: ProtocolTestFailure? = null): CR()
|
||||
@@ -5264,7 +5275,7 @@ sealed class CR {
|
||||
is ChatRunning -> noDetails()
|
||||
is ChatStopped -> noDetails()
|
||||
is ApiChats -> withUser(user, json.encodeToString(chats))
|
||||
is ApiChat -> withUser(user, json.encodeToString(chat))
|
||||
is ApiChat -> withUser(user, "section: ${json.encodeToString(section)}\n${json.encodeToString(chat)}")
|
||||
is ApiChatItemInfo -> withUser(user, "chatItem: ${json.encodeToString(chatItem)}\n${json.encodeToString(chatItemInfo)}")
|
||||
is UserProtoServers -> withUser(user, "servers: ${json.encodeToString(servers)}")
|
||||
is ServerTestResult -> withUser(user, "server: $testServer\nresult: ${json.encodeToString(testFailure)}")
|
||||
@@ -5504,6 +5515,12 @@ sealed class GroupLinkPlan {
|
||||
@Serializable @SerialName("known") class Known(val groupInfo: GroupInfo): GroupLinkPlan()
|
||||
}
|
||||
|
||||
@Serializable
|
||||
enum class ChatLandingSection {
|
||||
@SerialName("latest") Latest,
|
||||
@SerialName("unread") Unread,
|
||||
}
|
||||
|
||||
abstract class TerminalItem {
|
||||
abstract val id: Long
|
||||
abstract val remoteHostId: Long?
|
||||
|
||||
+287
@@ -0,0 +1,287 @@
|
||||
package chat.simplex.common.views.chat
|
||||
|
||||
import androidx.compose.runtime.toMutableStateList
|
||||
import chat.simplex.common.model.*
|
||||
import chat.simplex.common.platform.chatController
|
||||
import chat.simplex.common.platform.chatModel
|
||||
import kotlinx.coroutines.Dispatchers
|
||||
import kotlinx.coroutines.withContext
|
||||
import kotlin.math.max
|
||||
|
||||
const val MAX_SECTION_SIZE = 500
|
||||
|
||||
enum class ChatSectionArea {
|
||||
Bottom,
|
||||
Current,
|
||||
Destination
|
||||
}
|
||||
|
||||
data class ChatSectionAreaBoundary (
|
||||
var minIndex: Int,
|
||||
var maxIndex: Int,
|
||||
val area: ChatSectionArea
|
||||
)
|
||||
|
||||
data class ChatSection (
|
||||
val items: MutableList<SectionItems>,
|
||||
val boundary: ChatSectionAreaBoundary,
|
||||
// chatItemId, index in rendered LazyColumn
|
||||
val itemPositions: MutableMap<Long, Int>
|
||||
)
|
||||
|
||||
data class SectionItems (
|
||||
val mergeCategory: CIMergeCategory?,
|
||||
val items: MutableList<ChatItem>,
|
||||
val revealed: Boolean,
|
||||
val showAvatar: MutableSet<Long>,
|
||||
var originalItemsRange: IntRange
|
||||
)
|
||||
|
||||
data class ChatSectionLoader (
|
||||
val position: Int,
|
||||
val sectionArea: ChatSectionArea
|
||||
) {
|
||||
fun prepareItems(items: List<ChatItem>): List<ChatItem> {
|
||||
val chatItemsSectionArea = chatModel.chatItemsSectionArea
|
||||
val itemsToAdd = mutableListOf<ChatItem>()
|
||||
val sectionsToMerge = mutableMapOf<ChatSectionArea, ChatSectionArea>()
|
||||
val itemsThatCouldRequireMerge = mutableListOf<ChatItem>()
|
||||
for (cItem in items) {
|
||||
val itemSectionArea = chatItemsSectionArea[cItem.id]
|
||||
if (itemSectionArea == null) {
|
||||
itemsToAdd.add(cItem)
|
||||
val targetSection = sectionsToMerge[sectionArea] ?: this.sectionArea
|
||||
chatItemsSectionArea[cItem.id] = targetSection
|
||||
|
||||
if (targetSection == this.sectionArea) {
|
||||
itemsThatCouldRequireMerge.add(cItem)
|
||||
}
|
||||
} else if (itemSectionArea != this.sectionArea) {
|
||||
val (targetSection, sectionToDrop) = when (itemSectionArea) {
|
||||
ChatSectionArea.Bottom -> ChatSectionArea.Bottom to this.sectionArea
|
||||
ChatSectionArea.Current -> if (this.sectionArea == ChatSectionArea.Bottom) ChatSectionArea.Bottom to itemSectionArea else itemSectionArea to this.sectionArea
|
||||
ChatSectionArea.Destination -> if (this.sectionArea == ChatSectionArea.Bottom) ChatSectionArea.Bottom to itemSectionArea else itemSectionArea to this.sectionArea
|
||||
}
|
||||
|
||||
if (targetSection != sectionToDrop) {
|
||||
sectionsToMerge[sectionToDrop] = targetSection
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (sectionsToMerge.isNotEmpty()) {
|
||||
chatModel.chatItems.value.forEach {
|
||||
val currentSection = chatItemsSectionArea[it.id]
|
||||
val newSection = sectionsToMerge[currentSection]
|
||||
if (newSection != null) {
|
||||
chatItemsSectionArea[it.id] = newSection
|
||||
}
|
||||
}
|
||||
|
||||
itemsThatCouldRequireMerge.forEach {
|
||||
val targetSection = sectionsToMerge[sectionArea] ?: sectionArea
|
||||
chatItemsSectionArea[it.id] = targetSection
|
||||
}
|
||||
}
|
||||
|
||||
return itemsToAdd
|
||||
}
|
||||
}
|
||||
|
||||
fun ChatSection.getPreviousShownItem(sectionIndex: Int, itemIndex: Int): ChatItem? {
|
||||
val section = items.getOrNull(sectionIndex) ?: return null
|
||||
|
||||
return if (section.mergeCategory == null) {
|
||||
section.items.getOrNull(itemIndex + 1) ?: items.getOrNull(sectionIndex + 1)?.items?.firstOrNull()
|
||||
} else {
|
||||
items.getOrNull(sectionIndex + 1)?.items?.firstOrNull()
|
||||
}
|
||||
}
|
||||
|
||||
fun ChatSection.getNextShownItem(sectionIndex: Int, itemIndex: Int): ChatItem? {
|
||||
val section = items.getOrNull(sectionIndex) ?: return null
|
||||
|
||||
return if (section.mergeCategory == null) {
|
||||
section.items.getOrNull(itemIndex - 1) ?: items.getOrNull(sectionIndex - 1)?.items?.lastOrNull()
|
||||
} else {
|
||||
items.getOrNull(sectionIndex - 1)?.items?.lastOrNull()
|
||||
}
|
||||
}
|
||||
|
||||
fun List<ChatItem>.putIntoSections(revealedItems: Set<Long>): List<ChatSection> {
|
||||
if (isEmpty()) return emptyList()
|
||||
|
||||
val chatItemsSectionArea = chatModel.chatItemsSectionArea
|
||||
val sections = mutableListOf<ChatSection>()
|
||||
val first = this[0]
|
||||
|
||||
val showAvatar = mutableSetOf<Long>()
|
||||
if (first.chatDir is CIDirection.GroupRcv) {
|
||||
val second = getOrNull(1)
|
||||
if (second != null) {
|
||||
if (second.chatDir !is CIDirection.GroupRcv || second.chatDir.groupMember.memberId != first.chatDir.groupMember.memberId) {
|
||||
showAvatar.add(first.id)
|
||||
}
|
||||
} else {
|
||||
showAvatar.add(first.id)
|
||||
}
|
||||
}
|
||||
|
||||
var recent = SectionItems(
|
||||
mergeCategory = first.mergeCategory,
|
||||
items = mutableListOf(first),
|
||||
revealed = first.mergeCategory == null || revealedItems.contains(first.id),
|
||||
showAvatar = showAvatar,
|
||||
originalItemsRange = 0..0
|
||||
)
|
||||
|
||||
val area = chatItemsSectionArea[recent.items[0].id] ?: ChatSectionArea.Bottom
|
||||
|
||||
sections.add(
|
||||
ChatSection(
|
||||
items = mutableListOf(recent),
|
||||
boundary = ChatSectionAreaBoundary(minIndex = 0, maxIndex = 0, area = area),
|
||||
itemPositions = mutableMapOf(recent.items[0].id to 0)
|
||||
)
|
||||
)
|
||||
|
||||
var prev = this[0]
|
||||
var index = 0
|
||||
var positionInList = 0;
|
||||
while (index < size) {
|
||||
if (index == 0) {
|
||||
index++
|
||||
continue
|
||||
}
|
||||
val item = this[index]
|
||||
val itemArea = chatItemsSectionArea[item.id] ?: ChatSectionArea.Bottom
|
||||
val existingSection = sections.find { it.boundary.area == itemArea }
|
||||
|
||||
if (existingSection == null) {
|
||||
positionInList++
|
||||
val newSection = SectionItems(
|
||||
mergeCategory = item.mergeCategory,
|
||||
items = mutableListOf(item),
|
||||
revealed = item.mergeCategory == null || revealedItems.contains(item.id),
|
||||
showAvatar = mutableSetOf(item.id),
|
||||
originalItemsRange = index..index
|
||||
)
|
||||
sections.add(
|
||||
ChatSection(
|
||||
items = mutableListOf(newSection),
|
||||
boundary = ChatSectionAreaBoundary(minIndex = index, maxIndex = index, area = itemArea),
|
||||
itemPositions = mutableMapOf(item.id to positionInList)
|
||||
)
|
||||
)
|
||||
} else {
|
||||
recent = existingSection.items.last()
|
||||
val category = item.mergeCategory
|
||||
if (recent.mergeCategory == category) {
|
||||
if (category == null || recent.revealed || revealedItems.contains(item.id)) {
|
||||
positionInList++
|
||||
}
|
||||
if (item.chatDir is CIDirection.GroupRcv && prev.chatDir is CIDirection.GroupRcv && item.chatDir.groupMember.memberId != (prev.chatDir as CIDirection.GroupRcv).groupMember.memberId) {
|
||||
recent.showAvatar.add(item.id)
|
||||
}
|
||||
recent.items.add(item)
|
||||
recent.originalItemsRange = recent.originalItemsRange.first..index
|
||||
existingSection.itemPositions[item.id] = positionInList
|
||||
} else {
|
||||
positionInList++
|
||||
val newSectionItems = SectionItems(
|
||||
mergeCategory = item.mergeCategory,
|
||||
items = mutableListOf(item),
|
||||
revealed = item.mergeCategory == null || revealedItems.contains(item.id),
|
||||
showAvatar = if (item.chatDir is CIDirection.GroupRcv && (prev.chatDir !is CIDirection.GroupRcv || (prev.chatDir as CIDirection.GroupRcv).groupMember.memberId != item.chatDir.groupMember.memberId)) {
|
||||
mutableSetOf(item.id)
|
||||
} else {
|
||||
mutableSetOf()
|
||||
},
|
||||
originalItemsRange = index..index
|
||||
)
|
||||
existingSection.itemPositions[item.id] = positionInList
|
||||
existingSection.items.add(newSectionItems)
|
||||
}
|
||||
existingSection.boundary.maxIndex = index
|
||||
}
|
||||
prev = item
|
||||
index++
|
||||
}
|
||||
|
||||
return sections
|
||||
}
|
||||
|
||||
fun List<ChatSection>.chatItemPosition(chatItemId: Long): Int? {
|
||||
for (section in this) {
|
||||
val position = section.itemPositions[chatItemId]
|
||||
if (position != null) {
|
||||
return position
|
||||
}
|
||||
}
|
||||
|
||||
return null
|
||||
}
|
||||
|
||||
fun List<ChatSection>.revealedItemCount(): Int {
|
||||
var count = 0
|
||||
for (section in this) {
|
||||
var i = 0;
|
||||
while (i < section.items.size) {
|
||||
val item = section.items[i]
|
||||
if (item.revealed) {
|
||||
count += item.items.size
|
||||
} else {
|
||||
count++
|
||||
}
|
||||
i++
|
||||
}
|
||||
}
|
||||
|
||||
return count
|
||||
}
|
||||
|
||||
fun List<ChatSection>.dropTemporarySections() {
|
||||
val bottomSection = this.find { it.boundary.area == ChatSectionArea.Bottom }
|
||||
if (bottomSection != null) {
|
||||
val itemsOutsideOfSection = chatModel.chatItems.value.lastIndex - bottomSection.boundary.maxIndex
|
||||
chatModel.chatItems.removeRange(fromIndex = 0, toIndex = itemsOutsideOfSection + bottomSection.excessItemCount())
|
||||
chatModel.chatItemsSectionArea.clear()
|
||||
chatModel.chatItems.value.associateTo(chatModel.chatItemsSectionArea) { it.id to ChatSectionArea.Bottom }
|
||||
}
|
||||
}
|
||||
|
||||
private fun ChatSection.excessItemCount(): Int {
|
||||
return max(boundary.maxIndex - boundary.minIndex + 1 - MAX_SECTION_SIZE, 0)
|
||||
}
|
||||
|
||||
fun landingSectionToArea(chatLandingSection: ChatLandingSection) = when (chatLandingSection) {
|
||||
ChatLandingSection.Latest -> ChatSectionArea.Bottom
|
||||
ChatLandingSection.Unread -> ChatSectionArea.Current
|
||||
}
|
||||
|
||||
suspend fun apiLoadBottomSection(chatInfo: ChatInfo, rhId: Long?) {
|
||||
val chat = chatController.apiGetChat(rh = rhId, type = chatInfo.chatType, id = chatInfo.apiId)
|
||||
if (chatModel.chatId.value != chatInfo.id || chat == null) return
|
||||
withContext(Dispatchers.Main) {
|
||||
val updatedItems = chatModel.chatItems.value.toMutableStateList()
|
||||
var insertIndex = updatedItems.size
|
||||
var needsMerge = false
|
||||
|
||||
for (cItem in chat.first.chatItems.asReversed()) {
|
||||
if (chatModel.chatItemsSectionArea[cItem.id] == null) {
|
||||
updatedItems.add(insertIndex, cItem)
|
||||
chatModel.chatItemsSectionArea[cItem.id] = ChatSectionArea.Bottom
|
||||
} else {
|
||||
needsMerge = true
|
||||
chatModel.chatItemsSectionArea[cItem.id] = ChatSectionArea.Bottom
|
||||
insertIndex = max(0, insertIndex - 1)
|
||||
}
|
||||
}
|
||||
|
||||
if (needsMerge) {
|
||||
updatedItems.associateTo(chatModel.chatItemsSectionArea) { it.id to ChatSectionArea.Bottom }
|
||||
}
|
||||
|
||||
chatModel.chatItems.replaceAll(updatedItems)
|
||||
}
|
||||
}
|
||||
+428
-239
@@ -47,8 +47,7 @@ import kotlinx.coroutines.flow.*
|
||||
import kotlinx.datetime.*
|
||||
import java.io.File
|
||||
import java.net.URI
|
||||
import kotlin.math.abs
|
||||
import kotlin.math.sign
|
||||
import kotlin.math.*
|
||||
|
||||
data class ItemSeparation(val timestamp: Boolean, val largeGap: Boolean, val date: Instant?)
|
||||
|
||||
@@ -292,13 +291,35 @@ fun ChatView(staleChatId: State<String?>, onComposed: suspend (chatId: String) -
|
||||
}
|
||||
}
|
||||
},
|
||||
loadPrevMessages = { chatId ->
|
||||
val c = chatModel.getChat(chatId)
|
||||
loadMessages = { chatId, scrollDirection, (itemId, idx, area) ->
|
||||
val c = chatModel.getChat(chatId) ?: return@ChatLayout
|
||||
if (chatModel.chatId.value != chatId) return@ChatLayout
|
||||
val firstId = chatModel.chatItems.value.firstOrNull()?.id
|
||||
if (c != null && firstId != null) {
|
||||
withBGApi {
|
||||
apiLoadPrevMessages(c, chatModel, firstId, searchText.value)
|
||||
withBGApi {
|
||||
when (scrollDirection) {
|
||||
ScrollDirection.Up -> {
|
||||
val chatSectionLoader = ChatSectionLoader(idx, area)
|
||||
apiLoadMessages(
|
||||
rhId = c.remoteHostId,
|
||||
chatInfo = c.chatInfo,
|
||||
chatModel = chatModel,
|
||||
itemId = itemId,
|
||||
search = "",
|
||||
chatSectionLoader = chatSectionLoader,
|
||||
)
|
||||
}
|
||||
ScrollDirection.Down -> {
|
||||
val chatSectionLoader = ChatSectionLoader(idx + 1, area)
|
||||
apiLoadMessages(
|
||||
rhId = c.remoteHostId,
|
||||
chatInfo = c.chatInfo,
|
||||
chatModel = chatModel,
|
||||
itemId = itemId,
|
||||
search = "",
|
||||
chatSectionLoader = chatSectionLoader,
|
||||
pagination = ChatPagination.After(itemId, ChatPagination.PRELOAD_COUNT)
|
||||
)
|
||||
}
|
||||
else -> {}
|
||||
}
|
||||
}
|
||||
},
|
||||
@@ -583,7 +604,7 @@ fun ChatLayout(
|
||||
back: () -> Unit,
|
||||
info: () -> Unit,
|
||||
showMemberInfo: (GroupInfo, GroupMember) -> Unit,
|
||||
loadPrevMessages: (ChatId) -> Unit,
|
||||
loadMessages: (ChatId, ScrollDirection, Triple<Long, Int, ChatSectionArea>) -> Unit,
|
||||
deleteMessage: (Long, CIDeleteMode) -> Unit,
|
||||
deleteMessages: (List<Long>) -> Unit,
|
||||
receiveFile: (Long) -> Unit,
|
||||
@@ -611,7 +632,7 @@ fun ChatLayout(
|
||||
onComposed: suspend (chatId: String) -> Unit,
|
||||
developerTools: Boolean,
|
||||
showViaProxy: Boolean,
|
||||
showSearch: MutableState<Boolean>
|
||||
showSearch: MutableState<Boolean>,
|
||||
) {
|
||||
val scope = rememberCoroutineScope()
|
||||
val attachmentDisabled = remember { derivedStateOf { composeState.value.attachmentDisabled } }
|
||||
@@ -649,10 +670,10 @@ fun ChatLayout(
|
||||
Box(Modifier.fillMaxSize()) {
|
||||
ChatItemsList(
|
||||
remoteHostId, chatInfo, unreadCount, composeState, composeViewHeight, searchValue,
|
||||
useLinkPreviews, linkMode, selectedChatItems, showMemberInfo, loadPrevMessages, deleteMessage, deleteMessages,
|
||||
useLinkPreviews, linkMode, selectedChatItems, showMemberInfo, loadMessages, deleteMessage, deleteMessages,
|
||||
receiveFile, cancelFile, joinGroup, acceptCall, acceptFeature, openDirectChat, forwardItem,
|
||||
updateContactStats, updateMemberStats, syncContactConnection, syncMemberConnection, findModelChat, findModelMember,
|
||||
setReaction, showItemDetails, markRead, remember { { onComposed(it) } }, developerTools, showViaProxy,
|
||||
setReaction, showItemDetails, markRead, remember { { onComposed(it) } }, developerTools, showViaProxy
|
||||
)
|
||||
}
|
||||
}
|
||||
@@ -922,7 +943,7 @@ fun BoxScope.ChatItemsList(
|
||||
linkMode: SimplexLinkMode,
|
||||
selectedChatItems: MutableState<Set<Long>?>,
|
||||
showMemberInfo: (GroupInfo, GroupMember) -> Unit,
|
||||
loadPrevMessages: (ChatId) -> Unit,
|
||||
loadMessages: (ChatId, ScrollDirection, Triple<Long, Int, ChatSectionArea>) -> Unit,
|
||||
deleteMessage: (Long, CIDeleteMode) -> Unit,
|
||||
deleteMessages: (List<Long>) -> Unit,
|
||||
receiveFile: (Long) -> Unit,
|
||||
@@ -943,11 +964,12 @@ fun BoxScope.ChatItemsList(
|
||||
markRead: (CC.ItemRange, unreadCountAfter: Int?) -> Unit,
|
||||
onComposed: suspend (chatId: String) -> Unit,
|
||||
developerTools: Boolean,
|
||||
showViaProxy: Boolean
|
||||
showViaProxy: Boolean,
|
||||
) {
|
||||
val listState = rememberLazyListState()
|
||||
val scope = rememberCoroutineScope()
|
||||
ScrollToBottom(chatInfo.id, listState, chatModel.chatItems)
|
||||
val scrollAdjustmentEnabled = remember { mutableStateOf(true) }
|
||||
ScrollToBottom(chatInfo.id, listState, chatModel.chatItems, scrollAdjustmentEnabled)
|
||||
var prevSearchEmptiness by rememberSaveable { mutableStateOf(searchValue.value.isEmpty()) }
|
||||
// Scroll to bottom when search value changes from something to nothing and back
|
||||
LaunchedEffect(searchValue.value.isEmpty()) {
|
||||
@@ -961,21 +983,106 @@ fun BoxScope.ChatItemsList(
|
||||
}
|
||||
}
|
||||
|
||||
PreloadItems(chatInfo.id, listState, ChatPagination.UNTIL_PRELOAD_COUNT, loadPrevMessages)
|
||||
|
||||
Spacer(Modifier.size(8.dp))
|
||||
val reversedChatItems = remember { derivedStateOf { chatModel.chatItems.asReversed() } }
|
||||
val revealedItems = rememberSaveable(stateSaver = serializableSaver()) { mutableStateOf(setOf<Long>()) }
|
||||
val sections = remember { derivedStateOf { reversedChatItems.value.putIntoSections(revealedItems.value) } }
|
||||
val preloadItemsEnabled = remember { mutableStateOf(true) }
|
||||
val boundaries = remember { derivedStateOf { sections.value.map { it.boundary } } }
|
||||
val scrollPosition: State<(Int) -> Int> = remember { mutableStateOf({ idx -> min(sections.value.revealedItemCount() - 1, idx + 1 ) }) }
|
||||
|
||||
PreloadItems(chatInfo.id, listState, ChatPagination.UNTIL_PRELOAD_COUNT, preloadItemsEnabled, boundaries, loadMessages)
|
||||
|
||||
val topPaddingToContentPx = rememberUpdatedState(with(LocalDensity.current) { topPaddingToContent().roundToPx() })
|
||||
val maxHeight = remember { derivedStateOf { listState.layoutInfo.viewportEndOffset - topPaddingToContentPx.value } }
|
||||
val chatInfoUpdated = rememberUpdatedState(chatInfo)
|
||||
|
||||
LaunchedEffect(Unit) {
|
||||
launch {
|
||||
snapshotFlow { chatInfoUpdated.value.id }
|
||||
.distinctUntilChanged()
|
||||
.collect {
|
||||
if (revealedItems.value.isNotEmpty()) {
|
||||
revealedItems.value = setOf()
|
||||
}
|
||||
val firstUnreadItem = reversedChatItems.value.findLast { it.isRcvNew }
|
||||
if (firstUnreadItem != null) {
|
||||
val firstUnreadItemIndexIdx = sections.value.chatItemPosition(firstUnreadItem.id)
|
||||
if (firstUnreadItemIndexIdx != null) {
|
||||
scrollAdjustmentEnabled.value = false
|
||||
listState.scrollToItem(scrollPosition.value(firstUnreadItemIndexIdx), -maxHeight.value)
|
||||
}
|
||||
|
||||
if (chatModel.chatItemsSectionArea[firstUnreadItem.id] != ChatSectionArea.Bottom) {
|
||||
withBGApi {
|
||||
scrollAdjustmentEnabled.value = false
|
||||
try {
|
||||
apiLoadBottomSection(chatInfoUpdated.value, remoteHostId)
|
||||
} finally {
|
||||
delay(600)
|
||||
scrollAdjustmentEnabled.value = true
|
||||
preloadItemsEnabled.value = true
|
||||
}
|
||||
}
|
||||
} else {
|
||||
scrollAdjustmentEnabled.value = true
|
||||
}
|
||||
}
|
||||
preloadItemsEnabled.value = true
|
||||
}
|
||||
}
|
||||
}
|
||||
val scrollToItem: State<(Long) -> Unit> = remember {
|
||||
mutableStateOf(
|
||||
{ itemId: Long ->
|
||||
val index = reversedChatItems.value.indexOfFirst { it.id == itemId }
|
||||
if (index != -1) {
|
||||
scope.launch { listState.animateScrollToItem(kotlin.math.min(reversedChatItems.value.lastIndex, index + 1), -maxHeight.value) }
|
||||
mutableStateOf({ itemId: Long ->
|
||||
val index = sections.value.chatItemPosition(itemId)
|
||||
preloadItemsEnabled.value = false
|
||||
|
||||
if (index != null) {
|
||||
scope.launch {
|
||||
listState.animateScrollToItem(scrollPosition.value(index), -maxHeight.value)
|
||||
preloadItemsEnabled.value = true
|
||||
}
|
||||
} else {
|
||||
withBGApi {
|
||||
try {
|
||||
val destinationSection = sections.value.find { it.boundary.area == ChatSectionArea.Destination }
|
||||
val itemsToDrop = destinationSection?.items?.flatMap { it.items }?.toList()
|
||||
withContext(Dispatchers.Main) {
|
||||
itemsToDrop?.forEach {
|
||||
chatModel.chatItemsSectionArea[it.id] = ChatSectionArea.Current
|
||||
}
|
||||
}
|
||||
val chatSectionLoader = ChatSectionLoader(0, ChatSectionArea.Destination)
|
||||
apiLoadMessages(
|
||||
rhId = remoteHostId,
|
||||
chatInfo = chatInfoUpdated.value,
|
||||
chatModel = chatModel,
|
||||
itemId = itemId,
|
||||
search = "",
|
||||
chatSectionLoader = chatSectionLoader,
|
||||
pagination = ChatPagination.Around(itemId, ChatPagination.PRELOAD_COUNT * 2)
|
||||
)
|
||||
val idx = sections.value.chatItemPosition(itemId)
|
||||
scope.launch {
|
||||
if (idx != null) {
|
||||
listState.animateScrollToItem(scrollPosition.value(idx), -maxHeight.value)
|
||||
if (!itemsToDrop.isNullOrEmpty()) {
|
||||
itemsToDrop.forEach {
|
||||
chatModel.chatItemsSectionArea.remove(it.id)
|
||||
}
|
||||
chatModel.chatItems.removeAll { chatModel.chatItemsSectionArea[it.id] == null }
|
||||
val newIdx = reversedChatItems.value.indexOfFirst { it.id == itemId }
|
||||
listState.scrollToItem(scrollPosition.value(newIdx), -maxHeight.value)
|
||||
}
|
||||
}
|
||||
preloadItemsEnabled.value = true
|
||||
}
|
||||
} catch (ex: Exception) {
|
||||
preloadItemsEnabled.value = true
|
||||
}
|
||||
}
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
// TODO: Having this block on desktop makes ChatItemsList() to recompose twice on chatModel.chatId update instead of once
|
||||
LaunchedEffect(chatInfo.id) {
|
||||
@@ -993,23 +1100,14 @@ fun BoxScope.ChatItemsList(
|
||||
VideoPlayerHolder.releaseAll()
|
||||
}
|
||||
)
|
||||
LazyColumnWithScrollBar(
|
||||
Modifier.align(Alignment.BottomCenter),
|
||||
state = listState,
|
||||
reverseLayout = true,
|
||||
contentPadding = PaddingValues(
|
||||
top = topPaddingToContent(),
|
||||
bottom = composeViewHeight.value
|
||||
),
|
||||
additionalBarOffset = composeViewHeight
|
||||
) {
|
||||
itemsIndexed(reversedChatItems.value, key = { _, item -> item.id to item.meta.createdAt.toEpochMilliseconds() }) { i, cItem ->
|
||||
val itemScope = rememberCoroutineScope()
|
||||
@Composable
|
||||
fun ChatViewListItem(i: Int, range: IntRange?, showAvatar: Boolean, cItem: ChatItem, prevItem: ChatItem?, nextItem: ChatItem?) {
|
||||
CompositionLocalProvider(
|
||||
// Makes horizontal and vertical scrolling to coexist nicely.
|
||||
// With default touchSlop when you scroll LazyColumn, you can unintentionally open reply view
|
||||
LocalViewConfiguration provides LocalViewConfiguration.current.bigTouchSlop()
|
||||
) {
|
||||
val itemScope = rememberCoroutineScope()
|
||||
val provider = {
|
||||
providerForGallery(i, chatModel.chatItems.value, cItem.id) { indexInReversed ->
|
||||
itemScope.launch {
|
||||
@@ -1021,246 +1119,293 @@ fun BoxScope.ChatItemsList(
|
||||
}
|
||||
}
|
||||
|
||||
val revealed = remember { mutableStateOf(false) }
|
||||
val revealed = remember { mutableStateOf(revealedItems.value.contains(cItem.id)) }
|
||||
|
||||
KeyChangeEffect(revealed.value) {
|
||||
val revealIds = if (range == null) setOf(cItem.id) else reversedChatItems.value.subList(range.first, range.last + 1).map { it.id }.toSet()
|
||||
|
||||
if (revealIds.isNotEmpty()) {
|
||||
if (revealed.value) {
|
||||
revealedItems.value = revealedItems.value.toMutableSet().apply { addAll(revealIds) }
|
||||
} else {
|
||||
revealedItems.value = revealedItems.value.toMutableSet().apply { removeAll(revealIds) }
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@Composable
|
||||
fun ChatItemViewShortHand(cItem: ChatItem, itemSeparation: ItemSeparation, range: IntRange?, fillMaxWidth: Boolean = true) {
|
||||
tryOrShowError("${cItem.id}ChatItem", error = {
|
||||
CIBrokenComposableView(if (cItem.chatDir.sent) Alignment.CenterEnd else Alignment.CenterStart)
|
||||
}) {
|
||||
ChatItemView(remoteHostId, chatInfo, cItem, composeState, provider, useLinkPreviews = useLinkPreviews, linkMode = linkMode, revealed = revealed, range = range, fillMaxWidth = fillMaxWidth, selectedChatItems = selectedChatItems, selectChatItem = { selectUnselectChatItem(true, cItem, revealed, selectedChatItems) }, deleteMessage = deleteMessage, deleteMessages = deleteMessages, receiveFile = receiveFile, cancelFile = cancelFile, joinGroup = joinGroup, acceptCall = acceptCall, acceptFeature = acceptFeature, openDirectChat = openDirectChat, forwardItem = forwardItem, updateContactStats = updateContactStats, updateMemberStats = updateMemberStats, syncContactConnection = syncContactConnection, syncMemberConnection = syncMemberConnection, findModelChat = findModelChat, findModelMember = findModelMember, scrollToItem = scrollToItem.value, setReaction = setReaction, showItemDetails = showItemDetails, developerTools = developerTools, showViaProxy = showViaProxy, itemSeparation = itemSeparation, showTimestamp = itemSeparation.timestamp)
|
||||
}
|
||||
}
|
||||
|
||||
@Composable
|
||||
fun ChatItemView(cItem: ChatItem, range: IntRange?, prevItem: ChatItem?, itemSeparation: ItemSeparation, previousItemSeparation: ItemSeparation?) {
|
||||
val dismissState = rememberDismissState(initialValue = DismissValue.Default) {
|
||||
if (it == DismissValue.DismissedToStart) {
|
||||
itemScope.launch {
|
||||
if ((cItem.content is CIContent.SndMsgContent || cItem.content is CIContent.RcvMsgContent) && chatInfo !is ChatInfo.Local) {
|
||||
if (composeState.value.editing) {
|
||||
composeState.value = ComposeState(contextItem = ComposeContextItem.QuotedItem(cItem), useLinkPreviews = useLinkPreviews)
|
||||
} else if (cItem.id != ChatItem.TEMP_LIVE_CHAT_ITEM_ID) {
|
||||
composeState.value = composeState.value.copy(contextItem = ComposeContextItem.QuotedItem(cItem))
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
false
|
||||
}
|
||||
val swipeableModifier = SwipeToDismissModifier(
|
||||
state = dismissState,
|
||||
directions = setOf(DismissDirection.EndToStart),
|
||||
swipeDistance = with(LocalDensity.current) { 30.dp.toPx() },
|
||||
)
|
||||
val sent = cItem.chatDir.sent
|
||||
|
||||
@Composable
|
||||
fun ChatItemViewShortHand(cItem: ChatItem, itemSeparation: ItemSeparation, range: IntRange?, fillMaxWidth: Boolean = true) {
|
||||
tryOrShowError("${cItem.id}ChatItem", error = {
|
||||
CIBrokenComposableView(if (cItem.chatDir.sent) Alignment.CenterEnd else Alignment.CenterStart)
|
||||
}) {
|
||||
ChatItemView(remoteHostId, chatInfo, cItem, composeState, provider, useLinkPreviews = useLinkPreviews, linkMode = linkMode, revealed = revealed, range = range, fillMaxWidth = fillMaxWidth, selectedChatItems = selectedChatItems, selectChatItem = { selectUnselectChatItem(true, cItem, revealed, selectedChatItems) }, deleteMessage = deleteMessage, deleteMessages = deleteMessages, receiveFile = receiveFile, cancelFile = cancelFile, joinGroup = joinGroup, acceptCall = acceptCall, acceptFeature = acceptFeature, openDirectChat = openDirectChat, forwardItem = forwardItem, updateContactStats = updateContactStats, updateMemberStats = updateMemberStats, syncContactConnection = syncContactConnection, syncMemberConnection = syncMemberConnection, findModelChat = findModelChat, findModelMember = findModelMember, scrollToItem = scrollToItem.value, setReaction = setReaction, showItemDetails = showItemDetails, developerTools = developerTools, showViaProxy = showViaProxy, itemSeparation = itemSeparation, showTimestamp = itemSeparation.timestamp)
|
||||
fun ChatItemBox(modifier: Modifier = Modifier, content: @Composable () -> Unit = { }) {
|
||||
Box(
|
||||
modifier = modifier.padding(
|
||||
bottom = if (itemSeparation.largeGap) {
|
||||
if (i == 0) {
|
||||
8.dp
|
||||
} else {
|
||||
4.dp
|
||||
}
|
||||
} else 1.dp, top = if (previousItemSeparation?.largeGap == true) 4.dp else 1.dp
|
||||
),
|
||||
contentAlignment = Alignment.CenterStart
|
||||
) {
|
||||
content()
|
||||
}
|
||||
}
|
||||
|
||||
@Composable
|
||||
fun ChatItemView(cItem: ChatItem, range: IntRange?, prevItem: ChatItem?, itemSeparation: ItemSeparation, previousItemSeparation: ItemSeparation?) {
|
||||
val dismissState = rememberDismissState(initialValue = DismissValue.Default) {
|
||||
if (it == DismissValue.DismissedToStart) {
|
||||
itemScope.launch {
|
||||
if ((cItem.content is CIContent.SndMsgContent || cItem.content is CIContent.RcvMsgContent) && chatInfo !is ChatInfo.Local) {
|
||||
if (composeState.value.editing) {
|
||||
composeState.value = ComposeState(contextItem = ComposeContextItem.QuotedItem(cItem), useLinkPreviews = useLinkPreviews)
|
||||
} else if (cItem.id != ChatItem.TEMP_LIVE_CHAT_ITEM_ID) {
|
||||
composeState.value = composeState.value.copy(contextItem = ComposeContextItem.QuotedItem(cItem))
|
||||
}
|
||||
fun adjustTailPaddingOffset(originalPadding: Dp, start: Boolean): Dp {
|
||||
val chatItemTail = remember { appPreferences.chatItemTail.state }
|
||||
val style = shapeStyle(cItem, chatItemTail.value, itemSeparation.largeGap, true)
|
||||
val tailRendered = style is ShapeStyle.Bubble && style.tailVisible
|
||||
|
||||
return originalPadding + (if (tailRendered) 0.dp else if (start) msgTailWidthDp * 2 else msgTailWidthDp)
|
||||
}
|
||||
|
||||
Box {
|
||||
val voiceWithTransparentBack = cItem.content.msgContent is MsgContent.MCVoice && cItem.content.text.isEmpty() && cItem.quotedItem == null && cItem.meta.itemForwarded == null
|
||||
val selectionVisible = selectedChatItems.value != null && cItem.canBeDeletedForSelf
|
||||
val selectionOffset by animateDpAsState(if (selectionVisible && !sent) 4.dp + 22.dp * fontSizeMultiplier else 0.dp)
|
||||
val swipeableOrSelectionModifier = (if (selectionVisible) Modifier else swipeableModifier).graphicsLayer { translationX = selectionOffset.toPx() }
|
||||
if (chatInfo is ChatInfo.Group) {
|
||||
if (cItem.chatDir is CIDirection.GroupRcv) {
|
||||
val member = cItem.chatDir.groupMember
|
||||
val (prevMember, memCount) =
|
||||
if (range != null) {
|
||||
chatModel.getPrevHiddenMember(member, range)
|
||||
} else {
|
||||
null to 1
|
||||
}
|
||||
}
|
||||
}
|
||||
false
|
||||
}
|
||||
val swipeableModifier = SwipeToDismissModifier(
|
||||
state = dismissState,
|
||||
directions = setOf(DismissDirection.EndToStart),
|
||||
swipeDistance = with(LocalDensity.current) { 30.dp.toPx() },
|
||||
)
|
||||
val sent = cItem.chatDir.sent
|
||||
|
||||
@Composable
|
||||
fun ChatItemBox(modifier: Modifier = Modifier, content: @Composable () -> Unit = { }) {
|
||||
Box(
|
||||
modifier = modifier.padding(
|
||||
bottom = if (itemSeparation.largeGap) {
|
||||
if (i == 0) {
|
||||
8.dp
|
||||
} else {
|
||||
4.dp
|
||||
}
|
||||
} else 1.dp, top = if (previousItemSeparation?.largeGap == true) 4.dp else 1.dp
|
||||
),
|
||||
contentAlignment = Alignment.CenterStart
|
||||
) {
|
||||
content()
|
||||
}
|
||||
}
|
||||
if (showMemberImage(member, prevItem) || showAvatar) {
|
||||
Column(
|
||||
Modifier
|
||||
.padding(top = 8.dp)
|
||||
.padding(start = 8.dp, end = if (voiceWithTransparentBack) 12.dp else adjustTailPaddingOffset(66.dp, start = false))
|
||||
.fillMaxWidth()
|
||||
.then(swipeableModifier),
|
||||
verticalArrangement = Arrangement.spacedBy(4.dp),
|
||||
horizontalAlignment = Alignment.Start
|
||||
) {
|
||||
@Composable
|
||||
fun MemberNameAndRole() {
|
||||
Row(Modifier.padding(bottom = 2.dp).graphicsLayer { translationX = selectionOffset.toPx() }, horizontalArrangement = Arrangement.SpaceBetween) {
|
||||
Text(
|
||||
memberNames(member, prevMember, memCount),
|
||||
Modifier
|
||||
.padding(start = (MEMBER_IMAGE_SIZE * fontSizeSqrtMultiplier) + DEFAULT_PADDING_HALF)
|
||||
.weight(1f, false),
|
||||
fontSize = 13.5.sp,
|
||||
color = MaterialTheme.colors.secondary,
|
||||
overflow = TextOverflow.Ellipsis,
|
||||
maxLines = 1
|
||||
)
|
||||
if (memCount == 1 && member.memberRole > GroupMemberRole.Member) {
|
||||
val chatItemTail = remember { appPreferences.chatItemTail.state }
|
||||
val style = shapeStyle(cItem, chatItemTail.value, itemSeparation.largeGap, true)
|
||||
val tailRendered = style is ShapeStyle.Bubble && style.tailVisible
|
||||
|
||||
@Composable
|
||||
fun adjustTailPaddingOffset(originalPadding: Dp, start: Boolean): Dp {
|
||||
val chatItemTail = remember { appPreferences.chatItemTail.state }
|
||||
val style = shapeStyle(cItem, chatItemTail.value, itemSeparation.largeGap, true)
|
||||
val tailRendered = style is ShapeStyle.Bubble && style.tailVisible
|
||||
|
||||
return originalPadding + (if (tailRendered) 0.dp else if (start) msgTailWidthDp * 2 else msgTailWidthDp)
|
||||
}
|
||||
|
||||
Box {
|
||||
val voiceWithTransparentBack = cItem.content.msgContent is MsgContent.MCVoice && cItem.content.text.isEmpty() && cItem.quotedItem == null && cItem.meta.itemForwarded == null
|
||||
val selectionVisible = selectedChatItems.value != null && cItem.canBeDeletedForSelf
|
||||
val selectionOffset by animateDpAsState(if (selectionVisible && !sent) 4.dp + 22.dp * fontSizeMultiplier else 0.dp)
|
||||
val swipeableOrSelectionModifier = (if (selectionVisible) Modifier else swipeableModifier).graphicsLayer { translationX = selectionOffset.toPx() }
|
||||
if (chatInfo is ChatInfo.Group) {
|
||||
if (cItem.chatDir is CIDirection.GroupRcv) {
|
||||
val member = cItem.chatDir.groupMember
|
||||
val (prevMember, memCount) =
|
||||
if (range != null) {
|
||||
chatModel.getPrevHiddenMember(member, range)
|
||||
} else {
|
||||
null to 1
|
||||
}
|
||||
if (prevItem == null || showMemberImage(member, prevItem) || prevMember != null) {
|
||||
Column(
|
||||
Modifier
|
||||
.padding(top = 8.dp)
|
||||
.padding(start = 8.dp, end = if (voiceWithTransparentBack) 12.dp else adjustTailPaddingOffset(66.dp, start = false))
|
||||
.fillMaxWidth()
|
||||
.then(swipeableModifier),
|
||||
verticalArrangement = Arrangement.spacedBy(4.dp),
|
||||
horizontalAlignment = Alignment.Start
|
||||
) {
|
||||
@Composable
|
||||
fun MemberNameAndRole() {
|
||||
Row(Modifier.padding(bottom = 2.dp).graphicsLayer { translationX = selectionOffset.toPx() }, horizontalArrangement = Arrangement.SpaceBetween) {
|
||||
Text(
|
||||
memberNames(member, prevMember, memCount),
|
||||
Modifier
|
||||
.padding(start = (MEMBER_IMAGE_SIZE * fontSizeSqrtMultiplier) + DEFAULT_PADDING_HALF)
|
||||
.weight(1f, false),
|
||||
member.memberRole.text,
|
||||
Modifier.padding(start = DEFAULT_PADDING_HALF * 1.5f, end = DEFAULT_PADDING_HALF + if (tailRendered) msgTailWidthDp else 0.dp),
|
||||
fontSize = 13.5.sp,
|
||||
fontWeight = FontWeight.Medium,
|
||||
color = MaterialTheme.colors.secondary,
|
||||
overflow = TextOverflow.Ellipsis,
|
||||
maxLines = 1
|
||||
)
|
||||
if (memCount == 1 && member.memberRole > GroupMemberRole.Member) {
|
||||
val chatItemTail = remember { appPreferences.chatItemTail.state }
|
||||
val style = shapeStyle(cItem, chatItemTail.value, itemSeparation.largeGap, true)
|
||||
val tailRendered = style is ShapeStyle.Bubble && style.tailVisible
|
||||
|
||||
Text(
|
||||
member.memberRole.text,
|
||||
Modifier.padding(start = DEFAULT_PADDING_HALF * 1.5f, end = DEFAULT_PADDING_HALF + if (tailRendered) msgTailWidthDp else 0.dp),
|
||||
fontSize = 13.5.sp,
|
||||
fontWeight = FontWeight.Medium,
|
||||
color = MaterialTheme.colors.secondary,
|
||||
maxLines = 1
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@Composable
|
||||
fun Item() {
|
||||
ChatItemBox(Modifier.layoutId(CHAT_BUBBLE_LAYOUT_ID)) {
|
||||
androidx.compose.animation.AnimatedVisibility(selectionVisible, enter = fadeIn(), exit = fadeOut()) {
|
||||
SelectedChatItem(Modifier, cItem.id, selectedChatItems)
|
||||
}
|
||||
Row(Modifier.graphicsLayer { translationX = selectionOffset.toPx() }) {
|
||||
Box(Modifier.clickable { showMemberInfo(chatInfo.groupInfo, member) }) {
|
||||
MemberImage(member)
|
||||
}
|
||||
Box(modifier = Modifier.padding(top = 2.dp, start = 4.dp).chatItemOffset(cItem, itemSeparation.largeGap, revealed = revealed.value)) {
|
||||
ChatItemViewShortHand(cItem, itemSeparation, range, false)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (cItem.content.showMemberName) {
|
||||
DependentLayout(Modifier, CHAT_BUBBLE_LAYOUT_ID) {
|
||||
MemberNameAndRole()
|
||||
Item()
|
||||
}
|
||||
} else {
|
||||
Item()
|
||||
}
|
||||
}
|
||||
} else {
|
||||
ChatItemBox {
|
||||
AnimatedVisibility (selectionVisible, enter = fadeIn(), exit = fadeOut()) {
|
||||
SelectedChatItem(Modifier.padding(start = 8.dp), cItem.id, selectedChatItems)
|
||||
|
||||
@Composable
|
||||
fun Item() {
|
||||
ChatItemBox(Modifier.layoutId(CHAT_BUBBLE_LAYOUT_ID)) {
|
||||
androidx.compose.animation.AnimatedVisibility(selectionVisible, enter = fadeIn(), exit = fadeOut()) {
|
||||
SelectedChatItem(Modifier, cItem.id, selectedChatItems)
|
||||
}
|
||||
Row(Modifier.graphicsLayer { translationX = selectionOffset.toPx() }) {
|
||||
Box(Modifier.clickable { showMemberInfo(chatInfo.groupInfo, member) }) {
|
||||
MemberImage(member)
|
||||
}
|
||||
Box(modifier = Modifier.padding(top = 2.dp, start = 4.dp).chatItemOffset(cItem, itemSeparation.largeGap, revealed = revealed.value)) {
|
||||
ChatItemViewShortHand(cItem, itemSeparation, range, false)
|
||||
}
|
||||
}
|
||||
}
|
||||
Row(
|
||||
Modifier
|
||||
.padding(start = 8.dp + (MEMBER_IMAGE_SIZE * fontSizeSqrtMultiplier) + 4.dp, end = if (voiceWithTransparentBack) 12.dp else adjustTailPaddingOffset(66.dp, start = false))
|
||||
.chatItemOffset(cItem, itemSeparation.largeGap, revealed = revealed.value)
|
||||
.then(swipeableOrSelectionModifier)
|
||||
) {
|
||||
ChatItemViewShortHand(cItem, itemSeparation, range)
|
||||
}
|
||||
if (cItem.content.showMemberName) {
|
||||
DependentLayout(Modifier, CHAT_BUBBLE_LAYOUT_ID) {
|
||||
MemberNameAndRole()
|
||||
Item()
|
||||
}
|
||||
} else {
|
||||
Item()
|
||||
}
|
||||
}
|
||||
} else {
|
||||
ChatItemBox {
|
||||
AnimatedVisibility (selectionVisible, enter = fadeIn(), exit = fadeOut()) {
|
||||
AnimatedVisibility(selectionVisible, enter = fadeIn(), exit = fadeOut()) {
|
||||
SelectedChatItem(Modifier.padding(start = 8.dp), cItem.id, selectedChatItems)
|
||||
}
|
||||
Box(
|
||||
Row(
|
||||
Modifier
|
||||
.padding(start = if (voiceWithTransparentBack) 12.dp else adjustTailPaddingOffset(104.dp, start = true), end = 12.dp)
|
||||
.padding(start = 8.dp + (MEMBER_IMAGE_SIZE * fontSizeSqrtMultiplier) + 4.dp, end = if (voiceWithTransparentBack) 12.dp else adjustTailPaddingOffset(66.dp, start = false))
|
||||
.chatItemOffset(cItem, itemSeparation.largeGap, revealed = revealed.value)
|
||||
.then(if (selectionVisible) Modifier else swipeableModifier)
|
||||
.then(swipeableOrSelectionModifier)
|
||||
) {
|
||||
ChatItemViewShortHand(cItem, itemSeparation, range)
|
||||
}
|
||||
}
|
||||
}
|
||||
} else { // direct message
|
||||
} else {
|
||||
ChatItemBox {
|
||||
AnimatedVisibility (selectionVisible, enter = fadeIn(), exit = fadeOut()) {
|
||||
AnimatedVisibility(selectionVisible, enter = fadeIn(), exit = fadeOut()) {
|
||||
SelectedChatItem(Modifier.padding(start = 8.dp), cItem.id, selectedChatItems)
|
||||
}
|
||||
|
||||
Box(
|
||||
Modifier.padding(
|
||||
start = if (sent && !voiceWithTransparentBack) adjustTailPaddingOffset(76.dp, start = true) else 12.dp,
|
||||
end = if (sent || voiceWithTransparentBack) 12.dp else adjustTailPaddingOffset(76.dp, start = false),
|
||||
)
|
||||
Modifier
|
||||
.padding(start = if (voiceWithTransparentBack) 12.dp else adjustTailPaddingOffset(104.dp, start = true), end = 12.dp)
|
||||
.chatItemOffset(cItem, itemSeparation.largeGap, revealed = revealed.value)
|
||||
.then(if (!selectionVisible || !sent) swipeableOrSelectionModifier else Modifier)
|
||||
.then(if (selectionVisible) Modifier else swipeableModifier)
|
||||
) {
|
||||
ChatItemViewShortHand(cItem, itemSeparation, range)
|
||||
}
|
||||
}
|
||||
}
|
||||
if (selectionVisible) {
|
||||
Box(Modifier.matchParentSize().clickable {
|
||||
val checked = selectedChatItems.value?.contains(cItem.id) == true
|
||||
selectUnselectChatItem(select = !checked, cItem, revealed, selectedChatItems)
|
||||
})
|
||||
} else { // direct message
|
||||
ChatItemBox {
|
||||
AnimatedVisibility(selectionVisible, enter = fadeIn(), exit = fadeOut()) {
|
||||
SelectedChatItem(Modifier.padding(start = 8.dp), cItem.id, selectedChatItems)
|
||||
}
|
||||
|
||||
Box(
|
||||
Modifier.padding(
|
||||
start = if (sent && !voiceWithTransparentBack) adjustTailPaddingOffset(76.dp, start = true) else 12.dp,
|
||||
end = if (sent || voiceWithTransparentBack) 12.dp else adjustTailPaddingOffset(76.dp, start = false),
|
||||
)
|
||||
.chatItemOffset(cItem, itemSeparation.largeGap, revealed = revealed.value)
|
||||
.then(if (!selectionVisible || !sent) swipeableOrSelectionModifier else Modifier)
|
||||
) {
|
||||
ChatItemViewShortHand(cItem, itemSeparation, range)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
val (currIndex, nextItem) = chatModel.getNextChatItem(cItem)
|
||||
val ciCategory = cItem.mergeCategory
|
||||
if (ciCategory != null && ciCategory == nextItem?.mergeCategory) {
|
||||
// memberConnected events and deleted items are aggregated at the last chat item in a row, see ChatItemView
|
||||
} else {
|
||||
val (prevHidden, prevItem) = chatModel.getPrevShownChatItem(currIndex, ciCategory)
|
||||
|
||||
val itemSeparation = getItemSeparation(cItem, nextItem)
|
||||
val previousItemSeparation = if (prevItem != null) getItemSeparation(prevItem, cItem) else null
|
||||
|
||||
if (itemSeparation.date != null) {
|
||||
DateSeparator(itemSeparation.date)
|
||||
if (selectionVisible) {
|
||||
Box(Modifier.matchParentSize().clickable {
|
||||
val checked = selectedChatItems.value?.contains(cItem.id) == true
|
||||
selectUnselectChatItem(select = !checked, cItem, revealed, selectedChatItems)
|
||||
})
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
val range = chatViewItemsRange(currIndex, prevHidden)
|
||||
val reversed = reversedChatItems.value
|
||||
if (revealed.value && range != null) {
|
||||
reversed.subList(range.first, range.last + 1).forEachIndexed { index, ci ->
|
||||
val prev = if (index + range.first == prevHidden) prevItem else reversed[index + range.first + 1]
|
||||
ChatItemView(ci, null, prev, itemSeparation, previousItemSeparation)
|
||||
if (cItem.isRcvNew && chatInfo.id == ChatModel.chatId.value) {
|
||||
LaunchedEffect(cItem.id) {
|
||||
itemScope.launch {
|
||||
delay(600)
|
||||
val itemRange = if (range != null) {
|
||||
val firstItem = reversedChatItems.value.getOrNull(range.first)
|
||||
val lastItem = reversedChatItems.value.getOrNull(range.last)
|
||||
if (lastItem != null && firstItem != null) {
|
||||
CC.ItemRange(lastItem.id, firstItem.id)
|
||||
} else {
|
||||
null
|
||||
}
|
||||
} else {
|
||||
CC.ItemRange(cItem.id, cItem.id)
|
||||
}
|
||||
} else {
|
||||
ChatItemView(cItem, range, prevItem, itemSeparation, previousItemSeparation)
|
||||
}
|
||||
|
||||
if (i == reversed.lastIndex) {
|
||||
DateSeparator(cItem.meta.itemTs)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if (cItem.isRcvNew && chatInfo.id == ChatModel.chatId.value) {
|
||||
LaunchedEffect(cItem.id) {
|
||||
itemScope.launch {
|
||||
delay(600)
|
||||
markRead(CC.ItemRange(cItem.id, cItem.id), null)
|
||||
if (itemRange != null) {
|
||||
markRead(itemRange, null)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
val itemSeparation = getItemSeparation(cItem, nextItem)
|
||||
val previousItemSeparation = if (prevItem != null) getItemSeparation(prevItem, cItem) else null
|
||||
|
||||
if (itemSeparation.date != null) {
|
||||
DateSeparator(itemSeparation.date)
|
||||
}
|
||||
|
||||
ChatItemView(cItem, range, prevItem, itemSeparation, previousItemSeparation)
|
||||
}
|
||||
}
|
||||
LazyColumnWithScrollBar(
|
||||
Modifier.align(Alignment.BottomCenter),
|
||||
state = listState,
|
||||
reverseLayout = true,
|
||||
contentPadding = PaddingValues(
|
||||
top = topPaddingToContent(),
|
||||
bottom = composeViewHeight.value
|
||||
),
|
||||
additionalBarOffset = composeViewHeight
|
||||
) {
|
||||
for (area in sections.value) {
|
||||
for ((sIdx, section) in area.items.withIndex()) {
|
||||
if (section.revealed) {
|
||||
itemsIndexed(section.items, key = { _, item -> item.id to item.meta.createdAt.toEpochMilliseconds() }) { i, cItem ->
|
||||
// index here is just temporary, should be removed at all or put in the section items
|
||||
val prevItem = area.getPreviousShownItem(sIdx, i)
|
||||
val nextItem = area.getNextShownItem(sIdx, i)
|
||||
ChatViewListItem(area.itemPositions[cItem.id] ?: -1, section.originalItemsRange.takeIf { cItem.mergeCategory != null }, section.showAvatar.contains(cItem.id), cItem, prevItem, nextItem, )
|
||||
}
|
||||
} else {
|
||||
val item = section.items.first()
|
||||
item(key = item.id to item.meta.createdAt.toEpochMilliseconds()) {
|
||||
// here you make one collapsed item from multiple items (should be already in section items)
|
||||
val prevItem = area.getPreviousShownItem(sIdx, section.items.lastIndex)
|
||||
val nextItem = area.getNextShownItem(sIdx, section.items.lastIndex)
|
||||
ChatViewListItem(area.itemPositions[item.id] ?: -1, section.originalItemsRange, section.showAvatar.contains(item.id), item, prevItem, nextItem)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (reversedChatItems.value.isNotEmpty()) {
|
||||
item {
|
||||
DateSeparator(reversedChatItems.value.last().meta.itemTs)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
FloatingButtons(chatModel.chatItems, unreadCount, composeViewHeight, remoteHostId, chatInfo, searchValue, markRead, listState) {
|
||||
preloadItemsEnabled.value = false
|
||||
scope.launch {
|
||||
listState.animateScrollToItem(0)
|
||||
preloadItemsEnabled.value = true
|
||||
sections.value.dropTemporarySections()
|
||||
}
|
||||
}
|
||||
FloatingButtons(chatModel.chatItems, unreadCount, composeViewHeight, remoteHostId, chatInfo, searchValue, markRead, listState)
|
||||
|
||||
FloatingDate(
|
||||
Modifier.padding(top = 10.dp + topPaddingToContent()).align(Alignment.TopCenter),
|
||||
@@ -1276,13 +1421,13 @@ fun BoxScope.ChatItemsList(
|
||||
}
|
||||
|
||||
@Composable
|
||||
private fun ScrollToBottom(chatId: ChatId, listState: LazyListState, chatItems: State<List<ChatItem>>) {
|
||||
private fun ScrollToBottom(chatId: ChatId, listState: LazyListState, chatItems: State<List<ChatItem>>, enabled: State<Boolean>) {
|
||||
val scope = rememberCoroutineScope()
|
||||
// Helps to scroll to bottom after moving from Group to Direct chat
|
||||
// and prevents scrolling to bottom on orientation change
|
||||
var shouldAutoScroll by rememberSaveable { mutableStateOf(true to chatId) }
|
||||
LaunchedEffect(chatId, shouldAutoScroll) {
|
||||
if ((shouldAutoScroll.first || shouldAutoScroll.second != chatId) && listState.firstVisibleItemIndex != 0) {
|
||||
if ((shouldAutoScroll.first || shouldAutoScroll.second != chatId) && listState.firstVisibleItemIndex != 0 && enabled.value) {
|
||||
scope.launch { listState.scrollToItem(0) }
|
||||
}
|
||||
// Don't autoscroll next time until it will be needed
|
||||
@@ -1296,7 +1441,7 @@ private fun ScrollToBottom(chatId: ChatId, listState: LazyListState, chatItems:
|
||||
LaunchedEffect(Unit) {
|
||||
snapshotFlow { chatItems.value.lastOrNull()?.id }
|
||||
.distinctUntilChanged()
|
||||
.filter { listState.layoutInfo.visibleItemsInfo.firstOrNull()?.key != it }
|
||||
.filter { listState.layoutInfo.visibleItemsInfo.firstOrNull()?.key != it && enabled.value }
|
||||
.collect {
|
||||
try {
|
||||
if (listState.firstVisibleItemIndex == 0 || (listState.firstVisibleItemIndex == 1 && listState.layoutInfo.totalItemsCount == chatItems.value.size)) {
|
||||
@@ -1326,7 +1471,8 @@ fun BoxScope.FloatingButtons(
|
||||
chatInfo: ChatInfo,
|
||||
searchValue: State<String>,
|
||||
markRead: (CC.ItemRange, unreadCountAfter: Int?) -> Unit,
|
||||
listState: LazyListState
|
||||
listState: LazyListState,
|
||||
scrollToLatestItem: () -> Unit
|
||||
) {
|
||||
val scope = rememberCoroutineScope()
|
||||
val maxHeight = remember { derivedStateOf { listState.layoutInfo.viewportSize.height } }
|
||||
@@ -1348,9 +1494,7 @@ fun BoxScope.FloatingButtons(
|
||||
showBottomButtonWithCounter,
|
||||
showBottomButtonWithArrow,
|
||||
composeViewHeight,
|
||||
onClickArrowDown = {
|
||||
scope.launch { listState.animateScrollToItem(0) }
|
||||
},
|
||||
onClickArrowDown = scrollToLatestItem,
|
||||
onClickCounter = {
|
||||
val firstVisibleOffset = (-maxHeight.value * 0.8).toInt()
|
||||
scope.launch { listState.animateScrollToItem(kotlin.math.max(0, bottomUnreadCount.value - 1), firstVisibleOffset) }
|
||||
@@ -1397,12 +1541,35 @@ fun PreloadItems(
|
||||
chatId: String,
|
||||
listState: LazyListState,
|
||||
remaining: Int = 10,
|
||||
onLoadMore: (ChatId) -> Unit,
|
||||
enabled: State<Boolean>,
|
||||
boundaries: State<List<ChatSectionAreaBoundary>>,
|
||||
onLoadMore: (ChatId, ScrollDirection, Triple<Long, Int, ChatSectionArea>) -> Unit,
|
||||
) {
|
||||
// Prevent situation when initial load and load more happens one after another after selecting a chat with long scroll position from previous selection
|
||||
val allowLoad = remember { mutableStateOf(false) }
|
||||
val chatId = rememberUpdatedState(chatId)
|
||||
val onLoadMore = rememberUpdatedState(onLoadMore)
|
||||
var scrollDirection by remember { mutableStateOf(ScrollDirection.Idle) }
|
||||
var previousIndex by remember { mutableStateOf(0) }
|
||||
var previousScrollOffset by remember { mutableStateOf(0) }
|
||||
|
||||
LaunchedEffect(listState.firstVisibleItemIndex, listState.firstVisibleItemScrollOffset) {
|
||||
val currentIndex = listState.firstVisibleItemIndex
|
||||
val currentScrollOffset = listState.firstVisibleItemScrollOffset
|
||||
val threshold = 25
|
||||
|
||||
scrollDirection = when {
|
||||
currentIndex > previousIndex -> ScrollDirection.Up
|
||||
currentIndex < previousIndex -> ScrollDirection.Down
|
||||
currentScrollOffset > previousScrollOffset + threshold -> ScrollDirection.Up
|
||||
currentScrollOffset < previousScrollOffset - threshold -> ScrollDirection.Down
|
||||
currentScrollOffset == previousScrollOffset -> ScrollDirection.Idle
|
||||
else -> scrollDirection
|
||||
}
|
||||
|
||||
previousIndex = currentIndex
|
||||
previousScrollOffset = currentScrollOffset
|
||||
}
|
||||
LaunchedEffect(Unit) {
|
||||
snapshotFlow { chatId.value }
|
||||
.filterNotNull()
|
||||
@@ -1412,19 +1579,41 @@ fun PreloadItems(
|
||||
allowLoad.value = true
|
||||
}
|
||||
}
|
||||
KeyChangeEffect(allowLoad.value) {
|
||||
KeyChangeEffect(allowLoad.value, enabled.value) {
|
||||
snapshotFlow {
|
||||
val lInfo = listState.layoutInfo
|
||||
val totalItemsNumber = lInfo.totalItemsCount
|
||||
val lastVisibleItemIndex = (lInfo.visibleItemsInfo.lastOrNull()?.index ?: 0) + 1
|
||||
if (allowLoad.value && lastVisibleItemIndex > (totalItemsNumber - remaining) && totalItemsNumber >= ChatPagination.INITIAL_COUNT)
|
||||
totalItemsNumber + ChatPagination.PRELOAD_COUNT
|
||||
else
|
||||
0
|
||||
val section = if (scrollDirection == ScrollDirection.Up) {
|
||||
boundaries.value.find { lastVisibleItemIndex in it.minIndex..it.maxIndex }
|
||||
} else if (scrollDirection == ScrollDirection.Down) {
|
||||
boundaries.value.find { listState.firstVisibleItemIndex in it.minIndex..it.maxIndex }
|
||||
} else {
|
||||
null
|
||||
}
|
||||
|
||||
val request = if (allowLoad.value && section != null && enabled.value) {
|
||||
val itemIdx = when {
|
||||
scrollDirection == ScrollDirection.Up && lastVisibleItemIndex > (section.maxIndex - remaining) -> {
|
||||
chatModel.chatItems.size - 1 - section.maxIndex
|
||||
}
|
||||
scrollDirection == ScrollDirection.Down && section.area != ChatSectionArea.Bottom && listState.firstVisibleItemIndex < (section.minIndex + remaining) && totalItemsNumber > remaining -> {
|
||||
chatModel.chatItems.size - 1 - section.minIndex
|
||||
}
|
||||
else -> null
|
||||
}
|
||||
val itemId = itemIdx?.let { chatModel.chatItems.value.getOrNull(it)?.id }
|
||||
itemId?.let { Triple(it, itemIdx, section.area) }
|
||||
} else {
|
||||
null
|
||||
}
|
||||
|
||||
request
|
||||
}
|
||||
.filter { it > 0 }
|
||||
.distinctUntilChanged()
|
||||
.filterNotNull()
|
||||
.collect {
|
||||
onLoadMore.value(chatId.value)
|
||||
onLoadMore.value(chatId.value, scrollDirection, it)
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -2102,7 +2291,7 @@ fun PreviewChatLayout() {
|
||||
back = {},
|
||||
info = {},
|
||||
showMemberInfo = { _, _ -> },
|
||||
loadPrevMessages = {},
|
||||
loadMessages = { _, _, _ -> },
|
||||
deleteMessage = { _, _ -> },
|
||||
deleteMessages = { _ -> },
|
||||
receiveFile = { _ -> },
|
||||
@@ -2174,7 +2363,7 @@ fun PreviewGroupChatLayout() {
|
||||
back = {},
|
||||
info = {},
|
||||
showMemberInfo = { _, _ -> },
|
||||
loadPrevMessages = {},
|
||||
loadMessages = { _, _, _ -> },
|
||||
deleteMessage = { _, _ -> },
|
||||
deleteMessages = {},
|
||||
receiveFile = { _ -> },
|
||||
|
||||
+3
-2
@@ -70,8 +70,9 @@ fun GroupMemberInfoView(
|
||||
getContactChat = { chatModel.getContactChat(it) },
|
||||
openDirectChat = {
|
||||
withBGApi {
|
||||
val c = chatModel.controller.apiGetChat(rhId, ChatType.Direct, it)
|
||||
if (c != null) {
|
||||
val r = chatModel.controller.apiGetChat(rhId, ChatType.Direct, it, ChatPagination.Initial(ChatPagination.INITIAL_COUNT))
|
||||
if (r != null) {
|
||||
val (c) = r
|
||||
withChats {
|
||||
if (chatModel.getContactChat(it) == null) {
|
||||
addChat(c)
|
||||
|
||||
+7
-1
@@ -129,7 +129,13 @@ fun FramedItemView(
|
||||
.fillMaxWidth()
|
||||
.combinedClickable(
|
||||
onLongClick = { showMenu.value = true },
|
||||
onClick = { scrollToItem(qi.itemId?: return@combinedClickable) }
|
||||
onClick = {
|
||||
if (qi.itemId == null) {
|
||||
AlertManager.shared.showAlertMsg(generalGetString(MR.strings.failed_to_get_chat_item_not_found_title), generalGetString(MR.strings.failed_to_get_chat_item_not_found_description))
|
||||
} else {
|
||||
scrollToItem(qi.itemId)
|
||||
}
|
||||
}
|
||||
)
|
||||
.onRightClick { showMenu.value = true }
|
||||
) {
|
||||
|
||||
+27
-14
@@ -1,7 +1,6 @@
|
||||
package chat.simplex.common.views.chatlist
|
||||
|
||||
import SectionItemView
|
||||
import androidx.compose.animation.core.animateFloatAsState
|
||||
import androidx.compose.foundation.layout.*
|
||||
import androidx.compose.material.*
|
||||
import androidx.compose.runtime.*
|
||||
@@ -32,6 +31,7 @@ import chat.simplex.common.views.helpers.*
|
||||
import chat.simplex.common.views.newchat.*
|
||||
import chat.simplex.res.MR
|
||||
import kotlinx.coroutines.*
|
||||
import kotlinx.coroutines.flow.map
|
||||
import kotlinx.datetime.Clock
|
||||
|
||||
@Composable
|
||||
@@ -204,43 +204,56 @@ suspend fun noteFolderChatAction(rhId: Long?, noteFolder: NoteFolder) {
|
||||
}
|
||||
|
||||
suspend fun openDirectChat(rhId: Long?, contactId: Long, chatModel: ChatModel) = coroutineScope {
|
||||
val chat = chatModel.controller.apiGetChat(rhId, ChatType.Direct, contactId)
|
||||
val chat = chatModel.controller.apiGetChat(rhId, ChatType.Direct, contactId, ChatPagination.Initial(ChatPagination.INITIAL_COUNT))
|
||||
if (chat != null && isActive) {
|
||||
openLoadedChat(chat, chatModel)
|
||||
openLoadedChat(chat.first, chatModel, chat.second)
|
||||
}
|
||||
}
|
||||
|
||||
suspend fun openGroupChat(rhId: Long?, groupId: Long, chatModel: ChatModel) = coroutineScope {
|
||||
val chat = chatModel.controller.apiGetChat(rhId, ChatType.Group, groupId)
|
||||
val chat = chatModel.controller.apiGetChat(rhId, ChatType.Group, groupId, ChatPagination.Initial(ChatPagination.INITIAL_COUNT))
|
||||
if (chat != null && isActive) {
|
||||
openLoadedChat(chat, chatModel)
|
||||
openLoadedChat(chat.first, chatModel, chat.second)
|
||||
}
|
||||
}
|
||||
|
||||
suspend fun openChat(rhId: Long?, chatInfo: ChatInfo, chatModel: ChatModel) = coroutineScope {
|
||||
val chat = chatModel.controller.apiGetChat(rhId, chatInfo.chatType, chatInfo.apiId)
|
||||
val chat = chatModel.controller.apiGetChat(rhId, chatInfo.chatType, chatInfo.apiId, ChatPagination.Initial(ChatPagination.INITIAL_COUNT))
|
||||
if (chat != null && isActive) {
|
||||
openLoadedChat(chat, chatModel)
|
||||
openLoadedChat(chat.first, chatModel, chat.second)
|
||||
}
|
||||
}
|
||||
|
||||
fun openLoadedChat(chat: Chat, chatModel: ChatModel) {
|
||||
fun openLoadedChat(chat: Chat, chatModel: ChatModel, landingSection: ChatLandingSection = ChatLandingSection.Latest) {
|
||||
chatModel.chatItemStatuses.clear()
|
||||
chatModel.chatItems.replaceAll(chat.chatItems)
|
||||
chatModel.chatId.value = chat.chatInfo.id
|
||||
chatModel.chatItemsSectionArea.clear()
|
||||
chatModel.chatItems.value.associateTo(chatModel.chatItemsSectionArea) { it.id to landingSectionToArea(landingSection) }
|
||||
}
|
||||
|
||||
suspend fun apiLoadPrevMessages(ch: Chat, chatModel: ChatModel, beforeChatItemId: Long, search: String) {
|
||||
val chatInfo = ch.chatInfo
|
||||
val pagination = ChatPagination.Before(beforeChatItemId, ChatPagination.PRELOAD_COUNT)
|
||||
val chat = chatModel.controller.apiGetChat(ch.remoteHostId, chatInfo.chatType, chatInfo.apiId, pagination, search) ?: return
|
||||
suspend fun apiLoadMessages(
|
||||
rhId: Long?,
|
||||
chatInfo: ChatInfo,
|
||||
chatModel: ChatModel,
|
||||
itemId: Long,
|
||||
search: String,
|
||||
chatSectionLoader: ChatSectionLoader,
|
||||
pagination: ChatPagination = ChatPagination.Before(itemId, ChatPagination.PRELOAD_COUNT)
|
||||
) {
|
||||
val (chat) = chatModel.controller.apiGetChat(rhId, chatInfo.chatType, chatInfo.apiId, pagination, search) ?: return
|
||||
if (chatModel.chatId.value != chat.id) return
|
||||
chatModel.chatItems.addAll(0, chat.chatItems)
|
||||
withContext(Dispatchers.Main) {
|
||||
val itemsToAdd = chatSectionLoader.prepareItems(chat.chatItems)
|
||||
if (itemsToAdd.isNotEmpty()) {
|
||||
chatModel.chatItems.addAll(chatSectionLoader.position, itemsToAdd)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
suspend fun apiFindMessages(ch: Chat, chatModel: ChatModel, search: String) {
|
||||
val chatInfo = ch.chatInfo
|
||||
val chat = chatModel.controller.apiGetChat(ch.remoteHostId, chatInfo.chatType, chatInfo.apiId, search = search) ?: return
|
||||
val (chat) = chatModel.controller.apiGetChat(ch.remoteHostId, chatInfo.chatType, chatInfo.apiId, search = search) ?: return
|
||||
if (chatModel.chatId.value != chat.id) return
|
||||
chatModel.chatItems.replaceAll(chat.chatItems)
|
||||
}
|
||||
|
||||
+2
-2
@@ -105,7 +105,7 @@ class ModalManager(private val placement: ModalPlacement? = null) {
|
||||
// Means, animation is in progress or not started yet. Do not wait until animation finishes, just remove all from screen.
|
||||
// This is useful when invoking close() and ShowCustomModal one after another without delay. Otherwise, screen will hold prev view
|
||||
if (toRemove.isNotEmpty()) {
|
||||
runAtomically { toRemove.removeIf { elem -> modalViews.removeAt(elem); true } }
|
||||
runAtomically { toRemove.removeAll { elem -> modalViews.removeAt(elem); true } }
|
||||
}
|
||||
// Make animated appearance only on Android (everytime) and on Desktop (when it's on the start part of the screen or modals > 0)
|
||||
// to prevent unneeded animation on different situations
|
||||
@@ -184,7 +184,7 @@ class ModalManager(private val placement: ModalPlacement? = null) {
|
||||
}
|
||||
// This is needed because if we delete from modalViews immediately on request, animation will be bad
|
||||
if (toRemove.isNotEmpty() && it == modalCount.value && transition.currentState == EnterExitState.Visible && !transition.isRunning) {
|
||||
runAtomically { toRemove.removeIf { elem -> modalViews.removeAt(elem); true } }
|
||||
runAtomically { toRemove.removeAll { elem -> modalViews.removeAt(elem); true } }
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -101,6 +101,8 @@
|
||||
<string name="error_loading_xftp_servers">Error loading XFTP servers</string>
|
||||
<string name="error_setting_network_config">Error updating network configuration</string>
|
||||
<string name="failed_to_parse_chat_title">Failed to load chat</string>
|
||||
<string name="failed_to_get_chat_item_not_found_title">Message no longer available</string>
|
||||
<string name="failed_to_get_chat_item_not_found_description">The quoted message you are trying to access has been deleted.</string>
|
||||
<string name="failed_to_parse_chats_title">Failed to load chats</string>
|
||||
<string name="contact_developers">Please update the app and contact developers.</string>
|
||||
<string name="failed_to_create_user_title">Error creating profile!</string>
|
||||
|
||||
@@ -9,7 +9,6 @@ module Main where
|
||||
import Control.Concurrent.Async
|
||||
import Control.Concurrent.STM
|
||||
import Control.Monad
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Simplex.Chat.Bot
|
||||
import Simplex.Chat.Controller
|
||||
@@ -19,7 +18,6 @@ import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Terminal (terminalChatConfig)
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Util (tshow)
|
||||
import System.Directory (getAppUserDataDirectory)
|
||||
import Text.Read
|
||||
|
||||
@@ -36,7 +34,7 @@ welcomeGetOpts = do
|
||||
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
|
||||
pure opts
|
||||
|
||||
welcomeMessage :: Text
|
||||
welcomeMessage :: String
|
||||
welcomeMessage = "Hello! I am a simple squaring bot.\nIf you send me a number, I will calculate its square"
|
||||
|
||||
mySquaringBot :: User -> ChatController -> IO ()
|
||||
@@ -49,10 +47,10 @@ mySquaringBot _user cc = do
|
||||
contactConnected contact
|
||||
sendMessage cc contact welcomeMessage
|
||||
CRNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) : _} -> do
|
||||
let msg = ciContentToText mc
|
||||
number_ = readMaybe (T.unpack msg) :: Maybe Integer
|
||||
let msg = T.unpack $ ciContentToText mc
|
||||
number_ = readMaybe msg :: Maybe Integer
|
||||
sendMessage cc contact $ case number_ of
|
||||
Just n -> msg <> " * " <> msg <> " = " <> tshow (n * n)
|
||||
Just n -> msg <> " * " <> msg <> " = " <> show (n * n)
|
||||
_ -> "\"" <> msg <> "\" is not a number"
|
||||
_ -> pure ()
|
||||
where
|
||||
|
||||
@@ -21,7 +21,6 @@ import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Protocol (MsgContent (..))
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Util (tshow)
|
||||
import System.Directory (getAppUserDataDirectory)
|
||||
|
||||
welcomeGetOpts :: IO BroadcastBotOpts
|
||||
@@ -49,14 +48,14 @@ broadcastBot BroadcastBotOpts {publishers, welcomeMessage, prohibitedMessage} _u
|
||||
CRContactsList _ cts -> void . forkIO $ do
|
||||
let cts' = filter broadcastTo cts
|
||||
forM_ cts' $ \ct' -> sendComposedMessage cc ct' Nothing mc
|
||||
sendReply $ "Forwarded to " <> tshow (length cts') <> " contact(s)"
|
||||
sendReply $ "Forwarded to " <> show (length cts') <> " contact(s)"
|
||||
r -> putStrLn $ "Error getting contacts list: " <> show r
|
||||
else sendReply "!1 Message is not supported!"
|
||||
| otherwise -> do
|
||||
sendReply prohibitedMessage
|
||||
deleteMessage cc ct $ chatItemId' ci
|
||||
where
|
||||
sendReply = sendComposedMessage cc ct (Just $ chatItemId' ci) . MCText
|
||||
sendReply = sendComposedMessage cc ct (Just $ chatItemId' ci) . textMsgContent
|
||||
publisher = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
|
||||
allowContent = \case
|
||||
MCText _ -> True
|
||||
|
||||
@@ -7,7 +7,6 @@
|
||||
module Broadcast.Options where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Options.Applicative
|
||||
import Simplex.Chat.Bot.KnownContacts
|
||||
import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
|
||||
@@ -16,14 +15,14 @@ import Simplex.Chat.Options (ChatCmdLog (..), ChatOpts (..), CoreChatOpts, coreC
|
||||
data BroadcastBotOpts = BroadcastBotOpts
|
||||
{ coreOptions :: CoreChatOpts,
|
||||
publishers :: [KnownContact],
|
||||
welcomeMessage :: Text,
|
||||
prohibitedMessage :: Text
|
||||
welcomeMessage :: String,
|
||||
prohibitedMessage :: String
|
||||
}
|
||||
|
||||
defaultWelcomeMessage :: [KnownContact] -> Text
|
||||
defaultWelcomeMessage :: [KnownContact] -> String
|
||||
defaultWelcomeMessage ps = "Hello! I am a broadcast bot.\nI broadcast messages to all connected users from " <> knownContactNames ps <> "."
|
||||
|
||||
defaultProhibitedMessage :: [KnownContact] -> Text
|
||||
defaultProhibitedMessage :: [KnownContact] -> String
|
||||
defaultProhibitedMessage ps = "Sorry, only these users can broadcast messages: " <> knownContactNames ps <> ". Your message is deleted."
|
||||
|
||||
broadcastBotOpts :: FilePath -> FilePath -> Parser BroadcastBotOpts
|
||||
|
||||
@@ -89,11 +89,10 @@ crDirectoryEvent = \case
|
||||
CRChatErrors {chatErrors} -> Just $ DELogChatResponse $ "chat errors: " <> T.intercalate ", " (map tshow chatErrors)
|
||||
_ -> Nothing
|
||||
|
||||
data DirectoryRole = DRUser | DRAdmin | DRSuperUser
|
||||
data DirectoryRole = DRUser | DRSuperUser
|
||||
|
||||
data SDirectoryRole (r :: DirectoryRole) where
|
||||
SDRUser :: SDirectoryRole 'DRUser
|
||||
SDRAdmin :: SDirectoryRole 'DRAdmin
|
||||
SDRSuperUser :: SDirectoryRole 'DRSuperUser
|
||||
|
||||
deriving instance Show (SDirectoryRole r)
|
||||
@@ -108,14 +107,12 @@ data DirectoryCmdTag (r :: DirectoryRole) where
|
||||
DCListUserGroups_ :: DirectoryCmdTag 'DRUser
|
||||
DCDeleteGroup_ :: DirectoryCmdTag 'DRUser
|
||||
DCSetRole_ :: DirectoryCmdTag 'DRUser
|
||||
DCApproveGroup_ :: DirectoryCmdTag 'DRAdmin
|
||||
DCRejectGroup_ :: DirectoryCmdTag 'DRAdmin
|
||||
DCSuspendGroup_ :: DirectoryCmdTag 'DRAdmin
|
||||
DCResumeGroup_ :: DirectoryCmdTag 'DRAdmin
|
||||
DCListLastGroups_ :: DirectoryCmdTag 'DRAdmin
|
||||
DCListPendingGroups_ :: DirectoryCmdTag 'DRAdmin
|
||||
DCShowGroupLink_ :: DirectoryCmdTag 'DRAdmin
|
||||
DCSendToGroupOwner_ :: DirectoryCmdTag 'DRAdmin
|
||||
DCApproveGroup_ :: DirectoryCmdTag 'DRSuperUser
|
||||
DCRejectGroup_ :: DirectoryCmdTag 'DRSuperUser
|
||||
DCSuspendGroup_ :: DirectoryCmdTag 'DRSuperUser
|
||||
DCResumeGroup_ :: DirectoryCmdTag 'DRSuperUser
|
||||
DCListLastGroups_ :: DirectoryCmdTag 'DRSuperUser
|
||||
DCListPendingGroups_ :: DirectoryCmdTag 'DRSuperUser
|
||||
DCExecuteCommand_ :: DirectoryCmdTag 'DRSuperUser
|
||||
|
||||
deriving instance Show (DirectoryCmdTag r)
|
||||
@@ -133,14 +130,12 @@ data DirectoryCmd (r :: DirectoryRole) where
|
||||
DCListUserGroups :: DirectoryCmd 'DRUser
|
||||
DCDeleteGroup :: UserGroupRegId -> GroupName -> DirectoryCmd 'DRUser
|
||||
DCSetRole :: GroupId -> GroupName -> GroupMemberRole -> DirectoryCmd 'DRUser
|
||||
DCApproveGroup :: {groupId :: GroupId, displayName :: GroupName, groupApprovalId :: GroupApprovalId} -> DirectoryCmd 'DRAdmin
|
||||
DCRejectGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
|
||||
DCSuspendGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
|
||||
DCResumeGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
|
||||
DCListLastGroups :: Int -> DirectoryCmd 'DRAdmin
|
||||
DCListPendingGroups :: Int -> DirectoryCmd 'DRAdmin
|
||||
DCShowGroupLink :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
|
||||
DCSendToGroupOwner :: GroupId -> GroupName -> Text -> DirectoryCmd 'DRAdmin
|
||||
DCApproveGroup :: {groupId :: GroupId, displayName :: GroupName, groupApprovalId :: GroupApprovalId} -> DirectoryCmd 'DRSuperUser
|
||||
DCRejectGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
|
||||
DCSuspendGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
|
||||
DCResumeGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
|
||||
DCListLastGroups :: Int -> DirectoryCmd 'DRSuperUser
|
||||
DCListPendingGroups :: Int -> DirectoryCmd 'DRSuperUser
|
||||
DCExecuteCommand :: String -> DirectoryCmd 'DRSuperUser
|
||||
DCUnknownCommand :: DirectoryCmd 'DRUser
|
||||
DCCommandError :: DirectoryCmdTag r -> DirectoryCmd r
|
||||
@@ -173,20 +168,17 @@ directoryCmdP =
|
||||
"ls" -> u DCListUserGroups_
|
||||
"delete" -> u DCDeleteGroup_
|
||||
"role" -> u DCSetRole_
|
||||
"approve" -> au DCApproveGroup_
|
||||
"reject" -> au DCRejectGroup_
|
||||
"suspend" -> au DCSuspendGroup_
|
||||
"resume" -> au DCResumeGroup_
|
||||
"last" -> au DCListLastGroups_
|
||||
"pending" -> au DCListPendingGroups_
|
||||
"link" -> au DCShowGroupLink_
|
||||
"owner" -> au DCSendToGroupOwner_
|
||||
"approve" -> su DCApproveGroup_
|
||||
"reject" -> su DCRejectGroup_
|
||||
"suspend" -> su DCSuspendGroup_
|
||||
"resume" -> su DCResumeGroup_
|
||||
"last" -> su DCListLastGroups_
|
||||
"pending" -> su DCListPendingGroups_
|
||||
"exec" -> su DCExecuteCommand_
|
||||
"x" -> su DCExecuteCommand_
|
||||
_ -> fail "bad command tag"
|
||||
where
|
||||
u = pure . ADCT SDRUser
|
||||
au = pure . ADCT SDRAdmin
|
||||
su = pure . ADCT SDRSuperUser
|
||||
cmdP :: DirectoryCmdTag r -> Parser (DirectoryCmd r)
|
||||
cmdP = \case
|
||||
@@ -211,11 +203,6 @@ directoryCmdP =
|
||||
DCResumeGroup_ -> gc DCResumeGroup
|
||||
DCListLastGroups_ -> DCListLastGroups <$> (A.space *> A.decimal <|> pure 10)
|
||||
DCListPendingGroups_ -> DCListPendingGroups <$> (A.space *> A.decimal <|> pure 10)
|
||||
DCShowGroupLink_ -> gc DCShowGroupLink
|
||||
DCSendToGroupOwner_ -> do
|
||||
(groupId, displayName) <- gc (,)
|
||||
msg <- A.space *> A.takeText
|
||||
pure $ DCSendToGroupOwner groupId displayName msg
|
||||
DCExecuteCommand_ -> DCExecuteCommand . T.unpack <$> (A.space *> A.takeText)
|
||||
where
|
||||
gc f = f <$> (A.space *> A.decimal <* A.char ':') <*> displayNameP
|
||||
@@ -226,8 +213,8 @@ directoryCmdP =
|
||||
quoted c = A.char c *> takeNameTill (== c) <* A.char c
|
||||
refChar c = c > ' ' && c /= '#' && c /= '@'
|
||||
|
||||
viewName :: Text -> Text
|
||||
viewName n = if any (== ' ') (T.unpack n) then "'" <> n <> "'" else n
|
||||
viewName :: String -> String
|
||||
viewName n = if ' ' `elem` n then "'" <> n <> "'" else n
|
||||
|
||||
directoryCmdTag :: DirectoryCmd r -> Text
|
||||
directoryCmdTag = \case
|
||||
@@ -247,8 +234,6 @@ directoryCmdTag = \case
|
||||
DCResumeGroup {} -> "resume"
|
||||
DCListLastGroups _ -> "last"
|
||||
DCListPendingGroups _ -> "pending"
|
||||
DCShowGroupLink {} -> "link"
|
||||
DCSendToGroupOwner {} -> "owner"
|
||||
DCExecuteCommand _ -> "exec"
|
||||
DCUnknownCommand -> "unknown"
|
||||
DCCommandError _ -> "error"
|
||||
|
||||
@@ -11,7 +11,6 @@ module Directory.Options
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Options.Applicative
|
||||
import Simplex.Chat.Bot.KnownContacts
|
||||
import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
|
||||
@@ -19,10 +18,9 @@ import Simplex.Chat.Options (ChatOpts (..), ChatCmdLog (..), CoreChatOpts, coreC
|
||||
|
||||
data DirectoryOpts = DirectoryOpts
|
||||
{ coreOptions :: CoreChatOpts,
|
||||
adminUsers :: [KnownContact],
|
||||
superUsers :: [KnownContact],
|
||||
directoryLog :: Maybe FilePath,
|
||||
serviceName :: T.Text,
|
||||
serviceName :: String,
|
||||
searchResults :: Int,
|
||||
testing :: Bool
|
||||
}
|
||||
@@ -30,13 +28,6 @@ data DirectoryOpts = DirectoryOpts
|
||||
directoryOpts :: FilePath -> FilePath -> Parser DirectoryOpts
|
||||
directoryOpts appDir defaultDbFileName = do
|
||||
coreOptions <- coreChatOptsP appDir defaultDbFileName
|
||||
adminUsers <-
|
||||
option
|
||||
parseKnownContacts
|
||||
( long "admin-users"
|
||||
<> metavar "ADMIN_USERS"
|
||||
<> help "Comma-separated list of admin-users in the format CONTACT_ID:DISPLAY_NAME who will be allowed to manage the directory"
|
||||
)
|
||||
superUsers <-
|
||||
option
|
||||
parseKnownContacts
|
||||
@@ -61,10 +52,9 @@ directoryOpts appDir defaultDbFileName = do
|
||||
pure
|
||||
DirectoryOpts
|
||||
{ coreOptions,
|
||||
adminUsers,
|
||||
superUsers,
|
||||
directoryLog,
|
||||
serviceName = T.pack serviceName,
|
||||
serviceName,
|
||||
searchResults = 10,
|
||||
testing = False
|
||||
}
|
||||
|
||||
@@ -17,11 +17,13 @@ import Control.Concurrent.Async
|
||||
import Control.Concurrent.STM
|
||||
import Control.Logger.Simple
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Maybe (fromMaybe, maybeToList)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1)
|
||||
import Data.Time.Clock (diffUTCTime, getCurrentTime)
|
||||
import Data.Time.LocalTime (getCurrentTimeZone)
|
||||
import Directory.Events
|
||||
@@ -35,7 +37,6 @@ import Simplex.Chat.Core
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Protocol (MsgContent (..))
|
||||
import Simplex.Chat.Store.Shared (StoreError (..))
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Shared
|
||||
import Simplex.Chat.View (serializeChatResponse, simplexChatContact, viewContactName, viewGroupName)
|
||||
@@ -78,7 +79,7 @@ welcomeGetOpts = do
|
||||
pure opts
|
||||
|
||||
directoryService :: DirectoryStore -> DirectoryOpts -> User -> ChatController -> IO ()
|
||||
directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchResults, testing} user@User {userId} cc = do
|
||||
directoryService st DirectoryOpts {superUsers, serviceName, searchResults, testing} user@User {userId} cc = do
|
||||
initializeBotAddress' (not testing) cc
|
||||
env <- newServiceState
|
||||
race_ (forever $ void getLine) . forever $ do
|
||||
@@ -101,7 +102,6 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
logInfo $ "command received " <> directoryCmdTag cmd
|
||||
case sUser of
|
||||
SDRUser -> deUserCommand env ct ciId cmd
|
||||
SDRAdmin -> deAdminCommand ct ciId cmd
|
||||
SDRSuperUser -> deSuperUserCommand ct ciId cmd
|
||||
DELogChatResponse r -> logInfo r
|
||||
where
|
||||
@@ -118,9 +118,9 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
userGroupReference gr GroupInfo {groupProfile = GroupProfile {displayName}} = userGroupReference' gr displayName
|
||||
userGroupReference' GroupReg {userGroupRegId} displayName = groupReference' userGroupRegId displayName
|
||||
groupReference GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = groupReference' groupId displayName
|
||||
groupReference' groupId displayName = "ID " <> tshow groupId <> " (" <> displayName <> ")"
|
||||
groupReference' groupId displayName = "ID " <> show groupId <> " (" <> T.unpack displayName <> ")"
|
||||
groupAlreadyListed GroupInfo {groupProfile = GroupProfile {displayName, fullName}} =
|
||||
"The group " <> displayName <> " (" <> fullName <> ") is already listed in the directory, please choose another name."
|
||||
T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already listed in the directory, please choose another name."
|
||||
|
||||
getGroups :: Text -> IO (Maybe [(GroupInfo, GroupSummary)])
|
||||
getGroups = getGroups_ . Just
|
||||
@@ -151,7 +151,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
processInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = do
|
||||
void $ addGroupReg st ct g GRSProposed
|
||||
r <- sendChatCmd cc $ APIJoinGroup groupId
|
||||
sendMessage cc ct $ case r of
|
||||
sendMessage cc ct $ T.unpack $ case r of
|
||||
CRUserAcceptedGroupSent {} -> "Joining the group " <> displayName <> "…"
|
||||
_ -> "Error joining group " <> displayName <> ", please re-send the invitation!"
|
||||
|
||||
@@ -179,10 +179,10 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
where
|
||||
askConfirmation = do
|
||||
ugrId <- addGroupReg st ct g GRSPendingConfirmation
|
||||
sendMessage cc ct $ "The group " <> displayName <> " (" <> fullName <> ") is already submitted to the directory.\nTo confirm the registration, please send:"
|
||||
sendMessage cc ct $ "/confirm " <> tshow ugrId <> ":" <> viewName displayName
|
||||
sendMessage cc ct $ T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already submitted to the directory.\nTo confirm the registration, please send:"
|
||||
sendMessage cc ct $ "/confirm " <> show ugrId <> ":" <> viewName (T.unpack displayName)
|
||||
|
||||
badRolesMsg :: GroupRolesStatus -> Maybe Text
|
||||
badRolesMsg :: GroupRolesStatus -> Maybe String
|
||||
badRolesMsg = \case
|
||||
GRSOk -> Nothing
|
||||
GRSServiceNotAdmin -> Just "You must grant directory service *admin* role to register the group"
|
||||
@@ -218,7 +218,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
when (ctId `isOwner` gr) $ do
|
||||
setGroupRegOwner st gr owner
|
||||
let GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = g
|
||||
notifyOwner gr $ "Joined the group " <> displayName <> ", creating the link…"
|
||||
notifyOwner gr $ T.unpack $ "Joined the group " <> displayName <> ", creating the link…"
|
||||
sendChatCmd cc (APICreateGroupLink groupId GRMember) >>= \case
|
||||
CRGroupLinkCreated {connReqContact} -> do
|
||||
setGroupStatus st gr GRSPendingUpdate
|
||||
@@ -227,7 +227,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
"Created the public link to join the group via this directory service that is always online.\n\n\
|
||||
\Please add it to the group welcome message.\n\
|
||||
\For example, add:"
|
||||
notifyOwner gr $ "Link to join the group " <> displayName <> ": " <> strEncodeTxt (simplexChatContact connReqContact)
|
||||
notifyOwner gr $ "Link to join the group " <> T.unpack displayName <> ": " <> B.unpack (strEncode $ simplexChatContact connReqContact)
|
||||
CRChatCmdError _ (ChatError e) -> case e of
|
||||
CEGroupUserRole {} -> notifyOwner gr "Failed creating group link, as service is no longer an admin."
|
||||
CEGroupMemberUserRemoved -> notifyOwner gr "Failed creating group link, as service is removed from the group."
|
||||
@@ -256,7 +256,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
GPHasServiceLink -> when (ctId `isOwner` gr) $ groupLinkAdded gr
|
||||
GPServiceLinkError -> do
|
||||
when (ctId `isOwner` gr) $ notifyOwner gr $ "Error: " <> serviceName <> " has no group link for " <> userGroupRef <> ". Please report the error to the developers."
|
||||
logError $ "Error: no group link for " <> userGroupRef
|
||||
logError $ "Error: no group link for " <> T.pack userGroupRef
|
||||
GRSPendingApproval n -> processProfileChange gr $ n + 1
|
||||
GRSActive -> processProfileChange gr 1
|
||||
GRSSuspended -> processProfileChange gr 1
|
||||
@@ -277,7 +277,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
_ -> do
|
||||
let gaId = 1
|
||||
setGroupStatus st gr $ GRSPendingApproval gaId
|
||||
notifyOwner gr $ "Thank you! The group link for " <> userGroupReference gr toGroup <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 48 hours."
|
||||
notifyOwner gr $ "Thank you! The group link for " <> userGroupReference gr toGroup <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 24 hours."
|
||||
checkRolesSendToApprove gr gaId
|
||||
processProfileChange gr n' = do
|
||||
setGroupStatus st gr GRSPendingUpdate
|
||||
@@ -299,13 +299,13 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
notifyOwner gr $ "The group " <> userGroupRef <> " is updated!\nIt is hidden from the directory until approved."
|
||||
notifySuperUsers $ "The group " <> groupRef <> " is updated."
|
||||
checkRolesSendToApprove gr n'
|
||||
GPServiceLinkError -> logError $ "Error: no group link for " <> groupRef <> " pending approval."
|
||||
GPServiceLinkError -> logError $ "Error: no group link for " <> T.pack groupRef <> " pending approval."
|
||||
groupProfileUpdate = profileUpdate <$> sendChatCmd cc (APIGetGroupLink groupId)
|
||||
where
|
||||
profileUpdate = \case
|
||||
CRGroupLink {connReqContact} ->
|
||||
let groupLink1 = strEncodeTxt connReqContact
|
||||
groupLink2 = strEncodeTxt $ simplexChatContact connReqContact
|
||||
let groupLink1 = safeDecodeUtf8 $ strEncode connReqContact
|
||||
groupLink2 = safeDecodeUtf8 $ strEncode $ simplexChatContact connReqContact
|
||||
hadLinkBefore = groupLink1 `isInfix` description p || groupLink2 `isInfix` description p
|
||||
hasLinkNow = groupLink1 `isInfix` description p' || groupLink2 `isInfix` description p'
|
||||
in if
|
||||
@@ -331,7 +331,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
msg = maybe (MCText text) (\image -> MCImage {text, image}) image'
|
||||
withSuperUsers $ \cId -> do
|
||||
sendComposedMessage' cc cId Nothing msg
|
||||
sendMessage' cc cId $ "/approve " <> tshow dbGroupId <> ":" <> viewName displayName <> " " <> tshow gaId
|
||||
sendMessage' cc cId $ "/approve " <> show dbGroupId <> ":" <> viewName (T.unpack displayName) <> " " <> show gaId
|
||||
|
||||
deContactRoleChanged :: GroupInfo -> ContactId -> GroupMemberRole -> IO ()
|
||||
deContactRoleChanged g@GroupInfo {membership = GroupMember {memberRole = serviceRole}} ctId contactRole = do
|
||||
@@ -356,7 +356,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
where
|
||||
rStatus = groupRolesStatus contactRole serviceRole
|
||||
groupRef = groupReference g
|
||||
ctRole = "*" <> strEncodeTxt contactRole <> "*"
|
||||
ctRole = "*" <> B.unpack (strEncode contactRole) <> "*"
|
||||
suCtRole = "(user role is set to " <> ctRole <> ")."
|
||||
|
||||
deServiceRoleChanged :: GroupInfo -> GroupMemberRole -> IO ()
|
||||
@@ -382,7 +382,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
_ -> pure ()
|
||||
where
|
||||
groupRef = groupReference g
|
||||
srvRole = "*" <> strEncodeTxt serviceRole <> "*"
|
||||
srvRole = "*" <> B.unpack (strEncode serviceRole) <> "*"
|
||||
suSrvRole = "(" <> serviceName <> " role is changed to " <> srvRole <> ")."
|
||||
whenContactIsOwner gr action =
|
||||
getGroupMember gr
|
||||
@@ -426,7 +426,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
<> serviceName
|
||||
<> " bot will create a public group link for the new members to join even when you are offline.\n\
|
||||
\3. You will then need to add this link to the group welcome message.\n\
|
||||
\4. Once the link is added, service admins will approve the group (it can take up to 48 hours), and everybody will be able to find it in directory.\n\n\
|
||||
\4. Once the link is added, service admins will approve the group (it can take up to 24 hours), and everybody will be able to find it in directory.\n\n\
|
||||
\Start from inviting the bot to your group as admin - it will guide you through the process"
|
||||
DCSearchGroup s -> withFoundListedGroups (Just s) $ sendSearchResults s
|
||||
DCSearchNext ->
|
||||
@@ -448,47 +448,44 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
DCRecentGroups -> withFoundListedGroups Nothing $ sendAllGroups takeRecent "the most recent" STRecent
|
||||
DCSubmitGroup _link -> pure ()
|
||||
DCConfirmDuplicateGroup ugrId gName ->
|
||||
withUserGroupReg ugrId gName $ \g@GroupInfo {groupProfile = GroupProfile {displayName}} gr ->
|
||||
withUserGroupReg ugrId gName $ \gr g@GroupInfo {groupProfile = GroupProfile {displayName}} ->
|
||||
readTVarIO (groupRegStatus gr) >>= \case
|
||||
GRSPendingConfirmation ->
|
||||
getDuplicateGroup g >>= \case
|
||||
Nothing -> sendMessage cc ct "Error: getDuplicateGroup. Please notify the developers."
|
||||
Just DGReserved -> sendMessage cc ct $ groupAlreadyListed g
|
||||
_ -> processInvitation ct g
|
||||
_ -> sendReply $ "Error: the group ID " <> tshow ugrId <> " (" <> displayName <> ") is not pending confirmation."
|
||||
_ -> sendReply $ "Error: the group ID " <> show ugrId <> " (" <> T.unpack displayName <> ") is not pending confirmation."
|
||||
DCListUserGroups ->
|
||||
atomically (getUserGroupRegs st $ contactId' ct) >>= \grs -> do
|
||||
sendReply $ tshow (length grs) <> " registered group(s)"
|
||||
sendReply $ show (length grs) <> " registered group(s)"
|
||||
void . forkIO $ forM_ (reverse grs) $ \gr@GroupReg {userGroupRegId} ->
|
||||
sendGroupInfo ct gr userGroupRegId Nothing
|
||||
DCDeleteGroup ugrId gName ->
|
||||
withUserGroupReg ugrId gName $ \GroupInfo {groupProfile = GroupProfile {displayName}} gr -> do
|
||||
withUserGroupReg ugrId gName $ \gr GroupInfo {groupProfile = GroupProfile {displayName}} -> do
|
||||
delGroupReg st gr
|
||||
sendReply $ "Your group " <> displayName <> " is deleted from the directory"
|
||||
DCSetRole gId gName mRole ->
|
||||
(if isAdmin then withGroupAndReg sendReply else withUserGroupReg) gId gName $
|
||||
\GroupInfo {groupId, groupProfile = GroupProfile {displayName}} _gr -> do
|
||||
gLink_ <- setGroupLinkRole cc groupId mRole
|
||||
sendReply $ case gLink_ of
|
||||
Nothing -> "Error: the initial member role for the group " <> displayName <> " was NOT upgated"
|
||||
Just gLink ->
|
||||
("The initial member role for the group " <> displayName <> " is set to *" <> strEncodeTxt mRole <> "*\n\n")
|
||||
<> ("*Please note*: it applies only to members joining via this link: " <> strEncodeTxt (simplexChatContact gLink))
|
||||
sendReply $ T.unpack $ "Your group " <> displayName <> " is deleted from the directory"
|
||||
DCSetRole ugrId gName mRole ->
|
||||
withUserGroupReg ugrId gName $ \_gr GroupInfo {groupId, groupProfile = GroupProfile {displayName}} -> do
|
||||
gLink_ <- setGroupLinkRole cc groupId mRole
|
||||
sendReply $ T.unpack $ case gLink_ of
|
||||
Nothing -> "Error: the initial member role for the group " <> displayName <> " was NOT upgated"
|
||||
Just gLink ->
|
||||
("The initial member role for the group " <> displayName <> " is set to *" <> decodeLatin1 (strEncode mRole) <> "*\n\n")
|
||||
<> ("*Please note*: it applies only to members joining via this link: " <> safeDecodeUtf8 (strEncode $ simplexChatContact gLink))
|
||||
DCUnknownCommand -> sendReply "Unknown command"
|
||||
DCCommandError tag -> sendReply $ "Command error: " <> tshow tag
|
||||
DCCommandError tag -> sendReply $ "Command error: " <> show tag
|
||||
where
|
||||
knownCt = knownContact ct
|
||||
isAdmin = knownCt `elem` adminUsers || knownCt `elem` superUsers
|
||||
withUserGroupReg ugrId gName action =
|
||||
atomically (getUserGroupReg st (contactId' ct) ugrId) >>= \case
|
||||
Nothing -> sendReply $ "Group ID " <> tshow ugrId <> " not found"
|
||||
Nothing -> sendReply $ "Group ID " <> show ugrId <> " not found"
|
||||
Just gr@GroupReg {dbGroupId} -> do
|
||||
getGroup cc dbGroupId >>= \case
|
||||
Nothing -> sendReply $ "Group ID " <> tshow ugrId <> " not found"
|
||||
Nothing -> sendReply $ "Group ID " <> show ugrId <> " not found"
|
||||
Just g@GroupInfo {groupProfile = GroupProfile {displayName}}
|
||||
| displayName == gName -> action g gr
|
||||
| otherwise -> sendReply $ "Group ID " <> tshow ugrId <> " has the display name " <> displayName
|
||||
sendReply = mkSendReply ct ciId
|
||||
| displayName == gName -> action gr g
|
||||
| otherwise -> sendReply $ "Group ID " <> show ugrId <> " has the display name " <> T.unpack displayName
|
||||
sendReply = sendComposedMessage cc ct (Just ciId) . textMsgContent
|
||||
withFoundListedGroups s_ action =
|
||||
getGroups_ s_ >>= \case
|
||||
Just groups -> atomically (filterListedGroups st groups) >>= action
|
||||
@@ -498,8 +495,8 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
gs -> do
|
||||
let gs' = takeTop searchResults gs
|
||||
moreGroups = length gs - length gs'
|
||||
more = if moreGroups > 0 then ", sending top " <> tshow (length gs') else ""
|
||||
sendReply $ "Found " <> tshow (length gs) <> " group(s)" <> more <> "."
|
||||
more = if moreGroups > 0 then ", sending top " <> show (length gs') else ""
|
||||
sendReply $ "Found " <> show (length gs) <> " group(s)" <> more <> "."
|
||||
updateSearchRequest (STSearch s) $ groupIds gs'
|
||||
sendFoundGroups gs' moreGroups
|
||||
sendAllGroups takeFirst sortName searchType = \case
|
||||
@@ -507,8 +504,8 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
gs -> do
|
||||
let gs' = takeFirst searchResults gs
|
||||
moreGroups = length gs - length gs'
|
||||
more = if moreGroups > 0 then ", sending " <> sortName <> " " <> tshow (length gs') else ""
|
||||
sendReply $ tshow (length gs) <> " group(s) listed" <> more <> "."
|
||||
more = if moreGroups > 0 then ", sending " <> sortName <> " " <> show (length gs') else ""
|
||||
sendReply $ show (length gs) <> " group(s) listed" <> more <> "."
|
||||
updateSearchRequest searchType $ groupIds gs'
|
||||
sendFoundGroups gs' moreGroups
|
||||
sendNextSearchResults takeFirst SearchRequest {searchType, sentGroups} = \case
|
||||
@@ -519,7 +516,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
let gs' = takeFirst searchResults $ filterNotSent sentGroups gs
|
||||
sentGroups' = sentGroups <> groupIds gs'
|
||||
moreGroups = length gs - S.size sentGroups'
|
||||
sendReply $ "Sending " <> tshow (length gs') <> " more group(s)."
|
||||
sendReply $ "Sending " <> show (length gs') <> " more group(s)."
|
||||
updateSearchRequest searchType sentGroups'
|
||||
sendFoundGroups gs' moreGroups
|
||||
updateSearchRequest :: SearchType -> Set GroupId -> IO ()
|
||||
@@ -530,10 +527,9 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
sendFoundGroups gs moreGroups =
|
||||
void . forkIO $ do
|
||||
forM_ gs $
|
||||
\(GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) -> do
|
||||
\(GroupInfo {groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) -> do
|
||||
let membersStr = "_" <> tshow currentMembers <> " members_"
|
||||
showId = if isAdmin then tshow groupId <> ". " else ""
|
||||
text = showId <> groupInfoText p <> "\n" <> membersStr
|
||||
text = groupInfoText p <> "\n" <> membersStr
|
||||
msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
|
||||
sendComposedMessage cc ct Nothing msg
|
||||
when (moreGroups > 0) $
|
||||
@@ -541,134 +537,92 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe
|
||||
MCText $
|
||||
"Send */next* or just *.* for " <> tshow moreGroups <> " more result(s)."
|
||||
|
||||
deAdminCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRAdmin -> IO ()
|
||||
deAdminCommand ct ciId cmd
|
||||
| knownCt `elem` adminUsers || knownCt `elem` superUsers = case cmd of
|
||||
deSuperUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRSuperUser -> IO ()
|
||||
deSuperUserCommand ct ciId cmd
|
||||
| superUser `elem` superUsers = case cmd of
|
||||
DCApproveGroup {groupId, displayName = n, groupApprovalId} ->
|
||||
withGroupAndReg sendReply groupId n $ \g gr ->
|
||||
readTVarIO (groupRegStatus gr) >>= \case
|
||||
GRSPendingApproval gaId
|
||||
| gaId == groupApprovalId -> do
|
||||
getDuplicateGroup g >>= \case
|
||||
Nothing -> sendReply "Error: getDuplicateGroup. Please notify the developers."
|
||||
Just DGReserved -> sendReply $ "The group " <> groupRef <> " is already listed in the directory."
|
||||
_ -> do
|
||||
getGroupRolesStatus g gr >>= \case
|
||||
Just GRSOk -> do
|
||||
setGroupStatus st gr GRSActive
|
||||
let approved = "The group " <> userGroupReference' gr n <> " is approved"
|
||||
notifyOwner gr $ approved <> " and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
|
||||
sendReply "Group approved!"
|
||||
notifyOtherSuperUsers $ approved <> " by " <> viewName (localDisplayName' ct)
|
||||
Just GRSServiceNotAdmin -> replyNotApproved serviceNotAdmin
|
||||
Just GRSContactNotOwner -> replyNotApproved "user is not an owner."
|
||||
Just GRSBadRoles -> replyNotApproved $ "user is not an owner, " <> serviceNotAdmin
|
||||
Nothing -> sendReply "Error: getGroupRolesStatus. Please notify the developers."
|
||||
where
|
||||
replyNotApproved reason = sendReply $ "Group is not approved: " <> reason
|
||||
serviceNotAdmin = serviceName <> " is not an admin."
|
||||
| otherwise -> sendReply "Incorrect approval code"
|
||||
_ -> sendReply $ "Error: the group " <> groupRef <> " is not pending approval."
|
||||
getGroupAndReg groupId n >>= \case
|
||||
Nothing -> sendReply $ "The group " <> groupRef <> " not found (getGroupAndReg)."
|
||||
Just (g, gr) ->
|
||||
readTVarIO (groupRegStatus gr) >>= \case
|
||||
GRSPendingApproval gaId
|
||||
| gaId == groupApprovalId -> do
|
||||
getDuplicateGroup g >>= \case
|
||||
Nothing -> sendReply "Error: getDuplicateGroup. Please notify the developers."
|
||||
Just DGReserved -> sendReply $ "The group " <> groupRef <> " is already listed in the directory."
|
||||
_ -> do
|
||||
getGroupRolesStatus g gr >>= \case
|
||||
Just GRSOk -> do
|
||||
setGroupStatus st gr GRSActive
|
||||
sendReply "Group approved!"
|
||||
notifyOwner gr $ "The group " <> userGroupReference' gr n <> " is approved and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
|
||||
Just GRSServiceNotAdmin -> replyNotApproved serviceNotAdmin
|
||||
Just GRSContactNotOwner -> replyNotApproved "user is not an owner."
|
||||
Just GRSBadRoles -> replyNotApproved $ "user is not an owner, " <> serviceNotAdmin
|
||||
Nothing -> sendReply "Error: getGroupRolesStatus. Please notify the developers."
|
||||
where
|
||||
replyNotApproved reason = sendReply $ "Group is not approved: " <> reason
|
||||
serviceNotAdmin = serviceName <> " is not an admin."
|
||||
| otherwise -> sendReply "Incorrect approval code"
|
||||
_ -> sendReply $ "Error: the group " <> groupRef <> " is not pending approval."
|
||||
where
|
||||
groupRef = groupReference' groupId n
|
||||
DCRejectGroup _gaId _gName -> pure ()
|
||||
DCSuspendGroup groupId gName -> do
|
||||
let groupRef = groupReference' groupId gName
|
||||
withGroupAndReg sendReply groupId gName $ \_ gr ->
|
||||
readTVarIO (groupRegStatus gr) >>= \case
|
||||
GRSActive -> do
|
||||
setGroupStatus st gr GRSSuspended
|
||||
let suspended = "The group " <> userGroupReference' gr gName <> " is suspended"
|
||||
notifyOwner gr $ suspended <> " and hidden from directory. Please contact the administrators."
|
||||
sendReply "Group suspended!"
|
||||
notifyOtherSuperUsers $ suspended <> " by " <> viewName (localDisplayName' ct)
|
||||
_ -> sendReply $ "The group " <> groupRef <> " is not active, can't be suspended."
|
||||
getGroupAndReg groupId gName >>= \case
|
||||
Nothing -> sendReply $ "The group " <> groupRef <> " not found (getGroupAndReg)."
|
||||
Just (_, gr) ->
|
||||
readTVarIO (groupRegStatus gr) >>= \case
|
||||
GRSActive -> do
|
||||
setGroupStatus st gr GRSSuspended
|
||||
notifyOwner gr $ "The group " <> userGroupReference' gr gName <> " is suspended and hidden from directory. Please contact the administrators."
|
||||
sendReply "Group suspended!"
|
||||
_ -> sendReply $ "The group " <> groupRef <> " is not active, can't be suspended."
|
||||
DCResumeGroup groupId gName -> do
|
||||
let groupRef = groupReference' groupId gName
|
||||
withGroupAndReg sendReply groupId gName $ \_ gr ->
|
||||
readTVarIO (groupRegStatus gr) >>= \case
|
||||
GRSSuspended -> do
|
||||
setGroupStatus st gr GRSActive
|
||||
let groupStr = "The group " <> userGroupReference' gr gName
|
||||
notifyOwner gr $ groupStr <> " is listed in the directory again!"
|
||||
sendReply "Group listing resumed!"
|
||||
notifyOtherSuperUsers $ groupStr <> " listing resumed by " <> viewName (localDisplayName' ct)
|
||||
_ -> sendReply $ "The group " <> groupRef <> " is not suspended, can't be resumed."
|
||||
getGroupAndReg groupId gName >>= \case
|
||||
Nothing -> sendReply $ "The group " <> groupRef <> " not found (getGroupAndReg)."
|
||||
Just (_, gr) ->
|
||||
readTVarIO (groupRegStatus gr) >>= \case
|
||||
GRSSuspended -> do
|
||||
setGroupStatus st gr GRSActive
|
||||
notifyOwner gr $ "The group " <> userGroupReference' gr gName <> " is listed in the directory again!"
|
||||
sendReply "Group listing resumed!"
|
||||
_ -> sendReply $ "The group " <> groupRef <> " is not suspended, can't be resumed."
|
||||
DCListLastGroups count -> listGroups count False
|
||||
DCListPendingGroups count -> listGroups count True
|
||||
DCShowGroupLink groupId gName -> do
|
||||
let groupRef = groupReference' groupId gName
|
||||
withGroupAndReg sendReply groupId gName $ \_ _ ->
|
||||
sendChatCmd cc (APIGetGroupLink groupId) >>= \case
|
||||
CRGroupLink {connReqContact, memberRole} ->
|
||||
sendReply $ T.unlines
|
||||
[ "The link to join the group " <> groupRef <> ":",
|
||||
strEncodeTxt $ simplexChatContact connReqContact,
|
||||
"New member role: " <> strEncodeTxt memberRole
|
||||
]
|
||||
CRChatCmdError _ (ChatErrorStore (SEGroupLinkNotFound _)) ->
|
||||
sendReply $ "The group " <> groupRef <> " has no public link."
|
||||
r -> do
|
||||
ts <- getCurrentTime
|
||||
tz <- getCurrentTimeZone
|
||||
let resp = T.pack $ serializeChatResponse (Nothing, Just user) ts tz Nothing r
|
||||
sendReply $ "Unexpected error:\n" <> resp
|
||||
DCSendToGroupOwner groupId gName msg -> do
|
||||
let groupRef = groupReference' groupId gName
|
||||
withGroupAndReg sendReply groupId gName $ \_ gr@GroupReg {dbContactId} -> do
|
||||
notifyOwner gr msg
|
||||
owner_ <- getContact cc dbContactId
|
||||
let ownerInfo = "the owner of the group " <> groupRef
|
||||
ownerName ct' = "@" <> viewName (localDisplayName' ct') <> ", "
|
||||
sendReply $ "Forwarded to " <> maybe "" ownerName owner_ <> ownerInfo
|
||||
DCCommandError tag -> sendReply $ "Command error: " <> tshow tag
|
||||
DCExecuteCommand cmdStr ->
|
||||
sendChatCmdStr cc cmdStr >>= \r -> do
|
||||
ts <- getCurrentTime
|
||||
tz <- getCurrentTimeZone
|
||||
sendReply $ serializeChatResponse (Nothing, Just user) ts tz Nothing r
|
||||
DCCommandError tag -> sendReply $ "Command error: " <> show tag
|
||||
| otherwise = sendReply "You are not allowed to use this command"
|
||||
where
|
||||
knownCt = knownContact ct
|
||||
sendReply = mkSendReply ct ciId
|
||||
notifyOtherSuperUsers s = withSuperUsers $ \ctId -> unless (ctId == contactId' ct) $ sendMessage' cc ctId s
|
||||
superUser = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
|
||||
sendReply = sendComposedMessage cc ct (Just ciId) . textMsgContent
|
||||
listGroups count pending =
|
||||
readTVarIO (groupRegs st) >>= \groups -> do
|
||||
grs <-
|
||||
if pending
|
||||
if pending
|
||||
then filterM (fmap pendingApproval . readTVarIO . groupRegStatus) groups
|
||||
else pure groups
|
||||
sendReply $ tshow (length grs) <> " registered group(s)" <> (if length grs > count then ", showing the last " <> tshow count else "")
|
||||
sendReply $ show (length grs) <> " registered group(s)" <> (if length grs > count then ", showing the last " <> show count else "")
|
||||
void . forkIO $ forM_ (reverse $ take count grs) $ \gr@GroupReg {dbGroupId, dbContactId} -> do
|
||||
ct_ <- getContact cc dbContactId
|
||||
let ownerStr = "Owner: " <> maybe "getContact error" localDisplayName' ct_
|
||||
sendGroupInfo ct gr dbGroupId $ Just ownerStr
|
||||
|
||||
deSuperUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRSuperUser -> IO ()
|
||||
deSuperUserCommand ct ciId cmd
|
||||
| knownContact ct `elem` superUsers = case cmd of
|
||||
DCExecuteCommand cmdStr ->
|
||||
sendChatCmdStr cc cmdStr >>= \r -> do
|
||||
ts <- getCurrentTime
|
||||
tz <- getCurrentTimeZone
|
||||
sendReply $ T.pack $ serializeChatResponse (Nothing, Just user) ts tz Nothing r
|
||||
DCCommandError tag -> sendReply $ "Command error: " <> tshow tag
|
||||
| otherwise = sendReply "You are not allowed to use this command"
|
||||
where
|
||||
sendReply = mkSendReply ct ciId
|
||||
|
||||
knownContact :: Contact -> KnownContact
|
||||
knownContact ct = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
|
||||
|
||||
mkSendReply :: Contact -> ChatItemId -> Text -> IO ()
|
||||
mkSendReply ct ciId = sendComposedMessage cc ct (Just ciId) . MCText
|
||||
|
||||
withGroupAndReg :: (Text -> IO ()) -> GroupId -> GroupName -> (GroupInfo -> GroupReg -> IO ()) -> IO ()
|
||||
withGroupAndReg sendReply gId gName action =
|
||||
getGroup cc gId >>= \case
|
||||
Nothing -> sendReply $ "Group ID " <> tshow gId <> " not found (getGroup)"
|
||||
Just g@GroupInfo {groupProfile = GroupProfile {displayName}}
|
||||
| displayName == gName ->
|
||||
atomically (getGroupReg st gId) >>= \case
|
||||
Nothing -> sendReply $ "Registration for group ID " <> tshow gId <> " not found (getGroupReg)"
|
||||
Just gr -> action g gr
|
||||
| otherwise ->
|
||||
sendReply $ "Group ID " <> tshow gId <> " has the display name " <> displayName
|
||||
getGroupAndReg :: GroupId -> GroupName -> IO (Maybe (GroupInfo, GroupReg))
|
||||
getGroupAndReg gId gName =
|
||||
getGroup cc gId
|
||||
$>>= \g@GroupInfo {groupProfile = GroupProfile {displayName}} ->
|
||||
if displayName == gName
|
||||
then
|
||||
atomically (getGroupReg st gId)
|
||||
$>>= \gr -> pure $ Just (g, gr)
|
||||
else pure Nothing
|
||||
|
||||
sendGroupInfo :: Contact -> GroupReg -> GroupId -> Maybe Text -> IO ()
|
||||
sendGroupInfo ct gr@GroupReg {dbGroupId} useGroupId ownerStr_ = do
|
||||
@@ -689,7 +643,7 @@ getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId)
|
||||
where
|
||||
resp :: ChatResponse -> Maybe Contact
|
||||
resp = \case
|
||||
CRApiChat _ (AChat SCTDirect Chat {chatInfo = DirectChat ct}) -> Just ct
|
||||
CRApiChat _ (AChat SCTDirect Chat {chatInfo = DirectChat ct}) _ -> Just ct
|
||||
_ -> Nothing
|
||||
|
||||
getGroup :: ChatController -> GroupId -> IO (Maybe GroupInfo)
|
||||
@@ -714,8 +668,5 @@ setGroupLinkRole cc gId mRole = resp <$> sendChatCmd cc (APIGroupLinkMemberRole
|
||||
CRGroupLink _ _ gLink _ -> Just gLink
|
||||
_ -> Nothing
|
||||
|
||||
unexpectedError :: Text -> Text
|
||||
unexpectedError :: String -> String
|
||||
unexpectedError err = "Unexpected error: " <> err <> ", please notify the developers."
|
||||
|
||||
strEncodeTxt :: StrEncoding a => a -> Text
|
||||
strEncodeTxt = safeDecodeUtf8 . strEncode
|
||||
|
||||
+1
-1
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: 93f30c8edf9243ad2291dd6427d87328e282560a
|
||||
tag: a8471eed5be93e7c3741aa4742b24193c9a2d6f5
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
||||
+17
-15
@@ -8,23 +8,25 @@ layout: layouts/jobs.html
|
||||
|
||||
SimpleX Chat Ltd is a seed stage startup with a lot of user growth in 2022-2023, and a lot of exciting technical and product problems to solve to grow faster.
|
||||
|
||||
We currently have 6 full-time people in the team.
|
||||
We currently have 4 full-time people in the team - all engineers, including the founder.
|
||||
|
||||
We want to add up to 3 people to the team.
|
||||
|
||||
We want to add 2 people to the team.
|
||||
|
||||
## Who we are looking for
|
||||
|
||||
### Web designer & developer for a website contract
|
||||
### Product/UI designer
|
||||
|
||||
You will work with the founder and a product marketing expert to convert the stories we want to tell our current and prospective users into interactive experiences.
|
||||
You will be designing the user experience and the interface of both the app and the website in collaboration with the team.
|
||||
|
||||
You are an expert in creating interactive web experiences:
|
||||
- 15+ years of web development and design experience.
|
||||
- Passionate about communications, privacy and data ownership.
|
||||
- Competent using PhotoShop, 3D modelling, etc.
|
||||
- Competent in Web tech, including JavaScript, animations, etc.
|
||||
The current focus of the app is privacy and security, but we hope to have the design that would support the feeling of psychological safety, enabling people to achieve the results in the smallest amount of time.
|
||||
|
||||
We will NOT consider agencies or groups – it must be one person working on the project.
|
||||
You are an experienced and innovative product designer with:
|
||||
- 8+ years of user experience and visual design.
|
||||
- Expertise in typography and high sensitivity to colors.
|
||||
- Exceptional precision and attention to details.
|
||||
- Strong opinions (weakly held).
|
||||
- A strong empathy.
|
||||
|
||||
### Application Haskell engineer
|
||||
|
||||
@@ -32,12 +34,13 @@ You will work with the Haskell core of the client applications and with the netw
|
||||
|
||||
You are an expert in language models, databases and Haskell:
|
||||
- expert knowledge of SQL.
|
||||
- Haskell strictness, exceptions, [concurrency](https://simonmar.github.io/pages/pcph.html), STM, [type systems](https://thinkingwithtypes.com).
|
||||
- 15y+ of software engineering experience in complex projects.
|
||||
- Haskell exception handling, concurrency, STM, type systems.
|
||||
- 8y+ of software engineering experience in complex projects,
|
||||
- deep understanding of the common programming principles:
|
||||
- data structures, bits and bytes, text encoding.
|
||||
- [functional software design](https://mitp-content-server.mit.edu/books/content/sectbyfn/books_pres_0/6515/sicp.zip/index.html) and algorithms.
|
||||
- protocols and networking.
|
||||
- software design and algorithms.
|
||||
- concurrency.
|
||||
- networking.
|
||||
|
||||
## About you
|
||||
|
||||
@@ -45,7 +48,6 @@ You are an expert in language models, databases and Haskell:
|
||||
- already use SimpleX Chat to communicate with friends/family or participate in public SimpleX Chat groups.
|
||||
- passionate about privacy, security and communications.
|
||||
- interested to make contributions to SimpleX Chat open-source project in your free time before we hire you, as an extended test.
|
||||
- you founded (and probably failed) at least one startup, or spent more time working for yourself than being employed.
|
||||
|
||||
- **Exceptionally pragmatic, very fast and customer-focussed**:
|
||||
- care about the customers (aka users) and about the product we build much more than about the code quality, technology stack, etc.
|
||||
|
||||
@@ -1,24 +0,0 @@
|
||||
# Server operators
|
||||
|
||||
## Problem
|
||||
|
||||
All preconfigured servers operated by a single company create a risk that user connections can be analysed by aggregating transport information from these servers.
|
||||
|
||||
The solution is to have more than one operator servers pre-configured in the app.
|
||||
|
||||
For operators to be protected from any violations of rights of other users or third parties by the users who use servers of these operators, the users have to explicitely accept conditions of use with the operator, in the same way they accept conditions of use with SimpleX Chat Ltd by downloading the app.
|
||||
|
||||
## Solution
|
||||
|
||||
Allow to assign operators to servers, both with preconfigured operators and servers, and with user-defined operators. Agent added support for server roles, chat app could:
|
||||
- allow assigning server roles only on the operator level.
|
||||
- only on server level.
|
||||
- on both, with server roles overriding operator roles (that would require a different type for server for chat app).
|
||||
|
||||
For simplicity of both UX and logic it is probably better to allow assigning roles only on operators' level, and servers without set operators can be used for both roles.
|
||||
|
||||
For agreements, it is sufficient to record the signatures of these agreements on users' devices, together with the copy of signed agreement (or its hash and version) in a separate table. The terms themselves could be:
|
||||
- included in the app - either in code or in migration.
|
||||
- referenced with a stable link to a particular commit.
|
||||
|
||||
The first solution seems better, as it avoids any third party dependency, and the agreement size is relatively small (~31kb), to reduce size we can store it compressed.
|
||||
Generated
+29
-82
@@ -156,11 +156,11 @@
|
||||
"ghc98X": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1715066704,
|
||||
"narHash": "sha256-F0EVR8x/fcpj1st+hz96Wdsz5uwVIOziGKAwRxLOYJw=",
|
||||
"lastModified": 1696643148,
|
||||
"narHash": "sha256-E02DfgISH7EvvNAu0BHiPvl1E5FGMDi0pWdNZtIBC9I=",
|
||||
"ref": "ghc-9.8",
|
||||
"rev": "78a253543d466ac511a1664a3e6aff032ca684d5",
|
||||
"revCount": 61757,
|
||||
"rev": "443e870d977b1ab6fc05f47a9a17bc49296adbd6",
|
||||
"revCount": 61642,
|
||||
"submodules": true,
|
||||
"type": "git",
|
||||
"url": "https://gitlab.haskell.org/ghc/ghc"
|
||||
@@ -175,11 +175,11 @@
|
||||
"ghc99": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1726585445,
|
||||
"narHash": "sha256-IdwQBex4boY6s0Plj5+ixf36rfYSUyMdTWrztKvZH30=",
|
||||
"lastModified": 1697054644,
|
||||
"narHash": "sha256-kKarOuXUaAH3QWv7ASx+gGFMHaHKe0pK5Zu37ky2AL4=",
|
||||
"ref": "refs/heads/master",
|
||||
"rev": "7fd9e5e29ab54eb406880077463e8552e2ddd39a",
|
||||
"revCount": 67238,
|
||||
"rev": "f383a242c76f90bcca8a4d7ee001dcb49c172a9a",
|
||||
"revCount": 62040,
|
||||
"submodules": true,
|
||||
"type": "git",
|
||||
"url": "https://gitlab.haskell.org/ghc/ghc"
|
||||
@@ -225,8 +225,6 @@
|
||||
"hls-2.2": "hls-2.2",
|
||||
"hls-2.3": "hls-2.3",
|
||||
"hls-2.4": "hls-2.4",
|
||||
"hls-2.5": "hls-2.5",
|
||||
"hls-2.6": "hls-2.6",
|
||||
"hpc-coveralls": "hpc-coveralls",
|
||||
"hydra": "hydra",
|
||||
"iserv-proxy": "iserv-proxy",
|
||||
@@ -240,17 +238,16 @@
|
||||
"nixpkgs-2205": "nixpkgs-2205",
|
||||
"nixpkgs-2211": "nixpkgs-2211",
|
||||
"nixpkgs-2305": "nixpkgs-2305",
|
||||
"nixpkgs-2311": "nixpkgs-2311",
|
||||
"nixpkgs-unstable": "nixpkgs-unstable",
|
||||
"old-ghc-nix": "old-ghc-nix",
|
||||
"stackage": "stackage"
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1705833500,
|
||||
"narHash": "sha256-rUIr6JNbCedt1g4gVYVvE9t0oFU6FUspCA0DS5cA8Bg=",
|
||||
"lastModified": 1701163700,
|
||||
"narHash": "sha256-sOrewUS3LnzV09nGr7+3R6Q6zsgU4smJc61QsHq+4DE=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "haskell.nix",
|
||||
"rev": "d0c35e75cbbc6858770af42ac32b0b85495fbd71",
|
||||
"rev": "2808bfe3e62e9eb4ee8974cd623a00e1611f302b",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
@@ -331,50 +328,16 @@
|
||||
"hls-2.4": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1699862708,
|
||||
"narHash": "sha256-YHXSkdz53zd0fYGIYOgLt6HrA0eaRJi9mXVqDgmvrjk=",
|
||||
"lastModified": 1696939266,
|
||||
"narHash": "sha256-VOMf5+kyOeOmfXTHlv4LNFJuDGa7G3pDnOxtzYR40IU=",
|
||||
"owner": "haskell",
|
||||
"repo": "haskell-language-server",
|
||||
"rev": "54507ef7e85fa8e9d0eb9a669832a3287ffccd57",
|
||||
"rev": "362fdd1293efb4b82410b676ab1273479f6d17ee",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "haskell",
|
||||
"ref": "2.4.0.1",
|
||||
"repo": "haskell-language-server",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"hls-2.5": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1701080174,
|
||||
"narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=",
|
||||
"owner": "haskell",
|
||||
"repo": "haskell-language-server",
|
||||
"rev": "27f8c3d3892e38edaef5bea3870161815c4d014c",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "haskell",
|
||||
"ref": "2.5.0.0",
|
||||
"repo": "haskell-language-server",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"hls-2.6": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1705325287,
|
||||
"narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=",
|
||||
"owner": "haskell",
|
||||
"repo": "haskell-language-server",
|
||||
"rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "haskell",
|
||||
"ref": "2.6.0.0",
|
||||
"ref": "2.4.0.0",
|
||||
"repo": "haskell-language-server",
|
||||
"type": "github"
|
||||
}
|
||||
@@ -421,11 +384,11 @@
|
||||
"iserv-proxy": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1707968597,
|
||||
"narHash": "sha256-C53NqToxl+n9s1pQ0iLtiH6P5vX3rM+NW/mFt4Ykpsk=",
|
||||
"lastModified": 1691634696,
|
||||
"narHash": "sha256-MZH2NznKC/gbgBu8NgIibtSUZeJ00HTLJ0PlWKCBHb0=",
|
||||
"ref": "hkm/remote-iserv",
|
||||
"rev": "1b7f8aeb37bbc7c00f04e44d9379aa15a4409e8b",
|
||||
"revCount": 18,
|
||||
"rev": "43a979272d9addc29fbffc2e8542c5d96e993d73",
|
||||
"revCount": 14,
|
||||
"type": "git",
|
||||
"url": "https://gitlab.haskell.org/hamishmack/iserv-proxy.git"
|
||||
},
|
||||
@@ -589,11 +552,11 @@
|
||||
},
|
||||
"nixpkgs-2305": {
|
||||
"locked": {
|
||||
"lastModified": 1705033721,
|
||||
"narHash": "sha256-K5eJHmL1/kev6WuqyqqbS1cdNnSidIZ3jeqJ7GbrYnQ=",
|
||||
"lastModified": 1695416179,
|
||||
"narHash": "sha256-610o1+pwbSu+QuF3GE0NU5xQdTHM3t9wyYhB9l94Cd8=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "a1982c92d8980a0114372973cbdfe0a307f1bdea",
|
||||
"rev": "715d72e967ec1dd5ecc71290ee072bcaf5181ed6",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
@@ -603,22 +566,6 @@
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs-2311": {
|
||||
"locked": {
|
||||
"lastModified": 1719957072,
|
||||
"narHash": "sha256-gvFhEf5nszouwLAkT9nWsDzocUTqLWHuL++dvNjMp9I=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "7144d6241f02d171d25fba3edeaf15e0f2592105",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "NixOS",
|
||||
"ref": "nixpkgs-23.11-darwin",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs-lib": {
|
||||
"locked": {
|
||||
"dir": "lib",
|
||||
@@ -655,17 +602,17 @@
|
||||
},
|
||||
"nixpkgs-unstable": {
|
||||
"locked": {
|
||||
"lastModified": 1694822471,
|
||||
"narHash": "sha256-6fSDCj++lZVMZlyqOe9SIOL8tYSBz1bI8acwovRwoX8=",
|
||||
"lastModified": 1695318763,
|
||||
"narHash": "sha256-FHVPDRP2AfvsxAdc+AsgFJevMz5VBmnZglFUMlxBkcY=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "47585496bcb13fb72e4a90daeea2f434e2501998",
|
||||
"rev": "e12483116b3b51a185a33a272bf351e357ba9a99",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "NixOS",
|
||||
"ref": "nixpkgs-unstable",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "47585496bcb13fb72e4a90daeea2f434e2501998",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
@@ -717,11 +664,11 @@
|
||||
"stackage": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1726532152,
|
||||
"narHash": "sha256-LRXbVY3M2S8uQWdwd2zZrsnVPEvt2GxaHGoy8EFFdJA=",
|
||||
"lastModified": 1699834215,
|
||||
"narHash": "sha256-g/JKy0BCvJaxPuYDl3QVc4OY8cFEomgG+hW/eEV470M=",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "stackage.nix",
|
||||
"rev": "c77b3530cebad603812cb111c6f64968c2d2337d",
|
||||
"rev": "47aacd04abcce6bad57f43cbbbd133538380248e",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
||||
@@ -198,7 +198,6 @@
|
||||
packages.direct-sqlcipher.components.library.libs = pkgs.lib.mkForce [
|
||||
pkgs.pkgsCross.mingwW64.openssl
|
||||
];
|
||||
packages.simplexmq.flags.client_library = true;
|
||||
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
|
||||
pkgs.pkgsCross.mingwW64.openssl
|
||||
];
|
||||
@@ -336,7 +335,6 @@
|
||||
packages.direct-sqlcipher.patches = [
|
||||
./scripts/nix/direct-sqlcipher-android-log.patch
|
||||
];
|
||||
packages.simplexmq.flags.client_library = true;
|
||||
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
|
||||
(android32Pkgs.openssl.override { static = true; enableKTLS = false; })
|
||||
];
|
||||
@@ -445,7 +443,6 @@
|
||||
packages.direct-sqlcipher.patches = [
|
||||
./scripts/nix/direct-sqlcipher-android-log.patch
|
||||
];
|
||||
packages.simplexmq.flags.client_library = true;
|
||||
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
|
||||
(androidPkgs.openssl.override { static = true; })
|
||||
];
|
||||
@@ -550,7 +547,6 @@
|
||||
packages.simplexmq.flags.swift = true;
|
||||
packages.direct-sqlcipher.flags.commoncrypto = true;
|
||||
packages.entropy.flags.DoNotGetEntropy = true;
|
||||
packages.simplexmq.flags.client_library = true;
|
||||
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
|
||||
# TODO: have a cross override for iOS, that sets this.
|
||||
((pkgs.openssl.override { static = true; }).overrideDerivation (old: { CFLAGS = "-mcpu=apple-a7 -march=armv8-a+norcpc" ;}))
|
||||
@@ -565,7 +561,6 @@
|
||||
extra-modules = [{
|
||||
packages.direct-sqlcipher.flags.commoncrypto = true;
|
||||
packages.entropy.flags.DoNotGetEntropy = true;
|
||||
packages.simplexmq.flags.client_library = true;
|
||||
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
|
||||
((pkgs.openssl.override { static = true; }).overrideDerivation (old: { CFLAGS = "-mcpu=apple-a7 -march=armv8-a+norcpc" ;}))
|
||||
];
|
||||
@@ -583,7 +578,6 @@
|
||||
packages.simplexmq.flags.swift = true;
|
||||
packages.direct-sqlcipher.flags.commoncrypto = true;
|
||||
packages.entropy.flags.DoNotGetEntropy = true;
|
||||
packages.simplexmq.flags.client_library = true;
|
||||
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
|
||||
(pkgs.openssl.override { static = true; })
|
||||
];
|
||||
@@ -597,7 +591,6 @@
|
||||
extra-modules = [{
|
||||
packages.direct-sqlcipher.flags.commoncrypto = true;
|
||||
packages.entropy.flags.DoNotGetEntropy = true;
|
||||
packages.simplexmq.flags.client_library = true;
|
||||
packages.simplexmq.components.library.libs = pkgs.lib.mkForce [
|
||||
(pkgs.openssl.override { static = true; })
|
||||
];
|
||||
|
||||
@@ -29,7 +29,6 @@ dependencies:
|
||||
- email-validate == 2.3.*
|
||||
- exceptions == 0.10.*
|
||||
- filepath == 1.4.*
|
||||
- file-embed == 0.0.15.*
|
||||
- http-types == 0.12.*
|
||||
- http2 >= 4.2.2 && < 4.3
|
||||
- memory == 0.18.*
|
||||
@@ -39,7 +38,6 @@ dependencies:
|
||||
- optparse-applicative >= 0.15 && < 0.17
|
||||
- random >= 1.1 && < 1.3
|
||||
- record-hasfield == 1.0.*
|
||||
- scientific ==0.3.7.*
|
||||
- simple-logger == 0.1.*
|
||||
- simplexmq >= 5.0
|
||||
- socks == 0.6.*
|
||||
|
||||
@@ -25,7 +25,7 @@ for elem in "${exports[@]}"; do count=$(grep -R "$elem$" libsimplex.dll.def | wc
|
||||
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'
|
||||
cabal build lib:simplex-chat --ghc-options='-optl-Wl,-rpath,$ORIGIN -flink-rts -threaded'
|
||||
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
|
||||
|
||||
@@ -24,7 +24,7 @@ for elem in "${exports[@]}"; do count=$(grep -R "$elem$" libsimplex.dll.def | wc
|
||||
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 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'
|
||||
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"
|
||||
|
||||
cd $BUILD_DIR/build
|
||||
mkdir deps 2> /dev/null || true
|
||||
|
||||
@@ -51,7 +51,7 @@ echo " ghc-options: -shared -threaded -optl-L$openssl_windows_style_path -opt
|
||||
# Very important! Without it the build fails on linking step since the linker can't find exported symbols.
|
||||
# It looks like GHC bug because with such random path the build ends successfully
|
||||
sed -i "s/ld.lld.exe/abracadabra.exe/" `ghc --print-libdir`/settings
|
||||
cabal build lib:simplex-chat --constraint 'simplexmq +client_library'
|
||||
cabal build lib:simplex-chat
|
||||
|
||||
rm -rf apps/multiplatform/common/src/commonMain/cpp/desktop/libs/$OS-$ARCH/
|
||||
rm -rf apps/multiplatform/desktop/build/cmake
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
{
|
||||
"https://github.com/simplex-chat/simplexmq.git"."93f30c8edf9243ad2291dd6427d87328e282560a" = "1zf0sp9dy6kz4zvyz6mdgmhydps7khcq84n30irp983w1xh7gzs7";
|
||||
"https://github.com/simplex-chat/simplexmq.git"."a8471eed5be93e7c3741aa4742b24193c9a2d6f5" = "093i40api0dp7rvw6f1f3pww3q5iv6mvbj577nlxp3qqcbvyh6fs";
|
||||
"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";
|
||||
|
||||
+1
-17
@@ -150,13 +150,11 @@ library
|
||||
Simplex.Chat.Migrations.M20240920_user_order
|
||||
Simplex.Chat.Migrations.M20241008_indexes
|
||||
Simplex.Chat.Migrations.M20241010_contact_requests_contact_id
|
||||
Simplex.Chat.Migrations.M20241027_server_operators
|
||||
Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.File
|
||||
Simplex.Chat.Mobile.Shared
|
||||
Simplex.Chat.Mobile.WebRTC
|
||||
Simplex.Chat.Operators
|
||||
Simplex.Chat.Operators.Conditions
|
||||
Simplex.Chat.Options
|
||||
Simplex.Chat.ProfileGenerator
|
||||
Simplex.Chat.Protocol
|
||||
@@ -216,7 +214,6 @@ library
|
||||
, directory ==1.3.*
|
||||
, email-validate ==2.3.*
|
||||
, exceptions ==0.10.*
|
||||
, file-embed ==0.0.15.*
|
||||
, filepath ==1.4.*
|
||||
, http-types ==0.12.*
|
||||
, http2 >=4.2.2 && <4.3
|
||||
@@ -227,7 +224,6 @@ library
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, random >=1.1 && <1.3
|
||||
, record-hasfield ==1.0.*
|
||||
, scientific ==0.3.7.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplexmq >=5.0
|
||||
, socks ==0.6.*
|
||||
@@ -281,7 +277,6 @@ executable simplex-bot
|
||||
, directory ==1.3.*
|
||||
, email-validate ==2.3.*
|
||||
, exceptions ==0.10.*
|
||||
, file-embed ==0.0.15.*
|
||||
, filepath ==1.4.*
|
||||
, http-types ==0.12.*
|
||||
, http2 >=4.2.2 && <4.3
|
||||
@@ -292,7 +287,6 @@ executable simplex-bot
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, random >=1.1 && <1.3
|
||||
, record-hasfield ==1.0.*
|
||||
, scientific ==0.3.7.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=5.0
|
||||
@@ -347,7 +341,6 @@ executable simplex-bot-advanced
|
||||
, directory ==1.3.*
|
||||
, email-validate ==2.3.*
|
||||
, exceptions ==0.10.*
|
||||
, file-embed ==0.0.15.*
|
||||
, filepath ==1.4.*
|
||||
, http-types ==0.12.*
|
||||
, http2 >=4.2.2 && <4.3
|
||||
@@ -358,7 +351,6 @@ executable simplex-bot-advanced
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, random >=1.1 && <1.3
|
||||
, record-hasfield ==1.0.*
|
||||
, scientific ==0.3.7.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=5.0
|
||||
@@ -416,7 +408,6 @@ executable simplex-broadcast-bot
|
||||
, directory ==1.3.*
|
||||
, email-validate ==2.3.*
|
||||
, exceptions ==0.10.*
|
||||
, file-embed ==0.0.15.*
|
||||
, filepath ==1.4.*
|
||||
, http-types ==0.12.*
|
||||
, http2 >=4.2.2 && <4.3
|
||||
@@ -427,7 +418,6 @@ executable simplex-broadcast-bot
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, random >=1.1 && <1.3
|
||||
, record-hasfield ==1.0.*
|
||||
, scientific ==0.3.7.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=5.0
|
||||
@@ -483,7 +473,6 @@ executable simplex-chat
|
||||
, directory ==1.3.*
|
||||
, email-validate ==2.3.*
|
||||
, exceptions ==0.10.*
|
||||
, file-embed ==0.0.15.*
|
||||
, filepath ==1.4.*
|
||||
, http-types ==0.12.*
|
||||
, http2 >=4.2.2 && <4.3
|
||||
@@ -494,7 +483,6 @@ executable simplex-chat
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, random >=1.1 && <1.3
|
||||
, record-hasfield ==1.0.*
|
||||
, scientific ==0.3.7.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=5.0
|
||||
@@ -556,7 +544,6 @@ executable simplex-directory-service
|
||||
, directory ==1.3.*
|
||||
, email-validate ==2.3.*
|
||||
, exceptions ==0.10.*
|
||||
, file-embed ==0.0.15.*
|
||||
, filepath ==1.4.*
|
||||
, http-types ==0.12.*
|
||||
, http2 >=4.2.2 && <4.3
|
||||
@@ -567,7 +554,6 @@ executable simplex-directory-service
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, random >=1.1 && <1.3
|
||||
, record-hasfield ==1.0.*
|
||||
, scientific ==0.3.7.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=5.0
|
||||
@@ -657,7 +643,6 @@ test-suite simplex-chat-test
|
||||
, directory ==1.3.*
|
||||
, email-validate ==2.3.*
|
||||
, exceptions ==0.10.*
|
||||
, file-embed ==0.0.15.*
|
||||
, filepath ==1.4.*
|
||||
, generic-random ==1.5.*
|
||||
, http-types ==0.12.*
|
||||
@@ -669,7 +654,6 @@ test-suite simplex-chat-test
|
||||
, optparse-applicative >=0.15 && <0.17
|
||||
, random >=1.1 && <1.3
|
||||
, record-hasfield ==1.0.*
|
||||
, scientific ==0.3.7.*
|
||||
, silently ==1.2.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
|
||||
+149
-307
@@ -6,7 +6,6 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
@@ -44,7 +43,7 @@ import Data.Functor (($>))
|
||||
import Data.Functor.Identity
|
||||
import Data.Int (Int64)
|
||||
import Data.List (find, foldl', isSuffixOf, mapAccumL, partition, sortOn, zipWith4)
|
||||
import Data.List.NonEmpty (NonEmpty (..), (<|))
|
||||
import Data.List.NonEmpty (NonEmpty (..), nonEmpty, toList, (<|))
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
@@ -68,7 +67,6 @@ import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.Batch (MsgBatch (..), batchMessages)
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Messages.CIContent.Events
|
||||
import Simplex.Chat.Operators
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.ProfileGenerator (generateRandomProfile)
|
||||
import Simplex.Chat.Protocol
|
||||
@@ -99,7 +97,7 @@ import qualified Simplex.FileTransfer.Transport as XFTP
|
||||
import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId)
|
||||
import Simplex.Messaging.Agent as Agent
|
||||
import Simplex.Messaging.Agent.Client (SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary, getFastNetworkConfig, ipAddressProtected, withLockMap)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), ServerCfg (..), ServerRoles (..), allRoles, createAgentStore, defaultAgentConfig)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), ServerCfg (..), createAgentStore, defaultAgentConfig, enabledServerCfg, presetServerCfg)
|
||||
import Simplex.Messaging.Agent.Lock (withLock)
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
|
||||
@@ -139,32 +137,6 @@ import qualified UnliftIO.Exception as E
|
||||
import UnliftIO.IO (hClose, hSeek, hTell, openFile)
|
||||
import UnliftIO.STM
|
||||
|
||||
operatorSimpleXChat :: NewServerOperator
|
||||
operatorSimpleXChat =
|
||||
ServerOperator
|
||||
{ operatorId = DBNewEntity,
|
||||
operatorTag = Just OTSimplex,
|
||||
tradeName = "SimpleX Chat",
|
||||
legalName = Just "SimpleX Chat Ltd",
|
||||
serverDomains = ["simplex.im"],
|
||||
conditionsAcceptance = CARequired Nothing,
|
||||
enabled = True,
|
||||
roles = allRoles
|
||||
}
|
||||
|
||||
operatorXYZ :: NewServerOperator
|
||||
operatorXYZ =
|
||||
ServerOperator
|
||||
{ operatorId = DBNewEntity,
|
||||
operatorTag = Just OTXyz,
|
||||
tradeName = "XYZ",
|
||||
legalName = Just "XYZ Ltd",
|
||||
serverDomains = ["xyz.com"],
|
||||
conditionsAcceptance = CARequired Nothing,
|
||||
enabled = False,
|
||||
roles = ServerRoles {storage = False, proxy = True}
|
||||
}
|
||||
|
||||
defaultChatConfig :: ChatConfig
|
||||
defaultChatConfig =
|
||||
ChatConfig
|
||||
@@ -175,25 +147,13 @@ defaultChatConfig =
|
||||
},
|
||||
chatVRange = supportedChatVRange,
|
||||
confirmMigrations = MCConsole,
|
||||
presetServers =
|
||||
PresetServers
|
||||
{ operators =
|
||||
[ PresetOperator
|
||||
{ operator = Just operatorSimpleXChat,
|
||||
smp = simplexChatSMPServers,
|
||||
useSMP = 4,
|
||||
xftp = map (presetServer True) $ L.toList defaultXFTPServers,
|
||||
useXFTP = 3
|
||||
},
|
||||
PresetOperator
|
||||
{ operator = Just operatorXYZ,
|
||||
smp = xyzSMPServers,
|
||||
useSMP = 3,
|
||||
xftp = xyzXFTPServers,
|
||||
useXFTP = 3
|
||||
}
|
||||
],
|
||||
defaultServers =
|
||||
DefaultAgentServers
|
||||
{ smp = _defaultSMPServers,
|
||||
useSMP = 4,
|
||||
ntf = _defaultNtfServers,
|
||||
xftp = L.map (presetServerCfg True) defaultXFTPServers,
|
||||
useXFTP = L.length defaultXFTPServers,
|
||||
netCfg = defaultNetworkConfig
|
||||
},
|
||||
tbqSize = 1024,
|
||||
@@ -217,52 +177,29 @@ defaultChatConfig =
|
||||
chatHooks = defaultChatHooks
|
||||
}
|
||||
|
||||
simplexChatSMPServers :: [NewUserServer 'PSMP]
|
||||
simplexChatSMPServers =
|
||||
map
|
||||
(presetServer True)
|
||||
[ "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion",
|
||||
"smp://SkIkI6EPd2D63F4xFKfHk7I1UGZVNn6k1QWZ5rcyr6w=@smp9.simplex.im,jssqzccmrcws6bhmn77vgmhfjmhwlyr3u7puw4erkyoosywgl67slqqd.onion",
|
||||
"smp://6iIcWT_dF2zN_w5xzZEY7HI2Prbh3ldP07YTyDexPjE=@smp10.simplex.im,rb2pbttocvnbrngnwziclp2f4ckjq65kebafws6g4hy22cdaiv5dwjqd.onion",
|
||||
"smp://1OwYGt-yqOfe2IyVHhxz3ohqo3aCCMjtB-8wn4X_aoY=@smp11.simplex.im,6ioorbm6i3yxmuoezrhjk6f6qgkc4syabh7m3so74xunb5nzr4pwgfqd.onion",
|
||||
"smp://UkMFNAXLXeAAe0beCa4w6X_zp18PwxSaSjY17BKUGXQ=@smp12.simplex.im,ie42b5weq7zdkghocs3mgxdjeuycheeqqmksntj57rmejagmg4eor5yd.onion",
|
||||
"smp://enEkec4hlR3UtKx2NMpOUK_K4ZuDxjWBO1d9Y4YXVaA=@smp14.simplex.im,aspkyu2sopsnizbyfabtsicikr2s4r3ti35jogbcekhm3fsoeyjvgrid.onion",
|
||||
"smp://h--vW7ZSkXPeOUpfxlFGgauQmXNFOzGoizak7Ult7cw=@smp15.simplex.im,oauu4bgijybyhczbnxtlggo6hiubahmeutaqineuyy23aojpih3dajad.onion",
|
||||
"smp://hejn2gVIqNU6xjtGM3OwQeuk8ZEbDXVJXAlnSBJBWUA=@smp16.simplex.im,p3ktngodzi6qrf7w64mmde3syuzrv57y55hxabqcq3l5p6oi7yzze6qd.onion",
|
||||
"smp://ZKe4uxF4Z_aLJJOEsC-Y6hSkXgQS5-oc442JQGkyP8M=@smp17.simplex.im,ogtwfxyi3h2h5weftjjpjmxclhb5ugufa5rcyrmg7j4xlch7qsr5nuqd.onion",
|
||||
"smp://PtsqghzQKU83kYTlQ1VKg996dW4Cw4x_bvpKmiv8uns=@smp18.simplex.im,lyqpnwbs2zqfr45jqkncwpywpbtq7jrhxnib5qddtr6npjyezuwd3nqd.onion",
|
||||
"smp://N_McQS3F9TGoh4ER0QstUf55kGnNSd-wXfNPZ7HukcM=@smp19.simplex.im,i53bbtoqhlc365k6kxzwdp5w3cdt433s7bwh3y32rcbml2vztiyyz5id.onion"
|
||||
]
|
||||
<> map
|
||||
(presetServer False)
|
||||
[ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
|
||||
"smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
|
||||
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
|
||||
_defaultSMPServers :: NonEmpty (ServerCfg 'PSMP)
|
||||
_defaultSMPServers =
|
||||
L.fromList $
|
||||
map
|
||||
(presetServerCfg True)
|
||||
[ "smp://0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU=@smp8.simplex.im,beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion",
|
||||
"smp://SkIkI6EPd2D63F4xFKfHk7I1UGZVNn6k1QWZ5rcyr6w=@smp9.simplex.im,jssqzccmrcws6bhmn77vgmhfjmhwlyr3u7puw4erkyoosywgl67slqqd.onion",
|
||||
"smp://6iIcWT_dF2zN_w5xzZEY7HI2Prbh3ldP07YTyDexPjE=@smp10.simplex.im,rb2pbttocvnbrngnwziclp2f4ckjq65kebafws6g4hy22cdaiv5dwjqd.onion",
|
||||
"smp://1OwYGt-yqOfe2IyVHhxz3ohqo3aCCMjtB-8wn4X_aoY=@smp11.simplex.im,6ioorbm6i3yxmuoezrhjk6f6qgkc4syabh7m3so74xunb5nzr4pwgfqd.onion",
|
||||
"smp://UkMFNAXLXeAAe0beCa4w6X_zp18PwxSaSjY17BKUGXQ=@smp12.simplex.im,ie42b5weq7zdkghocs3mgxdjeuycheeqqmksntj57rmejagmg4eor5yd.onion",
|
||||
"smp://enEkec4hlR3UtKx2NMpOUK_K4ZuDxjWBO1d9Y4YXVaA=@smp14.simplex.im,aspkyu2sopsnizbyfabtsicikr2s4r3ti35jogbcekhm3fsoeyjvgrid.onion",
|
||||
"smp://h--vW7ZSkXPeOUpfxlFGgauQmXNFOzGoizak7Ult7cw=@smp15.simplex.im,oauu4bgijybyhczbnxtlggo6hiubahmeutaqineuyy23aojpih3dajad.onion",
|
||||
"smp://hejn2gVIqNU6xjtGM3OwQeuk8ZEbDXVJXAlnSBJBWUA=@smp16.simplex.im,p3ktngodzi6qrf7w64mmde3syuzrv57y55hxabqcq3l5p6oi7yzze6qd.onion",
|
||||
"smp://ZKe4uxF4Z_aLJJOEsC-Y6hSkXgQS5-oc442JQGkyP8M=@smp17.simplex.im,ogtwfxyi3h2h5weftjjpjmxclhb5ugufa5rcyrmg7j4xlch7qsr5nuqd.onion",
|
||||
"smp://PtsqghzQKU83kYTlQ1VKg996dW4Cw4x_bvpKmiv8uns=@smp18.simplex.im,lyqpnwbs2zqfr45jqkncwpywpbtq7jrhxnib5qddtr6npjyezuwd3nqd.onion",
|
||||
"smp://N_McQS3F9TGoh4ER0QstUf55kGnNSd-wXfNPZ7HukcM=@smp19.simplex.im,i53bbtoqhlc365k6kxzwdp5w3cdt433s7bwh3y32rcbml2vztiyyz5id.onion"
|
||||
]
|
||||
|
||||
xyzSMPServers :: [NewUserServer 'PSMP]
|
||||
xyzSMPServers =
|
||||
map
|
||||
(presetServer True)
|
||||
[ "smp://abcd@smp1.xyz.com",
|
||||
"smp://abcd@smp2.xyz.com",
|
||||
"smp://abcd@smp3.xyz.com",
|
||||
"smp://abcd@smp4.xyz.com",
|
||||
"smp://abcd@smp5.xyz.com",
|
||||
"smp://abcd@smp6.xyz.com"
|
||||
]
|
||||
|
||||
xyzXFTPServers :: [NewUserServer 'PXFTP]
|
||||
xyzXFTPServers =
|
||||
map
|
||||
(presetServer True)
|
||||
[ "xftp://abcd@xftp1.xyz.com",
|
||||
"xftp://abcd@xftp2.xyz.com",
|
||||
"xftp://abcd@xftp3.xyz.com",
|
||||
"xftp://abcd@xftp4.xyz.com",
|
||||
"xftp://abcd@xftp5.xyz.com",
|
||||
"xftp://abcd@xftp6.xyz.com"
|
||||
]
|
||||
<> map
|
||||
(presetServerCfg False)
|
||||
[ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
|
||||
"smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
|
||||
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
|
||||
]
|
||||
|
||||
_defaultNtfServers :: [NtfServer]
|
||||
_defaultNtfServers =
|
||||
@@ -299,19 +236,16 @@ newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Boo
|
||||
newChatController
|
||||
ChatDatabase {chatStore, agentStore}
|
||||
user
|
||||
cfg@ChatConfig {agentConfig = aCfg, presetServers, inlineFiles, deviceNameForRemote, confirmMigrations}
|
||||
cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, deviceNameForRemote, confirmMigrations}
|
||||
ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, simpleNetCfg, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable, yesToUpMigrations}, deviceName, optFilesFolder, optTempDirectory, showReactions, allowInstantFiles, autoAcceptFileSize}
|
||||
backgroundMode = do
|
||||
let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
|
||||
confirmMigrations' = if confirmMigrations == MCConsole && yesToUpMigrations then MCYesUp else confirmMigrations
|
||||
config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, presetServers = presetServers', inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable, confirmMigrations = confirmMigrations'}
|
||||
config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable, confirmMigrations = confirmMigrations'}
|
||||
firstTime = dbNew chatStore
|
||||
currentUser <- newTVarIO user
|
||||
randomSMP <- randomPresetServers SPSMP presetServers'
|
||||
randomXFTP <- randomPresetServers SPXFTP presetServers'
|
||||
let randomServers = RandomServers {smpServers = randomSMP, xftpServers = randomXFTP}
|
||||
currentRemoteHost <- newTVarIO Nothing
|
||||
servers <- withTransaction chatStore $ \db -> agentServers db config randomServers
|
||||
servers <- agentServers config
|
||||
smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore backgroundMode
|
||||
agentAsync <- newTVarIO Nothing
|
||||
random <- liftIO C.newRandom
|
||||
@@ -347,7 +281,6 @@ newChatController
|
||||
ChatController
|
||||
{ firstTime,
|
||||
currentUser,
|
||||
randomServers,
|
||||
currentRemoteHost,
|
||||
smpAgent,
|
||||
agentAsync,
|
||||
@@ -385,39 +318,28 @@ newChatController
|
||||
contactMergeEnabled
|
||||
}
|
||||
where
|
||||
presetServers' :: PresetServers
|
||||
presetServers' = presetServers {operators = operators', netCfg = netCfg'}
|
||||
where
|
||||
PresetServers {operators, netCfg} = presetServers
|
||||
netCfg' = updateNetworkConfig netCfg simpleNetCfg
|
||||
operators' = case (smpServers, xftpServers) of
|
||||
([], []) -> operators
|
||||
(smpSrvs, []) -> L.map removeSMP operators <> [custom smpSrvs []]
|
||||
([], xftpSrvs) -> L.map removeXFTP operators <> [custom [] xftpSrvs]
|
||||
(smpSrvs, xftpSrvs) -> [custom smpSrvs xftpSrvs]
|
||||
removeSMP op = (op :: PresetOperator) {smp = []}
|
||||
removeXFTP op = (op :: PresetOperator) {xftp = []}
|
||||
custom smpSrvs xftpSrvs =
|
||||
PresetOperator
|
||||
{ operator = Nothing,
|
||||
smp = map (presetServer True) smpSrvs,
|
||||
useSMP = 0,
|
||||
xftp = map (presetServer True) xftpSrvs,
|
||||
useXFTP = 0
|
||||
}
|
||||
agentServers :: DB.Connection -> ChatConfig -> RandomServers -> IO InitialAgentServers
|
||||
agentServers db ChatConfig {presetServers = PresetServers {operators = presetOps, ntf, netCfg}} randomServers = do
|
||||
users <- getUsers db
|
||||
opDomains <- operatorDomains <$> getUpdateServerOperators db presetOps (null users)
|
||||
smp' <- getUserServers SPSMP users opDomains
|
||||
xftp' <- getUserServers SPXFTP users opDomains
|
||||
configServers :: DefaultAgentServers
|
||||
configServers =
|
||||
let DefaultAgentServers {smp = defSmp, xftp = defXftp, netCfg} = defaultServers
|
||||
smp' = maybe defSmp (L.map enabledServerCfg) (nonEmpty smpServers)
|
||||
xftp' = maybe defXftp (L.map enabledServerCfg) (nonEmpty xftpServers)
|
||||
in defaultServers {smp = smp', xftp = xftp', netCfg = updateNetworkConfig netCfg simpleNetCfg}
|
||||
agentServers :: ChatConfig -> IO InitialAgentServers
|
||||
agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do
|
||||
users <- withTransaction chatStore getUsers
|
||||
smp' <- getUserServers users SPSMP
|
||||
xftp' <- getUserServers users SPXFTP
|
||||
pure InitialAgentServers {smp = smp', xftp = xftp', ntf, netCfg}
|
||||
where
|
||||
getUserServers :: forall p. (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [User] -> [(Text, ServerOperator)] -> IO (Map UserId (NonEmpty (ServerCfg p)))
|
||||
getUserServers p users opDomains = do
|
||||
let randomSrvs = rndServers p randomServers
|
||||
fmap M.fromList $ forM users $ \u ->
|
||||
(aUserId u,) . agentServerCfgs opDomains <$> getUpdateUserServers db p presetOps randomSrvs u
|
||||
getUserServers :: forall p. (ProtocolTypeI p, UserProtocol p) => [User] -> SProtocolType p -> IO (Map UserId (NonEmpty (ServerCfg p)))
|
||||
getUserServers users protocol = case users of
|
||||
[] -> pure $ M.fromList [(1, cfgServers protocol defServers)]
|
||||
_ -> M.fromList <$> initialServers
|
||||
where
|
||||
initialServers :: IO [(UserId, NonEmpty (ServerCfg p))]
|
||||
initialServers = mapM (\u -> (aUserId u,) <$> userServers u) users
|
||||
userServers :: User -> IO (NonEmpty (ServerCfg p))
|
||||
userServers user' = useServers config protocol <$> withTransaction chatStore (`getProtocolServers` user')
|
||||
|
||||
updateNetworkConfig :: NetworkConfig -> SimpleNetCfg -> NetworkConfig
|
||||
updateNetworkConfig cfg SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, smpWebPort, tcpTimeout_, logTLSErrors} =
|
||||
@@ -460,37 +382,33 @@ withFileLock :: String -> Int64 -> CM a -> CM a
|
||||
withFileLock name = withEntityLock name . CLFile
|
||||
{-# INLINE withFileLock #-}
|
||||
|
||||
serverCfg :: ProtoServerWithAuth p -> ServerCfg p
|
||||
serverCfg server = ServerCfg {server, operator = Nothing, enabled = True, roles = allRoles}
|
||||
useServers :: UserProtocol p => ChatConfig -> SProtocolType p -> [ServerCfg p] -> NonEmpty (ServerCfg p)
|
||||
useServers ChatConfig {defaultServers} p = fromMaybe (cfgServers p defaultServers) . nonEmpty
|
||||
|
||||
useServers :: forall p. UserProtocol p => SProtocolType p -> RandomServers -> [UserServer p] -> NonEmpty (NewUserServer p)
|
||||
useServers p rs servers = case L.nonEmpty servers of
|
||||
Nothing -> rndServers p rs
|
||||
Just srvs -> L.map (\srv -> (srv :: UserServer p) {serverId = DBNewEntity}) srvs
|
||||
|
||||
rndServers :: UserProtocol p => SProtocolType p -> RandomServers -> NonEmpty (NewUserServer p)
|
||||
rndServers p RandomServers {smpServers, xftpServers} = case p of
|
||||
SPSMP -> smpServers
|
||||
SPXFTP -> xftpServers
|
||||
|
||||
randomPresetServers :: forall p. UserProtocol p => SProtocolType p -> PresetServers -> IO (NonEmpty (NewUserServer p))
|
||||
randomPresetServers p PresetServers {operators} = toJust . L.nonEmpty . concat =<< mapM opSrvs operators
|
||||
randomServers :: forall p. UserProtocol p => SProtocolType p -> ChatConfig -> IO (NonEmpty (ServerCfg p), [ServerCfg p])
|
||||
randomServers p ChatConfig {defaultServers} = do
|
||||
let srvs = cfgServers p defaultServers
|
||||
(enbldSrvs, dsbldSrvs) = L.partition (\ServerCfg {enabled} -> enabled) srvs
|
||||
toUse = cfgServersToUse p defaultServers
|
||||
if length enbldSrvs <= toUse
|
||||
then pure (srvs, [])
|
||||
else do
|
||||
(enbldSrvs', srvsToDisable) <- splitAt toUse <$> shuffle enbldSrvs
|
||||
let dsbldSrvs' = map (\srv -> (srv :: ServerCfg p) {enabled = False}) srvsToDisable
|
||||
srvs' = sortOn server' $ enbldSrvs' <> dsbldSrvs' <> dsbldSrvs
|
||||
pure (fromMaybe srvs $ L.nonEmpty srvs', srvs')
|
||||
where
|
||||
toJust = \case
|
||||
Just a -> pure a
|
||||
Nothing -> E.throwIO $ userError "no preset servers"
|
||||
opSrvs :: PresetOperator -> IO [NewUserServer p]
|
||||
opSrvs op = do
|
||||
let srvs = operatorServers p op
|
||||
toUse = operatorServersToUse p op
|
||||
(enbldSrvs, dsbldSrvs) = partition (\UserServer {enabled} -> enabled) srvs
|
||||
if toUse <= 0 || toUse >= length enbldSrvs
|
||||
then pure srvs
|
||||
else do
|
||||
(enbldSrvs', srvsToDisable) <- splitAt toUse <$> shuffle enbldSrvs
|
||||
let dsbldSrvs' = map (\srv -> (srv :: NewUserServer p) {enabled = False}) srvsToDisable
|
||||
pure $ sortOn server' $ enbldSrvs' <> dsbldSrvs' <> dsbldSrvs
|
||||
server' UserServer {server = ProtoServerWithAuth srv _} = srv
|
||||
server' ServerCfg {server = ProtoServerWithAuth srv _} = srv
|
||||
|
||||
cfgServers :: UserProtocol p => SProtocolType p -> DefaultAgentServers -> NonEmpty (ServerCfg p)
|
||||
cfgServers p DefaultAgentServers {smp, xftp} = case p of
|
||||
SPSMP -> smp
|
||||
SPXFTP -> xftp
|
||||
|
||||
cfgServersToUse :: UserProtocol p => SProtocolType p -> DefaultAgentServers -> Int
|
||||
cfgServersToUse p DefaultAgentServers {useSMP, useXFTP} = case p of
|
||||
SPSMP -> useSMP
|
||||
SPXFTP -> useXFTP
|
||||
|
||||
-- enableSndFiles has no effect when mainApp is True
|
||||
startChatController :: Bool -> Bool -> CM' (Async ())
|
||||
@@ -634,23 +552,19 @@ processChatCommand' vr = \case
|
||||
forM_ profile $ \Profile {displayName} -> checkValidName displayName
|
||||
p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile
|
||||
u <- asks currentUser
|
||||
smpServers <- chooseServers SPSMP
|
||||
xftpServers <- chooseServers SPXFTP
|
||||
(smp, smpServers) <- chooseServers SPSMP
|
||||
(xftp, xftpServers) <- chooseServers SPXFTP
|
||||
users <- withFastStore' getUsers
|
||||
forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} ->
|
||||
when (n == displayName) . throwChatError $
|
||||
if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""}
|
||||
opDomains <- operatorDomains . fst <$> withFastStore getServerOperators
|
||||
let smp = agentServerCfgs opDomains smpServers
|
||||
xftp = agentServerCfgs opDomains xftpServers
|
||||
auId <- withAgent (\a -> createUser a smp xftp)
|
||||
ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure
|
||||
user <- withFastStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts
|
||||
createPresetContactCards user `catchChatError` \_ -> pure ()
|
||||
withFastStore $ \db -> do
|
||||
createNoteFolder db user
|
||||
liftIO $ mapM_ (insertProtocolServer db SPSMP user ts) smpServers
|
||||
liftIO $ mapM_ (insertProtocolServer db SPXFTP user ts) xftpServers
|
||||
withFastStore $ \db -> createNoteFolder db user
|
||||
storeServers user smpServers
|
||||
storeServers user xftpServers
|
||||
atomically . writeTVar u $ Just user
|
||||
pure $ CRActiveUser user
|
||||
where
|
||||
@@ -659,11 +573,18 @@ processChatCommand' vr = \case
|
||||
withFastStore $ \db -> do
|
||||
createContact db user simplexStatusContactProfile
|
||||
createContact db user simplexTeamContactProfile
|
||||
chooseServers :: forall p. (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> CM (NonEmpty (NewUserServer p))
|
||||
chooseServers p = do
|
||||
rs <- asks randomServers
|
||||
srvs <- chatReadVar currentUser >>= mapM (\user -> withFastStore' $ \db -> getProtocolServers db p user)
|
||||
pure $ useServers p rs $ fromMaybe [] srvs
|
||||
chooseServers :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> CM (NonEmpty (ServerCfg p), [ServerCfg p])
|
||||
chooseServers protocol =
|
||||
asks currentUser >>= readTVarIO >>= \case
|
||||
Nothing -> asks config >>= liftIO . randomServers protocol
|
||||
Just user -> chosenServers =<< withFastStore' (`getProtocolServers` user)
|
||||
where
|
||||
chosenServers servers = do
|
||||
cfg <- asks config
|
||||
pure (useServers cfg protocol servers, servers)
|
||||
storeServers user servers =
|
||||
unless (null servers) . withFastStore $
|
||||
\db -> overwriteProtocolServers db user servers
|
||||
coupleDaysAgo t = (`addUTCTime` t) . fromInteger . negate . (+ (2 * day)) <$> randomRIO (0, day)
|
||||
day = 86400
|
||||
ListUsers -> CRUsersList <$> withFastStore' getUsersInfo
|
||||
@@ -814,14 +735,14 @@ processChatCommand' vr = \case
|
||||
APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
|
||||
-- TODO optimize queries calculating ChatStats, currently they're disabled
|
||||
CTDirect -> do
|
||||
directChat <- withFastStore (\db -> getDirectChat db vr user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTDirect directChat)
|
||||
(directChat, section) <- withFastStore (\db -> getDirectChat db vr user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTDirect directChat) section
|
||||
CTGroup -> do
|
||||
groupChat <- withFastStore (\db -> getGroupChat db vr user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTGroup groupChat)
|
||||
(groupChat, section) <- withFastStore (\db -> getGroupChat db vr user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTGroup groupChat) section
|
||||
CTLocal -> do
|
||||
localChat <- withFastStore (\db -> getLocalChat db user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTLocal localChat)
|
||||
(localChat, section) <- withFastStore (\db -> getLocalChat db user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTLocal localChat) section
|
||||
CTContactRequest -> pure $ chatCmdError (Just user) "not implemented"
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
APIGetChatItems pagination search -> withUser $ \user -> do
|
||||
@@ -1561,95 +1482,25 @@ processChatCommand' vr = \case
|
||||
msgs <- lift $ withAgent' $ \a -> getConnectionMessages a acIds
|
||||
let ntfMsgs = L.map (\msg -> receivedMsgInfo <$> msg) msgs
|
||||
pure $ CRConnNtfMessages ntfMsgs
|
||||
GetUserProtoServers (AProtocolType p) -> withUser $ \user@User {userId} -> withServerProtocol p $ do
|
||||
(operators, smpServers, xftpServers) <- withFastStore (`getUserServers` user)
|
||||
userServers <- liftIO $ groupByOperator $ case p of
|
||||
SPSMP -> (operators, smpServers, [])
|
||||
SPXFTP -> (operators, [], xftpServers)
|
||||
pure $ CRUserServers user userServers
|
||||
SetUserProtoServers (AProtocolType p) servers -> withUser $ \user@User {userId} -> withServerProtocol p $ do
|
||||
userServers <- liftIO . groupByOperator =<< withFastStore (`getUserServers` user)
|
||||
-- disable operators servers and repace (or add) custom servers, or restore random defaults if empty list
|
||||
case L.nonEmpty userServers of
|
||||
Just srvs -> processChatCommand $ APISetUserServers userId $ L.map updated srvs
|
||||
where
|
||||
updated UserOperatorServers {operator, smpServers, xftpServers} =
|
||||
UpdatedUserOperatorServers
|
||||
{ operator,
|
||||
smpServers = map (AUS SDBStored) smpServers,
|
||||
xftpServers = map (AUS SDBStored) xftpServers
|
||||
}
|
||||
Nothing -> throwChatError $ CECommandError "no servers"
|
||||
APIGetUserProtoServers userId (AProtocolType p) -> withUserId userId $ \user -> withServerProtocol p $ do
|
||||
cfg@ChatConfig {defaultServers} <- asks config
|
||||
servers <- withFastStore' (`getProtocolServers` user)
|
||||
pure $ CRUserProtoServers user $ AUPS $ UserProtoServers p (useServers cfg p servers) (cfgServers p defaultServers)
|
||||
GetUserProtoServers aProtocol -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APIGetUserProtoServers userId aProtocol
|
||||
APISetUserProtoServers userId (APSC p (ProtoServersConfig servers))
|
||||
| null servers || any (\ServerCfg {enabled} -> enabled) servers -> withUserId userId $ \user -> withServerProtocol p $ do
|
||||
withFastStore $ \db -> overwriteProtocolServers db user servers
|
||||
cfg <- asks config
|
||||
lift $ withAgent' $ \a -> setProtocolServers a (aUserId user) $ useServers cfg p servers
|
||||
ok user
|
||||
| otherwise -> withUserId userId $ \user -> pure $ chatCmdError (Just user) "all servers are disabled"
|
||||
SetUserProtoServers serversConfig -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APISetUserProtoServers userId serversConfig
|
||||
APITestProtoServer userId srv@(AProtoServerWithAuth _ server) -> withUserId userId $ \user ->
|
||||
lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a (aUserId user) server)
|
||||
TestProtoServer srv -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APITestProtoServer userId srv
|
||||
APITestServerOperator -> do
|
||||
let serverOperator = ServerOperator {
|
||||
operatorId = DBEntityId 1,
|
||||
operatorTag = Just OTSimplex,
|
||||
tradeName = "Simplex",
|
||||
legalName = Just "Simplex",
|
||||
serverDomains = ["simplex.im"],
|
||||
conditionsAcceptance = CAAccepted Nothing,
|
||||
enabled = True,
|
||||
roles = ServerRoles {storage = True, proxy = True}
|
||||
}
|
||||
pure $ CRTestOperator serverOperator
|
||||
APITestUsageConditionsAction -> do
|
||||
ts <- liftIO getCurrentTime
|
||||
let conditionsAction = Just $ UCAReview {
|
||||
operators = [],
|
||||
deadline = Just ts,
|
||||
showNotice = True
|
||||
}
|
||||
pure $ CRTestUsageConditionsAction conditionsAction
|
||||
APITestConditionsAcceptance -> do
|
||||
let acceptance = CAAccepted Nothing
|
||||
pure $ CRTestConditionsAcceptance acceptance
|
||||
APITestServerRoles -> do
|
||||
let serverRoles = ServerRoles {storage = True, proxy = True}
|
||||
pure $ CRTestServerRoles serverRoles
|
||||
APIGetServerOperators -> uncurry CRServerOperators <$> withFastStore getServerOperators
|
||||
APISetServerOperators operatorsEnabled -> withFastStore $ \db -> do
|
||||
liftIO $ setServerOperators db operatorsEnabled
|
||||
uncurry CRServerOperators <$> getServerOperators db
|
||||
APIGetUserServers userId -> withUserId userId $ \user -> withFastStore $ \db ->
|
||||
CRUserServers user <$> (liftIO . groupByOperator =<< getUserServers db user)
|
||||
APISetUserServers userId userServers -> withUserId userId $ \user -> do
|
||||
let errors = validateUserServers userServers
|
||||
unless (null errors) $ throwChatError (CECommandError $ "user servers validation error(s): " <> show errors)
|
||||
(operators, smpServers, xftpServers) <- withFastStore $ \db -> do
|
||||
setUserServers db user userServers
|
||||
getUserServers db user
|
||||
let opDomains = operatorDomains operators
|
||||
rs <- asks randomServers
|
||||
lift $ withAgent' $ \a -> do
|
||||
let auId = aUserId user
|
||||
setProtocolServers a auId $ agentServerCfgs opDomains $ useServers SPSMP rs smpServers
|
||||
setProtocolServers a auId $ agentServerCfgs opDomains $ useServers SPXFTP rs xftpServers
|
||||
ok_
|
||||
APIValidateServers userServers -> pure $ CRUserServersValidation $ validateUserServers userServers
|
||||
APIGetUsageConditions -> do
|
||||
(usageConditions, acceptedConditions) <- withFastStore $ \db -> do
|
||||
usageConditions <- getCurrentUsageConditions db
|
||||
acceptedConditions <- liftIO $ getLatestAcceptedConditions db
|
||||
pure (usageConditions, acceptedConditions)
|
||||
-- TODO if db commit is different from source commit, conditionsText should be nothing in response
|
||||
pure
|
||||
CRUsageConditions
|
||||
{ usageConditions,
|
||||
conditionsText = usageConditionsText,
|
||||
acceptedConditions
|
||||
}
|
||||
APISetConditionsNotified condId -> do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
withFastStore' $ \db -> setConditionsNotified db condId currentTs
|
||||
ok_
|
||||
APIAcceptConditions condId opIds -> withFastStore $ \db -> do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
acceptConditions db condId opIds currentTs
|
||||
uncurry CRServerOperators <$> getServerOperators db
|
||||
APISetChatItemTTL userId newTTL_ -> withUserId userId $ \user ->
|
||||
checkStoreNotChanged $
|
||||
withChatLock "setChatItemTTL" $ do
|
||||
@@ -1902,7 +1753,8 @@ processChatCommand' vr = \case
|
||||
canKeepLink (CRInvitationUri crData _) newUser = do
|
||||
let ConnReqUriData {crSmpQueues = q :| _} = crData
|
||||
SMPQueueUri {queueAddress = SMPQueueAddress {smpServer}} = q
|
||||
newUserServers <- map (\UserServer {server} -> protoServer server) <$> withFastStore' (\db -> getProtocolServers db SPSMP newUser)
|
||||
cfg <- asks config
|
||||
newUserServers <- L.map (\ServerCfg {server} -> protoServer server) . useServers cfg SPSMP <$> withFastStore' (`getProtocolServers` newUser)
|
||||
pure $ smpServer `elem` newUserServers
|
||||
updateConnRecord user@User {userId} conn@PendingContactConnection {customUserProfileId} newUser = do
|
||||
withAgent $ \a -> changeConnectionUser a (aUserId user) (aConnId' conn) (aUserId newUser)
|
||||
@@ -2236,7 +2088,7 @@ processChatCommand' vr = \case
|
||||
where
|
||||
changeMemberRole user gInfo members m gEvent = do
|
||||
let GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberContactId, localDisplayName = cName} = m
|
||||
assertUserGroupRole gInfo $ maximum ([GRAdmin, mRole, memRole] :: [GroupMemberRole])
|
||||
assertUserGroupRole gInfo $ maximum [GRAdmin, mRole, memRole]
|
||||
withGroupLock "memberRole" groupId . procCmd $ do
|
||||
unless (mRole == memRole) $ do
|
||||
withFastStore' $ \db -> updateGroupMemberRole db user m memRole
|
||||
@@ -2634,15 +2486,14 @@ processChatCommand' vr = \case
|
||||
pure $ CRAgentSubsTotal user subsTotal hasSession
|
||||
GetAgentServersSummary userId -> withUserId userId $ \user -> do
|
||||
agentServersSummary <- lift $ withAgent' getAgentServersSummary
|
||||
withStore' $ \db -> do
|
||||
users <- getUsers db
|
||||
smpServers <- getServers db user SPSMP
|
||||
xftpServers <- getServers db user SPXFTP
|
||||
let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers _defaultNtfServers
|
||||
pure $ CRAgentServersSummary user presentedServersSummary
|
||||
cfg <- asks config
|
||||
(users, smpServers, xftpServers) <-
|
||||
withStore' $ \db -> (,,) <$> getUsers db <*> getServers db cfg user SPSMP <*> getServers db cfg user SPXFTP
|
||||
let presentedServersSummary = toPresentedServersSummary agentServersSummary users user smpServers xftpServers _defaultNtfServers
|
||||
pure $ CRAgentServersSummary user presentedServersSummary
|
||||
where
|
||||
getServers :: (ProtocolTypeI p, UserProtocol p) => DB.Connection -> User -> SProtocolType p -> IO [ProtocolServer p]
|
||||
getServers db user p = map (\UserServer {server} -> protoServer server) <$> getProtocolServers db p user
|
||||
getServers :: (ProtocolTypeI p, UserProtocol p) => DB.Connection -> ChatConfig -> User -> SProtocolType p -> IO (NonEmpty (ProtocolServer p))
|
||||
getServers db cfg user p = L.map (\ServerCfg {server} -> protoServer server) . useServers cfg p <$> getProtocolServers db user
|
||||
ResetAgentServersStats -> withAgent resetAgentServersStats >> ok_
|
||||
GetAgentWorkers -> lift $ CRAgentWorkersSummary <$> withAgent' getAgentWorkersSummary
|
||||
GetAgentWorkersDetails -> lift $ CRAgentWorkersDetails <$> withAgent' getAgentWorkersDetails
|
||||
@@ -3760,7 +3611,8 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete}
|
||||
S.toList $ S.fromList $ concatMap (\FD.FileChunk {replicas} -> map (\FD.FileChunkReplica {server} -> server) replicas) chunks
|
||||
getUnknownSrvs :: [XFTPServer] -> CM [XFTPServer]
|
||||
getUnknownSrvs srvs = do
|
||||
knownSrvs <- map (\UserServer {server} -> protoServer server) <$> withStore' (\db -> getProtocolServers db SPXFTP user)
|
||||
cfg <- asks config
|
||||
knownSrvs <- L.map (\ServerCfg {server} -> protoServer server) . useServers cfg SPXFTP <$> withStore' (`getProtocolServers` user)
|
||||
pure $ filter (`notElem` knownSrvs) srvs
|
||||
ipProtectedForSrvs :: [XFTPServer] -> CM Bool
|
||||
ipProtectedForSrvs srvs = do
|
||||
@@ -3972,7 +3824,7 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
|
||||
(sftConns, sfts) <- getSndFileTransferConns
|
||||
(rftConns, rfts) <- getRcvFileTransferConns
|
||||
(pcConns, pcs) <- getPendingContactConns
|
||||
let conns = concat ([ctConns, ucConns, mConns, sftConns, rftConns, pcConns] :: [[ConnId]])
|
||||
let conns = concat [ctConns, ucConns, mConns, sftConns, rftConns, pcConns]
|
||||
pure (conns, cts, ucs, gs, ms, sfts, rfts, pcs)
|
||||
-- subscribe using batched commands
|
||||
rs <- withAgent $ \a -> agentBatchSubscribe a conns
|
||||
@@ -4780,7 +4632,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
ctItem = AChatItem SCTDirect SMDSnd (DirectChat ct)
|
||||
SWITCH qd phase cStats -> do
|
||||
toView $ CRContactSwitch user ct (SwitchProgress qd phase cStats)
|
||||
when (phase == SPStarted || phase == SPCompleted) $ case qd of
|
||||
when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
|
||||
QDRcv -> createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCESwitchQueue phase Nothing) Nothing
|
||||
QDSnd -> createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
|
||||
RSYNC rss cryptoErr_ cStats ->
|
||||
@@ -5065,7 +4917,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
(Just fileDescrText, Just msgId) -> do
|
||||
partSize <- asks $ xftpDescrPartSize . config
|
||||
let parts = splitFileDescr partSize fileDescrText
|
||||
pure . L.toList $ L.map (XMsgFileDescr msgId) parts
|
||||
pure . toList $ L.map (XMsgFileDescr msgId) parts
|
||||
_ -> pure []
|
||||
let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
|
||||
GroupMember {memberId} = sender
|
||||
@@ -5191,7 +5043,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
when continued $ sendPendingGroupMessages user m conn
|
||||
SWITCH qd phase cStats -> do
|
||||
toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats)
|
||||
when (phase == SPStarted || phase == SPCompleted) $ case qd of
|
||||
when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
|
||||
QDRcv -> createInternalChatItem user (CDGroupSnd gInfo) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing
|
||||
QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
|
||||
RSYNC rss cryptoErr_ cStats ->
|
||||
@@ -6755,17 +6607,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
messageWarning "x.grp.mem.con: neither member is invitee"
|
||||
where
|
||||
inviteeXGrpMemCon :: GroupMemberIntro -> CM ()
|
||||
inviteeXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of
|
||||
GMIntroReConnected -> updateStatus introId GMIntroConnected
|
||||
GMIntroToConnected -> pure ()
|
||||
GMIntroConnected -> pure ()
|
||||
_ -> updateStatus introId GMIntroToConnected
|
||||
inviteeXGrpMemCon GroupMemberIntro {introId, introStatus}
|
||||
| introStatus == GMIntroReConnected = updateStatus introId GMIntroConnected
|
||||
| introStatus `elem` [GMIntroToConnected, GMIntroConnected] = pure ()
|
||||
| otherwise = updateStatus introId GMIntroToConnected
|
||||
forwardMemberXGrpMemCon :: GroupMemberIntro -> CM ()
|
||||
forwardMemberXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of
|
||||
GMIntroToConnected -> updateStatus introId GMIntroConnected
|
||||
GMIntroReConnected -> pure ()
|
||||
GMIntroConnected -> pure ()
|
||||
_ -> updateStatus introId GMIntroReConnected
|
||||
forwardMemberXGrpMemCon GroupMemberIntro {introId, introStatus}
|
||||
| introStatus == GMIntroToConnected = updateStatus introId GMIntroConnected
|
||||
| introStatus `elem` [GMIntroReConnected, GMIntroConnected] = pure ()
|
||||
| otherwise = updateStatus introId GMIntroReConnected
|
||||
updateStatus introId status = withStore' $ \db -> updateIntroStatus db introId status
|
||||
|
||||
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> CM ()
|
||||
@@ -8230,24 +8080,14 @@ chatCommandP =
|
||||
"/smp test " *> (TestProtoServer . AProtoServerWithAuth SPSMP <$> strP),
|
||||
"/xftp test " *> (TestProtoServer . AProtoServerWithAuth SPXFTP <$> strP),
|
||||
"/ntf test " *> (TestProtoServer . AProtoServerWithAuth SPNTF <$> strP),
|
||||
"/_dec_operator" $> APITestServerOperator,
|
||||
"/_dec_conditions_action" $> APITestUsageConditionsAction,
|
||||
"/_dec_acceptance" $> APITestConditionsAcceptance,
|
||||
"/_dec_roles" $> APITestServerRoles,
|
||||
"/smp " *> (SetUserProtoServers (AProtocolType SPSMP) . map (AProtoServerWithAuth SPSMP) <$> protocolServersP),
|
||||
"/smp default" $> SetUserProtoServers (AProtocolType SPSMP) [],
|
||||
"/xftp " *> (SetUserProtoServers (AProtocolType SPXFTP) . map (AProtoServerWithAuth SPXFTP) <$> protocolServersP),
|
||||
"/xftp default" $> SetUserProtoServers (AProtocolType SPXFTP) [],
|
||||
"/_servers " *> (APISetUserProtoServers <$> A.decimal <* A.space <*> srvCfgP),
|
||||
"/smp " *> (SetUserProtoServers . APSC SPSMP . ProtoServersConfig . map enabledServerCfg <$> protocolServersP),
|
||||
"/smp default" $> SetUserProtoServers (APSC SPSMP $ ProtoServersConfig []),
|
||||
"/xftp " *> (SetUserProtoServers . APSC SPXFTP . ProtoServersConfig . map enabledServerCfg <$> protocolServersP),
|
||||
"/xftp default" $> SetUserProtoServers (APSC SPXFTP $ ProtoServersConfig []),
|
||||
"/_servers " *> (APIGetUserProtoServers <$> A.decimal <* A.space <*> strP),
|
||||
"/smp" $> GetUserProtoServers (AProtocolType SPSMP),
|
||||
"/xftp" $> GetUserProtoServers (AProtocolType SPXFTP),
|
||||
"/_operators" $> APIGetServerOperators,
|
||||
"/_operators " *> (APISetServerOperators <$> jsonP),
|
||||
"/_servers " *> (APIGetUserServers <$> A.decimal),
|
||||
"/_servers " *> (APISetUserServers <$> A.decimal <* A.space <*> jsonP),
|
||||
"/_validate_servers " *> (APIValidateServers <$> jsonP),
|
||||
"/_conditions" $> APIGetUsageConditions,
|
||||
"/_conditions_notified " *> (APISetConditionsNotified <$> A.decimal),
|
||||
"/_accept_conditions " *> (APIAcceptConditions <$> A.decimal <*> _strP),
|
||||
"/_ttl " *> (APISetChatItemTTL <$> A.decimal <* A.space <*> ciTTLDecimal),
|
||||
"/ttl " *> (SetChatItemTTL <$> ciTTL),
|
||||
"/_ttl " *> (APIGetChatItemTTL <$> A.decimal),
|
||||
@@ -8461,6 +8301,8 @@ chatCommandP =
|
||||
(CPLast <$ "count=" <*> A.decimal)
|
||||
<|> (CPAfter <$ "after=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
|
||||
<|> (CPBefore <$ "before=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
|
||||
<|> (CPAround <$ "around=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
|
||||
<|> (CPInitial <$ "initial=" <*> A.decimal)
|
||||
paginationByTimeP =
|
||||
(PTLast <$ "count=" <*> A.decimal)
|
||||
<|> (PTAfter <$ "after=" <*> strP <* A.space <* "count=" <*> A.decimal)
|
||||
@@ -8589,7 +8431,7 @@ chatCommandP =
|
||||
onOffP
|
||||
(Just <$> (AutoAccept <$> (" incognito=" *> onOffP <|> pure False) <*> optional (A.space *> msgContentP)))
|
||||
(pure Nothing)
|
||||
-- srvCfgP = strP >>= \case AProtocolType p -> APSC p <$> (A.space *> jsonP)
|
||||
srvCfgP = strP >>= \case AProtocolType p -> APSC p <$> (A.space *> jsonP)
|
||||
rcCtrlAddressP = RCCtrlAddress <$> ("addr=" *> strP) <*> (" iface=" *> (jsonP <|> text1P))
|
||||
text1P = safeDecodeUtf8 <$> A.takeTill (== ' ')
|
||||
char_ = optional . A.char
|
||||
|
||||
@@ -12,7 +12,6 @@ import Control.Concurrent.STM
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Core
|
||||
@@ -32,10 +31,10 @@ chatBotRepl welcome answer _user cc = do
|
||||
case resp of
|
||||
CRContactConnected _ contact _ -> do
|
||||
contactConnected contact
|
||||
void $ sendMessage cc contact $ T.pack welcome
|
||||
void $ sendMessage cc contact welcome
|
||||
CRNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) : _} -> do
|
||||
let msg = T.unpack $ ciContentToText mc
|
||||
void $ sendMessage cc contact . T.pack =<< answer contact msg
|
||||
void $ sendMessage cc contact =<< answer contact msg
|
||||
_ -> pure ()
|
||||
where
|
||||
contactConnected Contact {localDisplayName} = putStrLn $ T.unpack localDisplayName <> " connected"
|
||||
@@ -58,11 +57,11 @@ initializeBotAddress' logAddress cc = do
|
||||
when logAddress $ putStrLn $ "Bot's contact address is: " <> B.unpack (strEncode uri)
|
||||
void $ sendChatCmd cc $ AddressAutoAccept $ Just AutoAccept {acceptIncognito = False, autoReply = Nothing}
|
||||
|
||||
sendMessage :: ChatController -> Contact -> Text -> IO ()
|
||||
sendMessage cc ct = sendComposedMessage cc ct Nothing . MCText
|
||||
sendMessage :: ChatController -> Contact -> String -> IO ()
|
||||
sendMessage cc ct = sendComposedMessage cc ct Nothing . textMsgContent
|
||||
|
||||
sendMessage' :: ChatController -> ContactId -> Text -> IO ()
|
||||
sendMessage' cc ctId = sendComposedMessage' cc ctId Nothing . MCText
|
||||
sendMessage' :: ChatController -> ContactId -> String -> IO ()
|
||||
sendMessage' cc ctId = sendComposedMessage' cc ctId Nothing . textMsgContent
|
||||
|
||||
sendComposedMessage :: ChatController -> Contact -> Maybe ChatItemId -> MsgContent -> IO ()
|
||||
sendComposedMessage cc = sendComposedMessage' cc . contactId'
|
||||
@@ -84,6 +83,9 @@ deleteMessage cc ct chatItemId = do
|
||||
contactRef :: Contact -> ChatRef
|
||||
contactRef = ChatRef CTDirect . contactId'
|
||||
|
||||
textMsgContent :: String -> MsgContent
|
||||
textMsgContent = MCText . T.pack
|
||||
|
||||
printLog :: ChatController -> ChatLogLevel -> String -> IO ()
|
||||
printLog cc level s
|
||||
| logLevel (config cc) <= level = putStrLn s
|
||||
|
||||
@@ -18,8 +18,8 @@ data KnownContact = KnownContact
|
||||
}
|
||||
deriving (Eq)
|
||||
|
||||
knownContactNames :: [KnownContact] -> Text
|
||||
knownContactNames = T.intercalate ", " . map (("@" <>) . localDisplayName)
|
||||
knownContactNames :: [KnownContact] -> String
|
||||
knownContactNames = T.unpack . T.intercalate ", " . map (("@" <>) . localDisplayName)
|
||||
|
||||
parseKnownContacts :: ReadM [KnownContact]
|
||||
parseKnownContacts = eitherReader $ parseAll knownContactsP . encodeUtf8 . T.pack
|
||||
|
||||
@@ -35,6 +35,7 @@ import qualified Data.ByteArray as BA
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Char (ord)
|
||||
import Data.Constraint (Dict (..))
|
||||
import Data.Int (Int64)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Map.Strict (Map)
|
||||
@@ -56,7 +57,6 @@ import Simplex.Chat.Call
|
||||
import Simplex.Chat.Markdown (MarkdownList)
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Operators
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Remote.AppVersion
|
||||
import Simplex.Chat.Remote.Types
|
||||
@@ -70,7 +70,7 @@ import Simplex.Chat.Util (liftIOEither)
|
||||
import Simplex.FileTransfer.Description (FileDescriptionURI)
|
||||
import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
|
||||
import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, SMPServerSubs, ServerQueueInfo, UserNetworkInfo)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig, ServerRoles)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig, ServerCfg)
|
||||
import Simplex.Messaging.Agent.Lock
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration, withTransaction, withTransactionPriority)
|
||||
@@ -84,7 +84,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgId, NMsgMeta (..), NtfServer, ProtocolType (..), QueueId, SMPMsgMeta (..), SubscriptionMode (..), XFTPServer)
|
||||
import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, MsgId, NMsgMeta (..), NtfServer, ProtocolType (..), ProtocolTypeI, QueueId, SMPMsgMeta (..), SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServer, userProtocol)
|
||||
import Simplex.Messaging.TMap (TMap)
|
||||
import Simplex.Messaging.Transport (TLS, simplexMQVersion)
|
||||
import Simplex.Messaging.Transport.Client (SocksProxyWithAuth, TransportHost)
|
||||
@@ -132,7 +132,7 @@ data ChatConfig = ChatConfig
|
||||
{ agentConfig :: AgentConfig,
|
||||
chatVRange :: VersionRangeChat,
|
||||
confirmMigrations :: MigrationConfirmation,
|
||||
presetServers :: PresetServers,
|
||||
defaultServers :: DefaultAgentServers,
|
||||
tbqSize :: Natural,
|
||||
fileChunkSize :: Integer,
|
||||
xftpDescrPartSize :: Int,
|
||||
@@ -154,11 +154,6 @@ data ChatConfig = ChatConfig
|
||||
chatHooks :: ChatHooks
|
||||
}
|
||||
|
||||
data RandomServers = RandomServers
|
||||
{ smpServers :: NonEmpty (NewUserServer 'PSMP),
|
||||
xftpServers :: NonEmpty (NewUserServer 'PXFTP)
|
||||
}
|
||||
|
||||
-- The hooks can be used to extend or customize chat core in mobile or CLI clients.
|
||||
data ChatHooks = ChatHooks
|
||||
{ -- preCmdHook can be used to process or modify the commands before they are processed.
|
||||
@@ -177,9 +172,12 @@ defaultChatHooks =
|
||||
eventHook = \_ -> pure
|
||||
}
|
||||
|
||||
data PresetServers = PresetServers
|
||||
{ operators :: NonEmpty PresetOperator,
|
||||
data DefaultAgentServers = DefaultAgentServers
|
||||
{ smp :: NonEmpty (ServerCfg 'PSMP),
|
||||
useSMP :: Int,
|
||||
ntf :: [NtfServer],
|
||||
xftp :: NonEmpty (ServerCfg 'PXFTP),
|
||||
useXFTP :: Int,
|
||||
netCfg :: NetworkConfig
|
||||
}
|
||||
|
||||
@@ -205,7 +203,6 @@ data ChatDatabase = ChatDatabase {chatStore :: SQLiteStore, agentStore :: SQLite
|
||||
|
||||
data ChatController = ChatController
|
||||
{ currentUser :: TVar (Maybe User),
|
||||
randomServers :: RandomServers,
|
||||
currentRemoteHost :: TVar (Maybe RemoteHostId),
|
||||
firstTime :: Bool,
|
||||
smpAgent :: AgentClient,
|
||||
@@ -349,22 +346,12 @@ data ChatCommand
|
||||
| APIGetGroupLink GroupId
|
||||
| APICreateMemberContact GroupId GroupMemberId
|
||||
| APISendMemberContactInvitation {contactId :: ContactId, msgContent_ :: Maybe MsgContent}
|
||||
| APIGetUserProtoServers UserId AProtocolType
|
||||
| GetUserProtoServers AProtocolType
|
||||
| SetUserProtoServers AProtocolType [AProtoServerWithAuth]
|
||||
| APISetUserProtoServers UserId AProtoServersConfig
|
||||
| SetUserProtoServers AProtoServersConfig
|
||||
| APITestProtoServer UserId AProtoServerWithAuth
|
||||
| TestProtoServer AProtoServerWithAuth
|
||||
| APITestServerOperator
|
||||
| APITestUsageConditionsAction
|
||||
| APITestConditionsAcceptance
|
||||
| APITestServerRoles
|
||||
| APIGetServerOperators
|
||||
| APISetServerOperators (NonEmpty ServerOperator)
|
||||
| APIGetUserServers UserId
|
||||
| APISetUserServers UserId (NonEmpty UpdatedUserOperatorServers)
|
||||
| APIValidateServers (NonEmpty UpdatedUserOperatorServers) -- response is CRUserServersValidation
|
||||
| APIGetUsageConditions
|
||||
| APISetConditionsNotified Int64
|
||||
| APIAcceptConditions Int64 (NonEmpty Int64)
|
||||
| APISetChatItemTTL UserId (Maybe Int64)
|
||||
| SetChatItemTTL (Maybe Int64)
|
||||
| APIGetChatItemTTL UserId
|
||||
@@ -585,20 +572,13 @@ data ChatResponse
|
||||
| CRChatSuspended
|
||||
| CRApiChats {user :: User, chats :: [AChat]}
|
||||
| CRChats {chats :: [AChat]}
|
||||
| CRApiChat {user :: User, chat :: AChat}
|
||||
| CRApiChat {user :: User, chat :: AChat, section :: ChatLandingSection}
|
||||
| CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]}
|
||||
| CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo}
|
||||
| CRChatItemId User (Maybe ChatItemId)
|
||||
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
|
||||
| CRUserProtoServers {user :: User, servers :: AUserProtoServers}
|
||||
| CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
|
||||
| CRTestOperator {operator :: ServerOperator}
|
||||
| CRTestUsageConditionsAction {conditionsAction :: Maybe UsageConditionsAction}
|
||||
| CRTestConditionsAcceptance {acceptance :: ConditionsAcceptance}
|
||||
| CRTestServerRoles {roles :: ServerRoles}
|
||||
| CRServerOperators {operators :: [ServerOperator], conditionsAction :: Maybe UsageConditionsAction}
|
||||
| CRUserServers {user :: User, userServers :: [UserOperatorServers]}
|
||||
| CRUserServersValidation {serverErrors :: [UserServersError]}
|
||||
| CRUsageConditions {usageConditions :: UsageConditions, conditionsText :: Text, acceptedConditions :: Maybe UsageConditions}
|
||||
| CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
|
||||
| CRNetworkConfig {networkConfig :: NetworkConfig}
|
||||
| CRContactInfo {user :: User, contact :: Contact, connectionStats_ :: Maybe ConnectionStats, customUserProfile :: Maybe Profile}
|
||||
@@ -859,8 +839,15 @@ data ChatPagination
|
||||
= CPLast Int
|
||||
| CPAfter ChatItemId Int
|
||||
| CPBefore ChatItemId Int
|
||||
| CPAround ChatItemId Int
|
||||
| CPInitial Int
|
||||
deriving (Show)
|
||||
|
||||
data ChatLandingSection
|
||||
= CLSLatest
|
||||
| CLSUnread
|
||||
deriving (Show, Eq)
|
||||
|
||||
data PaginationByTime
|
||||
= PTLast Int
|
||||
| PTAfter UTCTime Int
|
||||
@@ -961,23 +948,23 @@ instance ToJSON AgentQueueId where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
-- data ProtoServersConfig p = ProtoServersConfig {servers :: [ServerCfg p]}
|
||||
-- deriving (Show)
|
||||
data ProtoServersConfig p = ProtoServersConfig {servers :: [ServerCfg p]}
|
||||
deriving (Show)
|
||||
|
||||
-- data AProtoServersConfig = forall p. ProtocolTypeI p => APSC (SProtocolType p) (ProtoServersConfig p)
|
||||
data AProtoServersConfig = forall p. ProtocolTypeI p => APSC (SProtocolType p) (ProtoServersConfig p)
|
||||
|
||||
-- deriving instance Show AProtoServersConfig
|
||||
deriving instance Show AProtoServersConfig
|
||||
|
||||
-- data UserProtoServers p = UserProtoServers
|
||||
-- { serverProtocol :: SProtocolType p,
|
||||
-- protoServers :: NonEmpty (ServerCfg p),
|
||||
-- presetServers :: NonEmpty (ServerCfg p)
|
||||
-- }
|
||||
-- deriving (Show)
|
||||
data UserProtoServers p = UserProtoServers
|
||||
{ serverProtocol :: SProtocolType p,
|
||||
protoServers :: NonEmpty (ServerCfg p),
|
||||
presetServers :: NonEmpty (ServerCfg p)
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
-- data AUserProtoServers = forall p. (ProtocolTypeI p, UserProtocol p) => AUPS (UserProtoServers p)
|
||||
data AUserProtoServers = forall p. (ProtocolTypeI p, UserProtocol p) => AUPS (UserProtoServers p)
|
||||
|
||||
-- deriving instance Show AUserProtoServers
|
||||
deriving instance Show AUserProtoServers
|
||||
|
||||
data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
|
||||
deriving (Show)
|
||||
@@ -1580,28 +1567,28 @@ $(JQ.deriveJSON defaultJSON ''CoreVersionInfo)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''SlowSQLQuery)
|
||||
|
||||
-- instance ProtocolTypeI p => FromJSON (ProtoServersConfig p) where
|
||||
-- parseJSON = $(JQ.mkParseJSON defaultJSON ''ProtoServersConfig)
|
||||
instance ProtocolTypeI p => FromJSON (ProtoServersConfig p) where
|
||||
parseJSON = $(JQ.mkParseJSON defaultJSON ''ProtoServersConfig)
|
||||
|
||||
-- instance ProtocolTypeI p => FromJSON (UserProtoServers p) where
|
||||
-- parseJSON = $(JQ.mkParseJSON defaultJSON ''UserProtoServers)
|
||||
instance ProtocolTypeI p => FromJSON (UserProtoServers p) where
|
||||
parseJSON = $(JQ.mkParseJSON defaultJSON ''UserProtoServers)
|
||||
|
||||
-- instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
|
||||
-- toJSON = $(JQ.mkToJSON defaultJSON ''UserProtoServers)
|
||||
-- toEncoding = $(JQ.mkToEncoding defaultJSON ''UserProtoServers)
|
||||
instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
|
||||
toJSON = $(JQ.mkToJSON defaultJSON ''UserProtoServers)
|
||||
toEncoding = $(JQ.mkToEncoding defaultJSON ''UserProtoServers)
|
||||
|
||||
-- instance FromJSON AUserProtoServers where
|
||||
-- parseJSON v = J.withObject "AUserProtoServers" parse v
|
||||
-- where
|
||||
-- parse o = do
|
||||
-- AProtocolType (p :: SProtocolType p) <- o .: "serverProtocol"
|
||||
-- case userProtocol p of
|
||||
-- Just Dict -> AUPS <$> J.parseJSON @(UserProtoServers p) v
|
||||
-- Nothing -> fail $ "AUserProtoServers: unsupported protocol " <> show p
|
||||
instance FromJSON AUserProtoServers where
|
||||
parseJSON v = J.withObject "AUserProtoServers" parse v
|
||||
where
|
||||
parse o = do
|
||||
AProtocolType (p :: SProtocolType p) <- o .: "serverProtocol"
|
||||
case userProtocol p of
|
||||
Just Dict -> AUPS <$> J.parseJSON @(UserProtoServers p) v
|
||||
Nothing -> fail $ "AUserProtoServers: unsupported protocol " <> show p
|
||||
|
||||
-- instance ToJSON AUserProtoServers where
|
||||
-- toJSON (AUPS s) = $(JQ.mkToJSON defaultJSON ''UserProtoServers) s
|
||||
-- toEncoding (AUPS s) = $(JQ.mkToEncoding defaultJSON ''UserProtoServers) s
|
||||
instance ToJSON AUserProtoServers where
|
||||
toJSON (AUPS s) = $(JQ.mkToJSON defaultJSON ''UserProtoServers) s
|
||||
toEncoding (AUPS s) = $(JQ.mkToEncoding defaultJSON ''UserProtoServers) s
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCS") ''RemoteCtrlSessionState)
|
||||
|
||||
@@ -1611,6 +1598,8 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCSR") ''RemoteCtrlStopReason)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RHSR") ''RemoteHostStopReason)
|
||||
|
||||
$(JQ.deriveJSON (enumJSON $ dropPrefix "CLS") ''ChatLandingSection)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CR") ''ChatResponse)
|
||||
|
||||
$(JQ.deriveFromJSON defaultJSON ''ArchiveConfig)
|
||||
|
||||
@@ -239,6 +239,12 @@ chatItemTs (CChatItem _ ci) = chatItemTs' ci
|
||||
chatItemTs' :: ChatItem c d -> UTCTime
|
||||
chatItemTs' ChatItem {meta = CIMeta {itemTs}} = itemTs
|
||||
|
||||
chatItemCreatedAt :: CChatItem c -> UTCTime
|
||||
chatItemCreatedAt (CChatItem _ ci) = chatItemCreatedAt' ci
|
||||
|
||||
chatItemCreatedAt' :: ChatItem c d -> UTCTime
|
||||
chatItemCreatedAt' ChatItem {meta = CIMeta {createdAt}} = createdAt
|
||||
|
||||
chatItemTimed :: ChatItem c d -> Maybe CITimed
|
||||
chatItemTimed ChatItem {meta = CIMeta {itemTimed}} = itemTimed
|
||||
|
||||
|
||||
@@ -0,0 +1,34 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20241023_chat_item_autoincrement_id :: Query
|
||||
m20241023_chat_item_autoincrement_id =
|
||||
[sql|
|
||||
INSERT INTO sqlite_sequence (name, seq)
|
||||
SELECT 'chat_items', MAX(ROWID) FROM chat_items;
|
||||
|
||||
PRAGMA writable_schema=1;
|
||||
|
||||
UPDATE sqlite_master SET sql = replace(sql, 'INTEGER PRIMARY KEY', 'INTEGER PRIMARY KEY AUTOINCREMENT')
|
||||
WHERE name = 'chat_items' AND type = 'table';
|
||||
|
||||
PRAGMA writable_schema=0;
|
||||
|]
|
||||
|
||||
down_m20241023_chat_item_autoincrement_id :: Query
|
||||
down_m20241023_chat_item_autoincrement_id =
|
||||
[sql|
|
||||
DELETE FROM sqlite_sequence WHERE name = 'chat_items';
|
||||
|
||||
PRAGMA writable_schema=1;
|
||||
|
||||
UPDATE sqlite_master
|
||||
SET sql = replace(sql, 'INTEGER PRIMARY KEY AUTOINCREMENT', 'INTEGER PRIMARY KEY')
|
||||
WHERE name = 'chat_items' AND type = 'table';
|
||||
|
||||
PRAGMA writable_schema=0;
|
||||
|]
|
||||
@@ -1,54 +0,0 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20241027_server_operators where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20241027_server_operators :: Query
|
||||
m20241027_server_operators =
|
||||
[sql|
|
||||
CREATE TABLE server_operators (
|
||||
server_operator_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
server_operator_tag TEXT,
|
||||
trade_name TEXT NOT NULL,
|
||||
legal_name TEXT,
|
||||
server_domains TEXT,
|
||||
enabled INTEGER NOT NULL DEFAULT 1,
|
||||
role_storage INTEGER NOT NULL DEFAULT 1,
|
||||
role_proxy INTEGER NOT NULL DEFAULT 1,
|
||||
created_at TEXT NOT NULL DEFAULT (datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT (datetime('now'))
|
||||
);
|
||||
|
||||
CREATE TABLE usage_conditions (
|
||||
usage_conditions_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
conditions_commit TEXT NOT NULL UNIQUE,
|
||||
notified_at TEXT,
|
||||
created_at TEXT NOT NULL DEFAULT (datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT (datetime('now'))
|
||||
);
|
||||
|
||||
CREATE TABLE operator_usage_conditions (
|
||||
operator_usage_conditions_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
server_operator_id INTEGER REFERENCES server_operators (server_operator_id) ON DELETE SET NULL ON UPDATE CASCADE,
|
||||
server_operator_tag TEXT,
|
||||
conditions_commit TEXT NOT NULL,
|
||||
accepted_at TEXT,
|
||||
created_at TEXT NOT NULL DEFAULT (datetime('now'))
|
||||
);
|
||||
|
||||
CREATE INDEX idx_operator_usage_conditions_server_operator_id ON operator_usage_conditions(server_operator_id);
|
||||
CREATE UNIQUE INDEX idx_operator_usage_conditions_conditions_commit ON operator_usage_conditions(conditions_commit, server_operator_id);
|
||||
|]
|
||||
|
||||
down_m20241027_server_operators :: Query
|
||||
down_m20241027_server_operators =
|
||||
[sql|
|
||||
DROP INDEX idx_operator_usage_conditions_conditions_commit;
|
||||
DROP INDEX idx_operator_usage_conditions_server_operator_id;
|
||||
|
||||
DROP TABLE operator_usage_conditions;
|
||||
DROP TABLE usage_conditions;
|
||||
DROP TABLE server_operators;
|
||||
|]
|
||||
@@ -360,7 +360,7 @@ CREATE TABLE pending_group_messages(
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE TABLE chat_items(
|
||||
chat_item_id INTEGER PRIMARY KEY,
|
||||
chat_item_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
|
||||
contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
|
||||
group_id INTEGER REFERENCES groups ON DELETE CASCADE,
|
||||
@@ -399,6 +399,7 @@ CREATE TABLE chat_items(
|
||||
fwd_from_chat_item_id INTEGER REFERENCES chat_items ON DELETE SET NULL,
|
||||
via_proxy INTEGER
|
||||
);
|
||||
CREATE TABLE sqlite_sequence(name,seq);
|
||||
CREATE TABLE chat_item_messages(
|
||||
chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
|
||||
message_id INTEGER NOT NULL UNIQUE REFERENCES messages ON DELETE CASCADE,
|
||||
@@ -429,7 +430,6 @@ CREATE TABLE commands(
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE TABLE sqlite_sequence(name,seq);
|
||||
CREATE TABLE settings(
|
||||
settings_id INTEGER PRIMARY KEY,
|
||||
chat_item_ttl INTEGER,
|
||||
@@ -589,33 +589,6 @@ CREATE TABLE note_folders(
|
||||
unread_chat INTEGER NOT NULL DEFAULT 0
|
||||
);
|
||||
CREATE TABLE app_settings(app_settings TEXT NOT NULL);
|
||||
CREATE TABLE server_operators(
|
||||
server_operator_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
server_operator_tag TEXT,
|
||||
trade_name TEXT NOT NULL,
|
||||
legal_name TEXT,
|
||||
server_domains TEXT,
|
||||
enabled INTEGER NOT NULL DEFAULT 1,
|
||||
role_storage INTEGER NOT NULL DEFAULT 1,
|
||||
role_proxy INTEGER NOT NULL DEFAULT 1,
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE TABLE usage_conditions(
|
||||
usage_conditions_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
conditions_commit TEXT NOT NULL UNIQUE,
|
||||
notified_at TEXT,
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now')),
|
||||
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE TABLE operator_usage_conditions(
|
||||
operator_usage_conditions_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
server_operator_id INTEGER REFERENCES server_operators(server_operator_id) ON DELETE SET NULL ON UPDATE CASCADE,
|
||||
server_operator_tag TEXT,
|
||||
conditions_commit TEXT NOT NULL,
|
||||
accepted_at TEXT,
|
||||
created_at TEXT NOT NULL DEFAULT(datetime('now'))
|
||||
);
|
||||
CREATE INDEX contact_profiles_index ON contact_profiles(
|
||||
display_name,
|
||||
full_name
|
||||
@@ -917,10 +890,3 @@ CREATE INDEX idx_received_probes_group_member_id on received_probes(
|
||||
group_member_id
|
||||
);
|
||||
CREATE INDEX idx_contact_requests_contact_id ON contact_requests(contact_id);
|
||||
CREATE INDEX idx_operator_usage_conditions_server_operator_id ON operator_usage_conditions(
|
||||
server_operator_id
|
||||
);
|
||||
CREATE UNIQUE INDEX idx_operator_usage_conditions_conditions_commit ON operator_usage_conditions(
|
||||
conditions_commit,
|
||||
server_operator_id
|
||||
);
|
||||
|
||||
@@ -1,447 +0,0 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
||||
|
||||
module Simplex.Chat.Operators where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.Encoding as JE
|
||||
import qualified Data.Aeson.TH as JQ
|
||||
import Data.FileEmbed
|
||||
import Data.Foldable (foldMap')
|
||||
import Data.IORef
|
||||
import Data.Int (Int64)
|
||||
import Data.List (find, foldl')
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe, isNothing, mapMaybe)
|
||||
import Data.Scientific (floatingOrInteger)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time (addUTCTime)
|
||||
import Data.Time.Clock (UTCTime, nominalDay)
|
||||
import Data.Type.Equality
|
||||
import Database.SQLite.Simple.FromField (FromField (..))
|
||||
import Database.SQLite.Simple.ToField (ToField (..))
|
||||
import Language.Haskell.TH.Syntax (lift)
|
||||
import Simplex.Chat.Operators.Conditions
|
||||
import Simplex.Chat.Types.Util (textParseJSON)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, SProtocolType (..), UserProtocol)
|
||||
import Simplex.Messaging.Transport.Client (TransportHost (..))
|
||||
import Simplex.Messaging.Util (atomicModifyIORef'_, safeDecodeUtf8, (<$?>))
|
||||
|
||||
usageConditionsCommit :: Text
|
||||
usageConditionsCommit = "165143a1112308c035ac00ed669b96b60599aa1c"
|
||||
|
||||
previousConditionsCommit :: Text
|
||||
previousConditionsCommit = "edf99fcd1d7d38d2501d19608b94c084cf00f2ac"
|
||||
|
||||
usageConditionsText :: Text
|
||||
usageConditionsText =
|
||||
$( let s = $(embedFile =<< makeRelativeToProject "PRIVACY.md")
|
||||
in [|stripFrontMatter (safeDecodeUtf8 $(lift s))|]
|
||||
)
|
||||
|
||||
data DBStored = DBStored | DBNew
|
||||
|
||||
data SDBStored (s :: DBStored) where
|
||||
SDBStored :: SDBStored 'DBStored
|
||||
SDBNew :: SDBStored 'DBNew
|
||||
|
||||
deriving instance Show (SDBStored s)
|
||||
|
||||
class DBStoredI s where sdbStored :: SDBStored s
|
||||
|
||||
instance DBStoredI 'DBStored where sdbStored = SDBStored
|
||||
|
||||
instance DBStoredI 'DBNew where sdbStored = SDBNew
|
||||
|
||||
instance TestEquality SDBStored where
|
||||
testEquality SDBStored SDBStored = Just Refl
|
||||
testEquality SDBNew SDBNew = Just Refl
|
||||
testEquality _ _ = Nothing
|
||||
|
||||
data DBEntityId' (s :: DBStored) where
|
||||
DBEntityId :: Int64 -> DBEntityId' 'DBStored
|
||||
DBNewEntity :: DBEntityId' 'DBNew
|
||||
|
||||
deriving instance Show (DBEntityId' s)
|
||||
|
||||
type DBEntityId = DBEntityId' 'DBStored
|
||||
|
||||
type DBNewEntity = DBEntityId' 'DBNew
|
||||
|
||||
data ADBEntityId = forall s. DBStoredI s => AEI (SDBStored s) (DBEntityId' s)
|
||||
|
||||
pattern ADBEntityId :: Int64 -> ADBEntityId
|
||||
pattern ADBEntityId i = AEI SDBStored (DBEntityId i)
|
||||
|
||||
pattern ADBNewEntity :: ADBEntityId
|
||||
pattern ADBNewEntity = AEI SDBNew DBNewEntity
|
||||
|
||||
data OperatorTag = OTSimplex | OTXyz
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance FromField OperatorTag where fromField = fromTextField_ textDecode
|
||||
|
||||
instance ToField OperatorTag where toField = toField . textEncode
|
||||
|
||||
instance FromJSON OperatorTag where
|
||||
parseJSON = textParseJSON "OperatorTag"
|
||||
|
||||
instance ToJSON OperatorTag where
|
||||
toJSON = J.String . textEncode
|
||||
toEncoding = JE.text . textEncode
|
||||
|
||||
instance TextEncoding OperatorTag where
|
||||
textDecode = \case
|
||||
"simplex" -> Just OTSimplex
|
||||
"xyz" -> Just OTXyz
|
||||
_ -> Nothing
|
||||
textEncode = \case
|
||||
OTSimplex -> "simplex"
|
||||
OTXyz -> "xyz"
|
||||
|
||||
-- this and other types only define instances of serialization for known DB IDs only,
|
||||
-- entities without IDs cannot be serialized to JSON
|
||||
instance FromField DBEntityId where fromField f = DBEntityId <$> fromField f
|
||||
|
||||
instance ToField DBEntityId where toField (DBEntityId i) = toField i
|
||||
|
||||
data UsageConditions = UsageConditions
|
||||
{ conditionsId :: Int64,
|
||||
conditionsCommit :: Text,
|
||||
notifiedAt :: Maybe UTCTime,
|
||||
createdAt :: UTCTime
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data UsageConditionsAction
|
||||
= UCAReview {operators :: [ServerOperator], deadline :: Maybe UTCTime, showNotice :: Bool}
|
||||
| UCAAccepted {operators :: [ServerOperator]}
|
||||
deriving (Show)
|
||||
|
||||
usageConditionsAction :: [ServerOperator] -> UsageConditions -> UTCTime -> Maybe UsageConditionsAction
|
||||
usageConditionsAction operators UsageConditions {createdAt, notifiedAt} now = do
|
||||
let enabledOperators = filter (\ServerOperator {enabled} -> enabled) operators
|
||||
if
|
||||
| null enabledOperators -> Nothing
|
||||
| all conditionsAccepted enabledOperators ->
|
||||
let acceptedForOperators = filter conditionsAccepted operators
|
||||
in Just $ UCAAccepted acceptedForOperators
|
||||
| otherwise ->
|
||||
let acceptForOperators = filter (not . conditionsAccepted) enabledOperators
|
||||
deadline = conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt)
|
||||
showNotice = isNothing notifiedAt
|
||||
in Just $ UCAReview acceptForOperators deadline showNotice
|
||||
|
||||
conditionsRequiredOrDeadline :: UTCTime -> UTCTime -> Maybe UTCTime
|
||||
conditionsRequiredOrDeadline createdAt notifiedAtOrNow =
|
||||
if notifiedAtOrNow < addUTCTime (14 * nominalDay) createdAt
|
||||
then Just $ conditionsDeadline notifiedAtOrNow
|
||||
else Nothing -- required
|
||||
where
|
||||
conditionsDeadline :: UTCTime -> UTCTime
|
||||
conditionsDeadline = addUTCTime (31 * nominalDay)
|
||||
|
||||
data ConditionsAcceptance
|
||||
= CAAccepted {acceptedAt :: Maybe UTCTime}
|
||||
| CARequired {deadline :: Maybe UTCTime}
|
||||
deriving (Show)
|
||||
|
||||
type ServerOperator = ServerOperator' 'DBStored
|
||||
|
||||
type NewServerOperator = ServerOperator' 'DBNew
|
||||
|
||||
data AServerOperator = forall s. ASO (SDBStored s) (ServerOperator' s)
|
||||
|
||||
deriving instance Show AServerOperator
|
||||
|
||||
data ServerOperator' s = ServerOperator
|
||||
{ operatorId :: DBEntityId' s,
|
||||
operatorTag :: Maybe OperatorTag,
|
||||
tradeName :: Text,
|
||||
legalName :: Maybe Text,
|
||||
serverDomains :: [Text],
|
||||
conditionsAcceptance :: ConditionsAcceptance,
|
||||
enabled :: Bool,
|
||||
roles :: ServerRoles
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
conditionsAccepted :: ServerOperator -> Bool
|
||||
conditionsAccepted ServerOperator {conditionsAcceptance} = case conditionsAcceptance of
|
||||
CAAccepted {} -> True
|
||||
_ -> False
|
||||
|
||||
data UserOperatorServers = UserOperatorServers
|
||||
{ operator :: Maybe ServerOperator,
|
||||
smpServers :: [UserServer 'PSMP],
|
||||
xftpServers :: [UserServer 'PXFTP]
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data UpdatedUserOperatorServers = UpdatedUserOperatorServers
|
||||
{ operator :: Maybe ServerOperator,
|
||||
smpServers :: [AUserServer 'PSMP],
|
||||
xftpServers :: [AUserServer 'PXFTP]
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
updatedServers :: UserProtocol p => UpdatedUserOperatorServers -> SProtocolType p -> [AUserServer p]
|
||||
updatedServers UpdatedUserOperatorServers {smpServers, xftpServers} = \case
|
||||
SPSMP -> smpServers
|
||||
SPXFTP -> xftpServers
|
||||
|
||||
type UserServer p = UserServer' 'DBStored p
|
||||
|
||||
type NewUserServer p = UserServer' 'DBNew p
|
||||
|
||||
data AUserServer p = forall s. AUS (SDBStored s) (UserServer' s p)
|
||||
|
||||
deriving instance Show (AUserServer p)
|
||||
|
||||
data UserServer' s p = UserServer
|
||||
{ serverId :: DBEntityId' s,
|
||||
server :: ProtoServerWithAuth p,
|
||||
preset :: Bool,
|
||||
tested :: Maybe Bool,
|
||||
enabled :: Bool,
|
||||
deleted :: Bool
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data PresetOperator = PresetOperator
|
||||
{ operator :: Maybe NewServerOperator,
|
||||
smp :: [NewUserServer 'PSMP],
|
||||
useSMP :: Int,
|
||||
xftp :: [NewUserServer 'PXFTP],
|
||||
useXFTP :: Int
|
||||
}
|
||||
|
||||
operatorServers :: UserProtocol p => SProtocolType p -> PresetOperator -> [NewUserServer p]
|
||||
operatorServers p PresetOperator {smp, xftp} = case p of
|
||||
SPSMP -> smp
|
||||
SPXFTP -> xftp
|
||||
|
||||
operatorServersToUse :: UserProtocol p => SProtocolType p -> PresetOperator -> Int
|
||||
operatorServersToUse p PresetOperator {useSMP, useXFTP} = case p of
|
||||
SPSMP -> useSMP
|
||||
SPXFTP -> useXFTP
|
||||
|
||||
presetServer :: Bool -> ProtoServerWithAuth p -> NewUserServer p
|
||||
presetServer enabled server =
|
||||
UserServer {serverId = DBNewEntity, server, preset = True, tested = Nothing, enabled, deleted = False}
|
||||
|
||||
-- This function should be used inside DB transaction to update conditions in the database
|
||||
-- it evaluates to (conditions to mark as accepted to SimpleX operator, current conditions, and conditions to add)
|
||||
usageConditionsToAdd :: Bool -> UTCTime -> [UsageConditions] -> (Maybe UsageConditions, UsageConditions, [UsageConditions])
|
||||
usageConditionsToAdd = usageConditionsToAdd' previousConditionsCommit usageConditionsCommit
|
||||
|
||||
-- This function is used in unit tests
|
||||
usageConditionsToAdd' :: Text -> Text -> Bool -> UTCTime -> [UsageConditions] -> (Maybe UsageConditions, UsageConditions, [UsageConditions])
|
||||
usageConditionsToAdd' prevCommit sourceCommit newUser createdAt = \case
|
||||
[]
|
||||
| newUser -> (Just sourceCond, sourceCond, [sourceCond])
|
||||
| otherwise -> (Just prevCond, sourceCond, [prevCond, sourceCond])
|
||||
where
|
||||
prevCond = conditions 1 prevCommit
|
||||
sourceCond = conditions 2 sourceCommit
|
||||
conds
|
||||
| hasSourceCond -> (Nothing, last conds, [])
|
||||
| otherwise -> (Nothing, sourceCond, [sourceCond])
|
||||
where
|
||||
hasSourceCond = any ((sourceCommit ==) . conditionsCommit) conds
|
||||
sourceCond = conditions cId sourceCommit
|
||||
cId = maximum (map conditionsId conds) + 1
|
||||
where
|
||||
conditions cId commit = UsageConditions {conditionsId = cId, conditionsCommit = commit, notifiedAt = Nothing, createdAt}
|
||||
|
||||
-- This function should be used inside DB transaction to update operators.
|
||||
-- It allows to add/remove/update preset operators in the database preserving enabled and roles settings,
|
||||
-- and preserves custom operators without tags for forward compatibility.
|
||||
updatedServerOperators :: NonEmpty PresetOperator -> [ServerOperator] -> [AServerOperator]
|
||||
updatedServerOperators presetOps storedOps =
|
||||
foldr addPreset [] presetOps
|
||||
<> map (ASO SDBStored) (filter (isNothing . operatorTag) storedOps)
|
||||
where
|
||||
-- TODO remove domains of preset operators from custom
|
||||
addPreset PresetOperator {operator} = case operator of
|
||||
Nothing -> id
|
||||
Just presetOp -> (storedOp' :)
|
||||
where
|
||||
storedOp' = case find ((operatorTag presetOp ==) . operatorTag) storedOps of
|
||||
Just ServerOperator {operatorId, conditionsAcceptance, enabled, roles} ->
|
||||
ASO SDBStored presetOp {operatorId, conditionsAcceptance, enabled, roles}
|
||||
Nothing -> ASO SDBNew presetOp
|
||||
|
||||
-- This function should be used inside DB transaction to update servers.
|
||||
updatedUserServers :: forall p. UserProtocol p => SProtocolType p -> NonEmpty PresetOperator -> NonEmpty (NewUserServer p) -> [UserServer p] -> NonEmpty (AUserServer p)
|
||||
updatedUserServers _ _ randomSrvs [] = L.map (AUS SDBNew) randomSrvs
|
||||
updatedUserServers p presetOps randomSrvs srvs =
|
||||
fromMaybe (L.map (AUS SDBNew) randomSrvs) (L.nonEmpty updatedSrvs)
|
||||
where
|
||||
updatedSrvs = map userServer presetSrvs <> map (AUS SDBStored) (filter customServer srvs)
|
||||
storedSrvs :: Map (ProtoServerWithAuth p) (UserServer p)
|
||||
storedSrvs = foldl' (\ss srv@UserServer {server} -> M.insert server srv ss) M.empty srvs
|
||||
customServer :: UserServer p -> Bool
|
||||
customServer srv = not (preset srv) && all (`S.notMember` presetHosts) (srvHost srv)
|
||||
presetSrvs :: [NewUserServer p]
|
||||
presetSrvs = concatMap (operatorServers p) presetOps
|
||||
presetHosts :: Set TransportHost
|
||||
presetHosts = foldMap' (S.fromList . L.toList . srvHost) presetSrvs
|
||||
userServer :: NewUserServer p -> AUserServer p
|
||||
userServer srv@UserServer {server} = maybe (AUS SDBNew srv) (AUS SDBStored) (M.lookup server storedSrvs)
|
||||
|
||||
srvHost :: UserServer' s p -> NonEmpty TransportHost
|
||||
srvHost UserServer {server = ProtoServerWithAuth srv _} = host srv
|
||||
|
||||
agentServerCfgs :: [(Text, ServerOperator)] -> NonEmpty (UserServer' s p) -> NonEmpty (ServerCfg p)
|
||||
agentServerCfgs opDomains = L.map agentServer
|
||||
where
|
||||
agentServer :: UserServer' s p -> ServerCfg p
|
||||
agentServer srv@UserServer {server, enabled} =
|
||||
case find (\(d, _) -> any (matchingHost d) (srvHost srv)) opDomains of
|
||||
Just (_, ServerOperator {operatorId = DBEntityId opId, enabled = opEnabled, roles}) ->
|
||||
ServerCfg {server, operator = Just opId, enabled = opEnabled && enabled, roles}
|
||||
Nothing ->
|
||||
ServerCfg {server, operator = Nothing, enabled, roles = allRoles}
|
||||
|
||||
matchingHost :: Text -> TransportHost -> Bool
|
||||
matchingHost d = \case
|
||||
THDomainName h -> d `T.isSuffixOf` T.pack h
|
||||
_ -> False
|
||||
|
||||
operatorDomains :: [ServerOperator] -> [(Text, ServerOperator)]
|
||||
operatorDomains = foldr (\op ds -> foldr (\d -> ((d, op) :)) ds (serverDomains op)) []
|
||||
|
||||
groupByOperator :: ([ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> IO [UserOperatorServers]
|
||||
groupByOperator (ops, smpSrvs, xftpSrvs) = do
|
||||
ss <- mapM (\op -> (serverDomains op,) <$> newIORef (UserOperatorServers (Just op) [] [])) ops
|
||||
custom <- newIORef $ UserOperatorServers Nothing [] []
|
||||
mapM_ (addServer ss custom addSMP) (reverse smpSrvs)
|
||||
mapM_ (addServer ss custom addXFTP) (reverse xftpSrvs)
|
||||
mapM (readIORef . snd) ss
|
||||
where
|
||||
addServer :: [([Text], IORef UserOperatorServers)] -> IORef UserOperatorServers -> (UserServer p -> UserOperatorServers -> UserOperatorServers) -> UserServer p -> IO ()
|
||||
addServer ss custom add srv =
|
||||
let v = maybe custom snd $ find (\(ds, _) -> any (\d -> any (matchingHost d) (srvHost srv)) ds) ss
|
||||
in atomicModifyIORef'_ v $ add srv
|
||||
addSMP srv s@UserOperatorServers {smpServers} = (s :: UserOperatorServers) {smpServers = srv : smpServers}
|
||||
addXFTP srv s@UserOperatorServers {xftpServers} = (s :: UserOperatorServers) {xftpServers = srv : xftpServers}
|
||||
|
||||
data UserServersError
|
||||
= USEStorageMissing {protocol :: AProtocolType}
|
||||
| USEProxyMissing {protocol :: AProtocolType}
|
||||
| USEDuplicateServer {protocol :: AProtocolType, duplicateServer :: AProtoServerWithAuth, duplicateHost :: TransportHost}
|
||||
deriving (Show)
|
||||
|
||||
validateUserServers :: NonEmpty UpdatedUserOperatorServers -> [UserServersError]
|
||||
validateUserServers uss =
|
||||
missingRolesErr SPSMP storage USEStorageMissing
|
||||
<> missingRolesErr SPSMP proxy USEProxyMissing
|
||||
<> missingRolesErr SPXFTP storage USEStorageMissing
|
||||
<> duplicatServerErrs SPSMP
|
||||
<> duplicatServerErrs SPXFTP
|
||||
where
|
||||
missingRolesErr :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> (ServerRoles -> Bool) -> (AProtocolType -> UserServersError) -> [UserServersError]
|
||||
missingRolesErr p roleSel err = [err (AProtocolType p) | hasRole]
|
||||
where
|
||||
hasRole =
|
||||
any (\(AUS _ UserServer {deleted, enabled}) -> enabled && not deleted) $
|
||||
concatMap (`updatedServers` p) $ filter roleEnabled (L.toList uss)
|
||||
roleEnabled UpdatedUserOperatorServers {operator} =
|
||||
maybe True (\ServerOperator {enabled, roles} -> enabled && roleSel roles) operator
|
||||
duplicatServerErrs :: (ProtocolTypeI p, UserProtocol p) => SProtocolType p -> [UserServersError]
|
||||
duplicatServerErrs p = mapMaybe duplicateErr_ srvs
|
||||
where
|
||||
srvs =
|
||||
filter (\(AUS _ UserServer {deleted}) -> not deleted) $
|
||||
concatMap (`updatedServers` p) (L.toList uss)
|
||||
duplicateErr_ (AUS _ srv@UserServer {server}) =
|
||||
USEDuplicateServer (AProtocolType p) (AProtoServerWithAuth p server)
|
||||
<$> find (`S.member` duplicateHosts) (srvHost srv)
|
||||
duplicateHosts = snd $ foldl' (\acc (AUS _ srv) -> foldl' addHost acc $ srvHost srv) (S.empty, S.empty) srvs
|
||||
addHost (hs, dups) h
|
||||
| h `S.member` hs = (hs, S.insert h dups)
|
||||
| otherwise = (S.insert h hs, dups)
|
||||
|
||||
instance ToJSON ADBEntityId where
|
||||
toEncoding (AEI _ dbId) = toEncoding dbId
|
||||
toJSON (AEI _ dbId) = toJSON dbId
|
||||
|
||||
instance ToJSON (DBEntityId' s) where
|
||||
toEncoding = \case
|
||||
DBEntityId i -> toEncoding i
|
||||
DBNewEntity -> JE.null_
|
||||
toJSON = \case
|
||||
DBEntityId i -> toJSON i
|
||||
DBNewEntity -> J.Null
|
||||
|
||||
instance FromJSON ADBEntityId where
|
||||
parseJSON (J.Null) = pure $ AEI SDBNew DBNewEntity
|
||||
parseJSON (J.Number n) = case floatingOrInteger n of
|
||||
Left (_ :: Double) -> fail "bad ADBEntityId"
|
||||
Right i -> pure $ AEI SDBStored (DBEntityId $ fromInteger i)
|
||||
parseJSON _ = fail "bad ADBEntityId"
|
||||
|
||||
instance DBStoredI s => FromJSON (DBEntityId' s) where
|
||||
parseJSON v = (\(AEI _ dbId) -> checkDBStored dbId) <$?> parseJSON v
|
||||
|
||||
checkDBStored :: forall t s s'. (DBStoredI s, DBStoredI s') => t s' -> Either String (t s)
|
||||
checkDBStored x = case testEquality (sdbStored @s) (sdbStored @s') of
|
||||
Just Refl -> Right x
|
||||
Nothing -> Left "bad DBStored"
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''UsageConditions)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CA") ''ConditionsAcceptance)
|
||||
|
||||
instance ToJSON (ServerOperator' s) where
|
||||
toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerOperator')
|
||||
toJSON = $(JQ.mkToJSON defaultJSON ''ServerOperator')
|
||||
|
||||
instance DBStoredI s => FromJSON (ServerOperator' s) where
|
||||
parseJSON = $(JQ.mkParseJSON defaultJSON ''ServerOperator')
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "UCA") ''UsageConditionsAction)
|
||||
|
||||
instance ProtocolTypeI p => ToJSON (UserServer' s p) where
|
||||
toEncoding = $(JQ.mkToEncoding defaultJSON ''UserServer')
|
||||
toJSON = $(JQ.mkToJSON defaultJSON ''UserServer')
|
||||
|
||||
instance (DBStoredI s, ProtocolTypeI p) => FromJSON (UserServer' s p) where
|
||||
parseJSON = $(JQ.mkParseJSON defaultJSON ''UserServer')
|
||||
|
||||
instance ProtocolTypeI p => FromJSON (AUserServer p) where
|
||||
parseJSON v = (AUS SDBStored <$> parseJSON v) <|> (AUS SDBNew <$> parseJSON v)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''UserOperatorServers)
|
||||
|
||||
instance FromJSON UpdatedUserOperatorServers where
|
||||
parseJSON = $(JQ.mkParseJSON defaultJSON ''UpdatedUserOperatorServers)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "USE") ''UserServersError)
|
||||
@@ -1,19 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Simplex.Chat.Operators.Conditions where
|
||||
|
||||
import Data.Char (isSpace)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
stripFrontMatter :: Text -> Text
|
||||
stripFrontMatter =
|
||||
T.unlines
|
||||
. dropWhile ("# " `T.isPrefixOf`) -- strip title
|
||||
. dropWhile (T.all isSpace)
|
||||
. dropWhile fm
|
||||
. (\ls -> let ls' = dropWhile (not . fm) ls in if null ls' then ls else ls')
|
||||
. dropWhile fm
|
||||
. T.lines
|
||||
where
|
||||
fm = ("---" `T.isPrefixOf`)
|
||||
@@ -7,6 +7,7 @@ module Simplex.Chat.Stats where
|
||||
|
||||
import qualified Data.Aeson.TH as J
|
||||
import Data.List (partition)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
@@ -130,7 +131,7 @@ data NtfServerSummary = NtfServerSummary
|
||||
-- - users are passed to exclude hidden users from totalServersSummary;
|
||||
-- - if currentUser is hidden, it should be accounted in totalServersSummary;
|
||||
-- - known is set only in user level summaries based on passed userSMPSrvs and userXFTPSrvs
|
||||
toPresentedServersSummary :: AgentServersSummary -> [User] -> User -> [SMPServer] -> [XFTPServer] -> [NtfServer] -> PresentedServersSummary
|
||||
toPresentedServersSummary :: AgentServersSummary -> [User] -> User -> NonEmpty SMPServer -> NonEmpty XFTPServer -> [NtfServer] -> PresentedServersSummary
|
||||
toPresentedServersSummary agentSummary users currentUser userSMPSrvs userXFTPSrvs userNtfSrvs = do
|
||||
let (userSMPSrvsSumms, allSMPSrvsSumms) = accSMPSrvsSummaries
|
||||
(userSMPCurr, userSMPPrev, userSMPProx) = smpSummsIntoCategories userSMPSrvsSumms
|
||||
|
||||
+328
-162
@@ -138,7 +138,7 @@ import Data.Time (addUTCTime)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
import Database.SQLite.Simple (NamedParam (..), Only (..), Query, (:.) (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
import Simplex.Chat.Controller (ChatListQuery (..), ChatPagination (..), PaginationByTime (..))
|
||||
import Simplex.Chat.Controller (ChatLandingSection (CLSLatest, CLSUnread), ChatListQuery (..), ChatPagination (..), PaginationByTime (..))
|
||||
import Simplex.Chat.Markdown
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
@@ -947,37 +947,41 @@ getContactConnectionChatPreviews_ db User {userId} pagination clq = case clq of
|
||||
aChat = AChat SCTContactConnection $ Chat (ContactConnection conn) [] stats
|
||||
in ACPD SCTContactConnection $ ContactConnectionPD updatedAt aChat
|
||||
|
||||
getDirectChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect)
|
||||
getDirectChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect, ChatLandingSection)
|
||||
getDirectChat db vr user contactId pagination search_ = do
|
||||
let search = fromMaybe "" search_
|
||||
ct <- getContact db vr user contactId
|
||||
liftIO $ case pagination of
|
||||
CPLast count -> getDirectChatLast_ db user ct count search
|
||||
CPAfter afterId count -> getDirectChatAfter_ db user ct afterId count search
|
||||
CPBefore beforeId count -> getDirectChatBefore_ db user ct beforeId count search
|
||||
case pagination of
|
||||
CPLast count -> liftIO $ (,CLSLatest) <$> getDirectChatLast_ db user ct count search
|
||||
CPAfter afterId count -> (,CLSLatest) <$> getDirectChatAfter_ db user ct afterId count search
|
||||
CPBefore beforeId count -> (,CLSLatest) <$> getDirectChatBefore_ db user ct beforeId count search
|
||||
CPAround aroundId count -> (,CLSLatest) <$> getDirectChatAround_ db user ct aroundId count search
|
||||
CPInitial count -> do
|
||||
unless (null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
|
||||
getDirectChatInitial_ db user ct 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 -> String -> IO (Chat 'CTDirect)
|
||||
getDirectChatLast_ db user@User {userId} ct@Contact {contactId} count search = do
|
||||
getDirectChatLast_ db user ct count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
chatItemIds <- getDirectChatItemIdsLast_
|
||||
chatItemIds <- getDirectChatItemIdsLast_ db user ct count search
|
||||
currentTs <- getCurrentTime
|
||||
chatItems <- mapM (safeGetDirectItem db user ct currentTs) chatItemIds
|
||||
pure $ Chat (DirectChat ct) (reverse chatItems) stats
|
||||
where
|
||||
getDirectChatItemIdsLast_ :: IO [ChatItemId]
|
||||
getDirectChatItemIdsLast_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, contactId, search, count)
|
||||
|
||||
getDirectChatItemIdsLast_ :: DB.Connection -> User -> Contact -> Int -> String -> 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 item_text LIKE '%' || ? || '%'
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, contactId, search, count)
|
||||
|
||||
safeGetDirectItem :: DB.Connection -> User -> Contact -> UTCTime -> ChatItemId -> IO (CChatItem 'CTDirect)
|
||||
safeGetDirectItem db user ct currentTs itemId =
|
||||
@@ -1021,82 +1025,129 @@ getDirectChatItemLast db user@User {userId} contactId = do
|
||||
(userId, contactId)
|
||||
getDirectChatItem db user contactId chatItemId
|
||||
|
||||
getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> IO (Chat 'CTDirect)
|
||||
getDirectChatAfter_ db user@User {userId} ct@Contact {contactId} afterChatItemId count search = do
|
||||
getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
|
||||
getDirectChatAfter_ db user ct@Contact {contactId} afterChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
chatItemIds <- getDirectChatItemIdsAfter_
|
||||
currentTs <- getCurrentTime
|
||||
chatItems <- mapM (safeGetDirectItem db user ct currentTs) chatItemIds
|
||||
afterChatItem <- getDirectChatItem db user contactId afterChatItemId
|
||||
chatItemIds <- liftIO $ getDirectChatItemIdsAfter_ db user ct afterChatItemId count search (chatItemCreatedAt afterChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetDirectItem db user ct currentTs) chatItemIds
|
||||
pure $ Chat (DirectChat ct) chatItems stats
|
||||
where
|
||||
getDirectChatItemIdsAfter_ :: IO [ChatItemId]
|
||||
getDirectChatItemIdsAfter_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND chat_item_id > ?
|
||||
ORDER BY created_at ASC, chat_item_id ASC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, contactId, search, afterChatItemId, count)
|
||||
|
||||
getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> IO (Chat 'CTDirect)
|
||||
getDirectChatBefore_ db user@User {userId} ct@Contact {contactId} beforeChatItemId count search = do
|
||||
getDirectChatItemIdsAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getDirectChatItemIdsAfter_ db User {userId} Contact {contactId} afterChatItemId count search afterChatItemCreatedAt =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
|
||||
ORDER BY created_at ASC, chat_item_id ASC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, contactId, search, afterChatItemCreatedAt, afterChatItemCreatedAt, afterChatItemId, count)
|
||||
|
||||
getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
|
||||
getDirectChatBefore_ db user ct@Contact {contactId} beforeChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
chatItemIds <- getDirectChatItemsIdsBefore_
|
||||
currentTs <- getCurrentTime
|
||||
chatItems <- mapM (safeGetDirectItem db user ct currentTs) chatItemIds
|
||||
beforeChatItem <- getDirectChatItem db user contactId beforeChatItemId
|
||||
chatItemIds <- liftIO $ getDirectChatItemsIdsBefore_ db user ct beforeChatItemId count search (chatItemCreatedAt beforeChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetDirectItem db user ct currentTs) chatItemIds
|
||||
pure $ Chat (DirectChat ct) (reverse chatItems) stats
|
||||
|
||||
getDirectChatItemsIdsBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getDirectChatItemsIdsBefore_ db User {userId} Contact {contactId} beforeChatItemId count search beforeChatItemCreatedAt =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, contactId, search, beforeChatItemCreatedAt, beforeChatItemCreatedAt, beforeChatItemId, count)
|
||||
|
||||
getDirectChatAround_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
|
||||
getDirectChatAround_ db user ct@Contact {contactId} aroundItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
let (fetchCountBefore, fetchCountAfter) = divideFetchCountAround_ (count - 1)
|
||||
middleChatItem <- getDirectChatItem db user contactId aroundItemId
|
||||
beforeIds <- liftIO $ getDirectChatItemsIdsBefore_ db user ct aroundItemId fetchCountBefore search (chatItemCreatedAt middleChatItem)
|
||||
afterIds <- liftIO $ getDirectChatItemIdsAfter_ db user ct aroundItemId fetchCountAfter search (chatItemCreatedAt middleChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
beforeChatItems <- liftIO $ reverse <$> mapM (safeGetDirectItem db user ct currentTs) beforeIds
|
||||
afterChatItems <- liftIO $ mapM (safeGetDirectItem db user ct currentTs) afterIds
|
||||
let chatItems = beforeChatItems <> [middleChatItem] <> afterChatItems
|
||||
pure $ Chat (DirectChat ct) chatItems stats
|
||||
|
||||
getDirectChatInitial_ :: DB.Connection -> User -> Contact -> Int -> ExceptT StoreError IO (Chat 'CTDirect, ChatLandingSection)
|
||||
getDirectChatInitial_ db user@User {userId} ct@Contact {contactId} count = do
|
||||
firstUnreadItemId_ <- liftIO getDirectChatMinUnreadItemId_
|
||||
case firstUnreadItemId_ of
|
||||
Just firstUnreadItemId -> do
|
||||
chat <- getDirectChatAround_ db user ct firstUnreadItemId count ""
|
||||
lastItemId <- liftIO $ getDirectChatItemIdsLast_ db user ct 1 ""
|
||||
pure (chat, landingSection chat lastItemId)
|
||||
Nothing -> liftIO $ (,CLSLatest) <$> getDirectChatLast_ db user ct count ""
|
||||
where
|
||||
getDirectChatItemsIdsBefore_ :: IO [ChatItemId]
|
||||
getDirectChatItemsIdsBefore_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
getDirectChatMinUnreadItemId_ :: IO (Maybe ChatItemId)
|
||||
getDirectChatMinUnreadItemId_ =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
SELECT MIN(chat_item_id)
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND chat_item_id < ?
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
WHERE user_id = ? AND contact_id = ? AND item_status = ?
|
||||
|]
|
||||
(userId, contactId, search, beforeChatItemId, count)
|
||||
(userId, contactId, CISRcvNew)
|
||||
|
||||
getGroupChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
|
||||
landingSection :: Chat c -> [ChatItemId] -> ChatLandingSection
|
||||
landingSection Chat {chatItems} [lastItemId] = do
|
||||
let lastItemIdInChat = foldr (\ci acc -> acc || cchatItemId ci == lastItemId) False chatItems
|
||||
if lastItemIdInChat then CLSLatest else CLSUnread
|
||||
landingSection _ _ = CLSUnread
|
||||
|
||||
getGroupChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup, ChatLandingSection)
|
||||
getGroupChat db vr user groupId pagination search_ = do
|
||||
let search = fromMaybe "" search_
|
||||
g <- getGroupInfo db vr user groupId
|
||||
case pagination of
|
||||
CPLast count -> liftIO $ getGroupChatLast_ db user g count search
|
||||
CPAfter afterId count -> getGroupChatAfter_ db user g afterId count search
|
||||
CPBefore beforeId count -> getGroupChatBefore_ db user g beforeId count search
|
||||
CPLast count -> liftIO $ (,CLSLatest) <$> getGroupChatLast_ db user g count search
|
||||
CPAfter afterId count -> (,CLSLatest) <$> getGroupChatAfter_ db user g afterId count search
|
||||
CPBefore beforeId count -> (,CLSLatest) <$> getGroupChatBefore_ db user g beforeId count search
|
||||
CPAround aroundId count -> (,CLSLatest) <$> getGroupChatAround_ db user g aroundId count search
|
||||
CPInitial count -> do
|
||||
unless (null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
|
||||
getGroupChatInitial_ db user g count
|
||||
|
||||
getGroupChatLast_ :: DB.Connection -> User -> GroupInfo -> Int -> String -> IO (Chat 'CTGroup)
|
||||
getGroupChatLast_ db user@User {userId} g@GroupInfo {groupId} count search = do
|
||||
getGroupChatLast_ db user g count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
chatItemIds <- getGroupChatItemIdsLast_
|
||||
chatItemIds <- getGroupChatItemIdsLast_ db user g count search
|
||||
currentTs <- getCurrentTime
|
||||
chatItems <- mapM (safeGetGroupItem db user g currentTs) chatItemIds
|
||||
pure $ Chat (GroupChat g) (reverse chatItems) stats
|
||||
where
|
||||
getGroupChatItemIdsLast_ :: IO [ChatItemId]
|
||||
getGroupChatItemIdsLast_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
ORDER BY item_ts DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, groupId, search, count)
|
||||
|
||||
getGroupChatItemIdsLast_ :: DB.Connection -> User -> GroupInfo -> Int -> String -> IO [ChatItemId]
|
||||
getGroupChatItemIdsLast_ db User {userId} GroupInfo {groupId} count search =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
ORDER BY item_ts DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, groupId, search, count)
|
||||
|
||||
safeGetGroupItem :: DB.Connection -> User -> GroupInfo -> UTCTime -> ChatItemId -> IO (CChatItem 'CTGroup)
|
||||
safeGetGroupItem db user g currentTs itemId =
|
||||
@@ -1141,83 +1192,122 @@ getGroupMemberChatItemLast db user@User {userId} groupId groupMemberId = do
|
||||
getGroupChatItem db user groupId chatItemId
|
||||
|
||||
getGroupChatAfter_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
|
||||
getGroupChatAfter_ db user@User {userId} g@GroupInfo {groupId} afterChatItemId count search = do
|
||||
getGroupChatAfter_ db user g@GroupInfo {groupId} afterChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
afterChatItem <- getGroupChatItem db user groupId afterChatItemId
|
||||
chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ (chatItemTs afterChatItem)
|
||||
chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ db user g afterChatItemId count search (chatItemTs afterChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) chatItemIds
|
||||
pure $ Chat (GroupChat g) chatItems stats
|
||||
where
|
||||
getGroupChatItemIdsAfter_ :: UTCTime -> IO [ChatItemId]
|
||||
getGroupChatItemIdsAfter_ afterChatItemTs =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (item_ts > ? OR (item_ts = ? AND chat_item_id > ?))
|
||||
ORDER BY item_ts ASC, chat_item_id ASC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, groupId, search, afterChatItemTs, afterChatItemTs, afterChatItemId, count)
|
||||
|
||||
getGroupChatItemIdsAfter_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getGroupChatItemIdsAfter_ db User {userId} GroupInfo {groupId} afterChatItemId count search afterChatItemTs =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (item_ts > ? OR (item_ts = ? AND chat_item_id > ?))
|
||||
ORDER BY item_ts ASC, chat_item_id ASC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, groupId, search, afterChatItemTs, afterChatItemTs, afterChatItemId, count)
|
||||
|
||||
getGroupChatBefore_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
|
||||
getGroupChatBefore_ db user@User {userId} g@GroupInfo {groupId} beforeChatItemId count search = do
|
||||
getGroupChatBefore_ db user g@GroupInfo {groupId} beforeChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId
|
||||
chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ (chatItemTs beforeChatItem)
|
||||
chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ db user g beforeChatItemId count search (chatItemTs beforeChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) chatItemIds
|
||||
pure $ Chat (GroupChat g) (reverse chatItems) stats
|
||||
|
||||
getGroupChatItemIdsBefore_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getGroupChatItemIdsBefore_ db User {userId} GroupInfo {groupId} beforeChatItemId count search beforeChatItemTs =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (item_ts < ? OR (item_ts = ? AND chat_item_id < ?))
|
||||
ORDER BY item_ts DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, groupId, search, beforeChatItemTs, beforeChatItemTs, beforeChatItemId, count)
|
||||
|
||||
getGroupChatAround_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
|
||||
getGroupChatAround_ db user g@GroupInfo {groupId} aroundItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
let (fetchCountBefore, fetchCountAfter) = divideFetchCountAround_ (count - 1)
|
||||
middleChatItem <- getGroupChatItem db user groupId aroundItemId
|
||||
beforeIds <- liftIO $ getGroupChatItemIdsBefore_ db user g aroundItemId fetchCountBefore search (chatItemTs middleChatItem)
|
||||
afterIds <- liftIO $ getGroupChatItemIdsAfter_ db user g aroundItemId fetchCountAfter search (chatItemTs middleChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
beforeChatItems <- liftIO $ reverse <$> mapM (safeGetGroupItem db user g currentTs) beforeIds
|
||||
afterChatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) afterIds
|
||||
let chatItems = beforeChatItems <> [middleChatItem] <> afterChatItems
|
||||
pure $ Chat (GroupChat g) chatItems stats
|
||||
|
||||
getGroupChatInitial_ :: DB.Connection -> User -> GroupInfo -> Int -> ExceptT StoreError IO (Chat 'CTGroup, ChatLandingSection)
|
||||
getGroupChatInitial_ db user@User {userId} g@GroupInfo {groupId} count = do
|
||||
firstUnreadItemId_ <- liftIO getGroupChatMinUnreadItemId_
|
||||
case firstUnreadItemId_ of
|
||||
Just firstUnreadItemId -> do
|
||||
chat <- getGroupChatAround_ db user g firstUnreadItemId count ""
|
||||
lastItemId <- liftIO $ getGroupChatItemIdsLast_ db user g 1 ""
|
||||
pure (chat, landingSection chat lastItemId)
|
||||
Nothing -> liftIO $ (,CLSLatest) <$> getGroupChatLast_ db user g count ""
|
||||
where
|
||||
getGroupChatItemIdsBefore_ :: UTCTime -> IO [ChatItemId]
|
||||
getGroupChatItemIdsBefore_ beforeChatItemTs =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
getGroupChatMinUnreadItemId_ :: IO (Maybe ChatItemId)
|
||||
getGroupChatMinUnreadItemId_ =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
SELECT MIN(chat_item_id)
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (item_ts < ? OR (item_ts = ? AND chat_item_id < ?))
|
||||
ORDER BY item_ts DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
WHERE user_id = ? AND group_id = ? AND item_status = ?
|
||||
|]
|
||||
(userId, groupId, search, beforeChatItemTs, beforeChatItemTs, beforeChatItemId, count)
|
||||
(userId, groupId, CISRcvNew)
|
||||
|
||||
getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTLocal)
|
||||
getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTLocal, ChatLandingSection)
|
||||
getLocalChat db user folderId pagination search_ = do
|
||||
let search = fromMaybe "" search_
|
||||
nf <- getNoteFolder db user folderId
|
||||
liftIO $ case pagination of
|
||||
CPLast count -> getLocalChatLast_ db user nf count search
|
||||
CPAfter afterId count -> getLocalChatAfter_ db user nf afterId count search
|
||||
CPBefore beforeId count -> getLocalChatBefore_ db user nf beforeId count search
|
||||
case pagination of
|
||||
CPLast count -> liftIO $ (,CLSLatest) <$> getLocalChatLast_ db user nf count search
|
||||
CPAfter afterId count -> (,CLSLatest) <$> getLocalChatAfter_ db user nf afterId count search
|
||||
CPBefore beforeId count -> (,CLSLatest) <$> getLocalChatBefore_ db user nf beforeId count search
|
||||
CPAround aroundId count -> (,CLSLatest) <$> getLocalChatAround_ db user nf aroundId count search
|
||||
CPInitial count -> do
|
||||
unless (null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
|
||||
getLocalChatInitial_ db user nf count
|
||||
|
||||
getLocalChatLast_ :: DB.Connection -> User -> NoteFolder -> Int -> String -> IO (Chat 'CTLocal)
|
||||
getLocalChatLast_ db user@User {userId} nf@NoteFolder {noteFolderId} count search = do
|
||||
getLocalChatLast_ db user nf count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
chatItemIds <- getLocalChatItemIdsLast_
|
||||
chatItemIds <- getLocalChatItemIdsLast_ db user nf count search
|
||||
currentTs <- getCurrentTime
|
||||
chatItems <- mapM (safeGetLocalItem db user nf currentTs) chatItemIds
|
||||
pure $ Chat (LocalChat nf) (reverse chatItems) stats
|
||||
where
|
||||
getLocalChatItemIdsLast_ :: IO [ChatItemId]
|
||||
getLocalChatItemIdsLast_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, noteFolderId, search, count)
|
||||
|
||||
getLocalChatItemIdsLast_ :: DB.Connection -> User -> NoteFolder -> Int -> String -> 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 item_text LIKE '%' || ? || '%'
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, noteFolderId, search, count)
|
||||
|
||||
safeGetLocalItem :: DB.Connection -> User -> NoteFolder -> UTCTime -> ChatItemId -> IO (CChatItem 'CTLocal)
|
||||
safeGetLocalItem db user NoteFolder {noteFolderId} currentTs itemId =
|
||||
@@ -1245,51 +1335,88 @@ safeToLocalItem currentTs itemId = \case
|
||||
file = Nothing
|
||||
}
|
||||
|
||||
getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> IO (Chat 'CTLocal)
|
||||
getLocalChatAfter_ db user@User {userId} nf@NoteFolder {noteFolderId} afterChatItemId count search = do
|
||||
getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal)
|
||||
getLocalChatAfter_ db user nf@NoteFolder {noteFolderId} afterChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
chatItemIds <- getLocalChatItemIdsAfter_
|
||||
currentTs <- getCurrentTime
|
||||
chatItems <- mapM (safeGetLocalItem db user nf currentTs) chatItemIds
|
||||
afterChatItem <- getLocalChatItem db user noteFolderId afterChatItemId
|
||||
chatItemIds <- liftIO $ getLocalChatItemIdsAfter_ db user nf afterChatItemId count search (chatItemCreatedAt afterChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetLocalItem db user nf currentTs) chatItemIds
|
||||
pure $ Chat (LocalChat nf) chatItems stats
|
||||
where
|
||||
getLocalChatItemIdsAfter_ :: IO [ChatItemId]
|
||||
getLocalChatItemIdsAfter_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND chat_item_id > ?
|
||||
ORDER BY created_at ASC, chat_item_id ASC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, noteFolderId, search, afterChatItemId, count)
|
||||
|
||||
getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> IO (Chat 'CTLocal)
|
||||
getLocalChatBefore_ db user@User {userId} nf@NoteFolder {noteFolderId} beforeChatItemId count search = do
|
||||
getLocalChatItemIdsAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getLocalChatItemIdsAfter_ db User {userId} NoteFolder {noteFolderId} afterChatItemId count search afterChatItemCreatedAt =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (created_at > ? OR (created_at = ? AND chat_item_id > ?))
|
||||
ORDER BY created_at ASC, chat_item_id ASC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, noteFolderId, search, afterChatItemCreatedAt, afterChatItemCreatedAt, afterChatItemId, count)
|
||||
|
||||
getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal)
|
||||
getLocalChatBefore_ db user nf@NoteFolder {noteFolderId} beforeChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
chatItemIds <- getLocalChatItemIdsBefore_
|
||||
currentTs <- getCurrentTime
|
||||
chatItems <- mapM (safeGetLocalItem db user nf currentTs) chatItemIds
|
||||
beforeChatItem <- getLocalChatItem db user noteFolderId beforeChatItemId
|
||||
chatItemIds <- liftIO $ getLocalChatItemIdsBefore_ db user nf beforeChatItemId count search (chatItemCreatedAt beforeChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetLocalItem db user nf currentTs) chatItemIds
|
||||
pure $ Chat (LocalChat nf) (reverse chatItems) stats
|
||||
|
||||
getLocalChatItemIdsBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getLocalChatItemIdsBefore_ db User {userId} NoteFolder {noteFolderId} beforeChatItemId count search beforeChatItemCreatedAt =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND (created_at < ? OR (created_at = ? AND chat_item_id < ?))
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, noteFolderId, search, beforeChatItemCreatedAt, beforeChatItemCreatedAt, beforeChatItemId, count)
|
||||
|
||||
getLocalChatAround_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal)
|
||||
getLocalChatAround_ db user nf@NoteFolder {noteFolderId} aroundItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
let (fetchCountBefore, fetchCountAfter) = divideFetchCountAround_ (count - 1)
|
||||
middleChatItem <- getLocalChatItem db user noteFolderId aroundItemId
|
||||
beforeIds <- liftIO $ getLocalChatItemIdsBefore_ db user nf aroundItemId fetchCountBefore search (chatItemCreatedAt middleChatItem)
|
||||
afterIds <- liftIO $ getLocalChatItemIdsAfter_ db user nf aroundItemId fetchCountAfter search (chatItemCreatedAt middleChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
beforeChatItems <- liftIO $ reverse <$> mapM (safeGetLocalItem db user nf currentTs) beforeIds
|
||||
afterChatItems <- liftIO $ mapM (safeGetLocalItem db user nf currentTs) afterIds
|
||||
let chatItems = beforeChatItems <> [middleChatItem] <> afterChatItems
|
||||
pure $ Chat (LocalChat nf) chatItems stats
|
||||
|
||||
getLocalChatInitial_ :: DB.Connection -> User -> NoteFolder -> Int -> ExceptT StoreError IO (Chat 'CTLocal, ChatLandingSection)
|
||||
getLocalChatInitial_ db user@User {userId} nf@NoteFolder {noteFolderId} count = do
|
||||
firstUnreadItemId_ <- liftIO getLocalChatMinUnreadItemId_
|
||||
case firstUnreadItemId_ of
|
||||
Just firstUnreadItemId -> do
|
||||
chat <- getLocalChatAround_ db user nf firstUnreadItemId count ""
|
||||
lastItemId <- liftIO $ getLocalChatItemIdsLast_ db user nf 1 ""
|
||||
pure (chat, landingSection chat lastItemId)
|
||||
Nothing -> liftIO $ (,CLSLatest) <$> getLocalChatLast_ db user nf count ""
|
||||
where
|
||||
getLocalChatItemIdsBefore_ :: IO [ChatItemId]
|
||||
getLocalChatItemIdsBefore_ =
|
||||
map fromOnly
|
||||
<$> DB.query
|
||||
getLocalChatMinUnreadItemId_ :: IO (Maybe ChatItemId)
|
||||
getLocalChatMinUnreadItemId_ =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id
|
||||
SELECT MIN(chat_item_id)
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%'
|
||||
AND chat_item_id < ?
|
||||
ORDER BY created_at DESC, chat_item_id DESC
|
||||
LIMIT ?
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
|
||||
|]
|
||||
(userId, noteFolderId, search, beforeChatItemId, count)
|
||||
(userId, noteFolderId, CISRcvNew)
|
||||
|
||||
toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64, Maybe Int64) -> Either StoreError (ChatRef, ChatItemId)
|
||||
toChatItemRef = \case
|
||||
@@ -1581,6 +1708,13 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
|
||||
CPLast count -> liftIO $ getAllChatItemsLast_ count
|
||||
CPAfter afterId count -> liftIO . getAllChatItemsAfter_ afterId count . aChatItemTs =<< getAChatItem_ afterId
|
||||
CPBefore beforeId count -> liftIO . getAllChatItemsBefore_ beforeId count . aChatItemTs =<< getAChatItem_ beforeId
|
||||
CPAround aroundId count -> liftIO . getAllChatItemsAround_ aroundId count . aChatItemTs =<< getAChatItem_ aroundId
|
||||
CPInitial count -> do
|
||||
unless (null search) $ throwError $ SEInternalError "initial chat pagination doesn't support search"
|
||||
firstUnreadItemId <- liftIO getFirstUnreadItemId_
|
||||
case firstUnreadItemId of
|
||||
Just itemId -> liftIO . getAllChatItemsAround_ itemId count . aChatItemTs =<< getAChatItem_ itemId
|
||||
Nothing -> liftIO $ getAllChatItemsLast_ count
|
||||
mapM (uncurry (getAChatItem db vr user)) itemRefs
|
||||
where
|
||||
search = fromMaybe "" search_
|
||||
@@ -1624,6 +1758,31 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, search, beforeTs, beforeTs, beforeId, count)
|
||||
getChatItem chatId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT chat_item_id, contact_id, group_id, note_folder_id
|
||||
FROM chat_items
|
||||
WHERE chat_item_id = ?
|
||||
|]
|
||||
(Only chatId)
|
||||
getAllChatItemsAround_ aroundId count aroundTs = do
|
||||
let (fetchCountBefore, fetchCountAfter) = divideFetchCountAround_ (count - 1)
|
||||
itemsBefore <- getAllChatItemsBefore_ aroundId fetchCountBefore aroundTs
|
||||
item <- getChatItem aroundId
|
||||
itemsAfter <- getAllChatItemsAfter_ aroundId fetchCountAfter aroundTs
|
||||
pure $ itemsBefore <> item <> itemsAfter
|
||||
getFirstUnreadItemId_ =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT MIN(chat_item_id)
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND item_status = ?
|
||||
|]
|
||||
(userId, CISRcvNew)
|
||||
|
||||
getChatItemIdsByAgentMsgId :: DB.Connection -> Int64 -> AgentMsgId -> IO [ChatItemId]
|
||||
getChatItemIdsByAgentMsgId db connId msgId =
|
||||
@@ -2650,3 +2809,10 @@ getGroupHistoryItems db user@User {userId} GroupInfo {groupId} count = do
|
||||
LIMIT ?
|
||||
|]
|
||||
(userId, groupId, rcvMsgContentTag, sndMsgContentTag, count)
|
||||
|
||||
divideFetchCountAround_ :: Int -> (Int, Int)
|
||||
divideFetchCountAround_ count =
|
||||
let fetchCountEachSide = count `div` 2
|
||||
fetchCountBefore = fetchCountEachSide + if count `mod` 2 /= 0 then 1 else 0
|
||||
fetchCountAfter = fetchCountEachSide
|
||||
in (fetchCountBefore, fetchCountAfter)
|
||||
@@ -114,7 +114,7 @@ import Simplex.Chat.Migrations.M20240827_calls_uuid
|
||||
import Simplex.Chat.Migrations.M20240920_user_order
|
||||
import Simplex.Chat.Migrations.M20241008_indexes
|
||||
import Simplex.Chat.Migrations.M20241010_contact_requests_contact_id
|
||||
import Simplex.Chat.Migrations.M20241027_server_operators
|
||||
import Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -229,7 +229,7 @@ schemaMigrations =
|
||||
("20240920_user_order", m20240920_user_order, Just down_m20240920_user_order),
|
||||
("20241008_indexes", m20241008_indexes, Just down_m20241008_indexes),
|
||||
("20241010_contact_requests_contact_id", m20241010_contact_requests_contact_id, Just down_m20241010_contact_requests_contact_id),
|
||||
("20241027_server_operators", m20241027_server_operators, Just down_m20241027_server_operators)
|
||||
("20241023_chat_item_autoincrement_id", m20241023_chat_item_autoincrement_id, Just down_m20241023_chat_item_autoincrement_id)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -1,8 +1,5 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
@@ -50,19 +47,7 @@ module Simplex.Chat.Store.Profiles
|
||||
getContactWithoutConnViaAddress,
|
||||
updateUserAddressAutoAccept,
|
||||
getProtocolServers,
|
||||
getUpdateUserServers,
|
||||
-- overwriteOperatorsAndServers,
|
||||
overwriteProtocolServers,
|
||||
insertProtocolServer,
|
||||
getUpdateServerOperators,
|
||||
getServerOperators,
|
||||
getUserServers,
|
||||
setServerOperators,
|
||||
getCurrentUsageConditions,
|
||||
getLatestAcceptedConditions,
|
||||
setConditionsNotified,
|
||||
acceptConditions,
|
||||
setUserServers,
|
||||
createCall,
|
||||
deleteCalls,
|
||||
getCalls,
|
||||
@@ -85,14 +70,12 @@ import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
import Database.SQLite.Simple (NamedParam (..), Only (..), Query, (:.) (..))
|
||||
import Database.SQLite.Simple (NamedParam (..), Only (..), (:.) (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
import Simplex.Chat.Call
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Operators
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Store.Direct
|
||||
import Simplex.Chat.Store.Shared
|
||||
@@ -100,7 +83,7 @@ import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.Shared
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..))
|
||||
import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
@@ -108,7 +91,7 @@ import qualified Simplex.Messaging.Crypto as C
|
||||
import qualified Simplex.Messaging.Crypto.Ratchet as CR
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON)
|
||||
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode, UserProtocol)
|
||||
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
|
||||
import Simplex.Messaging.Transport.Client (TransportHost)
|
||||
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
|
||||
|
||||
@@ -532,309 +515,42 @@ updateUserAddressAutoAccept db user@User {userId} autoAccept = do
|
||||
Just AutoAccept {acceptIncognito, autoReply} -> (True, acceptIncognito, autoReply)
|
||||
_ -> (False, False, Nothing)
|
||||
|
||||
getUpdateUserServers :: forall p. (ProtocolTypeI p, UserProtocol p) => DB.Connection -> SProtocolType p -> NonEmpty PresetOperator -> NonEmpty (NewUserServer p) -> User -> IO (NonEmpty (UserServer p))
|
||||
getUpdateUserServers db p presetOps randomSrvs user = do
|
||||
ts <- getCurrentTime
|
||||
srvs <- getProtocolServers db p user
|
||||
let srvs' = updatedUserServers p presetOps randomSrvs srvs
|
||||
mapM (upsertServer ts) srvs'
|
||||
where
|
||||
upsertServer :: UTCTime -> AUserServer p -> IO (UserServer p)
|
||||
upsertServer ts (AUS _ s@UserServer {serverId}) = case serverId of
|
||||
DBNewEntity -> insertProtocolServer db p user ts s
|
||||
DBEntityId _ -> updateProtocolServer db p ts s $> s
|
||||
|
||||
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> IO [UserServer p]
|
||||
getProtocolServers db p User {userId} =
|
||||
map toUserServer
|
||||
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p]
|
||||
getProtocolServers db User {userId} =
|
||||
map toServerCfg
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT smp_server_id, host, port, key_hash, basic_auth, preset, tested, enabled
|
||||
SELECT host, port, key_hash, basic_auth, preset, tested, enabled
|
||||
FROM protocol_servers
|
||||
WHERE user_id = ? AND protocol = ?
|
||||
WHERE user_id = ? AND protocol = ?;
|
||||
|]
|
||||
(userId, decodeLatin1 $ strEncode p)
|
||||
(userId, decodeLatin1 $ strEncode protocol)
|
||||
where
|
||||
toUserServer :: (DBEntityId, NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> UserServer p
|
||||
toUserServer (serverId, host, port, keyHash, auth_, preset, tested, enabled) =
|
||||
let server = ProtoServerWithAuth (ProtocolServer p host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
|
||||
in UserServer {serverId, server, preset, tested, enabled, deleted = False}
|
||||
protocol = protocolTypeI @p
|
||||
toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> ServerCfg p
|
||||
toServerCfg (host, port, keyHash, auth_, preset, tested, enabled) =
|
||||
let server = ProtoServerWithAuth (ProtocolServer protocol host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
|
||||
in ServerCfg {server, preset, tested, enabled}
|
||||
|
||||
-- TODO remove
|
||||
-- overwriteOperatorsAndServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> Maybe [ServerOperator] -> [ServerCfg p] -> ExceptT StoreError IO [ServerCfg p]
|
||||
-- overwriteOperatorsAndServers db user@User {userId} operators_ servers = do
|
||||
overwriteProtocolServers :: ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> [UserServer p] -> ExceptT StoreError IO ()
|
||||
overwriteProtocolServers db p User {userId} servers =
|
||||
-- liftIO $ mapM_ (updateServerOperators_ db) operators_
|
||||
overwriteProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> [ServerCfg p] -> ExceptT StoreError IO ()
|
||||
overwriteProtocolServers db User {userId} servers =
|
||||
checkConstraint SEUniqueID . ExceptT $ do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND protocol = ? " (userId, decodeLatin1 $ strEncode p)
|
||||
forM_ servers $ \UserServer {serverId, server, preset, tested, enabled} -> do
|
||||
DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND protocol = ? " (userId, protocol)
|
||||
forM_ servers $ \ServerCfg {server, preset, tested, enabled} -> do
|
||||
let ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_ = server
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO protocol_servers
|
||||
(server_id, protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
(protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(Only serverId :. serverColumns p server :. (preset, tested, enabled, userId, currentTs, currentTs))
|
||||
((protocol, host, port, keyHash, safeDecodeUtf8 . unBasicAuth <$> auth_) :. (preset, tested, enabled, userId, currentTs, currentTs))
|
||||
pure $ Right ()
|
||||
|
||||
insertProtocolServer :: forall p. ProtocolTypeI p => DB.Connection -> SProtocolType p -> User -> UTCTime -> NewUserServer p -> IO (UserServer p)
|
||||
insertProtocolServer db p User {userId} ts srv@UserServer {server, preset, tested, enabled} = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO protocol_servers
|
||||
(protocol, host, port, key_hash, basic_auth, preset, tested, enabled, user_id, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(serverColumns p server :. (preset, tested, enabled, userId, ts, ts))
|
||||
sId <- insertedRowId db
|
||||
pure (srv :: NewUserServer p) {serverId = DBEntityId sId}
|
||||
|
||||
updateProtocolServer :: ProtocolTypeI p => DB.Connection -> SProtocolType p -> UTCTime -> UserServer p -> IO ()
|
||||
updateProtocolServer db p ts UserServer {serverId, server, preset, tested, enabled} =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE protocol_servers
|
||||
SET protocol = ?, host = ?, port = ?, key_hash = ?, basic_auth = ?,
|
||||
preset = ?, tested = ?, enabled = ?, updated_at = ?
|
||||
WHERE smp_server_id = ?
|
||||
|]
|
||||
(serverColumns p server :. (preset, tested, enabled, ts, serverId))
|
||||
|
||||
serverColumns :: ProtocolTypeI p => SProtocolType p -> ProtoServerWithAuth p -> (Text, NonEmpty TransportHost, String, C.KeyHash, Maybe Text)
|
||||
serverColumns p (ProtoServerWithAuth ProtocolServer {host, port, keyHash} auth_) =
|
||||
let protocol = decodeLatin1 $ strEncode p
|
||||
auth = safeDecodeUtf8 . unBasicAuth <$> auth_
|
||||
in (protocol, host, port, keyHash, auth)
|
||||
|
||||
getServerOperators :: DB.Connection -> ExceptT StoreError IO ([ServerOperator], Maybe UsageConditionsAction)
|
||||
getServerOperators db = do
|
||||
currentConds <- getCurrentUsageConditions db
|
||||
liftIO $ do
|
||||
now <- getCurrentTime
|
||||
latestAcceptedConds_ <- getLatestAcceptedConditions db
|
||||
let getConds op = (\ca -> op {conditionsAcceptance = ca}) <$> getOperatorConditions_ db op currentConds latestAcceptedConds_ now
|
||||
operators <- mapM getConds =<< getServerOperators_ db
|
||||
pure (operators, usageConditionsAction operators currentConds now)
|
||||
|
||||
getUserServers :: DB.Connection -> User -> ExceptT StoreError IO ([ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
|
||||
getUserServers db user =
|
||||
(,,)
|
||||
<$> (fst <$> getServerOperators db)
|
||||
<*> liftIO (getProtocolServers db SPSMP user)
|
||||
<*> liftIO (getProtocolServers db SPXFTP user)
|
||||
|
||||
setServerOperators :: DB.Connection -> NonEmpty ServerOperator -> IO ()
|
||||
setServerOperators db ops = do
|
||||
currentTs <- getCurrentTime
|
||||
mapM_ (updateServerOperator db currentTs) ops
|
||||
|
||||
updateServerOperator :: DB.Connection -> UTCTime -> ServerOperator -> IO ()
|
||||
updateServerOperator db currentTs ServerOperator {operatorId, enabled, roles = ServerRoles {storage, proxy}} =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE server_operators
|
||||
SET enabled = ?, role_storage = ?, role_proxy = ?, updated_at = ?
|
||||
WHERE server_operator_id = ?
|
||||
|]
|
||||
(enabled, storage, proxy, operatorId, currentTs)
|
||||
|
||||
getUpdateServerOperators :: DB.Connection -> NonEmpty PresetOperator -> Bool -> IO [ServerOperator]
|
||||
getUpdateServerOperators db presetOps newUser = do
|
||||
conds <- map toUsageConditions <$> DB.query_ db usageCondsQuery
|
||||
now <- getCurrentTime
|
||||
let (acceptForSimplex_, currentConds, condsToAdd) = usageConditionsToAdd newUser now conds
|
||||
mapM_ insertConditions condsToAdd
|
||||
latestAcceptedConds_ <- getLatestAcceptedConditions db
|
||||
ops <- updatedServerOperators presetOps <$> getServerOperators_ db
|
||||
forM ops $ \(ASO _ op) ->
|
||||
case operatorId op of
|
||||
DBNewEntity -> do
|
||||
op' <- insertOperator op
|
||||
case (operatorTag op', acceptForSimplex_) of
|
||||
(Just OTSimplex, Just cond) -> autoAcceptConditions op' cond
|
||||
_ -> pure op'
|
||||
DBEntityId _ -> do
|
||||
updateOperator op
|
||||
getOperatorConditions_ db op currentConds latestAcceptedConds_ now >>= \case
|
||||
CARequired Nothing | operatorTag op == Just OTSimplex -> autoAcceptConditions op currentConds
|
||||
CARequired (Just ts) | ts < now -> autoAcceptConditions op currentConds
|
||||
ca -> pure op {conditionsAcceptance = ca}
|
||||
where
|
||||
insertConditions UsageConditions {conditionsId, conditionsCommit, notifiedAt, createdAt} =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO usage_conditions
|
||||
(usage_conditions_id, conditions_commit, notified_at, created_at)
|
||||
VALUES (?,?,?,?)
|
||||
|]
|
||||
(conditionsId, conditionsCommit, notifiedAt, createdAt)
|
||||
updateOperator :: ServerOperator -> IO ()
|
||||
updateOperator ServerOperator {operatorId, tradeName, legalName, serverDomains, enabled, roles = ServerRoles {storage, proxy}} =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE server_operators
|
||||
SET trade_name = ?, legal_name = ?, server_domains = ?, enabled = ?, role_storage = ?, role_proxy = ?
|
||||
WHERE server_operator_id = ?
|
||||
|]
|
||||
(tradeName, legalName, T.intercalate "," serverDomains, enabled, storage, proxy, operatorId)
|
||||
insertOperator :: NewServerOperator -> IO ServerOperator
|
||||
insertOperator op@ServerOperator {operatorTag, tradeName, legalName, serverDomains, enabled, roles = ServerRoles {storage, proxy}} = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO server_operators
|
||||
(server_operator_tag, trade_name, legal_name, server_domains, enabled, role_storage, role_proxy)
|
||||
VALUES (?,?,?,?,?,?,?)
|
||||
|]
|
||||
(operatorTag, tradeName, legalName, T.intercalate "," serverDomains, enabled, storage, proxy)
|
||||
opId <- insertedRowId db
|
||||
pure op {operatorId = DBEntityId opId}
|
||||
autoAcceptConditions op UsageConditions {conditionsCommit} =
|
||||
acceptConditions_ db op conditionsCommit Nothing
|
||||
$> op {conditionsAcceptance = CAAccepted Nothing}
|
||||
|
||||
serverOperatorQuery :: Query
|
||||
serverOperatorQuery =
|
||||
[sql|
|
||||
SELECT server_operator_id, server_operator_tag, trade_name, legal_name,
|
||||
server_domains, enabled, role_storage, role_proxy
|
||||
FROM server_operators
|
||||
|]
|
||||
|
||||
getServerOperators_ :: DB.Connection -> IO [ServerOperator]
|
||||
getServerOperators_ db = map toServerOperator <$> DB.query_ db serverOperatorQuery
|
||||
|
||||
toServerOperator :: (DBEntityId, Maybe OperatorTag, Text, Maybe Text, Text, Bool, Bool, Bool) -> ServerOperator
|
||||
toServerOperator (operatorId, operatorTag, tradeName, legalName, domains, enabled, storage, proxy) =
|
||||
ServerOperator
|
||||
{ operatorId,
|
||||
operatorTag,
|
||||
tradeName,
|
||||
legalName,
|
||||
serverDomains = T.splitOn "," domains,
|
||||
conditionsAcceptance = CARequired Nothing,
|
||||
enabled,
|
||||
roles = ServerRoles {storage, proxy}
|
||||
}
|
||||
|
||||
getOperatorConditions_ :: DB.Connection -> ServerOperator -> UsageConditions -> Maybe UsageConditions -> UTCTime -> IO ConditionsAcceptance
|
||||
getOperatorConditions_ db ServerOperator {operatorId} UsageConditions {conditionsCommit = currentCommit, createdAt, notifiedAt} latestAcceptedConds_ now = do
|
||||
case latestAcceptedConds_ of
|
||||
Nothing -> pure $ CARequired Nothing -- no conditions accepted by any operator
|
||||
Just UsageConditions {conditionsCommit = latestAcceptedCommit} -> do
|
||||
operatorAcceptedConds_ <-
|
||||
maybeFirstRow id $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT conditions_commit, accepted_at
|
||||
FROM operator_usage_conditions
|
||||
WHERE server_operator_id = ?
|
||||
ORDER BY operator_usage_conditions_id DESC
|
||||
LIMIT 1
|
||||
|]
|
||||
(Only operatorId)
|
||||
pure $ case operatorAcceptedConds_ of
|
||||
Just (operatorCommit, acceptedAt_)
|
||||
| operatorCommit /= latestAcceptedCommit -> CARequired Nothing -- TODO should we consider this operator disabled?
|
||||
| currentCommit /= latestAcceptedCommit -> CARequired $ conditionsRequiredOrDeadline createdAt (fromMaybe now notifiedAt)
|
||||
| otherwise -> CAAccepted acceptedAt_
|
||||
_ -> CARequired Nothing -- no conditions were accepted for this operator
|
||||
|
||||
getCurrentUsageConditions :: DB.Connection -> ExceptT StoreError IO UsageConditions
|
||||
getCurrentUsageConditions db =
|
||||
ExceptT . firstRow toUsageConditions SEUsageConditionsNotFound $
|
||||
DB.query_ db (usageCondsQuery <> " DESC LIMIT 1")
|
||||
|
||||
usageCondsQuery :: Query
|
||||
usageCondsQuery =
|
||||
[sql|
|
||||
SELECT usage_conditions_id, conditions_commit, notified_at, created_at
|
||||
FROM usage_conditions
|
||||
ORDER BY usage_conditions_id
|
||||
|]
|
||||
|
||||
toUsageConditions :: (Int64, Text, Maybe UTCTime, UTCTime) -> UsageConditions
|
||||
toUsageConditions (conditionsId, conditionsCommit, notifiedAt, createdAt) =
|
||||
UsageConditions {conditionsId, conditionsCommit, notifiedAt, createdAt}
|
||||
|
||||
getLatestAcceptedConditions :: DB.Connection -> IO (Maybe UsageConditions)
|
||||
getLatestAcceptedConditions db =
|
||||
maybeFirstRow toUsageConditions $
|
||||
DB.query_
|
||||
db
|
||||
[sql|
|
||||
SELECT usage_conditions_id, conditions_commit, notified_at, created_at
|
||||
FROM usage_conditions
|
||||
WHERE conditions_commit = (
|
||||
SELECT conditions_commit
|
||||
FROM operator_usage_conditions
|
||||
ORDER BY accepted_at DESC
|
||||
LIMIT 1
|
||||
)
|
||||
|]
|
||||
|
||||
setConditionsNotified :: DB.Connection -> Int64 -> UTCTime -> IO ()
|
||||
setConditionsNotified db condId notifiedAt =
|
||||
DB.execute db "UPDATE usage_conditions SET notified_at = ? WHERE usage_conditions_id = ?" (notifiedAt, condId)
|
||||
|
||||
acceptConditions :: DB.Connection -> Int64 -> NonEmpty Int64 -> UTCTime -> ExceptT StoreError IO ()
|
||||
acceptConditions db condId opIds acceptedAt = do
|
||||
UsageConditions {conditionsCommit} <- getUsageConditionsById_ db condId
|
||||
operators <- mapM getServerOperator_ opIds
|
||||
let ts = Just acceptedAt
|
||||
liftIO $ forM_ operators $ \op -> acceptConditions_ db op conditionsCommit ts
|
||||
where
|
||||
getServerOperator_ opId =
|
||||
ExceptT $ firstRow toServerOperator (SEOperatorNotFound opId) $
|
||||
DB.query db (serverOperatorQuery <> " WHERE operator_id = ?") (Only opId)
|
||||
|
||||
acceptConditions_ :: DB.Connection -> ServerOperator -> Text -> Maybe UTCTime -> IO ()
|
||||
acceptConditions_ db ServerOperator {operatorId, operatorTag} conditionsCommit acceptedAt =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO operator_usage_conditions
|
||||
(server_operator_id, server_operator_tag, conditions_commit, accepted_at)
|
||||
VALUES (?,?,?,?)
|
||||
|]
|
||||
(operatorId, operatorTag, conditionsCommit, acceptedAt)
|
||||
|
||||
getUsageConditionsById_ :: DB.Connection -> Int64 -> ExceptT StoreError IO UsageConditions
|
||||
getUsageConditionsById_ db conditionsId =
|
||||
ExceptT . firstRow toUsageConditions SEUsageConditionsNotFound $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT usage_conditions_id, conditions_commit, notified_at, created_at
|
||||
FROM usage_conditions
|
||||
WHERE usage_conditions_id = ?
|
||||
|]
|
||||
(Only conditionsId)
|
||||
|
||||
setUserServers :: DB.Connection -> User -> NonEmpty UpdatedUserOperatorServers -> ExceptT StoreError IO ()
|
||||
setUserServers db user@User {userId} userServers = checkConstraint SEUniqueID $ liftIO $ do
|
||||
ts <- getCurrentTime
|
||||
forM_ userServers $ \UpdatedUserOperatorServers {operator, smpServers, xftpServers} -> do
|
||||
mapM_ (updateServerOperator db ts) operator
|
||||
mapM_ (upsertOrDelete SPSMP ts) smpServers
|
||||
mapM_ (upsertOrDelete SPXFTP ts) xftpServers
|
||||
where
|
||||
upsertOrDelete :: ProtocolTypeI p => SProtocolType p -> UTCTime -> AUserServer p -> IO ()
|
||||
upsertOrDelete p ts (AUS _ s@UserServer {serverId, deleted}) = case serverId of
|
||||
DBNewEntity -> void $ insertProtocolServer db p user ts s
|
||||
DBEntityId srvId
|
||||
| deleted -> DB.execute db "DELETE FROM protocol_servers WHERE user_id = ? AND smp_server_id = ? AND preset = ?" (userId, srvId, False)
|
||||
| otherwise -> updateProtocolServer db p ts s
|
||||
protocol = decodeLatin1 $ strEncode $ protocolTypeI @p
|
||||
|
||||
createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
|
||||
createCall db user@User {userId} Call {contactId, callId, callUUID, chatItemId, callState} callTs = do
|
||||
|
||||
@@ -127,8 +127,6 @@ data StoreError
|
||||
| SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
|
||||
| SERemoteCtrlDuplicateCA
|
||||
| SEProhibitedDeleteUser {userId :: UserId, contactId :: ContactId}
|
||||
| SEOperatorNotFound {serverOperatorId :: Int64}
|
||||
| SEUsageConditionsNotFound
|
||||
deriving (Show, Exception)
|
||||
|
||||
$(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
|
||||
|
||||
@@ -1,7 +1,6 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Simplex.Chat.Terminal where
|
||||
@@ -14,15 +13,15 @@ import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Database.SQLite.Simple (SQLError (..))
|
||||
import qualified Database.SQLite.Simple as DB
|
||||
import Simplex.Chat (_defaultNtfServers, defaultChatConfig, operatorSimpleXChat)
|
||||
import Simplex.Chat (defaultChatConfig)
|
||||
import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Core
|
||||
import Simplex.Chat.Help (chatWelcome)
|
||||
import Simplex.Chat.Operators
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Terminal.Input
|
||||
import Simplex.Chat.Terminal.Output
|
||||
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (presetServerCfg)
|
||||
import Simplex.Messaging.Client (NetworkConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig)
|
||||
import Simplex.Messaging.Util (raceAny_)
|
||||
import System.IO (hFlush, hSetEcho, stdin, stdout)
|
||||
@@ -30,24 +29,20 @@ import System.IO (hFlush, hSetEcho, stdin, stdout)
|
||||
terminalChatConfig :: ChatConfig
|
||||
terminalChatConfig =
|
||||
defaultChatConfig
|
||||
{ presetServers =
|
||||
PresetServers
|
||||
{ operators =
|
||||
[ PresetOperator
|
||||
{ operator = Just operatorSimpleXChat,
|
||||
smp =
|
||||
map
|
||||
(presetServer True)
|
||||
[ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
|
||||
"smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
|
||||
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
|
||||
],
|
||||
useSMP = 3,
|
||||
xftp = map (presetServer True) $ L.toList defaultXFTPServers,
|
||||
useXFTP = 3
|
||||
}
|
||||
],
|
||||
ntf = _defaultNtfServers,
|
||||
{ defaultServers =
|
||||
DefaultAgentServers
|
||||
{ smp =
|
||||
L.fromList $
|
||||
map
|
||||
(presetServerCfg True)
|
||||
[ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im,o5vmywmrnaxalvz6wi3zicyftgio6psuvyniis6gco6bp6ekl4cqj4id.onion",
|
||||
"smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im,jjbyvoemxysm7qxap7m5d5m35jzv5qq6gnlv7s4rsn7tdwwmuqciwpid.onion",
|
||||
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
|
||||
],
|
||||
useSMP = 3,
|
||||
ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion"],
|
||||
xftp = L.map (presetServerCfg True) defaultXFTPServers,
|
||||
useXFTP = L.length defaultXFTPServers,
|
||||
netCfg =
|
||||
defaultNetworkConfig
|
||||
{ smpProxyMode = SPMUnknown,
|
||||
|
||||
@@ -10,7 +10,7 @@ import Data.Maybe (fromMaybe)
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import Data.Time.LocalTime (getCurrentTimeZone)
|
||||
import Network.Socket
|
||||
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatResponse (..), PresetServers (..), SimpleNetCfg (..), currentRemoteHost, versionNumber, versionString)
|
||||
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatResponse (..), DefaultAgentServers (DefaultAgentServers, netCfg), SimpleNetCfg (..), currentRemoteHost, versionNumber, versionString)
|
||||
import Simplex.Chat.Core
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Terminal
|
||||
@@ -56,7 +56,7 @@ simplexChatCLI' cfg opts@ChatOpts {chatCmd, chatCmdLog, chatCmdDelay, chatServer
|
||||
putStrLn $ serializeChatResponse (rh, Just user) ts tz rh r
|
||||
|
||||
welcome :: ChatConfig -> ChatOpts -> IO ()
|
||||
welcome ChatConfig {presetServers = PresetServers {netCfg}} ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, simpleNetCfg = SimpleNetCfg {socksProxy, socksMode, smpProxyMode_, smpProxyFallback_}}} =
|
||||
welcome ChatConfig {defaultServers = DefaultAgentServers {netCfg}} ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, simpleNetCfg = SimpleNetCfg {socksProxy, socksMode, smpProxyMode_, smpProxyFallback_}}} =
|
||||
mapM_
|
||||
putStrLn
|
||||
[ versionString versionNumber,
|
||||
|
||||
+26
-37
@@ -53,7 +53,7 @@ import Simplex.Chat.Types.Shared
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import qualified Simplex.FileTransfer.Transport as XFTP
|
||||
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..), ServerCfg (..))
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
|
||||
import Simplex.Messaging.Client (SMPProxyFallback, SMPProxyMode (..), SocksMode (..))
|
||||
@@ -93,18 +93,10 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
CRChatSuspended -> ["chat suspended"]
|
||||
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]
|
||||
CRApiChat u chat lsec -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat] <> (["newer messages available" | lsec == CLSUnread])
|
||||
CRApiParsedMarkdown ft -> [viewJSON ft]
|
||||
-- CRUserProtoServers u userServers operators -> ttyUser u $ viewUserServers userServers operators testView
|
||||
CRUserProtoServers u userServers -> ttyUser u $ viewUserServers userServers testView
|
||||
CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
|
||||
CRTestOperator _ -> []
|
||||
CRTestUsageConditionsAction _ -> []
|
||||
CRTestConditionsAcceptance _ -> []
|
||||
CRTestServerRoles _ -> []
|
||||
CRServerOperators {} -> []
|
||||
CRUserServers {} -> []
|
||||
CRUserServersValidation _ -> []
|
||||
CRUsageConditions {} -> []
|
||||
CRChatItemTTL u ttl -> ttyUser u $ viewChatItemTTL ttl
|
||||
CRNetworkConfig cfg -> viewNetworkConfig cfg
|
||||
CRContactInfo u ct cStats customUserProfile -> ttyUser u $ viewContactInfo ct cStats customUserProfile
|
||||
@@ -1217,27 +1209,27 @@ viewUserPrivacy User {userId} User {userId = userId', localDisplayName = n', sho
|
||||
"profile is " <> if isJust viewPwdHash then "hidden" else "visible"
|
||||
]
|
||||
|
||||
-- viewUserServers :: AUserProtoServers -> [ServerOperator] -> Bool -> [StyledString]
|
||||
-- viewUserServers (AUPS UserProtoServers {serverProtocol = p, protoServers, presetServers}) operators testView =
|
||||
-- customServers
|
||||
-- <> if testView
|
||||
-- then []
|
||||
-- else
|
||||
-- [ "",
|
||||
-- "use " <> highlight (srvCmd <> " test <srv>") <> " to test " <> pName <> " server connection",
|
||||
-- "use " <> highlight (srvCmd <> " <srv1[,srv2,...]>") <> " to configure " <> pName <> " servers",
|
||||
-- "use " <> highlight (srvCmd <> " default") <> " to remove configured " <> pName <> " servers and use presets"
|
||||
-- ]
|
||||
-- <> case p of
|
||||
-- SPSMP -> ["(chat option " <> highlight' "-s" <> " (" <> highlight' "--server" <> ") has precedence over saved SMP servers for chat session)"]
|
||||
-- SPXFTP -> ["(chat option " <> highlight' "-xftp-servers" <> " has precedence over saved XFTP servers for chat session)"]
|
||||
-- where
|
||||
-- srvCmd = "/" <> strEncode p
|
||||
-- pName = protocolName p
|
||||
-- customServers =
|
||||
-- if null protoServers
|
||||
-- then ("no " <> pName <> " servers saved, using presets: ") : viewServers operators presetServers
|
||||
-- else viewServers operators protoServers
|
||||
viewUserServers :: AUserProtoServers -> Bool -> [StyledString]
|
||||
viewUserServers (AUPS UserProtoServers {serverProtocol = p, protoServers, presetServers}) testView =
|
||||
customServers
|
||||
<> if testView
|
||||
then []
|
||||
else
|
||||
[ "",
|
||||
"use " <> highlight (srvCmd <> " test <srv>") <> " to test " <> pName <> " server connection",
|
||||
"use " <> highlight (srvCmd <> " <srv1[,srv2,...]>") <> " to configure " <> pName <> " servers",
|
||||
"use " <> highlight (srvCmd <> " default") <> " to remove configured " <> pName <> " servers and use presets"
|
||||
]
|
||||
<> case p of
|
||||
SPSMP -> ["(chat option " <> highlight' "-s" <> " (" <> highlight' "--server" <> ") has precedence over saved SMP servers for chat session)"]
|
||||
SPXFTP -> ["(chat option " <> highlight' "-xftp-servers" <> " has precedence over saved XFTP servers for chat session)"]
|
||||
where
|
||||
srvCmd = "/" <> strEncode p
|
||||
pName = protocolName p
|
||||
customServers =
|
||||
if null protoServers
|
||||
then ("no " <> pName <> " servers saved, using presets: ") : viewServers presetServers
|
||||
else viewServers protoServers
|
||||
|
||||
protocolName :: ProtocolTypeI p => SProtocolType p -> StyledString
|
||||
protocolName = plain . map toUpper . T.unpack . decodeLatin1 . strEncode
|
||||
@@ -1334,11 +1326,8 @@ viewConnectionStats ConnectionStats {rcvQueuesInfo, sndQueuesInfo} =
|
||||
["receiving messages via: " <> viewRcvQueuesInfo rcvQueuesInfo | not $ null rcvQueuesInfo]
|
||||
<> ["sending messages via: " <> viewSndQueuesInfo sndQueuesInfo | not $ null sndQueuesInfo]
|
||||
|
||||
-- viewServers :: ProtocolTypeI p => [ServerOperator] -> NonEmpty (ServerCfg p) -> [StyledString]
|
||||
-- viewServers operators = map (plain . (\ServerCfg {server, operator} -> B.unpack (strEncode server) <> viewOperator operator)) . L.toList
|
||||
-- where
|
||||
-- ops :: Map (Maybe DBEntityId) Text = foldl' (\m ServerOperator {operatorId, tradeName} -> M.insert (Just operatorId) tradeName m) M.empty operators
|
||||
-- viewOperator = maybe "" $ \op -> " (operator " <> maybe (show op) T.unpack (M.lookup (Just op) ops) <> ")"
|
||||
viewServers :: ProtocolTypeI p => NonEmpty (ServerCfg p) -> [StyledString]
|
||||
viewServers = map (plain . B.unpack . strEncode . (\ServerCfg {server} -> server)) . L.toList
|
||||
|
||||
viewRcvQueuesInfo :: [RcvQueueInfo] -> StyledString
|
||||
viewRcvQueuesInfo = plain . intercalate ", " . map showQueueInfo
|
||||
|
||||
@@ -10,8 +10,7 @@ import ChatTests.Utils
|
||||
import Control.Concurrent (forkIO, killThread, threadDelay)
|
||||
import Control.Exception (finally)
|
||||
import Control.Monad (forM_)
|
||||
import qualified Data.Text as T
|
||||
import qualified Directory.Events as DE
|
||||
import Directory.Events (viewName)
|
||||
import Directory.Options
|
||||
import Directory.Service
|
||||
import Directory.Store
|
||||
@@ -28,7 +27,7 @@ import Test.Hspec hiding (it)
|
||||
directoryServiceTests :: SpecWith FilePath
|
||||
directoryServiceTests = do
|
||||
it "should register group" testDirectoryService
|
||||
it "should suspend and resume group, send message to owner" testSuspendResume
|
||||
it "should suspend and resume group" testSuspendResume
|
||||
it "should delete group registration" testDeleteGroup
|
||||
it "should change initial member role" testSetRole
|
||||
it "should join found group via link" testJoinGroup
|
||||
@@ -68,7 +67,6 @@ mkDirectoryOpts :: FilePath -> [KnownContact] -> DirectoryOpts
|
||||
mkDirectoryOpts tmp superUsers =
|
||||
DirectoryOpts
|
||||
{ coreOptions = testCoreOpts {dbFilePrefix = tmp </> serviceDbPrefix},
|
||||
adminUsers = [],
|
||||
superUsers,
|
||||
directoryLog = Just $ tmp </> "directory_service.log",
|
||||
serviceName = "SimpleX-Directory",
|
||||
@@ -79,9 +77,6 @@ mkDirectoryOpts tmp superUsers =
|
||||
serviceDbPrefix :: FilePath
|
||||
serviceDbPrefix = "directory_service"
|
||||
|
||||
viewName :: String -> String
|
||||
viewName = T.unpack . DE.viewName . T.pack
|
||||
|
||||
testDirectoryService :: HasCallStack => FilePath -> IO ()
|
||||
testDirectoryService tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
@@ -116,7 +111,7 @@ testDirectoryService tmp =
|
||||
-- putStrLn "*** update profile so that it has link"
|
||||
updateGroupProfile bob welcomeWithLink
|
||||
bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (PSA) is added to the welcome message."
|
||||
bob <## "You will be notified once the group is added to the directory - it may take up to 48 hours."
|
||||
bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
|
||||
approvalRequested superUser welcomeWithLink (1 :: Int)
|
||||
-- putStrLn "*** update profile so that it still has link"
|
||||
let welcomeWithLink' = "Welcome! " <> welcomeWithLink
|
||||
@@ -144,7 +139,7 @@ testDirectoryService tmp =
|
||||
-- putStrLn "*** update profile so that it has link again"
|
||||
updateGroupProfile bob welcomeWithLink'
|
||||
bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (PSA) is added to the welcome message."
|
||||
bob <## "You will be notified once the group is added to the directory - it may take up to 48 hours."
|
||||
bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
|
||||
approvalRequested superUser welcomeWithLink' (1 :: Int)
|
||||
superUser #> "@SimpleX-Directory /pending"
|
||||
superUser <# "SimpleX-Directory> > /pending"
|
||||
@@ -212,17 +207,6 @@ testSuspendResume tmp =
|
||||
superUser <## " Group listing resumed!"
|
||||
bob <# "SimpleX-Directory> The group ID 1 (privacy) is listed in the directory again!"
|
||||
groupFound bob "privacy"
|
||||
superUser #> "@SimpleX-Directory privacy"
|
||||
groupFoundN_ (Just 1) 2 superUser "privacy"
|
||||
superUser #> "@SimpleX-Directory /link 1:privacy"
|
||||
superUser <# "SimpleX-Directory> > /link 1:privacy"
|
||||
superUser <## " The link to join the group ID 1 (privacy):"
|
||||
superUser <##. "https://simplex.chat/contact"
|
||||
superUser <## "New member role: member"
|
||||
superUser #> "@SimpleX-Directory /owner 1:privacy hello there"
|
||||
superUser <# "SimpleX-Directory> > /owner 1:privacy hello there"
|
||||
superUser <## " Forwarded to @bob, the owner of the group ID 1 (privacy)"
|
||||
bob <# "SimpleX-Directory> hello there"
|
||||
|
||||
testDeleteGroup :: HasCallStack => FilePath -> IO ()
|
||||
testDeleteGroup tmp =
|
||||
@@ -666,7 +650,7 @@ testRegOwnerRemovedLink tmp =
|
||||
bob <## "description changed to:"
|
||||
bob <## welcomeWithLink
|
||||
bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
|
||||
bob <## "You will be notified once the group is added to the directory - it may take up to 48 hours."
|
||||
bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
|
||||
cath <## "bob updated group #privacy:"
|
||||
cath <## "description changed to:"
|
||||
cath <## welcomeWithLink
|
||||
@@ -708,7 +692,7 @@ testAnotherOwnerRemovedLink tmp =
|
||||
bob <## "description changed to:"
|
||||
bob <## (welcomeWithLink <> " - welcome!")
|
||||
bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
|
||||
bob <## "You will be notified once the group is added to the directory - it may take up to 48 hours."
|
||||
bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
|
||||
cath <## "bob updated group #privacy:"
|
||||
cath <## "description changed to:"
|
||||
cath <## (welcomeWithLink <> " - welcome!")
|
||||
@@ -790,7 +774,7 @@ testDuplicateProhibitWhenUpdated tmp =
|
||||
cath ##> "/gp privacy security Security"
|
||||
cath <## "changed to #security (Security)"
|
||||
cath <# "SimpleX-Directory> Thank you! The group link for ID 2 (security) is added to the welcome message."
|
||||
cath <## "You will be notified once the group is added to the directory - it may take up to 48 hours."
|
||||
cath <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
|
||||
notifySuperUser superUser cath "security" "Security" welcomeWithLink' 2
|
||||
approveRegistration superUser cath "security" 2
|
||||
groupFound bob "security"
|
||||
@@ -1051,7 +1035,7 @@ updateProfileWithLink u n welcomeWithLink ugId = do
|
||||
u <## "description changed to:"
|
||||
u <## welcomeWithLink
|
||||
u <# ("SimpleX-Directory> Thank you! The group link for ID " <> show ugId <> " (" <> n <> ") is added to the welcome message.")
|
||||
u <## "You will be notified once the group is added to the directory - it may take up to 48 hours."
|
||||
u <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
|
||||
|
||||
notifySuperUser :: TestCC -> TestCC -> String -> String -> String -> Int -> IO ()
|
||||
notifySuperUser su u n fn welcomeWithLink gId = do
|
||||
@@ -1128,13 +1112,10 @@ groupFoundN count u name = do
|
||||
groupFoundN' count u name
|
||||
|
||||
groupFoundN' :: Int -> TestCC -> String -> IO ()
|
||||
groupFoundN' = groupFoundN_ Nothing
|
||||
|
||||
groupFoundN_ :: Maybe Int -> Int -> TestCC -> String -> IO ()
|
||||
groupFoundN_ shownId_ count u name = do
|
||||
groupFoundN' count u name = do
|
||||
u <# ("SimpleX-Directory> > " <> name)
|
||||
u <## " Found 1 group(s)."
|
||||
u <#. ("SimpleX-Directory> " <> maybe "" (\gId -> show gId <> ". ") shownId_ <> name)
|
||||
u <#. ("SimpleX-Directory> " <> name)
|
||||
u <## "Welcome message:"
|
||||
u <##. "Link to join the group "
|
||||
u <## (show count <> " members")
|
||||
|
||||
+4
-20
@@ -25,10 +25,9 @@ import Data.Maybe (isNothing)
|
||||
import qualified Data.Text as T
|
||||
import Network.Socket
|
||||
import Simplex.Chat
|
||||
import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..), PresetServers (..), defaultSimpleNetCfg)
|
||||
import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), ChatController (..), ChatDatabase (..), ChatLogLevel (..), defaultSimpleNetCfg)
|
||||
import Simplex.Chat.Core
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Operators (PresetOperator (..), presetServer)
|
||||
import Simplex.Chat.Protocol (currentChatVersion, pqEncryptionCompressionVersion)
|
||||
import Simplex.Chat.Store
|
||||
import Simplex.Chat.Store.Profiles
|
||||
@@ -52,7 +51,6 @@ import qualified Simplex.Messaging.Crypto.Ratchet as CR
|
||||
import Simplex.Messaging.Protocol (srvHostnamesSMPClientVersion)
|
||||
import Simplex.Messaging.Server (runSMPServerBlocking)
|
||||
import Simplex.Messaging.Server.Env.STM
|
||||
import Simplex.Messaging.Server.MsgStore.Types (AMSType (..), SMSType (..))
|
||||
import Simplex.Messaging.Transport
|
||||
import Simplex.Messaging.Transport.Server (ServerCredentials (..), defaultTransportServerConfig)
|
||||
import Simplex.Messaging.Version
|
||||
@@ -95,8 +93,8 @@ testCoreOpts =
|
||||
{ dbFilePrefix = "./simplex_v1",
|
||||
dbKey = "",
|
||||
-- dbKey = "this is a pass-phrase to encrypt the database",
|
||||
smpServers = [],
|
||||
xftpServers = [],
|
||||
smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"],
|
||||
xftpServers = ["xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002"],
|
||||
simpleNetCfg = defaultSimpleNetCfg,
|
||||
logLevel = CLLImportant,
|
||||
logConnections = False,
|
||||
@@ -150,18 +148,6 @@ testCfg :: ChatConfig
|
||||
testCfg =
|
||||
defaultChatConfig
|
||||
{ agentConfig = testAgentCfg,
|
||||
presetServers =
|
||||
(presetServers defaultChatConfig)
|
||||
{ operators =
|
||||
[ PresetOperator
|
||||
{ operator = Just operatorSimpleXChat,
|
||||
smp = map (presetServer True) ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"],
|
||||
useSMP = 1,
|
||||
xftp = map (presetServer True) ["xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002"],
|
||||
useXFTP = 1
|
||||
}
|
||||
]
|
||||
},
|
||||
showReceipts = False,
|
||||
testView = True,
|
||||
tbqSize = 16
|
||||
@@ -436,10 +422,8 @@ smpServerCfg =
|
||||
ServerConfig
|
||||
{ transports = [(serverPort, transport @TLS, False)],
|
||||
tbqSize = 1,
|
||||
msgStoreType = AMSType SMSMemory,
|
||||
-- serverTbqSize = 1,
|
||||
msgQueueQuota = 16,
|
||||
maxJournalMsgCount = 24,
|
||||
maxJournalStateLines = 4,
|
||||
queueIdBytes = 12,
|
||||
msgIdBytes = 6,
|
||||
storeLogFile = Nothing,
|
||||
|
||||
+18
-11
@@ -25,7 +25,7 @@ import Database.SQLite.Simple (Only (..))
|
||||
import Simplex.Chat.AppSettings (defaultAppSettings)
|
||||
import qualified Simplex.Chat.AppSettings as AS
|
||||
import Simplex.Chat.Call
|
||||
import Simplex.Chat.Controller (ChatConfig (..), PresetServers (..))
|
||||
import Simplex.Chat.Controller (ChatConfig (..), DefaultAgentServers (..))
|
||||
import Simplex.Chat.Messages (ChatItemId)
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Protocol (supportedChatVRange)
|
||||
@@ -210,6 +210,7 @@ testAddContact = versionTestMatrix2 runTestAddContact
|
||||
-- pagination
|
||||
alice #$> ("/_get chat @2 after=" <> itemId 1 <> " count=100", chat, [(0, "hello there"), (0, "how are you?")])
|
||||
alice #$> ("/_get chat @2 before=" <> itemId 2 <> " count=100", chat, features <> [(1, "hello there 🙂")])
|
||||
alice #$> ("/_get chat @2 around=" <> itemId 2 <> " count=3", chat, [(1, "hello there 🙂"), (0, "hello there"), (0, "how are you?")])
|
||||
-- search
|
||||
alice #$> ("/_get chat @2 count=100 search=ello ther", chat, [(1, "hello there 🙂"), (0, "hello there")])
|
||||
-- read messages
|
||||
@@ -332,8 +333,8 @@ testRetryConnectingClientTimeout tmp = do
|
||||
{ quotaExceededTimeout = 1,
|
||||
messageRetryInterval = RetryInterval2 {riFast = fastRetryInterval, riSlow = fastRetryInterval}
|
||||
},
|
||||
presetServers =
|
||||
let def@PresetServers {netCfg} = presetServers testCfg
|
||||
defaultServers =
|
||||
let def@DefaultAgentServers {netCfg} = defaultServers testCfg
|
||||
in def {netCfg = (netCfg :: NetworkConfig) {tcpTimeout = 10}}
|
||||
}
|
||||
opts' =
|
||||
@@ -791,7 +792,7 @@ testDirectMessageDelete =
|
||||
alice @@@ [("@bob", lastChatFeature)]
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures)
|
||||
|
||||
-- alice: msg id 1
|
||||
-- alice: msg id 3
|
||||
bob ##> ("/_update item @2 " <> itemId 2 <> " text hey alice")
|
||||
bob <# "@alice [edited] > hello 🙂"
|
||||
bob <## " hey alice"
|
||||
@@ -806,12 +807,12 @@ testDirectMessageDelete =
|
||||
alice @@@ [("@bob", "hey alice [marked deleted]")]
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "hey alice [marked deleted]")])
|
||||
|
||||
-- alice: deletes msg id 1 that was broadcast deleted by bob
|
||||
alice #$> ("/_delete item @2 " <> itemId 1 <> " internal", id, "message deleted")
|
||||
-- alice: deletes msg id 3 that was broadcast deleted by bob
|
||||
alice #$> ("/_delete item @2 " <> itemId 3 <> " internal", id, "message deleted")
|
||||
alice @@@ [("@bob", lastChatFeature)]
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures)
|
||||
|
||||
-- alice: msg id 1, bob: msg id 3 (quoting message alice deleted locally)
|
||||
-- alice: msg id 4, bob: msg id 3 (quoting message alice deleted locally)
|
||||
bob `send` "> @alice (hello 🙂) do you receive my messages?"
|
||||
bob <# "@alice > hello 🙂"
|
||||
bob <## " do you receive my messages?"
|
||||
@@ -819,14 +820,14 @@ testDirectMessageDelete =
|
||||
alice <## " do you receive my messages?"
|
||||
alice @@@ [("@bob", "do you receive my messages?")]
|
||||
alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "do you receive my messages?"), Just (1, "hello 🙂"))])
|
||||
alice #$> ("/_delete item @2 " <> itemId 1 <> " broadcast", id, "cannot delete this item")
|
||||
alice #$> ("/_delete item @2 " <> itemId 4 <> " broadcast", id, "cannot delete this item")
|
||||
|
||||
-- alice: msg id 2, bob: msg id 4
|
||||
-- alice: msg id 5, bob: msg id 4
|
||||
bob #> "@alice how are you?"
|
||||
alice <# "bob> how are you?"
|
||||
|
||||
-- alice: deletes msg id 2
|
||||
alice #$> ("/_delete item @2 " <> itemId 2 <> " internal", id, "message deleted")
|
||||
-- alice: deletes msg id 5
|
||||
alice #$> ("/_delete item @2 " <> itemId 5 <> " internal", id, "message deleted")
|
||||
|
||||
-- bob: marks deleted msg id 4 (that alice deleted locally)
|
||||
bob #$> ("/_delete item @2 " <> itemId 4 <> " broadcast", id, "message marked deleted")
|
||||
@@ -2340,6 +2341,12 @@ testUserPrivacy =
|
||||
"bob> Voice messages: enabled",
|
||||
"bob> Audio/video calls: enabled"
|
||||
]
|
||||
alice ##> "/_get items around=11 count=3"
|
||||
alice
|
||||
<##? [ "bob> Message reactions: enabled",
|
||||
"bob> Voice messages: enabled",
|
||||
"bob> Audio/video calls: enabled"
|
||||
]
|
||||
alice ##> "/_get items after=12 count=10"
|
||||
alice
|
||||
<##? [ "@bob hello",
|
||||
|
||||
@@ -1,10 +1,8 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PostfixOperators #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
||||
|
||||
module ChatTests.Groups where
|
||||
|
||||
@@ -346,6 +344,7 @@ testGroupShared alice bob cath checkMessages directConnections = do
|
||||
-- so we take into account group event items as well as sent group invitations in direct chats
|
||||
alice #$> ("/_get chat #1 after=" <> msgItem1 <> " count=100", chat, [(0, "hi there"), (0, "hey team")])
|
||||
alice #$> ("/_get chat #1 before=" <> msgItem2 <> " count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there")])
|
||||
alice #$> ("/_get chat #1 around=" <> msgItem2 <> " count=6", chat, [(0, "connected"), (1, "hello"), (0, "hi there"), (0, "hey team")]) -- expecting only 4 items since there is only 1 item after
|
||||
alice #$> ("/_get chat #1 count=100 search=team", chat, [(0, "hey team")])
|
||||
bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")]
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")])
|
||||
|
||||
@@ -51,7 +51,7 @@ testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
alice ##> "/chats"
|
||||
|
||||
alice /* "ahoy!"
|
||||
alice ##> "/_update item *1 1 text Greetings."
|
||||
alice ##> "/_update item *1 2 text Greetings."
|
||||
alice ##> "/tail *"
|
||||
alice <# "* Greetings."
|
||||
|
||||
@@ -102,6 +102,10 @@ testChatPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
|
||||
alice #$> ("/_get chat *1 count=100", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock"), (1, "who's there?")])
|
||||
alice #$> ("/_get chat *1 count=1", chat, [(1, "who's there?")])
|
||||
alice #$> ("/_get chat *1 around=2 count=1", chat, [(1, "memento mori")])
|
||||
alice #$> ("/_get chat *1 around=2 count=3", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock")])
|
||||
alice #$> ("/_get chat *1 around=3 count=10", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock"), (1, "who's there?")])
|
||||
alice #$> ("/_get chat *1 around=4 count=3", chat, [(1, "knock-knock"), (1, "who's there?")])
|
||||
alice #$> ("/_get chat *1 after=2 count=10", chat, [(1, "knock-knock"), (1, "who's there?")])
|
||||
alice #$> ("/_get chat *1 after=2 count=2", chat, [(1, "knock-knock"), (1, "who's there?")])
|
||||
alice #$> ("/_get chat *1 after=1 count=2", chat, [(1, "memento mori"), (1, "knock-knock")])
|
||||
|
||||
@@ -2,7 +2,6 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PostfixOperators #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
||||
|
||||
module ChatTests.Profiles where
|
||||
|
||||
|
||||
+20
-33
@@ -1,64 +1,51 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
||||
|
||||
module RandomServers where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import Data.Foldable (foldMap')
|
||||
import Data.List (sortOn)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Monoid (Sum (..))
|
||||
import Simplex.Chat (defaultChatConfig, randomPresetServers)
|
||||
import Simplex.Chat.Controller (ChatConfig (..), PresetServers (..))
|
||||
import Simplex.Chat.Operators (DBEntityId' (..), NewUserServer, UserServer' (..), operatorServers, operatorServersToUse)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..))
|
||||
import Simplex.Chat (cfgServers, cfgServersToUse, defaultChatConfig, randomServers)
|
||||
import Simplex.Chat.Controller (ChatConfig (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..))
|
||||
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), SProtocolType (..), UserProtocol)
|
||||
import Test.Hspec
|
||||
|
||||
randomServersTests :: Spec
|
||||
randomServersTests = describe "choosig random servers" $ do
|
||||
it "should choose 4 + 3 random SMP servers and keep the rest disabled" testRandomSMPServers
|
||||
it "should choose 3 + 3 random XFTP servers and keep the rest disabled" testRandomXFTPServers
|
||||
it "should choose 4 random SMP servers and keep the rest disabled" testRandomSMPServers
|
||||
it "should keep all 6 XFTP servers" testRandomXFTPServers
|
||||
|
||||
deriving instance Eq ServerRoles
|
||||
|
||||
deriving instance Eq (DBEntityId' s)
|
||||
|
||||
deriving instance Eq (UserServer' s p)
|
||||
deriving instance Eq (ServerCfg p)
|
||||
|
||||
testRandomSMPServers :: IO ()
|
||||
testRandomSMPServers = do
|
||||
[srvs1, srvs2, srvs3] <-
|
||||
replicateM 3 $
|
||||
checkEnabled SPSMP 7 False =<< randomPresetServers SPSMP (presetServers defaultChatConfig)
|
||||
checkEnabled SPSMP 4 False =<< randomServers SPSMP defaultChatConfig
|
||||
(srvs1 == srvs2 && srvs2 == srvs3) `shouldBe` False -- && to avoid rare failures
|
||||
|
||||
testRandomXFTPServers :: IO ()
|
||||
testRandomXFTPServers = do
|
||||
[srvs1, srvs2, srvs3] <-
|
||||
replicateM 3 $
|
||||
checkEnabled SPXFTP 6 False =<< randomPresetServers SPXFTP (presetServers defaultChatConfig)
|
||||
(srvs1 == srvs2 && srvs2 == srvs3) `shouldBe` False -- && to avoid rare failures
|
||||
checkEnabled SPXFTP 6 True =<< randomServers SPXFTP defaultChatConfig
|
||||
(srvs1 == srvs2 && srvs2 == srvs3) `shouldBe` True
|
||||
|
||||
checkEnabled :: UserProtocol p => SProtocolType p -> Int -> Bool -> NonEmpty (NewUserServer p) -> IO [NewUserServer p]
|
||||
checkEnabled p n allUsed srvs = do
|
||||
let srvs' = sortOn server' $ L.toList srvs
|
||||
PresetServers {operators = presetOps} = presetServers defaultChatConfig
|
||||
presetSrvs = sortOn server' $ concatMap (operatorServers p) presetOps
|
||||
Sum toUse = foldMap' (Sum . operatorServersToUse p) presetOps
|
||||
srvs' == presetSrvs `shouldBe` allUsed
|
||||
map enable srvs' `shouldBe` map enable presetSrvs
|
||||
let enbldSrvs = filter (\UserServer {enabled} -> enabled) srvs'
|
||||
checkEnabled :: UserProtocol p => SProtocolType p -> Int -> Bool -> (L.NonEmpty (ServerCfg p), [ServerCfg p]) -> IO [ServerCfg p]
|
||||
checkEnabled p n allUsed (srvs, _) = do
|
||||
let def = defaultServers defaultChatConfig
|
||||
cfgSrvs = L.sortWith server' $ cfgServers p def
|
||||
toUse = cfgServersToUse p def
|
||||
srvs == cfgSrvs `shouldBe` allUsed
|
||||
L.map enable srvs `shouldBe` L.map enable cfgSrvs
|
||||
let enbldSrvs = L.filter (\ServerCfg {enabled} -> enabled) srvs
|
||||
toUse `shouldBe` n
|
||||
length enbldSrvs `shouldBe` n
|
||||
pure enbldSrvs
|
||||
where
|
||||
server' UserServer {server = ProtoServerWithAuth srv _} = srv
|
||||
enable :: forall p. NewUserServer p -> NewUserServer p
|
||||
enable srv = (srv :: NewUserServer p) {enabled = False}
|
||||
server' ServerCfg {server = ProtoServerWithAuth srv _} = srv
|
||||
enable :: forall p. ServerCfg p -> ServerCfg p
|
||||
enable srv = (srv :: ServerCfg p) {enabled = False}
|
||||
|
||||
+3
-1
@@ -102,7 +102,9 @@ skipComparisonForDownMigrations =
|
||||
-- table and indexes move down to the end of the file
|
||||
"20231215_recreate_msg_deliveries",
|
||||
-- on down migration idx_msg_deliveries_agent_ack_cmd_id index moves down to the end of the file
|
||||
"20240313_drop_agent_ack_cmd_id"
|
||||
"20240313_drop_agent_ack_cmd_id",
|
||||
-- on down migration chat_item_autoincrement_id makes sequence table creation move down on the file
|
||||
"20241023_chat_item_autoincrement_id"
|
||||
]
|
||||
|
||||
getSchema :: FilePath -> FilePath -> IO String
|
||||
|
||||
Reference in New Issue
Block a user