IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: multiple users api (#1679)

Browse Source 
* api

* UCR

* Revert "UCR"

This reverts commit 1f98d25192.

* comment

* events User

* events in api User

* CRActiveUser in APISetActiveUser

* process message with/without connection

* refactor

* mute error

* user in api responses

* name

* lost response

* user in CRChatCmdError

* compiles

* user in CRChatError

* -- UserId

* mute unused warning

* catch in withUser

* remove comment

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
JRoberts 2023-01-04 21:06:28 +04:00 committed by GitHub
parent f68d8fd97c
commit fa9e0086f6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 602 additions and 490 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt
View File

@ -1611,7 +1611,7 @@ sealed class CC {
val cmdString: String get() = when (this) { val cmdString: String get() = when (this) {
is Console -> cmd is Console -> cmd
is ShowActiveUser -> "/u" is ShowActiveUser -> "/u"
is CreateActiveUser -> "/u ${profile.displayName} ${profile.fullName}" is CreateActiveUser -> "/create user ${profile.displayName} ${profile.fullName}"
is StartChat -> "/_start subscribe=on expire=${onOff(expire)}" is StartChat -> "/_start subscribe=on expire=${onOff(expire)}"
is ApiStopChat -> "/_stop" is ApiStopChat -> "/_stop"
is SetFilesFolder -> "/_files_folder $filesFolder" is SetFilesFolder -> "/_files_folder $filesFolder"

2
apps/ios/SimpleXChat/APITypes.swift
View File

@ -95,7 +95,7 @@ public enum ChatCommand {
get { get {
switch self { switch self {
case .showActiveUser: return "/u" case .showActiveUser: return "/u"
case let .createActiveUser(profile): return "/u \(profile.displayName) \(profile.fullName)" case let .createActiveUser(profile): return "/create user \(profile.displayName) \(profile.fullName)"
case let .startChat(subscribe, expire): return "/_start subscribe=\(onOff(subscribe)) expire=\(onOff(expire))" case let .startChat(subscribe, expire): return "/_start subscribe=\(onOff(subscribe)) expire=\(onOff(expire))"
case .apiStopChat: return "/_stop" case .apiStopChat: return "/_stop"
case .apiActivateChat: return "/_app activate" case .apiActivateChat: return "/_app activate"

2
packages/simplex-chat-client/typescript/src/command.ts
View File

@ -450,7 +450,7 @@ export function cmdString(cmd: ChatCommand): string {
case "showActiveUser": case "showActiveUser":
return "/u" return "/u"
case "createActiveUser": case "createActiveUser":
return `/u ${JSON.stringify(cmd.profile)}` return `/create user ${JSON.stringify(cmd.profile)}`
case "startChat": case "startChat":
return `/_start subscribe=${cmd.subscribeConnections ? "on" : "off"} expire=${cmd.expireChatItems ? "on" : "off"}` return `/_start subscribe=${cmd.subscribeConnections ? "on" : "off"} expire=${cmd.expireChatItems ? "on" : "off"}`
case "apiStopChat": case "apiStopChat":

542
src/Simplex/Chat.hs
View File

File diff suppressed because it is too large Load Diff

10
src/Simplex/Chat/Bot.hs
View File

@ -24,10 +24,10 @@ chatBotRepl welcome answer _user cc = do
race_ (forever $ void getLine) . forever $ do race_ (forever $ void getLine) . forever $ do
(_, resp) <- atomically . readTBQueue $ outputQ cc (_, resp) <- atomically . readTBQueue $ outputQ cc
case resp of case resp of
CRContactConnected contact _ -> do CRContactConnected _ contact _ -> do
contactConnected contact contactConnected contact
void $ sendMsg contact welcome void $ sendMsg contact welcome
CRNewChatItem (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content}) -> do CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content}) -> do
let msg = T.unpack $ ciContentToText content let msg = T.unpack $ ciContentToText content
void . sendMsg contact $ answer msg void . sendMsg contact $ answer msg
_ -> pure () _ -> pure ()
@ -38,11 +38,11 @@ chatBotRepl welcome answer _user cc = do
initializeBotAddress :: ChatController -> IO () initializeBotAddress :: ChatController -> IO ()
initializeBotAddress cc = do initializeBotAddress cc = do
sendChatCmd cc "/show_address" >>= \case sendChatCmd cc "/show_address" >>= \case
CRUserContactLink UserContactLink {connReqContact} -> showBotAddress connReqContact CRUserContactLink _ UserContactLink {connReqContact} -> showBotAddress connReqContact
CRChatCmdError (ChatErrorStore SEUserContactLinkNotFound) -> do CRChatCmdError _ (ChatErrorStore SEUserContactLinkNotFound) -> do
putStrLn "No bot address, creating..." putStrLn "No bot address, creating..."
sendChatCmd cc "/address" >>= \case sendChatCmd cc "/address" >>= \case
CRUserContactLinkCreated uri -> showBotAddress uri CRUserContactLinkCreated _ uri -> showBotAddress uri
_ -> putStrLn "can't create bot address" >> exitFailure _ -> putStrLn "can't create bot address" >> exitFailure
_ -> putStrLn "unexpected response" >> exitFailure _ -> putStrLn "unexpected response" >> exitFailure
where where

263
src/Simplex/Chat/Controller.hs
View File

@ -140,6 +140,11 @@ instance ToJSON HelpSection where
data ChatCommand data ChatCommand
= ShowActiveUser = ShowActiveUser
| CreateActiveUser Profile | CreateActiveUser Profile
| ListUsers
| APISetActiveUser UserId
| SetActiveUser UserName
| APIDeleteUser UserId
| DeleteUser UserName
| StartChat {subscribeConnections :: Bool, enableExpireChatItems :: Bool} | StartChat {subscribeConnections :: Bool, enableExpireChatItems :: Bool}
| APIStopChat | APIStopChat
| APIActivateChat | APIActivateChat
@ -153,7 +158,7 @@ data ChatCommand
| APIStorageEncryption DBEncryptionConfig | APIStorageEncryption DBEncryptionConfig
| ExecChatStoreSQL Text | ExecChatStoreSQL Text
| ExecAgentStoreSQL Text | ExecAgentStoreSQL Text
| APIGetChats {pendingConnections :: Bool} | APIGetChats {pendingConnections :: Bool} -- UserId
| APIGetChat ChatRef ChatPagination (Maybe String) | APIGetChat ChatRef ChatPagination (Maybe String)
| APIGetChatItems Int | APIGetChatItems Int
| APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, composedMessage :: ComposedMessage} | APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, composedMessage :: ComposedMessage}
@ -172,9 +177,9 @@ data ChatCommand
| APISendCallAnswer ContactId WebRTCSession | APISendCallAnswer ContactId WebRTCSession
| APISendCallExtraInfo ContactId WebRTCExtraInfo | APISendCallExtraInfo ContactId WebRTCExtraInfo
| APIEndCall ContactId | APIEndCall ContactId
| APIGetCallInvitations | APIGetCallInvitations -- UserId
| APICallStatus ContactId WebRTCCallStatus | APICallStatus ContactId WebRTCCallStatus
| APIUpdateProfile Profile | APIUpdateProfile Profile -- UserId
| APISetContactPrefs ContactId Preferences | APISetContactPrefs ContactId Preferences
| APISetContactAlias ContactId LocalAlias | APISetContactAlias ContactId LocalAlias
| APISetConnectionAlias Int64 LocalAlias | APISetConnectionAlias Int64 LocalAlias
@ -183,7 +188,7 @@ data ChatCommand
| APIRegisterToken DeviceToken NotificationsMode | APIRegisterToken DeviceToken NotificationsMode
| APIVerifyToken DeviceToken C.CbNonce ByteString | APIVerifyToken DeviceToken C.CbNonce ByteString
| APIDeleteToken DeviceToken | APIDeleteToken DeviceToken
| APIGetNtfMessage {nonce :: C.CbNonce, encNtfInfo :: ByteString} | APIGetNtfMessage {nonce :: C.CbNonce, encNtfInfo :: ByteString} -- UserId
| APIAddMember GroupId ContactId GroupMemberRole | APIAddMember GroupId ContactId GroupMemberRole
| APIJoinGroup GroupId | APIJoinGroup GroupId
| APIMemberRole GroupId GroupMemberId GroupMemberRole | APIMemberRole GroupId GroupMemberId GroupMemberRole
@ -194,11 +199,11 @@ data ChatCommand
| APICreateGroupLink GroupId | APICreateGroupLink GroupId
| APIDeleteGroupLink GroupId | APIDeleteGroupLink GroupId
| APIGetGroupLink GroupId | APIGetGroupLink GroupId
| GetUserSMPServers | GetUserSMPServers -- UserId
| SetUserSMPServers SMPServersConfig | SetUserSMPServers SMPServersConfig -- UserId
| TestSMPServer SMPServerWithAuth | TestSMPServer SMPServerWithAuth
| APISetChatItemTTL (Maybe Int64) | APISetChatItemTTL (Maybe Int64) -- UserId
| APIGetChatItemTTL | APIGetChatItemTTL -- UserId
| APISetNetworkConfig NetworkConfig | APISetNetworkConfig NetworkConfig
| APIGetNetworkConfig | APIGetNetworkConfig
| APISetChatSettings ChatRef ChatSettings | APISetChatSettings ChatRef ChatSettings
@ -221,26 +226,26 @@ data ChatCommand
| VerifyGroupMember GroupName ContactName (Maybe Text) | VerifyGroupMember GroupName ContactName (Maybe Text)
| ChatHelp HelpSection | ChatHelp HelpSection
| Welcome | Welcome
| AddContact | AddContact -- UserId
| Connect (Maybe AConnectionRequestUri) | Connect (Maybe AConnectionRequestUri) -- UserId
| ConnectSimplex | ConnectSimplex -- UserId
| DeleteContact ContactName | DeleteContact ContactName
| ClearContact ContactName | ClearContact ContactName
| ListContacts | ListContacts -- UserId
| CreateMyAddress | CreateMyAddress -- UserId
| DeleteMyAddress | DeleteMyAddress -- UserId
| ShowMyAddress | ShowMyAddress -- UserId
| AddressAutoAccept (Maybe AutoAccept) | AddressAutoAccept (Maybe AutoAccept) -- UserId
| AcceptContact ContactName | AcceptContact ContactName
| RejectContact ContactName | RejectContact ContactName
| SendMessage ChatName ByteString | SendMessage ChatName ByteString
| SendLiveMessage ChatName ByteString | SendLiveMessage ChatName ByteString
| SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: ByteString, message :: ByteString} | SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: ByteString, message :: ByteString}
| SendMessageBroadcast ByteString | SendMessageBroadcast ByteString -- UserId
| DeleteMessage ChatName ByteString | DeleteMessage ChatName ByteString
| EditMessage {chatName :: ChatName, editedMsg :: ByteString, message :: ByteString} | EditMessage {chatName :: ChatName, editedMsg :: ByteString, message :: ByteString}
| UpdateLiveMessage {chatName :: ChatName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: ByteString} | UpdateLiveMessage {chatName :: ChatName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: ByteString}
| NewGroup GroupProfile | NewGroup GroupProfile -- UserId
| AddMember GroupName ContactName GroupMemberRole | AddMember GroupName ContactName GroupMemberRole
| JoinGroup GroupName | JoinGroup GroupName
| MemberRole GroupName ContactName GroupMemberRole | MemberRole GroupName ContactName GroupMemberRole
@ -249,7 +254,7 @@ data ChatCommand
| DeleteGroup GroupName | DeleteGroup GroupName
| ClearGroup GroupName | ClearGroup GroupName
| ListMembers GroupName | ListMembers GroupName
| ListGroups | ListGroups -- UserId
| UpdateGroupNames GroupName GroupProfile | UpdateGroupNames GroupName GroupProfile
| ShowGroupProfile GroupName | ShowGroupProfile GroupName
| UpdateGroupDescription GroupName (Maybe Text) | UpdateGroupDescription GroupName (Maybe Text)
@ -257,9 +262,9 @@ data ChatCommand
| DeleteGroupLink GroupName | DeleteGroupLink GroupName
| ShowGroupLink GroupName | ShowGroupLink GroupName
| SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString} | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString}
| LastMessages (Maybe ChatName) Int (Maybe String) | LastMessages (Maybe ChatName) Int (Maybe String) -- UserId
| LastChatItemId (Maybe ChatName) Int | LastChatItemId (Maybe ChatName) Int -- UserId
| ShowChatItem (Maybe ChatItemId) | ShowChatItem (Maybe ChatItemId) -- UserId
| ShowLiveItems Bool | ShowLiveItems Bool
| SendFile ChatName FilePath | SendFile ChatName FilePath
| SendImage ChatName FilePath | SendImage ChatName FilePath
@ -268,13 +273,13 @@ data ChatCommand
| ReceiveFile {fileId :: FileTransferId, fileInline :: Maybe Bool, filePath :: Maybe FilePath} | ReceiveFile {fileId :: FileTransferId, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
| CancelFile FileTransferId | CancelFile FileTransferId
| FileStatus FileTransferId | FileStatus FileTransferId
| ShowProfile | ShowProfile -- UserId
| UpdateProfile ContactName Text | UpdateProfile ContactName Text -- UserId
| UpdateProfileImage (Maybe ImageData) | UpdateProfileImage (Maybe ImageData) -- UserId
| SetUserFeature AChatFeature FeatureAllowed | SetUserFeature AChatFeature FeatureAllowed -- UserId
| SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed) | SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed)
| SetGroupFeature AGroupFeature GroupName GroupFeatureEnabled | SetGroupFeature AGroupFeature GroupName GroupFeatureEnabled
| SetUserTimedMessages Bool | SetUserTimedMessages Bool -- UserId
| SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled) | SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled)
| SetGroupTimedMessages GroupName (Maybe Int) | SetGroupTimedMessages GroupName (Maybe Int)
| QuitChat | QuitChat
@ -286,137 +291,138 @@ data ChatCommand
data ChatResponse data ChatResponse
= CRActiveUser {user :: User} = CRActiveUser {user :: User}
| CRUsersList {users :: [User]}
| CRChatStarted | CRChatStarted
| CRChatRunning | CRChatRunning
| CRChatStopped | CRChatStopped
| CRChatSuspended | CRChatSuspended
| CRApiChats {chats :: [AChat]} | CRApiChats {user :: User, chats :: [AChat]}
| CRApiChat {chat :: AChat} | CRApiChat {user :: User, chat :: AChat}
| CRChatItems {chatItems :: [AChatItem]} | CRChatItems {user :: User, chatItems :: [AChatItem]}
| CRChatItemId (Maybe ChatItemId) | CRChatItemId User (Maybe ChatItemId)
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList} | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
| CRUserSMPServers {smpServers :: NonEmpty ServerCfg, presetSMPServers :: NonEmpty SMPServerWithAuth} | CRUserSMPServers {user :: User, smpServers :: NonEmpty ServerCfg, presetSMPServers :: NonEmpty SMPServerWithAuth}
| CRSmpTestResult {smpTestFailure :: Maybe SMPTestFailure} | CRSmpTestResult {smpTestFailure :: Maybe SMPTestFailure}
| CRChatItemTTL {chatItemTTL :: Maybe Int64} | CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
| CRNetworkConfig {networkConfig :: NetworkConfig} | CRNetworkConfig {networkConfig :: NetworkConfig}
| CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile} | CRContactInfo {user :: User, contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
| CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats} | CRGroupMemberInfo {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats}
| CRContactSwitch {contact :: Contact, switchProgress :: SwitchProgress} | CRContactSwitch {user :: User, contact :: Contact, switchProgress :: SwitchProgress}
| CRGroupMemberSwitch {groupInfo :: GroupInfo, member :: GroupMember, switchProgress :: SwitchProgress} | CRGroupMemberSwitch {user :: User, groupInfo :: GroupInfo, member :: GroupMember, switchProgress :: SwitchProgress}
| CRContactCode {contact :: Contact, connectionCode :: Text} | CRContactCode {user :: User, contact :: Contact, connectionCode :: Text}
| CRGroupMemberCode {groupInfo :: GroupInfo, member :: GroupMember, connectionCode :: Text} | CRGroupMemberCode {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionCode :: Text}
| CRConnectionVerified {verified :: Bool, expectedCode :: Text} | CRConnectionVerified {user :: User, verified :: Bool, expectedCode :: Text}
| CRNewChatItem {chatItem :: AChatItem} | CRNewChatItem {user :: User, chatItem :: AChatItem}
| CRChatItemStatusUpdated {chatItem :: AChatItem} | CRChatItemStatusUpdated {user :: User, chatItem :: AChatItem}
| CRChatItemUpdated {chatItem :: AChatItem} | CRChatItemUpdated {user :: User, chatItem :: AChatItem}
| CRChatItemDeleted {deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool} | CRChatItemDeleted {user :: User, deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool}
| CRChatItemDeletedNotFound {contact :: Contact, sharedMsgId :: SharedMsgId} | CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId}
| CRBroadcastSent MsgContent Int ZonedTime | CRBroadcastSent User MsgContent Int ZonedTime
| CRMsgIntegrityError {msgError :: MsgErrorType} | CRMsgIntegrityError {user :: User, msgError :: MsgErrorType}
| CRCmdAccepted {corr :: CorrId} | CRCmdAccepted {corr :: CorrId}
| CRCmdOk | CRCmdOk {user_ :: Maybe User}
| CRChatHelp {helpSection :: HelpSection} | CRChatHelp {helpSection :: HelpSection}
| CRWelcome {user :: User} | CRWelcome {user :: User}
| CRGroupCreated {groupInfo :: GroupInfo} | CRGroupCreated {user :: User, groupInfo :: GroupInfo}
| CRGroupMembers {group :: Group} | CRGroupMembers {user :: User, group :: Group}
| CRContactsList {contacts :: [Contact]} | CRContactsList {user :: User, contacts :: [Contact]}
| CRUserContactLink {contactLink :: UserContactLink} | CRUserContactLink {user :: User, contactLink :: UserContactLink}
| CRUserContactLinkUpdated {contactLink :: UserContactLink} | CRUserContactLinkUpdated {user :: User, contactLink :: UserContactLink}
| CRContactRequestRejected {contactRequest :: UserContactRequest} | CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest}
| CRUserAcceptedGroupSent {groupInfo :: GroupInfo, hostContact :: Maybe Contact} | CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
| CRUserDeletedMember {groupInfo :: GroupInfo, member :: GroupMember} | CRUserDeletedMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupsList {groups :: [GroupInfo]} | CRGroupsList {user :: User, groups :: [GroupInfo]}
| CRSentGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember} | CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
| CRFileTransferStatus (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus | CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
| CRUserProfile {profile :: Profile} | CRUserProfile {user :: User, profile :: Profile}
| CRUserProfileNoChange | CRUserProfileNoChange {user :: User}
| CRVersionInfo {version :: String} | CRVersionInfo {version :: String}
| CRInvitation {connReqInvitation :: ConnReqInvitation} | CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation}
| CRSentConfirmation | CRSentConfirmation {user :: User}
| CRSentInvitation {customUserProfile :: Maybe Profile} | CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
| CRContactUpdated {fromContact :: Contact, toContact :: Contact} | CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
| CRContactsMerged {intoContact :: Contact, mergedContact :: Contact} | CRContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact}
| CRContactDeleted {contact :: Contact} | CRContactDeleted {user :: User, contact :: Contact}
| CRChatCleared {chatInfo :: AChatInfo} | CRChatCleared {user :: User, chatInfo :: AChatInfo}
| CRUserContactLinkCreated {connReqContact :: ConnReqContact} | CRUserContactLinkCreated {user :: User, connReqContact :: ConnReqContact}
| CRUserContactLinkDeleted | CRUserContactLinkDeleted {user :: User}
| CRReceivedContactRequest {contactRequest :: UserContactRequest} | CRReceivedContactRequest {user :: User, contactRequest :: UserContactRequest}
| CRAcceptingContactRequest {contact :: Contact} | CRAcceptingContactRequest {user :: User, contact :: Contact}
| CRContactAlreadyExists {contact :: Contact} | CRContactAlreadyExists {user :: User, contact :: Contact}
| CRContactRequestAlreadyAccepted {contact :: Contact} | CRContactRequestAlreadyAccepted {user :: User, contact :: Contact}
| CRLeftMemberUser {groupInfo :: GroupInfo} | CRLeftMemberUser {user :: User, groupInfo :: GroupInfo}
| CRGroupDeletedUser {groupInfo :: GroupInfo} | CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo}
| CRRcvFileAccepted {chatItem :: AChatItem} | CRRcvFileAccepted {user :: User, chatItem :: AChatItem}
| CRRcvFileAcceptedSndCancelled {rcvFileTransfer :: RcvFileTransfer} | CRRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileStart {chatItem :: AChatItem} | CRRcvFileStart {user :: User, chatItem :: AChatItem}
| CRRcvFileComplete {chatItem :: AChatItem} | CRRcvFileComplete {user :: User, chatItem :: AChatItem}
| CRRcvFileCancelled {rcvFileTransfer :: RcvFileTransfer} | CRRcvFileCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileSndCancelled {rcvFileTransfer :: RcvFileTransfer} | CRRcvFileSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
| CRSndFileStart {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer} | CRSndFileStart {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndFileComplete {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer} | CRSndFileComplete {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndFileCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer} | CRSndFileCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndFileRcvCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer} | CRSndFileRcvCancelled {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndGroupFileCancelled {chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]} | CRSndGroupFileCancelled {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
| CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile} | CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile}
| CRContactAliasUpdated {toContact :: Contact} | CRContactAliasUpdated {user :: User, toContact :: Contact}
| CRConnectionAliasUpdated {toConnection :: PendingContactConnection} | CRConnectionAliasUpdated {user :: User, toConnection :: PendingContactConnection}
| CRContactPrefsUpdated {fromContact :: Contact, toContact :: Contact} | CRContactPrefsUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
| CRContactConnecting {contact :: Contact} | CRContactConnecting {user :: User, contact :: Contact}
| CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile} | CRContactConnected {user :: User, contact :: Contact, userCustomProfile :: Maybe Profile}
| CRContactAnotherClient {contact :: Contact} | CRContactAnotherClient {user :: User, contact :: Contact}
| CRSubscriptionEnd {connectionEntity :: ConnectionEntity} | CRSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity}
| CRContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]} | CRContactsDisconnected {user :: User, server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]} | CRContactsSubscribed {user :: User, server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactSubError {contact :: Contact, chatError :: ChatError} | CRContactSubError {contact :: Contact, chatError :: ChatError}
| CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]} | CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]}
| CRUserContactSubSummary {userContactSubscriptions :: [UserContactSubStatus]} | CRUserContactSubSummary {userContactSubscriptions :: [UserContactSubStatus]}
| CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost} | CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost} | CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRGroupInvitation {groupInfo :: GroupInfo} | CRGroupInvitation {groupInfo :: GroupInfo}
| CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole} | CRReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
| CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember} | CRUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember} | CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRJoinedGroupMemberConnecting {groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember} | CRJoinedGroupMemberConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
| CRMemberRole {groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole} | CRMemberRole {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
| CRMemberRoleUser {groupInfo :: GroupInfo, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole} | CRMemberRoleUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
| CRConnectedToGroupMember {groupInfo :: GroupInfo, member :: GroupMember} | CRConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRDeletedMember {groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember} | CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
| CRDeletedMemberUser {groupInfo :: GroupInfo, member :: GroupMember} | CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRLeftMember {groupInfo :: GroupInfo, member :: GroupMember} | CRLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupEmpty {groupInfo :: GroupInfo} | CRGroupEmpty {groupInfo :: GroupInfo}
| CRGroupRemoved {groupInfo :: GroupInfo} | CRGroupRemoved {groupInfo :: GroupInfo}
| CRGroupDeleted {groupInfo :: GroupInfo, member :: GroupMember} | CRGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupUpdated {fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember} | CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
| CRGroupProfile {groupInfo :: GroupInfo} | CRGroupProfile {user :: User, groupInfo :: GroupInfo}
| CRGroupLinkCreated {groupInfo :: GroupInfo, connReqContact :: ConnReqContact} | CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
| CRGroupLink {groupInfo :: GroupInfo, connReqContact :: ConnReqContact} | CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
| CRGroupLinkDeleted {groupInfo :: GroupInfo} | CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
| CRAcceptingGroupJoinRequest {groupInfo :: GroupInfo, contact :: Contact} | CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact}
| CRMemberSubError {groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError} | CRMemberSubError {groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
| CRMemberSubSummary {memberSubscriptions :: [MemberSubStatus]} | CRMemberSubSummary {memberSubscriptions :: [MemberSubStatus]}
| CRGroupSubscribed {groupInfo :: GroupInfo} | CRGroupSubscribed {groupInfo :: GroupInfo}
| CRPendingSubSummary {pendingSubscriptions :: [PendingSubStatus]} | CRPendingSubSummary {pendingSubscriptions :: [PendingSubStatus]}
| CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError} | CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
| CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError} | CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
| CRCallInvitation {callInvitation :: RcvCallInvitation} | CRCallInvitation {user :: User, callInvitation :: RcvCallInvitation}
| CRCallOffer {contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool} | CRCallOffer {user :: User, contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool}
| CRCallAnswer {contact :: Contact, answer :: WebRTCSession} | CRCallAnswer {user :: User, contact :: Contact, answer :: WebRTCSession}
| CRCallExtraInfo {contact :: Contact, extraInfo :: WebRTCExtraInfo} | CRCallExtraInfo {user :: User, contact :: Contact, extraInfo :: WebRTCExtraInfo}
| CRCallEnded {contact :: Contact} | CRCallEnded {user :: User, contact :: Contact}
| CRCallInvitations {callInvitations :: [RcvCallInvitation]} | CRCallInvitations {user :: User, callInvitations :: [RcvCallInvitation]}
| CRUserContactLinkSubscribed | CRUserContactLinkSubscribed
| CRUserContactLinkSubError {chatError :: ChatError} | CRUserContactLinkSubError {chatError :: ChatError}
| CRNtfTokenStatus {status :: NtfTknStatus} | CRNtfTokenStatus {status :: NtfTknStatus}
| CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode} | CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode}
| CRNtfMessages {connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]} | CRNtfMessages {user :: User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
| CRNewContactConnection {connection :: PendingContactConnection} | CRNewContactConnection {user :: User, connection :: PendingContactConnection}
| CRContactConnectionDeleted {connection :: PendingContactConnection} | CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
| CRSQLResult {rows :: [Text]} | CRSQLResult {rows :: [Text]}
| CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks} | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
| CRAgentStats {agentStats :: [[String]]} | CRAgentStats {agentStats :: [[String]]}
| CRMessageError {severity :: Text, errorMessage :: Text} | CRMessageError {user :: User, severity :: Text, errorMessage :: Text}
| CRChatCmdError {chatError :: ChatError} | CRChatCmdError {user_ :: Maybe User, chatError :: ChatError}
| CRChatError {chatError :: ChatError} | CRChatError {user_ :: Maybe User, chatError :: ChatError}
deriving (Show, Generic) deriving (Show, Generic)
instance ToJSON ChatResponse where instance ToJSON ChatResponse where
@ -551,7 +557,8 @@ instance ToJSON ChatError where
data ChatErrorType data ChatErrorType
= CENoActiveUser = CENoActiveUser
| CEActiveUserExists | CENoConnectionUser {agentConnId :: AgentConnId}
| CEActiveUserExists -- TODO delete
| CEChatNotStarted | CEChatNotStarted
| CEChatNotStopped | CEChatNotStopped
| CEChatStoreChanged | CEChatStoreChanged
@ -627,8 +634,8 @@ throwDBError = throwError . ChatErrorDatabase
type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m) type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
chatCmdError :: String -> ChatResponse chatCmdError :: Maybe User -> String -> ChatResponse
chatCmdError = CRChatCmdError . ChatError . CECommandError chatCmdError user = CRChatCmdError user . ChatError . CECommandError
setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m () setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
setActive to = asks activeTo >>= atomically . (`writeTVar` to) setActive to = asks activeTo >>= atomically . (`writeTVar` to)

46
src/Simplex/Chat/Store.hs
View File

@ -28,6 +28,9 @@ module Simplex.Chat.Store
createUser, createUser,
getUsers, getUsers,
setActiveUser, setActiveUser,
getSetActiveUser,
getUserIdByName,
getUserByAConnId,
createDirectConnection, createDirectConnection,
createConnReqConnection, createConnReqConnection,
getProfileById, getProfileById,
@ -440,15 +443,16 @@ createUser db Profile {displayName, fullName, image, preferences = userPreferenc
getUsers :: DB.Connection -> IO [User] getUsers :: DB.Connection -> IO [User]
getUsers db = getUsers db =
map toUser map toUser <$> DB.query_ db userQuery
<$> DB.query_
db userQuery :: Query
[sql| userQuery =
SELECT u.user_id, u.contact_id, p.contact_profile_id, u.active_user, u.local_display_name, p.full_name, p.image, p.preferences [sql|
FROM users u SELECT u.user_id, u.contact_id, cp.contact_profile_id, u.active_user, u.local_display_name, cp.full_name, cp.image, cp.preferences
JOIN contacts c ON u.contact_id = c.contact_id FROM users u
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id JOIN contacts ct ON ct.contact_id = u.contact_id
|] JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
|]
toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe Preferences) -> User toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe Preferences) -> User
toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences) = toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences) =
@ -460,6 +464,26 @@ setActiveUser db userId = do
DB.execute_ db "UPDATE users SET active_user = 0" DB.execute_ db "UPDATE users SET active_user = 0"
DB.execute db "UPDATE users SET active_user = 1 WHERE user_id = ?" (Only userId) DB.execute db "UPDATE users SET active_user = 1 WHERE user_id = ?" (Only userId)
getSetActiveUser :: DB.Connection -> UserId -> ExceptT StoreError IO User
getSetActiveUser db userId = do
liftIO $ setActiveUser db userId
getUser_ db userId
getUser_ :: DB.Connection -> UserId -> ExceptT StoreError IO User
getUser_ db userId =
ExceptT . firstRow toUser (SEUserNotFound userId) $
DB.query db (userQuery <> " WHERE u.user_id = ?") (Only userId)
getUserIdByName :: DB.Connection -> UserName -> ExceptT StoreError IO Int64
getUserIdByName db uName =
ExceptT . firstRow fromOnly (SEUserNotFoundByName uName) $
DB.query db "SELECT user_id FROM users WHERE local_display_name = ?" (Only uName)
getUserByAConnId :: DB.Connection -> AgentConnId -> IO (Maybe User)
getUserByAConnId db agentConnId =
maybeFirstRow toUser $
DB.query db (userQuery <> " JOIN connections c ON c.user_id = u.user_id WHERE c.agent_conn_id = ?") (Only agentConnId)
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> IO PendingContactConnection createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> IO PendingContactConnection
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId = do createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId = do
createdAt <- getCurrentTime createdAt <- getCurrentTime
@ -4803,7 +4827,9 @@ randomBytes gVar = atomically . stateTVar gVar . randomBytesGenerate
-- These error type constructors must be added to mobile apps -- These error type constructors must be added to mobile apps
data StoreError data StoreError
= SEDuplicateName = SEDuplicateName
| SEContactNotFound {contactId :: Int64} | SEUserNotFound {userId :: UserId}
| SEUserNotFoundByName {contactName :: ContactName}
| SEContactNotFound {contactId :: ContactId}
| SEContactNotFoundByName {contactName :: ContactName} | SEContactNotFoundByName {contactName :: ContactName}
| SEContactNotReady {contactName :: ContactName} | SEContactNotReady {contactName :: ContactName}
| SEDuplicateContactLink | SEDuplicateContactLink

7
src/Simplex/Chat/Terminal/Input.hs
View File

@ -43,7 +43,8 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
unless (isMessage cmd) $ echo s unless (isMessage cmd) $ echo s
r <- runReaderT (execChatCommand bs) cc r <- runReaderT (execChatCommand bs) cc
case r of case r of
CRChatCmdError _ -> when (isMessage cmd) $ echo s CRChatCmdError _ _ -> when (isMessage cmd) $ echo s
CRChatError _ _ -> when (isMessage cmd) $ echo s
_ -> pure () _ -> pure ()
printRespToTerminal ct cc False r printRespToTerminal ct cc False r
startLiveMessage cmd r startLiveMessage cmd r
@ -58,7 +59,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
Right SendMessageBroadcast {} -> True Right SendMessageBroadcast {} -> True
_ -> False _ -> False
startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO () startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO ()
startLiveMessage (Right (SendLiveMessage chatName msg)) (CRNewChatItem (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})) = do startLiveMessage (Right (SendLiveMessage chatName msg)) (CRNewChatItem _ (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})) = do
whenM (isNothing <$> readTVarIO liveMessageState) $ do whenM (isNothing <$> readTVarIO liveMessageState) $ do
let s = T.unpack $ safeDecodeUtf8 msg let s = T.unpack $ safeDecodeUtf8 msg
int = case cType of SCTGroup -> 5000000; _ -> 3000000 :: Int int = case cType of SCTGroup -> 5000000; _ -> 3000000 :: Int
@ -111,7 +112,7 @@ sendUpdatedLiveMessage :: ChatController -> String -> LiveMessage -> Bool -> IO
sendUpdatedLiveMessage cc sentMsg LiveMessage {chatName, chatItemId} live = do sendUpdatedLiveMessage cc sentMsg LiveMessage {chatName, chatItemId} live = do
let bs = encodeUtf8 $ T.pack sentMsg let bs = encodeUtf8 $ T.pack sentMsg
cmd = UpdateLiveMessage chatName chatItemId live bs cmd = UpdateLiveMessage chatName chatItemId live bs
either CRChatCmdError id <$> runExceptT (processChatCommand cmd) `runReaderT` cc either (CRChatCmdError Nothing) id <$> runExceptT (processChatCommand cmd) `runReaderT` cc
runTerminalInput :: ChatTerminal -> ChatController -> IO () runTerminalInput :: ChatTerminal -> ChatController -> IO ()
runTerminalInput ct cc = withChatTerm ct $ do runTerminalInput ct cc = withChatTerm ct $ do

4
src/Simplex/Chat/Terminal/Output.hs
View File

@ -95,8 +95,8 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems} = do
forever $ do forever $ do
(_, r) <- atomically $ readTBQueue outputQ (_, r) <- atomically $ readTBQueue outputQ
case r of case r of
CRNewChatItem ci -> markChatItemRead ci CRNewChatItem _ ci -> markChatItemRead ci
CRChatItemUpdated ci -> markChatItemRead ci CRChatItemUpdated _ ci -> markChatItemRead ci
_ -> pure () _ -> pure ()
liveItems <- readTVarIO showLiveItems liveItems <- readTVarIO showLiveItems
printRespToTerminal ct cc liveItems r printRespToTerminal ct cc liveItems r

2
src/Simplex/Chat/Types.hs
View File

@ -216,6 +216,8 @@ instance ToJSON ConnReqUriHash where
data ContactOrRequest = CORContact Contact | CORRequest UserContactRequest data ContactOrRequest = CORContact Contact | CORRequest UserContactRequest
type UserName = Text
type ContactName = Text type ContactName = Text
type GroupName = Text type GroupName = Text

204
src/Simplex/Chat/View.hs
View File

@ -59,35 +59,36 @@ serializeChatResponse user_ ts = unlines . map unStyle . responseToView user_ Fa
responseToView :: Maybe User -> Bool -> Bool -> CurrentTime -> ChatResponse -> [StyledString] responseToView :: Maybe User -> Bool -> Bool -> CurrentTime -> ChatResponse -> [StyledString]
responseToView user_ testView liveItems ts = \case responseToView user_ testView liveItems ts = \case
CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
CRUsersList users -> viewUsersList users
CRChatStarted -> ["chat started"] CRChatStarted -> ["chat started"]
CRChatRunning -> ["chat is running"] CRChatRunning -> ["chat is running"]
CRChatStopped -> ["chat stopped"] CRChatStopped -> ["chat stopped"]
CRChatSuspended -> ["chat suspended"] CRChatSuspended -> ["chat suspended"]
CRApiChats chats -> if testView then testViewChats chats else [plain . bshow $ J.encode chats] CRApiChats _u chats -> if testView then testViewChats chats else [plain . bshow $ J.encode chats]
CRApiChat chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat] CRApiChat _u chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat]
CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft] CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
CRUserSMPServers smpServers _ -> viewSMPServers (L.toList smpServers) testView CRUserSMPServers _u smpServers _ -> viewSMPServers (L.toList smpServers) testView
CRSmpTestResult testFailure -> viewSMPTestResult testFailure CRSmpTestResult testFailure -> viewSMPTestResult testFailure
CRChatItemTTL ttl -> viewChatItemTTL ttl CRChatItemTTL _u ttl -> viewChatItemTTL ttl
CRNetworkConfig cfg -> viewNetworkConfig cfg CRNetworkConfig cfg -> viewNetworkConfig cfg
CRContactInfo ct cStats customUserProfile -> viewContactInfo ct cStats customUserProfile CRContactInfo _u ct cStats customUserProfile -> viewContactInfo ct cStats customUserProfile
CRGroupMemberInfo g m cStats -> viewGroupMemberInfo g m cStats CRGroupMemberInfo _u g m cStats -> viewGroupMemberInfo g m cStats
CRContactSwitch ct progress -> viewContactSwitch ct progress CRContactSwitch _u ct progress -> viewContactSwitch ct progress
CRGroupMemberSwitch g m progress -> viewGroupMemberSwitch g m progress CRGroupMemberSwitch _u g m progress -> viewGroupMemberSwitch g m progress
CRConnectionVerified verified code -> [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code] CRConnectionVerified _u verified code -> [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
CRContactCode ct code -> viewContactCode ct code testView CRContactCode _u ct code -> viewContactCode ct code testView
CRGroupMemberCode g m code -> viewGroupMemberCode g m code testView CRGroupMemberCode _u g m code -> viewGroupMemberCode g m code testView
CRNewChatItem (AChatItem _ _ chat item) -> unmuted chat item $ viewChatItem chat item False ts CRNewChatItem _u (AChatItem _ _ chat item) -> unmuted chat item $ viewChatItem chat item False ts
CRChatItems chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems CRChatItems _u chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
CRChatItemId itemId -> [plain $ maybe "no item" show itemId] CRChatItemId _u itemId -> [plain $ maybe "no item" show itemId]
CRChatItemStatusUpdated _ -> [] CRChatItemStatusUpdated _u _ -> []
CRChatItemUpdated (AChatItem _ _ chat item) -> unmuted chat item $ viewItemUpdate chat item liveItems ts CRChatItemUpdated _u (AChatItem _ _ chat item) -> unmuted chat item $ viewItemUpdate chat item liveItems ts
CRChatItemDeleted (AChatItem _ _ chat deletedItem) toItem byUser timed -> unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts CRChatItemDeleted _u (AChatItem _ _ chat deletedItem) toItem byUser timed -> unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts
CRChatItemDeletedNotFound Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"] CRChatItemDeletedNotFound _u Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"]
CRBroadcastSent mc n t -> viewSentBroadcast mc n ts t CRBroadcastSent _u mc n t -> viewSentBroadcast mc n ts t
CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr CRMsgIntegrityError _u mErr -> viewMsgIntegrityError mErr
CRCmdAccepted _ -> [] CRCmdAccepted _ -> []
CRCmdOk -> ["ok"] CRCmdOk _u -> ["ok"]
CRChatHelp section -> case section of CRChatHelp section -> case section of
HSMain -> chatHelpInfo HSMain -> chatHelpInfo
HSFiles -> filesHelpInfo HSFiles -> filesHelpInfo
@ -97,65 +98,64 @@ responseToView user_ testView liveItems ts = \case
HSMarkdown -> markdownInfo HSMarkdown -> markdownInfo
HSSettings -> settingsInfo HSSettings -> settingsInfo
CRWelcome user -> chatWelcome user CRWelcome user -> chatWelcome user
CRContactsList cs -> viewContactsList cs CRContactsList _u cs -> viewContactsList cs
CRUserContactLink UserContactLink {connReqContact, autoAccept} -> connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept CRUserContactLink _u UserContactLink {connReqContact, autoAccept} -> connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept
CRUserContactLinkUpdated UserContactLink {autoAccept} -> autoAcceptStatus_ autoAccept CRUserContactLinkUpdated _u UserContactLink {autoAccept} -> autoAcceptStatus_ autoAccept
CRContactRequestRejected UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"] CRContactRequestRejected _u UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"]
CRGroupCreated g -> viewGroupCreated g CRGroupCreated _u g -> viewGroupCreated g
CRGroupMembers g -> viewGroupMembers g CRGroupMembers _u g -> viewGroupMembers g
CRGroupsList gs -> viewGroupsList gs CRGroupsList _u gs -> viewGroupsList gs
CRSentGroupInvitation g c _ -> CRSentGroupInvitation _u g c _ ->
if viaGroupLink . contactConn $ c if viaGroupLink . contactConn $ c
then [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"] then [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c] else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
CRFileTransferStatus ftStatus -> viewFileTransferStatus ftStatus CRFileTransferStatus _u ftStatus -> viewFileTransferStatus ftStatus
CRUserProfile p -> viewUserProfile p CRUserProfile _u p -> viewUserProfile p
CRUserProfileNoChange -> ["user profile did not change"] CRUserProfileNoChange _u -> ["user profile did not change"]
CRVersionInfo _ -> [plain versionStr, plain updateStr] CRVersionInfo _ -> [plain versionStr, plain updateStr]
CRChatCmdError e -> viewChatError e CRInvitation _u cReq -> viewConnReqInvitation cReq
CRInvitation cReq -> viewConnReqInvitation cReq CRSentConfirmation _u -> ["confirmation sent!"]
CRSentConfirmation -> ["confirmation sent!"] CRSentInvitation _u customUserProfile -> viewSentInvitation customUserProfile testView
CRSentInvitation customUserProfile -> viewSentInvitation customUserProfile testView CRContactDeleted _u c -> [ttyContact' c <> ": contact is deleted"]
CRContactDeleted c -> [ttyContact' c <> ": contact is deleted"] CRChatCleared _u chatInfo -> viewChatCleared chatInfo
CRChatCleared chatInfo -> viewChatCleared chatInfo CRAcceptingContactRequest _u c -> [ttyFullContact c <> ": accepting contact request..."]
CRAcceptingContactRequest c -> [ttyFullContact c <> ": accepting contact request..."] CRContactAlreadyExists _u c -> [ttyFullContact c <> ": contact already exists"]
CRContactAlreadyExists c -> [ttyFullContact c <> ": contact already exists"] CRContactRequestAlreadyAccepted _u c -> [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
CRContactRequestAlreadyAccepted c -> [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"] CRUserContactLinkCreated _u cReq -> connReqContact_ "Your new chat address is created!" cReq
CRUserContactLinkCreated cReq -> connReqContact_ "Your new chat address is created!" cReq CRUserContactLinkDeleted _u -> viewUserContactLinkDeleted
CRUserContactLinkDeleted -> viewUserContactLinkDeleted CRUserAcceptedGroupSent _u _g _ -> [] -- [ttyGroup' g <> ": joining the group..."]
CRUserAcceptedGroupSent _g _ -> [] -- [ttyGroup' g <> ": joining the group..."] CRUserDeletedMember _u g m -> [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
CRUserDeletedMember g m -> [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"] CRLeftMemberUser _u g -> [ttyGroup' g <> ": you left the group"] <> groupPreserved g
CRLeftMemberUser g -> [ttyGroup' g <> ": you left the group"] <> groupPreserved g CRGroupDeletedUser _u g -> [ttyGroup' g <> ": you deleted the group"]
CRGroupDeletedUser g -> [ttyGroup' g <> ": you deleted the group"] CRRcvFileAccepted _u ci -> savingFile' ci
CRRcvFileAccepted ci -> savingFile' ci CRRcvFileAcceptedSndCancelled _u ft -> viewRcvFileSndCancelled ft
CRRcvFileAcceptedSndCancelled ft -> viewRcvFileSndCancelled ft CRSndGroupFileCancelled _u _ ftm fts -> viewSndGroupFileCancelled ftm fts
CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts CRRcvFileCancelled _u ft -> receivingFile_ "cancelled" ft
CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft CRUserProfileUpdated _u p p' -> viewUserProfileUpdated p p'
CRUserProfileUpdated p p' -> viewUserProfileUpdated p p' CRContactPrefsUpdated {user = _u, fromContact, toContact} -> case user_ of
CRContactPrefsUpdated {fromContact, toContact} -> case user_ of
Just user -> viewUserContactPrefsUpdated user fromContact toContact Just user -> viewUserContactPrefsUpdated user fromContact toContact
_ -> ["unexpected chat event CRContactPrefsUpdated without current user"] _ -> ["unexpected chat event CRContactPrefsUpdated without current user"]
CRContactAliasUpdated c -> viewContactAliasUpdated c CRContactAliasUpdated _u c -> viewContactAliasUpdated c
CRConnectionAliasUpdated c -> viewConnectionAliasUpdated c CRConnectionAliasUpdated _u c -> viewConnectionAliasUpdated c
CRContactUpdated {fromContact = c, toContact = c'} -> case user_ of CRContactUpdated {user = _u, fromContact = c, toContact = c'} -> case user_ of
Just user -> viewContactUpdated c c' <> viewContactPrefsUpdated user c c' Just user -> viewContactUpdated c c' <> viewContactPrefsUpdated user c c'
_ -> ["unexpected chat event CRContactUpdated without current user"] _ -> ["unexpected chat event CRContactUpdated without current user"]
CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt CRContactsMerged _u intoCt mergedCt -> viewContactsMerged intoCt mergedCt
CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile CRReceivedContactRequest _u UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
CRRcvFileStart ci -> receivingFile_' "started" ci CRRcvFileStart _u ci -> receivingFile_' "started" ci
CRRcvFileComplete ci -> receivingFile_' "completed" ci CRRcvFileComplete _u ci -> receivingFile_' "completed" ci
CRRcvFileSndCancelled ft -> viewRcvFileSndCancelled ft CRRcvFileSndCancelled _u ft -> viewRcvFileSndCancelled ft
CRSndFileStart _ ft -> sendingFile_ "started" ft CRSndFileStart _u _ ft -> sendingFile_ "started" ft
CRSndFileComplete _ ft -> sendingFile_ "completed" ft CRSndFileComplete _u _ ft -> sendingFile_ "completed" ft
CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft
CRSndFileRcvCancelled _ ft@SndFileTransfer {recipientDisplayName = c} -> CRSndFileRcvCancelled _u _ ft@SndFileTransfer {recipientDisplayName = c} ->
[ttyContact c <> " cancelled receiving " <> sndFile ft] [ttyContact c <> " cancelled receiving " <> sndFile ft]
CRContactConnecting _ -> [] CRContactConnecting _u _ -> []
CRContactConnected ct userCustomProfile -> viewContactConnected ct userCustomProfile testView CRContactConnected _u ct userCustomProfile -> viewContactConnected ct userCustomProfile testView
CRContactAnotherClient c -> [ttyContact' c <> ": contact is connected to another client"] CRContactAnotherClient _u c -> [ttyContact' c <> ": contact is connected to another client"]
CRSubscriptionEnd acEntity -> [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"] CRSubscriptionEnd _u acEntity -> [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"]
CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] CRContactsDisconnected _u srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] CRContactsSubscribed _u srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e] CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e]
CRContactSubSummary summary -> CRContactSubSummary summary ->
[sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors" [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
@ -169,27 +169,27 @@ responseToView user_ testView liveItems ts = \case
addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError
(groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks (groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
CRGroupInvitation g -> [groupInvitation' g] CRGroupInvitation g -> [groupInvitation' g]
CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role CRReceivedGroupInvitation _u g c role -> viewReceivedGroupInvitation g c role
CRUserJoinedGroup g _ -> viewUserJoinedGroup g CRUserJoinedGroup _u g _ -> viewUserJoinedGroup g
CRJoinedGroupMember g m -> viewJoinedGroupMember g m CRJoinedGroupMember _u g m -> viewJoinedGroupMember g m
CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h] CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h]
CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h] CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h]
CRJoinedGroupMemberConnecting g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"] CRJoinedGroupMemberConnecting _u g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
CRConnectedToGroupMember g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"] CRConnectedToGroupMember _u g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
CRMemberRole g by m r r' -> viewMemberRoleChanged g by m r r' CRMemberRole _u g by m r r' -> viewMemberRoleChanged g by m r r'
CRMemberRoleUser g m r r' -> viewMemberRoleUserChanged g m r r' CRMemberRoleUser _u g m r r' -> viewMemberRoleUserChanged g m r r'
CRDeletedMemberUser g by -> [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g CRDeletedMemberUser _u g by -> [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
CRDeletedMember g by m -> [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"] CRDeletedMember _u g by m -> [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
CRLeftMember g m -> [ttyGroup' g <> ": " <> ttyMember m <> " left the group"] CRLeftMember _u g m -> [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"] CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"]
CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"] CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"]
CRGroupDeleted g m -> [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"] CRGroupDeleted _u g m -> [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"]
CRGroupUpdated g g' m -> viewGroupUpdated g g' m CRGroupUpdated _u g g' m -> viewGroupUpdated g g' m
CRGroupProfile g -> viewGroupProfile g CRGroupProfile _u g -> viewGroupProfile g
CRGroupLinkCreated g cReq -> groupLink_ "Group link is created!" g cReq CRGroupLinkCreated _u g cReq -> groupLink_ "Group link is created!" g cReq
CRGroupLink g cReq -> groupLink_ "Group link:" g cReq CRGroupLink _u g cReq -> groupLink_ "Group link:" g cReq
CRGroupLinkDeleted g -> viewGroupLinkDeleted g CRGroupLinkDeleted _u g -> viewGroupLinkDeleted g
CRAcceptingGroupJoinRequest g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."] CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."]
CRMemberSubError g m e -> [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e] CRMemberSubError g m e -> [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors" CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
CRGroupSubscribed g -> viewGroupSubscribed g CRGroupSubscribed g -> viewGroupSubscribed g
@ -198,16 +198,16 @@ responseToView user_ testView liveItems ts = \case
["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e] ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e -> CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e] ["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
CRCallInvitation RcvCallInvitation {contact, callType, sharedKey} -> viewCallInvitation contact callType sharedKey CRCallInvitation _u RcvCallInvitation {contact, callType, sharedKey} -> viewCallInvitation contact callType sharedKey
CRCallOffer {contact, callType, offer, sharedKey} -> viewCallOffer contact callType offer sharedKey CRCallOffer {user = _u, contact, callType, offer, sharedKey} -> viewCallOffer contact callType offer sharedKey
CRCallAnswer {contact, answer} -> viewCallAnswer contact answer CRCallAnswer {user = _u, contact, answer} -> viewCallAnswer contact answer
CRCallExtraInfo {contact} -> ["call extra info from " <> ttyContact' contact] CRCallExtraInfo {user = _u, contact} -> ["call extra info from " <> ttyContact' contact]
CRCallEnded {contact} -> ["call with " <> ttyContact' contact <> " ended"] CRCallEnded {user = _u, contact} -> ["call with " <> ttyContact' contact <> " ended"]
CRCallInvitations _ -> [] CRCallInvitations _u _ -> []
CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"] CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"]
CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"] CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"]
CRNewContactConnection _ -> [] CRNewContactConnection _u _ -> []
CRContactConnectionDeleted PendingContactConnection {pccConnId} -> ["connection :" <> sShow pccConnId <> " deleted"] CRContactConnectionDeleted _u PendingContactConnection {pccConnId} -> ["connection :" <> sShow pccConnId <> " deleted"]
CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)] CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)] CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
CRNtfMessages {} -> [] CRNtfMessages {} -> []
@ -217,8 +217,9 @@ responseToView user_ testView liveItems ts = \case
plain $ "agent locks: " <> LB.unpack (J.encode agentLocks) plain $ "agent locks: " <> LB.unpack (J.encode agentLocks)
] ]
CRAgentStats stats -> map (plain . intercalate ",") stats CRAgentStats stats -> map (plain . intercalate ",") stats
CRMessageError prefix err -> [plain prefix <> ": " <> plain err] CRMessageError _u prefix err -> [plain prefix <> ": " <> plain err]
CRChatError e -> viewChatError e CRChatCmdError _u e -> viewChatError e
CRChatError _u e -> viewChatError e
where where
testViewChats :: [AChat] -> [StyledString] testViewChats :: [AChat] -> [StyledString]
testViewChats chats = [sShow $ map toChatView chats] testViewChats chats = [sShow $ map toChatView chats]
@ -256,6 +257,13 @@ responseToView user_ testView liveItems ts = \case
| muted chat chatItem = [] | muted chat chatItem = []
| otherwise = s | otherwise = s
viewUsersList :: [User] -> [StyledString]
viewUsersList =
let ldn = T.toLower . (localDisplayName :: User -> ContactName)
in map (\user@User {profile = LocalProfile {displayName, fullName}} -> ttyFullName displayName fullName <> active user) . sortOn ldn
where
active User {activeUser} = if activeUser then highlight' " (active)" else ""
muted :: ChatInfo c -> ChatItem c d -> Bool muted :: ChatInfo c -> ChatItem c d -> Bool
muted chat ChatItem {chatDir} = case (chat, chatDir) of muted chat ChatItem {chatDir} = case (chat, chatDir) of
(DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True (DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True
@ -1130,6 +1138,7 @@ viewChatError :: ChatError -> [StyledString]
viewChatError = \case viewChatError = \case
ChatError err -> case err of ChatError err -> case err of
CENoActiveUser -> ["error: active user is required"] CENoActiveUser -> ["error: active user is required"]
CENoConnectionUser _agentConnId -> [] -- ["error: connection has no user, conn id: " <> sShow agentConnId]
CEActiveUserExists -> ["error: active user already exists"] CEActiveUserExists -> ["error: active user already exists"]
CEChatNotStarted -> ["error: chat not started"] CEChatNotStarted -> ["error: chat not started"]
CEChatNotStopped -> ["error: chat not stopped"] CEChatNotStopped -> ["error: chat not stopped"]
@ -1179,6 +1188,7 @@ viewChatError = \case
-- e -> ["chat error: " <> sShow e] -- e -> ["chat error: " <> sShow e]
ChatErrorStore err -> case err of ChatErrorStore err -> case err of
SEDuplicateName -> ["this display name is already used by user, contact or group"] SEDuplicateName -> ["this display name is already used by user, contact or group"]
SEUserNotFoundByName u -> ["no user " <> ttyContact u]
SEContactNotFoundByName c -> ["no contact " <> ttyContact c] SEContactNotFoundByName c -> ["no contact " <> ttyContact c]
SEContactNotReady c -> ["contact " <> ttyContact c <> " is not active yet"] SEContactNotReady c -> ["contact " <> ttyContact c <> " is not active yet"]
SEGroupNotFoundByName g -> ["no group " <> ttyGroup g] SEGroupNotFoundByName g -> ["no group " <> ttyGroup g]

8
tests/MobileTests.hs
View File

@ -25,9 +25,9 @@ noActiveUser = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"e
activeUserExists :: String activeUserExists :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON) #if defined(darwin_HOST_OS) && defined(swiftJSON)
activeUserExists = "{\"resp\":{\"chatCmdError\":{\"chatError\":{\"error\":{\"errorType\":{\"activeUserExists\":{}}}}}}}" activeUserExists = "{\"resp\":{\"chatCmdError\":{\"chatError\":{\"errorStore\":{\"storeError\":{\"duplicateName\":{}}}}}}}"
#else #else
activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"activeUserExists\"}}}}" activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"errorStore\",\"storeError\":{\"type\":\"duplicateName\"}}}}"
#endif #endif
activeUser :: String activeUser :: String
@ -85,7 +85,7 @@ testChatApiNoUser = withTmpFiles $ do
Left (DBMErrorNotADatabase _) <- chatMigrateInit testDBPrefix "myKey" Left (DBMErrorNotADatabase _) <- chatMigrateInit testDBPrefix "myKey"
chatSendCmd cc "/u" `shouldReturn` noActiveUser chatSendCmd cc "/u" `shouldReturn` noActiveUser
chatSendCmd cc "/_start" `shouldReturn` noActiveUser chatSendCmd cc "/_start" `shouldReturn` noActiveUser
chatSendCmd cc "/u alice Alice" `shouldReturn` activeUser chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUser
chatSendCmd cc "/_start" `shouldReturn` chatStarted chatSendCmd cc "/_start" `shouldReturn` chatStarted
testChatApi :: IO () testChatApi :: IO ()
@ -98,7 +98,7 @@ testChatApi = withTmpFiles $ do
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix ""
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey" Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey"
chatSendCmd cc "/u" `shouldReturn` activeUser chatSendCmd cc "/u" `shouldReturn` activeUser
chatSendCmd cc "/u alice Alice" `shouldReturn` activeUserExists chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUserExists
chatSendCmd cc "/_start" `shouldReturn` chatStarted chatSendCmd cc "/_start" `shouldReturn` chatStarted
chatRecvMsg cc `shouldReturn` contactSubSummary chatRecvMsg cc `shouldReturn` contactSubSummary
chatRecvMsg cc `shouldReturn` userContactSubSummary chatRecvMsg cc `shouldReturn` userContactSubSummary